Google
 

Trailing-Edge - PDP-10 Archives - BB-H311D-RM - arpanet-sources/tcpbbn.mac
There are 9 other files named tcpbbn.mac in the archive. Click here to see a list.
; UPD ID= 4839, SNARK:<6.MONITOR>TCPBBN.MAC.12,  17-Sep-84 11:37:22 by PURRETTA
;Update copyright notice
; UPD ID= 4024, SNARK:<6.MONITOR>TCPBBN.MAC.11,  31-Mar-84 16:21:36 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 3916, SNARK:<6.MONITOR>TCPBBN.MAC.10,  13-Mar-84 08:06:34 by PAETZOLD
;More TCO 6.1733 - BBNCKK smashes T1.  Reflect that fact in .OPEN
; UPD ID= 3893, SNARK:<6.MONITOR>TCPBBN.MAC.9,  11-Mar-84 10:36:06 by PAETZOLD
;More TCO 6.1733 - Use "JRST EMRET1"  instead of RETERR at TCPERR so as
;not to set LSTERR and allow ITRAPs to work. TATTVT routine for  TVTJFN
;to  attach a JFN to a TVT. Require Wheel/Operator/NetWiz/AbsSockets to
;open listening on small port #. ACJ test passes host and  port  number
;to  ACJ.  If  caller  specifies  a  local  address,  use it in OPEN1A.
;Prevents FTP data connection opened on different host from control.
; UPD ID= 3823, SNARK:<6.MONITOR>TCPBBN.MAC.8,  29-Feb-84 18:13:12 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal.  Bug fixes.  Cleanup.
;<TCPIP.5.3.MONITOR>TCPBBN.MAC.5,  6-Dec-83 23:58:40, Edit by PAETZOLD
;Add an ACJ call in .OPEN
;Make HISTOGRAM symbols conditional
;More TCO 6.1733 - Bug fixes.
;TCO 6.1689 - Move fork tables to extended sections.  Fix FKPGS reference.
;<TCPIP.5.1.MONITOR>TCPBBN.MAC.21,  5-Jul-83 22:30:57, Edit by PAETZOLD
;JFN Interface
;BBN JSYS Stuff into this module

;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  1982, 1984.
;ALL RIGHTS RESERVED.


	SEARCH	ANAUNV,PROLOG
	TTITLE	(TCPBBN,TCPBBN,< - BBN TCP JSYS Interface Routines>)
	IFNDEF REL6,<REL6==1>

COMMENT	!

This module implements the BBN TCP JSYS interface.

This  code  was originally developed at Bolt Beranek and Newman (BBN)
under contract to  the  Defense  Advanced  Research  Projects  Agency
(DARPA).

!

	SWAPCD

STSFLG==TCP%IX!TCP%NI!TCP%NT!TCP%SD!TCP%ST!TCP%SY!TCP%TV ; Frequent constant
	SUBTTL Send JSYS - Send a Buffer

;T1/	Flags,,JCN (or Pointer to Connection Descriptor)
;T2/	Pointer to buffer header
;T3/	Timeout (in seconds) (0 is infinite)
;T4/	RX parameters
;	SEND%
;Ret+1:	 Error, Code in T1
;Ret+2:	Success

.SEND::	MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT>&^-<TCP%JS!TCP%WT!TCP%HP>
         JRST TCPILP		; Illegal control bit
	XMOVEI T1,SEND1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call SEND1
	JUMPL T1,TCPERR		; Error.
	UMOVE T1,T1		; Get the Flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
         JRST SKMRTN		; No.  Give immediate skip return
SENDW:	LOAD T1,BIDX,(BFR)	; Buffer Done Flag Index
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,^D18+<WID(TERRF)> ; Build bfr,err,,INTOOT
	HRRI T1,INTOOT		; Select SEND Done Test routine
	MDISMS			; Wait for either to come on
	XMOVEI T1,SENDP2	; Code to do Send checking w/ tcb locked
	CALL CHKARG		; Do tcb lookup in case it's gone
	JUMPL T1,TCPERR		; Jump if error
	JUMPE T1,SKMRTN		; Skip return if conn open
	HRLS T1			; Conn closing, move wait bits to lh
	HRRI T1,INTZOT		; Select close done test
	MDISMS			;
	XMOVEI T1,TCJFRE	; Code to do cleanup w/ tcb locked
	CALL CHKARG		; Do tcb lookup in case it's gone
	JUMPL T1,TCPERR		; Jump if error
	SMRETN			; All done, skip return

SENDP2:	LOAD T1,TERR,(TCB)	; Get possible error
	JUMPN T1,[HRROS T1	; If error,
		RET ]		; ... return -1,,error in 1.
	JE TSUOP,(TCB),SENDP3	; Jump if conn closing already
	CALL FREBFR		; Conn open, release buffer resources
	SETZ T1,		; Return 0 in t1.
	RET

SENDP3:				; Get wait bits for close wait test
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,<WID(TERRF)>	; Put opn,err in rh of T1.
	RET			; Ret index bits to wait on

TCJFRE:	CALL FREBFR		; Release resources
	LOAD T1,TERR,(TCB)	; Get possible error
	JUMPE T1,R		; Return 0 in T1 if no error
	HRROS T1		;
	RET			; Ret with -1,,error in T1.

TCPERR:	ANDI T1,-1		; Save just the error code
TCPERO:	UMOVEM T1,T1		; Pass to user
	JRST EMRET1		; Give no-skip return.  Do not update LSTERR

TCPILP:	HRROI T1,ELP+^D1	; Illegal parameter (control bit)
	JRST TCPERR
	SUBTTL Send JSYS - Send a Buffer - Second Phase

;T1/	JCN specified by caller
;TCB/	(Extended) Pointer to locked connection block
;   	NOINT
;	CALL SEND1
;Ret+1:	Always, T1 has 0 and BFR has the buffer, or T1 has -1,,error

SEND1:	JN TTVT,(TCB),SEND8	; Not allowed for TVTs
	LOAD T3,TSSYN,(TCB)
	CAIE T3,NOTSYN
	CAIN T3,FINSNT		; Closed or closing?
         JRST SEND6		; Give error
	SETZ T2,		; Not allow options from CDB here
	CALL ACTTCB		; Try to activate the TCB (JCN in T1)
	JUMPL T1,SEND6		; Can't
	XCTU [HRRZ T2,2]	; Get user buffer header address
	SETZ T1,
	JE TNUFM,(TCB),SEND3	; Skip if old format
	UMOVE T1,.TCPBI(T2)	; Get IP info
	UMOVE T2,.TCPBO(T2)	; Get user option addresses word
	TRNE T1,777		; Specified?
         STOR T1,TTOS,(TCB)	; Yes, Save type of service
	HLRS T1
	TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
         STOR T1,TTTL,(TCB)	; Yes, Save Time to live
	LSH T1,^D<-18+2>	; Top two bits
	TRNE T1,3
         STOR T1,TIFDF,(TCB)	; Don't fragment
	MOVE T1,T2		; Option addresses
SEND3:

; Should options be synchronous or asynchronous??

	SKIPE T1		; Have options?
	 CALL TCPUOP		; Yes
	  JUMPL T1,SENDX	; Error in options
	CALL MAKBFR		; Make a buffer descriptor
	SKIPGE BFR,T1		; Error?
         EXIT SENDX		; Yes.  Code in T1.
	UMOVE T3,T3		; Get the Send Timeout from user
	JUMPE T3,SEND4		; He says infinite.  Don't set it.
	CAMLE T3,TCPPTM		; Be sure it is reasonable for add to TODCLK
         MOVE T3,TCPPTM
	IMULI T3,^D1000		; Convert to milliseconds
	STOR T3,TSTO,(TCB)	; Set new value in TCB
SEND4:
	UMOVE T1,T4		; Get Retrans. parameter word
	CALL RXPARS		; Change them in TCB
	MOVE T1,BFR		; What to Enqueue
	XMOVEI T2,TCBSBQ(TCB)	; Queue head for send buffers
	CALL NQ			; Enqueue it for Packetizer.
	LOAD T1,BICNT,(BFR)	; Initial count
	LOAD T2,TSBYT,(TCB)	; Currently queued for PZ
	ADD T2,T1
	STOR T2,TSBYT,(TCB)	; More...
	MOVE T1,BFRFLG(BFR)	; Get the buffer flags
	TXNN T1,TCP%UR		; URGENT send?
	  JRST SEND43		; No.
	CALL SETURP		; Yes.  Set the send urgent pointer
SEND43:
	LOAD T1,TSLFT,(TCB)	; Current Send Left
	LOAD T2,TSSEQ,(TCB)	; Current Send Sequence
	LOAD T3,TSWND,(TCB)	; Current Send Window
	ADD T3,T1		; Current Right
	MODSEQ T3
	CALL CHKWND		; See if there is space in the window
	JUMPE T1,SEND5		; Jump if not.  Recv'd ACK will restart.
	$SIGNL(PZ,0)		; Make Packetizer run now
SEND5:
	TDZA T1,T1		; Say OK to caller
SEND6:	  HRROI T1,ELP+^D12	; "Connection Closing"
SENDX:	RET
SEND8:	HRROI T1,ELP+^D30	; Only internet fork can run TVTs
	RET
	SUBTTL SETURP - Setup Urgent Pointer

;An  URGENT  send  is  being  done  and  the value of the send urgent
;pointer must be computed. This is done by adding up all  the  queued
;data (on the send buffer queue) to get the current end of the urgent
;data, relative to the current send sequence.

;TCB/	Pointer to connection block
;     	NOINT
;	CALL SETRUP
;Ret+1:	Always.  TSURP setup and TSURG turned on.

