Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 7/ft3/monitor/stanford/ipipip.mac
There are 9 other files named ipipip.mac in the archive. Click here to see a list.
;[MACBETH.STANFORD.EDU]SRC:<7.FT2.MONITOR.STANFORD>IPIPIP.MAC.3, 20-Jun-88 15:21:06, Edit by A.ALDERSON
; V7.0 FT Clock tape
;[MACBETH]SRC:<7.FT2.MONITOR.STANFORD>IPIPIP.MAC.2,  5-Apr-88 12:07:46, Edit by A.APPLEHACKS
; FT7.2 Merge
;[MACBETH]SRC:<7.FT1.MONITOR.STANFORD>IPIPIP.MAC.2, 23-Jan-88 17:47:02, Edit by A.APPLEHACKS
; FT7 Merge
;;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= 8710, RIP:<7.MONITOR>IPIPIP.MAC.5,   6-May-88 11:41:35 by RASPUZZI
;TCO 7.1283 - Make some symbols global for GTDOM% hooks.
; UPD ID= 8531, RIP:<7.MONITOR>IPIPIP.MAC.4,   9-Feb-88 16:15:38 by GSCOTT
;TCO 7.1218 - Update copyright date.
; *** Edit 7182 to IPIPIP.MAC by MELOHN on 5-Nov-85 (TCO 6-1-1549)
; Fix SNDPNG routine to correctly send ECHOs to all but DUMB gateways 
; 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

;	COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
;	ALL RIGHTS RESERVED.
;
;	THIS SOFTWARE IS FURNISHED UNDER A  LICENSE AND MAY BE USED AND  COPIED
;	ONLY IN  ACCORDANCE  WITH  THE  TERMS OF  SUCH  LICENSE  AND  WITH  THE
;	INCLUSION OF THE ABOVE  COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY  OTHER
;	COPIES THEREOF MAY NOT BE PROVIDED  OR OTHERWISE MADE AVAILABLE TO  ANY
;	OTHER PERSON.  NO  TITLE TO  AND OWNERSHIP  OF THE  SOFTWARE IS  HEREBY
;	TRANSFERRED.
;
;	THE INFORMATION IN THIS  SOFTWARE IS SUBJECT  TO CHANGE WITHOUT  NOTICE
;	AND SHOULD  NOT  BE CONSTRUED  AS  A COMMITMENT  BY  DIGITAL  EQUIPMENT
;	CORPORATION.
;
;	DIGITAL ASSUMES NO  RESPONSIBILITY FOR  THE USE OR  RELIABILITY OF  ITS
;	SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
	SEARCH ANAUNV,PROLOG
	TTITLE (IPIPIP,IPIPIP,< - ARPANET Internet Protocols>)

	IF1 <IFN IPLDSW,<PRINTX Assembling Debuging IP Locking Routines>>
	IF1 <IFN IPQDSW,<PRINTX Assembling Debuging IP Queue Routines>>
	Subttl	Table of Contents

;		     Table of Contents for IPIPIP
;
;				  Section		      Page
;
;
;    1. Lock Handling  . . . . . . . . . . . . . . . . . . . .   5
;        1.1    Clear and Release Locks  . . . . . . . . . . .   6
;        1.2    Seize Locks and Free Locks . . . . . . . . . .   7
;    2. Queue Handling . . . . . . . . . . . . . . . . . . . .   8
;        2.1    Event Tracking . . . . . . . . . . . . . . . .   9
;        2.2    Initialization and Clearing  . . . . . . . . .  10
;        2.3    Enqueueing and Dequeueing  . . . . . . . . . .  11
;    3. Wait Bit Routines  . . . . . . . . . . . . . . . . . .  12
;    4. Wait Bit Initialization, Assignment, and Deassignment   13
;    5. Wait Bit State Changing Routines . . . . . . . . . . .  14
;    6. Wait Bit Single Bit Scheduler Test Routines  . . . . .  15
;    7. Wait Bit Multiple Bit Scheduler Tests  . . . . . . . .  16
;    8. Internet Process Switching (INTFRK)  . . . . . . . . .  17
;    9. Internet Fork
;        9.1    Startup and Initialization . . . . . . . . . .  18
;        9.2    Main Loop  . . . . . . . . . . . . . . . . . .  19
;        9.3    Buffer Releasing . . . . . . . . . . . . . . .  21
;        9.4    Get and Return Internet Buffers  . . . . . . .  22
;        9.5    Internet Grand Initialization  . . . . . . . .  23
;   10. Internet Control Message Protocol  . . . . . . . . . .  24
;   11. ICMP
;       11.1    Gateway and ICMP Initialization  . . . . . . .  26
;       11.2    Load the Gateway File  . . . . . . . . . . . .  27
;       11.3    Gateway File Line Processing . . . . . . . . .  28
;       11.4    Load Gateway Descriptor  . . . . . . . . . . .  30
;       11.5    Create Gateway Blocks  . . . . . . . . . . . .  32
;       11.6    Gateway File Processing  . . . . . . . . . . .  34
;       11.7    Find A Gateway . . . . . . . . . . . . . . . .  35
;       11.8    ICMP Processing  . . . . . . . . . . . . . . .  36
;       11.9    Gateway Pinger . . . . . . . . . . . . . . . .  37
;       11.10   Gateway Pinging Routine  . . . . . . . . . . .  38
;       11.11   ICMP Message Handling  . . . . . . . . . . . .  40
;       11.12   ICMP Message Dispatching . . . . . . . . . . .  41
;       11.13   ICMP Message Handling Routines . . . . . . . .  42
;       11.14   ICMP Action Passing  . . . . . . . . . . . . .  45
;       11.15   ICMP Error Handling  . . . . . . . . . . . . .  46
;   12. Internet Gateway . . . . . . . . . . . . . . . . . . .  48
;       12.1    Send a Packet into the Internet  . . . . . . .  49
;       12.2    Send a Packet  . . . . . . . . . . . . . . . .  52
;       12.3    Local Bypass . . . . . . . . . . . . . . . . .  53
;       12.4    Checksum Handling  . . . . . . . . . . . . . .  55
;       12.5    Receive a Packet . . . . . . . . . . . . . . .  56
;       12.6    Fragment an IP Packet  . . . . . . . . . . . .  59
;       12.7    Receive Fragment Processing  . . . . . . . . .  66
;       12.8    Process IP Options . . . . . . . . . . . . . .  74
;       12.9    Process Routing Options  . . . . . . . . . . .  76
;       12.10   Timestamp Option Handling  . . . . . . . . . .  78
	Subttl	Table of Contents (page 2)

