;<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