;<PUP>PUPSRV.MAC;63    22-JAN-83 10:03:47    EDIT BY TAFT
;<PUP>PUPSRV.MAC;62    21-JAN-83 11:06:02    EDIT BY TAFT
; Change DMPLOG to write daily log files
;<PUP>PUPSRV.MAC;61    13-JAN-83 14:34:58    EDIT BY TAFT
; Change ATPTY to ATNVT
;<PUP>PUPSRV.MAC;60    24-NOV-81 16:23:06    EDIT BY TAFT
; GETUSR accepts and ignores ".registry" suffix.
;<PUP>PUPSRV.MAC;59    10-MAY-81 19:01:11    EDIT BY TAFT
; MAKPRT no longer assigns socket numbers that might conflict
; with automatically-assigned job-relative sockets.
;<PUP>PUPSRV.MAC;58    27-FEB-81 17:05:22    EDIT BY TAFT
; Add lost interrupt watcher
;<PUP>PUPSRV.MAC;57    29-AUG-80 14:21:06    EDIT BY TAFT
; Get local host address(es) as well as name at initialization time.
; Add auto-restart to install new version of PUPSRV.
;<PUP>PUPSRV.MAC;56    10-FEB-80 12:06:16    EDIT BY TAFT
; Get time zone from Tenex rather than compiling it in
;<PUP>PUPSRV.MAC;55     8-FEB-80 14:20:45    EDIT BY TAFT
; Change Validate Recipient Pup type
;<PUP>PUPSRV.MAC;54     2-FEB-80 15:56:03    EDIT BY TAFT
; Add ValidateRecipient to misc server
;<PUP>PUPSRV.MAC;53    20-JAN-80 17:42:24    EDIT BY TAFT
; Move mail-related misc services code to PUPMLS.MAC
;<PUP>PUPSRV.MAC;52    28-NOV-79 11:14:40    EDIT BY TAFT
; Give mail server distinct entry point
;<PUP>PUPSRV.MAC;51     2-SEP-79 16:01:20    EDIT BY TAFT
;<PUP>PUPSRV.MAC;50    18-MAR-79 19:20:42    EDIT BY TAFT
; Add call to mail server initialization
;<PUP>PUPSRV.MAC;49    24-NOV-78 19:09:08    EDIT BY TAFT
; Fix log code so that only the top fork tries to write on the log file
;<PUP>PUPSRV.MAC;48    23-NOV-78 19:24:37    EDIT BY TAFT
;<PUP>PUPSRV.MAC;47    21-NOV-78 18:36:57    EDIT BY TAFT
; Fix race between fork creation and fork termination interrupt.
; Add code to record loss of log entries.
;<PUP>PUPSRV.MAC;45    26-OCT-78 21:50:20    EDIT BY TAFT
; Log server creation before starting fork -- else scramble log entries
;<PUP>PUPSRV.MAC;44     4-SEP-78 13:02:51    EDIT BY TAFT
; Log duplicate RFCs only if debugging
;<PUP>PUPSRV.MAC;43    16-MAY-78 14:07:03    EDIT BY TAFT
; Change Laurel MailCheck to require non-empty as well as undeleted mailbox
;<PUP>PUPSRV.MAC;42    28-APR-78 11:16:38    EDIT BY TAFT
; Add Laurel variant of Mail Check request
;<PUP>PUPSRV.MAC;41    24-APR-78 19:37:28    EDIT BY TAFT
; Remove server for old Alto time standard
;<PUP>PUPSRV.MAC;40    11-JAN-78 17:15:09    EDIT BY TAFT
; Raise lower-case password in authentication server
;<PUP>PUPSRV.MAC;38    31-DEC-77 20:30:55    EDIT BY TAFT
; Conform to revised local time parameter format
;<PUP>PUPSRV.MAC;37    18-DEC-77 16:01:26    EDIT BY TAFT
; Add server for new Alto time standard
; Add user authentication server
;<PUP>PUPSRV.MAC;36    15-SEP-77 11:50:58    EDIT BY TAFT
; Map DDT down to inferior fork if present in top fork.
;<PUP>PUPSRV.MAC;35    15-APR-77 09:51:15    EDIT BY TAFT
; Set SERVF during initialization
;<PUP>PUPSRV.MAC;34     7-APR-77 19:03:57    EDIT BY TAFT
; Improve handling of various fork states in DELFRK
; Prevent some possible (but unlikely) races in fork manipulation
;<PUP>PUPSRV.MAC;33    18-MAR-77 17:43:46    EDIT BY TAFT
; Rip out UUO handler -- now share PUPUUO.MAC with PUPFTP.
; Absorb the few remaining routines from PUPUTL back into PUPSRV.
;<PUP>PUPSRV.MAC;31    25-OCT-76 21:09:26    EDIT BY TAFT
; Put in better random number generator
; Top loop computes dismiss time based on next timer to expire
;<PUP>PUPSRV.MAC;30    20-OCT-76 13:27:23    EDIT BY TAFT
; Remove name lookup to PUPDIR.MAC
; Add hooks for network directory update logic
;<PUP>PUPSRV.MAC;29     5-OCT-76 02:09:20    EDIT BY TAFT
; Fix FNDCON bug when purging obsolete entry
;<PUP>PUPSRV.MAC;28     3-OCT-76 00:16:43    EDIT BY TAFT
; Split out gateway info stuff into separate file PUPGAT.MAC
;<PUP>PUPSRV.MAC;26    14-AUG-76 18:05:14    EDIT BY TAFT
; Print octal numbers unsigned
; Control-S forces event buffer dump also
;<PUP>PUPSRV.MAC;25    13-AUG-76 17:36:35    EDIT BY TAFT
; Log illegal pup type errors only if debugging.
; Fix MAKPRT to handle errors properly.
;<PUP>PUPSRV.MAC;24    30-JUN-76 20:02:03    EDIT BY TAFT
; Remove various utility routines to PUPUTL.MAC
; Modify initialization for new storage assignment mechanisms
;<PUP>PUPSRV.MAC;21     1-JUN-76 18:02:26    EDIT BY TAFT
; Change MAKPRT to generate foreign port address as constant, not symbolically
;<PUP>PUPSRV.MAC;20    14-MAY-76 19:50:29    EDIT BY TAFT
; Fix race between DELFRK and fork termination interrupt
; Add code to release log lock when a fork crashes
;<PUP>PUPSRV.MAC;19     7-MAR-76 00:23:44    EDIT BY TAFT
; Add check for illegal zero fields in incoming RFCs

; Copyright 1979, 1980 by Xerox Corporation

	TITLE PUPSRV -- TOP FORK OF PUP SERVER
	SUBTTL E. A. Taft / September, 1975

	SEARCH PUPDEF,PSVDEF,STENEX
	USEVAR TOPVAR,TOPPVR

; Initialize

PUPSRV::RESET			; Close files, kill forks
	MOVE P,[IOWD STKLEN,STACK]  ; Setup stack
	MOVSI F,(SERVF)		; Clear flags, set SERVF

	PUSHJ P,CKOVLP##	; Check for storage overlap

	MOVNI D,ETOPPV##	; End of top fork storage
	ADDI D,IGSLOC-777	; Compute -number of pages
	LSH D,-9
	MOVSI D,0(D)		; Make AOBJN pointer
	SETO A,			; Delete page
	MOVSI B,400000		; This fork
	HRRI B,IGSLOC/1000(D)	; Unmap and delete storage page
	PMAP
	AOBJN D,.-2

	SETOB FX,FORKX		; Record that we are the top fork
	SETOB SV,SERVX		; No service in progress

	PUSHJ P,INILOG		; Initialize logging package
	PUSHJ P,INIPSI		; Initialize psi system
	PUSHJ P,INIGTB		; Initialize GETAB table pointers

	GTAD			; Get current date/time
	AOJE A,[MOVEI A,^D5000	; None set yet
		DISMS		; Wait 5 seconds
		JRST .-1]	; Look again

	GJINF			; Get job info
	MOVEI 1,400000		; This fork
	RPCAP			; Get capabilities
	SKIPL D			; Skip if detached
	 TLOA F,(DEBUGF)	; Attached, assume debugging
	 IORI C,600000		; Detached, enable wheel/operator
	AND C,B			;  if possible
	EPCAP
	TRNE C,600000		; Enabled wheel or operator?
	 TLO F,(ENABLF)		; Yes, remember so

