Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
6-1-monitor/ipipip.mac
There are 9 other files named ipipip.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.33, 15-Feb-89 21:16:16, Edit by MKL
; around INQDS6, don't send source quench anymore.
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.26, 5-Jul-88 15:04:30, Edit by MKL
; change IS.xxx stats stuff
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.23, 17-May-88 14:32:48, Edit by MKL
; add code to ignore packets from LOSHST (can be patched)
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.22, 4-Apr-88 16:36:57, Edit by MKL
; make CHKIQ global if CHIVES
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.21, 21-Jan-88 21:30:37, Edit by MKL
; MARKUP routine looked in wrong place for host number
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.19, 20-Jan-88 02:45:39, Edit by MKL
; more statistics, count fragments and echos
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.18, 14-Jan-88 22:39:25, Edit by MKL
; in ICMPEC, put back echo replies, but only one per host packet stream
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.7, 10-Nov-87 15:55:55, Edit by MKL
; add IP statistics counting
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.6, 6-Nov-87 14:40:02, Edit by MKL
; BUGCHK in RETPKT for proper buffer size
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.3, 31-Aug-87 16:36:14, Edit by MKL
; At RCVGA6, don't forward packets back out.
;[SRI-NIC]SRC:<6-1-MONITOR>IPIPIP.MAC.2, 25-Jun-87 17:57:52, Edit by MKL
; don't process ICMP echo's.
;[SRI-NIC]XS:<SU-61SU>IPIPIP.MAC.2, 5-Dec-86 14:52:34, Edit by MKL
;;[SRI-NIC]SS:<6-1-MONITOR>IPIPIP.MAC.3, 30-Oct-85 20:10:38, Edit by MKL
;; get rid of ethernet calls to FNDINT
;SRC:<6.1.MONITOR.STANFORD>IPIPIP.MAC.6, 5-Nov-86 13:43:42, Edit by BILLW
; use HS%RSN=13 for destination unreachable
;<6-1-MONITOR>IPIPIP.MAC.13, 21-Apr-86 17:06:58, Edit by LOUGHEED
; Fix RCVGAT patch to check correctly for broadcast IP addresses
;<6-1-MONITOR.FT6>IPIPIP.MAC.2, 11-Aug-85 19:41:48, Edit by WHP4
;Stanford changes:
; Support multiple interfaces to a single network
; Teach RCVGAT to accept broadcast packets without reforwarding.
; INTLKB and INTULK lock/unlock header portion of Internet buffer
; Give non-privileged users access to IQ for UDP user ports only.
;
; 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:<TCPIP.5.4.MONITOR>IPIPIP.MAC.18, 30-Oct-84 09:41:39 by PAETZOLD
;TCO 6.2266 - Fix SQX1 reference in RELIQ7
; UPD ID= 313, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.17, 18-Oct-84 15:41:39 by PAETZOLD
;Fix up RETPKT for BF18SZ changes.
; UPD ID= 300, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.16, 1-Oct-84 14:14:24 by PAETZOLD
;Fix typo/bug in .ASNIQ.
; UPD ID= 286, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.15, 24-Sep-84 13:54:44 by PURRETTA
;Update copyright notice.
; UPD ID= 278, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.14, 8-Sep-84 10:20:38 by PAETZOLD
;Fix PI context smashing bug in IPLTRK.
; UPD ID= 274, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.13, 6-Sep-84 12:00:05 by PAETZOLD
;Additional ILULK2 debuging stuff.
; UPD ID= 230, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>IPIPIP.MAC.11, 31-May-84 10:58:25 by PAETZOLD
;Add interface state resolution code. ENDSV.'s.
; UPD ID= 144, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>IPIPIP.MAC.9, 15-May-84 08:35:38 by PAETZOLD
;Turn off IPLDSW.
; UPD ID= 86, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>IPIPIP.MAC.6, 5-Apr-84 22:42:57 by PAETZOLD
;Add IPLDSW stuff
; UPD ID= 25, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.5, 4-Apr-84 16:55:12 by PAETZOLD
;Always return NI buffers in RETPKT.
; UPD ID= 8, SNARK:<TCPIP.5.4.MONITOR>IPIPIP.MAC.4, 2-Apr-84 12:19:39 by PRATT
;Remove FTIPNI, dummy NIPSRV routine is in STG.
; UPD ID= 4, SNARK:<TCPIP.5.4.MONITOR>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:<TCPIP.5.4.MONITOR>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.
;<TCPIP.5.3.MONITOR>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
;<TCPIP.5.1.MONITOR>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,<REL6==1>
IF1 <IFN IPLDSW,<PRINTX Assembling Debuging IP Locking Routines>>
IF1 <IFN IPQDSW,<PRINTX Assembling Debuging IP Queue Routines>>
SUBTTL Lock Handling
$INIT
IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>
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 <LOCKPT>
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 <LOCKPT>
MOVEM T1,LOCKPT
SETLC0: NOINT
LOAD T1,LIDX,(LOCKPT) ; Get the wait bit index
CALL SETWTB ; Set it
OPSTR <AOSN >,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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<IPQRNN*IPQLEN> ; QUEUE EVENT RING BUFFER
RS IPQADR,1 ; CURRENT RING BUFFER ADDRESS
IFE REL6,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; 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,<IPQLEN*IPQRNN> ; 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,<SWAPCD>
IFN REL6,<XSWAPCD>
> ; 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 <QHEAD>
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 <FROM,TO>
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,<CALL IPQTRK> ; If debuging queue maniulations
TEMP <ITEM,QHEAD,PREV>
SKIPE 0(ITEM)
BUG.(HLT,INTNQ1,IPIPIP,SOFT,<EnQ: Item not dequeued>,,<
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,<CALL IPQTRK> ; If debuging queue maniulations
TEMP <ITEM,PREV,NEXT>
SKIPN 0(ITEM)
BUG.(HLT,INTNQ2,IPIPIP,SOFT,<DeQ: Item not queued>,,<
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<RELBFR: Bit table fouled>,,<
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,<SETWTB: Wait bit not assigned>,,<
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,<CLRWTB: Wait bit not assigned>,,<
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<INTBEG::>
IFN REL6,<XNENT INTBEG,G>
MOVSI T1,(CR%CAP)
CFORK ; Get a fork of JOB0
BUG.(HLT,INTMA0,IPIPIP,SOFT,<INTBEG: Can't create Internet fork>,,<
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,<SE1ENT> ; make sure section one
MOVX T1,<JP%SYS!1B35> ; 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,<MOVE T1,[ITFPC,,INTUXI]>
IFN REL6,<MOVE T1,[XCDSEC,,INTUXI]>
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,<PUSH P,[MSEC1,,INTBP1]> ; Return for following routines.
IFN REL6,<PUSH P,[XCDSEC,,INTBP1]> ; 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,<CALL CIPSRV> ; 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,<Internet fork: unexpected interrupt>,,<
Cause: The TCP/IP asynchronous process has received an unexpected software
interrupt.
>)
IFE REL6,<SE1ENT> ; 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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<STKVAR <NFBSV>>
SETZ T4,
EXCH T4,INTNFB ; Get and clear free list
IFN IPLDSW,<MOVEM T4,NFBSV> ; 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 <T4>
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 <PKT>
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,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; 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+<BF18SZ*INTBSZ>] ; ?
SKIPA ; no
JRST RETPK2 ; yes. always release.
MOVE T1,INTNFI ; Yes. Get number currently around
CAML T1,INTNIB ; Less than required?
JRST RETPK1 ; No.
ifn nicsw,<
push p,t1
hlrz t1,-1(pkt) ;get buffer header word (length field)
trz t1,400000
caml t1,maxwpm
jrst retpk9
BUG.(CHK,RETSPK,IPIPIP,SOFT,<IPIPIP: Internet buffer wrong size>,<<T1,D>>,<
Cause: The monitor has detected an input buffer that is not of the
maximum size required by this routine. This is probably a
software problem.
>)
pop p,t1
jrst retpk1
retpk9: pop p,t1
>;ifn nicsw
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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 <PIX,PTB,PTL>
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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:
IFE CHIVES,<
MAXGWA==^D50 ; Number of GWs we will keep track of
; (Gateways and multi-homed hosts)
>
IFN CHIVES,<
MAXGWA==:^D80
>
; The file name to use:
GWFILE: ASCIZ "SYSTEM:INTERNET.GATEWAYS"
; ICMP packet is pointed to by CPKT, structure as defined in
; INPAR
MINICW==PKTELI+<<MINIHS+3>/4>+2 ; Minimum ICMP packet size, words with local
MINIHB==<MINICW-PKTELI>*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,<No storage for ICMP>,,<
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,<SE1CAL> ; In case called from MDDT
SAVEAC <GW>
ACVAR <I>
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,<GWYINI: Crucial storage missing>,,<
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 <JFH,CHNS>
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,<FLD(7,OF%BSZ)+OF%RD> ; 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 <JFH,BOL,ERRPNT,ERRCOL>
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 <GW>
ACVAR <JFH,EOLFLG>
TRVAR <<GWTMP,GWBKSZ>> ; 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 <CIDX,CCNT,CSLT>
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 <GWUP,GWHIS>,(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 <GWT,I,DEFGW,DEFTY>
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 <GW>
ACVAR <I>
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 <P1,PKT,CPKT>
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,<<MINIHS+3>/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 <P1,PKT,CPKT,TCB>
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,<PRINTX ? ICMP dispatch tables have wrong size>
; 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,<PRINTX ? ICMP tables screwed up>
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
IFE STANSW,<
MOVX T1,HS%VAL!<FLD 1,HS%RSN> ; Value status, system down, reason 1
>;IFE STANSW
IFN STANSW,<;;; use special code for icmp unreachable
MOVX T1,HS%VAL!<FLD ^d13,HS%RSN> ; Value status, system down, reason 13
>;IFN STANSW
HLLM T1,HSTSTS(T2) ; Put this status into table
JRST ICMUSR ; In case some user wants it...
ICMPEC: ; Process an ECHO message:
IFN NICSW,<
AOS IS.ECO+1 ; Count echo requests
LOAD T1,PISH,(PKT) ; Get the host number
CAMN T1,LSTHEC ;same damn host?
RET ;yep. sorry loser.
MOVEM T1,LSTHEC ;else save this guy and do echo
AOS IS.ECO ; Count echos sent
>
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 <GW>
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
IFE NICSW,<
LOAD T1,PIDH,-PKTELI+.CMINH(CPKT) ; Get the host number
>
IFN NICSW,<
LOAD T1,PISH,(PKT) ; 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,<HS%RSN!HS%HR!HS%DAY!HS%MIN> ; get mask
ANDCAM T1,HSTSTS(T2) ; Turn off these bits
MOVX T1,<HS%UP!HS%VAL> ; 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 <GWY>
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 <GWX>
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 <PIX,PTB,PTL>
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 <ICMIDX,INFO> ; AC variables
TRVAR <ERROR,HDRSIZ> ; 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,<ICMERR -- Bad type code>,<<T1,D>>,<
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 <PINTL,PPROG>,(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,<<MINIHS+3>/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+<<MINIHS+3>/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,<<MINIHS+3>/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+<MINIHS+3>/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,<MINIHS+5*4>
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 <PINTL,PPROG>,(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,<SWAPCD>
IFN REL6,<XSWAPCD>
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 <P1>
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,<DU%PRO,,ICM%DU> ; Protocol Unreachable
JRST SNDGA5 ; Make like interface code refused it
SNDGA0: ; Normal, non-secure packet.
STACKL <<IPOPA,^D8>> ; 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,<DU%NET,,ICM%DU> ; Net unreachable
JRST SNDGA5 ; error exit
SNDGA3: MOVX T1,<DU%SRF,,ICM%DU> ; Strict Source Route failure
JRST SNDGA5
SNDGA4: ; Option problem
HRRZ T1,T2 ; Error code or pointer?
TLNN T2,<-1> ; Skip if <class,,error> code
MOVX T1,<PP%PTR,,ICM%PP> ; 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-.>,<PRINTX ? SNDGA6: Stack clobbered>
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:
IFN NICSW,<
PUSH P,T1
PUSH P,T2
AOS IS.IP ;ip
LDB T1,[POINT 16,PKTELI+5(PKT),31] ;get dest port
LDB T2,[POINT 16,PKTELI+5(PKT),15] ;get src port
CAMLE T2,T1
MOVE T2,T1 ;get well known port
LOAD T1,PIPRO,(PKT) ;get protocol
CAIE T1,^d1 ;icmp
IFSKP.
AOS IS.ICM
LDB T2,[POINT 8,PKTELI+5(PKT),7] ;get type
CAIN T2,3
AOS IS.UNR
CAIN T2,4
AOS IS.SQ
CAIN T2,5
AOS IS.RED
ENDIF.
CAIE T1,^d6 ;tcp
IFSKP.
AOS IS.TCP
CAIN T2,^D25
AOS IS.T25
CAIN T2,^D23
AOS IS.T23
CAIN T2,^D43
AOS IS.T43
CAIN T2,^D101
AOS IS.T101
CAIE T2,^D20
CAIN T2,^D21
AOS IS.T21
ENDIF.
CAIE T1,^d17 ;udp
IFSKP.
AOS IS.UDP
CAIN T2,^D53
AOS IS.U53
ENDIF.
POP P,T2
POP P,T1
>;IFN NICSW
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,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; 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,<INTLC0: INT buffer list fouled.>,,<
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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*<PKTELI-LCLPKT> ; 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,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; THIS CODE IS RESIDENT
RCVGAT:
SAVEAC <P1>
STACKL <<IPOPA,^D8>> ; 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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<Internet input pkt smashed>,,<
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.
;patch area to ignore packets from losing hosts
IFN NICSW,<
LOAD T1,PISH,(PKT) ; get source host
CAMN T1,LOSHST ; is it the losing host?
JRST RCVGA9 ; yep, flush it.
>;IFN NICSW
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
IFE STANSW,<
SKIPN SRP+IPOPA ; Must forward if it has a route option
>;IFE STANSW
IFN STANSW,<
SKIPE SRP+IPOPA ; Must forward if it has a route option
JRST RCVGA6 ; No, packet to be forwarded
LDB T2,[POINT 8,T1,35] ; Get the host #
SKIPE T2 ; Zero means broadcast addr
CAIN T2,377 ; And so does 377
JRST RCVGA7 ; Don't forward broadcasts
>;IFN STANSW
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 <class,,error> code
MOVX T1,<PP%PTR,,ICM%PP> ; 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:
IFN NICSW,<
JRST RCVGA9 ; DON'T FORWARD PACKETS!
>
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 <PIMF,PIFO>,(PKT),RCVGAX ; Not a fragment, give to dispatcher
CALL RCVFR ; Process fragment (and queue)
IFN NICSW,<
; SKIPE PKT
; AOS IS.FRG+1 ; Count fragmented packets received
>
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,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; THIS CODE IS RESIDENT
RCVGAY: PION
RCVGAX:
IFN NICSW,<
JUMPE PKT,[RET]
PUSH P,T1
PUSH P,T2
AOS IS.IP+1 ;ip
LDB T1,[POINT 16,PKTELI+5(PKT),31] ;get dest port
LDB T2,[POINT 16,PKTELI+5(PKT),15] ;get src port
CAMLE T2,T1
MOVE T2,T1 ;get well known port
LOAD T1,PIPRO,(PKT) ;get protocol
CAIE T1,^d1 ;icmp
IFSKP.
AOS IS.ICM+1
LDB T2,[POINT 8,PKTELI+5(PKT),7] ;get type
CAIN T2,3
AOS IS.UNR+1
CAIN T2,4
AOS IS.SQ+1
CAIN T2,5
AOS IS.RED+1
ENDIF.
CAIE T1,^d6 ;tcp
IFSKP.
AOS IS.TCP+1
CAIN T2,^D25
AOS IS.T25+1
CAIN T2,^D23
AOS IS.T23+1
CAIN T2,^D43
AOS IS.T43+1
CAIN T2,^D101
AOS IS.T101+1
CAIE T2,^D20
CAIN T2,^D21
AOS IS.T21+1
ENDIF.
CAIE T1,^d17 ;udp
IFSKP.
AOS IS.UDP+1
CAIN T2,^D53
AOS IS.U53+1
ENDIF.
POP P,T2
POP P,T1
>;IFN NICSW
..X=. ; Logically clean up here, but the
RESTORE ; Arg block stays until RET
IFN <..X-.>,<PRINTX ? RCVGAX: Stack clobbered>
PURGE SRP,SRC,RRTP,..X
RET
IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>
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 <DPT,FFR,FRO,MAXSIZ,OIN,OOT,SFR,TPK,DCT>
LOCAL <BDOL,BOOP,LPCT> ; Locals shouldn't overrun P1
IFLE P1-LPCT,<PRINTX SNDFR -- Overrunning NCT with local variables>
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,<DU%FRG,,ICM%DU> ; 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,<TE%TTL,,ICM%TE> ; Error message too
CALL ICMERR ; generate ICMP error
JRST SNDFWX ; Lose
SNDFR2:
IFN NICSW,<
; AOS IS.FRG ; Count packets fragmented
>
; 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,<<MINIHS/4>+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,<MINIHS/4> ; 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,<MINIHS/4>(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,<<PKTELI*4>+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 <LASTFO,KILLTM>
LOCAL <LPK,CPK,SAMPKT,KPK>
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 <PIMF,PIFO>,(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,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; 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 <OPLB,REMB,ARGP>
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,<ENDOPT&^-CPYOPT> ; END of options?
JRST DONOP ; Yes, quit
CAIN T4,<NOPOPT&^-CPYOPT> ; 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,<LSROPT&^-CPYOPT> ; Lose Source Route?
CAIN T4,<SSROPT&^-CPYOPT> ; Strict Source Route?
CALL RUTOP
JUMPE T3,FINOP ; Found it, T2 may indicate error
XMOVEI T3,RRTP(ARGP)
CAIN T4,<RRTOPT&^-CPYOPT> ; Record Route?
CALL RUTOP
JUMPE T3,FINOP ; Found it, T2 may indicate error
XMOVEI T3,GARB(ARGP)
CAIN T4,<TSPOPT&^-CPYOPT> ; 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 <class,,error>
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 <OPT,OPTP,OPTL,CPTR>
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,<RRTOPT&^-CPYOPT> ; 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,<SSROPT&^-CPYOPT> ; Strict route?
JRST RUTK ; No. Ignore route option,
; Use full routing
MOVX T2,<DU%SRF,,ICM%DU> ; 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,<RRTOPT&^-CPYOPT> ; 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 <class,,error>
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 <T1>
LOCAL <OPTP,OPTL,CPTR,SAVPTR>
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,<SWAPCD>
IFN REL6,<XSWAPCD>
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
IFE CHIVES,<GWYLUK:>
IFN CHIVES,<GWYLUK::>
ACVAR <NET>
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?
IFE NICSW,<
IFE STANSW,<
RET ; -1,,.NCTi ; No, return with interface
>;IFE STANSW
IFN STANSW,<
JRST FNDINT ; No, interface. Find best and return
>;IFN STANSW
>;IFE NICSW
IFN NICSW,<
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
IFE NICSW,<
IFN STANSW,<
CALL FNDINT ; Ensure best interface on desired net
>;IFN STANSW
>;IFE NICSW
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,<FNDGWY returned unconnected gateway>,,<
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
IFN STANSW,<
SKIPL NETGWY(T2) ; don't touch if another interface
; on this net came up ealier
>;IFN STANSW
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 <INDEX> ; 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,<INTDWN -- Impossible failure of NETHSH>,,<
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
IFN STANSW,<
MOVE T1,NTNET(P1) ; get net of interface that went away
XMOVEI P1,NCTVT ; get header of NCT list
INTDL3: LOAD P1,NTLNK,(P1) ; get pointer to next NCT
JUMPE P1,R ; just return if no more candidates
SKIPE NTORDY(P1) ; if this interface is off
CAME T1,NTNET(P1) ; or it is for another network
JRST INTDL3 ; then go look at another interface
CALL INTUP ; bring up a new interface on this net
>;IFN STANSW
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 <P1>
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> ; 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,<SWAPCD>
IFN REL6,<XSWAPCD>
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,<XNENT .ASNIQ,G>
MCENT ; Enter monitor
SKIPN INTON ; IP initialized?
RETERR(ASNSX1) ; No, Cannot have queue
TXNE T1,<<-1,,0>&<^-<AQ%SCR!AQ%SPT!AQ%ICM>>> ;any bad bits on?
RETERR(ARGX22) ; yes so bad call
MOVX T4,<SC%WHL!SC%OPR!SC%NWZ> ; 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 <<USRQDB,.IQLEN>> ; Stack space for copy of user's QDB
LOCAL <QDB,IQ,FQ,FLGS>
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...
IFN STANSW,<
MOVX T4,SC%NWZ ; Get capability
TDNE T4,CAPENB ; Does he have it enabled
IFSKP. ; Nope. He can only use UDP and can't be server
LOAD T1,IQFHM,(QDB) ; Get FH mask
LOAD T2,IQFHV,(QDB) ; Get foreign host
CAMN T1,[37777,,777777] ; Mask must be present
SKIPN T2 ; And FH must be specified
JRST ASNIPX ; Nope, he loses
LOAD T1,IQPRV,(QDB) ; Get protocol version number
LOAD T2,IQPRM,(QDB) ; and protocol mask
CAIN T1,UDPPN ; UDP protocol?
CAME T2,[37777,,777777] ; And specifying proper protocol mask?
JRST ASNIPX ; Nope, protocol privilege failure
LOAD T1,IQPLP,(QDB) ; Get local port number
LOAD T2,IQLPM,(QDB) ; And local port mask
TXNE T1,177400 ; Must be job-relative (non-server)
CAIE T2,177777 ; Only this one local port is allowed
JRST ASNIPX ; Nope. Port access privilege failure
TXNN FLGS,AQ%SPT ; Does he want single-port protocol?
TXNE FLGS,AQ%ICM ; Or does he want ICMP access
JRST ASNIPX ; He loses then
ENDIF.
>;IFN STANSW
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
IFN STANSW,<
ASNIPX: HRROI T1,NTWZX1 ; NET-WIZARD required for non-UDP
JRST ASNIQX ; Exit with the error set
>;IFN STANSW
SUBTTL Internet User Queues - RELIQ% JSYS
;INTLGO Internet logout routine -- called by each job as it logs out.
IFE REL6,<INTLGO::>
IFN REL6,<XNENT INTLGO,G>
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,<XNENT .RELIQ,G>
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 RLIQFK> ; 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 <IQ,FKX> ; 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 <IQ>
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 <IQ>
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 -> <words, inc this>,<IP header>,<IP data>
;T3/ Local net address for source route
; SNDIN
;Ret+1: Failed. Error code in T1.
;Ret+2: Success.
IFE REL6,<.SNDIN::>
IFN REL6,<XNENT .SNDIN,G>
MCENT ; Enter monitor
CALL SNDIN0 ; Do the work
JUMPL T1,IQFAIL
SMRETN
; Workhorse for SNDIN:
SNDIN0: LOCAL <IQ,BUF,SIZ>
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,<<MINIHS+3>/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,<MINIHS+3>/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 -> <act,,max, inc this>,<IP header>,<IP data>
;T3/ (Not currently used. Must be 0)
; RCVIN
;Ret+1: Failed. Code in T1.
;Ret+2: Success.
IFE REL6,<.RCVIN::>
IFN REL6,<XNENT .RCVIN,G>
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 <IQ,BUF>
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 our fork number
HRLM T1,INTQFK(IQ) ; Leave it for when segment arrives
OKINT
XMOVEI T1,INTQFK(IQ) ; The cell to wait on
CALL DISL ; Wait for it to be gronked
JRST RCVIN1 ; Go try again
; Still NOINT
RCVIN2: MOVE PKT,T1 ; Put packet pointer in proper place
LOAD T1,PIPL,(PKT) ; Get the Internet pkt length in bytes
ADDI T1,4+3 ; Allow for bfr length word. Round up.
ASH T1,-2 ; Number of words required.
XCTU [HRRZ T2,0(BUF)] ; Get user's buffer size
XCTU [HRLM T1,0(BUF)] ; Tell him what's needed/present
SETZ IQ, ; Assume no truncation error
CAMG T1,T2 ; Enough space available?
JRST RCVIN3 ; Yes ...
MOVE T1,T2 ; ... No. Give him what we can.
HRROI IQ,SNDIX1 ; Remember to give error return
RCVIN3:
SOSG T1 ; Don't count the count word
JRST RCVIN4 ; User area too small
XMOVEI T2,PKTELI(PKT) ; First word in Internet part
MOVEI T3,1(BUF) ; First word in user's data area
CALL BLTMU ; Transfer it to the user
RCVIN4:
OKINT
CALL RETPKT ; Return the packet storage
SKIPA T1,IQ ; Error code
RCVINX: OKINT ; For fatal error returns
RESTORE
RET ; No.
SUBTTL Internet User Queues - Misc. Routines
;INQGET Get a message (Internet segment) from specified queue.
;T1/ Internet Queue Handle
;INTQLK/ Locked NOINT
; CALL INQGET
;Ret+1: Always. T1 has pointer to message if any, or is -1 if none
INQGET: LOCAL <IQ>
MOVEM T1,IQ
NOSKED ; Prevent simultaneous access to Q
ADD T1,INTQHD ; Compute address of queue head
MOVE T2,T1
LOAD T1,QNEXT,(T2) ; Get first thing on queue
CAIN T1,0(T2) ; If that is the queue head itself,
JRST INQGE9 ; The queue is empty
SETSEC T1,INTSEC ; Make extended address
CALL DQ ; Dequeue the message and return in T1
SOSA INTQSP(IQ) ; Credit space to queue
; Success return. T1 has the message
INQGE9: SETO T1, ; Fail return.
OKSKED
MOVE T2,TODCLK ; "Now"
SKIPLE INTQSP(IQ) ; Messages remaining?
ADD T2,INTQT0 ; Yes, Bump no-activity time out
MOVEM T2,INTQTM(IQ) ; Otherwise record when examined
RESTORE
RET
;CHKIQ Check that the calling job has access an Internet Queue.
;T1/ Internet Queue Handle
; NOINT
; CALL CHKIQ
;Ret+1: Always. T1 ge 0 if ok, -1,,error code if not
IFE CHIVES,<
CHKIQ:
>
IFN CHIVES,<
CHKIQ::
> HRRZS T2,T1
CAIL T2,NIQ ; Range check the handle
JRST CHKIQ9 ; Bad
HRRZ T2,INTQJB(T2) ; Get JOBNO which owns this queue
CAMN T2,JOBNO ; Is that this job?
RET ; Yes. T1 still has the Q index
SKIPA T1,[-1,,SQX2] ; Owned by some other job
CHKIQ9: HRROI T1,SQX1 ; Bad handle
RET
; Common exit when T1 has -1,,error code
IQFAIL: HRRZS T1
JRST MRETNE
;LHCHK Check non-zero logical host values.
; T1/ Masked logical host value
; T2/ Protocol (preserved of bashed if for user queue)
; P1/ Interface (if MNET)
; CALL LHCHK
; Return+1 Always, T2 changed if destined for user queue
LHCHK: MOVE T3,T1 ; Masked value (non-zero)
MOVE T4,NTNLHM(P1) ; Mask
TRNN T4,177777
LSHC T3,-20
TRNN T4,377
LSHC T3,-10
TRNN T4,17
LSHC T3,-4
TRNN T4,3
LSHC T3,-2
TRNN T4,1
LSHC T3,-1
CAMG T3,INTLHX ; Deliver to protocol or user queue?
RET ; Protocol
LSH T3,10
IOR T2,T3 ; Logical Host,Protocol
RET ; User - Make protocol compares fail
;INTDSP Dispatch messages from the gateway to the right Internet Queue.
; CALL INTDSP
;Ret+1: Always. Internet Input Queue empty.
INTDSP:
SAVEAC <P1,PKT>
LOCAL <PIX,PTB,PTL>
INTDS0: CALL RCVGAT ; Get a message from the gateway
JUMPE PKT,INTDSX ; None available. We're done for now.
XMOVEI PTB,INTPIX+1 ; Locate tables
MOVE PIX,-1(PTB) ; # Protocols
HRRZ PTL,PIX ; Table length
LOAD T2,PIPRO,(PKT) ; Internet protocol
INTDS2: SKIPN .INTPO(PTB) ; Protocol on?
JRST INTDS3 ; No
SKIPL T3,.INTPL(PTB) ; Take any protocol
CAMN T2,T3 ; or match
JRST INTDS4 ; Yes
INTDS3:
ADD PTB,PTL ; Not for this protocol module
AOBJN PIX,INTDS2 ; Try next
; Shouldn't get here because user queues should take anything
MOVX T1,PT%KIP ; Invalid protocol
TDNE T1,INTTRC ; Want trace?
CALL PRNPKI ; Yes
MOVX T1,<DU%PRO,,ICM%DU> ; Protocol unreachable
CALL ICMERR ; (releases storage)
JRST INTDS0 ; and process next ...
INTDS4: ; ... Found protocol
MOVE T1,PKT ; What to enqueue
MOVE T2,.INTPQ(PTB) ; Where to enqueue it
NOSKED ; In case protocol run by different fork
CALL NQ
OKSKED
AOS .INTPF(PTB) ; Say a pkt waiting
MOVX T1,PT%IQP ; Packet given to protocol
TDNE T1,INTTRC ; Want trace?
CALL PRNPKI ; Yes
JRST INTDS0 ; Process another message
INTDSX: RESTORE
RET
SUBTTL Internet User Queues - Processing
;INQPRC Internet User Queue Process.
;Dispatch Internet messages to a user-assigned queue.
;Find next run time (when a queue timesout).
; CALL INQPRC
;Ret+1: Always. Packets queued to user or flushed; INQTIM set
INQPRC::SAVEAC <PKT>
SETZM INQFLG ; No rerun required
SKIPN INQON ; Been initialized?
JRST INQPRX ; No??
; Pass out all packets
INQPR0: MOVE T2,INQIPQ ; Locate Queue head
NOSKED
LOAD T1,QNEXT,(T2) ; Get first thing
CAIN T1,(T2) ; Empty?
JRST INQPR2 ; Yes
SETSEC T1,INTSEC
CALL DQ
OKSKED
MOVE T3,T1 ; Arg for that routine is packet
XMOVEI T1,INTQLK ; Internet queue lock
XMOVEI T2,INQDSP ; Routine to call
CALL LCKCAL ; Call routine while lock set
JRST INQPR0 ; Get rest
INQPR2: OKSKED
XMOVEI T1,INTQLK ; Lock to lock
XMOVEI T2,INQCH0 ; Function to call
CALL LCKCAL
MOVEM T1,INQTIM ; Next timeout
INQPRX: RET
;INQDSP
;T1/ Pointer to packet
;INTQLK/set NOINT
; CALL INQDSP ; do work for INQPRC
;Ret+1: Always. Packet queued or flushed.
INQDSP: ACVAR <IQ,IQERR>
MOVE PKT,T1
MOVX IQERR,<DU%PRO,,ICM%DU> ; Assume no protocol
MOVSI IQ,-NIQ ; Set to scan them
INQDS2: MOVE T1,INTQJB(IQ) ; Get owner of queue
CAMN T1,[-1] ; Assigned?
JRST INQDS5 ; No. Go try next.
TXNN T1,AQ%SCR ; Secure queue?
TDZA T1,T1 ; No
MOVX T1,1 ; Yes
LOAD T2,PSCR,(PKT) ; Get interface class (secure or not)
CAME T1,T2 ; Packet class matches queue?
JRST INQDS5 ; No. Try next. ...
LOAD T1,PIPRO,(PKT) ; ... Get Internet Protocol number
LSH T1,^D4
XOR T1,INTQV0(IQ) ; Compare
TDNE T1,INTQM0(IQ) ; But only in bits that matter
JRST INQDS5 ; Not for this queue
MOVE T2,PKTELI+.IPKSH(PKT) ; Source address
XOR T2,INTQV1(IQ)
TDNE T2,INTQM1(IQ)
JRST INQDS5
LOAD T1,PIDH,(PKT) ; Destination address
LSH T1,^D4 ; Position 32-bit wise
XOR T1,INTQV2(IQ) ; Compare with source logical host
TDNE T1,INTQM2(IQ) ; In the bits which matter
JRST INQDS5
MOVE T1,INTQJB(IQ) ; Get flags
LOAD T3,PIPL,(PKT) ; Get packet length in bytes
LOAD T4,PIDO,(PKT) ; Get IN hdr length in words
ASH T4,2 ; Convert to bytes
SKIPN INTQM3(IQ) ; Filtering on ports?
JRST INQDS3 ; No, have length required
ADDI T4,4 ; 2 Ports take 4 more bytes
TXNE T1,AQ%SPT ; But a single port only
SUBI T4,2 ; Take 2 bytes
INQDS3: CAMGE T3,T4 ; Enough in packet?
JRST INQDS5 ; Maybe more luck on a different queue
SKIPN INTQM3(IQ) ; Should we do the port compare?
JRST INQDS6 ; No. We found the right queue
MOVX IQERR,<DU%PRT,,ICM%DU> ; Port Unreachable
LOAD T4,PIDO,(PKT) ; Get Internet Data Offset
ADD T4,PKT ; Add base of packet
MOVE T3,PKTELI(T4) ; Get FP.LP and 4 extra bits
LDB T4,[POINT 16,T3,15] ; Save foreign port
TXNN T1,AQ%SPT ; Single port protocol? FP.FP
LSH T3,^D16 ; No. Move Local port LP.FP
DPB T4,[POINT 16,T3,31] ; Plop in the foreign port
XOR T3,INTQV3(IQ)
TDNE T3,INTQM3(IQ)
INQDS5: AOBJN IQ,INQDS2
JUMPGE IQ,INQDS9 ; Flush it if no queue found
INQDS6: MOVE T1,INTQSP(IQ) ; Number of messages on this queue
CAML T1,INTQMX ; Less than number allowed?
IFE NICSW,<
JRST INQDS8 ; No. Flush this one.
>
IFN NICSW,<
JRST RETPKT ; No. Flush this one.
>
AOS INTQSP(IQ) ; Count space
MOVE T3,TODCLK ; "Now"
ADD T3,INTQT0 ; Deadman timeout
HRRZ T2,IQ ; Queue index
ADD T2,INTQHD ; Get pointer to the queue head
LOAD T1,QNEXT,(T2) ; Get first thing on queue
CAIN T1,0(T2) ; If the head itself, queue is empty.
MOVEM T3,INTQTM(IQ) ; Keep away the grim reaper ...
MOVE T1,PKT ; ... What to enqueue. T2 has where
NOSKED
CALL NQ
OKSKED
PUSH P,7 ; Protect critical AC
SKIPGE 7,INTQFK(IQ) ; See if a fork is waiting on this queue
JRST INQDS7 ; No
HRROS INTQFK(IQ) ; Forget that and make its wait complete
INQDS7: POP P,7
JRST INQDSX ; Try for another segment
; Errors
INQDS8: MOVX IQERR,ICM%SQ ; Source Quench
INQDS9: MOVX T1,PT%UKQ
CAIN IQERR,ICM%SQ ; Was error Source Quench?
MOVX T1,PT%UKS ; Yes
TDNE T1,INTTRC ; Want trace?
CALL PRNPKI ; Yes
MOVE T1,IQERR ; Report error
CALL ICMERR ; (Releases storage)
INQDSX: RET
ENDAV.
;INQICM Give an ICMP message to a user Q.
; PKT/ message
INQICM::XMOVEI T1,INTQLK ; Point to lock
XMOVEI T2,INQIC0 ; Routine to call
CALL LCKCAL ; Lock and call the routine
RETSKP ; (packet taken or flushed)
INQIC0: ; Workhorse routine
ACVAR <IQ,IQERR,CPK2> ; IQ and IQERR must match that at INQDSP
LOAD CPK2,PIDO,(PKT) ; Get packet data offset
ADD CPK2,PKT ; Add in to get to ICMP packet
ADDI CPK2,.CMINH ; And point to the INET header therein
MOVSI IQ,-NIQ ; Number of user Q's
INQIC1: MOVE T2,INTQJB(IQ)
TXNE T2,AQ%ICM ; ICMP messages allowed on this Q?
CAMN T2,[-1] ; Is this Q in use?
JRST INQIC5 ; No
; Should we check for secure here???
LOAD T1,PIPRO,(CPK2) ; Get protocal
LSH T1,4 ; Shift
MOVE T2,PKTELI+.IPKSH(CPK2) ; Source host
MOVE T3,PKTELI+.IPKDH(CPK2) ; Destination host
LOAD T4,PIDO,(CPK2) ; Get data offset
ADD T4,CPK2 ; add in
MOVE T4,PKTELI(T4) ; and get port word
CALL TSTIQ ; Match this Q?
CAIA ; No
CALLRET INQDS6 ; Join above to put packet on Q
INQIC5: AOBJN IQ,INQIC1 ; Loop through
CALL RETPKT ; Nothing matches, flush
RET ; and return
;TSTIQ Check that parameters match a special Q.
; T1/ Protocal
; T2/ Source host
; T3/ destination host
; T4/ port word
; (all left justified)
; (This is only valid for testing packets that we are sending
; or have sent), expects IQ to be in Q1
; Returns +2 if the paremeters match the given Q
TSTIQ: XOR T1,INTQV0(IQ) ; Check
TDNE T1,INTQM0(IQ) ; Match?
RET ; no
XOR T2,INTQV2(IQ) ; source
TDNE T2,INTQM2(IQ) ; ?
RET
XOR T3,INTQV1(IQ) ; dest
TDNE T3,INTQM1(IQ) ; ?
RET
XOR T4,INTQV3(IQ) ; Ports
TDNE T4,INTQM3(IQ) ; ?
RET
RETSKP ; match
ENDAV.
;INQCH0 Find next timeout over all queues, and flush timedout packets.
;INQLCK/ Locked NOINT
; CALL INQCH0
;Ret+1: Always. Minimum time in T1
INQCH0: LOCAL <IQ,TOD,NXT>
MOVX NXT,<377777777777>
MOVE TOD,TODCLK ; "Now"
MOVSI IQ,-NIQ ; Set to scan all queues
INQCH1: MOVE T1,INTQJB(IQ) ; Get owner
CAME T1,[-1] ; Is this queue assigned?
SKIPG INTQSP(IQ) ; And have received packets?
JRST INQCH9 ; No. Try next.
CAMG TOD,INTQTM(IQ) ; Has user forgotten it?
JRST INQCH8 ; No
; Forgotten queue gets flushed
INQCH2: HRRZ T1,IQ ; Get the queue handle
CALL INQGET ; Get a message from that queue
JUMPL T1,INQCH7 ; Jump if none left
MOVE PKT,T1 ; For trace
MOVX T1,PT%UKT ; Delivery time exceeded
TDNE T1,INTTRC ; Want trace?
CALL PRNPKI ; Yes
MOVX T1,<TE%TTL,ICM%TE> ; Report Error
CALL ICMERR ; (releases storage)
JRST INQCH2 ; Loop over the whole queue
INQCH7: SETZM INTQSP(IQ) ; Better be zero if all flushed
MOVE T1,TODCLK
MOVEM T1,INTQTM(IQ) ; Remember when flushed
JRST INQCH9
INQCH8: CAMLE NXT,INTQTM(IQ) ; Min next check against timeout
MOVE NXT,INTQTM(IQ)
INQCH9: AOBJN IQ,INQCH1 ; Loop over all queues
MOVE T1,NXT ; Value to return
RESTORE
RET
;INQCHK See if user queues are next thing to go.
;T1/ TODCLK of when next check is needed by checkers run so far
; CALL INQCHK
;Ret+1: Always. T1 has TODCLK when to check next.
INQCHK::SKIPN INQON
RET
CAMLE T1,INQTIM ; Clock to check
MOVE T1,INQTIM ; Next time something timesout
RET
INQINI::LOCAL <IQ> ; Internet Queue Initialization:
MOVX T1,<377777777777>
MOVEM T1,INQTIM ; Don't need to be run
SETZM INQFLG
SETOM INQPCL ; Protocol -1 to accept anything
MOVX T1,QSZ ; Get Input queue head
CALL GETBLK
JUMPLE T1,INQIN0 ; Lose
CALL INITQ ; Initialize it
MOVEM T1,INQIPQ ; Set pointer to it
MOVEI T1,NIQ ; Number of queues
CALL GETBLK ; Get a block of free storage for heads
JUMPLE T1,INQIN0 ; No space
NOSKED
MOVEM T1,INTQHD ; Save pointer to the area
MOVSI IQ,-NIQ ; Set to scan the queue heads
INQIN1: HRRZ T1,IQ ; Current index
ADD T1,INTQHD ; Plus base is the queue head
CALL INITQ ; Initialize that queue
SETOM INTQJB(IQ) ; Say queue not owned
SETZM INTQTM(IQ)
AOBJN IQ,INQIN1 ; Loop through all
XMOVEI T1,INTQLK ; Pointer to the lock
CALL CLRLCK ; Initialize it
OKSKED
SETOM INQON ; All set
CAIA
INQIN0: BUG.(HLT,INGWA1,IPIPIP,SOFT,<INQINI: Free Storage gone>,,<
Cause: During system initialization no internet free space was available
for the initialization of the internet special queues.
>)
RESTORE
RET
SUBTTL Internet Packet Locking and Unlocking
;N.B.
;These routines assume that a packet will never be larger than a page.
;INTLKB Lock both ends of an Internet packet
;T2/ Extended pointer to the IMP-style packet
; CALL INTLKB
;Ret+1: Always. T2 preserved.
IFE REL6,<RESCD> ; THIS CODE IS RESIDENT
IFN REL6,<XRESCD> ; THIS CODE IS RESIDENT
INTLKB::LOCAL <IMPPKT,PKTLIM>
MOVEM T2,IMPPKT ; Save pointer to IMP packet
LOAD PKTLIM,NBBSZ,(IMPPKT) ; Get size field
CAMLE PKTLIM,MAXWPM ; OK?
BUG.(HLT,INTMS1,IPIPIP,SOFT,<INTLKB: Pkt size smashed>,,<
Cause: The internet buffer locking facility was called to lock
a buffer which appears to have a smahed local header.
>)
MOVE T1,IMPPKT ; get the packet address
IFN STANSW,<
SUBI T1,LCLPKT ; Lock down all of packet (for ARP, PKOPR)
>;IFN STANSW
IFN IPLDSW,<CALL IPLTRK> ; track this if needed
CALL INTLKW ; lock the first address
ADD T1,PKTLIM ; add in the packet limit
IFE STANSW,<
SUBI T1,1 ; determine last address
>;IFE STANSW
IFN STANSW,<
ADDI T1,LCLPKT-1 ; Determine last address
>;IFN STANSW
CALL INTLKW ; lock down the last address
MOVE T2,IMPPKT ; restore the packet address
RESTORE
RET
INTLKW:: ; worker routine for above
SAVEAC <T1,T2> ; save some acs
IFE REL6,<CALL MLKMA> ; lock down the page
IFN REL6,<CALLX (MSEC1,MLKMA)> ; lock down the page
RET ; and return to caller
;INTULK Unlock both ends of an Internet packet.
;T1/ Pointer to IMP-style part of packet
; CALL INTULK
;Ret+1: Always. T1 preserved.
INTULK::LOCAL <IMPPKT,PKTLIM>
MOVEM T1,IMPPKT ; save the packet address
LOAD PKTLIM,NBBSZ,(IMPPKT) ; Get size field
CAMLE PKTLIM,MAXWPM ; OK?
BUG.(HLT,INTBUF,IPIPIP,SOFT,<IPIPIP: Packet size smashed when unlocking Internet Buffer>,,<
Cause: The internet buffer locking facility was called to unlock
a buffer which appears to have a smashed local header.
>)
IFN STANSW,<
SUBI T1,LCLPKT ; Unlock all of packet (for ARP, PKOPR)
>;IFN STANSW
IFN IPLDSW,<CALL IPLTRK> ; track this if needed
CALL INTULW ; unlock first word of the packet
ADD T1,PKTLIM ; add in the length
IFE STANSW,<
SUBI T1,1 ; determine the last address of the packet
>;IFE STANSW
IFN STANSW,<
ADDI T1,LCLPKT-1 ; Determine last address
>;IFN STANSW
CALL INTULW ; unlock the last word of the packet
MOVE T1,IMPPKT ; Restore T1 as required
RESTORE
RET
INTULW:: ; worker routine for above
SAVEAC <T1,T2> ; save acs
IFE REL6,<CALL MULKSP> ; unlock the page
IFN REL6,<CALLX (MSEC1,MULKSP)> ; unlock the page
RET ; return to caller
SUBTTL Lock Handling - Event Tracking
; IP Buffer Lock Manipulation Debugging code and storage
IFN IPLDSW,<
; Queue event ring buffer entries have the following format
.IPLFX==0 ; word 0/ 525252,,FORKX
.IPLBA==1 ; word 1/ Buffer Address
.IPLPC==2 ; work 2/ Calling PC
.IPLSZ==3 ; word 3/ Buffer Size
.IPLHP==4 ; word 4/ HP time value
IPLLEN==.IPLHP-.IPLFX+1 ; Length of ring entry
IPLRNN==^D500 ; number of entries in ring buffer
RS IPLRNG,<IPLRNN*IPLLEN> ; QUEUE EVENT RING BUFFER
RS IPLADR,1 ; CURRENT RING BUFFER ADDRESS
IPLTRK: ; TRACK IP QUEUE EVENTS
PUSH P,T2 ; SAVE T2
PUSH P,T3 ; SAVE T3
PUSH P,T4 ; SAVE T4
SETO T2, ; ASSUME PI IS ON
CONSO PI,PIPION ; IS PI ON?
TDZA T2,T2 ; NO SO TURN OFF FLAG
PIOFF ; YES SO MAKE THE MACHINE MINE
MOVE T3,IPLADR ; GET CURRENT RING BUFFER POINTER
ADDI T3,IPLRNG ; OFFSET BY BASE ADDRESS
MOVE T4,FORKX ; GET FORKX
HRLI T4,525252 ; GET MAGIC NUMBER
MOVEM T4,.IPLFX(T3) ; SAVE FORKX
MOVEM T1,.IPLBA(T3) ; SAVE THE BUFFER ADDRESS
LOAD T4,NBBSZ,(T1) ; GET THE SIZE
MOVEM T4,.IPLSZ(T3) ; SAVE THE SIZE
MOVE T4,-6(P) ; GET THE CALLING PC
MOVEM T4,.IPLPC(T3) ; SAVE THE PC
PUSH P,T1 ; SAVE T1
PUSH P,T2 ; SAVE T2
JSP T4,MTIME ; GET THE HPTIM
MOVE T4,T1 ; GET TIME IN PROPER PLACE
POP P,T2 ; RESTORE T2
POP P,T1 ; RESTORE T1
MOVEM T4,.IPLHP(T3) ; SAVE THE HPTIM
MOVE T3,IPLADR ; GET THE RING ADDRESS AGAIN
ADDI T3,IPLLEN ; BUMP THE RING POINTER
CAIL T3,<IPLLEN*IPLRNN> ; SHOULD THE POINTER LOOP AROUND?
SETZ T3, ; YES SO MAKE IT LOOP
MOVEM T3,IPLADR ; SAVE THE NEW RING POINTER
SKIPE T2 ; SHOULD WE GO PION?
PION ; YES SO GIVE BACK THE MACHINE
POP P,T4 ; RESTORE ACS
POP P,T3
POP P,T2
RET ; AND RETURN
> ; end of IPLDSW
SUBTTL Misc. Routines
;INETUT Get universal time since midnight.
; CALL INETUT
;Ret+1: Always, T1 contains 32-bit time since midnight
IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>
INETUT: SAVEAC <T2>
GTAD ; Get current day,,fraction
HRRZS T1 ; Just fraction
MUL T1,[^D<24*60*60*1000>] ; To msec since midnight
LSH T2,1 ; Drop sign
LSHC T1,^D<18-1> ; Right justify into T1
RET
TNXEND
END