TITLE IMAPSV - Multiforking mail access protocol listener
	SUBTTL Derived from SMTJFN
	SEARCH MACSYM,MONSYM
	.REQUIRE SYS:MACREL
	SALL			; suppress macro expansions
	.DIRECTIVE FLBLST	; sane listings for ASCIZ, etc.
	.TEXT "/NOINITIAL"	; suppress loading of JOBDAT
	.TEXT "IMAPSV/SAVE"	; save as IMAPSV.EXE

; Version components

IMPWHO==0			; who last edited IMAPSV (0=developers)
IMPVER==6			; IMAPSV's release version (matches monitor's)
IMPMIN==1			; IMAPSV's minor version
IMPEDT==^D2			; IMAPSV's edit version

;  This program manages a set of MAPSER forks, and uses TCP JFNs instead
; of TVTs for I/O.
;
;  The maximum number of simultaneous connections allowed is controlled
; by the setting of NFKS below.  The maximum number of forks to allow to
; exist after they have finished (in order to cut down on MAPSER startup
; overhead) is specified with MAXIDL.

IFNDEF MAXIDL,MAXIDL==2		; maximum allowable idle forks
IFNDEF NFKS,NFKS==^D30		; maximum simultaneous connections
IFNDEF PDLLEN,PDLLEN==200	; PDL size

A=1				; AC definitions
B=2
C=3
D=4
FX=14				; fork table index of current fork
CX=16

; Fork variables
;
;  The current fork index (not a TOPS-20 fork handle) is always kept in
; FX, so indexing into the fork table is done implicitly by the following
; DEFSTRs.

DEFSTR FH,FKSTAT(FX),17,18	; TOPS-20 fork handle
DEFSTR FKRUN,FKSTAT(FX),18,1	; set if fork is currently running
DEFSTR FKJFN,FKSTAT(FX),35,9	; fork's network JFN
 
DEFINE NOINT <CALL .NOINT>	; disable PSI
DEFINE OKINT <CALL .OKINT>	; enable PSI
DEFINE TMOSET (INTVL,RETAD) <
	SETZM CLKCNT
	PUSH P,[PC%USR+RETAD]
	POP P,CLKLOC
	PUSH P,[-<INTVL/5>]
	POP P,CLKCNT
>;DEFINE TMOSET

DEFINE TMOCLR <
	SETZM CLKCNT
	SETZM CLKLOC
>;DEFINE TMOCLR
	SUBTTL Data area

PC1:	BLOCK 1			; level 1 interrupt PC
IN1ACS:	BLOCK 20		; level 1 AC save
PC2:	BLOCK 1			; level 2 interrupt PC
IN2ACS:	BLOCK 20		; level 2 AC save
CLKCNT:	BLOCK 1			; clock count
CLKLOC:	BLOCK 1			; clock location
NRUN:	BLOCK 1			; active fork count list
NFORKS:	BLOCK 1			; subfork count
NJFNS:	BLOCK 1			; connection count
FKSTAT:	BLOCK NFKS		; fork status
PDL:	BLOCK PDLLEN		; stack
	SUBTTL Pure data

CHNTAB:	PHASE 0			; interrupt channel table
TIMCHN:!1,,TIMINT		; timeout
	BLOCK .ICIFT-.
.ICIFT:!2,,FRKINT		; fork termination interrupts
	BLOCK ^D36-.
	DEPHASE
	
LEVTAB:	PC1			; level 1
	PC2			; level 2
	BLOCK 1			; level 3 unused
	SUBTTL Main program

; Entry vector

EVEC:	JRST IMAPSV		; START address
	JRST IMAPSV		; REENTER address
	<FLD IMPWHO,VI%WHO>!<FLD IMPVER,VI%MAJ>!<FLD IMPMIN,VI%MIN>!<FLD IMPEDT,VI%EDN>
EVECL==.-EVEC

IMAPSV:	RESET%
	MOVE P,[IOWD PDLLEN,PDL]
	MOVX A,.FHSLF		; enable all capabilities
	RPCAP%
	IORB C,B
	EPCAP%
	MOVE B,[LEVTAB,,CHNTAB]
	SIR%			; set up interrupt channels
	EIR%			; enable interrupts
	MOVX B,1B<TIMCHN>!1B<.ICIFT> ; channels to interrupt on
	AIC%			; activate the interrupt channels
	JSP CX,SETTIM		; start the timer
	GJINF%			; get my job number
	MOVE A,C
	MOVX B,<JP%SYS!2>	; get some response for the poor schmucks
	SJPRI%
	SETZM FKSTAT		; clear the fork table
	MOVE A,[FKSTAT,,FKSTAT+1]
	BLT A,FKSTAT+NFKS-1
	DO.
	  MOVE A,NRUN		; get running fork count
	  CAIL A,NFKS		; all in use?
	   WAIT%		; yes, wait for one to complete
	  CALL LISTEN		; listen for a connection
	  LOOP.			; and go back for another one
	ENDDO.
	SUBTTL Interrupt routines

