;ULF:MNETDV.MAC.2, 19-Dec-85 18:10:20, Edit by CHASE ;[dmc] get dbg version of site-address file if dbugsw > 1 ;ISIMON:MNETDV.MAC.180, 16-Aug-85 11:48:20, Edit by CHASE ;[rut] In LCLHST, logical host checking assumed 0 in logical field ;Merge in domain code from Mockapetris@ISIF ;Merge with DEC 5.4 ; UPD ID= 163, SNARK:MNETDV.MAC.8, 3-Jun-84 17:26:35 by PAETZOLD ;Make MNTHLT reset NETON for each interface so that it stays down. ;Clean up MNTHLT in general. Remove MNTKIL since no one uses it. ;Add VMS, TACs, and MSDOS to OPSTAB. ; UPD ID= 159, SNARK:MNETDV.MAC.7, 1-Jun-84 11:35:17 by PAETZOLD ;AOS INTFLG in MNTSET. ; UPD ID= 156, SNARK:MNETDV.MAC.6, 31-May-84 11:25:18 by PAETZOLD ;Use indirects in MNTRSV ; UPD ID= 155, SNARK:MNETDV.MAC.5, 31-May-84 10:58:54 by PAETZOLD ;Add MNTRSV. Add some ENDSV.'s. ; UPD ID= 129, SNARK:MNETDV.MAC.4, 14-May-84 16:13:25 by PAETZOLD ;MNTHLT needs an EA.ENT. ; UPD ID= 33, SNARK:MNETDV.MAC.3, 7-Apr-84 13:15:19 by PAETZOLD ;Remove some spaces in initial HSTINI message. ; UPD ID= 31, SNARK:MNETDV.MAC.2, 5-Apr-84 22:46:02 by PAETZOLD ;Add IPNI to INTNAM. Change SITE-ADDRESS.TXT to INTERNET.ADDRESS. Clean ;up MNTSTS output. Use NETPRT to print out network numbers. Add ;informational message during startup when calling HSTINI. ; UPD ID= 4022, SNARK:<6.MONITOR>MNETDV.MAC.13, 31-Mar-84 16:20:59 by PAETZOLD ;TCO 6.2019 - Use ADJSPs ; UPD ID= 3941, SNARK:<6.MONITOR>MNETDV.MAC.12, 18-Mar-84 13:15:57 by PAETZOLD ;More TCO 6.1733 - Do not check for dots in GTHSIL. ; UPD ID= 3935, SNARK:<6.MONITOR>MNETDV.MAC.11, 17-Mar-84 13:01:33 by PAETZOLD ;GIDNEY::MNETDV.MAC.3, 16-Mar-84 18:03:06, Edit by PAETZOLD ;More TCO 6.1733 - Add Fuzzballs to OPSTAB ; UPD ID= 3921, SNARK:<6.MONITOR>MNETDV.MAC.10, 14-Mar-84 10:17:06 by PAETZOLD ;More TCO 6.1733 - Add Foonex to OPSTAB as Tenex ; UPD ID= 3901, SNARK:<6.MONITOR>MNETDV.MAC.9, 11-Mar-84 14:28:21 by PAETZOLD ;More TCO 6.1733 - 5.3 needs a EA.ENT in MNTINI ; UPD ID= 3894, SNARK:<6.MONITOR>MNETDV.MAC.8, 11-Mar-84 10:36:16 by PAETZOLD ;More TCO 6.1733 - Allow JFNs in ATNVT%. New HSTINI preference scheme. ;Make HSTINI set up gateway (HS%GAT) and network (HS%NET) entries. ;Make RDFLD fold case to upper. Add TAC and WAITS to OPSTAB. Check and ;dispatch for Pup JFN in .ATNVT. ; UPD ID= 3826, SNARK:<6.MONITOR>MNETDV.MAC.7, 29-Feb-84 18:15:40 by PAETZOLD ;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug fixes. Cleanup. ;MNETDV.MAC.4, 6-Dec-83 23:53:55, Edit by PAETZOLD ;Call CHKI7 from MNTCHK ;TCO 6.1867 - Use SAVEAC and not SAVP1 ;Add subtitles. Make code that was RSCOD SWAPCD. ;More TCO 6.1733 - Fix day one off by one bug with NUMOPS ;More TCO 6.1733 - NCPFRK has gone away. HSTLUK Changes. HSTINI changes. ;MNETDV.MAC.42, 5-Jul-83 08:28:09, Edit by PAETZOLD ;New host table support ;IP debuging switch support ;Use ANAUNV as the universal SEARCH DOMSYM,ANAUNV,PROLOG TTITLE MNETDV IFNDEF REL6, ;Routines for driving Multinet ; AC definitions for MNETDV ; Physical & Virtual NCT both use P1, but have distinct names ;for clarity PNCT== ;Physical & Virtual NCT ;Error handling macro for file parsing routines. DEFINE PERROR(MSG)< HRROI T1,[ASCIZ "MSG"] JRST PERROT > SWAPCD ;ps Initialization only SUBTTL Multinet Initialization ;MNTINI Called at system startup from RUNDD7 in MEXEC, initializes ;tables and storage needed by Multinet. MNTINI:: IFE REL6, ; enter section one SE1CAL ; Call section 1 (stack has return) ACVAR ; Temp register CALL LGTAD ; Record time counters reset MOVE T2,TODCLK DMOVEM T1,AASDT+2 ; Beginning times into monitoring data ; NB: NETSUP has 1B35 - init, 1B18 - bring up MOVX T1,1B0 ; Writer flag MOVEM T1,HTBLCK ; So GTHST will hang until HSTINI completes CALL BUFINI ; Initialize the network buffer pool SKIPE MNTRAC ; Trace start-up? CALL MNTPIN ; Yes MOVX T1,CR%CAP ; Create a Job 0 fork, with capabilities CFORK% BUG.(HLT,MNTCCF,MNETDV,SOFT,,,< Cause: MNTINI CFORK% at system startup failed. Possibly there are to many forks under JOB 0. Action: Either find a way to get rid of some forks (or move them to another job) or increase the forks/job parameter. >) MOVEI T2,MNETGO MSFRK% ; Start fork in monitor MOVX T1,CR%CAP ; Create a Job 0 fork, with capabilities CFORK% BUG.(HLT,MNTCUF,MNETDV,SOFT,,,< Cause: MNTINI CFORK% at system startup failed. Possibly there are to many forks under JOB 0. Action: Either find a way to get rid of some forks (or move them to another job) or increase the forks/job parameter. >) MOVEI T2,MNTUTL MSFRK% ; Start fork in monitor RET ; Done ENDAV. ;Here in fork context to initialize the rest of Multinet. MNETGO: MOVX Q2,MNTUXI ; Illegal interrupt address CALL MNTFKI ; Setup high priority monitor fork MOVEM T1,MNTFRK ; Remember FORKX ;Initialize local site configuration and addresses and create the NCTs. CALL ADRINI ; Init addresses CAIE T1,MNTX00 ; Skip if ok BUG.(INF,NOADDR,MNETDV,SOFT,, ,< Cause: The network site initialization file SYSTEM:SITE-ADDRESS.TXT (or SYSTEM:INTERNET.ADDRESS) could not be found. The host's local network interfaces could not be initialized. Action: Have the host's network liason create the file. >) ; Initialize domain databases CALL DOMINI ; Init domain database CAIE T1,MNTX00 ; Skip if ok BUG.(INF,NODOM,MNETDV,SOFT,, ,< Cause: There is a problem with the domain system database files. The files DOMAIN:FLIP.DD.gen and DOMAIN:FLOP.DD.gen must both exist, be uncorrupted, and consistent with the monitor. If the top generation of the files is not useable, successively older generations are examined. The file(s) could have been corrupted due to a recent crash. Action: Verify that there is a logical definition for DOMAIN:. Verify that the files exist, with identical generation numbers. Create new versions of the files from a backup copy (make sure the generation numbers are identical). >) ;Initialize host tables CALL HSTINI ; Get the system to know names of sites CAIE T1,MNTX00 ; Skip if ok BUG.(INF,NOHSTN,MNETDV,SOFT,, ,< Cause: The network host table initialization file SYSTEM:HOSTS.TXT could not be found. No host tables have been loaded. Action: Have the host's network liason create the file. >) SETZM HTBLCK ; Unlock host tables CALL NETHSI ; Initialize the network hash table ;If normal operation and want net up ... HRRE T1,NETSUP ; Want networks up? (1B18 implies yes) TRZ T1,-1 ; Initialization complete HRRM T1,NETSUP PUSH P,T1 ; Save ON/OFF ;Initialize higher level protocols MOVX CX,<-NP.MAX,,0> ; AOBJN counter for higher level protocols DO. HRRZ T1,CX ; Protocol code PUSH P,CX ; Save index MOVE T2,@PROON(CX) ; Get startup flags TXNE T2,1B35 ; Initialize protocol? CALL @PROINZ(CX) ; Yes TRN POP P,CX AOBJN CX,TOP. ; Do next ENDDO. ;STG has the PROON/PROINZ tables of routines to call to initialize a protocol. POP P,T1 ; ON/OFF flag MOVE T2,DBUGSW ; Get system switch CAILE T2,1 ; System normal? JRST MNTINX ; No, don't bring nets up MOVEM T1,NETSUP ; ON is -1,,0, OFF is 0 JUMPGE T1,MNTINX ; Don't bring nets up ;Fall into MNETON ;MNETON Turn networks on if NETSUP has been off. May call from MDDT by ;CALL MNETON$X. ;Ret+1: Always. MNETON:: ; Initialize all NCTs MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get next in list JUMPE VNCT,ENDLP. ; Return when done SETOM NETON(VNCT) ; Turn it on CALL LGTAD ; Get current time MOVEM T1,NTIUPT(VNCT) ; Save as when it was turned on MNTCALL NTPINI ; Do protocol specific initialization NOP SKIPN NTPHY(VNCT) IFSKP. ; If virtual, SETOM NTRDY(VNCT) ; Don't init hardware, bring interface up ELSE. ; If physical MOVE T1,TODCLK ; Init down clock MOVEM T1,NTDCLK(VNCT) ; So virtual NCT's start off right SETOM NTERRF(VNCT) ; Start things off right. MNTCALL NTRSRT ; Get it going NOP ENDIF. LOOP. ; And loop ENDDO. MNTINY: MOVX T1,<-1,,0> ; Standard UP value MOVEM T1,NETSUP ; ON is -1,,0, OFF is 0 MOVE T1,FORKX ; Check on FORKX CAME T1,MNTFRK ; If MultiNet Fork, continue RET ; Must be MDDT "CALL MNETON$X" MNTINX: JRST MNETLP ; Go to main fork loop ;Unexpected interrupt trap MNTUXI: BUG.(CHK,MNTUX0,MNETDV,SOFT,) SE1ENT ; Make sure in section one MCENTR JRST MNETLP ; Recover processing RESCD ;ps Keep this resident for better response ;Main Multinet fork loop MNETLP: DO. MOVE T1,MNTFLG MNTM5< ADDM T1,CELL(MNTFF,1,,MNT)> ; Count sum MNTFLG MNTM5 AOS CELL(MNTFF,0,,MNT) ; And runs SETZM MNTFLG ; Clear flag MOVE T1,MNTI0 ; Default time interval to run next MOVEM T1,MNTIM ; Save CALL MNTCHK ; Check on the network interfaces MOVE T1,MNTIM ; Set as next time to run CALL SETBKT ; Convert to BLOCKT arg HRRI T1,MNTBPT ; Scheduler test routine MDISMS ; Sleep awhile LOOP. ; Loop forever ENDDO. ;MNTWAK ;Wake up multinet fork. If caller is not the Multinet fork, wakeup ;immediately. Otherwise sets a wakeup "fairly soon" (assuming that ;nothing is critical enough to take over the whole machine). ;Preserves T2,T3,T4. MNTWAK:: MOVE T1,FORKX ; Get running fork CONSO PI,77400 ; At PI level, or CAME T1,MNTFRK ; Not called from maintenance code? IFSKP. ; No MOVEI T1,^D1000 ; Wake in one second CAMG T1,MNTIM ; Anyone asking for sooner? MOVEM T1,MNTIM ; No, use one second ELSE. ; Yes AOS MNTFLG ; Wakeup immediately ENDIF. RET ; Done SWAPCD ;ps End of better response RESCD ;ps Scheduler tests ;Scheduler test for Multinet hardware fork MNTBPT: SKIPE MNTFLG ; Any reason to run? JRST 1(T4) ; Yes JRST BLOCKT ; Check for time expired ;Test for dismiss until right half of word becomes zero DISRE:: MOVE T2,(T1) ; Get word TRNE T2,-1 ; Right half zero? JRST 0(T4) ; No, Wait JRST 1(T4) ; Yes, Run ;Test for domain resolver completion or timeout DOMRSK: SKIPE T1,(T1) ; Resolver completed? CAMG T1,TODCLK ; No, time passed? JRST 1(T4) ; Yes, wake up JRST 0(T4) ; Neither, wait some more RESCD ;ps Keep this resident for better response ;MNTCHK ;Routine for keeping things going on all nets. MNTCHK: MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get next in list JUMPE VNCT,ENDLP. ; Done MNTCALL NTPMNT ; Do protocol specific maintenance CALL CHKHDW ; Check out the interface SKIPE NTSTCH(VNCT) ; Change of state? CALL LOGSTC ; Yes, print it out MOVE T1,SCTLW ; System shutdown? TXNN T1,<1B3> LOOP. ; No SKIPN NTPHY(VNCT) ; If virtual or SKIPN NETON(VNCT) ; Network off LOOP. ; Neither, onward MNTCALL NTHKIL ; Kill the hardware NOP LOOP. ; Onward ENDDO. CALL GCBUF ; Garbage collect buffer pools RET RESCD ;ps Called at interrupt level ;CHKHDW ;Check, and maintain, the status of an interface. ;This routine assumes the following usage for some flags in the NCT: ;NTERRF -- -1 if an error occured "recently" ;NETON -- <>0 if the interface should be up, 0 if it should be down ;NTRDY -- <0 if interface is up, 0 if interface is down, ; >0 if interface is on the way down ; Protocol, or hardware specific "take down" routines ; can use bits in the right half as flags. Basicly ; The right half is set to 777777 when the down cycle ; starts, and is changed (set to 0) only when the ; interface is completely down. ;NTDCLK -- Timeout clock, used to timeout various events ; (error condition, going down, etc.) ;NTINRS -- Input restart needed. 0 or address of restart routine ; (This occurs if no buffers were available at PI level) CHKHDW: SKIPL NTRDY(PNCT) ; Should it be up? JRST CHKIND ; Down cycle SKIPE NTPHY(PNCT) ; Is this a physical NCT? IFSKP. ; Yes, check on hardware SKIPN T1,NTINRS(PNCT) ; Input restart needed? IFSKP. ; Yes SKIPGE T3,NTPSTI(PNCT) ; Collecting statistics? AOS CELL(MNMRC,^D7,(T3)) ; Input restart ("no buffer") CALL (T1) ; Do it JFCL ; Routine might skip return ENDIF. MNTCALL NTSCHK ; Check the current status JRST CHKINE ; Not good AOSN NTERRF(PNCT) ; Did an error occur recently? JRST CHKINE ; Yes SKIPN NTDCLK(PNCT) ; Was it down previously? ANSKP. ; Yes ;Signal the virtual NCT's that it's come up XMOVEI T1,CHKINC CALL VNCTFN ; Do the function ENDIF. ; Physical NCT ;At this point the interface is apparently functional CHKINU: SKIPN NETON(PNCT) ; Should it be functional? JRST CHKINN ; No, take it down ;Interface is, and should be, up SKIPE NTPHY(PNCT) RET ; Nothing more if only a virtual interface SKIPLE T1,NTTOUT(PNCT) ; If no output timeout or CAMLE T1,TODCLK ; Timeout hasn't passed IFNSK. ; Check input SKIPLE T1,NTTOUT+1(PNCT) ; If no input timeout or CAMLE T1,TODCLK ; Timeout hasn't passed ANNSK. ; Then no timeouts have passed ELSE. SKIPGE T3,NTPSTI(PNCT) ; Collecting statistics? AOS CELL(MNMSC,^D10,(T3)) ; Output timeout BUG.(INF,NTOHNG,MNETDV,SOFT,, <,,,>,< Cause: An IO operation to a network interface has not completed in a reasonable amount of time. Either the interface is hung or the haardware may be malfunctioning (loss of interrupts). Data: NCT memory address, Local host address, TODCLK of output timeout, TODCLK of input timeout; the failing side is probably the lowest non-zero time. >) MNTCALL NTRSRT ; If timeout, reset net NOP ENDIF. CHKINA: SKIPE NTPHY(PNCT) ; Must be physical RET ; Virtual MNTCALL NTISRT ; Make sure input and CHKINB: CALLRET MNOSRT ; Output are going ; Function applied to all virtual NCTs when the physical interface comes up CHKINC: SETZM NTDCLK(VNCT) ; It's up now CALL LGTAD ; Get time of day MOVEM T1,NTXUPP(VNCT) ; Save as when it came up SKIPG NTLADR(VNCT) ; If no address associated RET ; Done MNTCALL NTPINI ; Do protocol specific initialization RET ; Not yet up AOS NTSTCH(VNCT) ; Status change CALLRET NCTUP ; And mark it up ; Function applied to all virtual NCTs when the physical interface goes down CHKINO: HRRZI T1,-1 ; Flags in RH MOVEM T1,NTRDY(VNCT) ; Signal going down SETZM NTORDY(VNCT) ; No new output allowed SETZM NTDCLK(VNCT) ; Clear clock CALL LGTAD ; Get current time MOVEM T1,NTXDNT(VNCT) ; Save as when it when off SKIPG NTLADR(VNCT) ; If no address associated with it RET ; Done AOS NTSTCH(VNCT) ; Status change CALLRET NCTDWN ; Take that one down ;Here if interface is dead, or has a transient error CHKINE: SKIPE T1,NTDCLK(PNCT) ; Was it down last time? IFSKP. MNTCALL NTPERR ; Do protocol dependent error recovery MOVE T1,TODCLK ; Get time now MOVEM T1,NTDCLK(PNCT) ; Save as when went off ENDIF. SUB T1,TODCLK ; Subtract current time MOVNS T1 ; (Current time is larger) CAIG T1,^D30000 ; Down for 30 seconds (arbitrary)? JRST CHKINU ; No, may still be ok ;Interface has been down for too long, kill it. CHKINN: ;Must take this one down and all its "virtual" interfaces SKIPE NTPHY(P1) ; If physical, IFSKP. ; Take hardware down XMOVEI T1,CHKINO ; Function to perform CALL VNCTFN ; Do it ENDIF. ;Here if an interface is down or on it's way down CHKIND: SKIPE NTRDY(PNCT) ; Already down? IFSKP. ; Net is down SKIPN NETON(PNCT) ; Should it be up? IFSKP. ; Yes SKIPN T1,NTPHY(PNCT) IFSKP. ; Virtual SKIPGE NTRDY(T1) ; Is real one usable? SKIPL NTORDY(T1) IFSKP. ; Usable, so SETOM NTRDY(PNCT) ; Mark net up SETOM NTORDY(PNCT) AOS NTSTCH(PNCT) ENDIF. ELSE. ; Physical MNTCALL NTRSRT ; Try to restart it NOP ENDIF. ; End of SKIPN NTPHY ENDIF. ; End of SKIPN NETON ;Down, and should be down RET ; Return now ENDIF. ; End of SKIPE NTRDY ;Net is not down CALL MNTWAK ; We need to come back fairly soon. MNTCALL NTPKIL ; Do protocol specific kill action JRST CHKINA ; Not done yet, restart I & O ;Protocol is now shut down, shut off the hardware SETZM NTORDY(PNCT) ; No more output allowed SKIPE NTPHY(PNCT) ; Physical interface? IFSKP. ; Here to kill the physical interface MNTCALL NTHKIL ; Kill the hardware NOP ENDIF. SETZM NTRDY(PNCT) ; All down AOS NTSTCH(PNCT) ; Log the change of state CALLRET MNTCLQ ; Clear anything still in the queues RESCD ;ps PIOFF/PION ;MNTCLQ Clear an interface's buffer queues. The interface should be turned ; off at this point or I/O page failures may result. ;PNCT/ Physical NCT MNTCLQ: SKIPE NTPHY(PNCT) ; Physical? RET ; No, no buffer lists SKIPN NTRDY(PNCT) ; Must be turned off SKIPE NTORDY(PNCT) ; Output disallowed (for ALL virtuals). RET ; Bad, don't try it SKIPN T2,NTIB(PNCT) ; Input going? IFSKP. MOVX T1,NP.GEN ; General protocol SETZ T3, ; 0 for local leader size STOR T3,PLNBZ,(T2) ; Nothing received MNTCALL NTIDUN ; Simulate end of input ; (It does an NTISRT) ; (which should therefore check NTRDY) ENDIF. SKIPN T1,NTOB(PNCT) ; Anything on output? IFSKP. TXNN T1,IPDV%R!1B0 ; Canned or locked? IFSKP. SETZM NTOB(PNCT) ; Ignore canned messages ELSE. MOVX T1,PT%KOL ; Packet flushed MNTCALL NTODUN SETZM NTOB(PNCT) ; Can now send more buffers ENDIF. ENDIF. ; Is this PIOFFing necessary with the network turned off? PIOFF SETZB T2,NTHOBI(PNCT) ; High priority Q EXCH T2,NTHOBO(PNCT) ; Get tail PUSH P,T2 ; Save possible list SETZB T2,NTLOBI(PNCT) ; Low priority Q EXCH T2,NTLOBO(PNCT) ; Get tail SKIPGE T1,NTPSTI(PNCT) ; Collecting statistics? SETZM CELL(MNMSQ,0,(T1)) ; Yes, output queue empty PION CALL FREBFL ; Flush low priority list POP P,T2 ; Saved high priority list CALLRET FREBFL ; Flush it and return RESCD ;ps Called at interrupt level ;PVNCT Physical to virtual NCT. Given a Physical NCT and a protocol code ;find the associated VNCT (if any) that handles that protocol. ;PNCT/ Physical NCT ;T1/ NP.xxx ;Ret+1: Always. ;Preserves all ACs (Except PNCT if virtual found) ;If there is no VNCT for that protocol (or VNCTs at all) PNCT still contains ;the PNCT. PVNCT:: ACVAR ;Local NCT AC MNTM5< AOS CELL(MNTSB,^D19,,MNT)> ; PVNCT called MOVE CNCT,PNCT DO. LOAD CX,NTPRO,(CNCT) ; Get the protocol code CAME T1,CX ; Same? IFSKP. HRRZ VNCT,CNCT ; Yes, return this one RET ENDIF. LOAD CNCT,NTLNK,(CNCT) ; Get the next in the chain SKIPE CNCT ; Any more? SKIPN NTPHY(CNCT) ; Yes, Virtual? TRNA ; None or physical LOOP. ; Another virtual ENDDO. RET ENDAV. ;VNCTFN Perform a function on an NCT and all the associated virtual NCT's. ;T2-T4 may be passed to function. ;T1/ Pointer to function to call ;PNCT/ Physical NCT ;Ret+2: If any of the function calls did VNCTFN:: STKVAR SETZM SKPFLG ; Nothing skipped MOVEM PNCT,SVPNCT ; Save NCT MOVEM T1,FUNC ; Save function DO. CALL @FUNC ; Perform the function CAIA ; Returned +1 SETOM SKPFLG ; Something skipped LOAD VNCT,NTLNK,(VNCT) ; Get linked JUMPE VNCT,ENDLP. ; No more SKIPN NTPHY(VNCT) ; Virtual? EXIT. ; No, done LOOP. ENDDO. MOVE PNCT,SVPNCT ; Retore NCT SKIPN SKPFLG ; Something skipped? RET ; No RETSKP ; Yes, follow suite ENDSV. SWAPCD ; Not needed often ;Functions for freeing buffers ;FREBFL Free a list of buffers. ;T2/ buffer list head ;PNCT/ Physical NCT FREBFL: ACVAR MOVE BLST,T2 ; Remember list head DO. MOVE T1,BLST ; Get list head JUMPE T1,R ; Done LOAD BLST,NBQUE,(T1) ; Save the next CALL FREBUF ; Free a buffer and LOOP. ; Do the rest ENDDO. ENDAV. ; /*NOTREACHED*/ ;FREBUF Free a packet buffer to the appropriate place. ;T1/ Buffer address ;PNCT/ Physical NCT FREBUF: JUMPE T1,R ; No buffer SKIPE NTOB(PNCT) ; Must be empty at this point BUG.(HLT,FREBFX,MNETDV,SOFT,) MOVEM T1,NTOB(PNCT) ; Pretend it was output MOVX T1,PT%KOL ; but it's killed MNTCALL NTODUN ; Do output completion, keeps counts correct SETZM NTOB(PNCT) ; Can now do more buffers RET ; Return ;LOGSTC Log network change of state to CTY. ;***This needs to be generalized for other than Internet nets ;VNCT/ Virtual NCT for the network LOGSTC: SKIPGE T1,NTPSTI(VNCT) ; Collecting statistics? AOS CELL(MNMST,0,(T1)) ; Count status changes SETZM NTSTCH(VNCT) ; Clear flag SKIPG NTLADR(VNCT) ; Any address? RET ; No, ignore it ;Now isolate the bytes of the net number TMSG < [> LOAD T1,NTPRO,(VNCT) ; Get protocol type of network HRRO T1,PRONAM(T1) ; Name of this protocol PSOUT% ERJMP .+1 MOVE T1,NTNET(VNCT) ; Get number TXZ T1, ; Mask off protocol type SETZ T4, ; Init count (N-1) ;This assumes that all network numbers are immediate values DO. LSHC T1,-^D8 ; Shift off a byte PUSH P,T2 ; Save SKIPE T1 ; Done? AOJA T4,TOP. ; Count it up ENDDO. TMSG < network number > ;Write all the bytes of the net number MOVX T1,.PRIOU ; Primary output DO. SETZ T2, POP P,T3 ; Get a byte LSHC T2,^D8 ; Justify it correctly MOVX T3,^D10 ; Output in decimal NOUT% ERJMP .+1 MOVEI T2,"." ; Seperator SKIPE T4 ; If any left BOUT% ; Write it ERJMP .+1 SOJGE T4,TOP. ; Loop through them all ENDDO. HRROI T1,[ASCIZ / on/] SKIPN NETON(VNCT) HRROI T1,[ASCIZ / off/] PSOUT% ERJMP .+1 HRROI T1,[ASCIZ /, Output /] PSOUT% ERJMP .+1 HRROI T1,[ASCIZ /on/] SKIPN NTORDY(VNCT) HRROI T1,[ASCIZ /off/] PSOUT% ERJMP .+1 MOVEI T1," " PBOUT% ERJMP .+1 CALL LGTAD ; Report time of this change SKIPGE T2,T1 ; If time known IFSKP. MOVEI T1,.PRIOU ; Still on CTY SETZ T3, ODTIM% ERJMP .+1 ENDIF. TMSG <] > SKIPN NTORDY(VNCT) ; Did the hardware come up? CALLRET NCTDWN ; No, signal it's down CALLRET NCTUP ; Signal that it's available for use SUBTTL Interrupt level assistance RESCD ;ps ;The following are common routines used by network PI level. ;State save routines. ;The appropriate routine for the interrupt level is entered via JSR XXXX. ; .+1 holds the address of a routine to call ; .+2 holds the address of this NCT ; .+3 is the XPCW block for this interrupt ;The routine must preserve P5. ;Level 6 handler .PSECT RSDAT ;ps Impure code - JSR ;The following is used to speed up interrupt context switching, ideally ;these would be in APRSRV, but until we have a feel for how well this works. FSTINT==0 ; Non-zero to turn on AC block code IFN FSTINT,< LV6ACB==4 ; AC block for level 6 interrupts LV6OAC: 0 ; Previous AC block SETLV6: PGLACB+FLD(LV6ACB,PGCACB) ; DATAO PAG to set AC block > ;; IFN FSTINT LV6SAV:: 0 IFE FSTINT,< MOVEM 0,LV6ACS ; Save AC's MOVX 0, BLT 0,LV6ACS+P> ; Save all registers IFN FSTINT,< ; Save fast way DATAI PAG,LV6OAC ; Save pager state and DATAO PAG,SETLV6> ; Set new state MOVE P,LV6PDP ; Set proper stack MOVE P5,LV6SAV ; Get return address and HRRZ PNCT,1(P5) ; 0,,NCT CALL @(P5) ; Process the interrupt XMOVEI P5,2(P5) ; Return address MOVEM P5,LV6SAV ; Set up IFE FSTINT,< MOVX P, ; Restore AC's BLT P,P> IFN FSTINT,< DATAO PAG,LV6OAC> ; Restore old state XJEN @LV6SAV ; Restore context .ENDPS ;ps RSDAT back to pure code SUBTTL Network Interface Statistics ;NTPOSS ;Collect output statistics (before beginning output). ;T1/ Subtype,,Type ;T2/ Extended pointer to output buffer, or ; if IPDV%R, pointer to local leader ;PNCT/ Physical NCT ;Preserves T2 NTPOSS:: SKIPGE T4,NTPSTS(PNCT) ; Have area? CAML T4,[-,,0] ; & Big enough? JRST NTPRNX ; No, forget all of this ADDI T4, ; Point to Output area PUSH P,T2 ; Save pointer PUSH P,T1 ; Subtype,,Type HRRZS T1 ; Type INHSTI (,,T1,T4,T3,2) ; Histogram Type (CELL(NCTiE) SKIPG T4,XCELL(NCTiE,1,(T4)) ; Counting subtypes? IFSKP. HLRZ T1,(P) ; Subtype INHSTI (,,T1,T4,T3) ; Histogram Sub-type (CELL(NCTiE) ENDIF. POP P,T1 POP P,T2 ; Original pointer w/flags ;Fall into NTPRNG ;NTPRNG Collect timing info and keep ring buffer of device operations. ;T2/ Extended pointer to output buffer, or ; if IPDV%R, pointer to local leader ;PNCT/ Physical NCT ;Preserves T2 (& IPDV%R) only NTPRNG:: MOVE CX,MNTSW ; Get configuration switches TXNN CX,MNS%DS ; Want to collect driver statistics? JRST NTPRNX ; No, skip over them PUSH P,T2 ; Save packet pointer & flags CALL UPDTCK ; Update TODCLK MOVE T1,TODCLK ; Get the time ;Record interface statistics MOVE T2,(P) ; Get flags TXNE T2,IPDV%O ; Output operation? JRST NTPRO0 ; Yes, output ;Input operation: Use MNMWR, MNMWU,MNMWV,MNMWW SKIPGE T4,NTPSTI(PNCT) ; Have MNMWR area? CAML T4,[-,,0] ; & Big enough? JRST NTPRN0 ; No ADDI T4, ; Point to MNMWR receive stats TXNE T2,IPDV%E ; Beginning or ending operation? JRST NTPRIE ; Ending ;Beginning of input: May terminate a run. ;Input is always a "run", unless the input buffers were exhausted. MOVE T2,XCELL(mnmwr,^D15,(T4)) ; Get time last input ended ADDI T2,1 ; (delta of 1 is probably a clock tic) CAMG T1,T2 ; Continuing a run? IFSKP. ; No ;Been idle, update cumulative run length statistics MOVE T2,XCELL(mnmwr,^D15,(T4)) ; Last end time SUB T2,XCELL(mnmwr,^D14,(T4)) ; Beginning of run ADDM T2,XCELL(mnmwr,^D13,(T4)) ; Accumulate run time AOS XCELL(mnmwr,^D12,(T4)) ; Count number of runs ;Histogram run length PUSH P,T4 ; Save MNMWR pointer SKIPGE T4,NTPSTI(PNCT) ; Have run histogram (MNMWW) area? CAML T4,[-,,0] ; & Big enough? IFSKP. ; Yes ADDI T4, ; Point to MNMWW run hist INHIST(,,T2,T4,T3) ; Receive run histogram (CELL(MNMWW ENDIF. POP P,T4 ; Restore pointer to MNMWR MOVEM T1,XCELL(mnmwr,^D14,(T4)) ; Now begins next run ;Been idle, update cumulative idle time statistics MOVE T2,T1 ; Now minus SUB T2,XCELL(mnmwr,^D15,(T4)) ; Last end time ADDM T2,XCELL(mnmwr,^D9,(T4)) ; Accumulate idle time AOS XCELL(mnmwr,^D8,(T4)) ; Count number of idles ;Histogram idle time PUSH P,T4 ; Save MNMWR pointer SKIPGE T4,NTPSTI(PNCT) ; Have Idle hist (MNMWU) area? CAML T4,[-,,0] ; & Big enough? IFSKP. ; Yes ADDI T4, ; Point to MNMWU idle hist INHIST(,,T2,T4,T3) ; Receive idle histogram (CELL(MNMWU ENDIF. POP P,T4 ; Restore pointer to MNMWR ENDIF. MOVEM T1,XCELL(mnmwr,^D15,(T4)) ; Record time input started JRST NTPRN0 ; Go update internal packet header ;Input end: Update transfer info NTPRIE: MOVE T2,T1 ; Now minus SUB T2,XCELL(mnmwr,^D15,(T4)) ; Last start time ADDM T2,XCELL(mnmwr,^D11,(T4)) ; Accumulate packet time AOS XCELL(mnmwr,^D10,(T4)) ; Count number of packets MOVEM T1,XCELL(mnmwr,^D15,(T4)) ; Record time finished ;Update both cumulative and incremental baud-rate parameters MOVE T3,(P) ; Pointer to packet TXZ T3, ; Beware of flags TXZE T3,IPDV%R ; Canned buffer? IFSKP. ; No LOAD T3,PLNBZ,(T3) ; Length at local net level ANDG. T3 ; Don't include MNTCLQ'd packets AOS XCELL(mnmwr,5,(T4)) ; Incremental packets ADDM T3,XCELL(mnmwr,6,(T4)) ; Incremental bytes received ADDM T2,XCELL(mnmwr,7,(T4)) ; Per incremental time to receive them AOS XCELL(mnmwr,0,(T4)) ; Total packets ADDM T3,XCELL(mnmwr,1,(T4)) ; Total bytes received ADDM T2,XCELL(mnmwr,2,(T4)) ; Per total time to receive them SKIPGE T4,NTPSTI(PNCT) ; Have transfer hist (MNMWV) area? CAML T4,[-,,0] ; & Big enough? ANSKP. ; Yes ADDI T4, ; Point to MNMWV receive xfer hist INHIST(,,T2,T4,T3) ; Received packet histogram (CELL(MNMWV ENDIF. JRST NTPRN0 ; Go update internal packet header ;Output operation: Use MNMWS, MNMWX,MNMWY,MNMWZ, MNMWT NTPRO0: SKIPGE T4,NTPSTI(PNCT) ; Have MNMWS area? CAML T4,[-,,0] ; & Big enough? JRST NTPRN0 ; No ADDI T4, ; Point to MNMWS send stats TXNE T2,IPDV%E ; Beginning or ending operation? JRST NTPROE ; Ending ;Beginning of output: May terminate a run MOVE T2,XCELL(mnmws,^D15,(T4)) ; Get time last output ended ADDI T2,1 ; (Delta of 1 is probably a clock tic) CAMG T1,T2 ; Continuing a run? IFSKP. ; No ;Been idle, update cumulative run length statistics MOVE T2,XCELL(mnmws,^D15,(T4)) ; Last end time SUB T2,XCELL(mnmws,^D14,(T4)) ; Beginning of run ADDM T2,XCELL(mnmws,^D13,(T4)) ; Accumulate run time AOS XCELL(mnmws,^D12,(T4)) ; Count number of runs ;Histogram run length PUSH P,T4 ; Save MNMWS pointer SKIPGE T4,NTPSTI(PNCT) ; Have run histogram (MNMWZ) area? CAML T4,[-,,0] ; & Big enough? IFSKP. ; Yes ADDI T4, ; Point to MNMWZ run hist INHIST(,,T2,T4,T3) ; Send run histogram (CELL(MNMWZ ENDIF. POP P,T4 ; Restore pointer to MNMWS MOVEM T1,XCELL(mnmws,^D14,(T4)) ; Now begins next run ;Been idle, update cumulative idle time statistics MOVE T2,T1 ; Now minus SUB T2,XCELL(mnmws,^D15,(T4)) ; Last end time ADDM T2,XCELL(mnmws,^D9,(T4)) ; Accumulate idle time AOS XCELL(mnmws,^D8,(T4)) ; Count number of idles ;Histogram idle time PUSH P,T4 ; Save MNMWS pointer SKIPGE T4,NTPSTI(PNCT) ; Have Idle hist (MNMWX) area? CAML T4,[-,,0] ; & Big enough? IFSKP. ; Yes ADDI T4, ; Point to MNMWX idle hist INHIST(,,T2,T4,T3) ; Send idle histogram (CELL(MNMWX ENDIF. POP P,T4 ; Restore pointer to MNMWS ENDIF. MOVEM T1,XCELL(mnmws,^D15,(T4)) ; Record time output started JRST NTPRN0 ; Go update internal packet header ;Output end: Update transfer info NTPROE: MOVE T2,T1 ; Now minus SUB T2,XCELL(mnmws,^D15,(T4)) ; Last start time ADDM T2,XCELL(mnmws,^D11,(T4)) ; Accumulate packet time AOS XCELL(mnmws,^D10,(T4)) ; Count number of packets MOVEM T1,XCELL(mnmws,^D15,(T4)) ; Record time finished ;Update both cumulative and incremental baud-rate parameters MOVE T3,(P) ; Pointer to packet TXZ T3, ; Beware of flags TXZE T3,IPDV%R ; Canned? IFSKP. ; No LOAD T3,PLNBZ,(T3) ; Length at local net level ANDG. T3 ; Don't include MNTCLQ'd packets AOS XCELL(mnmws,5,(T4)) ; Incremental packets ADDM T3,XCELL(mnmws,6,(T4)) ; Incremental bytes sent ADDM T2,XCELL(mnmws,7,(T4)) ; Per incremental time to send them AOS XCELL(mnmws,0,(T4)) ; Total packets ADDM T3,XCELL(mnmws,1,(T4)) ; Total bytes sent ADDM T2,XCELL(mnmws,2,(T4)) ; Per total time to send them SKIPGE T4,NTPSTI(PNCT) ; Have transfer hist (MNMWY) area? CAML T4,[-,,0] ; & Big enough? ANSKP. ; Yes ADDI T4, ; Point to MNMWY send xfer hist INHIST(,,T2,T4,T3) ; Sent packet histogram (CELL(MNMWY ENDIF. ;Update transmission-delay histogram MOVE T2,(P) ; Pointer to packet TXZ T2, ; Clear out flags TXZE T2,IPDV%R ; Canned buffer? IFSKP. ; No LOAD T4,PLNQD,(T2) ; Time queued for driver LOAD T3,PLNDB,(T2) ; Time driver began minus SUB T3,T4 ; Time queued for driver is delay SKIPGE T4,NTPSTI(PNCT) ; Transmission delay hist (MNMWT) area? CAML T4,[-,,0] ; & Big enough? ANSKP. ; Yes ADDI T4, ; Point to MNMWT trans. delay hist INHIST(,,T3,T4,T2) ; Trans. delay histogram (CELL(MNMWT ENDIF. ;Fall into NTPRN0 ;Update internal packet header ; T1 has TODCLK NTPRN0: MOVE T2,(P) ; Pointer to packet buffer TXNE T2,IPDV%R ; Canned buffer? IFSKP. ; No TXNN T2,IPDV%E ; Beginning? STOR T1,PLNDB,(T2) ; Yes TXNE T2,IPDV%E ; End? STOR T1,PLNDE,(T2) ; Save end time ENDIF. POP P,T2 ; Pointer to packet buffer ;Packet into ring SKIPGE T3,NTPSTS(PNCT) ; Have ring area? CAML T3,[-,,0] ; & Big enough? IFSKP. ;Yes ADDI T3, ; Point to Ring area MOVE T4,XCELL(mnmxx,1,-2(T3)) ; Get current position CAML T4,XCELL(mnmxx,0,-2(T3)) ; At end? SETZB T4,XCELL(mnmxx,1,-2(T3)) ; To beginning ADD T4,T3 ; Current slot MOVX T1,IPDVSZ ; Size of slot ADDM T1,XCELL(mnmxx,1,-2(T3)) ; Set next slot MOVE T1,TODCLK ; Record time MOVEM T1,IPDVTM(T4) MOVEM T2,IPDVBF(T4) ; Record packet address & flags HRLI T4,<-IPDVSZ+IPDVLL> ; Rest of block is sample ADDI T4,IPDVLL ; AOBJN for local leader MOVE T1,T2 ; Working packet pointer TXZ T1, ; Beware of flags TXZE T1,IPDV%R ; Canned? IFSKP. PNTLDR T1,PLNDT,(T1) ; Address of local net level leader ENDIF. SUB T1,NTHDRL(PNCT) ; Correct for different size leaders DO. MOVE T3,(T1) ; Copy leader word MOVEM T3,(T4) AOS T1 AOBJN T4,TOP. ENDDO. ENDIF. NTPRNX: TXZ T2, ; Clear all flags but IPDV%R RET SUBTTL Multinet IO Interfacing Routines RESCD ;ps Called at interrupt level ;Input - Multinet background fork (MNTFRK) keeps input going by calling NCT's ;start input routine (MNTCALL NTISRT). It initializes an input operation, ;setting interrupt vectors as required, and gets a packet buffer and puts ;data into it. It then calls the local net layer input completion routine ;(MNTCALL NTIDUN). When any protocol functions have been completed, or if ;there are none, and the packet contains information for a higher level ;protocol, the packet is passed to Multinet via CALL MNTEIN, which performs ;common operations and passes the packet to the specified transport protocol. ;Input for the next packet is then started via an MNTCALL NTISRT. ;MNTEIN General end of input. (May be called at interrupt level.) ;T1/ Protocol code (NP.xxx) ;T2/ Extended pointer to input buffer, PLNDT/BZ set ;T3/ Number of bytes in local leader ;VNCT/ Virtual NCT MNTEIN:: STOR T1,NBPRO,(T2) ; Set protocol code in the buffer LOAD T4,PLNBZ,(T2) ; Length at local net level SUB T4,T3 ; Higher level length STOR T4,PTPBZ,(T2) ; Length at transport level PNTLDR T4,PLNDT,(T2) ; Address of local net level leader ADDI T3,3 ; Round up LSH T3,-2 ; Bytes to words (divide by 4) ADD T4,T3 ; Point to higher level data STOR T4,PTPDT,(T2) ; Address of transport level leader STOR VNCT,NBNCT,(T2) ; Remember the VNCT PUSH P,T2 CALL UPDTCK ; Update TODCLK POP P,T2 MNTEI0: ; Entry for loopback NCT ; T2/ pointer to packet, PLNDT/BZ + PTPDT/BZ set MOVE T3,TODCLK ; When local net driver STOR T3,PLNDE,(T2) ; Ended reception LOAD CX,PLNDB,(T2) ; Get begin time SUB T3,CX ; Get difference STOR T3,PLNAM,(T2) ; Save the actual recv time MOVX T1,PT%RLN ; Received packet TDNE T1,MNTRAC ; Want trace? CALL PRNPKH ;(T1,T2,VNCT) ; Yes MNTM5< AOS CELL(CMNTEIN,0,,MNT)> ; MNTEIN called with input packet MOVE T1,T2 ; Packet address for subsequent levels LOAD T2,NBPRO,(T1) ; Get the protocol number CAIE T2,NP.GEN ; General or CAIG T2,NP.MAX ; Specific protocol? IFSKP. BUG.(CHK,MNTEIP,MNETDV,SOFT,, <,>,< Cause: Network packet buffer contains an invalid protocol code. Action: Check the packet buffer to find the associated NCT. Data: Packet buffer address and protocol code. >) MOVX T2,NP.GEN ; Use general code ENDIF. ; (NB: section overflow ok here) SKIPL @PROON(T2) ; Protocol ON? MOVX T2,NP.GEN ; No, use default CALL @PROEIN(T2) ; Process it by protocol SKIPE NTPHY(VNCT) ; Pointer to a physical? MOVE PNCT,NTPHY(VNCT) ; Yes, need physical NCT now SETZM NTTOUT+1(PNCT) ; Clear input timeout MNTJRST NTISRT ;(PNCT) ; Keep input moving if needed ;STG has the PROON table of protocol initialized/ON/OFF flags. ;STG has the PROEIN table of how to process an input packet for each protocol. ;Routines for enqueuing packets to a network. ;Error codes returned ; NE%DRP Set if dropped. ; MNTX00 Ok ; MNTX02 Packet too long (LH has max size) ; MNTX04 Flow control ; MNTX06 Host down ; MNTX11 Interface down ; MNTX21 Protocol not supported by local net ; MNTX23 Service not available ;NTSNDI Routine for enqueuing an IP packet, with header creation. ;T1/ Local host (first-hop destination) ;T2/ Extended pointer to packet buffer (PTPDT/PTPBZ set) ;T3/ Protocol code ;VNCT/ Virtual 0,,NCT, or LupNCT,,LogNCT ;Ret+1: Always, with T1 holding an error code, NE%DRP indicates pkt not sent ;T2 containing the estimated output queue length, in milliseconds. NTSNDI:: MNTM5< AOS CELL(CNTSNDI,0,,MNT)> ; NTSNDI called with output packet MNTCALL NTLLDR ; Make a local header, setting PLNDT/BZ TXNN T1,NE%DRP ; Able to proceed? IFSKP. ; No, local leader error MNTM5< AOS CELL(CNTSNDI,1,,MNT)> ; NTSNDI/NTLLDR failed ELSE. ; Yes, queue packet for local net PUSH P,T1 ; Save local leader error code MOVEI T1,NTLOBO ; Low priority queue CALL NTQPKT ; Place in low priority output queue CAIN T1,MNTX00 ; Have queueing error? IFSKP. MOVEM T1,(P) ; Yes, return queueing error code MNTM5< AOS CELL(CNTSNDI,2,,MNT)> ; NTSNDI/NTLSND error ENDIF. POP P,T1 ; Error code to be returned ENDIF. RET ;NTHSND Put packet on High priority queue. ;T1/ Destination network code ;T2/ Extended packet pointer, PLNDT/BZ set at local leader ;Ret+1: Always, T1 has an error code, T2/ estimated length output queue, msec. NTHSND:: MNTM5< AOS CELL(CNTHSND,0,,MNT)> ; NTHSND called with output packet MOVEI T4,NTHOBO ; High priority queue JRST NTXSND ; Join common code ;NTLSND Put packet on Normal priority queue. ;T1/ Destination network code ;T2/ Extended packet pointer, PLNDT/BZ set at local leader ;Ret+1: Always, T1 has an error code, T2/ estimated length output queue, msec. NTLSND:: MNTM5< AOS CELL(CNTLSND,0,,MNT)> ; NTLSND called with output packet MOVEI T4,NTLOBO ; Low priority queue NTXSND: SAVEAC CALL NETLUK ; Find the NCT SKIPLE VNCT,T1 ; 0-none, 1B0+NCT-down, <0,,NC>T-ok IFSKP. ; Nothing useable MNTM5< CAIE T4,NTLOBO> ; Which priority? MNTM5< AOSA CELL(CNTHSND,1,,MNT)> ; NTHSND/NETLUK failed MNTM5< AOS CELL(CNTLSND,1,,MNT)> ; NTLSND/NETLUK failed MOVX T1, ; Interface down RET ; No interface not there ENDIF. MOVE T1,T4 ; Offset to queue ;Fall into NTQPKT ;NTQPKT Put packet on FIFO queue. ;T1/ Queue head offset ;T2/ Extended pointer to packet buffer, PLNDT/BZ set ;VNCT/ Virtual 0,,NCT, or LupNCT,,LogNCT ;Ret+1: Always, T1 has error code, T2 preserved only if error, otherwise, ; T2/ estimated length output queue, msec. NTQPKT: SAVEAC ; Preserve for caller SETZRO NBQUE,(T2) ; Buffer is not on a queue STOR VNCT,NBNCT,(T2) ; Remember NCT(s) MNTM5< AOS CELL(CNTQPKT,0,,MNT)> ; NTQPKT called MOVX CX, ; Clear transmission status flags ANDCAM CX,PKTFLG(T2) PUSH P,T1 ; Save offset to queue head PUSH P,T2 ; Save pointer to packet CALL UPDTCK ; Update TODCLK POP P,T2 ; Restore pointer to packet MOVE T1,TODCLK ; Already there, but just in case STOR T1,PLNQD,(T2) ; Queued for local net POP P,T1 ; Restore offset to queue head SETZRO PLNDB,(T2) ; Local net hasn't begun transmission SETZRO PLNDE,(T2) ; Local net hasn't ended transmission TLNE VNCT,377777 ; Double NCT? MOVSS VNCT ; Yes, get LogNCT,,LupNCT HRRZ T3,VNCT ; Save (virtual) NCT address SKIPE NTPHY(VNCT) ; Virtual? HRR PNCT,NTPHY(VNCT) ; Yes, get the physical one SKIPGE NTORDY(T3) ; Output not allowed on virtual, or SKIPL NTRDY(PNCT) ; Physical is not up IFNSK. ; Return error MOVX CX,<1,,0> SKIPGE T1,NTPSTI(PNCT) ; Collecting statistics? ADDM CX,CELL(MNMSQ,1,(T1)) ; Total packets not accepted for output MNTM5< AOS CELL(CNTQPKT,1,,MNT)> ; NTQPKT failed - found output off MOVX T1, ; Interface not available RET ; Fail, T2 still valid ENDIF. LOAD T3,PLNBZ,(T2) ; Length at local net level IMUL T3,NTORAT(PNCT) ; Multiply by output transmission ; rate (microsecs/octet) IDIVI T3,^D1000 ; Convert to milliseconds SKIPG T3 ; More than 0? MOVX T3,1 ; Use a minimum of 1 STOR T3,PLNEM,(T2) ; Save estimated time to send STOR T3,PLNAM,(T2) ; Also as actual time to send ADDB T3,NTOMSC(PNCT) ; Update total output time PUSH P,T3 ; Time to be returned PIOFF ; Insure intergrety of queues SKIPL T3,NTPSTI(PNCT) ; Collecting statistics? IFSKP. AOS T4,CELL(MNMSQ,0,(T3)) ; Another entry in output queue CAMGE T4,CELL(MNMSQ,2,(T3)) ; Largest? ANSKP. MOVEM T4,CELL(MNMSQ,2,(T3)) ; New longest output queue MOVE T4,TODCLK MOVEM T4,CELL(MNMSQ,3,(T3)) ; Time of longest output queue ENDIF. ADD T1,PNCT ; Offset to the proper queue MOVE T3,T2 ; Copy packet address for queueing EXCH T3,1(T1) ; Packet at end of output FIFO queue SKIPN T3 ; Was queue empty? XMOVEI T3,-$NBQUE+0(T1) ; Yes, this becomes only queue entry STOR T2,NBQUE,(T3) ; Link last end to new end PION ; Allow interrupts again CALL MNOSRT ; Start output if needed SKIPLE T2,NTTOUT(PNCT) ; Get output timeout, if any, and CAMLE T2,TODCLK ; Have an output timeout? IFNSK. ; No SKIPLE T2,NTTOUT+1(PNCT) ; Get input timeout, if any, and CAMLE T2,TODCLK ; Have an input timeout? ANNSK. ; No, do nothing ELSE. CALL MNTWAK ; Get multinet to notice it now ENDIF. MOVX T1,MNTX00 ; All ok POP P,T2 ; Return output queue length, msec. RET ; And return succesfully RESCD ;ps Called from interupt level ;MNOSRT ;Start output if not already in progress. ;Contains common code for all interfaces. ; Call: ; PNCT/ Extended pointer to Physical NCT ; CALL MNOSRT MNOSRT:: SKIPE NTPHY(PNCT) ; Physical NCT? MOVE PNCT,NTPHY(PNCT) ; No, let's get physical SKIPN NTRDY(PNCT) ; Network Ready? RET ; No, just return PIOFF ; No interrupts SKIPN NTOB(PNCT) ; Anything going now? IFSKP. PION ; Yes, Allow interrupts again SKIPGE T1,NTPSTI(PNCT) ; Collecting Stats? AOS CELL(MNMSC,4,(T1)) ; Yes, Output busy RET ENDIF. SETOM NTOB(PNCT) ; Reserve buffer PION MNTJRST NTOSRT ; Join Interface specific Start Output ;MNTUNQ ;Routine called by local net protocols to get next packet to be sent from ;the driver's output queues. ;PNCT/ RH has Physical NCT ;Ret+1: No buffer available, T1/ zero ;Ret+2: T1/ Highest priority buffer available ; T2/ Clobbered MNTUNQ:: MNTM5< AOS CELL(CMNTUNQ,0,,MNT)> ; MNTUNQ called DO. XMOVEI T2,NTHOBO(PNCT) ; Point to High priority queue SKIPE (T2) ; Anything there? IFSKP. XMOVEI T2,NTLOBO(PNCT) ; Point to normal priority queue SKIPE (T2) ; Anything there? ANSKP. MNTM5< AOS CELL(CMNTUNQ,1,,MNT)> ; MNTUNQ found output queue empty SETZ T1, ; Nothing to be returned RET ; No, nothing to send ENDIF. PIOFF ; Protect the queue SKIPE T1,(T2) ; Get the first packet in queue IFSKP. ; Shouldn't be empty, but just in case PION ; Queue empty MNTM5< AOS CELL(CMNTUNQ,1,,MNT)> ; MNTUNQ found output queue empty SETZ T1, ; Nothing to be returned RET ; Fail return ENDIF. LOAD CX,NBQUE,(T1) ; The second in the queue SKIPN CX ; Was there a second? SETZM 1(T2) ; No, zero the tail MOVEM CX,(T2) ; Set new head SKIPGE T2,NTPSTI(PNCT) ; Collecting statistics? SOS CELL(MNMSQ,0,(T2)) ; One less entry in output queue PION SETZRO NBQUE,(T1) ; Clear successor chain IFN <$NBQUE>, ; Point to top of structure PUSH P,T1 CALL UPDTCK ; Update TODCLK POP P,T1 MOVE T2,TODCLK STOR T2,PLNDB,(T1) ; When driver began MOVE CX,PKTFLG(T1) ; Get flags TXNN CX,PPRAX ; Request to abort transmission? IFSKP. ; Yes. MOVX T2,PLNXO ; Tell not sending (so won't restart) IORM T2,PKTFLG(T1) MOVEM T1,NTOB(PNCT) ; MNTODN expects packet address here MNTM5< AOS CELL(CMNTUNQ,2,,MNT)> ; MNTUNQ found PPRAX set ;cwl not really used w/PLNXO MOVX T1,PT%KOL ; Output killed MNTCALL NTODUN ; Perform output-done processing SETZM NTOB(PNCT) ; Can now do more buffers LOOP. ; But return to find the next packet ENDIF. ENDDO. MOVX CX,PLNXB IORM CX,PKTFLG(T1) ; Driver is starting RETSKP ; Done ;MNTODN Output done buffer completion, called at interrupt level. ;T1/ Trace code (PT%SLN or PT%KOL) ;PNCT/ Physical NCT ;NTOB(PNCT)/ Extended pointer to output buffer, PLNDT/BZ set ; Note that during error recovery NTOB may be 0, -1, or IPDV%R+adr. MNTODN:: SAVEAC ; Save a register SETO PKT, ; Keep buffer reserved EXCH PKT,NTOB(PNCT) ; Buffer SETZM NTTOUT(PNCT) ; Clear the timeout SKIPLE PKT ; Watch out for calls in funny states TXNE PKT,IPDV%R ; Watch out for canned (control) msgs RET MNTM5< AOS CELL(CMNTODN,0,,MNT)> ; MNTODN called PUSH P,T1 ; Save trace code CALL UPDTCK ; Update TODCLK STOR T1,PLNDE,(PKT) ; Time local driver ended transmission LOAD CX,PLNDB,(PKT) ; Get begin time SUB T1,CX ; Get difference STOR T1,PLNAM,(PKT) ; Save the actual send time LOAD T1,PLNEM,(PKT) ; Get estimated send time MOVNS T1 ; Negate ADDM T1,NTOMSC(PNCT) ; Subtract off estimated time POP P,T1 ; Restore trace code MOVE CX,PKTFLG(PKT) ; Get flags TXNN CX,PLNXO ; Packet not sent? IFSKP. LOAD T1,NTPRO,(PNCT) ; Be sure protocol set STOR T1,NBPRO,(PKT) SKIPGE T1,NTPSTI(PNCT) ; Collecting statistics? AOS CELL(MNMSQ,1,(T1)) ; Yes, total packets dropped (PLNXO) MNTM5< AOS CELL(CMNTODN,1,,MNT)> ; MNTODN found PLNXO set, dropped pkt ;cwl dif ferent code here? MOVX T1,PT%KOL ; Trace code ELSE. SKIPGE CX,NTPSTI(PNCT) ; Collecting statistics? AOS CELL(MNMSQ,4,(CX)) ; Yes, total packets output MOVX CX,PLNXE ; Ending transmission IORB CX,PKTFLG(PKT) ; Get flags back ENDIF. ; CX/ flags, T1/ trace code MOVE T2,PKT ; Extended pointer to top of packet TXNN CX,PTRAC ; Packet to be traced or TDNE T1,MNTRAC ; Want trace? CALL PRNPKH ;(T1,T2,PNCT) ; Yes LOAD CX,NBPRO,(PKT) ; Get the protocol number CAIE CX,NP.GEN ; Validate protocol code CAIGE CX,NP.MAX IFSKP. ; Bad protocol code BUG.(CHK,MNTODP,MNETDV,SOFT,, <,>,< Cause: Network packet buffer contains an invalid protocol code. Action: Check the packet buffer to find the associated NCT. Data: Packet buffer address and protocol code. >) MNTM5< AOS CELL(CMNTODN,2,,MNT)> ; MNTODN packet w/ bad protocol code MOVX CX,NP.GEN ; Use general code ENDIF. SKIPLE @PROON(CX) ; Protocol been initialized? MOVX CX,-1 ; No, use default MOVE T1,PKT ; Packet address for PROODN CALLRET @PROODN(CX) ; Do the function ;STG has the PROON table of protocol initialized/ON/OFF flags. ;STG has the PROODN table of output completion routines, by protocol code. SUBTTL Loopback NCT SWAPCD ;ps Initialization only ;This is a special NCT used for packets that are intended for this host. ;To avoid the overhead of going over the network they are copied internally. ;Initialization vector for NCT LUPNCI: FLD(NCTBAS,IVLEN)+FLD(NUMINI,IVINI) XWD NTLADR,[-1] ; Special address XWD NTPVEC,[LPPVEC] ; Protocol vector XWD NTHVEC,[LPHVEC] ; Hardware vector XWD NTPSIZ,[<776-MAXOVH>*4] ; Fragment so GETBUF won't BUGHLT XWD NTPSTI,[-NCT0B,,NCT0A] NUMINI==.-LUPNCI-1 SETOM NTORDY(VNCT) ; Output always working SETOM NETON(VNCT) ; "Interface" operational SETOM NTRDY(VNCT) ; Network always ready CALL LGTAD ; Get current time MOVEM T1,NTIUPT(VNCT) ; Save as when it was turned on RETSKP ; Success always RESCD ;ps Response only ;Protocol vector for loopback NCT LPPVEC: NCTVEC(LPPVEC,RSKP,NTPKIL) ; Kill function NCTVEC(LPPVEC,R,NTPERR) ; Error handler NCTVEC(LPPVEC,MNTEIN,NTIDUN) ; Input done NCTVEC(LPPVEC,MNTODN,NTODUN) ; Output done NCTVEC(LPPVEC,LUPLDR,NTLLDR) ; Create local leader NCTVEC(LPPVEC,RSKP,NTPINI) ; Initialize NCTVEC(LPPVEC,R,NTPMNT) ; Maintenance ;Hardware vector for loopback NCT LPHVEC: NCTVEC(LPHVEC,RSKP,NTHKIL) ; Hardware shutdown NCTVEC(LPHVEC,RSKP,NTRSRT) ; And restart NCTVEC(LPHVEC,R,NTISRT) ; Start input NCTVEC(LPHVEC,LUPOUT,NTOSRT) ; Start output NCTVEC(LPHVEC,RSKP,NTSCHK) ; Status check ; Construct local leader for loop-back LUPLDR: STOR T1,PFLAD,(T2) ; Set address PUSH P,T2 ; Save packet address CALL @PRONET(T3) ; Convert host number to net number CALL NETLUK ; Look it up TXZ T1,1B0 ; Clear down flag IFE. T1 BUG.(HLT,LUPNLF,MNETDV,SOFT,) ENDIF. POP P,T2 ; Restore address STOR T1,NBNCT,(T2) ; Fake out the NCT it came in on. MOVX T1,MNTX00 ; No error RET ;LUPOUT Start output is the only real function ;PNCT/ Physical LogNCT,,LupNCT ;NTOB(PNCT) -1 - busy LUPOUT: CALL MNTUNQ ; Get a buffer IFNSK. SETZM NTOB(PNCT) ; None there, unlock RET ENDIF. NOSKED ; Protect the cell MOVEM T1,NTOB(PNCT) ; Change -1 to extended packet buffer LOAD T2,NBPRO,(T1) ; Protocol code LOAD T3,PLNBZ,(T1) ; Length at local net level LOAD T1,PTPBZ,(T1) ; Length at transport level ADDI T1,3 ; Round up LSH T1,-2 ; Words ADD T1,PROOVH(T2) ; Protocol's overhead, words CALL GETBUF ;(T1,T2:T1) ; Try to get storage IFE. T1 ; Didn't get storage, discard packet MOVE T2,NTOB(PNCT) ; Get output buffer back MOVX T1,PLNXO ; Packet not transmitted IORM T1,PKTFLG(T2) MOVX T1,PT%KOL ; Packet dropped ELSE. ; Got storage in T1 MOVEM T1,NTIB(PNCT) ; Save buffer pointer MOVE T4,T1 ; Input buffer gets data from MOVE T2,NTOB(PNCT) ; Output buffer LOAD T3,NBNCT,(T2) ; Copy NCT STOR T3,NBNCT,(T4) MOVE T3,TODCLK STOR T3,PLNDB,(T2) ; Began output STOR T3,PLNQD,(T4) ; Queued for input STOR T3,PLNDB,(T4) ; Beginning input LOAD T1,PTPBZ,(T2) ; Length at transport level (output) STOR T1,PTPBZ,(T4) ; Length at transport level (input) MOVX T3,MAXLDR HLRZ CX,PNCT ; Logical NCT has local leader info SUB T3,NTHDRL(CX) ; Words in local leader PUSH P,T3 ; Save local leader length, words LSH T3,2 ; Bytes in local leader ADD T1,T3 STOR T1,PLNBZ,(T4) ; Length of local net level leader ADDI T1,3 ; Round up LSH T1,-2 ; Words to copy LOAD T3,NBPRO,(T4) ; Prorocol code MOVE T3,PROOVH(T3) ; "Fixed point" in new packet ADD T3,T4 ; Address for transport level leader STOR T3,PTPDT,(T4) ; Address of transport level leader SUB T3,(P) ; Less local leader words STOR T3,PLNDT,(T4) ; Address of local net level leader PNTLDR T2,PTPDT,(T2) ; Address of transport level leader SUB T2,(P) ; Source address POP P,(P) ; Drop local leader words CALL XBLTA ; Transfer local leader plus data ;Use special entrance into MNTEIN to avoid clobbering the NBNCT field ;setup above. SETZ T2, EXCH T2,NTIB(PNCT) ; Get buffer CALL MNTEI0 ; Do end of input on new packet MOVX T1,PT%SLN ; Packet sent over local net ENDIF. MNTCALL NTODUN ; End of output on old SETZM NTOB(PNCT) ; Can now do more buffers OKSKED ; Allow scheduling again CALLRET MNOSRT ; Restart output SUBTTL Miscellaneous Multinet Functions ;Routines called to perform protocol dependent operations MNTCZF:: ; Fork-relative close by protocol PUSH P,CX ; Save CX just in case MOVEI CX,PROCZF ; Table to be used JRST MNTALL ; Go process all protocols MNTKFK:: ; Protocol dependent kill fork PUSH P,CX ; Save CX just in case MOVEI CX,PROKFK ; Table to be used JRST MNTALL ; Go process all protocols MNTKJB:: ; Protocol dependent kill job PUSH P,CX ; Save CX just in case MOVEI CX,PROKJB ; Table to be used JRST MNTALL ; Go process all protocols MNTALL: ; Common routine .LX==CX-1 ADJSP P,.LX+1 ; Save AC 0-<.LX> MOVEM .LX,(P) ; Save .LX HRRZI .LX,-.LX(P) ; For AC 0 BLT .LX,-1(P) ; Save them HRLI CX,-NP.MAX ; For all higher protocols DO. PUSH P,CX ; Save AOBJN counter PUSH P,(CX) ; Get routine address HRLZI CX,-.LX-2(P) ; For BLT CALL @(P) ; Call routine POP P,(P) ; Drop routine address POP P,CX ; AOBJN counter AOBJN CX,TOP. ; Do all protocols ENDDO. HRLZI .LX,-.LX(P) ; Saved AC 0 to 0 BLT .LX,.LX ; Restore all ADJSP P,-<.LX+1> ; Clear stack POP P,CX ; Restore CX RET PURGE .LX ;MNTHLT Tell all networks we are going away. Called twice at system ;shutdown time in system shutdown fork context. ;T1/ .lt. 0 System is (starting to) shutdown (first call), or ; .ge. 0 Reason for going down (last call) ;T2/ When back up ;Ret+1: Always. MNTHLT:: MNTM5< AOS CELL(MNTSB,^D11,,MNT)> ; MNTHLT called SAVEAC ; Save register TRVAR <> DMOVEM T1,MNTHLA ; Save args IFE REL6, ; enter section one MOVX T3,<1B1> ; +Infinity IORM T3,PNGTM ; Turn off pinging IFL. T1 ; First call MOVE T2,TODCLK ; Send out final monitoring information MOVEM T2,CELL(INMTM,0,,INM) AOS INTFLG ; Get internet fork do send it CALL DOMKIL ; Stop the domain system MOVX T1,^D1000 ; Wait a second for it to get going DISMS% RET ; Proceed with shutdown ENDIF. ; Final call, shut nets off MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get link to next NCT JUMPE VNCT,ENDLP. ; Zero ends the chain SETZM NETON(VNCT) ; Turn it off CALL LGTAD ; Get current time MOVEM T1,NTIDNT(VNCT) ; Save as when it was turned off DMOVE T1,MNTHLA ; Get args MNTCALL NTPKIL ; Tell protocol to go away SKIPE NTPHY(VNCT) ; Have hardware? LOOP. ; No, on to next DMOVE T1,MNTHLA ; Get args MNTCALL NTHKIL ; Tell hardware to go away NOP LOOP. ENDDO. CALL MNTWAK ; Wake up the hardware fork to print messages SKIPN MNTRAC ; Tracing? IFSKP. ; Yes SETZM MNTRAC ; Shut it off MOVX T1,1B0 IORM T1,MNTFLG+1 ; Get last in-core buffer written out ENDIF. MOVX T1,^D2000 ; Wait two seconds DISMS% RET ;MNTRED Read a network status. ;T1/ Network number, or host address ;T2/ Value: Possible values are: -1 = on, 0,,-1 cycle, 0 = off ;Ret+1: Always, T1/ MNTX00 if ok, or error code MNTRED:: ; Routine to return network state MNTM5< AOS CELL(MNTSB,^D12,,MNT)> ; MNTRED called SAVEAC ; Save trashed ac TXNN T1,IA%NET ; If Internet address, net byte not 0 IFSKP. ; Given host address NETNUM T1,T1 ENDIF. SETZ T2, ; Assume net is down CALL NETNCT ; Get the NCT IFSKP. ; Have NCT MOVE T2,NETON(VNCT) ; Get the state MOVX T1,MNTX00 ; Ok ELSE. MOVX T1,MNTX13 ; Invalid host or network specified ENDIF. RET ;MNTSET Set a network status. ;T1/ Network number, or host address ;T2/ Value: Possible values are: -1 = on, 0,,-1 cycle, 0 = off MNTSET:: MNTM5< AOS CELL(MNTSB,^D13,,MNT)> ; MNTSET called SAVEAC TXNN T1,IA%NET ; If Internet address, net byte not 0 IFSKP. ; Given host address NETNUM T1,T1 ENDIF. CALL NETNCT ; Find the NCT IFSKP. ; Valid net IFN. T2 CAIE T2,-1 CAMN T2,[-1] ANSKP. MOVX T1,MNTX15 ; Invalid value ELSE. MOVEM T2,NETON(VNCT) ; Set function CALL LGTAD ; Get current time SKIPGE T2,NETON ; ON? MOVEM T1,NTIUPT(VNCT) ; Yes, when it was turned on SKIPL T2 ; OFF? MOVEM T1,NTIDNT(VNCT) ; Save as when it was turned off CALL MNTWAK ; Wake up the hardware fork MOVX T1,MNTX00 ; Ok ENDIF. ELSE. MOVX T1,MNTX13 ; Invalid host or network specified ENDIF. RET SUBTTL Multinet Utility Fork ;Unexpected interrupt trap MNTUTI: SE1ENT ; Make sure in section one MCENTR BUG.(CHK,MNTUX1,MNETDV,SOFT,,,< Cause: Something caused an interrupt, try to figure out what. To be safe, packet tracing will be disabled. >) SETZM MNTRAC JRST MNTUTM ; Recover processing RESCD ;ps For response only ;Multinet utility fork initialization MNTUTL: MOVX Q2,MNTUTI ; Illegal interrupt address CALL MNTFKI ; Setup high priority monitor fork MOVEM T1,MNTFRK+1 ; Remember FORKX MNTUTM: ; Join from unexpected interrupt DO. SETZM MNTFLG+1 ; Clear run request flag ;Check on packet tracing buffer MOVE T1,MNTPTB ; Beginning of in-core buffer MOVE T2,T1 ADD T2,MNTPTE ; End of in-core buffer ASH T2,-1 ; Half-full address SKIPN MNTRAC ; Tracing ON/OFF CAML T1,MNTPTC ; If tracing OFF and buffer isn't empty, or CAMG T2,MNTPTC ; If tracing ON and half-full, then CALL MNTPWR ; Write out packet tracing buffer MOVMS MNTFLG+1 ; Its written (may have been incremented) ;Check for a Host's Down on each interface MOVEI VNCT,NCTVT-$NTLNK ;Get Address of first NCT pointer (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ;Get next NCT JUMPE VNCT,ENDLP. ;Exit if no more interfaces SKIPN T1,NTHDWN(VNCT) ;A Host reported Down? IFSKP. ;Yes, so mark it that way PUSH P,T1 ;Save host address SETZM NTHDWN(VNCT) ;Clear the host address MOVE T2,NTLADR(VNCT) ;Reporting Entity ;cwl Should set "WHY" also MOVX T3,RTCRLN ;Credibility Level MOVE T4,TODCLK ;When reported down CALL HSTDWN ;Flag it down JFCL ;Already reported down POP P,T1 ;Recover host address CALL HSTHSH ;(T1:T2) ;Hash it ANSKP. ;Found it SKIPN T1,NTHDWI(VNCT) ;Get status word if any ANSKP. ;Have one SETZRO ,HSTSTS&777777(T2) IORM T1,HSTSTS&777777(T2) ;Set it ENDIF. LOOP. ;Do the next ENDDO. ; Check for .IPDOM requests (Must run under Job0 for JFNs) MOVE Q1,DOMSRV ; Want domains off? TXNN Q1,DMC%KL IFSKP. ; Yes CALL DOMKIL ; Turn domains off CAIN T1,MNTX00 ; Ok or TXNN Q1,DMC%IN ; Not want on? JRST MNTUT2 ; Yes, go update flags and error code ENDIF. TXNN Q1,DMC%IN ; Want domains on? IFSKP. ; Yes CALL DOMINI ; Turn domains on MNTUT2: ; T1/ Error code MOVX CX,DMC%KL+DMC%IN ; (Both) done ANDCAM CX,DOMSRV HRRM T1,DOMSRV ; Return error code (to .IPDOM) ENDIF. ;Other things MOVEI T1,MNTUTS ; Wait for something else to do MDISMS LOOP. ENDDO. ; /* Not Reached */ RESCD ;ps Scheduler test routine MNTUTS: SKIPL T1,MNTFLG+1 ; Less than zero is forced wakeup CAIL T1,1 ; Something to do? JRST 1(T4) ; Wake up JRST 0(T4) ; Not yet needed LMNETE: LIT SUBTTL Site Address Initialization Code SWAPCD ;ps ;All initialization code together so can be swapped out ;ADRINI ;Reads in the file SYSTEM:SITE-ADDRESS.TXT and builds the NCTs and ;initializes the interface tables from it. Called from MNTFRK at ;system startup, or .IPOPR. ;AC usage ;VNCT/ Virtual NCT associated with that address, if any ;P2/ Local address once read ;Ret+1: Always, T1/ MNTX00 if ok, or error code MNTX01 (file missing). ADRINI:: MNTM5< AOS CELL(MNTSB,2,,MNT)> ; Multinet ADRINI calls SAVEPQ ; Save registers clobbered MAXIDS==1_ ; Maximum number of ID keywords allowed TRVAR <,NONUM,NUMDEV,LSTNCT,NTHASH,,ERCT> SETZM ERCT ; No errors TMSG < [Initializing network interfaces]> HRROI T2,[ASCIZ /SYSTEM:SITE-ADDRESS.54/] ;[dmc] . MOVX T3,MNTX01 ; Error code CALL GTFIL IFNSK. HRROI T2,[ASCIZ /SYSTEM:INTERNET.ADDRESS/] CALL GTFIL ; Get the file RET ; Failed, T1 has error code TMSG < ... [Using SYSTEM:INTERNET.ADDRESS]> ENDIF. ;Lock down the host tables (1B0 - write/ing, 0 - free, RH is # readers) NOINT MOVEI T1,HTBLCK ; Point at the lock (in section 0) MOVX T2,1B0 ; Want to write host tables IORB T2,(T1) ; Tell all no more readers SKIPG NETSUP ; If initializing, or TRNN T2,-1 ; If no readers, go IFSKP. ; Have to wait HRLS T1 ; Word to be tested HRRI T1,DISRE ; Wait til RH is zero MDISMS ; Wait until writer is done ENDIF. MOVEI T1,NCTVT-$NTLNK ; Start of interface list MOVEM T1,LSTNCT SETZM NTHASH ; Hash codes start at 1 ;Turn off all interfaces DO. PUSH P,BHC ; Save a flag MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get the next JUMPE VNCT,ENDLP. ; End of list SKIPE NTRDY(VNCT) ; This interface still up? AOS (P) ; Yes, increment flag SETZM NETON(VNCT) ; Make sure it is taken down CALL LGTAD ; Get current time MOVEM T1,NTIDNT(VNCT) ; Save as when it was turned off LOOP. ; Loop through all ENDDO. POP P,T1 ; Get flag back JUMPE T1,ENDLP. ; None are up CALL MNTWAK ; Wake up hardware fork MOVEI T1,^D1000 ; Sleep a second DISMS% LOOP. ; Check again ENDDO. ;Clear NLHOST slots SETZ T1, ; Clear an index DO. SKIPN NLHOST(T1) ; Slot used? EXIT. ; No, end of list SETOM NLHOST(T1) ; Empty that slot AOJA T1,TOP. ; Loop ENDDO. ;Release all NCT storage SETZ VNCT, EXCH VNCT,NCTVT ; Get the start of the chain DO. JUMPE VNCT,ENDLP. ; All done MNTCALL NTPRMV ; Release Protocol resources SKIPE NTPHY(VNCT) IFSKP. ; Has hardware MNTCALL NTHRMV ; Release Hardware resources ENDIF. HRRZ T1,VNCT ; Address of block in T1 LOAD VNCT,NTLNK,(VNCT) ; Retrieve the next CALL RELRES ; Release this storage LOOP. ENDDO. SETZM LOGHST ; Disable logical host support MOVX CX, ; Get word 0 of IDTAB MOVEM CX,IDTAB ; And set it SETZM MNTFWT+2 ; Clear the unrest. forwarding table MOVE CX,[XWD MNTFWT+2,MNTFWT+3] ;... MOVE T4,MNTFWT+1 ; Number of words BLT CX,MNTFWT+2-1(T4) ; Clear all words ;*** ;Return here on a parsing error in the following ;*** SOS ERCT ; Correct for AOS below XMOVEI CX,. PUSH P,CX ; Set error return MOVEM P,SAVEDP ; Save stack fence AOS ERCT ; Count parsing error ;This is the main parsing loop - traversed once for each line in the file. ADRLP0: MOVE P,SAVEDP ; Restore stack fence CALL GBOL ; Start off a line (Set BOL) JRST ADRDUN ; Done with file ;Now read the interface hardware type SETZM NUMDEV ; Clear count of device numbers XMOVEI P2,DEVBLK ; Point to storage block CALL RDFLD ; Read in a field ; See if it is a command MOVEI T1,CMDNAM ; Point to type table (in STG) MOVX T2, ; Make a pointer TBLUK% ; Look it up IFNJE. ; If no JSYS error... ANDXE. T2,TL%NOM!TL%AMB ; Match? HRRZ T1,(T1) ; Yes, Get the dispatch address CALL (T1) ; Call the routine JRST ADRLP0 ; Get the next line ENDIF. ; Not a command, must be an interface type DO. ; While more device numbers MOVE T2,TERM ; Check last terminator CAIE T2,":" ; Start of a device number? EXIT. ; No, end of list MOVEI T3,^D8 ; Device numbers are octal CALL RDNUM ; Read in a number MOVEM T2,(P2) ; Save in the block AOS P2 ; Increment pointer and AOS NUMDEV ; Number of devices LOOP. ; Loop through all ENDDO. MOVEI T1,INTNAM ; Point to type table (in STG) MOVX T2, ; Make a pointer TBLUK% ; Look it up ERJMP ADRER1 ; Error TXNE T2,TL%NOM!TL%AMB ; Match? JRST ADRER1 ; No ;cwl extended HRRZ T1,(T1) ; Get the initialization vector JUMPE T1,ADRER4 ; No NCT in configuration CALL ININCT ; Initialize NCT (set NTDEV, NTHVEC, NTPSTS) ; Sets VNCT ;Keyword loop - traversed once for each keyword in the line ADGTYP: DO. ; While more modifying types MOVE T1,TERM ; Get the last terminator CAIE T1,";" ; Start of comment? CAIN T1,.CHCRT ; End of line? IFNSK. ; Yes, finish processing NCT MOVE T1,NTNLHM(VNCT) ; Get logical host mask CALL MSK2BP ; Make it a byte pointer IORI T1,T1 ; Dataum in T1 MOVEM T1,NTNLHB(VNCT) ; Save Net logical byte pointer JRST ADRLP0 ; Go to next line ENDIF. ;Here to read in a modifier CALL RDFLD ; Read in a token MOVEI T1,TYPNAM ; Point to type table (in STG) MOVX T2, ; Point to string TBLUK% ; Look it up in table TXNE T2,TL%NOM!TL%AMB ; Good name? JRST ADRER5 ; No HRRO T1,(T1) ; Get routine address, this section CALL (T1) ; Go to it LOOP. ENDDO. ;Here on end of file ADRDUN: ;Create the special loopback NCT MOVE T1,NTHASH ; Count the number of interfaces CAIL T1,IHSHSZ ; Can we handle that many? BUG.(HLT,TOMNYI,MNETDV,SOFT,,<>,< Cause: NCTs were built for more interfaces then the system was configured to handle (too many to fit in the lookup hash table). Action: Change the parameter IHSHSZ to be larger than the total number of interfaces (including virtual NCTs) that will be used. Data: The number of interfaces built. >) ;Enter the NCTs and addresses in the hash tables ; First clear the tables in case ADRINI has been called before. MOVE T1,[XWD NCTHSH,NCTHSH+1] SETZM NCTHSH BLT T1,NCTHSH+IHSHSZ-1 MOVE T1,[XWD NCTTBL,NCTTBL+1] SETZM NCTTBL BLT T1,NCTTBL+IHSHSZ-1 MOVE T1,[XWD ADRHSH,ADRHSH+1] SETZM ADRHSH BLT T1,ADRHSH+IHSHSZ-1 MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get the next in the list JUMPE VNCT,ENDLP. ; Done XMOVEI T2,ADRNET ; Worker functions SKIPLE T1,NTNET(VNCT) ; Any net number set? CALL HSHNET ; Hash into the tables XMOVEI T2,ADRADR ; Worker functions SKIPLE T1,NTLADR(VNCT) ; Any address set? CALL HSHADR ; Hash into the table LOOP. ; Loop through all NCTs ADRNET: IFIW!ADRNE0 IFIW!R ; shouldn't occur ADRNE0: MOVEM T1,NCTHSH(Q2) ; Reserve the table slot HRRZM VNCT,NCTTBL(Q2) ; Set the NCT MOVX CX,1B0 ; Mark it down for now IORM CX,NCTTBL(Q2) RET ADRADR: IFIW!ADRAD0 IFIW!R ; Shouldn't occur ADRAD0: MOVEM T1,ADRHSH(Q2) ; Set in the table RET ENDDO. ; Release the ID keyword storage HLLZ Q1,IDTAB ;Get actual number of ID keywords in table SKIPN Q1 ;Any? IFSKP. ;Yes, release them MOVNS Q1 ;Get -N,,0 HRRI Q1,1+IDTAB ;Get -N,,IDTAB+1 DO. HLRZ T1,(Q1) ;Get string address CALL RELRES ;Release it AOBJN Q1,TOP. ;Do next ENDDO. ENDIF. MOVEI T1,LUPNCT ; Where to store this NCT MOVEM T1,LSTNCT ; Fool ININCT MOVEI T1,LUPNCI ; Initialization vector for it CALL ININCT ; Create the NCT ; Sets VNCT MOVE T1,NTNLHM(VNCT) ; Get logical host mask CALL MSK2BP ; Make it a byte pointer IORI T1,T1 ; Dataum in T1 MOVEM T1,NTNLHB(VNCT) ; Save Net logical byte pointer MOVE P,SAVEDP ; Get stack fence back ADJSP P,-1 ; Clean up stack MOVX T1,1B0 ; Writer flag SKIPG NETSUP ; Unless initializing, ANDCAM T1,HTBLCK ; Writer done OKINT HRRZ T1,HTBJFN ; File to be closed CLOSF% ; Close the JFN NOP ; Don't worry if fails SKIPE T2,ERCT ; Any errors? IFSKP. ; No TMSG < [OK] > ELSE. TMSG < [> MOVX T1,.PRIOU MOVX T3,^D10 NOUT% ; Give error count JFCL TMSG < error(s)] > ENDIF. MOVX T1,MNTX00 ; Ok RET ; And return succesfully ;ININCT Initialize an NCT. Clobbers Q1 ;T1/ Initailization vector ; CALL ININCT ;VNCT/ Section 0 pointer to NCT ININCT: MOVE Q1,T1 ; Save initailization vector pointer LOAD T1,IVLEN,(Q1) ; Size of the NCT HRLI T1,.RESP3 ; Priority of free storage request MOVX T2,.RESGP ; From general pool CALL ASGRES ; Assign it JRST ADRER9 ; Failed TXNE T1,1B18 ; Bit 18 must be on for indexing TLNE T1,-1 BUG.(HLT,NCTSEC,MNETDV,SOFT, ) HRRZ VNCT,T1 ; Save the NCT address ;Initialize constant fields SETZM (VNCT) ; Zero the first word HRLS T1 ; Set up for a BLT AOS T1 ; X,,X+1 LOAD T2,IVLEN,(Q1) ; Size of the NCT ADD T2,VNCT ; Plus addres of top BLT T1,-1(T2) ; Zero the entire block MOVEI T1,377777 ; Plus infinity MOVEM T1,NTPSIZ(VNCT) ; Maximum packet size AOS T1,NTHASH ; Count up the hash codes. STOR T1,NTHSH,(VNCT) ; Save NCT unique code in NCT. SETOM NTLADR(VNCT) ; No local address SETOM NTNET(VNCT) ; No net number LOAD T1,IVLEN,(Q1) ; Size of this NCT MOVX T2,^D75 ; Microseconds per octet CAIL T1,NTORAT ; Physical NCT? MOVEM T2,NTORAT(PNCT) ; Yes, initialize estimated transmission rate ;Now init the NCT dependent constant fields LOAD Q2,IVINI,(Q1) ; Number of fields AOS Q1 ; Point to the first DO. JUMPE Q2,ENDLP. ; No more to do HLRZ T1,(Q1) ; Offset of this value ADD T1,VNCT ; Into the NCT HRRZ T2,(Q1) ; Address of value MOVE T2,(T2) ; Value itself MOVEM T2,(T1) ; Save in NCT AOS Q1 ; Point to next SOS Q2 ; Count down LOOP. ENDDO. MOVE T1,NUMDEV ; Number of devices MOVEI T2,DEVBLK ; Pointer to list CALL (Q1) ; Do the init routine JRST ADRERB ; Failed MOVE T1,NTNLHM(VNCT) ; Get logical host mask CALL MSK2BP ; Make it a byte pointer IORI T1,T1 ; Dataum in T1 MOVEM T1,NTNLHB(VNCT) ; Save Net logical byte pointer MOVE T1,LSTNCT ; Get the previous NCT STOR VNCT,NTLNK,(T1) ; Link this one to it MOVEM VNCT,LSTNCT ; Save this one RET SUBTTL Site Address Interface Modifier Processing Routines ; Network level protocols (set NTHDRL, NTPSIZ, NTPSTI, NTTYP, NTPVEC) ; ADPVEC Place NL.xxx, local leader adjustment, Protocol Vector address ; into NCT. ;T1/ Pointer to ASCIZ error message ;T2/ Protocol Vector address (or 0 if not in configuration) ;T3/ Local leader adjustment ;T4/ NL.xxx code ADPVEC:: TRNN T2,-1 ; Have protocol vector? JRST PERROT ; No, complain STOR T4,NTTYP,(VNCT) ; Set local network protocol type, NL.xxx MOVEM T3,NTHDRL(VNCT) ; Set local net protocol leader adjustment MOVEM T2,NTPVEC(VNCT) ; Set local net protocol vectors RET ; Protocol Suites, with interface addresses ; (set NTPRO, NTNET, NTLADR, NTNLHM, another NLHOST). ;ADLNPA ;Common code to insert higher level protocol code, local network net ;number, and local network interface address into NCT. ;T1/ Pointer to ASCIZ error message, or 0 if ok ;T2/ Protocol code (NP.xxx) ;T3/ Interface Address ;T4/ Network number ;P2/ Interface Address ADLNPA:: JUMPN T1,PERROT ; Leave if error STOR T2,NTPRO,(VNCT) ; Higher level protocol to NCT STOR T2,NA%PRO,+T4 ; Protocol into network number MOVEM T4,NTNET(VNCT) ; Set network number into NCT STOR T2,NA%PRO,+T3 ; Protocol into address MOVEM T3,NTLADR(VNCT) ; Set interface address into NCT MOVE P2,T3 ; Others want it here CALLRET GETERM ; Skip white & get next terminator ;Miscellaneous modifiers repeat 0,< ADDPRF: ; Here on PREFERRED keyword NETNUM T1,P2 ; Get the network number MOVEM T1,PRFNET ; Save as preferred network number MOVE T2,P2 ; Get number ANDX T2,-1B27 ; mask off network number (Class C) CAIG T1,177777 ; Class B or A? ANDX T2,-1B19 ; Mask for class B CAIG T1,377 ; Class A? ANDX T2,-1B11 ; yes, mask appropriately MOVEM T2,PRFNFD ; Set as preferred network field MOVEM P2,PRFADR ; Save as preferred address RET > ; end of repeat 0 ;PRIORITY keyword, next number is a priority from 0 to 63. ADPRIO:: MOVE T2,TERM ; Get token terminator CAIE T2,":" ; right? JRST ADRER6 ; no MOVX T3,^D10 ; Decimal CALL RDNUM ; read a number STOR T2,NTPRIO,(VNCT) ; Set the priority cell RET ;PACKET-SIZE keyword, next parameter is the maximum packet size for ;this interface, in decimal bytes. ADPSIZ:: MOVE T2,TERM ; Get token terminator CAIE T2,":" ; Proper? JRST ADRER6 ; No, error MOVX T3,^D10 ; Decimal CALL RDNUM ; Read a number MOVEM T2,NTPSIZ(VNCT) ; Set it RET ;LOGICAL-HOST-MASK keyword, next parameter is the 32-bit mask for this ;interface, in decimal bytes. ADLHM:: MOVE T2,TERM ; Get token terminator CAIE T2,":" ; Valid? JRST ADRER6 ; No ADJSP P,4 ; Save registers MOVEM FR,-3(P) DMOVEM 5,-2(P) MOVEM 7,(P) SETZ FR, ; No flags - GH%PRT MOVE T1,HTBJFN ; Input designator LOAD T2,NTPRO,(VNCT) ; This protocol suite MOVX 7, ; Reads a file CALL @PRONUM(T2) ; Read an address mask TDZA T1,T1 ; Error MOVEM 5,NTNLHM(VNCT) ; Save the mask MOVE FR,-3(P) ; Restore registers DMOVE 5,-2(P) MOVE 7,(P) ADJSP P,-4 JUMPE T1,ADRER6 ; Error CALLRET GETERM ; Update terminator ;Here on SET keyword. ;Format is: SET:PARAMETER[:] ; Default VALUE is 1 ; ; See the ADSRVL routine for the format of . ADSET:: MOVE T2,TERM ; Get the terminator CAIE T2,":" ; Valid? JRST ADRER6 ; Bad format CALL RDFLD ; Read in the keyword MOVEI T1,SETTAB ; Point to parameter table (in STG) MOVX T2,; Point to string TBLUK% ; Look it up in table TXNE T2,TL%NOM!TL%AMB ; Good name? JRST ADRER7 ; No PUSH P,T1 ; Save the table entry address MOVE T2,TERM ; Get the terminator CAIE T2,":" ; A colon means a value follows IFSKP. ; A value follows CALL ADSRV0 ; Read the value ELSE. MOVX T2,1 ; Default to 1 ENDIF. POP P,T1 ; Restore the table entry address HRRO T1,(T1) ; Get routine address, this section CALLRET (T1) ; Set the output rate STORAT:: SKIPE NTPHY(P1) ;Physical? JRST ADRERI ;No, error MOVEM T2,NTORAT(P1) ;Set the output rate RET ;MONITOR keyword. Format is: MONITOR:SYMBOL1[:SYMBOL2] ;SYMBOL1 is used as the block for the local net protocol monitoring cell, ;NTPSTI, in the NCT. If present SYMBOL2 is used for the local net hardware ;monitoring cell, NTPSTS. ADMNSZ==4 ADMON:: STKVAR <,, ,> SETZB T1,T2 DMOVEM T1,CNTBUF ; Init the values DMOVEM T1,2+CNTBUF DMOVEM T1,VALBUF DMOVEM T1,2+VALBUF MOVE T2,TERM ; Get the terminator CAIE T2,":" ; Valid? JRST ADRER6 ; No, bad format CALL RDFLD ; Read in the next field ; TMPBUF now holds ASCIZ of symbol name MOVE T2,TMPBUF ; Get the first characters MOVEM T2,SYBUF ; Save as first symbol MOVEI T4,1 ; Assume one symbol MOVE T2,TERM ; Get that terminator CAIE T2,":" ; Another? IFSKP. CALL RDFLD ; Read that one MOVE T2,TMPBUF ; Get its value MOVEM T2,1+SYBUF ; Save ADDI T2, ; "C" to "E" MOVEM T2,2+SYBUF ADDI T2, ; "E" to "G" MOVEM T2,3+SYBUF ADDI T4,3 ; Count other symbols ENDIF. MOVX T1,.IPRIP ;Read information MOVEI T2,STSBLK ;Address of the Status Block MOVX T3,.NTLNP+1 ;Length in words including length word MOVEM T3,.NTLEN(T2) MOVX T3,NT%SD!NT%SY!NT%SL ;Symbols, return LDB pointer MOVEM T3,.NTFLG(T2) ; and length MOVN T3,T4 ; - Number of symbols MOVSS T3 ; In LH HRRI T3,SYBUF ; Address of list in RH MOVEM T3,.NTNMP(T2) MOVEI T3,VALBUF ; Where to store value HRLI T3,-ADMNSZ ; Size MOVEM T3,.NTDTP(T2) MOVEI T3,CNTBUF ; And length MOVEM T3,.NTLNP(T2) IPOPR% ;Get the byte pointers and length ERJMP ADRER8 ; Give message ;This assumes that the symbol evaluates to a 36 bit byte pointer to start ;start of a data region (offset from STAT0). SKIPE T1,VALBUF ; Get a value? ADDI T1,STAT0 ; Offset it from STAT0 MOVN T2,CNTBUF ; Size of the region HRL T1,T2 ; -Size,,address MOVEM T1,NTPSTI(VNCT) ; Set basic statistics region SKIPN T1,1+VALBUF ; 2nd (if exists) RET ADDI T1,STAT0 MOVN T2,1+CNTBUF SUB T2,2+CNTBUF SUB T2,3+CNTBUF HRL T1,T2 MOVEM T1,NTPSTS(VNCT) ; Secondary statistics region RET ENDSV. ;ADIDKW Parses "ID:" field in the NCT, adds ID keyword for the ; NCT to the IDTAB ADIDKW:: ACVAR ; Check syntax MOVE T2,TERM ;Get the terminator CAIE T2,":" ;Was it ":" JRST ADRER6 ;No, give error ; Read the keyword, compute it's word length CALL RDFLD ;Read the ID keyword IDIVI T1,5 ;Get number of words this keyword ;occupies AOJ T1, ;Plus a word ; Assign free storage space for it and put it there HRLI T1,.RESP3 ;Priority of request,,# of words MOVX T2,.RESGP ;General pool CALL ASGRES ;Assign free storage space JRST ADRERD ;Failed TXNN T1,.LHALF ;In section 0? IFSKP. ;Nope, we loose CALL RELRES ;Release it JRST ADRERE ;Fail ENDIF. MOVE KEYWRD,T1 ;Save address of keyword HRLI T1,() ;Make a byte pointer to it MOVX T2, ;Get address of keyword DO. ;Byte transfer ILDB T3,T2 ;Get a source byte IDPB T3,T1 ;Put it in the destination JUMPN T3,TOP. ;Loop if not null ENDDO. ; Add the ID keyword and the NTHSH to the table MOVEI T1,IDTAB ;Get address if the ID table LOAD T2,NTHSH,(P1) ;Get Hash Link fot this NCT HRL T2,KEYWRD ;Get the address of the keyword TBADD% ;Add it to the table ERJMP ADRERF ;Woops... RET ;Done ENDAV. ;ADURFC Unrestricted-forwarding command. ; Format: UNRESTRICTED-FORWARDING:,[:,]... ; Defines that unrestricted forwarding exists from to ADURFC:: ACVAR ; Check syntax MOVE T2,TERM ;Get the terminator DO. CAIE T2,":" ;Was it ":" JRST ADRER6 ;No, give error ; Read CALL RDFLD ;Get the field MOVEI T1,IDTAB ;Point to ID table (a TRVAR) MOVX T2, ;Point to string TBLUK% ;Look it up in table ERJMP ADRERG ;Failed TXNE T2,TL%NOM!TL%AMB ;Good name? JRST ADRERG ;No HRRZ ID1,(T1) ;Yes, get the NTHSH code ; Separated by comma MOVE T2,TERM ;Get the terminator CAIE T2,"," ;Was it "," JRST ADRER6 ;No, give error ; Read CALL RDFLD ;Get the field MOVEI T1,IDTAB ;Point to ID table (a TRVAR) MOVX T2, ;Point to string TBLUK% ;Look it up in table ERJMP ADRERG ;Failed TXNE T2,TL%NOM!TL%AMB ;Good name? JRST ADRERG ;No HRRZ ID2,(T1) ;Yes, get the NTHSH code ; Set the bit in MNTFWT MOVE T1,ID1 ;Get the source hash code for ADJBP ADJBP T1,MNTFWT ;Point before the byte LDB T2,T1 ;Get the byte MOVX T3,1 ;Get a one bit LSH T3,(ID2) ;Put the bit in the right place TDO T2,T3 ;Turn the bit on DPB T2,T1 ;Put the modified byte back ;Do the next ID keyword pairs MOVE T2,TERM ;Get the terminator CAIE T2,.CHCRT ;End of line? CAIN T2,";" ;Start a comment? RET ;Yes, we are done LOOP. ;Loop ENDDO. RET ENDAV. ;ADSETC ; SET Command ; FORMAT: "SET:[,]..." ; Where is defined as: ; : ; or [+]: ; ; where is defined as: ; & ; or # ; or ADSETC:: ; Check syntax MOVE T2,TERM ;Get the terminator CAIE T2,":" ;Was it ":" JRST ADRER6 ;No, give error DO. CALL RDFLD ;Read the switch name MOVEI T1,SWTTAB ;Get address of Switch Table MOVX T2, ;Point to string TBLUK% ;Look it up in table ERJMP ADRERH ;Failed TXNE T2,TL%NOM!TL%AMB ;Good name? IFSKP. ;Yes CALL ADSSWT ;Parse the switch ELSE. ;Not a switch name, must be a symbol CALL ADSSYM ;Parse the symbol and optional offset ENDIF. ; Process next switch/symbol if any MOVE T2,TERM ;Get the terminator CAIE T2,.CHCRT ;End of line? CAIN T2,";" ;Start a comment? RET ;Yes, we are done CAIE T2,"," ;A comma? JRST ADRER6 ;No, sytax error LOOP. ;Loop ENDDO. ;Not reached ; Handle the SET command with a Switch Keyword ; Call: ; T1/ Address of the Switch Keyword entry in the SWTTAB ; CALL ADSSWT ; Returns: +1 always with the switch bits set to the value ADSSWT: ACVAR HRRZ IDWRD,(T1) ;Get the switch id word address: ; [SwitchAddress,,FlagAddress] CALL ADSRVL ;Read the value MOVE VALUE,T2 ;Save the value HRRZ T1,(IDWRD) ;Get FlagAddress MOVE T1,(T1) ;Get Flag CALL MSK2BP ;Get the Byte Pointer to the mask bit ;in the LH of T1 HLR T1,(IDWRD) ;Get SwitchAddress into the RH DPB VALUE,T1 ;Save the value away RET ENDAV. ; Read the value for the SET command ; Allows: & ; # ; ; Returns value in T2 ADSRVL: ; Check syntax MOVE T2,TERM ;Get the terminator CAIE T2,":" ;Was it ":" JRST ADRER6 ;No, give error ; Read the value ADSRV0: MOVX T3,"&" ;Proceeded by an ampersand? CALL RDNCH IFSKP. ;Yes, what follows is an Internet Address CALL RDHNUM ;Read host number MOVE T2,T1 ;Stick it in T2 RET ;Return ENDIF. MOVX T3,"#" ;Proceeded by a pound sign? CALL RDNCH SKIPA T3,[^D10] ;No, a decimal number follows MOVX T3,^D8 ;Yes, an octal number follows CALLRET RDNUM ;Read the number into T2, return ; Handle the SET command with a Symbol and optional offset ; Call: ; TMPBUF/ Contains the symbol plus optional offset ; CALL ADSSWT ; Returns: +1 always with the location set to the value ADSSYM: ACVAR STKVAR <,BYTPTR,LENGTH> SETZ OFFSET, ;Assume no offset SETZ SYMBOL, ;Clear the destination MOVX T1, ;Get byte pointer to the text MOVX T2, ;Place the symbol here MOVNI T3,5 ;Allow upto 5 characters DO. ILDB T4,T1 ;Get a byte CAIE T4,.CHNUL ;A null? CAIN T4,"+" ;OR plus sign? EXIT. ;Yes, exit SKIPGE T3 ;Did we fill the destination? IDPB T4,T2 ;No, Save the byte AOJA T3,TOP. ;Loop until we find a null or plus sign ENDDO. JUMPE SYMBOL,ADRERH ;If we did not get anything, error IFN. T4 ;Terminated by a plus sign? MOVX T3,^D10 ;Yes, read the offset NIN% ;As a decimal number ERJMP ADRERH ;Error MOVE OFFSET,T2 ;Save the offset LDB T2,T1 ;Get the terminator JUMPN T2,ADRERH ;If not a null, error JUMPL OFFSET,ADRERH ;No negative offsets ENDIF. MOVX T1,.IPRIP ;Read information MOVEI T2,STATBK ;Address of the Status Block MOVX T3,.NTLNP+1 ;Length in words including length word MOVEM T3,.NTLEN(T2) MOVX T3,NT%SD!NT%SY!NT%SL ;Symbols, return LDB pointer MOVEM T3,.NTFLG(T2) ; and length HRROI T3,SYMBOL ;-1,,Symbol MOVEM T3,.NTNMP(T2) HRROI T3,BYTPTR ;-1,,Byte Pointer destination MOVEM T3,.NTDTP(T2) MOVEI T3,LENGTH ;0,,Length destination MOVEM T3,.NTLNP(T2) IPOPR% ;Get the byte pointers and length ERJMP ADRERH ;Woops CAML OFFSET,LENGTH ;Offset must be less than the length JRST ADRERH ;Error MOVX T1,<4B17> TDNE T1,BYTPTR ;Must be indexed by 13, Not 14 JRST ADRERH ;No, error ;Now get the value CALL ADSRVL ;Read the value (T2) ADJBP OFFSET,BYTPTR ;Point to correct byte before changing P PUSH P,13 ;Save the index register MOVEI 13,STAT0 ;Get the STAT0 base address DPB T2,OFFSET ;Set the new value POP P,13 RET ENDSV. ENDAV. ;Error handlers NETFUL: BUG.(CHK,LHSTFL,MNETDV,SOFT,) PERROR ADRER0: PERROR ADRER1: PERROR ADRER3: PERROR ADRER4: PERROR ADRER5: PERROR ADRER6: PERROR ADRER7: PERROR ADRER8: PERROR ADRER9: PERROR ;ADRERA: PERROR
ADRERB: PERROR ADRERC: PERROR ADRERD: PERROR ADRERE: PERROR ADRERF: PERROR ADRERG: PERROR ADRERH: PERROR ADRERI: PERROR ;Initialization table for a VNCT, keyword VIRTUAL VIRNCT:: FLD(VNCTSZ,IVLEN)+FLD(0,IVINI) ;Init code starts here ;VNCT/ Extended Virtual NCT address ;LSTNCT/Extended address of the previous NCT MKVNCT: MOVEI T1,NCTVT-$NTLNK CAMN T1,LSTNCT ; Any NCT's inited yet? JRST ADRERC ; Bad if none there MOVE T1,LSTNCT ; T1 now holds physical one, or ; last virtual one on this physical LOAD T2,NTTYP,(T1) ; Same network type STOR T2,NTTYP,(VNCT) LOAD T2,NTDEV,(T1) ; Same device (sort of) STOR T2,NTDEV,(VNCT) MOVE T2,NTPVEC(T1) ; Same protocol vector MOVEM T2,NTPVEC(VNCT) MOVE T2,NTPSIZ(T1) ; Same packet size MOVEM T2,NTPSIZ(VNCT) SKIPE NTPHY(T1) ; Was last virtual? MOVE T1,NTPHY(T1) ; Yes, get the physical HRRZM T1,NTPHY(VNCT) ; Set physical NCT for this one RETSKP ; Return success ENDTV. SUBTTL Host Table Processing Routine ;HSTHSH Host address code to host table index. ;T1/ Host address, preserved ;Ret+1: T2/ available section,,index or -1 if no room ;Ret+2: T2/ section,,index HSTHSH:: MNTM5< AOS CELL(MNTSB,7,,MNT)> ; Multinet HSTHSH calls CAMN T1,[-1] ; Beware NLHOST not yet set MOVEI T1,1 ; Make it 'better' MOVE T2,T1 ; Do a hash IDIVI T2,NHOSTS ; Get initial guess, divide by prime EXCH T2,T3 ; T2/ first guess IDIVI T3,NHOSTS ; Divide by prime again CAIN T4,0 ; Get increment MOVEI T4,1 MOVEI T3,NHOSTS ; Counter for guesses HLL T2,[HOSTNN] ; Get section,,initial index DO. SKIPG HOSTNN&7777777(T2) ; Entry in use? RET ; No, T2/ available section,,index CAMN T1,HOSTNN&7777777(T2) ; Match? RETSKP ; Yes, found desired entry ADDI T2,(T4) ; No, step by increment CAML T2,[+NHOSTS] ; Check for overflow SUBI T2,NHOSTS ; Wrap around if needed SOJG T3,TOP. ; Count down guesses ENDDO. SETO T2, ; T2/-1 table full RET ; Return error COMMENT ! Host Tables Skip T2/hi = HSTHSH(T1/ NA%PRO+32-bit address code) | (No-skip if table full, T2 .lt.0) | HOSTNN (hi) NA%PRO+32-bit address code [NHOSTS]| | HSTSTS (hi) Entity status ;* If datum is no longer always updated [NHOSTS]| HS%UP==1B0 ; Entity is UP | HS%VAL==1B1 ; Status valid | HS%DAY==7B4 ;* Day when up if DOWN | HS%HR==37B9 ;* Hour | HS%MIN==17B13 ;* 5 min interval | HS%RSN==17B17 ;* Reason | HS%SRV==1B18 ;* Entity is SERVER | HS%USR==1B19 ;* Entity is USER | HS%NCK==1B20 ;* Entity name string is nickname (Obsolete | HS%STY==77B26 ; System type mask with multiple | .HS10X==1B26 ;TENEX .HSITS==2B26 ;ITS addresses) | .HSDEC==3B26 ;TOPS-10 .HSTIP==4B26 ;TIP | .HSMTP==5B26 ;MTIP .HSELF==6B26 ;ELF | .HSANT==7B26 ;ANTS .HSMLT==10B26 ;MULTICS | .HST20==11B26 ;TOPS-20 .HSUNX==12B26 ;UNIX | .HSNET==13B26 ;NETWORK (Obsolete, see HS%NET) | .HSFUZ==14B26 ;Fuzzball .HSTAC==15B26 ;TAC | HS%NEW==1B27 ;* Entity does new protocol (Obsolete, no old) | HS%NAM==1B28 ; Entity has name string | HS%SLF==1B29 ; Entity is local host alias | HS%NET==1B30 ; Entity is a NETWORK | HS%GAT==1B31 ; Entity is a GATEWAY | HOSTPN (hi) [Addr of HOSTN entry (or .eq. 0 if none)] [NHOSTS] | | < HOSTN ==> | +--------------------------+ < [NHOSTS*2] +->|Flags|Addr of HSTNAM entry|---+ "HSTNIC", "HSTNMP" +--------------------------+ | Updating variables | 0 |Addr of HSTNML entry|-+ | "HSTIDX" --------------------- +--------------------------+ | | NAMIDX sec,,adr free +-------------+ | NAMCNT # free entries | | | | < [NAMLST stack used] | +->HSTNAM ASCIZ /name/ NAMPTR sec,,adr free | [NHSTN] NAMSPC # free words | (4*NHOSTS) | < Address codes list +->HSTNML NA%PRO+32-bit address code [NUMLST stack used] [NHSTNL] ... NUMID0 sec,,adr first (2*NHOSTN) -1 NUMIDX sec,,adr free # free words ! ;HSTINI Initialize host tables. COMMENT \ Initialize the Host tables. Called at system startup (and possibly other times). Reads in system Hostname file and sets up the host tables from it. In order to save Section 0/1 space Host tables are put in MNTSEC. This is the new Internet host table parser. This is intended as a stopgap measure to allow TOPS-20's to use the Internet format host table until they can really take advantage of it. \ ;Ret+1: Always, T1/ MNTX00 if ok, or error code MNTX10 (file missing) HSTINI:: SAVEAC ; Save NCT register TRVAR MNTM5< AOS CELL(MNTSB,^D8,,MNT)> ; Multinet HSTINI calls TMSG < [Loading HOSTS.TXT host names]> NAMIDX==HTBLCK+1 ; Extended address of free entry in HOSTN NAMCNT==HTBLCK+2 ; # remaining free entries in HOSTN NAMPTR==HTBLCK+3 ; Extended address of free entry in HSTNAM NAMSPC==HTBLCK+4 ; # remaining free words in HSTNAM NUMIDX==HTBLCK+5 ; Extended address of free entry in HSTNML NUMSPC==HTBLCK+6 ; # remaining free words in HSTNML HRROI T2,[ASCIZ/SYSTEM:HOSTS.TXT/] ; Filename MOVX T3,MNTX10 ; Error code CALL GTFIL ; Try to get the file RET ; Failed, T1 has error code ;Lock down the host tables (1B0 - write/ing, 0 - free, RH is # readers) NOINT MOVEI T1,HTBLCK ; Point at the lock (in section 0) MOVX T2,1B0 ; Want to write host tables IORB T2,(T1) ; Tell all no more readers SKIPG NETSUP ; If initializing, or TRNN T2,-1 ; If no readers, go IFSKP. ; Have to wait HRLS T1 ; Word to be tested HRRI T1,DISRE ; Wait til RH is zero MDISMS ; Wait until writer is done ENDIF. MOVE T1,[HOSTN] ; Extended address of HOSTN table becomes MOVEM T1,NAMIDX ; Extended address of free slot in HOSTN MOVX T1,NHSTNL ; Number of possible entries in HOSTN MOVEM T1,NAMCNT ; Remaining free entries MOVE T1,[HSTNAM] ; Extended address of HSTNAM table becomes MOVEM T1,NAMPTR ; Extended address of free slot in HSTNAM MOVX T1,NHSTN ; Words in HSTNAM table MOVEM T1,NAMSPC ; Is remaining free words MOVE T1,[HSTNML] ; Extended address of HSTNML table becomes MOVEM T1,NUMIDX ; Extended address of free slot in HSTNML MOVX T1,NHSTNL ; Words in HSTNML table MOVEM T1,NUMSPC ; Is remaining free words ;Clear the current tables MOVE T1,[HOSTNN] SETZM 0(T1) ; Clear first word of the table MOVE T2,[XWD HOSTNN&777777,HOSTNN&777777+1] ; Get the BLT AC BLT T2,NHOSTS-1(T1) ; Zap MOVE T1,[HSTSTS] SETZM 0(T1) ; Clear first word of the table MOVE T2,[XWD HSTSTS&777777,HSTSTS&777777+1] ; Get the BLT AC BLT T2,NHOSTS-1(T1) ; Zap MOVE T1,[HOSTPN] SETZM 0(T1) ; Clear first word of the table MOVE T2,[XWD HOSTPN&777777,HOSTPN&777777+1] ; Get the BLT AC BLT T2,NHOSTS-1(T1) ; Zap MOVE T1,[HOSTN] SETZM 0(T1) ; Clear first word of the table MOVE T2,[XWD HOSTN&777777,HOSTN&777777+1] ; Get the BLT AC BLT T2,NHOSTS*HOSTNW-1(T1) ; Zap MOVE T1,[HSTNAM] SETZM 0(T1) ; Clear first word of name space MOVE T2,[XWD HSTNAM&777777,HSTNAM&777777+1] ; Get the BLT AC BLT T2,NHSTN-1(T1) ; Zap MOVE T1,[HSTNML] SETZM 0(T1) ; Clear first word of name space MOVE T2,[XWD HSTNML&777777,HSTNML&777777+1] ; Get the BLT AC BLT T2,NHSTNL-1(T1) ; Zap XMOVEI CX,HFILDN ; ABORT on parsing errors PUSH P,CX MOVEM P,SAVEDP ; Save a stack fence HSTIN6: ; Loop for processing entries MOVE P,SAVEDP ; Reset stack fence CALL GBOL ; Skip to start of next non-blank, ; Non-comment line @ first non-white JRST HFILDN ; +1 == EOF CALL RDFLD ; Read a value MOVE T1,TMPBUF ; Get first word SETZ T2, ; Zero means unknown type of entry CAMN T1,[ASCIZ/HOST/] ; Host? MOVX T2,HS%SRV ; Yes CAMN T1,[ASCIZ/NET/] ; Network? MOVX T2,HS%NET ; Yes CAMN T1,[ASCIZ/GATEW/] ; Gateway? MOVX T2,HS%GAT ; Yes JUMPE T2,HSTIN6 ; Flush if an unknown entry type MOVEM T2,ENTTYP ; Save entry type ;Should also check if it is a gateway, and if so place into routing tables MOVEM P,NUMLST ; Save pointer to numbers ;Read host addresses (assume all IP for now) MOVE T1,NUMIDX ; Start of this list MOVEM T1,NUMID0 ; Remember for later DO. CALL RDHNUM ; Read a host address MOVEM T1,@NUMIDX ; Save in the list SOSG NUMSPC ; Run out of number space? JRST HSTIE6 ; Yes, give error AOS NUMIDX CALL HSTHSH ; Hash it into the tables NOP ; Ignore skip return JUMPL T2,HSTIE2 TXO T1, ; All IP addresses from this file MOVEM T1,HOSTNN&777777(T2) ; Save the address code PUSH P,T2 ; Save the index MOVE T1,TERM ; Get field terminator CAIE T1,":" ; End? LOOP. ; No ENDDO. PUSH P,[-1] ; Flag end of list SETOM @NUMIDX ; Flag end of number list SOSG NUMSPC ; Run out of number space? JRST HSTIE6 ; Yes, give error AOS NUMIDX ; Increment pointer ;Sec,,index for all host's addresses in HOSTNN are on the stack followed by -1 ;Read host's names MOVEM P,NAMLST ; Start of name list (also the "prime name") DO. CALL RDFLD ; Read the next field JUMPE T1,HSTIE3 ADDI T1,1 ; Count the null terminator IDIVI T1,5 ; Convert char count to word count SKIPE T2 ; Round up if needed ADDI T1,1 CAMLE T1,NAMSPC ; Table full? JRST HSTIE4 ; Yes MOVN T2,T1 ADDM T2,NAMSPC ; Reduce remaining name space XMOVEI T2,TMPBUF ; Point to name read MOVE T3,NAMPTR ; Extended addredd of next empty slot in HSTNAM PUSH P,T3 ; Save this address in list ADDM T1,NAMPTR ; Extended address of next free HSTNAM slot CALL XBLTA ; Move the name into HSTNAM MOVE T1,TERM ; Get terminator CAIE T1,":" ; End of list? LOOP. ; No, back for next name ENDDO. PUSH P,[-1] ; Flag end of name list ;List of HSTNAM address for host's names also on stack followed by -1 MOVE T2,ENTTYP ; Get entry type CAME T2,[HS%SRV] ; Skip if a host entry IFSKP. ; Hosts have machine type:os:protocol CALL SKPFLD ; Skip machine type CALL RDFLD ; Read operating system SETZ T2, IFN. T1 MOVEI T1,OPSTAB ; Operating system type table (in STG) MOVX T2, ; Point to name TBLUK% ERJMP .+1 TXNE T2,TL%NOM!TL%AMB ; No match? TDZA T2,T2 ; Then no opsys HRRZ T2,(T1) ; Else get table value ENDIF. TXO T2,HS%SRV ; Restore server flag ENDIF. MOVEM T2,HSTS ; Save it ;Current status: ;HSTS contains the operating system type. ;NUMLST points to (the word before) a list of HOSTNN ext indices for this host. ;NUMID0 points to the start of the list of host addresses for host in HSTNML. ;NUMIDX points to the next available entry in HSTNML. ; ;NAMLST points to (the word before) a list of HSTNAM addresses for its names. ;NAMIDX extended address of the first free HOSTN entry. ;NAMCNT is the number of remaining unused HOSTN entries. ;HSTNAM contains the host's names, ;NAMPTR is the next free entry, ;NAMSPC is the number of remaining unused HSTNAM entries. MOVE T4,NAMIDX ; Extended address of free slot in HOSTN HRRZ T3,NUMLST ; Point to list of extended HOSTNN idicies DO. SKIPG T2,1(T3) ; Get next extended HOSTNN index EXIT. ; Done MOVEM T4,HOSTPN&777777(T2) ; Insert HOSTN address as primary name MOVE T1,HSTS ; Insert opsys type MOVEM T1,HSTSTS&777777(T2) AOJA T3,TOP. ; Loop through number list ENDDO. ; MOVE T4,NAMIDX ; Get extended address of free HOSTN entry HRRZ T2,NAMLST ; Get name list MOVE T1,NUMID0 ; Extended index of free slot in HSTNML DO. SKIPG T3,1(T2) ; Get extended address of next name for host EXIT. STOR T3,HSTNMP,(T4) ; Extended address of host name into HOSTN STOR T1,HSTIDX,(T4) ; Extended address of list of host addresses SETO T3, ; Nickname flag HRRZ CX,NAMLST ; Identify first host name CAME T2,CX ; This the first name? STOR T3,HSTNIC,(T4) ; No, flag as a nickname ADDI T4,HOSTNW ; Move to next free slot in HOSTN SOSG NAMCNT ; Count down total number of free HOSTN entries JRST HSTIE5 AOJA T2,TOP. ; Move to next name for host ENDDO. MOVEM T4,NAMIDX ; Save extended address of next free HOSTN slot JRST HSTIN6 ; Back for next host ;Routine to finish up HOSTS.TXT HFILDN: MOVE T1,NAMCNT ; Final free count less SUBI T1,NHSTNL ; Initial number of free HOSTN slots MOVEM T1,MHOSTS ; Is negative number of HOSTN entries MOVX T1,1B0 ; Writer flag SKIPG NETSUP ; Unless initializing, ANDCAM T1,HTBLCK ; Release the host table lock OKINT MOVE T1,HTBJFN ; Get back JFN CLOSF% ERJMP .+1 MOVE P,SAVEDP ; Get back stack fence ADJSP P,-1 ; Clean off error address TMSG < [OK] > MOVX T1,MNTX00 ; Ok. RET ENDTV. SUBTTL File Processing Support Routines ;GBOL ;Move to start of next line, skipping comments and white space. ;Ret+1: EOF reached ;Ret+2: BOL/ file pointer of start of this line GBOL: MOVE T1,HTBJFN ; Get JFN back DO. BIN% ; Read a byte ERJMP R ; End of file CAIE T2,.CHLFD ; EOL? LOOP. ; No ENDDO. RFPTR% ; Read file position ERJMP .+1 ; Shouldn't fail MOVEM T2,BOL ; Save start of this line DO. BIN% ; Read start of next line ERJMP R ; End of file CAIE T2,";" ; Comment or CAIN T2,.CHCRT ; Blank line? JRST GBOL ; Yes, skip line CAIE T2," " ; White space? CAIN T2,.CHTAB LOOP. ; Yes, skip character ENDDO. BKJFN% ; Back up ERJMP .+1 RETSKP ; Return success ;RDFLD ;Read next field. Terminated by a "," or ":" ;Ret+1: ;T1/ Number of characters read ;TERM/ Terminating character ;TMPBUF/Holds (null terminated) string RDFLD:: STKVAR SETZM COUNT ; Clear field length MOVX T1, ; Point to start of buffer MOVEM T1,PTR ; To store string SETZM TMPBUF ; First word of buffer must be zero MOVE T1,HTBJFN ; Get JFN ;Here at start of field DO. ; Skip white space BIN% ; Read a byte ERJMP PEOF CAIE T2,.CHTAB ; Tab or CAIN T2," " ; Blank? LOOP. ; Yes, skip ENDDO. ;Here after first non-white character DO. CAIE T2,":" ; End of field? CAIN T2,"," EXIT. ; Yes, done CAIE T2," " ; White space? CAIN T2,.CHTAB EXIT. ; Yes, done CAIN T2,.CHCRT ; EOL? EXIT. ; Yes, done CAIL T2,"a" ; Lower case? CAILE T2,"z" CAIA TRZ T2,40 ; Yes, capitalize it IDPB T2,PTR ; Save character AOS COUNT ; Count it BIN% ; Read the next ERJMP PEOF ; Premature end of file LOOP. ; Back for next character ENDDO. ;Here at field terminator DO. CAIE T2,"," ; Field terminator seen? CAIN T2,":" EXIT. ; Yes CAIE T2,.CHCRT ; End of line or CAIN T2,";" ; Start of comment EXIT. BIN% ; Skip trailing white space ERJMP PEOF LOOP. ENDDO. ;Here after field completely read MOVEM T2,TERM ; Save terminator SETZ T2, IDPB T2,PTR ; Null terminate the string MOVE T1,COUNT ; Get size of field RET ENDSV. ;SKPFLD ;Skip to next field (next ":"). SKPFLD: MOVE T1,HTBJFN DO. BIN% ; Read a byte ERJMP PEOF CAIN T2,":" ; Start of new field? RET ; Yes, done CAIN T2,.CHCRT ; End of line? JRST PEOLX ; Yes so error LOOP. ENDDO. ;RDHNUM Read an (IP format) host number. ;Returns address code in T1 RDHNUM:: STKVAR MOVEI T1,4 ; Number of fields MOVEM T1,COUNT SETZM HOST DO. MOVX T3,^D10 ; Number is decimal CALL RDNUM ; Read in a number EXCH T2,HOST ; Get last part LSH T2,^D8 ; Shift it ADDM T2,HOST ; Add to previous SOSLE COUNT LOOP. ; Loop until all read ENDDO. MOVE T1,HOST ; Get result RET ENDSV. ;RDNUM ;Read a number. T3 contains radix. ;Returns number in T2 RDNUM:: MOVE T1,HTBJFN ; Read from file NIN% ERJMP RDNUME ; Error SAVEAC BKJFN% ; Backup over terminator ERJMP .+1 GETERM: MOVE T1,HTBJFN ; Read from file DO. BIN% ; Read it in ERJMP ENDLP. ; Premauture EOF CAIE T2," " ; White space? CAIN T2,.CHTAB ; Including tab? LOOP. ; Yes ENDDO. CAIE T2,.CHLFD ; Get an LF? IFSKP. ; Yes, GBOL wants to see it too, so BKJFN% ; Backup ERJMP .+1 MOVX T2,.CHCRT ; Carriage return for those who don't ENDIF. ; check for LF MOVEM T2,TERM ; Remember terminator RET ;RDNCH ;Read the next character, if it matches the character in T3, skip-return, ;else, put the character back and return. ;In any case, the next character is returned in T2. RDNCH: MOVE T1,HTBJFN ; Read from the file BIN% ; Get the next character ERJMP PEOF CAMN T2,T3 ; Same as character in T3? RETSKP ; Yes, Skip return BKJFN% ; No, Put it back ERJMP .+1 RET ; Return ;Error handlers for HSTINI RDNUME: PERROR HSTIE2: PERROR HSTIE3: PERROR HSTIE4: PERROR HSTIE5: PERROR HSTIE6: PERROR RDHNE2: PERROR PEOF: PERROR PEOLX: PERROR ;PMARK ;Mark where error occured. PMARK: PUSH P,T1 ; Save AC1 MOVX T1,"^" ; A convenient character PBOUT% ; Write it out ERJMP .+1 POP P,T1 ; And restore it RET ; And back to caller ;PERROT Print out the erring line in the file. ;T1/ Error message ;HTBJFN/JFN of file PERROT:: PUSH P,T1 ; Save error string TMSG < > POP P,T1 ; Error string PSOUT% ; Print error message ERJMP .+1 TMSG < > MOVE T1,HTBJFN RFPTR% ; Read where we are ERJMP .+1 MOVEI T3,-1(T2) ; Save position BEFORE terminator MOVE T2,BOL ; Get BOL pointer CAIGE T3,(T2) ; Don't backup before BOL MOVE T3,T2 SFPTR% ; set back to beginning of line ERJMP .+1 DO. MOVE T1,HTBJFN RFPTR% ; Read where we are ERJMP .+1 CAMN T2,T3 ; Are we where error occured? CALL PMARK ; Yes, Mark it BIN% ERJMP .+2 ; SKIPA if EOF CAIN T2,.CHLFD ; End of line? EXIT. MOVE T1,T2 ; Get caharacter PBOUT% ; Type it out ERJMP .+1 LOOP. ENDDO. BKJFN% ; Backup over the line feed ERJMP .+1 ; so GBOL on next will work. ; Done with error line TMSG < > MOVE P,SAVEDP ; Get back stack fence RET ; Return when done ;GTFIL ;Get a JFN for a file, Used in HSTINI and ADRINI ;T2/ Pointer to file string ;T3/ Error code for T1 if fails ;Ret+1: File not found or not opened ;Ret+2: File opened ;HTBJFN/JFN GTFIL: MOVE T4,T2 ; Save file name SETZM HTBJFN ; Assume not found MOVX T1, ; Old file, short GTJFN% ; Get JFN IFSKP. MOVEM T1,HTBJFN ; Save JFN MOVX T2,7B5+OF%RD ; Open for reading OPENF% TRNA ; Failed, go release JFN RETSKP ; Succesful return MOVE T1,HTBJFN RLJFN% ERJMP .+1 ENDIF. ;Here if error getting or opening the file SKIPE HTBJFN ; File found? IFSKP. TMSG < GTJFN failed for > ELSE. TMSG < OPENF failed for > ENDIF. MOVE T1,T4 ; Write the file name PSOUT% ERJMP .+1 TMSG < > MOVE T1,T3 ; Error code to be returned RET SUBTTL DOMINI Domain Database Initialization ; The choices are pairs of files called DOMAIN:FLIP.DD and DOMAIN:FLOP.DD. ; The version to choose is the highest version number such that: ; both files exist and can be opened and at least one file is not dirty ; within such a set, select the newest update_date which is not dirty DOMINI:: MOVX T1,MNTX35 ; Assume failure HRRZ CX,JOBNO ; Must run in Job0 context for JFNs CAIE CX,0 RET ; Wrong job, return error CALL DOMKIL ; Make sure it is off MNTM5< AOS CELL(DOMCT,0,,MNT)> ; DOMINI calls HRROI T1,[ASCIZ / [Initializing domain database]/] PSOUT% ERJMP .+1 ACVAR ; FILVER may be two words SETZB FILVER,FILVR2 ; Default to highest version MOVSI DBASE,DOMSEC ; Use the domain section DO. ; Look through all generations MOVX T1,GJ%SHT+GJ%OLD ; Setup for GTJFN on first file HRR T1,FILVER ; Setup gen. for GTJFN for first file HRROI T2,[ ASCIZ /DOMAIN:FLIP.DD do not share this lit/] GTJFN% ERJMP TLOWER ; Try next lower version or die MOVE JFN1,T1 ; Remember JFN IFE. FILVER ; If first time, get generation number HRROI T1,FILVER ; JFNS to get version of file opened MOVE T2,JFN1 MOVX T3, JFNS% ERJMP REL1 HRROI T1,FILVER ; Do NIN to produce version MOVX T3,^D10 NIN% ERJMP REL1 ; Should never fail MOVE FILVER,T2 ; Remember file version SETZ FILVR2 ENDIF. MOVX T1,GJ%SHT+GJ%OLD ; Setup for GTJFN on first file HRR T1,FILVER ; Setup gen. for GTJFN for 2nd file HRROI T2,[ ASCIZ /DOMAIN:FLOP.DD do not share this lit/] GTJFN% ERJMP REL1 MOVE JFN2,T1 ; Remember second JFN MOVX T2,OF%RD+OF%WR+OF%THW ; Try to open JFN2 OPENF% ERJMP RELB MOVE T1,JFN1 ; Open JFN 1 OPENF% ERJMP CLO2 ; Now both are open, so see if they are any good. MOVE T1,JFN1 ; Check out FLIP.DD file CALL CDIRTY JUMPL T1,CLOB ; Reject set MOVEM T1,STS1 ; Time from first file MOVE T1,JFN2 ; Check out FLOP.DD file CALL CDIRTY JUMPL T1,CLOB ; Reject set CAMN T1,STS1 ; Both dirty? JUMPE T1,CLOB ; Yes CAMGE STS1,T1 ; Which is newer? EXCH JFN1,JFN2 ; Use FLOP EXIT. ; Found a pair ; Release resources so can try lower generation CLOB: MOVE T1,JFN1 ; If PMAP fails close and loop CLOSF% ERJMP .+1 CLO2: MOVE T1,JFN2 CLOSF% ERJMP .+1 RELB: MOVE T1,JFN2 ; On error, release both JFNs and loop RLJFN% ERJMP .+1 REL1: MOVE T1,JFN1 ; On error, release JFN1 and try again RLJFN% ERJMP .+1 TLOWER: AOS FILVR2 ; Count bad generations MNTM5< AOS CELL(DOMCT,2,,MNT)> ; DOMINI generations tried SOJG FILVER,TOP. ; Try next lower version MFATAL: SETZRO DMC%ON,+DOMSRV ; Say no such service MNTM5< AOS CELL(DOMCT,1,,MNT)> ; DOMINI failed HRROI T1,[ASCIZ / [DOMINI FAILED, no domain service.] /] PSOUT% ; Tell someone ERJMP .+1 MOVX T1,MNTX35 ; Error code RET ; Initialization failed ENDDO. MOVEI T1,FLIPFS ; Address for filespec ADD T1,[G1BPT MSEC1,7,0] ; In section 1 HRRZ T2,JFN1 ; FLIP.DD's JFN MOVX T3, JFNS% ; For others to see ERJMP .+1 TRNN FILVR2,-1 ; Using top generation? IFSKP. ; No HRROI T1,[ASCIZ / Warning: Top generation of DOMAIN:FLIP.DD and FLOP.DD are corrupted, using generation number /] PSOUT% ; No, tell someone ERJMP .+1 MOVX T1,.PRIOU MOVE T2,FILVER MOVX T3,^D10 NOUT% ; No, tell someone ERJMP .+1 HRROI T1,[ASCIZ /./] PSOUT% ; No, tell someone ERJMP .+1 ENDIF. ; Map JFN1 into sections DOMSEC and DM2SEC HRLZ T1,JFN1 ; JFN.0 CALL JFNOFN ; Get OFN on first section BUG. (HLT,DMIOF2,SOFT,MNETDV, ) MOVE T2,SHRPTR ; Virgin share pointer HLR T2,T1 ; To index page MOVEM T2,DOMSEC+MSECTB ; Make it a new section ptr HLL T2,INDPTR ; Indirect pointer, page 0 of file MOVEM T2,MMAP+> ; Map it into DOMIDX for scheduler test HRLZ T1,JFN1 ; Get this back for a sec HRRI T1,1000 ; JFN.2nd section CALL JFNOFN ; Get it BUG. (HLT,DMIOF3,SOFT,MNETDV, ) MOVE T2,SHRPTR ; Virgin share pointer HLR T2,T1 ; To index page MOVEM T2,DM2SEC+MSECTB ; Make it a new section ptr ; The database is now mapped in MOVEM JFN1,PRIJFN(DBASE) ; Save the JFNs for later release MOVEM JFN2,SECJFN(DBASE) MOVEM DBASE,MBASE(DBASE) ; CWL This what it is suppose to be? SKIPE JSYSIN(DBASE) ; Mark database as initialized AOS JSYSIN(DBASE) ; CWL What is this?? ; Now go clear all of the locks XMOVEI T1,SZONE(DBASE) ; Unlock search zone CALL BREAKZ SKIPN T1,CACHEP(DBASE) ; Unlock cache, if any IFSKP. ; Have a cache SKIPN ZONELO+EXCLUS(T1) ; Skip if cache was write-locked IFSKP. ; Was write locked, therfore dirty SETZM CACHEP(DBASE) ; Throw cache away ELSE. ; Was clean, so keep it but CALL BREAKZ ; Unlock it ENDIF. ENDIF. MOVE T4,SZONE+ZNODE(DBASE) ; Get top node of search zone XMOVEI T3,BZLIST ; Break locks in this zone list CALL WALKN ; Unlock all search blocks and set scheduler test cell address MOVE T1,SBLOOP(DBASE) ; Get address of first block XMOVEI T4,SKDTST(DBASE) ; Scheduler test cells DO. MOVEM T4,SBRSKD(T1) ; Set this block's test cell and SETZM (T4) ; Zero timeout SETOM SLOCK(T1) ; Break lock SETZM RCOMND(T1) ; Mark as not to be resolved MOVE T1,SBNEXT(T1) ; Get next CAME T1,SBLOOP(DBASE) AOJA T4,TOP. ; Back for next scheduler test cell ENDDO. SETONE ,+DOMSRV ; Signal all is ready HRROI T1,[ASCIZ / [Ok] /] TRNN FILVR2,-1 ; Using top generation? PSOUT% ; Yes, say ok ERJMP .+1 MOVX T1,MNTX00 ; Ok return RET ; Return after database initialized SUBTTL Subroutines ;T1/ JFN of open file ; CALL CDIRTY ;Ret+1: Always. ;T1/ .lt. 0 Reject set due to bad format, etc. ; 0 Dirty ; .gt. 0 Update time CDIRTY: MNTM5< AOS CELL(DOMCT,3,,MNT)> ; CDIRTY calls MOVX T2,<1,,.FBBYV> ; Page count MOVEI T3,T4 GTFDB% ERJMP CDIRTB ; Flush both LOAD T3,FB%PGC,+T4 ; Get number of pages CAILE T3,^D1024 ; Fit in two sections? IFSKP. ; Yes IFG , ; Check truncated file using FLPGCT(DBASE) ... ; Check for skew in MAKEDB and monitor using VERSUN(DBASE) ... HRLZS T1 ; JFN,,0 CALL JFNOFN ; Convert JFN to OFN,,PN IFNSK. ; Bad BUG. (CHK,DOMIOF,SOFT,MNETDV, ) JRST CDIRTB ENDIF. MOVE T2,[PM%RWX!DOMIDX] ; Where it goes CALL SETMPG ; Map it in SKIPG T1,UPDATE(T2) ; Get time of last update MOVX T1,1 ; (Update must be .gt. 0) PUSH P,T1 PUSH P,DIRTY(T2) ; Get dirty flag IFG ,< ; Only have one page mapped here PRINTX ? CDIRTY: SBLOOP is not in first page of database PUSH P,[12345,,0] ; Bad section and bad address > IFLE ,< PUSH P,SBLOOP(T2) ; For section check > SETZ T1, MOVX T2, CALL SETMPG ; Unmap it POP P,T3 ; Address of search block POP P,T2 ; Dirty flag POP P,T1 ; Time of last update HLRZ T4,T3 ; Get section of first search block CAIE T4,DOMSEC ; Make sure section is correct JRST CDIRSC ; Bad HRRZ T3,T3 ; Get section of first search block CAIL T3,SBARRA ; In proper region? CAIL T3,SBARRA+SERCH*MAXSB JRST CDIRAD ; Bad JUMPE T2,R ; Return if ok MNTM5< AOS CELL(DOMCT,5,,MNT)> ; CDIRTY found dirty file SETZ T1, ; Dirty, no time RET ; Errors worth telling CDIRAD: SKIPA T1,[-1,,[ASCIZ \ % DOMAIN:FLIP.DD/FLOP.DD format differs from monitor definitions.\]] CDIRSC: HRROI T1,[ASCIZ \ % DOMAIN:FLIP.DD/FLOP.DD use different section than assembled in the monitor.\] PSOUT% ; Complain ERJMP .+1 ENDIF. CDIRTB: SETO T1, ; Flush set MNTM5< AOS CELL(DOMCT,4,,MNT)> ; CDIRTY flushed a generation RET ENDAV. SUBTTL WALKN Walks a node tree ; On entry: ; T4 points to a node ; T3 points to routine to execute ; ; When routine specified by T3 is called, ; T2 points at node (routine may garbage T2) WALKN: MNTM5< AOS CELL(DOMCT,6,,MNT)> ; WALKN calls MOVE T2,T4 ; Call at root node CALL (T3) SKIPN T2,DOWNPT(T4) ; Skip if only one string of sons IFSKP. MOVE T4,T2 ; Setup node address CALLCH: DO. PUSH P,T4 ; Save node address CALL WALKN POP P,T4 SKIPE T4,SIDEPT(T4) ; Get next in list, skip if end LOOP. ENDDO. RET ENDIF. SKIPN T2,DOWNTB(T4) ; Have a down table? RET ; Return if no down table pointer XMOVEI T2,LABELH-1(T2) ; Get address of last table entry DO. PUSH P,T2 ; Save table address PUSH P,T4 ; Save starting point SKIPE T4,(T2) ; Get actual pointer CALL CALLCH ; Walk string if non-zero POP P,T4 ; Restore starting point POP P,T2 ; Restore table address CAMLE T2,DOWNTB(T4) ; Was it last one in table? SOJA T2,TOP. ; Back for next ENDDO. RET ; Return BZLIST: SKIPN T2,ZONEPT(T2) ; Get address of first zone in list RET ; Return if none DO. XMOVEI T1,ZONELO(T2) ; Get address of lock CALL BREAKL ; Break this zone's lock SKIPE T2,ZCHAIN(T2) ; Get address of next zone in list LOOP. ; Iterate if more ENDDO. RET ; Return, list complete ; DOMKIL is called to disable the domain system, either for a database ; reload or at system shutdown time. Note: not in usual context; must be Job0. ;Ret+1: Always, T1/ Error code DOMKIL: MOVX T1,MNTX00 ; Assume ok SKIPL DOMSRV ; Domains turned on? RET ; No, all done MOVX T1,MNTX35 ; Assume failure HRRZ CX,JOBNO ; Must run in Job0 context for JFNs CAIE CX,0 RET ; Wrong job, return error MNTM5< AOS CELL(DOMCT,7,,MNT)> ; DOMKIL calls HRROI T1,[ASCIZ / [Shutting domain service off]/] PSOUT% ERJMP .+1 ACVAR SETZRO ,+DOMSRV ; Turn off requests to GTHST%+resolver MOVE DBASE,[DOMSEC,,0] ; Locate the database NOINT ; Get exclusive lock on database XMOVEI T1,0-0(DBASE) ; Exclusive master lock jfcl; CALL ; Maybe this will not be needed if have write lock .... SETZ T1, ; Find timeout for active resolvers MOVE SBLOCK,SBLOOP(DBASE) ; A search block DO. SKIPE RCOMND(SBLOCK) ; Resolver busy here and SKIPG T3,@SBRSKD(SBLOCK) ; Have a timeout? TRNA ; No CAML T1,T3 ; This timeout later? TRNA ; No, or no timeout MOVE T1,T3 ; This one is later MOVE SBLOCK,SBNEXT(SBLOCK) ; On to next CAME SBLOCK,SBLOOP(DBASE) ; Back at start? LOOP. ; No, back for next ENDDO. SUB T1,TODCLK ADDI T1,^D200 ; Little fudge DISMS% ; Wait til all reolved SETZB JFN1,JFN2 EXCH JFN1,PRIJFN(DBASE) ; Get JFNs EXCH JFN2,SECJFN(DBASE) SETZM MMAP+> ; Unmap the page SETZM MSECTB+DOMSEC ; Remove database mapping SETZM MSECTB+DM2SEC ; Have to tell the mapping hardware to look again?? MOVEI T1,DOMIDX;CALL MONCLA OKINT ; Close the database files MOVX T3,MNTX00 ; Assume Ok SKIPLE T1,JFN1 ; Primary JSP T4,DOMKFL SKIPLE T1,JFN2 ; Secondary JSP T4,DOMKFL HRROI T1,[ASCIZ / [Ok] /] CAIE T3,MNTX00 ; All ok? HRROI T1,[ASCIZ / [DOMKIL Error /] PSOUT% ERJMP .+1 MOVE T1,T3 ; Return the error MNTM5< CAIE T1,MNTX00 > ; Count errors MNTM5< AOS CELL(DOMCT,10,,MNT)> ; DOMKIL error RET ; All gone ENDAV. DOMKFL: JUMPLE T1,(T4) ; Nothing to be closed (??) CLOSF% ; Close file ERJMP .+2 ; Error JRST (T4) ; All ok MOVE T3,T1 ; Set error code JRST (T4) ; Continue SUBTTL CVHST% ;.CVHST Convert host number to string. ; This should really be removed, since it duplicates a GTHST% function. ; Placed next to init code so more can be swapped out .CVHST:: MCENT STKVAR </4>>> ; Temp storage MNTM5< AOS CELL(MNTSB,1,,MNT)> ; Multinet CVHST% JSYSI MOVE Q1,T1 ; Output designator in T1 SKIPG T3,T2 ; Host number SETZ T3, ; -1 changed to 0 for local host MOVX T1,.GTHNS ; Number to string function MOVEI T2,HNBUF ; Where to store result HRLI T2,(POINT 7,0) ; String pointer GTHST% ; Use the newer JSYS IFSKP. XMOVEI P3,HNBUF ; Where to get result MOVE T1,Q1 ; Destination CALL GTHSOU ; Write to user JRST MRETNE ; Failed, pass up error UMOVEM T1,1 ; Update pointer JRST SKMRTN ; Return success ENDIF. MOVEI T1,CVHST1 ; Expected error code JRST MRETNE ENDSV. LMNETF: LIT SUBTTL JSYS Support Routines ;ATNVT% Attach connection to NVT. ;T1/ Receive JFN of opened network connection (JCN for BBN TCP) ;T2/ Send JFN of open network connection ; ATNVT% ;Ret+1: Cannot attach ;Ret+2: Ok. The JFN is released, AC 1 has line number of attached PTY. ;DEFAC (JFN,P2) ;DEFAC (DEV,P4) .ATNVT:: MCENT MNTM5< AOS CELL(MNTSB,0,,MNT)> ; Multinet ATNVT% JSYSI TXNE T1,AN%TCP ; Attach TCP Virtual Terminal? JRST TATNVT ; Yes, go to TCP code XCTU [HRRZ P2,1] ; JFN CALL CHKJFN ; Check JFN of receive connection RETERR(ATNX1) ; Bogus JFN RETERR(ATNX1) ; TTY RETERR(ATNX1) ; Byte pointer or NUL: ;; Only real JFNs are legal HRRZ T2,P4 ;DEV ; Check device CAIN T2,TCPDTB ; TCP? JRST TVTJFN ; Yes CAIN T2,CHADTB## ; Or Chaos? JRST CATNVT## REPEAT 0,< CAIN T2,PUPDTB## ; Or PUP? JRST PATNVT## ; > ERUNLK(ATNX10) ;no, "Send JFN is not a NET connection" SUBTTL GTHST% Jsys ;The GTHST% JSYS, Get information on a Host or Network. ; Input flags in AC1 which get set by user ..x==GH%ANY ; Match a host, gateway, or network ..x==GH%GWY ; Only match a gateway ..x==GH%NET ; Only match a network ; None of the above, only match a host ..x=GH%MOD ; Resolution mode ..x=.GHDEF ; Default, use resolver if required ..x=.GHLCL ; Local data only ..x=.GHNRF ; Resolver without referrals ..x=.GHRF ; Resolver with referrals ..x=GH%INI ; If resolution is needed, initiate it but fail immediately ..x=GH%MBA ; Answer must be authoritative ..x=GH%VIR ; Foreign queries should use tcp to avoid truncation ..x=GH%RRF ; Query name in domain format, not ASCIZ ..x=GH%CNM ; Rewrite query name ; Formatting/parsing flags ..x==GH%SNM ; Suppress printing host name ..x==GH%PSU ; Print protocol suite identifier ..x==GH%ADR ; Print host address (according to PROHST(protocol suite)) ..x==GH%PRT ; Print port (according to PROHST(protocol suite)) ..x==GH%SPC ; Append a space to the string ; Mask for all input flags DIFLAG==GH%ANY+GH%GWY+GH%NET+GH%MOD+GH%INI+GH%MBA+GH%VIR+GH%RRF DIFLAG==DIFLAG+GH%CNM+GH%SNM+GH%ADR+GH%PSU+GH%PRT+GH%SPC ; Status returned in AC1 LH ..x=GH%AKA ; Alias found ..x=GH%TRN ; Answer was truncated ; Internally flags are kept in FR; internal flags are CONLY==1B18 ; OUTCHR to count, not output DIGOK==1B19 ; Digit is ok as first character (.GTHRR IN-ADDR) HAVCV==1B20 ; Last character was a Control-V NEDNAM==1B21 ; Still need an ASCII name string NEDSPC==1B22 ; Need a space before next field NODOT==1B23 ; No leading dot in ASCII names output NULLOK==1B24 ; Is a null answer considered correct ? RELDNM==1B25 ; Relative domain name (ASCII didn't end in a ".") ;temp beg ghonly==1B26 ; Only use GTHST gdonly==1B27 ; Only use GTDOM usedht==1B28 ; Used the host tables ;temp end RHFLG==CONLY+DIGOK+HAVCV+NEDNAM+NEDSPC+NODOT+NULLOK+RELDNM rhflg==rhflg+ghonly+gdonly+usedht ; Domain name strings may include any alpha-numeric characters plus ; star, the "." which separates labels and the protocol suite identifier ; prefix, "#". Other charactes may be included if quoted using ; Control-V. Any other character terminates the string. ;.CHNUL==:000 ; Null terminates ASCIZ strings ;.CHCNV==:026 ; Quoting character in ASCII names - Control-V LABND=="." ; End of ASCIZ label PSUID=="#" ; Protocol suite prefix character in a label ; Build break mask for names. GTHFOK==1 ; Bit in field indicating break char GTHFLC==2 ; Bit in field indicating lower case GTHFIC==4 ; Bit in field indicating initial char ..FW==3 ; Field width ..FPW==^D36/..FW ; Fields per word DEFINE ..OKC(list,bit)> ; Drop bit from mask DEFINE ..RMVC(..lit,bit)<..val==..lit;; String to value ..OKV(..val,bit)> ; Value of ok character DEFINE ..OKV(..val,bit)<..of==..val/..FPW;; Calculate word offset ..fp==..val-..of*..FPW;; Calculate field position within word ..DRPB (\..of,bit)> ; Offset becomes a digit(s) DEFINE ..DRPB(arg,bit)<..W'ARG'.==..W'ARG'.!<B<..fp*..fw+..fw-1>>> ; Add bit(s) to mask ..W0.==<..W1.==<..W2.==<..W3.==<..W4.==<..W5.==<..W6.==<..W7.==0>>>>>>> ..W10.==<..W11.==<..W12.==<..W13.==<..W14.==0>>>> ..OKC(.-0123456789) ; Valid internal charaters ..OKC(*ABCDEFGHIJKLMNOPQRSTUVWXYZ,GTHFOK+GTHFIC) ; Valid (initial) characters ..OKC(abcdefghijklmnopqrstuvwxyz,GTHFOK+GTHFIC+GTHFLC) ; Valid l.c. & initial ..OKV(.CHCNV,GTHFOK+GTHFIC) ; Except these characters and values ..OKV(PSUID,GTHFOK+GTHFIC) GTHBPT: POINT ..FW,GTHBRK ; Pointer to character table GTHBRK: EXP ..W0.,..W1.,..W2.,..W3.,..W4.,..W5.,..W6. ; Table for ADJBP EXP ..W7.,..W10.,..W11.,..W12.,..W13.,..W14. ; On entry T1-T4 have user acs 1-4; they are saved in Q1 to P1. ; FR contains the working copy of the user's flags. ; During the transistion to the new doamin software the old host table ; code is still available (in lower case). There are three modes: ; the default is to use the domain code, but if it fails to revert to ; the host table version (note that the original user arguments are ; preserved in FCODE to +3; all updates to the user's registers happen ; at the very end). The second mode, invoked by the GTDOM% JSYS will ; not use the host table version but will return a failure. The third ; mode, invoked by setting 1B0 in AC1 on calls to GTHST%, will not try ; to use the doamin code; it can be forced if something goes wrong with ; the domain code, allowing things to continue using just the host tables. ;temp beg .gtdom:: mcent ; establsh monitor context txz t1,rhflg ; flush unwanted bits txz t1,1b0 txo t1,gdonly ; gtdom only jrst gthgtd ;temp end .GTHST:: MCENT ; Establsh MONITOR context TXZ T1,RHFLG ; Remove internal flags ;temp beg txze t1,1b0 ; 1b0 means gthst only txo t1,ghonly ; gthst only gthgtd: ;temp end MOVE FR,T1 ; Flags for all to use DMOVE Q1,T1 ; Save ACs DMOVE Q3,T3 MOVE P2,T1 ANDX P2,37 ; Function code SKIPL P2 ; Check range of function code CAIL P2,GTHMAX RETERR (ARGX02) ; Bad function code MNTM5< INHSTI(JGTHST,MNT,P2,T2,T3,1)> ; Histogram functions XCT GTHDSP(P2) ; Call function IFSKP. ; Ok, T2-4 should be returned to called XCTU [MOVEM T2,2] ; User ACs 2-4 back if ok XCTU [DMOVEM T3,3] JRST SKMRTN ; Return success ENDIF. ; Error, only return error code in T1 XCTU [MOVEM T1,1] ; Error code back if error JRST MRETNE ; Error ;Dispatch table GTHDSP: CALL GTHSIZ ;.GTHSZ ; (00) Get name table size CALL GTHIDX ;.GTHIX ; (01) Index into name space CALL GTDNUM ;.GTHNS ; (02) Convert number to string CALL GTDSTR ;.GTHSN ; (03) Convert string to number CALL GTHHNN ;.GTHHN ; (04) Status by number CALL GTHHNI ;.GTHHI ; (05) Status by index CALL GTHNHN ;.GTHNL ; (06) Get local number on a network CALL GTHNST ;.GTHNT ; (07) Get status table of a network CALL GTHRUT ;.GTHRT ; (10) Get first hop/route to a host CALL GTDGEN ;.GTHRR ; (11) Return Resource Record GTHMAX==.-GTHDSP ; Number of functions ; Table of function to be applied to each matching resource record GTHFCT: JFCL ;.GTHSZ ; (00) Get name table size JFCL ;.GTHIX ; (01) Index into name space RET ;.GTHNS ; (02) Convert number to string CALL GTDSTF ;.GTHSN ; (03) Convert string to number JFCL ;.GTHHN ; (04) Status by number JFCL ;.GTHHI ; (05) Status by index JFCL ;.GTHNL ; (06) Get local number on a network JFCL ;.GTHNT ; (07) Get status table of a network JFCL ;.GTHRT ; (10) Get first hop/route to a host CALL RTRNRR ;.GTHRR ; (11) Return Resource Record IFN .-GTHFCT-GTHMAX, ; First, the functions that do not need locks ... ;Function .GTHLN(6), get host address on a network. ;Q2/ Network number (also accept a host number on the net) ;Ret+1: If no interface on that network ;Ret+2: If we have one, T2 - Host address GTHNHN: MOVE T1,Q2 ; Get number CALL LCLHST ; Is it a local host? IFSKP. ; Yes MOVE T2,Q2 ; Preserve user's ac 2 DMOVE T3,Q3 ; Preserve user's ac 3 & 4 RETSKP ; Return success ENDIF. ; See if we have one on the same net LOAD T2,NA%PRO,+Q2 ; Get protocol code CALL @PRONET(T2) ; Host address to net number IFN P1-VNCT, MOVE P2,P1 ; Save register CALL NETNCT ;(T1:VNCT) ; Look for an NCT for that net IFSKP. ; Have one MOVE T2,NTLADR(VNCT) ; Get local host number on that net MOVE P1,P2 ; Restore register DMOVE T3,Q3 ; Preserve user's ac 3 & 4 RETSKP ; Return success ENDIF. MOVX T1,GTHSX4 ; Invalid network number RET ;Function .GTHNT(7), get status of a network. ;Q2/ Network number (also accept host number on the net) ;Q3/ Pointer to where to store data ;P1/ -Number of words,,offset of first ;Ret+1: If no such network or invalid offset ;Ret+2: If good arguments with data in table GTHNST: MOVE T1,Q2 ; Get number LOAD T2,NA%PRO,+Q2 ; Get protocol code CALL @PRONET(T2) ; Host address to net number IFN P1-VNCT, MOVE P2,P1 ; Save register CALL NETNCT ;(T1:VNCT) ; Look for an NCT for that net IFSKP. HLRE T1,P2 ; Get number entries wanted MOVMS T1 ; Magnitude IFG. T1 ; Must ask for at least one word ADDI T1,(P2) ; One more than maximum offset CAILE T1,^D8 ; Within range? ANSKP. MOVE T3,Q3 ; Where to return results DO. MOVE T1,@[GFIWM 0,NTRDY(VNCT) ; Actual status GFIWM 0,NETON(VNCT) ; Desired status GFIWM 0,NTSTCH(VNCT) ; Unreported change GFIWM 0,NTORDY(VNCT) ; Output enabled GFIWM 0,NTIUPT(VNCT) ; Internal up T&D GFIWM 0,NTXDNT(VNCT) ; External down T&D GFIWM 0,NTXUPP(VNCT) ; External up T&D GFIWM 0,NTIDNT(VNCT) ; Internal down T&D ](P2) ; Get desired word UMOVEM T1,(Q3) ; Store it AOS Q3 ; Increment destination pointer AOBJN P2,TOP. ; And loop through all desired ENDDO. MOVE T2,Q2 ; Preserve user's ac 2 MOVE P1,P2 ; Restore register DMOVE T3,Q3 ; Preserve user's ac 3 & 4 RETSKP ; Return success ENDIF. MOVX T1,ARGX17 ; Invalid argument block length RET ENDIF. MOVX T1,GTHSX4 ; Invalid network number RET ;Function .GTHRT(10), find current route (first-hop) to a host. ;Q1/ .GTHRT ;Q2/ Internet address ;Ret+1: If no current route to that host; T3/ Gateway to try, or 0 ;Ret+2: If there is a route; T3/ Internet address (may be same as T2) ;Don't call GWYLUK -- it adds the entry to the routing table. GTHRUT: MOVE T1,Q2 ; Save desired address TXZ T2,NA%FLG ; Do not add host address if not there CALL NETHSH ;T1 preserved ; Get hash number for host IFSKP. ; Found entry SKIPN T3,NETIFC-NETHTB(T2) ; Is entry valid? ANSKP. ; Valid host entry ELSE. ; No entry or entry not valid PUSH P,T1 ; Save given LOAD T2,NA%PRO,+T1 ; Get protocol code CALL @PRONET(T2) ; Extract network number MOVE T2,T1 ; Setup for NETHSH POP P,T1 ; Argument CAIN T1,T2 ; Try host last time? IFSKP. ; Yes, now try net TXZ T2,NA%FLG ; Do not add net number if not there CALL NETHSH ;T1 preserved ; Get hash number for net TRNA ; None in table SKIPN T3,NETIFC-NETHTB(T2) ; Valid entry? ANSKP. ; Yes ELSE. ; No, deleted or invalid, find gateway ;cwl this is IP'ish CALL FNDGWY ; Find a gateway MOVE T3,T1 UMOVEM T3,3 ; Return gateway that would be tried MOVX T1,GTHSX5 ; Route not known - would try gateway RET ENDIF. ENDIF. SKIPN T3,NETGWY-NETHTB(T2) ; Get entry is a local interface, MOVE T3,T1 ; Argument is first-hop destination MOVE T2,Q2 ; Preserve user's ac 2 MOVE T4,P1 ; Preserve user's ac 4 RETSKP ; Its the route ; Functions that require locking the host tables ... ;GTHLCK Lock the host tables (1B0 - write/ing, 0 - free, RH is # readers) ;Ret+1: Tables locked, leaves a call to the unlocking routine on the stack. GTHLCK: PUSH P,T1 ; Save all acs but CX MOVEI T1,HTBLCK ; Point at the lock (in section 0) DO. NOINT ; Don't risk leaving lock set. AOSL (T1) ; Want to read host tables IFSKP. SOS (T1) ; Cannot, it is being changed OKINT CALL DISGE ; Wait until writer is done LOOP. ; Try again ENDIF. ENDDO. POP P,T1 ; Restore ac POP P,CX ; Coroutine address CALL (CX) ; Continue TRNA ; Regular return AOS (P) ; Pass skip return along SOS HTBLCK ; One less reader OKINT RET ;Function .GTHSZ(0), return basic data (only local host address meaningful) GTHSIZ: MOVE T1,[XWD MSEC1,NLHOST] ; Point to list of local host addresses CALL FHPADR ; Find the highest priority one MOVE T4,T1 ; Return to user MOVSI T3,-NHOSTS ; Number of host slots HRLZ T2,MHOSTS ; -Length,,1st index RETSKP ;Function .GTHIX(1), index to string. ;This function is obsoelete and should be removed. GTHIDX: CALL GTHLCK ; Lock host tables for reading til return MOVN T2,MHOSTS ; Get number of host names in use HRRZ P2,Q3 ; Check range of host name index MOVX T1,GTJIX1 ; Assume Invalid index CAML P2,T2 ; Is it Ok? RET ; No IMULI P2,HOSTNW ; HOSTN entry index to offset ADD P2,[HOSTN] ; Extended address of entry LOAD T1,HSTIDX,(P2) ; Extended address of list of host's addresses CALL FHPADR ; Find the best address in the list MOVEM T1,Q3 ; Return it in AC3 CALL HSTHSH ; Look up the number NOP MOVE P1,HSTSTS&777777(T2) ; Get status word for AC4 LOAD P3,HSTNMP,(P2) ; Get extended address of host's name MOVE T1,Q2 ; Get caller's pointer CALL GTHSOU ; Write string RET ; Failed, pass up error MOVE T2,T1 ; Args to be returned DMOVE T3,Q3 RETSKP ;temp beg ;function .gthns(2), number to string only used if domains didn't initialize gthnum: call gthlck ; lock host tables for reading til return skipe t1,q3 ; number given in ac3? camn t1,[-1] ; old value for "local host" ifnsk. ; no, zero means local host movei t1,nlhost ; get pointer to our list of addresses call fhpadr ; find the best address in the list movem t1,q3 ; return host address in ac3 endif. call hsthsh ; look it up seto t2, ; not there ifl. t2 ; host address not in table movx t1,gthsx1 ; invalid host number ret endif. move p1,hststs&777777(t2) ; get host status for ac4 movx t1,gthsx3 ; assune no string for that host number skipg p2,hostpn&777777(t2) ; extended address of primary hostn entry ret load p3,hstnmp,(p2) ; get extended address of host's name move t1,q2 ; get caller's pointer call gthsou ; write string ret ; failed, pass up error move t2,t1 ; args to be returned dmove t3,q3 retskp ;temp end ;GTHSOU Write string to user space. ;(Note: this is also used by CVHST%) ;T1/ Dest in user space ;P3/ Extended monitor address for 1-word 7-bit global byte pointer ;Ret+1: T1/ error code from BOUT% ;Ret+2: T1/ Updated byte pointer GTHSOU: ADD P3,[G1BPT 0,7,0] ; Global 1 word 7-bit byte pointer MOVE T4,[XCTBU [IDPB T2,T1]] ; Assume user specified a string TLNN T1,777777 ; If JFN do the JSYS MOVE T4,[BOUT%] ; Not a string pointer TLC T1,777777 ; Check for LH - -1 TLCN T1,777777 HRLI T1,() ; Use standard pointer DO. ILDB T2,P3 ; Get next byte JUMPE T2,ENDLP. ; If a null, don't copy it (yet) XCT T4 ; Do right operation ERJMP GTHSOV LOOP. ; Loop ENDDO. CAMN T4,[BOUT%] ; Don't backup a JFN RETSKP ; Retrun now if a JFN XCT T4 ; Stick on NUL at end of string ERJMP GTHSOV BKJFN% ; Backup string pointer ERJMP GTHSOV RETSKP ; Skip Return GTHSOV: CAME T4,[BOUT%] ; JFN or Byte pointer? RETBAD(DESX1) ; BP, Invalid source/destination designator HRRZ T1,LSTERR ; JFN, return last error RET ;temp beg ;function .gthsn(3), convert string to number. ;called with q1-p1/ user acs 1-4: flags,,function code, source designator ;hstluk skips if string found with: q2/ updated pointer ; q3/ host number ; p1/ host status ;first, move string from caller's space (ac2) to monitor space (p3). ;must allow [.]- in strings. returns t1/ length gthstr: call gthlck ; lock host tables for reading til return stkvar </5>>> xmovei p3,gthsbf ; point to buffer add p3,[g1bpt 0,7,0] move t1,q2 ; get caller's pointer move t4,[xctbu [ildb t2,t1]] ; instruction if byte pointer tlnn t1,777777 ; if jfn do the jsys move t4,[bin%] ; instruction if jfn tlc t1,777777 ; check for lh = -1 tlcn t1,777777 hrli t1,() ; use standard pointer movx p5,maxlc ; up to 39 chars do. xct t4 ; do right operation erjmp .+1 sosg p5 ; decrement counter movx t2,.chnul ; after maxlc chars force null cail t2,"a" ; lower case? trz t2,40 ; yes, raise caig t2,40 ; end on space or less movx t2,.chnul ; terminating with null idpb t2,p3 ; stick it in destination string jumpg t2,top. ; loop if more to it enddo. bkjfn% ; backup to before termination erjmp .+1 ; (shouldn't fail) movem t1,q2 ; restore updated pointer movx t1,maxlc ; up to 39 chars sub t1,p5 ; # characters xmovei t2,gthsbf ; make byte pointer add t2,[g1bpt 0,7,0] call hstluk ; lookup name ifskp. move t2,q2 ; args to be returned retskp ; return success endif. movx t1,gthsx2 ; no number for that host name ret ;temp end ;Function .GTHHI(5), convert index to status. ;This function is obsolete and should be removed. GTHHNI: CALL GTHLCK ; Lock host tables for reading til return MOVN T2,MHOSTS ; Get number of host names in use HRRZ P2,Q3 ; Check range of host name index MOVX T1,GTJIX1 ; Assume Invalid index CAML P2,T2 ; Is it Ok? RET ; No IMULI P2,HOSTNW ; HOSTN entry index to offset ADD P2,[HOSTN] ; Extended address of entry LOAD T1,HSTIDX,(P2) ; Extended address of list of host's addresses CALL FHPADR ; Find the highest priority address in the list MOVE Q3,T1 ; Setup for GTHHNN ;Function .GTHHN(4), get status of a host given host number. TRNA ; Already locked GTHHNN: CALL GTHLCK ; Lock host tables for reading til return MOVE T1,Q3 ; Get host number CALL HSTHSH ; Convert number to index IFSKP. MOVE T4,HSTSTS&777777(T2) ; Get status word for AC4 DMOVE T2,Q2 ; Args to be returned RETSKP ; Return success ENDIF. ; Access name server here ... MOVX T1,GTHSX1 ; Unknown host number RET SUBTTL DSETUP Domain database access initialization ; Functions which use the domain database (.GTHNS, .GTHSN, and .GTHRR) ; are called with: ;FR/ Flags from AC1, internal flags cleared ;Q1-P1/ User acs ;P2/ Function code ; CALL FuncTable(T4) ;Ret+1: Error, T1/ error code to be returned to user ;Ret+2: Ok, T2-T4/ to be returned to user ; Their first instruction calls DSETUP to setup pointers to the database, ; a search block, etc. Since these routines may acquire locks, they must ; run NOINT. DSETUP leaves a call to the unlocking routine on the stack. ;Funct: CALL DSETUP ; ... ;BP/ Global byte pointer into SNAME entry of search block ;LABEL/ Points to (last) label entry in SBPS ;DBASE/ Points to domain database ;SBLOCK/Points to search block for this call ; SLOCK Locked, .gt. 0 ; FCODE User AC1-4 ; PSAVE P after acvar block has been created ; TQUERY Time of user JSYS, in sec since db creation (TZERO) ; rest cleared ; ... ;If ok/ T2-T4 have data to be returned to user; DERC is zero. ;If not/DERC has error code to be returned. ; RET ; to unlock, return args, etc DSETUP: POP P,T4 ; Coroutine address *** preserve MNTM5< AOS CELL(DOMSB,0,,MNT)> ; DSETUP calls MOVE CX,DOMPAR ; Domain parameters TXNE CX,DMS%ED ; Domain facilities enabled and SKIPL DOMSRV ; Domains initialized ok? IFNSK. ; No MOVX T1,GTDX6 ; Domain failure ;temp beg caie p2,.gthrr ; not return resource records and txne fr,gdonly ; allowed to use host tables? ifskp. ; yes cain p2,.gthns ; number to string? jrst gthnum ; yes, do it old way jrst gthstr ; no, must be string to number, old way endif. ;temp end RET ENDIF. MNTM5< AOS CELL(DOMSB,1,,MNT)> ; DSETUP trying ACVAR ; *** Beware changing ;T5-T8 have User's ACs HRLZI DBASE,DOMSEC ; Setup address of database NOINT ; Make sure nothing left locked ; Next task is to find and lock a search block in the shared domain ; section(s). The search blocks are chained in a circular list. The ; search starts at the block pointed to by SBLOOP in the master block. ; SBLOOP is updated so that these blocks are used in a quasi-fifo manner. MOVE SBLOCK,SBLOOP(DBASE) ; Get address of first search block DO. AOSN SLOCK(SBLOCK) ; See if we can lock this one EXIT. MOVE SBLOCK,SBNEXT(SBLOCK) ; Get next CAME SBLOCK,SBLOOP(DBASE) ; Skip if looped LOOP. ; Try next search block OKINT ; Let user break out of this ;cwl better MOVE T1,LCKTTL ; If tried all wait DISMS% NOINT ; No interrupts MOVE CX,DOMPAR ; Domain parameters TXNE CX,DMS%ED ; Domain facilities enabled and SKIPL DOMSRV ; Domains initialized ok? TRNA LOOP. ; Try again MNTM5< AOS CELL(DOMSB,2,,MNT)> ; DSETUP now off MOVX T1,GTDX6 ; Domain failure RET ENDDO. MOVE T1,SBNEXT(SBLOCK) ; Update sbloop MOVEM T1,SBLOOP(DBASE) ; No lock since it doesn't matter MOVX T1,SERCH-SBZF-1 ; Length to BLT in order to SETZM SBZF(SBLOCK) ; Zero out tail of search block XMOVEI T2,SBZF(SBLOCK) XMOVEI T3,SBZF+1(SBLOCK) EXTEND T1,[XBLT] ; Zero out block section MNTM5< MOVE T1,TODCLK > ; Record time MNTM5< PUSH P,T1 > ; Save state and user's arguments MOVEM P,PSAVE(SBLOCK) ; Save stack pointer for exit DMOVEM T5,FCODE(SBLOCK) ; User 1&2, save flags,,function, arg DMOVEM T5+2,FCODE+2(SBLOCK) ; User 3,4 MOVE FR,T5 ; Flags ANDX FR,DIFLAG ; Just user flags, no function code IFN , HRLZM T5-1+3,OUTCNT(SBLOCK) ; Max return count, if applicable MOVX T1,SBRCOR ; This is a co-resident request MOVEM T1,SRESTR(SBLOCK) XMOVEI LABEL,SBPS-1(SBLOCK) ; Setup address of last used pointer MOVE BP,[G1BPT 0,8,SNAME] ADD BP,SBLOCK ; Initialize TQUERY to absolute time at start of query CALL LGTAD ; Get current time of day SUB T1,TZERO(DBASE) ; Delta from database creation MULI T1,^D<24*60*60> ; Convert to seconds * 2 **18 ASHC T1,-^D18 ; Scale back to seconds MOVEM T2,TQUERY(SBLOCK) ; Set absolute reference time ; Now ready to go back to the function co-routine CALL (T4) ; Back to function *** T4 free NOP ; Just in case JRST DFINIS ; Function completed ; Error codes ;GTDX2 Referenced domain name does not exist ;GTDX3 Requested domain data not present at name ;GTDX4 Requested domain data not available ; Error aborts BADT1: TXO FR,GH%TRN ; Set truncated (input) flag BADA1: MOVX T1,GTDX1 ; "Invalid domain specification" TRNA BADOUT: MOVX T1,GTDX5 ; "Bad domain output specification" TRNA GTHITR: MOVX T1,GTDX6 ; "Domain system error" EFINIS: MOVEM T1,DERC(SBLOCK) ; Store domain error code MNTM5< AOS CELL(DOMSB,3,,MNT)> ; DSETUP Abort DFINIS: ; Finish up, returning either error code or updated flags to user CALL ULOCKA ; Unlock everything MOVE P,PSAVE(SBLOCK) ; Restore stack pointer to acvar MNTM5< MOVE T6,TODCLK > ; Measure time MNTM5< SUB T6,(P) > MNTM5< ADJSP P,-1 > MNTM5< MOVEI T5,CELL(DOMTM,0,,MNT) > ; Histogram MNTM5< CALL DOHIST > MOVE T1,FR ; Flag bits to go back HRR T1,FCODE(SBLOCK) ; Current flags, original function SKIPN CX,DERC(SBLOCK) ; Any errors detected? AOSA (P) ; No, skip return MOVE T1,CX ; Yes, return the error code UMOVEM T1,1 ; Return in register 1 MNTM5< TXNE T1,.ERBAS > ; Error? MNTM5< IFSKP. > ; No MNTM5< MOVE T5,ERTTL(SBLOCK) > ; Count of CNAME loops MNTM5< INHSTI (DOMCN,MNT,T5,T6,T8) > ; Histogram them MNTM5< ENDIF. > ;cwl GH%INI & resolver still going ... SETOM SLOCK(SBLOCK) ; Unlock the search block OKINT RET ; Undo acvar and back to JSYS DOHIST: AOS HSMPL(T5) ; Count number of samples IFG. T6 ADDM T6,HTOTL(T5) ; Accumulate total JFFO T6,.+1 ; Get log MOVNS T6+1 ; Want low first ADDI T6+1,^D36 ; Positive exp HLRE CX,HSQNB(T5) ; Squeeze factor ASH T6+1,(CX) HRRZ CX,HSQNB(T5) ; Number of bins CAIL T6+1,(CX) ; Fit into histogram or overflow bin? MOVEI T6+1,-1(CX) ; No, put in overflow bin ADD T5,T6+1 ; Address in histogram ENDIF. AOS HBIN0(T5) ; Count sample RET SUBTTL GTDNUM - Convert number to string ; BEFORE: AFTER: ;AC1/ .GTHNS ;AC2/ Destination byte pointer AC2/ Updated byte pointer ;AC3/ Host number ;AC4/ Host number (cont), port AC4/ Host status ;This function constructs a domain name for lookup from the address in AC3. ;An address of the form 1.2.3.4 is translated to 4.3.2.1.IN-ADDR.ARPA by ;the protocol suite dependent PROIAD routine. GTDNUM: CALL DSETUP ; Setup database context MOVEM LABEL,SBMAX(SBLOCK) ; SINDN might need it TXZ FR,GH%CNM ; Not supported here MNTM5< AOS CELL(DOMNS,0,,MNT)> ; GTDNUM functions SKIPE T1,FCODE+2(SBLOCK) ; Standard form network address given? CAMN T1,[-1] ; Old value for "local host" IFNSK. ; No, zero means local host MOVE T1,[XWD MSEC1,NLHOST] ; Get pointer to our list of addresses CALL FHPADR ; Find the best address in the list MOVEM T1,FCODE+2(SBLOCK) ; Save it ENDIF. MOVE T1,FCODE+1(SBLOCK) ; Get user's AC2 destination designator CALL SBOUTI ; Setup OUTINS/OUTBP(SBLOCK) SETZM OUTCNT(SBLOCK) ; Infinite count DMOVE T5,FCODE+2(SBLOCK) ; User's AC3,4 host address (PROIAD) LOAD T2,NA%PRO,+T5 ; Protocol suite (PROIAD) ;temp beg skipn t2 ; specified? movx t2,1;np.ip ; no, default to ip ;temp end CAILE T2,NP.MAX ; Legal value? MOVX T2,NP.GEN ; No, use default ; If a name isn't required, may skip doing inverse lookup SETZ T1, ; No error TXNE FR,GH%SNM ; Want name string? IFSKP. ; Yes, must do query MNTM5< AOS CELL(DOMNS,1,,MNT)> ; GTDNUM needs name TXO FR,NEDNAM ; Need a name or address ;temp beg movx t1,gtdx2 ; "Referenced domain name does not exist" txne fr,ghonly ; allowed to use domain data? anskp. ; yes ;temp end ; Have to do lookup, get address translated to inverse address string MOVE T1,BP ; SNAME byte pointer in T1 for PROIAD PUSH P,T2 ; Save protocol suite SETOB T3,T4 ; First time flag for PROIAD DO. MOVEM T1,1(LABEL) ; Starting pointer AOS LABEL ;1/ Destination byte pointer ;2/ NP.xxx protocol code ;3,4/ -1 on first call, should be changed to distinguish subsequent calls ;5,6/ Standard form network address ; CALL @PROIAD(T2) ;Ret+1: Another label is needed ;Ret+2: All labels completed MOVE T2,(P) CALL @PROIAD(T2) ; Get next label LOOP. ENDDO. POP P,T3 ; NP.xxx code ; Append origin from IAORG(class) ;temp beg ifn din-np.ip, cain t3,np.ip movx t3,din> ;temp end MOVEM T3,SCLASS(SBLOCK) ; Save query class IMULI T3, ; Size of IAORG dname strings ADD T3,[XWD DOMSEC,0] ADD T3,[G1BPT 0,8,IAORG] ;no domsec?? ADD T3,[G1BPT DOMSEC,8,IAORG] DO. ; Copy labels MOVEM T1,1(LABEL) ; Set up byte pointer ILDB T4,T3 ; Get length IDPB T4,T1 ; Store length byte JUMPE T4,ENDLP. ; Zero length means done DO. ; Copy characters in label ILDB T2,T3 IDPB T2,T1 ; Store byte of label SOJG T4,TOP. ; Loop till label copied ENDDO. AOJA LABEL,TOP. ; Increment label value ENDDO. MOVEM LABEL,SBMAX(SBLOCK) ; Identify pointer to last label CALL UCASES ; Make sure search name is upper case ; Inverse address label has been constructed, now do the lookup MOVX T1,.GHSTD ; Standard operation MOVEM T1,SOPERA(SBLOCK) ; Set operation IFN DPTR-.GHPTR,> MOVX T2,DPTR ; Looking for pointer (type) MOVEM T2,STYPE(SBLOCK) CALL DLOOK ; Go do lookup IFSKP. ; RRD has a PTR-type Resource Record RRD==T8; Pointer to a Resource Record MOVE T4,RDATA(RRD) ; Get address of first chunk MOVE T4,LITDAT(T4) ; Get address of dname PURGE RRD MOVE T1,OUTBP(SBLOCK) ; User's destination designator CALL DNDUMP ; Dump out domain name MOVEM T1,OUTBP(SBLOCK) ; Save updated destination designator TXZ FR,NEDNAM ; Name request satisfied TXO FR,NEDSPC ; Need a space before next field ;temp beg mntm5< txnn fr,gdonly > ; restricted? ;temp end MNTM5< AOS CELL(DOMNS,2,,MNT)> ; GTDNUM Dlook succeeded SETZ T1, ; Ok ELSE. ;temp beg txnn fr,gdonly ; restricted? ;temp end MNTM5< AOS CELL(DOMNS,3,,MNT)> ; GTDNUM Dlook failed MOVX T1,GTDX4 ; "Requested domain data not available" ENDIF. ; End of DLOOK win/lose ENDIF. ; End of no GH%SNM MOVEM T1,DERC(SBLOCK) ; Save error code CALL ULOCKA ; No longer need domain db locked ;temp beg ifn. t1 ; have answer? txne fr,gh%rrf+gdonly ; no, allowed to use ascii host tables? anskp. ; yes call gthlck ; lock host tables for reading til ret move t1,fcode+2(sblock) ; user's ac 3 host address call hsthsh ; look it up ifskp. ; host tables succeeded txo fr,usedht ; Had to use host tables move t1,hststs&777777(t2) ; get host status movem t1,sbhsts(sblock) mntm5< txnn fr,gdonly+ghonly > ; restricted? mntm5< aos cell(domns,7,,mnt)> ; gtdnum dom. failed, host tbl won movx t1,gthsx3 ; assune no string for that host number skipn t3,hostpn&777777(t2) ; ext. address of primary hostn entry anskp. move t1,outbp(sblock) ; get user's destination designator load t3,hstnmp,(t3) ; ext. adr of string add t3,[g1bpt 0,7,0] ; global byte pointer move inst,outins(sblock) ; Output instruction do. ildb t2,t3 ; get next byte jumpe t2,endlp. ; stop at null xct inst ; do right operation erjmp badout loop. ; loop enddo. movem t1,outbp(sblock) ; save user's destination designator txz fr,nednam ; have a name txo fr,nedspc ; need a space setz t1, ; no errors else. ; host tables failed setzm sbhsts(sblock) ; no name or status movx t1,gthsx1 ; invalid host number mntm5< txnn fr,gdonly+ghonly > ; restricted? mntm5< aos cell(domns,10,,mnt)> ; gtdnum both failed endif. movem t1,derc(sblock) ; set error code endif. ;temp end ; Return other fields in string - Protocol Suite, ASCII address, Port, Space MOVE T1,OUTBP(SBLOCK) ; Output designator (PROHST) DMOVE T5,FCODE+2(SBLOCK) ; Standard form host address & port MOVE INST,OUTINS(SBLOCK) ; Output instruction (PROHST) LOAD T4,NA%PRO,+T5 ; Protocol suite CAILE T4,NP.MAX ; Legal? MOVX T4,NP.GEN ; No, use default ; Process GH%PSU, optional Procotol Suite Identifier TXNN FR,GH%PSU ; Want protocol suite id IFSKP. ; Yes MNTM5< AOS CELL(DOMNS,4,,MNT)> ; GTDNUM w/PsuId MOVX T3,^D20 ; Allow full name TXNN FR,GH%RRF ; Resource Record format? IFSKP. ; Yes, have to give legnth byte MOVX T3,2 ; Just first 2 characters MOVE T2,T3 XCT INST ; Output number of characters ERJMP BADOUT ENDIF. ; ASCII - already have ".", if needed ; Copy the Protocol Suite ID MOVE BP,PRONAM(T4) ; Address of ASCIZ string ADD BP,[G1BPT 0,7,0] ; Point to it MOVX T2,PSUID ; # prefix DO. XCT INST ; Output character ERJMP BADOUT ILDB T2,BP ; Get next byte JUMPE T2,ENDLP. ; ends it SOJG T3,TOP. ; If more allowed, back for them ENDDO. TXNN FR,GH%RRF ; Resource record format? IFSKP. ; Yes SETZ T2, ; RRF ends with zero length label XCT INST ; End the name ERJMP BADOUT ENDIF. TXO FR,NEDSPC ; Need a separator before next field ENDIF. ; Of want PSU Id MNTM5< TXNE FR,GH%ADR > ; Want address? MNTM5< AOS CELL(DOMNS,5,,MNT)> ; GTDNUM w/ADR MNTM5< TXNE FR,GH%PRT > ; Want port? MNTM5< AOS CELL(DOMNS,6,,MNT)> ; GTDNUM w/Port TXNE FR,NEDNAM ; Name lookup win? TXO FR,GH%ADR ; No, force ASCII address string ; Process GH%ADR & GH%PRT TXNN FR,GH%ADR+GH%PRT ; Want address or port? IFSKP. ; Yes, need to call the PROHST routine MOVX T2," " ; May need a space TXZE FR,NEDSPC ; One needed? XCT INST ; Yes ERJMP BADOUT ;PROHST Routine to translate a standard form network address and optional ;port to ASCII ;0/ Flags, GH%ADR and GH%PRT ;1/ Destination designator ;2/ NP.xxx protocol suite code ;5,6/ Standard form host address & port ;7/ Output instruction for character in 2 ; CALL @PROHST(T2) ;Ret+1: Error ;Ret+2: Ok, ;1/ Updated destination designator MOVE T2,T4 ; NP.xxx left over from above CALL @PROHST(T2) ; Call protocol dependent routine JRST BADOUT ; Output error TXO FR,NEDSPC ; It must have output something ENDIF. MOVX T2," " TXNE FR,GH%SPC ; Want a trailing space? XCT INST ; Yes ERJMP BADOUT MOVEM T1,OUTBP(SBLOCK) ; Save destination designator CAMN INST,[BOUT%] ; JFN or byte pointer? IFSKP. ; Byte pointer, MOVX T2,.CHNUL XCT INST ; End string with a NUL ERJMP BADOUT ENDIF. ; Get host status MOVE T3,T5 ; User supplied address SETZ T4, CALL SETNCK ;(T3) ; Get host status in ac 4 MOVE T2,OUTBP(SBLOCK) ; Updated destination designator MOVE T3,T5 ; Host address RET ; T2-4 for User ; Back to DSETUP to unwind SUBTTL GTDSTR - Convert string to number ; BEFORE: AFTER: ;AC1/ .GTHSN ;AC2/ Source byte pointer AC2/ Updated byte pointer ; AC3/ Standard form host address ; AC4/ Host status or port GTDSTR: CALL DSETUP ; Set up database context MNTM5< AOS CELL(DOMSN,0,,MNT)> ; GTDSTR functions MOVX T1,.GHSTD ; Standard operation MOVEM T1,SOPERA(SBLOCK) ; Set operation SKIPN T2,DEFCLA ; System default class specified? MOVX T2,DIN ; No, default to INTERNET MOVEM T2,SCLASS(SBLOCK) ; Setup class MOVX T3,DA ; Type is address MOVEM T3,STYPE(SBLOCK) ; Setup type TXZ FR,GH%CNM+GH%SNM+GH%PSU ; Unsupported or set by SINDN CALL SINDN ; Get domain name set up ; It may change SCLASS JUMPN T1,R ; Error exit MNTM5< AOS CELL(DOMSN,1,,MNT)> ; GTDSTR parsed TXNE FR,GH%ADR ; Was an ASCII address specified? IFSKP. ; No ;temp beg movx t1,gtdx4 ; "Requested domain data not available" txne fr,ghonly ; use of domain allowed? anskp. ; yes ;temp end MNTM5< AOS CELL(DOMSN,2,,MNT)> ; GTDSTR need lookup MAXABL==^D10 ; Maximum number of addresses permitted TRVAR >> ; AOBJN pointer and block MOVX T1,<<-MAXABL,,0>> ; Make AOBJN counter MOVEM T1,ADRCT ; Save it CALL DLOOK ; Go do lookup, calling GTDSTF per RR IFSKP. ; Found one or more addresses XMOVEI T1,ADRBL ; Point to list HRRZ T2,ADRCT ; Number of entries ANDN. T2 ; Be safe (shouldn't have skipped if 0) ADD T2,T1 ; Next free slot SETOM (T2) ; End the list CALL FHPADR ;(T1) ; Get best address MOVE T3,T1 ; The best SETZ T4, ; cwl here the place to call it? CALL BLDSTS ; Build host status word from RRs SETZ T1, ; Have an address ;temp beg mntm5< txnn fr,gdonly > ; forced to use domains? mntm5< aos cell(domsn,5,,MNT)> ; gtdstr domain succeeded else. ; domain failed mntm5< txnn fr,gdonly > ; forced to use domains? mntm5< aos cell(domsn,6,,mnt)> ; gtdstr domain failed ;temp end ENDIF. ENDIF. MOVEM T1,DERC(SBLOCK) ; Set error code ;temp beg call ulocka ; no longer need domain db locks ;temp end ;temp beg ifn. t1 ; domain lookup failed txne fr,gdonly ; allowed to try host tables? anskp. ; yes move bp,sbps(sblock) ; pointer to name string movx t2,labnd ; end of label character (".") movx t1,-1 ; for total ascii length (one less .) do. ; put periods back ildb t4,bp ; get length jumpe t4,endlp. ; terminates labels addi t1,1(t4) ; dot plus label length dpb t2,bp ;***** ; put a dot between labels moves erttl(sblock) ;***** ; G1BPT & DBP & ADJBP microcode 326 bug ;***** ; need to touch memory between to work adjbp t4,bp ;***** ; point to next label's length move bp,t4 loop. enddo. move t2,sbps(sblock) ; point to first ascii character idpb t1,t2 ; set total length call gthlck ; lock host tables until ret skiple t1 ; no zero length names in tables call hstluk ;(fr,t1,t2) ; lookup in host tables ifskp. ; found txo fr,usedht ; had to use host tables mntm5< txnn fr,gdonly+ghonly > ; both tried? mntm5< aos cell(domsn,7,,mnt)> ; gtdstr, domain failed, hst table won setzb t1,t4 ; flush possible domain failure, status else. ; not found movx t1,gtdx2 ; "Referenced domain name does not exist" mntm5< txnn fr,gdonly+ghonly > ; both tried? mntm5< aos cell(domsn,10,,mnt)> ; gtdstr, both failed endif. movem t1,derc(sblock) ; save error code endif. ;temp end IFE. T1 ; Won, T3/address, T4/status, SBIPTR/srcdes MNTM5< AOS CELL(DOMSN,3,,MNT)> ; GTDSTR found address MOVE T2,SCLASS(SBLOCK) ; Class SBHSTS/optional port ;temp beg cain t2,din ; internet? movx t2,np.ip ; yes ;temp end STOR T2,NA%PRO,+T3 ; Insert protocol suite TXNN T3,NA%FLG ; Physical address may be 2 words TXNE FR,GH%PRT ; Port also uses AC4 TRNA ; User AC4 in use, omit status CALL SETNCK ;(T3) ; Get host status in ac 4 MOVE LABEL,SBMAX(SBLOCK) ; Last label MOVE T2,SBIPTR(SBLOCK) ; Updated input pointer TXNN FR,GH%PRT ; Parse a port? ANSKP. ; Yes IOR T4,SBHSTS(SBLOCK) ; IOR it in to possible phys. adr MNTM5< AOS CELL(DOMSN,4,,MNT)> ; GTDSTR w/port ENDIF. RET ; T2-4 for User ; Back to DSETUP to unwind ;GTDSTF ANCOPY function to extract address from resource record and add to list RRD==T8; Pointer to resource record ;RRD/ Pointer to A-type Resource Record ; Called from ANCOPY GTDSTF: MOVE T4,RDATA(RRD) ; Get address of Rdchunk MOVE T4,LITDAT(T4) ; Get address of Litchunk CALL BLDADR ; Build address form Litchunk data RET ; Error, ignore it SKIPL T2,ADRCT ; Room for another? RET ; No, ignore it XMOVEI T1,ADRBL ; Point to list ADDI T1,(T2) ; Index into list MOVEM T3,(T1) ; Insert next address AOBJN T2,.+1 ; Update the index MOVEM T2,ADRCT ; Save it AOS ANRET(SBLOCK) ; Count it RET PURGE RDD ENDTV. SUBTTL GTDGEN - General domain resolution request ; BEFORE: AFTER: ;AC1/ .GTHRR ;AC2/ Source byte pointer AC2/ Updated byte pointer ;AC3/ FLD(Oper,GH%OPR)+FLD(type,GH%TYP)+FLD(class,GH%CLA)+FLD(len,GH%LEN) ;AC4/ Destination byte pointer AC4/ Updated byte pointer GTDGEN: CALL DSETUP ; Set up database context MOVX T1,ARGX02 ; Invalid function LOAD T2,GH%OPR,+FCODE+2(SBLOCK) ; Requested function CAIE T2,.GHSTD ; Standard operation JRST EFINIS ; Others not yet supported MOVEM T2,SOPERA(SBLOCK) ; Set operation LOAD T2,GH%CLA,+FCODE+2(SBLOCK) ; Class MOVEM T2,SCLASS(SBLOCK) ; Setup class LOAD T3,GH%TYP,+FCODE+2(SBLOCK) ; Type MOVEM T3,STYPE(SBLOCK) ; Setup type MOVE T1,FCODE+3(SBLOCK) ; User's AC4 CALL SBOUTI ; Setup OUTINS/OUTBP(SBLOCK) LOAD T4,GH%LEN,+FCODE+2(SBLOCK) ; Original length is HRLZM T4,OUTCNT(SBLOCK) ; Initial output count (0 is infinite) TXO FR,DIGOK ; Digits ok as first character CALL SINDN ; Setup input name JUMPN T1,R ; Error exit TXO FR,NULLOK ; Nothing returned is ok CALL DLOOK ; Go do lookup NOP ; Failed is ok here (T1/ error) MOVE T3,FCODE+2(SBLOCK) ; Original args LOAD T2,GH%LEN,+T3 ; Original length HLRZ T4,OUTCNT(SBLOCK) ; Remaining SUB T2,T4 ; Used STOR T2,GH%LEN,+T3 ; Into user arg MOVE LABEL,SBMAX(SBLOCK) ; Find top label MOVE T2,SBIPTR(SBLOCK) ; User's updated source designator MOVE T4,OUTBP(SBLOCK) ; User's updated destination designator RET ; T2-4 for User ; Back to DSETUP to unwind SUBTTL SINDN Parse a generalized domain name string from user ;SINDN Gets a domain name into SNAME using the byte pointer specified by ;the user in AC2 (also parses optional Protocol Suite Id, ASCII address, ;port). ;The domain name is in domain name format if GH%RRF is set; ;otherwise ASCIZ is assumed ;Register usage: ;T1/ Source designator ;T2/ Input byte ;T3/ Temp ;T4/ Count of space remaining in dname ;T5/ Temp ;T6/ Temp ;INST Input instruction to get a byte in T2 ;T8/ Count of octets in label ;BP/ Byte pointer into dname in SNAME ;Abort: To BADA1 on read error ;Ret+1: Always, T1/ Error code SINDN: MOVE T1,FCODE+1(SBLOCK) ; Get source designator from user AC MOVE INST,[XCTBU [ILDB T2,T1]] ; Assume byte pointer TLNN T1,777777 ; If JFN do JSYS MOVE INST,[BIN%] TLC T1,777777 ; Check for LH=-1 TLCN T1,777777 HRLI T1,() ; Use standard pointer MOVEM T1,FCODE+1(SBLOCK) ; Save reformatted byte pointer MOVX T4,MAXDC ; Maximum characters in domain name MNTM5< AOS CELL(DOMST,0,,MNT)> ; SINDN calls MNTM5< TXNE FR,GH%RRF > MNTM5< AOS CELL(DOMST,1,,MNT)> ; Sindn w/RRF calls DO. (SINDNL) ; Next label MOVEM BP,1(LABEL) ; Save BP to start of next label MNTM5< AOS CELL(DOMST,2,,MNT)> ; Sindn lables TXNN FR,GH%RRF ; Domain name format or ASCII? IFSKP. ; Parse domain name format labels CALL SINOC ; Get and store length SKIPN T8,T2 ; Process a non-zero length label EXIT. ; Done, go update designator CALL SINCL ; Go check label length DO. ; Characters in label CALL SINOC ; Copy label character SOJN T8,TOP. ; Loop through label ENDDO. ELSE. ; Parse an ASCIZ label SETZB T8,T2 ; Zero count CALL SOUT1 ; Reserve space for length DO. ; Characters in label DO. ; Get (quoted) character XCT INST ; Get a character ERJMP BADA1 TXNE FR,HAVCV ; Last a Control-V? IFSKP. ; No, check character CAIE T2,.CHCNV ; This a Control-V? ANSKP. ; Yes TXO FR,HAVCV ; Remember it LOOP. ; Back for character being quoted ENDIF. ENDDO. ; Have a character TXZE FR,HAVCV ; Is this character quoted? IFSKP. ; No, look for ".", , and breaks CAIN T2,LABND ; Check for label termination EXIT. ; End of label MOVE CX,T2 ; Character ADJBP CX,GTHBPT ; Pointer to character in mask ILDB CX,CX ; Get field TXNE CX,GTHFLC ; Lower case? SUBI T2,"a"-"A" ; Yes, change to upper case TXNN CX,GTHFOK ; Break character? MOVX T2,.CHNUL ; Yes, treat it as a null SKIPN T8 ; If this is the first character, TXNE FR,DIGOK ; Checking? TRNA ; No, it is ok TXNE CX,GTHFIC ; First character invalid CAIN T2,.CHNUL ; Check for end of string EXIT. ; End of label ENDIF. CALL SOUT1 ; Copy into label AOJA T8,TOP. ; Increment count, back for next char ENDDO. ; End of copying a label ; End of ASCII label CALL SINCL ; Validate length MOVE T5,1(LABEL) ; Retrieve byte pointer IDPB T8,T5 ; Store length ANDE. T8 ; Length zero? (E.g., trailing ".") ; Yes, end of ASCII name, ended in dot XMOVEI CX,SBPS(SBLOCK) ; First label pointer's address CAML LABEL,CX ; Have anything to complete? CALL DNMCMP ; Yes, complete relative name EXIT. ; Yes, null label ENDIF. ; End of domain format or ASCII ; End of ASCII or RRF label AOS LABEL ; Finished another label CALL PSUCHK ;saves t1,t2 ; Check for protocol suite id ; May be another label TXNN FR,GH%RRF ; Resource record format must loop SKIPE T2 ; ASCII loops only on ".", not break LOOP. ; Back for next label ; End of ASCII name, didn't end in dot ENDDO. ; Processing all labels TXNN FR,GH%RRF ; ASCII format? BKJFN% ; Yes, backup source designator ERJMP .+1 MOVEM LABEL,SBMAX(SBLOCK) ; Save position of last label MOVEM T1,SBIPTR(SBLOCK) ; Save updated source designator SETZM SBHSTS(SBLOCK) ; No port ; Check if got anything XMOVEI T2,SBPS(SBLOCK) ; Address of pointer to first label CAMGE LABEL,T2 ; Get a name? TXO FR,GH%SNM ; No TXNE FR,NULLOK ; .GTHSN or .GTHRR? IFSKP. ; .GTHSN TXNN FR,GH%ADR+GH%PRT ; Giving address, port or CAMGE LABEL,T2 ; Did not get a name? ANNSK. ; True SKIPL T2,SCLASS(SBLOCK) ; Class CAILE T2,NP.MAX ; Valid? MOVX T2,NP.GEN ; No, use general MNTM5< AOS CELL(DOMST,6,,MNT)> ; PRONUM called ;PRONUM Try looking for an ASCII host address/port by protocol suite (class) ;0/ GTHST% Flags: GH%PRT set if a port should be parsed ;1/ Source designator ;2/ Protocol suite id (NP.xxx) ;7/ Instruction to execute to get next input character ; Call @PRONUM(T2) ;Ret+1: Failed, 1/ Updated source designator ;Ret+2: Succeeded, 0/ Updated flags: GH%PSU and/or GH%ADR set if parsed ; 1/ Updated source designator ; 5/ Standard format network addess ; 6/ Port if GH%PRT was set IFN INST-7, CALL @PRONUM(T2) ; Call routine for that protocol IFSKP. DMOVE T3,5 ; Address and optional port TXNE FR,GH%PRT ; Have a port? MOVEM T4,SBHSTS(SBLOCK) ; Yes, save it SETZ T2, ; Ok ELSE. MNTM5< AOS CELL(DOMST,7,,MNT)> ; PRONUM failed MOVX T2,GTDX1 ; Didn't succeed ENDIF. MOVEM T2,DERC(SBLOCK) ; Set error BKJFN% ; Backup source to last character ERJMP BADOUT MOVEM T1,SBIPTR(SBLOCK) ; Save updated source designator MOVE T1,T2 ; Possible error code to T1 ELSE. SETZ T1, ; No error ENDIF. RET ; Input subroutines SINOC: XCT INST ; Get a label character ERJMP BADA1 SOUT1: SOJL T4,BADA1 ; Error if more than max char total IDPB T2,BP RET ;cwl sbps uses maxdc/2 = 200, not 77 SINCL: CAILE T8,MAXLC ; Check that t8 is legal label length JRST BADA1 RET ;PSUCHK Look to see if last label was a protocol suite identifier/class ;(T1/ Source designator) ;BP/ Byte pointer into dname ;LABEL/ Pointer to label byte pointer of label just parsed ;SBLOCK/Pointer to search block ;Ret+1: Always, LABEL, etc. backed up if PSUID was just parsed ; Must save T1, T2 PSUCHK: MOVE T6,(LABEL) ; Byte pointer to label just parsed ILDB T5,T6 ; Length ILDB CX,T6 ; First character SOSLE T5 ; Be safe, length less PSUID CAIE CX,PSUID ; Protocol suite identifier? RET ; Zero length or not PSUID STR1==7;,10 ; Length/pointer to label just parsed IFN INST-7, IFN T8-10, IFN LABEL-12, NP.==13 ; Counter for possible protocol suites IFN SBLOCK-14, SAVET ; Need T1-6 for CMPSE SAVEAC ; Save some acs MOVEM T1,SBIPTR(SBLOCK) ; Save source designator for EFINIS MNTM5< AOS CELL(DOMST,4,,MNT)> ; PSUCHK checking DMOVE STR1,T5 ; Identifier length and byte pointer MOVX NP.,NP.MAX ; Loop through PRONAM DO. DMOVE T1,STR1 ; Length and pointer MOVE T1+3,STR1 ; Second string too SKIPN T1+4,PRONAM(NP.) ; Address of ASCIZ string IFSKP. ADD T1+4,[G1BPT 0,7,0] ; Make pointer to it EXTEND T1,[ CMPSE ; Compare strings 0 0] ANSKP. ; Found match, leave ELSE. ; Not this one SOJGE NP.,TOP. ; Back if more MNTM5< AOS CELL(DOMST,5,,MNT)> ; PSUCHK failure MOVX T1,GTDX1 ; Bad argument JRST EFINIS ; Get out quickly ENDIF. ENDDO. ; Label just parsed is a protocol suite id. Set SCLASS and flush the ; label from the search block. ;temp beg skipe np. cain np.,np.ip ; ip? movx np.,din ; yes, set interenet ;temp end MOVEM NP.,SCLASS(SBLOCK) ; Set proper class ; Backup over protocol suite id SETZB T2,BP ; Be clean EXCH BP,0(LABEL) ; Backup pointer into SNAME SUBI LABEL,1 ; Flush label MOVE T3,BP ; ASCII format IDPB T2,T3 ; Null over psuid length byte TXO FR,GH%PSU ; Parsed a Protocol Suite Id RET PURGE STR1,NP. ;DNMCMP Completion for relative Dname ;Called from SINDN, same register usage, must update LABEL, etc. ;as completion labels are added to SNAME. ;T8/ Label length ;BP/ Destination pointer into SNAME ;Must preserve T1, T2 DNMCMP: SAVET MNTM5< AOS CELL(DOMST,3,,MNT)> ; DNMCMP calls TXO FR,GH%AKA+RELDNM ; Relative domain name (no ending ".") MOVEI T1,LCLDNM ; Address of domain completion name ADD T1,[G1BPT MSEC1,8,0] ; Make byte pointer DO. ; Next label MOVEM BP,1(LABEL) ; Save BP to start of next label ILDB T2,T1 ; Get label length ERJMP GTHITR IDPB T2,BP ; Copy it ERJMP GTHITR SKIPN T8,T2 ; Process a non-zero length label EXIT. ; Done, go update designator CALL SINCL ; Go check label length DO. ; Characters in label ILDB T2,T1 ; Get label length ERJMP GTHITR IDPB T2,BP ; Copy it ERJMP GTHITR SOJN T8,TOP. ; Loop through label ENDDO. AOJA LABEL,TOP. ; Finished another label, back for next ENDDO. ; Processing all labels RET ;BLDADR Build a standard form network address from a LITDAT of an A type RR ;T4/ LITDAT of A record ; CALL BLDADR ;Ret+1: Error ;Ret+2: Ok, with ;T3,4/ Standard form network address BLDADR: SAVEAC MOVE T6,T4 ; Pointer to A type LITDAT SETZB T3,T4 ; For address LDB T5,[POINT 16,0(T6),15] ; # bytes in the address MOVE T1,T5 ; Save it CAILE T5,^D8 ; More than 64 bits is error RET ; Return zero on error MOVE BP,[POINT 8,(T6),15] ; Byte pointer to read address bytes MOVE T2,[POINT 8,T3,3] ; Byte pointer to move them to T3,4 DO. ; Build address ILDB CX,BP ; Get a byte IDPB CX,T2 ; Into standard form network address SOJG T5,TOP. ; Back for rest ENDDO. MOVE T5,SCLASS(SBLOCK) ; Protocol suite STOR T5,NA%PRO,+T3 ; Into standard form network address CAIG T1,4 ; Double word? RETSKP ; No, all set DMOVE T1,T3 ; Compress double word to single CALL ETHRAH ; Get standard 1-word value STOR T5,NA%PRO,+T1 ; Make sure protocol suite is set MOVE T3,T1 ; Return it in standard place SETZ T4, RETSKP BLDSTS: ret SUBTTL FSON tries to move down the tree by one label ;LABEL/ Points to byte pointer of search label ;NOD/ Points at node block ; CALL FSON ;Ret+1: Found son, NOD/ Points to node ;Ret+2: No son NOD==T6 ; Pointer to a node FSON: SKIPN DOWNTB(NOD) ; See if hash table available SKIPA NOD,DOWNPT(NOD) ; Get node list from pointer CALL HASHLS ; Get down pointer from hashing DO. ; Breadth of tree JUMPE NOD,RSKP ; Return failure if no node here PUSH P,NOD ; Save it, CMPS reformts byte pointers MOVE T1+1,(LABEL) ; Byte pointer of key ILDB T1,T1+1 ; Length of key MOVE T1+4,NODELA+LABPTR(NOD) ; Adress of ulabel ADD T1+4,[G1BPT 0,8,ULTEXT] ; One word extended pointer ILDB T1+3,T1+4 ; Length of candidate SUB T1,T1+3 ; Compute excess length of key PUSH P,T1 ; Result if match through shortest len SKIPGE T1 ; Skip if key is as long or longer LDB T1+3,T2 ; Use (shorter) key length MOVE T1,T1+3 ; Make lengths equal EXTEND T1,[ CMPSN ; Do string compare 0 0] IFSKP. ; Not match, see if must look further LDB T3,T1+1 ; Mismatching key character LDB T4,T1+4 ; Mismatching candidate character SUB T3,T4 ; Compare mismatching characters MOVEM T3,0(P) ; Return result below ENDIF. POP P,T3 ; Result of comparison POP P,NOD ; Get byte pointer back IFG. T3 ; If key is greater, must look further MOVE NOD,SIDEPT(NOD) ; Try next node LOOP. ENDIF. ENDDO. ; Matched or look far enough SKIPE T3 ; Zero t3 signals success AOS (P) ; If key is less search failed RET SUBTTL HASHLS picks up a hashed down table pointer ;LABEL/ Points to the search byte pointer ;NOD/ Points at the node block ; CALL HASHLS ;NOD/ Points at the head of the node list to search HASHLS: MOVE T1,(LABEL) ; Byte pointer of label to hash ILDB T3,T1 ; Get length byte for counting down MOVE T4,T3 ; Also include it in hash DO. (HLSLP) SOJL T3,ENDLP. ; Finish up if all bytes hashed ILDB T5,T1 ; Get a new even byte LSH T5,6 ; Shift it ADD T4,T5 ; Add it to sum SOJL T3,ENDLP. ; Finish up if all bytes hashed ILDB T5,T1 ; Get a new odd byte ADD T4,T5 ; Add it unshifted LOOP. ENDDO. IDIVI T4,LABELH ; Hash it ADD T5,DOWNTB(NOD) ; Add address of start of hash table MOVE NOD,(T5) ; Get chain head RET SUBTTL DLOOK routine looks up the query ;DBASE/ Pointer to database ;SBLOCK/ Pointer to search block, SBPS(SBLOCK) for last (highest) label ;SNAME(SBLOCK)/ Upper case domain format name ZON==T8 ; Pointer to a zone ; First step is to look up an authoritative zone, if any DLOOK: MNTM5< AOS CELL(DOMLK,0,,MNT)> ; DLOOK call/loop XMOVEI T1,SZONE(DBASE) ; Get address of search zone lock CALL ZLOCKS ; Get a sharable lock SETZM AZONE(SBLOCK) ; Set zone not found SETZM CDELN(SBLOCK) ; Forget data for last name MOVE LABEL,SBMAX(SBLOCK) ; Get max label value MOVE NOD,SZONE+ZNODE(DBASE) ; Get address of root node DO. (AZLOOP) ; Process next level SKIPN ZON,ZONEPT(NOD) ; Get pointer to zone IFSKP. MOVE T1,SCLASS(SBLOCK) ; Get search class DO. (AZTRY) ; Try zones at this level CAMN T1,ZCLASS(ZON) ; Try next if classes different SKIPN LOADED(ZON) ; Try next if not loaded IFSKP. ; Zone loaded and desired class MOVEM ZON,AZONE(SBLOCK) ; Remember this zone MOVEM LABEL,ALABEL(SBLOCK) ; And its label level ELSE. ; Not loaded or wrong class SKIPE ZON,ZCHAIN(ZON) ; Another to try at this level? LOOP. ; Yes, try next class ENDIF. ENDDO. ; Of AZTRY ENDIF. XMOVEI T1,SBPS-1(SBLOCK) ; Try next level down CAMG LABEL,T1 ; All labels matched ? IFSKP. ; Not yet CALL FSON ;(NOD) ; Try to find descendant SOJA LABEL,TOP. ; And loop if next label found ENDIF. ENDDO. ; Of AZLOOP PURGE ZON ;T8 ; If we get here either AZONE is zero, and there is no authoritative < ; zone to check, or AZONE=>zone block and alabel points to the last ; label in SNAME which corresponds to the last label of the SOA name SKIPE T1,AZONE(SBLOCK) ; Find an authoritative zone to try? CALL ZLOCKS ; Yes, lock it before XMOVEI T1,SZONE+ZONELO(DBASE) ; Unlocking the search zone CALL ULOCKS DELND==T8; Delegation node pointer SKIPN T1,AZONE(SBLOCK) ; Check again for authoritative zone IFSKP. ; Yes MNTM5< AOS CELL(DOMLK,1,,MNT)> ; DLOOK authoritative ; Next step is to descend though the rest of labels to see if node there ; or delegated MOVE NOD,ZSOA(T1) ; Get address of soa node MOVE LABEL,ALABEL(SBLOCK) SETZB DELND,ADELN(SBLOCK) ; Zero ns delegation node pointer DO. (ZSLOOP) MOVEM NOD,LMATCH(SBLOCK) ; Remember last match IFE. DELND ; No delegation SKIPE NODELC(NOD) ; Authoritative? ANSKP. ; No, MOVE DELND,NOD ; Remember delegation MOVEM DELND,ADELN(SBLOCK) MOVEM LABEL,ADELL(SBLOCK) MNTM5< AOS CELL(DOMLK,2,,MNT)> ; DLOOK Auth. delegated ENDIF. XMOVEI T1,SBPS-1(SBLOCK) CAMG LABEL,T1 ; More labels to match? IFSKP. ; Yes CALL FSON ;(NOD) ; Able to move down a level? SOJA LABEL,TOP. ; Yes ; Named node not there ANDE. DELND ; If no delegation has been found, MNTM5< AOS CELL(DOMLK,3,,MNT)> ; DLOOK checking for star XMOVEI LABEL,STARK(DBASE) ; Set label for * search MOVE NOD,LMATCH(SBLOCK) ; Return to last success CALL FSON ;(NOD) ; Look for * ANSKP. MNTM5< AOS CELL(DOMLK,4,,MNT)> ; DLOOK not exist MOVX T1,GTDX2 ; "Referenced domain name does not exist" MOVEM T1,DERC(SBLOCK) ; Set error code RET ; Fail return from DLOOK ENDIF. ENDDO. ; Of ZSLOOP JUMPE DELND,ANHERE ; Found named node or ; * node covering it, go copy ENDIF. PURGE DELND;=T8 ; Authoritative search failed, try the cache CACHE: TXNE FR,GH%MBA ; Ignore cache if must be authoritative IFSKP. ; Non-authoritative is ok MOVE LABEL,SBMAX(SBLOCK) ; Restart label search SETZM CDELN(SBLOCK) ; Set cache delegation to not found SKIPN T1,CACHEP(DBASE) ; See if a cache exists ANSKP. ; Have cache MNTM5< AOS CELL(DOMLK,5,,MNT)> ; DLOOK checking cache MOVE NOD,ZNODE(T1) ; Get pointer to root node of cache ; Should be after lock; probably ok CALL ZLOCKS ; Get a read lock on the cache ; Search down the labels, looking for cache delegation which is better ; than already found authoritative delegation (if any) RRD==T8 ; Pointer to a Resource Record DO. (CSLOOP) SKIPE T1,ADELN(SBLOCK) ; Authoritative delegation found? CAMLE T1,LABEL ; Y, Would cache delegation be better? SKIPN RRD,RRPTR(NOD) ; N, Y, Get first RR for this node IFSKP.; No authoritative, or cache would be better, and have RRs DO. (CCHEK) ; Look through RRs for an NS record MOVN T1,RRTTL(RRD) ; Get expiration time of RR CAMGE T1,TQUERY(SBLOCK) ; Has RR expired? IFSKP. ; Not yet LOAD T1,RRCLA,(RRD) ; Get class of this RR CALL CMATCH ; Check class ANSKP. ; Matches LOAD T1,RRTYP,(RRD) ; Get RR type CAIE T1,DNS ; Name server RR? ANSKP. ; Yes, found an NS delegation MOVEM LABEL,CDELL(SBLOCK) ; Remember this delegation MOVEM NOD,CDELN(SBLOCK) MNTM5< AOS CELL(DOMLK,6,,MNT)> ; DLOOK Cache delegation ELSE. ; RR no good, expired or not NS SKIPE RRD,RRNEXT(RRD) ; More RRs to check? LOOP. ; Yes loop ENDIF. ; No delegation at this level ENDDO. ; Of CCHEK ENDIF. ; Delegation check complete, now see if search is over XMOVEI T1,SBPS-1(SBLOCK) CAMG LABEL,T1 ; All labels matched? IFSKP. CALL FSON ;(NOD) ; Try to match another label SOJA LABEL,TOP. ; Iterate if found ELSE. MNTM5< AOS CELL(DOMLK,7,,MNT)> ; DLOOK node in cache CALL ANCOPY ;(NOD) ; Yes, Search name found, copy answers ; Found, T4/DNAME or LITDAT, (RRD/ RR) RETSKP ; Skip return from DLOOK MNTM5< AOS CELL(DOMLK,10,,MNT)> ; DLOOK cached node not have data JUMPN RRD,CNAMEL ; If ANCOPY found CNAME, restart search MNTM5< AOS CELL(DOMLK,11,,MNT)> ; DLOOK cached node not have cname ENDIF. ENDDO. ; Of CSLOOP ENDIF. SUBTTL RSOLVE ; If we get to RSolve either: the search name was not found in the cache, OR ; the name was found but no data matched the query AND a CNAME was not found. ; In any case the plan is to set up the search block so that the resolver ; process will attempt to service the query. The JSYS calls the resolver ; by setting a timeout in the search block's associated scheduler test cell ; [@SBRSKD(SBLOCK)] and storing 1 in RCOMND. ; The resolver can use all of the information in the search block to speed ; query processing. In particular, ADLEN and CDELN are useful for identifing ; the name server to ask, the resolver process can assume ownerships of the ; locks acquired by the JSYS, and the resolver can read and change the FR ; register via RFLAGS. ; If the resolver encountered an error, it returns it via DERC. If the ; resolver puts the new RRs in the cache, it points to the node where it ; put them via RSOLVN (if multiple nodes are involved, RSOLVN should be ; left zero so that the tree will be rewalked). ; The resolver returns control to the JSYS by first setting RCOMND to zero ; and then zeroing the scheduler test word whose address is in SBRSKD. ; Note about GH%INI and jsys returning while resolver still going ... RSOLVE: LOAD T1,GH%MOD,+FR ; Get mode MOVE CX,DOMPAR ; Configuration parameters TXNN CX,DMS%ER ; Resolver enabled and IFSKP. SKIPL DOMSRV ; Still on and ANSKP. CAIN T1,.GHLCL ; Local only? ANSKP. ; Yes, continue ELSE. ; No, error MOVX T1,GTDX4 ; "Requested domain data not available" MOVEM T1,DERC(SBLOCK) ; Set error code MNTM5< AOS CELL(DOMLK,12,,MNT)> ; DLOOK Rsolve punted RET ; Fail return from DLOOK ENDIF. MNTM5< AOS CELL(DOMLK,13,,MNT)> ; DLOOK Rsolve tried MOVEM FR,RFLAGS(SBLOCK) ; Store flags for resolver process ; Would like to do this once in DOMINI, but un-PMAPs hang in DSV, Dumper, etc HRLZ T1,PRIJFN(DBASE) ; JFN.0 CALL JFNOFN ; Get OFN on first section BUG. (HLT,DMIOF4,SOFT,MNETDV, ) PUSH P,T1 ; Save SPT.PG CALL MLKPG ; Lock the first page in memory MOVE T2,SBRSKD(SBLOCK) ; Section DOMSEC address of test word MOVE T3,RWAIT ; Set timeout interval TXNE FR,GH%INI ; Initiate only? MOVE T3,INITTL ; Yes ADD T3,TODCLK ; When check back MOVEM T3,(T2) ; Set timeout ; Note: DOMIDX, which is in section 0/1, has page zero of DBASE (i.e., 20,,0) ; mapped into it. HRLI T1,DOMIDX(T2) ; Test cell address, section 0/1 HRRI T1,DOMRSK ; Scheduler test AOS RCOMND(SBLOCK) ; Turn on resolver MDISMS ; Sleep POP P,T1 ; Get SPT.PG CALL MULKPG ; Unlock page MOVX T1,GTDX6 ; "Domain system error" SKIPE RCOMND(SBLOCK) ; Skip if resolver finished MOVEM T1,DERC(SBLOCK) ; Loop for resolver MOVE FR,RFLAGS(SBLOCK) ; Restore flags SKIPE T1,DERC(SBLOCK) ; Skip if resolver signals error RET ; Fail return from DLOOK ; Resolver found an answer MNTM5< AOS CELL(DOMLK,14,,MNT)> ; DLOOK Rsolve found answer SKIPN NOD,RSOLVN(SBLOCK) ; (Single) node returned? JRST RELOOK ; No, rewalk the tree for multiple ; replies ANHERE: MNTM5< AOS CELL(DOMLK,15,,MNT)> ; DLOOK at ANHERE CALL ANCOPY ; Try to copy answers RETSKP ; Found, T4/ DNAME or LITDAT, (RRD/ RR) MNTM5< AOS CELL(DOMLK,16,,MNT)> ; DLOOK Anhere copy failed ; Failed, Was a CNAME RR found? IFE. RRD ; No MNTM5< AOS CELL(DOMLK,17,,MNT)> ; DLOOK copy w/o cname MOVX T1,GTDX1 ; GTHST emulators return error TXNN FR,NULLOK ; Nothing returned ok? MOVEM T1,DERC(SBLOCK) ; No, set error code RET ; Fail return from DLOOK ; (No records may be ok to caller) ENDIF. ; Found a CNAME so start all over... SUBTTL CNAMEL ; CNAMEL gets control when the name is found to be an alias; it restarts the ; search at the cannonical name. Check for infinite loops which can be caused ; by circular CNAMEs or other problems. It does so by incrementing ERTTL and ; aboring if ERTTL becomes equal to INFTTL. ; ; On Entry: ; RRD points at CNAME RR CNAMEL: TXO FR,GH%AKA ; Set alias found bit MNTM5< AOS CELL(DOMLK,20,,MNT)> ; DLOOK trying cname MOVE BP,[G1BPT 0,8,SNAME] ; Make g1bpt to search name ADD BP,SBLOCK XMOVEI LABEL,SBPS-1(SBLOCK) MOVE T8,RDATA(RRD) ; Use rr ptr to get chunk pointer PURGE RRD;=T8 MOVE T8,RRNAME(T8) ; Use chunk ptr to get dname pointer DO. (CNL) MOVE T3,DLABEL+LABPTR(T8) ; Get ulabel pointer ADD T3,[ G1BPT 0,8,ULTEXT] ; Make it into byte pointer for label ILDB T4,T3 ; Get label length IFN. T4 ; Have label MOVEM BP,1(LABEL) ; Store byte pointer IDPB T4,BP ; Store length DO. (CNLOOP) ILDB T2,T3 ; Get next octet IDPB T2,BP ; Store label octet SOJN T4,TOP. ; Loop till label done ENDDO. ; Of CNLOOP MOVE T8,MORE(T8) ; Move on to next label in domain name AOJA LABEL,TOP. ; Move on to next byte pointer slot ENDIF. ENDDO. ; Of CNL MOVEM LABEL,SBMAX(SBLOCK) ; Remember max label value RELOOK: AOS T2,ERTTL(SBLOCK) ; Increment infinite loop counter MNTM5< AOS CELL(DOMLK,21,,MNT)> ; DLOOK relook CAMGE T2,INFTTL IFSKP. MNTM5< AOS CELL(DOMLK,22,,MNT)> ; DLOOK loop error MOVX T1,GTDX6 ; "Domain system error" MOVEM T1,DERC(SBLOCK) ; Set error code RET ; Fail return from DLOOK ENDIF. CALL ULOCKA ; Unlock everything JRST DLOOK ; Start it up again SUBTTL ANCOPY Scans RR chain for matching RRs & Applies GTHFCT to them ;NOD/ Points at node ; CALL ANCOPY ;RRD=T8/Points to CNAME if one found, zero otherwise ;Ret+1: If found answers ;Ret+2: If no answers found RRD==T8 ; Pointer to a Resource Record ANCOPY: SETZM CNPTR(SBLOCK) ; Clear CNAME pointer SETZM ANRET(SBLOCK) ; Set +2 return (0 RRs returned) MOVE RRD,RRPTR(NOD) ; Get address of first RR PURGE NOD;=T6 DO. (ACLOOP) ; Do all RRs JUMPE RRD,ENDLP. ; No RRs LOAD T1,RRCLA,(RRD) ; Get class of RR CALL CMATCH ; See if classes are compatible IFSKP. ; Yes CALL TMATCH ; See if types are compatible & allowed ANSKP. ; No, CNPTR(SBLOCK) set if an NS RR ; Found match MOVE T1,FCODE(SBLOCK) ; Get function code of JSYS ANDX T1,37 XCT GTHFCT(T1) ;(RRD) ; Process RR by function JFCL ; (In case it skips) ENDIF. ; End not match class, type, rest. MOVE RRD,RRNEXT(RRD) ; Move to next RR JUMPN RRD,TOP. ; Try next RR if not ENDDO. ; Of ACLOOP SKIPE ANRET(SBLOCK) ; Anything returned? RET ; Yes, return from DLOOK SKIPE RRD,CNPTR(SBLOCK) ; Have a CNAME RR pointer and TXNN FR,GH%CNM ; Want CNAMEs? AOSA 0(P) ; No, Set skip return CALL RTRNRR ; Yes, Return the CNAME RET ; Return from DLOOK ;RTRNRR Dump a RR for .GTHRR, formatted as follows: ; type 2 bytes ; class 2 bytes ; ttl 4 bytes ; length 2 bytes ; rdata length bytes RRHDR==2+2+4+2 ; Number of header octets RCK==T5 ; Pointer to a RDCHUNK RTRNRR: MOVE CX,FCODE(SBLOCK) ; Get function code of JSYS ANDX CX,37 CAIE CX,.GTHRR ; Make sure right type of call RET HLLZS OUTCNT(SBLOCK) ; No octets returned MOVE RCK,RDATA(RRD) ; Get RDCHUNK chain address TXO FR,CONLY ; Count only first time CALL RDDUMP TXZ FR,CONLY ; Turn off counting MOVE RCK,RDATA(RRD) ; Get RDCHUNK chain address HLRZ T2,OUTCNT(SBLOCK) ; Number of octets available IFG. T2 ; Have a limit HRRZ T3,OUTCNT(SBLOCK) ; Number of octets of rrdata to return SUBI T2,RRHDR(T3) ; Enough room left? ANDLE. T2 ; (Beware exactly 0) TXO FR,GH%TRN ; No, output truncated, skip RR ELSE. ; Copy, T2 has updated count HRLM T2,OUTCNT(SBLOCK) ; Count that will remain AOS ANRET(SBLOCK) ; Increment count of RRs copied MOVE T1,OUTBP(SBLOCK) ; Get destination designator LOAD T2,RRTYP,(RRD) ; Output RR type CALL OUTTWO LOAD T2,RRCLA,(RRD) ; Output RR class CALL OUTTWO SKIPL T2,RRTTL(RRD) ; Get TTL, skip if negative IFSKP. MOVM T2,T2 ; Adjust cache timeout SUB T2,TQUERY(SBLOCK) ENDIF. CALL OUT4 HRRZ T2,OUTCNT(SBLOCK) ; Output rdata length CALL OUTTWO CALL RDDUMP ; Output the rdata fields MOVEM T1,OUTBP(SBLOCK) ; Updated destination designator ENDIF. RET SUBTTL RDDUMP dumps a rdata chain ;T1/ Destination designator ;RCK/ Extended address of first Rchunk RDDUMP: DO. ; Process next RDCHUNks in list MOVE T4,LITDAT(RCK) ; Get pointer to data SKIPE CKIND(RCK) ; Skip if literal chunk IFSKP. ; Literal block ADD T4,[ G1BPT 0,8,0 ] ; Make a byte pointer ILDB T2,T4 ; Get high order length LSH T2,10 ILDB T3,T4 ; Get low order length ADD T2,T3 MOVEM T2,DNLC(SBLOCK) ; Remember for countdown MOVEM T4,DNBP(SBLOCK) DO. ; Copy literal octets SOSGE DNLC(SBLOCK) ; Count length down IFSKP. ILDB T2,DNBP(SBLOCK) ; Get next character to output CALL OUTCHR LOOP. ; Loop for more ENDIF. ENDDO. ELSE. PUSH P,FR ; Save flags TXO FR,GH%RRF ; Always return RRF format names ; ASCII strings lose (ASCIZ ok) CALL DNDUMP ; Dump a domain name TXZ FR,GH%RRF ; Clear flag IOR FR,(P) ; Put them back POP P,(P) ; Drop flags ENDIF. SKIPE RCK,RDMORE(RCK) ; Get address of next RDCHUNk LOOP. ENDDO. RET PURGE RCK;=T5 SUBTTL DNDUMP Outputs a domain name whose DNAME pointer is in T4 ;T1/ Destination designator ; +----------------------------+ +-----------------+ ;<< t4->| DLABEL | LABPTR ulabel_ptr |-------->| | ; | +-------------------+ +-----------------+ ; | | CASEMO 1 for lowc | | | ; +--------+-------------------+ +-----------------+ ; | MORE chain to next DNAME | ULTEXT | octets... | ; +----------------------------+ + + DNDUMP: TXO FR,NODOT ; No dot before first label DO. ; For all labels in DNAME MOVE T3,[ POINT 1,DLABEL+CASEMO(T4)] MOVEM T3,DNCP(SBLOCK) ; Setup case mod bits pointer MOVE T3,DLABEL+LABPTR(T4) ; Ulabel pointer ADD T3,[ G1BPT 0,8,ULTEXT] ; Byte pointer for length MOVEM T3,DNBP(SBLOCK) ; Dname byte pointer ILDB T2,DNBP(SBLOCK) ; Get length MOVEM T2,DNLC(SBLOCK) ; Remember for countdown ; What to output before label: 0 GH%RRF 1 | ; | 1 NODOT 0 | | ; ------------+------+------+------+--------- ; | | omit | <0> | 0 ; 0 | omit +------+------+-- GH%PSU ; Label | | "." | omit | 1 ; Len -----+------+------+------+--------- ; gt 0 | omit | "." | Len | ; ------------+------+------+------+ TXNN FR,GH%RRF ; Resource Record output format? IFSKP. ; Yes SKIPG T2 ; If length gt 0, output it TXNN FR,GH%PSU ; If PSU will follow, don't end name CALL OUTCHR ; Output T2/ , or ELSE. ; ASCII format TXZE FR,NODOT ; If NODOT, omit first time only ANSKP. MOVX T2,LABND SKIPG DNLC(SBLOCK) ; Length eq 0 and TXNE FR,GH%PSU ; No PSU to follow CALL OUTCHR ; Output a dot ENDIF. SKIPG DNLC(SBLOCK) ; Any characters in label? IFSKP. ; Yes DO. ; Characters in label ILDB T2,DNBP(SBLOCK) ; Get octet of label ; Check if character must be quoted, insert Control-V if so CAIE T2,.CHCNV ; Quoting character or CAIN T2,LABND ; Label separator? IFSKP. ; No MOVE CX,T2 ; Character ADJBP CX,GTHBPT ; Point to its field ILDB CX,CX ; Get its flags TXNN CX,GTHFOK ; Valid character? ANSKP. ; Yes ; Do not quote the character ELSE. ; Character must be quoted PUSH P,T2 ; Save character MOVX T2,.CHCNV ; Quote CALL OUTCHR ; Before POP P,T2 ; Character ENDIF. ILDB CX,DNCP(SBLOCK) ; Get case mod bit SKIPE CX ; Character lower case? ADDI T2,"a"-"A" ; Transform to lower case CALL OUTCHR ; Output this character SOSLE DNLC(SBLOCK) ; Skip if done LOOP. ; Back for rest ENDDO. ENDIF. SKIPE T4,MORE(T4) ; Skip if no more labels in name LOOP. ; Back for next label ENDDO. RET ; Return if done SUBTTL CMATCH and TMATCH ;CMATCH Tests the class in T1 against the QCLASS in SCLASS ;Ret+1: if not compatible ;Ret+2: if compatible CMATCH: MOVE CX,SCLASS(SBLOCK) ; Desired class CAME CX,T1 ; Exact match or CAMN CX,DSTAR ; Star? AOS 0(P) ; Yes, compatible RET ;TMATCH Tests the resource record type against the QTYPE in STYPE and ;checks for restrictions ;RRD/ Resource Record pointer ;Ret+1: if not compatible, or restricted; CNPTR set if CNAME found ;Ret+2: if compatible (CNPTR may be set [currently unused]) TMATCH: LOAD T1,RRTYP,(RRD) ; Get type of RR LOAD T2,RRRES,(RRD) ; Get restrictions CAMLE T2,SRESTR(SBLOCK) ; Requestor have access? IFSKP. ; Yes MOVX T2,DSTAR CAME T1,STYPE(SBLOCK) ; Exact match, or CAMN T2,STYPE(SBLOCK) ; If stype=* is ok IFSKP. ; Otherwise, CAIE T1,.GHMB ; Mailbox or CAIN T1,.GHMG ; Mail group is a MOVX T1,.GHWMB ; Wild Mailbox CAIN T1,.GHMR ; Mail rename is also a MOVX T1,.GHWMB ; Wild Mailbox CAIE T1,.GHMD ; Mail destination or CAIN T1,.GHMF ; Mail forwarder is a MOVX T1,.GHWMA ; Wild mail agent CAMN T1,STYPE(SBLOCK) ; Exact wild match is ok ANSKP. ; Otherwise, no match CAIN T1,DCNAME ; Was it a CNAME? MOVEM RRD,CNPTR(SBLOCK) ; Yes, remember CNAME ELSE. ; Compatible AOS 0(P) ; Matches so skip return ENDIF. ELSE. ; Restricted ;cwl use restricted CNAMEs? CAIN T1,DCNAME ; Was it a CNAME? MOVEM RRD,CNPTR(SBLOCK) ; Remember CNAME ENDIF. RET PURGE RRD SUBTTL Output routines to store string data in user memory ; SBOUTI Set up for output ;T1/ User's destination designator SBOUTI: MOVE T2,[XCTBU [IDPB T2,T1]] ; Instruction for byte pointer TLNN T1,777777 ; If JFN do JSYS MOVE T2,[BOUT%] ; Instruction for JFN TLC T1,777777 ; Check for lh=-1 TLCN T1,777777 HRLI T1,() ; Use standard pointer MOVEM T1,OUTBP(SBLOCK) ; Save designator MOVEM T2,OUTINS(SBLOCK) ; Save instruction RET ;OUTCHR Outputs one character in AC2 if CONLY set, ; otherwise it only increments OUTCNT ;FR/ CONLY flag ;T1/ Destination designator ;T2/ Byte to be output OUT4: ROT T2,-20 CALL OUTTWO ROT T2,20 OUTTWO: ROT T2,-10 CALL OUTCHR ; Output high order ROT T2,10 ; And fall through for another OUTCHR: MOVE CX,OUTINS(SBLOCK) ; Get instruction to execute TXNE FR,CONLY ; Skip if output enabled AOSA OUTCNT(SBLOCK) ; Count chatacter and skip output XCT CX ; Output the byte ERJMP BADOUT ; Bad destination RET SUBTTL Lock hackers ; The following routines manipulate locks in the master database. The ; acquired locks are recorded in the search block in variables lock1 and ; lock2. Although the lookup code only acquires locks in share mode, and ; assumes share mode for release, the locking code does check for locks which ; may have been acquired in exclusive mode by other parts of the domain system. ; ;ZLOCKS T1/zone Change T1 to point to lock, fall though to ; ;LOCKS T1/lock Gets lock in shared mode, waiting if required ; records lock in search block ; ;ULOCKA Releases all shared locks recorded in search block ; ;ULOCKS T1/lock Releases specified lock ; ;BREAKZ T1/zone Initiaizes lock in zone to be totally unlocked ; changes T1 to point to lock ; ;BREAKL T1/lock Initializes specified lock ZLOCKS: XMOVEI T1,ZONELO(T1) ; Change zone address to lock address LOCKS: SKIPE LOCK1(SBLOCK) ; Is this slot open to record lock? IFSKP. MOVEM T1,LOCK1(SBLOCK) ; Remember in lock1 ELSE. MOVEM T1,LOCK2(SBLOCK) ; Remember in lock2 ENDIF. PUSH P,T2 ; Save T2 MOVE T2,T1 ; Lock to T2 DO. ; Until get lock MOVE T1,PLTTL ; Wait for lock to free up AOSE LOCKWD(T2) ; Try to acquire lock IFSKP. MOVE T1,LCKTTL ; Wait two seconds for free SKIPN EXCLUS(T2) ; Test for exclusive lock set EXIT. ; Have the lock SETOM LOCKWD(T2) ; Free master lock while waiting ENDIF. ;cwl better test DISMS% ; Look again in a while LOOP. ENDDO. AOS SHARE(T2) ; Increment share count SETOM LOCKWD(T2) ; Free master lock MOVE T1,T2 ; Lock back to T1 POP P,T2 ; Restore T2 RET ; And return ;ULOCKA ULOCKS Unlock locks ULOCKA: SAVEAC SKIPE T1,LOCK1(SBLOCK) ; Free all locked zones CALL ULOCKS SKIPN T1,LOCK2(SBLOCK) RET ULOCKS: CAMN T1,LOCK1(SBLOCK) ; Free appropriate lock SETZM LOCK1(SBLOCK) CAMN T1,LOCK2(SBLOCK) SETZM LOCK2(SBLOCK) SOS SHARE(T1) ; Decrement share count RET BREAKZ: XMOVEI T1,ZONELO(T1) ; Change zone address to lock address BREAKL: SETOM LOCKWD(T1) ; Set lock to available SETZM SHARE(T1) ; Set share count to zero SETZM EXCLUS(T1) ; Set exclusive count to zero RET SUBTTL UCASE sets the case of a domain name to all upper ; On entry: ; t1 points at first octet of domain name ; ; routine UCASES does the search name UCASES: MOVE T1,[POINT 8,SNAME(SBLOCK)] UCASE: DO. ; For all labels in domain name ILDB T2,T1 ; Get length of label IFN. T2 ; If label has characters DO. ; Check whether each character must be raised ILDB T3,T1 ; Get character to check MOVE CX,T3 ADJBP CX,GTHBPT ; Point to character's field ILDB CX,CX ; Get field for character TXNE CX,GTHFLC ; Lower case? SUBI T3,"a"-"A" ; Yes, change to upper case DPB T3,T1 ; Put character back SOJN T2,TOP. ; Go get next character ENDDO. ; Characters in label LOOP. ; Go get next label ENDIF. ENDDO. ; Labels in domain name RET ;SETNCK Sets the host status, including the nickname flag HS%NCK. ;T3/ Standard format network address ;FR/ User flags SETNCK: SAVEAC ; Save address from HSTHSH MOVE T1,T3 ; Standard format network address, save it too CALL HSTHSH ; Look it up in host tables IFNSK. ; Did not find it ;temp beg load t2,na%pro,+t1 ; get protocol suite txz t1,na%pro ; try ip w/o np.ip cain t2,np.ip ; ip? call hsthsh annsk. ;temp end SETZ T4, ; No status ELSE. MOVE T4,HSTSTS&777777(T2) ; Get host table status ENDIF. TXNE FR,GH%AKA ; Skip if alias TXO T4,HS%NCK ; Set nickname RET ;MNOUTD NOUT% for decimal # to previous context caller ;1/ Output designator ;2/ Number to be output ;INST/ Output instruction ; CALL MNOUTD ;Ret+1: IO error ;Ret+2: Ok MNOUTD:: PUSH P,T4 PUSH P,[XWD 777777,0] ; Stop flag XMOVEI T4,0(P) ; Point to it DO. IDIVI T2,^D10 ; Extract least significant digit ADDI T3,"0" ; Convert to ASCII PUSH P,T3 ; Save it JUMPN T2,TOP. ; Back for next ENDDO. DO. POP P,T2 ; Get next digit JUMPL T2,ENDLP. ; All done XCT INST ; Output it ERJMP .+2 LOOP. ; Ok AOS (T4) ; Error LOOP. ENDDO. POP P,T4 TRNN T2,-1 ; Any errors? AOS (P) ; No RET ENDAV. ; End GTDOM JSYS AC definitions SUBTTL Network Support Routines ;HSTLUK Translate an IP name to address ;T1/ Length of string ;T2/ String pointer ;FR/ Flags from GTHST% call: GH%ANY, GH%GWY, GH%NET ; CALL HSTLUK ;Ret+1: Name not found ;Ret+2: Name found T3/ Best address for that host ; T4/ Host status HSTLUK: SKIPLE T1 ; No zero length names in tables SKIPL MHOSTS ; Anything in table? RET ; No ACVAR DMOVE LEN,T1 ; Save length and string pointer SETZ FLGS, ; Translate GH% flags to HS% TXNE FR,GH%GWY ; Gateway? TXO FLGS,HS%GAT ; Yes TXNE FR,GH%NET ; Network? TXO FLGS,HS%NET ; Yes TXNE FR,GH%ANY ; Anything? TXO FLGS,HS%GAT+HS%NET+HS%SRV ; Yes TXNN FR,GH%ANY+GH%GWY+GH%NET ; Old way? MOVX FLGS,HS%SRV ; Yes, just host HRLZ CTR,MHOSTS ; Scan the HOSTN table MOVE HNP,[HOSTN] ; Ext. address of HOSTN DO. DMOVE T1,LEN ; Callers pointer MOVE T1+3,T1 ; Fake length LOAD T1+4,HSTNMP,(HNP) ; Ext. address of host's name string ADD T1+4,[G1BPT 0,7,0] ; Global 1-word byte pointer to ASCIZ EXTEND T1,[ CMPSE 0 ; Filler for string 1 unused 0] ; Filler for string 2 unused IFSKP. ; Match LOAD T1,HSTIDX,(HNP) ; Extended address of host's addresses CALL FHPADR ; Find the highest priority address CALL HSTHSH ;(T1) ; Look up the number ANSKP. ; Have entry MOVE T4,HSTSTS&777777(T2) ; Get the status word TDNE T4,FLGS ; Desired entity? EXIT. ; Yes, found one so stop ENDIF. ADDI HNP,HOSTNW ; Move to next HOSTN entry AOBJN CTR,TOP. ; Loop through all HOSTN entries RET ; Not in the table ENDDO. MOVE T3,T1 ; T3/ Address MOVE CX,(HNP) ; Has a nicname flag TXNE CX,HSTNIC ; Is this a nickname? TXO T4,HS%NCK ; Yes, mark status accordingly RETSKP ; T4/ Host status (or 0) ENDAV. ;FHPADR Find the address in a list that is on the highest priority ; interface (or the first in the list if none are on connected nets). ;T1/ Pointer to a list of host addresses terminated with a -1 FHPADR:: ACVAR MNTM5< AOS CELL(MNTSB,4,,MNT)> ; Multinet FHPADR calls MOVE LST,T1 ; Save list head MOVE ADR,(LST) ; Default SETO PRI, ; Priority of that DO. MOVE T1,(LST) ; Get the next CAMN T1,[-1] ; End of list? EXIT. LOAD CX,NA%PRO,<+T1> ; Get protocol type of this address CAIG CX,NP.MAX ; Valid code and SKIPL @PROON(CX) ; Protocol ON? AOJA LST,TOP. ; No, skip it and do next CALL @PRONET(CX) ; Convert to a network number in T1 XMOVEI T2,FHPAD0 ; Worker functions CALL HSHNET ; Look this one up IFSKP. MOVE ADR,(LST) ; Replace this number MOVE PRI,T2 ; Remember priority ENDIF. AOJA LST,TOP. ; No, skip it and do next ENDDO. MOVE T1,ADR ; Return whatever we found RET FHPAD0: IFIW!R ; If not found IFIW!FHPAD1 ; If found FHPAD1: MOVE T2,NCTTBL(Q2) ; Get the NCT for this net LOAD T2,NTPRIO,(T2) ; And priority CAMLE T2,PRI ; Smaller than last? AOS (P) ; No,skip RET ; Yes, no skip ENDAV. ;LCLNET Check if an interface is on a connected network. ;T1/ Host address ;Ret+1: No such connected network ;Ret+2: Network exists ;T1/ Clobbered ;WARNING: This is only compatable with IP. LCLNET:: SAVEAC MNTM5< AOS CELL(MNTSB,^D10,,MNT)> ; Multinet LCLNET calls NETNUM T1,T1 ; Network in T1 XMOVEI T2,NOSKSK ; No skip or skip CALLRET HSHNET ; Look it up NOSKSK: IFIW!R ; Not found IFIW!RSKP ; Found ;NETCHK ;Check if our interface on a given net is up. ;T1/ Net number ;Ret+1: If interface is down ;Ret+2: If interface is up NETCHK:: SAVEAC MNTM5< AOS CELL(MNTSB,^D16,,MNT)> ; NETCHK called XMOVEI T2,DWNUP ; Worker routines CALLRET HSHNET ; Check state DWNUP: IFIW!R ; Interface is down - non-existent IFIW!DWNUP0 DWNUP0: SKIPLE NCTTBL(Q2) ; Check NCT AOS (P) ; Just NCT means up RET ; Zero or flagged down means down ;NETLUK Find an interface to a connected network. ;T1/ Network number (including type code) ;Ret+1: ;T1/ 0 No interface on that net ; NCT Interface exists and is up ; 1B0+NCT Interface is down ;T2/ Clobbered, T4/ Preserved ;Future addition: This could do interface load splitting if the lookup ;were re-arranged. NETLUK:: MNTM5< AOS CELL(MNTSB,^D17,,MNT)> ; NETLUK called XMOVEI T2,NETLU0 ; Worker functions CALLRET HSHNET NETLU0: IFIW!NETLU1 IFIW!NETLU2 NETLU1: SETZ T1, ; Not there RET NETLU2: MOVE T1,NCTTBL(Q2) ; Get NCT (possibly flagged down) RET ;HSHNET Workhorse routine for finding an interface in the tables. ;T1/ Network number (including code) ;T2/ Routine to execute if that number found. ;Return ;@0(T2) Entry not found, Q2 holds index of empty slot ;@1(T2) Entry found HSHNET: ACVAR MNTM5< AOS CELL(MNTSB,6,,MNT)> ; Multinet HSHNET calls MOVE NUM,T1 ; Network number IDIVI NUM,IHSHSZ ; Divide by size of table to get random number HRLI PRB,-IHSHSZ ; AOBJN counter DO. ; PRB/ -IHSHSZ,,Remainder SKIPN NUM,NCTHSH(PRB) ; Any interface? CALLRET @0(T2) ; No CAMN T1,NUM ; Same? CALLRET @1(T2) ; Yes AOBJP PRB,ENDLP. ; Increment the pointer, stop if full table CAIL PRB,IHSHSZ ; Past end of table? SUBI PRB,IHSHSZ ; Yes, back up LOOP. ENDDO. CALLRET @0(T2) ; No interface ENDAV. ;NCTDWN The interface connected to a NCT has gone down. ;P1/ VNCT NCTDWN:: MNTM5< AOS CELL(MNTSB,^D14,,MNT)> ; NCTDWN called MOVE T1,NTNET(VNCT) ; Get the network number XMOVEI T2,NCTDW0 ; Worker functions CALL HSHNET ; Look that one up LOAD T2,NTPRO,(VNCT) ; Get the protocol type code CAIE T2,NP.GEN ; General, OR CAIG T2,NP.MAX ; .LE. max? IFSKP. ; No, complain BUG.(CHK,MNTIDP,MNETDV,SOFT,, <,>,< Cause: NCT contains an invalid protocol code. Action: Data: NCT address and protocol code. >) RET ENDIF. SKIPL @PROON(T2) ; Protocol ON? MOVX T2,NP.GEN ; No, use default CALLRET @PRONDN(T2) ; Notify the appropriate handler NCTDW0: IFIW!R ; Not found IFIW!NCTDW2 NCTDW2: MOVX CX,1B0 ; Found, mark entry deleted IORM CX,NCTTBL(Q2) RET ;NCTUP The interface is up. ;P1/ VNCT NCTUP: MNTM5< AOS CELL(MNTSB,^D15,,MNT)> ; NCTUP called MOVE T1,NTNET(VNCT) ; Get the network number XMOVEI T2,NCTUP0 ; Worker functions CALL HSHNET ; Look it up LOAD T1,NTPRO,(VNCT) ; Get type code CAIE T1,NP.GEN ; General, OR CAIG T1,NP.MAX ; .LE. max? IFSKP. ; No, complain BUG.(CHK,MNTNUP,MNETDV,SOFT,, <,>,< Cause: NCT contains an invalid protocol code. Action: Data: NCT address and protocol code. >) RET ENDIF. SKIPL @PROON(T1) ; Protocol ON? MOVX T1,NP.GEN ; No, use default CALLRET @PRONUP(T1) ; Execute protocol function NCTUP0: IFIW!R ; Not found (shouldn't happen) IFIW!NCTUP2 NCTUP2: MOVX CX,1B0 ; Found, clear the down bit ANDCAM CX,NCTTBL(Q2) RET ;MSK2BP Convert mask in a word to the left half of a byte pointer. ;T1/ Mask ; CALL MSK2BP ;T1/ Byte pointer (right half is zero) MSK2BP: PUSH P,T2 ; Save reg JFFO T1,.+2 ; Count lead zeros MOVX T2,^D36 ; All zeros, fake nul pointer PUSH P,T2 ; Number of lead zeros before mask MOVN T2,T1 ; Find lsb of mask AND T1,T2 JFFO T1,.+2 ; Find bits before lsb MOVX T2,^D35 MOVX T1,^D35 SUB T1,T2 LSH T1,6 ; Position field ADDI T1,1(T2) SUB T1,(P) POP P,(P) ; Drop number of lead zeros LSH T1,^D36-6-6 ; Left justify pointer POP P,T2 ; Restore register RET ;NETNCT Net number to NCT. ;T1/ Net number ;Ret+1: No NCT on the net ;Ret+2: VNCT/ 0,,NCT for an interface on that net which may not be up ;Saves T1-T4. NETNCT:: SAVET ; Save temps MNTM5< AOS CELL(MNTSB,^D18,,MNT)> ; NETNCT called MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get net in the chain JUMPE VNCT,R ; No more CAMN T1,NTNET(VNCT) ; Same network? RETSKP ; Yes, success LOOP. ENDDO. ; /*NOTREACHED*/ ;LCLHST Check if a given (non-zero) address is one of ours. ;T1/ Host address ;Ret+1: Address does not match those for this host. ;Ret+2: Address is this host. ;Saves all registers. LCLHST:: MNTM5< AOS CELL(MNTSB,^D9,,MNT)> ; Multinet LCLHST calls SKIPN LOGHST ; Supporting logical hosts? IFSKP. SAVEAC ; Yes, must use slow check MOVEI VNCT,NCTVT-$NTLNK ; Point to the table (sec 0) DO. LOAD VNCT,NTLNK,(VNCT) ; Get the next in the list JUMPE VNCT,R ; Not found MOVE T2,T1 ;[rut] ANDCM T2,NTNLHM(VNCT) ; Without logical host bits ;[rut] CAME T2,NTLADR(VNCT) ; Match address? ;[rut] LOOP. ; No, try next nct XOR T2,NTLADR(VNCT) ;[rut] One of ours? TDZ T2,NTNLHM(VNCT) ;[rut] Ignore logical host bits JUMPN T2,TOP. ;[rut] No, loop through all ENDDO. RETSKP ; Return success if found ENDIF. SAVEAC ; No logical hosts to worry about XMOVEI T2,NOSKSK ; Worker functions ; Fall through into HSHADR ;HSHADR ;T1/ Host address ;Return ;0(T2)/ Address to execute if entry is not in table ;1(T2)/ Address to execute if entry is in table HSHADR: ACVAR MNTM5< AOS CELL(MNTSB,5,,MNT)> ; Multinet HSHADR calls MOVE NUM,T1 IDIVI NUM,IHSHSZ ; Make probe HRLI PRB,-IHSHSZ ; AOBJN counter DO. SKIPN NUM,ADRHSH(PRB) ; Anything there? CALLRET @0(T2) ; No CAMN T1,NUM ; Same? CALLRET @1(T2) ; Yes AOBJP PRB,ENDLP. ; Increment the pointer, stop if full table CAML PRB,IHSHSZ ; Past table end? SUBI PRB,IHSHSZ ; Back to beginning LOOP. ENDDO. CALLRET @0(T2) ; No interface ENDAV. RESCD ;ps ;LKSTOR Lock down a region of core. ;T1/ Extended address of start ;T2/ Extended address of end ;(Probably should be in PAGEM, but this keeps the sources cleaner) LKSTOR:: TRZ T1,777 ; Round down to nearest page DO. PUSH P,T1 ; Save start PUSH P,T2 ; End CALL MLKMA ; Lock down that page POP P,T2 ; Rstore POP P,T1 ADDI T1,PGSIZ ; Increment to next page CAMG T1,T2 ; Past last address? LOOP. ENDDO. RET ;ETHRAH ;This routine is used to 'canonicalize' a 48 bit ethernet address, or any ;address which is longer than 32 bits, in order to allow single word ;comparisons of "addresses". ;T1,T2/ 48 bit address ;Ret+1: T1/ Pointer to 'address block' ;The address block (currently) has the format ;w0: Flag word ;w1: word 1 of address ;w2: word 2 of address ;w3: unused ;Bit 1 of the flag word means the block is in use. The other bits are ;available to higher level protocols, but if they are all 0 the block may ;be re-used if the table overflows. ;(This might want to move to ETHER.MAC whenever there is an official one). ;(Also note that this is not currently used by anything, it is more of an ;implementation suggestion of to how to get around the multiple word ;address problem than an actual mandate). ETHRAH:: ACVAR MNTM5< AOS CELL(MNTSB,3,,MNT)> ; Multinet ETHRAH calls MOVE HSH,T1 ; Get the address ADD HSH,T2 ; Combine the parts IDIVI HSH,ETHRTS ; / size of table PUSH P,PTR ; Save initial probe IDIVI HSH,ETHRTS ; Get delta POP P,HSH EXCH HSH,PTR LSH PTR,2 ; Blocks are 4 words long LSH HSH,2 ADD PTR,[ETHRTB] ; Point to address table MOVX CNT,ETHRTS ; MAX number of probes SETZ FIRST, DO. SKIPL (PTR) ; Anything there? IFSKP. CAMN T1,1(PTR) ; Here? CAME T2,2(PTR) IFNSK. ; Not in this slot SKIPE FIRST ; Have we a possible? IFSKP. MOVE CX,(PTR) TXNN CX, ; Anyone want this one? MOVE FIRST,PTR ; No, possible overwrite ENDIF. ADD PTR,HSH ; Try next probe CAML PTR,[ETHRTB+ETHRTS] SUBI PTR,ETHRTS ; Overflow SOJG CNT,TOP. ; Loop SKIPN PTR,FIRST ; Table overflow BUG.(HLT,ETHROV,MNETDV,SOFT,,,< Cause: There are to active entries in the ethernet address table Action: Either the table is to small or protocols are not marking entries inactive properly. The theory is that the system should not need to actively remember addresses for more than a few (20? 200?) ethernet hosts at once. Determine which is the problem and take appropriate action. >) ENDIF. ELSE. ; Inactive entry MOVEM T1,1(PTR) MOVEM T2,2(PTR) MOVX CX,1B0 MOVEM CX,(PTR) ENDIF. ENDDO. MOVE T1,PTR ; Return the pointer RET ENDAV. SUBTTL General buffer management ;Still in RSCOD Psect ;Packet buffer management for Multinet. ;This package uses a modified buddy-system for storage allocation. Packets ;allocated are one of a small number of fixed sizes (currently 64, 128, 256, ;512 words). ;Each active packet has the following format ;Word -1 | Flag,,Pool # | ;Word 0 | Forward link | ;Word 1 | Size,,Protocol | or | Backward link (if free) | ;Word 2 | Pointer to data | ;Word's 2-N | used by protocols | ;Internal to this module packets are offset with the first word as 0 ;Definitions (these are all internal to this module) DEFSTR LINKF,1,35,36 ; Forward link, Same as NBQUE DEFSTR LINKB,2,35,36 ; Backward link pointer FLGWRD==0 ; Word flags are in DEFSTR PFLAG,0,17,18 FREEF==123456 ; Buffer is free USEDF==654321 ; Buffer is in use DEFSTR PPOOL,0,35,18 ;Constants ;Pool sizes PULSIZ:;EXP ^D32 EXP ^D64 EXP ^D128 EXP ^D256 EXP ^D512 ; Size of a page, should be largest NUMPUL==.-PULSIZ ;Masks for finding a buffers buddy (XOR with buffer address) PULMSK:;EXP 40 EXP 100 EXP 200 EXP 400 EXP 0 ; Page Pool has no buddy ;Minimum size for each pool. This is an initial guess. The actual ;number that is kept on each list is based on the past usage (see ;PULOPT). But when usage decreases the numbers are not allowed to ;fall below this. PULMIN:;EXP 0 EXP ^D20 ; (Minimal IP packet falls here) EXP 0 EXP 0 EXP ^D20 ;STG has initialized PULMAP, with PULMAP-1 containing an AOBJN counter and ;PULBAS:XWD BUFSEC,BUFFRE ; (BUFSEC = 0 on a KA) ;PULTOP:XWD BUFSEC,BUFFRZ ; Top of free storage ;Time interval between buffer list GC ;MNTB0: EXP ^D<10*60*1000> ; 10 minutes ;RS MNTBT,1 ; TODCLK for next GC ;Current optimal size for each pool list, based on recent demand. RS PULOPT,NUMPUL ;Pool lists - linked list of free blocks on a pool RS PULLST,NUMPUL ;Current count in each pool RS PULCNT,NUMPUL ;BUFINI Initialize the buffer free storage package. BUFINI:: ; Set the initial optimum sizes for each pool MOVSI T1,<-NUMPUL> ; For all pools DO. MOVE T2,PULMIN(T1) ; Minimum size becomes MOVEM T2,PULOPT(T1) ; First guess at optimum AOBJN T1,TOP. ENDDO. RET ;GETBUF Allocate a packet buffer. ;T1/ Size wanted, if a packet buffer, count includes NBHDRL header. ;T2/ Protocol code (NP.xx). ;Ret+1: T1/ Extended pointer to packet or 0 if no storage available. ; NBSIZ # words allocated GETBUF:: TRVAR SKIPL T2 ; Protocol code CAILE T2,NP.MAX ; Make sure valid MOVX T2,NP.GEN ; Not valid, use default MOVEM T2,PROT ; Save protocol code MNTM5< AOS CELL(MNTBF,0,,MNT)> ; Multinet GETBUF calls MNTM5< INHIST(MNTBH,MNT,T1,T2,T3)> ; Histogram block sizes ADDI T1,FLGWRD+1 ; Include free-storage header word CAML T1,PULSIZ+NUMPUL-1 ; Request too large? JRST GETBAD ; Yes, let someone know something ; is probably wrong CALL GETBF0 ;(T1:T1) ; Get buffer SKIPG T1 ; Get one? RET ; No, return failure ;Init the non-data portions of the buffer. ;T1/ Internal buffer address. MOVEI CX,USEDF ; Flag this buffer in use STOR CX,PFLAG,(T1) LOAD T3,PPOOL,(T1) ; Get pool number MOVE T3,PULSIZ(T3) ; Size of this pool in words SUBI T3,FLGWRD+1 ; Words available to user PUSH P,T3 ; Save it for header XMOVEI T2,FLGWRD+1(T1) ; Point past the free-storage header PUSH P,T2 ; Save address of buffer to be returned ; Zero protocol dependent overhead area MOVE T1,PROT ; Protocol code MOVE T1,PROOVH(T1) ; Protocol's overhead, words CAMLE T1,T3 ; Make sure don't exceed allocation MOVE T1,T3 ; Does, so use actual allocation XMOVEI T3,1(T2) ; Destination for clearing SETZM (T2) ; Zero first word CALL XBLTA ; Zero the rest POP P,T1 ; Extended address of buffer POP P,T3 ; Words allocated STOR T3,NBSIZ,(T1) ; Allocated words in buffer MOVE T2,PROT ; Protocol code STOR T2,NBPRO,(T1) RET ; Done ;Recursive routine to get buffer ;T1/ Size needed, including internal overhead ;Ret+1: Always, T1/ Internal buffer address, or 0 if no space available GETBF0: SAVEQ ; Get some work AC's MOVSI Q1,-NUMPUL ; Create an AOBJN pointer DO. CAMLE T1,PULSIZ(Q1) ; Is it this one? AOBJN Q1,TOP. ; No, try next pool ENDDO. JUMPGE Q1,GETBAD ; Cannot find a pool PIOFF ; Protect the buffer lists SKIPE T1,PULLST(Q1) ; Anything on this list? IFSKP. ; This pool empty, try to get from next ; higher unless it is the page pool PION ; Give the machine back MOVE T1,Q1 ; Current pool AOBJP T1,.+2 ; Is next pool the largest size pool? IFSKP. ; Yes CALL GETPAG ; Get largest size buffer from system ELSE. ; Not largest size pool MOVE T1,PULSIZ(T1) ; Size of next larger pool CALL GETBF0 ; Get one from that pool JUMPE T1,R ; No storage at all, return failure MOVE Q2,T1 IOR T1,PULMSK(Q1) ; Split it in two STOR Q1,PPOOL,(T1) ; Set new pool number STOR Q1,PPOOL,(Q2) ; into both halves MOVEI CX,FREEF ; Buffer freed by GETBUF STOR CX,PFLAG,(T1) PIOFF ; Grab the machine back CALL LINK ; Add the new buffer to the list PION ; Frees T1 MOVE T1,Q2 ; Buffer to return ENDIF. ELSE. ; There was a free buffer this size CALL UNLINK ; Remove it from the list PION ; Give the machine back ENDIF. RET ; T1 has internal buffer address or 0 ENDTV. ;GETPAG Steal another page from the system. ;Q1/ .ge.0,,pool ;Ret+1: T1/ 0 (if no more storage), or buffer page address GETPAG: ; Cannot do this at PI level MNTM5< AOS CELL(MNTBF,2,,MNT)> ; Multinet GETPAG calls SKIPN INSKED ; In the scheduler? CONSZ PI,77400 ; At PI level? JRST GETPGF ; Yes, fail MNTM5< AOS CELL(MNTBF,3,,MNT)> ; Multinet GETPAG calls not PI/sched NOSKED ; Stop scheduling MOVE Q2,PULMAP-1 ; Size of page bitmap SKIPN T1,PULMAP(Q2) ; Free page near here? AOBJN Q2,.-1 ; No IFG. Q2 BUG.(CHK,BBITMF,MNETDV,SOFT,,,< Cause: All pages in the buffer section bitmap are in use. This would mean that a full section has been allocated and locked down for network buffers. This is not expected to happen. If it does an effort should be made to find what protocol is hoarding buffers and fix it. >) OKSKED ; Allow scheduling again JRST GETPGF ; Failed ENDIF. JFFO T1,.+1 ; Count number leading 1's MOVE T1,BITS(T2) ; Get the bit number ANDCAM T1,PULMAP(Q2) ; And mark that page allocated OKSKED ; Allow scheduling again HRRZS Q2 ; Find page number IMULI Q2,^D36 ADD Q2,T2 LSH Q2,PGSFT ; Relative page number to address ADD Q2,PULBAS ; Relative address to absolute address ;TEMP time how long these routines take us STKVAR ; Base times MOVX T1,.HPRNT ; Get runtime HPTIM% SETZ T1, ; Failed? MOVEM T1,RT0 ; Save MOVE T1,TODCLK ; Get elapsed time MOVEM T1,ET0 ;End of TEMP MNTM5< AOS CELL(MNTBF,^D8,,MNT)> ; Multinet STEALP calls MOVE T1,Q2 ; Get the address CALL STEALP ; Steal a page from the free list ;More TEMP MOVX T1,.HPRNT HPTIM% MOVE T1,RT0 ; Failed? SUB T1,RT0 ; Get difference MOVEM T1,CELL(MNTBF,4,,MNT) ; Last runtime in pager (HP units) ADDM T1,CELL(MNTBF,5,,MNT) ; Total Run time in pager (HP units) MOVE T1,TODCLK SUB T1,ET0 MOVEM T1,CELL(MNTBF,6,,MNT) ; Last elapsed time in pager code (ms) ADDM T1,CELL(MNTBF,7,,MNT) ; Total elapsed time in pager code (ms) ;End of more TEMP MOVE T1,Q2 ; Get address back STOR Q1,PPOOL,(T1) ; Set pool number RET ;Here when requested size too large GETBAD: BUG.(CHK,BADSIZ,MNETDV,SOFT,, <>,< Cause: A network buffer was requested that was too large to fit in any of the Multinet buffer pools. Action: Find the caller, and where it got the value. The maximum pool (1page) should be enough for any reasonable network. >) ;Cannot get a buffer/page, return failure GETPGF: SETZ T1, ; Fail signal RET ;RETBUF Return a buffer to the system. ;T1/ Buffer address ;Ret+1: Always. RETBUF:: MNTM5< AOS CELL(MNTBF,1,,MNT)> ; Multinet RETBUF calls SAVEAC ; ** NB: -2(P) below XMOVEI T1,-(T1) ; Point to the pool word LOAD CX,PFLAG,(T1) ; Get flag CAIE CX,USEDF ; In use? BUG.(HLT,RETBF0,MNETDV,SOFT,, <,<(T1),Hdr>>,< Cause: An attempt was made to free a buffer that was not marked in use. There are several possible causes for this: . Multiply freeing buffers . The flag word (-1 of the buffer) was overwritten . a garbage value was passed to the routine. Action: Try to determine which it was and take appropriate action. >) MOVE CX,-2(P) ; Get caller's PC STOR CX,PFLAG,(T1) ; Mark buffer not in use LOAD Q1,PPOOL,(T1) ; Get the pool number CAIL Q1,NUMPUL ; Valid? BUG.(HLT,RETBF1,MNETDV,SOFT,,,< Cause: A buffer was returned which claimed to be from an impossible pool. The possible causes are similar to those for RETBF0. >) PIOFF ; Get the machine CALL LINK ; Link in the buffer PION RET ; Done ;GCBUF Garbage collect the buffer lists. ;This routine is called periodicly by the maintainence fork to re-compact ;storage and return unneeded pages to the system. GCBUF:: MOVE T1,MNTBT ; Get time to GC next SUB T1,TODCLK ; From time now JUMPG T1,R ; Not time yet MNTM5< AOS CELL(MNTBF,^D10,,MNT)> ; Multinet GCBUF calls SAVEQ ; Save some work registers MOVSI Q1,-NUMPUL ; Setup for looping GCBUF0: DO. ; First calculate the new optimum size MOVE T2,PULCNT(Q1) ; Get current count SUB T2,PULOPT(Q1) ; Check against current optimum IFG. T2 ; Greater than optimum, increase the optimun LSH T2,-1 ; Difference / 2 ADDM T2,PULOPT(Q1) ELSE. AOS T2 ; (In case of difference by 1) ANDGE. T2 ; Current is at the optimum, this may mean that ; demand has diminished below previous optimum MOVE T2,PULMIN(Q1) ; Minimum for this pool SUB T2,PULOPT(Q1) ; Minus last 'optimum' ASH T2,-1 ; Split the difference ADDM T2,PULOPT(Q1) ; Set new optimum ENDIF. ; If count is LT optimum then it needs filling. DO. ; Now make sure the pool is within that range. MOVE T2,PULCNT(Q1) ; Current size SUB T2,PULOPT(Q1) ; Check against optimum SKIPLE T2 ; Too many in this pool CALL GC1B ; Collect one (two) from this pool TRNA ; Couldn't do any LOOP. ; Check again ENDDO. AOBJN Q1,TOP. ; Loop through all the pools ENDDO. MOVE T1,TODCLK ; Calculate time to GC next ADD T1,MNTB0 ; Offset MOVEM T1,MNTBT ; When we will next RET ;GC1B Collect 1 buffer from a pool (actually 2 from anything but page pool). ;Q1/ Pool number ;Ret+1: Couldn't find any buffers to GC ;Ret+2: Some collected GC1B: PIOFF ; Must protect the lists from PI level MNTM5< AOS CELL(MNTBF,^D11,,MNT)> ; Multinet GC1B calls SKIPN T1,PULLST(Q1) ; Anything on this list? IFSKP. ; Yes SKIPE PULMSK(Q1) IFSKP. ; Page pool CALL UNLINK ; Remove it from the list PION ; List is safe again MOVE T2,T1 ; Absolute address to SUB T2,PULBAS ; Relative address to LSH T2,-PGSFT ; Relative page number to IDIVI T2,^D36 ; Offset and page to MOVE T3,BITS(T3) ; Bit IORM T3,PULMAP(T2) ; Mark that page free MNTM5< AOS CELL(MNTBF,^D9,,MNT)> ; Multinet RETRNP calls CALL RETRNP ; Return the page to the free list AOS (P) ; Do a skip return ELSE. DO. MOVE T2,T1 XOR T2,PULMSK(Q1) ; Find its buddy MOVE CX,FLGWRD(T1) ; Make sure CAME CX,FLGWRD(T2) ; They're both free and same pool IFSKP. ; Yes, Unlink both CALL UNLINK ; Undo T1 EXCH T1,T2 CALL UNLINK PION ; Lists safe for a moment ANDCM T1,PULMSK(Q1) ; Get the top buffer AOS Q1 ; Temp increment pool counter STOR Q1,PPOOL,(T1) ; In this pool now PIOFF CALL LINK ; Link this buffer to higher list PION SOS Q1 ; Back to previous pool AOS (P) ; Set for a skip return ELSE. LOAD T1,LINKF,(T1) ; Get the next on the list JUMPN T1,TOP. ; Loop if not at the list end. PION ; Buffer lists are safe again ENDIF. ; End of "buddy is free" check ENDDO. ENDIF. ; End of SKIPE PULMSK(Q1) ELSE. PION ENDIF. ; End of SKIPN PULLST(Q1) RET ;LINK Link buffer to the head of a buffer list. ;T1/ Buffer ;MUST BE CALLED PIOFF ;Q1/ List number ;Ret+1: Always with the buffer on the head of the list. LINK: SETZRO LINKB,(T1) ; This will be the head MNTM5< AOS CELL(MNTBF,^D12,,MNT)> ; Multinet LINK calls MOVE CX,T1 ; Save it EXCH T1,PULLST(Q1) ; Put as list head STOR T1,LINKF,(CX) ; Set the forward link SKIPE T1 ; If there were any more STOR CX,LINKB,(T1) ; Link to the other AOS PULCNT(Q1) ; One more buffer on this list RET ;UNLINK Unlink buffer from doubly linked list. ;T1/ Buffer ;MUST BE CALLED PIOFF ;Q1/ List number ;Ret+1: Always. UNLINK: SAVET MNTM5< AOS CELL(MNTBF,^D13,,MNT)> ; Multinet UNLINK calls LOAD T2,LINKF,(T1) ; Get forward link LOAD T3,LINKB,(T1) ; Backward link IFE. T3 ; Head of list IFE. T2 ; End of list SETZM PULLST(Q1) ; This was the only element on the list ELSE. ; This was the list head SETZRO LINKB,(T2) MOVEM T2,PULLST(Q1) ENDIF. ; End of IFE. T2 ELSE. ; T2 will be 0 if this was the list tail STOR T2,LINKF,(T3) SKIPE T2 STOR T3,LINKB,(T2) ; Insert back link ENDIF. ; End of IFE. T3 SOS PULCNT(Q1) ; One less buffer in the list RET ;BUFCHK Check whether something is a network buffer. ;T1/ Address ;Ret+1: If not a buffer ;Ret+2: Otherwise BUFCHK:: CAML T1,PULBAS ; Less than base of storage? CAMLE T1,PULTOP ; Greater than top? RET ; Yes, fail RETSKP LMNETG: LIT SUBTTL Packet Tracing Buffer Allocation ;MNTPIN Allocate buffer for packet tracing (resident since may be written ;into from interrupt level). For now, 36 pages long (1 word of PULMAP). PPBFSP==^D36 ;Called at initialization if MNTRAC is non-zero, of from MDDT. MNTPIN:: SETZ T1, ; Assume failed MOVE Q2,PULMAP-1 ; # words in bitmap IFN PPBFSP-^D36, SETO T2, ; Want 36 pages NOSKED ; Protect PULMAP DO. CAME T2,PULMAP(Q2) ; These free? AOBJN Q2,.-1 ; No JUMPGE Q2,ENDLP. ; Give up ANDCAM T2,PULMAP(Q2) ; Get pages OKSKED ; PULMAP safe HRRZS Q2 ; First page # /36 IMULI Q2,^D36 ; First page # (bits in PULMAP word) LSH Q2,PGSFT ; First page offset ADD Q2,PULBAS ; First page address MOVE Q1,Q2 ; Working address MOVSI Q3,-PPBFSP ; # pages DO. MOVE T1,Q1 ; Page desired CALL STEALP ; Get resident page ADDI Q1,PGSIZ ; Next page AOBJN Q3,TOP. ENDDO. MOVX T1,USEDF ; Initialize header STOR T1,PFLAG,(Q2) SETZRO LINKF,(Q2) SETZRO LINKB,(Q2) MOVX Q1,^D36*1000-FLGWRD-1 ; Total length, words STOR Q1,NBSIZ,(Q2) SUBI Q1,NBHDRL+2*PPBWDS ; Useable length (leader plus guard at end) XMOVEI T1,NBHDRL(Q2) ; Useable start ADD Q1,T1 ; Useable end NOSKED ; Protect tracing buffer info MOVEM T1,MNTPTB ; Base MOVEM T1,MNTPTC ; Current MOVEM Q1,MNTPTE ; End SETZM MNTPTO SETZM MNTPTD ENDDO. OKSKED ; Tracing buffer info (or PULMAP) safe LOAD T1,LIDX,+PPBLCK ; Lock inited? SKIPN T1 ; Yes SKIPL INTON ; Internet on? RET ; Stop now CALLRET PPINI ; Internet on but not setup, do it now ;***** End of buffer management SUBTTL Network Packet Tracing COMMENT ! PRNPKH is called by the Multinet layer and network drivers (maybe at interrupt level). If space is available, it is reserved in the buffer and the data inserted. If no space is available, the counter MNTPTD is incremented. PRNPKI is called by IP, and PRNPKT by TCP, at process level (they are currently the same routine). If no space is available, the routine which dumps the in-core buffer to disk is invoked (it is part of the Multinet Utility fork, which owns the tracing file JFN), but overflow is not expected to normally occur. In all cases, T1 contains the trace code, PT%xxx, which identifies both the point where the sample was taken, and flags which describe what registers, etc. are valid. In general, a packet is dumped if one exists, otherwise a (TCP) buffer header, or the registers. Tracing may be started before the system comes up (to observe what transpires with the local networks) by setting the tracing flag, MNTRAC, from EDDT. ! ;PPINI ;Initialize the Packet Printer. ; CALL PPINI ;Ret+1: Always, T1 preserved. PPINI: PUSH P,T1 ; Save trace code MOVEI T1,INTON ; Wait til IP initialized CALL DISL XMOVEI T2,PPBUF XMOVEI T1,PPBLCK ; Lock on buffer accesses CALL CLRLCK ; Reset that MOVX T1, ; Allow IP or higher tracing SKIPN MNTRAC+1 ; Filtering on hosts or SKIPE MNTRAC+2 ; Filtering on ports? MOVX T1, ; Yes, switch in filtering MOVEM T1,XPRNPK POP P,T1 ; Restore trace code RET SUBTTL Packet Printer - Process Level Tracing ;PRNPKI/T ;Main Routine, called from all over the IP/TCP. ;T1/ Number saying where the call is from and why ;BFR/ Possible (ext) pointer to a Buffer Header (TCP call only) ;PKT/ Possible (ext) pointer to Packet ;TCB/ Possible (ext) pointer to locked TCB Connection Block (TCP call only) ; MOVX T1,PT%xxx ; TXNN FR,1B0 ; TDNE T1,MNTRAC ; CALL PRNPKI/T ;Ret+1: Always, T1-4 preserved %PIDH (<;>) ; Define offset for destination host %PISH (<;>) ; Define offset for source host PRNPKI:: ; IP/ICMP calls PRNPKT:: ; TCP calls SKIPN MNTRAC ; Tracing packets right now? RET ; No. ADJSP P,20 ; Room for regs on stack MOVEM P,(P) MOVEM 16,-1(P) HRRZI 16,-17(P) ; Save all regs BLT 16,-2(P) RSI XPRNPK, ; Becomes JFCL or filter XCT XPRNPK ; Make sure initialized, filter JRST PRNPKG ; No filter, continue SKIPN T2,MNTRAC+1 ; Filtering on hosts or SKIPE T4,MNTRAC+2 ; Filtering on ports and TXNN T1,PT%%VI ; Code imply packet there? JRST PRNPKG ; No, skip this JUMPE PKT,PRNPKG ; Yes, but skip if no packet CAME T2,PKTELI+$PISH(PKT) ; From there? CAMN T2,PKTELI+$PIDH(PKT) ; Or to there? TRNA ; Yes JUMPN T2,PRNPKX ; No, different, forget it XMOVEI T2,PKTELI(PKT) ; IP header LOAD T3,PIDO,(PKT) ; IP header length, w ADD T2,T3 ; Address of Port bytes MOVE T2,(T2) ; Get them (maybe) LSHC T2,-^D20 ; Source port, right justified in T2 LSH T3,-^D20 ; Destination port, right justified in T3 CAME T2,T4 ; One or CAMN T3,T4 ; the other? TRNA ; Yes JUMPN T4,PRNPKX ; No, different, forget it PRNPKG: MOVE T3,T1 ; Setup for call via LCKCAL MOVEI T4,-17(P) ; Location of AC 0 XMOVEI T1,PPBLCK ; Lock to set (section 0) XMOVEI T2,PKTPRN ; (Extended) Function to call CALL LCKCAL ; Lock the lock and call the function PRNPKX: HRLZI 16,-17(P) ; Locate saved AC0 BLT 16,16 ; Restore all regs ADJSP P,-20 RET SWAPCD ;ps Rarely called ;PKTPRN ;Action routine. ;T1/ Where report is coming from (PT%xxx) ;T2/ Location of saved AC 0 ;BFR/ Possible (ext) pointer to a Buffer Header ;PKT/ Possible (ext) pointer to Packet ;TCB/ Possible (ext) pointer to locked TCB Connection Block ; (All registers saved) ; Call PKTPRN ;Ret+1: Always. PBF==TPKT ; Points to packet tracing buffer PKTPRN: ACVAR XMOVEI PBF,PPBUF ; Set pointer to buffer DMOVEM T1,WHERE ; Save args in safe places MOVE T3,TODCLK ; When report is happening (milliseconds) MOVEM T3,WHEN SETONE ,(PBF) ; Assume not known SETZRO DAUXI,(PBF) ; No aux info SETZRO DSTAT,(PBF) ; No state yet SETZRO ,(PBF) ;No TCB trace info yet ; Decide if valid PKT, BFR, REG or TCB, in that order. Default ; to REG if none of them. TXNE WHERE,PT%%VI ; Supposed to be a packet and SKIPN PKT ; is there one? IFSKP. ; Yes LOAD T1,NBPRO,(PKT) ; Protocol code SKIPE T1 ; None (note may be -1) STOR T1,DPRO,(PBF) ; NP.xxx LOAD T2,NBNCT,(PKT) ; Have an NCT? IFN. T2 ; Yes LOAD T1,NTTYP,(T2) ; Interface type SKIPE T1 ; None STOR T1,DTYP,(PBF) ; NL.xxx LOAD T1,NTDEV,(T2) ; Interface device SKIPE T1 ; None STOR T1,DDEV,(PBF) ; NH.xxx ENDIF. MOVX T1,PPPKSZ ; Portion of packet to sample MOVE T2,PKT ; Address of Packet MOVX T3,ND.PKT ; Data type is Packet JRST PKTPR0 ENDIF. TXNE WHERE,PT%%VB ; Supposed to be a buffer and SKIPN T2,BFR ; is there one? IFSKP. ; Yes MOVX T1,BFRSIZ ; Size of a buffer MOVX T3,ND.BFR ; Data type is Buffer JRST PKTPR0 ENDIF. TXNN WHERE,PT%%VR ; Valid Register sample? IFSKP. ; Yes MOVX T1,20 ; 20 ACs MOVE T2,REGS ; Located here MOVX T3,ND.REG ; Data type is Register JRST PKTPR0 ENDIF. TXNE WHERE,PT%%VH ; Supposed to be a TCB and SKIPN TCB ; is there one? IFSKP. ; Yes LOAD T1,MNPTN ; Get number of words to trace for TCB SKIPN T1 ; Zero? MOVX T1,TCBSIZ ; Yes, trace the entire TCB LOAD T2,MNPTO ; Get the starting offset CAIL T2,TCBSIZ ; Starting offset beyond end of TCB? SETZ T2, ; Yes, take it from the top of the TCB MOVE T3,T2 ; Get the starting offset ADD T3,T1 ; Add in N, giving last word to trace SUBI T3,TCBSIZ ; Get the number of excess words SKIPLE T3 ; Any excess? SUB T1,T3 ; Yes, reduce N by the excess STOR T1,DTCBN,(PBF) ; Save N and Offset the trace header STOR T2,DTCBO,(PBF) ADD T2,TCB ; Get the real start address MOVX T3,ND.TCB ; Data type is TCB JRST PKTPR0 ENDIF. ; Default to REGS MOVX T1,20 ; 20 ACs MOVE T2,REGS ; Located here MOVX T3,ND.REG ; Data type is Register ; JRST PKTPR0 ; Tracing either Packet, Buffer, ACs or TCB ; T1 has the length of what is being traced, and T2 has the address PKTPR0: MOVX T4,PPPKTO ; Header length ADD T4,T1 ; Sample length STOR T4,DLENW,(PBF) STOR WHERE,DPTRC,(PBF) ; Save extended trace code STOR WHEN,DTIME,(PBF) ; Save the report time STOR T2,DPKTP,(PBF) ; Save data address STOR T3,DTYPE,(PBF) ; Save data type XMOVEI T3,PPBUF+PPPKTO ; Corresponding place in buffer CALL XBLTA ; Copy the data TXNN WHERE,PT%%VH ; Valid TCB? IFSKP. ; Yes, save the state LOAD T2,TSTAT,(TCB) ; Get the STAT word STOR T2,DSTAT,(PBF) ; Save it ENDIF. XMOVEI T2,PPBUF ; Dump this out now LOAD T1,DLENW,(T2) ; Number of words in the buffer CALLRET MNTPDP ; Routine to dump PPBUF ENDAV. PURGE PBF SUBTTL Packet Printer - Interrupt Level Tracing RESCD ;ps Called at interrupt level ;IPBCHK Check whether packet pointed to by T2 is for IP protocol. IPBCHK: LOAD CX,NBPRO,(T2) ; Get protocol code SKIPE CX ; Accept zero until NP.IP fully integrated CAIN CX,NP.IP ; IP protocol? AOS (P) ; Yes, skip return RET ; No ;PRNPKH Packet tracing routine called from interrupt level. ;T1/ Trace code, PT%xxx, identifying where the call is from and why ;T2/ 0 if no packet pointer, or ; 0B0+Extended pointer to top of packet buffer to be traced, or ; 1B0+Extended pointer to (canned) local leader, with ;T3/ Formatted DPRO,DTYP,DDEV fields for canned leader. ;VNCT/ Virtual NCT address ; MOVX T1,PT%xxx ; TDNE T1,MNTRAC ; CALL PRNPKH ;Ret+1: Always, T1-4 preserved PKTLTH==PKTELI-SAMPKT+/4+1 ; Length of sample from packet PRNPKH:: SKIPN MNTRAC ; Tracing packets right now? RET ; No. SAVET ; Easier for others SKIPN T4,MNTRAC+1 ; Foreign address to be traced IFSKP. CALL IPBCHK ;(T2) ; IP packet? RET ; No, if want trace, don't set address! LOAD CX,PFLAD,(T2) ; Get foreign local net address CAME CX,T4 ; To be traced? RET ; No, different, forget it ENDIF. MOVE T4,T3 ; Possible DDEV, DPRO, DTYP PIOFF ; Keep others out a while MOVE T3,MNTPTC ; Current ending address CAMG T3,MNTPTE ; Full? IFSKP. AOS MNTPTD ; Yes, Count missing sample PION MOVX T3,1B0 IORM T3,MNTFLG+1 ; Get utility fork to dump it RET ; Cannot do much at PI level ENDIF. MOVEI CX,PPPKTO+PKTLTH ; Length of samples here ADDM CX,MNTPTC ; Update ending address PION STOR T1,DPTRC,(T3) ; Trace code IFG. T2 ; Packet in standard packet buffer LOAD CX,NBPRO,(T2) ; Get transport protocol type code STOR CX,DPRO,(T3) LOAD CX,NTTYP,(VNCT) ; Local net protocol type code STOR CX,DTYP,(T3) LOAD CX,NTDEV,(VNCT) ; Device type code STOR CX,DDEV,(T3) ELSE. ; Not in standard packet buffer SKIPL T2 ; "Canned"? SETO T4, ; No, Don't know what it is MOVEM T4,$DPRO(T3) ; Save pre-formatted DPRO, DTYP, DDEV ENDIF. IFN $DLENW-$DPRO, MOVEI CX,PPPKTO+PKTLTH STOR CX,DLENW,(T3) ; Length of samples here MOVE CX,TODCLK STOR CX,DTIME,(T3) ; Timestamp MOVX CX,ND.PKT ; Data type is Packet STOR CX,DTYPE,(T3) ; Save it in the trace header SETZRO DSTAT,(T3) ; Assume no "status" SETZ CX, EXCH CX,MNTPTD ; # lost samples STOR CX,DAUXI,(T3) STOR T2,DPKTP,(T3) ; PKT address, or .le. 0 ADDI T3,PPPKTO ; Position for packet info MOVEI T1,PKTLTH ; Remaining length IFN. T2 ; Have packet TXZN T2,1B0 ; Canned? IFSKP. ; Yes, pointing at local leader SUB T2,NTHDRL(VNCT) ; Remove leader differences SETZRO DSTAT,-PPPKTO(T3) ; No "flags" ELSE. ; Normal packet to be sampled MOVE CX,PKTFLG(T2) ; Get general flags STOR CX,DSTAT,-PPPKTO(T3) XMOVEI T2,SAMPKT(T2) ; Point to interrupt trace position ENDIF. ELSE. ; No buffer SETONE PT%%VR,+$DPTRC-PPPKTO(T3) ; Might as well give the registers MOVEM 0,(T3) ; Copy AC0 DMOVE T1,-4(P) ; SAVET saved T1-T4 on stack DMOVEM T1,1(T3) DMOVE T1,-2(P) DMOVEM T1,3(T3) IFG ,< MOVX T1,20-5> ; Don't go beyond end of acs IFLE ,< MOVX T1,PKTLTH-5> ; Don't go beyond end of sample MOVEI T2,5 ; BLT from AC5-17 ADDI T3,5 ; Where to put AC5-17 ENDIF. CALL XBLTA ; Data from packet into trace buffer (or 0) MOVX T3,1B0 MOVE T2,MNTPTB ; If in-core buffer is ADD T2,MNTPTE ASH T2,-1 ; Over half full CAMGE T2,MNTPTC IORM T3,MNTFLG+1 ; Get utility fork to dump it RET SUBTTL Packet Printer - In-core Buffer Routines RESCD ;ps Protect from page faults while PIOFF ;MNTPDP ;Dump out PPBUF. Uses PIOFF to lock out Interrupt Level Tracing while ;sample is being moved to the in-core buffer. ;T1/ # words ;T2/ First word ; CALL MNTPDP MNTPDP: PIOFF MOVE T3,MNTPTC ; Current ending address CAMG T3,MNTPTE ; Full? IFSKP. AOS MNTPTD ; Yes, Count missing sample PION MOVX T3,1B0 ; Get Multinet Utility fork to dump it IORM T3,MNTFLG+1 RET ENDIF. ADDM T1,MNTPTC ; Update ending address PION SETZ T4, EXCH T4,MNTPTD ; # lost samples STOR T4,DAUXI,(T2) CALL XBLTA ; Copy MOVE T2,MNTPTB ; If in-core buffer is ADD T2,MNTPTE ASH T2,-1 ; Over half full CAML T2,T3 ; (T3 is MNTPTC) RET ; No, return MOVX T3,1B0 IORM T3,MNTFLG+1 ; Get utility fork to dump it RET ; SWAPCD ;ps No more PIOFF SUBTTL Multinet Trap Event Logging RESCD ; Called at interrupt level ;For the current time, use the packet tracing buffer to log events. ;Should make a separate facility, maybe later. ;MNTRAP ;Log a trap event by dumping the registers. Let the post processor ;worry about which are significant, etc. ;CX/ Trap code ;ACs/ Hopefully something about event (but not necessary) ;Ret+1: Always, all registers are unchanged. MNTRAP:: JFCL ; Until better integrated, default OFF RET PUSH P,CX ; Save trap code PIOFF ; Protect pointers from interrupts MOVE CX,MNTPTC ; Current free position CAMG CX,MNTPTE ; Beyond useable end? IFSKP. ; Yes AOS MNTPTD ; Count another dropped sample PION ; Allow interrupts MOVX CX,1B0 ; Request utility fork to dump buffer IORM CX,MNTFLG+1 POP P,CX ; Restore registers RET ; Give up ENDIF. MOVX CX,PPPKTO+20 ; Sample length ADDB CX,MNTPTC ; Update free position PION ; Allow interrupts SUBI CX,PPPKTO+20 ; Find start of sample DMOVEM 0,0+PPPKTO(CX) ; Save the registers DMOVEM 2,2+PPPKTO(CX) ; Is setting up for CALL XBLTA faster? DMOVEM 4,4+PPPKTO(CX) DMOVEM 6,6+PPPKTO(CX) DMOVEM 10,10+PPPKTO(CX) DMOVEM 12,12+PPPKTO(CX) DMOVEM 14,14+PPPKTO(CX) POP P,16+PPPKTO(CX) ; Save CX PUSH P,16+PPPKTO(CX) MOVEM 17,17+PPPKTO(CX) ; Fillin the trace header SETZRO ,(CX) MOVX T1,PPPKTO+20 ; Sample length STOR T1,DLENW,(CX) MOVE T1,-1(P) ; Trap code STOR T1,DPTRC,(CX) MOVE T1,TODCLK ; Sample time STOR T1,DTIME,(CX) SETZRO DSTAT,(CX) ; Unused SETZ T1, EXCH T1,MNTPTD ; Number of lost samples STOR T1,DAUXI,(CX) MOVE T1,-2(P) ; Caller's return address STOR T1,DPKTP,(CX) MOVX T1,ND.REG ; Data type is Register STOR T1,DTYPE,(CX) ; Save it MOVE 1,1+PPPKTO(CX) ; Restore T1 ; Check if full enough to request dump MOVE CX,MNTPTB ; If in-core buffer is ADD CX,MNTPTE ASH CX,-1 ; Over half full CAML CX,MNTPTC IFSKP. ; Yes MOVX CX,1B0 IORM CX,MNTFLG+1 ; Get utility fork to dump it ENDIF. POP P,CX ; Restore CX RET ; All done ; RESCD ;ps Keep write routine in core for quick access ;MNTPWR Dump trace buf, called by Multinet Utility Fork/MDDT at process level. MNTPWR: MOVE T1,FORKX ; Make sure correct fork CAMN T1,MNTFRK+1 ; Multinet Utility? IFSKP. MOVX T1,1B0 ; No, ask for it IORM T1,MNTFLG+1 ; Get utility fork to dump it RET ENDIF. MOVE T3,MNTPTC ; Get current end pointer EXCH T3,MNTPTO ; Uninterruptable set lock/check if was locked SKIPE T3 BUG.(CHK,MNTPWL,MNETDV,SOFT,,,< Cause: The Multinet utility fork wants to lock the packet tracing buffer but found that it already had it locked. This may have been caused by a previous illegal interrupt (MNTUX1). The resulting trace file may contain bad data, try again. >) MOVX T1, HRROI T2,MNTRFN ; File name SKIPE MNTCPT ; TCP user's file HRROI T2,MNTCFN GTJFN% JRST MNTPWX ; Quit MOVE T3,T1 ; Save JFN in case OPENF% fails MOVX T2, ; Open for 36 bit append OPENF% JRST MNTPWV ; Quit, releasing JFN MOVE T2,MNTPTC ; Get current end (for first phase) PUSH P,T2 ; May have a second phase MOVE T4,MNTPTB ; Extended start address MOVE T3,T4 ; Beginning SUB T3,T2 ; -End is negative length for SOUT MOVSI T2,(POINT 36,0(T4)) ; Pointer to beginning SKIPGE T3 ; May save a little SOUT% ; Write out trace info EXCH T4,MNTPTC ; Uninterruptable start at beginning/get end MOVN T3,T4 ; -End POP P,T4 ; "Beginning" of second phase ADD T3,T4 ; +Beginning is negative length for SOUT MOVSI T2,(POINT 36,0(T4)) ; Pointer to beginning SKIPGE T3 ; May save a little SOUT% ; Write out trace info CLOSF% ; Close trace file JFCL SETZM MNTPTO ; Unlock MNTPWR RET ; Cannot access trace file, discard the trace data and contine MNTPWV: MOVE T1,T3 ; Get JFN back RLJFN% ; Release it JFCL MNTPWX: MOVE T4,MNTPTB ; Extended start address MOVEM T4,MNTPTC ; is where to start over SETZM MNTPTO ; Unlock TCPPWR RET SWAPCD ;ps End of write routine IFN IPPDSW,< repeat 0,< ;MNTPSO ;Open file for simulation. ;MNTPSR ;Read the next simulated packet. ;MNTPSC ;Close simulation file. ;MNTPSF ;Free the simulated packets. ; Debugging and tracing utilities (used from MDDT) ; Read packets from file & insert where desired ; CALL MNTPSO$X to Open file for Simulation ; ; if OK ; CALL MNTPSR to Read the next Simulated packet ; if OK with PKT set ; CALL SNDGAT$X ,e.g. to send the packet ; CALL MNTPSC to Close the Simulation file and ; CALL MNTPSF to Free the Simulated packets MNTPSO: CALL MNTPSC ; Open Simulation file (close old one) MOVX T1, MOVX T2,<.PRIIN,,.PRIOU> GTJFN% ; Get name from TTY: (MDDT) RET MOVEM T1,MNTPSJ MOVX T2, OPENF% ; Open file for reading RET AOS (P) ; OK return skips RET MNTPSC: SETZ T1, ; Close Simulation file EXCH T1,MNTPSJ SKIPE T1 CLOSF% JFCL RET MNTPSF: MOVE T1,MNTPSQ ; Free packets from Simulation Queue JUMPE T1,MNTPSV JN PINTL,(T1),MNTPSV MOVE T2,PKTQ(T1) MOVEM T2,MNTPSQ CALL RETBLK JRST MNTPSF MNTPSR: MOVE T1,MNTPSJ ; Read next packet from Simulation file BIN% ERJMP MNTPSV HLRZ T1,T2 ; Free size JUMPLE MNTPSV PUSH P,T1 ADDI T1,NBHDRL ; plus buffer overhead CALL GETBLK ; Get storage for packet XMOVEI PKT,NBHDRL(T1) MOVN T3,(P) POP P,(P) JUMPLE PKT,MNTPSV MOVE T1,MNTPSJ MOVX T2, SIN% ; Read packet into it ERJMP MNTPSU SETONE PPROG,(PKT) ; We will hang on to packet MOVE T1,MNTPSQ ; (may want to try again) MOVEM T1,PKTQ(PKT) MOVEM PKT,MNTPSQ ; Place it in our queue MOVE T1,MNTPSA STOR T1,PIDH,(PKT) ; Fake the address AOS (P) RET MNTPSU: MOVE T1,PKT ; Lose, free packet CALL RETBLK MNTPSV: RET ; Create a file of packets from some point in code (XXX:) ; Initialize trace with trace off & when done CALL MNTPWR ; xxx: CALL MNTPSS MNTPSS: CAIE T1,-1 ; Fill in with desired values CAIN T1,-1 ; if filtering desired CAIA RET XMOVEI T2,(PKT) ; Beginning of packet HLRZ T1,-1(PKT) ; Free storage block length fix.adr JRST MNTPDP+2 ; Dump ,N > ; End of repeat 0 > ; END OF IFN IPPDSW DCHECK ; Verify domain values for consistency TNXEND END ; Of MNETDV