Google
 

Trailing-Edge - PDP-10 Archives - BB-EV84A-SM_1985 - monitor-sources/tcptcp.mac
There are 9 other files named tcptcp.mac in the archive. Click here to see a list.
; UPD ID= 2197, SNARK:<6.1.MONITOR>TCPTCP.MAC.10,   5-Jun-85 11:21:13 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 1704, SNARK:<6.1.MONITOR>TCPTCP.MAC.9,  31-Mar-85 13:10:40 by PAETZOLD
;More TCO 6.1.1300  - typeo in last.
; UPD ID= 1703, SNARK:<6.1.MONITOR>TCPTCP.MAC.8,  31-Mar-85 13:08:16 by PAETZOLD
;TCO 6.1.1300 - Check for null buffer in BUFHNT.
; UPD ID= 1602, SNARK:<6.1.MONITOR>TCPTCP.MAC.7,   7-Mar-85 16:47:37 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1568, SNARK:<6.1.MONITOR>TCPTCP.MAC.6,  26-Feb-85 17:16:59 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1043, SNARK:<6.1.MONITOR>TCPTCP.MAC.5,  12-Nov-84 15:27:07 by PAETZOLD
;TCO 6.1041 - Move ARPANET to XCDSEC
; UPD ID= 291, SNARK:<TCPIP.5.4.MONITOR>TCPTCP.MAC.4,  24-Sep-84 13:56:00 by PURRETTA
;Update copyright notice.
; UPD ID= 238, SNARK:<TCPIP.5.4.MONITOR>TCPTCP.MAC.3,  21-Aug-84 10:29:34 by PAETZOLD
;TCO 6.2185 - Flush hung TCBs.
; UPD ID= 96, SNARK:<TCPIP.5.4.MONITOR>TCPTCP.MAC.2,  12-May-84 10:51:52 by PAETZOLD
;Move CLRBLK to IPFREE
; UPD ID= 4037, SNARK:<6.MONITOR>TCPTCP.MAC.11,   1-Apr-84 18:56:43 by PAETZOLD
;More TCO 6.1733 - Fix MAX packet size calculation
; UPD ID= 4036, SNARK:<6.MONITOR>TCPTCP.MAC.10,   1-Apr-84 18:44:21 by PAETZOLD
;More TCO 6.1733 - Change USRBFFs in FLSSBX to USRBFEs.
; UPD ID= 4025, SNARK:<6.MONITOR>TCPTCP.MAC.9,  31-Mar-84 16:21:45 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3944, SNARK:<6.MONITOR>TCPTCP.MAC.8,  19-Mar-84 10:23:58 by PAETZOLD
;More TCO 6.1733 - Fix typo in NUWND0.
; UPD ID= 3928, SNARK:<6.MONITOR>TCPTCP.MAC.7,  14-Mar-84 14:54:44 by PAETZOLD
;More TCO 6.1733 - Make initial buffer size selection more reasonable.
; UPD ID= 3891, SNARK:<6.MONITOR>TCPTCP.MAC.6,  11-Mar-84 10:35:31 by PAETZOLD
;More TCO 6.1733 - Fix  for exceeding the  send window. Fix for runaway
;ACK bug. Fix TCB's hung in NOT.FIN.  Fix  for  zero  window  bug.  fix
;packetizer  to  see  if transfer count fills window. fix packetizer to
;make sure FIN sent after deferred data transmitted.
; UPD ID= 3820, SNARK:<6.MONITOR>TCPTCP.MAC.5,  29-Feb-84 18:09:34 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal.  Bug Fixes.  Cleanup.
;<TCPIP.5.3.MONITOR>TCPTCP.MAC.4,  6-Dec-83 23:59:50, Edit by PAETZOLD
;TCO 6.1867 - Use SAVEAC and not SAVP1
;More TCO 6.1733 - bug fixes to packetizer.
;<TCPIP.5.1.MONITOR>TCPTCP.MAC.19,  5-Jul-83 22:30:44, Edit by PAETZOLD
;JFN Interface
;TCP Changes for 5.1

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION  1976, 1985.
;ALL RIGHTS RESERVED.


	SEARCH	ANAUNV,PROLOG
	TTITLE	(TCPTCP,TCPTCP,< - ARPANET Transmission Control Protocol>)

	IFNDEF REL6,<REL6==1>

Comment \

This  module  implements  most  of  the  Department  of Defense (DOD)
Standard  Tranmission  Control  Protocol  (TCP)  for  the   TOPS-20AN
Operating  system. This code was originally developed at Bolt Beranek
and Newman (BBN) under contract  to  the  Defense  Advanced  Research
Projects Agency (DARPA).

\

	IF1 <IFN IPPDSW,<PRINTX Assembling Packet Printer Routines>>
	SUBTTL	TCP Process

COMMENT	!

This is the top level of the TCP protocol module.  Herein are the
TCP initialization, "interprocess communication" between parts of
the TCP, etc.

!
;SIGNAL
;Cause a process to run.

;T1/	(Extended) Target process ID
;T2/	0 or delta in milliseconds
;TCB/	(Extended) Locked Connection Block
;	CALL SIGNAL
;Ret+1:	Always

SIGNAL::
	TEMP <LCK,FN,PRC,DL>
	DMOVEM T1,PRC
	ADD DL,TODCLK		; Compute deadline
	XMOVEI LCK,PRCLCK(PRC)	; Pointer to lock cell of process
	XMOVEI FN,SIGNL0	; Function
				; PRC and DL have args to SIGNL0
	CALL LCKCAL		; Lock the lock and call the function
	RESTORE
	RET
;SIGNL0		Guts of the Signal

;T1/	(Extended) Process block (locked)
;T2/	Wakeup TODCLK
;TCB/	(Extended) Connection block (locked)
;      	NOINT
;	CALL SIGNL0
;Ret+1:	Always

SIGNL0:	LOCAL <PRC,DL,SAVTCB>
	DMOVEM T1,PRC		; Save Process and Deadline
	MOVEM TCB,SAVTCB	; Save the signalee
	MOVE T3,TODCLK		; Now in milliseconds
	MOVEM T3,PRCSGT(PRC)	; Set time of most recent signal
	SKIPN @PRCQOF(PRC)	;@TCBQxx(TCB) This TCB already Q'd for task?
	  JRST SIGNL1		; No. Just insert in queue.
	XMOVEI T1,@PRCQOF(PRC)	;@TCBQxx(TCB) Get pointer to queue in the TCB
	CAML DL,@PRCWOF(PRC)	;@TCBTxx(TCB) Compare with deadline already set
	  JRST SIGNL5		; Leave in current position.
	CALL DQ			; Sooner.  Dequeue so it can be inserted
SIGNL1:	MOVEM DL,@PRCWOF(PRC)	;@TCBTxx(TCB) NB double idx, here and elsewhere
	MOVE T2,PRCQ(PRC)	; Pointer to input queue head
	MOVE T3,PRCQOF(PRC)	; Get offset to queue in TCB
SIGNL2:	LOAD T2,QNEXT,(T2)	; Get next TCB on input queue
	SETSEC T2,INTSEC	; Make extended address
	CAMN T2,PRCQ(PRC)	; Back to head?
         JRST SIGNL4		; Yes.  Append to end of queue.
	MOVE TCB,T2		; Make right for indirect index
	SUBI TCB,0(T3)		; Make TCB point to base of block
	CAML DL,@PRCWOF(PRC)	;@TCBTxx(TCB) Found place to insert?
         JRST SIGNL2		; No. Scan more of queue
SIGNL4:	MOVE TCB,SAVTCB		; Point TCB at the signalee
	XMOVEI T1,@PRCQOF(PRC)	; Get pointer to queue in that TCB
	CALL NQ			; And queue it up
SIGNL5:	MOVE TCB,PRCQ(PRC)	; Pointer to input queue head
	LOAD TCB,QNEXT,(TCB)	; Get first TCB on the queue
	SUB TCB,PRCQOF(PRC)	; Make into standard TCB pointer
	SETSEC TCB,INTSEC	; Make extended address
	MOVE T1,@PRCWOF(PRC)	;@TCBTxx(TCB) Get wakeup time of 1st TCB on Q
	MOVEM T1,PRCWAK(PRC)	; That is new wakeup for process
	MOVE TCB,SAVTCB		; Restore TCB pointer for caller
	CAMG T1,TODCLK		; Wakeup already gone by?
	  AOS TCPFLG		; Yes. Ensure that we keep running.
	AOS INTFLG		; Cause Internet fork run TCPCHK
	RESTORE
	RET
;TCPPRC
;TCP processing.

;	CALL TCPPRC		(From Internet fork)
;Ret+1:	Always.

TCPPRC::SETZM TCPFLG		; Clear run request
	SKIPE INTSVR		; Internet level needs space badly?
	  SETZM BG+PRCWAK	; Yes.  Make BG scavenge what it can
	XMOVEI T1,IP		; Select Input Processor
	MOVE T2,TCPIPQ		; (Ext) Ptr to TCP input queue head
	LOAD T3,QNEXT,(T2)	; Get first thing on the queue
	CAIE T3,0(T2)		; Empty if that is the head.
	  CALL TCPTSK		; Process any available input packets
	CALL TCPRUN		; Run all the other "processes"
	XMOVEI T1,BG		; Ptr to Background Process
	MOVE T2,PRCWAK(T1)	; Wakeup time for BG
	CAMG T2,TODCLK		; Due for a run?
	  CALL TCPTSK		; Yes.  Run BG.
	IFE REL6,<CALL TVTOPR>	; Operate TCP Virtual Terminals
	IFN REL6,<CALLX (MSEC1,TVTOPR)> ; Operate TCP Virtual Terminals
	SKIPE TCPFLG		; Further work to do?
	  JRST TCPPRC		; Yes.
	RET
;TCPCHK
;Periodic check on TCP.

;T1/	A TODCLK to be min'd against
;	CALL TCPCHK		; From Internet fork
;Ret+1:	Always.  T1 as min of arg and next TCP check time
;		 TCPTIM set to next run time

TCPCHK::
	LOCAL <TOD>
	MOVEM T1,TOD
	MOVE T1,TODCLK		; Now.
	ADD T1,TCPCKT		; Check again in 10 seconds
	SKIPN TCPON		; Is the TCP on right now?
	  JRST TCPCH9		; No.
	MOVSI T2,-NPROCS	; Set to scan process table
TCPCH1:	MOVE T3,PRCTAB(T2)	; Get pointer to process block
	SKIPL T4,PRCWAK(T3)	; Avoid ones which aren't scheduled
	 CAML T4,T1		; Less than current best min?
	  CAIA			; No.
	   MOVE T1,T4		; Yes.  Take the new value
	AOBJN T2,TCPCH1		; Loop over all processes in the table
	SKIPL T4,BG+PRCWAK	; Special case background
	 CAML T4,T1
	  CAIA
	   MOVE T1,T4
TCPCH9:	MOVEM T1,TCPTIM		; Save for scheduler test
	CAMLE T1,TOD		; Min against arg
	  MOVE T1,TOD
	RESTORE
	RET
;TCPRUN
;Run all the TCP tasks.

;Each   process  has  an  input  queue  of  TCBs.  TCPRUN  scans  all
;"processes"  and  for  each  with  a  non-empty  queue,  calls   the
;approriate  routine  for each TCB on the queue. The new wake up time
;is set into the process block.

;	CALL TCPRUN
;Ret+1:	Always.

TCPRUN:	SAVEAC <TCB>
	LOCAL <I,PRC>
	MOVSI I,-NPROCS		; Set to scan all processes
TCPRU1:	MOVE PRC,PRCTAB(I)	; Get pointer to process block
TCPRU2:	SKIPGE T1,PRCWAK(PRC)	; Get the wakeup time for this one
	  JRST TCPRU9		; No run needed
	MOVE T4,PRCQ(PRC)	; Get pointer to queue head
	LOAD T3,QNEXT,(T4)	; Get first thing on the input queue
	SETSEC T3,INTSEC	; Make extended address
	CAMN T3,T4		; Empty queue?
	  JRST TCPRU8		; Yes.  Cancel this process.
	CAMLE T1,TODCLK		; Time to run?
	  JRST TCPRU9		; No.  Try next process
	XMOVEI T1,PRCLCK(PRC)	; The lock to lock
	XMOVEI T2,DQTASK	; The function to call
	MOVE T3,PRC		; Process to work on
	CALL LCKCAL		; Lock the lock and call the function
	MOVE TCB,T1		; Put in standard place
	XMOVEI T1,TCBLCK(TCB)	; The lock on the TCB
	XMOVEI T2,TCPTSK	; Subfunction to call
	MOVE T3,PRC		; The task to run
	CALL LCKCAL		; Lock the TCB and run the function
	JRST TCPRU2		; See if next TCB is due

TCPRU8:	SETO T1,		; Empty queue means no wakeup
	MOVEM T1,PRCWAK(PRC)	; Set into process block
TCPRU9:	AOBJN I,TCPRU1		; Loop over all processes in table
	RESTORE
	RET
; Table of process block pointers:

PRCTAB:	NCTDSP RA		; Reassembler
	NCTDSP PZ		; Packetizer
	NCTDSP RX		; Retransmitter
	NCTDSP DY		; Delayed Actions
NPROCS==.-PRCTAB

; Note that BG is special in that it does not have an input queue and
; that  it  must  lock  TCBH  while it is running. IP is also special
; because it is driven by packets arriving from the network.
;DQTASK
;Remove a TCB from a task input queue and reset wakeup time.

;T1/	Process block pointer
;      	NOINT
;	CALL DQTASK
;Ret+1:	Always.  T1 has pointer to TCB.

DQTASK:	SAVEAC <TCB>
	LOCAL <PRC,PROCQ>
	MOVEM T1,PRC
	MOVE PROCQ,PRCQ(PRC)	; Pointer to input queue
	LOAD TCB,QNEXT,(PROCQ)	; Get 1st item on the queue
	SETSEC TCB,INTSEC	; Make extended address
	MOVE T1,TCB		; This the one to return
	CALL DQ			; Remove it from the queue
	MOVE T2,PRCQOF(PRC)	; Get offset to queue word in TCB
	SUBI T1,0(T2)		; Get standard TCB pointer
	LOAD TCB,QNEXT,(PROCQ)	; Get 1st item on remaining queue
	SETSEC TCB,INTSEC	; Make extended address
	CAMN TCB,PROCQ		; Is the queue now empty?
	  JRST DQTAS8		; Yes.
	SUBI TCB,0(T2)		; Get pointer to base of TCB
	SKIPA T2,@PRCWOF(PRC)	; Note double index by PRC and TCB
DQTAS8:	  SETO T2,		; No need to run
	MOVEM T2,PRCWAK(PRC)	; Set new wakeup
	RESTORE
	RET
;TCPTSK
;Call the process routine and do accounting.

;T1/	(Extended) Process block pointer
;TCB/	(Extended) Locked Connection Block, unless IP or BG being run
;	CALL TCPTSK
;Ret+1:	Always

TCPTSK::
	LOCAL <PRC>
	MOVEM T1,PRC
	MOVEM PRC,PROC		; Indicate who is running now.
IFN IPPDSW,<
	SKIPN STATF		; Taking statistics right now?
	  JRST TCPTS9		; No.  Just call the function
	XMOVEI T1,BG
	XMOVEI T2,IP
	CAME PRC,T1		; Running Background?
	 CAMN PRC,T2		; Running Input Processor?
	  JRST TCPTS8		; Yes.  Activate delay not defined
	MOVEI T1,ACDLAY		; Select activation delay histogram
	MOVE T2,TODCLK		; Now
	SUB T2,PRCSGT(PRC)	; Time of most recent signal
	CALL DOHIST		; Histogram that delta
TCPTS8:
	MOVE T1,PRCTMR(PRC)	; Pointer to appropriate timer
	MOVE T2,PRCROU(PRC)	; The routine to call
	CALL TIMCAL		; Time the call
	JRST TCPTSX
>				; End of IFN IPPDSW
TCPTS9:	CALL @PRCROU(PRC)	; Call the routine
TCPTSX:	AOS TASKCT		; Count tasks run
	AOS @PRCRNC(PRC)	; Count runs of this particular process
	SETZM PROC		; Indicate nobody running now.
	RESTORE
	RET
;TCPINI
;Initialize TCP module.

;	CALL TCPINI		(From INTINI)
;Ret+1:	Always.  TCP ready to run.

TCPINI::NOSKED
	MOVEI T1,QSZ		; Size of a queue head
	CALL GETBLK		; Get that amount of free storage
	JUMPE T1,TCPINX		; Lose
	MOVEM T1,TCPIPQ		; That is the TCP input queue
	CALL INITQ		; Initialize it
	CALL TBFINI		; Initialize Buffer Windows
	CALL PZINI		; Initialize Packetizer
	JUMPE T1,TCPINX		; Lose
	CALL IPINI		; Initialize Input Processor
	JUMPE T1,TCPINX		; Lose
	CALL RAINI		; Initialize Reassembler
	JUMPE T1,TCPINX		; Lose
	CALL RXINI		; Initialize Retransmitter
	JUMPE T1,TCPINX		; Lose
	CALL DYINI		; Initialize Delayed Action Generator
	JUMPE T1,TCPINX		; Lose
	CALL BGINI		; Initialize Background Routine
	JUMPE T1,TCPINX		; Lose
	CALL USRINI		; Initialize User Interface
	JUMPE T1,TCPINX		; Lose
IFN IPPDSW,<CALL STSINI>		; Initialize Statistics
	CALL PPINI		; Initialize Packet Printer
	CALL TCBINI		; Initialize TCB Hash table
	JUMPE T1,TCPINX		; Lose
	SETZM TCPSID		; Clear TCP segment idents.
	SETOM TCPIFG		; TCP has now been initialized
	SETOM TCPON		; The TCP is now on
TCPINX:	OKSKED
	RET
	SUBTTL	TCP Input Processor

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

Executed  in Internet (JOB0) context. The INPUTPROCESSOR is called to
process the queue of packets just input from the network. Each packet
is checked for proper format, protocol version, checksum, etc and  if
all  is  OK, the correct TCB is looked up. IP may respond with an RST
packet if the TCB is not there, it may ACK the  packet  if  it  is  a
duplicate, or it may process some things from the packet and queue it
for   the   REASSEMBLER.   In   particular,  IP  processes  the  data
acknowledged by the packet and sets the new window for PZ.

!
;INPROC
;Process the input packet queue.
;Packets have been queued by IMPDV interrupt level.

;	CALL INPROC
;Ret+1:	always.

INPROC:	SAVEAC <PKT,TPKT>
	STACKL <<ARGBLK,CHKADW>>
	CHKADL			; Room for args to CHKADD

; Top of main loop.  Get next packet to be processed.

INPRO0:	MOVE T1,TCPIPQ		; Get pointer to input queue head
	LOAD PKT,QNEXT,(T1)	; Get pointer to first thing on queue
	CAIN PKT,0(T1)		; If that is the head itself
         JRST INPROX		; Get out because it is empty (need OKSKED)
	SETSEC PKT,INTSEC	; Make extended address
	MOVE T1,PKT		; What to dequeue
	CALL DQ			; Remove from input queue
	SETZ TCB,		; May be a bad packet
	MOVX T1,PT%TDI		; TCP received packet
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	LOAD T1,PIDO,(PKT)	; Internet Data Offset
	XMOVEI TPKT,PKTELI(PKT)	; Pointer to Internet packet
	ADD TPKT,T1		; Pointer to TCP packet
	CALL TCPCKS		; Compute checksum function
	JUMPE T1,INPRO2		; Jump if good
; Packet has bad checksum.  Flush it.

	AOS BADPCT		; Count bad packets
	MOVX T1,PT%XX5		; Code for "Flushed by IP"
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	MOVX T1,PT%TKC		; TCP Killed due to bad checksum
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	CALL RETPKT		; Return the packet storage
	JRST INPRO0		; And hope for better luck next Pkt

; Packet is OK to process ...

INPRO2:
	CALL PKTEND		; Get seq. number of End of Pkt plus 1
	STOR T1,PESEQ,(PKT)	; Keep in handy place

; Now setup for a call to CHKADD which looks up the TCB addressed
; by the pkt.  If it is found, CHKADD calls INPUT with said TCB locked.

	MOVEI PARAMS,ARGBLK	; Arg area on stack (ref. via sec. 0)
	LOAD T1,PIDH,(PKT)	; Destination Host
	MOVEM T1,LH
	LOAD T2,PDP,(TPKT)	; Destination port
	MOVEM T2,LP
	LOAD T3,PISH,(PKT)	; Source Host
	MOVEM T3,FH
	LOAD T4,PSP,(TPKT)	; Source Port
	MOVEM T4,FP
	SETZM JCN		; No JCN.  Call is from IP.
	SETOM WILDOK		; Wild TCB (Listen) is OK for match
	XMOVEI T2,INPUT		; Function to call if found
	MOVEM T2,FN
	SETZM ARG1		; No ARG1
	SETZM ARG2		; or ARG2
	MOVE T1,PARAMS		; Arg block for CHKADD
	CALL CHKADD		; Check the address of the packet
	CAMN T1,[-1]		; Packet disposed of successfully?
         JRST INPRO0		; Yes. Do another one.
	PUSH P,T1
	MOVX T1,PT%XX5		; Code for "Flushed by IP"
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	POP P,T1
	JN PRST,(TPKT),INPRO5	; Don't respond to RST!
	HRRZ T2,T1		; Get just the error portion
	CAIE T2,EFP+^D7		; Is it "No such TCB" ?
	 CAIN T2,ELP+^D7	; Is it "No such TCB" ?
	  SETZ TCB,0		; Yes.  TCB used as flag to SNDRST
	CALL SNDRST		; Reply with an RST Packet
INPRO5:				; Here when done with packet.
	MOVX T1,PT%TID		; TCP done with packet
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	CALL RETPKT		; Give back the storage
	JRST INPRO0		; And process some more packets
INPROX:				; Here when packet queue completely processed.
	CHKADR
	RET
;INPUT
;2nd phase of InputProcessor.
;Called via CHKADD from INPROC

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL INPUT
;Ret+1:	Always.  T1 has -1 if Pkt was handled OK,
;			 0 if Pkt was on a closed (NOTSYN,NOTSYN) connection,
;			-1,,EFP+^D7

INPUT:	LOCAL <TESTB>
	LOAD T1,TSSYN,(TCB)	; State of Send synchronization
	LOAD T2,TRSYN,(TCB)	; State of Recv synchronization
	CAIN T1,NOTSYN
	 CAIE T2,NOTSYN
	  CAIA			; Still open in some respect
	   JRST INPUTF		; Packet on closed connection.
	CALL CHKSEQ		; See if properly sequenced
	MOVEM T1,TESTB		; -1 OK or DUP,,0; IGN,,0; ERR,,EFP+^D7
	HLRZ T2,TESTB
	CAMN TESTB,[-1]		; TRUE ?
         JRST INPUT3
	CAIN T2,ERR		; ERROR ?
         JRST INPUT4

; Packet is a DUP, IGN, (or "other")

	 CAIE T2,DUP		; DUPLICATE ?
	  JRST INPUT2		; NOTA -- Ignore it

; Duplicate received. (SYN on a synched connection)

	AOS DUPKCT		; Count it.
	JE PACK,(TPKT),INPUT1	; No ACK.  Forget the following.
	JN PRST,(TPKT),INPUT1	; Don't process ACK from RST packet
	LOAD T1,PACKS,(TPKT)	; ACK sequence from Packet
	CALL PRCACK		; Process the ACK
INPUT1:
	CALL NULPKT		; Does the packet have any contents
	SKIPN T1		; Skip FRCPKT if null
	  CALL FRCPKT		; Generate an ACK for the DUP
	SKIPA T1,[PT%TKD]

; All packets except ERR and good ones come here (ie DUP & IGN)
; Pkt should be IGNored, resyncing connection

INPUT2:
	MOVX T1,PT%TKR		; TCP Killed, Resyncing
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	MOVX T1,PT%XX6		; IP code
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	CALL RETPKT		; Release the storage space
	JRST INPUTT		; Return true to say it's been handled

; Handle normal, acceptable packet

INPUT3:	LOAD T1,PIDH,(PKT)	; Get which incarnation he knows us under
	STOR T1,TLH,(TCB)	; Stick it away
	CALL PRCPKT		; Process the packet
	AOS IPPKCT		; Count as Processed by IP
	JRST INPUTT		; and return TRUE

; CHKSEQ said this packet is in error -- no TCB (ERR,,EFP+^D7)

INPUT4:	MOVX T1,PT%XX3		; IP code
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	MOVX T1,PT%TKX		; TCP Killed, no TCB
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	HRRO T1,TESTB		; -1,,EFP+^D7 to return
	EXIT INPUTX		; (must RETPKT)

; Packet on closed connection (NOTSYN,NOTSYN)

INPUTF:	MOVX T1,PT%TKN		; TCP Pkt received on closed connection
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	TDZA T1,T1		; Packet not processed (must RETPKT)
INPUTT:	 SETO T1,		; Return TRUE, packet processed & RETPKT'd
INPUTX:	RESTORE
	RET
;CHKSEQ
;Determine  the validity of a packet on the basis of sequence number,
;acknowledge number, synchronization state, and the presence  of  SYN
;in the packet.

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL CHKSEQ
;Ret+1:	always with T1 having ERR,,EFP+^D7; DUP,,0; IGN,,0 or -1 if OK

CHKSEQ:	LOAD T1,TRSYN,(TCB)	; Recv state
	CAIN T1,SYNABL		; Listening?
	  JRST CKACKS		; Yes.  Validate using ACK sequence
				; Fall into CKSYNS
;Fall into CKSYNS from CHKSEQ above

;CKSYNS
;Check  sequence  number.  Used  while receive sync is established. A
;packet sequenced within the receive window is accepted;  without  is
;considered a duplicate.

;Stray  SYNs on already synched connections are called DUPlicates and
;will cause a null packet to be emitted which contains  the  sequence
;we  are  sending  on and the ACK sequence describing what we want to
;hear next. This is enough information for the other end to  be  able
;to  form  an RESET packet which will flush this connection. He would
;do this only if he had restarted recently.

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL CKSYNS
;Ret+1:	always. T1 has -1 if pkt is OK to process, or DUP,,0; IGN,,0

CKSYNS:	JE PSYN,(TPKT),CKSYN1	; Jump if no stray SYN in packet.
	LOAD T1,TRSYN,(TCB)	; Get receive state
	LOAD T2,PSEQ,(TPKT)	; and sequence number from packet
	LOAD T3,TRIS,(TCB)	; and seq. number of original SYN recvd
	CAIN T1,SYNRCV		; In SYN-RECEIVED?
	 CAMN T2,T3		; or just another copy of orig SYN?
	  JRST CKSYND		; Call it a dup. to get null pkt sent
	CALL SYNAGN		; Resync. the conn.  Other end crashed
	MOVX T1,<IGN,,0>	; Tell caller to ignore this packet
	EXIT CKSYNX

CKSYN1:	LOAD T1,TRLFT,(TCB)	; Left window edge
	LOAD T2,TRWND,(TCB)	; Width of window
	JE PRST,(TPKT),CKSYN2	; No window diddle if not RST in pkt
	SKIPN T3,T2		; If non-0, use it
         MOVX T3,1		; Otherwise diddle so RST gets done
	ADD T3,T1		; Compute Right plus 1 or width 1 window
	MODSEQ T3		; Keep within right number of bits
	LOAD T2,PSEQ,(TPKT)	; Get sequence number of packet
	CALL CHKWND		; Is RST within the window?
	JRST CKSYN9		; Go see

CKSYN2:	ADD T2,T1		; Right window edge plus 1
	MODSEQ T2
	LOAD T3,PSEQ,(TPKT)	; Packet sequence number
	LOAD T4,PESEQ,(PKT)	; Sequence number following Pkt
	CALL OVRLAP		; Pkt and window have common point(s)?
CKSYN9:	SKIPN T1		; Skip if yes
CKSYND:	 MOVX T1,<DUP,,0>	; Call it a DUPlicate
CKSYNX:	RET			; From CHKSEQ
;CKACKS
;Check ACK Sequence.  Validate pkt when not synchronized.

;When  receive  synchronization  has  not  been established, the only
;acceptable   packet   is   one   which   will   establish    receive
;synchronization.   Furthermore,   if   we   have   established  send
;synchronization, the  packet,  if  it  acknowledges  anything,  must
;acknowledge something we have currently sent (eg, a SYN).

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL CKACKS
;Ret+1:	always. T1 having ERR,,EFP+^D7 else -1 if pkt is ok to process

CKACKS:	JN PACK,(TPKT),CKASE1	; Jump if packet ACKs something
	JE PSYN,(TPKT),CKASE2	; Give error if no SYN and no ACK
	JRST CKASET		; SYN and no ACK.  Try to open conn.
CKASE1:	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIN T1,SYNABL		; Have a Send Sequence to check?
         JRST CKASE2		; Error if not waiting for SYN
	LOAD T1,TSLFT,(TCB)	; Get Send Left
	LOAD T2,PACKS,(TPKT)	; What the Packet ACKS
	LOAD T3,TSSEQ,(TCB)	; Current Send Sequence
	ADDI T3,1
	MODSEQ T3
	CALL CHKWND		; Does Pkt ACK someting outstanding?
	JUMPN T1,CKASET		; Return TRUE if so
CKASE2:
	CALL RSTADR		; Restore Wild foreign address fields
	SKIPA T1,[ERR,,EFP+^D7]	; Give error
CKASET:	SETO T1,		; Ok to process
	RET			; From CHKSEQ
;PRCPKT
;Process Packet which has been determined to be acceptable

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL PRCPKT
;Ret+1:	always. No value returned. PKT disposed of

PRCPKT:	LOCAL <QP,QS>		; OLDR??

; Extract IP & TCP options

	CALL TCPXIO		; Extract IP
	CALL TCPXTO		; and TCP options

; Avoid some processing overhead if possible

	LOAD T1,PCTL,(TPKT)	; Get the control flags
	TXNN T1,<PACK!PURG!PRST!PSYN> ; Any control stuff is this packet?
	 JRST PRCPK7		; no so save some overhead

; Process RESET

	JE PRST,(TPKT),PRCPK1	; Jump if not a RESET Packet
	CALL PRCRST		; Process the reset (may not have PACK)
	MOVX T1,PT%TRS
	JRST PRCPKR		; Return to caller.
PRCPK1:				; Process ACK
	JE PACK,(TPKT),PRCPK2	; Does the packet acknowledge anything?
	LOAD T1,PACKS,(TPKT)	; Yes.  Get the ack sequence
	CALL PRCACK		; And process the ACK & update send window
PRCPK2:				; Process Urgent
	JE PURG,(TPKT),PRCPK5	; Contains urgent pointer?
	CALL PRCURG		; Yes.  Process that.
PRCPK5:

;See  if there is anything to process in the packet If not return the
;storage and return to caller.

	CALL NULPKT		; See if PKT is null
	MOVX T2,PT%TID
	EXCH T1,T2
	JUMPN T2,PRCPKR		; Jump if so.  Return to caller.
;Process SYN

	JE PSYN,(TPKT),PRCPK7	; Jump if no SYN
	CALL PRCSYN		; Process the SYN
PRCPK7:				; Sets TRLFT at TRIS+1, R-state changed
				; Tell USREVT(OK) if SYN.SYN
;Trim input packet if short on space

	CALL TRMPKT		; Trim it size or flush PKT for space
	JUMPE PKT,PRCPKX

;Queue  the  Packet  for the Reassembler. The receive packet queue is
;basically  ordered  by  sequence  number,  but  may  have  partially
;overlapping segments on it. (try searching right to left)

	XMOVEI QS,TCBRPQ(TCB)	; Set scan pointer to Reassembly Q head
	JE TRPP,(TCB),PRCPK8	; Partial Pkt contains left. Skip it.
	LOAD QS,QNEXT,(QS)	; Get next packet after the partial one.
	SETSEC QS,INTSEC	; Make extended address

;Top of the search for right place to insert loop

PRCPK8:	LOAD QS,QNEXT,(QS)	; Get ptr to thing after scan pointer
	CAIN QS,TCBRPQ(TCB)	; If that is the head, all has been seen
         JRST PRCPK9		; So insert just before the head (= end)
	SETSEC QS,INTSEC	; Make extended address
	LOAD T3,PIDO,(QS)	; Internet data offset
	XMOVEI T4,PKTELI(QS)	; Pointer to Internet portion
	ADD T4,T3		; Pointer to TCP portion
	LOAD T1,TRLFT,(TCB)	; Get Recv Left
	LOAD T2,PSEQ,(T4)	; Sequence of current pkt (QS) is end
	PUSH P,T2		; Save sequence number around call
	LOAD T3,PSEQ,(TPKT)	; Sequence of new packet
	LOAD T4,PESEQ,(PKT)	; End sequence of new packet
	CALL OVRLAP		; New pkt fit before this one (QS) in queue?
	POP P,T3		; Recover sequence number for use below
	JUMPE T1,PRCPK8		; No. Advance queue scan ptr. Try next.

;Have  a  likely  place  to  put the packet. Be sure that we will not
;insert before one which contains left.

	MOVE T1,T3		; Sequence number of packet on queue
	LOAD T2,TRLFT,(TCB)	; Recv Left
	LOAD T3,PESEQ,(QS)	; End of packet + 1
	CALL CHKWND		; Left within this packet?
	JUMPN T1,PRCPK8		; Jump if so.  Look at next packet.
;Now  QS  points  to  where  to insert the new packet (before QS). Do
;checking to see if the packet to the left and packets to  the  right
;are  completely  contained  by  the  packet being processed. Release
;storage of those which are. This works well  if  retranmissions  are
;equal  to-  or  bigger than- the original transmissions. It does not
;worry about duplicates of (small) original transmissions which might
;be contained by packets already queued. N.B. It works to  replace  a
;"partial packet" with a bigger one.

