; UPD ID= 2088, SNARK:<6.1.MONITOR>IPIPIP.MAC.13, 3-Jun-85 14:46:18 by MCCOLLUM ;TCO 6.1.1406 - Update copyright notice. ; UPD ID= 1769, SNARK:<6.1.MONITOR>IPIPIP.MAC.12, 22-Apr-85 09:45:48 by PAETZOLD ;TCO 6.1.1333 - allow sc%whl and sc%opr to work for .ASNIQ. ; UPD ID= 1717, SNARK:<6.1.MONITOR>IPIPIP.MAC.11, 5-Apr-85 15:13:11 by PAETZOLD ;TCO 6.1.1308 - Make SNDLC4 check PFSIZ and behave accordingly. ; UPD ID= 1709, SNARK:<6.1.MONITOR>IPIPIP.MAC.10, 2-Apr-85 08:18:35 by PAETZOLD ;TCO 6.1.1303 - Up the priority of the internet fork. ; UPD ID= 1596, SNARK:<6.1.MONITOR>IPIPIP.MAC.9, 6-Mar-85 13:30:51 by PAETZOLD ;document bugxxx's ; UPD ID= 1573, SNARK:<6.1.MONITOR>IPIPIP.MAC.8, 26-Feb-85 17:18:24 by PAETZOLD ;document bugxxx's ; UPD ID= 1036, SNARK:<6.1.MONITOR>IPIPIP.MAC.7, 12-Nov-84 15:24:45 by PAETZOLD ;TCO 6.1041 - Move ARPANET to XCDSEC ; UPD ID= 1000, SNARK:<6.1.MONITOR>IPIPIP.MAC.6, 7-Nov-84 14:46:58 by PRATT ;TCO 6.1.1030 - Add CI TCP/IP. Call CIPSRV from Internet fork ; UPD ID= 315, SNARK:IPIPIP.MAC.18, 30-Oct-84 09:41:39 by PAETZOLD ;TCO 6.2266 - Fix SQX1 reference in RELIQ7 ; UPD ID= 313, SNARK:IPIPIP.MAC.17, 18-Oct-84 15:41:39 by PAETZOLD ;Fix up RETPKT for BF18SZ changes. ; UPD ID= 300, SNARK:IPIPIP.MAC.16, 1-Oct-84 14:14:24 by PAETZOLD ;Fix typo/bug in .ASNIQ. ; UPD ID= 286, SNARK:IPIPIP.MAC.15, 24-Sep-84 13:54:44 by PURRETTA ;Update copyright notice. ; UPD ID= 278, SNARK:IPIPIP.MAC.14, 8-Sep-84 10:20:38 by PAETZOLD ;Fix PI context smashing bug in IPLTRK. ; UPD ID= 274, SNARK:IPIPIP.MAC.13, 6-Sep-84 12:00:05 by PAETZOLD ;Additional ILULK2 debuging stuff. ; UPD ID= 230, SNARK:IPIPIP.MAC.12, 8-Aug-84 14:27:05 by PAETZOLD ;TCO 6.2165 - Zero Checksum word in ICMER9 before calling ICMCKS. ; UPD ID= 153, SNARK:IPIPIP.MAC.11, 31-May-84 10:58:25 by PAETZOLD ;Add interface state resolution code. ENDSV.'s. ; UPD ID= 144, SNARK:IPIPIP.MAC.10, 30-May-84 09:36:44 by PAETZOLD ;Fix ILMNRF problem with .ASNIQ. Also check for bad user bits in ASNIQ%. ; UPD ID= 134, SNARK:IPIPIP.MAC.9, 15-May-84 08:35:38 by PAETZOLD ;Turn off IPLDSW. ; UPD ID= 86, SNARK:IPIPIP.MAC.8, 10-May-84 10:59:02 by PAETZOLD ;Get to INTNRB via a CALL and not a CALLRET in INTBP1. ; UPD ID= 32, SNARK:IPIPIP.MAC.7, 7-Apr-84 13:08:10 by PAETZOLD ;It's not nice when your debuging code smashes your ACs ; UPD ID= 30, SNARK:IPIPIP.MAC.6, 5-Apr-84 22:42:57 by PAETZOLD ;Add IPLDSW stuff ; UPD ID= 25, SNARK:IPIPIP.MAC.5, 4-Apr-84 16:55:12 by PAETZOLD ;Always return NI buffers in RETPKT. ; UPD ID= 8, SNARK:IPIPIP.MAC.4, 2-Apr-84 12:19:39 by PRATT ;Remove FTIPNI, dummy NIPSRV routine is in STG. ; UPD ID= 4, SNARK:IPIPIP.MAC.3, 27-Mar-84 16:57:01 by PAETZOLD ;More TCO 6.1733 - Mark host up when receiving ICMP ECs and ERs. ; Translate local job number to global in ASNIQ% for release 6. ; UPD ID= 3, SNARK:IPIPIP.MAC.2, 25-Mar-84 17:03:42 by PRATT ;Make changes for IPNIDV: INTLKB,INTULK,ICMERR, Call to NIPSRV ; UPD ID= 3936, SNARK:<6.MONITOR>IPIPIP.MAC.14, 17-Mar-84 13:01:43 by PAETZOLD ;More TCO 6.1733 - More cleanup. ; UPD ID= 3895, SNARK:<6.MONITOR>IPIPIP.MAC.13, 11-Mar-84 10:36:30 by PAETZOLD ;More TCO 6.1733 - Handle destination unreachable ICMP messages. Change ;GWYFNB BUGHLT into a BUGHCK and handle it. Remove NTHSHF BUGHLT. Up ;the hold time of the internet fork to one second. Do check IMPNOS in ;INTBPT. ; UPD ID= 3824, SNARK:<6.MONITOR>IPIPIP.MAC.12, 29-Feb-84 18:13:31 by PAETZOLD ;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug fixes. Cleanup. ;IPIPIP.MAC.4, 6-Dec-83 23:52:17, Edit by PAETZOLD ;TCO 6.1872 - Always call SIQCHK in INTBP1 ;TCO 6.1867 - Use SAVEAC and not SAVP1 ;Remove foolish question mark from INGWA1 ;Move gateway block symbols to ANAUNV from here ;TCO 6.1836 - Make GWYINI global ;More TCO 6.1733 - Fix some Gateway problems ;TCO 6.1630 - PSIMB/MONBK Fix ;IPIPIP.MAC.7, 5-Jul-83 08:25:46, Edit by PAETZOLD ;TCP Merge for 5.1 ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED ;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1976, 1985. ;ALL RIGHTS RESERVED. SEARCH ANAUNV,PROLOG TTITLE (IPIPIP,IPIPIP,< - ARPANET Internet Protocols>) IFNDEF REL6, IF1 > IF1 > SUBTTL Lock Handling $INIT IFE REL6, IFN REL6, COMMENT ! These routines are the lowest level lock manipulating functions. This whole module may be replaced by some other for the purposes of testing as long as the functionality of the individual routines is preserved. ! SUBTTL Lock Handling - Clear and Release Locks ;CLRLCK Initialize a lock. ;T1/ (Extended) Pointer to lock ; CALL CLRLCK ;Ret+1: always CLRLCK::LOCAL MOVEM T1,LOCKPT CALL ASNWTB ; Assign a wait bit index STOR T1,LIDX,(LOCKPT) SETONE LWORD,(LOCKPT) SETZRO LLOKR,(LOCKPT) ; Clear last locker SETZRO LCCNT,(LOCKPT) ; Clear conflict count RESTORE RET ;RELLCK Release a lock handle. ;T1/ (Extended) Pointer to lock ; CALL RELLCK ;Ret+1: always RELLCK::LOAD T1,LIDX,(T1) ; Wait bit index CALLRET RELWTB ; Release it SUBTTL Lock Handling - Seize Locks and Free Locks ;SETLCK Seize a lock. ;T1/ (Extended) Pointer to lock ; CALL SETLCK ;Ret+1: Always. NOINT, lock set. SETLCK::LOCAL MOVEM T1,LOCKPT SETLC0: NOINT LOAD T1,LIDX,(LOCKPT) ; Get the wait bit index CALL SETWTB ; Set it OPSTR ,LWORD,(LOCKPT) ; Attempt to get the lock JRST SETLC1 ; Got it. Return NOINT. INCR LCCNT,(LOCKPT) ; Increment the conflict count LOAD T2,LLOKR,(LOCKPT) ; Get the current locker STOR T2,LOLKR,(LOCKPT) ; Save as the Old locker MOVE T2,PROC ; Get our own process ID STOR T2,LNLKR,(LOCKPT) ; Save this as the New locker AOS GENCFL ; Count up general conflicts OKINT LOAD T1,LIDX,(LOCKPT) ; Get the wait bit index HRLI T1,INTBZT ; Select the wait bit zero test MOVSS T1 MDISMS JRST SETLC0 SETLC1: MOVE T2,PROC ; ID of this process STOR T2,LLOKR,(LOCKPT) ; Say it is us that has the lock RESTORE RET ;UNLCK Free a lock. ;T1/ (Extended) Pointer to lock ; CALL UNLCK ;Ret+1: always UNLCK:: SETONE LWORD,(T1) LOAD T1,LIDX,(T1) ; Get the wait bit index CALL CLRWTB ; Indicate not locked OKINT RET SUBTTL Queue Handling $INIT IFE REL6, IFN REL6, COMMENT ! Queues are double linked lists. The left half word points back to the previous item and the right half word points forward to the next item. Each queue has a head which looks like any other item. When a queue is empty, the previous and next pointers of the head both point at the head itself. ! SUBTTL Queue Handling - Event Tracking ; IP Queue Manipulation Debugging code and storage IFN IPQDSW,< ; Queue event ring buffer entries have the following format .IPQFX==0 ; word 0/ 525252,,FORKX .IPQBK==1 ; word 1/ Address of ITEM .IPQQH==2 ; word 2/ address of queue head pointer .IPQTD==3 ; word 3/ TODCLK value .IPQHP==4 ; word 4/ HP time value .IPQTK==5 ; word 5/ Stack Cells .IPQTS==5 ; number of stack words to save IPQLEN==<.IPQTK+.IPQTS>-.IPQFX+1 ; Length of ring entry IPQRNN==^D50 ; number of entries in ring buffer RS IPQRNG, ; QUEUE EVENT RING BUFFER RS IPQADR,1 ; CURRENT RING BUFFER ADDRESS IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT IPQTRK: ; TRACK IP QUEUE EVENTS PUSH P,T1 ; SAVE ACS (CAN NOT USE SAVEAC) PUSH P,T2 PUSH P,T3 PUSH P,T4 SETO T3, ; ASSUME PI IS ON CONSO PI,PIPION ; IS PI ON? TDZA T3,T3 ; NO SO TURN OFF FLAG PIOFF ; YES SO MAKE THE MACHINE MINE MOVE T1,IPQADR ; GET THE CURRENT RING POINTER ADDI T1,IPQRNG ; OFFSET BY BASE ADDRESS OF THE RING BUFFER HRRZ T2,FORKX ; GET OUR FORKX HRLI T2,525252 ; GET THE MAGIC CODE MOVEM T2,.IPQFX(T1) ; SAVE THE FIRST WORD MOVE T2,-3(P) ; GET THE ADDRESS OF THE BLOCK MOVEM T2,.IPQBK(T1) ; SAVE IT MOVE T2,-2(P) ; GET THE ADDRESS OF THE QUEUE HEADER MOVEM T2,.IPQQH(T1) ; SAVE IT MOVE T2,TODCLK ; GET THE CURRENT TODLCK MOVEM T2,.IPQTD(T1) ; SAVE TODCLK VALUE ALSO PUSH P,T1 ; SAVE T1 JSP T4,MTIME ; GET THE HPTIM MOVE T2,T1 ; GET TIME IN PROPER PLACE POP P,T1 ; RESTORE MOVEM T2,.IPQHP(T1) ; NOW SAVE THE LAST .IPSTS STACK CELLS HRLI T2,-<.IPQTS+3>(P) ; GET THE ADDRESS OF THE FIRST STACK WORD HRRI T2,.IPQTK(T1) ; GET THE ADDRESS OF THE FIRST RING STACK WORD BLT T2,<.IPQTK+.IPQTS-1>(T1) ; SAVE THE STACK CELLS ; NOW MOVE THE RING BUFFER ADDRESS MOVE T1,IPQADR ; GET THE RING ADDRESS AGAIN ADDI T1,IPQLEN ; BUMP THE RING POINTER CAIL T1, ; SHOULD THE POINTER LOOP AROUND? SETZ T1, ; YES SO MAKE IT LOOP MOVEM T1,IPQADR ; SAVE THE NEW RING POINTER SKIPE T3 ; SHOULD WE GO PION? PION ; YES SO GIVE BACK THE MACHINE JRST PA4 ; POP ACS AND RETURN TO CALLER IFE REL6, IFN REL6, > ; end of IPQDSW SUBTTL Queue Handling - Initialization and Clearing ;INITQ Initialize a queue head ;T1/ (Extended) Pointer to the queue head ; CALL INITQ ;Ret+1: always INITQ:: TEMP STOR QHEAD,QPREV,(QHEAD) ; Make previous(head) point to the head STOR QHEAD,QNEXT,(QHEAD) ; Make next(head) point to the head RESTORE RET ;CLEARQ Clear a queue between two items ;The items themselves are not removed. A common use is to make the ;"from" and "to" pointer both be the queue head in order to clear all ;items off the queue. ;T1/ (Extended) "From" item pointer ;T2/ (Extended) "To" item pointer ; CALL CLEARQ ;Ret+1: always CLEARQ::LOCAL DMOVEM T1,FROM ; T1, T2 to FROM, TO CLRQ1: LOAD T1,QNEXT,(FROM) ; Get pointer to next item? SETSEC T1,INTSEC ; Make into extended pointer CAMN T1,TO ; Points to the last one? EXIT CLRQX ; Yes. Get out. CALL DQ ; Remove it from the queue (value is T1) CALL RETBLK ; Return block to free storage JRST CLRQ1 CLRQX: RESTORE RET SUBTTL Queue Handling - Enqueueing and Dequeueing ;NQ Add an item to a queue just to the left of another item. ;Usual application is where the other item is the queue head. This ;has the effect of adding the new item to the end of the queue. ;T1/ (Extended) Item pointer ;T2/ (Extended) Queue head pointer ; CALL NQ ;Ret+1: always, value is the new item. NQ:: IFN IPQDSW, ; If debuging queue maniulations TEMP SKIPE 0(ITEM) BUG.(HLT,INTNQ1,IPIPIP,SOFT,,,< Cause: The TCP/IP list enqueuing facility was called for an item which was already queued on a list. >) STOR QHEAD,QNEXT,(ITEM) ; Make Item point forward to the head LOAD PREV,QPREV,(QHEAD) ; Pointer to thing to left of head SETSEC PREV,INTSEC ; Make into extended pointer STOR PREV,QPREV,(ITEM) ; Is now to the left of new item STOR ITEM,QNEXT,(PREV) ; New item is now to right of prev. STOR ITEM,QPREV,(QHEAD) ; and to left of the head. RESTORE RET ;DQ Remove an item from a queue. ;T1/ (Extended) Pointer to the item to be dequeued ; CALL DQ ;Ret+1: always. Value is the item dequeued. Queue slot is cleared. DQ:: IFN IPQDSW, ; If debuging queue maniulations TEMP SKIPN 0(ITEM) BUG.(HLT,INTNQ2,IPIPIP,SOFT,,,< Cause: The TCP/IP list dequeuing facility was called for an item which was not queued on a list. >) LOAD PREV,QPREV,(ITEM) SETSEC PREV,INTSEC ; Make extended address LOAD NEXT,QNEXT,(ITEM) SETSEC NEXT,INTSEC ; Make into extended pointer STOR NEXT,QNEXT,(PREV) STOR PREV,QPREV,(NEXT) SETZM 0(ITEM) ; Indicate this item not queued. RESTORE RET SUBTTL Wait Bit Routines $INIT COMMENT ! INTWTB is a pool of bits which are dynamically assigned to things which the INT may have to wait on such as non-resident locks, and buffer done conditions. These bits are in resident storage for efficiency reasons. INTBFF is a parallel bit table which tells which bits are free. ! ; Define a TCP-compatible error code (should be a TOPS20 standard error ; code here anyway): ELT==300 SUBTTL Wait Bit Initialization, Assignment, and Deassignment ;WTBINI Initialize Buffer Free Flag pool. ; CALL WTBINI ;Ret+1: Always. IFE REL6, IFN REL6, WTBINI: MOVSI T1,-NTWBWD ; Number of words in the pool MOVE T2,[-1-1B0] ; Never use index 0 MOVEM T2,INTBFF(T1) ; Clear free flags SETO T2, AOBJN T1,.-2 RET ;ASNWBT Assign a wait bit index. ; CALL ASNWBT ;Ret+1: Always. T1 has the index or -1,,error ASNWTB::NOSKED ; Only one process at a time MOVSI T3,-NTWBWD ; Number of words in bit table ASNWT0: SKIPE T1,INTBFF(T3) ; Any free bits in this word? JFFO T1,ASNWB1 ; Yes. Get bit number AOBJN T3,ASNWT0 ; No. Try next JRST ASNWB9 ; No free buffer bits ASNWB1: MOVE T1,BITS(T2) ; Get the corresponding bit mask ANDCAM T1,INTBFF(T3) ; Make it not free HRRZS T3 ; Get word offset IMULI T3,^D36 ; Convert to bits ADD T3,T2 ; Add bit within last word SKIPA T1,T3 ; That's the result ASNWB9: HRROI T1,ELT+^D16 ; "No space right now" OKSKED RET ;RELWTB Release the wait bit assignment. ;T1/ Bit index to INTWTB ; CALL RELWTB ;Ret+1: Always. RELWTB::JUMPE T1,RELWTX ; Beware IDIVI T1,^D36 ; Convert to word and bit MOVE T2,BITS(T2) ; Get corresponding bit mask TDNE T2,INTBFF(T1) ; Better be in use right now. BUG.(HLT,INTWA0,IPIPIP,SOFT,,,< Cause: The TCP/IP release wait bit mechanism was called to release a wait bit and the wait bit facility was determined to be corrupted. >) IORM T2,INTBFF(T1) ; Free it RELWTX: RET SUBTTL Wait Bit State Changing Routines ;SETWTB Set a wait bit to one state. ;T1/ Index of bit ; CALL SETWTB ;Ret+1: Always. SETWTB::SETZ T2, ; Beware bit 0 JUMPE T1,SETWTE IDIVI T1,^D36 MOVE T2,BITS(T2) ; Get bit mask TDNE T2,INTBFF(T1) ; Check that it is assigned SETWTE: BUG.(CHK,INTWA1,IPIPIP,SOFT,,,< Cause: The TCP/IP wait bit facility was called to set a wait bit and the wait bit has not been assigned. >) IORM T2,INTWTB(T1) ; Set the bit RET ;CLRWTB Clear a wait bit to zero state. ;T1/ Index of bit ; CALL CLRWTB ;Ret+1: Always. CLRWTB::SETZ T2, ; Beware bit 0 JUMPE T1,CLRWTE IDIVI T1,^D36 MOVE T2,BITS(T2) TDNE T2,INTBFF(T1) CLRWTE: BUG.(CHK,INTWA2,IPIPIP,SOFT,,,< Cause: The TCP/IP wait bit facility was called to reset a wait bit and the wait bit has not been assigned. >) ANDCAM T2,INTWTB(T1) RET SUBTTL Wait Bit Single Bit Scheduler Test Routines ;INTBZT Scheduler test for a wait bit zero. ;T1/ Wait Bit Index ;T4/ Return address ; JSP T4,INTBZT ;Ret+1: Bit not zero ;Ret+2: Bit is zero RESCD INTBZT: JUMPE T1,INTBZX ; Beware bit 0 IDIVI T1,^D36 ; Convert to word and bit numbers MOVE T2,BITS(T2) ; Get bit mask TDNE T2,INTWTB(T1) ; Zero yet? JRST 0(T4) ; No INTBZX: JRST 1(T4) ;INTBOT Scheduler test for a wait bit being on. ;T1/ Index to INTWTB ;T4/ Return address ; JSP T4,INTBOT ;Ret+1: Wait flag still off ;Ret+2: Wait flag now on INTBOT: JUMPE T1,INTBOX ; Beware bit 0 IDIVI T1,^D36 MOVE T2,BITS(T2) TDNN T2,INTWTB(T1) JRST 0(T4) INTBOX: JRST 1(T4) SUBTTL Wait Bit Multiple Bit Scheduler Tests ;INTOOT Scheduler test for either of 2 bits becoming a one. ;T1/ Index1 in left half of right half, Index 2 in RH of RH ;T4/ Return address ; JSP T4,INTOOT ;Ret+1: Both bits are still off ;Ret+2: One or both of the bits are now on INTOOT::IDIVI T1,1000 ; Index1 to T1, Index2 to T2 MOVE T3,T2 ; Save Index2 JUMPE T1,INTOOX ; Beware bit 0 IDIVI T1,^D36 ; Separate in to word and bit number MOVE T2,BITS(T2) ; Get the bit TDNE T2,INTWTB(T1) ; Is bit1 on? JRST 1(T4) ; Yes. Give skip return. MOVE T1,T3 ; Get Index2 JUMPE T1,INTOOX ; Beware bit 0 IDIVI T1,^D36 MOVE T2,BITS(T2) TDNN T2,INTWTB(T1) ; Is that bit on? JRST 0(T4) ; No. INTOOX: JRST 1(T4) ; Yes. ;INTZOT Scheduler test for a bit becoming 0 or another becoming 1. ;T1/ Index1 in left half of right half, Index 2 in RH of RH ;T4/ Return address ; JSP T4,INTZOT ;Ret+1: Index1 still on and Index2 still off ;Ret+2: Either Index1 has gone off or Index2 has come on, or both INTZOT::IDIVI T1,1000 ; Index1 to T1, Index2 to T2 MOVE T3,T2 ; Save Index2 JUMPE T1,INTZOX ; Beware bit 0 IDIVI T1,^D36 ; Get word and bit number MOVE T2,BITS(T2) ; Get the bit TDNN T2,INTWTB(T1) ; Is bit1 off? JRST 1(T4) ; Yes. Give skip return. MOVE T1,T3 ; Get Index2 JUMPE T1,INTZOX ; Beware bit 0 IDIVI T1,^D36 MOVE T2,BITS(T2) TDNN T2,INTWTB(T1) ; Is bit2 on? JRST 0(T4) ; No. INTZOX: JRST 1(T4) ; Yes. SUBTTL Internet Process Switching (INTFRK) $INIT IFE REL6, IFN REL6, COMMENT ! These routines control the running of the various Internet processes such as the Internet User Queue mechansism, TCP, etc. This process keeps a supply of input buffers available for the various interfaces and handles returning of spent buffers. ! SUBTTL Internet Fork - Startup and Initialization ;INTBEG Start the Internet process at system startup time. ; CALL INTBEG ;Ret+1: Always. IFE REL6, IFN REL6, MOVSI T1,(CR%CAP) CFORK ; Get a fork of JOB0 BUG.(HLT,INTMA0,IPIPIP,SOFT,,,< Cause: During system initialization the monitor was not able to create a fork for the TCP/IP asynchronous process. >) XMOVEI T2,INTBP0 MSFRK ; Start fork in monitor mode RET INTBP0: ; Internet fork top level IFE REL6,< MOVSI T1,(PC%USR) ; User mode bit MOVEM T1,FPC ; Fake a return PC > IFN REL6,< MOVX T1,USRCTX ; INIT CONTEXT MOVEM T1,FFL SETZM FPC > MCENTR ; Establish monitor context IFE REL6, ; make sure section one MOVX T1, ; GET THE SYS BIT MOVEM T1,JOBBIT ; MAKE SURE WE CAN GO FAST MOVE T1,FORKX ; ID of this fork MOVEM T1,INTFRK ; Save for debugging IFE REL6, IFN REL6, MOVEM T1,MONBK ; Setup unexpected interrupt dispatch MOVE T1,CHNSON MOVEM T1,MONCHN ; Setup for panic channels MOVEI T1,NETSUP ; wait for CALL DISL ; network hardware to be inited CALL IMPIN0 ; initialize all the 1822 level stuff CALL INTINI ; initialize internet stuff SUBTTL Internet Fork - Main Loop PIX==5 PTB==6 PTL==7 INTBP1: ; Main loop for the internet fork IFE REL6, ; Return for following routines. IFN REL6, ; Return for following routines. SETZM INTFLG ; Clear forced run flag. SKIPE IMINFB ; Garbage buffers to release? CALL IMINRB ; yes so go release them CALL IMPCHK ; do input processing ; resolve states of interfaces SKIPA P1,NCTVT ; Get link to first nct INBPS1: LOAD P1,NTLNK,(P1) ; Get NCT address JUMPE P1,INBPS2 ; All NCTs scanned? LOAD T1,NTTYP,(P1) ; Get type of interface XMOVEI T2,MNTRSV ; Assume non 1822 interface CAIN T1,NT.NCP ; 1822 type? XMOVEI T2,IMPSTS ; yes so use alternate routine CALL 0(T2) ; Make interface have the desired state JRST INBPS1 ; Loop through all NCTs INBPS2: ; here after all NCTs checked MOVE T1,TODCLK ; get the current time CALL SIQCHK ; yes so go check the special queues MOVEM T1,SIQNXT ; save the new time to check special queues MOVEM T1,IBPTIM ; save the time the next 1822 stuff needed MOVE T1,TODCLK ; Check if time to discard CAML T1,INTRAT ; timedout IP fragments CALL RCVFLS ; Yes SKIPE INTIBO ; Packets waiting for dispatch? CALL INTDSP ; Yes. Hand them out to TCP, etc. SKIPE INTNFB ; Any empty output buffers around? CALL INTNRB ; Yes. Go release them. MOVE T1,INTNFI ; Number of free input buffers CAMGE T1,INTNIB ; Below desired level? CALL INTGIB ; Yes. Go queue some more for PI level.... CALL NIPSRV ; See if IP Ethernet driver needs anything IFN REL6, ; See if IP CI driver needs anything MOVEI PTB,INTPIX+1 ; ... MOVE PIX,-1(PTB) HRRZ PTL,PIX INTBP3: SKIPLE T2,.INTPP(PTB) ; Processing routine SKIPN .INTPO(PTB) ; Check if its ON JRST INTBP4 ; Skip it if no routine or not on MOVE T1,.INTPT(PTB) ; Next run time CAMLE T1,TODCLK ; Call if time to run SKIPE .INTPF(PTB) ; or run flag set CALL (T2) ; Call protocol processor INTBP4: ADD PTB,PTL AOBJN PIX,INTBP3 HRLOI T1,377777 ; Next run time unless needed sooner MOVEI PTB,INTPIX+1 MOVE PIX,-1(PTB) HRRZ PTL,PIX INTBP6: SKIPLE T2,.INTPC(PTB) ; Time check routine CALL (T2) ; Call protocol time checker ADD PTB,PTL AOBJN PIX,INTBP6 CAMLE T1,IBPTIM ; need 1822 stuff sooner? MOVE T1,IBPTIM ; yes so get the time it is needed MOVEM T1,INTTIM ; Set wakup JSP T4,INTBPT ; Run the test at process level CAIA ; To save overhead of scheduler RET ; Back to INTBP1 MOVEI T1,INTBPT ; Select the activation test HDISMS 1000 ; Keep us around for a while RET PURGE PIX,PTB,PTL INTUXI: ; Unexpected interrupt BUG.(CHK,INTMA1,IPIPIP,SOFT,,,< Cause: The TCP/IP asynchronous process has received an unexpected software interrupt. >) IFE REL6, ; Enter section 1 MCENTR JRST INTBP1 ;INTBPT Scheduler activation test for Internet fork. ; JSP T4,INTBPT ;Ret+1: Internet fork not ready to run ;Ret+2: Internet fork runnable RESCD INTBPT: SKIPE INTFLG ; Forced run? JRST 1(T4) ; Yes. MOVE T1,TODCLK ; Current millisecond number CAML T1,INTTIM ; After desired wakeup time? JRST 1(T4) ; Yes. JRST 0(T4) IFE REL6, IFN REL6, SUBTTL Internet Fork - Buffer Releasing ;INTNRB Release packet buffers left by PI level ;INTNFB/List of freed buffers ; CALL INTNRB ;Ret+1: Always INTNRB: IFN IPLDSW,> SETZ T4, EXCH T4,INTNFB ; Get and clear free list IFN IPLDSW, ; save the head of the list if debuging INTNR1: SKIPN T4 ; Quit at end of list RET SETSEC T4,INTSEC ; Make extended address XMOVEI T2,0(T4) ; Pointer to IMPDV part of packet LOAD T4,NBQUE,(T4) ; Pointer to CDR of list CALL INTRBF ; Release on buffer to INT free area JRST INTNR1 ;INTRBF Release an IMPDV-style packet to INT free area. ;T2/ (Extended) Pointer to IMPDV portion of packet ;T4/ MUST BE PRESERVED ; CALL INTRBF ;Ret+1: Always INTRBF::SAVEAC PUSH P,T2 MOVE T1,T2 CALL INTULK ; Unlock the packet POP P,T2 ; Get back IMP style pointer XMOVEI T1,-LCLPKT(T2) ; Compute standard Internet pointer SETZRO PINTL,(T1) ; No longer in use by interrupt level JN PPROG,(T1),INTRBX ; Do RETBLK if REMSEQ won't do it. CALL RETBLK ; Release it (assume not full size) INTRBX: RET SUBTTL Internet Fork - Get and Return Internet Buffers ;INTGIB Get input buffers. ;Called to pump up the list of free input buffers used by the input ;PI routines. If this is not done often enough, INT messages will be ;discarded. INTGIB: SAVEAC INTGI0: MOVE T1,INTXPW ; Maximum Internet packet size CALL GETBLK ; Get a block of free storage SKIPN PKT,T1 ; Did we get it? JRST INTGIX ; No. SETZRO PKTFLG,(PKT) ; Clear all internal control flags SETONE PFSIZ,(PKT) ; Indicate it is a full size packet CALL RETPKT ; Release it to be free input buffer CAMGE T1,INTNIB ; Have enough yet? JRST INTGI0 ; No. Get another INTGIX: RET ;RETPKT Release packet storage. ;If a full size packet is being released and we are low on IMP input ;buffers, the packet will be used as an inut buffer. Otherwise, it ;gets released to free storage. Called from INGWAY, TCPIP, TCPRA and ;INTGIB above. ;PKT/ (Extended) Pointer to a packet ; CALL RETPKT ;Ret+1: Always. Packet pointer invalid. T1 has # of input buffers q'd. IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT RETPKT::JE PFSIZ,(PKT),RETPK1 ; Is it a full size packet? CAML PKT,[INTSEC,,BF1822] ; Is this an NI buffer? CAML PKT,[INTSEC,,BF1822+] ; ? SKIPA ; no JRST RETPK2 ; yes. always release. MOVE T1,INTNFI ; Yes. Get number currently around CAML T1,INTNIB ; Less than required? JRST RETPK1 ; No. XMOVEI T2,LCLPKT(PKT) ; Get pointer to IMPDV portion MOVE T3,MAXWPM ; Size of the IMPDV portion STOR T3,NBBSZ,(T2) ; Make look like a good IMPDV pkt buffer SETZRO NBQUE,(T2) CALL INTLKB ; Lock down ends of the packet MOVE T1,T2 ; (INTLKB preserves T2) PIOFF EXCH T2,INTFRI ; Add to list of free input buffers STOR T2,NBQUE,(T1) ; Old list is successor of this buf AOS T1,INTNFI ; Bump the count to match PION RET ; Value is number queued IFE REL6, IFN REL6, RETPK1: MOVE T1,PKT ; What to return CALL RETBLK ; Give it to free storage area MOVE T1,INTNFI ; Value is number queued RET RETPK2: ; Here for an NI buffer MOVE T1,PKT ; Get the address CALL RETNIB ; Return it to the pool MOVE T1,INTNFI ; Get the number queued RET ; And return SUBTTL Internet Fork - Internet Grand Initialization ;INTINI Internet Grand Initialization. ; CALL INTINI ;Ret+1: Always. ; N.B. System startup code clears all resident variables. ; In particular all queues to/from interrupt level are "empty". INTINI: MOVEI T1,NINTIB ; Number of input buffers to keep q'd MOVEM T1,INTNIB ; for interrupt level. NOSKED CALL WTBINI ; Initialize Wait Bits CALL FREINI ; Initialize Free Storage OKSKED MOVEI T1,NETSUP ; Point to network up flag CALL DISL ; Wait for things to be initialized CALL GATINI ; Initialize the Gateway LOCAL MOVEI PTB,INTPIX+1 ; Locate first table MOVE PIX,-1(PTB) ; Get # of protocols HRRZ PTL,PIX ; Table length INTINP: SKIPE T1,.INTPI(PTB) ; xxxINI address CALL (T1) ; Initialize Protocol ADD PTB,PTL ; Next Protocol AOBJN PIX,INTINP RESTORE SETOM INTON ; IP initialized RET SUBTTL Internet Control Message Protocol IFE REL6, IFN REL6, COMMENT ! These routines implement the Internet Control Message Protocol. They are derived from the old GGP routines, which we no longer support. Besides handling the protocol messages this module also maintains the gateway tables (as distinguished from the routing tables). ! ; Accumulators used globally in this module: GW==BFR ; Points to a gateway block CPKT==TPKT ; Index register to point to ICMP pkt ; Parameters: MAXGWA==^D50 ; Number of GWs we will keep track of ; (Gateways and multi-homed hosts) ; The file name to use: GWFILE: ASCIZ "SYSTEM:INTERNET.GATEWAYS" ; ICMP packet is pointed to by CPKT, structure as defined in ; INPAR MINICW==PKTELI+</4>+2 ; Minimum ICMP packet size, words with local MINIHB==*4 ; Usual header size, w/o imbedded pkt SUBTTL ICMP - Gateway and ICMP Initialization ;ICMINI Initialize ICM Protocol ; CALL ICMINI ;Ret+1: Always. ICMINI::SETZM PINGTM ; Do Pings now SETZM ICMTIM ; Run ICMP now MOVE T1,NETHT0 ; Get hash table clear interval ADD T1,TODCLK ; add to now MOVEM T1,NETHTM ; when to clear them again SKIPE ICMIPQ ; Already have a queue head? JRST ICMIN0 ; Yes. MOVEI T1,QSZ ; Size of a queue head CALL GETBLK ; Get one from free area SKIPN T1 ; Did we get the space? BUG.(HLT,ICMNST,IPIPIP,SOFT,,,< Cause: During TCP/IP initialization the monitor was unable to obtain the free space needed for ICMP message processing. This probably indicates that internet free space is corrupted. >) MOVEM T1,ICMIPQ ; Put where we can find it CALL INITQ ; Initialize it ICMIN0: SETOM ICMON ; Turn the protocal on JRST GWYINI ; now initialize gateway styff ;GWYINI Initialize the gateway tables. ; CALL GWYINI ; Rets +1 always GWYINI::IFE REL6, ; In case called from MDDT SAVEAC ACVAR SKIPN GWTAB ; Is this a reinit? JRST GWYIN2 ; No. MOVSI I,-MAXGWA ; Yes so Set to scan GWTAB GWYINL: MOVE GW,GWTAB ADDI GW,0(I) ; Point to actual entry SETZ T1, ; Get a zero EXCH T1,0(GW) ; Flush entry, get previous value SKIPN T1 ; Was there one? JRST GWYIN1 ; No, continue PUSH P,T1 ; Signal that all these gateways are down MOVE T1,.GWILS(T1) ; get local address of this gateway CALL GWYDWN ; Signal that it's gone away POP P,T1 ; restore block address CALL RETBLK ; Yes. Give back storage GWYIN1: AOBJN I,GWYINL ; Do all GW blocks JRST GWYIN5 ; not first time init GWYIN2: ; Here for First time init MOVEI T1,MAXGWA ; Maximum number of gateways CALL GETBLK ; Get a block of storage JUMPE T1,GWYIN9 ; Crash MOVEM T1,GWTAB MOVEI T2,MAXGWA ; Size of the block CALL CLRBLK ; Clear it out GWYIN5: CALL LODFIL ; Load the gateway file CALL NETHSI ; Clear the gateway cache CALL PINGER ; Ping the gateways JRST GWYINX GWYIN9: BUG.(HLT,INGGP0,IPIPIP,SOFT,,,< Cause: During TCP/IP initialization the monitor was unable to obtain the free space needed for gateway message processing. This probably indicates that internet free space is corrupted. >) GWYINX: RET ENDAV. SUBTTL ICMP - Load the Gateway File ;LODFIL Load the gateway file ; CALL LODFIL ;Ret+1: Always LODFIL: ACVAR SETO JFH, ; Indicate nothing to release MOVEI T1,.FHSLF ; This fork RCM ; Get channels which are on MOVEM T1,CHNS ; Save for restoring MOVEI T1,.FHSLF MOVX T2,1B<.ICEOF> ; End of file channel DIC ; Prevent unwanted interrupt MOVX T1,GJ%OLD+GJ%SHT ; Want existing file HRROI T2,GWFILE ; Pointer to filename string GTJFN JRST LODFIX ; Not there MOVEM T1,JFH MOVX T2, ; Want to read it OPENF JRST LODFIX CALL PRCLIN ; Process lines in the file CLOSF JFCL LODFIX: SKIPL T1,JFH RLJFN JFCL MOVEI T1,.FHSLF MOVE T2,CHNS AIC RET ENDAV. SUBTTL ICMP - Gateway File Line Processing ;PRCLIN Process lines of the gateway file ;T1/ JFN of the file ; CALL PRCLIN ;Ret+1: Always. T1 still has the JFH PRCLIN::ACVAR MOVEM T1,JFH ; Stash JFH in a save place ; Top of main per-line loop: PRCLI1: MOVE T1,JFH ; Get the file JFH RFPTR ; Find out where in file line is JFCL MOVEM T2,BOL ; Save beginning of line CALL GETC ; First character of line JUMPE T2,PRCLIX ; get out if end of file CAIN T2,12 ; Linefeed? JRST PRCLI1 ; Ignore blank lines CAIN T2,";" JRST PRCLI8 ; Flush comment line CAIN T2,"C" JRST PRCLI7 ; Go do CREATION command BKJFN ; Back up so LOADGW can read 1st chr JFCL ; Will ITRAP on BIN if error in T1 CALL LOADGW ; Load a gateway description JUMPE T2,PRCLI1 ; Do next if no error ; Here when error detected in current line (pointer to message in T2) PRCLI2: MOVEI T1,.PRIOU SETZ T3, SOUT ; Type the error string HRROI T2,[ASCIZ " in file: "] SOUT MOVE T2,JFH JFNS ; And the actual file name HRROI T2,[ASCIZ " "] SOUT ; And a carriage return MOVE T1,JFH RFPTR ; Find out where we have read to JFCL SOS ERRPNT,T2 ; Save the error point MOVE T2,BOL ; Beginning of the bad line SFPTR JFCL SETOM ERRCOL ; Maybe nothing read of line PRCLI3: MOVE T1,JFH ; Top of loop that types out a bad line RFPTR ; Get the file pointer JFCL CAME T2,ERRPNT ; Up to the point of the error JRST PRCLI4 ; No. Dont save column yet MOVEI T1,.PRIOU RFPOS HRRZM T2,ERRCOL ; Column where to show error... PRCLI4: MOVE T1,JFH ; ... CALL GETC ; Get a character from bad line SKIPN T2 ; End of file? MOVEI T2,12 ; Yes. Use linefeed. CAIN T2,12 ; End of line? JRST PRCLI5 ; Yes. Done MOVEI T1,.PRIOU BOUT ; Type a character JRST PRCLI3 ; Do next one PRCLI5: MOVEI T1,.PRIOU HRROI T2,[ASCIZ " "] SETZ T3, SOUT ; Type and end of line terminal JUMPLE ERRCOL,PRCLI6 ; Know where to show the error? MOVEI T2," " ; Yes. Space over to it. BOUT SOJG ERRCOL,.-1 ; All the way. PRCLI6: HRROI T2,[ASCIZ "^ "] SOUT JRST PRCLI1 ; Try to finish the file ; Do CREATION command PRCLI7: CALL GETC ; Skip over stuff following the C MOVE T3,T2 ; Free up T2 HRROI T2,[ASCIZ "% INCMP: Premature EOF"] JUMPE T3,PRCLI2 ; Go do the error if need be CAIE T3," " ; One space is required separator JRST PRCLI7 ; Loop til it is found SETZ T2, ; Default flags IDTIM ; Input the time and date SKIPA T2,[-1,,[ASCIZ "% INCMP: Bad format in creation date"]] MOVEM T2,GFCTAD ; Save our gateway file creation date JUMPL T2,PRCLI2 ; Do error if need be JRST PRCLI1 ; Do another command ; Here to flush a comment line PRCLI8: CALL GETC ; Get a character JUMPE T2,PRCLIX ; Get out if end of file CAIE T2,12 ; End of line? JRST PRCLI8 ; No. JRST PRCLI1 ; Go read the next line. PRCLIX: MOVE T1,JFH ; Preserve JFH as promised RET ENDAV. NR GFCTAD,1 ; Gateway file creation time and date SUBTTL ICMP - Load Gateway Descriptor ;LOADGW Load one gateway desciption and add to table ;T1/ JFH ; CALL LOADGW ;Ret+1: Always. T2 has 0 if no error or -1,,errorstring ; T1 preserved. LOADGW: SAVEAC ACVAR TRVAR <> ; Temp gateway block storage MOVEM T1,JFH XMOVEI T1,GWTMP ; Point to the temp block MOVE GW,T1 ; ... MOVEI T2,GWBKSZ ; size thereof CALL CLRBLK ; clear it SETZM EOLFLG ; end of line not seen LOADG1: MOVE T1,JFH ; Top of per-keyword loop: CALL GETC ; Get a character JUMPE T2,LOADG8 ; Oops. End of file. CAIE T2,"." ; decimal number separator CAIN T2," " ; Space (control, etc) JRST LOADG1 ; Yes. Flush it. CAIL T2,"0" CAILE T2,"9" JRST LOADG4 ; Non-digit. Must be keyword ; Here to input an interface address in N H L I form. LOADG2: SETZM T4 ; Clear the number accumulator BKJFN ; Reread the digit JFCL LODG2A: MOVEI T3,^D10 ; Decimal NIN JRST LOADG7 ; Null number? LSH T4,^D8 ; Make room for another byte ADD T4,T2 ; Add it in BKJFN ; Reread the terminator JFCL BIN CAIN T2,15 ; Happens on TENEX BIN ; Get the line feed, like TOPS20 JUMPE T2,LOADG8 ; Jump if end of file encountered CAIE T2,"." ; Dots separate bytes CAIN T2," " ; Space means another byte follows JRST LODG2A ; Go get it CAIN T2,12 ; End of line? SETOM EOLFLG ; Yes. Remember to exit later. CAIE T2,12 ; End of line CAIN T2,"," ; End of address expression? JRST LOADG3 ; Yes. Go enter into GW block JRST LOADG7 ; Anything else is bad format. ; Put address in temporary GW block. LOADG3: LOAD T3,GWICT,(GW) ; Get current count CAIL T3,MXGWIC ; Room for another? JRST LOAD65 ; No. ADDI T3,1 ; Bump the count STOR T3,GWICT,(GW) ; Store back ADDI T3,.GWILS-1 ; Offset to first empty slot ADD T3,GW ; Where to store the address MOVEM T4,0(T3) ; Insert interface address into GW block SKIPN EOLFLG ; Read entire GW spec? JRST LOADG1 ; No. Get another keyword/addr JRST LOADG6 ; Yes. Go tie off this block ; Process a keyword LOADG4: SETO T3, ; Keyword error flag CAIN T2,"P" ; "PRIME" MOVX T3,GW%PRM CAIN T2,"D" ; "DUMB" MOVX T3,GW%DUM CAIN T2,"H" ; "HOST" MOVX T3,GW%HST CAIN T2,"A" MOVX T3,GW%AUP ; "ALLWAYS-UP" HRROI T2,[ASCIZ "% LOADGW: Unknown keyword "] JUMPL T3,LOADGX ; Give error if invalid keyword HRROI T2,[ASCIZ "% LOADGW: Too many gateway type specs."] JN GWTYP,(GW),LOADGX ; Give error if already have spec STOR T3,GWTYP,(GW) ; Set type into GW block ; Here to skip over the rest of the current keyword LOADG5: CALL GETC ; Get a character JUMPE T2,LOADG8 ; End of file? CAIN T2,12 ; End of line? JRST LOADG6 ; Yes. Go tie it off. CAIE T2," " ; Space CAIN T2,"," ; Or comma will end it JRST LOADG1 ; Go read next keyword JRST LOADG5 ; Keep reading the rest of this one ; Here to tie off the block which has been accumulating LOADG6: CALL DEFGWY ; Create real gateway blocks JRST LOADGX ; return with the result ; Error returns LOAD65: CALL DEFGWY ; Create real gateway blocks SKIPN T2 ; Double error HRROI T2,[ASCIZ /% INCMP: Too many addresses in gateway description./] JRST LOADGX ; return with the result LOADG7: SKIPA T2,[-1,,[ASCIZ "% INGGP: Bad format "]] LOADG8: HRROI T2,[ASCIZ "% INGGP: Premature end of file "] LOADGX: MOVE T1,JFH RET ENDAV. SUBTTL ICMP - Create Gateway Blocks ;DEFGWY Create real gateway blocks ;Given a gateway block pointer in GW, creates a real gateway block ;for each interface on a network we have in common with the gateway. ; GW/ (ext) pointer to gateway block (in stack) ; CALL DEFGWY ;Ret+1: Always, T2/ 0 if ok, or ; -1,,pointer to error msg DEFGWY: ACVAR XMOVEI CIDX,.GWILS(GW) ; Point to the interface list LOAD CCNT,GWICT,(GW) ; Interface count JUMPE CCNT,DEFGX1 ; None (?) JE GWTYP,(GW),DEFGX2 ; No type specified ; Top of the loop DEFGW0: MOVE T1,(CIDX) ; Get an interface from the table CALL LCLNET ; have we an interface on the same net? JRST DEFGW9 ; no ; Find a slot to store the gateway block in MOVE CSLT,GWTAB ; point to the gateway table MOVEI T4,MAXGWA ; size of the table DEFGW1: SKIPN 0(CSLT) ; slot empty? JRST DEFGW2 ; yes XMOVEI CSLT,1(CSLT) ; increment pointer SOJG T4,DEFGW1 ; Loop HRROI T2,[ASCIZ /% INCMP: DEFGW -- GWTAB full/] RET DEFGW2: MOVEI T1,GWBKSZ ; size of a gateway block CALL GETBLK ; get storage JUMPE T1,DEFGX3 ; no storage MOVEI T2,GWBKSZ ; Size of the block PUSH P,T1 ; Save block address CALL CLRBLK ; clear it POP P,T1 ; get block address back SETONE ,(T1) ; Init history bits MOVEI T2,WID(GWHIS) ; Number of bits in ping history STOR T2,GWSPC,(T1) ; Set succesfull ping count to match LOAD T2,GWTYP,(GW) ; Get gateway type STOR T2,GWTYP,(T1) ; And save it MOVE T2,(CIDX) ; Get interface we can reach MOVEM T2,.GWILS(T1) ; Save LOAD T3,GWICT,(GW) ; interface count STOR T3,GWICT,(T1) ; Save here also XMOVEI T2,.GWILS(GW) ; point to the list PUSH P,T1 ; Save block XMOVEI T1,.GWILS+1(T1) ; Point to interface list DEFGW3: CAMN CIDX,T2 ; Same as current? JRST DEFGW4 ; yes, on to next MOVE T4,(T2) ; get an interface MOVEM T4,(T1) ; save in block XMOVEI T1,1(T1) ; increment block pointer DEFGW4: XMOVEI T2,1(T2) ; increment source pointer SOJG T3,DEFGW3 ; loop POP P,T1 ; restore block pointer MOVEM T1,(CSLT) ; save block in gateway table ; See if another interface on a common net DEFGW9: XMOVEI CIDX,1(CIDX) ; increment interface pointer SOJG CCNT,DEFGW0 ; try the next interface SETZ T2, ; return good RET ; return when done ; Error returns DEFGX1: HRROI T2,[ASCIZ /% INCMP: DEFGW -- No interfaces for gateway/] RET DEFGX2: HRROI T2,[ASCIZ /% INCMP: No gateway type specified/] RET DEFGX3: HRROI T2,[ASCIZ /% INCMP: DEFGW -- No free storage for gateway block/] RET ENDAV. SUBTTL ICMP - Gateway File Processing ;GETC Get a character from a file ;T1/ JFH of the file ; CALL GETC ;Ret+1: T1 preserved. T2 has the chr or 0 if end of file GETC: BIN ; Read the file JUMPN T2,GETC2 ; Jump if a character gotten GTSTS ; Read a null. TXNN T2,GS%EOF ; At end of file? JRST GETC ; No. Just flush the null MOVEI T2,0 ; Set to return the EOF code JRST GETCX GETC2: CAIE T2,14 ; Formfeed? CAIN T2,37 ; TENEX EOL? MOVEI T2,12 ; Convert to linefeed CAIN T2,12 ; Linefeed? JRST GETCX ; Return that CAIGE T2," " ; Other control? JRST GETC ; Yes. Flush CAIL T2,"a" CAILE T2,"z" CAIA ; Not lowercase SUBI T2,"a"-"A" ; Raise lowercase GETCX: RET SUBTTL ICMP - Find A Gateway ;FNDGWY Find a gateway with an interface on a given net. ; T1/ HOST number ; returns ; +1 always ; T1/ address of the best gateway to that net ; (if none directly connected can be found, then a random ; PRIME gateway is chosen) ; If no gateways or interfaces are up returns 0 FNDGWY: ACVAR SETZB DEFGW,DEFTY ; No default gateway yet MOVSI I,-MAXGWA ; Size of tables NETNUM T2,T1 ; Get the network number FNDGWL: HRRZ GWT,I ; Get offset ADD GWT,GWTAB ; Point into table SKIPN GWT,(GWT) ; Get entry (if any) JRST FNDGW5 ; Slot is empty JE GWUP,(GWT),FNDGW5 ; Gateway is not up MOVE T1,.GWILS(GWT) ; Get accessable address CALL NETCHK ; Is this interface up? JRST FNDGW5 ; No, try another gateway CAIN DEFTY,GW%PRM ; Is our default a prime gateway? JRST FNDGW0 ; Yes, no need to look further LOAD T3,GWTYP,(GWT) ; Get type of current gateway CAIN T3,GW%PRM ; If current prime JRST FNDGW6 ; Then set default to prime CAIN DEFTY,GW%DUM ; If default is dumb.. JRST FNDGW0 ; Then don't reset default. CAIN T3,GW%DUM ; If current is dumb and default isn't JRST FNDGW6 ; Then set default to dumb CAIN DEFTY,GW%AUP ; If default is always up.. JRST FNDGW0 ; Then don't reset default CAIN T3,GW%AUP ; If current is aup and default isn't JRST FNDGW6 ; The set default to always up CAIN DEFTY,GW%HST ; If default is host JRST FNDGW0 ; Then don't reset default FNDGW6: MOVE DEFGW,.GWILS(GWT) ; Get the accessable address MOVE DEFTY,T3 ; Remember type of gateway FNDGW0: LOAD T3,GWICT,(GWT) ; Get the interface count XMOVEI T4,.GWILS(GWT) ; Point to interface names FNDGW1: MOVE T1,(T4) ; Get an address NETNUM T1,T1 ; Get the net number CAME T1,T2 ; Same network as we want? JRST FNDGW2 ; No MOVE T1,.GWILS(GWT) ; Get the accessable address RET ; and return FNDGW2: AOS T4 ; Point to the next entry SOJG T3,FNDGW1 ; and loop through this gateway FNDGW5: AOBJN I,FNDGWL ; Loop through all gateway blocks ; Here if no gateway is perfect MOVE T1,DEFGW ; get default gateway (0 if none) RET ; no gateway found ENDAV. SUBTTL ICMP - ICMP Processing ;ICMPRC Top level ICMP Processing routine. Called From Internet Fork ;CALL ICMPRC ;Ret+1: Always ICMPRC::SETZM ICMFLG ; Clear run request flag CALL ICMDSP ; Dispatch any msgs which are waiting MOVE T1,PINGTM ; Time of next ping CAMGE T1,TODCLK ; Over due? CALL PINGER ; Yes. Do ping stuff. MOVE T1,NETHTM ; Time to reinit the hash tables? CAML T1,TODCLK ; ? JRST ICMPR1 ; No, skip following CALL NETHSI ; clear the tables MOVE T1,TODCLK ; get time now ADD T1,NETHT0 ; add in offset MOVEM T1,NETHTM ; save ICMPR1: CAML T1,PINGTM ; use the minimum time MOVE T1,PINGTM ; get time of next ping MOVEM T1,ICMTIM ; save as when we have to run RET ;ICMCHK Check Routine for ICMP Tells when to run next ;T1/ A TODCLK ; CALL ICMCHK ;Ret+1: Always. T1 has min of input T1 and when we should run next. ICMCHK::CAMLE T1,ICMTIM ; Check against our next timeout MOVE T1,ICMTIM ; That is sooner RET SUBTTL ICMP - Gateway Pinger ;PINGER Ping gateways to see if they are alive ; CALL PINGER ;Ret+1: Always. PINGTM reset for next run PINGER: SAVEAC ACVAR MOVSI I,-MAXGWA ; Set to scan the gateway table PINGE1: HRRZ GW,I ; Get offset into table ADD GW,GWTAB ; Add base pointer SKIPN GW,0(GW) ; Get pointer to gateway JRST PINGE8 ; Unoccupied slot LOAD T1,GWHIS,(GW) ; Get the history bits LOAD T2,GWSPC,(GW) ; Get the successful ping count TRNE T1,1 ; Test bit about to be forgotten SUBI T2,1 ; Forgetting a success SKIPGE T2 ; Avoid negative while down MOVEI T2,0 ; This is as bad as you can get LOAD T3,GWPIP,(GW) ; See if previous ping still in progress XORI T3,1 ; Flip sense to indicate success LSH T3,WID(GWHIS)-1 ; Move to left end LSH T1,-1 ; Flush the oldest history bit IOR T1,T3 ; Include in history bits SKIPE T3 ; Did we add a success to the list ADDI T2,1 ; Yes. Count it up CAILE T2,WID(GWHIS) ; Check for overflow MOVEI T2,WID(GWHIS) ; Limit to max STOR T2,GWSPC,(GW) ; Store back the count STOR T1,GWHIS,(GW) ; Store back the bits LOAD T4,GWUP,(GW) ; Get current state MOVE T3,T4 ; Save a copy CAIL T2,.THRUP ; Enough success to say it's up? MOVEI T4,1 ; Yes CAIG T2,.THRDN ; So few that it is down? MOVEI T4,0 ; Yes. STOR T4,GWUP,(GW) ; Set new value XOR T3,T4 ; Compare to see if change JUMPE T3,PINGE7 ; Jump if no change JUMPN T4,PINGE7 ; Jump if it came up CALL GWDOWN ; Yes. Flush from tables now. PINGE7: SETONE GWPIP,(GW) ; Set ping-in-progress bit CALL SNDPNG ; Send a ping to guy in GW PINGE8: AOBJN I,PINGE1 ; Loop over all gateways MOVE T1,PINGT0 ; Interping interval ADD T1,TODCLK ; Time of next ping/check MOVEM T1,PINGTM ; Save for scheduling RET ENDAV. SUBTTL ICMP - Gateway Pinging Routine ;SNDPNG Send a ping message to a GW ;This is an ECHO message if we are sending to a PRIME gateway, or an ;ECHO REPLY addressed to ourself if testing a non-PRIME gateway. Net ;result is that we get back only ECHO REPLIES. ;GW/ Pointer to gateway block ; CALL SNDPNG ;Ret+1: Always. SNDPNG: SAVEAC LOAD T1,GWTYP,(GW) ; Gateway type code CAIN T1,GW%AUP ; Always up? JRST SNDPNU ; Yes, go fake a successful ping ; Must actually send a ping MOVEI T1,MINICW ; Size of echo packet CALL GETBLK ; Get storage in which to build pkt SKIPN PKT,T1 ; Put in standard place JRST SNDPNU ; Not available. Don't let it go down. MOVEI T2,MINICW ; Size again CALL CLRBLK ; Clear all flags, checksum, etc MOVE T1,[BYTE (8)105,0,0,<8+MINIHS>] MOVEM T1,PKTELI+.IPKVR(PKT) ; Set version, length MOVEI T1,3 ; Ping "lifetime" STOR T1,PITTL,(PKT) MOVEI T1,.ICMFM ; Protocol is ICMP STOR T1,PIPRO,(PKT) MOVEI CPKT,</4>+PKTELI ; Min. Internet header size ADD CPKT,PKT ; Pointer to ICMP Section MOVE T1,.GWILS(GW) ; Get accessable interface CALL GWYLUK ; Look it up JUMPE T1,SNDPNW ; No way to that net?? MOVE T2,NTLADR(P1) ; get interface address MOVEI T3,ICM%EC ; Echo type LOAD T4,GWTYP,(GW) ; Get type CAIN T4,GW%PRM ; Prime? JRST SNDPN6 ; Yes EXCH T1,T2 ; Swap source and destination MOVEI T3,ICM%ER ; ECHO-REPLY code SETONE PNLCL,(PKT) ; No local delivery allowed... SNDPN6: ; ... STOR T2,PISH,(PKT) ; Make it look like it came from there STOR T1,PIDH,(PKT) ; Make it go there STOR T3,CMTYP,(CPKT) ; Set into ICMP section SETZRO CMCOD,(CPKT) ; Clear code word SETONE CMID,(CPKT) ; (Make field non-zero) AOS T1,ICMSID ; Get an Id STOR T1,CMSEQ,(CPKT) STOR T1,PISID,(PKT) CALL ICMCKS ; Compute checksum STOR T1,CMCKS,(CPKT) ; Insert in packet CALL SNDGAT ; Send it off JRST SNDPNX ; Error exits SNDPNU: SETZRO GWPIP,(GW) ; Fake a successful ping JRST SNDPNX SNDPNW: CALL RETPKT ; Don't have anywhere to send packet SNDPNX: RET ;GWDOWN Gateway just detected down ;Called by the PINGER and in response to a local net "destination ;dead" message. ;GW/ Pointer to gateway block ; CALL GWDOWN ;Ret+1: Always. GWUP bit cleared and all interfaces removed from tables GWDOWN: MOVE T1,.GWILS(GW) ; Get the relevant interface CALL GWYDWN ; say it went away RET SUBTTL ICMP - ICMP Message Handling ;ICMDSP Dispatch on ICMP message type ; CALL ICMDSP ;Ret+1: Always. ICMDSP: SAVEAC SETZ TCB, ICMDS1: MOVE T1,ICMIPQ ; Pointer to input queue head LOAD PKT,QNEXT,(T1) ; Get first thing on queue SETSEC PKT,INTSEC ; Make extended address CAMN PKT,T1 ; Pointer to head means empty JRST ICMDSX ; Empty MOVE T1,PKT ; What to dequeue CALL DQ ; Get it off queue (NOSKED not needed) MOVX T1,PT%CDI ; ICMP dequeued from input queue TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes CALL ICMCKS ; Check ICMP Checksum JUMPN T1,ICMDSC ; Jump if bad LOAD CPKT,PIDO,(PKT) ; Internet data offset ADD CPKT,PKT ; Get pointer to ICMP portion ADDI CPKT,PKTELI ; Skip over local information LOAD T1,CMTYP,(CPKT) ; What kind of message it is MOVSI T2,-NICMPT ; Number of messages we know about CAME T1,ICMTTB(T2) ; Matches this one? AOBJN T2,.-1 ; No. Try next. JUMPGE T2,ICMDST ; Jump if not found LOAD T3,PIPL,(PKT) ; Packet length in bytes LOAD T4,PIDO,(PKT) ; Internet data offset in words ASH T4,2 ; Make that bytes SUB T3,T4 ; Number of bytes in ICMP part SUB T3,ICMMDC(T2) ; Minus min number req'd for this type JUMPL T3,ICMDSS ; Enough in packet? CALL @ICMRTB(T2) ; Yes, call routine; skips if keeping pkt ICMDS8: CALL RETPKT ; Return the packet to free storage JRST ICMDS1 ; Loop through rest of Q ; Errors ICMDSC: MOVX T1,PT%CKC ; Checksum failure JRST ICMDS9 ICMDSS: MOVX T1,PT%CKS ; Short packet JRST ICMDS9 ICMDST: MOVX T1,PT%CKT ; Unknown type ICMDS9: TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes AOS BADPCT ; Increment bad packet count JRST ICMDS8 ; and loop ICMDSX: RET SUBTTL ICMP - ICMP Message Dispatching ; Table of type codes (ordered by frequency): ICMTTB: ICM%ER ; Echo reply ICM%EC ; Echo ICM%DU ; Destination unreachable ICM%RD ; Redirect output ICM%SQ ; Source quench ICM%PP ; Parameter problem ICM%TE ; Time exceeeded ICM%TM ; Time stamp ICM%TR ; Time stamp reply ICM%IQ ; Information request ICM%IR ; Information reply NICMPT==.-ICMTTB ; Number of types we know about ; Action routines table parallel to the above: ICMPTR==ICMUSR ICMPIR==ICMUSR ICMRTB: NCTDSP ICMPER ; process echo reply NCTDSP ICMPEC ; process echo NCTDSP ICMPDU ; process destination unreachable NCTDSP ICMPRD ; process redirect NCTDSP ICMUSR ; process source quench NCTDSP ICMUSR ; process parameter problem NCTDSP ICMUSR ; process time exceeded NCTDSP ICMPTM ; process timestamp request NCTDSP ICMPTR ; process timestamp reply NCTDSP ICMPIQ ; process information request NCTDSP ICMPIR ; process information reply IFN .-ICMRTB-NICMPT, ; Table of minimum data counts (in bytes) ; (if greater than 8+24, then an internet header and 64 bits of data ; is part of the packet) ICMMDC: 8 ; Echo reply length 8 ; Echo length 8+MINIHS+8 ; Destination unreachable 8+MINIHS+8 ; Redirect 8+MINIHS+8 ; Source quench 8+MINIHS+8 ; Parameter problem 8+MINIHS+8 ; Time exceeded 8+24 ; Timestamp request 8+24 ; Timestamp reply 8 ; Information request 8 ; Information reply IFN .-ICMMDC-NICMPT, SUBTTL ICMP - ICMP Message Handling Routines ICMPDU: LOAD T1,CMCOD,(CPKT) ; Get code for destination unreachable CAIE T1,DU%NET ; Net unreachable? CAIN T1,DU%HST ; Host unreachable? CAIA ; Yes to either JRST ICMUSR ; No to both, give it to user SAVET LOAD T1,PIDH,-PKTELI+.CMINH(CPKT) ; Get the host which caused it all CALL HSTHSH ; Get its hash code JUMPL T2,ICMUSR ; If .LT. 0, no room, else new MOVEM T1,HOSTNN(T2) ; Put host number in hash table in case new MOVX T1,HS%VAL! ; Value status, system down, reason 1 HLLM T1,HSTSTS(T2) ; Put this status into table JRST ICMUSR ; In case some user wants it... ICMPEC: ; Process an ECHO message: CALL MARKUP ; Mark the host as up MOVX T1,ICM%ER ; Echo reply code JRST ICMPEX ; Swap & send ICMPTM: ; Process Timestamp request CALL INETUT ; Get universal time STOR T1,CMTSR,(CPKT) ; Not really right STOR T1,CMTST,(CPKT) ; Transmission time MOVX T1,ICM%TR ; Timestamp reply code JRST ICMPEX ; Swap & send ICMPIQ: ; Process Information request MOVX T1,ICM%IR ; Information reply code MOVE T2,DEFADR JRST ICMPEY ICMPEX: ; Common exit for replies LOAD T2,PIDH,(PKT) ; Destination (us) ICMPEY: LOAD T3,PISH,(PKT) ; Source (who wants echo) STOR T1,CMTYP,(CPKT) ; Set as the ICMP type code STOR T2,PISH,(PKT) ; We are the echoer STOR T3,PIDH,(PKT) ; Sender is the echoee SETZRO CMCKS,(CPKT) ; Clear checksum CALL ICMCKS ; do checksum STOR T1,CMCKS,(CPKT) ; set it CALL SNDGAT ; Send it back RETSKP ICMPER: ; Process an ECHO-REPLY message: CALL MARKUP ; Mark the host as up MOVX T1,<.RTJST(-1,CMID)> ; We set it to -1 LOAD T2,CMID,(CPKT) ; What's in packet? CAME T1,T2 ; Reply for us or a user? JRST ICMUSR ; Not one PINGER sent, give to user SAVEAC LOAD T1,PISH,(PKT) ; Who it appears to be from (maybe us) CALL FINDGW ; Look up the gateway block JUMPE GW,ICERX ; Not there SETZRO GWPIP,(GW) ; Clear ping-in-progress bit ICERX: RET MARKUP: ; Mark a host as up SAVET LOAD T1,PIDH,-PKTELI+.CMINH(CPKT) ; Get the host number CALL HSTHSH ; Get its hash code JUMPL T2,R ; If .LT. 0, no room MOVEM T1,HOSTNN(T2) ; Put host number in hash table in case new MOVX T1, ; get mask ANDCAM T1,HSTSTS(T2) ; Turn off these bits MOVX T1, ; Get mask IORM T1,HSTSTS(T2) ; Turn on these bits. RET ; and return to caller ;ICMPRD Process a REDIRECT message ;The destination that triggered the message is in the "trigger ;header". ICMPRD: ; Process a Redirect ACVAR LOAD T1,CMCOD,(CPKT) ; get the code CAIE T1,RD%NET ; re-direct net? CALLRET ICMUSR ; No, the rest must be handled by the user LOAD T1,CMGWA,(CPKT) ; And the correct gateway address CALL FNDNCT ; Get the NCT for that net RET ; NO? ignore it LOAD T2,NTNUM,(P1) ; Get the interface index STOR T2,INTNUM,+T1 ; Save in the address MOVE GWY,T1 ; Save address LOAD T1,PIDH,-PKTELI+.CMINH(CPKT); get the triggering destination host NETNUM T2,T1 ; Get the network number CALL NETHSH ; Hash it CAIA ; Not currently in tables (cache flushed) ; Local net unreachable mean partitioned?? SKIPL NETGWY(T2) ; A local net? MOVEM GWY,NETGWY(T2) ; No, set this as the gateway RET ; and return ENDAV. ;FINDGW Set GW to point to gateway block with address in T1 ;T1/ An interface address ; CALL FINDGW ;Ret+1: Always. GW has pointer to block or 0 if not found FINDGW: ACVAR MOVSI GWX,-MAXGWA ; Size of table FINDG1: HRRZ GW,GWX ; Get table offset ADD GW,GWTAB ; Add base SKIPN GW,0(GW) ; Get pointer to gateway block JRST FINDG9 ; Empty slot CAMN T1,.GWILS(GW) ; This gateway? JRST FINDGX ; yes, exit with it FINDG9: AOBJN GWX,FINDG1 ; Try next gateway MOVEI GW,0 ; Indicate failure FINDGX: RET ENDAV. SUBTTL ICMP - ICMP Action Passing ;ICMUSR Give an ICMP message to the user. ;There are two possibilities: If the message is in response to a user ;Q message, we simply stick it on that Q's recieve Q (and let the ;user process it) If the message is in response to a monitor protocal ;(TCP) then we have to call the proper routines for handling it. (at ;all times, if we reach this routine, the ICMP data contains the ;Internet header that triggered the message starting at .CMINH(CPKT) ; Called with ; PKT/ Packet pointer ; CPKT/ ICMP portion ; *** NOT FULLY IMPLEMENTATED **** ICMUSR: ACVAR MOVEI PTB,INTPIX+1 ; Locate tables MOVE PIX,INTPIX ; # protocals HRRZ PTL,PIX ; Table length LOAD T1,PIPRO,-PKTELI+.CMINH(CPKT) ; Get triggering protocal ICMUS0: SKIPN .INTPO(PTB) ; Protocal on? JRST ICMUS3 ; No, skip it SKIPL T2,.INTPL(PTB) ; Take any protocal? CAMN T1,T2 ; Or match? CALLRET @.INTPE(PTB) ; Enter the proper routine ; Routine returns (to ICMDS8) +2 if it has kept the packet ICMUS3: ADD PTB,PTL ; Increment pointer AOBJN PIX,ICMUS0 ; And loop ; Here if nobody to accept the packet RET ; Return so it will be released. ; Here to process an ICMP message for ICMP ICMICM::RET ; Shouldn't happen ; Dummy routine to handle an ICMP message for TCP ; (** remove when implimented **) TCPICM::RET ENDAV. SUBTTL ICMP - ICMP Error Handling ;ICMERR Handle an error. ; T1/ ICMP error code (LH == subcode if any) ; T2/ Additional info, if any (parameter problem pointer) ; PKT/ Erring packet ; CALL ICMERR ; Ret+1: Always, packet returned if PINTL and PPROG were both zero ICMERR::ACVAR ; AC variables TRVAR ; Stack variables PUSH P,CPKT ; Save register we clobber SETZ CPKT, ; Clear MOVEM T1,ERROR ; Save erorr code MOVEM T2,INFO ; and additional info LOAD T2,PIPRO,(PKT) ; Get protocal CAIN T2,.ICMFM ; Internet control message format? JRST ICMERX ; Yes, Ignore the packet HRRZS T1 ; Keep only the ICMP type MOVSI ICMIDX,-NICMPT ; Number of ICMP types we handle ICMERL: ; Loop for looking for ICMP error codes CAME T1,ICMTTB(ICMIDX) ; Same? AOBJN ICMIDX,ICMERL ; Loop through the table SKIPL ICMIDX ; Do we know about this type? BUG.(HLT,ICMBDE,IPIPIP,SOFT,,<>,< Cause: The ICMERR routine was called to send an ICMP error message with a message type code that is not supported by the monitor. >) SETZM HDRSIZ ; Assume don't include header MOVX T1,^D<8+24> ; Size of data if no header CAMLE T1,ICMMDC(ICMIDX) ; Same? JRST ICMER0 ; Yes, no header, skip next LOAD T1,PIDO,(PKT) ; Get data offset ADDI T1,2 ; Plus 64 bits of data MOVEM T1,HDRSIZ ; Remember it (words) ICMER0: MOVX T1,MINICW ; Buffer size w/o header ADD T1,HDRSIZ ; Plus size of header (if needed) JN ,(PKT),ICMER1 ; Program still need packet? LOAD T2,PIPL,(PKT) ; This buffer big enough to reuse? LSH T2,-2 ; Its size, words, rounded down MOVE T3,HDRSIZ ; Beware BLT over self CAIG T3,</4>+.CMINH ; Vs first word written CAILE T1,PKTELI(T2) ; Req'd vs actual CAIA ; Need more than have or overwrite JRST ICMER2 ; Reuse this packet, go shift ICMER1: CALL GETBLK ; Get new packet JUMPE T1,ICMERX ; No storage, do nothing SKIPA CPKT,T1 ; Save packet ICMER2: MOVE CPKT,PKT ; Re-use the packet buffer ; NB: CPKT is not pointing at ICMP header, but at packet SKIPN T1,HDRSIZ ; Include header? JRST ICMER3 ; No, skip next XMOVEI T2,PKTELI(PKT) ; Start of internet leader XMOVEI T3,PKTELI+</4>+.CMINH(CPKT) ; Where to stash it CALL XBLTA ; move the data... ICMER3: ; ... LOAD T1,PISH,(PKT) ; Get the packet source host STOR T1,PIDH,(CPKT) ; Save as error destination MOVE T1,DEFADR STOR T1,PISH,(CPKT) ; Save it also MOVE T1,[BYTE (8)105,0,0,0] ; First word of packet MOVEM T1,PKTELI+.IPKVR(CPKT) ; Save SETZM PKTELI+.IPKSG(CPKT) ; clear segmentation info MOVE T1,[BYTE (8)12,.ICMFM,0,0] ; Time to live, protocal MOVEM T1,PKTELI+.IPKPR(CPKT) ; Save it MOVE T1,HDRSIZ ; Get header size included ADDI T1,</4>+.CMINH ; Plus Internet & ICMP header ASH T1,2 ; Convert to bytes STOR T1,PIPL,(CPKT) ; Save packet length PUSH P,PKT ; Save old packet PUSH P,CPKT ; ... MOVE PKT,CPKT ; Get new ADDI CPKT,PKTELI+/4 ; Point to the ICMP section HRRZ T1,ERROR ; Get error type STOR T1,CMTYP,(CPKT) ; Save type HLRZ T2,ERROR ; Get code STOR T2,CMCOD,(CPKT) ; Save it SETZM 1(CPKT) ; Unused word CAIN T1,ICM%PP ; Parameter problem? CAIE T2,PP%PTR ; With pointer? JRST ICMER5 ; No STOR INFO,CMPTR,(CPKT) ; Yes, set pointer JRST ICMER9 ICMER5: CAME T1,ICM%TM ; Time request? JRST ICMER9 ; No CALL INETUT ; Get time STOR T1,CMTSO,(CPKT) SETZRO CMTSR,(CPKT) SETZRO CMTST,(CPKT) MOVX T1, LOAD T1,PIPL,(PKT) ICMER9: AOS T1,ICMSID ; Get an Id STOR T1,CMSEQ,(CPKT) STOR T1,PISID,(PKT) SETZRO CMCKS,(CPKT) ; Zero the packet checksum CALL ICMCKS ; Checksum the packet STOR T1,CMCKS,(CPKT) ; Save it also CALL SNDGAT ; Send it off POP P,CPKT ; Restore old contents POP P,PKT ; Restore old contents ICMERX: JN ,(PKT),ICMERZ ; Return without destroying packet CAME PKT,CPKT ; Don't release if re-used CALL RETPKT ; and return storage ICMERZ: POP P,CPKT ; restore RET ; return ENDAV. PURGE HDRSIZ,ERROR SUBTTL Internet Gateway $INIT COMMENT ! These routines link all Internet protocol modules with interface drivers such as IMPDV and IMPPHY. This is a "full gateway". All interfaces (ie, network inputs), queue messages on INTIBx. When RCVGAT is called it looks to see if the input message is addressed to this host, and if so, returns it to the gateway for processing. If not, it calls SNDGAT to get the message forwarded to the appropriate host or gateway. It may be that the gateway function is imlemented in a box connected to this machine using a BBN 1822 interface. If so, packets with no local headers will be sent over the RPI (Raw Packet Interface) if INTSCR is non-0. If this device is present and being used, packets cannot be forwarded in RCVGAT ! ;GATINI Initialize the gateway IFE REL6, IFN REL6, GATINI: MOVE T1,DEFADR ; Get our default address MOVEM T1,INETID ; Set our name RET SUBTTL Internet Gateway - Send a Packet into the Internet ;Send the packet to some host on a local net which is either the ;destination or a gateway known to be capable of getting the packet ;closer to the destination. If INTBYP is on, and the packet is ;destined for this host, a copy will be queued without even using the ;hardware at all. ;SNDGAT Send a packet into the Network. ;PKT/ Packet to be sent ;User 3/ Destination address if PSROU is set in PKT ; CALL SNDGAT ;Ret+1: Always. Pkt may not be sent. RX or timeout should handle this. SRP==0 ; Pointer before our sending interface's address, or 0 SRC==1 ; Route option code (LSROPT or SSROPT) RRTP==2 ; Pointer before our sending interface's address, or 0 SNDGAT:: SAVEAC SETONE PLCLO,(PKT) ; Packet of local origin MOVX T1,PT%RGI ; Packet received at gateway TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes (Note: Checksum invalid here) ; Following is no longer correct/used JE PSCR,(PKT),SNDGA0 ; Jump if not a pkt on a secure conn. MOVX T1, ; Protocol Unreachable JRST SNDGA5 ; Make like interface code refused it SNDGA0: ; Normal, non-secure packet. STACKL <> ; Args for option processing XMOVEI T1,IPOPA ; Option arguments CALL IPOPT ; Do options JRST SNDGA4 ; Option error ;Find where to send packet (PIDH may have been changed by routing ;option. Note that if changed, the TCP checksum is "wrong" until the ;the last gateway is reached and the original destination is ;restored.) LOAD T1,PIDH,(PKT) ; Get 32-bit internet destination ;(Obsolete) First hop routing for user datagrams OPSTR SKIPE,PSROU,(PKT) ; If we do routing UMOVE T1,3 ; Get gateway address user wanted ;PNLCL is set when a packet must be forced out to the net to the ;SOURCE. This is typically an ECHO-REPLY made by ICMP/GGP on this ;host but faked up to make it look like it came from remote gateway ;which, because it is dumb, can only forward the packet back to us. OPSTR SKIPE,PNLCL,(PKT) ; Special addressing? LOAD T1,PISH,(PKT) ; Entire 32-bit gateway address JRST SNDGA1 ;SNDGA1 Entry for RCVGAT to forward a packet ; T1/ a 32 bit destination address for which a route must be found ; PKT/ (ext) pointer to packet ; Stack has valid IPOPA block on top SNDGA1: PUSH P,T1 ; In case Strict Source Route CALL GWYLUK ; Look up the gateway or interface (sets P1/T3) POP P,T2 ; Original Destination w/logical host XOR T2,T1 ; Routed First Hop TDZ T2,NTNLHM(P1) ; Forget logical host mis-match MOVE T4,SRC+IPOPA ; Get strict/lose flag CAIN T4,SSROPT ; Skip if not strict route JUMPN T2,SNDGA3 ; Jump if strict route failure JUMPE T1,SNDGA2 ; Found a path? No JRST SNDGA6 ; Packet ready to go ; Here if no path to that net SNDGA2: MOVX T1, ; Net unreachable JRST SNDGA5 ; error exit SNDGA3: MOVX T1, ; Strict Source Route failure JRST SNDGA5 SNDGA4: ; Option problem HRRZ T1,T2 ; Error code or pointer? TLNN T2,<-1> ; Skip if code MOVX T1, ; This is error for pointer in T2 SNDGA5: ; Cannot send packet, ICMP error code in T1 PUSH P,T2 ; Save info and PUSH P,T1 ; ICMP error code while MOVX T1,PT%KIA ; Trace packet TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes POP P,T1 ; Restore ICMP error code POP P,T2 ; and info CALL ICMERR ; Report error (maybe free packet) RET ; Return from SNDGAT ; Here after routing and interface selection have been completed ; T1 has a destination on the selected local network (maybe w/logical host) ; If not Multinet, T3 is an interface index ; If Multinet, P1 is the NCT address ; May have to insert host address for routing option SNDGA6: MOVE T3,NTLADR(P1) ; Address from which packet is being sent SKIPE T4,RRTP+IPOPA ; If Record route CALL INSHST ; Insert host name SKIPE T4,SRP+IPOPA ; If Source route CALL INSHST ; Insert host name... ; ... what is this bs? ..X=. ; Logically clean up here, but the RESTORE ; Arg block stays until RET IFN <..X-.>, PURGE SRP,SRC,RRTP,..X PUSH P,T1 ; Save destination from checksum CALL SNDGAC ; Compute checksum MOVE T3,NTPSIZ(P1) ; Get maximum size for the interface POP P,T1 ; Restore destination ; Check if packet is to this host, if so, try for bypass SKIPE INTBYP ; Skip over if bypassing prohibited CALL LCLHST ; Is it one of us? CAIA ; No, or may not bypass CALL SNDLCL ; Yes. Try to send locally. JUMPE T1,R ; Sent, Go RESTORE & return from SNDGAT ; Decide if packet is too big for selected network, if so, fragment it LOAD T4,PIPL,(PKT) ; Get packet length CAMLE T4,T3 ; Check against maximum size for the interface CALLRET SNDFR ; Fragment it CALLRET SNDPKT ; Send the whole packet SUBTTL Internet Gateway - Send a Packet ;SNDPKT Send a packet ;T1/ Local net (first hop) destination address ;T2/ Routine (If not Multinet) ;P1/ NCT (If Multinet) ;PKT/ Packet address ; CALL SNDPKT ;Ret+1: Always, packet either passed to net or ; released if error (and PINTL+PPROG=0) SNDPKT: PUSH P,T1 ; Save the host PUSH P,T2 ; Save the routine XMOVEI T2,LCLPKT(PKT) ; Pointer to interrupt level part MOVEM T2,(P) ; Save ptr for NTSNDI from PRNPKT CALL INTLKB ; Lock down the packet SETONE PINTL,(PKT) ; Say it has been given to int. level MOVX T1,PT%QLN ; Queued for local net TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes POP P,T2 ; Restore the routine/local pkt ptr POP P,T1 ; Restore the host ; T1 has local net address ; T2 points to the local packet CALL NTSNDI ; Send an internet packet CAIA ; Failed JRST SNDPKX ; Success PUSH P,T1 ; T1 has ICMP reason for failure XMOVEI T1,LCLPKT(PKT) ; Pointer to IMPDV portion CALL INTULK ; Unlock since not queued for PI level SETZRO PINTL,(PKT) ; Indicate interface didn't take it. POP P,T1 ; Restore error code CALLRET ICMERR ; Record the ICMP error & release pkt JN PPROG,(PKT),SNDPKX ; Pkt should be retransmitted. Save it. CALL RETPKT SNDPKX: RET SUBTTL Internet Gateway - Local Bypass ;SNDLCL Attempt to send the packet via the "bypass". ; T1/ Destination address ; CALL SNDLCL ;Ret+1: Always, PKT .ne. 0 Cannot bypass; T1 = 0, bypassed SNDLCL: MOVE T4,T1 ; Keep address here in case can't bypass XMOVEI T2,LCLPKT(PKT) ; Pointer to Local network part of packet JE PPROG,(PKT),SNDLC4 ; No need to copy if no ACK expected ;Since we have to make a copy of the packet, try a few places to get ;the storage. First, if it will fit, try to get a real, full-size IMP ;input buffer. If that fails, go through the overhead of getting the ;space from free storage. If that fails, give it to the IMP. LOAD T1,PIPL,(PKT) ; Header length in bytes ADDI T1,3+PKTELI*4 ; Packet size in bytes, rounded up ASH T1,-2 ; Packet size in full words MOVEI T3,-PKTELI+MAXLDR(T1) ; Size w/o "local info" CAMLE T3,MAXWPM ; Fit in Input buffer? JRST SNDLC2 ; No, get free storage JRST SNDLC0 ; Off to resident code IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT SNDLC0: PIOFF ; Get unique access to IMP buffers SKIPG INTNFI ; Is there an IMP buffer available? JRST SNDLC1 ; No. Try something else ; Use input buffer SOSL INTNFI ; Count down number left SKIPN T4,INTFRI ; Grab the first one BUG.(HLT,INTGW2,IPIPIP,SOFT,,,< Cause: The internet bypass send routine has determined that the internet buffer list is corrupted. >) LOAD T3,NBQUE,(T4) ; Get next one after that SETSEC T3,INTSEC ; Make extended address MOVEM T3,INTFRI ; Make that the new head of the list SETZRO NBQUE,(T4) ; Dequeue it from others PION ; Free list is stable now PUSH P,.NBHDR(T4) ; Save free storage word PUSH P,T4 ; Save IMP-style pkt ptr XMOVEI T3,-LCLPKT(T4) ; Setup for XBLTA XMOVEI T2,0(PKT) ; Source pointer. T1 has word count. CALL XBLTA ; Do the appropriate BLT POP P,T2 ; Get back IMPDV-style pointer POP P,.NBHDR(T2) ; Restore buffer size JRST SNDLC5 ; Go queue for receive side SNDLC1: PION ; Not going to fiddle with IMP queue ; No free input buffers, try internet free storage SNDLC2: PUSH P,T4 ; Save address around call PUSH P,T1 ; Save size around call CALL GETBLK ; Get a block of free storage POP P,T2 ; Number of words in the block POP P,T3 ; Address EXCH T1,T3 ; 1/address, 2/size, 3/pkt JUMPE T3,R ; Couldn't. Send thru interface anyway SETZRO PFLGS,(T3) ; Clear all internal flags CAME T2,INTXPW ; Is this a max sized packet? JRST SNDLC3 ; No SETONE PFSIZ,(T3) ; Yes. Remember it can be an in buffer. SNDLC3: MOVE T1,T2 ; Size to T1 PUSH P,PKTFLG(T3) ; Save PFSIZ bit from the BLT PUSH P,T3 ; Save pkt ptr XMOVEI T2,0(PKT) ; First source word CALL XBLTA ; Do the appropriate BLT POP P,T2 ; Get back pkt ptr POP P,PKTFLG(T2) ; Restore the PFSIZ bit ADDI T2,LCLPKT ; Compute pointer to ARPA leader start SNDLC4: TMNN PFSIZ,<-LCLPKT>(T2) ; is this a full size buffer IFSKP. ; yes MOVE T1,MAXWPM ; get max buffer size STOR T1,NBBSZ,(T2) ; save the size ENDIF. CALL INTLKB ; Lock down so RCVGAT can unlock it. SETZRO NBQUE,(T2) ; Clear pointer ; Place the packet on the gateway input queue for the dispatcher ; T2/ (ext) address of packet at PKTELI-MAXLDR (LCLPKT) SNDLC5: PUSH P,T2 MOVX T1,PT%BYP ; Queued for input TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes POP P,T2 PIOFF ; Turn off IMP interrupts and scheduling MOVE T3,INTIBI ; Get 0 or current list JUMPN T3,SNDLC6 ; Jump if queue not empty MOVEM T2,INTIBO ; Was empty. This is only item now. SKIPA ; Go set input pointer too. SNDLC6: STOR T2,NBQUE,(T3) ; Set queue pointer in packet too MOVEM T2,INTIBI ; Set new input pointer AOS INTFLG ; Cause gateway to run (more) PION SETZ T1, ; Packet has been disposed of RET IFE REL6, IFN REL6, SUBTTL Internet Gateway - Checksum Handling ;SNDGAB Fill in header fields ;SNDGAC Fill in header fields ;PKT/ Extended packet address ;CALL SNDGAB or SNDGAC ;Ret+1: Always, with fields filled in SNDGAB: SETZ PKTQ(PKT) ; Zero queue SETZRO PFLGS,(PKT) ; Zero flags SNDGAC: SETZRO PICKS,(PKT) ; Clear Internet checksum field CALL INTCKS ; Compute Internet checksum STOR T1,PICKS,(PKT) ; Enter in header LOAD T1,PIPL,(PKT) ; Packet length in bytes ADDI T1,3+4* ; Length of IMPPHY portion ASH T1,-2 ; Convert to words, round up STOR T1,NBBSZ,+LCLPKT(PKT) ; Put in pkt for use elsewhere RET SUBTTL Internet Gateway - Receive a Packet ;RCVGAT Receive a packet from all networks ; CALL RCVGAT ;Ret+1: Always. PKT has pointer to packet or 0 if none available IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT RCVGAT: SAVEAC STACKL <> ; Args for option processing SRP==0 ; Pointer before our sending interface's address, or 0 SRC==1 ; Route option code (LSROPT or SSROPT) RRTP==2 ; Pointer before our sending interface's address, or 0 RCVGAL: PIOFF ; Top of loop ... MOVE PKT,INTIBO ; Get input queue output pointer JUMPE PKT,RCVGAY ; No packets queued LOAD T1,NBQUE,(PKT) ; Get successor, if any. JUMPN T1,RCVGAN ; Queue not about to run dry SETZM INTIBI ; Make empty queue SKIPA RCVGAN: SETSEC T1,INTSEC ; Make extended address MOVEM T1,INTIBO ; Set new output pointer PION JRST RCVGA0 IFE REL6, IFN REL6, RCVGA0: SETZRO NBQUE,(PKT) ; Packet not in a queue PUSH P,PKT SUBI PKT,LCLPKT SETZRO PLCLO,(PKT) ; Packet came from net MOVX T1,PT%RGW ; Packet received from local net TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes POP P,PKT LOAD T2,NBBSZ,(PKT) ; Super size packets? CAMLE T2,MAXWPM BUG.(HLT,INTGW1,IPIPIP,SOFT,,,< Cause: The receive gateway code has determined that a buffer with a corrupted local header has been passed from a device driver. >) JE PFSIZ,<-LCLPKT>(PKT),RCVGAO ; Not full size means came on bypass MOVE T3,MAXWPM ; Reset local length to "full size" STOR T3,NBBSZ,(PKT) ; Which is right for input buffer RCVGAO: PUSH P,T2 ; Save packet size MOVE T1,PKT ; Pointer to the buffer again CALL INTULK ; Unlock packet POP P,T2 ; Get back number or words in packet SUBI PKT,LCLPKT ; Return standard Internet PKT pointer SETZM PKTQ(PKT) ; Indicate that PKT is not queued... ; Check to see that all of the packet has been received. LOAD T1,PIPL,(PKT) ; ... Internet total length in bytes ADDI T1,3 ; Round up ASH T1,-2 ; Number of words required CAML T1,T2 ; Got it all? JRST RCVGA9 ; No. Flush it. ; Check to see if it is ok to look at the Internet leader: RCVGA1: LOAD T1,PIVER,(PKT) ; Internet Version CAIE T1,.INTVR ; Right Internet Version? JRST RCVGA9 ; No. Flush it. CALL INTCKS ; Compute the checksum JUMPN T1,RCVGA9 ; Jump if it is bad ; Process IP options XMOVEI T1,IPOPA ; Option arguments CALL IPOPT ; Process options JRST RCVGA4 ; Option error ; Find where to send packet (may have been changed by routing option). ; Check if packet is to this host, if so deliver, else forward it. LOAD T1,PIDH,(PKT) ; Get 32-bit internet destination SKIPN SRP+IPOPA ; Must forward if it has a route option CALL LCLHST ; Is it one of us? JRST RCVGA6 ; No, packet to be forwarded JRST RCVGA7 ; Yes, deliver a packet to host ; Option problem RCVGA4: HRRZ T1,T2 ; Error code or pointer? TLNN T2,<-1> ; Skip if code MOVX T1, ; This is error for pointer in T2 ; Cannot send packet, ICMP error code in T1 PUSH P,T2 ; Save info and PUSH P,T1 ; ICMP error code while MOVX T1,PT%KIA ; Trace packet TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes POP P,T1 ; Restore ICMP error code POP P,T2 ; and info CALL ICMERR ; Report error (maybe free packet) JRST RCVGAL ; Loop back for another packet ; The packet is not to be processed on this host. Forward it (to T1/) RCVGA6: SKIPE INTSCR JRST RCVGA9 ; Only the other GW can do the fwd-ing SETZRO PPROG,(PKT) ; Packet storage not to be saved for ACK LOAD T2,PITTL,(PKT) ; Time to live SUBI T2,1 ; Reduce by processing "time" STOR T2,PITTL,(PKT) ; Store new time to live JUMPLE T2,RCVGA9 ; Flush if packet now dead CALL SNDGA1 ; Send packet to address in T1 JRST RCVGAL ; Go process next packet ; Packet is for (one of) this host's address(es). RCVGA7: SKIPN T4,RRTP+IPOPA ; Check if Record route JRST RCVGA8 ; No, skip following ; Have to insert host address for routing option LOAD T3,PIDH,(PKT) ; Us CALL INSHST ; Insert host name RCVGA8: ; See if packet is a fragment JE ,(PKT),RCVGAX ; Not a fragment, give to dispatcher CALL RCVFR ; Process fragment (and queue) JUMPN PKT,RCVGAX ; Packet was reassembled, to dispatcher JRST RCVGAL ; Fragment was queued, get next packet ; Something bad about this packet. Flush it. RCVGA9: AOS BADPCT ; Count bad packets received MOVX T1,PT%XX5 ; Code for "Flushed by IP" TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes CALL RETPKT ; Return space to free storage JRST RCVGAL ; Hope for better luck on next packet IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT RCVGAY: PION RCVGAX: ..X=. ; Logically clean up here, but the RESTORE ; Arg block stays until RET IFN <..X-.>, PURGE SRP,SRC,RRTP,..X RET IFE REL6, IFN REL6, SUBTTL Internet Gateway - Fragment an IP Packet ;SNDFR Fragment IP packet ;T1/ Host (0 if RPI) ;T2/ Routine (if not multinet) ;T3/ Maximum packet size for the appropriate interface ;P1/ NCT address (If multinet) ;PKT/ Packet address ; CALL SNDFR ;Ret+1: Always, pkt passed to net or released if error (and PINTL+PPROG=0) ; Local variables ; BD Data length for first fragment (b) ; BO Original data offset (b) ; CNT A count of option bytes in header left to process. ; DCT Number of data octets remaining in original packet ; DPT Address in original packet for next data to be copied ; FFR Address of packet containing first fragment, or zero if none ; FRO Fragment offset ; LPK Extended address of the (long) packet being fragmented. ; MAXSIZ Maximum PIPL length for fragment. ; OIN Byte pointer into original packet for next option byte (T2) ; OLB Option length ; OOT Byte pointer into second fragment for next option byte (T3) ; OPT Option code ; SFR Address of packet containing second fragment (containing ; header & squeezed options), or zero if none ; NB: PPROG is set in this packet to make sure it stays ; around until all fragments have been generated; it is ; then cleared & if PINTL is zero, the packet is freed ; TPK If original PKT has PPROG zero, then PKT else zero [we RETPKT it]. SNDFR: STACKL LOCAL ; Locals shouldn't overrun P1 IFLE P1-LPCT, BD==:BDOL BO==:BOOP LPK==:LPCT PUSH P,T3 PUSH P,T2 PUSH P,T1 PUSH P,PKT ; Must be saved SETZM FFR ; Initialize SETZM SFR MOVE LPK,PKT MOVEM T3,MAXSIZ ; Maximum PIPL for local network SETZM TPK ; Assume PPROG 1 (save PKT) JN PPROG,(PKT),SNDFRB MOVEM PKT,TPK ; Release PKT when done... ; Check if fragmention not allowed or Time to Live about to expire SNDFRB: ; ... Check for fragment legal JE PIDF,(PKT),SNDFR1 ; Fragmentation not allowed? MOVX T1,PT%KDF ; Killed due to fragmentation TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes MOVX T1, ; Error message too CALL ICMERR ; Generate ICMP error JRST SNDFWX ; Not allowed, lose SNDFR1: ; Check Time to live LOAD T1,PITTL,(PKT) ; Get Time to live value CAILE T1,2 ; Need one for fragmentation & 1 left to send JRST SNDFR2 ; we have enough left MOVX T1,PT%KPT ; Killed due to time out TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes MOVX T1, ; Error message too CALL ICMERR ; generate ICMP error JRST SNDFWX ; Lose SNDFR2: ; Compute storage required for fragment LOAD T2,PIDO,(LPK) ; Data offset (w) MOVE BO,T2 ASH BO,2 ; Data offset (b) MOVE BD,MAXSIZ ; Max PIPL allowed SUB BD,BO ANDI BD,777770 ; Data octets (b) MOVE T1,BD ASH T1,-2 ; Data (ew) ADDI T1,PKTELI(T2) ; Packet length (w) PUSH P,T1 ; Save for copy CALL GETBLK ; Get some free space MOVE PKT,T1 ; First fragment address (or 0) POP P,T1 ; Copy length (w) JUMPG PKT,SNDFR3 ; did we get any space? MOVE PKT,(P) ; no. Get original PKT MOVX T1,PT%KFS ; Not enough room TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST SNDFRW SNDFR3: ; We got some free space MOVE T2,LPK ; Original packet MOVE T3,PKT ; First fragment CALL XBLTA ; Copy local+header+options+data MOVEM T2,DPT ; Next data address LOAD T1,PIFO,(PKT) ; Save initial fragment offset MOVEM T1,FRO LOAD T1,PIPL,(LPK) ; Initial packet length (b) SUB T1,BO ; Less header & options MOVEM T1,DCT ; Is initial data length (negative) CAMG T1,BD ; Should be greater that allowed data length JRST SNDFRD ; Shouldn't get here MOVE T1,BD ; Another fragment required SETONE PIMF,(PKT) ; So set more fragments flag... SNDFRD: ; ... SUBM T1,DCT ; Update Remaining data octets MOVNS DCT ; ... MOVE T2,T1 ASH T2,-3 ; Fragment blocks in fragment ADDM T2,FRO ; Next fragment offset ADD T1,BO ; Packet length (b) STOR T1,PIPL,(PKT) LOAD T1,PITTL,(PKT) ; Reduce time to live in first SUBI T1,1 ; fragment STOR T1,PITTL,(PKT) CALL SNDGAB ; Clear flags & set checksum SKIPG DCT ; Anything left? JRST SNDFRV ; No, all done MOVEM PKT,FFR ; Save frist fragment until check options MOVE T1,MAXSIZ ; Build second fragment squishing options ASH T1,-2 ; (w) ADDI T1,PKTELI CALL GETBLK ; Get some free space SKIPLE PKT,T1 ; Get the space? JRST SNDFR4 ; yup. MOVE PKT,(P) ; Nope. Original PKT MOVX T1,PT%KFS ; Not enough room TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST SNDFRW SNDFR4: MOVEI T1,<+PKTELI> ; Local plus minimum internet header MOVE T2,LPK ; From original packet MOVE T3,PKT ; Into second fragment CALL XBLTA ; T2 is now address of first original option byte & T3 is where they go ; Selectively copy options, if present SETZ T1, ; In case branch OLB==:BDOL OPT==:BOOP CNT==:LPCT LOAD CNT,PIDO,(LPK) ; Original header+option length (w) SUBI CNT, ; Minumum header size (w) JUMPLE CNT,SNDFRO ; No options ASH CNT,2 ; # option bytes present MOVE T1,[POINT 8,(T2)] ; Get byte pointers to MOVEM T1,OIN ; read old options MOVE T1,[POINT 8,(T3)] ; and MOVEM T1,OOT ; write those copied... ; ... Process next option SNDFRG: ILDB OPT,OIN ; Get option code CAIE OPT,ENDOPT ; End of options - go align CAIN OPT,ENDOPT+CPYOPT ; Watch out! JRST SNDFRN CAIN OPT,NOPOPT ; NOP - drop it JRST SNDFRL CAIN OPT,NOPOPT+CPYOPT ; Watch out! (let the next IP die) JRST SNDFRK ; Option with length ILDB OLB,OIN ; Get option length CAIL CNT,2 ; Was that a valid byte? CAMGE CNT,OLB ; Make sure have enough bytes left JRST SNDFRM ; Error, partial option ; Check if to copy option into all fragments TRNN OPT,CPYOPT ; Check copy on fragmentation flag JRST SNDFRH ; Not to be copied IDPB OPT,OOT ; Copy option code IDPB OLB,OOT ; and option length SNDFRH: SUB CNT,OLB ; Option bytes beyond this option ADDI CNT,1 ; Will count 1 at end SUBI OLB,2 ; Count down length byte JUMPLE OLB,SNDFRL ; Beware 2 byte option SNDFRI: ILDB T1,OIN ; Get next octet TRNE OPT,CPYOPT ; Check if copying IDPB T1,OOT ; Yes SOJG OLB,SNDFRI ; Loop if more in option CAIA SNDFRK: IDPB OPT,OOT ; Copy NOP... SNDFRL: SOJG CNT,SNDFRG ; Loop if another option JRST SNDFRN ; Error in options SNDFRM: CALL RETPKT ; Get rid of bad packet MOVE PKT,(P) ; Original packet MOVX T1,PT%KIO ; Error (not killing it though) TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST SNDFRW ; Give up ; Align options on word boundary SNDFRN: SETZ T2, ; Make sure padding is zero IDPB T2,OOT IDPB T2,OOT IDPB T2,OOT IDPB T2,OOT ; and leave it in free word HRRZ T1,OOT ; RH has # words of options MOVEI T2,(T1) STOR T2,PIDO,(PKT) ; New Data offset (w) SNDFRO: ; ... ; Update PIPL and copy data, T1 (new) option length (w), T3 Adr of first opt ; ... ADD T3,T1 ; Where to copy to LOAD T4,PIDO,(PKT) ; New data offset (w) ASH T4,2 ; (b) MOVE T1,MAXSIZ ; Max packet length (b) SUB T1,T4 ; Max data length (b) ANDI T1,777770 ; In fragment blocks CAMLE T1,DCT ; Number of bytes left MOVE T1,DCT ; Last fragment SUBM T1,DCT ; update Data bytes left MOVNS DCT ; ... ADD T4,T1 ; New data+header (b) STOR T4,PIPL,(PKT) ; Packet length ADDI T1,3 ; Round octets up to ASH T1,-2 ; Data words to copy MOVE T2,FRO ; Fragment offset for second frag STOR T2,PIFO,(PKT) ; Into header MOVE T2,T1 ASH T2,-1 ; Fragment blocks ADDM T2,FRO MOVE T2,DPT ; Where to copy from CALL XBLTA ; From original to second fragment MOVEM T2,DPT ; For next time LOAD T1,PITTL,(PKT) ; Reduce time to live SUBI T1,1 ; by fragmentation STOR T1,PITTL,(PKT) SETZM PKTQ(PKT) SETZRO PFLGS,(PKT) SKIPG DCT ; Need another fragment? JRST SNDFRQ ; No, second is the last SETONE PPROG,(PKT) ; We keep this PKT to copy headers & options MOVEM PKT,SFR ; Save packet address for copy SETONE PIMF,(PKT) ; There are more fragments SNDFRQ: CALL SNDGAC ; Set checksum ; Send first two fragments MOVEM PKT,LPCT ; Save second packet SETZ PKT, EXCH PKT,FFR ; While send first MOVX T1,PT%IFR ; Fragment created TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes MOVE T1,-1(P) ; Restore regs MOVE T2,-2(P) MOVE T3,-3(P) CALL SNDPKT ; Fragment to local interface MOVE PKT,LPCT ; Now send second MOVX T1,PT%IFR ; Fragment created TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes... MOVE T1,-1(P) ; ... Restore regs MOVE T2,-2(P) MOVE T3,-3(P) CALL SNDPKT ; Fragment to local interface SKIPG DCT ; Anything left? JRST SNDFRX ; All done ; Create third through last fragments SNDFRS: MOVE T1,SFR ; Packet with header+options LOAD T4,PIDO,(T1) ; Data offset (w) ASH T4,2 ; (b) MOVE T1,MAXSIZ ; Max packet length (b) SUB T1,T4 ; Max data length (b) ANDI T1,777770 ; In fragment blocks CAMLE T1,DCT ; Number of bytes left MOVE T1,DCT ; Last fragment SUBM T1,DCT ; Data bytes left MOVNS DCT PUSH P,T1 ADDI T1,<+3>(T4) ; Local+round up+header ASH T1,-2 ; Buffer length (w) CALL GETBLK ; Get some space SKIPLE PKT,T1 ; did we get the space? POP P,(P) ; Drop T1 MOVE PKT,(P) ; Original PKT MOVX T1,PT%KFS ; Not enough room TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST SNDFRW ; give up SNDFR5: MOVE T3,PKT ; Empty buffer MOVE T2,SFR ; Packet with local+header+options LOAD T1,PIDO,(T2) ; Length header+options (w) ADDI T1,PKTELI ; Plus local CALL XBLTA POP P,T1 ; Data length (b) LOAD T4,PIDO,(PKT) ; Header length (w) ASH T4,2 ; (b) ADD T4,T1 STOR T4,PIPL,(PKT) ; New length ADDI T1,3 ; Data bytes are ASH T1,-2 ; Rounded up words MOVE T2,FRO ; Fragment offset STOR T2,PIFO,(PKT) ; Into packet MOVE T2,T1 ASH T2,-1 ; Fragment blocks ADDM T2,FRO ; Next fragment offset MOVE T2,DPT ; Next data address CALL XBLTA MOVEM T2,DPT ; For next fragment... MOVE T2,LPK ; ... Get PIMF from LOAD T4,PIMF,(T2) ; original packet SKIPLE T4,DCT ; If more data MOVEI T4,1 ; Set PIMF STOR T4,PIMF,(PKT) ; Store result CALL SNDGAB ; Clear flags & set checksum ; (May enter here with first fragment in PKT, if fragmentation wasn't needed) SNDFRV: MOVX T1,PT%IFR ; Fragment created TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes MOVE T1,-1(P) ; Restore regs MOVE T2,-2(P) MOVE T3,-3(P) CALL SNDPKT ; Fragment to local interface SKIPLE DCT ; More data? JRST SNDFRS ; Yes JRST SNDFRX ; No, all done SNDFRW: ; Error, drop original packet MOVE PKT,(P) ; Restore PKT JN PPROG,(PKT),SNDFRX ; Pkt should be retransmitted. Save it. CALL RETPKT ; here after an ICMP error (storage already returned) SNDFWX: SETZM TPK ; Can only free it once SNDFRX: SKIPLE PKT,FFR ; Still have first fragment (had error)? CALL RETPKT ; Yes, return it SKIPG PKT,SFR ; Have second fragment? JRST SNDFRY ; No ?? SETZRO PPROG,(PKT) ; Were done with it JN PINTL,(PKT),SNDFRY ; Still in use by net? CALL RETPKT ; No, both done so return packet SNDFRY: SKIPE PKT,TPK ; Release original PKT? CALL RETPKT ; Yes, PPROG was zero POP P,PKT POP P,T1 POP P,T2 POP P,T3 RESTORE RET PURGE BD,BO,CNT,LPK,OLB,OPT ; Purge temp reg names SUBTTL Internet Gateway - Receive Fragment Processing ;RCVFR Process a fragment which was just received or Flush timedouts. ; MOVE PKT,24-bit fragment packet address ; CALL RCVFR CALL RCVFLS ;Ret+1: Always. PKT has 24-bit address of reassembled packet, or 0 ;While scanning received fragment queue (INTRAQ), drop any packets ;whose Time To Live has expired. ;Argument & return value ;PKT Packet which just arrived (0 if packet has been queued) ; During scan, 0 if packet has been processed (but can't RA) ; <0 24-bit address of packet to be RA'd ; >0 24-bit address of fragment to be inserted ; On return, 0 if reassembly is incomplete or the 24-bit ; address of the reassembled packet ;Global variables: ;INTRAQ 24-bit adr of first packet in reassembly queue, or 0 ; The queue is sorted by source host (PISH), protocol ; (PIPRO), destination host (PIDH), segment id (PISID), ; and fragment offset (PIFO). ;INTRAN Unique # for each packet to be RA'd; starts at 0 ; (minimizes comparisons of PISH, PIPRO, PIDH, & PISID) ;INTRAT TODCLK time INTRAQ should be scanned for expired packets ;Local variables are: ;LPK 24-bit adr of previous packet in chain ;CPK 24-bit adr of current packet being examined (0 if end) ;SAMPKT 0 the packet pointed to by PKT is not part of that ; pointed to by CPK ; >0 the packet pointed to by PKT is part of that pointed ; to by CPK AND all fragments (so far) are present ; The value is a pointer to the fragment BEFORE the ; first fragment of the (reassembled) packet (e.g. a LPK) ; <0 the packet pointed to by PKT is part of that pointed ; to by CPK AND all fragments (so far) are NOT present ;KPK List of expired packets, or 0 if none ;KILLTM TODCLK when fragment just received should be killed ;LASTFO Last value of fragment offset (all fragments up to it ; are present) ;Fields in the packet header are used as follows (while in INTRAQ): ;PKTQ Chains fragments together in sorted order; it contains ; the 24-bit packet address of the next packet in the Q ;PRXI Contains packet RA id (from INTRAN) when in INTRAQ ; Contains reason for being killed when in KPK list ; When PKT<0, First fragment contains LASTFO of last fragment ;PDCT The TODCLK time that the Time To Live expires ;PESEQ The fragment offset of the next fragment (PIFO+(PIPL-4*PIDO)+7/8) RCVFLS: SETZ PKT, ; Flush fragments which have timedout RCVFR: STACKL LOCAL SETZB SAMPKT,KPK ; Initialize local variables SETZM LASTFO ; No last fragment offset XMOVEI LPK,INTRAQ-PKTQ ; Dummy packet at head MOVX T1,377777777777 ; Plus infinity ; See if just dropping timed out packets JUMPE PKT,RCVFRA ; Yes, begin scan ; Fill in packet variables SETZM PKTQ(PKT) ; Not yet queued SETZRO PRXI,(PKT) ; No RA id LOAD T4,PITTL,(PKT) ; Get Time To Live SUBI T4,1 ; Processing time here JUMPLE T4,RCVFRT ; Kill it now IMULI T4,^D1000 ; Lifetime in milliseconds ADD T4,TODCLK ; When to kill it STOR T4,PDCT,(PKT) MOVEM T4,KILLTM ; Save it (from PRNPKI) LOAD T4,PIMF,(PKT) ; To check if last fragment LOAD T2,PIDO,(PKT) ; Header length (w) ASH T2,2 ; (b) LOAD T3,PIPL,(PKT) ; Total packet length (b) SUB T3,T2 ; Data length (b) SKIPE T4 ; If not last fragment TRNN T3,7 ; data must be multiple of 8 bytes CAIA ; Ok JRST RCVFRS ; Its a bad packet ADDI T3,7 ; Round up ASH T3,-3 ; Data length (f) LOAD T2,PIFO,(PKT) ; Get fragment offset ADD T3,T2 ; Find fragment end STOR T3,PESEQ,(PKT) ; Save for later MOVEM T1,INTRAT ; Plus infinity ; See if INTRAQ is empty MOVE CPK,INTRAQ ; Locate first fragment JUMPN CPK,RCVFRC ; Begin if not empty ; Queue was empty: only entry becomes this packet & KILLTM is next scan time MOVEM PKT,INTRAQ ; Begin a queue MOVE T4,KILLTM MOVEM T4,INTRAT ; Next scan time AOSN T1,INTRAN ; Get next RA id AOS T1,INTRAN ; Don't use 0 (Wow 2**36 packets??) STOR T1,PRXI,(PKT) MOVX T1,PT%QIF ; Fragment queued TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST RCVFRU ; All done... ; Just want to purge expired fragments (PKT=0) RCVFRA: MOVEM T1,INTRAT ; ... Plus infinity SKIPN CPK,INTRAQ ; Look for empty queue JRST RCVFRV ; All done JRST RCVFRC ; Begin with first fragment ; Move to next entry in queue RCVFRB: JUMPE CPK,RCVFRV ; All done MOVE LPK,CPK MOVE CPK,PKTQ(CPK) ; Process current queue entry RCVFRC: JUMPE CPK,RCVFRG ; Reached end of Q, may have PKT to insert ; Check if its time to kill this fragment LOAD T1,PDCT,(CPK) ; Get packet kill time CAMLE T1,TODCLK ; Its time up? JRST RCVFRD ; Not yet ; Place the packet on kill list MOVE T1,PKTQ(CPK) ; Next packet in INTRAQ MOVEM T1,PKTQ(LPK) MOVEM KPK,PKTQ(CPK) ; Killed packet to head of kill list MOVE KPK,CPK MOVE CPK,T1 MOVX T1,PT%KIT ; Reassembly timeout PKTPRN code STOR T1,PRXI,(KPK) JRST RCVFRC ; New current packet to process RCVFRD: ; See if still have a PKT fragment to insert JUMPLE PKT,RCVFRO ; No, just continue scan ; See if fragment should be inserted between LPK and CPK (KILLTM=kill todclk) LOAD T1,PRXI,(CPK) ; Get RA ids (this one is never 0) LOAD T2,PRXI,(PKT) ; 0 if none assigned CAMN T2,T1 JRST RCVFRE ; Skip 4 tests (PRXI set) LOAD T1,PISH,(CPK) ; Get source addresses LOAD T2,PISH,(PKT) CAMLE T2,T1 JRST RCVFRB ; Cannot insert yet CAME T2,T1 JRST RCVFRH ; Insert it here, may have RA id LOAD T1,PIPRO,(CPK) ; Get protocols LOAD T2,PIPRO,(PKT) CAMLE T2,T1 JRST RCVFRB ; Cannot insert yet CAME T2,T1 JRST RCVFRH ; Insert it here, may have RA id LOAD T1,PIDH,(CPK) ; Get destination addresses LOAD T2,PIDH,(PKT) CAMLE T2,T1 JRST RCVFRB ; Cannot insert yet CAME T2,T1 JRST RCVFRH ; Insert it here, may have RA id... LOAD T1,PISID,(CPK) ; ... Get packet ids LOAD T2,PISID,(PKT) CAMLE T2,T1 JRST RCVFRB ; Cannot insert yet CAME T2,T1 JRST RCVFRH ; Insert it here, may have RA id ; Just found another fragment, must be sure to set SAMPKT & LASTFO & PDCT LOAD T1,PRXI,(CPK) ; Get RA id STOR T1,PRXI,(PKT) ; For new fragment RCVFRE: MOVE T4,KILLTM STOR T4,PDCT,(CPK) ; Update kill time LOAD T1,PIFO,(CPK) ; Get fragment offsets LOAD T2,PIFO,(PKT) CAMLE T2,T1 JRST RCVFRJ ; Cannot insert yet, but part of packet CAME T2,T1 JRST RCVFRI ; Insert it here, have RA id ; Just found a duplicate, discard smaller LOAD T2,PESEQ,(PKT) ; Get end fragment offsets LOAD T1,PESEQ,(CPK) CAMG T2,T1 JRST RCVFRF ; Kill PKT ; New arrival is longer than old, swap new into queue MOVE T1,PKTQ(CPK) ; Tail MOVEM T1,PKTQ(PKT) MOVEM PKT,PKTQ(LPK) MOVX T1,PT%QIF ; Queued for reassembly TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes EXCH CPK,PKT RCVFRF: MOVEM KPK,PKTQ(PKT) ; Kill copy pointed to by PKT MOVE KPK,PKT SETZ PKT, ; PKT gone MOVX T1,PT%KDP ; Duplicate fragment rec'd & killed STOR T1,PRXI,(KPK) JRST RCVFRO ; Go process current fragment ; Reached end of INTRAQ (CPK=0), may still have PKT to process RCVFRG: JUMPLE PKT,RCVFRV ; Packet already processed ; Insert PKT between LPK and CPK, may have RA id RCVFRH: JN PRXI,(PKT),RCVFRI ; Already have RA id for fragment? AOSN T1,INTRAN ; Get next RA id AOS T1,INTRAN ; Don't use 0 (really had 2**36 packets??) STOR T1,PRXI,(PKT) RCVFRI: ; Now have RA id MOVEM PKT,PKTQ(LPK) ; Insert PKT between LPK and CPK MOVEM CPK,PKTQ(PKT) MOVE CPK,PKT MOVX T1,PT%QIF ; Fragment queued TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes SETZ PKT, ; Fragment processed... ; See if first fragment of a packet, if so, set SAMPKT & LASTFO RCVFRJ: ; ... JUMPN SAMPKT,RCVFRL ; Cannot be first fragment of packet MOVE SAMPKT,LPK ; Flag is adr before first (to unlink) JE PIFO,(CPK),RCVFRK ; Jump if first fragment TLO SAMPKT,400000 ; First fragment missing, cannot RA RCVFRK: LOAD T1,PESEQ,(CPK) ; Next fragment offset MOVEM T1,LASTFO ; for continuity check JRST RCVFRB RCVFRL: RCVFRO: ; Process current fragment LOAD T1,PDCT,(CPK) ; Fragment timeout CAMG T1,INTRAT ; Find minimum MOVEM T1,INTRAT ; For next scan JUMPLE SAMPKT,RCVFRB ; Not part of a RA'able packet LOAD T1,PRXI,(CPK) ; Get RA ids LOAD T2,PRXI,(LPK) CAMN T1,T2 JRST RCVFRP SETZM SAMPKT ; End of packet, not reassemblable JRST RCVFRB ; Go for next in queue RCVFRP: ; Check if current fragment is next one required LOAD T1,PIFO,(CPK) ; Its fragment offset must CAMLE T1,LASTFO ; be less than or equal to this offset JRST RCVFRQ ; Missing fragment LOAD T1,PESEQ,(CPK) ; Next fragment needed MOVEM T1,LASTFO JRST RCVFRR RCVFRQ: TLO SAMPKT,400000 ; Cannot RA RCVFRR: ; Update kill time in fragments to that of recently arrived fragment MOVE T4,KILLTM STOR T4,PDCT,(CPK) JUMPLE SAMPKT,RCVFRB ; Don't look for last fragment JN PIMF,(CPK),RCVFRB ; Not last fragment ; Have all fragments for reassembly, remove them from the INTRAQ MOVE LPK,SAMPKT ; Points before first MOVE PKT,PKTQ(LPK) ; First fragment for reassembly LOAD T1,PESEQ,(CPK) ; Number of fragments in packet STOR T1,PRXI,(PKT) ; saved for RA TLO PKT,400000 ; Flag it so don't try to insert MOVE T1,PKTQ(CPK) MOVEM T1,PKTQ(LPK) ; Relink INTRAQ SETZM PKTQ(CPK) ; Last fragment for reassembly MOVE CPK,T1 ; Next fragment to scan SETZ SAMPKT, ; Just check timeouts in rest of scan JRST RCVFRC ; Go for current item RCVFRS: SKIPA T1,[PT%KIP] ; Code for invalid packet RCVFRT: MOVX T1,PT%KPT ; Code for Time To Live expired STOR T1,PRXI,(PKT) MOVEM PKT,KPK ; Argument packet has expired RCVFRU: SETZ PKT, ; Nothing to be returned ; All done with scan of queue, return any killed packets RCVFRV: MOVEM PKT,LASTFO ; Save return value over local variable JUMPE KPK,RCVFRX ; Nothing to kill RCVFRW: MOVE PKT,KPK ; Head of expired packet queue MOVE KPK,PKTQ(PKT) ; Get tail SETZM PKTQ(PKT) LOAD T1,PRXI,(PKT) ; Reason for discarding TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes; Finished with packet CALL RETPKT ; Release storage JUMPN KPK,RCVFRW ; If more go back RCVFRX: MOVE PKT,LASTFO ; Get return value back RCVRA: ; If PKT < 0, then reassemble fragments JUMPGE PKT,RCVRAX ; PKT = 0 means nothing to RA TLZ PKT,400000 ; Get first fragment address MOVE KPK,PKT ; All fragments will be killed SETZ PKT, ; Nothing to return MOVE CPK,KPK ; To move through fragments ; Get storage for reassembled packet LOAD T1,PIDO,(KPK) ; Internet header (w) LOAD T2,PRXI,(KPK) ; Number of fragment blocks ASH T2,1 ; at 2 words each ADDI T1,PKTELI(T2) ; Add them and local overhead CALL GETBLK ; Get storage for all JUMPN T1,RCVRAF ; Got enough? ; Not enough space, kill fragments off MOVX T1,PT%KIS ; Code for killed due to no space RCVRAE: STOR T1,PRXI,(CPK) ; Code into fragment MOVE CPK,PKTQ(CPK) ; Move to next JUMPN CPK,RCVRAE ; Back for all fragments JRST RCVFRV ; Back to kill them off RCVRAF: ; Enough room, copy first fragment into packet MOVE PKT,T1 ; Combined packet SETZM PKTQ(PKT) SETZRO PFLGS,(PKT) MOVE SAMPKT,PKT ; Working address in combined packet ADDI SAMPKT,PKTSII ; but skip flags MOVE T2,KPK ; Start with complete first fragment ADDI T2,PKTSII ; but skip flags LOAD T1,PESEQ,(KPK) ; Data length MOVEM T1,LASTFO ; Next fragment offset ASH T1,1 ; in words LOAD T4,PIDO,(KPK) ; Header length (w) ADDI T1,PKTELI-PKTSII(T4) ; Add local - flags + header + data JRST RCVRAP ; Into loop RCVRAL: MOVE CPK,PKTQ(CPK) ; Get next fragment JUMPN CPK,RCVRA1 ; Missing Last fragment? CALL RETPKT ; yes. Error SETZ PKT, ; Nothing to return MOVX T1,PT%KIT ; Code for impossible error JRST RCVRAE ; give up RCVRA1: LOAD T2,PIDO,(CPK) ; Header length (w) MOVE T3,LASTFO ; Next fragment to copy LOAD T1,PESEQ,(CPK) ; Data end LOAD T4,PIFO,(CPK) ; Data start ; Worry about overlap - beginning of fragment may already be copied CAMGE T3,T1 ; If this fragment adds some MOVEM T1,LASTFO ; Save new last fragment SUB T3,T4 ; Find # fragments of overlap JUMPGE T3,RCVRA2 ; Missing fragment? CALL RETPKT ; yes. Error. SETZ PKT, ; Nothing to return MOVX T1,PT%KIT ; Code for impossible error JRST RCVRAE ; give up RCVRA2: ASH T3,1 ; In words SUB T1,T4 ; Data length of CPK ASH T1,1 ; in words ADDI T2,PKTELI(T3) ; Increase copy offset and SUB T1,T3 ; Decrease copy length by overlap JUMPLE T1,RCVRAS ; Nothing required from this fragment ADD T2,CPK ; Start of data address RCVRAP: ; Copy T1 words from T2 into packet MOVX T4,PT%DIF ; Code for IP RA'd STOR T4,PRXI,(CPK) MOVE T3,SAMPKT ; Address in packet ADD SAMPKT,T1 ; Next address in packet CALL XBLTA ; Copy words RCVRAS: JN PIMF,(CPK),RCVRAL ; If more fragments, loop ; Done, correct internet header; find new packet length LOAD T1,PIPL,(CPK) ; Last fragment length (b) LOAD T2,PIDO,(CPK) ; Header length (w) ASH T2,2 ; (b) SUB T1,T2 ; Data length (b) of last fragment LOAD T2,PIFO,(CPK) ; Data length (f) of previous fragments ASH T2,3 ; (b) ADD T1,T2 ; Total data length (b) LOAD T2,PIDO,(PKT) ; Data offset (w) ASH T2,2 ; (b) ADD T1,T2 ; Total packet length (b) STOR T1,PIPL,(PKT) ; into packet SETZRO ,(PKT) ; Should be zero... LOAD T1,PDCT,(PKT) ; ... Kill time SUB T1,TODCLK ; remaining IDIVI T1,^D1000 ; in seconds CAILE T1,377 ; Clamp to 8 bits MOVEI T1,377 CAIGE T1,1 MOVEI T1,1 STOR T1,PITTL,(PKT) ; Remaining Time To Live SETZRO PICKS,(PKT) ; Compute CALL INTCKS ; new header checksum STOR T1,PICKS,(PKT) SETZRO PRXI,(PKT) ; Clear variables in header SETZRO PDCT,(PKT) SETZRO PESEQ,(PKT) ; Have a reassembled packet to return after release fragments MOVX T1,PT%IRA ; Packet reassembled TDNE T1,INTTRC ; Want trace? CALL PRNPKI ; Yes JRST RCVFRV ; Go kill fragments from KPK RCVRAX: RESTORE RET SUBTTL Internet Gateway - Process IP Options ;IPOPT Process IP Options - Phase 1, before routing. ;T1/ Pointer to argument block: SRP,SRC,RRTP,RRTC,CURBYT,OPTP SRP==0 ; Pointer before our sending interface's address, or 0 SRC==1 ; Route option code (LSROPT or SSROPT) [temp:see RRTC] RRTP==2 ; Pointer before our sending interface's address, or 0 RRTC==3 ; Current byte number for RRTOPT parameter problem message CURBYT==4 ; Current byte number for parameter problem message OPTP==5 ; Working pointer to next option byte GARB==6 ;,2 ; Dummy pointer/count pair ; IPOPS==^D8 ; Size of block ;PKT/ (ext) pointer to packet ;CALL IPOPT ;Ret+1: Option error, T2 has code ;Ret+2: OK IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT IPOPT: SETZM SRP(T1) ; No Source Route SETOM SRC(T1) ; Invaild option code SETZM RRTP(T1) ; No Record Route SETZM CURBYT(T1) ; No Parameter problem error pointer LOAD T2,PIDO,(PKT) ; Get size of IP header LSH T2,2 ; In bytes SUBI T2,MINIHS ; Option length, bytes JUMPLE T2,RSKP ; Good, No options (CURBYT is 0) LOCAL MOVEM T1,ARGP ; Address of argument block MOVEM T2,REMB ; # Option bytes to process MOVX T2,MINIHS ; Byte offset to options MOVEM T2,CURBYT(ARGP) ; First option byte AOS CURBYT(ARGP) ; Start with one?? ADJBP T2,[POINT 8,PKTELI(PKT),7] ; From IP header MOVEM T2,OPTP(ARGP) ; Save pointer SETZ T2, ; No parameter problems ; Process next option from header NXTOP: MOVE T1,OPTP(ARGP) ; Pointer at option for subroutines MOVX OPLB,1 ; Assume single byte option length LDB T4,OPTP(ARGP) ; Get option TRZ T4,CPYOPT ; Drop copy flag CAIN T4, ; END of options? JRST DONOP ; Yes, quit CAIN T4, ; NOP? JRST FINOP ; Yes, on to next... ; ... Option with length MOVX T2,1 ; Parameter problem - option length CAIGE REMB,2 ; Enough remaining for length? JRST DONOP ; No, error ILDB OPLB,OPTP(ARGP) ; Get length CAMLE OPLB,REMB ; Exceed remaining header length? JRST DONOP ; Yes, error MOVE T2,CURBYT(ARGP) ; Count at option (useful parameter) XMOVEI T3,SRP(ARGP) CAIE T4, ; Lose Source Route? CAIN T4, ; Strict Source Route? CALL RUTOP JUMPE T3,FINOP ; Found it, T2 may indicate error XMOVEI T3,RRTP(ARGP) CAIN T4, ; Record Route? CALL RUTOP JUMPE T3,FINOP ; Found it, T2 may indicate error XMOVEI T3,GARB(ARGP) CAIN T4, ; Time Stamp? CALL DOTSP ; Yes, process it now (save T1) JUMPE T3,FINOP ; Found it, T2 may indicate error ; Uninteresting or unknown option SETZ T2, ; No parameter problem FINOP: JUMPN T2,DONOP ; Parameter problem SUB REMB,OPLB ; Bytes remaining in header ADDM OPLB,CURBYT(ARGP) ; Count for next option ADJBP OPLB,T1 ; Point at next option MOVEM OPLB,OPTP(ARGP) ; Reset pointer JUMPG REMB,NXTOP ; Loop if more DONOP: TLNE T2,<-1> ; Non-zero left half is SETZM CURBYT(ARGP) ; Error code will replace count ADDM T2,CURBYT(ARGP) ; Done processing options SKIPN T2 ; Any errors? SETZM CURBYT(ARGP) ; No errors MOVE T2,CURBYT(ARGP) ; Return code RESTORE SKIPN T2 ; Look for error in options AOS (P) ; All ok, skip return RET PURGE SRP,SRC,RRTP,RRTC,CURBYT,OPTP,GARB SUBTTL Internet Gateway - Process Routing Options ;RUTOP Routing Options ;T1/ Pointer at Option type code ;T2/ Count of Option type code byte ;T3/ Address for pointer & count ;T4/ Option code w/o CPYOPT ; CALL RUTOP ;Ret+1: Always, Parameter problem if T2 non-zero (relative offset, or error) ; T1/ unchanged, T3/0 RUTOP: SKIPE (T3) ; Already have this option? JRST RUTZ ; Yes, error DMOVEM T1,(T3) ; No, Save pointer and curbyt LOCAL PUSH P,T1 MOVEM T1,OPTP ; Set working pointer MOVEM T4,OPT ; Masked option ILDB OPTL,OPTP ; Option length MOVX T2,1 ; In case error CAIGE OPTL,7 ; Header + one id JRST RUTY ; Lose CAIN OPT, ; Record route? JRST RUTEX ; Yes, skip following JN PLCLO,(PKT),RUTEX ; Jump if we generated packet LOAD T1,PIDH,(PKT) ; Immediate destination CALL LCLHST ; To one of us? CAIA ; No JRST RUTEX ; Yes, go look for next hop ;We received a packet for which we are not the destination specified ;in the packet destination field. This is a route failure for Strict ;Source Routes, but is OK for Loose Routes. CAIE OPT, ; Strict route? JRST RUTK ; No. Ignore route option, ; Use full routing MOVX T2, ; Yes, Different error message JRST RUTY ; For route failure ;We recieved a packet for which we are the destination specified in ;the packet destination field. ;Check if the Route option has been exhausted or not. RUTEX: ILDB CPTR,OPTP ; Current pointer offset CAIG OPTL,(CPTR) ; Already full? JRST RUTK ; Yes, ignore option, send to destination MOVX T2,2 ; Parameter problem with pointer CAIGE OPTL,4-1(CPTR) ; Enough room for another entry? JRST RUTY ; No, fail ... MOVEI T2,-4(CPTR) ; ... Bytes to before our slot ADDI CPTR,4 ; Update pointer DPB CPTR,OPTP ; In option header ADDM T2,1(T3) ; Updated count in case error ADJBP T2,OPTP ; Pointer before our sending MOVEM T2,OPTP ; address slot MOVEM T2,(T3) ; To be filled in later CAIN OPT, ; Record route option? JRST RUTX ; Yes, don't update packet destination ; Extract next destination from route and put it in packet header MOVX T1,17 ; Unused bits ILDB T2,OPTP ; Get id byte LSH T2,^D<36-8> ; Left justify LSHC T1,^D8 ; & pack JUMPGE T1,.-3 ; 4 bytes STOR T1,PIDH,(PKT) ; Next destination for packet MOVEM OPT,1(T3) ; Save Strict/Loose code JRST RUTX ; Done for now, no errors RUTK: SETZM (T3) ; Ignore this option SETZM 1(T3) RUTX: SETZ T2, ; No errors RUTY: POP P,T1 ; Error, T2 has <0,,relative offset>, RESTORE ; Or SETZ T3, ; Option processed RET ; Duplicate route option is an error RUTZ: MOVEM T2,1(T3) ; Error pointer SETZ T3, ; Option processed RET ;INSHST insert out-going host id in packet. ; Second Phase 2 of route option - ; T3/ Host id to be inserted ; T4/ Pointer before slot ; CALL INSHST ;Ret+1: Always, T1,T2 preserved INSHST: ROT T3,^D<4+8> ; First byte right justified IDPB T3,T4 ; Pack them in ROT T3,^D8 IDPB T3,T4 ROT T3,^D8 IDPB T3,T4 ROT T3,^D8 IDPB T3,T4 RET SUBTTL Internet Gateway - Timestamp Option Handling ;DOSTP Time Stamp Option. ; T1/ Pointer at TSPOPT ; CALL DOTSP ;Ret+1: Always, Parameter problem if T2 non-zero (relative offset) ; T1/ unchanged, T3/0 DOTSP: SAVEAC LOCAL MOVE OPTP,T1 ; Set working pointer ILDB OPTL,OPTP ; Option length MOVX T2,1 ; In case error CAIGE OPTL,8 ; Header + one timestamp JRST DOTSY ; Lose ILDB CPTR,OPTP ; Current pointer offset MOVEM OPTP,SAVPTR ; Save length for later update CAIG OPTL,(CPTR) ; Already full? JRST DOTSF ; Yes SUBI CPTR,1+1 ; Begins at 1 not 0 & ILDB not LDB ILDB T3,OPTP ; Get Overflow/Type ANDI T3,17 ; Type field ; 4-byte options MOVX T4,4 ; Assumed required length CAIGE OPTL,4(CPTR) ; Enough room for us? JRST DOTSY ; No, parameter problem CAIN T3,0 ; Is it Type 0? JRST DOTS0 ; Yes ; 8-byte options MOVX T4,8 ; Required length CAIGE OPTL,8(CPTR) ; Enough room for us? JRST DOTSY ; No, parameter problem CAIN T3,1 ; Is it Type 1? JRST DOTS1 ; Yes CAIN T3,3 ; Is it Type 3? JRST DOTS3 ; Yes ; Unknown type - may be protocol extension we don't know about, ; so just skip whole option JRST DOTSX DOTS3: ; Type 3: Add time if we are next Id ADJBP CPTR,T1 ; Point before our slot MOVX T1,17 ; Used to count bytes ILDB T2,CPTR ; Get id byte LSH T2,^D<36-8> ; Left justify LSHC T1,^D8 ; & pack JUMPGE T1,.-3 ; 4 bytes TXZ T1,<740000,,0> ; Mask to 32 bits CALL LCLHST ; Is it one of us? JRST DOTSX ; No, skip option JRST DOTST ; Yes, Go add time DOTS1: ; Type 1: Add our Id and current time ; since midnight to list ADJBP CPTR,T1 ; Point before our slot MOVE T2,DEFADR ; Our default Id LSH T2,4 ; Unused bits MOVX T1,17 ; Unused bits in word LSHC T1,^D8 ; Next byte IDPB T1,CPTR ; Into header JUMPG T1,.-2 JRST DOTST DOTS0: ; Type 0: Add current time since ; midnight to list ADJBP CPTR,T1 ; Point before our slot DOTST: CALL INETUT ; Get current msec since midnight LSHC T1,^D<-32> ; Left justify into T2 MOVX T1,17 ; Unused bits in word LSHC T1,^D8 ; Next byte IDPB T1,CPTR ; Into header JUMPG T1,.-2 DOTSU: LDB T1,SAVPTR ; Get old pointer ADD T1,T4 ; Plus length we used DPB T1,SAVPTR ; Back into header JRST DOTSX ; All done without error DOTSF: ; Full ILDB T1,SAVPTR ; Get Ovfl/Type ADDI T1,20 ; Bump Ovfl MOVX T2,3 ; Parameter problem, Ovfl CAIL T1,400 ; Field too large? JRST DOTSY ; Yes, lose DPB T1,SAVPTR ; Update Ovfl DOTSX: SETZ T2, ; No error (offset for parameter problem) DOTSY: ; Error exit with T2 set RESTORE SETZ T3, RET SUBTTL Gateway Table Routines $INIT IFE REL6, IFN REL6, COMMENT ! This module contains routines for maintaining and accessing net<->gateway tables. ! SUBTTL Gateway Table Routines - Lookup a Gateway Address ;GWYLUK Look up a gateway address for a given destination. ;Accepts T1/ 32 bit destination address ;Returns T1/ 0 if no path to the destination, or ; Interface# & Address of a gateway/host on a ; connected network that can gateway to that ; destination (may be the same destination) ; T2/ Garbage ; T3/ If system runs Multinet, garbage; otherwise ; the interface index to use (-1,,index). ; P1/ If system runs multinet the address of the ; NCT for an interface to use ((0 or -1),,index) ; 0 if no path GWYLUK: ACVAR NETNUM T2,T1 ; Get the network number MOVEM T2,NET ; Save number CALL NETHSH ;(T2 to T2, killing 3,4); Hash the network into tables JRST LUKNIT ; not in the tables SKIPGE P1,NETGWY(T2) ; Gateway? RET ; -1,,.NCTi ; No, return with interface JUMPE P1,LUKNIT ; Deleted entry ; Found gateway MOVE T1,P1 ; get address GWYL5: LOAD T3,INTNUM,+T1 ; get interface index MOVE P1,NCTVT(T3) ; get NCT address TLZ T1,740000 ; Just 32-bit address RET ; and return with it ENDAV. ; Here if there is no entry in the network tables ; for that net. ; T1/ destination, T2/ net hash index of empty slot in NETGWY LUKNIT: PUSH P,T2 ; Save hash table index CALL FNDGWY ; Find a gateway JUMPE T1,[POP P,T2 ; Restore hash address RET] ; Return unsucessfully CALL FNDNCT ; Find interface for this one IFNSK. BUG.(CHK,GWYFNB,IPIPIP,SOFT,,,< Cause: The internet gateway lookup routine has returned the address for a gateway that is not a neighbor. >) POP P,T2 ; Trim stack JRST RETZ ; Say no path exists ENDIF. LOAD T2,NTNUM,(P1) ; Get interface index STOR T2,INTNUM,+T1 ; save interface index POP P,T2 ; restore hash address MOVEM T1,NETGWY(T2) ; place gateway in tables JRST GWYL5 ; and join above SUBTTL Gateway Table Routines - State Change Routines ;INTUP Signal that an interface has come up. ;Called T1/ Interface index (if not multinet) ; P1/ NCT address (If multinet) INTUP:: MOVE T2,NTNET(P1) ; get network number CALL NETHSH ; hash the entry NOP ; ignore failure HRROM P1,NETGWY(T2) ; save NCT RET ; and return ;INTDWN Signal that an interface has gone down. ;Called P1/ NCT for the interface (if multinet) ; T1/ Interface index (if not) INTDWN::SAVET STKVAR ; interface index MOVE T1,NTLADR(P1) ; Get our address MOVE T2,NTNET(P1) ; and it's net number CALL NETHSH ; Hash it BUG.(HLT,INTDHF,IPIPIP,SOFT,,,< Cause: The internet network hashing routine has failed to find the local network. This probably indicates that the network hash table is corrupted. >) SETZM NETGWY(T2) ; don't use this interface LOAD T2,NTNUM,(P1) ; Get the internal index MOVEM T2,INDEX ; Save it MOVSI T2,-NETHSZ ; size of hash table ; INDEX has interface index ; T2 has index into hash table INTDWL: SKIPG T1,NETGWY(T2) ; Anything in this slot? JRST INTDL2 ; no, onward LOAD T4,INTNUM,+T1 ; get index of this number CAME T4,INDEX ; Same interface? JRST INTDL2 ; mark it down SETZM NETGWY(T2) ; erase that entry INTDL2: AOBJN T2,INTDWL ; loop through the table RET ; and return ENDSV. ;GWYDWN Signal that a gateway has crashed. ;Called T1/ Address of gateway ;Return T2,T3 clobbered ; all paths using this gateway erased. GWYDWN: MOVSI T2,-NETHSZ ; Size of the hash tables GWYDWL: SKIPG T3,NETGWY(T2) ; get address JRST GWYDW2 ; None there TXZ T3,-1B3 ; Clear the index field CAMN T1,T3 ; this gateway a path to there? SETZM NETGWY(T2) ; Yes, flush it GWYDW2: AOBJN T2,GWYDWL ; Loop through the table RET ; and return SUBTTL Internet Gateway Tables - Hash Table Routines ;NETHSI Initialize the network hash table ;Called at system startup, whenever the hash table overflows, and at ;random times to flush unused table entries. NETHSI:: SAVEAC NOSKED ; Take over the machine SETZM NETHTB ; Clear MOVE T1,[XWD NETHTB,NETHTB+1] BLT T1,NETHTB+NETHSZ ; The entire table SETZM NETGWY ; And MOVE T1,[XWD NETGWY,NETGWY+1] BLT T1,NETGWY+NETHSZ ; the parallel table XMOVEI P1,NCTVT ; Point to NCT vector table NETHI0: LOAD P1,NTLNK,(P1) ; get next in chain JUMPE P1,NETHIX ; done MOVE T2,NTNET(P1) ; get the net number CALL NETHSH ; Hash it into tables NOP ; Ignore return SKIPE NTORDY(P1) ; If this network is usable HRROM P1,NETGWY(T2) ; Set it as the path to this net JRST NETHI0 ; And loop through all interfaces NETHIX: OKSKED ; Allow use of the machine RET ; return when done ;NETHSH Look up a network number in the hash tables ;T2/ network number ;Returns ;T2/ Slot in the table for that network ;Clobbers T3, T4 ;+1 if no entry currently there ;(the slot is reserved in that case) ;+2 if that network already has a slot in the tables NETHSH::ACVAR ; net number MOVE NET,T2 ; Save it here IDIVI T2,NETHSZ ; Make the initial probe EXCH T2,T3 ; ... NOSKED ; protect the table ;The following is an optimization for the (hopefully common) case ;where there is no collision and/or the entry is already in the ;table. CAMN NET,NETHTB(T2) ; Same entry? JRST NETHSS ; Success, go use it SKIPN NETHTB(T2) ; Empty? JRST NETHSF ; First probe failed IDIVI T3,NETHSZ ; divide again to get the delta SKIPN T4 ; If there is none MOVEI T4,1 ; use 1 MOVEI T3,NETHSZ-1 ; size of the tables... ;At this point T2 holds the current probe, T4 holds the delta, T3 ;holds the number of attempts before deciding the table is full. The ;current table slot is not this net. NETHSL: ADDI T2,(T4) ; ... Add in the delta CAIL T2,NETHSZ ; Overflow? SUBI T2,NETHSZ ; back up CAMN NET,NETHTB(T2) ; Same net? JRST NETHSS ; found it SKIPN NETHTB(T2) ; Slot in use? JRST NETHSF ; Empty, use it SOJG T3,NETHSL ; loop through the table ;Here if the table is full. we reinitialize the table, since we ;assume that the table is large enough to hold all networks with ;active connections. CALL NETHSI ; re-init the table MOVE T2,NET ; Get the network number back CALL NETHSH ; hash it JRST NETHSF ; Consider not there if none NETHSS: ; Here if an entry is found. OKSKED ; Allow scheduling again RETSKP ; return success NETHSF: ; Here if there is no entry for this net. MOVEM NET,NETHTB(T2) ; Reserve a table slot OKSKED RET ; return failure ENDAV. SUBTTL Internet User Queues $INIT IFE REL6, IFN REL6, COMMENT ! These routines implement the user interface to the Internet world. Once assigned, an Internet queue may be used to send and receive messages to Internet hosts. The buffer in user space has only a count word, an Internet header and Internet text. The gateway selects an appropriate hardware interface, generates the required local header for that network and sends the packet out. ! SUBTTL Internet User Queues - ASNIQ% JSYS ;Assign Internet Queue JSYS (ASNIQ%) ;T1/ Flags,,pointer to QDB ; AQ%SCR==1B0 ; B0: Use secure interface. ; AQ%SPT==1B1 ; B1: Single(local) port protocol ; AQ%ICM==1B2 ; B2: Allow sending and receiving ICMP messages ; (Other flag bits must be 0) ;T2/ (Not currently used. Must be 0) ;T3/ (Not currently used. Must be 0) ; Note: Must have Net Wiz enabled ; ASNIQ ;Ret+1: Failed. Error code in T1. Owning job # in T2 if ASNSX2. ;Ret+2: OK. Internet queue handle in T1. Max buffer count in T2. IFE REL6,<.ASNIQ::> IFN REL6, MCENT ; Enter monitor SKIPN INTON ; IP initialized? RETERR(ASNSX1) ; No, Cannot have queue TXNE T1,<<-1,,0>&<^->> ;any bad bits on? RETERR(ARGX22) ; yes so bad call MOVX T4, ; Capability bit for network wizard TDNN T4,CAPENB ; Caller has it enabled? RETERR(NTWZX1) ; No. DMOVE T3,T1 ; Place for call via locked call XMOVEI T1,INTQLK ; The lock to lock XMOVEI T2,ASNIQ0 ; Function to call CALL LCKCAL ; Call work routine while lock set JUMPL T1,IQFAIL ; Finish up and give error return UMOVEM T1,T1 ; Pass queue handle to caller MOVE T2,INTXPW ; Biggest count word user can give MOVEI T2,-PKTELI+1(T2) ; (without fragmentation) UMOVEM T2,T2 ; Tell him this size SMRETN ; Give success return ;ASNIQ0 Guts of ASNIQ JSYS. ;T1/ From user ;T2/ From user ;INTQLK/locked NOINT ; CALL ASNIQ0 ;Ret+1: Always. T1 has queue handle, or ; If error, T1 has -1,,errror (if T1 is ASNSX2, T2 has Job #) ASNIQ0: STACKL <> ; Stack space for copy of user's QDB LOCAL MOVEM T1,QDB MOVEM T1,FLGS ; Save flags MOVEI T3,USRQDB ; Local copy MOVE T2,T1 ; User data block MOVEI T1,.IQLEN ; Length of a queue descriptor CALL BLTUM ; Copy from user into monitor MOVEI QDB,USRQDB ; Reference only our copy now MOVSI T1,-.IQLEN ; Set to scan the QDB HRR T1,QDB MOVEI T2,17 ; Right four bits must be cleared ANDCAM T2,0(T1) AOBJN T1,.-1 MOVX T1,<-1B15> ; Mask for single port TXNE FLGS,AQ%SPT ; Single port protocol? ANDM T1,.IQPTM(QDB) ; Yes. Flush comparison on foreign port... MOVSI IQ,-NIQ ; ... Set to scan the queue tables MOVEI FQ,0 ; Indicate no free slot found yet ASNIQ1: MOVE T1,INTQJB(IQ) ; Get owner CAME T1,[-1] ; Free? JRST ASNIQ2 ; No. Go check for conflicts. SKIPN FQ ; Already know of a free slot? MOVE FQ,IQ ; No so save this one. JRST ASNIQ8 ; And loop to next queue ; Check for conflicts with already assigned queues ASNIQ2: MOVE T1,.IQPRM(QDB) ; Get protocol mask word from user's blk AND T1,INTQM0(IQ) ; Compute least specific mask MOVE T2,.IQPRV(QDB) ; Get value word XOR T2,INTQV0(IQ) ; Compare against this queue TDNE T1,T2 ; But only in the bits that matter JRST ASNIQ8 ; Difference is OK. Try next. MOVE T1,.IQFHM(QDB) ; Same for foreign host AND T1,INTQM1(IQ) MOVE T2,.IQFHV(QDB) XOR T2,INTQV1(IQ) TDNE T1,T2 JRST ASNIQ8 MOVE T1,.IQSHM(QDB) ; Same for local host AND T1,INTQM2(IQ) MOVE T2,.IQSHV(QDB) XOR T2,INTQV2(IQ) TDNE T1,T2 JRST ASNIQ8 MOVE T1,INTQJB(IQ) ; Get flags XOR T1,FLGS ; Compare with request TXNE T1,AQ%SPT ; Differ only in single/double port spec? JRST ASNIQF ; Yes. Not allowed MOVE T1,.IQPTM(QDB) ; Compare port word AND T1,INTQM3(IQ) MOVE T2,.IQPTV(QDB) XOR T2,INTQV3(IQ) TDNN T1,T2 JRST ASNIQF ; Give fail return due to conflict ASNIQ8: AOBJN IQ,ASNIQ1 ; Doesn't conflict with this queue, try next JUMPE FQ,ASNIQN ; All slots full ... ; ... Assign queue to user MOVE T1,.IQPRM(QDB) ; Copy into queue tables MOVEM T1,INTQM0(FQ) AND T1,.IQPRV(QDB) MOVEM T1,INTQV0(FQ) MOVE T2,.IQFHM(QDB) MOVEM T2,INTQM1(FQ) AND T2,.IQFHV(QDB) MOVEM T2,INTQV1(FQ) MOVE T3,.IQSHM(QDB) MOVEM T3,INTQM2(FQ) AND T3,.IQSHV(QDB) MOVEM T3,INTQV2(FQ) MOVE T4,.IQPTM(QDB) MOVEM T4,INTQM3(FQ) AND T4,.IQPTV(QDB) MOVEM T4,INTQV3(FQ) MOVE T1,JOBNO ; Our job number HLL T1,FLGS ; Merge in the flags MOVEM T1,INTQJB(FQ) ; Say we are the owner MOVEI T1,(FQ) ; Get the queue number CALL REL1IQ ; Flush old packets SETZM INTQSP(FQ) ; No messages MOVE T3,TODCLK ; When assigned MOVEM T3,INTQTM(FQ) MOVE T1,FORKX ; Fork ID of creator HRROM T1,INTQFK(FQ) ; No fork waiting,,owner's FORKX ; fork for receive interrupt & support HRRZ T1,FQ ; Get the queue handle for user JRST ASNIQX ; Success return ASNIQF: HRRZ T1,INTQJB(IQ) ; Get job number owning this queue IFN REL6,< ; Only if we are release 6 CALL LCL2GL ; Get the global job number SETZ T1,> ; in case of error return UMOVEM T1,T2 ; Give it to user SKIPA T1,[ASNSX2] ; "Queue already in use" ASNIQN: MOVEI T1,ASNSX1 ; "All queues in use" HRROS T1 ; Make neg. left half to signal error ASNIQX: RESTORE RET SUBTTL Internet User Queues - RELIQ% JSYS ;INTLGO Internet logout routine -- called by each job as it logs out. IFE REL6, IFN REL6, SETO T1, ; Say all Internet Queues RELIQ% ; Release them JFCL RET ;RELIQ Release Internet Queue (RELIQ%) JSYS ;T1/ Internet Queue Handle or -1 for all owned by this job or ; (multiple) fork handle for all owned by requested fork(s). ; RELIQ ;Ret+1: Failure. Error code in T1 ;Ret+2: Success IFE REL6,<.RELIQ::> IFN REL6, MCENT ; Enter monitor SKIPN INTON ; IP Initialized? RETERR(SQX2) ; No, can't be assigned MOVE T3,T1 ; Place arg for LCKCAL ; AOSE T1 ; Check for -1 ; JUMP [HRRZ T1,T3 ; No, check RH only ??bug here?? ; CAIL T1,NIQ ; Is it a queue handle? ; JRST RELIQ5 ; No, go check for fork handle ; JRST .+1] ; Yes, back to normal code XMOVEI T1,INTQLK ; The lock to lock XMOVEI T2,RELIQ0 ; Function to call CALL LCKCAL JUMPL T1,IQFAIL SMRETN ; Check for multiple fork handle argument RELIQ5: CAIL T1,.FHJOB ; Multiple handle? JRST RELIQ1 ; yes CAIL T1,.FHSLF ; No, Job relative handle? CAIL T1,.FHSLF+NLFKS JRST RELIQ7 ; Neither, garbage RELIQ1: CALL FLOCK ; Lock fork structure MOVX T2, ; Call this routine CALL MAPFKH ; Per fork NOP ; Never blocks CALL FUNLK ; Unlock fork structure SMRETN ; All done RELIQ7: MOVEI T1,SQX1 ; Bad IQ handle error JRST MRETNE ; Lock INTQLK and do work per fork; LCKCAL of INTQLK needs to be here ; so MAPFKH won't ITRAP with INTQLK locked. RLIQFK: MOVE T3,T1 ; Place FORKN for LCKCAL XMOVEI T1,INTQLK ; The lock to lock XMOVEI T2,RLIQF0 ; Function to call CALL LCKCAL RET ; Work routine for RLIQFK ; Called with T1 a FORKN & INTQLK locked RLIQF0: LOCAL ; Get FORKX corresponding HRRZ FKX,SYSFK(T1) ; to MAPFKH's FORKN MOVSI IQ,-NIQ ; Scan all queues RLIQF1: MOVE T1,IQ ; Current handle CALL CHKIQ ; Check access JUMPL T1,RLIQFX ; Not this job HRRZ T1,INTQFK(IQ) ; Get owning FORKX CAME T1,FKX ; Owned by this fork? JRST RLIQFX ; No, skip it HRRZ T1,IQ ; Yes, get queue handle CALL REL1IQ ; Release it and SETOM INTQJB(IQ) ; Deassign it SETZM INTQSP(IQ) ; Make sure no messages MOVE T1,TODCLK ; Record when queue MOVEM T1,INTQTM(IQ) ; was deassigned RLIQFX: AOBJN IQ,RLIQF1 ; Loop through all queues RESTORE RET ;RELIQ0 Innards of RELIQ. ;T1/ IQ handle or -1 for all ;INTQLK/set ; NOINT ; CALL RELIQ0 ;Ret+1: Always. T1 ge 0 if successful or -1,,errorcode if not RELIQ0: LOCAL MOVEM T1,IQ AOSE T1 ; Asked to do all for this job? (-1) TLOA IQ,-1 ; No. Set AOBJN ptr to do just one MOVSI IQ,-NIQ ; Yes. Set up for all RELIQ2: MOVE T1,IQ ; Get the handle CALL CHKIQ ; Check access. JUMPL T1,RELIQ8 ; Jump if no access (different job) HRRZ T1,IQ CALL REL1IQ ; Flush packets in this queue SETOM INTQJB(IQ) ; Deassign the queue SETZM INTQSP(IQ) ; Make sure no messages MOVE T1,TODCLK ; Record when queue MOVEM T1,INTQTM(IQ) ; was deassigned RELIQ8: AOBJN IQ,RELIQ2 RELIQ9: SETZ T1, ; Always successful RESTORE RET ;REL1IQ Routine to flush packets in queue if it is owned by calling job. ;T1/ Internet Queue handle ;INTQLK/Set NOINT ; CALL REL1IQ ;Ret+1: Always. REL1IQ: LOCAL MOVEM T1,IQ HRRZ T2,INTQJB(IQ) ; Which job owns this one CAME T2,JOBNO ; Us? JRST REL1IX ; No. REL1I1: HRRZ T1,IQ ; Get the handle CALL INQGET ; Get a message if possible JUMPL T1,REL1IX ; Jump if queue now empty. CALL RETBLK ; Return the storage to free area JRST REL1I1 ; Loop til queue empty REL1IX: RESTORE RET SUBTTL Internet User Queues - SNDIN% JSYS ;Send an Internet Segment JSYS ;T1/ Flags,,Internet Queue Handle (No flags defined. Must be 0) ;T2/ Buffer Address -> ,, ;T3/ Local net address for source route ; SNDIN ;Ret+1: Failed. Error code in T1. ;Ret+2: Success. IFE REL6,<.SNDIN::> IFN REL6, MCENT ; Enter monitor CALL SNDIN0 ; Do the work JUMPL T1,IQFAIL SMRETN ; Workhorse for SNDIN: SNDIN0: LOCAL NOINT DMOVEM T1,IQ XCTU [HRRZ SIZ,0(BUF)] ; Get size of user's buffer area HRRZ T1,IQ ; The queue handle CALL CHKIQ ; See if we have access to it JUMPL T1,SNDINX ; Jump if not ; Not need this with fragmentation HRROI T1,SNDIX1 ; Anticipate fail return MOVE T2,INTXPW SUBI T2,PKTELI-1 CAILE SIZ,</4> ; Must have size word & minimal IP header CAMLE SIZ,T2 ; Must fit in our biggest packets JRST SNDINX ; Give fail return MOVEI T1,PKTELI-1(SIZ) ; Size of buffer needed here CALL GETBLK ; Get a chunk of free storage SKIPG PKT,T1 ; OK? JRST SNDIN8 SETZM PKTFLG(PKT) ; Clear all internal flags MOVEI T1,-1(SIZ) ; Number of words in user's area MOVEI T2,1(BUF) ; First address in user's area XMOVEI T3,PKTELI(PKT) ; First address in monitor area CALL BLTUM ; Move it into the monitor LOAD T1,PIPL,(PKT) ; Packet length in bytes ADDI T1,3 ; Set to round up ASH T1,-2 ; Number of words which must be present CAIL T1,0(SIZ) ; Must be in what we were given JRST SNDIN9 ; No. Length error LOAD T2,PIDO,(PKT) ; Get data offset in 32-bit words CAIGE T2,/4 ; Must be at least a full header JRST SNDIN9 SKIPE INTQM3(IQ) ; Filtering on ports? CAIGE T2,0(T1) ; Yes. Pkt must include ports. CAILE T2,0(T1) ; Pkt must always include min header JRST SNDIN9 LOAD T1,PIVER,(PKT) ; Pick up the Internet version CAIE T1,.INTVR ; Is that right? JRST SNDIN9 LOAD T1,PIPRO,(PKT) ; Protocol CAIN T1,.ICMFM ; ICMP? JRST SNDINC ; Yes, treat specially LSH T1,^D4 ; 'left justify' for TSTIQ LOAD T4,PIDO,(PKT) ; Get Internet data offset ADD T4,PKT ; Get address of port word MOVE T4,PKTELI(T4) ; Get the port word JRST SNDIN3 ;Here if the user is sending an ICMP packet, it must be for the ;appropriate protocal/host/port. We check the protocal and ports in ;the packets "error header" rather than those in the main header. SNDINC: MOVE T2,INTQJB(IQ) ; Get flags TXNN T2,AQ%ICM ; ICMP messages enabled? JRST SNDIN7 ; Return an error LOAD T2,PIDO,(PKT) ; Get data offset ADD T2,PKT ; Add it in ADDI T2,.CMINH ; Plus header offset in packet LOAD T1,PIPRO,(T2) ; get the protocal from the header LSH T1,4 ; Shift for TSTIQ LOAD T4,PIDO,(T2) ; get length from header ADD T4,T2 ; Add in MOVE T4,PKTELI(T4) ; Get port word SNDIN3: MOVE T2,PKTELI+.IPKSH(PKT) ; Get source MOVE T3,PKTELI+.IPKDH(PKT) ; and dest CALL TSTIQ ; All good for this Q? JRST SNDIN9 ; No, error. LOAD T1,PISH,(PKT) ; Get packet source JUMPE T1,SNDIN4 ; User did not specifiy CALL LCLHST ; Is it one of us? JRST SNDIN9 ; Bad address JRST SNDIN5 ; Skip SNDIN4: MOVE T1,INETID ; Default source for packet STOR T1,PISH,(PKT) ; Save SNDIN5: MOVE T1,INTQJB(IQ) ; Get flags TXNN T1,AQ%SCR ; RPI desired? JRST SNDIN6 ; No SETONE PSCR,(PKT) ; Flag the packet for that interface SNDIN6: XCTU [SKIPN T3] ; Source route address in T3? JRST SNDINS ; No, go send SETONE PSROU,(PKT) ; Flag to do source routing SNDINS: CALL SNDGAT ; Send it. Low lvl code will return stg SETZ T1, ; Tell caller all is ok JRST SNDINX ; Error returns SNDIN7: HRROI T1,SNDIX1 ; Header or format problem: SIZ, PIPL, JRST SNDINE ; PIDO, ports, PIVER, PIPRO, S, D SNDIN8: HRROI T1,SNDIX2 ; No storage error JRST SNDINX ; Don't return what we didn't get SNDIN9: HRROI T1,SNDIX4 SNDINE: PUSH P,T1 CALL RETPKT ; Return storage used for packet POP P,T1 SNDINX: OKINT RESTORE RET SUBTTL Internet User Queues - RCVIN% JSYS ;Receive an Internet Segment JSYS ;T1/ Flags,,Internet Queue Handle ; RIQ%NW On to give error return instead of waiting ;T2/ Buffer pointer -> ,, ;T3/ (Not currently used. Must be 0) ; RCVIN ;Ret+1: Failed. Code in T1. ;Ret+2: Success. IFE REL6,<.RCVIN::> IFN REL6, MCENT ; Enter the monitor CALL RCVIN0 ; Do work CAMN T1,[-1] ; Nothing waiting error (RIQ%NW was 1) JRST MRETNE ; Return -1 JUMPL T1,IQFAIL ; Return 0,,errorcode SMRETN ; No error return ;RCVIN0 Guts of RCVIN. ; CALL RCVIN0 ;Ret+1: Always, T1 is: -1, .lt. 0, or .ge. 0 RCVIN0: LOCAL RCVIN1: NOINT UMOVE IQ,T1 ; Get the queue handle & flags UMOVE BUF,T2 ; And user's buffer address HRRZ T1,IQ ; Get the handle CALL CHKIQ ; See if we have access to it JUMPL T1,RCVINX ; Jump if not (T1 has error code) HRRZ T1,IQ CALL INQGET ; Try to get a segment from that queue JUMPGE T1,RCVIN2 ; Jump if we did TXNE IQ,RIQ%NW ; Check the "don't wait" flag JRST RCVINX ; Don't wait, return -1 (from INQGET) MOVE T1,FORKX ; Must wait. Get