; Initialization (cont'd)

	LOG <***** PUPSRV restarted *****>

	PUSHJ P,ERPINI##	; Init event report server

	MOVSI SV,-NSERVS	; Count services
INIT1:	HRRZM SV,SERVX		; Save index in case error
	PUSHJ P,OPNSRV		; Open server socket
	MOVEM A,SRVJFN(SV)	; Store JFN
	AOBJN SV,INIT1		; Repeat for all server sockets
	SETOB SV,SERVX		; No service in progress

	GJINF			; Get job info
	ADDI C,^D100000		; Make job # + 100000
	TLNN F,(ENABLF)
	 DTYPE <Server sockets are %3O00000+n%/>

	PUSHJ P,SSTTIM		; Init time for logging statistics
	PUSHJ P,SGCTIM		; Init time for GC of connections
	PUSHJ P,GATINI##	; Init gateway info server
	PUSHJ P,DIRINI##	; Init directory update server
	PUSHJ P,INIMLS##	; Init mail server

	MOVSI A,-NFORKS		; Initialize fork timers
	HRLOI B,377777		;  to infinity
	MOVEM B,FRKTIM(A)
	AOBJN A,.-1

	SETO B,			; Get and save local time zone
	SETZ D,
	ODCNV
	LDB A,[POINT 6,D,17]
	MOVEM A,TIMZON

; -----------------------------------------------------------------
;	Main loop of top fork
; -----------------------------------------------------------------

BSLEEP:		; New packet arrival interrupts out of this range
	MOVSI SV,-NSERVS	; Init count of services
	SKIPE NEWPKT(SV)	; New packet for port?
	 JRST LOOP2		; Yes, process it
	AOBJN SV,.-2		; No, check next
	SETOB SV,SERVX		; None now, reset indices

; Check time to expiration of selected timers.
; Timers whose expiration generate periodic broadcast Pups
; should be checked in this fashion in order to avoid synchronizing
; with other hosts doing the same thing.
	TIME			; Get now
	SUB A,GATTIM##		; How long until gateway timer expires
	MOVNS A
	JUMPLE A,LOOP5		; Already expired, service it
	CAILE A,POLINT*^D1000	; Greater than maximum?
	 MOVEI A,POLINT*^D1000	; Yes, use maximum
	TLNN F,(CHKTMF)		; Forced to check timers?
	 DISMS			; No, dismiss for poll interval
ESLEEP:		; End of code that can be interrupted out of
	JRST LOOP5		; If get here, just check timers

; Here when a packet has arrived for some port
;	SV/ service index
LOOP2:	HRRZM SV,SERVX		; Save service index in case error
	MOVEI A,400000		; Get runtime for this fork
	RUNTM
	PUSH P,A		; Save it
LOOP3:	SETZM NEWPKT(SV)	; Clear count
	SKIPGE A,SRVJFN(SV)	; Get JFN for server port
	 JRST LOOP4		; Isn't one
	HRLI A,(1B0+1B1)	; Check checksum, never dismiss
	MOVE B,[MXPBLN,,SRVPKT]	; Length,,address of packet buffer
	PUPI			; Attempt to input a Pup
	 JRST [	CAIN A,PUPX3	; Failed, check error code
		 JRST LOOP4	; Simply nothing there, go on
		MOVEI PB,SRVPKT	; Set pointer to received packet
		ELOG <Error reading Pup from %2P%/ - %1J>
		JRST LOOP3]	; Ignore bad packet and go on
	AOS SRVCNT(SV)		; Count packets received on port
	MOVEI PB,SRVPKT		; Set pointer to received packet
	LDB A,PUPTYP		; Load Pup Type
	CAIN A,PT.ERR		; Error packet?
	 JRST LOOP3		; Yes, ignore
	HRRZ B,SRVDSP(SV)	; Get dispatch
	PUSHJ P,0(B)		; Perform the service
	SETO FX,		; No specific fork now
	JRST LOOP3		; Look for next packet

; Here when port queue empty
LOOP4:	MOVEI A,400000		; Get runtime for this fork
	RUNTM
	POP P,B			; Restore runtime at start
	SUB A,B			; Compute increment
	ADDM A,SRVTIM(SV)	; Add to total for this service

	SKIPE NEWPKT(SV)	; Check flag for service
	 JRST LOOP2		; Nonzero, look again
	AOBJN SV,.-2		; Loop for remaining services

; Main loop (cont'd)

; Here when no more ports to check.  Check timers and dismiss
LOOP5:	SETOB SV,SERVX		; Now no services in progress
	TIME			; Get now
	MOVE P1,A
	TLZ F,(CHKTMF)		; Reset forced check flag

	MOVSI FX,-NFORKS	; Scan fork table
	CAML P1,FRKTIM(FX)	; Fork timed out?
	 PUSHJ P,DELFRK		; Yes, flush it
	AOBJN FX,.-2
	SETO FX,		; No specific fork now

	CAML P1,STTTIM		; Time to log statistics?
	 PUSHJ P,LOGSTT		; Yes, do so
	CAML P1,GCCTIM		; Time to GC connection table?
	 PUSHJ P,GCCON		; Yes, do so
	CAML P1,LOGTIM		; Time to force data to log file?
	 PUSHJ P,DMPLOG		; Yes, do so
	CAML P1,ERPTIM##	; Time to dump event logs?
	 PUSHJ P,DMPAEB##	; Yes, do so
	CAML P1,GATTIM##	; Time to do gateway info stuff?
	 PUSHJ P,GATCHK##	; Yes, do so
	CAML P1,DIRTIM##	; Time to do net directory check?
	 PUSHJ P,DIRCHK##	; Yes, do so
	CAML P1,RSTTIM		; Time to check for auto-restart?
	 PUSHJ P,RSTCHK		; Yes, do so
	CAML P1,LIWTIM		; Time to check for lost interrupts?
	 PUSHJ P,LIWCHK		; Yes, do so

	JRST BSLEEP		; Back to top


; Lost interrupt watcher.
; It seems that Tenex occasionally loses the "packet arrived" interrupt,
; and somehow we end up with one of the port IQs full (and therefore unable
; to receive more Pups and generate more interrupts) without having noticed
; that anything is there.  Therefore, occasionally force all ports
; to be polled.

LIWCHK:	MOVSI A,-NSERVS
	AOS NEWPKT(A)		; Poke the port
	AOBJN A,.-1
	TIME			; Compute next time to do this
	ADD A,[LIWINT*^D1000]
	MOVEM A,LIWTIM
	POPJ P,


LS LIWTIM

; -----------------------------------------------------------------
;	Pup Servers
; -----------------------------------------------------------------

; Assemble socket number table

DEFINE X(NAME,SOCKET,ROUTINE) <
	SOCKET
>

SRVSKT::SERVERS
	BLOCK NSERVS-<.-SRVSKT>

; Assemble name and dispatch table

DEFINE X(NAME,SOCKET,ROUTINE) <
IF2,<IFNDEF ROUTINE,<EXTERN ROUTINE>>
	[ASCIZ /NAME/] ,, ROUTINE
>

SRVDSP::SERVERS
	BLOCK NSERVS-<.-SRVDSP>

; Server socket data base

LS SRVJFN,NSERVS	; JFNs for the server sockets (-1 => none)
LS NEWPKT,NSERVS	; Nonzero if new packet arrived for port
LS SRVCNT,NSERVS	; Count of packets received on this port
LS SRVTIM,NSERVS	; Time spent servicing this port

LS SRVPKT,MXPBLN	; Packet buffer for i/o on server sockets

; Servers implemented by subroutines in the top fork
; All have the following calling sequence:
;	PB/ Pointer to incoming packet
;	A/ Pup Type of incoming packet
;	SV/ Service table index
; Returns +1 always
; Clobbers A-D


; Telnet server (socket 1)

TELSRV:	CAIE A,PT.RFC		; Make sure it's an RFC
	 JRST [	ELOG <Illegal Pup Type %1O from %2P>
		POPJ P,]
	PUSHJ P,CHKENT		; Check for logins allowed
	 POPJ P,		; Not allowed, stop here
	PUSHJ P,OPNCON		; Open local connection port
	 POPJ P,		; Failed, message already printed
	PUSH P,A		; Save receive JFN
	PUSH P,B		; Save send JFN
	SETZ C,			; Return just status
	GDSTS
	TLO B,(1B7)		; Suppress checksumming
	SDSTS
	MOVE B,0(P)		; Recover second JFN
	ATNVT			; Attach JFNs to NVT
	 JRST TELSRF		; Failed
	SUB P,[2,,2]		; Ok, flush JFNs from stack
	PUSH P,A		; Save TTY designator
	PUSHJ P,SNDRFC		; Send answering RFC
	 CAI			; Too late to worry about errors
	POP P,A			; Recover TTY designator
	MOVEI B,3		; Force control-C on line
	STI
	MOVEI B,-400000(A)	; Convert designator to TTY #
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <TTY %2O <=> %3P>
	POPJ P,			; Done

; Here if ATNVT failed
TELSRF:	ELOG <Failed to attach NVT to %3P%/ - %1J>
	CAIE A,ATNX13		; Simply out of NVTs?
	 JRST [	PUSHJ P,SNDABJ	; No, give JSYS error verbatim
		JRST TELSR7]
	HRROI B,[ASCIZ /No Pup terminals available/]
	PUSHJ P,SNDABT		; Send Abort with this string
TELSR7:	POP P,B			; Recover send JFN
	POP P,A			; Recover receive JFN
	PUSHJ P,ABTCO2		; Kill local connection port
	POPJ P,



; Gateway info server (socket 2) is in PUPGAT.MAC


; FTP server (socket 3)
; Mail server (socket 7)

FTPSRV:
MAISRV:	CAIE A,PT.RFC		; Make sure it's an RFC
	 JRST [	ELOG <Illegal Pup Type %1O from %2P>
		POPJ P,]
	PUSHJ P,CHKENT		; Check for logins allowed
	 POPJ P,		; Not allowed, stop here
	PUSHJ P,MAKFRK		; Make server fork
	 POPJ P,		; Failed
	LOG <Server created for %3P>
	HRRZ A,FRKHND(FX)	; Succeeded, get fork handle
	MOVEI B,FTPFRK##	; Starting address
	SFORK			; Start the fork
	PUSHJ P,SETWDT		; In case FRKTRM saw fork before it was started
	POPJ P,

; Miscellaneous server (socket 4)

MSCSRV:	MOVSI B,-NMISCT		; Search for Pup type in table
MSCSR1:	MOVE C,MSCTYP(B)
	TLC C,0(A)
	TLNN C,-1
	 JRST 0(C)		; Found it, dispatch
	AOBJN B,MSCSR1
	TLNE F,(DEBUGF)		; Not found, log only if debugging
	 ELOG <Illegal Pup Type %1O from %2P>
	POPJ P,

MSCTYP:	200 ,, DATSTR		; Date and time as a string
	202 ,, DATTNX		; Date and time in Tenex form
	204 ,, CPOPJ##		; Date and time in old Alto form -- ignore
	206 ,, DATNEW		; Date and time in new Alto form
	210 ,, MAICHK##		; Mail check (Msg variant)
	214 ,, MAICHK##		; Mail check (Laurel variant)
	220 ,, NETLUK##		; Network directory lookup
	230 ,, WHRUSR		; Where is user
	240 ,, DIRVER##		; Net dir version info
	241 ,, DIRSND##		; Send net dir request
	250 ,, AUTHUS##		; User authentication request
	266 ,, VALREC##		; Validate recipient request

NMISCT==.-MSCTYP


; Where is user?
WHRUSR:	PUSHJ P,SAVE2##
	HRROI A,TEMP		; Where to put name string
	PUSHJ P,GETUSR		; Get user name from request Pup
	 JRST [	LOG <Where is "%C" failed for %2P>
		MOVEI A,232	; Pup Type for error
		HRROI B,[ASCIZ /No such Maxc user/]
		JRST REPSTR]	; Send the error Pup and return
	MOVE P1,A		; Ok, save dir #
	MOVE A,JOBDIR		; Read job-directory table
	MOVEI B,TEMP+200	; Put it here
	PUSHJ P,REDGTB
	MOVEI P2,PBCONT(PB)	; Init byte ptr into packet
	HRLI P2,(POINT 8)
	HLLZ D,JOBDIR		; Init AOBJN ptr
WHRUS1:	HRRZ A,TEMP+200(D)	; Get logged-in dir #
	CAIE A,(P1)		; Compare to user being checked
	 JRST WHRUS5		; Not equal
	IDPB D,P2		; Got one, store job # in packet
	MOVE A,JOBTTY		; Get table # for job-TTY mapping
	HRLI A,0(D)		; Set index
	GETAB			; Get controlling TTY
	 PUSHJ P,SCREWUP
	HLRE A,A		; Put in rh, extend sign
	IDPB A,P2		; Store it (detached => 377)
WHRUS5:	AOBJN D,WHRUS1		; Repeat for all jobs
	MOVE A,P2		; Done, get byte ptr
	PUSHJ P,ENDPUP		; Compute length of Pup
	PUSHJ P,SWPPRT		; Swap source and destination
	MOVEI A,231		; Pup Type for reply
	PUSHJ P,SNDPUP		; Send it off
	 POPJ P,		; Failed
	HRROI B,TEMP		; Ok, recover name string ptr
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Where is "%2S" for %1P>
	POPJ P,

; Date and time as a string
DATSTR:	MOVEI A,PBCONT(PB)	; Init byte ptr into packet
	HRLI A,(POINT 8)
	SETO B,			; Current date and time
	SETZ C,			; Standard form DD-MMM-YY HH:MM:SS
	ODTIM			; Put date and time in packet
	PUSHJ P,ENDPUP		; Finish up, compute size
	PUSHJ P,SWPPRT		; Swap source and destination
	MOVEI A,201		; Reply Pup Type
	JRST DATSND		; Go send it and log it

; Date and time in Tenex internal form:
; Two 24-bit numbers containing the Tenex date and time,
;  respectively, right-justified
DATTNX:	GTAD			; Get now
	LSHC A,-^D18		; Separate date and time
	LSH A,6			; Make gap of 6 bits
	LSHC A,2		; Pick off 2 high bits of time
	LSH A,4			; Date in B6-23, high time in 30-31
	MOVEM A,PBCONT(PB)	; Store date/time
	MOVEM B,PBCONT+1(PB)
	MOVEI A,MNPLEN+6	; Length = 6 bytes
	DPB A,PUPLEN
	PUSHJ P,SWPPRT		; Swap source and destination
	MOVEI A,203		; Reply Pup Type
	JRST DATSND		; Go send it and log it

; Date and time in new Alto format:
; A 32-bit number representing seconds since midnight, Jan 1, 1901, GMT
DATNEW:	GTAD			; Get now
	HLRZ B,A		; Get days
	SUBI B,^D15385		; Adjust origin to Jan 1, 1901
	IMULI B,^D86400		; Convert days to seconds
	ADDI B,0(A)		; Add seconds increment
	LSH B,4			; Left-justify 32 bits
	MOVEM B,PBCONT(PB)	; Put it in the Pup
	MOVE A,[POINT 8,PBCONT+1(PB)]
	MOVE B,TIMZON		; Local time zone
	IDPB B,A
	SETZ B,
	IDPB B,A
	TLC A,(30B11)
	MOVEI B,^D121		; DST start day
	IDPB B,A
	MOVEI B,^D305		; DST end day
	IDPB B,A
	MOVEI A,MNPLEN+^D10	; Length = 10 bytes
	DPB A,PUPLEN
	PUSHJ P,SWPPRT		; Swap source and destination
	MOVEI A,207		; Reply Pup type
DATSND:	PUSHJ P,SNDPUP		; Send it off
	 POPJ P,		; Failed
	TLNE F,(DEBUGF)		; Log only if debugging
	 LOG <Date and time for %1P>
	POPJ P,

LS TIMZON		; Local time zone


; Network Directory Lookup code is in PUPDIR.MAC
; Mail Check, Validate Recipient, and Authenticate code is in PUPMLS.MAC

; Echo server (socket 5)

ECHSRV:	CAIE A,PT.ECH		; Make sure it's an EchoMe packet
	 JRST [	ELOG <Illegal Pup Type %1O from %2P>
		POPJ P,]
	PUSHJ P,SWPPRT		; Swap source and destination ports
	MOVEI A,PT.IEC		; Set Type to "I'm an echo"
	DPB A,PUPTYP
	SETZ A,			; Clear transport control byte
	DPB A,PUPTCB
	PUSHJ P,GPTCKS		; Get pointer to checksum
	LDB C,B			; Get the checksum
	HRRZ A,SRVJFN(SV)	; Get port JFN
	CAIE C,177777		; Was incoming Pup checksummed?
	 HRLI A,(1B1)		; Yes, checksum outgoing Pup
	MOVEI B,PBHEAD(PB)	; Set address
	HRLI B,MXPBLN		; Maximum length
	PUPO			; Send off the reply
	 JRST [	ELOG <Error sending Pup to %1P%/ - %1J>
		POPJ P,]
	POPJ P,			; Don't log successful echo replies



; Get pointer to Pup checksum
;	PB/ Packet Buffer pointer
; Returns +1:
;	A/ Packet-Buffer-relative offset of 16-bit checksum word
;	B/ Byte pointer to Pup checksum
; No other ac's clobbered

GPTCKS:	LDB A,PUPLEN		; Get Pup length in bytes
	MOVEI A,4*PBHEAD-1(A)	; Compute PB-relative 16-bit word offset
	LSH A,-1		;  of Pup checksum
				; Fall into GPTWRD


; Get pointer to 16-bit word in Pup
;	A/ Packet-Buffer-relative offset of word
;	   e.g. 2*PBHEAD denotes offset of Pup Length field
; Returns +1:
;	B/ Byte ptr to selected word (indexed by PB)
; No ac's clobbered (besides B)

GPTWRD:	MOVEI B,(A)		; Copy offset
	ROT B,-1		; Compute Maxc-word offset
	JUMPL B,.+2		; Which byte?
	 TLOA B,(POINT 16,(PB),15)  ; Left
	 HRLI B,(POINT 16,(PB),31)  ; Right
	POPJ P,

; Get Destination Port from Pup
;	PB/ Packet buffer ptr
; Returns +1:
;	A/ Net, B/ Host, C/ Socket

GTDPRT::MOVE A,PBHEAD+2(PB)	; Get net/host and high socket
	MOVE C,PBHEAD+3(PB)	; Get low socket
	LSHC A,-^D28		; Right-justify net
	LSH B,-^D12		; Right-justify high socket
	LSHC B,-^D16		; Concatenate, right-justify host
	LSH C,-4		; Right-justify socket
	POPJ P,

; Set Destination Port in Pup
;	PB/ Packet buffer ptr
;	A/ Net, B/ Host, C/ Socket
; Returns +1
; Clobbers A-C

STDPRT::DPB A,PPUPDN		; Store net
	DPB B,PPUPDH		; Store host
	DPB C,PPUPD1		; Store low socket
	LSH C,-^D16		; Right-justify high socket
	DPB C,PPUPD0		; Store it
	POPJ P,



; Get Source Port from Pup
;	PB/ Packet buffer ptr
; Returns +1:
;	A/ Net, B/ Host, C/ Socket

GTSPRT::LDB A,PPUPSN		; Get net
	LDB B,PPUPSH		; Get host
	LDB C,PPUPSS		; Get socket
	POPJ P,

; Set Source Port in Pup
;	PB/ Packet buffer ptr
;	A/ Net, B/ Host, C/ Socket
; Returns +1

STSPRT::DPB A,PPUPSN		; Store net
	DPB B,PPUPSH		; Store host
	DPB C,PPUPSS		; Store socket
	POPJ P,

; Get Connection Port from RFC Pup
;	PB/ Packet buffer ptr
; Returns +1:
;	A/ Net, B/ Host, C/ Socket

GTCPRT::MOVE A,PBCONT(PB)	; Get net/host and high socket
	MOVE C,PBCONT+1(PB)	; Get low socket
	LSHC A,-^D28		; Right-justify net
	LSH B,-^D12		; Right-justify high socket
	LSHC B,-^D16		; Concatenate, right-justify host
	LSH C,-4		; Right-justify socket
	POPJ P,

; Set Connection Port in RFC Pup
;	PB/ Packet buffer ptr
;	A/ Net, B/ Host, C/ Socket
; Returns +1
; Clobbers A-C

STCPRT::LSH C,4			; Left-justify socket
	LSHC B,^D16		; Concatenate host and high socket
	LSH B,^D12		; Left-justify host
	LSHC A,-8		; Concatenate net/host/high socket
	MOVEM B,PBCONT(PB)	; Store
	MOVEM C,PBCONT+1(PB)
	POPJ P,


; Swap Source and Destination Ports in Pup
;	PB/ Packet buffer pointer
; Returns +1 always
; Clobbers A, B

SWPPRT::MOVE A,PBHEAD+2(PB)	; Get dest net/host/high socket
	MOVE B,PBHEAD+3(PB)	; Get dest low socket
	LSH A,-4		; Concatenate socket
	LSHC A,-^D16		;  and right-justify dest net/host
	EXCH B,PBHEAD+4(PB)	; Exchange source and dest sockets
	LSH A,^D20		; Left-justify dest net/host
	LSH B,-4		; Right-justify source socket
	ROTC A,-^D16		; Concatenate src low skt to dest net/host
	EXCH A,PBHEAD+3(PB)	; Exchange for dst low skt, src net/host
	LSH A,-4		; Right-justify
	LSH B,^D20		; Left-justify source high socket
	LSHC A,-^D16		; Concatenate src net/host/high skt
	MOVEM B,PBHEAD+2(PB)	; Store in header
	POPJ P,

; Get and check Maxc user name in Pup
;	A/ String ptr to temp buffer
;	PB/ Packet buffer ptr
; Returns +1:  Error
;	+2:  Successful, A/ Directory #
; Clobbers A-C

GETUSR::TLC A,-1
	TLCN A,-1
	 HRLI A,(POINT 7)
	MOVEI B,PBCONT(PB)	; Init byte ptr into packet
	HRLI B,(POINT 8)
	LDB C,PUPLEN		; Get Pup Length
	MOVNI C,-MNPLEN(C)	; Subtract overhead, negate
	JUMPGE C,CPOPJ		; Fail if empty
	PUSH P,A		; Save start of buffer
	SOUT			; Move text to buffer, null on end
GETUS1:	MOVEI A,1		; Exact match
	MOVE B,0(P)		; Recover start of buffer
	STDIR			; Look up name
	 JRST GETUS2		; No match
	 CAIA			; Ambiguous, fail
	AOS -1(P)
GETUSX:	POP P,B
	HRRZS A			; Ok, clear lh bits
	POPJ P,

GETUS2:	MOVE A,0(P)		; Failed, see if have ".registry" suffix
	ILDB B,A
	CAIE B,"."
	 JUMPN B,.-2
	JUMPE B,GETUSX		; No, fail
	SETZ B,			; Yes, smash "." with null
	DPB B,A
	JRST GETUS1		; Try again

; Send answering zero-length Pup to sender
;	PB/ Packet buffer pointer
;	A/ Pup Type for reply
; Returns +1 always
; A log entry is made only on failure
; Clobbers A-D

REPNUL::SETZ B,			; No text in message


; Send answering message to sender of Pup
;	PB/ Packet buffer pointer
;	A/ Pup Type for reply
;	B/ String ptr to text of message
; Returns +1 always
; A log entry is made only on failure
; Clobbers A-D

REPSTR::DPB A,PUPTYP		; Set Pup Type
	MOVEI A,PBCONT(PB)	; Init byte ptr into packet
	HRLI A,(POINT 8)
	SETZ C,
	SOUT			; Put string in Pup
	PUSHJ P,ENDPUP		; Compute and store length
	PUSHJ P,SWPPRT		; Swap source and destination
	PUSHJ P,SNDPU1		; Send it off
	 POPJ P,		; Failed
	POPJ P,



; Compute Pup Length given byte pointer
;	A/ Byte ptr to last byte stored
;	PB/ Packet buffer ptr
; Returns +1 always
; Clobbers A-D

ENDPUP::MOVEI B,@A		; Compute address of last word
	SUBI B,PBHEAD-1(PB)	; Compute # 36-bit words used
	LSH B,2			; Convert to bytes
	LSH A,-^D33		; Get bytes not used in last word
	SUBI B,(A)		; Compute Pup Length
	ADDI B,2		; Include checksum
	DPB B,PUPLEN		; Store it
	POPJ P,



; Finish up and send off Pup
;	A/ Pup Type
;	PB/ Packet buffer pointer
;	SV/ Pup service index
; Returns +1:  Unsuccessful
;	+2:  Successful
; A log entry is made only upon failure
; Clobbers A, B

SNDPUP::DPB A,PUPTYP		; Set the type
SNDPU1:	SETZ A,			; Clear transport control byte
	DPB A,PUPTCB
	HRRZ A,SRVJFN##(SV)	; Get port JFN
	HRLI A,(1B1)		; Compute checksum
	MOVEI B,PBHEAD(PB)	; Set address
	HRLI B,MXPBLN		; Maximum length
	PUPO			; Send it off
	 JRST [	ELOG <Error sending Pup to %1P%/ - %1J>
		POPJ P,]	; Fail return
	JRST SKPRET##		; Succeeded, return +2

; -----------------------------------------------------------------
;	Fork management
; -----------------------------------------------------------------

; Make server fork
;	PB/ Packet buffer pointer to incoming RFC
;	SV/ Service table index
; Returns +1:  Failed or duplicate, all cleanup and reporting done
;	+2:  Succeeded:  FX/ Fork table index of new fork
; Clobbers A-D, FX

MAKFRK:	PUSHJ P,CKCPRT		; Check connection port for legality
	 POPJ P,
	PUSHJ P,FNDCON		; Look for a duplicate connection
	 JRST [	TLNE F,(DEBUGF)
		 LOG <Duplicate RFC <=> %3P>
		PUSHJ P,SNDRFC	; Retransmit answering RFC
		 POPJ P,	; Failed -- oh, well
		POPJ P,]	; Nothing more to do

; Search for an empty fork slot
	MOVSI FX,-NFORKS
	SKIPE FRKHND(FX)	; Fork slot empty?
	 AOBJN FX,.-1
	JUMPGE FX,[ELOG <Fork table full for %3P>
		PUSHJ P,DELCON	; Delete connection table entry
		HRROI B,[ASCIZ /Server full, try again later/]
		JRST SNDABT]	; Send Abort and fail return

; Create a fork
	MOVSI A,(1B3)		; Set fork's ac's
	SETZ B,			;  to be same as mine
	CFORK			; Create fork
	 JRST [	ELOG <Failed to create fork for %3P%/ - %1J>
		PUSHJ P,DELCON	; Delete connection table entry
		JRST SNDABJ]	; Send Abort with JSYS error string
	HRRZM A,FRKHND(FX)	; Ok, save fork handle
	HRRM FX,CONFRK(CX)	; Record fork index for connection
	HRLZM CX,FRKSRV(FX)	; Save connection table index
	HRRM SV,FRKSRV(FX)	; Record service being performed

; Open connection port
	PUSHJ P,MAKPRT		; Make local connection port
	 JRST [	ELOG <Failed to connect to %3P%/ - %1J>
		PUSHJ P,SNDABJ	; Send Abort with JSYS error string
		HRRZ A,FRKHND(FX)  ; Kill fork
		SETZM FRKHND(FX)  ; Clear fork slot
		KFORK
		POPJ P,]	; Fail return
	HRLZM A,FRKJFN(FX)	; Ok, store JFNs in fork table
	HRRM B,FRKJFN(FX)
	PUSHJ P,SNDRFC		; Send answering RFC
	 CAI			; Ignore failure

; Set inferior's map and capabilities appropriately
	HRRZ A,FRKHND(FX)	; Get fork handle
	PUSHJ P,SETMAP		; Map code and global storage
	HRRZ A,FRKHND(FX)	; Get fork handle
	MOVSI B,(777B8)		; Pass job but no user capabilities
	SETZ C,			; None initially enabled
	EPCAP			; Set capabilities
	CFGRP			; Define as independent fork group
	 PUSHJ P,SCREWUP

	PUSHJ P,SETWDT		; Set watchdog timer
	JRST SKPRET##		; Return +2

; Delete server fork
;	FX/ Fork table index
; Returns +1
; Clobbers A-D, SV, CX

DELFRK:	HRRZ SV,FRKSRV(FX)	; Get service table index
	HLRZ CX,FRKSRV(FX)	; Get connection table index
	HRRZ A,FRKHND(FX)	; Get fork handle
	FFORK			; Freeze fork in case still running
	HRRZ B,LOGLKF		; Get last locker of log buffer
	SKIPL LOGLCK		; Now locked?
	CAIE B,(FX)		; Yes, by fork being killed?
	 CAIA			; No
	 SETOM LOGLCK		; Yes, unlock it
	RFSTS			; Read fork status
	HLRZ C,A		; Get state
	TRZ C,400000		; Clear frozen bit
	HRLM C,0(P)		; Save state for later
	CAIL C,7		; Make sure in range
	 MOVEI C,7
	HRRZS B			; Clear lh of pc
	HRRZ D,A		; Copy channel # if any
	XCT [	ELOG <Server fork timed out, running at %2O>
		ELOG <Server fork timed out, I/O wait at %2O>
		CAI		; Voluntary termination (normal)
		ELOG <Server fork channel %4D interrupt at %2O>
		ELOG <Server fork timed out, fork wait at %2O>
		ELOG <Server fork timed out, dismissed at %2O>
		ELOG <Server fork breakpoint at %2O>
		ELOG(<Funny fork status %1O at %2O>)](C)
	HRRZ A,FRKHND(FX)	; Get fork handle
	RUNTM			; Return time used by fork
	ADDM A,SRVTIM(SV)	; Accumulate it
	LOG <Terminated server fork, used %1R>
	HRRZ A,FRKHND(FX)	; Get fork handle
	SETZM FRKHND(FX)	; Clear out fork table entry
				; Doing this now prevents the fork
				; termination interrupt routine from
				; noticing this fork's demise.
	HRLOI B,377777		; Reset timer to infinity
	MOVEM B,FRKTIM(FX)
	KFORK			; Kill fork
	SKIPN FRKJFN(FX)	; JFNs already released by fork?
	 JRST DELFR2		; Yes, bypass this
	HRRZ A,FRKJFN(FX)	; Get output JFN for connection
	GTSTS			; Get JFN status
	JUMPGE B,DELFR1		; JFN still open?
	MOVEI B,25		; Yes, abort the connection
	HRROI D,[ASCIZ /Timeout, goodbye/]
	HLRZ C,0(P)		; Recover fork state code
	CAIE C,2		; Stopped by HALTF?
	CAIN C,3		;  or by involuntary termination?
	 HRROI D,[ASCIZ /Server crashed/]
	SETZ C,			; Abort code = 0 (?)
	MTOPR			; Abort the connection
	SETZ B,			; Clear any error flags
	SDSTS
	CLOSF			; Close the port
	 PUSHJ P,SCREWUP	; Can't fail
DELFR1:	HLRZ A,FRKJFN(FX)	; Get input JFN for connection
	GTSTS			; Get JFN status
	JUMPGE B,DELFR2		; JFN still open?
	CLOSF			; Yes, close it
	 PUSHJ P,SCREWUP	; Can't fail
DELFR2:	PUSHJ P,DELCON		; Ok, delete connection table entry
	SETZM FRKJFN(FX)
	SETO SV,		; No service in progress
	POPJ P,

; Set watchdog timer for fork
;	FX/ Fork table index
; Returns +1
; Clobbers A

SETWDT::TIME			; Get now
	ADD A,[WDTINT*^D1000]	; Add timeout interval
	MOVEM A,FRKTIM(FX)	; Set clock
	POPJ P,



; Fork initialization routine
; Enter via JSYS FRKINI with F, FX, SV setup (by creator of fork)
; This should be the first instruction executed in the fork

FRKINI::STACK ,, .+1		; Put return on stack
	MOVE P,[IOWD STKLEN-1,STACK+1]  ; Init stack ptr
	HRRZM FX,FORKX		; Record fork index
	HRRZM SV,SERVX		; Record service table index
	HRRI F,0		; Clear rh flags
	POPJ P,			; Return

; -----------------------------------------------------------------
;	Network I/O and connection management
; -----------------------------------------------------------------

; Open connection port (first part of rendezvous)
;	PB/ Packet buffer ptr to incoming RFC
; Returns +1:  Failed or duplicate, all cleanup and reporting done
;	+2:  Succeeded:
;		A/ input JFN, B/ output JFN for connection
;		CX/ Connection table index
; Clobbers A-D, CX

OPNCON:	PUSHJ P,CKCPRT		; Check connection port for legality
	 POPJ P,
	PUSHJ P,FNDCON		; Look for a duplicate connection
	 JRST [	TLNE F,(DEBUGF)
		 LOG <Duplicate RFC <=> %3P>
		PUSHJ P,SNDRFC	; Retransmit answering RFC
		 POPJ P,	; Failed -- oh, well
		POPJ P,]	; Nothing more to do
	PUSHJ P,MAKPRT		; Not found, make one
	 JRST [	ELOG <Failed to connect to %3P%/ - %1J>
		JRST SNDABJ]	; Send Abort with JSYS error string
	JRST SKPRET##		; Return +2



; Send answering RFC (second part of rendezvous)
;	PB/ Pointer to incoming RFC
;	CX/ Connection table index
; Returns +1:  Failed
;	+2:  Ok
; A log entry is made only upon failure
; Does not clobber the incoming packet
; Clobbers A-D

SNDRFC::PUSH P,PB		; Save pointer to incoming packet
	MOVSI A,(PB)		; Make BLT pointer
	HRRI A,TEMP		; Copy RFC to temp region
	BLT A,TEMP+MNPBLN+2-1
	MOVEI PB,TEMP		; Set pointer to copy
	PUSHJ P,SWPPRT		; Swap source and destination ports
	HLRZ A,CONLNH(CX)	; Get local net
	HRRZ B,CONLNH(CX)	; Host
	MOVE C,CONLSK(CX)	; Socket
	PUSHJ P,STCPRT		; Set Connection Port in Pup
	MOVEI A,PT.RFC		; Pup Type = RFC
	PUSHJ P,SNDPUP		; Finish up and send it
	 SOS -1(P)		; Failed, preset +1 return
	POP P,PB		; Succeeded, recover PB ptr
	JRST SKPRET##		; Return +2

; Send answering Abort with JSYS error string
;	A/ JSYS error #
;	PB/ Packet buffer pointer
; Returns +1
; Clobbers A-D;  also overwrites the incoming RFC

SNDABJ::HRRZ B,A		; Copy error #
	MOVEI A,PBCONT(PB)	; Where to put Abort text
	HRLI A,(POINT 8,,15)
	WRITE <JSYS error:  %2J>
	JRST SNDAB1		; Join common code


; Send answering Abort with arbitrary string
;	PB/ Packet buffer pointer
;	B/ String ptr
; Returns +1
; Clobbers A-D;  also overwrites the incoming RFC

SNDABT::MOVEI A,PBCONT(PB)	; Where to put Abort text
	HRLI A,(POINT 8,,15)
	SETZ C,
	SOUT

; Common code for answering Aborts
;	A/ Byte ptr to last byte stored
SNDAB1:	PUSHJ P,ENDPUP		; Compute and store length
	SETZ A,			; Use zero for Abort code
	DPB A,[POINT 16,PBCONT(PB),15]
	PUSHJ P,SWPPRT		; Swap source and destination ports
	MOVEI A,PT.ABT		; Pup Type = Abort
	PUSHJ P,SNDPUP		; Finish up and send
	 POPJ P,		; Failed
	POPJ P,


; Check whether connections are being accepted (ENTFLG on)
;	PB/ Packet buffer ptr to incoming RFC
; Returns +1:  Not being accepted (reply already generated)
;	+2:  Being accepted
; Clobbers A-D

CHKENT:	HRRZ A,ENTFLG		; Get ENTFLG table number
	GETAB			; Item 0 is what we want
	 PUSHJ P,SCREWUP
	JUMPN A,SKPRET##	; Return +2 if logins allowed
	HRROI B,[ASCIZ /Tenex not available/]
	JRST SNDABT		; Send Abort, return +1


; Check connection port for legality in incoming RFC
;	PB/ Packet buffer ptr to incoming RFC
; Returns +1:  Bad (reply already generated)
;	+2:  Ok.  (also defaults zero net number if required)
; Clobbers A-D

CKCPRT:	PUSHJ P,GTCPRT		; Get connection port from RFC
	JUMPE B,BADPRT		; Zero host is bad
	JUMPE C,BADPRT		; Zero socket is bad
	JUMPN A,.+3		; Zero net?
	LDB A,PPUPSN		; Yes, substitute source net of Pup
	DPB A,[POINT 8,PBCONT(PB),7]
	JRST SKPRET##		; Return +2

BADPRT:	ELOG <Bad connection port %3P for %2P>
	HRROI B,[ASCIZ /Bad connection port/]
	JRST SNDABT		; Abort the connection attempt

; Make local connection port
;	CX/ Connection table index (CONFNH, CONFSK, CONCID setup)
; Returns +1:  Failed, A/ JSYS error #, connection entry deleted
;	+2:  Succeeded, A/ input JFN, B/ output JFN
; Opens JFNs, sets local port address and Tenex connection index
; Clobbers A-D

MAKPRT:	MOVEI D,^D25		; Max # retries for busy errors
MAKPR1:	HRLM D,0(P)		; Save retry count

; Construct filename using random number for local socket
MAKPR2:	PUSHJ P,RANDOM		; Generate random #
	LSH B,-^D21		; Use only 15 bits

; Don't assign local sockets s such that s mod 8 = 0 and
; s < 256*8, so as not to conflict with job-relative sockets
; assigned automatically by Tenex (e.g., in PUPNM).
	TRNN B,74007
	 JRST MAKPR2
	HRROI A,TEMP		; Put string in temp storage
	WRITE <PUP:%2O!J.>	; Generate local port name
	HLRZ B,CONFNH(CX)	; Get foreign net
	HRRZ C,CONFNH(CX)	; Host
	MOVE D,CONFSK(CX)	; Socket
	WRITE <%2O#%3O#%4O>	; Generate foreign port name

; Attempt to open port for input
	MOVSI A,(1B2+1B17)	; Old file, name from string
	HRROI B,TEMP		; Name string in temp storage
	GTJFN			; Get a JFN for the port
	 JRST DELCON		; Failed, clean up and return
	PUSH P,A		; Ok, save it
	MOVE B,[8B5+4B9+1B19]	; Bytesize 8, direct open, read
	MOVE C,CONCID(CX)	; Get connection ID
	OPENF			; Attempt to open the port
	 JRST [	EXCH A,0(P)	; Failed, recover JFN
		RLJFN		; Release it
		 PUSHJ P,SCREWUP
		POP P,A		; Restore error code
		HLRZ D,0(P)	; Get retry count
		CAIN A,OPNX9	; Busy error?
		 SOJG D,MAKPR1	; Yes, retry with another socket #
		JRST DELCON]	; No, delete connection entry and fail

; Now open same port for output
	MOVSI A,(1B2+1B17)	; Old file, name from string
	HRROI B,TEMP		; Name string in temp storage
	GTJFN			; Get a JFN for the port
	 JRST MAKPR8		; Failed
	PUSH P,A		; Ok, save it
	MOVE B,[8B5+4B9+1B20]	; Bytesize 8, direct open, write
	MOVE C,CONCID(CX)	; Get connection ID
	OPENF			; Attempt to open the port
	 JRST MAKPR7		; Failed

; Initialize remaining connection table entries and return
	PUSHJ P,GETLCL		; Get stuff from Tenex tables
	POP P,B			; Restore output JFN
	POP P,A			; Restore input JFN
	JRST SKPRET##		; Return +2

; Here to unwind from failures
MAKPR7:	EXCH A,0(P)		; Save error #, get output JFN
	RLJFN			; Release it
	 PUSHJ P,SCREWUP
	POP P,A			; Recover error #
MAKPR8:	EXCH A,0(P)		; Save error #, get input JFN
	PUSHJ P,ABTCON		; Abort connection
	POP P,A			; Recover error #
	POPJ P,			; Return +1

; Check for new request duplicating an existing connection
;	PB/ Pointer to incoming RFC
; Returns +1:  Duplicate found, CX/ connection table index
;	+2:  No duplicate found, CX/ new connection table index
; On the +2 return, a new connection table index has been assigned
;  and the foreign port and connection ID initialized
; Clobbers A-D

FNDCON:	MOVSI CX,(1B0)		; Note no free entry seen yet
FNDCO1:	PUSHJ P,GTCPRT		; Get Connection Port from RFC
	HRLI B,(A)		; Make foreign net,,host
	MOVE A,PBHEAD+1(PB)	; Get Pup ID
	LSH A,-4		; Right-justify
	MOVSI D,-NCONNS		; Init count of connections
FNDCO2:	CAMN B,CONFNH(D)	; Foreign net/host same?
	 JRST [	CAMN C,CONFSK(D)  ; Yes, foreign socket same?
		CAME A,CONCID(D)  ; And Connection ID same?
		 JRST FNDCO3	; No, continue search
		MOVEI CX,(D)	; Yes, copy index
		PUSHJ P,CHKCON	; Connection still exist?
		 JRST FNDCO5	; No, go delete it
		POPJ P,]	; Yes, return +1 (duplicate)
	SKIPN CONFNH(D)		; Is this slot empty?
	 JUMPL CX,[MOVEI CX,(D)	; Yes, save index if don't have one
		JRST FNDCO3]
FNDCO3:	AOBJN D,FNDCO2		; Repeat for all connections
	JUMPGE CX,FNDCO6	; Not found, jump if saw free slot
	TLOE CX,(1B1)		; Table full, been here before?
	 PUSHJ P,SCREWUP	; Yes, something is wrong
	PUSHJ P,GCCON		; Garbage-collect connection table
	JRST FNDCO1		; Try again

; Here when found matching connection but it no longer exists
FNDCO5:	PUSHJ P,DELCON		; Delete connection table entry
	PUSHJ P,GTCPRT		; Get back connection port address
	HRLI B,(A)		; Make foreign net,,host
	MOVE A,PBHEAD+1(PB)	; Get Pup ID
	LSH A,-4		; Right-justify

; Here when no duplicate, use first free entry seen
FNDCO6:	MOVEM A,CONCID(CX)	; Store connection ID
	MOVEM B,CONFNH(CX)	; Store foreign net/host
	MOVEM C,CONFSK(CX)	; Store foreign socket
	HLLOS CONFRK(CX)	; No fork attached yet
	JRST SKPRET##		; Return +2



; Get and store local port address and Tenex connection index
;	A/ JFN for port
;	CX/ Connection table index
; Returns +1 always
; Clobbers A-D

GETLCL:	CVSKT			; Get local port address
	 PUSHJ P,SCREWUP
	MOVEM B,CONLNH(CX)	; Store local net/host
	MOVEM C,CONLSK(CX)	; Store local socket
	HLLZ C,PUPLSK		; Init count of Tenex ports
GETLC1:	HRRZ A,PUPLSK		; Set GETAB table # of local socket
	HRLI A,(C)		; Index
	GETAB			; Get the local socket
	 PUSHJ P,SCREWUP
	CAME A,CONLSK(CX)	; Same as one we are looking for?
	 JRST GETLC2		; No
	HRRZ A,PUPLNH		; Yes, now get local net/host
	HRLI A,(C)
	GETAB
	 PUSHJ P,SCREWUP
	LSHC A,-^D28		; Right-justify net
	LSH A,^D10		; Make net,,host
	LSHC A,8
	CAMN A,CONLNH(CX)	; Same as one we are looking for?
	 JRST GETLC3		; Yes
GETLC2:	AOBJN C,GETLC1		; Repeat for all Tenex ports
	PUSHJ P,SCREWUP		; Couldn't find local port

GETLC3:	HRLM C,CONFRK(CX)	; Got Tenex index, store in table
	POPJ P,

; Garbage-collect the connection table
; Returns +1
; Clobbers A, B

GCCON:	PUSH P,CX
	MOVSI CX,-NCONNS	; Init count of connections
GCCON1:	SKIPN CONFNH(CX)	; This slot in use?
	 JRST GCCON5		; No, skip it
	HRRE A,CONFRK(CX)	; Connection owned by a fork?
	JUMPGE A,GCCON5		; If so, don't touch it
	PUSHJ P,CHKCON		; Connection still exist?
	 PUSHJ P,DELCON		; No, delete connection table entry
GCCON5:	AOBJN CX,GCCON1		; Repeat for all connections
	POP P,CX

; Called here to init timer
SGCTIM:	TIME			; Get now
	ADD A,[GCCINT*^D1000]	; Compute time for next GC
	MOVEM A,GCCTIM		; Store it
	POPJ P,			; Done

LS GCCTIM		; Time for next GC of connection table



; Check whether connection still exists
;	CX/ Connection table index
; Returns +1:  No longer exists
;	+2:  Still exists
; Clobbers A, B

CHKCON:	HRRZ A,PUPLSK		; GETAB table # for local socket
	HLL A,CONFRK(CX)	; Set Tenex connection index
	GETAB			; Get local socket from Tenex
	 PUSHJ P,SCREWUP
	CAME A,CONLSK(CX)	; Still same local socket?
	 POPJ P,		; No, no longer exists
	HRRZ A,PUPLNH		; Yes, now look at local net/host
	HLL A,CONFRK(CX)	; Set Tenex connection index
	GETAB			; Get local net/host from Tenex
	 PUSHJ P,SCREWUP
	LSHC A,-^D28		; Right-justify net
	LSH A,^D10		; Make net,,host
	LSHC A,8
	CAME A,CONLNH(CX)	; Still same local net/host?
	 POPJ P,		; No, no longer exists
	HRRZ A,PUPFPT		; Yes, now look at foreign port
	HLL A,CONFRK(CX)	; Set Tenex connection index
	GETAB			; Get foreign address table pointer
	 PUSHJ P,SCREWUP
	JUMPE A,CPOPJ##		; No longer exists if none
	SUB A,PUPBFP		; Subtract start of storage
	MOVE B,A		; Save offset
	HRRZ A,PUPBUF		; GETAB table # for storage region
	HRLI A,1(B)		; Get first word of address table
	GETAB
	 PUSHJ P,SCREWUP
	CAME A,CONFNH(CX)	; Still same foreign net/host?
	 POPJ P,		; No, no longer exists
	HRRZ A,PUPBUF		; GETAB table # for storage region
	HRLI A,2(B)		; Get second word of address table
	GETAB
	 PUSHJ P,SCREWUP
	CAMN A,CONFSK(CX)	; Still same foreign socket?
	 AOS 0(P)		; Yes, skip return
	POPJ P,

; Abort Pup connection attempt given both JFNs
;	A/ input JFN
;	B/ output JFN
;	CX/ Connection table index
; Returns +1 always
; Clobbers A-D

ABTCO2:	PUSH P,B		; Save output JFN
	PUSHJ P,ABTCON		; Abort connection, close input JFN
	POP P,A			; Recover input JFN
	CLOSF			; Close it
	 PUSHJ P,SCREWUP	; Can't fail
	POPJ P,


; Abort Pup connection attempt given one JFN
;	A/ JFN
;	CX/ Connection table index
; Returns +1 always
; Clobbers B-D

ABTCON:	MOVEI B,25		; Abort function
	SETZ C,			; No code assigned
	HRROI D,[ASCIZ /Connection attempt aborted/]
	MTOPR			; Abort the connection
	CLOSF			; Close the port
	 PUSHJ P,SCREWUP	; Can't fail
				; Fall into DELCON



; Delete connection table entry
;	CX/ Connection table index
; Returns +1 always
; Clobbers no ac's

DELCON:	SETZM CONFNH(CX)	; Clear all the various cells
	SETZM CONFSK(CX)
	SETZM CONLNH(CX)
	SETZM CONLSK(CX)
	SETOM CONFRK(CX)
	SETZM CONCID(CX)
	POPJ P,

; -----------------------------------------------------------------
;	UUO handler routines specific to PUPSRV
; -----------------------------------------------------------------


; LOG <string>
; Log given string with formatting actions

%ULOG::	TLZA F,(LGTTYF)		; Log only on file

; ELOG <string>
; Log and type the given string with formatting actions

%UELOG::TLO F,(LGTTYF)		; Log on both file and TTY
	PUSHJ P,FORMAT##	; Call formatter
	 PUSHJ P,BEGLOG		; Setup -- begin log entry
	 PUSHJ P,ENDLOG		; Completion -- end log entry
	POPJ P,			; Return from UUO

; UUOs not used in the server
%UNOIS:: %UPROM:: PUSHJ P,SCREWUP


; Individual functions for escape sequences

; C - Pup contents as a string, from packet pointed to by PB
%LETC::	LDB C,PUPLEN		; Get Pup Length
	CAILE C,MNPLEN+^D50	; Limit length
	 MOVEI C,MNPLEN+^D50
	MOVNI C,-MNPLEN(C)	; Subtract overhead, negate
	MOVEI B,PBCONT(PB)	; Init byte ptr into packet
	HRLI B,(POINT 8)
	SKIPGE C		; Unless zero bytes
	 SOUT			; Output bytes from packet
	POPJ P,

; P - Selected address from Pup pointed to by PB
;	1P = Destination, 2P = Source, 3P = Connection Port
%LETP::	PUSH P,A		; Save string ptr
	CAIL C,1		; Make sure arg in range
	CAILE C,3
	 PUSHJ P,SCREWUP
	XCT [	PUSHJ P,GTDPRT	; 1 = Destination Port
		PUSHJ P,GTSPRT	; 2 = Source Port
		PUSHJ P,GTCPRT]-1(C)  ; 3 = Connection Port
	MOVE D,C		; Copy socket
	MOVSI C,(A)		; Make net,,host
	HRRI C,(B)
	POP P,A			; Recover string ptr
	MOVE B,[1B2+C]		; Full expansion, constants allowed
	PUPNM			; Convert address to string
	 PUSHJ P,SCREWUP
	POPJ P,

; -----------------------------------------------------------------
;	Logging routines
; -----------------------------------------------------------------

; Begin a log entry
;	FX/ Fork index of fork being considered
;	SV/ Service table index
; Returns +1, A/ string ptr to logging buffer
; Clobbers B, C

BEGLOG:	PUSHJ P,LCKLOG		; Lock the logging lock
	MOVE A,LOGBPT		; Get current byte ptr
	SETO B,			; Default time to now
	MOVSI C,(1B0)		; No date, just the time
	ODTIM
	MOVEI B," "		; A space
	IDPB B,A
	HRRE B,FX		; Copy fork #
	JUMPL B,[MOVEI B," "	; If top fork, print 2 spaces
		IDPB B,A
		IDPB B,A
		JRST BEGLO1]
	MOVE C,[1B2+2B17+10B35]	; 2 digits, octal radix
	NOUT			; Record fork #
	 PUSHJ P,SCREWUP
BEGLO1:	MOVEI B," "		; Another space
	IDPB B,A
	TRNE SV,400000		; Any particular service running?
	 POPJ P,		; No, stop here
	HLRO B,SRVDSP(SV)	; Yes, get name string
	SETZ C,
	SOUT			; Append it
	HRROI B,[ASCIZ /: /]
	SOUT
	POPJ P,

; Logging routines (cont'd)

; End a log entry
;	A/ Used string ptr (into logging buffer)
; Returns +1

ENDLOG:	MOVE B,FORKX		; Get our fork #
	SKIPL LOGLCK		; Locked?
	CAME B,LOGLKF		; By us?
	 PUSHJ P,SCREWUP	; No
	HRROI B,[ASCIZ /
/]
	SETZ C,			; Append crlf and null
	SOUT
	MOVE C,LOGBPT		; Get start of string
	MOVEM A,LOGBPT		; Update pointer to end
	TLNE F,(DEBUGF)		; Debugging?
	 JRST [	MOVEI A,101	; Yes, always print on TTY
		DOBE		; Avoid intermixed messages
		JRST ENDLO2]	; Go type
	TLNN F,(LGTTYF)		; No, serious error?
	 JRST ENDLO3		; No, print nothing
	TIME			; Yes, get now
	SUBM A,LTTTIM		; Compute time since last we did this
	EXCH A,LTTTIM		; Save now, get interval
	CAIGE A,^D30000		; Too soon?
	 JRST ENDLO3		; Yes, don't hog the logging TTY
	MOVEI A,101		; Wait for logging TTY to be free
	DOBE
	HRROI A,[ASCIZ /**PUPSRV /]  ; Identify source of message
	PSOUT
ENDLO2:	MOVE A,C		; Recover message pointer
	PSOUT			; Print message
ENDLO3:	HRRZ A,LOGBPT		; Get rh of current pointer
	CAIGE A,LOGBUF+LOGBFS/2	; More than half full?
	 JRST ULKLOG		; No, unlock buffer and return
	SKIPGE FORKX		; Yes, are we the top fork?
	 JRST DMPLO1		; Yes, go dump buffer on file
	PUSHJ P,ULKLOG		; No, unlock log
	MOVEI A,-1		; Request superior to dump log
	MOVSI B,(1B1)
	IIC
	POPJ P,

GS LTTTIM		; Time we last printed on logging TTY

; Logging routines (cont'd)

; Dump log buffer on file
; Returns +1
; Clobbers A-D

DMPLOG:	SKIPGE LOGBPT		; Any text buffered?
	 JRST DMPLO5		; No, just reset clock
	PUSHJ P,LCKLOG		; Lock the buffer
	SETO B,			; Convert current time to components
	SETZ D,
	ODCNV
	HRRZ D,C		; Save day of week
	HRROI A,LOGNAM		; Construct log file name
	TLNN F,(DEBUGF)		; Private log if debugging, system log otherwise
	 WRITE A,<<SYSTEM>>
	HRROI B,[ASCIZ /MON/
		 ASCIZ /TUE/
		 ASCIZ /WED/
		 ASCIZ /THU/
		 ASCIZ /FRI/
		 ASCIZ /SAT/
		 ASCIZ /SUN/](D)
	WRITE A,<PUPSRV.%2S>	; PUPSRV.day-of-week
DMPLO1:	MOVSI C,(1B17)
DMPLO2:	MOVE A,C		; Get bits
	HRROI B,LOGNAM
	GTJFN			; Look for an existing log file
	 JRST [	TLON C,(1B0)	; Failed, maybe make a new version
		 JRST DMPLO2	; Try again
		MOVE C,A	; Save reason for failure
		JRST DMPLO3]	; Already did, give up
	CAME D,LOGDAY		; Same day of week as last time?
	 JUMPGE C,[		; No, starting a new log file
		MOVE C,A
		DELF		; If have existing version then delete it
		 PUSHJ P,[MOVE A,C
			RLJFN
			 CAI
			POPJ P,]
		MOVSI C,(1B0+1B17) ; Make a new version
		JRST DMPLO2]
	MOVEM D,LOGDAY
	MOVE C,A		; Ok, save JFN
	MOVE B,[7B5+1B22]	; Open for append
	OPENF
	 JRST [	EXCH A,C	; Failed, recover JFN
		RLJFN		; Release it
		 CAI
		HRRZ A,LOGBPT	; Look at buffer pointer again
		CAIGE A,LOGBUF+LOGBFS-^D<200/5>  ; Desperately full?
		 JRST DMPLO4	; No, leave it and try again later
		JRST DMPLO3]	; Yes, flush buffer
	HRROI B,LOGBUF		; Ok, make string ptr to log buffer
	SETZ C,			; Until null
	SOUT			; Append bufferful to log file
	CLOSF			; Close it
	 CAI			; Huh?
	MOVE A,[POINT 7,LOGBUF]	; Reinitialize buffer pointer
	MOVEM A,LOGBPT
DMPLO4:	SETOM LOGLCK		; Unlock the lock
DMPLO5:	TIME			; Get now
	ADD A,[LOGLAT*^D1000]	; Compute time to force dump
	MOVEM A,LOGTIM
	POPJ P,			; Done

; Here if failed to open file. C has jsys error code
DMPLO3:	MOVE A,[POINT 7,LOGBUF]	; Reset buffer pointer
	MOVEM A,LOGBPT
	SETOM LOGLCK
	ELOG <** Log entries lost%/ - %3J>
	JRST DMPLO5


LS LOGNAM,5		; Temp for name of log file

; Logging routines (cont'd)

; Lock the logging lock
; Returns +1
; Clobbers A

LCKLOG:	AOSE LOGLCK		; Lock the lock
	 JRST [	MOVEI A,^D200	; Failed, wait a bit
		DISMS
		JRST LCKLOG]	; Try again
	MOVE A,FORKX		; Ok, save fork # of locker
	MOVEM A,LOGLKF
	POPJ P,


; Initialize logging package
; Returns +1
; Clobbers A-D

INILOG:	MOVE A,[POINT 7,LOGBUF]	; Initialize byte ptr into buffer
	MOVEM A,LOGBPT
	TIME			; Get now
	ADD A,[LOGLAT*^D1000]	; Compute time to force dump
	MOVEM A,LOGTIM		; Store it
	SETO B,			; Convert current time to components
	SETZ D,
	ODCNV
	HRRZM C,LOGDAY		; Save current day of week


; Unlock logging lock
; Returns +1

ULKLOG:	SETOM LOGLCK		; Unlock the lock
	POPJ P,

; -----------------------------------------------------------------
;	Miscellaneous subroutines
; -----------------------------------------------------------------

; Open a server port
;	SV/ Service table index
; Returns +1 always, A/ JFN (-1 if failed)

OPNSRV:	HRROI A,TEMP		; Build name string in temp region
	SKIPN B,SRVSKT(SV)	; Get server socket number
	 JRST [	SETO A,		; No server, return -1
		POPJ P,]
	WRITE <PUP:%2O!>
	MOVEI B,"A"		; Assume system socket
	TLNN F,(ENABLF)		; Are we enabled?
	 MOVEI B,"J"		; No, make job-relative
	BOUT
	MOVSI A,(1B2+1B17)	; Old file, name from string
	HRROI B,TEMP
	GTJFN			; Get a JFN for the port
	 JRST [	MOVE B,SRVSKT(SV)  ; Failed, get socket # for msg
		ELOG <Failed to GTJFN server port %2O%/ - %1J>
		SETO A,		; No JFN
		POPJ P,]	; Return
	HRLM A,0(P)		; Ok, save JFN
	MOVE B,[16B9+1B19+1B20]	; Open for i/o in raw packet mode
	OPENF
	 JRST [	MOVE B,SRVSKT(SV)  ; Failed, get socket # for msg
		ELOG <Failed to OPENF server port %2O%/ - %1J>
		HLRZ A,0(P)	; Recover JFN
		RLJFN		; Release it
		 CAI
		SETO A,		; No JFN
		POPJ P,]	; Return
	MOVEI B,24		; Ok, arm Received Pup interrupt
	HRROI C,777700+SRVPSI(SV)  ; Compute interrupt channel
	ROT C,-^D12		; Position in B6-11, ones in rest
	MTOPR
	POPJ P,			; Done



; Log statistics for all ports
; Returns +1
; Clobbers A-D, SV

LOGSTT:	SETOB SV,SERVX		; No specific server
	MOVEI A,400000		; Our fork
	RUNTM			; Get total runtime
	LOG <**Server statistics:  Total top fork runtime = %1R>
	MOVSI SV,-NSERVS	; Count servers
LOGST1:	HRRZM SV,SERVX		; Store service index
	MOVE A,SRVCNT(SV)	; Get count of Pups received
	MOVE B,SRVTIM(SV)	; Get time spent running service
	SKIPE SRVSKT(SV)	; Skip if no socket for this server
	 LOG <Count = %1D, Runtime = %2R>
	AOBJN SV,LOGST1		; Repeat for all services
	SETOB SV,SERVX		; No specific server

; Called here to init timer
SSTTIM:	TIME			; Get now
	ADD A,[STTINT*^D1000]	; Add interval
	MOVEM A,STTTIM		; Store next time to log statistics
	POPJ P,

LS STTTIM		; Time to log statistics next

; Compare two strings
;	A/ One string ptr
;	B/ Another string ptr
; Returns +1:  Not equal
;	+2:  Equal
; Clobbers A-D

STRCMP::TLC A,-1		; Convert -1 lh to string ptr
	TLCN A,-1
	 HRLI A,(POINT 7)
	TLC B,-1
	TLCN B,-1
	 HRLI B,(POINT 7)
STRCM1:	ILDB C,A		; Compare strings the slow and
	ILDB D,B		;  dumb way
	CAIE C,(D)
	 POPJ P,
	JUMPN C,STRCM1
	JRST SKPRET##		; Strings matched, return +2


; Set up inferior fork's map to have top fork's code and
; global storage
;	A/ fork handle
; Returns +1
; Clobbers A-D

SETMAP::HRLZ B,A		; Destination is inferior
	MOVSI A,400000		; Source is top fork
	MOVSI C,(1B2+1B4+1B9)	; R+X+CW access for page 0
	MOVEI D,EGSPVR##+777	; Compute # pages code and
	LSH D,-9		;  global storage
SETMA1:	PMAP			; Map a page
	ADDI A,1		; Advance page numbers
	ADDI B,1
	MOVSI C,(1B2+1B3+1B4)	; R+W+X access for remaining pages
	SOJG D,SETMA1		; Repeat for all pages
	MOVE D,B		; Save fork handle
	MOVE A,[400000,,770]	; See if DDT is present
	RPACS
	TLNN B,(1B5)
	 POPJ P,		; No, done
	MOVE B,D		; Yes, recover inferior fork handle
	HRRI B,770		; First page of DDT
SETMA2:	PMAP			; Map a page
	ADDI A,1		; Advance page numbers
	ADDI B,1
	TRNE A,777		; Done?
	 JRST SETMA2		; No
	POPJ P,

; Initialize GETAB table pointers and related data
; Returns +1
; Clobbers A-C

INIGTB:	MOVSI C,-NGTABS		; # of tables
INIGT1:	MOVE A,GTBNAM(C)	; Get a table name
	SYSGT			; Get the index
	SKIPN B			; Make sure got one
	 PUSHJ P,SCREWUP
	MOVEM B,GTBIDX(C)	; Ok, store length and index
	AOBJN C,INIGT1		; Repeat for all

; Now setup some useful constants
	HRRZ A,PUPPAR		; Pup parameter table number
	GETAB			; Get entry 0
	 PUSHJ P,SCREWUP
	HRRZM A,PUPLO		; Store first Pup TTY #
	HLRE A,A		; Get - # of Pup TTYs
	MOVN A,A		; Make positive
	ADD A,PUPLO		; Compute first non-Pup TTY
	SUBI A,1		; Last Pup TTY
	MOVEM A,PUPHI		; Store it
	HRRZ A,PUPPAR		; Pup parameter table
	HRLI A,1		; Entry 1
	GETAB
	 PUSHJ P,SCREWUP
	MOVEM A,PUPBFP		; Store monitor adr of Pup buffers
	MOVE A,PUPROU		; Read routing table
	MOVEI B,TEMP		; Where to put it
	PUSHJ P,REDGTB
	HLLZ A,PUPROU		; Search for local host addresses
	MOVSI B,-10
INIGT2:	HRRZ C,TEMP(A)		; Get an entry
	JUMPE C,INIGT3		; Jump if not local address
	HRLI C,1(A)		; Ok, set net #
	MOVEM C,LCLHAD(B)	; Put in table
	AOBJP B,.+2
INIGT3:	AOBJN A,INIGT2		; Not this one, look more
	MOVNI B,0(B)		; Done, generate AOBJN ptr
	HRLI B,LCLHAD
	MOVSM B,LCLHPT
	MOVE C,LCLHAD		; Convert first local address to string
	SETZ D,			; No socket
	HRROI A,LCLHNM		; Where to put local host name
	MOVE B,[1B1+1B2+C]	; Omit fields, octal constants ok
	PUPNM			; Convert local address to string
	 PUSHJ P,SCREWUP
	POPJ P,

GS PUPLO	; Lowest TTY that is a Pup NVT
GS PUPHI	; Highest TTY that is a Pup NVT
GS PUPBFP	; Monitor address of Pup buffer region
GS LCLHNM,10	; Local host name as a string
GS LCLHAD,10	; Local net,,host address(es)
GS LCLHPT	; AOBJN ptr to local net,,host address(es)

; Read an entire GETAB table
;	A/ Length,,table #
;	B/ Where to put it
; Returns +1 always
; Clobbers A-C

REDGTB::HRLM A,0(P)		; Save table #
	HLLZ C,A		; Init AOBJN pointer
	HRLI B,C		; Set for indexing by C
REDGT1:	HLRZ A,0(P)		; Recover table #
	HRLI A,0(C)		; Insert index
	GETAB			; Get the item
	 PUSHJ P,SCREWUP
	MOVEM A,@B		; Store in memory
	AOBJN C,REDGT1		; Repeat for whole table
	POPJ P,


; Declaration of the GETAB tables that are used

DEFINE GTABS(NAME) <IRP NAME <
	SIXBIT /NAME/
	GS NAME
>>

GTBNAM:		; Start of name table
GS GTBIDX,0	; Storage for -length,,index

	GTABS <PUPLSK,PUPLNH,PUPFPT,PUPSTS>
	GTABS <NVTPUP,PUPPAR,PUPBUF,PUPROU>
	GTABS <JOBDIR,JOBTTY,ENTFLG>

NGTABS==.-GTBNAM	; Number of GETAB tables

; Check for auto-restart
; Returns +1
; Clobbers A-C

RSTCHK:	MOVSI A,-NFORKS		; Any active forks?
	SKIPE FRKHND(A)
	 POPJ P,		; Yes, do nothing
	AOBJN A,.-2
	SKIPE DIRFRK##
	 POPJ P,
	TIME			; All idle.  Compute time for next check
	ADD A,[RSTINT*^D1000]
	MOVEM A,RSTTIM
	MOVSI A,(1B2+1B17)
	HRROI B,[ASCIZ /PUPSRV.SAV/]
	GTJFN
	 POPJ P,
	MOVE B,[1,,14]		; FDBWRT
	MOVEI C,C
	GTFDB
	EXCH C,SRVWRT		; PUPSRV write date
	CAME C,SRVWRT		; Changed?
	 JUMPN C,RSTSRV		; Yes, restart server if knew old date
	RLJFN			; No, do nothing
	 PUSHJ P,SCREWUP
	POPJ P,

; Start new version of server!
RSTSRV:	ELOG <***** %1F restarting *****>
	PUSH P,A
	PUSHJ P,DMPLOG
	MOVEI A,400000
	DIR			; No interrupts!
	MOVE A,[RSTCOD,,B]	; Put restart code in ACs
	BLT A,B+LRSTCD-1
	POP P,A
	HRLI A,400000		; Fork ,, JFN
	JRST B

; Code that runs in the ACs and actually loads and starts the new PUPSRV.
; Note that it does not bother to clean up JFNs, etc., because we know
; that PUPSRV executes a RESET as soon as it starts up.
RSTCOD:	GET
	MOVEI A,400000
	GEVEC
	TLNE B,777000		; 10/50 style entry vector?
	 HRR B,120		; Yes
	JRST 0(B)

LRSTCD==.-RSTCOD

LS RSTTIM		; Time for next check
LS SRVWRT		; Write date of current version of PUPSRV

; Generate random number
; Returns +1
;	B/ 36-bit random #
; Clobbers A, B

RANDOM::SKIPN A,RANNUM		; Get current random #
	 GTAD			; None, use date and time for first
	MUL A,[156547327435]	; Randomize by linear congruent method
	ADD B,[154145417165]
	MOVEM B,RANNUM		; Store new random #
	POPJ P,			; Return it

GS RANNUM		; Current random #


; Initialize PSI system
; Returns +1
; Clobbers A, B

INIPSI:	MOVEI A,400000		; Initialize psi system
	MOVE B,[LEVTAB,,CHNTAB]
	SIR
	EIR
	MOVE B,[ACTCHN]		; Activate channels
	AIC
	MOVSI A,^D19		; Assign ^S interrupt to channel 0
	ATI			; (force out statistics and log)
	POPJ P,


; PSI channel definitions

DEFINE PSI(CH,LEV,DISP) <
	ACTCHN==ACTCHN!1B<CH>
RELOC CHNTAB+^D<CH>
	LEV ,, DISP
>

	ACTCHN==0

CHNTAB:	PSI(0,3,CNTRLS)		; Control-S -- force out statistics
	PSI(1,3,LOGINT)		; Force log buffer to file
	PSI(9,1,PDLOVF)		; Pushdown overflow
	PSI(11,1,DATERR)	; Data error
	PSI(15,1,ILLINS)	; Illegal instruction
	PSI(16,1,ILLRED)	; Illegal read
	PSI(17,1,ILLWRT)	; Illegal write
	PSI(18,1,ILLXCT)	; Illegal execute
	PSI(19,3,FRKTRM)	; Inferior fork termination
	PSI(20,1,ILLSIZ)	; Machine size exceeded


; Assignments for Pup Received interrupts on each socket

CH==<SRVPSI==^D24>	; PSI channel for first server

REPEAT NSERVS,<
	PSI(CH,3,RCVPUP+2*<CH-SRVPSI>)
	CH==CH+1
>


RELOC CHNTAB+^D36

LEVTAB::CH1PC		; Level 1 - fatal errors
	CH2PC		; Level 2 - not used
	CH3PC		; Level 3 - normal wakeups, eof, etc.

; Interrupt routines

; Received Pup on one of the server ports

RCVPUP:				; Assemble all the initial code
REPEAT NSERVS,<
	AOS NEWPKT+<.-RCVPUP>/2	; Increment counter for port
	JRST AWAKEN		; Join common code
>


; Control-S -- generate statistics, force out log file

CNTRLS:	SETZM STTTIM		; Force statistics now
	SETZM ERPTIM##		; Force dump of event buffers

; Interrupt from inferior fork requesting log buffer to be forced out

LOGINT:	SETZM LOGTIM		; Force log now
	TLO F,(CHKTMF)		; Force timers to be checked
	JRST AWAKEN		; Awaken top fork and dismiss


; Inferior fork termination

FRKTRM:	PUSH P,A
	PUSH P,B
	PUSH P,FX
	MOVSI FX,-NFORKS	; Loop thru all forks
FRKTR1:	SKIPE A,FRKHND(FX)	; Is there a fork in this slot?
	 RFSTS			; Yes, read its status
	TLNE A,2		; Voluntary or forced termination?
	 SETZM FRKTIM(FX)	; Yes (code 2 or 3), force timeout
	AOBJN FX,FRKTR1		; Repeat for all forks
	SKIPE A,DIRFRK##	; Is there a net dir fork?
	 RFSTS			; Yes, read its status
	TLNE A,2		; Voluntary or forced termination?
	 SETZM DIRTIM##		; Yes, force call of check routine
	POP P,FX
	POP P,B
	TLOA F,(CHKTMF)		; Force timers to be checked

; Common code to awaken the top fork if it is idle
AWAKEN:	PUSH P,A
	HRRZ A,CH3PC		; Get interrupt pc
	CAIL A,BSLEEP		; Is top fork idle?
	CAILE A,ESLEEP
	 JRST .+3		; No, don't touch it
	MOVE A,[1B5+BSLEEP]	; Yes, activate by restarting it
	MOVEM A,CH3PC
	POP P,A
	DEBRK			; Dismiss interrupt

; Fatal errors

PDLOVF::JSP B,CRASHX
	ASCIZ /Pushdown overflow/

DATERR::JSP B,CRASHX
	ASCIZ /IO data error/

ILLINS::JSP B,CRASHX
	ASCIZ /Illegal instruction/

ILLRED::JSP B,CRASHX
	ASCIZ /Illegal read/

ILLWRT::JSP B,CRASHX
	ASCIZ /Illegal write/

ILLXCT::JSP B,CRASHX
	ASCIZ /Illegal execute/

ILLSIZ::JSP B,CRASHX
	ASCIZ /Machine size exceeded/

; Common code for fatal error interrupts
CRASHX:	PUSH P,CH1PC		; Put trap pc on stack
	TLOA B,-1		; Make call pc into string ptr


; Routine to call if an impossible error occurs
; Does not return

SCREWUP::HRROI B,[ASCIZ /An impossible error has occurred/]
	SKIPGE LOGLCK		; Is the log locked?
	 JRST .+4		; No
	MOVE A,LOGLKF		; Yes, get last locker
	CAMN A,FORKX		; Is it me?
	 SETOM LOGLCK		; Yes, unlock it
	HRRZ A,0(P)		; Get return pc
	SUBI A,1		; Backup to call
	ELOG <%2S at %1O>
	SKIPL FORKX		; Are we the top fork?
	 HALTF			; No, just die
	TIME			; Yes, get now
	SUBM A,CRSTIM		; Check time of last crash
	EXCH A,CRSTIM		; Save this time
	CAIGE A,^D<60*1000>	; Last crash less than a minute ago?
	 JRST [	ELOG <Too-frequent top fork crashes, aborting>
		PUSHJ P,DMPLOG
		HALTF
		JRST PUPSRV]	; In case continued
	ELOG <Top fork crashed, restarting>
	PUSHJ P,DMPLOG		; Make sure entry reaches log file
	JRST PUPSRV		; Start over....

LS CRSTIM		; Time of last top fork crash



	END PUPSRV