PRCPK9:	SETSEC QS,INTSEC	; Make extended address
	LOAD T1,QPREV,(QS)	; Get one just skipped (or header)
	CAIE T1,TCBRPQ(TCB)	; Avoid fiddling with the header
	  CALL REMCHK		; Check and maybe remove T1 from Q
				; (REMCHK does SETSEC)
PRCP9A:	HRRZ T1,QS		; Get current insert point
	CAIN T1,TCBRPQ(TCB)	; Is that the header?
	  JRST PRCP10		; Yes.  Don't check that.
	MOVE QP,QS		; Save as predecessor in case needed
	LOAD QS,QNEXT,(QP)	; Get next item on Q for next time
	SETSEC QS,INTSEC	; Make extended address
	MOVE T1,QP		; Check the current item
	CALL REMCHK		; Maybe delete it
				; (REMCHK does SETSEC)
	JUMPN T1,PRCP9A		; Jump if deleted (QS ok for next time)
	MOVE QS,QP		; Restore QS (point of insertion)
PRCP10:

; Actually queue the packet for the Reassembler.

	MOVE T1,PKT		; Select the packet for EnQueueing
	MOVE T2,QS		; Where to enqueue it -- before QS.
	CALL NQ			; Enqueue the packet
	MOVX T1,PT%XX3		; Code for "processed by IP"
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	MOVX T1,PT%TQR
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
;Now see if the Reassembler has anything to do.  Call it if so.

	LOAD T4,QNEXT,<+TCBRPQ(TCB)> ; Must be a pkt queued!
	SETSEC T4,INTSEC	; Make extended address
	LOAD T2,PESEQ,(T4)	; Fetch end sequence for what follows
	LOAD T3,PIDO,(T4)	; Internet data offset
	XMOVEI T4,PKTELI(T4)	; Pointer to Internet portion
	ADD T4,T3		; Pointer to TCP portion
	LOAD T3,PCTL,(T4)	; Get word containing control bits
	TXNE T3,<PSYN!PFIN>	; Some kind of control?
         JRST PRCP11		; Yes.  RA must process it now.
	JN TRCB,(TCB),PRCP11	; Maybe there is a partially filled buffer
	JN TTVT,(TCB),PRCP11	; No normal buffers for TVTs
	LOAD T1,QNEXT,<+TCBRBQ(TCB)> ; Pointer 1st buffer on queue
	CAIN T1,TCBRBQ(TCB)	; Empty?
         JRST PRCPKX		; Yes.  RA cannot do anything.
PRCP11:	MOVE T3,T2		; Recover end sequence
	LOAD T1,PSYN,(TPKT)	; If have a SYN, TRLFT already increased
	ADD T3,T1		; so increase right too
	MODSEQ T3
	LOAD T1,PSEQ,(T4)	; Get sequence number of pkt
	LOAD T2,TRLFT,(TCB)	; Recv Left is the point of reassembly
	CALL CHKWND		; Did this packet fill the hole?
	JUMPE T1,PRCPKX		; Jump if not.  No need to run RA.
	$SIGNL(RA,0)		; Make Reassembler run now
	EXIT PRCPKX

; Here with packet which cannot be processed further.  Release storage.

PRCPKR:	TDNE T1,INTTRC		; Want trace? (PT%TID,PT%TRS)
	  CALL PRNPKT		; Yes
	MOVX T1,PT%XX6		; "Flushed by IP" code
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Call Packet Printer
	CALL RETPKT		; Give back to free storage
PRCPKX:	RESTORE
	RET
;REMCHK
;Check  whether  incoming  packet  contains  a packet on a reassembly
;queue. If so, delete the Q'd packet.

;T1/	NOT EXTENDED pointer to packet on a reassembly queue
;PKT/	(Extended) Internet Packet Pointer (incoming pkt)
;TPKT/	(Extended) TCP Packet Pointer (incoming pkt)
;TCB/	(Extended) Locked connection block
;	CALL REMCHK
;Ret+1:	Always.  T1 -1 if packet was deleted or 0 otherwise.

REMCHK:	LOCAL <QPKT>		; Holds pointer to queued packet
	MOVEM T1,QPKT
	SETSEC QPKT,INTSEC	; Make extended address
	LOAD T3,PIDO,(QPKT)	; Number of words of IN header
	XMOVEI T4,PKTELI(QPKT)	; Pointer to Internet portion
	ADD T4,T3		; Pointer to TCP portion
	LOAD T1,PSEQ,(T4)	; Start of queued packet
	LOAD T2,PESEQ,(QPKT)	; End + 1 of queued packet
	LOAD T3,PESEQ,(PKT)	; End + 1 of Pkt being processed
	LOAD T4,PSEQ,(TPKT)	; Start of packet being processed
	CAMN T1,T4		; Quick check for exact duplicate
	 CAME T2,T3		; (Faster than OVRLAP)
	  CAIA			; Have to use OVRLAP to be sure
	   TDZA T1,T1		; Fake false return from OVRLAP
	    CALL OVRLAP		; See if QPKT has something PKT does not
	JUMPN T1,REMCH9		; Jump if so.  Must keep both.
	MOVE T1,QPKT		; This packet is extra baggage.
	CALL DQ			; Remove it from the queue.
	PUSH P,PKT
	MOVE PKT,T1		; Put pointer in standard place
	MOVX T1,PT%TDR
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	CALL RETPKT		; Give up possibly full-size packet
	POP P,PKT
	SKIPA T1,[-1]		; Return true to say something was done
REMCH9:  SETZ T1,		; Return false to say nothing was done
	RESTORE
	RET
;PRCRST
;Process a RESET packet

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL PRCRST
;Ret+1:	always

PRCRST:	AOS RSTRCT		; Count RSTs received
	LOAD T1,TSSYN,(TCB)	; Send state
	LOAD T2,TRSYN,(TCB)	; Recv state
	CAIN T1,FINSNT
	 CAIE T2,NOTSYN
	  JRST PRCRS1

; S-FINSNT, R-NOTSYN		; PKT always have ACK??

	LOAD T1,PACKS,(TPKT)	; ACK Sequence from packet
	CALL PRCACK		; Process it.
	EXIT PRCRSX

PRCRS1: JRST PRCRS2		; prevent hanging when SYNAGN forgets user open timeout
	JN TSOPN,(TCB),PRCRS2	; Jump if user thinks connection is open
	JE TSPRS,(TCB),PRCRS2	; Give error if not persistent
	CALL SYNAGN		; Start over.
	EXIT PRCRSX

PRCRS2:	MOVX T1,EFP+^D7		; "Connection RESET"
	CALL USRERR		; Tell user.
	MOVX T1,EFP+^D7		; "Connection RESET"
	CALL ABTCON		; Abort the connection.  Flush bufs etc

PRCRSX:	RET
;PRCWND
;Process Window Information from incoming packet

;We  desire  the  most  recently sent information to be that which is
;acted on. Since retransmitted packets have more current  information
;than  when  they were originally transmitted, the packet sequence is
;not a good basis for deciding if a  given  packet  has  more  recent
;info.  In  order  to  prevent  lockups,  window  information must be
;processed out of sequence.

;(PKT/	(Extended) Internet Packet Pointer)
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL PRCWND
;Ret+1:	always.

PRCWND:	LOAD T1,TSWND,(TCB)	; The current window
	LOAD T2,PWNDO,(TPKT)	; The new window
	STOR T2,TSWND,(TCB)	; Set into the TCB
	JUMPN T1,PRCWNX		; Exit if window not closed previously
	JUMPE T2,PRCWNX		; Or not now open

; Window opened

	LOAD T3,PACKS,(TPKT)	; Get the ACK Sequence from the packet
	LOAD T4,TSLFT,(TCB)	; and Send Left from TCB
	CAME T3,T4		; Re-request for Left?
	  EXIT PRCWNX		; No.
	LOAD T1,QNEXT,<+TCBRXQ(TCB)>
	CAIN T1,TCBRXQ(TCB)	; Retransmit queue empty?
	  EXIT PRCWNX		; Yes.  No need for retranmitter to run
	$SIGNL(RX,0)		; Make Retransmitter run now
PRCWNX:	RET
;PRCACK
;Delete acknowledged send data

;Called  from  IP  while  processing incoming packets and by BG if it
;needs to fake an ACK for a FIN.

;T1/	ACKnowledge sequence
;TPKT/	(Extended) TCP Packet Pointer (for PRCWND)
;TCB/	(Extended) Locked Connection block
;	CALL PRCACK
;Ret+1:	always

PRCACK:	LOCAL <ACKSEQ,LEFT,OLDR>
	MOVEM T1,ACKSEQ		; Save in good place
	LOAD T2,TSLFT,(TCB)	; Send Left
	MOVEM T2,LEFT		; Save in safe place
	EXCH T1,T2		; Put in desired ACs for CHKWND below
	LOAD T3,TSSEQ,(TCB)	; Get the current Send Sequence
	ADDI T3,1
	MODSEQ T3
	CALL CHKWND		; ACKs something outstanding?
	JUMPE T1,PRCACX		; Do no more if not

; Process Urgent

	JE TSURG,(TCB),PRCAC0	; Skip following if not in urgent send mode
	MOVE T1,LEFT		; Send left
	LOAD T2,TSURP,(TCB)	; Send urgent pointer
	SUBI T2,1		; Consider ACKd if ACK=URP
	MODSEQ T2		; Worry about 32-bit arithmetic
	MOVE T3,ACKSEQ		; Number being acknowledged
	CALL CHKWND		; See if URP is being ACKd
	JUMPE T1,PRCAC0		; Jump if not
	SETZRO TSURG,(TCB)	; Leave urgent send mode
PRCAC0:

; Process window

	MOVE OLDR,LEFT		; Old Send Left
	LOAD T1,TSWND,(TCB)	; Old Send Window
	ADD OLDR,T1		; Compute Old Send Right
	MODSEQ OLDR
	CALL PRCWND		; Process Window info in packet
				; (TSWND = PWNDO, maybe RX)
	STOR ACKSEQ,TSLFT,(TCB)	; ACK Sequence is our Send Left
; Process unACKed SYN

	LOAD T1,TSSYN,(TCB)	; Send State
	CAIE T1,SYNSNT
	  JRST PRCAC2		; No unACKd SYN to handle
	MOVX T1,SYNCED
	STOR T1,TSSYN,(TCB)	; Set fully synched state on send side
	LOAD T2,TRSYN,(TCB)	; Recv state
	CAIE T2,SYNRCV
	  JRST PRCAC1
	STOR T1,TRSYN,(TCB)	; Make receive side open too
	JN TTVT,(TCB),PRCA0A	; Avoid RA since TVT not assigned
	$SIGNL(RA,0)		; Make RA remove any dangling SYN pkt
PRCA0A:
	MOVX T1,OK		; General success code
	CALL USREVT		; Pass the event to the user
PRCAC1:				; (No TVT error needs work here)
	JE TRPP,(TCB),PRCAC2	; If there is no partial pkt in RA
	$SIGNL(RA,0)		; Make Reassembler run now
PRCAC2:
	STOR ACKSEQ,TSLFT,(TCB)	; ACK Sequence is our Send Left
	MOVEI T1,TCBRXQ(TCB)	; Retransmit queue
	SETSEC T1,INTSEC	; Make extended address
	MOVE T2,LEFT		; Old Left
	MOVE T3,ACKSEQ		; New Left
	SETZ T4,		; A send queue is being processed
	CALL REMSEQ		; Delete ACKed packets

;Now  that  the  new  Send  Window location and extent have been set,
;determine if the Packetizer should be started. This means there must
;be something waiting to be sent and window space to send it  in  and
;the connection state must be right.

	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIE T1,SYNCED		; Fully synchronized?
         JRST PRCAC4		; No.  Don't start PZ

;Test for waiting output on TCP Virtual Terminal connection

	JE TTVT,(TCB),PRCA34	; Jump if not a TVT
	LOAD T2,TVTL,(TCB)	; Get the line number of the TVt
	JUMPE T2,PRCAC4		; Jump if not assigned yet
	CALL LCKTTY		; Lock TTY & NOINT
         JUMPLE T2,PRCA33	; Inactive or becoming active
	PUSH P,T2		; Save the line block addr
	IFE REL6,<CALL TVTOSP>	; Find out if anything waiting to go
	IFN REL6,<CALLX (MSEC1,TVTOSP)> ; Find out if anything waiting to go
	POP P,T2		; Recover addr of line block
	SKIPA
PRCA33: MOVX T1,0		; No TTY means no characters
	PUSH P,T1		; Save the count
	CALL ULKTTY		; Unlock TTY & OKINT
	POP P,T1		; Get back the count
	JUMPG T1,PRCA35		; Something to be sent.  See if OK
	JRST PRCAC4		; Nothing to be sent.
PRCA34:				; Here to test for waiting output on a
				; normal TCP data connection
	JN TSCB,(TCB),PRCA35	; Jump if something wait to be sent
	LOAD T1,QNEXT,<+TCBSBQ(TCB)>
	CAIN T1,TCBSBQ(TCB)	; Any queued from user?
         JRST PRCAC4		; Nothing to be sent
PRCA35:
;Connection state is right and there is something waiting to be sent

	LOAD T1,TSLFT,(TCB)	; Get new Send Left
	LOAD T2,TSSEQ,(TCB)	; Get current Send Sequence
	SUB T2,T1		; Bytes used in send window
	MODSEQ T2		; (Must be .ge. 0)
	LSH T2,2		; 4 * Used
	LOAD T3,TSWND,(TCB)	; Get new Send Window
	IMULI T3,3		; 3 * Offered window
	CAMGE T2,T3		; If Used/Offered .lt. 3/4
	 CALL FRCPKT		; Run PZ, but after RA
PRCAC4:

;See  if  packets  which  might have been made untransmittable due to
;Send Right moving backwards have now  become  transmittable.  If  so
;start  the Retransmitter. This is due to the "PUSH problem" in which
;the sender has no idea of  the  size  of  the  receive  buffers  and
;therefore  cannot  tell  how  many sequence number slots a PUSH will
;absorb.

	LOAD T1,QNEXT,<+TCBRXQ(TCB)>
	CAIN T1,TCBRXQ(TCB)	; Any packets on retransmit queue?
	  JRST PRCACX		; No
	MOVE T1,LEFT		; Old Left before ACK
	MOVE T2,OLDR		; Old right, before this ACK
	LOAD T3,TSSEQ,(TCB)	; Current send sequence
	CALL CHKWND		; Any pkts cutoff?
	JUMPE T1,PRCACX		; Jump if not
	MOVE T1,OLDR		; Right before this ACK,WND processed
	MOVE T2,ACKSEQ		; New Left due to this ACK
	LOAD T3,TSSEQ,(TCB)	; Current send sequence
	CALL CHKWND		; See if ACK has exposed any pkts
	JUMPE T1,PRCACX		; Jump if not
	XMOVEI T1,RX		; What to signal -- the retransmitter
	MOVX T2,0		; When to run it -- now
	CALL SIGNAL		; But after we finish here
PRCACX:	RESTORE
	RET
;PRCURG
;Process URGENT pointer from packet

;TCB/	(Extended) pointer to locked connection block
;(PKT/	(Extended) pointer to packet)
;TPKT/	(Extended) pointer to TCP portion of packet
;	CALL PRCURG
;Ret+1:	Always.

PRCURG:	LOCAL <URGPTR>
	LOAD URGPTR,PSEQ,(TPKT)	; Sequence number of packet
	LOAD T1,PURGP,(TPKT)	; Offset to urgent pointer
	ADD URGPTR,T1		; Compute actual urgent pointer
	MODSEQ URGPTR		; Reduce to the right number of bits
	JN TRURG,(TCB),PRCUR1	; Already in urgent receive mode?
	STOR URGPTR,TRURP,(TCB)	; No.  Set receive urgent pointer
	SETONE TRURG,(TCB)	; Mark it as valid.
	CALL USRURG		; Signal user of urgent data waiting
	EXIT PRCURX

PRCUR1:	LOAD T1,TRLFT,(TCB)	; Receive Left pointer
	MOVE T2,URGPTR		; What packet says pointer is
	LOAD T3,TRURP,(TCB)	; Current Urgent pointer
	CALL CHKWND		; See if urgent pointer is "bigger"
	JUMPN T1,PRCURX		; Nothing to do if not
	STOR URGPTR,TRURP,(TCB)	; Update receive urgent pointer
PRCURX:	RESTORE
	RET
;PRCSYN
;Process SYN in incoming packet

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	(Extended) Locked connection block
;	CALL PRCSYN
;Ret+1:	always

PRCSYN:	LOAD T1,TRSYN,(TCB)	; Get receive state
	CAIN T1,FINRCV		; Ignore SYN if FIN Received
         EXIT PRCSYX
	LOAD T2,TSSYN,(TCB)	; Get send state
	CAIE T2,SYNCED		; Send sync established?
         JRST PRCSY2		; No.