SETURP:	PUSH P,BFR		; Need this global for scanning buffers
	TEMP <CNT,NXT>		; Give names to T1, T2
	MOVEI CNT,0		; Assume no partial buffer
	LOAD BFR,TSCB,(TCB)	; Get partial buffer if any
	JUMPE BFR,SETUR1	; Jump if none
	SETSEC BFR,INTSEC	; Make extended address
	LOAD CNT,BCNT,(BFR)	; Get number of unsent bytes from bfr
SETUR1:
	MOVEI NXT,TCBSBQ(BFR)	; Pointer to send buffer queue head
SETUR2:	MOVE BFR,NXT		; Point bfr to what we will process
	CAIN BFR,TCBSBQ(BFR)	; Back to the queue head
	  JRST SETUR3		; Means done.  Go finish up.
	SETSEC BFR,INTSEC	; Make extended address
	LOAD NXT,QNEXT,+TCBSBQ(TCB) ; Get pointer to next item for next time
	LOAD T3,BCNT,(BFR)	; Get count from this buffer
	ADD CNT,T3		; Add into total
	JRST SETUR2		; Loop over entire queue, incl. bfr being sent
SETUR3:
	LOAD T3,TSSEQ,(TCB)	; Next send seq. num. to be used
	ADD T1,T3		; Compute 1st non-urgent seq. num.
	MODSEQ T1		; Keep within the right number of bits
	STOR CNT,TSURP,(TCB)	; Set the urgent pointer into the TCB
	SETONE TSURG,(TCB)	; Say we are in send urgent mode
	POP P,BFR
	RESTORE
	RET
	SUBTTL RECV JSYS - Receive a Buffer

;T1/	Flags,,JCN (or pointer to CDB)
;T2/	Pointer to buffer header
;	RECV%
;Ret+1:	 Error.  Code in T1
;Ret+2:	Success

.RECV::	MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
         JRST TCPILP		; Illegal control bit
	XMOVEI T1,RECV1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call RECV1
	JUMPL T1,TCPERR		; Error.
	UMOVE T1,T1		; Get flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
         SMRETN			; No.  Give immediate skip return
RECVW:	LOAD T1,BIDX,(BFR)
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,^D18+<WID(TERRF)>	; Put indexes in LH
	HRRI T1,INTOOT		; Select RECV done test routine
	MDISMS
	XMOVEI T1,TCJFRE	; Code to cleanup w/ tcb locked
	CALL CHKARG		; Do tcb lookup in case it's gone
	JUMPL T1,TCPERR		; Jump if error
	SMRETN			; Return skip to user
	SUBTTL RECV JSYS - Receive a Buffer - Second Phase

;T1/	JCN specified by caller
;TCB/	(Extended) Locked connection block
;     	NOINT
;	CALL RECV1
;Ret+1:	Always.  T1 has 0 and BFR has the buffer, or T1 has-1,,error

RECV1:	JN TTVT,(TCB),RECV8	; Not allow for TVTs
	LOAD T3,TRSYN,(TCB)	; Get receive state
	CAIE T3,NOTSYN		; Not synchronized
	 CAIN T3,FINRCV		; or FIN received?
	  JRST RECV9		; Yes.  Fail. (error code into buffer?)
	SETZ T2,		; Not allow options from CDB here
	CALL ACTTCB		; Try to activate the TCB (JCN in T1)
	JUMPL T1,RECV9		; Could not.
	CALL MAKBFR		; Make a buffer descriptor
	SKIPGE BFR,T1		; Check for error
         EXIT RECVX		; There was one.
	LOAD T1,TRBS,(TCB)	; Current amount of receive buffer space
	LOAD T2,BICNT,(BFR)	; How much more is being made available
	ADD T1,T2
	STOR T1,TRBS,(TCB)	; New amount (for window setting)
	MOVE T1,BFR		; Item to enqueue
	XMOVEI T2,TCBRBQ(TCB)	; Receive buffer queue head
	CALL NQ			; Enqueue this buffer there
	CALL NUWNDO		; Setup the new window, maybe ENCPKT
	JN TRPP,(TCB),RECV5	; Jump if partially process pkt waiting
	LOAD T1,QNEXT,<+TCBRPQ(TCB)>	; Ptr to 1st thing on RA queue
	CAIN T1,TCBRPQ(TCB)	; Empty queue?
         JRST RECV6		; Yes.  No use running RA
RECV5:
	JN TRCB,(TCB),RECV6	; No signal if RA already has a BFR
	LOAD T3,QNEXT,<+TCBRBQ(TCB)> ; Get next buffer on the queue
	SETSEC T3,INTSEC	; Make extended address
	CAME T3,BFR		; Will this new buffer restart RA?
         JRST RECV6		; No.  No need to run RA
	$SIGNL(RA,0)		; Make Reassembler run now
RECV6:
	TDZA T1,T1		; Say OK to caller
RECV9:	 HRROI T1,ELP+^D12	; "Connection Closing"
RECVX:	RET
RECV8:	HRROI T1,ELP+^D30	; Only internet fork can run TVTs
	RET
	SUBTTL OPEN JSYS - Open a Connection

;T1/	Flags,,Pointer to Connection Descriptor Block (CDB)
;T2/	Persistence, seconds (max is TCPPTM)
;T3/	RX parameters
;	OPEN%
;Ret+1:	 Error.  T1 has <JCN,,code>.	ELP+^D1 - bad bit (TCP%JS)
;Ret+2:	Success.

.OPEN::	MCENT			; Enter the monitor context
	CALL BBNCKK
	 RETERR	(TCPX28)	; not legal

;Unprivileged  users  must  not be allowed to do a listening OPEN% on a
;small port number, e.g. [0.xxx]. This avoids a user from grabbing some
;server port, e.g. [0.23] (the TELNET port) and putting a trojan  horse
;on  it  that gobbles down the user's password. It is really not enough
;to ask the ACJ just based upon it being some TCP open. For example,  a
;site  with  on  ARPANET and some local network may want to allow local
;net access but not ARPA access. Another example are resources such  as
;printing servers which may be accessed only by certain individuals.

HOCTET==377B27			; high order octet in a port number

	UMOVE T1,1		; get users AC1
	TXNE T1,<STSFLG!TCP%JS>&^-<TCP%WT> ; JCN supplied is an error
         JRST TCPILP		; Illegal control bit
	MOVE T3,FORKX		; get our fork number
	CAMN T3,INTFRK		; bypass check if we're the Internet fork
	IFSKP.
	  XCTU [HRRZ T3,T1]	; must check, get connection block pointer
	  IFXE. T1,TCP%FS	; active connection may have any port #
	    UMOVE T1,.TCPLP(T3)	; get requested local port
	  ANDXE. T1,HOCTET	; not active, if high octet zero need privs
	    JE <SC%WHL,SC%OPR,SC%NAS,SC%NWZ>,CAPENB,[RETERR (NTWZX1)]
	  ENDIF.
	  UMOVE T1,.TCPFH(T3)	; get foreign host number
	  UMOVE T2,.TCPFP(T3)	; get foreign port number
	  GTOKM (.GOANA,<T1,T2>,[RETERR ()]) ; ask ACJ for its blessing
	ENDIF.
	XMOVEI T1,OPEN1		; Routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call OPEN1
	JUMPL T1,OPENE		; Jump if there was an error ?? JCN/TCB
	UMOVE T2,T1		; Get flags
	TLNE T2,(TCP%WT)	; Supposed to wait?
         JRST OPENW		; Yes.
OPENOK:	TLO T1,(TCP%JS)		; Turn on JCN Supplied bit for him
	UMOVEM T1,T1		; Give JCN to user
	SMRETN

OPENW:	PUSH P,T1		; Save the JCN
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,^D18+<WID(TERRF)> ; Put indexes in LH
	HRRI T1,INTOOT		; Select OPEN Done Test
	MDISMS
	POP P,T1
	LOAD T2,TERR,(TCB)	; Get error code
	JUMPE T2,OPENOK		; Jump if no error
	HRLZS T1		; JCN left half
	HRR T1,T2		; Put error code in right half
	SKIPA
OPENE:	 TLZ T1,400000		; TURN OFF THE ERROR BIT
	JRST TCPERO
	SUBTTL OPEN JSYS - Open a Connection - Second Phase

;T1/	JCN resulting from CDB specified by caller
;T2/	Option addresses word, or 0 if none specified
;TCB/	(Extended) Locked connection block
;    	NOINT
;	CALL OPEN1
;Ret+1:	Always.  T1 has -1,,error or the JCN
;		-1,,ELP+^D6	Already open
;		-1,,ELP+^D12	Closing (one side or other NOTSYN)
;		-1,,ELP+^D30	TCP%VT not allowed by user jobs

OPEN1::	LOCAL <USRAC1,JCN,UOPTS>
	MOVEM T1,JCN
	MOVEM T2,UOPTS
        UMOVE USRAC1,T1		; get the flags
	TLNN USRAC1,(TCP%VT)	; Virtual terminal?
         JRST OPEN1A		; Not a virtual terminal
	HRROI T1,ELP+^D30	; "Only Internet fork can run TVTs"
	MOVE T2,FORKX		; Which fork this is
	CAME T2,INTFRK		; The Internet fork?
         JRST OPENX		; No.  Give error return
OPEN1A:
	JN TSUOP,(TCB),OPEN6	; Jump if already open
	JN TLH,(TCB),OPEN1D	; If caller specified a local address use it
	LOAD T1,TFH,(TCB)	; Get foreign host
	JUMPE T1,OPEN1D
	PUSH P,P1		; Save AC
	CALL FNDNCT		; Get the NCT for that net
	 JRST [ POP P,P1	; Restore AC
		MOVE T1,DEFADR	; Use default address
		JRST OPEN1B]	; Join below
	MOVE T1,NTLADR(P1)	; get our address on that network
	POP P,P1		; Restore AC
OPEN1B:
	STOR T1,TLH,(TCB)	; And stick it in the TCB