; Here to initialize the timer, called via JSP CX,SETTIM.  Note that A,B,C
; are clobbered!

SETTIM:	MOVE A,[.FHSLF,,.TIMEL]	; tick the timer
	MOVX B,^D5000		; every 5 seconds
	MOVX C,TIMCHN		; on TIMCHN channel
	TIMER%
	 ERJMP .+1
	JRST (CX)

;;;Here on timer interrupt
TIMINT:	MOVEM 17,IN1ACS+17	; save ACs
	MOVEI 17,IN1ACS
	BLT 17,IN1ACS+16
	JSP CX,SETTIM		; reinitialize the timer
	AOSE CLKCNT		; should time out now?
	IFSKP.
	  SKIPE A,CLKLOC	; get time-out routine
	   MOVEM A,PC1		; set it
	ENDIF.
	MOVSI 17,IN1ACS		; restore ACs
	BLT 17,17
	DEBRK%

; FRKINT is called on fork termination to scan the fork list to find
; any halted forks and close the corresponding connections.

FRKINT:	MOVEM 17,IN2ACS+17	; save ACs
	MOVEI 17,IN2ACS
	BLT 17,IN2ACS+16
	MOVE 17,IN2ACS+17
	MOVE A,PC2		; get interrupt pc location
	MOVE A,-1(A)		; get waiting instruction
	CAME A,[WAIT%]		; waiting for a free fork?
	IFSKP.
	  SETONE PC%USR,PC2	; yes, make JSYS return to user
	ENDIF.
	MOVSI FX,-NFKS		; loop through all forks
	DO.
	  IFQN. FKRUN		; only "running" forks are checked
	    LOAD A,FH		; get the fork handle
	    RFSTS%		; get its status
	     ERJMP STOP
	    HRRZS B		; flush flags from PC
	    LOAD D,RF%STS,A	; get the fork status code
	    CAIE D,.RFHLT	; halted?
	     CAIN D,.RFFPT	; or terminated?
	      SOSA NRUN		; yes, one less running fork
	  ANSKP.
	    SETZRO FKRUN	; say fork is no longer running
	    CAIE D,.RFHLT	; halted normally?
	    IFSKP.
	      MOVE A,NFORKS	; get the number of existing forks
	      SUB A,NRUN	; subtract balance of running forks
	      CAILE A,MAXIDL	; too many free forks?
	    ANSKP.
	    ELSE.
	      LOAD A,FH		; get the fork handle back
	      KFORK%		; zap it
	       ERJMP STOP
	      SOS NFORKS	; one less fork to worry about
	      SETZRO FH		; say the fork is gone
	    ENDIF.
	    LOAD A,FKJFN	; get the JFN
	    CALL CLSJFN		; close the connection
	    SETZRO FKJFN	; delete it from the table
	  ENDIF.
	  AOBJN FX,TOP.		; loop if more forks to examine
	ENDDO.
	MOVSI 17,IN2ACS
	BLT 17,17
	DEBRK%			; return from the interrupt
	 ERJMP STOP

; CLSJFN - close the TCP connection
;
; Accepts:
;	A/ network JFN
; Returns:
;	+1 Always

CLSABT:	TXO A,CZ%ABT		; abort the connection
CLSJFN:	MOVE D,A		; get a copy of the JFN
	TMOSET (30,CLSABT)
	CLOSF%			; close it
	IFJER.
	  TMOCLR
	  MOVE A,D		; get the JFN back
	  RLJFN%		; if close failed, just release JFN
	   ERJMP .+1
	ENDIF.
	TMOCLR
	SOS NJFNS		; one less connection
	RET
	SUBTTL LISTEN - listen for a connection

; Listens for a connection on the TCP IMAP socket and starts up a copy
; of MAPSER.
;
; Returns:
;	+1 open failed
;	+2 open succeeded, IMAP fork started