; S-SYNCED (Recv'd ACK, maybe this packet)

	MOVX T1,SYNCED
	STOR T1,TRSYN,(TCB)	; Make the state "synchronized" (syn.syn)
	MOVX T1,OK		; General success event code
	CALL USREVT		; Tell the user connection is open now
	JRST PRCSY3

; S-not synced (& not in this packet)

PRCSY2:	MOVX T1,SYNRCV		; SYN Received state
	STOR T1,TRSYN,(TCB)	; is new Receive state
	LOAD T2,PWNDO,(TPKT)	; Extract the window
	STOR T2,TSWND,(TCB)	; That is the (first) send window for us
PRCSY3:
	LOAD T1,PSEQ,(TPKT)	; Get the packet sequence number
	STOR T1,TRIS,(TCB)	; Save for filtering duplicate SYNs
	STOR T1,TRURP,(TCB)	; Not in urgent receive mode
	ADDI T1,1		; Advance Recv.Left over SYN
	MODSEQ T1
	STOR T1,TRLFT,(TCB)	; That is the first Left for us

; If the Reassembler will not see this packet, get an ACK for it now.
; Otherwise, see to it that one is eventually generated.

	LOAD T1,PIPL,(PKT)	; Total Internet packet length in octets
	LOAD T2,PIDO,(PKT)	; Data offset in 32-bit words
	LOAD T3,PTDO,(TPKT)	; TCP data offset in 32-bit words
	ADD T2,T3		; Compute total header length
	ASH T2,2		; In bytes
	CAMLE T1,T2		; Is there any data in TCP portion?
	  JRST PRCSY4		; Yes.  RA must see it.
	LOAD T1,PCTL,(TPKT)	; Get word containing control flags
	TXNE T1,<PFIN!PEOL>
	  JRST PRCSY4		; RA must see these
	CALL FRCPKT		; Force an ACK, now.
	JRST PRCSY5

PRCSY4:	MOVE T1,TCPRA0		; Time to wait for RA
	CALL ENCPKT		; Encourage an ACK in the future
PRCSY5:	AOS SYNRCT		; Count SYNs received
PRCSYX:	RET
;SNDRST
;Send a RESET Response to the Foreign TCP.

;PKT/	(Extended) Internet Packet Pointer
;TPKT/	(Extended) TCP Packet Pointer
;TCB/	0 or (Extended) connection block
;	CALL SNDRST		Beware of routing options
;Ret+1:	always

SNDRST:	SAVEAC <TCB,PKT,TPKT>
	STACKL <<ADR,4>>
	LOCAL <PKTACK,ENDPKT>
	LOAD T1,PISH,(PKT)	; Extract source of packet
	LOAD T2,PIDH,(PKT)	; Get number he knew me by
	LOAD T3,PSP,(TPKT)
	LOAD T4,PDP,(TPKT)	; and destination port
	DMOVEM T1,ADR		; Swap into address block
	DMOVEM T3,2+ADR
	LOAD ENDPKT,PESEQ,(PKT)	; Get the end of the packet (plus 1)
	SETZ T1,		; Assume no ack
	JE PACK,(TPKT),SNDRS0	; Jump if no ack
	LOAD T1,PACKS,(TPKT)	; Extract the ACK Sequence from PKT
SNDRS0:	MOVEM T1,PKTACK		; Save for our SEQ

;Now we have tucked away all we need from the incoming packet.

	SETZB T1,TCB		; Min packet & no data & no TCB
	XMOVEI T2,ADR		; Address block
	CALL TCPIPK		; Get packet & initialize header
	  JRST SNDRSX		; Error.  Other end will try again.
	SETONE PRST,(TPKT)	; Set the RST bit
	STOR ENDPKT,PACKS,(TPKT); Arrange to ACK all of the input packet
	SETONE PACK,(TPKT)	; Set the ACK bit
	MOVE T1,PKTACK		; ACK Sequence from packet
	JUMPE TCB,SNDRS1	; if there is no TCB
	LOAD T1,TSSEQ,(TCB)	; Else use the right thing
SNDRS1:
	STOR T1,PSEQ,(TPKT)	; As the Packet Sequence number
	MOVE T1,TODCLK		; "Now"
	STOR T1,PTG,(PKT)	; Store as Time Generated
	CALL TCPCKS		; Compute TCP packet checksum
	STOR T1,PTCKS,(TPKT)	; Set into packet
	MOVX T1,PT%XX2		; Fake OP
	SKIPN TCB
	  MOVX T1,PT%XX7
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Call the packet printer
	MOVX T1,PT%TIR
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	AOS RSTSCT		; Count errors sent
	AOS PZPKCT		; Count Packetized packets
	AOS OPPKCT		; Count Output packets
IFN IPPDSW,<
	XMOVEI T1,OPDLAY	; Select OP Delay Histogram
	SKIPE STATF		; Avoid overhead if not taking stats
	  CALL TSTAMP>		; Process the timestamp
	CALL SNDGAT		; Send it to gateway. (NB: PPROG is 0)
SNDRSX:	RESTORE
	RET
;REMSEQ
;Remove packets from a queue which are between Left and Right

;T1/	(Extended) Queue head pointer
;T2/	Left
;T3/	Right
;T4/	Receive Queue Flag (0 is SEND is TCBRXQ)
;TCB/	(Extended) Locked connection block
;	CALL REMSEQ
;Ret+1:	always

REMSEQ:	SAVEAC <PKT,TPKT>
	STACKL <NEXTRX,RECVF>
	LOCAL <Q,LEFT,RIGHT,NEXT>
	DMOVEM T1,Q		; T1,T2 to Q,LEFT
	MOVEM T3,RIGHT		; T3 to RIGHT
	MOVEM T4,RECVF
	HRLOI T1,377777		; Infinity
	MOVEM T1,NEXTRX		; is first quess at next RX time
	LOAD NEXT,QNEXT,(Q)	; Get first thing on Queue (if any)
	SETSEC NEXT,INTSEC	; Make extended address
REMSE1:	MOVE PKT,NEXT		; Get the current pkt to standard place
	LOAD NEXT,QNEXT,(PKT)	; Set for next time
	SETSEC NEXT,INTSEC	; Make extended address
	CAMN PKT,Q		; Is this the queue Head?
         JRST REMSE7		; Yes. Done.  Whole queue scanned.
	MOVE T1,LEFT
	LOAD T2,PESEQ,(PKT)	; End of packet plus one
	SUBI T2,1		; Seq. Num of last byte in packet
	MODSEQ T2
	MOVE T3,RIGHT
	CALL CHKWND		; Is end of packet within the window?
	JUMPN T1,REMSE2		; Yes.  Go delete the packet.
	LOAD T1,PXT,(PKT)	; Get the Transmit time
	LOAD T2,PRXI,(PKT)	; and current Retransmit interval
	ADD T1,T2		; Time of next retransmit
	CAMG T1,NEXTRX		; MIN with last time of next RX
	MOVEM T1,NEXTRX
	JRST REMSE1		; Continue scanning the queue
REMSE2:	MOVE T1,PKT
	CALL DQ			; Dequeue the packet from the queue
	SKIPE RECVF		; Processing receive packet queue?
	  JRST REMSE6		; Yes

; Send Queue

	LOAD T1,PIDO,(PKT)	; Number of words in the IN header
	XMOVEI TPKT,PKTELI(PKT)	; Pointer to Internet portion
	ADD TPKT,T1		; Pointer to TCP portion

; ACK of FIN

	JE PFIN,(TPKT),REMSE4	; Skip this part if not ACK of FIN
	MOVX T1,NOTSYN		; Not Synchronized state (dead)
	STOR T1,TSSYN,(TCB)	; Set into TCB
	LOAD T1,TRSYN,(TCB)	; Get receive state
	CAIE T1,NOTSYN		; Also closed?
	  JRST REMSE4
	SKIPE INTSCR		; Running in Secure mode?
	  CALL SCRCLS		; Yes.  Send a Secure Close Option
	MOVX T1,XLP+^D3		; "CLOSED" event code
	CALL USREVT		; Pass the word to the user
REMSE4:

;Update  estimate  of  round  trip  time.  Instead of discarding RX'd
;packets, include them in the sum... If the  original  is  not  being
;ACKed,  then  a packet was lost so something is probably overloaded,
;slow down RX in either case

	MOVE T1,TODCLK		; "Now"
	LOAD T2,PTG,(PKT)	; Time packet was originally generated
	SUB T1,T2		; How long it took to ACK it
	JE <TRXPN,TRXPD>,(TCB),REMSE5 ; Newer algorithm
	LOAD T2,TMNRT,(TCB)	; Min Round Trip time
	CAMGE T1,T2		; Is this one shorter?
	  STOR T1,TMNRT,(TCB)	; Save new min
	LOAD T2,TMXRT,(TCB)	; MAX Round Trip time
	CAMLE T1,T2		; Is this longer?
	  STOR T1,TMXRT,(TCB)	; Save new max
	JRST REMSE6
REMSE5:	LOAD T4,TSMRT,(TCB)	; Current estimate
	MOVE T3,T4
	LSH T3,2
	MOVX T2,1
	MOVNI T3,@TCPRXF	; Positive scale factor
	LSH T2,(T3)		; Scaled 1.0
	SUB T2,TCPRXS		; Scaled (1-alpha)
	IMUL T1,T2		; RTT*(1-alpha)
	IMUL T4,TCPRXS		; SRTT*alpha
	ADD T1,T4
	LSH T1,@TCPRXF		; New estimate of round trip time
	STOR T1,TSMRT,(TCB)
REMSE6:				; Both Send and Receive Queues
	SETZRO PPROG,(PKT)	; Say no need for Pkt at program level
	JN PINTL,(PKT),REMSE1	; Jump if interrupt will do the INTRBF
	MOVX T1,PT%TDR
	SKIPN RECVF
	  MOVX T1,PT%TDX
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	CALL RETPKT		; Return the storage to free area
	JRST REMSE1		; Go look at more of the queue

REMSE7:	SKIPE RECVF		; Processing send retransmit queue?
	  JRST REMSEX		; No
	CAMN PKT,NEXT		; Queue empty now?
	  JRST REMSE8		; Yes.
	XMOVEI T1,RX		; Select the Retransmitter
	MOVE T2,NEXTRX		; Computed next retransmit time
	SUB T2,TODCLK		; Convert to increment
	CALL SIGNAL		; Make the retransmitter run then
	JRST REMSEX

REMSE8:	MOVEI T1,TCBQRX(TCB)
	SETSEC T1,INTSEC

REMSEX:	RESTORE
	RET
;ABTCON
;Abort a connection

;Clears  queues  and forces send and receive buffers back to the user
;with the (argument) Code. The connection is set to Not Synchronized.

; Called both from PRCRST and from the ABORT JSYS.
;TCB/	(Extended) Locked Connection Block
;T1/	Event Code	(ELP+^D14 - reset)
;			(ELT+^D4  - no free TVTs)
;	CALL ABTCON
;Ret+1:	always

ABTCON::
	SAVEAC <PKT>
	LOCAL <CODE>
	MOVEM T1,CODE

;Buffers flushed via USRBFE/F are placed onto the TCPDBQ by BFRDUN if
;the  have  wait  bits  assigned  (for  wait or interrupt) others are
;returned directly to free storage.

	CALL FLSSBF		; Flush SEND buffers
	MOVE T1,CODE
	CALL FLSRBF		; Flush RECV buffers

; Flush packets from Retransmission Queue

ABTCOA:	LOAD T1,QNEXT,<+TCBRXQ(TCB)>	; Get first thing on Retrans Q
	CAIN T1,TCBRXQ(TCB)	; Is that the head itself?
	  JRST ABTCOB		; Yes.  The queue is now empty.
	SETSEC T1,INTSEC	; Make extended address
	CALL DQ			; Remove from the Retransmission queue
	SETZRO PPROG,(T1)	; Program level now has no claim on PKT
	JN PINTL,(T1),ABTCOA	; Jump if INTRBF will return the space
	MOVE PKT,T1		; Put pointer in right place for RETPKT
	CALL RETPKT
	JRST ABTCOA

;Flush packets from Received Packet Queue

ABTCOB:	LOAD T1,QNEXT,<+TCBRPQ(TCB)>
	CAIN T1,TCBRPQ(TCB)
	  JRST ABTCOC
	SETSEC T1,INTSEC	; Make extended address
	CALL DQ
	MOVE PKT,T1
	CALL RETPKT
	JRST ABTCOB
ABTCOC:
;Flush any Partially Filled Packet

	NOSKED
	LOAD PKT,TSCPK,(TCB)	; Possible packet
	SETZRO TSCPK,(TCB)	; is gone
	OKSKED
	SKIPE PKT		; IF have one
	  CALL RETPKT		; release it

; Collect buffers for this TCB from TCPBDQ and place them on TCPIDQ.
; Then release them all.

	NOSKED			; Prevent user from snatching bufs
	MOVE T1,TCPIDQ
	CALL ABTCO1		; Collect up all dead ones
	OKSKED
	MOVE T1,TCPIDQ
	MOVE T2,T1
	CALL CLEARQ		; Return all to free storage

; Force state to NOT.NOT

	MOVX T1,NOTSYN
	STOR T1,TSSYN,(TCB)	; Set Send state to Not Synchronized
	STOR T1,TRSYN,(TCB)	; Set Recv state to Not Synchronized

; Notify the user

	MOVE T1,CODE
	CALL USREVT		; Pass the event to the user

; Maybe need a secure close

	SKIPE INTSCR		; Running in Secure mode?
	  CALL SCRCLS		; Send a Secure Close Option
	RESTORE
	RET
;ABTCO1(Q)
;Release buffers from Buffer Done Queue.

;T1/	(Extended) Pointer to a queue head
;TCB/	(Extended) Locked connection block
;NOSKED				How do we know they are finished??
;	CALL ABTCO1
;Ret+1:	Always.  No buffers on DEADBQ owned by TCB; BIDX bits released

ABTCO1:	SAVEAC <BFR>
	LOCAL <NXTBFR,DEADBQ>
	MOVEM T1,DEADBQ
	MOVE NXTBFR,TCPBDQ	; Pointer to queue head
ABTCO2:	MOVE BFR,NXTBFR
	LOAD NXTBFR,QNEXT,(BFR)	; Get next item on the list
	SETSEC NXTBFR,INTSEC	; Make extended address
	CAMN BFR,TCPBDQ		; Back to head means done
         JRST ABTCOX
	LOAD T1,BTCB,(BFR)	; Get owning TCB
	SETSEC T1,INTSEC	; Make extended address
	CAME T1,TCB		; It is this connection?
         JRST ABTCO2		; Go try next
	MOVE T1,BFR		; Pointer to the item
	CALL DQ			; Remove it
	LOAD T1,BIDX,(BFR)	; Get the wait bit index
	CALL RELWTB		; Release it
	MOVE T1,BFR		; Pointer to the block again
	MOVEI T2,DEADBQ		; Where to stash the buffer for later
	CALL NQ			; Release when not NOSKED
	JRST ABTCO2

ABTCOX:	RESTORE
	RET
;SYNAGN
;Return a connection to Synchable state

;TCB/	(Extended) Locked Connection Block
;	CALL SYNAGN
;Ret+1:	always

SYNAGN:	SAVEAC <BFR,PKT>
	CALL RSTADR		; Restore wild address fields

;Moving Send Left to Send Sequence makes the next incarnation of this
;connection  different  from  the  one  which  has just failed and is
;getting resynched. Thus, RSTs caused by old copyies of the  original
;SYN will be unacceptable and will not wipe out the new incarnation.

	LOAD T1,TSSEQ,(TCB)	; Send sequence = SYN + DATA
	STOR T1,TSLFT,(TCB)	; Where to begin next time.
	MOVX T1,SYNABLE
	STOR T1,TRSYN,(TCB)	; Reset the Recv state
	LOAD BFR,TRCB,(TCB)	; Get current receive buffer
	JUMPE BFR,SYNAG1	; Jump if no receive current buffer
	SETSEC BFR,INTSEC	; Make extended address
	SETZRO TRCB,(TCB)	; Forget about it
	CALL RSTBFR		; Reset it to virgin state (hard to do)
	MOVE T1,BFR		; What to NQ
	MOVEI T2,TCBRBQ(TCB)	; The receive buffer queue
	SETSEC T2,INTSEC	; Make extended address
	LOAD T2,QNEXT,(T2)	; First thing on the queue
	SETSEC T2,INTSEC	; Make extended address
	CALL NQ			; Make the recycled buffer first again
SYNAG1:
	SETZRO TRPP,(TCB)	; Forget about partially processed PKT
SYNAG2:	LOAD T1,QNEXT,<+TCBRPQ(TCB)>	; Receive Packet Queue
	CAIN T1,TCBRPQ(TCB)	; Empty now?
         JRST SYNAG3		; Yes
	SETSEC T1,INTSEC	; Make extended address
	CALL DQ			; Dequeue the packet
	MOVE PKT,T1		; Put in standard place
	CALL RETPKT		; Return possibly full size packet
	JRST SYNAG2
SYNAG3:
	MOVX T1,SYNABL
	STOR T1,TSSYN,(TCB)	; Reset Send state
	LOAD BFR,TSCB,(TCB)	; Get current send buffer
	JUMPE BFR,SYNAG4	; Jump if none
	SETSEC BFR,INTSEC	; Make extended address
	SETZRO TSCB,(TCB)	; Forget there was one
	CALL RSTBFR		; Reset the buffer
	MOVE T1,BFR
	MOVEI T2,TCBSBQ(TCB)	; Send buffer queue
	SETSEC T2,INTSEC	; Make extended address
	LOAD T2,QNEXT,(T2)	; First thing on the queue
	CALL NQ			; Make recycled buffer first again
SYNAG4:
	PUSH P,Q1		; save this AC
	XMOVEI Q1,TCBRXQ(TCB)	; Retransmit queue
SYNAG5:	LOAD T1,QNEXT,(Q1)	; Get next item
	SETSEC T1,INTSEC	; Make extended address
	CAMN T1,Q1		; Qhead point to self?
	 JRST SYNAG6		; Yes, done
	CALL DQ			; No, dequeue item
	PIOFF			; Keep flags from changing
	SETZRO PPROG,(T1)	; Program isnt keeping this anymore
	LOAD T2,PINTL,(T1)	; Get int-level-has-pkt flag
	PION			; We are safe
	SKIPN T2		; Does (or did) int-level have it?
	 CALL RETBLK		; No, return it
	JRST SYNAG5		; Loop till Q empty
SYNAG6:	POP P,Q1		; Restore this AC
	JE TSPRS,(TCB),SYNAGX	; Check if this end is initiator
	JN <TWLDN,TWLDT,TWLDP>,(TCB),SYNAGX	; Don't send if no 4N host
	MOVE T1,TCPSY0		; 2 second delay to prevent loop if
	CALL DLAYPZ		; Foreign TCB non-x and RST causing us to loop
SYNAGX:	RET
;RSTADR(TCB)
;Restore wild address fields

;A delayed duplicate may cause a foreign TCP to emit an RST packet to
;kill  what  it thinks is a half-open connection here. If in fact the
;connection has been closed and deleted, there may be a listening TCB
;which  CHKADD  will  find  and  bind  to  the  source  of  the  RST.
;Subsequently the TCP will just flush the RST and will not  emit  any
;response  to  it.  This  routine  is  called  to  undo the temporary
;binding.

;TCB/	(Extended) Locked connection block
;	CALL RSTADR
;Ret+1:	Always.

RSTADR:	LOAD T1,TOPLH,(TCB)	; Restore original local host
	STOR T1,TLH,(TCB)
	LOAD T1,TOPFH,(TCB)	; Restore original foreign host
	STOR T1,TFH,(TCB)
	LOAD T1,TOPFP,(TCB)	; Restore original foreign port
	STOR T1,TFP,(TCB)
	SETZRO TIPOR,(TCB)	; No received IP option count
	SETZM TCBIR(TCB)	; Nor data
	SETZRO TTPOR,(TCB)	; No received TCP option count
	SETZM TCBTR(TCB)	; Nor data
	SETO T1,		; Don't change options
	CALL TCPUOP		; But re-merge
	SETZ T1,
	CALL TCPMXP		; Undo max packet size
	RET
;IPINI
;Initialize IP process block

;	CALL IPINI
;Ret+1:	Always

IPINI:	LOCAL <PRC>
	XMOVEI PRC,IP		; Pointer to process block

; Following are guards against really bad things

	SETZM PRCQ(PRC)		; Be sure queue is empty.
	SETZM PRCLCK(PRC)	; Should never try to lock IP lock!
	SETZM PRCWAK(PRC)	; Be sure to run it promptly!
	SETZM PRCQOF(PRC)	; Clear unused cells
	SETZM PRCWOF(PRC)
	XMOVEI T1,INPROC	; Routine address
	MOVEM T1,PRCROU(PRC)	; Set into the control block
	XMOVEI T1,IPRNCT	; Run counter address
	MOVEM T1,PRCRNC(PRC)
	XMOVEI T1,IPUSE		; CPU usage meter
	MOVEM T1,PRCTMR(PRC)
	MOVX T1,QSZ		; Size of a queue head
	CALL GETBLK		; Queue head must be in Internet section
	  JUMPE T1,IPINIX	; Lose, need better way (lose memory)
	MOVEM T1,TCPIDQ		; Save pointer to it
	CALL INITQ		; Initialize it
	HRROI T1,-1
IPINIX:	RESTORE
	RET
	SUBTTL	TCP Reasembler

COMMENT	!

The  REASEMBLER  is  called  with  TCB  set up to point at a (locked)
connection block. Its function  is  to  transfer  data  from  packets
queued  for it by the Inputprocessor into user buffers queued by RECV
calls on the TCP. The REASEMBLER also processes certain control  bits
in  the packets such FIN. Once handled, the PACKETIZER is signaled so
that it may generate an ACK for  the  packet.  TCP  Virtual  Terminal
characters  are  moved  into  line  buffers  via  the TELNET protocol
routines in the NVT code.

!
;REASEM
;Reasembler.

;TCB/	(Extended) Pointer to connection block
;	CALL REASEM
;Ret+1:	always

REASEM:	SAVEAC <PKT,TPKT,BFR>
	LOCAL <BYTNUM,XFRCNT,RCVLFT,LINBLK>
	SETO LINBLK,		; Indicate no terminal line locked
				; <0 must check TTVT, not locked
				;    (NOTSYN or no TVT assigned)
				; =0 non-standard, locked
				; >0 have TTVT (& TVTL & R-SYNCED) & locked
	JE TTVT,(TCB),REASMN	; Jump if not a TCP Virtual Terminal
	LOAD T1,TRSYN,(TCB)	; State of receive side
	CAIE T1,SYNCED		; OK to pass data now?
	  JRST REASMN		; No.  But process control
	LOAD T2,TVTL,(TCB)	; Get the line number
	JUMPE T2,REASMN		; Jump if none assigned yet or gone away
	IFE REL6,<CALL TVTCHK>	; Lock the terminal data base
	IFN REL6,<CALLX (MSEC1,TVTCHK)> ; Lock the terminal data base
	  JRST [JUMPLE T2,REASMN ;Nothing locked (inactive, becoming active)
		SETZ T2,	; Locked & non-standared so
		JRST .+1]	; must update LINBLK
	MOVEM T2,LINBLK		; Save here for later
REASMN:

; Top of main loop:
; Check the queue of packets from the InputProcessor.  If there are
;  no packets, there is nothing that the Reassembler can do.

REASM0:	LOAD PKT,QNEXT,<+TCBRPQ(TCB)> ; Get pointer to first thing on Q
	CAIN PKT,TCBRPQ(TCB)	; Receive packet queue empty?
	  JRST REASMX		; Yes.  Get out.
	SETSEC PKT,INTSEC	; Make extended address
	LOAD T1,PIDO,(PKT)	; Internet data offset in words
	XMOVEI TPKT,PKTELI(PKT)	; Pointer to Internet portion of packet
	ADD TPKT,T1		; Pointer to TCP portion of packet
; Set BFR to 0 if this is a TVT so as to avoid code which
; fiddles with normal buffers.

	JE TTVT,(TCB),REAS0A	; If not TVT go get BFR
	MOVX BFR,0		; Indicate no normal buffer
	SKIPG T2,LINBLK		; Set arg.
	  JRST REAS0A		; Not a TVT or gone away
	IFE REL6,<CALL TVTISP>	; Get space in input buffer
	IFN REL6,<CALLX (MSEC1,TVTISP)> ; Get space in input buffer
	JRST REASM3		; Forge ahead to (say) open conn/closing
REAS0A:

; Try to find a user buffer for filling.  This could be the Receive
;  current buffer left from a previous pass or one queued from
;  a user RECV call.

	LOAD BFR,TRCB,(TCB)	; Get 0 or receive current buffer
	SETSEC BFR,INTSEC	; Make extended address
	TRNE BFR,-1		; Is there a current buffer?
	  JRST REASM3		; Go use what is left of it
	LOAD BFR,QNEXT,<+TCBRBQ(TCB)>	; Pointer to first buffer queued
	CAIE BFR,TCBRBQ(TCB)	; Empty if that is the queue head
	  JRST REASM1		; Go dequeue the buffer and use it

; No buffer available. If there is a partially processed packet,
;  we can do no more.  Otherwise there may be controls (SYN)
;  which can be handled.  This allows a SYN to be ACKd and thus a
;  connection to open before any user RECVs have been done.

	JN TRPP,(TCB),REASMX	; Get out if there is a partial packet
	MOVX BFR,0		; Indicate no buffer to use.
	JRST REASM3		; Proceed
; Dequeue buffer at the head of the receive buffer queue

REASM1:	SETSEC BFR,INTSEC	; Make extended address
	MOVE T1,BFR		; Pointer to the buffer
	CALL DQ			; Dequeue it
	STOR BFR,TRCB,(TCB)	; And remember as the current buffer
REASM3:	LOAD RCVLFT,TRLFT,(TCB)
	JE TRPP,(TCB),REASM4	; Jump if not continuing a packet
	LOAD BYTNUM,TRCBY,(TCB)	; Where to resume in this packet
	JRST REAS13		; Go process the remainder

; First time we have seen this packet.  Flush it unless there is
;  some unseen stuff in it.

REASM4:	AOS RAPKCT		; Count packets seen by Reassembler
	MOVX T1,PT%TRA
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	MOVE T1,RCVLFT		; Recv Left -- start of "The present"
	LOAD T2,TRWND,(TCB)	; Get current window width
	ADD T2,T1		; Form Recv.Right -- beginning of "Past"
	ADDI T2,1		; Allow SYN thru 0-window crock
	MODSEQ T2		; T1,T2 are Left and Right of the past
	LOAD T3,PSEQ,(TPKT)	; Sequence of the packet
	LOAD T4,PESEQ,(PKT)	; Get end + 1 from packet
	CALL OVRLAP		; Packet included in the past?
	JUMPN T1,REASM5		; Jump if not.
IFN IPPDSW,<
	MOVEI T1,RADLAY		; Select Reassembler delay histogram
	SKIPE STATF		; Actually taking statistics?
	  CALL TSTAMP		; Yes.  Process the timestamp.
>				; end of IFN IPPDSW
	MOVX T1,PT%XX4		; Code for reassembler
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Call the packet printer
	MOVE T1,PKT		; Pointer to this useless packet
	CALL DQ			; Dequeue it
	CALL RETPKT		; Give space to freestorage
	JRST REASM0		; Try the next packet.
REASM5:

; If Left is within the current packet, there is something which
; can be reassembled out of it.

	LOAD T1,PSEQ,(TPKT)	; Start of the packet
	MOVE T2,RCVLFT		; Next thing needed for reassembly
	LOAD T3,PESEQ,(PKT)	; End of the packet
	CALL CHKWND		; Left within the packet?
	JUMPE T1,REASMX		; Jump if not.  Must wait for it to show
; Setup BYTNUM to be the byte number within the packet where data
; handling should start.

	LOAD RCVLFT,TRLFT,(TCB)	; Get updated copy
	MOVE BYTNUM,RCVLFT	; Next to be reassembled
	LOAD T1,PSEQ,(TPKT)	; Start of packet
	SUB BYTNUM,T1		; Offset into data
	JUMPLE BYTNUM,REAS12	; No control to worry about
	LOAD T1,PSYN,(TPKT)	; Get value of SYN bit
	SUBI BYTNUM,0(1)	; Discount space taken by SYN
REAS12:

; Setup XFRCNT to be the number of bytes to transfer out of the
; packet into the user buffer.

REAS13:	LOAD XFRCNT,PIPL,(PKT)	; Get total length
	LOAD T1,PIDO,(PKT)	; Number of words in Internet header
	LOAD T2,PTDO,(TPKT)	; Number of words in TCP header
	ADD T1,T2		; Number of header words
	ASH T1,2		; Number of header bytes
	SUB XFRCNT,T1		; Number of TCP data bytes
	SUB XFRCNT,BYTNUM	; Forget already processed bytes
	PUSH P,XFRCNT		; Save packet count (number available)
	SKIPG T2,LINBLK		; Is this a TVT w/ standard data block?
	 TDZA T1,T1		; No. Assume no buf and no space
	IFE REL6,<CALL TVTISP>	; Get space in input buffer
	IFN REL6,<CALLX (MSEC1,TVTISP)>
	JUMPE BFR,REAS14	; Jump if no buffer
	LOAD T1,BCNT,(BFR)	; Get number of holes in the buffer
REAS14:
	CAMLE XFRCNT,T1		; Min of available bytes and space
	  MOVE XFRCNT,T1	; is the actual transfer count
	JUMPLE XFRCNT,REAS15	; Jump if nothing to transfer.
	ADDM XFRCNT,BYTRCT	; Count bytes received
	MOVE T1,BYTNUM		; Where to start transfer from packet
	LOAD T3,PTDO,(TPKT)	; Get TCP data offset in words
	IDIVI T1,4		; Get words and byte into data
	ADD T1,T3		; Get word offset from TPKT
	HLL T1,[POINT 8,.-.(TPKT),-1
		POINT 8,.-.(TPKT),07
		POINT 8,.-.(TPKT),15
		POINT 8,.-.(TPKT),23](T2)
	SKIPG T2,LINBLK		; Addr of dynamic data area
	  JRST REA14A		; None
	MOVE T3,XFRCNT		; How much to transfer
	IFE REL6,<CALL PRCTVT>	; Process TVT chr on line in T2
	IFN REL6,<CALLX (MSEC1,PRCTVT)> ; Process TVT chr on line in T2
	JRST REAS15
REA14A:
	MOVE T2,XFRCNT		; How much to transfer
	CALL PRCDAT		; Process the data
REAS15:	POP P,T1		; Restore the packet count
; If the packet has been emptied into a buffer after the connection
; has become synchronized in the receive direction, process the
; trailing controls and flush the packet.  If the buffer was
; filled, report the fact to the user.

	LOAD T2,TRSYN,(TCB)	; Get receive state
	CAIE T2,SYNCED		; Synchronized?
	 CAIN T2,FINRCV		; or FIN Received?
	  CAIA			; Yes.
	   JRST REAS19		; No. Save as partial packet.
; ?? See if user buffer is full here for USRBFF a la reas18
	CAME T1,XFRCNT		; Emptied all data from the packet?
	  JRST REAS18		; No.
	JN TTVT,(TCB),REAS16	; Assume EOL and buffer if TVT
	JUMPN BFR,REAS16	; Into a buffer?
	JN PEOL,(TPKT),REAS18	; Lack buffer to report EOL in
REAS16:

; Packet empty, finish it off & loop back for next

	SETZRO TRPP,(TCB)	; Indicate no partial packet waiting

; See if we can leave receive urgent mode.  The urgent pointer must
; coincide with the end of a packet plus one.  So, we need only test the
; PESEQ for equality with the urgent pointer to tell if data up to the
; urgent pointer has been given to the user.

	JE TRURG,(TCB),REAS17	; Forget if not in receive urgent mode
	LOAD T1,PESEQ,(TPKT)	; Get the end plus one of this packet
	LOAD T2,TRURP,(TCB)	; And the receive urgent pointer
	CAMGE T1,T2		; Will the urgent pointer be acked? (FIN)
	  JRST REAS17		; No.
	SETZRO TRURG,(TCB)	; Leave receive urgent mode
REAS17:
	JN TTVT,(TCB),REA17A	; No EOL processing on TVTs
	JE PEOL,(TPKT),REA17A
	CALL PRCEOL		; Process EOL
REA17A:
	JE PFIN,(TPKT),REA17B
	CALL PRCFIN		; Process FIN if present, generate ack
REA17B:
	LOAD T1,PESEQ,(PKT)	; Get the sequence number following Pkt
	STOR T1,TRLFT,(TCB)	; Set the new Left
	CALL NUWNDO		; Update the window, maybe generate ACK
IFN IPPDSW,<
	MOVEI T1,RADLAY		; Select Reassembler delay
	SKIPE STATF		; Taking statistics right now?
	  CALL TSTAMP		; Yes, process the timestamp
>				; end of IFN IPPDSW
	MOVX T1,PT%XX4		; "Reassembled" code
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Print the packet
	MOVX T1,PT%TDR
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes

; Since we have completely finished with this packet, dequeue it
; and return the space to free storage.

	MOVE T1,PKT		; Pointer to the packet
	CALL DQ			; Dequeue it
	CALL RETPKT		; Free the area
	JRST REASM0		; And process the next packet.

; Here when more remains in packet

REAS18:	JUMPE BFR,REAS19	; Jump if no buffer
	JN BCNT,(BFR),REAS19	; Jump if buffer not filled
	MOVX T1,OK		; Indicate buffer is good
	SETZRO TRCB,(TCB)	; Indicate no current buffer anymore
	CALL USRBFF		; User buffer filled routine
REAS19:

; Save the partial packet for the next time through.

	SETONE TRPP,(TCB)	; Set the partial packet waiting bit
	MOVE T1,XFRCNT		; Number transferred
	ADD T1,BYTNUM		; Where the transfer started
	STOR T1,TRCBY,(TCB)	; Is where to resume in the packet
	JUMPN BYTNUM,REAS20	; First time we have
	JE PSYN,(TPKT),REAS20	; Seen a packet with a SYN in it?
	ADD RCVLFT,XFRCNT	; Yes. Update Left
	STOR RCVLFT,TRLFT,(TCB)
	MOVX T1,^D500
	CALL ENCPKT ;FRCPKT	; Get it ACK'd
REAS20:

	JUMPE BFR,REASMX	; If TVT input full, stop now
	JE TRCB,(TCB),REASM0	; Try to get another buffer from queue
REASMX:	SKIPL T2,LINBLK		; Do we have a term line locked?
	  CALL ULKTTY		; Yes.  Unlock it
	RESTORE
	RET
;PRCEOL
;Process EOL.

;TCB/	(Extended) Locked connection block
;BFR/	(Extended) Current buffer
;	CALL PRCEOL
;Ret+1:	always

PRCEOL:	MOVX T1,<<OK>B7+TCP%EL>	; OK code, with end of letter flag
	SETZRO TRCB,(TCB)	; no current buffer
	CALL USRBFF		; Tell user buffer filled
	MOVX BFR,0		; Indicate no current buffer
	RET

;PRCFIN
;Process FIN.

;TCB/	(Extended) Locked connection block
;	CALL PRCFIN
;Ret+1:	always

PRCFIN:	MOVX T1,FINRCV		; FIN Received state
	STOR T1,TRSYN,(TCB)	; Set into TCB
	AOS FINRCT		; Count FINs received
	MOVX T1,^D100
	CALL ENCPKT		; Make sure its ACKed promptly
	RET
;PRCDAT
;Process data from packet.

;TCB/	(Extended) Locked connection block
;PKT/	(Extended) Packet
;TPKT/	(Extended) pointer to TCP part of packet
;BFR/	(Extended) Buffer
;T1/	Byte pointer into packet
;T2/	Count of bytes to transfer to buffer
;	CALL PRCDAT
;Ret+1:	always

PRCDAT:	LOCAL <PKTPTR,XFRCNT>
	DMOVEM T1,PKTPTR
	CALL SETTUM		; Set TCP's usermode map
	MOVE T1,PKTPTR		; Source byte pointer
	LOAD T2,BPTR,(BFR)	; Destination byte pointer
	MOVE T3,XFRCNT		; Number to do
	SETZ T4,		; Monitor-to-user transfer
	CALL XFRDAT		; Do the data transfer
	STOR T2,BPTR,(BFR)	; Store back updated pointers
	MOVEM T1,PKTPTR
	LOAD T1,BCNT,(BFR)	; Get number of holes in buffer at start
	SUB T1,XFRCNT		; Reduce by number transferred
	STOR T1,BCNT,(BFR)	; Update the count in the buffer
	LOAD T3,TRBS,(TCB)	; Get receive bufferspace (due to RECVs)
	SUB T3,XFRCNT		; Remove space just filled from window
	STOR T3,TRBS,(TCB)
	CALL USTTUM
PRCDAX:	RESTORE
	RET
;NUWNDO
;Update Receive Window.

; Whenever a user RECV increases the available buffer space or
; after processing a packet entirely the size of the window being
; sent to the remote TCP is determined and set into the TCB.  If
; processing the packet has moved Received Left, the Packetizer is
; signaled so it will generate an ACK.

;TCB/	(Extended) Locked Connection block
;	CALL NUWNDO
;Ret+1:	always

NUWNDO::
	LOAD T1,TRBS,(TCB)	; Currently available buffer space
	JE TTVT,(TCB),NUWND1	; If a TVT
	SETZ T1,		; Assume no space
	LOAD T2,TVTL,(TCB)	; Unless a line
	JUMPE T2,NUWND1		; Has been assigned
	CALL STADYN		; Get line's data block
	  JRST NUWND1		; ??  address
	IFE REL6,<CALL TVTISP>	; Get space in input buffer
	IFN REL6,<CALLX (MSEC1,TVTISP)> ; Get space in input buffer
NUWND1:

; Now have available input space, maybe zero

	LOAD T2,TRLWN,(TCB)	; Seq # of last receive-right reported
	JUMPL T2,NUWND5		; Not yet available, use actual space
	LOAD T3,TRLFT,(TCB)	; Compute unused space from last window
	SUB T2,T3
	MODSEQ T2
	CAIL T2,<.RTJST(-1,PIPL)> ;CAML T2,[MAXSEQ/2] ; Beware negative
	  SETZ T2,		; Window (transmitter sent too much)
	JUMPLE T1,NUWND4	; No space, don't increase offered window
				; (but don't shrink it either)
	MOVE T4,INTXPB		; Estimated packet size
	SUBI T4,MINIHS+MINTHS	; w/o minimal headers
;	LSH T4,1		; How optimistic are we??
	CAIG T1,(T4)		; If user space is less
	  MOVE T1,T4		; Be optimistic
	CAILE T1,<.RTJST(-1,PWNDO)> ; But not more so than
	  MOVEI T1,<.RTJST(-1,PWNDO)> ; Size of window field
	MOVE T3,T2		; Remaining space, last window
	LSH T3,1		; Factor is 1/2
	CAMLE T3,T1		; If remaining .gt. 1/2 actual
NUWND4:	  MOVE T1,T2		; Don't report it (no silly windows)
NUWND5:	STOR T1,TRWND,(TCB)	; Offered window space
; Check if sender should be notified of ACKed data or new window info

	LOAD T3,TRSYN,(TCB)	; Check connection state
	LOAD T4,TSSYN,(TCB)
	CAIE T4,SYNABL		; If send side doesn't have a seq #
	 CAIN T3,SYNABL		; or don't know foreign address
	  RET			; Cannot send a packet
	LOAD T4,TRLFT,(TCB)	; Current ACK point
	LOAD T3,TRLAK,(TCB)	; Last reported ACK point
	SUB T2,T1		; Non-zero if new window info
	MOVX T1,^D250		; Estimated time too long, get RXs
	CAMN T3,T4		; If new ACK point or
	 SKIPE T2		; New window space
	  CALL ENCPKT		; Get a packet sent in a bit
	RET
;FLSRBF
;Flush Receive Buffers.

; Called when aborting a connection
;TCB/	(Extended) Locked connection block
;T1/	Code (377B7) to be left in the buffer header for user to see
;		XLP+12.	EFP+7.	ELP+7.	ELP+14.	E?T+? (TVTs)
;	CALL FLSRBF
;Ret+1:	always

FLSRBF:	SAVEAC <BFR>
	LOCAL <CODE>
	MOVEM T1,CODE
	LOAD BFR,TRCB,(TCB)	; Get the current receive buffer if any
	SETZRO TRCB,(TCB)	; Forget there is one
	JUMPE BFR,FLSRB2	; Jump if no current buffer
	SETSEC BFR,INTSEC	; Make extended address
FLSRB1:	MOVE T1,CODE
	LSH T1,^D<36-8>		; Put into postion
	CALL USRBFF		; Indicate user buffer "filled"
FLSRB2:	LOAD BFR,QNEXT,<+TCBRBQ(TCB)>	; First thing on queue
	CAIN BFR,TCBRBQ(TCB)	; If that is the head, queue now empty
	  JRST FLSRB3
	SETSEC BFR,INTSEC	; Make extended address
	MOVE T1,BFR
	CALL DQ			; Dequeue the buffer
	JRST FLSRB1

FLSRB3:	RESTORE
	RET
;FLSRBX
;Flush Receive Buffers for the current fork.

; Called when killing a fork
;TCB/	(Extended) Locked connection block
;	CALL FLSRBX
;Ret+1:	always

FLSRBX::			;FLUSH RECEIVE BUFFERS FOR CURRENT FORK
	JN TDEC,(TCB),R		;DO NOT DO THIS FOR DEC TCBS
	SAVEAC <BFR,Q1>		;DO NOT TRASH THIS AC
	STKVAR <FLSRBQ>
	LOAD BFR,TRCB,(TCB)	;GET THE CURRENT RECEIVE BUFFER IF ANY
	JUMPE BFR,FLRBX2	;JUMP IF NO CURRENT BUFFER
	SETSEC BFR,INTSEC	;MAKE EXTENDED ADDRESS
	LOAD T1,BFRKX,(BFR)	;GET THE FORK THAT OWNS THIS BUFFER
	CAME T1,FORKX		;IS IT US?
	 JRST FLRBX2		;NO SO DO NOT PLAY WITH IT
	SETZRO TRCB,(TCB)	;FORGET THE CURRENT BUFFER
	CALL USRBFF		;INDICATE CURRENT BUFFER FILLED
FLRBX2:				;HERE TO SETUP FOR TRIP THROUGH BUFFER CHAIN
	LOAD BFR,QNEXT,<+TCBRBQ(TCB)> ;GET THE FIRST THING ON THE QUEUE
FLRBX3:				;HERE TO LOOP THROUGH BUFFERS FOR THE TCB
	CAIN BFR,TCBRBQ(TCB)	;IF THAT IS THE HEAD, QUEUE NOW EMPTY
	 RET			;ALL DONE SO RETURN
	SETSEC BFR,INTSEC	;MAKE EXTENDED ADDRESS
	LOAD T1,QNEXT,(BFR)	;GET ADDRESS OF THE NEXT BUFFER IN CHAIN
	MOVEM T1,FLSRBQ		;SAVE THE NEXT BUFFER ADDRESS
	LOAD T1,BFRKX,(BFR)	;GET THE FORK THAT OWNS THIS BUFFER
	CAME T1,FORKX		;IS IT US?
	 JRST FLRBX4		;NO
	MOVE T1,BFR		;YES SO GET THE BUFFER ADDRESS
	CALL DQ			;DEQUEUE THE BUFFER
	CALL USRBFF		;INDICATE THE BUFFER IS FILLED
FLRBX4:				;HERE TO CONTINUE THROUGH THE BUFFER CHAIN
	MOVE BFR,FLSRBQ		;GET THE NEXT BUFFER TO LOOK AT
	JRST FLRBX3		;AND GO CHECK IT OUT
;RAINI
;Initialize RA process block.

;	CALL RAINI
;Ret+1:	Always, T1 zero if error

RAINI: 	LOCAL <PRC>
	MOVEI PRC,RA		; Pointer to the Process block for RA
	MOVX T1,QSZ		; Size of a queue head
	CALL GETBLK		; Head must be in same section as items
	JUMPE T1,RAINIX		; No room
	MOVEM T1,PRCQ(PRC)	; Input queue
	CALL INITQ		; Initialize it
	XMOVEI T1,PRCLCK(PRC)	; Lock
	CALL CLRLCK		; Initilize it
	XMOVEI T1,REASEM	; The Reassembler function
	MOVEM T1,PRCROU(PRC)	; Routine address
	SETOM PRCWAK(PRC)	; No run time yet
	MOVE T1,[<GIW TCBQRA,TCB>]; Offset of RA queue in TCB
	MOVEM T1,PRCQOF(PRC)	; Store process block
	MOVE T1,[<GIW TCBTRA,TCB>]; Offset of RA run time in TCB
	MOVEM T1,PRCWOF(PRC)	; Store in process block
	HRLOI T1,377777		; Infinity
	MOVEM T1,PRCSGT(PRC)	; Set time of most recent signal
	MOVEI T1,RARNCT		; Pointer to run counter
	MOVEM T1,PRCRNC(PRC)	; Put in standard place
	MOVEI T1,RAUSE		; Pointer to CPU use meter
	MOVEM T1,PRCTMR(PRC)	; Put in standard place
RAINIX:	RESTORE
	RET
	SUBTTL	TCP Packetizer

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT !

The  PACKETIZER  is  called  with  TCB  setup  to point at a (locked)
connection block. It attempts  to  form  packets  from  data  in  any
buffers  which  are queued from the user SENDs. If the "force packet"
bit is on, the PACKETIZER will always generate a packet containing an
ACK, even if there is no data to be sent. Packetizing continues until
no more is available from user buffers or until the send  window  has
been filled.

In  the  case  of  virtual  terminals  (TVTs) output is stored in TTY
buffers and TVTNOF is set to cause a scan by OPSCAN  which  forces  a
packet  on  TCBs which are TVTs. PZ runs with BFR set to 0 and BFRCNT
set to infinity in this case since it is not known how much output is
waiting to go and since the buffers are non-standard format.

!
;PKTIZE
;TCP Packetizer.

;TCB/	(Extended) Pointer to connection block
;	CALL PKTIZE
;Ret+1:	Always

PKTIZE:	SAVEAC <PKT,TPKT,BFR>
	LOCAL <BUFCNT,XFRCNT,WNDSPC,LINBLK>
	SETO LINBLK,		; Assume not TVT (abort case)

;User did an ABORT for this connection or a RESET, CLZFF, LOGOUT etc.
;If a foreign address is known and we're not NOT.NOT a "non-existant"
;TCB  error  is sent to it so it can know that the connection is gone
;on this end.

	JE TSABT,(TCB),PKTIZ0	; User requested ABORT?
	LOAD T1,TRSYN,(TCB)	; Get state of Recv and
	LOAD T2,TSSYN,(TCB)	; Send synchronization
	CAIN T1,NOTSYN
	 CAIE T2,NOTSYN
	  CAIN T1,SYNABL	; If we know the foreign address,
	   CAIA
	    CALL ABTNTC		; Send a courtesy error pkt to other end
	MOVX T1,ELP+^D7		; "No such connection"
	CALL ABTCON		; Set to NOTSYN, flush buffers, queues
	SETZRO <TSUOP,TSFP>,(TCB) ; Fake user CLOSE, Clear Force Packet request
	CALL USRABD		; Tell user that ABORT is done.
	JRST PKTIZX
PKTIZ0:

; If packet is being encouraged, set Force packet bit to get it done.

	JE TSEP,(TCB),PKTZ00
	SETONE TSFP,(TCB)
PKTZ00:
; If a SYN is sent when the connection is first used,
; it should have a sequence number gotten from the "Initial
; Sequence Number" curve (a function of the clock).

	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIN T1,SYNABL		; SYNCABLE?
	  CALL SETISN		; Yes. Set initial sequence number

; If this is a TVT, TSFP will be on but there will be no buffer.
; Do the special things for this case.

	JE TTVT,(TCB),PKTZ1D	; Jump if not a TVT
	MOVX BFRCNT,177700	; Maybe lots of output to handle
	LOAD T2,TVTL,(TCB)	; Get the line number
	JUMPE T2,PKTZ1D		; None if no TVT assigned (not synced)
	CALL LCKTTY		; Lock TTY, trm blk address to T2 & NOINT
	  JUMPLE T2,PKTZ1C	; Can't.
	MOVEM T2,LINBLK		; Save the address
	CALL TTSOBE		; CFOBF might have happened since OPSCAN
	  JRST PKTZ1E		; Chrs available. (Zero if ^S)
	MOVE T2,LINBLK		; Restore line blk address
PKTZ1C:	CALL ULKTTY		; Decrease the lock count & OKINT
PKTZ1D:	SETO LINBLK,		; No terminal block to unlock later

; Top of main non-TVT loop

;Try to find a user buffer to send data from.  This could the the
; "send current buffer" which is left from a previous call or a
; buffer queued from user SEND.  If there is no buffer, BFR is set
; to 0 as is the byte count.

PKTIZ1:	LOAD BFR,TSCB,(TCB)	; Get current send buffer if any
	JUMPN BFR,PKTIZ3	; Got one. Go set count.
	LOAD T1,QNEXT,<+TCBSBQ(TCB)> ; Get next thing on send buf Q
	CAIN T1,TCBSBQ(TCB)	; Next points at header ...
	  JRST PKTZ1E		; means empty.  No buffer.
	SETSEC T1,INTSEC	; Make extended address
	CALL DQ			; Dequeue the buffer
	SKIPA BFR,T1		; And setup the standard pointer.
PKTZ1E:	  MOVX BFR,0		; 0 means no buffer
	STOR BFR,TSCB,(TCB)	; Remember as current buffer
; Top of main TVT loop

; If there is a current buffer, set BUFCNT from the sum of the buffers.
; If no current buffer, try for a TVT.  If neither, set BUFCNT to 0.

PKTIZ2:	JUMPN BFR,PKTIZ3	; Jump if we have a buffer
	MOVX BUFCNT,0		; Count if not a TVT
	JUMPL LINBLK,PKTIZ4	; Jump if not TVT, or TVT w/ empty output buf
	MOVE T2,LINBLK		; Arg for TVTOSP
	IFE REL6,<CALL TVTOSP>	; Find out if anything waiting to go
	IFN REL6,<CALLX (MSEC1,TVTOSP)> ; Find out if anything waiting to go
	MOVE BUFCNT,T1		; May be zero
	STOR T1,TSBYT,(TCB)	; Keep TSBYT up to date too
	JRST PKTIZ4

PKTIZ3:	SETSEC BFR,INTSEC	; Make extended address
	LOAD BUFCNT,TSBYT,(TCB)	; Get total (SEND) queued byte count
PKTIZ4:
	LOAD PKT,TSCPK,(TCB)	; May have partially filled packet

; Force our idea of the availble window space to 0 if we cannot send
; data but have to generate only an ACK.

	LOAD T1,TSSYN,(TCB)	; Send state
	LOAD T2,TRSYN,(TCB)	; Receive state
	CAIE T1,SYNABL		; If send side is SYNABL or
	 CAIN T2,SYNABL		; Recv side is SYNABL then
	  JRST PKTIZ5		; Make useable window 0
; Compute the amount of window space available to send into as
; provided by the remote end.

	LOAD T1,TSLFT,(TCB)	; Send Left
	LOAD T3,TSWND,(TCB)	; Send Window offered
	SKIPN T3		; Allow sending if window is shut
	  MOVX T3,1		; Need probe to sense remote window openning
	LOAD T2,TSSEQ,(TCB)	; Send Sequence
	SKIPE PKT		; or
	 LOAD T2,PESEQ,(PKT)	; Packet end sequence if partial packet
	ADD T1,T3		; Compute Send Right
	SUB T1,T2		; Minus Sequence
	MODSEQ T1		; Keep within right number of bits
	CAML T1,[MAXSEQ/2]	; If window space is .lt. 0 then
	  JRST PKTIZ5		; Make it zero
	MOVEM T1,WNDSPC		; Amount of useable window space

	LOAD T2,TSMXP,(TCB)	; Max size of a packet (incl. header)
	CAML T1,T2		; If window is as large as a packet
	  JRST PKTIZ6		; Go use it
	LSH T1,2		; 4*Useable
	CAML T1,T3		; If Useable/Offered .ge. 1/4
	  JRST PKTIZ6		; Use it
	JUMPE BFR,PKTIZ5	; Cannot have PUSH if no buffer
	JN BEOL,(BFR),PKTIZ6	; Use anything if PUSH
PKTIZ5:	SETZ WNDSPC,		; Make useable window 0
PKTIZ6:

	SKIPLE BUFCNT		; If no data or
	 JUMPG WNDSPC,PKTIZ7	; No useable window
	  JE TSFP,(TCB),PKTIZX	; Give up unless Force Pkt on.
PKTIZ7:

; Now the number of bytes available from the user buffer(s) is
; known and the apparent amount of useable window space is known.
; Set XFRCNT to the (maximum) amount which can actually be sent in this
; Pkt.  In the case of a TVT, it is not known how much is available
; and we will assume a full packet (or window, etc) is to be sent.

	CAML BUFCNT,WNDSPC	; Take min of what is available to be
	 SKIPA XFRCNT,WNDSPC	; sent and space allowed to send in
	  MOVE XFRCNT,BUFCNT
	CAMLE XFRCNT,INTXPB	; Limit (roughly) to what a
	 MOVE XFRCNT,INTXPB	; Pkt can hold.

; See if have a current packet to continue filling

	LOAD PKT,TSCPK,(TCB)	; Partially filled packet?
	JUMPE PKT,PKTZ10	; No
	XMOVEI TPKT,PKTELI(PKT)	; Locate TCP header
	LOAD T1,PIDO,(PKT)
	ADD TPKT,T1
	LOAD T1,PTCKS,(TPKT)	; Total max packet size
	LOAD T2,PIPL,(PKT)	; Current length
	SUB T1,T2		; Unused data space in pkt (NB in T1)
	JRST PKTZ12
PKTZ10:

; Try to assign a block of free storage for the packet to be sent.

	LOAD T1,TSMXP,(TCB)	; Get a big packet
	SETZ T2,		; Have a TCB
	CALL TCPIPK		; Get packet & fill in headers
	  JRST [MOVX T1,^D2000	; Two seconds later,
		CALL ENCPKT	; Try again.
		INCR TCTBS,(TCB) ; Count them
		JRST PKTIZX]
	LOAD T2,PIPL,(PKT)	; Length of headers
	ADD T2,T1		; Max IP+TCP+Data length
	STOR T2,PTCKS,(TPKT)	; Save it in case continue filling later
	PUSH P,T1		; T1 is max packet data count
; Enter the send sequence for the connection as the sequence number
; of the packet.

	LOAD T1,TSSEQ,(TCB)	; Current send sequence
	STOR T1,PSEQ,(TPKT)	; Packet sequence number

; Send a SYN if connection is opening

	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIN T1,SYNABL		; SYNCHABLE means we must tell other
	  CALL SNDSYN		; end our seq. num. by sending a SYN
				; PSYN to 1 & TSSYN to SYNSNT
	POP P,T1		; Max # data octets

; Transfer data from the user buffer (if any) to the packet.  XFRCNT
; has the maximum number of bytes, which may be 0.  T1 has unused bytes
; in packet.  Find how much can really be sent, given options & header

PKTZ12:	CAMLE XFRCNT,T1		; Min against available data
	  MOVEI XFRCNT,(T1)	; Cannot send all the data in pkt
	MOVE T1,XFRCNT		; # of octets for SNDxxx

; Call appropriate data transfer routine

	JUMPE BFR,PKTZ14	; Jump if no buffer from user SEND (or a TVT)
	CALL SNDDAT		; Transfer it from user buffer to Pkt
	JRST PKTZ15		; Note that SNDDAT set timestamp
PKTZ14:
	SKIPGE T2,LINBLK	; Do we have a terminal block?
	  JRST PKZ14A		; No.
	IFE REL6,<CALL SNDTVT>	; Send data from a virtual terminal
	IFN REL6,<CALLX (MSEC1,SNDTVT)> ; Send data from a virtual terminal
	SETONE PEOL,(TPKT)	; Hussle up receiver
PKZ14A:
	MOVE T2,TODCLK		; Current millisecond
	STOR T2,PTS,(PKT)	; Set the Packet timestamp
PKTZ15:	MOVEM T1,XFRCNT		; Save number actually sent
	LOAD T1,PIPL,(PKT)	; Get packet length (b) witout data
	ADD T1,XFRCNT		; Add amount just inserted
	STOR T1,PIPL,(PKT)	; Set into Internet Packet Length
	LOAD T1,TSBYT,(TCB)	; Reduce queued count too
	SUB T1,XFRCNT
	STOR T1,TSBYT,(TCB)
; Send a FIN if it is time.  User must have said CLOSE (TSUOP
; bit is off), SEND connection must be synchronized, and there must be
; nothing waiting to be sent (no current send buffer and nothing Q'd)

	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIE T1,SYNCED		; Connection synchronized?
	  JRST PKTZ16		; No.  No FIN can be sent.
	JN TSUOP,(TCB),PKTZ16	; Jump if connection still OPEN by user
	JN TSCB,(TCB),PKTZ16	; Still something to send. No FIN yet.
	LOAD T1,QNEXT,<+TCBSBQ(TCB)>	; Get first thing on send bfr q
	CAIN T1,TCBSBQ(TCB)	; Is the queue empty?
	  CALL SNDFIN		; Include a FIN in this packet
PKTZ16:				; PFIN is 1, TSSYN=FINSNT, DG scheduled
       				; if R=NOTSYN

; Now all control and data have been stored in the packet.

	CALL PKTEND		; Returns next seq num after this Pkt
	STOR T1,PESEQ,(PKT)	; Save computed end of packet

; If we are ACKing a remote FIN, the receive side becomes NOTSYNCHED.
; If that makes both sides NOTSYNCHED, the user is notified that the
; connection is fully closed.  If just the receive side closed, the
; user is told that the connection is closing.  If all that remains
; to happen on the connection is that this end should receive an ACK
; of our FIN, Background is notified to generate a fake ACK after a
; reasonable time; this guards against the network losing the final ACK.

	LOAD T1,TRSYN,(TCB)	; Get receive state
	CAIE T1,FINRCV		; FINRECEIVED?
	  JRST PKTZ19		; No.  Skip the checks.
	MOVX T1,NOTSYN
	STOR T1,TRSYN,(TCB)	; Change to NOTSYNCHED
	MOVX T1,XLP+^D12	; "Closing" code (Why not XFP+^D12??)
	CALL FLSRBF		; Flush receive buffers with this code
	LOAD T2,TSSYN,(TCB)	; Get send state
	CAIE T2,FINSNT		; Sending a FIN now?
	  JRST PKTZ17		; No
	XMOVEI T1,DY		; Who to signal
	MOVE T2,TCPDGT		; When to signal
	CALL SIGNAL
	JRST PKTZ20		; Force this packet out
PKTZ17:
	MOVX T1,XFP+^D12	; Assume "Closing"
	CAIN T2,NOTSYN		; Send side already closed?
	  MOVX T1,XLP+^D3	; Yes, "Closed" event
	CALL USREVT		; Tell user
PKTZ19:
; Decide whether to wait for more data or send what packet now holds

	JN TSFP,(TCB),PKTZ20	; Send it if Force Packet is on
	JN <PSYN,PEOL,PFIN>,(TPKT),PKTZ20 ; or packet contains control
	LOAD T1,PIPL,(PKT)	; or if packet is full
	LOAD T2,PTCKS,(TPKT)
	CAMGE XFRCNT,WNDSPC	; Transfer count fill window?
	CAMN T1,T2
	  JRST PKTZ20		; Full, send it
	STOR PKT,TSCPK,(TCB)	; Packet to be held
	SETZRO <TSFP,TSEP>,(TCB) ; Clear signals
	JRST PKTIZX

; Packet will be sent now, finish it off

PKTZ20:	SETZRO TSCPK,(TCB)	; No saved packet
	SETZRO <TSFP,TSEP>,(TCB) ; Clear signals

; Now all control and data have been stored in the packet. Advance
; the send sequence in the TCB to include all of this packet.

	CALL PKTEND		; Returns next seq num after this Pkt
	STOR T1,TSSEQ,(TCB)	; Advance Send sequence
	STOR T1,PESEQ,(PKT)	; Save recomputed end of packet
	JE PSYN,(TPKT),PKZ201	; Jump if not first packet on this conn
	LOAD T2,TSLFT,(TCB)	; Get send left
	SUB T1,T2		; Compute amount of window taken by this
	MODSEQ T1		; first Pkt.
	STOR T1,TSWND,(TCB)	; And prevent further sends until window
PKZ201:				; info arrives from other end.

	CALL NULPKT		; See if anything retransmittable here
	SETCA T1,		; Get sense right
	STOR T1,PPROG,(PKT)	; Say program must retain the packet
	CALL SETRXP		; Setup packet rexmit parameters

; Set the timegenerated word in the local header.  Used to compute
; roundtrip time for determining what the retransmit interval will be.

	MOVE T1,TODCLK		; Current millisecond
	STOR T1,PTG,(PKT)	; Packet Time Generated
; Done filling the packet.  If running in  secure mode and this
; packet has something which will be acknowledged, make the
; current level be the next level so as to shut off subsequent
; connection change request options to the KDC.

	SKIPN INTSCR		; In secure mode?
	  JRST PKTZ21		; No.  Avoid the overhead.
	JE PPROG,(PKT),PKTZ21	; See if pkt will be ACK'd
	LOAD T2,TSLVN,(TCB)	; Guaranteed that KDC will here the word
	STOR T3,TSLVC,(TCB)	; So update the current level
PKTZ21:
	LOAD T1,PPROG,(PKT)	; Save flag for later test
	PUSH P,T1		; PKT may vanish if error in EMTPKT (SNDGAT)
	AOS PZPKCT		; Count Packetizer packets
	MOVX T1,PT%XX1		; "Being output"
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	MOVX T1,PT%TPZ
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes

; Do statistics functions

IFN IPPDSW,<
	SKIPN STATF		; Taking statistics right now?
	  JRST PKTZ22		; No
	MOVEI T1,OPDLAY		; Histogram time to (null) Output Proc.
	CALL TSTAMP		; Process the time stamp
	MOVEI T1,OPUSE		; Charge time to Output Processor
	XMOVEI T2,EMTPKT	; for call to EmitPacket
	MOVE T3,LINBLK		; TVT block if any
	CALL TIMCAL		; Do a timed call.
	JRST PKTZ23		; Skip non-statistics code
>				; end of IFN IPPDSW
PKTZ22:	MOVE T1,LINBLK		; TVT block if any
	CALL EMTPKT		; EmitPacket
PKTZ23:
	POP P,T1		; Saved PPROG tells if PKT needed RX
	JUMPE T1,PKZ23A		; Not needed (maybe its been sent & freed)
	SKIPN T1,PKT		; What to Enqueue (if there wasn't an error)
	  JRST PKZ23A		; Error in EMTPKT/SNDGAT
	XMOVEI T2,TCBRXQ(TCB)	; Pointer to the retransmit queue
	CALL NQ			; Enqueue it there
	XMOVEI T1,RX		; Select the Retransmitter
	LOAD T2,PRXI,(PKT)	; Retransmission interval
	MOVE T4,T2
	ADD T4,TODCLK		; Time of next run
	SKIPE TCBQRX(TCB)	; Not queued, or ...
	 CAMG T4,TCBTRX(TCB)	; Need it sooner than scheduled?
	  CALL SIGNAL		; Cause RX to run after that time
PKZ23A:
	LOAD T1,TSSYN,(TCB)	;GET THE SEND STATE
	CAIE T1,SYNCED		;SYNCHRONIZED?
	 JRST PKZ24B		;NO SO NO FIN COULD BE SENT
	JN TSUOP,(TCB),PKZ24B	;CONNECTION STILL OPEN (ACCORDING TO USER)?
	MOVE T1,TVTWTM		;No so wait for window to open but
	CALL DLAYPZ		;check back in case other TCP loses
PKZ24B:				;HERE WHEN NO FIN TO BE SENT
; See if Packetizer should run again for this connection.  This is true
; if there is something waiting to be sent and there is window space
; in which to send it.

; TVT checks

	JE TTVT,(TCB),PKTZ24	; Jump if not a virtual terminal
	SETZ T1,		; Assume LINBLK is -1
	SKIPLE T2,LINBLK	; Pointer to dynamic area
	IFE REL6,<CALL TVTOSP>	; Get amount of output waiting
	IFN REL6,<CALLX (MSEC1,TVTOSP)>
	STOR T1,TSBYT,(TCB)
	JUMPE T1,PKTIZX		; None right now.
	CAMLE WNDSPC,XFRCNT	; If there is still unused window space
	  JRST PKTIZ2		; Go try for it
	MOVE T1,TVTWTM		; After this number of milliseconds
	CALL DLAYPZ		; Try again
	JRST PKTIZX
PKTZ24:

; Non-TVT checks

	JN TSCB,(TCB),PKTZ25	; Jump if there is a current buffer
	LOAD T1,QNEXT,<+TCBSBQ(TCB)>	; Send buffer queue
	CAIN T1,TCBSBQ(TCB)	; Empty?
	  JRST PKTIZX		; Yes.  Nothing to send.  Return.
PKTZ25:
	CAMLE WNDSPC,XFRCNT	; Is there some unused window space?
	  JRST PKTIZ1		; Yes. Use it.

; Return from the Packetizer

PKTIZX:
	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIE T1,SYNCED		; Connection synchronized?
	IFSKP.			; (FIN can't be sent if not)
	ANDQE. TSUOP,(TCB)	; Yes, jump if connection still OPEN by user
	  MOVE T1,TVTWTM	; Try to send FIN later, we must have been
	  CALL DLAYPZ		;  unable to send it this time through
	ENDIF.			;  (ie, due to presence of q'd snd data)
	SKIPL T2,LINBLK		; Have a TVT line locked?
	 CALL ULKTTY		; Yes.  Unlock it.
	RESTORE			; POP all locals
	RET
;SETISN
;Set Initial Sequence Number for a connection.
;SETIS1
;Sets default initial send window.

;TCB/	(Extended) Locked connection block
;	CALL SETISN
;Ret+1:	always

SETISN:	JN TSSV,(TCB),SETIS1	; Jump if the current sequence is valid
	CALL GETISN		; Get current value of ISN curve
	STOR T1,TSSEQ,(TCB)	; Store as current send sequence
	SETONE TSSV,(TCB)	; Indicate sequence is now valid
SETIS1:
	LOAD T1,TSSEQ,(TCB)
	STOR T1,TSLFT,(TCB)	; Move Send Left up to Sequence
	RET			; Wait for window

;SNDSYN
;Include a SYN bit in the packet.

;TCB/	(Extended) Current locked connection block
;PKT/	(Extended) Packet
;TPKT/	(Extended) pointer to TCP part of packet
;	CALL SNDSYN
;Ret+1:	always

SNDSYN:	SETONE PSYN,(TPKT)	; Set the SYN bit in the packet
	LOAD T1,TSSYN,(TCB)	; Get send state
	CAIE T1,SYNABLE		; SYNCABLE (ie, opening)
	  JRST SNDSY1		; No.
	MOVX T2,SYNSNT
	STOR T2,TSSYN,(TCB)	; Yes. Change to SYNSENT state.
SNDSY1:	AOS SYNSCT		; Count SYNs sent
	RET
;SNDDAT
;Move data from user buffer(s) to a (partially filled) packet.

; All OPTIONS must be in the Packet at the time this is called.
;TCB/	(Extended) Locked connection block
;PKT/	(Extended) Packet
;TPKT/	(Extended) pointer to TCP part of packet
;BFR/	(Extended) Buffer header address (of first buffer)
;T1/	Number of bytes to move (maybe 0).
;	CALL SNDDAT
;Ret+1:	Always. T1 has number actually transferred

SNDDAT:	LOCAL <CPYCNT,XFRCNT,PKTPTR>
	MOVEM T1,XFRCNT		; Set up the transfer count
	SETZ CPYCNT,
	LOAD T1,PIPL,(PKT)	; Packet length
	IDIVI T1,4		; Divided into
	MOVEI PKTPTR,PKTELI(T1)	; Word offset and byte
	HLL PKTPTR,[	POINT 8,.-.(PKT)
			POINT 8,.-.(PKT),7
			POINT 8,.-.(PKT),15
			POINT 8,.-.(PKT),23](T2)
	SKIPN STATF		; Taking statistics now?
	  JRST SNDDA0		; No
IFN IPPDSW,<
	LOAD T1,BTS,(BFR)	; Get the buffer time stamp
	STOR T1,PTS,(PKT)	; and make that the Packet time stamp
>				; end of IFN IPPDSW
SNDDA0:

; Top of per-user buffer loop

SNDDA1:	CALL SETTUM		; Set user map
	LOAD T4,BCNT,(BFR)	; Available bytes in user buffer
	MOVE T3,T4
	CAILE T3,(XFRCNT)	; Min'ed with remaining space in packet
	  MOVE T3,XFRCNT
	SUB XFRCNT,T3		; Bytes to transfer from next buffer
	SUB T4,T3		; Bytes remaining in user buffer
	STOR T4,BCNT,(BFR)
	ADDM T3,CPYCNT		; Total bytes transferred so far
	LOAD T1,BPTR,(BFR)	; Source is buffer ptr (mapped into mon)
	MOVE T2,PKTPTR		; Destination is packet pointer
	SETO T4,		; Indicate User-to-monitor
	CALL XFRDAT		; Do the data transfer
	MOVEM T2,PKTPTR		; Store updated infomation
	STOR T1,BPTR,(BFR)
	CALL USTTUM		; Unmap user space
; Stop if more remains in user buffer (should have reached end of count

	JN BCNT,(BFR),SNDDAX	; More remains in buffer, wait for next pkt

; Finished with this buffer, transfer PUSH if present

	SETZRO TSCB,(TCB)	; Done with this buffer
	JE BEOL,(BFR),SNDDA5	; Jump if no PUSH in the buffer
	SETONE PEOL,(TPKT)	; Set packet PUSH
SNDDA5:
	MOVX T1,<<OK>B7>	; The general success event code
	CALL USRBFE		; Tell user his send buffer is empty
	MOVX T1,PT%TBD
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes

; Stop if transferred full count

	JUMPLE XFRCNT,SNDDAX	; Pkt filled so quit

; Setup for next user buffer

	LOAD T1,QNEXT,<+TCBSBQ(TCB)> ; Get next thing on send buf Q
	CAIN T1,TCBSBQ(TCB)	; Next points at header ...
	  JRST SNDDAX		; means empty.  Something is wrong...stop
	SETSEC T1,INTSEC	; Make extended address
	CALL DQ			; Dequeue the buffer
	MOVE BFR,T1		; And setup the standard pointer.
	STOR BFR,TSCB,(TCB)	; Remember as current buffer
	JRST SNDDA1		; Go to work on this buffer

SNDDAX:	ADDM CPYCNT,BYTSCT	; Count Bytes Sent
	MOVE T1,CPYCNT		; Return bytes actually transferred
	RESTORE
	RET
;SNDFIN
;Send a FIN in this packet.

;TCB/	(Extended) Locked connection block
;PKT/	(Extended) Packet
;TPKT/	(Extended) pointer to TCP part of packet
;	CALL SNDFIN
;Ret+1:	always

SNDFIN:	SETONE PFIN,(TPKT)	; Set FIN bit in the packet
	MOVX T1,FINSNT		; New send state
	STOR T1,TSSYN,(TCB)	; Set it.
	LOAD T1,TRSYN,(TCB)	; Get receive state
	CAIE T1,NOTSYN		; NOTSYNCHED?
	  JRST SNDFI1		; No.
	XMOVEI T1,DY
	MOVE T2,TCPDGT
	CALL SIGNAL		; Run again in 30 seconds
SNDFI1:
	AOS FINSCT		; Count FINs sent
	RET
;EMTPKT
;Emit a packet into a network.

;TCB/	(Extended) Locked connection block
;PKT/	(Extended) Packet, NB: It may be invalid on return from SNDGAT
;TPKT/	(Extended) pointer to TCP part of packet
;T1/	Pointer to dynamic data if TVT w/ output data, or -1

EMTPKT:	LOCAL <LINBLK>
	MOVEM T1,LINBLK		; Save TTYSRV line block if any
	JN PINTL,(PKT),EMTPKX	; Already in use by interrupt level
				; (ReXmit while NET is off or slow)
	LOAD T4,TRSYN,(TCB)	; Get receive state
	CAIN T4,SYNABLE		; SYNCABLE
	  JRST EMTPK1		; Yes.  Cannot ACK anything.

; Insert ACK

	SETONE PACK,(TPKT)	; Set the packet ACK bit
	LOAD T1,TRLFT,(TCB)	; Receive Left is what we want to hear
	STOR T1,PACKS,(TPKT)	; next.  ACK that.
	STOR T1,TRLAK,(TCB)	; Sending an ACK

; Insert receive window

	CAIE T4,FINRCV		; If received FIN or
	 CAIN T4,NOTSYN		; already closed
	  JRST EMTPK0		; Leave window zero
	LOAD T1,TRWND,(TCB)	; Offered window size
	STOR T1,PWNDO,(TPKT)	; into packet
	JE PACK,(TPKT),EMTPK0	; If no ACK, cannot
	LOAD T2,PACKS,(TPKT)	; Receive-left
	ADD T2,T1		; Plus window
	MODSEQ T2		; is Receive-right
	STOR T2,TRLWN,(TCB)	; Last offered
EMTPK0:

; Set urgent if required

	JE TSURG,(TCB),EMTPK1	; Skip following if not in urgent mode
	LOAD T1,TSURP,(TCB)	; End of urgent data
	LOAD T2,PSEQ,(TPKT)	; Sequence number of this packet
	SUB T1,T2		; Offset to urgent pointer
	CAIG T1,<PURGP/<PURGP&<-PURGP>>>	; Limit to max
	  MOVX T1,<PURGP/<PURGP&<-PURGP>>>
	STOR T1,PURGP,(TPKT)	; Set into packet
	SETONE PURG,(TPKT)	; Set the control bit
EMTPK1:

; Insert checksum

	SETZRO PTCKS,(TPKT)	; Clear the check sum field
	CALL TCPCKS		; Compute the packet checksum
	STOR T1,PTCKS,(TPKT)	; and enter it in the packet

; Log packet

	MOVX T1,PT%XX2		; "passing Output processor" code
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Tell Pkt printer
	MOVX T1,PT%TRX
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	MOVE T1,TODCLK		; Current millisecond number
	STOR T1,PXT,(PKT)	; Store as time of most recent transmit
	CALL SNDGAT		; Send it
	AOS OPPKCT		; Count packets output
	AOS OPRNCT		; and Output runs
EMTPKX:	RESTORE
	RET
;ABTNTC
;Send a RST to remote TCP when this end is abandonned.

; This is a courtesy which serves to speed things up but is not
; required by the protocol.

;TCB/	(Extended) Locked connection block
;	CALL ABTNTC
;Ret+1:	always

ABTNTC:	SAVEAC <PKT,TPKT>
	SETZB T1,T2		; No data & have TCB
	CALL TCPIPK		; Get packet & fill in headers
	  JRST ABTNTX		; No space.  Not required anyway.
	SETONE PRST,(TPKT)	; Set the reset bit
	LOAD T1,TSSEQ,(TCB)	; Current send sequence
	STOR T1,PSEQ,(TPKT)	; Is the Packet sequence
	LOAD T2,TRLFT,(TCB)	; What we want to hear next (or 0)
	STOR T2,PACKS,(TPKT)	; Is the acknowledge
	SETONE PACK,(TPKT)	; Make the ACK Sequence meaningful
	SETZRO PWNDO,(TPKT)	; 0 window to other end (TCB is dead)
	SETZRO PTCKS,(TPKT)
	CALL TCPCKS		; Compute TCP packet checksum
	STOR T1,PTCKS,(TPKT)	; and insert into packet
	MOVX T1,PT%XX2		; Say Pkt is being sent
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Print the packet
	MOVX T1,PT%TRX
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	AOS PZPKCT		; Count Packetized packets
	AOS OPPKCT		; Count Output packets
	AOS RSTSCT		; Count ERRs sent
	CALL SNDGAT		; Sent Pkt to the net. (NB: PPROG is 0)
ABTNTX:	RET
;SCRCLS
;Send a "Secure Close".

; After all has been said, one more packet containing a SCLOPT must
; be sent.  This will cause the BCR to contact the KDC in order
; to remove the keys, etc for the connection.

;TCB/	(Extended) Locked connection block
;	CALL SCRCLS
;Ret+1:	always

SCRCLS:	SAVEAC <PKT,TPKT>
	SETZB T1,T2		; No data & have TCB
	CALL TCPIPK		; Get packet & fill in headers
	  JRST SCRCLX		; No.  Don't worry about it however
	CALL SNDSCL		; Add in the secure close option
	CALL TCPCKS		; Compute TCP packet checksum
	STOR T1,PTCKS,(PKT)	; and insert into packet
	MOVX T1,PT%XX2		; Say Pkt is being sent
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, Print the packet
	MOVX T1,PT%TRX
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes
	AOS PZPKCT		; Count Packetized packets
	AOS OPPKCT		; Count Output packets
	CALL SNDGAT		; Sent Pkt to the net. (NB: PPROG is 0)
SCRCLX:	RET

;FRCPKT
;Force a packet.

; Causes a packet to be emitted even if there is no data to send.
; Done to cause something to be ACKd for instance.
;TCB/	(Extended) Locked connection block
;	CALL FRCPKT
;Ret+1:	always

FRCPKT::JN TSFP,(TCB),FRCPKX	; Filter extra calls
	SETONE TSFP,(TCB)	; Set the Force packet request bit
	$SIGNL(PZ,0)		; Make Packetizer run now
FRCPKX:	RET
;ENCPKT
;Encourage generation of a packet.

; A packet is needed to ACK something, but allow time for some data
; to appear so that the ACK can piggyback on it.  Also, more calls
; may be made and we wish to minimize network traffic by not
; generating an ACK-only packet each time.
;TCB/	(Extended) Locked connection block
;T1/	# msec to wait
;	CALL ENCPKT
;Ret+1:	always

ENCPKT::JN TSEP,(TCB),ENCPKX	; Already encouraged.  No more needed.
	SETONE TSEP,(TCB)	; Remember a packet is being encouraged
	CALL DLAYPZ		; Get background to signal PZ(TCB)
ENCPKX:	RET

;DLAYPZ
;Schedule a delayed signal for the packetizer.

;TCB/	(Extended) Locked TCB
;T1/	Delay time in milliseconds
;	CALL DLAYPZ
;Ret+1:	always

DLAYPZ:	JN TSFP,(TCB),DLAYPX	; Already forced.  No need.
	MOVE T2,T1		; Desired delay for SIGNAL
	SKIPN TCBQPZ(TCB)	; Already queued?
	  JRST DLAYPS		; No
	MOVE T1,TCBTPZ(TCB)	; When
	SUB T1,TODCLK
	CAMG T1,T2		; This request sooner?
	  JRST DLAYPX		; No, its later so ignore it
DLAYPS:	XMOVEI T1,PZ		; Select Packetizer
	CALL SIGNAL
DLAYPX:	RET
;FLSSBF
;Flush all SEND buffers with a given Event Code.

;TCB/	(Extended) Locked connection block
;T1/	Event Code: EFP+^D7; ELP+^D7; ELP+^D14, ELT+^D4 (no TVTs)
;	CALL FLSSBF
;Ret+1:	always

FLSSBF:	SAVEAC <BFR>
	LOCAL <CODE>
	MOVEM T1,CODE
	LOAD BFR,TSCB,(TCB)	; Get the current send buffer
	SETZRO TSCB,(TCB)	; Forget the current send buffer
	JUMPE BFR,FLSSB2	; Do we have a buffer here?
	SETSEC BFR,INTSEC	; Make extended address
FLSSB1:	MOVE T1,CODE		; Yes.
	LSH T1,^D<36-8>		; Position in error byte
	CALL USRBFE		; Tell user it is done
FLSSB2:	LOAD BFR,QNEXT,<+TCBSBQ(TCB)>	; Get next thing on buffer queue
	CAIN BFR,TCBSBQ(TCB)	; Points at head of queue
	  JRST FLSSB3		; means empty queue.  Done.
	SETSEC BFR,INTSEC	; Make extended address
	MOVE T1,BFR
	CALL DQ			; Dequeue the buffer
	JRST FLSSB1

FLSSB3:	RESTORE
	RET
;FLSSBX
;Flush all SEND buffers for the current fork.

;TCB/	(Extended) Locked connection block
;Ret+1:	always

FLSSBX::			;FLUSH SEND BUFFERS FOR CURRENT FORK
	JN TDEC,(TCB),R		;DO NOT DO THIS FOR DEC TCBS
	SAVEAC <BFR,Q1>		;DO NOT TRASH THIS AC
	STKVAR <FLSSBQ>
	LOAD BFR,TSCB,(TCB)	;GET THE CURRENT SEND BUFFER IF ANY
	JUMPE BFR,FLSBX2	;JUMP IF NO CURRENT BUFFER
	SETSEC BFR,INTSEC	;MAKE EXTENDED ADDRESS
	LOAD T1,BFRKX,(BFR)	;GET THE FORK THAT OWNS THIS BUFFER
	CAME T1,FORKX		;IS IT US?
	 JRST FLSBX2		;NO SO DO NOT PLAY WITH IT
	SETZRO TSCB,(TCB)	;FORGET THE CURRENT BUFFER
	CALL USRBFE		;INDICATE CURRENT BUFFER EMPTY
FLSBX2:				;HERE TO SETUP FOR TRIP THROUGH BUFFER CHAIN
	LOAD BFR,QNEXT,<+TCBSBQ(TCB)> ;GET THE FIRST THING ON THE QUEUE
FLSBX3:				;HERE TO LOOP THROUGH BUFFERS FOR THE TCB
	CAIN BFR,TCBSBQ(TCB)	;IF THAT IS THE HEAD, QUEUE NOW EMPTY
	 RET			;ALL DONE SO RETURN
	SETSEC BFR,INTSEC	;MAKE EXTENDED ADDRESS
	LOAD T1,QNEXT,(BFR)	;GET THE NEXT BUFFER TO LOOK AT
	MOVEM T1,FLSSBQ		;SAVE THE NEXT BUFFER ADDRESS
	LOAD T1,BFRKX,(BFR)	;GET THE FORK THAT OWNS THIS BUFFER
	CAME T1,FORKX		;IS IT US?
	 JRST FLSBX4		;NO
	MOVE T1,BFR		;YES SO GET THE BUFFER ADDRESS
	CALL DQ			;DEQUEUE THE BUFFER
	CALL USRBFE		;INDICATE THE BUFFER IS EMPTY
FLSBX4:				;HERE TO CONTINUE THROUGH THE BUFFER CHAIN
	MOVE BFR,FLSSBQ		;GET THE NEXT BUFFER
	JRST FLSBX3		;AND GO CHECK IT OUT
;PZINI
;Initialize PZ process block.

;	CALL PZINI
;Ret+1:	ALways

PZINI:	LOCAL <PRC>
	MOVEI PRC,PZ		; Pointer to the Process block for PZ
	MOVX T1,QSZ		; Size of a queue head
	CALL GETBLK		; Head must be in same section as items
	JUMPE T1,PZINIX		; No room
	MOVEM T1,PRCQ(PRC)	; Input queue
	CALL INITQ		; Initialize it
	XMOVEI T1,PRCLCK(PRC)	; Lock
	CALL CLRLCK		; Initilize it
	XMOVEI T1,PKTIZE	; Packetizer function
	MOVEM T1,PRCROU(PRC)	; Routine address
	SETOM PRCWAK(PRC)	; No run time yet
	MOVE T1,[<GIW TCBQPZ,TCB>]; Offset of PZ queue in TCB
	MOVEM T1,PRCQOF(PRC)	; Store process block
	MOVE T1,[<GIW TCBTPZ,TCB>]; Offset of PZ run time in TCB
	MOVEM T1,PRCWOF(PRC)	; Store in process block
	HRLOI T1,377777		; Infinity
	MOVEM T1,PRCSGT(PRC)	; Set time of most recent signal
	MOVEI T1,PZRNCT		; Pointer to run counter
	MOVEM T1,PRCRNC(PRC)	; Put in standard place
	MOVEI T1,PZUSE		; Pointer to CPU use meter
	MOVEM T1,PRCTMR(PRC)	; Put in standard place
	HRROI T1,-1		; All ok
PZINIX:	RESTORE
	RET
	SUBTTL	TCP Retransmitter

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

The  Retransmitter  task is call from the top level of the TCP when a
connection deadline has elapsed. The single packet at the head of the
restransmission queue is sent again and  its  retranmission  interval
adjusted. Should the maximum persistence of some message be exceeded,
the user is notified and the connection aborted.

Two retransmission strategies are available. The old initial interval
with backoff and the "newer" dynamic method.

The   "newer"   method   is   the  default;  it  is  specified  by  a
"retransmission parameters word" (OPEN, SEND)  of  zero.  It  uses  a
smoothed round trip time estimate based on the formula:

	SRTT = SRTT(last) * alpha + RTT * (1-alpha)

and the packet retransmission interval is computed by

	RXI = SRTT * beta

where	SRTT	is TSMRT	(initial value is TCPRX0)
	alpha	is TCPRXS	(scaled by 2**-(TCPRXF))
	RTT	is TODCLK(ACK)-PTG
	beta	is TCPRXV	(scaled by 2**-(TCPRXF))
	RXI	is PRXI

The  old  method is specified if the "retransmission parameters word"
has ever been non-zero. It computes the  minimum  and  maximum  round
trip  times  for  all packets in a TCPBG0 msec interval and then sets
the estimated retransmission time (TRXI, initial value from RX  param
word,  or TCPDXI if 0) to one-half second above the average estimated
round trip time. With each  retransmission  of  a  packet,  the  next
retransmission   interval   is   the  current  value  *  numinator  /
denominator (each from the RX param word or TCPDXN, TCPDXD).

!
;REXMIT
;Retransmit for a connection.

;TCB/	(Extended) Locked connection block. (Dequeued from RX queue)
;	CALL REXMIT
;Ret+1:	Always

REXMIT:	SAVEAC <PKT,TPKT>
	LOCAL <LINBLK,NXRXI>
	XMOVEI T1,TCBRXQ(TCB)	; Pointer to the retranmit queue
	LOAD PKT,QNEXT,(T1)	; Set pointer to first thing on queue
	SETSEC PKT,INTSEC	; Make extended address
	SETO LINBLK,		; Assume not a TVT
	CAMN PKT,T1		; If that is the head of the queue,
	  JRST REXMIX		; we are done.

; TVT processing

	JE TTVT,(TCB),REXM1B	; Jump if not a TVT
	JUMPGE LINBLK,REXM1B	; Jump if already have line locked
	LOAD T2,TVTL,(TCB)	; Get the line number
	JUMPLE T2,REXM1B	; TVTL may be 0 if RXing a SYN
	CALL LCKTTY		; Lock and get ptr to dynamic block
	  JUMPLE T2,REXM1A	; Not init'd yet
	MOVEM T2,LINBLK
	JRST REXM1B
REXM1A:	CALL ULKTTY
REXM1B:

; Common processing

	LOAD T1,PIDO,(PKT)	; Internet data offset in words
	XMOVEI TPKT,PKTELI(PKT)	; Pointer to Internet portion
	ADD TPKT,T1		; Pointer to TCP portion
	SKIPN TCPON		; Force error if TCP is turned off
	  JRST REXMI2
; If this is the first retransmission of this packet, reinitialize
; the retransmission parameters (Initial interval and discard
; time).   Since this is done as each packet appears at Send.Left,
; timeouts are avoided in the case where the receiver is very slow.

	JN PRXD,(PKT),REXM11	; Pkt has been RX'd at least once
	LOAD T1,PSEQ,(TPKT)	; Packet sequence number
	LOAD T2,TSLFT,(TCB)	; Send Left
	LOAD T3,PESEQ,(PKT)	; End sequence of the Packet
	CALL CHKWND		; Is Left within this Pkt?
	JUMPE T1,REXMI3		; No.  Retransmit if needed.
	CALL SETRXP		; Initialize the RX parameters
REXM11:

; This packet contains TSLFT or has already been retransmitted
; Check for Retransmission timeout

	LOAD T1,PDCT,(PKT)	; Get discard time for this pkt
	JUMPE T1,REXMI3		; Jump if no discard time specified
	CAML T1,TODCLK		; Packet undeliverable?
	  JRST REXMI3		; Not yet.

; A pkt has not been ACKed within the (send) timeout specified
; by the user, or TCP has been shut off (TCPON is 0)

REXMI2:	MOVEI T1,ELP+^D9	; "Retransmission timeout"
	CALL USRERR		; Tell the user
	MOVEI T1,ELP+^D14	; "Connection reset"
	CALL ABTCON		; Abort the connection
	JRST REXMIX		; Return to caller

; See if it is time to retransmit this packet.

REXMI3:	LOAD NXRXI,PRXI,(PKT)	; Get the current retransmit interval
	JN PINTL,(PKT),REXMI6	; Cannot RX if last still unsent

	LOAD T1,PXT,(PKT)	; Time of last transmission
	ADD NXRXI,T1		; Plus interval is time to RX
	SUB NXRXI,TODCLK	; Time before next RX
	JUMPG NXRXI,REXMI6	; Not yet time, go reschedule
; Re-transmit the packet.  Refresh IP options that might have been changed

	CALL TCPIIO		; Hope user hasn't changed them
	MOVE NXRXI,TCPRXW	; Time to use if zero window (note that
	JE TSWND,(TCB),REXM36	; PRXI is unchanged but won't look til later)
	JE <TRXPN,TRXPD>,(TCB),REXM32 ; Use newer method
	LOAD T1,PRXI,(PKT)	; Get the current retransmit interval
	LOAD T2,TRXPN,(TCB)	; Numerator of backoff ratio
	LOAD T3,TRXPD,(TCB)	; Denominator
	IMULI T1,0(T2)
	IDIVI T1,0(T3)
	JRST REXM34

; Estimates based only on round trip time are essentially constant
; retransmissions, which looses if a large round trip time is usual.

REXM32:	JN PRXD,(PKT),REXM33	; Jump if multiple retransmissions
	LOAD T1,TSMRT,(TCB)	; Current round trip estimate
	IMUL T1,TCPRXV		; Increase by (scaled) variance
	ASH T1,@TCPRXF		; Remove scale factor
	JRST REXM34

; Until we have the estimate use a backoff factor of about 2.

REXM33:	LOAD T2,PTG,(PKT)	; Time packet generated
	MOVE T1,TODCLK		; Now
	SUB T1,T2		; Time packet has been unACKed
				; Essentially doubles RX interval
REXM34:
	CAMLE T1,TCPRXX		; Limit to maximum
	  MOVE T1,TCPRXX
	STOR T1,PRXI,(PKT)	; Store back in the packet header
	MOVEM T1,NXRXI		; Save for signal
REXM36:
; Before queueing the packet for an interface, set RXd flag

	SETONE PRXD,(PKT)	; Indicate that packet has been RXd
	MOVX T1,PT%XX8		; Code for "being retransmitted"
	TDNE T1,INTTRC		; Want trace?
	  CALL PRNPKT		; Yes, tell the packet printer
	MOVE T1,LINBLK		; TVT block if any
	CALL EMTPKT		; Send off the packet
REXMI5:
	AOS RXPKCT		; Count retransmitted packets

; Now reschedule Retransmitter to run again when this packet should
; again be retransmitted

REXMI6:	XMOVEI T1,RX		; What to signal
	MOVE T2,NXRXI		; The desired interval
	CALL SIGNAL		; Cause ourself to run later
REXMIX:	SKIPL T2,LINBLK		; Running for a TVT?
	  CALL ULKTTY		; Yes.  Unlock it
	RESTORE
	RET
;SETRXP
;Initialize retransmission parameters in a pkt.

;PKT/	(Extended) Packet pointer
;(TPKT/	(Extended) pointer to TCP part of packet)
;TCB/	(Extended) Locked connection block
;	CALL SETRXP
;Ret+1:	Always

SETRXP:

; Set packet discard time
; How should Source-quench & send timeout interact?

	LOAD T1,TSTO,(TCB)	; Send time out set by user
	SKIPE T1		; Use 0 if none specified
	  ADD T1,TODCLK		; Else compute the deadline
	STOR T1,PDCT,(PKT)	; Set the discard time in the packet

; Set initial retransmission interval

	JE <TRXPN,TRXPD>,(TCB),SETRX4 ; Use newer method
	LOAD T1,TRXI,(TCB)	; Get estimated Retrans. Interval.
	SKIPG T1		; Guard against bad extimate of rnd trip
	  MOVE T1,TCPDXI	; Choose default interval in that case
	LOAD T2,TRXPI,(TCB)	; Get possible user setting
	IMULI T2,^D1000		; Convert to milliseconds
	SKIPE T2		; Did user set retrans parameters?
	  MOVE T1,T2		; Yes.  Use that initial interval
	JRST SETRX6

SETRX4:	LOAD T1,TSMRT,(TCB)	; Get estimated round trip time
	IMUL T1,TCPRXV		; Increase by (scaled) variance
	ASH T1,@TCPRXF		; Remove scale factor
SETRX6:
	CAMLE T1,TCPRXX		; Keep within bounds
	  MOVE T1,TCPRXX
	CAMGE T1,TCPRXN		; both ends.
	  MOVE T1,TCPRXN
	SKIPE INTTRC		; Actively tracing packets?
	  IMULI T1,^D1 ;8	; Slow down retransmissions
	STOR T1,PRXI,(PKT)	; Set packet retrans interval
	RET
;RXPARS(TCB)
;Change retransmission parameters.

; Called by SEND and OPEN which allow the caller to change the
; retransmission characteristics -- Backoff rate and initial
; retransmission interval.

;TCB/	(Extended) Locked Connection Block
;T1/	Retrans. parameter word.  Format is that of TRXP.
;	CALL RXPARS
;Ret+1:	Always.

;Note:  Newly created TCBs have 0 in the TRXP word which
;means that the user has not chosen to override the use of
;measured round trip time as the way of selecting the retrans
;interval.  If the user sets TRXP, those parameters are used.

RXPARS::
	JUMPE T1,RXPARX		; No change wanted
	LOAD T2,TRXP,(TCB)	; Current settings
	CAMN T1,T2		; Different?
	  JRST RXPARX		; No.
	STOR T1,TRXP,(TCB)	; Put them in place for LOADs
	LOAD T2,TRXPN,(TCB)	; Get numerator
	LOAD T3,TRXPD,(TCB)	; and denominator of backoff fraction
	LOAD T4,TRXPI,(TCB)	; Initial interval in seconds
	SKIPN T2		; Get defaults
	  MOVE T2,TCPDXN
	SKIPN T3
	  MOVE T3,TCPDXD
	SKIPN T4
	  MOVE T4,TCPDXI
	CAMLE T3,T2		; Prevent interval from decreasing
	  MOVE T3,T2
	STOR T2,TRXPN,(TCB)	; Set it all into the TCB
	STOR T3,TRXPD,(TCB)
	STOR T4,TRXPI,(TCB)
RXPARX:	RET
;RXINI
;Initialize RX process block.

;	CALL RXINI
;Ret+1:	ALways, T1 zero if error

RXINI: 	LOCAL <PRC>
	XMOVEI PRC,RX		; Pointer to the Process block for RX
	MOVX T1,QSZ		; Size of a queue head
	CALL GETBLK		; Head must be in same section as items
	JUMPE T1,RXINIX		; No room
	MOVEM T1,PRCQ(PRC)	; Input queue
	CALL INITQ		; Initialize it
	XMOVEI T1,PRCLCK(PRC)	; Lock
	CALL CLRLCK		; Initilize it
	XMOVEI T1,REXMIT	; Retransmitter function
	MOVEM T1,PRCROU(PRC)	; Routine address
	SETOM PRCWAK(PRC)	; No run time yet
	MOVE T1,[<GIW TCBQRX,TCB>]; Offset of RX queue in TCB
	MOVEM T1,PRCQOF(PRC)	; Store process block
	MOVE T1,[<GIW TCBTRX,TCB>]; Offset of RX run time in TCB
	MOVEM T1,PRCWOF(PRC)	; Store in process block
	HRLOI T1,377777		; Infinity
	MOVEM T1,PRCSGT(PRC)	; Set time of most recent signal
	XMOVEI T1,RXRNCT	; Pointer to run counter
	MOVEM T1,PRCRNC(PRC)	; Put in standard place
	XMOVEI T1,RXUSE		; Pointer to CPU use meter
	MOVEM T1,PRCTMR(PRC)	; Put in standard place
RXINIX:	RESTORE
	RET
	SUBTTL	TCP Background Routines

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

Routines  run  periodically at a low rate to check for things such as
dead (closed) TCBs and connections which need to be  poked  in  order
that they resynchronized.

!

;BACKG		Top level of background
;	CALL BACKG
;Ret+1:	Always

BACKG:	SAVEAC <PKT,TPKT>
	MOVEI T1,TCBHLK		; Which lock to set
	XMOVEI T2,SCAN		; Function to run
	CALL LCKCAL		; Lock the lock and run the function
	SKIPE INTSVR		; Was a scavenge requested?
         AOS INTSVC		; Yes.  Count it as having been done
	SETZM INTSVR		; Cancel scavenge request
	MOVX T1,PT%XX0		; Indicate no packet
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes, Flush out the packet printer buffer
	MOVE T1,TCPBGT		; Run again in a few seconds
	ADD T1,TODCLK
	MOVEI T2,BG		; Pointer to Background process block
	MOVEM T1,PRCWAK(T2)	; BG has no input queue.
	NOSKD1			; Take the machine
 	IFE REL6,<CALL TVTCSO>	; Force scan of TVT for output
 	IFN REL6,<CALLX (MSEC1,TVTCSO)> ; Force scan of TVT for output
	 NOP
	OKSKD1			; Give back the machine
	RET
;SCAN
;Scan through all TCBs and apply the functions to each

;TCBH/	Locked, NOINT
;	CALL SCAN
;Ret+1:	Always

SCAN:  	SAVEAC <TCB>
	LOCAL <TCBHX,NXTTCB,Q,DEADQ>
	MOVE T1,TCBDQ		; Locate queue head
	MOVEM T1,DEADQ		; Save pointer to the queue
	MOVEI T1,TCBHUC		; Pointer to TCBH Use Count
	SKIPE TCBHUC		; Is it 0 as required?
	  CALL DISE		; No.  Wait for that.
	MOVSI TCBHX,-TCBHSZ	; Set to loop through all of TCBH
SCAN1:	HRRZ Q,TCBHX		; Index into TCBH table
	ADD Q,TCBH		; Plus (ext) pointer to table base
	LOAD NXTTCB,QNEXT,(Q)	; Pointer to first thing on this queue
	SETSEC NXTTCB,INTSEC	; Make extended address
SCAN2:	MOVE TCB,NXTTCB		; Set current TCB
	CAMN TCB,Q		; Back to head of queue?
         JRST SCAN3		; Yes.  On to next queue
	LOAD NXTTCB,QNEXT,(TCB)	; Setup for next time
	SETSEC NXTTCB,INTSEC	; Make extended address
	XMOVEI T1,TCBLCK(TCB)	; Pointer to lock
	XMOVEI T2,FUNCS		; Routine to apply functions
	MOVE T3,DEADQ		; Arg for DEADP
	CALL LCKCAL		; Lock the TCB and do the functions
	JRST SCAN2		; Go to next TCB on this queue
SCAN3:	AOBJN TCBHX,SCAN1	; On to next queue
	MOVE Q,DEADQ		; Queue of dead TCBs
	LOAD NXTTCB,QNEXT,(Q)	; First thing on the queue
	SETSEC NXTTCB,INTSEC	; Make extended address
SCAN4:	MOVE TCB,NXTTCB		; Advance down the queue
	LOAD NXTTCB,QNEXT,(TCB)	; Set for next time
	SETSEC NXTTCB,INTSEC	; Make extended address
	CAMN TCB,Q		; Back to head?
	  JRST SCANXX		; Yes.  Done.
	CALL REMBFS		; Remove all buffers from TCPDBQ
	LOAD T1,TOPNF,(TCB)	; Get open/close wait bit index
	CALL RELWTB		; Release it
	LOAD T1,TERRF,(TCB)	; Get error wait flag number
	CALL RELWTB		; Release it
	XMOVEI T1,TCBLCK(TCB)	; Pointer to the lock
	CALL RELLCK		; Delete that
	MOVE T1,TCB
	CALL DQ			; Dequeue from dead queue
	CALL RETBLK		; Return the storage
	SOS TCBCNT		; Now one less connection
	JRST SCAN4

SCANXX:	RESTORE
	RET
;FUNCS
;Apply a list of functions to a TCB

;TCB/	(Extended) Locked connection block
;T1/	(Extended) Pointer to queue head for dead TCBs
;TCBHLK/Locked		NOINT
;	CALL FUNCS
;Ret+1:	Always

FUNCS:	PUSH P,T1		; Arg is pointer to dead queue head
	SKIPE INTSVR		; Scavenge free storage requested?
	  CALL SCAVNG		; Yes.  Do it to this TCB.
	CALL UPDATE		; Update Retransmission variables
	CALL FIXHNG		; FLush Hung TCBs
	POP P,T1		; Get back arg for DEADP
	CALL DEADP		; Check for completely closed
	RET

;FIXHNG 
;Flush hung TCB's by aborting them. The better way of dealing with this
;problem  is to not put TCB's into a hung state, but until such time as
;someone solves that problem, we'll use this after the fact method. TCB
;must satisify the following criteria:
;	- owned by job zero, associated with a TVT, TVT line number is zero
;	- RCV.SND state is EST.NOT
;Takes TCB/ pointer to locked TCB
;Returns +1 always

FIXHNG:	JN TOWNR,(TCB),R	; Quit if TCB owner is other than job zero
	JE TTVT,(TCB),R		; Quit if TCB not associated with a TVT
	JN TVTL,(TCB),R		; Quit if TVT is still there
	LOAD T1,TSSYN,(TCB)	; Get Send state
	CAIE T1,NOTSYN		; NOT?
	 RET			; Quit if send side still active
	LOAD T1,TRSYN,(TCB)	; Get Recv state
	CAIE T1,SYNCED		; EST?
	 RET			; Quit if receive side is other than active
	MOVEI T1,EFP+^D7	; T1/ error code is "Connection RESET"
	CALL ABTCON		; Flush buffers, set to NOT.NOT
	RET			; Return to caller

;REMBFS(TCB, TCPBDQ)
;Remove buffers owned by dead TCB

;TCB/	(Extended) Pointer to dead TCB
;	CALL REMBFS
;Ret+1:	Always

REMBFS:	SAVEAC <BFR>
	LOCAL <NEXT>
	MOVE BFR,TCPBDQ		; Get pointer to queue head
	LOAD NEXT,QNEXT,(BFR)	; Get first thing on queue
REMBF1:	SETSEC NEXT,INTSEC	; Make extended address
	MOVE BFR,NEXT
	CAMN BFR,TCPBDQ		; Points at head...
	  JRST REMBFX		; means we are done
	LOAD NEXT,QNEXT,(BFR)	; Get next item on queue
	LOAD T1,BTCB,(BFR)	; Get owning TCB
	SETSEC T1,INTSEC	; Make extended address
	CAME T1,TCB		; Is it the one under consideration?
	  JRST REMBF1		; No.  Try next.
	MOVE T1,BFR		; What to dequeue
	CALL DQ			; Do it.
	CALL RETBLK		; And return the storage
	JRST REMBF1		; Scan some more

REMBFX:	RESTORE
	RET
;UPDATE
;Update retransmitter control variables

;TCB/	(Extended) Locked Connection Block
;TCBHLK/Locked		NOINT
;	CALL UPDATE
;Ret+1:	Always

UPDATE:	JE <TRXPN,TRXPD>,(TCB),UPDATX ; Omit if newer algorithm
	LOAD T1,TMXRT,(TCB)	; Maximum round trip time (millisec.)
	LOAD T2,TMNRT,(TCB)	; Minimum
	MOVE T3,T1
	SUB T3,T2		; Delta
	IDIVI T3,2		; Decay 50% towards min.
	SUB T1,T3
	STOR T1,TMXRT,(TCB)	; Set new max.
	IDIVI T3,5
	ADD T2,T3		; Expand by 10% towards max.
	STOR T2,TMNRT,(TCB)	; Set new min.
	ADD T1,T2		; 2 times new average
	ADDI T1,^D1000		; Arrange for a half second above average
	ASH T1,-1
	STOR T1,TRXI,(TCB)	; Is the new retransmit interval
UPDATX:	RET
;DEADP
;Collect dead (closed) TCBs on a queue

;T1/	(Extended) Pointer to head of DEAD Queue
;TCB/	(Extended) Locked connection block to be examined
;TCBHLK/Locked		NOINT
;	CALL DEADP
;Ret+1:	Always. TCB placed on dead queue if appropriate

DEADP:	LOCAL <DEADQ>
	MOVEM T1,DEADQ
	JN TSUOP,(TCB),DEADPX	; Keep if no CLOSE from user yet

; TVT processing

	JE TTVT,(TCB),DEADP1	; Jump if not a TVT
	LOAD T2,TVTL,(TCB)	; Get tvt line number, if any
	JUMPE T2,DEADP2		; Jump if no line number
	NOSKD1			; Don't let tty data change under us
	CALL STADYN		; Get tty datablock, if any
	 TDZA T1,T1		; Skip load if line not active
	  LOAD T1,PTVT,(T2)	; Get tcb pointer, if any
	OKSKD1			;
	JUMPN T1,DEADPX		; Keep if tty datablock points to it
DEADP2:
	JN TERR,(TCB),DEADP0	; Jump to release JCN if error
	LOAD T1,TRSYN,(TCB)	; Receive state
	LOAD T2,TSSYN,(TCB)	; Send state
	CAIN T1,NOTSYN		; No error & FINs exchanged
	 CAIE T2,NOTSYN
	  JRST DEADP1		; Jump if not dead state (closed)
DEADP0:
	LOAD T1,TJCN,(TCB)	; Get the JCN (owned by INTFRK)
	JUMPE T1,DEADP1		; Jump if USREVT already released it
	CALL RETJCN
	SETZRO TJCN,(TCB)	; (RETJCN can't do this if JCN = -1)
DEADP1:
; Common processing

	JN TJCN,(TCB),DEADPX	; Keep if user can still reference this
	LOAD T1,TSSYN,(TCB)	; Send state
	LOAD T2,TRSYN,(TCB)	; Recv state
	CAIN T1,NOTSYN
	CAIE T2,NOTSYN
         JRST DEADPX		; Keep unless FINd on both sides
	LOAD T1,QNEXT,<+TCBRXQ(TCB)>
	CAIE T1,TCBRXQ(TCB)	; Compare as if in sec. 0
         JRST DEADPX		; Keep if retransmit queue non-empty
	LOAD T1,QNEXT,<+TCBSBQ(TCB)>
	CAIE T1,TCBSBQ(TCB)
         JRST DEADPX		; Keep if stuff waiting to be sent
	JN TSCB,(TCB),DEADPX	; Which might be a current SEND buffer
	LOAD T1,QNEXT,<+TCBRPQ(TCB)>
	CAIE T1,TCBRPQ(TCB)
         JRST DEADPX		; Keep if packets waiting for RA
	LOAD T1,QNEXT,<+TCBRBQ(TCB)>
	CAIE T1,TCBRBQ(TCB)
         JRST DEADPX		; Keep if RECV buffers waiting
	JN TRCB,(TCB),DEADPX	; or if there is a current RECV buffer
	SKIPN TCBQRA(TCB)	; Must not be queued for RA
	SKIPE TCBQPZ(TCB)	; Or PZ
         JRST DEADPX
	SKIPN TCBQRX(TCB)	; Or RX
	SKIPE TCBQDG(TCB)	; Or DG
         JRST DEADPX
	MOVE T1,TCB
	CALL DQ			; Dequeue the buffer from the TCBH queue
	MOVE T2,DEADQ
	CALL NQ			; And put on the Dead queue
DEADPX:	RESTORE
	RET
;SCAVNG
;Scavenge  free  storage  from  connection blocks. All packets on the
;reassembly  queue  are  released  to  permit  the  TCP  to  continue
;functioning. Retransmissions will replace them.

;TCB/	(Extended) Locked Connection block
;TCBHLK/Locked		NOINT
;	CALL SCAVNG
;Ret+1:	Always

SCAVNG:	SAVEAC <PKT>
SCAVN1:	LOAD PKT,QNEXT,<+TCBRPQ(TCB)>	; Get first thing on RA queue
	CAIN PKT,TCBRPQ(TCB)	; Empty if that is the head itself
         JRST SCAVNX		; No more to get from this connection
	SETSEC PKT,INTSEC	; Make extended address
	MOVE T1,PKT		; What to dequeue
	CALL DQ			; Take it off the receive packet queue
	CALL RETPKT
	JRST SCAVN1
SCAVNX:	RET
;BGINI
;Initialize BG process block

;	CALL BGINI
;Ret+1:	ALways

BGINI:	LOCAL <PRC>
	MOVEI PRC,BG		; Pointer to the Process block for BG
	SETZM PRCQ(PRC)		; Input queue
	MOVEI T1,QSZ		; Size of a queue head
	CALL GETBLK		; Head must in same section as items
	JUMPE T1,BGINIX		; Give up, T1 is zero
	CALL INITQ		; Initialize it (not used)
	MOVEM T1,TCBDQ		; Queue head for SCAN
	XMOVEI T1,PRCLCK(PRC)	; Lock
	CALL CLRLCK		; Initilize it
	XMOVEI T1,BACKG		; Background function
	MOVEM T1,PRCROU(PRC)	; Routine address
	MOVE T1,TODCLK		; Now
	ADD T1,TCPBGT		; Plus a few seconds
	MOVEM T1,PRCWAK(PRC)	; Start BG for the first time
	SETZM PRCWOF(PRC)	; Store in process block
	MOVEI T1,BGRNCT		; Pointer to run counter via section 0
	MOVEM T1,PRCRNC(PRC)	; Put in standard place
	MOVEI T1,BGUSE		; Pointer to CPU use meter
	MOVEM T1,PRCTMR(PRC)	; Put in standard place
	MOVX T1,QSZ		; Size of a queue head
	CALL GETBLK		; Get that amount of free storage
	  JUMPE T1,BGINIX	; Lose
	MOVEM T1,TCBDQ		; Used at cleanup (don't want to fail then)
	CALL INITQ		; Initialize it
	HRROI T1,-1
BGINIX:
	RESTORE
	RET
	SUBTTL	TCP Delayed Actions

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

Delayed  actions  are  those things which must happen after some time
delay. No event in the TCP can  be  counted  on  to  kick  off  these
functions.

!
;FAKEAK
;Fake  input  of an ACK for final outstanding FIN. This occurs if the
;final ACK gets lost in the network  for  more  than  the  prescribed
;number  of  seconds.  It  is  necessary because the final ACK cannot
;itself be ACKd and therefore cannot have guaranteed delivery.

;TCB/	(Extended) Connection block (locked)
;	CALL FAKEAK
;Ret+1:	Always.

FAKEAK:	LOAD T1,TSSYN,(TCB)	; Get send state
	LOAD T2,TRSYN,(TCB)	; Get recv state
	CAIN T1,FINSNT		; Do we have an outstanding FIN?
	CAIE T2,NOTSYN		; and recv side closed?
	 JRST FAKEAX		; A bug? FAKEAK should not be called?
	XMOVEI T1,TCBRXQ(TCB)	; Pointer to the Retransmit queue
	LOAD T2,TSLFT,(TCB)	; Send Left
	LOAD T3,TSSEQ,(TCB)	; Send Sequence (1 after FIN)
	SETZ T4,		; Say it is not a Recv queue
	CALL REMSEQ		; Clear all that is outstanding
FAKEAX:	RET
;DYINI
;Initialize DG process block

;	CALL DYINI
;Ret+1:	ALways, T1 zero if error

DYINI:	LOCAL <PRC>
	MOVEI PRC,DY		; Pointer to the Process block for DG
	MOVEI T1,QSZ		; Size of a queue head
	CALL GETBLK		; Head must be in same section as items
         JUMPE T1,DGINIX	; Error return if no memory
	MOVEM T1,PRCQ(PRC)	; Input queue
	CALL INITQ		; Initialize it
	XMOVEI T1,PRCLCK(PRC)	; Lock
	CALL CLRLCK		; Initilize it
	XMOVEI T1,FAKEAK	; The only DG function!
	MOVEM T1,PRCROU(PRC)	; Routine address
	SETOM PRCWAK(PRC)	; No run time yet
	MOVE T1,[<GIW TCBQDG,TCB>]; Offset of DG queue in TCB
	MOVEM T1,PRCQOF(PRC)	; Store process block
	MOVE T1,[<GIW TCBTDG,TCB>]; Offset of DG run time in TCB
	MOVEM T1,PRCWOF(PRC)	; Store in process block
	HRLOI T1,377777		; Infinity
	MOVEM T1,PRCSGT(PRC)	; Set time of most recent signal
	MOVEI T1,DGRNCT		; Pointer to run counter via section 0
	MOVEM T1,PRCRNC(PRC)	; Put in standard place
	MOVEI T1,DGUSE		; Pointer to CPU use meter
	MOVEM T1,PRCTMR(PRC)	; Put in standard place
DGINIX:	RESTORE
	RET
    	SUBTTL	TCP Miscellaneous Routines

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

;CHKWND
;CheckWindow(Left, Sequence, Right)

;Test  "Sequence"  to  see  if  it  is between "Left" (inclusive) and
;"Right" (not incl.). Sequence numbers  are  modulo  MAXSEQ  and  are
;always positive when represented in a 36-bit word.

;T1/	Left
;T2/	Sequence
;T3/	Right
;	CALL CHKWND
;Ret+1:	always.  T1 has -1 if Sequence is in the window, 0 if not

CHKWND::TEMP <VAL,SEQ,RIGHT,LEFT>
	MOVEM T1,LEFT		; Make T1 available for value
	SETZ VAL,		; Init value
	CAMG LEFT,RIGHT		; Crosses 0?
	 SOSA VAL		; No. Get a -1 to return
	  EXCH LEFT,RIGHT	; Yes.  Reverse Left and Right.
	CAMGE SEQ,RIGHT
	 CAMGE SEQ,LEFT
	  SETCA VAL,		; Out of window.  Complement initial guess
	RESTORE
	RET
;OVRLAP
;Test for sequence number overlap

;Test  to see if two sequence number segments have one or more common
;points. The two segments are semi-open  on  the  right,  similar  to
;CHKWND.

;T1/	Left1
;T2/	Right1
;T3/	Left2
;T4/	Right2
;	CALL OVRLAP
;Ret+1	always, T1 is -1 if overlap exists, 0 if not

OVRLAP:	LOCAL <LEFT1,LEFT2,RIGHT2>
	MOVEM T1,LEFT1
	DMOVEM T3,LEFT2		; T3,T4 to LEFT2,RIGHT2
	EXCH T2,T3
	CALL CHKWND
	JUMPN T1,OVRLAX
	MOVE T1,LEFT2
	MOVE T2,LEFT1
	MOVE T3,RIGHT2
	CALL CHKWND
OVRLAX:	RESTORE
	RET
;ONLCLT
;Check timebase of sending host

;Test  to see if the current packet was sent by a host which is using
;the same timebase as this host. So that we will  know  if  the  time
;stamp is valid

;PKT/	(Extended) Pointer to the packet under consideration
;	CALL ONLCLT
;Ret+1:	always, T1 non-0 if packet has a useable timestamp

ONLCLT:	LOAD T1,PISH,(PKT)	; Get the 32-bit source address
	CALL LCLHST		; Is it me?
         SETZ T1,		; No, clear T1
	RET

;GETISN
;Get value of initial sequence number curve

;Get  the  current  value  of the Initial Sequence Number curve. This
;curve is a straight line which starts at  0  and  goes  through  the
;maximum  sequence number minus 1 every cycle time of the network. It
;steps once a second.

;	CALL GETISN
;Ret+1:	always, ISN in T1

GETISN:
	CALL LGTAD		; Day,,tick
	HRRZS T1		; Save tick with day
	LSH T1,^D17		; Make into binary fraction of day

; TCPISN is [^D<<MAXSEQ/8>*<<24*60*60>/CYCTIM>>]

	MUL T1,TCPISN		; Get sequence number
	LSH T1,@TCPISN+1	; Scale factor of 8 above
	MODSEQ T1
	RET
;PKTEND(PKT)
;returns the sequence number following the packet

;PKT/	(Extended) Packet pointer
;TPKT/	(Extended) pointer to TCP part of packet
;	CALL PKTEND
;Ret+1:	always.  End of packet plus one in T1

PKTEND:	LOAD T1,PSEQ,(TPKT)	; Get the start of the packet
	LOAD T2,PCTL,(TPKT)	; Get word containing control flags
	TXNE T2,<PSYN>		; Count one for SYN
         ADDI T1,1
	TXNE T2,<PFIN>		; Another if FIN
         ADDI T1,1
	LOAD T2,PIPL,(PKT)	; Length of whole packet in bytes
	LOAD T3,PIDO,(PKT)	; Number of words in Internet part
	LOAD T4,PTDO,(TPKT)	; Number of words in TCP header
	ADD T3,T4		; Total header word count
	ASH T3,2		; Byte count
	SUB T2,T3		; Difference is # bytes in data part
	ADD T1,T2		; Each data byte is one sequence slot
	MODSEQ T1		; Take MOD field size
	RET

;CHKWND
;CheckWindow(Left, Sequence, Right).
;OVRLAP
;Test for sequence number overlap.
;ONLCLT
;Check timebase of sending host.
;GETISN
;Get value of initial sequence number curve.
;PKTEND(PKT)
;returns the sequence number following the packet.
;NULPKT(PKT)
;Tells if packet doesn't contain anything ACK-able.

;PKT/	(Extended) Packet pointer
;TPKT/	(Extended) pointer to TCP part of packet
;	CALL NULPKT
;Ret+1:	Always.  T1 -1 if packet is null, 0 if something

NULPKT:	SETZ T1,		; Assume something ackable
	LOAD T2,PIPL,(PKT)	; Total packet length
	LOAD T3,PIDO,(PKT)	; Offset to Internet data in words
	LOAD T4,PTDO,(TPKT)	; Offset to TCP data in words
	ADD T3,T4		; Number of header words, total
	ASH T3,2		; Number of header bytes, total
	CAMLE T2,T3		; Anything in TCP data part?
         JRST NULPKX		; Yes.  Packet is not null
	LOAD T2,PCTL,(TPKT)	; Get word of control flags
	TXNN T2,<PSYN!PFIN>
	  SETO T1,		; No data, no control.  Pkt is null.
NULPKX:	RET
;TRMPKT(PKT)
;Return excess storage not used in packet block.

;PKT/	(Extended) Packet pointer
;TPKT/	(Extended) pointer to TCP part of packet
;	CALL TRMPKT
;Ret+1:	Always.  PKT may come back 0 if storage unavailable.
; Copy the little piece into a new block.
; Return all of the whole (big) packet.

TRMPKT:	JE PFSIZ,(PKT),TRMPKX	; Only full-size packets can be trimmed
	MOVE T1,INTNFI		; Number of free input buffer right now
	CAML T1,INTNIB		; Number desired
         EXIT TRMPKX		; No reason to trim.  Space not tight.
	LOAD T1,PIPL,(PKT)	; Internet Packet Length in bytes
	ADDI T1,<4*PKTELI>+3	; Total length, set to round up
	ASH T1,-1		; Twice number of words in packet
	CAML T1,INTXPW		; Too big.  Wont leave a useful tail.
         EXIT TRMPKX		; or lengths smashed on input packet?
	ASH T1,-1		; # words in packet
	PUSH P,T1		; Save the new size
	MOVX T1,PT%TTP		; Going to trim packet
	TDNE T1,INTTRC		; Want trace?
         CALL PRNPKT		; Yes
	MOVE T1,(P)		; New size, w
	CALL GETBLK		; And get a new little chunk
	POP P,T2		; Get back size
	JUMPE T1,[MOVX T1,PT%TKT ; Killed because no space
		TDNE T1,INTTRC	; Want trace?
		  CALL PRNPKT	; Yes
		JRST TRMPK9]	; Don't copy into non-X packet
	PUSH P,T1		; Save for later
	XMOVEI T3,PKTSII(T1)	; Destination
	MOVEI T1,-PKTSII(T2)	; Number of words to copy
	XMOVEI T2,PKTSII(PKT)	; Source
	CALL XBLTA		; Do a BLT
	POP P,T1		; Restore destination pkt ptr
	SETZM PKTQ(T1)		; Indicate not queued
	SETZRO PFLGS,(T1)	; Clear all internal flags
TRMPK9:
	PUSH P,T1		; Save pointer to the new packet (or 0)
	MOVE T2,TPKT		; Parallel pointer to TCP portion
	SUB T2,PKT		; Compute offset
	PUSH P,T2		; Save it
	CALL RETPKT		; Return be big piece
	POP P,TPKT		; Get back offset
	POP P,PKT		; Here's the replacement (or 0)
	ADD TPKT,PKT		; Reconstruct pointer
TRMPKX:	RET

;LCKCAL(Lock, Fn, Arg1, Arg2)
; Call Fn(Arg1, Arg2) with Lock set & NOINT
;T1/	(Extended) Lock pointer
;T2/	(Extended) Function address
;T3/	Arg1
;T4/	Arg2
;	CALL LCKCAL
;Ret+1:	always.  T1 has value of Fn(Arg1, Arg2)
; Can be used for cross-section calls

LCKCAL::PUSH P,T1		; (Ext) Lock address (save for UNLCK)
	PUSH P,T2		; (Ext) Function to CALL
	PUSH P,T3		; Save args from SETLCK
	PUSH P,T4
	MOVE T1,-3(P)		; Get pointer to the lock
	CALL SETLCK		; Test and set the lock (may wait)
	POP P,T2		; Put args in standard place for a call
	POP P,T1
	CALL @0(P)		; Call function
	ADJSP P,-1		; Drop Function address
	EXCH T1,0(P)		; Save the value while we unlock...
	CALL UNLCK
	POP P,T1
	RET
;CHKADD
;Lookup up a connection and maybe create a new one.

;If  the  desired  (possibly  wild) connection is found, the argument
;function is called with the TCB locked. If  no  TCB  is  found,  the
;value of CHKADD is -1,,errorcode. Otherwise the value is that of the
;function called, which may also be an error value.

; T1/	(Extended) Pointer to argument block defined by CHKADL
;      	NOINT
;	CALL CHKADD
;Ret+1:	always.  Value in T1, TCB set up.  ELP+^D13. Illegal port (LP=0)
;	(net)	ELP+^D5. Pkt w/ wild FH/FP;  EFP+^D7.  No TCB matches
;	(JSYS)	ELT+^D4. No storage, wait bit, too many connections

CHKADD::
	STACKL <WILD1>
	CHKADL (<TCBX,TCB.FH,TCB.FP>) ; PARAMS & other LOCALs
	MOVEM T1,PARAMS		; Save pointer to parameters
	HRROI T1,ELP+^D13	; "Illegal port"
	SKIPN LP
         EXIT CHKADX		; Should never have to lookup wild LP
	HRROI T1,ELP+^D5
	SKIPE FP		; Wild FP and/or FH ok only if "listen"
	 SKIPN FH
	  SKIPE JCN		; Called from a JSYS?
	   CAIA
	 EXIT CHKADX		; Bad packet from network (FP=0 or FH=0)

; Get hash index to the TCB Hash table

	CALL HTLOCK		; GET UNIQUE ACCESS TO THE HASH TABLE
	MOVE T1,LP		; Local port is what is hashed on
	LSH T1,-3
	ADDI T1,^D23		; Hash LP into a TCBH index
	IMUL T1,LP
	IDIVI T1,TCBHSZ		; Size of the hash table
	ADD T2,TCBH		; (Ext) Location within TCBH
	MOVEM T2,TCBX		; Save the (ext) pointer to q head

; Scan the TCB queue which has its head in the slot at TCBX

	MOVE TCB,TCBX		; Initize the scan pointer
	SETZM WILD1		; No Wild match found yet
CHKAD4:	LOAD TCB,QNEXT,(TCB)	; Get next (first) thing on queue
	SETSEC TCB,INTSEC	; Make extended address
	CAMN TCB,TCBX		; Points back to head?
         JRST CHKAD6		; Yes.  Scan done.
	LOAD T1,TOWNR,(TCB)	; Get Job number which owns this tcb
	SKIPE JCN		; Any job ok if called from net side
	 CAMN T1,JOBNO		; Must stay in this job
	  CAIA			; OK to think about this TCB
	   JRST CHKAD4		; Skip it and try next
	LOAD T1,TLP,(TCB)	; Get the Local Port from this TCB
	CAME T1,LP		; Does it match what we are looking for?
         JRST CHKAD4		; No.  Try next TCB
	LOAD TCB.FH,TFH,(TCB)	; Get foreign host
	LOAD TCB.FP,TFP,(TCB)	; and foreign port
	CAMN TCB.FH,FH		; Compare these with what
	 CAME TCB.FP,FP		; is being sought
	  JRST CHKAD5		; Not an exact match.  Maybe OK for wild
	LOAD T4,TLH,(TCB)	; Check local address also
; TCB points to an exact match.  If CHKADD was called from the JSYS
;  side, it means the user is trying to say more about the connection.

	SKIPE JCN		; Called from a JSYS?
	  JRST CHKAD6		; Yes.  Go use this exact match.
	LOAD T1,TRSYN,(TCB)	; Get state of Receive synchronization
	LOAD T2,TSSYN,(TCB)	; and state of Send synch.
	CAIN T1,NOTSYN		; Recv side still open?
	 CAIE T2,NOTSYN		; Send side still open?
	  JRST CHKAD6		; Yes.  Reuse this TCB.
	JRST CHKAD4		; Both closed. Pkt cannot reactivate
				; conn.  Look for another incarnation.

; See if this TCB should be remembered for use as a wild one.

CHKAD5:	SKIPN WILD1		; Continue scan if already have a wild match
	 SKIPN WILDOK		; Caller says OK to use wild TCB?
	  JRST CHKAD4		; No.  Keep looking for exact match.
	JUMPE TCB.FH,.+3 	; TCB has wild foreign host
	CAME TCB.FH,FH		; or exact match means ok.
	  JRST CHKAD4		; No. Resume scan.
	JUMPE TCB.FP,.+3 	; Wild foreign port in TCB?
	CAME TCB.FP,FP		; or exact match?
	  JRST CHKAD4		; No good.
	MOVEM TCB,WILD1		; Save the location of the wild TCB
	JRST CHKAD4		; Continue looking for exact match.

; End of scan.  TCB has the TCB to use or points at queue head (TCBX)
; if none found.  WILD1 is 0 or pointer to a wild TCB.

CHKAD6:	CAME TCB,TCBX		; Found an exact match?
	  JRST CHKAD9		; Yes.  Go use TCB
	SKIPN WILD1		; Have a wild match?
	  JRST CHKAD7		; No.

; Bind a wild match.

	MOVE T1,FH		; Get the desired foreign host
	MOVE T2,FP		; and foreign port
	MOVE T3,LH		; and local host
	MOVE TCB,WILD1		; This is the TCB to work with
	STOR T1,TFH,(TCB)	; Store in the wild TCB
	STOR T2,TFP,(TCB)
	STOR T3,TLH,(TCB)
	JRST CHKAD9		; Do it.
; No wild match and no exact match.  If called from JSYS Create the connection.
; NOTE TCB=TCBX & WILD1=0

CHKAD7:	CAMN TCB,TCBX		; If have a TCB go to CHKAD9
	 SKIPN JCN		; Called from a JSYS?
	  JRST CHKAD9		; Net.  Don't create a TCB

; JSYS & no TCB

	MOVE T1,PARAMS		; Argument block address
	MOVE T2,TCBX		; (Ext) Where to enqueue the new TCB
	CALL NEWTCB		; Create it and initialize it.
	JUMPN TCB,CHKAD9	; Go use the new TCB
	MOVEI T1,TCBHLK		; Ran out of free storage.
	CALL UNLCK		; Unlock TCBH
	HRROI T1,ELT+^D4	; "No room for another connection"
	EXIT CHKADX		; Report the error to the caller

; TCB has the TCB to use or is equal to TCBX if not.

REPEAT 0,<
CHKAD9:	JRST CHKA10		; Following doesn't work, why??
	CAME TCB,TCBX		; Found a TCB?
	 SKIPN JCN		; And called from the JSYS side?
	  JRST CHKA10		; No.
	LOAD T1,TJCN,(TCB)	; Get original JCN of TCB
	JUMPE T1,CHKA10		; None.  Use the new one.
	EXCH T1,JCN		; Use the original JCN
	CAME T1,JCN		; If temporary one is different,
	  CALL RETJCN>		; Return it (RH of JCNTCB is 0)

; If a TCB was found/created, lock it and call the argument function.

CHKAD9:
CHKA10:	AOS TCBHUC		; Indicate TCBH has a reader
	CALL HTUNLK		; Unlock TCBH with use count gt 0
	HRROI T1,EFP+^D7	; "No such TCB"
	CAMN TCB,TCBX		; Did we locate a TCB?
         JRST CHKA11		; No. Report the error
	XMOVEI T1,TCBLCK(TCB)	; Pointer to the TCB Lock
	MOVE T2,FN		; Function to be called
	MOVE T3,JCN		; Argument for the function
	MOVE T4,ARG1		; The argument passed through
	CALL LCKCAL		; Lock the lock and call the function
CHKA11:	SOS TCBHUC		; Indicate TCBH may change now

CHKADX:	CHKADR			; Restore
	RET
;TCBINI
;Initialize the TCB Hash Table.

;	CALL TCBINI
;Ret+1:	Always

TCBINI:	LOCAL <TCBX>
	MOVEI T1,TCBHSZ*QSZ	; Size of the TCB Hash table
	CALL GETBLK		; Qs must point to things in same section!
	  JUMPE T1,TCBINX	; No space
	MOVEM T1,TCBH		; (Ext) Loc of hash table.
IF1 <IFN QSZ-1,<PRINTX ? QSZ isn't 1, Fix code>>
	MOVSI TCBX,-TCBHSZ	; Set to scan TCBH (assumes QSZ==1)
TCBIN1:	HRRZ T1,TCBX		; Index within TCBH table
	ADD T1,TCBH		; Pointer to table base
	CALL INITQ		; Initialize as a queue
	AOBJN TCBX,TCBIN1	; Loop over all slots
	SETZM TCBHUC		; Clear the use count
	XMOVEI T1,TCBHLK	; Pointer to the lock on TCBH
	CALL CLRLCK		; Initialize it
TCBINX:	RESTORE
	RET
; Routine to get unique access to the TCB Hash table.  This means having
; it locked with the TCBH Use Count = 0.

HTLOCK::
	XMOVEI T1,TCBHLK	; Pointer to the TCBH Lock
	CALL SETLCK		; Test and set the lock
	SKIPG TCBHUC		; TCBH Use Count.  Any readers?
	 RET			; OK we have sole access
	XMOVEI T1,TCBHLK	; Pointer to the lock
	CALL UNLCK		; Unlock it.
	MOVEI T1,TCBHUC		; Pointer to the use count
	CALL DISE		; Wait for it to go to zero
	JRST HTLOCK		; and try again.

HTUNLK::			; Hash table unlock routine
	MOVEI T1,TCBHLK		; Pointer to the TCBH lock
	CALL UNLCK		; Unlock the lock
	RET			; and return to caller

; Routine to get TCB Hash table index from local port number
; Local port is in T1.  Returned in T2.

TCBHSH::			; Get TCB hash
	MOVE T2,T1		; Save port number for a while
	LSH T1,-3		; Divide port by 8
	ADDI T1,^D23		; Add in a prime
	IMUL T1,T2		; Multiply by the local port number
	IDIVI T1,TCBHSZ		; Divide by the size of the hash table
	ADD T2,TCBH		; Get location within TCBH
	RET			; Return to caller
;NEWTCB
;Initialize a new connection block.

;T1/	PARAMS	; (Ext) address of parameter block
;T2/	TCBX	; (Ext) Adr of TCB Hash table entry
;	CALL NEWTCB
;Ret+1:	always.  TCB points to the TCB or is 0 if no space,
;		too many conn, no wait bits

NEWTCB:	CHKADL (TCBX)
	MOVEM T1,PARAMS		; Argument block address
	MOVEM T2,TCBX		; Where to enqueue new TCB
	MOVE T2,TCBCNT		; Current number of connections
	CAML T2,TCBMAX		; Test against max we support at once
         JRST NEWTCE		; No room for another.
	MOVX T1,TCBSIZ		; Size of a connection block
	CALL GETBLK		; Get a block of free storage
	JUMPE T1,NEWTCE		; None available.  Fail.
	MOVEM T1,TCB		; Put (ext) adr in standard place
	MOVX T2,TCBSIZ		; Size again for CLRBLK
	CALL CLRBLK
	MOVE T1,LH		; Set the local host
	STOR T1,TLH,(TCB)
	STOR T1,TOPLH,(TCB)
	MOVE T2,LP		; Set the local port
	STOR T2,TLP,(TCB)
	MOVE T3,FH		; Set the foreign host
	STOR T3,TFH,(TCB)
	STOR T3,TOPFH,(TCB)
	MOVE T4,FP		; Set the foreign port
	STOR T4,TFP,(TCB)
	STOR T4,TOPFP,(TCB)
	JUMPN T4,NEWTC0		; Wild foreign port?
	SETONE TWLDP,(TCB)	; Yes.
NEWTC0:
	EXCH 0,T3
	LOAD T4,NETCLS		; Get network class bit(s)
	EXCH 0,T3
	TDZ T3,INTCLS(T4)	; Drop class bit(s)
	TDZE T3,INTNET(T4)	; Net field zero?
         JRST NEWTC1		; No, but host might be.
	JUMPN T3,NEWTC2		; Yes, but host isn't, neither wild
	SETONE <TWLDN,TWLDT>,(TCB) ; Wild net & host
	JRST NEWTC2

NEWTC1:	JUMPN T3,NEWTC2		; Wild foreign host?
	SETONE TWLDT,(TCB)	; Yes. Wild host, net specified
NEWTC2:
	XMOVEI T1,TCBSBQ(TCB)	; TCB Send buffer queue
	CALL INITQ		; Initialize it.
	XMOVEI T1,TCBRXQ(TCB)	; TCB Retransmission queue
	CALL INITQ		; Initialize it.
	XMOVEI T1,TCBRBQ(TCB)	; TCB Receive buffer queue
	CALL INITQ		; Initialize it.
	XMOVEI T1,TCBRPQ(TCB)	; TCB Receive packet queue
	CALL INITQ		; Initialize it.
	CALL ASNWTB		; Assign a wait bit index for open/close
	JUMPL T1,NEWTC9		; Jump if we didn't get the bit.
	STOR T1,TOPNF,(TCB)	; Set into TCB
	CALL CLRWTB		; Initialize to zero state (closed)
	CALL ASNWTB		; Get another bit for error events
	JUMPL T1,NEWTC8		; Jump if that failed
	STOR T1,TERRF,(TCB)	; Set into TCB
	CALL CLRWTB		; Clear it.  (No error yet)
	XMOVEI T1,TCBLCK(TCB)	; Pointer to the TCB lock
	CALL CLRLCK		; Clear it.
	MOVX T1,^D60		; Default time to live
	STOR T1,TTTL,(TCB)	; for this connection
	MOVX T1,<<1B<35-WID(PIPL)>>-1>	; Max possible packet 2**16-1 octets
	STOR T1,TSMXP,(TCB)	; including headers
	XMOVEI T1,TCBQ(TCB)	; (Ext) Pointer to the TCB just initialized
	MOVE T2,TCBX		; (Ext) Adr of TCB Hash table entry (of Q's)
	CALL NQ			; Place it on the right queue
	AOS TCBCNT		; Count as another connection
	EXIT NEWTCX

NEWTC8:	LOAD T1,TOPNF,(TCB)	; Oh well.  Have to back out.
	CALL RELWTB		; Release the open/close wait bit
NEWTC9:	MOVE T1,TCB		; Pointer to the connection block
	CALL RETBLK		; Give back that storage
NEWTCE:	SETZ TCB,		; Tell caller the bad news.
NEWTCX:	CHKADR
	RET
;TSMXP
;Update maximum packet size generated on connection.

; T1/	Foreign specified limit (from option), or 0
;	CALL TCPMXP

TCPMXP:
	SAVEAC <P1>
	LOCAL <PSZ>
	SKIPLE PSZ,T1		; Save argument if specified
	 CAIL PSZ,177777	; Infinite size?
	  TRNA			; not ok to use
           JRST TCPMX6		; ok to use 
	LOAD T1,TFH,(TCB)	; Get foreign address
	CALL LCLHST		; Is it one of us?
	 SKIPA PSZ,[^D576]	; No, sociable maximum
	  MOVE PSZ,TCPBYS	; Yes, big ones

; Packet Radio Kludge - small packets to certain nets

	LOAD T2,TFH,(TCB)	; Foreign address contains
	NETNUM T2,T2		; Foreign net number
	CAIE T2,^D1		; BBN-PR
	 CAIN T2,^D2		; SF-PR-1
	  MOVEI PSZ,^D254
	CAIE T2,^D5		; SILL-PR
	 CAIN T2,^D6		; SF-PR-2
	  MOVEI PSZ,^D254
	CAIE T2,^D9		; BRAGG-PR
	 CAIN T2,^D47		; SAC-PR
	  MOVEI PSZ,^D254

; End of Kludge
; This isn't true if bypassing

TCPMX6:
	LOAD T1,TLH,(TCB)	; Foreigner's name for us
	CALL FNDNCT		; Put address of interface in T2
         CAIA			; Not found
          SKIPG T1,NTPSIZ(P1) 	; Get max size for that (interface) net
           MOVE T1,INTXPB	; None or 0, use maximum packet length
	CAMLE PSZ,T1		; Use it if smaller
	  MOVE PSZ,T1
	CAMLE PSZ,TCPBYS	; User want bigger than we support?
	  MOVE PSZ,TCPBYS	; Yes, Clamp to our max
	CAIGE PSZ,<.RTJST(-1,PIDO)+.RTJST(-1,PTDO)>*4+^D8 ; Beware too
	  MOVX PSZ,<<.RTJST(-1,PIDO)+.RTJST(-1,PTDO)>*4+^D8> ; small
	STOR PSZ,TSMXP,(TCB)	; Set max packet size for connection
	RESTORE
	RET
;TCPIPK
;Get space for packet and fill in headers.

; TCPIPK(Min size (w), Max siz (w) or 0, Adr of addresses or 0 if TCB)
; T1/	0 (or maximum) data length, in octets
; T2/	Address of address block, or 0 if addresses in TCB are valid
;	Address block:	32-bit Destination address
;			32-bit Source (local) address
;			16-bit Destination port
;			16-bit Source port
; TCB/	Contains addresses if T2 is zero; may be zero
;	Call TCPIPK
;Ret+1:	  Cannot get space for packet, or neither T2 nor TCB specified
;Ret+2:	Success, PKT & TPKT set, packet headers & options set
;	PICKS/	contains maximum PIPL allowed
;	PIPL/	header+option length
;	T1/	PICKS-PIPL is available	for data

TCPIPK:	LOCAL <SIZW,ADRS>
	MOVEM T2,ADRS		; Save Adr block address or 0
	ADD T2,TCB		; Make sure have TCB or Adr argument
	SKIPN T2		; Both T2 & TCB zero is error
	  JRST TCPIPV		; Lose

; Try to assign a block of free storage for the packet to be sent.

	MOVEI T2,TCPNPW		; Minimal packet (w/ max headers)
	EXCH T2,T1
	JUMPN T2,TCPIPB		; Use GETBBK for data
	MOVEM T1,SIZW		; Save minimal size
	CALL GETBLK		; Get block that big
	JUMPE T1,TCPIPV		; Lose
	JRST TCPIPC
TCPIPB:	ADDI T2,3		; Round up data count
	ASH T2,-2		; words
	ADD T2,T1
	CAMLE T2,INTXPW		; Don't ask for more than
	  MOVE T2,INTXPW	; Maximal pkt
	CALL GETBBK		; Get biggest block of free storage
	HLRZ SIZW,T1		; Size, wds, of block gotten, if any
	HRRZS T1		; Clear garbage from addr pointer
	JUMPE T1,TCPIPV		; Lose
	SETSEC T1,INTSEC	; Make extended address (GETBBK)
TCPIPC:	MOVE PKT,T1		; Put in standard place
	MOVEI T1,PKTELI+<<MINIHS+3>/4>-1 ; Clear through IP header
	XMOVEI T2,(PKT)		; Source
	XMOVEI T3,1(T2)		; Destination
	SETZM 0(T2)		; Clear a word.
	CALL XBLTA		; Clear the rest

; Fill in IP header

	MOVEI T1,.INTVR
	STOR T1,PIVER,(PKT)	; Store protocol version number
	MOVEI T1,<MINIHS+3>/4	; # words in smallest IN hdr
	STOR T1,PIDO,(PKT)	; Set as initial data offset
	ASH T1,2		; Length, bytes
	STOR T1,PIPL,(PKT)	; Current length
	AOS T2,TCPSID		; Get the next segment ID
	STOR T2,PISID,(PKT)	; Into packet
	SETO T3,		; Max time to live
	JUMPE TCB,TCPIPE	; No TCB values, use 0
	LOAD T3,TTOS,(TCB)	; Copy Type of Service
	STOR T3,PITOS,(PKT)
	LOAD T3,TIFDF,(TCB)	; Copy Don't Fragment flag
	STOR T3,PIDF,(PKT)
	LOAD T3,TTTL,(TCB)	; Copy Time to Live
TCPIPE:	STOR T3,PITTL,(PKT)	; Set Time to Live
	MOVEI T3,.TCPFM		; TCP format
	STOR T3,PIPRO,(PKT)	; Set into protocol field

; Stuff in all pertinent Internet options so we can know where
; the TCP portion will begin

	CALL TCPIIO		; Insert IP Options & adjust PIDO
				;  and PIPL (Note TCB may be 0)

; Set pointer to TCP portion of packet now that all internet
; options have been set or reserved.

	XMOVEI TPKT,PKTELI(PKT)	; Pointer to Internet portion
	LOAD T2,PIDO,(PKT)	; Internet data offset (inc opt)
	ADDB T2,TPKT		; T2 & TPKT now point at TCP area of pkt
	MOVEI T1,<<MINTHS+3>/4>-1 ; Clear it
	XMOVEI T3,1(T2)		; Destination
	SETZM 0(T2)		; Clear a word.
	CALL XBLTA		; Clear the rest

; Fill in IP addresses & TCP header

	SKIPN ADRS		; Address block specified?
	  JRST TCPIPH		; No, use TCB
	DMOVE T1,(ADRS)		; Get addresses from arg block
	DMOVE T3,2(ADRS)
	JRST TCPIPI
TCPIPH:	LOAD T1,TFH,(TCB)	; Destination address
	LOAD T2,TLH,(TCB)	; Source address
	LOAD T3,TFP,(TCB)	; Destination port
	LOAD T4,TLP,(TCB)	; Source port
TCPIPI:
	STOR T1,PIDH,(PKT)	; Store the destination host
	STOR T2,PISH,(PKT)	; Store the source host
	STOR T3,PDP,(TPKT)	; Store the destination port
	STOR T4,PSP,(TPKT)	; Store the source port
	MOVEI T1,<<MINTHS+3>/4>	; Minimum TCP header size
	STOR T1,PTDO,(TPKT)	; Set into TCP data offset field
	ASH T1,2		; Bytes in TCP header
	LOAD T2,PIPL,(PKT)	; Current IP header length (inc opt)
	ADD T2,T1		; Total IP+TCP header length
	STOR T2,PIPL,(PKT)	; Set Internet packet length

; Now the Internet header is initialized and we can add TCP options.

	CALL TCPITO		; Insert TCP options & update PTDO
				; and PIPL (Note TCB may be 0)

IFL <WID(PICKS)-WID(PIPL)>,<? PRINTX Width of PIPL exceeds that of PICKS>
	MOVEI T1,-PKTELI(SIZW)	; Words for IP+TCP+DATA
	ASH T1,2		; Max # bytes (max PIPL)
	MOVE T2,INTXPB		; Maximum for all interfaces
	CAMLE T1,T2		; Bigger than max allowed?
	  MOVE T1,T2		; Yes, limit it
	SKIPE TCB		; Have TCB?
	  LOAD T2,TSMXP,(TCB)	; Connection maximum
	CAMLE T1,T2		; Bigger than connection max?
	  MOVE T1,T2		; Yes, limit it
	STOR T1,PICKS,(PKT)	; Save max PIPL (PICKS unused til end)
	LOAD T2,PIPL,(PKT)	; Total header size
	SUB T1,T2		; Octets available for data
	MOVE T2,TODCLK		; Current millisecond number
	STOR T2,PTS,(PKT)	; Store as timestamp
	TDZA T2,T2		; 0 OK
TCPIPV:	  SETO T2,		; NZ is bad
	RESTORE
	SKIPN T2		; Skip if bad
         AOS (P)		; Skip if good
	RET
	SUBTTL	TCP Option Routines

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

	These routines perform various functions associated with
	TCP and Internet Options.  Options are stored in packets
	after the header and before the data.  The format is
	described in TCPPAR.

!
;TCPIIO
;Insert IP Options (from TCB image) into packet.

; PKT/	(ext) pointer to packet being constructed
; TCB/	(ext) pointer to TCB  or  0
;	CALL TCPIIO
;Ret+1:	Always, Any options inserted & PIPL & PIDO updated accordingly

TCPIIO:	JUMPE TCB,TCPIIX	; No TCB
	LOAD T1,TIPDO,(TCB)	; TOTAL IP header size, words
	SUBI T1,<MINIHS+3>/4	; Minus standard header
	JUMPLE T1,TCPIIX	; No IP options
	LOAD T2,PIDO,(PKT)	; IP header size, words
	CAIE T2,<MINIHS+3>/4	; Insert or refresh?
	  JRST TCPII5		; Refresh

; Insert options

	ADD T1,T2		; Desired header+options
	CAILE T1,.RTJST(-1,PIDO) ; Too big?
	  MOVX T1,.RTJST(-1,PIDO) ; Clamp to max
	STOR T1,PIDO,(PKT)	; Update IP header size, words
	SUB T1,T2		; Room for options, words
	MOVE T4,T1		; Option words
	LSH T4,2		; Bytes in option words
	LOAD T2,PIPL,(PKT)	; Current packet length
	ADD T2,T4		; New packet length, bytes
	STOR T2,PIPL,(PKT)	; Updated packet length
	JRST TCPII8

; Refresh options

TCPII5:	MOVE T1,T2		; Available space
	SUBI T1,<MINIHS+3>/4	; for options
TCPII8:

; Copy options into header

	XMOVEI T2,TCBIO(TCB)	; Option image in TCB
	XMOVEI T3,PKTELI(PKT)	; IP header base
	ADDI T3,<MINIHS+3>/4	; Pointer to IP option area
	CALL XBLTA		; Options into header
TCPIIX:
	RET
;TCPITO
;Insert TCP options (from TCB image) into packet.

; PKT/	(ext) pointer to packet being constructed
; TPKT/	(ext) pointer to TCP portion of packet
; TCB/	(ext) pointer to TCB  or  0
;	CALL TCPITO
;Ret+1:	Always, any options copied & PIPL and PTDO updated

TCPITO:	JUMPE TCB,TCPITX	; No TCB
	LOAD T1,TTPDO,(TCB)	; TOTAL TCP header size, words
	SUBI T1,<MINTHS+3>/4	; Minus standard header
	JUMPLE T1,TCPITX	; No TCP options
	LOAD T2,PTDO,(TPKT)	; TCP header size, words
	MOVE T3,TPKT		; TCP header base
	ADD T3,T2		; Pointer to TCP option area
	ADD T1,T2		; Desired header+options
	CAILE T1,.RTJST(-1,PTDO) ; Too big?
         MOVX T1,.RTJST(-1,PTDO) ; Clamp to max
	STOR T1,PTDO,(TPKT)	; Update TCP header size, words
	SUB T1,T2		; Room for options, words
	MOVE T4,T1		; Option words
	LSH T4,2		; Bytes in option words
	LOAD T2,PIPL,(PKT)	; Current packet length
	ADD T2,T4		; New packet length, bytes
	STOR T2,PIPL,(PKT)	; Updated packet length
	XMOVEI T2,TCBTO(TCB)	; Option image in TCB
	CALL XBLTA		; Options into header
TCPITX:
	RET
; Maximum # words for options

MAXIOW==1_<WID(PIDO)>-1-<MINIHS+3>/4	; Max # IP option words
MAXTOW==1_<WID(PTDO)>-1-<MINTHS+3>/4	; Max # TCP option words
MAXOPW==MAXIOW				; Max of the two
IFG <MAXTOW-MAXIOW>,<MAXOPW==MAXTOW>

; AC redefinitions - Temp and Local register definitions initiated
; by CALL OPSAV

OPSAV:	STACKL <UPTRS,<UOPS,MAXOPW+1>,<REGS,11+1>>
	MOVEM 11,11+REGS	; Save last reg
	MOVEI 11,REGS		; 0,,save area adr
	BLT 11,11-1+REGS	; Save others
	MOVX CX,<MSEC1,,R>	; Wipe out our 
	EXCH CX,-2+UPTRS	; return with dummy
	CALL (CX)		; Back to mainline
	JRST OPRES		; Go clean up stack

OPTS==0				; Bit corresponding to options present
RP==2     			; Pointer to received option byte
RC==3 				; Count of remaining received option bytes
BIT==4  			; Bit corresponding to current option
OPT==5 				; Option (byte)
OPL==6 				; Option length
OPC==7  			; Count of remaining option bytes
OPP==10  			; Pointer to option byte
IORT==11       			; Pointer to IP or TCP Info table
; Option Tables

DEFINE OPTION (T,NA,C,NU,L,U,R,E)<
	EXP NU
> ; End of DEFINE OPTION

	-NIPOP,,.+1	; IP option numbers
IOPNU:	IPOPTS
NIPOP==.-IOPNU		; # IP options
	ENDOPT

	-NTCPOP,,.+1	; TCP option numbers
TOPNU:	TCPOPTS
NTCPOP==.-TOPNU		; # TCP options
	ENDOPT

DEFINE OPTION (T,NA,C,NU,L,U,X)<
IFE REL6,<
IFDEF  NA'U,<MSEC1,,NA'U>
IFNDEF NA'U,<MSEC1,,X>>
IFN REL6,<
IFDEF  NA'U,<XCDSEC,,NA'U>
IFNDEF NA'U,<XCDSEC,,X>>> ; End of DEFINE OPTION

OPTCOF==.-IOPNU		; Is user option valid
	IPOPTS  (CHK,RSKP)	; Known IP Options
	MSEC1,,RSKP	; Unknown IP Options - OK if cannot prove wrong
	MSEC1,,RSKP	; Maintain spacing
	TCPOPTS (CHK,RSKP)	; Known TCP Options
	MSEC1,,RSKP	; Unknown TCP Options - OK if cannot prove wrong
OPTDOF==.-IOPNU		; Should received option be dropped or sent?
	IPOPTS  (CPY,R)	; Known IP Options
	MSEC1,,R	; Unknown IP Options - Drop unknowns
	MSEC1,,R	; Maintain spacing
	TCPOPTS (CPY,R)	; Known TCP Options
	MSEC1,,R	; Unknown TCP Options - Drop unknowns

OPTXOF==.-IOPNU		; What does received option mean?
	IPOPTS  (XCT,R)	; Known IP Options
	MSEC1,,R	; Unknown IP Options - Forget unknowns
	MSEC1,,R	; Maintain spacing
	TCPOPTS (XCT,R)	; Known TCP Options
	MSEC1,,R	; Unknown TCP Options - Forget unknowns

DEFINE OPTION (T,NA,C,NU,L,U,R,E)<
NA'LEN==L
> ; End of DEFINE OPTION

	IPOPTS
	TCPOPTS
;TCPUOP
;Process User specified options.

; T1/	(ip,,tcp) user section 0 option addresses (or -1 to re-merge)
; TCB/	(ext) pointer to locked connection block
;	CALL TCPUOP
;Ret+1:	Always, T1 is 0 or error code


TCPUOP::
	CALL OPSAV		; Save regs & get working area
	MOVEM T1,UPTRS		; Save user addresses
	HLRZ T2,UPTRS		; User address of IP options
	JUMPE T2,TCPUO2		; None
	XMOVEI IORT,IPINFO	; IP Info
	SETZ T1,		; Incase re-merge
	CAIE T2,-1		; Skip PARSOP if re-merge
	  CALL PARSOP		; Parse and validate user specified options
	JUMPN T1,TCPUOX		; Error
	CALL MERGE		; Merge new user options with received
TCPUO2:
	HRRZ T2,UPTRS		; User address of TCP options
	JUMPE T2,TCPUO4		; None
	XMOVEI IORT,TCPINFO	; TCP Info
	SETZ T1,		; Incase re-merge
	CAIE T2,-1		; Skip PARSOP if re-merge
	CALL PARSOP		; Parse and validate user specified options
	JUMPN T1,TCPUOX		; Error
	CALL MERGE		; Merge new user options with received
TCPUO4:
	SETZ T1,		; All ok
TCPUOX:	MOVEM T1,T1+REGS	; Return value
	RET
;PARSOP
;Parse and validate user specified options.

; T2/	(section 0) user address of options (non-zero if here)
; IORT/	(Ext) pointer to IP or TCP Info table
;	CALL PARSOP
;Ret+1:	Always, T1 non-zero if error

PARSOP:	SETZM OPTS		; No user options yet
	MOVE T1,MXW(IORT) ;MAXxOW ; Max possible length, w
	XMOVEI T3,UOPS		; Our local copy
	CALL BLTUM		; Get user options
	MOVE T3,MXW(IORT) ;MAXxOW ; Maximum length, w
	LSH T3,2		; Bytes
	MOVE OPC,T3		; Used later too
	MOVX OPP,<POINT 8,UOPS,7> ; Byte pointer to first
PARSO2:	LDB OPT,OPP		; Get option
	ANDCM OPT,CPY(IORT) ;CPYOPT/0 ; Without copy on fragmentation
	CAIN OPT,ENDOPT		; End?
         JRST PARSO6		; Yes
	CAIN OPT,NOPOPT		; NOP?
         JRST PARSO4		; Yes
	MOVE T1,OTAB(IORT)	; XCDSEC,,xOPNU ; Address of option table
	MOVE T1,-1(T1)		; -count,,address of first
	CAME OPT,(T1)		; This it?
         AOBJN T1,.-1		; No, try next
	HLRE BIT,T1		; -i or 0
	SKIPE BIT		; Unknown option
         MOVE BIT,BITS+^D36(BIT) ; Known option
        CALL @OPTCOF(T1)	; Check option
         JRST PARSO9		; Looses
	ILDB OPT,OPP		; Get length (maybe)
	CAIL OPC,2		; Enough for length?
	 CAMGE OPC,OPT		; Enough for option?
	  JRST PARSO9		; No, error
	IORM BIT,OPTS		; Remember option exists
	SUBI OPC,1		; Count option byte
	SUBI OPT,1		; Already past it
IFN NOPOPT-1,<
	CAIA
PARSO4:	  MOVX OPT,1		; Option length is 1 (NOPOPT)
> ; End of IFN NOPOPT-1
IFE NOPOPT-1,<PARSO4:>		; OPT code is length
	SUB OPC,OPT		; Free bytes after this option
	ADJBP OPT,OPP		; Point at next
	MOVEM OPT,OPP
	JUMPG OPC,PARSO2	; Back for next option
PARSO6:
	SUB T3,OPC		; Used bytes
	JUMPLE OPC,PARSO7	; No free bytes
	SETZ T1,
	IDPB T1,OPP		; Clear free bytes
	SOSLE OPC
	  JRST .-2
PARSO7:
	XCT SOU(IORT) ;STOR T3,TxPOU,(TCB) ; Store user option bytes
	MOVE T1,MXW(IORT) ;MAXxOW ; Max possible length, w
	XMOVEI T2,UOPS		; New options
	XCT XTOU(IORT) ;XMOVEI T3,TCBxU(TCB) ; TCB location
	CALL XBLTA		; Copy them there
	XCT SOF(IORT) ;STOR OPTS,TxOPF,(TCB) ; Save flags
	TDZA T1,T1		; No error
PARSO9:	  HRROI T1,ELP+^D2	; Error
	RET

;LSRCHK
;Make sure routing options end with packet source address.

; T1/		Option table index (free)
; T2/		(free)
; T3/		Max count (preserve)
; T4=BIT/	Bit representing option (preserve)
; OPT/		Option code w/o CPYOPT (free)
; OPP/		Pointing at option code byte (preserve)
; OPC/		Remaining count (preserve)
; TCB/		Locked (ext) TCB address
;	CALL LSRCHK or SSRCHK
; Return+1	Error in option
; Return+2	Ok

LSRCHK:
SSRCHK:
	SAVEAC <OPP>
	JE TLH,(TCB),RUTCKO	; Not yet specified so cannot check
	ILDB T2,OPP		; Length
	ILDB OPT,OPP		; Initial pointer
	CAIL T2,7		; 7 is leagal but 13(8) is reasonable
	 CAIE OPT,4
	  JRST RUTCKE		; Bad
	SUBI T2,3		; Option header length
RUTCKL:	ILDB OPT,OPP		; Next address byte
	LSH T1,^D8		; Room for another byte
	IOR T1,OPT		; of address
	SOSLE T2		; More bytes?
	  JRST RUTCKL		; Yes
	ANDX T1,<BYTE (4)0(8)377,377,377,377> ; Just last 4 bytes
	LOAD T2,TLH,(TCB)	; Source
	CAMN T1,T2		; Same?
RUTCKO:	 AOS (P)		; OK, skip return
RUTCKE:	RET
;TCPXIO
;Extract interesting IP options from received packet.

; PKT/	(ext) pointer to IP header
; TCB/	(ext) pointer to locked TCB
;	CALL TCPXIO
;Ret+1:	Always, options updated/processed

TCPXIO:	LOAD T1,PIDO,(PKT)	; IP header size, w
	SUBI T1,<MINIHS+3>/4	; Size w/o options
	JUMPLE T1,TCPXIX	; None
	CALL OPSAV		; Save regs & get working area
	MOVE T2,PKT
	ADDI T2,PKTELI+<MINIHS+3>/4
	XMOVEI IORT,IPINFO	; IP Info
	CALL TCPXXO		; Process received IP options
TCPXIX:	RET

;TCPXTO
;Extract interesting TCP options from received packet.

; TPKT/	(ext) pointer to TCP header
; TCB/	(ext) pointer to locked TCB
;	CALL TCPXTO
;Ret+1:	Always, options updated/processed

TCPXTO:	LOAD T1,PTDO,(TPKT)	; TCP header size, w
	SUBI T1,<MINTHS+3>/4	; Size w/o options
	JUMPLE T1,TCPXTX	; None
	CALL OPSAV		; Save regs & get working area
	MOVE T2,TPKT
	ADDI T2,<MINTHS+3>/4
	XMOVEI IORT,TCPINFO	; TCP Info
	CALL TCPXXO		; Process TCP options
TCPXTX:
	RET
;TCPXXO
;Scan options.

; T1/	# option words
; T2/	(ext) pointer to options in packet
; IORT/	(Ext) Information table address
;	CALL TCPXXO
;Ret+1:	Always

TCPXXO:	PUSH P,T1		; Save received option words
	SETZM UOPS		; Clear working area
	MOVEI T4,UOPS		; Build BLT word
	HRLS T4
	ADDI T4,1		; But save T2
	BLT T4,MAXOPW-1+UOPS
	MOVE T1,(P)		; Words received
	XMOVEI T3,UOPS
	CALL XBLTA		; Get options from packet
	MOVE RC,(P)		; Words received
	LSH RC,2		; Bytes
	MOVEM RC,(P)		; Save for later
	MOVX RP,<POINT 8,UOPS,7> ; First received option
TCXXX3:	LDB OPT,RP		; Reveived option byte
	ANDCM OPT,CPY(IORT) ;CPYOPT/0 ; Without copy on fragmentation
	CAIN OPT,ENDOPT		; End of options?
         JRST TCXXX7		; Yes, all done
	CAIN OPT,NOPOPT		; Watch out for length 1
         JRST TCXXX5
	MOVE T1,OTAB(IORT)	; XCDSEC,,xOPNU ; Option table address
	MOVE T1,-1(T1)		; AOBJN pointer for options
	CAME OPT,(T1)		; This the option?
         AOBJN T1,.-1		; No, look further
	ILDB OPT,RP		; Get option length
	CALL @OPTXOF(T1)	; Interpret option
	LDB OPT,RP		; Option length
	SUBI RC,1		; Count option code
	SUBI OPT,1		; Already past it
IFN NOPOPT-1,<
	CAIA
TCXXX5:	  MOVX OPT,1		; Option length is 1 (NOPOPT)
> ; End of IFN NOPOPT-1
IFE NOPOPT-1,<TCXXX5:>		; OPT code is length
	SUB RC,OPT		; Bytes left to process
	ADJBP OPT,RP		; Option byte
	MOVEM OPT,RP
	JUMPG RC,TCXXX3		; Loop if more
TCXXX7:
	MOVNS RC
	ADD RC,(P)		; Acutal option bytes
	XCT SOR(IORT) ;STOR RC,TxPOR,(TCB)
	ADJSP P,-1		; Restore stack
	MOVE T1,MXW(IORT) ;MAXxOW
	XMOVEI T2,UOPS
	XCT XTOR(IORT) ;XMOVEI T3,TCBxR(TCB)
	CALL XBLTA		; Save options for future
	CALL MERGE		; Merge them with user's
	RET
;MSLXCT
;Received TCP Maximum Segment Length Option.

; RP/	Points to length byte
;	CALL MSLXCT
;Ret+1:	Always, TSMXP updated if possible

MSLXCT:	SAVEAC <RP,RC>
	MOVE T3,RP
	LDB T4,T3		; Get length
	CAIE T4,MSLLEN		; Right length?
	  JRST MSLXCX		; No, ignore
	SETZ T1,
	MOVX T4,<-2,,0>		; Two more bytes
MSLXC4:	ILDB T2,T3		; Accumulate #
	LSH T2,^D<36-8>
	LSHC T1,^D8
	AOBJN T4,MSLXC4
	CALL TCPMXP		; Compute new segment length
MSLXCX:	RET
;MERGE
;User options and received options into send options.

; IORT/	IP/TCP Information table address
;	CALL MERGE

MERGE:	XCT XFOU(IORT) ;XMOVEI T2,TCBxU(TCB) ; Assume User options
	XCT LOU(IORT) ;LOAD OPP,TxPOU,(TCB) ; User bytes used
	XCT LOR(IORT) ;LOAD RC,TxPOR,(TCB) ; Received bytes used
	JUMPE RC,MERGE8		; Nothing to merge - User only
	MOVE OPC,MXW(IORT) ;MAXxOW ; Max words allowed
	LSH OPC,2		; Max bytes allowed
	SUB OPC,OPP		; Free bytes after User
	JUMPLE OPC,MERGE8	; No room for merge - User only

; Either merge or copy/drop received options

	ADJBP OPP,[POINT 8,UOPS,7] ; Point at free output byte
	MOVE T1,MXW(IORT) ;MAXxOW ; Begin with User options
	XMOVEI T3,UOPS		; Get user options
	CALL XBLTA
	MOVE RP,POR(IORT) ;POINT 8,TCBxR(TCB),7>) ; Received options
	XCT LOR(IORT) ;LOAD RC,TxPOR,(TCB) ; Get received bytes
	XCT LOF(IORT) ;LOAD OPTS,TxOPF,(TCB) ; Get User option flags
MERGE3:	LDB OPT,RP		; Reveived option byte
	ANDCM OPT,CPY(IORT) ;CPYOPT/0 ; Without copy on fragmentation
	CAIN OPT,ENDOPT		; End of options?
         JRST MERGE5		; Yes, All done
	CAIN OPT,NOPOPT		; Nop?
         JRST [SUBI RC,1	; Length
	       	ILDB OPT,RP	; Point at next
		JRST MERGE4]	; Go to loop

; Option with length

	MOVE T1,OTAB(IORT)	; XCDSEC,,xOPNU ; Option table address
	MOVE T1,-1(T1)		; AOBJN pointer for options
	CAME OPT,(T1)		; This the option?
         AOBJN T1,.-1		; No, look further
	HLRE BIT,T1		; -i (or 0)
	SKIPE BIT
         MOVE BIT,BITS+^D36(BIT) ; 1B<36-i>
	LDB OPT,RP		; Copy option
	DPB OPT,OPP
	ILDB OPT,RP		; Get length
	SUB RC,OPT		; Received bytes after this option
	MOVEI OPL,-1(OPT)	; # bytes left to copy in this option
	TRNN OPTS,(BIT)		; If User specified, drop
	 CAMLE OPT,OPC		; or if not enough space
	  CAIA			; Go drop it
	   CALL @OPTDOF(T1)	; Try to copy it
	    CALL MERGED		; Drop it
MERGE4:
	SKIPLE RC		; If more left
         JUMPG OPC,MERGE3	; and room, loop
MERGE5:
	MOVX OPT,ENDOPT		; End options (may overflow
	DPB OPT,OPP		; into guard word ending UOPS)
	XMOVEI T2,UOPS		; Copy from merged
	MOVE OPP,MXW(IORT) ;MAXxOW ; Maximum option words
	LSH OPP,2		; Bytes
	SUB OPP,OPC		; Used bytes

MERGE8:	;(T2,OPP) Enter here if no merge, just copy user to send

	ADDI OPP,3		; Round bytes up to
	LSH OPP,-2		; Option words used
	SKIPE OPP		; If none, 0 is ok
         ADDI OPP,<MINIHS+3>/4	; Including header
	XCT SDO(IORT) ;STOR OPP,TxPDO,(TCB) ; Set send header length
	MOVE T1,MXW(IORT) ;MAXxOW ; Maximum option words
	XCT XTOO(IORT) ;XMOVEI T3,TCBxO(TCB) ; To TCB image
	CALL XBLTA		; Go the options
	RET

;MERGED 	Drop option from net

; RP/	Points at Len byte
; OPT/	Len of option
; OPL/	Len-1 of option
; OPC/	Len of option
; OPP/	Points at output option byte (already copied)
;	CALL MERGED
; RP/	Points at next option
; OPC/	Unchanged since none used
; OPP/	Unchanged since none used

MERGED:	ADJBP OPL,RP
	MOVEM OPL,RP		; Point at next
	RET
;RRTCPY
;Change Record Route from net into Strict Source Route for reply.

; RP/	Points at Len byte
; OPT/	Len of option
; OPL/	Len-1 of option
; OPC/	Len of option
; OPP/	Points at output option byte (already copied)
;	CALL RRTCPY
;Ret+1:	  Option should be dropped
;Ret+2:	Option was copied and
; RP/	Points at next option
; OPC/	Count reduced if copied
; OPP/	Pointer updated if copied

RRTCPY:	PUSH P,[0]		; Turn it into a (trimmed) SSR
	MOVE T1,RP		; Peek ahead at
	ILDB T4,T1		; Pointer
	CAIN OPT,-1(T4)		; At end? (Len vs (Ptr)-1)
	  JRST RRTDS2		; Yes
	MOVE T1,OPT		; Len reserved for RRT
	MOVEI OPT,-1(T4)	; Len actually used
	SUB T1,OPT		; Unused bytes in RRT option
	MOVEM T1,(P)		; Save for RP adjustment
RRTDS2:
	MOVX T1,SSROPT		; Change RRT
	DPB T1,OPP		; to SRT
	CALL NUSSR		; Process as Strict Source Route
	  JRST RRTDSX		; Have to drop it (OPL still Len-1)
	POP P,T1		; Unused bytes in RRT are
	ADJBP T1,RP		; Skipped
	MOVEM T1,RP		; over
	AOS (P)			; All OK return
	RET

RRTDSX:	ADJSP P,-1		; Clear stack of unused RRT bytes
	RET			; Dropped return
;LSRCPY
;Invert Record Route or Loose  Source Route from net for reply.
;SSRCPY
;Invert Record Route or Strict Source Route from net for reply.

; RP/	Points at Len byte
; OPT/	Len of option
; OPL/	Len-1 of option
; OPC/	Len of option
; OPP/	Points at output option byte (already copied)
;	CALL LSRCPY  or  SSRCPY  or  NUSSR
;Ret+1:	  Option should be dropped
;Ret+2:	Option was copied and
; RP/	Points at next option
; OPC/	Count reduced if copied
; OPP/	Pointer updated if copied

LSRCPY:
SSRCPY:				; Invert address list

	MOVE T1,RP		; Peek ahead at
	ILDB T4,T1		; LSR/SSR pointer
	TRNN T4,3		; Pointer multiple of 4 and
	 CAIE OPT,-1(T4)	; At end? (Len vs (Ptr)-1)
	  RET			; No, error, drop it (shouldn't get here)
NUSSR:	PUSH P,RC		; Save register for our use
	PUSH P,OPP		; Pointer to (copied) option code
	IDPB OPT,OPP		; Copy option length
	SUB OPC,OPT		; Remaining free bytes tobe
	ILDB RC,RP		; Old pointer changed to
	LSH RC,-2		; Counter of addresses
	SUBI RC,1		; (omit code,len,ptr)
	MOVX OPT,4		; Initial pointer
	IDPB OPT,OPP
	PUSH P,[-1]		; Marker
INVRI:	MOVX T4,<-4,,0>		; Collect 4-byte addresses
	PUSH P,BHC ;[0]		; here
	MOVX T1,<POINT 8,(P),3>	; Point to it (right justified)
	ILDB OPT,RP
	IDPB OPT,T1		; Pack
	AOBJN T4,.-2
	SOSLE RC
	  JRST INVRI		; Another address to pack
INVRO:	MOVX T4,<-4,,0>		; Pack 4-byte addresses
	MOVX T1,<POINT 8,(P),3>	; From top of stack (right justified)
	ILDB OPT,T1
	IDPB OPT,OPP		; Into send option
	AOBJN T4,.-2
	POP P,T1		; Save processed address
	SKIPL (P)		; Reached marker?
         JRST INVRO		; No, do another
	ADJSP P,-1		; Drop marker
	LOAD T4,TFH,(TCB)	; Destination must be last address in route
	CAIN T1,T4		; Same as last?
         JRST NDSSR		; Yes all ok
	MOVE T1,(P)		; Pointer to option code byte
	MOVX OPT,LSROPT		; If adding, make into loose route
	DPB OPT,T1
	ILDB OPT,T1		; Must increase length by another address
	ADDI OPT,4
	DPB OPT,T1
	SUBI OPC,4		; Using 4 more bytes
	JUMPL OPC,NDSSR		; Overran max header length, lose
	MOVEM T4,(P)		; Have to append destination address
	MOVX T4,<-4,,0>		; Pack 4-byte addresses
	MOVX T1,<POINT 8,(P),3>	; From top of stack (right justified)
	ILDB OPT,T1
	IDPB OPT,OPP		; Into send option
	AOBJN T4,.-2
NDSSR:	ADJSP P,-1		; Drop pointer to option byte
	ILDB OPT,RP		; Point at next received and
	ILDB OPT,OPP		; Send option position
	POP P,RC		; Restore register
	AOS (P)			; Skip return since copied
	RET
;TSPCPY
;Copy Received option if reserved space not all used.

; RP/	Points at Len byte
; OPT/	Len of option
; OPL/	Len-1 of option
; OPC/	Len of option
; OPP/	Points at output option byte (already copied)
;	CALL TSPCPY
;Ret+1:	  Option should be dropped
;Ret+2:	Option was copied and
; RP/	Points at next option
; OPC/	Count reduced if copied
; OPP/	Pointer updated if copied

TSPCPY:
	MOVE T1,RP		; Peek ahead at
	ILDB T4,T1		; Pointer
	CAIN OPT,-1(T4)		; At end? (Len vs (Ptr)-1)
	  RET			; Yes, drop it
				; No, fall into copy
; Fall into copy

;SIDCPY
;Copy Received option.

; RP/	Points at Len byte
; OPT/	Len of option
; OPL/	Len-1 of option
; OPC/	Len of option
; OPP/	Points at output option byte (already copied)
;	CALL SIDCPY
;Ret+1:	  Option should be dropped
;Ret+2:	Option was copied and
; RP/	Points at next option
; OPC/	Count reduced if copied
; OPP/	Pointer updated if copied

SIDCPY:				; Copy option
	SUB OPC,OPT		; Remaining free send bytes tobe
	IDPB OPT,OPP		; Copy length
	ILDB OPT,RP		; and rest
	SOSLE OPL
	  JRST .-3
	ILDB OPL,OPP		; Both point at start of next
	AOS (P)			; Skip MERGED since copied it
	RET
; IP and TCP Information Tables

ICPY==CPYOPT	; IP copy-on-fragmentation
TCPY==0		; TCP doesn't have such a bit

DEFINE INFOW (NAM,INST)<
NAM==.-..X
	INST
> ; End of INFOW


DEFINE INFO (W)<
..X=.
INFOW(CPY,<W'CPY>)
INFOW(LOF,<LOAD OPTS,T'W'OPF,(TCB)>)
INFOW(LOR,<LOAD RC,T'W'POR,(TCB)>)
INFOW(LOU,<LOAD OPP,T'W'POU,(TCB)>)
INFOW(MXW,<MAX'W'OW>)
IFE REL6,<INFOW(OTAB,<MSEC1,,W'OPNU>)>
IFN REL6,<INFOW(OTAB,<XCDSEC,,W'OPNU>)>
INFOW(POR,<POINT 8,TCB'W'R(TCB),7>)
INFOW(SDO,<STOR OPP,T'W'PDO,(TCB)>)
INFOW(SOF,<STOR OPTS,T'W'OPF,(TCB)>)
INFOW(SOR,<STOR RC,T'W'POR,(TCB)>)
INFOW(SOU,<STOR T3,T'W'POU,(TCB)>)
INFOW(XFOR,<XMOVEI T2,TCB'W'R(TCB)>)
INFOW(XFOU,<XMOVEI T2,TCB'W'U(TCB)>)
INFOW(XTOO,<XMOVEI T3,TCB'W'O(TCB)>)
INFOW(XTOR,<XMOVEI T3,TCB'W'R(TCB)>)
INFOW(XTOU,<XMOVEI T3,TCB'W'U(TCB)>)
	PURGE ..X
> ; End of DEFINE INFO


IPINFO:	INFO (I)		; IP Info Table

TCPINFO:INFO (T)		; TCP Info Table

; Restore registers and clean up stack

OPRES:	MOVEI 11,REGS		; Saved registers
	HRLZS 11		; REGS,,0
	BLT 11,11		; Restore them
	RESTORE
	RET			; To R: then to caller

;SNDSCL
;Send a Secure Close Option (Internet).

;PKT/	(Extended) Packet
;	CALL SNDSCL
;Ret+1:	always

SNDSCL:	RET

;GETTSO(PKT)
;Get the value stored in the timestamp option (TCP).

;PKT/	(Extended) Packet
;TPKT/	(Extended) TCP packet pointer
;	CALL GETTSO
;Ret+1:	Qlways.  T1 .LT. 0 if no timestamp, or has the 32-bit timestamp

GETTSO:	 RET
	SUBTTL	Packet Printer

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

PRNPKT  is called from the TCP and IP each time it is fondled by some
task. If the current packet is different than the one which is stored
in the PPBUF, or T1 contains an extended code  PPBUF  is  dumped  via
TCPPDP  (instead  of the DBGIM (JSYS) code in IMPDV), and the current
packet is stored in PPBUF. If the current packet is the same as  that
in PPBUF, a record is kept regarding what has been done to it and the
state  of  the  TCB  to  which  it belongs so that when it is finally
dumped, the most recent information is available. This minimizes  the
number  of  printed  lines  which the usermode program which actually
prints the formated script will have to print.

!

IFE IPPDSW,<			;THIS STUFF ONLY IF WE DO NOT HAVE THE PP
PPINI::
PRNPKI::
PRNPKT::
	RET
>				;END OF IFE IPPDSW

IFN IPPDSW,<			;THIS STUFF ONLY IF WE SUPPORT THE PP

;PPINI
;Initialize the Packet Printer.

;	CALL PPINI
;Ret+1:	Always

PPINI:	SAVEAC <FR,BFR>
	XMOVEI BFR,PPBUF
	CALL RSTPPB		; Reset the buffer
	SETZM NXTLBL		; Label number for LBLOPT in packets
	XMOVEI T1,PPBLCK	; Lock on buffer accesses
	CALL CLRLCK		; Reset that
	RET

;RSTPPB
;Reset the Packet Printer Buffer state.

;FR/	Packet Printer flag word (modified here)
;BFR/	Pointer to packet printer buffer
;	CALL RSTPPB
;Ret+1:	Always.

RSTPPB:	MOVX FR,PP%MT	; Mark buffer as empty, clear all others
	STOR FR,DFLAG,(BFR)	; Store in PPB Flag word
	RET

;DMPBUF
;Dump what's in PPBUF through IMPDV.

;FR/	Packet Printer flag word
;BFR/	Pointer to packet printer buffer
;	CALL DMPBUF
;Ret+1:	Always

DMPBUF:	STOR FR,DFLAG,(BFR)	; Update display flags before output
	MOVX T1,PPBWDS		; Number of words in the buffer
	HRRM T1,PPBUF		; Fake an NCP buffer header (keep code)
	XMOVEI T1,PPBUF		; This looks like an NCP Packet buffer
	CALL TCPPDP		; Use our routine instead of DBGIN
	RET
;PRNPKI/T
;Main Routine, called from all over the IP/TCP.

;TCB/	0 or (ext) pointer to Locked connection block (TCP only)
;PKT/	0 or (ext) pointer to packet to print
;T1/	Number saying where the call is from and why
;	MOVX T1,PT%xxx
;	TDNE T1,INTTRC
;	  CALL PRNPKI/T
;Ret+1:	Always

PRNPKI::
	SAVEAC <TCB>
	SETZ TCB,
	CALL PRNPKT
	RET

PRNPKT::
	SKIPN INTTRC		; Tracing packets right now?
         RET			; No.
	MOVE T3,T1		; Setup for call via LCKCAL
	MOVE T4,TODCLK		; When the report is happening
	XMOVEI T1,PPBLCK	; Lock to set (section 0)
	XMOVEI T2,PKTPRN	; (Extended) Function to call
	CALL LCKCAL		; Lock the lock and call the function
	RET

;PKTPRN
;Action routine.

;TCB/	0 or (ext) pointer to locked connection block
;PKT/	0 or (ext) pointer to packet
;T1/	Where report is coming from (PT%xxx)
;T2/	When report is happening (milliseconds)
;	Call PKTPRN
;Ret+1:	Always.

PKTPRN:	SAVEAC <BFR,FR>
	LOCAL <WHERE,WHEN,COUNT,STATE>
	XMOVEI BFR,PPBUF	; Set pointer to buffer
	LOAD FR,DFLAG,(BFR)	; Get local copy of PPB flags
	MOVEM T1,WHERE		; Save args in safe places
	MOVEM T2,WHEN
	JUMPN PKT,PKTPR1	; Jump unless it is BG flushing buffer
	TXNE FR,PP%MT		; Is the buffer empty?
	  JRST PKTPRX		; Yes. Nothing to do.
	CALL DMPBUF		; Dump the buffer via IMPDV
	CALL RSTPPB		; Reset buffer state
	JRST PKTPRX		; Return

PKTPR1:	TXNE FR,PP%MT		; PPB empty?
	  JRST PKTPR4		; Yes.  Just dump in this one
	LOAD T1,PIDO,(PKT)	; Internet Data Offset
	MOVE T2,PKT		; Locate TCP header
	ADD T2,T1
	LOAD T2,PTDO,(T2)	; TCP Data Offset
	ADD T1,T2		; Total number of Header words
	CAILE T1,<PPBFSZ+LCLPKT-PKTELI> ; Beware too many options
	  MOVEI T1,<PPBFSZ+LCLPKT-PKTELI> ; Clamp at PPBUF limit
	SOS T1			; Skip first word
	MOVEM T1,COUNT		; Number of words to compare
	CAIN WHERE,8		; Retransmitter calling?
	 JRST PKTPR3		; Yes.  Force printing
	MOVN T1,COUNT		; Number of full header words
	HRLZS T1		; Make AOBJN pointer
	XMOVEI T2,PKTELI+1(PKT)	; Beginning of corresponding part of hdr
PKTPR2:	MOVE T3,0(T2)		; Get a header word from packet
	CAME T3,PPBUF+PKTELI+1-LCLPKT(T1) ; Same as header in the buffer?
	 JRST PKTPR3		; No.  Dump the buffer
	ADDI T2,1		; Bump the packet pointer
	AOBJN T1,PKTPR2		; Loop over the buffer
	JRST PKTPR4

PKTPR3:	CALL DMPBUF		; Dump the buffer
	CALL RSTPPB		; Reset it
PKTPR4:	TXZN FR,PP%MT		; Is the buffer empty?
	 JRST PKTPR5		; No.  Just update state
	MOVX T1,PPBFSZ-1	; Skip first word (fake header)
	XMOVEI T2,LCLPKT+1(PKT)	; Beginning of real header info(+1)
	XMOVEI T3,PPBUF+1	; Corresponding place in buffer
	CALL XBLTA		; Copy the header into the buf
	STOR WHEN,DTIME,(BFR)	; Save the report time
	STOR PKT,DPKTP,(BFR)	; Save buffer address
PKTPR5:	SKIPE STATE,TCB		; Use 0 for state if no TCB
	  LOAD STATE,TSTAT,(TCB) ; Else get the actual state
	TXZ FR,PP%DUN
	HRRZS (BFR)		; Clear prior extended trace code
	CAILE WHERE,0
	CAILE WHERE,8		; Good value for where?
	 TXOA FR,PP%DUN		; Say we are done with this packet
	  XCT WHRTAB-1(WHERE)
	HRLM WHERE,(BFR) ;****	; Save extended trace code
	JRST PKTPR6
WHRTAB:	JRST WHR1
	JRST WHR2
	JRST WHR3
	JRST WHR4
	JRST WHR5
	JRST WHR6
	JRST WHR7
	JRST WHR8

WHR1:	TXO FR,<PP%PZ!PP%GSS!PP%SK>	; PZ output a packet
	STOR STATE,DSS,(BFR)	; Store source state
	JRST PKTPR6

WHR2:	TXO FR,PP%GSS		; OP reporting
	STOR STATE,DSS,(BFR)

WHR7:	TXO FR,<PP%SNT!PP%SK>	; IP sent RESET based on input packet
	JRST PKTPR6

WHR3:	TXO FR,<PP%RCV!PP%GDS!PP%DK>	; IP, normal
	STOR STATE,DDS,(BFR)	; Store destination state
	JRST PKTPR6

WHR4:	TXO FR,<PP%RA!PP%DK!PP%GDS!PP%DUN> ; RA
	STOR STATE,DDS,(BFR)
	JRST PKTPR6

WHR8:	TXO FR,<PP%REX!PP%GSS!PP%SK>	; RX
	STOR STATE,DSS,(BFR)
	JRST PKTPR6

WHR6:	TXO FR,PP%GDS		; IP, flushed (DUP, IGN, RST, nothing
	STOR STATE,DDS,(BFR)	; to be RA'd) (have TCB)

WHR5:	TXO FR,<PP%DK!PP%DUN>	; IP, flushed (checksum error, CHKADR
				; failed) (no TCB)
PKTPR6:
	TXNN FR,PP%DUN		; Has pkt reached the end of the line?
	 JRST PKTPRX		; No.
	CALL DMPBUF		; Yes.  Dump it now
	CALL RSTPPB		; Reset the buffer

PKTPRX:	STOR FR,DFLAG,(BFR)	; Save the PPB flags
	RESTORE
	RET
;TCPPSO
;Open file for simulation.
;TCPPSR
;Read the next simulated packet.
;TCPPSC
;Close simulation file.
;TCPPSF
;Free the simulated packets.

; Debugging and tracing utilities (used from MDDT)
; Read packets from file & insert where desired

; CALL TCPPSO$X		to Open file for Simulation
; <file name>
; <SKIP> if OK

; CALL TCPPSR		to Read the next Simulated packet
; <SKIP> if OK with PKT set

; CALL SNDGAT$X ,e.g. to send the packet

; CALL TCPPSC		to Close the Simulation file and
; CALL TCPPSF		to Free the Simulated packets

TCPPSO:	CALL TCPPSC		; Open Simulation file (close old one)
	MOVX T1,<GJ%OLD+GJ%FNS+GJ%SHT>
	MOVX T2,<.PRIIN,,.PRIOU>
	GTJFN			; Get name from TTY: (MDDT)
	  RET
	MOVEM T1,TCPPSJ
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD>
	OPENF			; Open file for reading
	  RET
	AOS (P)			; OK return skips
	RET

TCPPSC:	SETZ T1,		; Close Simulation file
	EXCH T1,TCPPSJ
	SKIPE T1
	 CLOSF
	  JFCL
	RET

TCPPSF:	MOVE T1,TCPPSQ		; Free packets from Simulation Queue
	JUMPE T1,TCPPSV
	JN PINTL,(T1),TCPPSV
	MOVE T2,PKTQ(T1)
	MOVEM T2,TCPPSQ
	CALL RETBLK
	JRST TCPPSF
TCPPSR:	MOVE T1,TCPPSJ		; Read next packet from Simulation file
	BIN
	  ERJMP TCPPSV
	HLRZ T1,T2		; Free size
	JUMPLE TCPPSV
	PUSH P,T1
	CALL GETBLK		; Get storage for packet
	MOVEM T1,PKT
	MOVN T3,(P)
	POP P,(P)
	JUMPLE PKT,TCPPSV
	MOVE T1,TCPPSJ
	MOVX T2,<POINT 36,(PKT)>
	SIN			; Read packet into it
	  ERJMP TCPPSU
	SETONE PPROG,(PKT)	; We will hang on to packet
	MOVE T1,TCPPSQ		; (may want to try again)
	MOVEM T1,PKTQ(PKT)
	MOVEM PKT,TCPPSQ	; Place it in our queue
	MOVE T1,TCPPSA
        STOR T1,PIDH,(PKT)	; Fake the address
	AOS (P)
	RET

TCPPSU:	MOVE T1,PKT		; Lose, free packet
	CALL RETBLK
TCPPSV:	RET
;TCPPIN
;In-core trace facility.
; IMP trace:	DBGS1B+2/	JFCL
;		DBGS1B+3/	JFCL
;		DBGS1B+4/	MOVEM T2,(T1)
;	&	DBGCK1+2/	MOVEI T1,2(T2)
;		DBGCK1+3/	ADDB T1,TCPPTC
;		DBGCK1+4/	SUBI T1,3(T2)
;		DBGCK1+5/	MOVEM T1,DBGSP
;		DBGCK1+6/	AOS -1(P)
; and set DBGERR and/or DBGNCP non-zero

TCPPIN:	MOVX T1,40000		; Size of core buffer
	CALL GETBLK
	JUMPE T1,TCPPIX		; Lose
	XMOVEI T2,<40000-2*PPBWDS>(T1)	; End, allow room for DBG
	MOVEM T2,TCPPTE
	MOVEM T1,TCPPTC
	MOVEM T1,TCPPTB
	SETZM TCPPTO
TCPPIX:	RET

; Create a file of packets from some point in code (XXX:)
; Initialize trace with trace off & when done CALL TCPPWR
; xxx:	CALL TCPPSS

TCPPSS:
	CAIE T1,-1		; Fill in with desired values
	 CAIN T1,-1		; if filtering desired
	  CAIA
	   RET
	XMOVEI T2,(PKT)		; Beginning of packet
	HLRZ T1,-1(PKT)		; Free storage block length
	JRST TCPPDP+2		; Dump <N,,garb>,N<data>

TCPPDP:	  MOVEI T1,PPBWDS	; PPBUF size
	  XMOVEI T2,PPBUF	; Where from
	HLLZ T3,TCPPTC
	SKIPN T3		; Enforce IF2 above
	  RET			; Don't allow into section zero
	MOVE T3,T1		; Be careful of TCPPTC, both
	ADDB T3,TCPPTC		; TCPPDP and DBGCKS use it w/o lock
	SUB T3,T1		; Where to dump
	CALL XBLTA		; Copy
	CAMGE T3,TCPPTE
	  RET			;   and return
	MOVEM T3,TCPPTO		; Save overflow address and
				; Fall into write routine
TCPPWR:
	MOVX T1,<GJ%OLD+GJ%SHT>
	HRROI T2,TCPPFN		File name
	GTJFN
	  JRST TCPPWX		; Quit
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%APP> ; Open for 36 bit append
	OPENF
	  JRST TCPPWX
	MOVE T4,TCPPTB		; Extended start address
	MOVSI T2,(POINT 36,0(T4)) ; & pointer to it
	MOVE T3,TCPPTO		; Possible end
	SKIPG T3		; If not zero
	  MOVE T3,TCPPTC	; If zero, use current
	SUB T3,TCPPTB		; Length, w
	MOVN T3,T3		; Count
	SOUT
	CLOSF
	 JFCL
TCPPWX:	MOVE T4,TCPPTB		; Extended start address
	MOVEM T4,TCPPTC		; is where to start over
	SETZM TCPPTO		; No overflow
	RET

>				; END OF IFN IPPDSW
	SUBTTL	TCP Statistics Routines

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

WARNING -- These routines are not currently supported

These  routines  handle  time  accounting, timestamping and histogram
making.

!

IFN IPPDSW,<
;STSINI
;Initialize Statistics.

;	CALL STSINI
;Ret+1:	Always

STSINI:	MOVE T1,[STAT0,,STAT0+1] ; First cell to clear
	SETZM STAT0		; Clear the first word
	BLT T1,STATZZ
	MOVEI T1,OHUSE		; Overhead time accumulator
	MOVEM T1,TIMPTR		; Select that as the timer
	RET
;TSTAMP
;Process a packet time stamp.

;T1/	(Extended) Histogram pointer
;PKT/	(Extended) Packet
;	CALL TSTAMP
;Ret+1:	Always.

TSTAMP:	TEMP <HIST,NOW,TIMSTP>
	LOAD TIMSTP,PTS,(PKT)	; Get the timestamp from packet
	MOVE NOW,TODCLK
	STOR NOW,PTS,(PKT)	; Set the new timestamp
	SUB NOW,TIMSTP		; Compute Difference
	CALL DOHIST		; Do the histogram
	RESTORE
	RET

;DOHIST
;Do the histogram functions.

;T1/	(Extended) Histogram pointer
;T2/	Sample
;	CALL DOHIST
;Ret+1:	Always

DOHIST:	TEMP <HIST,SAMPLE,BINNUM>
	IFN <SAMPLE+1-BINNUM>,<PRINTS ?DOHIST: ACs not properly defined>
	SKIPGE BINNUM,SAMPLE	; Good sample?
	  MOVEI BINNUM,^D36-NHBINS ; No. Put in Garbare Bin.
	JUMPL SAMPLE,DOHIS1	; Don't accumulate bad samples
	OPSTR <ADDM SAMPLE,>,HTOTL,(HIST); Accumulate total
	INCR HSMPL,(HIST)	; Count samples
	JFFO SAMPLE,.+2		; Take the LOG
	  MOVEI BINNUM,^D36
	CAIL BINNUM,^D36-NHBINS+1 ; Super big ones go in last bin
DOHIS1:	  SUBI BINNUM,^D36
	MOVNS BINNUM
	IHBIN HIST,BINNUM	; Count in that bin
	RESTORE
	RET
;TIMCAL
;Time a call to a subroutine.

;T1/	(Extended) Address to charge time to
;T2/	(Extended) Function to call
;T3/	Arg1 for function
;T4/	Arg2 for function
;TIMPTR/ (Extended) Pointer to current time accumulator

TIMCAL:	PUSH P,TIMPTR		; Save old timer
	MOVEM T1,TIMPTR		; Set new timer
	PUSH P,T3		; Save ARG1
	PUSH P,T4		; Save ARG2
	PUSH P,T2		; Save routine
	CALL GETFRT		; Get fork's runtime til now
	POP P,T4		; Get the routine address
	POP P,T2		; Get Arg2
	EXCH T1,0(P)		; Save start time and get Arg1
	CALL 0(T4)		; Call the function
	PUSH P,T1		; Save result of the function
	CALL GETFRT		; Get the runtime now, after the funcal
	MOVE T3,T1		; Put in a safe place for a second
	POP P,T1		; Restore the result
	POP P,T4		; Get starting usage
	SUB T4,T3		; Compute negative usage
	MOVN T3,T4		; Positive useage
	MOVE T2,TIMPTR		; Get current time accumulator
	ADDM T3,0(T2)		; Charge to the current timer cell
	POP P,T3		; Restore previous timer
	MOVEM T3,TIMPTR
	ADDM T4,(T3)		; Avoid double charges
	RET

>				; end of IFN IPPDSW
	SUBTTL	TCP Buffer handling routines

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

	DEFAC (FX,Q3)		; Must agree with PROLOG, PAGEM

COMMENT	!

These are routines for mapping, reading, and writing buffers. Buffers
are  actually  in  the  address space of the fork executing a SEND or
RECV, but are manipuated by the TCP fork. Data is copied  only  once,
directly from (or to) the buffer into a packet (or vice versa).

Since  the  TCP  fork  must  guard against the page(s) containing the
buffer disappearing (unmapped, fork killed, etc), it  increments  the
share  count  on the SPT slot containing the calling fork's UPT. This
prevents the map from going away.  Subsequent  access  checking  will
discover that the page is missing and approriate errors returned.

SEND  and  RECV  buffer  headers  are  actually  formed by the MAKBFR
routine in TCPJS. They are queued on TCBSBQ or TCBRBQ for  action  by
the Packetizer or Reassembler.

!
;SETTUM(BFR)
;Set  TCP  fork's  user  map to be that of the buffer This routine is
;called by the Packetizer and Reassembler (TCPUSR) to get the current
;page of a buffer mapped so it can reference the data in it.

;BFR/	(Extended) Pointer to the current buffer descriptor block.
;TCB/	(Extended) Pointer to TCB for connection.
;	CALL SETTUM
;Ret+1:	Always. NOSKED

SETTUM:	SAVEAC <FX>
	NOSKED			; Prevent user from changing access
	LOAD FX,BFRKX,(BFR)	; Get the fork which owns the buffer
	MOVE T1,USECTB+0	; TCP's user section 0
	MOVEM T1,TCPUS0		; Save that for later
	JE TDEC,(TCB),SETTU2	; is this a DEC TCB?
	MOVE T1,MMSPTN		; yes so get MMAPs SPT slot
	JRST SETTU3		; go map it
SETTU2:				; here to map a fork section
	LOAD T1,FKUPT		; Get SPT index of page table
	CALL UPSHR		; Keep it from going away
	LOAD T1,FKUPT		; Get SPT index of page table
SETTU3:				; now map the section
	MOVE T2,SHRPTR		; Prototype share pointer
	STOR T1,SPTX,T2		; To that SPT slot
	MOVEM T2,USECTB+0	; Place in process table
	DATAI PAG,T1		; Get current pager status (UBA)
	TXZ T1,PGLACB+PGLPCS	; Be sure these control bits are off
	TXO T1,PGLUBR		; Say we want to load the UBA
	DATAO PAG,T1		; Which invalidates stale info in map
	JN TDEC,(TCB),R		; If DEC TCB do not set PCU
	JSP T2,[XSFM T1		; Store processor flags
		TXO T1,PCU	; Previous context user bit
		XJRSTF T1]	; Return with PCU set so XCTU works
	RET
;USTTUM(BFR)
;Unmap user space

;BFR/	(Extended) pointer to buffer descriptor block
;NOSKED
;	CALL USTTUM
;Ret+1:	Always.  Returns OKSKED

USTTUM:	SAVEAC <FX>
	MOVE T1,TCPUS0		; The TCP's actual user secton 0
	MOVEM T1,USECTB+0	; Put back in process table
	DATAI PAG,T1
	TXZ T1,PGLACB+PGLPCS
	TXO T1,PGLUBR
	DATAO PAG,T1		; Cause pager to look again
	JN TDEC,(TCB),USTTU2	; Do not reset PCU for DEC TCB
	LOAD FX,BFRKX,(BFR)	; Get the owning fork
	LOAD T1,FKUPT		; Get SPT index of that fork's map
	CALL DWNSHR
	JSP T2,[XSFM T1		; Get flags
		TXZ T1,PCU	; Turn off PCU bit
		XJRSTF T1]
USTTU2:				; here when the maps are fixed up
	OKSKED
	RET
;RSTBFR(BFR)
;Reset a buffer (descriptor block)

;BFR/	(Extended) Pointer to the buffer descriptor
;	CALL RSTBFR
;Ret+1:	Always.

RSTBFR::
	LOAD T1,BICNT,(BFR)	; Initial byte/word cnt set by SEND, etc
	STOR T1,BCNT,(BFR)	; Set as the working countdown
	LOAD T1,BDADR,(BFR)	; Data address in user space
	STOR T1,BPTRA,(BFR)	; Set buffer byte pointer address
	MOVEI T1,^D36
	STOR T1,BPTRP,(BFR)	; Set position field
	RET
;XFRDAT
;Transfer data between user buffer and a packet

;T1/	Source pointer (may index by TPKT)
;T2/	Dest pointer (may index by TPKT)
;T3/	Number of 8-bit bytes to transfer
;T4/	Non-0 says User-to-monitor transfer (Send direction)
;	CALL XFRDAT
;Ret+1:	Always.  T1, T2, T3 updated

;This is a cutdown version of BYTBLT which assumes 8-bit bytes and is
;able  to  cope  with  the source or destination pointers indexing by
;TPKT which is required to get extended addressing.

XFRDAT:	SAVEAC <FR>
	LOCAL <SRC,DEST,CNT,CNT2>
	MOVE FR,T4		; Save the Send flag
	SKIPG CNT,T3		; Move count and test for early done
	 JRST XFRDAZ		; Zero byte move
	DMOVEM T1,SRC		; T1 to SRC and T2 to DEST
	CAIG CNT,20		; Short transfer? (must be ge 10!)
	 JRST XFRDA1		; Yes
	XOR T1,T2		; Set to compare
	TLC T2,(10B11)		; Flip the byte size
	TLNN T1,(77B11)		; Byte sizes agree?
	TLNE T2,(77B11)		; And both are 8?
	CAIA			; Something is fishy
	 JRST XFRDA3		; Go do it word-at-a-time
	BUG.(CHK,TCPMSX,TCPTCP,SOFT,<XFRDAT: Byte size incorrect>,,<

Cause:	The TCP byte copying routine was called for other than 8 bit
	bytes.

>)

;Byte-at-a-time  mover. Use Extended Instruction Set if present. Here
;for byte-at-a-time move when EIS not on the machine.  Also  used  to
;finish up after other move routines.

XFRDA1:
XFRDA2:	JUMPE FR,XFRD21		; Jump if receive direction
XFRD20:	XCTBU [	ILDB T1,SRC]	; Get a source byte
	IDPB T1,DEST		; Put it where it belongs
	SOJG CNT,XFRD20		; Loop til done
	JRST XFRDAX		; Return to caller

XFRD21:	ILDB T1,SRC
	XCTBU [	IDPB T1,DEST]
	SOJG CNT,XFRD21
	JRST XFRDAX
; Word-at-a-time movers.  Use BLT if no offset in positions.

XFRDA3:	TLNN DEST,(7B2)		; Not up to a word boundary yet?
	TLNE SRC,(1B0)		; Or SRC is a 4410XX style pointer?
	CAIA			; Yes.  Bump both pointers.
	 JRST XFRDA4		; No
	JUMPE FR,XFRD31		; Jump if receive direction
	XCTBU [ILDB T1,SRC]		; No. Move a few bytes til so
	IDPB T1,DEST
	SOJA CNT,XFRDA3		; Note CNT starts ge 10

XFRD31:	ILDB T1,SRC		; No. Move a few bytes til so
	XCTBU [IDPB T1,DEST]
	SOJA CNT,XFRDA3		; Note CNT starts ge 10

XFRDA4:	PUSH P,SRC		; Save pointers so left half can be
	PUSH P,DEST		; restored after using as local indirect
	LDB T1,[POINT 3,SRC,2]	; Position will be 04, 14, 24, or 34
	TXZ SRC,-1B12		; Clear reserved bits
	TXZ DEST,-1B12
	TXO SRC,IFIW		; Form local indirect pointers
	TXO DEST,IFIW
	IDIVI CNT,^D<36/8>	; Number of full words to move
	JUMPE T1,XFRDA8		; No offset in position.  Use BLT

; Offset move

XFRDA5:	ASH T1,3		; Number of bits present in T1
	MOVNI T3,-^D36(T1)	; Amount of shift required in loop
	MOVNI T4,-^D32(T3)	; Number left in T2 after 1st LSH
	SKIPN FR		; Sending?
	 SKIPA T1,@SRC		; No.  Source is monitor space
	 UMOVE T1,@SRC		; Get 1st source word
	ADDI SRC,1		; Bump (extended) pointer
	LSH T1,-4		; Flush the extra bits
; Main move-shift loop (should be in ACs on KA10)

XFRDA6:	SKIPN FR		; Skip if send-direction
	 SKIPA T2,@SRC		; Get four more bytes
	 UMOVE T2,@SRC		; Get four more bytes
	ADDI SRC,1		; Bump extended indirect word
	LSHC T1,0(T3)		; Fill out 32 T1 bits and left justify
	ADDI DEST,1		; Advance destination indirect word
	SKIPN FR		; Skip if sending
	 UMOVEM T1,@DEST	; Store away
	SKIPE FR		; Skip if receiving
	 MOVEM T1,@DEST		; Store away
	LSHC T1,0(T4)		; Get rest from T2 and right just. in T1
	SOJG CNT,XFRDA6		; Loop over all full words
	POP P,T2		; Original DEST
	POP P,T1		; Original SRC
	HLL SRC,T1		; Restore position and size fields
	HLL DEST,T2		; Index and indirect bits wont change
	SOJA SRC,XFRDA9		; Undo the last increment

; No offset.  SRC and DEST were 0410xx,,Y-1

XFRDA8:	MOVE T1,CNT		; Get count
	XMOVEI T2,@SRC		; Get source address
	XMOVEI T3,@DEST		; and Destination
	ADDI T2,1		; Byte ptrs were at end of previous word
	ADDI T3,1
	JUMPN FR,XFRD81		; Jump if receiving
	HRRZS T3		; Sending.  Dest is user section 0
	CALL BLTMU		; Move to user
	JRST XFRD82
XFRD81:	HRRZS T2		; Source is user section 0
	CALL BLTUM
XFRD82:	POP P,DEST		; Original DEST
	POP P,SRC		; Original SRC
	ADD SRC,CNT
	ADD DEST,CNT		; Advance pointers

; Exit for word-at-a-time movers.

XFRDA9:	SKIPE CNT,CNT2		; Number left in partial word
	 JRST XFRDA2		; Go finish them and return

; Common exit

XFRDAX:	DMOVE T1,SRC		; Get updated pointers
	SETZ T3,		; Return a count of 0
XFRDAZ:	RESTORE
	RET
;TBFINI
;Buffer initialization code. Called only at startup.

;	CALL TBFINI
;Ret+1:	Always.

TBFINI:	RET			; Nothing to do in this version
	SUBTTL	TCP User Responses from TCP

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

COMMENT	!

Routines  called  from  within  the TCP to inform the user of various
events that have occurred such as a connection opening or closing, or
a buffer completion.

!
;USREVT(EVENT, TCB)
;Connection open or close.

;T1/	Event Code (Error Code) (377B35)
;TCB/	(Extended) Locked Connection block
;	CALL USREVT
;Ret+1:	Always

USREVT:	LOCAL <CODE>
	MOVEM T1,CODE
	JN TSABT,(TCB),USREVX	; Ignore if ABORT in progress
	LOAD T1,TOPNF,(TCB)	; Index of open/close wait bit index
	LOAD T2,TSSYN,(TCB)	; Send state
	LOAD T3,TRSYN,(TCB)	; Recv state
	CAIN T2,NOTSYN		; Both NOT SYNCHRONIZED?
	 CAIE T3,NOTSYN
	  JRST USREV1

; State now NOT-NOT

	CALL CLRWTB		; Yes. Clear the wait bit (now CLOSED)
	JRST USREV2		; Cannot be SYN-SYN too

USREV1:
	CAIN T2,SYNCED		; Both fully synchronized?
	 CAIE T3,SYNCED
	  JRST USREV2		; No

; State now SYN-SYN

	JN TSOPN,(TCB),USREVX	; Jump if we have already said its open
	SETONE TSOPN,(TCB)	; Indicate that is now true
	CALL SETWTB		; Set the wait bit.
	LOAD T1,TSMXP,(TCB)	; get the size the other side asked for
	CALL TCPMXP		; Set buffer size (TSMXP)
USREV2:
; Any state

	JN TTVT,(TCB),USREV3	; Jump if a virtual terminal

; Here for non-TVT actions

	LOAD T1,TPICX,(TCB)	; Get Status-Change channel
	LOAD T2,TPIFX,(TCB)	; And FORKX to PSI
	CAIE T1,77		; No channel named
	 CAIN T2,-1		; or fork went away,
	  EXIT USREVX		; Means no PSI
	   CALL PSIRQ		; Set off the PSI
	JRST USREVX

; Here for TVT actions

USREV3:	CAIN CODE,OK		; What kind of event is this?
	  JRST USREV4		; Must be open

	MOVE T1,CODE		; Must be something to do with closing
	IFE REL6,<CALL TVTCLS>	; Go close the Virtual terminal
	IFN REL6,<CALLX (MSEC1,TVTCLS)> ; Go close the Virtual terminal
	JRST USREVX

USREV4:	
	IFE REL6,<CALL TVTOPN>	; Open a TCP Virtual Terminal
	IFN REL6,<CALLX (MSEC1,TVTOPN)> ; Open a TCP Virtual Terminal
	JUMPE T1,USREVX		; Done if TVT assigned
	MOVEM T1,CODE		; Save error code (ELT+^D4)

; Failed to assign a TVT to the connection.  The connection is now
; synchronized in both directions.  Try to send an error message to
; the other end before we abort the connection so the user has some
; idea of why the connection is being aborted.

	PUSH P,PKT		; Save these
	PUSH P,TPKT
	MOVX T1,4*<TVTFUE-TVTFUL> ; Message length, words
	SETZ T2,		; Have a TCB
	CALL TCPIPK		; Get empty packet
	  JRST USREV7		; Failed, just abort connection
	LOAD T1,PIPL,(PKT)	; Update packet byte length
	ADDI T1,4*<TVTFUE-TVTFUL>
	STOR T1,PIPL,(PKT)
	MOVX T1,<TVTFUE-TVTFUL>	; Move message into packet
	XMOVEI T2,TVTFUL
	LOAD T3,PTDO,(TPKT)
	ADD T3,TPKT
	CALL XBLTA
	SETONE <PEOL,PFIN>,(TPKT) ; This is the last data
	LOAD T1,TSSEQ,(TCB)	; Set the sequence #
	STOR T1,PSEQ,(TPKT)
	ADDI T1,4*<TVTFUE-TVTFUL>+1 ; End seq # is initial + data + FIN
	MODSEQ T1
	STOR T1,TSSEQ,(TCB)	; Advance Send sequence
	STOR T1,PESEQ,(PKT)	; Save recomputed end of packet
	SETZRO PPROG,(PKT)	; Don't bother with retransmissions
	MOVE T1,TODCLK		; Current millisecond
	STOR T1,PTG,(PKT)	; Packet Time Generated
	SETO T1,		; No TVT line block
	CALL EMTPKT		; Send the packet
	AOS FINSCT

; Now send a RESET to get connection closed

	SETZB T1,T2		; Have a TCB & no data
	CALL TCPIPK		; Get empty packet
	  JRST USREV7		; Give up if no space
	LOAD T1,TSSEQ,(TCB)	; Set the sequence #
	STOR T1,PSEQ,(TPKT)
	STOR T1,PESEQ,(PKT)	; Save recomputed end of packet
	SETONE <PRST>,(TPKT)	; Don't reply
	SETZRO PPROG,(PKT)	; Don't bother with retransmissions
	MOVE T1,TODCLK		; Current millisecond
	STOR T1,PTG,(PKT)	; Packet Time Generated
	SETO T1,		; No TVT line block
	CALL EMTPKT		; Send the packet
	AOS RSTSCT
USREV7:
	POP P,TPKT		; Restore registers
	POP P,PKT
	MOVE T1,CODE		; Error code
	CALL ABTCON		; Abort the connection (ABTCON/USREVT/TVTCLS)
USREVX:	RESTORE
	RET

TVTFUL:	BYTE (8)"4","2","1"," ","N","o"," ","f","r","e","e"," "
	BYTE (8)"t","e","r","m","i","n","a","l","s",15,12
TVTFUE:
;USRERR
;Indicate TCP error condition to user.

; May be called for TVTs with either error
;T1/	TCP-style error code
;		EFP+^D7  RST Received
;		ELP+^D9  RX timeout
;TCB/	(Extended) Locked Connection block
;	CALL USRERR
;Ret+1:	Always

USRERR:	NOSKED
	STOR T1,TERR,(TCB)	; Save the event code for user to see
	JN TSABT,(TCB),USRER1	; Forget PSI if ABORT in progress
	LOAD T1,TPICE,(TCB)	; Get the error channel
	LOAD T2,TPIFE,(TCB)	; Get the error FORKX
	CAIE T1,77		; No channel named
	 CAIN T2,-1		; or fork went away
	  CAIA			; Skip the PSI
	   CALL PSIRQ		; Poke that fork's channel
USRER1:
	LOAD T1,TERRF,(TCB)	; Index of the error flag
	CALL SETWTB		; Set it to wake up waiting process(es)
	OKSKED
	RET

;USRURG
;Alert user that Urgent data is to be read.

;TCB/	(Extended) Locked Connection Block
;	CALL USRURG
;Ret+1:	Always.

USRURG:	JN TSABT,(TCB),USRURX	; Forget if ABORT in progress
	LOAD T1,TPICU,(TCB)	; Get the URG channel
	LOAD T2,TPIFU,(TCB)	; and FORKX
	CAIE T1,77		; None named
	 CAIN T2,-1		; or fork went away
	  EXIT USRURX		; Skip the PSI
	   CALL PSIRQ		; Request the PSI in that fork
USRURX:	RET
;USRBFE
;User buffer empty condition (SEND, etc).

; Never called for TVTs
;T1/	TCP-style event code and flags
;TCB/	(Extended) Locked Connection Block
;BFR/	(Extended) Buffer descriptor
;	CALL USRBFE
;Ret+1:	Always

USRBFE:	PUSH P,T1		; Save the code for a second
	CALL SETTUM		; Make map user into our user space (NOSKED)
	POP P,T1		; Recover the code
	JE TSABT,(TCB),USRBE2	; Different error if ABORT in progress
	MOVX T1,<<ELP+^D14>B7>	; Connection reset
USRBE2:
	LOAD T2,BHADR,(BFR)	; Origin of the Buffer Header
	LOAD T3,BCNT,(BFR)	; Get the count
	UMOVEM T3,BFRCNT(T2)	; Store into user space
	JUMPE T3,USRBE3		; Skip if whole buffer sent
	LOAD T4,TSBYT,(TCB)	; Reduce outstanding count
	SUB T4,T3		; by bytes not sent
	STOR T4,TSBYT,(TCB)
USRBE3:
	TXO T1,TCP%DN		; Buffer done bit
	MOVX T3,<-1B7+TCP%DN>	; Bits changed here
	AND T1,T3		; Flush stray bits
	XCTU [ANDCAM T3,BFRFLG(T2)] ; Clear in user space
	XCTU [IORM T1,BFRFLG(T2)] ; Set to tell the user it has finished
	CALL USTTUM		; Unmap the user space & OKSKED
	LOAD T1,TPICS,(TCB)	; Get the SEND done PSI Channel
	LOAD T2,TPIFS,(TCB)	; And forkx
	CALL BFRDUN		; Dispose of the buffer
	RET
;USRBFF
;User buffer filled (RECV).

; Never called for TVTs
;T1/	TCP-style event code and flags (TCP%PU, TCP%UR, etc.)
;BFR/	(Extended) Buffer desciptor which is completing
;TCB/	(Extended) Locked Connection Block
;	CALL USRBFF
;Ret+1:	Always.

USRBFF:	PUSH P,T1		; Save the code
	CALL SETTUM		; Map the user into our user space (NOSKED)
	POP P,T1		; Recover the code
	JE TRURG,(TCB),USRBFA	; Jump if not in receive urgent mode
	TXO T1,TCP%UR		; Give urgent flag in buffer
USRBFA:
	JE TSABT,(TCB),USRBF2	; Different error if ABORT in progress
	MOVX T1,<<ELP+^D14>B7>	; Connection reset
USRBF2:
	LOAD T2,BHADR,(BFR)	; Get address of header in user space
	LOAD T3,BCNT,(BFR)	; Get count from monitor copy of header
	UMOVEM T3,BFRCNT(T2)	; Store into user copy
	LOAD T4,TRBS,(TCB)	; Amount of RECV buffer space
	SUB T4,T3		; The whole buffer is going back!
				; Shrinking the window is bad!!
	STOR T4,TRBS,(TCB)	; Leave what is left for window setting.
	TXO T1,TCP%DN		; Set the done bit
	MOVX T3,<-1B7+TCP%PU+TCP%UR+TCP%DN> ; Bit we change
	AND T1,T3		; Flush stray bits
	XCTU [ANDCAM T3,BFRFLG(T2)] ; Clear in user space
	XCTU [IORM T1,BFRFLG(T2)] ; Merge with user's header
	MOVX T1,<.RTJST(-1,PIDO)-<MINIHS+3>/4> ; Max IP option words
	XMOVEI T2,TCBIR(TCB)	; Received IP options
	HLRZ T3,BFROPT(BFR)	; Address for IP options
	SKIPE T3		; If none, don't return any
	  CALL BLTMU		; IP options to user
	MOVX T1,<.RTJST(-1,PTDO)-<MINTHS+3>/4> ; Max TCP option words
	XMOVEI T2,TCBTR(TCB)	; Received TCP options
	HRRZ T3,BFROPT(BFR)	; Address for TCP options
	SKIPE T3		; If none, don't return any
	  CALL BLTMU		; TCP options to user
USRBF9:	CALL USTTUM		; Unmap the user space & OKSKED
	LOAD T1,TPICR,(TCB)	; Get the RECV done PSI Channel
	LOAD T2,TPIFR,(TCB)	; And forkx
	CALL BFRDUN		; Dispose of the buffer
	RET
;USRABD
;User ABORT Done.

;TCB/	(Extended) Locked Connection Block
;	CALL USRABD
;Ret+1:	Always

USRABD:	NOSKED
	LOAD T1,TABTFX,(TCB)	; Get FORKX of ABORTer
	ADJBP T1,FKABCP 	; Get pointer to that fork's count
	LDB T2,T1
	SKIPE T2		; Don't let counter underflow
	  SUBI T2,1
	DPB T2,T1
	OKSKED
	RET

;BFRDUN
;Handle buffer done condition.

; Never called for TVTs
;T1/	PSI Channel
;T2/	FORKX to PSI
;BFR/	(Extended) Buffer
;TCB/	(Extended) Locked connection block
;	CALL BFRDUN
;Ret+1:	Always

BFRDUN:	NOSKED
	CAIE T1,77		; No channel named?
	 CAIN T2,-1		; Or fork went away?
	  CAIA			; Means no PSI
	   CALL PSIRQ		; Set off the PSI
	JN TDEC,(TCB),BFRDU4	; do not so this for DEC TCBs
	LOAD T1,BFRKX,(BFR)	; Fork wherein buffer lives
	HLRZ T1,FKPGS(T1)	; Get SPT index of UPT for that fork
	CALL DWNSHR		; Decrement share count
BFRDU4:
	JE BIDX,(BFR),BFRDU5	; Jump if no fork will be waiting
	MOVE T1,BFR		; The item to enqueue
	MOVE T2,TCPBDQ		; The buffer done queue
	CALL NQ			; Pick it up later
	LOAD T1,BIDX,(BFR)	; Get the wait bit index
	CALL SETWTB		; Make the user wake up now
	OKSKED
	EXIT BFRDUX

BFRDU5:	OKSKED
	MOVE T1,BFR		; What to release
	CALL RETBLK		; Return the free storage
BUFDUX:	RET

;USRINI
;Initialize the user interface.

USRINI:	MOVEI T1,QSZ		; Size of a queue head
	CALL GETBLK		; Get space from INTSEC
	JUMPE T1,USRINX		; No room
	MOVEM T1,TCPBDQ		; Save for all to find
	CALL INITQ		; Initialize it
	SETO T1,		; All ok
USRINX:	RET
;BUFHNT
;Hunt for data for the JFN interface

;T1/ Locked TCB Address
;CALL BUFHNT

BUFHNT::
	SAVEAC <TCB,BFR>
	MOVE TCB,T1		; put TCB into correct AC
	SETZ T1,		; no special flags
	LOAD BFR,TRCB,(TCB)	; get the receive buffer
	SETZRO TRCB,(TCB)	; no more receive buffer
	JUMPE BFR,R		; if no buffer return now
	CALL USRBFF		; user buffer filled
	RET			; and return to caller

	TNXEND
	END