OPEN1D:
	MOVE T1,JCN
	MOVE T2,UOPTS
	CALL ACTTCB		; Try to activate the TCB
	JUMPL T1,OPENX2		; Cannot
	SETONE TSUOP,(TCB)	; Mark the TCB as open
	JE TNUFM,(TCB),OPEN5	; Skip following if old format
	HRRZ T1,USRAC1		; Connection block address
	UMOVE T1,.TCPIP(T1)	; Get IP parameter word
	STOR T1,TTOS,(TCB)	; Save type of service
	HLRS T1
	TRNE T1,.RTJST(-1,PITTL) ; User specify non-zero time?
         STOR T1,TTTL,(TCB)	; Yes, Save Time to live
	LSH T1,^D<-18+2>	; Top two bits
	STOR T1,TIFDF,(TCB)	; Don't fragment
OPEN5:
        UMOVE T2,T2		; no get the send timeout from user
	JUMPE T2,OPEN4		; Don't change if no specification
	CAMLE T2,TCPPTM		; Be sure it is reasonable for add to TODCLK
         MOVE T2,TCPPTM
	IMULI T2,^D1000		; Make into milliseconds
	STOR T2,TSTO,(TCB)	; Set the new value into the TCB
OPEN4:
        UMOVE T1,T3		; get retrans. parameter word
	CALL RXPARS		; Change them in TCB
	TLNN USRAC1,(TCP%VT)	; Openning as a virtual terminal?
	  JRST OPEN3		; No
	SETONE TTVT,(TCB)	; Yes.  Mark TCB as such
OPEN3:
	TMNN TCDFS,(TCB)	; JFN interface want active?
	TLNE USRAC1,(TCP%FS)	; Supposed to force synchronization?
	  CALL FRCPKT		; Yes.  Packetizer will do that.
				; Should TSPRS be on allready?
	TLNN USRAC1,(TCP%PS)	; Supposed to be persistent?
	  JRST OPEN2		; No.
	SETONE TSPRS,(TCB)	; Yes, mark the TCB as such.
OPEN2:
	MOVE T1,JCN		; Value to return
	EXIT OPENX

;Returning an error is bad since connection is open & cannot return
;both error and JCN,  either abort & return error or skip & return JCN

OPEN6:	HRROI T1,ELP+^D6	; "Connection already open"
OPENX2:				; Probably bad options
OPENX:
	JUMPGE T1,OPENX3	; JUMP IF NO ERROR
	HRLI T1,(JCN)		; GET THE JCN FOR USER ABORT
	TLO T1,400000		; TURN ON THE ERROR BIT
OPENX3:				; HERE WHEN NO ERROR
	RESTORE
	RET
	SUBTTL CLOSE JSYS - Close a Connection