LISTEN:	STKVAR <TCPJFN>		; temp ac for storing JFN
	DO.
	  MOVX A,GJ%SHT
	  HRROI B,[ASCIZ "TCP:143#;TIMEOUT:60"] ; wait 60 seconds for SYN
	  GTJFN%		; get a JFN to listen on
	  IFJER.
	    MOVX A,^D<10*1000>	; failed, wait a bit
	    DISMS%
	    LOOP.		; and try again
	  ENDIF.
	  MOVEM A,TCPJFN	; copy the JFN to a safe register
	  MOVX B,<OF%RD!OF%WR!<FLD ^D8,OF%BSZ>!<FLD .TCMWH,OF%MOD>>
	  OPENF%		; wait for a connection
	  IFJER.
	    MOVE A,TCPJFN	; get the JFN back
	    RLJFN%		; through it away
	     ERJMP .+1
	    MOVX A,^D<10*1000>	; failed, wait a bit
	    DISMS%
	    LOOP.		; and try again
	  ENDIF.
	ENDDO.
	MOVX B,.TCSTP		; reset retranmission timeout
	SETZ C,			; MAPSER will handle timeout
	TCOPR%
	 ERJMP STOP
	AOS NJFNS		; bump connection count
	GDSTS%			; get the device status
	 ERJMP STOP
	CALL GETFRK		; find a free fork table entry
	IFNSK.
	  MOVE A,TCPJFN
	  HRROI B,[ASCIZ/NO Insufficient system resources; please report this
/]
	  SETZ C,
	  SOUTR%
	   ERJMP .+1
	  CALLRET CLSJFN	; close the connection and return
	ENDIF.
	MOVE A,TCPJFN		; get the JFN back
	STOR A,FKJFN		; save the JFN
	LOAD A,FH		; get the fork handle in a
	LOAD B,FKJFN		; get the JFN
	HRLS B			; B/ input JFN,,output JFN
	SPJFN%			; set the primary JFNs
	 ERJMP STOP
	NOINT			; defer interrupts
	LOAD A,FH
	SETZ B,			; start the fork at normal entry
	SFRKV%			; start it
	 ERJMP STOP
	SETONE FKRUN		; say the fork has been started
	AOS NRUN		; bump running the running fork count
	OKINT			; allow interrupts again
	RET			; return to get another fork

	ENDSV.
	SUBTTL GETFRK - allocate a fork

;  Scan the fork table looking for an idle fork.  If one is found, its
; index is returned, otherwise a new fork is created unless the table is
; full.
;
; Returns:
;	+1 no more forks
;	+2 success, fork index in FX

GETFRK:	MOVSI FX,-NFKS		; loop through all forks
	DO.
	  IFQE. FKJFN		; fork in use?
	    JN FH,,RSKP		; no, if fork exists we can use it
	  AOBJN FX,TOP.
	  ENDIF.
	ENDDO.

; No idle fork exists, so create one if table can hold it

	MOVSI FX,-NFKS
	DO.
	  IFQE. FKJFN		; fork in use?
	    HRRZS FX		; no, isolate the fork index
	    JN FH,,RSKP		; if exists, idle fork appeared, use it
	    MOVX A,CR%CAP	; else make one with our caps
	    CFORK%
	     ERJMP STOP
	    AOS NFORKS		; bump the fork count
	    STOR A,FH		; save the handle
	    TXZ A,.FHSLF
	    MOVX A,GJ%SHT!GJ%OLD
	    HRROI B,[ASCIZ/SYSTEM:MAPSER.EXE/]
	    GTJFN%		; get a handle on the file
	     ERJMP STOP
	    LOAD B,FH		; get the fork handle
	    HRL A,B		; A/ fork,,JFN
	    GET%		; load in the file
	     ERJMP STOP
	    RETSKP		; return with FX set up
	  ENDIF.
	  AOBJN FX,TOP.		; loop if more to try
	ENDDO.
	RET			; otherwise fail
	SUBTTL OKINT and NOINT - turn interrupts on and off

.OKINT:	SAVEAC <A>
	MOVX A,.FHSLF
	EIR%			; enable interrupts
	RET

.NOINT:	SAVEAC <A>
	MOVX A,.FHSLF
	DIR%			; disable interrupts
	RET
	SUBTTL Other randomness

STOP:	HRROI A,[ASCIZ/IMAPSV: /]
	ESOUT%
	MOVX A,.PRIOU
	HRLOI B,.FHSLF		; dumb ERSTR%
	SETZ C,
	ERSTR%
	 NOP			; undefined error number
	 NOP			; can't happen
	MOVX A,^D5000		; sleep for 5 seconds
	DISMS%
	JRST IMAPSV		; restart

; Literals

...VAR:!VAR			; generate variables (there shouldn't be any)
IFN .-...VAR,<.FATAL Variables illegal in this program>
...LIT:	XLIST			; save trees during LIT
	LIT			; generate literals
	LIST

	END EVECL,,EVEC		; The End