perm filename PUPSRV.MAC[S,NET] blob
sn#642401 filedate 1982-02-07 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00035 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TENEX WAITS TENEX WAITS PUPSRV INIT1
C00014 00003 BSLEEP ESLEEP LOOP2 LOOP3 LOOP4
C00019 00004 LOOP5
C00021 00005 SRVSKT SRVDSP
C00023 00006 TELSRV TELSRF TELSR7 FTPSRV MAISRV
C00027 00007 MSCSRV MSCSR1 MSCTYP NMISCT WHRUSR WHRUS1 WHRUS5
C00031 00008 DATSTR DATTNX DATNEW DATSND LTPARS
C00034 00009 MAICHK OKMAIL NOMAIL MAICH2
C00038 00010 AUTHUS ILLSTR AUFAIL AUFAI1
C00041 00011 GMESTR GMEST1 GMEST2
C00044 00012 ECHSRV GPTCKS GPTWRD NOSRVR
C00047 00013 GTDPRT STDPRT GTSPRT STSPRT
C00049 00014 GTCPRT STCPRT SWPPRT GETUSR
C00053 00015 REPNUL REPSTR ENDPUP SNDPUP SNDPU1 ROUSET
C00057 00016 MAKFRK
C00061 00017 DELFRK DELFR1 DELFR2
C00065 00018 SETWDT FRKINI
C00067 00019 OPNCON SNDRFC
C00070 00020 SNDABJ SNDABT SNDAB1 CHKENT CKCPRT BADPRT
C00074 00021 MAKPRT MAKPR1 MAKPR2 MAKPR7 MAKPR8
C00078 00022 FNDCON FNDCO1 FNDCO2 FNDCO3 FNDCO5 FNDCO6 GETLCL GETLC1 GETLC2 GETLC3
C00083 00023 GCCON GCCON1 GCCON5 SGCTIM CHKCON
C00087 00024 ABTCO2 ABTCON DELCON
C00089 00025 %ULOG %UELOG %UNOIS %LETC %LETP
C00092 00026 BEGLOG BEGLO1
C00094 00027 ENDLOG ENDLO2 ENDLO3
C00097 00028 INILOG ULKLOG DMPLOG DMPLO1 DMPLO2 DMPLO4 DMPLO5 DMPLO3 LCKLOG
C00101 00029 OPNSRV LOGSTT LOGST1 SSTTIM
C00106 00030 STRCMP STRCM1 SETMAP SETMA1 SETMA2
C00109 00031 INIGTB INIGT1 INIGT2
C00112 00032 REDGTB REDGT1 GTBNAM NGTABS
C00114 00033 RANDOM INIPSI ACTCHN ACTCHN CHNTAB CH CH LEVTAB IMASK
C00118 00034 RCVPUP CNTRLS LOGINT FRKTRM FRKTR1 AWAKEN INTSER
C00122 00035 PDLOVF DATERR ILLINS ILLRED ILLWRT ILLXCT ILLSIZ CRASHX SCREWUP
C00126 ENDMK
C⊗;
;TENEX WAITS TENEX WAITS PUPSRV INIT1
; Copyright 1979 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
IFN TENEX,<
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
>;IFN TENEX
IFN WAITS,<
MOVSI A,40 ; Set privledge for loading routing table
CALLI A,400066 ; SETPRV
>;IFN WAITS
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
IFN TENEX,<
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
>;IFN TENEX
LOG <***** PUPSRV restarted *****>
IFN TENEX,<
PUSHJ P,ERPINI## ; Init event report server
>;IFN TENEX
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
IFN TENEX,<
GJINF ; Get job info
ADDI C,↑D100000 ; Make job # + 100000
TLNN F,(ENABLF)
DTYPE <Server sockets are %3O00000+n%/>
>;IFN TENEX
PUSHJ P,SSTTIM ; Init time for logging statistics
PUSHJ P,SGCTIM ; Init time for GC of connections
PUSHJ P,GATINI## ; Init gateway info server
IFN TENEX,<
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
>;IFN TENEX
;BSLEEP ESLEEP LOOP2 LOOP3 LOOP4
; -----------------------------------------------------------------
; Main loop of top fork
; -----------------------------------------------------------------
BSLEEP: ; New packet arrival interrupts out of this range
MOVSI SV,-NSERVS ; Init count of services
BSLP1:
IFN TENEX,<
SKIPE NEWPKT(SV) ; New packet for port?
>;IFN TENEX
IFN WAITS,<
SKIPGE C,SRVJFN(SV)
JRST BSLP2
PUSHJ P,ARBCHN ; Input pending?
MTAPE 0,[10]
JRST BSLP2
>;IFN WAITS
JRST LOOP2 ; Yes, process it
BSLP2: AOBJN SV,BSLP1 ; 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
;LOOP5
; 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
IFN TENEX,<
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
>;IFN TENEX
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
IFN TENEX,<
CAML P1,ERPTIM## ; Time to dump event logs?
PUSHJ P,DMPAEB## ; Yes, do so
>;IFN TENEX
CAML P1,GATTIM## ; Time to do gateway info stuff?
PUSHJ P,GATCHK## ; Yes, do so
IFN TENEX,<
CAML P1,DIRTIM## ; Time to do net directory check?
PUSHJ P,DIRCHK## ; Yes, do so
>;IFN TENEX
JRST BSLEEP ; Back to top
;SRVSKT SRVDSP
; -----------------------------------------------------------------
; 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
;TELSRV TELSRF TELSR7 FTPSRV MAISRV
; 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
IFN TENEX,<
; 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
ATPTY ; 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 ATPTY failed
TELSRF: ELOG <Failed to attach NVT to %3P%/ - %1J>
CAIE A,ATPX13 ; 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,
>;IFN TENEX
;MSCSRV MSCSR1 MSCTYP NMISCT WHRUSR WHRUS1 WHRUS5
; Miscellaneous server (socket 4)
IFN TENEX,<
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
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 [< for next comment]
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,
>;IFN TENEX
;DATSTR DATTNX DATNEW DATSND LTPARS
IFN TENEX,<
; 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
MOVSI A,LTPARS ; Copy local time parameters
HRRI A,PBCONT+1(PB)
BLT A,PBCONT+2(PB)
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,
; Local time parameters -- compiled in since Maxc never moves
LTPARS: BYTE(8) 8, 0 (16) ↑D121, ↑D305 ; Zone, DST start day, DST end day
>;IFN TENEX
;MAICHK OKMAIL NOMAIL MAICH2
; Miscellaneous server (cont'd)
IFN TENEX,<
; Mail check
MAICHK: HRLM A,0(P) ; Save request type
HRROI A,TEMP+100 ; Where to put name string
PUSHJ P,GETUSR ; Get user name from request Pup
JRST [ LOG <Mail Check "%C" failed for %2P>
MOVEI A,213 ; Pup Type for Mail Check error
HRROI B,[ASCIZ /No such Maxc user/]
JRST REPSTR] ; Send the error Pup and return
MOVE B,A ; Ok, copy dir #
HRROI A,TEMP ; Put string in temp region
DIRST
PUSHJ P,SCREWUP
MOVEI A,[1B2+1 ; Old file only, version 1
377777,,377777 ; No i/o
0 ; Device disk
POINT 7,TEMP ; Directory as given
POINT 7,[ASCIZ /MESSAGE/]
POINT 7,[ASCIZ /TXT/]
0
0]
SETZ B, ; No main string
GTJFN ; Get JFN for mail file
JRST NOMAIL ; Not there
MOVE B,[25,,0] ; Ok, read the FDB
MOVEI C,TEMP
GTFDB
RLJFN ; Get rid of the JFN
PUSHJ P,SCREWUP
HLRZ A,0(P) ; Get request type
CAIN A,214 ; Laurel variant?
JRST [ SKIPN TEMP+12 ; Yes, just check for non-emptiness
JRST NOMAIL
JRST OKMAIL]
MOVE B,TEMP+14 ; Get write date/time
CAMG B,TEMP+15 ; Written later than read?
JRST NOMAIL ; No
; New mail exists
OKMAIL: MOVEI A,PBCONT(PB) ; Init byte ptr into packet
HRLI A,(POINT 8)
HLRZ C,TEMP+6 ; Get last writer dir #
WRITE <%2T %3U> ; Write date/time and user into Pup
PUSHJ P,ENDPUP ; Compute and store length
PUSHJ P,SWPPRT ; Swap source and destination
MOVEI A,211 ; Reply Pup Type
JRST MAICH2 ; Join common code
; Here if no mail
NOMAIL: MOVEI A,MNPLEN ; Minimum length
DPB A,PUPLEN
PUSHJ P,SWPPRT ; Swap source and destination
MOVEI A,212 ; Pup Type for reply
MAICH2: PUSHJ P,SNDPUP ; Send it out
POPJ P, ; Failed
HRROI B,TEMP+100 ; Ok, recover user name string
TLNE F,(DEBUGF) ; Log only if debugging
LOG <Mail Check "%2S" for %1P>
POPJ P,
>;IFN TENEX
; Network Directory Lookup code is in PUPDIR.MAC
;AUTHUS ILLSTR AUFAIL AUFAI1
IFN TENEX,<
; User authentication request
; Pup contains user name and password as two Mesa strings (!!)
AUTHUS: HRROI A,TEMP ; Transfer user name to temp buffer
MOVEI B,PBCONT(PB)
HRLI B,(POINT 16)
TRZ F,RAISEF
PUSHJ P,GMESTR
JRST ILLSTR
MOVE D,B ; Save source pointer
SETZ A, ; Convert string to dir number
HRROI B,TEMP
STDIR
CAI ; No such user name
JRST [ HRROI B,[ASCIZ /Illegal user name/]
JRST AUFAIL]
JUMPL A,[HRROI B,[ASCIZ /Files-only directory name not permitted/]
JRST AUFAIL]
HRLM A,0(P) ; Save dir number
HRROI A,TEMP+100 ; Transfer password
MOVE B,D
TRO F,RAISEF ; Raise lower-case letters
PUSHJ P,GMESTR
JRST ILLSTR
HLRZ A,0(P) ; Recover dir number
HRLI A,(1B0) ; Just check password
HRROI B,TEMP+100 ; Where the password is
CNDIR
JRST [ HRROI B,[ASCIZ /Incorrect password/]
JRST AUFAIL]
MOVEI A,MNPLEN ; Ok, set up reply
DPB A,PUPLEN
PUSHJ P,SWPPRT
MOVEI A,251 ; Positive response type
PUSHJ P,SNDPUP
POPJ P,
HRROI A,TEMP
TLNE F,(DEBUGF) ; Log only if debugging
LOG <Authenticate user "%1S">
POPJ P,
ILLSTR: ELOG <Malformed string in Authenticate request for %2P>
HRROI B,[ASCIZ /Malformed string in request Pup/]
JRST AUFAI1
; Here on failure, B/ string ptr to error message
AUFAIL: HRROI A,TEMP
LOG <Authenticate "%1S" failed for %2P>
AUFAI1: MOVEI A,252 ; Negative response type
JRST REPSTR ; Append string and send Pup
>;IFN TENEX
;GMESTR GMEST1 GMEST2
; Get Mesa string
; A/ Destination string pointer
; B/ 16-bit byte pointer to Mesa string structure
; RAISEF set in F iff lower-case letters are to be raised
; Returns +1: Error, string malformed
; +2: Successful:
; A/ Updated string pointer
; B/ Updated 16-bit byte pointer (advanced past end of Mesa string)
; Clobbers C, D
GMESTR: TLC A,-1 ; Convert destination pointer if necessary
TLCN A,-1
HRLI A,(POINT 7)
ILDB C,B ; Get length
CAIL C,0 ; Ensure in range
CAILE C,↑D39
POPJ P,
ILDB D,B ; Get maxLength
TRNE D,1 ; Force it to be even
ADDI D,1
CAIL D,0 ; Ensure in range
CAILE D,↑D40
POPJ P,
SUB D,C ; Compute maxLength-length
JUMPL D,CPOPJ## ; Ensure length <= maxLength
HRLM D,0(P) ; Save maxLength-length
TLC B,(30B11) ; Convert source pointer to 8-bit bytes
JUMPE C,GMEST2 ; In case empty string
GMEST1: ILDB D,B ; Get a byte
CAIL D,"a" ; Lower-case?
CAILE D,"z"
JRST .+3 ; No
TRNE F,RAISEF ; Yes, want to raise it?
SUBI D,40 ; Yes, do so
IDPB D,A ; Store in destination string
SOJG C,GMEST1 ; Repeat for all
GMEST2: MOVE D,A ; Store null at end
IDPB C,D
HLRZ D,0(P) ; Recover maxLength-length
JUMPE D,.+3
IBP B ; Advance source pointer to maxLength
SOJG D,.-1
TLC B,(30B11) ; Convert back to 16-bit bytes
JRST SKPRET## ; Return +2
;ECHSRV GPTCKS GPTWRD NOSRVR
; Echo server (socket 5)
IFE WAITS,< ;WAITS does this at interrupt level.
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
>;IFE WAITS
IFN WAITS,<
echsrv==.
TELSRV==.
FTPSRV==.
MAISRV==.
MSCSRV==.
NOSRVR: POPJ P,
>;IFN WAITS
; 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,
;GTDPRT STDPRT GTSPRT STSPRT
; 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,
;GTCPRT STCPRT SWPPRT GETUSR
; 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,
IFN TENEX,<
; 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::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
MOVEI A,1 ; Exact match
POP P,B ; Recover start of buffer
STDIR ; Look up name
POPJ P, ; No match, fail
POPJ P, ; Ambiguous, fail
HRRZS A ; Ok, clear lh bits
JRST SKPRET## ; Success
>;IFN TENEX
;REPNUL REPSTR ENDPUP SNDPUP SNDPU1 ROUSET
; 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
IFN WAITS,<
; Give new routing table to WAITS
; Clobbers A,B,C
ROUSET::HRRZ C,SRVJFN(SV) ; Get a PUP JFN, any PUP JFN
MOVEI A,30 ; Opcode for set routing table
MOVE B,PUPROU## ; Get at IOWD for WAITS style routing table
MOVE B,-1(B)
PUSHJ P,ARBCHN
MTAPE A ; MTAPE [30
POPJ P, ; IOWD table←size,routing←table]
JRST SKPRET
>;IFN WAITS
;MAKFRK
IFN TENEX,<
; -----------------------------------------------------------------
; 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
>;IFN TENEX
;DELFRK DELFR1 DELFR2
IFN TENEX,<
; 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,
>;IFN TENEX
;SETWDT FRKINI
; 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,
IFN TENEX,<
; 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
>;IFN TENEX
;OPNCON SNDRFC
; -----------------------------------------------------------------
; Network I/O and connection management
; -----------------------------------------------------------------
IFN TENEX,<
; 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
>;IFN TENEX
;SNDABJ SNDABT SNDAB1 CHKENT CKCPRT BADPRT
; 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
IFN TENEX,<
; 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
>;IFN TENEX
BADPRT: ELOG <Bad connection port %3P for %2P>
HRROI B,[ASCIZ /Bad connection port/]
JRST SNDABT ; Abort the connection attempt
;MAKPRT MAKPR1 MAKPR2 MAKPR7 MAKPR8
IFN TENEX,<
; 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
JUMPE B,MAKPR2 ; Don't use zero
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
>;IFN TENEX
;FNDCON FNDCO1 FNDCO2 FNDCO3 FNDCO5 FNDCO6 GETLCL GETLC1 GETLC2 GETLC3
IFN TENEX,<
; 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,
>;IFN TENEX
;GCCON GCCON1 GCCON5 SGCTIM CHKCON
; Garbage-collect the connection table
; Returns +1
; Clobbers A, B
GCCON:
IFN TENEX,<
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
>;IFN TENEX
; 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
IFN TENEX,<
; 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,
>;IFN TENEX
;ABTCO2 ABTCON DELCON
IFN TENEX,<
; 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,
>;IFN TENEX
;%ULOG %UELOG %UNOIS %LETC %LETP
; -----------------------------------------------------------------
; 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,
;BEGLOG BEGLO1
; -----------------------------------------------------------------
; 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,(1B10+1B12) ; Suppress seconds and colon
ODTIM ; Log the date and time
MOVEI B," " ; A space
IDPB B,A
IFN TENEX,<
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
>;IFN TENEX
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,
;ENDLOG ENDLO2 ENDLO3
; 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
IFN TENEX,<
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?
>;IFN TENEX
JRST DMPLO1 ; Yes, go dump buffer on file
IFN TENEX,<
PUSHJ P,ULKLOG ; No, unlock log
MOVEI A,-1 ; Request superior to dump log
MOVSI B,(1B1)
IIC
POPJ P,
>;IFN TENEX
GS LTTTIM ; Time we last printed on logging TTY
;INILOG ULKLOG DMPLOG DMPLO1 DMPLO2 DMPLO4 DMPLO5 DMPLO3 LCKLOG
; Logging routines (cont'd)
; Initialize logging package
; Returns +1
; Clobbers A
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
ULKLOG: SETOM LOGLCK ; Unlock the lock
POPJ P,
; Dump log buffer on file
; Returns +1
; Clobbers A-C
DMPLOG: SKIPGE LOGBPT ; Any text buffered?
JRST DMPLO5 ; No, just reset clock
PUSHJ P,LCKLOG ; Lock the buffer
DMPLO1: MOVSI C,(1B8+1B17) ; Ignore deleted, short form
DMPLO2: MOVE A,C ; Get bits
IFN TENEX,<
HRROI B,[ASCIZ /<SYSTEM>PUPSRV.LOG/]
TLNE F,(DEBUGF) ; Debugging?
HRROI B,[ASCIZ /PUPSRV.LOG/] ; Yes, make private log
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
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
SETO A, ; Fake JFN
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?
>;IFN TENEX
IFN WAITS,<
OUTSTR LOGBUF
printx "Currently just typing on TTY for DMPLOG"
>;IFN TENEX
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
; 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,
;OPNSRV LOGSTT LOGST1 SSTTIM
; -----------------------------------------------------------------
; Miscellaneous subroutines
; -----------------------------------------------------------------
; Open a server port
; SV/ Service table index
; Returns +1 always, A/ JFN (-1 if failed)
OPNSRV:
IFN TENEX,<
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
>;IFN TENEX
IFN WAITS,<
HRRZ A,SRVDSP(SV) ;Does this server really exist?
CAIE A,NOSRVR
SKIPN B,SRVSKT(SV) ; Get server socket number
JRST [ SETO A, ; No server, return -1
POPJ P,]
PUSHJ P,GETCHN## ;Get a channel to use
JRST[ SETO A, ; No server or no channel
POPJ P, ]
PUSHJ P,ARBCHN##
OPEN[ 15
SIXBIT/PUP/
0 ]
PUSHJ P,SCREWUP
SETZM TEMP ;Setup connection block
MOVE A,[XWD TEMP,TEMP+1]
BLT A,TEMP+4
SETOM TEMP+5 ;Wild foreign socket
SETOM TEMP+6 ;Wild foreign host
MOVE A,SRVSKT(SV)
MOVEM A,TEMP+2
AOS TEMP ;Opcode 1 = Listen
PUSHJ P,ARBCHN
MTAPE TEMP
SKIPE TEMP+1 ;Any errors?
JRST[ MOVE B,SRVSKT(SV) ; Failed, get socket # for msg
ELOG <Failed to OPENF server port %2O%/ - %1J>
PUSHJ P,ARBCHN ; Recover JFN
RELEAS 3 ; Release it
SETO A, ; No JFN
POPJ P,] ; Return
MOVE A,C
POPJ P,
>;IFN WAITS
; 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
;STRCMP STRCM1 SETMAP SETMA1 SETMA2
; 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
IFN TENEX,<
; 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,
>;IFN TENEX
;INIGTB INIGT1 INIGT2
IFN TENEX,<
; 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 address
INIGT2: HRRZ C,TEMP(A) ; Get an entry
JUMPN C,.+3 ; Jump if local address
AOBJN A,INIGT2 ; Not this one, look more
PUSHJ P,SCREWUP
HRLI C,1(A) ; Ok, set net #
SETZ D, ; No socket
HRROI A,LCLHST ; 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 LCLHST,10 ; Local host name as a string
>;IFN TENEX
;REDGTB REDGT1 GTBNAM NGTABS
; 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,
IFN TENEX,<
; 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
>;IFN TENEX
IFN WAITS,<
;More of the TENEX placebo
EXTERNAL ENTFLG,PUPX3
>;IFN WAITS
;RANDOM INIPSI ACTCHN ACTCHN CHNTAB CH CH LEVTAB IMASK
; Generate random number
; Returns +1
; B/ 36-bit random #
; Clobbers A, B
RANDOM::SKIPN A,RANNUM ; Get current random #
IFN TENEX,< GTAD > ; None, use date and time for first
IFN WAITS,< TIMER A, > ; 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:
IFN TENEX,<
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)
>;IFN TENEX
IFN WAITS,<
MOVEI A,INTSER ; Set interrupt vector
MOVEM A,JOBAPR##
MOVE A,IMASK ; Set interrupt enablings
INTENB A,
>;IFN WAITS
POPJ P,
IFN TENEX,<
; 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
>;REPEAT
RELOC CHNTAB+↑D36
LEVTAB::CH1PC ; Level 1 - fatal errors
CH2PC ; Level 2 - not used
CH3PC ; Level 3 - normal wakeups, eof, etc.
>;IFN TENEX
IFN WAITS,<
IMASK: XWD 14,230000 ; INTINP,INTTTI,POV,ILM,NXM
>;IFN WAITS
;RCVPUP CNTRLS LOGINT FRKTRM FRKTR1 AWAKEN INTSER
; Interrupt routines
; Received Pup on one of the server ports
RCVPUP: ; Assemble all the initial code
IFN TENEX,<
REPEAT NSERVS,<
AOS NEWPKT+<.-RCVPUP>/2 ; Increment counter for port
JRST AWAKEN ; Join common code
>;REPEAT
>;IFN TENEX
IFN WAITS,<
AOS NEWPKT ; We can't distinguish at this time.
JRST AWAKEN ; Join common code
>;IFN WAITS
; Control-S -- generate statistics, force out log file
CNTRLS: SETZM STTTIM ; Force statistics now
IFN TENEX,<
SETZM ERPTIM## ; Force dump of event buffers
>;IFN TENEX
; Interrupt from inferior fork requesting log buffer to be forced out
LOGINT: SETZM LOGTIM ; Force log now
IFE WAITS,< ;We can't be sure what ACs we have.
TLO F,(CHKTMF) ; Force timers to be checked
>;IFE WAITS
JRST AWAKEN ; Awaken top fork and dismiss
IFN TENEX,<
; 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
>;IFN TENEX
; Common code to awaken the top fork if it is idle
AWAKEN:
IFN TENEX,<
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
>;IFN TENEX
IFN WAITS,<
SETOM WAKFLG## ; Remember an interrupt
DISMIS ; We've been woken already if sleeping.
>;IFN WAITS
IFN WAITS,<
; All user interrupts go here. Beware, these are not the usual ACs.
; You must do a UWAIT to get proper ACs.
INTSER: MOVE A,JOBCNI## ; Get reason for interrupt
TLNE A,200 ; INTCLK?
JRST AWAKEN
TLNE A,10 ; INTINP (PUP input)
JRST RCVPUP
TLNE A,4 ; INTTTI (ESC I)
JRST CNTRLS
TRNE A,200000 ; POV?
JRST PDLOVF
TRNE A,20000 ; ILL MEM REF?
JRST ILMERR
TRNE A,10000 ; NON EX MEM?
JRST NXMERR
JRST UNKERR ; Who knows!
>;IFN WAITS
;PDLOVF DATERR ILLINS ILLRED ILLWRT ILLXCT ILLSIZ CRASHX SCREWUP
; Fatal errors
PDLOVF::JSP B,CRASHX
ASCIZ /Pushdown overflow/
IFN TENEX,<
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/
>;IFN TENEX
IFN WAITS,<
NXMERR: JSP B,CRASHX
ASCIZ /Non-existent memory/
ILMERR: JSP B,CRASHX
ASCIZ /Illegal memory reference/
UNKERR: JSP B,CRASHX
ASCIZ /Unexpected interrupt/
>;IFN WAITS
; Common code for fatal error interrupts
CRASHX:
IFN WAITS,<
MOVEM B,SAVERR ; Save error away somewhere safe
UWAIT ; Get back normal AC's
HRRZ B,P ; Check our stack
CAIL B,STACK
CAILE B,STACK+STKLEN-2
MOVE P,[IOWD STKLEN,STACK] ; No good, reset it.
PUSH P,JOBTPC##
MOVE B,SAVERR ; Restore error
>;IFN WAITS
IFN TENEX,<
PUSH P,CH1PC ; Put trap pc on stack
>;IFN TENEX
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
IFN WAITS,<
LS SAVERR ; Message for last error
>;IFN WAITS
END PUPSRV