;T1/	Flags,,JCN (NOTE: don't allow CDB here since it would create a TCB)
;	CLOSE%
;Ret+1:	 Error, Code in T1
;		ELP+^D1   Bad JCN, No TCB, CDB not allowed
;		ELP+^D3   Was never open
;Ret+2:	Success

.CLOSE::MCENT			; Enter the monitor context
	TXNE T1,TCP%JS		; JCN must be supplied
	 TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
          JRST TCPILP		; Illegal control bit
	HRRZS T1		; Save just the JCN part
	XMOVEI T2,CLOSE1	; Select CLOSE1 routine
	CALL CHKJCN		; Check access, set TCB, call CLOSE1
	JUMPL T1,TCPERR		; Jump if error.
	UMOVE T1,T1		; Get flags
	TLNN T1,(TCP%WT)	; Supposed to wait?
         JRST CLOSEX		; No.  User will do ABORT to release JCN
	LOAD T1,TOPNF,(TCB)	; Get ID of Open Flag for this TCB
	LOAD T2,TERRF,(TCB)	; Error Flag index
	ROT T2,-<WID(TERRF)>	; Put in high bits of T2
	LSHC T1,^D18+<WID(TERRF)> ; Put indexes in LH
	HRRI T1,INTZOT		; Select Close Done Test
	MDISMS
	LOAD T1,TERR,(TCB)	; Get the error code
	JUMPN T1,TCPERR		; Jump if error code non-null
	LOAD T1,TJCN,(TCB)	; Get the JCN for this connection
	CALL RETJCN		; Release it
CLOSEX:	SMRETN

CLOSE1::JE TSOPN,(TCB),CLOSE3	; Was it ever open?
	JE TSUOP,(TCB),CLOSE3	; Still Open?
	SETZRO TSUOP,(TCB)	; No longer
	CALL FRCPKT		; Get a FIN sent by Packetizer
	TDZA T1,T1		; Tell caller OK
CLOSE3:	  HRROI T1,ELP+^D3	; "Connection not open"
	RET
	SUBTTL ABORT JSYS - Abandon this end of a connection

;T1/	Flags,,JCN
;	ABORT
;Ret+1:	Error.  T1 has code.	ELP+^D1 - CDB supplied
;Ret+2:	Success.  Nothing more will be heard about this connection.

.ABORT::MCENT			; Enter monitor context
	TXNE T1,TCP%JS		; JCN must be supplied
	 TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	HRRZS T1		; Save just the JCN
	XMOVEI T2,ABORT1	; Select the routine to run
	CALL CHKJCN		; Check arguement, set TCB, run ABORT1
	JUMPL T1,TCPERR		; Jump if some sort of error
	MOVEI T1,TCPABT		; Select wait routine
	HRL T1,FORKX		; For this fork
	MDISMS
	SMRETN

;ABORT1(TCB)
;Second phase of ABORT JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked Connection Block
;      	NOINT
;	CALL ABORT1
;Ret+1:	Always.  T1 has 0 for passing to caller.

ABORT1:
	CALL ABTTCB		; Abort the connection and increment
				; # being aborted by this forkx
	LOAD T1,TJCN,(TCB)	; Get user's handle
	CALL RETJCN		; Release that.
	MOVX T1,OK		; Say OK to caller
	RET
	SUBTTL ABTJCS - Abort JCNs for Forks

;T1/	Job fork number of fork being considered
;	CALL ABTJCS
;Ret+1:	Always.

ABTJCS::SKIPE TCPON		; TCP enabled?
	 SKIPL TCPIFG		; TCP Initialized yet (JOB-0 startup)
	  RET			; No.
	SAVET			; CLZFF code requires this
	MOVE T3,T1		; Put in place for call via LCKCAL
	XMOVEI T1,TCBHLK	; Stabilize JCNTCB table in JSB
	XMOVEI T2,ABTJC1	; and call function to abort JCNs
	NOINT			; Retain control during this
	CALL LCKCAL
	MOVEI T1,TCPABT		; Wait for all to be aborted
	HRL T1,FORKX		; The ones by this fork, that is.
	MDISMS
	OKINT			; State is clean again
	RET

;T1/	Job fork number of fork being considered
;ABTJC1
;Same as above, but called with TCBH Lock set, NOINT
;TCBHLK locked, NOINT

ABTJC1:	LOCAL <JCN,JOBFRK>
	PUSH P,TCB
	MOVEM T1,JOBFRK
	MOVSI JCN,-MAXJCN	; Set to scan table
ABTJC2:	HRRZ TCB,JCNTCB(JCN)	; Get pointer to TCB
	JUMPE TCB,ABTJC3	; Avoid non-pointers
	SETSEC TCB,INTSEC	; Make extended address
	XMOVEI T1,TCBLCK(TCB)	; Pointer to lock on that TCB
	XMOVEI T2,ABTJCN	; Function to abort a JCN
	MOVE T3,JOBFRK		; Argument for ABTJCN
	CALL LCKCAL		; Lock the TCB and Abort the JCN
ABTJC3:	AOBJN JCN,ABTJC2	; Loop over all
	POP P,TCB
	RESTORE
	RET
	SUBTTL ABTBUF - Abort Buffers Associated with Forks

;	CALL ABTJCS
;Ret+1:	Always.

ABTBUF::
	SAVET			; KSELF code requires this
	SKIPE TCPON		; TCP enabled?
	 SKIPL TCPIFG		; TCP Initialized yet (JOB-0 startup)
	  RET			; No.
	XMOVEI T1,TCBHLK	; Stabilize JCNTCB table in JSB
	XMOVEI T2,ABTBF1	; and call function to abort JCNs
	CALL LCKCAL		; lock the lock and scan the TCBs
	RET

;ABTBF1	worker for above, but called with TCBH Lock set

ABTBF1:	LOCAL <JCN>
	PUSH P,TCB
	MOVSI JCN,-MAXJCN	; Set to scan table
ABTBF2:	HRRZ TCB,JCNTCB(JCN)	; Get pointer to TCB
	JUMPE TCB,ABTBF3	; Avoid non-pointers
	SETSEC TCB,INTSEC	; Make extended address
	PUSH P,JCN
	XMOVEI T1,TCBLCK(TCB)	; Lock the TCB
	XMOVEI T2,ABTBF4	; Go to worker routine for the TCB
	CALL LCKCAL		; Lock the lock and call the routine
	POP P,JCN
ABTBF3:	AOBJN JCN,ABTBF2	; Loop over all the JCNs
	POP P,TCB		; Restore an AC
	RESTORE
	RET

ABTBF4:				; worker routine called with TCB locked
	CALL FLSRBX		; flush any receive buffers
	CALL FLSSBX		; flush any send buffers
	RET			; return to caller
	SUBTTL ABTJCN - Abort a JCN

;T1/	Job fork number being considered
;TCB/	(Extended) Locked connection block
;TCBH/	Locked TCB Hash table
;      	NOINT
;	CALL ABTJCN
;Ret+1:	Always.

ABTJCN:	LOAD T2,TOWNR,(TCB)	; Get job number of owner
	CAME T2,JOBNO		; Better be ours
	 BUG.(CHK,TCPJS4,TCPTCP,SOFT,<ABTJCN: TCP Conn not owned by aborting job>)
	LOAD T2,TOFRK,(TCB)	; Get job fork handle of owning fork
	UMOVE T3,T1		; Get CLZFF flags from caller
	CAME T1,T2		; Was JCN created by the object fork?
	  JRST ABTJC4		; No.
	TXNN T3,CZ%NSF		; Yes. Are we supposed to abort there?
	  JRST ABTJC5		; Yes.  Go do it
	EXIT ABTJCX

ABTJC4:	EXCH T1,T2		; Get to right places for SKIIFA
	TXNN T3,CZ%NIF		; Abort inferiors' connections?
	 CALL SKIIFA		; Check owner inferior to object fork
	  EXIT ABTJCX		; Should not kill it
ABTJC5:				; ??Why not CALL ABORT1 for these?
	CALL ABTTCB		; Get the TCP fork to do the work
	LOAD T1,TJCN,(TCB)	; Get the JCN
	CALL RETJCN		; Release that
ABTJCX:	RET
	SUBTTL ABTTCB - Abort a TCB

;TCB/	Locked Connection Block
;     	NOINT
;	CALL ABTTCB
;Ret+1:	Always.

ABTTCB::
	JN TSABT,(TCB),R	; Already being aborted?
	SETONE TSABT,(TCB)	; No.  Make it so.
	SETZRO TSUOP,(TCB)	; Fake a CLOSE
	MOVEI T1,ELP+^D14	; Connection reset
	CALL ABTCON		; Clean up the database for this connection
	MOVE T1,FORKX		; Our fork number
	STOR T1,TABTFX,(TCB)	; Indicate which is killing the TCB
	NOSKED			; Make sure we get the system
	ADJBP T1,FKABCP		; Pointer to base of counters
	LDB T2,T1
	CAIGE T2,<1_ABTCBS>-1	; Do not allow count to wrap around
         ADDI T2,1		; Bump the number killed by this fork
	DPB T2,T1
	OKSKED			; Only be NOSKED for the ABORT part
	$SIGNL(PZ,0)		; Run packetizer
	RET
	RESCD

;TCPABT(FORKX)
;Scheduler test for ABORT(s) done

;T1/	a FORKX
;T4/	Return address
;	JSP T4,TCPABT
;Ret+1:	 One or more connections still being aborted
;Ret+2:	All ABORTs completed

TCPABT::
	ADJBP T1,FKABCP
	LDB T2,T1
	JUMPE T2,1(T4)
	JRST 0(T4)

	SWAPCD
	SUBTTL STAT JSYS - Get status of a connection or a TCB

;T1/	Flags,,JCN or Pointer to CDB
;T2/	-N,,Offset	Number and beginning to return
;T3/	-M,,Address	Size and location in user space for results
;	STAT%
;Ret+1:	 Error.  Code in T1
;			ELP+^D20
;			ELP+^D21
;		from CHKARG
;Ret+2:	Success

.STAT::	MCENT			; Enter monitor context
	TXNE T1,<TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT!STSFLG>
         JRST TCPILP		; Illegal control bit
	TXNE T1,TCP%ST		; Asking for TCP statistics?
         JRST STATS		; Yes
	TXNE T1,TCP%NT		; AOBJN pointer for TVTs wanted?
         JRST STATNT		; Yes
	TXNE T1,TCP%NI		; AOBJN pointer for connections wanted?
         JRST STATNI		; Yes
	XMOVEI T1,STAT1		; Select routine to call
	CALL CHKARG		; Check arguments, set TCB, call STAT1
	JUMPL T1,TCPERR		; There was something wrong.
	SMRETN

; Return in 2/ -#TVTs,,first TVT

STATNT:	MOVE T2,TVTPTR		; Get AOBJN pointer
	UMOVEM T2,2		; to user
	SMRETN			; All ok

; Return in 2/ -# connections,,1

STATNI:	MOVN T2,TCBCNT		; # connections
	HRLS T2			; in LH
	HRRI T2,1		; First connection #
	UMOVEM T2,2		; to user
	SMRETN			; All ok
; Just copy the statistics area to user space

STATS:	SETZ TCB,		; Be safe
	TXNE T1,TCP%SY		; Giving symbolic names?
         JRST STATS9		; Yes
	HLRE T1,T2		; Get count
	MOVNS T1		; As a positive number
	HLRE T4,T3		; Get size of user's area
	MOVNS T4		; As a positive number
	CAMLE T1,T4		; Take min as size of transfer
         MOVE T1,T4
	MOVEI T4,0(T2)		; Start point
	ADD T4,T1		; End + 1
	CAILE T4,STATZZ-STAT0	; Compare with size of statistics area
         JRST STATS8		; Tell him it is bad.
	PUSH P,T1		; Save for awhile
	MOVEI T2,STAT0(T2)	; Start address within statistics area
	HRRZS T3		; Assume user section 0
	CALL BLTMU		; Transfer from monitor to user
	POP P,T4		; Recover size
	HRLS T4			; Make N,,N
	XCTU [ADDM T4,T2]	; Update user's pointers
	XCTU [ADDM T4,T3]
	SMRETN

STATS8:	HRROI T1,ELP+^D21	; Bad arg to STAT
	JRST TCPERR

STATS9:	CALL STATNM		; Do work
	JUMPL T1,TCPERR		; Error exit
	SMRETN
	SUBTTL STAT JSYS - Get status of a connection - Second Phase

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked connection block
;     	NOINT
;	CALL STAT1
;Ret+1:	Always.  T1 has 0 for OK, or -1,,error
;			-1,,ELP+^D20
;			-1,,ELP+^D21

STAT1:	LOCAL <XFRCNT>
	UMOVE T1,T1		; Get flags
	UMOVE T2,T2		; Get pointer
	UMOVE T3,T3		; Get pointer to user space
	TXNE T1,TCP%SY		; Giving symbolic names?
         JRST STAT6		; Yes
	JUMPGE T2,STAT9		; Strange pointer
	JUMPGE T3,STAT9		; Strange pointer
	HLRE T1,T2		; Get count
	MOVNS T1		; As a postive number
	HLRE XFRCNT,T3		; Get size of user's area
	MOVNS XFRCNT		; As a postive number
	CAMLE XFRCNT,T1		; Take min as size of transfer
         MOVE XFRCNT,T1
	HRRZ T4,T2		; Start offset
	CAIL T4,TCBSIZ		; Must be within TCB
         JRST STAT8		; Tell him "bad arg"
	ADD T4,XFRCNT		; Compute end+1
	CAILE T4,TCBSIZ		; Trying to read too much?
         JRST STAT8		; Tell him arg is bad.
	HRRZS T2		; Flush the count
	ADD T2,TCB		; Start address within TCB
	HRRZS T3		; Flush the count (assume user sec 0)
	MOVE T1,XFRCNT		; Set up count
	CALL BLTMU		; Transfer from monitor to user
	HRLS XFRCNT
	XCTU [ADDM XFRCNT,T2]	; Update user's pointers
	XCTU [ADDM XFRCNT,T3]
	MOVX T1,OK		; Tell caller all is well
	EXIT STATX

STAT6:	CALL STATNM		; Do the work
	JRST STATX

STAT8:	SKIPA T1,[-1,,ELP+^D20]	; "Funny pointer to STAT"
STAT9:	  HRROI T1,ELP+^D21	; "Bad transfer size to STAT"
STATX:	RESTORE
	RET
	SUBTTL STATNM - Symbolic Routines

; T1/	User flags
; T2/	Input count/pointer
; T3/	Output count/pointer
;	CALL STATNM
;Ret+1:	Always  T1 has error code or 0

STATNM:	LOCAL <UFL,INP,OUP>
	PUSH P,TCB-1		; Used for STAT0
	XMOVEI TCB-1,STAT0	; References
	JUMPGE T2,STATNV	; IN pointer error
	JUMPGE T3,STATNV	; OUT pointer error
	MOVEM T1,UFL		; Save flags (TCP%SD)
	MOVEM T2,INP		; Save pointers
	MOVEM T3,OUP

; Know have valid input ptr & at least 1 output slot

STATN3:	UMOVE T4,(INP)		; Get name
	CALL SRCH		; Lookup name
	JUMPE T2,STATNW		; Lose
	TXNE UFL,TCP%SD		; Want pointer or value?
	  MOVEI T2,1		; Pointer has only one value
	TXNE UFL,TCP%SD		; Want pointer or value?
	 SKIPA T1,T3		; Get pointer
	  LDB T1,T3		; Get value

STATN7:	UMOVEM T1,(OUP)		; For user
	SOS T2			; One less to go
	AOBJP OUP,STATNU	; Leave if output full
	JUMPLE T2,STATN8	; End Multiple
	ILDB T1,T3		; Get value
	JRST STATN7

STATN8:	AOBJN INP,STATN3	; More input?
	SETZ T1,		; No, All done w/o error
	JRST STATNX

STATNU:	SKIPN T1,T2		; Error if more to output
         AOBJP INP,STATNX	; Or more input
STATNV:	SKIPA T1,[-1,,ELP+^D21]	; Bad pointers
STATNW:	 HRROI T1,ELP+^D22	; Invalid name

STATNX:	UMOVEM INP,2		; Return updated input
	UMOVEM OUP,3		; And output pointers
	POP P,TCB-1		; Restore register
	RESTORE
	RET			; Return
	SUBTTL SRCH - Exact Match Binary Search Routine

; T4/	Symbol
;	CALL SRCH
; T3/	Pointer
; T2/	Count

SRCH:	TEMP <PRB,XXX,OFS,KEY>
	SETZB PRB,T2		; Offset into table & Assume missing
	MOVX OFS,1_<^D<36-^L<STABLN>>> ; Get Initial offset (next 2**N)
SRCHF:	ADD PRB,OFS		; Move forward (double)
SRCHR:	LSH OFS,-1		; Next time
         SUB PRB,OFS		; Move reverse
	JUMPLE OFS,SRCHX	; Stop if no move
	CAIG PRB,STABLN		; Point too far? or
	 CAMGE KEY,STSTAB(PRB)	; Value too big?
	  JRST SRCHR		; Yes, move back
	CAML KEY,STSTAB+1(PRB)	; As far as next?
         JRST SRCHF		; Yes, move forward
SRCHX:	CAME KEY,STSTAB(PRB)	; Exact match?
         RET			; No, error (T2 is 0)
	MOVE T3,STATPT(PRB)	; Value
	MOVE T2,STATCT(PRB)	; Count
	RESTORE
	RET
	SUBTTL Symbolic STAT Tables

DEFINE DEFSTS <
	IFN IPPDSW,<XX (M,ACDLAY,HISTSZ)>
	XX (M,BGRNCT)
	XX (M,BGUSE)
	XX (M,BYTRCT)
	XX (M,BYTSCT)
	XX (M,DGRNCT)
	XX (M,DGUSE)
	XX (M,DUPKCT)
	XX (M,FINRCT)
	XX (M,FINSCT)
	XX (M,INTBYP)
	IFN IPPDSW,<XX (M,IPDLAY,HISTSZ)>
	XX (M,IPPKCT)
	XX (M,IPRNCT)
	XX (M,IPUSE)
	XX (M,OHUSE)
	IFN IPPDSW,<XX (M,OPDLAY,HISTSZ)>
	XX (M,OPPKCT)
	XX (M,OPRNCT)
	XX (M,OPUSE)
	IFN IPPDSW,<XX (M,PZDLAY,HISTSZ)>
	XX (M,PZPKCT)
	XX (M,PZRNCT)
	XX (M,PZUSE)
	IFN IPPDSW,<XX (M,RADLAY,HISTSZ)>
	XX (M,RAPKCT)
	XX (M,RARNCT)
	XX (M,RAUSE)
	XX (M,RSTRCT)
	XX (M,RSTSCT)
	IFN IPPDSW,<XX (M,RXDLAY,HISTSZ)>
	XX (M,RXPKCT)
	XX (M,RXRNCT)
	XX (M,RXUSE)
	XX (M,SYNRCT)
	XX (M,SYNSCT)
	XX (T,TABTFX)
	XX (M,TASKCT)
	XX (T,TCBIO,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBIR,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBIU,<1_<WID(PIDO)>-1-<MINIHS+3>/4>)
	XX (T,TCBTO,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCBTR,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCBTU,<1_<WID(PTDO)>-1-<MINTHS+3>/4>)
	XX (T,TCTBS)
	XX (T,TCTSQ)
	XX (T,TERBF)
	XX (T,TERJN)
	XX (T,TERR)
	XX (T,TERRF)
	XX (T,TERRT)
	XX (T,TFH)
	XX (T,TFP)
	XX (T,TIFDF)
	XX (T,TIPDO)
	XX (T,TIPOR)
	XX (T,TIPOU)
	XX (T,TJCN)
	XX (T,TLH)
	XX (T,TLP)
	XX (T,TMNRT)
	XX (T,TMXRT)
	XX (T,TOFRK)
	XX (T,TOPFH)
	XX (T,TOPFP)
	XX (T,TOPLH)
	XX (T,TOPNF)
	XX (T,TOWNR)
	XX (T,TPICA)
	XX (T,TPICE)
	XX (T,TPICR)
	XX (T,TPICS)
	XX (T,TPICU)
	XX (T,TPICX)
	XX (T,TPIFA)
	XX (T,TPIFE)
	XX (T,TPIFR)
	XX (T,TPIFS)
	XX (T,TPIFU)
	XX (T,TPIFX)
	XX (T,TRBS)
	XX (T,TRCBY)
	XX (T,TRIS)
	XX (T,TRLAK)
	XX (T,TRLFT)
	XX (T,TRLWN)
	XX (T,TRPP)
	XX (T,TRSYN)
	XX (T,TRURG)
	XX (T,TRURP)
	XX (T,TRWND)
	XX (T,TRXI)
	XX (T,TRXPD)
	XX (T,TRXPI)
	XX (T,TRXPN)
	XX (T,TSABT)
	XX (T,TSBYT)
	XX (T,TSCB)
	XX (T,TSCR)
	XX (T,TSEP)
	XX (T,TSFP)
	XX (T,TSLFT)
	XX (T,TSLVC)
	XX (T,TSLVN)
	XX (T,TSMRT)
	XX (T,TSMXB)
	XX (T,TSMXP)
	XX (T,TSOPN)
	XX (T,TSPRS)
	XX (T,TSSEQ)
	XX (T,TSSV)
	XX (T,TSSYN)
	XX (T,TSTO)
	XX (T,TSUOP)
	XX (T,TSURG)
	XX (T,TSURP)
	XX (T,TSWND)
	XX (T,TTOS)
	XX (T,TTPDO)
	XX (T,TTPOR)
	XX (T,TTPOU)
	XX (T,TTTL)
	XX (T,TTVT)
	XX (T,TVTL)
	XX (T,TWLDN)
	XX (T,TWLDP)
	XX (T,TWLDT)
> ; End of DEFINE DEFSTS

; Construct the ASCII Name Table

DEFINE XX (TYP,NAM,LEN)<
IFLE <ASCII /NAM/>-..XL,<PRINTX ? DEFSTS NAM is truncated or out of order>
	..XL=ASCII /NAM/
	EXP ..XL
> ; End of DEFINE XX

	..XL=400000000000
STSTAB:	400000000000		; Minimum
	XLIST
	DEFSTS			; Status names
	LIST
	377777777777		; Maximum
STABLN=.-STSTAB-2

; Construct the Count Table

DEFINE XX (TYP,NAM,LEN)<
	IFB  <LEN>,<1>
	IFNB <LEN>,<LEN>
> ; End of DEFINE XX

STATCT:	0			; Minimum
	XLIST
	DEFSTS			; Status counts
	LIST
	0			; Maximum

; Construct the LDB Pointer Table

DEFINE XLDB  (L,O,M)<	<^D<35-POS(M)>>B5+<WID(M)>B11+<TCB>B17+O >

DEFINE XX (TYP,NAM,LEN)<
	..XL=-1
  IFIDN <TYP><M>,<			POINT 36,NAM-STAT0(TCB-1),35
		..XL=..XL+1> ; End IFIDN M
  IFIDN <TYP><T>,<	IFNDEF %'NAM,<	POINT 36,NAM(TCB),35>
			IFDEF  %'NAM,<	%'NAM (XLDB,,,NAM)>
		..XL=..XL+1> ; End IFIDN T
  IFN ..XL,<PRINTX ? Type code for NAM must be M or T>
> ; End of DEFINE XX

STATPT:	0
	XLIST
	DEFSTS			; Status pointers
	LIST
	0

	PURGE ..XL
	SUBTTL CHANL - Set TCP Event Interrupt Channels

;T1/	Flags,,JCN (or pointer to CDB)
;T2/	Six 6-bit bytes (channel numbers)
;	77 - No change, or 0-5, 24-35 Channel to get intertupt
;	CHANL
;Ret+1:	 Error, Code in T1.
;		from CHKARG
;			ELP+^D17 Bad arg to CHANL
;Ret+2:	Success

.CHANL::MCENT			; Enter monitor context
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,CHANL1	; Select routine to call via CHKARG
	CALL CHKARG		; Check arguments, set TCB, call CHANL1
	JUMPL T1,TCPERR		; Jump if something is wrong.
	SMRETN

;CHANL1(TCB)
;Second phase of CHANL JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	(Extended) Locked Connection Block
;      	NOINT
;	CALL CHANL1
;Ret+1:	Always.  T1 has 0 if OK, or -1,,error
;			-1,,ELP+^D17 Bad arg to CHANL

CHANL1:	TEMP <NEW,OLD,CNT,FORKID>
	LOCAL <NEWCHS,NEWPTR,OLDPTR,FRKPTR>
	UMOVE NEWCHS,T2		; Get channel word from user
	MOVE NEWPTR,[POINT 6,NEWCHS]	; Set to scan them
	MOVE OLDPTR,[POINT 6,TCBPIC(TCB)]; Set to scan current ones
	MOVE FRKPTR,[POINT 18,TCBPIF(TCB)]; Set to scan forks
	MOVEI CNT,6		; How many to scan
	MOVE FORKID,FORKX	; Who is setting the new channels
CHANL2:	ILDB NEW,NEWPTR		; Get a new setting
	ILDB OLD,OLDPTR		; and what was there before
	CAIE NEW,77		; No change mark?
	 CAIG NEW,5		; OK number for the channel?
	  JRST CHANL3		; Take the good number
	CAIL NEW,^D24		; These are also OK
	 CAILE NEW,^D35
	  JRST CHANL9		; Bad.  Tell user.
CHANL3:
	CAIE NEW,77		; No change?
	  MOVE OLD,NEW		; No.  New will replace old
	DPB OLD,NEWPTR		; Construct the replacement set
	IBP FRKPTR		; Move to current fork slot
	CAIE NEW,77		; Changing the channel
	  DPB FORKID,FRKPTR	; Yes.  This fork gets the PSIs now.
	SOJG CNT,CHANL2		; Loop over all six bytes
	MOVEM NEWCHS,TCBPIC(TCB); Stash into TCB
	TDZA T1,T1		; Tell caller all is well
CHANL9:	  HRROI T1,ELP+^D17	; "Bad arg to CHANL"
	RESTORE
	RET
	SUBTTL SCSLV JSYS - Set Connection Security Level

;T1/	Flags,,JCN or pointer to CDB
;T2/	Security Level
;	SCSLV
;Ret+1:	 Error.  Code in T1
;		from CHKARG
;			ELP+^D29 Security already set
;Ret+2:	Success.

.SCSLV::MCENT
	TXNE T1,<STSFLG!TCP%FS!TCP%PS!TCP%VT!TCP%HP!TCP%SC>&^-<TCP%JS!TCP%WT>
	  JRST TCPILP		; Illegal control bit
	XMOVEI T1,SCSLV1	; Select routine to call via CHKARG
	CALL CHKARG		; Check args, set TCB, call SCSLV1
	JUMPL T1,TCPERR		; Give error return if appropriate
	SMRETN			; Otherwise, it was good.

;SCSLV1(TCB)
;Second Phase of SCSLV JSYS

;T1/	JCN specified by caller (ignored here)
;TCB/	Locked connection block
;      	NOINT
;	CALL SCSLV1
;Ret+1:	Always.  T1 has 0 if OK, or -1,,error
;			-1,,ELP+^D29 Security already set

SCSLV1:	UMOVE T2,T2		; Get arg from caller
	JN TSLVN,(TCB),SCSLVE	; Bad.  No changes allowed.
	STOR T2,TSLVN,(TCB)	; Set the new value
	TDZA T1,T1		; Get a 0 to indicate OK
SCSLVE:	  HRROI T1,ELP+^D29	; "Can't change security levels"
	RET
	SUBTTL TCP Portion of ATNVT JSYS

;TATNVT
;Part of ATNVT JSYS for TVTs, Returns to USER w/ w/o skip
;TATNVT
;Attach a TVT to a User TCB; Called in non-Job-0 context

;T1/	Flags+JCN
;	JRST TATNVT
;Ret+1:	 Failed, Error code in T1, JCN still valid
;	ATNX1	-1,,ELP+^D1	Invalid JCN
;	ATNX2			Receive side not SYNCED
;	ATNX3			User CLOSEd/ABORTed connection
;	ATNX5			Recieve side has been used (RECVs)
;	ATNX6			Connection has been closed, or has errors
;	ATNX8			Send side not SYNCED
;	ATNX11			Send side has been used (SENDs)
;	ATNX13	-1,,ELT+^D4	No TVTs or
;		-1,,ELT+^D31	TCP not Initialized
;Ret+2:	Success, T1 contains TTY designator for TVT
;		 JCN has been released

TATNVT::XCTU [HRRZ T1,1]	; Get JCN w/o flags
	CALL TATTVT		; Call worker routine
	 JRST TCPERR		; Return error
	SMRETN			; OK (skip) return

;TATTVT - Worker routine for TATNVT and TVTJFN
;Takes	T1/ JCN
;Returns +1 failure, T1/ TOPS-20 error code
;	 +2 success, user T1 updated with TTY designator

TATTVT::TXO T1,TCP%JS		; Set JCN Supplied
	UMOVEM T1,1		; Put it back for CHKARG
	XMOVEI T1,TATNV1	; Routine to call
	CALL CHKARG		; Check arg, set TCB, call TATNV1
	IFL. T1
	  HRRZS T1		; Drop -1,, for compares
	  CAIN T1,<ELP+^D1>	; Translate TCP error code into TOPS20
	   MOVX T1,ATNX1
	  CAIE T1,<ELT+^D4>
	   CAIN T1,<ELT+^D31>
	    MOVX T1,ATNX13
	  RET			; Return non-skip
	ENDIF.
	LOAD T1,TVTL,(TCB)	; Make TTY descriptor
	TXO T1,.TTDES
	UMOVEM T1,1		; Return TT Descriptor
	RETSKP

;TATNV1(TCB,JCN)
;Second phase of TATNVT

; T1/	JCN supplied by caller
; TCB/	Locked connection block
;      	NOINT
;	CALL TATNV1
;Ret+1:	Always. T1 has -1,,error, or TTY descriptor otherwise

TATNV1:	LOCAL <JCN>
	MOVEM T1,JCN
	MOVX T1,<-1,,ATNX2>
	LOAD T2,TRSYN,(TCB)	; Receive side SYNCED?
	CAIE T2,SYNCED
         JRST TATNV9		; No, error
	MOVX T1,<-1,,ATNX8>
	LOAD T2,TSSYN,(TCB)	; Send side SYNCED?
	CAIE T2,SYNCED
         JRST TATNV9		; No, error
	MOVX T1,<-1,,ATNX5>
	LOAD BFR,QNEXT,<+TCBRBQ(TCB)>
	CAIE BFR,TCBRBQ(TCB)	; Without receive buffers
         JRST TATNV9		; Has buffer, error
	MOVX T1,<-1,,ATNX11>
	LOAD BFR,QNEXT,<+TCBSBQ(TCB)>
	CAIE BFR,TCBSBQ(TCB)	; Without send buffers
         JRST TATNV9		; Has buffer, error
	MOVX T1,<-1,,ATNX3>
	JE TSUOP,(TCB),TATNV9	; Not OPENed by user error
	MOVX T1,<-1,,ATNX6>
	JE TSOPN,(TCB),TATNV9	; Not still OPEN error
	JN TERR,(TCB),TATNV9	; Had some error error
	HRRZ T1,TCB		; ASNTVT wants TCB &
	TXO T1,AN%NTP		; Say it will speak new Telnet
	CALL ASNTVT		; Assign a virtual terminal
         JRST TATNV8		; Failed (no TVT available, etc)
	STOR T1,TVTL,(TCB)	; Save TTY # connection block
; Forget everything about Job which opened connection & give to Job0

	MOVE T1,JCN		; Our JCN
	CALL RETJCN		; Release PSIs & JCN
	SETZRO TOWNR,(TCB)	; Transferred to Job0
	SETONE TJCN,(TCB)	; without a JCN (hard to get to Job0 JSB)
	SETONE TTVT,(TCB)	; Say its a TVT

; T2 from ASNTVT

	CALL ULKTTY		; Block now stable
	TDZA T1,T1		; OK
TATNV8:	  MOVX T1,<-1,,ATNX13>	; Out of resources error (TVTs)
TATNV9:	RESTORE
	RET
	SUBTTL ACTTCB - Activate a Connection

;ACTTCB tries to move a connection from the completely unsynchronized
;(closed  or  brand  new)  state  into the SYNABLE state, where it is
;able to send and/or repond to SYNs. Activating a connection  is  the
;operation performed by user calls like OPEN, SEND and RECV, and make
;the connection be "alive". If the connection is already active, this
;results  in  a  true  value.  False  is  return if the connection is
;partially closed -- one side or the other is NOTSYN state.

;T1/	JCN
;T2/	Option addresses word from OPEN, or 0 if otherwise
;TCB/	(Extended) Locked connection block
;      	NOINT
;	CALL ACTTCB
;Ret+1:	Always.  T1 has 0 if successfully activated, error code otherwise

; **** Preserve T2 until TCPUOP

ACTTCB:	LOAD T4,TSSYN,(TCB)	; Get send state
	LOAD T3,TRSYN,(TCB)	; Get recv state
	CAIE T4,NOTSYN		; Unsynchronized?
	  JRST ACTTC7		; No.
	CAIE T3,NOTSYN
	  JRST ACTTC8		; Return FALSE
				; NOTSYN-NOTSYN
	STOR T1,TJCN,(TCB)	; Indicate this TCB is owned
	MOVE T3,TCB
	HRL T3,FORKX		; Form system fork,,TCB
	MOVEM T3,JCNTCB(T1)	; Store in job private table
				; **** T2 Preserved
	SKIPE T1,T2		; Option address word
	 CALL TCPUOP		; Get options from user
	  JUMPL T1,ACTTCX	; Return error code ** RETJCN too
	MOVE T2,JOBNO		; Our job number
	STOR T2,TOWNR,(TCB)	; Store this as TCB Owner
	MOVX T1,SYNABL		; SYN Ok state
	STOR T1,TSSYN,(TCB)	; Set send side
	STOR T1,TRSYN,(TCB)	; and recv side

; Clear persistent SYN flag, Clear OPEN has been done flag
; Clear "said it's open" bit, Clear ABORT requested flag
; Clear TVT flag

	SETZRO <TSPRS,TSUOP,TSOPN,TSABT,TTVT>,(TCB)
	SETZRO TVTL,(TCB)	; Clear TVT line number
	SETZRO TSCPK,(TCB)	; No partially filled packet
	MOVE T1,INTXPB		; Maximum data size for a packet
	SUBI T1,MINIHS+MINTHS	; Assuming no options & largest net
	STOR T1,TRWND,(TCB)	; is the default initial receive window.
	SETZRO TRBS,(TCB)	; No RECV buffer space yet
	HRRZ T1,FORKN		; Our Job fork number
	STOR T1,TOFRK,(TCB)	; Say who owns the TCB
	SETO T1,
	STOR T1,TPSIC,(TCB)	; No PSI Channels named yet
	STOR T1,TPIFU,(TCB)	; No INTRP fork
	STOR T1,TPIFR,(TCB)	; No RECV DONE fork
	STOR T1,TPIFS,(TCB)	; No SEND DONE fork
	STOR T1,TPIFE,(TCB)	; No ERROR fork
	STOR T1,TPIFX,(TCB)	; No STATE CHANGE fork
	STOR T1,TPIFA,(TCB)	; No EOL ACK fork
	STOR T1,TRLWN,(TCB)	; No last window seq #
	MOVE T1,TCPRX0		; Good starting point for retrans
	STOR T1,TMNRT,(TCB)	; Minimum round trip time
	STOR T1,TMXRT,(TCB)	; Maximum round trip time
	STOR T1,TRXI,(TCB)	; Current RX interval
	SETZRO <TRXPN,TRXPD,TRXPI>,(TCB) ; Clear RX parameters
	MOVX T1,OK		; General success code
	STOR T1,TERR,(TCB)	; Indicate no error on this connection
	LOAD T1,TERRF,(TCB)	; Index of the error event flag
	CALL CLRWTB		; Clear it
	JRST ACTTC9		; Return true to say it is now active
ACTTC7:	CAIN T3,NOTSYN		; Check receive side state
ACTTC8:	 HRROI T1,ELP+^D12	; "Connection closing" error
				; (S=NOTSYN, R.ne.NOTSYN or
				;  S.ne.NOTSYN, R=NOTSYN)
ACTTC9:	  SETZ T1,		; Return OK (S.ne.NOTSYN & R.ne.NOTSYN)
ACTTCX:	RET			; Return with TCPUOP's error code
	SUBTTL CHKARG - Check BBN TCP JSYS Arguments

; call FN(JCN,user option word or 0)
;T1/	(Extended) Function address
;T2/	ARG2 for FUNC	(***** obsolete *****)
;	CALL CHKARG
;Ret+1:	Always.  T1 has value of FUNC(JCN,ARG).  TCB has been setup.
;		Note:  TCB is locked & NOINT during call to FUNC
;	CHKJCN	-1,,ELP+^D1	JCN out of range, or no TCB for JCN
;	GETJCN	-1,,ELT+^D4	No free JCN, no space for TCB
;		-1,,ELT+^D31	TCP not initialized
;	CHKADD	...
;	function ...

CHKARG:	STACKL <<ARGBLK,CHKADW>>
	CHKADL (USR)		; LOCAL
	XMOVEI PARAMS,ARGBLK	; Set the pointer
	MOVEM T1,FN		; Save function address
	SETZM ARG1
	NOINT
	SKIPE TCPON		; TCP turned on?
	 SKIPN TCPIFG		; TCP Initialized yet?
	  JRST CHKARI		; No.
	UMOVE T1,T1		; Get user's AC1 flags
	TXNE T1,TCP%IX		; Connection # specified?
         JRST CHKAR3		; Yes
	TXNN T1,TCP%JS		; JCN Supplied in right half?
         JRST CHKAR1		; No.  Go translate into one

; Given JCN

	HRRZS T1		; Save JCN part
	MOVE T2,FN		; Function to call if JCN ok
	MOVE T3,ARG1		; Argument to FN
	CALL CHKJCN		; Set TCB, Lock it & call FN
	EXIT CHKARX		; Return whatever result
; Given Connection block or TVT number

CHKAR1:	TXNE T1,TCP%TV		; TVT number specified?
         JRST CHKAR2		; Yes

; Given Connection block

	CALL GETJCN		; Reserve a JCN
	JUMPL T1,CHKARX		; Couldn't.  Tell caller
	MOVEM T1,JCN		; Save the JCN
	XCTU [HRRZ USR,T1]	; Get ptr to Connection Descriptor Blk
	UMOVE T1,.TCPLH(USR)
	UMOVE T2,.TCPLP(USR)	; Copy the info from user area
	UMOVE T3,.TCPFH(USR)
	UMOVE T4,.TCPFP(USR)
	UMOVE USR,.TCPOP(USR)

; ****	Beginning of Compatability Kludge

	PUSH P,BHC+1		; Assume new format
	JUMPE T1,KLUDG0		; If first word 0, must be new (LP=0 illegal)
	TLNE T1,-1		; If first word is LP, then only rh 16 bits used
         JRST KLUDG0		; New format
	MOVE T4,T3		; Map old format into new
	MOVE T3,T2
	MOVE T2,T1
	SETZB T1,USR		; New info zero if old format
	SETZM (P)		; Use old format
KLUDG0:

; ****	End of Compatability Kludge

	ANDX T1,.RTJST(-1,PISH)
	ANDX T2,.RTJST(-1,PSP)
	ANDX T3,.RTJST(-1,PIDH)
	ANDX T4,.RTJST(-1,PDP)
	MOVEM T1,LH
	MOVEM T2,LP		; Store into ARGBLK for CHKADD
	MOVEM T3,FH
	MOVEM T4,FP
	MOVEM USR,ARG1		; Option addresses is second arg for FN
	SETZM WILDOK		; Not OK to find listening connections
	MOVE T1,PARAMS		; Pointer to parameter block for CHKADD
	CALL CHKADD		; Find TCB, Lock it, Call FN

; ****	Beginning of Compatability Kludge

	POP P,T2		; Old (0)/New (1) flag
	JUMPL T1,CHKA19		; Jump if all went well
	STOR T2,TNUFM,(TCB)	; Save format flag
	JRST CHKARX

; ****	End of Compatability Kludge

CHKA19:	PUSH P,T1		; Save error result
	MOVE T1,JCN		; Get back the JCN
	CALL RETJCN		; To return & disown TCB ("DEAD")
	POP P,T1		; Restore error code
	EXIT CHKARX
; Given TVT #

CHKAR2:	MOVEI T2,(T1)		; TVT line # into 2
	CALL CHKTVT		; Check if valid TVT
	  JRST CHKART		; Lose
	CALL TVTCHK		; Get (locked) data base
	  JRST CHKARU		; Not fully active
	LOAD TCB,PTVT,(T2)	; Get TCB address
	CALL ULKTTY		; Unlock TTY data base
	JUMPE TCB,CHKART	; Illegal connection
	SETSEC TCB,INTSEC	; TCBs in this section
	MOVX T3,0 ;T1		; Unused Arg for FN is line type??
	XMOVEI T1,TCBLCK(TCB)	; Lock to lock
	MOVE T4,ARG1		; Second arg for FN
	MOVE T2,FN		; Function to call
	CALL LCKCAL
	JRST CHKARX		; Leave
; Find the nth connection specified by T1

CHKAR3:	HRRZS T1		; Just the number
	CAILE T1,0		; Must be greater than 0 and
	 CAMLE T1,TCBCNT	; Less than current number
	  JRST CHKART		; Lose, invalid index
	MOVEM T1,JCN		; Save index
	XMOVEI T1,TCBHLK	; Lock for TCB hash table
	CALL SETLCK		; Lock it
	PUSH P,TCB		; Save TCB
	MOVSI T2,-TCBHSZ	; Size of hash table
CHKA30:	HRRZ TCB,T2		; Current TCBH slot
	ADD TCB,TCBH		; Add base of table (including section)
	HRRZ T3,TCB		; Save head of list
CHKA31:	LOAD TCB,QNEXT,(TCB)	; Get next on list
	CAMN TCB,T3		; Back to head?
	  JRST [AOBJN T2,CHKA30	; Yes, jump back if another slot
		SETZ TCB,	; No more, TCB not found
		JRST CHKA32]	; Quit
	SETSEC TCB,INTSEC	; TCBs in this section
	SOSE JCN		; Count down index
	  JRST CHKA31		; Loop if not want this one

; TCB points to TCB or is 0

CHKA32:	AOS TCBHUC		; Bump hash table use count
	XMOVEI T1,TCBHLK	; TCBH lock
	CALL UNLCK		; Unlock it with non-zero count means reading
	HRROI T1,<ELP+^D1>	; Assume error
	SKIPN TCB		; Find a TCB?
         JRST CHKA33		; No
	XMOVEI T1,TCBLCK(TCB)	; TCB to lock
	MOVE T2,FN		; Function to call
	MOVX T3,0 ;JCN		; Restore args (JCN=0 here)
	MOVE T4,ARG1
	CALL LCKCAL		; Call function
CHKA33:	SOS TCBHUC		; Done reading TCB
	POP P,TCB		; Restore register
	JRST CHKARX		; Leave, error code in T1

CHKARU:	CALL ULKTTY		; Maybe a non-standard block
CHKART:	HRROI T1,ELP+^D1	; Illegal connection
	JRST CHKARX

CHKARI:	HRROI T1,ELT+^D31	; "TCP Not initialized yet"

CHKARX:	OKINT
	CHKADR
	RET
	SUBTTL CHKJCN - See if caller has access to JCN

;T1/	JCN in question
;T2/	(Extended) Function to call if OK
;T3/	Argument for function
;     	Maybe NOINT
;	CALL CHKJCN
;Ret+1:	Always.  T1 has -1,,error or value of FN(JCN,ARG1)
;			-1,,ELP+^D1  Invalid JCN, No TCB

CHKJCN:	PUSH P,T1		; Save the JCN
	CAIL T1,1		; Reasonable number?
	 CAIL T1,MAXJCN
	  JRST CHKJC9		; No.  Tell Caller
	HRRZ TCB,JCNTCB(T1)	; Get the TCB
	JUMPE TCB,CHKJC9	; Non-JCN, give error
	SETSEC TCB,INTSEC
	CALL BBNCHK		; is this call legal for other reasons
	 JRST CHKJC9		; no
	LOAD T1,TOWNR,(TCB)	; check the owning job number
	CAME T1,JOBNO		; is it the same as our job
	 BUG.(CHK,TCPJS3,TCPTCP,SOFT,<CHKJCN: TCB ownership screwed up>)
	XMOVEI T1,TCBLCK(TCB)	; Pointer to the connection lock
	MOVE T4,T3		; Put arg in right place
	MOVE T3,0(P)		; Get the JCN as first ARG to function
	CALL LCKCAL		; Lock the lock and call the function
	CAIA			; Use whatever value is returned
CHKJC9:	  HRROI T1,ELP+^D1	; "Illegal Connection"
	ADJSP P,-1		; CLEAR STACK
	RET
	SUBTTL GETJCN - Assign a Job Connection Number

;     	NOINT
;	CALL GETJCN
;Ret+1:	Always.  T1 has the JCN (.GT.0) or -1,,ELT+^D4

GETJCN::NOSKED			; Prevent others from interfering
	MOVSI T2,-MAXJCN+1	; Max number of JCNs per job (ignore 0)
	SKIPE JCNTCB+1(T2)	; Empty slot?
	  AOBJN T2,.-1		; No.  Check next
	HRROI T1,ELT+^D4	; "No space for another connection"
	JUMPGE T2,GETJCX	; Return that if no empty slot found
	MOVE T3,FORKX		; Our identity.
	HRLZM T3,JCNTCB+1(T2)	; Reserve the slot for later use
	MOVEI T1,1(T2)		; The JCN as a result.
GETJCX:	OKSKED
	RET
	SUBTTL RETJCN - Free a Job Connection Number

;T1/	JCN
;     	NOINT
;	CALL RETJCN		; NB T2 preserved
;Ret+1:	Always.

RETJCN::SAVEAC <T1,TCB>
	NOSKED
	CAIN T1,-1		; Job0 w/o JCN?
         JRST RETJCX		; Yes, special User TVT connection
	CAIL T1,1
	 CAIL T1,MAXJCN		; Reasonable number
	  CAIA
	   JRST RETJC1
	BUG.(INF,TCPJS1,TCPTCP,SOFT,<RETJCN: JCN out of range>)
	JRST RETJCX

RETJC1:	SETZ TCB,
	EXCH TCB,JCNTCB(T1)
	TRNN TCB,-1		; Just a reserved slot?
         JRST RETJCX		; Yes.  Get out.
	SETSEC TCB,INTSEC	; Make extended address
	MOVNI T3,1
	STOR T3,TPSIC,(TCB)	; Disable all PSIs
	STOR T3,TPIFU,(TCB)	; Remove forks from TCB
	STOR T3,TPIFR,(TCB)
	STOR T3,TPIFS,(TCB)
	STOR T3,TPIFE,(TCB)
	STOR T3,TPIFX,(TCB)
	STOR T3,TPIFA,(TCB)
	STOR T3,TOFRK,(TCB)	; Forget owning fork
	SETZRO TJCN,(TCB)	; Disown the TCB ("DEAD")
	MOVE T1,TCB		; in case we call TCPBFD
	TMNE TDEC,(TCB)		; a DEC TCB?
	 CALL TCPBFD		; yes so release all DEC buffers
RETJCX:	OKSKED
	RET
	SUBTTL MAKBFR - Make a Buffer Descriptor

;Buffer  descriptors  ("Buffers")  are the items which get queued for
;the Packetizer and Reassembler. There is one for each SEND  or  RECV
;executed  by  the user. Amoung other things, a buffer block contains
;an "index" which associates that buffer with a particular  DONE  bit
;which  is stored in resident core; it is this bit that the scheduler
;tests to reactivate a process which is waiting for  that  particular
;buffer.

;TCB/	(ext) pointer to locked connection block
;	CALL MAKBFR
;Ret+1:	Always.  T1 has the buffer address (.GT.0) or -1,,error
;		-1,,ELP+^D15  Count < 0, Adr last word >= 1,,0
;		-1,,ELT+^D16  No WAIT bits, No memory for BFR HDR

MAKBFR:	STACKL <DATADR>
	LOCAL <HDRADR,FLAGS,COUNT,JCNFLG>
	PUSH P,BFR
	UMOVE JCNFLG,T1		; Get JCN control flags from user
	UMOVE HDRADR,T2		; Get address of header from user
	SUBI HDRADR,BFRSUI	; Make it into standard header ptr.
	MOVSI FLAGS,(TCP%DN!TCP%ER)	; Done and Error bits
	XCTU [ANDCAB FLAGS,BFRFLG(HDRADR)] ; Clear in user space, get others
	TXNE FLAGS,TCP%UR	; Urgent (send) bit on?
         TXO FLAGS,TCP%PU	; Yes.  That implies a PUSH.
	UMOVE T3,BFRDAD(HDRADR); Address of data area
	MOVEM T3,DATADR
	UMOVE COUNT,BFRCNT(HDRADR); Number of words/bytes in buffer
	JUMPL COUNT,MAKBF9	; Illegal
	MOVE T1,DATADR
	LSH T1,-PGSFT		; First page of buffer
	MOVE T2,DATADR
	MOVE T3,COUNT
	TLNE JCNFLG,(TCP%WM)	; Count is words?
         JRST MAKBF1		; Yes.
	ADDI T3,3		; Round up to word boundary
	ASH T3,-2		; Number of words in the buffer
MAKBF1:
	ADD T2,T3
	SUBI T2,1		; Last word in buffer
	LSH T2,-PGSFT		; Last page in buffer
	CAIL T2,1000		; Better fit in memory
         JRST MAKBF9		; Give error
	TLNN JCNFLG,(TCP%WT)	; Will this fork wait for this buffer?
	 TDZA T1,T1		; No.  No wait bit index assigned
	  CALL ASNWTB		; Assign an index
	JUMPL T1,MAKBFX		; None available right now ??? error code?
	PUSH P,T1		; Save for a while
	SKIPE T1		; No bit to clear
         CALL CLRWTB		; Clr it to make us hang at SENDW (e.g.)
	MOVEI T1,BFRSIZ		; Size of a buffer descriptor
 	CALL GETBLK		; Get a block of free storage
	SKIPG BFR,T1		; Got it? ??? error code?
         JRST MAKBF8		; No.  Release index and return ELT+^D16
	JN TDEC,(TCB),MAKBF6	; do not do this for a DEC TCB
	NOSKED			; Make sure we are the only one
	MOVE T1,FORKX		; get my fork index
IFN REL6,<LOAD T1,FKUP%,(T1)>	; get UPT SPT slot
IFE REL6,<HLRZ T1,FKPGS(T1)>	; get UPT SPT slot
	LOAD T2,SPTSHC,(T1)	; get the share count on the spt slot
	CAIL T2,MAXSHC-10	; is it close to overflow?
	 JRST MAKBF7		; yes so we can not continue
	CALL UPSHR		; Increment the share count
	OKSKED			; give back the system
MAKBF6:
	SETZM BFRQ(BFR)		; Indicate buffer is not on a queue
	POP P,T1		; Get back the index
	STOR T1,BIDX,(BFR)	; Put in wait bit index
	STOR TCB,BTCB,(BFR)	; Remember which TCB owns the buffer
	MOVEM FLAGS,BFRFLG(BFR)	; Store in monitor copy
	SETZRO BPTR,(BFR)	; Clear Index and Indirect fields
	MOVX T1,^D8		; Assume byte-send
	TLNE FLAGS,(TCP%WM)	; Word mode?
         MOVX T1,^D36		; Yes.  Byte size is 36
	STOR T1,BPTRS,(BFR)	; Set into size field of byte pointer
	MOVE T1,TODCLK		; Now in milliseconds
	STOR T1,BTS,(BFR)	; Set into buffer timestamp
	STOR COUNT,BICNT,(BFR)	; Remember the initial count
	STOR HDRADR,BHADR,(BFR)	; and header address in user space
	MOVE T3,DATADR		; Get the user's data address
	STOR T3,BDADR,(BFR)	; Remember it
	UMOVE T1,BFROPT(HDRADR)	; Get option addresses word
       				; Beginning of Compatability Kludge
	OPSTR SKIPN,TNUFM,(TCB)	; Using new formats?
	  SETZ T1,		; No, garbage
				; End of Compatability Kludge
	MOVEM T1,BFROPT(BFR)	; Save them
	MOVX T1,-1		; "Not mapped" indication
	STOR T1,BMPAG,(BFR)	; In the monitor window page number
	CALL RSTBFR		; Reset the buffer state
	MOVE T1,FORKX		; Our own System Fork Number
	STOR T1,BFRKX,(BFR)	; Remember for mapping user space
	MOVE T1,BFR		; This is the value
	JRST MAKBFX

MAKBF7:				; here when UPT Share count will overflow
	OKSKED			; give back the machine
	MOVE T1,BFR		; get the free space address
	CALL RETBLK		; return the block and fall through
				; here when no free space for buffer
MAKBF8:	POP P,T1		; Get back index
	TLNE JCNFLG,(TCP%WT)	; Did we assign one?
         CALL RELWTB		; Release it
	SKIPA T1,[-1,,ELT+^D16]	; "No space right now"
MAKBF9:	 HRROI T1,ELP+^D15	; "Bad buffer arg(s)"
MAKBFX:	POP P,BFR
	RESTORE
	RET
	SUBTTL FREBFR - Release Resources Used By a Buffer

;Called  by  a process doing a SEND, RECV which waits for completion.
;In this case USRBFE (or USRBFF) places the complete  buffer  on  the
;TCPBDQ so it may be release by this routine in the above JSYSs or by
;ABORT.

;BFR/	(Extended) Buffer
;	CALL FREBFR
;Ret+1:	Always

FREBFR:	NOSKED
	LOAD T1,BIDX,(BFR)	; Get the wait bit index
	SETZRO BIDX,(BFR)	; Indicate it has been released
	SKIPE T1		; Have a bit to release?
         CALL RELWTB		; Actually release it
	MOVE T1,BFR		; Item to dequeue
	SKIPE (T1)		; If not queued, skip it
         CALL DQ		; Remove it from the done queue
	OKSKED
	CALL RETBLK		; Release the storage
	RET
;BBNCHK
;Check  to  see  if  a  BBN  TCP  JSYS is legal. Always legal for the
;monitor. If from user mode not legal for a DEC TCB. If BBNOK is  off
;then never legal from user mode. Skip return if legal.

BBNCHK:
	XSFM T1			; Get PC Flags
	TXNN T1,PCU		; Previous Context User on?
	 RETSKP			; No, call is always legal for the monitor
	TMNN TDEC,(TCB)		; is this a DEC TCB?
         SKIPN BBNOK		; not DEC TCB.  Are BBN Calls OK?
          RET			; not OK aor this is a DEC TCB
	RETSKP			; skip return

BBNCKK:				; Same as above but does not check the TCB
	XSFM T1			; Get PC Flags
	SKIPN BBNOK		; BBN Calls OK?
         TXNN T1,PCU		; No. Previous Context User on?
          RETSKP		; PCU off or BBNOK on.
	RET			; PCU on and BBNOK off.

	TNXEND
	END