;		     Table of Contents for IPIPIP
;
;				  Section		      Page
;
;
;   13. Gateway Table Routines . . . . . . . . . . . . . . . .  80
;       13.1    Lookup a Gateway Address . . . . . . . . . . .  81
;       13.2    State Change Routines  . . . . . . . . . . . .  82
;       13.3    Hash Table Routines  . . . . . . . . . . . . .  83
;   14. Internet User Queues . . . . . . . . . . . . . . . . .  85
;       14.1    ASNIQ% JSYS  . . . . . . . . . . . . . . . . .  86
;       14.2    RELIQ% JSYS  . . . . . . . . . . . . . . . . .  89
;       14.3    SNDIN% JSYS  . . . . . . . . . . . . . . . . .  92
;       14.4    RCVIN% JSYS  . . . . . . . . . . . . . . . . .  94
;       14.5    Misc. Routines . . . . . . . . . . . . . . . .  96
;       14.6    Processing . . . . . . . . . . . . . . . . . .  99
;   15. Internet Packet Locking and Unlocking  . . . . . . . . 104
;   16. Misc. Routines
;       16.1    Lock Handling - Event Tracking . . . . . . . . 105
;       16.2    Get Universal Time Since Midnight  . . . . . . 106
;   17. End Of IPIPIP  . . . . . . . . . . . . . . . . . . . . 107
	SUBTTL Lock Handling

	$INIT

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

	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

	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.

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

	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
	MOVX T1,USRCTX		; INIT CONTEXT
	MOVEM T1,FFL
	SETZM FPC
	MCENTR			; Establish monitor context
	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
	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
	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
	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.

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

	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.

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

	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

	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:

MAXGWA==:^D50			;[7.1283] Number of GWs we will keep track of
				; (Gateways and multi-homed hosts)
; The file name to use:

GWFILE:	ASCIZ "SYSTEM:INTERNET.GATEWAYS"

; ICMP packet is pointed to by CPKT, structure as defined in
; INPAR

MINICW==PKTELI+<<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::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
	CAIE T4,GW%DUM		; [7182] Dumb Gateway?
	 JRST SNDPN6		; No.
	EXCH T1,T2		; Yes, 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:
	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
	LOAD T1,PIDH,-PKTELI+.CMINH(CPKT) ; Get the host number
	CALL HSTHSH		; Get its hash code
	 JUMPL T2,R		; If .LT. 0, no room
	MOVEM T1,HOSTNN(T2)	; Put host number in hash table in case new
	MOVX T1,<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

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

	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

	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

	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

	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.
	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:	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)
	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

	XRESCD			; THIS CODE IS RESIDENT

RCVGAY:	PION
RCVGAX:

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

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

	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

	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

GWYLUK::ACVAR	<NET>			;[7.1283] Global routine
	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 STANSW,<
	 RET		; -1,,.NCTi	; No, return with interface
>;IFE STANSW
IFN STANSW,<
	 JRST FNDINT			; No, interface. Find best and return
>;IFN STANSW
	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
IFN STANSW,<
	CALL FNDINT			; Ensure best interface on desired net
>;IFN STANSW
	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 Gateway Table Routines -- 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

	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.

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

	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

	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.

	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.

	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

CHKIQ::	HRRZS T2,T1             ;[7.1283] Global routine
	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?
	 JRST INQDS8		; 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.

	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
	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
	CALLX (MSEC1,MULKSP)	; unlock the page
	RET			; return to caller
	SUBTTL Misc. Routines -- 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 -- Get Universal Time Since Midnight

;INETUT	Get universal time since midnight.
;	CALL INETUT
;Ret+1:	Always, T1 contains 32-bit time since midnight

	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
	SUBTTL End Of IPIPIP
	TNXEND
	END