;<134-TENEX>NETWRK.MAC;240     4-NOV-75 12:00:04    EDIT BY ALLEN
; MAKE ASNTBF AND RLNTBF RESIDENT
;<134-TENEX>NETWRK.MAC;239     9-OCT-75 13:10:39    EDIT BY ALLEN
; ADD CHECK IN ASNTBF TO BE SURE WE DON'T ASSIGN A BUFFER ALREADY 
;IN USE
;<134-TENEX>NETWRK.MAC;238    17-SEP-75 10:20:23    EDIT BY ALLEN
; CHECK FOR REQUESTS LARGER THAN MAXWPM IN ASNTBF
;<134-TENEX>NETWRK.MAC;237    12-SEP-75 15:36:57    EDIT BY ALLEN
; RLNTBF PLACES PC OF ITS CALLER IN RH OF BUFFER BEING RELEASED.
; IT CHECKS THAT THIS FIELD DOES NOT CONTAIN A VALUE .GT.MAXWPM
; INDICATING IT'S ALREADY ON THE FREELIST
;<134-TENEX>NETWRK.MAC;236     8-SEP-75 11:10:07    EDIT BY ALLEN
;<134-TENEX>NETWRK.MAC;235     5-SEP-75 16:37:00    EDIT BY ALLEN
;<134-TENEX>NETWRK.MAC;234    28-AUG-75 16:35:35    EDIT BY ALLEN
; SLIGHT MOD DUE TO CHANGE IN LOCK-UNLOCK MACROS
;<134-TENEX>DCANET.MAC;4     5-AUG-75 14:04:17    EDIT BY ALLEN
; VARIOUS FIXES TO NEW BUFFER MANAGEMENT STUFF
;<134-TENEX>DCANET.MAC;3     5-AUG-75 10:07:22    EDIT BY ALLEN
;<134-TENEX>DCANET.MAC;2     4-AUG-75 13:14:41    EDIT BY ALLEN
; NEW BUFFER MANAGEMENT. ASGFRE NO LONGER IN USE. NET BUFFERS ARE ALL
;MAXWPM IN SIZE AND ARE ALWAYS ASSIGNED AS SUCH. NO RETURN OF RESIDUAL
;SPACE IN BUFFERS IS PROVIDED FOR.
;<134-TENEX>NETWRK.MAC;232    28-APR-75 14:23:52    EDIT BY CLEMENTS
;<134-TENEX>NETWRK.MAC;231    28-APR-75 11:40:05    EDIT BY CLEMENTS
;<134-TENEX>NETWRK.MAC;230    24-APR-75 14:20:25    EDIT BY CLEMENTS
;<134-TENEX>NETWRK.MAC;229    11-APR-75 17:11:32    EDIT BY ALLEN
; REPAIRS TO NEW LOCKING STUFF
;<134-TENEX>NETWRK.MAC;227    10-APR-75 22:34:02    EDIT BY ALLEN
; USE LOCK MACRO TO TAKE ADVANTAGE OF NEW SCHEDULING FOR LOCKERS
;<134-TENEX>NETWRK.MAC;226    26-MAR-75 14:23:54    EDIT BY PLUMMER
; ADD ABSOKT CHECK IN NAMDEC
;<134-TENEX>NETWRK.MAC;225    17-JAN-75 18:08:43    EDIT BY CLEMENTS
; FIX TO NCPERR. IT WAS SENDING THE "ERR" MSGS TO THE WRONG HOST.
; IN PARTICULAR, TO THE HOST NUMBERED BY THE ERROR SUBCODE, USUALLY 4.
;<133-TENEX>NETWRK.MAC;224    13-DEC-74 10:43:05    EDIT BY TOMLINSON
; RESET CONNECTION CLOCK EVERY SUCCESSFUL XMIT TO MINIMIZE RESYNCS
; FIX CAIG/GE CHECK IN SK2DWN TO BE CORRECT
;<133-TENEX>NETWRK.MAC;223    25-SEP-74 12:52:27    EDIT BY TOMLINSON
; INTERN SK2DWN. REMOVE INTERN SKTDWN.
;<TENEX-132>NETWRK.MAC;222    14-JUN-74 16:44:10    EDIT BY TOMLINSON
; FIX ALLOCATE RESYNC
;<TENEX-132>NETWRK.MAC;221     7-JUN-74 13:46:29    EDIT BY ALLEN
; FIX DMPBUF FOR FORCED CLOSES
;<TENEX-132>NETWRK.MAC;220     3-JUN-74 11:57:54    EDIT BY TOMLINSON
; ADDED ALLOCATION CHECKER -- GENERATE IO ERROR ON FAILURE IF CLOSING
;<TENEX-132>NETWRK.MAC;217    14-MAY-74 08:51:15    EDIT BY TOMLINSON
; Eliminated perpetual hang-up if missing allocate
;<TENEX-132>NETWRK.MAC;216    13-MAY-74 09:33:48    EDIT BY TOMLINSON
;<TENEX-132>NETWRK.MAC;215     6-MAY-74 13:10:58    EDIT BY TOMLINSON
; INTERN SKTDWN
;<TENEX-132>NETWRK.MAC;214     4-APR-74 12:36:46	EDIT BY TOMLINSON
; ADDED MTOPR 23 TO ABORT CONNECTION
;<TENEX-132>NETWRK.MAC;213    28-MAR-74 18:21:08	EDIT BY TOMLINSON
;<TENEX-132>NETWRK.MAC;212    28-MAR-74 14:04:44	EDIT BY TOMLINSON
; CHANGE MNHSTS TO VARIABLE. NOT CONSTANT
;<TENEX-132>NETWRK.MAC;211    28-MAR-74 13:44:55	EDIT BY TOMLINSON
;<TENEX-132>NETWRK.MAC;210    27-MAR-74 21:33:48	EDIT BY TOMLINSON
; FIX EDITTING ERRORS ABOUT INIHST
;<TENEX-132>NETWRK.MAC;209    27-MAR-74 19:56:20	EDIT BY TOMLINSON
; ADDED CALL TO INITIALIZE HOST TABLES FROM NETINI
;<TENEX-132>NETWRK.MAC;208    15-MAR-74 22:36:07	EDIT BY TOMLINSON
; FIXED BUG IN PC BACKUP BUG FIX
; ADDED MTOPR 26 FOR NETWRK -- SET UP INPUT BUFFERS AND SEND ALLOCATE
; NOTE MTOPR 25 IS DEFINED AS WAITING UNTIL OUTPUT CAN BE DONE
; BUT THIS IS NOT DOCUMENTED IN JSYS MANUAL.
;<TENEX-132>NETWRK.MAC;207    15-MAR-74 19:30:40	EDIT BY TOMLINSON
; FIXED BALTST AND WATBAL
;<TENEX-132>NETWRK.MAC;206    13-MAR-74 18:32:15	EDIT BY CLEMENTS
; CHANGED SOS OF RETURN PC TO HALF-WORD ARITHMETIC
;<TENEX-132>NETWRK.MAC;205    11-MAR-74 11:44:45	EDIT BY TOMLINSON
; FIXED ATPTY BUG, NEW NVT PROTOCOL OPTION INTO ATPTY
;<TENEX-132>NETWRK.MAC;204     7-MAR-74 19:56:31	EDIT BY TOMLINSON
;<TENEX-132>NETWRK.MAC;203     5-MAR-74 14:27:48	EDIT BY TOMLINSON
; INTERN LCKNCP AND ULKNCP.
;<TENEX-132>NETWRK.MAC;202    11-FEB-74 17:26:23	EDIT BY TOMLINSON
; ADDED DESIRED BIT ALLOCATION VARIABLE
;<TENEX-132>NETWRK.MAC;201     7-FEB-74 14:54:18	EDIT BY TOMLINSON
; HANDLE SERVICE INTERUPTIONS
;<TENEX-132>NETWRK.MAC;199     1-FEB-74 16:40:20	EDIT BY TOMLINSON
; NEW MSG ALLOC STRATEGY
;<TENEX-132>NETWRK.MAC;198     1-FEB-74 09:13:26	EDIT BY TOMLINSON
; FLUSH PREVIOUS CONNECTIONS WHEN RFC ARRIVES FOR SAME SOCKETS/LINK
;<TENEX-132>NETWRK.MAC;197    27-NOV-73 17:15:47	EDIT BY CLEMENTS
;<TENEX-132>NETWRK.MAC;195    10-NOV-73 20:15:17	EDIT BY CLEMENTS
;<TENEX-132>NETWRK.MAC;194    10-NOV-73 18:00:10	EDIT BY CLEMENTS
; NETRDY, NETSQO, DMPBUF AND BALTST WAIT FOR MSG ALLOC AS WELL AS BITS.
; ALSO CHANGES FOR KI-10
;<TENEX-132>NETWRK.MAC;193    20-AUG-73 17:31:18	EDIT BY CLEMENTS
;<TENEX-132>NETWRK.MAC;192     6-MAR-73 17:38:54	EDIT BY CLEMENTS
;<TENEX-132>NETWRK.MAC;191     6-MAR-73 17:04:57	EDIT BY CLEMENTS
;MOVED HOST TABLES OUT INTO HOST.MAC, RANGE CK RECINS/RECINR
;<TENEX-132>NETWRK.MAC;190    13-FEB-73 17:07:49	EDIT BY CLEMENTS
; PATCHES WHICH WERE DISTRIBUTED VIA GRIPE FILE
;<TENEX-131>NETWRK.MAC;189    16-JAN-73 12:39:42	EDIT BY CLEMENTS
;<TENEX-131>NETWRK.MAC;188    11-JAN-73 16:56:59	EDIT BY CLEMENTS
;CHANGED "CC" TO "CC." IN HOST MACROS,DUE TO NAME CONFLICTS
;<TENEX-130>NETWRK.MAC;187    28-DEC-72 18:15:41	EDIT BY CLEMENTS
;<TENEX-130>NETWRK.MAC;186    11-DEC-72 10:36:20	EDIT BY TOMLINSON
; ADDED USC-44 TO HOST TABLE
;<TENEX-130>NETWRK.MAC;185    29-NOV-72 14:35:50	EDIT BY TOMLINSON
;<TENEX-130>NETWRK.MAC;184    29-NOV-72 13:50:16	EDIT BY TOMLINSON
;<TENEX-130>NETWRK.MAC;183    29-NOV-72 13:09:32	EDIT BY TOMLINSON
;<TENEX-130>NETWRK.MAC;182    20-NOV-72 13:19:55	EDIT BY TOMLINSON
; ADDED PATCH SPACE FOR HOST TABLES
;<TENEX-130>NETWRK.MAC;181     6-NOV-72 10:52:13	EDIT BY TOMLINSON
; INTERN NETNAM
;<DLM/TEMP>NETWRK.MAC;180    31-OCT-72 22:48:28	EDIT BY TOMLINSON
; MATHLAB==306, HSTCHK SUCCEEDS FOR LISTEN
;<DLM/TEMP>NETWRK.MAC;179    19-OCT-72 19:13:13	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;178    19-OCT-72 15:29:08	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;177    17-OCT-72 17:58:22	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;176    17-OCT-72 15:40:03	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;175    16-OCT-72 15:24:33	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;174    16-OCT-72 15:02:04	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;173    16-OCT-72 14:50:08	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;172    16-OCT-72 14:45:09	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;171    16-OCT-72 14:03:51	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;170    15-OCT-72 15:35:55	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;169    15-OCT-72 14:26:52	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;168    14-OCT-72 13:52:36	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;167    13-OCT-72 15:45:40	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;166    13-OCT-72 13:40:47	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;165    11-OCT-72 23:16:46	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;164    10-OCT-72 23:39:58	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;163    10-OCT-72 22:19:55	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;162    10-OCT-72 13:10:20	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;161    10-OCT-72 10:41:42	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;160    10-OCT-72 10:28:45	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;159     6-OCT-72 12:35:15	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;158     6-OCT-72 12:33:57	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;157     5-OCT-72 17:19:07	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;156     5-OCT-72 10:13:05	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;155     4-OCT-72 16:27:58	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;154     4-OCT-72 14:27:41	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;153     3-OCT-72 14:32:50	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;152     1-OCT-72 14:43:20	EDIT BY MURPHY
;<DLM/TEMP>NETWRK.MAC;151    29-SEP-72 13:45:10	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;150    29-SEP-72 13:24:05	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;149    29-SEP-72 13:12:19	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;148    29-SEP-72 12:12:58	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;147    28-SEP-72 21:47:24	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;146    28-SEP-72 21:35:27	EDIT BY TOMLINSON
;<DLM/TEMP>FREE.MAC;34    28-SEP-72 21:13:05	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;144    28-SEP-72 19:43:58	EDIT BY MURPHY
;<DLM/TEMP>NETWRK.MAC;143    28-SEP-72 14:53:47	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;142    28-SEP-72 14:12:17	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;141    12-SEP-72 17:27:19	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;140    12-SEP-72 15:02:23	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;139    12-SEP-72 13:29:54	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;138    12-SEP-72 12:07:51	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;137    12-SEP-72 11:22:23	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;136    12-SEP-72 11:17:11	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;135    11-SEP-72 16:27:08	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;134    11-SEP-72 14:37:48	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;133     7-SEP-72 14:48:58	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;132     6-SEP-72 14:45:24	EDIT BY TOMLINSON
;<DLM/TEMP>NETWRK.MAC;131    30-AUG-72 12:22:25	EDIT BY TOMLINSON
;<FILESYSTEM>NETWRK.MAC;133    25-AUG-72 18:07:01	EDIT BY TOMLINSON
;<FILESYSTEM>NETWRK.MAC;132    25-AUG-72 16:30:16	EDIT BY TOMLINSON
;<FILESYSTEM>NETWRK.MAC;131    22-AUG-72 20:32:10	EDIT BY CLEMENTS
;<FILESYSTEM>NETWRK.MAC;130    22-AUG-72 11:08:37	EDIT BY TOMLINSON
;<FILESYSTEM>NETWRK.MAC;129    29-JUN-72 10:22:46	EDIT BY TOMLINSON

	SEARCH	STENEX,PROLOG
IFDEF	NETN,<
	TITLE	NETWRK
	SUBTTL	R.S.Tomlinson

; Entries to this part

; Externally defined things

EXTERN	BHC,BITS,DBUGSW,BUGCHK,BUGHLT,CAPENB,CAPMSK,MENTR,MRETN
EXTERN	ASGFRE,RELFRE
EXTERN	PBYTSZ,PBYTPO
EXTERN	CHKJFN,RELJFN,UNLCKF,DISGT,DISLT,FORKX,JFNSS,MPP
EXTERN	BLOCKW
EXTERN	TODCLK,SKMRTN,SK2RET
EXTERN	CPOPJ,SKPRET
EXTERN	MULKMP
EXTERN	PSIRQ	; Generate psi request
EXTERN	MRETNE	; Error return to user
EXTERN	FKINT	; Bit 1 tested to see if deferred int
EXTERN	EDISMS	; Dismiss til test
EXTERN	MLKPG	; Lock page
EXTERN	MULKPG	; Unlock page
EXTERN	FPTA	; Find page table from address
EXTERN	PSIBW	; Breaks waiting mask
EXTERN	INSKED	; Flag says in scheduler
EXTERN	NSKED
EXTERN	RSKED
EXTERN	NETTIM

; LINKAGE TO HOSTS (HOST NAME TABLES ETC)

EXTERN	MHOSTS,HOSTN,HSTNAM

; Linkage to imp driver section

EXTERN	NTTRC3
EXTERN	IMPBG0
EXTERN	PTNETI,PTNETO
EXTERN	IMPLT1,IMPLT2,IMPLT3,IMPLT4
EXTERN	PKCHK,PKULCK,PKBYT,PKMSG,UPMSG
EXTERN	IMPALL,NETON,IMPCLL,IMPABL,IMPOPL,IMPSDB,IMPSYN
EXTERN	IMPCLS,IMPINR,IMPINS
EXTERN	HSTDED
EXTERN	IMPRTS,IMPSTR,IMPRRP,IMSRST,IMPERR
EXTERN	ASNNVT,NVTDET,IMPHRT,IMPRDY,IMPBHT,IMPCHO,I8CAL

INTERN	NETINI
INTERN	NETNAM
INTERN	NCPERR
INTERN	SK2DWN
INTERN	NETRAL
INTERN	NTSIBE
INTERN	ASNTBF,RLNTBF
INTERN	LCKNCP,ULKNCP
INTERN	NSKT,NETHDN,NETDWN,NETCHK,RECRST
INTERN	RECINS,RECINR,NETKFK
INTERN	RECSTR,RECRTS,RCFRFN,RECCLS,PLINK,PFHST,PFSM,PLIDX,SVCINT,SVCRST
INTERN	PBPBYT,PBFSIZ
INTERN	EOTF,DEDF,ERRB,NVTCLZ
INTERN	.ATPTY,.ATNVT,.CVSKT,.FLHST,.CVHST

; Macros to turn imp on and off

DEFINE	NCPON<PUSHJ P,ULKNCP>

DEFINE	NCPOFF<PUSHJ P,LCKNCP>

; Local accumulators

UNIT=5		; Pseudo-unit number
IOS=6		; Status flags (loaded from netsts(unit))

; Parameters

FLINK==2	; First link number to use
LLINK==^D72
NLNKBW==<LLINK+^D35>/^D36

; Storage

LS(LSKT,NSKT)		; Local socket number
LS(FSKT,NSKT)		; Foreign socket number
LS(NETAWD,NSKT)		; B0-8 -- foreign host number (777 for none)
			; B9-17 -- link number (0 for none)
			; B18-23 -- time-out countdown
			; B24-26 -- unused
			; B27-35 -- index to link table
LS(NETBAL,NSKT)		; Bits of allocation
LS(NETDAL,NSKT)		; Desired level of bit allocation
LS(NETBUF,NSKT)		; B0-17 -- bytes per buffer
			; B18-35 -- buffer location -1 (0 for none)
LS(NETSTS,NSKT)		; B0-3 -- fsm state
			; B4-11 -- flag bits
			; B12-17 -- bit stream byte size
			; B18-35 -- MESSAGE COUNT STATISTICS
LS(NETFRK,NSKT)		; B0-b5 -- interrupt channel for ins
			; B6-B11 -- UNUSED
			; B12-B17 -- FSM STATE CHANGE INTERRUPT CHANNEL
			; B18-b35 -- forkx of fork to interrupt
LS(NETBTC,NSKT)		; BIT COUNT STATISTICS
LS(NCPLCK)		; Lock to prevent DOFSM confusion
LS(NCPLLK)		; FORKX OF LAST NCPLCK LOCKER
LS(NCPLCN)		; COUNT OF NCPLCK LOCKS
LS(NCPLFC)		; COUNT OF NCPLCK FAILURES
LS(ASNTBC)		; ASNTBF TRAFFIC COUNTER
LS(NETCNC)		; Count of total conections opened
LS(FUNNYC)		; Count of funny inputs to fsm
NRP(NTBUFS,NNTBFS)	; Network buffer area
LS(NETFRE,7)		; Net buffer free list header

; Flags in lh of netsts

FLG(BFSND,L,IOS,020000)	; Buffered send mode
FLG(ERRB,L,IOS,010000)	; Error has occurred
FLG(EOTF,L,IOS,004000)	; End of transmission flag
FLG(SVCIF,L,IOS,002000)	; Service interruption in progress
FLG(CLZF,L,IOS,001000)	; Connection is being closed
FLG(DEDF,L,IOS,000400)	; Host is dead
FLG(PROGF,L,IOS,000200)	; Set if program is watching this connection
FLG(ALLFF,L,IOS,000100)	; Allocation resync has been done

; Pointers to various fields of a connection

	USE	RESPC

MSGALL:	2		; DESIRED MESSAGE ALLOCATION LEVEL
MAXBPM::^D<8095-3*36>	; MAX DATA BITS PER MESSAGE

PLINK:	POINT 9,NETAWD(UNIT),8	; Pointer to link number
PFHST:	POINT 9,NETAWD(UNIT),17	; Pointer to foreign host number
PCLKS:	POINT 6,NETAWD(UNIT),23	; Pointer to time-out counter
PLIDX:	POINT 9,NETAWD(UNIT),35	; Pointer to link table index
PLIDXC:	POINT 9,NETAWD(C),35	; SAME AS PLIDX, BUT (C) FOR SCHED LEVEL
PINTCH:	POINT 6,NETFRK(UNIT),5	; Pointer to ins/inr psi channel
PFSMCH:	POINT 6,NETFRK(UNIT),17	; Pointer to psi channel for fsm change
PFSM:	POINT 4,NETSTS(UNIT),3	; Pointer to current state of fsm
PBPBYT:	POINT 6,NETSTS(UNIT),17	; Pointer to net bit stream byte size
PBFSIZ:	POINT 18,NETBUF(UNIT),17; Pointer to bytes per buffer

; Bbn socket numbers description
; A socket number is a 32-bit number which in conjunction with
; A host number specifies one end of a connection
; For bbn sockets, the 32 bit field is divided in 3 parts:
; The high 17 bits is used as follows:
;  if 0:      then this is a system socket
;  if <100000 then the number is a bbn user number and the socket is
;             is called a user socket
;  if >99999  then the number is tss job-number plus 100000, and the
;             socket is called a job socket

; A job socket is analogous to a temporary file and is guaranteed to
; Be unique to that job.  a user socket is analogous to a regular file
; And is guaranteed to be unique to that user.  a system socket is
; For use as agreed upon by members of the network for such purposes
; As inter system communication, memo-distribution etc.

; The next 14 bits are an arbitrary number which may be defaulted
; To the jfn associated with the socket or specified by the name field
; Of the file name string.  the low order bit is determined by
; The gender of the socket.  a socket opened for for writing
; Will have this bit equal to one. a socket opened for reading will
; Have this bit equal to zero.

; Network dispatch table

	USE	SWAPPC

NETDTB::NETSET		; Directory setup
	NETNAM		; Name lookup
	NETEXT		; Extension lookup
	NETVER		; Version lookup
	CPOPJ		; Protection insert
	CPOPJ		; Account insert
	CPOPJ		; Status insert
	NETOPN		; Open
	NETSQI		; Byte input
	NETSQO		; Byte output
	NETCLZ		; Close
	CPOPJ		; Rename
	CPOPJ		; Delete
	CPOPJ		; Dump
	CPOPJ
	CPOPJ		; Mount
	CPOPJ		; Dismount
	CPOPJ		; Initialize
	NETMTP		; Mtopr
	NETGST		; Get status
	NETSST		; Set status

; Network lock and unlock

LCKNCP:	AOS NCPLCN		; COUNT CALLS TO THIS ROUTINE
	LOCK NCPLCK,<JRST LCKNC1>,SPQ
LCKNC2:	PUSH P,FORKX
	POP P,NCPLLK		; SAVE LAST LOCKER
	POPJ P,

LCKNC1: AOS NCPLFC		; COUNT FAILURES
	PUSH P,1
	MOVEI 1,NCPLKT
	JSYS EDISMS
	POP P,1
	JRST LCKNC2

	USE	RESPC

NCPLKT:	AOSE NCPLCK
	 JRST 0(4)
	JRST 1(4)

	USE SWAPPC

ULKNCP:	UNLOCK NCPLCK,RESIDENT,SPQ
	POPJ P,

; Initialize network stuff

NETINI:	SETZM NETSTS
	MOVE A,[NETSTS,,NETSTS+1]
	BLT A,NETSTS+NSKT-1
	SETZM NETCNC
	SETZM FUNNYC
	MOVEI A,NTBUFS
	HRLOM A,NETFRE		; Initial free list
	MOVEI A,NNTBFS		; Size of buffer area
	MOVEM A,NETFRE+2
	MOVE A,[NTBUFS+NNTBFS,,NTBUFS]
	MOVEM A,NETFRE+4

;INITIALIZE FREE LIST INTO ITEMS OF MAXWPM EACH
	MOVEI B,NNTBFS		; SIZE OF BUFFER AREA
	IDIV B,MAXWPM##		; COMPUTE NUMBER OF BUFFERS
	SKIPE C
	BUG (HLT,<NETINI: NNTBFS NOT INTEGRAL MULTIPLE OF MAXWPM>)

	MOVN A,MAXWPM		;GET NEGATIVE MAX BUFFER SIZE
	MOVE C,[Z NTBUFS(A)]	;SET UP C FOR BOTH INDEXING AND INDIRECTION
NETIN2:	ADD C,MAXWPM		;RH(C) POINTS TO NEXT BUFFER
	HRLOM C,@C		;STORE THAT IN LEFT HALF IN CURRENT BUFFER
	SOJG B,NETIN2		;DO ANOTHER
	HRRZS @C		; LAST ITEM POINTER IS 0

	SETOM NETFRE+1
	SETOM NCPLCK
	MOVE A,DBUGSW		; IN SYSTEM DEBUG MODE?
	CAIGE A,2		; IF SO, DON'T TURN ON NET.
	SETOM NETON		; Net on
	POPJ P,

; Prepare to lookup network names

NETSET:	NOINT
	JRST SK2RET		; Complicated huh?

; Name lookup routine

NETNAM:	JUMPE A,NAMBAD		; *. -- failure
	HRLI A,(<POINT 7,0,35>)	; Make lookup pointer into byte pointer
	PUSHJ P,NAMDEC		; Decode name
	JRST NAMBAD		; Bad syntax
OKRET:	TEST(NE,UNLKF)
	JRST SK2RET
	OKINT
	JRST SK2RET

NAMBAD:	MOVEI A,GJFX18
	JRST ERRET		; Error return

ERRET:	OKINT
	POPJ P,

; Extension lookup routine

NETEXT:	JUMPE A,NAMBAD		; .* -- failure
	HRLI A,(<POINT 7,0,35>)	; Make lookup pointer into byte pointer
	PUSHJ P,EXTDEC		; Decode extension to check syntax
	JRST EXTBAD		; Bad syntax
	JRST OKRET		; Success

EXTBAD:	MOVEI A,GJFX19
	JRST ERRET

; Version lookup

NETVER:	HRRES A			; Extend sign
	CAIGE A,^D100000	; If lss 100000
	HRRZ A,FILDDN(JFN)	; Then use user number
	TEST(NE,UNLKF)
	JRST SKPRET
	OKINT
	JRST SKPRET

; Decode extension string
; Called both at gtjfn and openf to decode extension string into
; Foreign socket number and host number

EXTDEC:	PUSH P,A
	ILDB D,A
	POP P,A
	JUMPE D,[SETOB A,B
		JRST SKPRET]
	CAIGE D,"8"
	CAIGE D,"0"
	 JRST EXTDES		; Symbolic
	MOVEI C,10
	NIN
	 POPJ P,
	CAIL B,0
	CAILE B,377
	 POPJ P,
	MOVE D,B
	LDB B,A
	CAIE B,"-"
	 POPJ P,
	NIN
	 POPJ P,
	MOVE A,D
	JRST SKPRET

EXTDES:	HRLZ D,MHOSTS		;MINUS NHOSTS
EXTDE1:	PUSH P,A
	HRRZ C,HOSTN(D)
	ADD C,[POINT 7,HSTNAM]
	PUSH P,C
EXTDE2:	ILDB B,A
	ILDB C,0(P)
	JUMPE C,EXTDE3
	CAMN C,B
	 JRST EXTDE2
EXTDE4:	SUB P,BHC+1
	POP P,A
	AOBJN D,EXTDE1
	POPJ P,

EXTDE3:	CAIE B,"-"
	 JRST EXTDE4		; Not this one
	MOVEI C,10
	NIN			; Convert remainder of string to number
	 JRST EXTDE4		; Must not be this one
	LDB C,A			; Get terminator
	JUMPN C,EXTDE4		; Not this one
	SUB P,BHC+2		; This is it, flush stack
	LDB A,[POINT 9,HOSTN(D),17]
	JRST SKPRET

; Decode name string
; Called both at gtjfn and openf to decode name string into
; Local socket number

NAMDEC:	MOVEI C,10		; Perhaps this should be decimal?
	NIN			; Convert to a number
	JRST NAMDE1		; Failure: no number there
	LDB C,A			; Get terminator
	CAIE C,"#"		; If not number sign
	JRST NAMDE2		; Then ordinary
	MOVE C,CAPMSK		; Else system socket
	TRNN C,WHEEL!OPR!ABSOKT	; Must be operator, wheel, etc.
	POPJ P,			; Else fail
	ILDB C,A		; Get next ch
	TDZA A,A		; Zero for high 17 bits
NAMDE2:	HRRZ A,FILVER(JFN)	; Use filver for high 17 bits
	JUMPN C,CPOPJ		; String too long
	SKIPE A
	 ANDI B,77777		; If not system socket, retain 15 bits
	TRZ B,1			; Clear gender
	ROT A,^D15
	IOR A,B
	JRST SKPRET

NAMDE1:	LDB C,A
	JUMPN C,CPOPJ		; Not number, fail
	MOVE B,JFN		; Default to jfn
	LSH B,1-SJFN		; Jfn will end up lsh'ed 1
	JRST NAMDE2

; Open network file

NETOPN:	TEST(NE,XCTF,RNDF)
	JRST ILLACC		; Illegal to access in append or xct
	TEST(NE,READF)
	TEST(NN,WRTF)
	TEST(NN,READF,WRTF)
	JRST ILLACC		; Must be only one of read or write
	LDB A,PBYTSZ
	CAIG A,^D36
	CAIG A,0
	 JRST [	MOVEI A,SFBSX2
		POPJ P,]	; Bad byte size
	HLRZ A,FILNEN(JFN)
	HRLI A,(<POINT 7,0,35>)
	PUSHJ P,NAMDEC		; Decode name
	JRST ILLACC		; Can only happen if wheel lost
	TEST(NE,WRTF)
	TROA A,1		; If writing set gender bit for local
	TRZ A,1			; Else clear it
	PUSH P,A		; Save for later
	HRRZ A,FILNEN(JFN)
	HRLI A,(<POINT 7,0,35>)
	PUSHJ P,EXTDEC		; Decode extension
	BUG(HLT,<NETOPN: EXTDEC FAILURE AFTER PREVIOUS NON-FAILURE.>)
	TEST(NE,READF)
	TROA B,1		; If reading set gender bit for forskt
	TRZ B,1			; Else clear
	POP P,C
	LDB D,PBYTSZ		; Get file byte size
	CAIN D,7
	MOVEI D,8		; Make ascii be net ascii
	JUMPL A,OPNLSN		; No foreign socket, do a listen
	PUSHJ P,CONNECT		; Connect
	 POPJ P,
	TEST(Z,WNDF)		; Remember this was not a listen

NETOP1:	HRLM UNIT,DEV		; Remember unit number
	HRLM UNIT,FILDEV(JFN)
	SETZ IOS,		; Clear status bits
	LDB A,[POINT 4,STS,35]
	CAIE A,5		; In modes 5
	CAIN A,7		; Or 7
	TEST(O,BFSND)		; Do buffered transmission
	IORB IOS,NETSTS(UNIT)	; Set it in status word
	MOVEI A,^D36
	LDB B,PBYTSZ
	IDIV A,B		; Get bytes per WORD
	XCTBU [	LDB C,[POINT 6,2,17]]
	LSH C,2			; GET DESIRED SIZE OF BUFFER
	IMUL A,C		; DESIRED BYTES
	DPB A,PBFSIZ		; Gives bytes per buffer
	SETZM FILBYN(JFN)	; About to reference byte 0 of buffer
	SETZM FILOFN(JFN)	; NEXT BYTE TO XMIT = 0
	TEST(O,SIZF)		; Cannot change byte size
	TEST(OE,WNDF)		; No buffer yet. also if listen
	JRST SKPRET		; Return immediately
	LDB A,[POINT 4,STS,35]
	CAIE A,6		; Also in modes 6
	CAIN A,7		; And 7
	JRST SKPRET		; Return immediately
	LDB A,PFSM		; No. get current state
	CAIN A,RFCS		; Will usually be rfcs
	PUSHJ P,WATNOT		; If so, wait for it to not be
	MOVE IOS,NETSTS(UNIT)	; GET STATE
	LDB A,[POINT 4,IOS,3]
	TEST(NN,EOTF)		; IF LEFT OPND
	CAIN A,OPND		; OR STILL OPENED
	 JRST SKPRET		; THEN SUCCEED
OPNFAI:	MOVSI B,PROGF
	ANDCAM B,NETSTS(UNIT)	; Program not watching
	TEST(NE,ERRB)		; ERRB REMEMBERS BAD BYTE SIZE
	SKIPA A,[OPNX22]	; MAKE THAT THE ERROR CODE
	MOVEI A,OPNX21		; ELSE IT WAS REJECTED
	POPJ P,			; And give bad return

OPNLSN:	PUSHJ P,LISTEN
	 POPJ P,		; Can't listen
	TEST(O,WNDF)		; To remember that this was a listen
	JRST NETOP1		; First bin/out is accept

ILLACC:	MOVEI A,OPNX14
	POPJ P,

; Wait for fsm to leave state given in a

WATNOT:	HRLI A,NOTTST		; TEST ROUTINE ADDRESS
WATNO1:	MOVE B,UNIT		; COMPUTE SCHEDULER TEST ARGUMENT
	ROT B,-9
	MOVSS A
	IOR A,B
	SKIPE INSKED
	BUG(HLT,<WATNOT: WAS CALLED FROM SCHEDULER LEVEL.>)
	JSYS EDISMS
	POPJ P,

; Wait for fsm to enter a particular state

WATFOR:	HRLI A,WATTST
	JRST WATNO1

	USE	RESPC

NOTTST:	LDB B,[POINT 9,A,26]	; EXTRACT UNIT
	ANDI A,777		; AND STATE TO TEST AGAINST
	EXCH UNIT,B
	LDB C,PFSM		; GET CURRENT STA(E
	EXCH UNIT,B
	CAME A,C		; IS IT THE SAME
	JRST 1(4)		; NO, READY TO GO
	JRST WATTS1		; YES, MAKE OTHER TESTS

; SCHEDULER TEST WAITING FOR CONNECTION TO GET TO A STATE

WATTST:	LDB B,[POINT 9,A,26]	; EXTRACT UNIT
	ANDI A,777		; AND STATE
	EXCH B,UNIT
	LDB C,PFSM		; GET CURRENT STATE
	EXCH B,UNIT
	CAMN C,A		; SAME?
	JRST 1(4)		; YES, READY TO GO
WATTS1:	MOVE C,FKINT(7)		; Look for deferred interrupts
	TLNN C,(1B1)
	JRST 0(4)		; None. return no skip
	EXCH B,UNIT		; Deferred interrupt, get back unit
	SETZ C,
	DPB C,PCLKS		; Set clock to zero to hasten time-out
	EXCH B,UNIT
	JRST 0(4)

; BIT ALLOCATION TEST

BALTST:	EXCH UNIT,A
	LDB B,PBPBYT
	LDB C,PLIDX
	HLL C,NETSTS(UNIT)	; GET STATUS INFO
	SKIPE IMPLT4(C)		; SKIP IF NEITHER MSG ALLOC OR BUFFER
	CAMLE B,NETBAL(UNIT)	; MSG OK, HOW ABOUT BITS?
	TLNE C,DEDF+EOTF	; ALLOC BAD. BUT IF DEAD..STILL OK
	 AOS 4
	EXCH UNIT,A
	JRST 0(4)

	USE	SWAPPC

; Close network file

NETCLZ:	HLRZ UNIT,DEV
	TEST(NN,WNDF)		; If no buffer ever assigned
	TEST(NN,WRTF)		; Or if reading
	JRST NETCL1		; Then skip the following
	PUSHJ P,DMPBUF		; Dump last buffer
	 JRST NETCLW		; NOT ALL SENT. GO WAIT.
NETCL1:	TEST(NE,ERRF)		; ANY FINAL ERRORS
	 JRST [	MOVEI A,IOX5
		RET]		; DON'T CLOSE IF ANY UN-HANDLED ERRORS
	SETOM NETFRK(UNIT)
	HRRZ B,NETBUF(UNIT)
	SKIPE B
	 PUSHJ P,RLNTBF
	TEST(NN,WRTF)		; IF NOT sending
	SKIPA A,[CLZR]		; THEN DO CLZR
	MOVEI A,CLZS		; ELSE do clzs
	PUSHJ P,DOFSM
	UMOVE A,1
	TDNN A,[1,,400000]
	TLNN A,(1B1)
	 JRST NETCL2		; Return immediately if no bit 1
	LDB B,PFSM
	MOVEI A,FREE
	CAIE B,FREE
	PUSHJ P,WATFOR
NETCL2:	MOVSI A,PROGF
	ANDCAM A,NETSTS(UNIT)	; No program wants this any more
	JRST SKPRET

NETCLW:	MOVEI B,^D60		; 5 MINUTES OF TICKS
	DPB B,PCLKS
	MOVSI IOS,CLZF
	IORB IOS,NETSTS(UNIT)
	JSYS EDISMS
	JRST NETCLZ		; AND GO TRY AGAIN

; Close nvt

NVTCLZ:	MOVE A,LSKT(UNIT)
	TRNN A,1
	SKIPA A,[CLZR]
	MOVEI A,CLZS
	PUSHJ P,DOFSM
	POPJ P,

; Network mtopr routines

NETMTP:	HLRZ UNIT,DEV
	MOVE IOS,NETSTS(UNIT)
	CAIG B,26
	CAIGE B,20
	 POPJ P,
	JRST .+1-20(B)
	JRST NETACP
	JRST NETDMP
	JRST SNDINT
	JRST ABTCON
	JRST NETINT
	JRST NETRDY
	JRST NETFAL

NETACP:	LDB B,PFSM
	MOVEI A,ACPT
	CAIN B,RFCR
	 PUSHJ P,DOFSM
	POPJ P,

NETDMP:	TEST(NE,BFSND)
	TEST(NN,WRTF)
	 POPJ P,
	TEST(NE,WNDF)
	 POPJ P,
	PUSHJ P,DMPBUF
	 JRST WATXXX
	POPJ P,

SNDINT:	LDB A,PFHST
	LDB B,PLINK
	MOVE D,LSKT(UNIT)
	TRNE D,1
	SKIPA D,[IMPINS]
	MOVEI D,IMPINR
	NCPOFF
	LDB C,PFSM
	CAIN C,OPND
	PUSHJ P,@D
	NCPON
	POPJ P,

; WAIT FOR READY TO SEND AT LEAST ONE BYTE

ABTCON:	MOVE A,CAPENB
	TRNN A,NETWIZ
	 POPJ P,
	JRST SKTDWN

NETRDY:	TEST(NN,WRTF)		; RECEIVE OR SEND?
	 JRST NETRD1		; RECEIVE. SEND ALLOCATES OUT
	LDB A,PLIDX
	PUSHJ P,PKCHK		; GET BYTES THAT CAN BE SENT
	JUMPN B,PKULCK		; READY TO GO
	PUSHJ P,WATBAL		; COMPUTE ACTIVATION TEST
	JRST WATXXX		; AND WAIT

NETRD1:	TEST(NE,WNDF)		;HAS ALLOCATION ALREADY BEEN SENT?
	PUSHJ P,FIRSTI		;NO. SEND IT OUT.
	POPJ P,

NETINT:	UMOVE B,3
	HRR B,FORKX
	MOVEM B,NETFRK(UNIT)
	POPJ P,

NETFAL:	TEST(NE,WNDF,WRTF)	; IF WRITE OR FIRSTI ALREADY DONE
	 POPJ P,		; DO NOTHING
	JRST FIRSTI		; ELSE SET UP BUFFERS AND SEND ALLOCATE

NETKFK:	PUSH P,UNIT
	PUSH P,A
	MOVSI UNIT,-NSKT
NETKF1:	HRRE A,NETFRK(UNIT)
	CAMN A,FORKX
	 SETOM NETFRK(UNIT)
	AOBJN UNIT,NETKF1
	POP P,A
	POP P,UNIT
	POPJ P,

; SKIP IF NET INPUT BUFFER EMPTY

NTSIBE:	HLRZ UNIT,DEV
	LDB A,PLIDX
	MOVSI B,777777
	TDNN B,IMPLT4(A)
	TDNE B,IMPLT3(A)
	 POPJ P,
	JRST SKPRET

; Network file sequential byte input

NETSQI:	HLRZ UNIT,DEV
	MOVE IOS,NETSTS(UNIT)
	TEST(NE,WNDF)
	PUSHJ P,FIRSTI		; Wait for listen set up buffers etc.
	SOSGE FILCNT(JFN)
	PUSHJ P,LODBUF		; Get another bufferful
	TEST(NE,EOFF)
	POPJ P,
	ILDB A,FILBYT(JFN)
	AOS FILBYN(JFN)
	POPJ P,

LODBUF:	MOVSI IOS,ERRB
	TDNE IOS,NETSTS(UNIT)
	TEST(O,ERRF)
	ANDCAB IOS,NETSTS(UNIT)
	LDB D,PBFSIZ
	MOVE C,NETBUF(UNIT)
	HLL C,FILBYT(JFN)
	TLZ C,770000
	MOVEM C,FILBYT(JFN)
	LDB A,PLIDX
	PUSHJ P,UPMSG		; Unpack message(s) into buffer
	 JRST [	MOVSI IOS,EOTF
		TDNE IOS,NETSTS(UNIT)
		 JRST [	TEST(O,EOFF)
			POPJ P,]
		JRST WATXXX]	; BACK OUT AND WAIT
	LDB B,PBFSIZ
	SUB B,D			; Bytes loaded
	MOVEM B,FILCNT(JFN)
	ADDM B,FILLEN(JFN)
	LDB D,PBPBYT		; Byte size
	IMUL D,B		; Bits received
	ADDM D,NETBTC(UNIT)	; KEEP COUNT OF BITS RECEIVED
	MOVN B,D
	ADDM B,NETBAL(UNIT)	; DEBIT ALLOCATION FOR MESSAGE RECEIVED
	PUSHJ P,NETRAL		; Re-allocate if needed
	SOSGE FILCNT(JFN)
	 JRST LODBUF		; No bytes
	POPJ P,

NETRAL:	NCPOFF			; PREVENT CONFUSION
	MOVE IOS,NETSTS(UNIT)
	TEST(NE,EOTF,DEDF)
	 JRST NETRAX		; DON'T BOTHER IF DEAD OR DONE
	MOVE D,NETDAL(UNIT)	; GET DESIRED BIT ALLOCATION
	MOVE B,D
	ASH B,-1		; HALVE
	PUSH P,B		; SAVE
	MOVE C,MSGALL		; DESIRED LEVEL OF MSG ALLOC
	MOVE B,C
	ASH B,-1		; HALVE
	PUSH P,B		; AND SAVE
	LDB B,PLIDX
	HRRZ B,IMPLT4(B)	; OUTSTANDING MSG ALLOC
	SUB C,B			; NEEDED INCREMENT
	SUB D,NETBAL(UNIT)	; NEEDED INCREMENT
	LDB B,PLINK
	LDB A,PFHST
	CAMGE D,-1(P)		; IF GREATER THAN HALF
	CAML C,0(P)		; FOR EITHER ONE
	 PUSHJ P,IMPALL		; THEN SEND AN ALLOCATE
	SUB P,BHC+2
NETRAX:	NCPON
	POPJ P,

FIRSTI:	PUSHJ P,FRSTIO		; SET UP BUFFER
	JUMPG B,FRSTI1		; BUFFER SPECIFIED. USE FOR ALLOCATION
	PUSH P,A
	MOVE A,MAXBPM		; MAXIMUM BITS IN A MESSAGE
	LDB B,PBPBYT		; CONNECTION BYTE SIZE
	IDIV A,B		; BYTES
	IMUL A,MSGALL		; TIMES MESSAGE ALLOCATION
	ADDM A,0(P)		; THAT PLUS FILE BUFFER BYTES
	POP P,B			; IS WHAT TO USE
FRSTI1:	LDB D,PBPBYT		; GET BYTES SIZE
	IMUL D,B		; BITS IN BUFFERS
	MOVEM D,NETDAL(UNIT)	; SAVE DESIRED LEVEL
	PUSHJ P,NETRAL		; SEND ALLOCATE AS NEEDED
	POPJ P,

WATLSN:	LDB A,PFSM		; Get state of this connection
	CAIN A,OPND
	 POPJ P,
	CAIN A,RFCR
	 JRST [	MOVEI A,ACPT
		PUSHJ P,DOFSM
		POPJ P,]
	CAIN A,RFCS		; If still waiting for rfc
	 JRST WATLS1		; Continue waiting
	CAIE A,LSNG
	 JRST [	MOVSI IOS,EOTF
		TDNE IOS,NETSTS(UNIT)
		 POPJ P,	; Null file sent
		MOVSI IOS,ERRB!EOTF	; Connection never actually opened
		IORB IOS,NETSTS(UNIT)
		POPJ P,]
WATLS1:	MOVE P,MPP		; Reset stack
	MOVE B,0(P)		; GET RETURN PC
	SOS B		; DECREMENT WITHOUT CARRY FROM LH
	HRRM B,0(P)		; BACK TO RETURN ON STACK
	PUSHJ P,UNLCKF		; Unlock file and turn ints back on
	PUSHJ P,WATNOT		; Wait to leave current state
	JRST MRETN		; Back to user to restart jsys

WATBUF:	MOVE P,MPP		; Else
	MOVE B,0(P)		; GET RETURN PC
	SOS B		; DECREMENT WITHOUT CARRY FROM LH
	HRRM B,0(P)		; BACK TO RETURN ON STACK
	PUSHJ P,UNLCKF		; Unlock file
	MOVEI A,^D5000
	DISMS			; Wait a while
	JRST MRETN		; And start again from the top

WATXXX:	MOVE P,MPP
	MOVE B,0(P)		; GET RETURN PC
	SOS B		; DECREMENT WITHOUT CARRY FROM LH
	HRRM B,0(P)		; BACK TO RETURN ON STACK
	PUSHJ P,UNLCKF
	JSYS EDISMS
	JRST MRETN

; Network file sequential byte output

NETSQO:	HLRZ UNIT,DEV
	MOVE IOS,NETSTS(UNIT)
	TEST(NE,DEDF,ERRB)
	 TEST(O,ERRF)
	TEST(NE,DEDF,EOTF)
	 POPJ P,
	PUSH P,A
	TEST(NE,WNDF)
	PUSHJ P,FIRSTO
	TEST(NE,BFSND)		; Immediate send
	 JRST NTSQO1		; No
	LDB A,PLIDX
	PUSHJ P,PKCHK		; HOW MANY BYTES CAN WE SEND?
	JUMPE B,NTSQO3		; NOT ENOUGH
	POP P,C
	PUSHJ P,PKBYT
	 JFCL
	LDB A,PBPBYT
	ADDM A,NETBTC(UNIT)
	MOVNS A
	ADDM A,NETBAL(UNIT)
	MOVEI A,^D24
	DPB A,PCLKS		; RESET CLOCK TO TWO MINUTES
	POPJ P,

NTSQO1:	SOSL FILCNT(JFN)
	 JRST NTSQO2
	PUSHJ P,DMPBUF
	 JRST WATXXX		; Can't dump now, wait
NTSQO2:	AOS FILBYN(JFN)
	POP P,A
	IDPB A,FILBYT(JFN)
	POPJ P,

NTSQO3:	PUSHJ P,WATBAL		;WAIT FOR BITS AND A MSG TO BE ALLOCATED
	JRST WATXXX		; ..

DMPBUF:	MOVSI IOS,ERRB
	TDNE IOS,NETSTS(UNIT)
	 TEST(O,ERRF)
	ANDCAB IOS,NETSTS(UNIT)
	MOVE D,FILOFN(JFN)	; GET CURRENT OUTPUT POINT
	CAML D,FILBYN(JFN)	; DONE?
	 JRST DMPDUN		; YES
	TEST(NE,EOTF,DEDF)
	 JRST [	TEST(O,ERRF)
		SETZM FILBYT(JFN)
		SETZM FILBYN(JFN)
		SETZM FILOFN(JFN)
		HRLOI A,377777
		MOVEM A,FILCNT(JFN)
		JRST SKPRET]
	LDB A,PLIDX
	PUSHJ P,PKCHK		; HOW MANY BYTES CAN WE SEND?
	JUMPE B,WATBAL		; NONE, WAIT
	MOVE D,FILBYN(JFN)
	SUB D,FILOFN(JFN)	; NUMBER OF BYTES IN BUFFER
	CAML D,B
	MOVE D,B		; TAKE MIN OF THE TWO
	LDB B,PBYTSZ		; COMPUTE BYTE POINTER, GET BYTE SIZE
	MOVEI A,^D36
	IDIV A,B		; BYTES PER WORD
	MOVE B,FILOFN(JFN)
	IDIV B,A		; WORD NUMBER AND OFFSET
	LDB A,PBYTSZ
	IMULM A,C		; BIT OFFSET
	MOVNS C
	ADDI C,^D36
	ROT C,6
	IOR C,A
	ROT C,-^D12
	HRR C,NETBUF(UNIT)
	ADDI C,1(B)		; YIELDS BYTE POINTER
	LDB A,PLIDX
	PUSH P,D
	PUSHJ P,PKMSG
	POP P,D
	ADDM D,FILOFN(JFN)
	LDB C,PBPBYT
	IMUL D,C		; GIVES BITS JUST SENT
	ADDM D,NETBTC(UNIT)	; KEEP COUNT OF BITS SENT
	MOVNS D
	ADDM D,NETBAL(UNIT)
;	HRRM B,NETSTS(UNIT)	; NEED TO HAVE MESSAGES GENERATED
	MOVEI A,^D24
	DPB A,PCLKS		; RESET CLOCK FOR THIS CONNECTION
	JRST DMPBUF

DMPDUN:	SETZM FILBYN(JFN)
	SETZM FILOFN(JFN)
	MOVE A,NETBUF(UNIT)
	HLL A,FILBYT(JFN)
	TLZ A,770000
	MOVEM A,FILBYT(JFN)
	LDB A,PBFSIZ
	SUBI A,1
	MOVEM A,FILCNT(JFN)
	JRST SKPRET

WATBAL:	LDB A,PLIDX
	PUSHJ P,PKULCK		; UNLOCK CONNECTION TOO
	MOVEI A,BALTST
	HRL A,UNIT
	POPJ P,

FIRSTO:	TEST(NN,BFSND)		; BUFFERED?
	 JRST [	PUSHJ P,WATLSN	; NO, WAIT FOR CONNECTION TO OPEN
		TEST(Z,WNDF)
		POPJ P,]
	PUSHJ P,FRSTIO		; YES, SET UP BUFFER ETC
	POPJ P,

; SET UP BUFFER 

FRSTIO:	PUSHJ P,WATLSN		; WaIt for connection complete
	MOVEI A,^D36
	LDB C,PBYTSZ
	IDIV A,C		; BYTES PER WORD
	MOVEI C,^D36
	LDB B,PBPBYT		; BITS PER BYTE
	IDIVM C,B		; BYTES PER WORD
	IMUL C,B		; BITS PER WORD
	MOVE B,MAXBPM		; BITS PER MESSAGE
	IDIVM B,C		; MAX WORDS FOR MESSAGE
	PUSH P,A		; SAVE BYTES PER WORD
	LDB B,PBFSIZ		; DESIRED BYTES IN BUFFER
	IMUL A,B		; WORDS NEEDED
	SKIPE A			; IF ZERO
	CAML A,C		; OR BIGGER THAN MAX
	 MOVE A,C		; USE MAX
	AOS B,A			; PLUS HEADER
	PUSHJ P,ASNTBF
	 JRST [	CAILE B,4
		 JRST .-1	; TAKE WHAT WE CAN GET
		JRST WATBUF]	; ELSE WAIT
	HRRM A,NETBUF(UNIT)
	HRRZ C,0(A)
	SUBI C,1
	POP P,A
	IMUL A,C
	LDB B,PBFSIZ		; RETURN AS VALUE
	DPB A,PBFSIZ		; REAL BYTES PER BUFFER
	TEST(Z,WNDF)
	POPJ P,

; Attach sockets to pty
; Call:	1	; Receive jfn of opened network connection
;	2	; Send jfn of opened network connection
;	ATNVT
; Returns
;	+1	; Cannot attach
;	+2	; Ok.  the jfns are released, ac 1 has line number of
;		; Attached pty.

.ATPTY::
.ATNVT::JSYS MENTR
	UMOVE JFN,1
	HRRZS JFN
	PUSHJ P,CHKJFN		; Check jfn of receive connection
	 JRST ATPER0		; Only real jfns are legal
	 JRST ATPER0
	 JRST ATPER0
	MOVEI A,ATPX2		; Error code if test skips
	TEST(NE,READF)		; Must be opened for reading
	PUSHJ P,CHKATP		; Check for dev=net, open, no buffer
	 JRST ATPER1		; Failed one of the above
	PUSH P,DEV		; Save dev and jfn
	PUSH P,JFN
ATNVT1:	UMOVE JFN,2		; Get send jfn
	PUSHJ P,CHKJFN		; Check it
	JRST ATPER2		; Must also be a real jfn
	JRST ATPER2
	JRST ATPER2
	MOVEI A,ATPX2		; Becomes atpx8 at atper3
	TEST(NE,WRTF)		; This one must be for writing
	PUSHJ P,CHKATP		; And dev=net, open, no buffer
	 JRST ATPER3		; Failed above tests
	HLRZ UNIT,DEV
	LDB A,PFSM
	CAIN A,RFCS
	PUSHJ P,WATNOT		; Wait for response from foreign host
	MOVEI A,ATPX12		; Error code for refused send
	LDB B,PFSM		; Now get state
	CAIE B,OPND		; If not opnd
	JRST ATPER4		; Then fail
	EXCH DEV,-1(P)		; Switch to receive connection
	HLRZ UNIT,DEV
	LDB A,PFSM		; Get its state
	CAIN A,RFCS
	PUSHJ P,WATNOT		; Wait for response from foreign host
	MOVEI A,ATPX6		; Error code for refused receive
	LDB B,PFSM
	CAIE B,OPND		; If not opnd
	JRST ATPER4		; Then fail

ATNVT2:	PUSH P,UNIT
	NCPOFF
	LDB A,PFSM
	CAIE A,OPND
	 JRST [	MOVEI A,ATPX6
		JRST ATPERZ]
	HLRZ UNIT,-2(P)
	LDB A,PFSM
	CAIE A,OPND
	 JRST [		MOVEI A,ATPX12
		JRST ATPERZ]
	UMOVE 1,1		; GET OPTION FLAGS
	UMOVE 3,3		; LINE NUMBER IF NEEDED
	HRR 1,0(P)		; Set up args, receive unit in 1
	HLRZ 2,-2(P)		; Send unit in 2
	PUSHJ P,ASNNVT		; Assign pty to these units
	 JRST [	MOVEI A,ATPX13	; Can't, no pty's
		JRST ATPERZ]
	POP P,UNIT
	MOVSI B,PROGF
	ANDCAM B,NETSTS(UNIT)	; PROGRAM NO LONGER LOOKING
	HRRM 1,NETBUF(UNIT)	; Store pty number here
	HRRM UNIT,-1(P)
	HLRZ UNIT,-1(P)
	ANDCAM B,NETSTS(UNIT)	; NOT HERE EITHER
	HRRM 1,NETBUF(UNIT)	; Put pty here also
	NCPON
	IORI A,400000		; Convert pty to tty designator
	UMOVEM A,1		; Return to user
	PUSHJ P,RELJFN		; Release send jfn
	POP P,JFN
	PUSHJ P,RELJFN		; And receive jfn
	POP P,UNIT
	PUSHJ P,NTTRC3
	JRST SKMRTN		; Return skipping

; Check validity of jfn for atpty

CHKATP:	MOVEI A,ATPX3		; Receive not open
	TEST(NN,OPNF)
	POPJ P,
	HRRZ B,DEV
	MOVEI A,ATPX4
	CAIE B,NETDTB
	POPJ P,
	MOVEI A,ATPX5
	TEST(NN,WNDF)
	POPJ P,
	JRST SKPRET

ATPERZ:	NCPON
	POP P,UNIT
	JRST ATPER4

ATPER2:	MOVEI A,ATPX7		; Bad send jfn
	JRST ATPER5

ATPER3:	ADDI A,ATPX7-ATPX1	; Convert receive errors to send errors
ATPER4:	PUSHJ P,UNLCKF
ATPER5:	POP P,JFN
	POP P,DEV
	MOVE STS,FILSTS(JFN)
ATPER1:	PUSHJ P,UNLCKF
	JRST MRETNE		; Save error return in ac1

ATPER0:	MOVEI A,ATPX1		; Bad receive jfn
	JRST MRETNE

; Convert jfn to absolute network socket number
; Call:	1	; Jfn
;	CVSKT
; Returns
;	+1	; Error
;	+2	; Ok, in 2 the absolute socket number

.CVSKT:	JSYS MENTR
	MOVE JFN,1
	PUSHJ P,CHKJFN
	 JRST CVSER0
	 JRST CVSER0
	 JRST CVSER0
	HLRZ A,FILNEN(JFN)
	HRLI A,(<POINT 7,0,35>)
	PUSHJ P,NAMDEC
	 JRST CVSER1
	TRZ A,1
	PUSHJ P,UNLCKF
	UMOVEM A,2
	JRST SKMRTN

CVSER1:	PUSHJ P,UNLCKF
	SKIPA A,[CVSKX2]
CVSER0:	MOVEI A,CVSKX1
	JRST MRETNE

; Flush host

.FLHST:	JSYS MENTR
	MOVEI B,WHEEL!OPR
	TDNN B,CAPENB
	 JRST MRETN
	PUSHJ P,HSTDED
	PUSHJ P,IMSRST
	JRST MRETN

; Convert host number to string

.CVHST:	JSYS MENTR
	HRLZ D,MHOSTS		;MINUS NHOSTS
	LDB C,[POINT 9,HOSTN(D),17]
	CAME C,B
	 AOBJN D,.-2
	JUMPGE D,MRETN
	HRRZ A,HOSTN(D)
	ADDI A,HSTNAM-1
	PUSHJ P,JFNSS
	JRST SKMRTN

; Get net status

NETGST:	HLRZ UNIT,DEV
	MOVE A,NETSTS(UNIT)
	LDB B,PFHST
	UMOVEM B,3
	MOVE B,FSKT(UNIT)
	UMOVEM B,4
	POPJ P,

; Set net status

NETSST:	POPJ P,



; ASSIGN BUFFERS IN NETWORK AREA

	USE RESPC

ASNTBF:	CAMLE B,MAXWPM		; BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
	 BUG (HLT,<ASNTBF: REQUEST FOR BUFFER LARGER THAN MAXWPM>)
	AOS ASNTBC		; COUNT CALLS
	LOCK NETFRE+1		;LOCK NETWORK BUFFER FREE LIST
	HLRZ A,NETFRE		;GET POINTER TO CURRENT BUFFER
	JUMPE A,ASNTB2		;THERE ISN'T ONE
	HRL B,0(A)		;GET CURRENT SIZE FIELD
	HRRM B,0(A)		;STASH REQUESTED SIZE
	HLRZS B			;MOVE OLD SIZE FIELD TO RH, CLEARING LH
	CAMG B,MAXWPM		;MAKE SURE ITS NOT IN USE
	 BUG (HLT,<ASNTBF: ATTEMPT TO ASSIGN A BUFFER ALREADY IN USE>)
	HLLZ B,0(A)		;GET POINTER TO NEXT ONE IN LIST
	HLLM B,NETFRE		;THAT BECOMES FIRST ONE
	AOS 0(P)		;INDICATE SUCCESS
	MOVN B,MAXWPM		;MAINTAIN TOTAL SPACE AS A MATTER 
				;OF INTEREST
	ADDM B,NETFRE+2
ASNTB2:	UNLOCK NETFRE+1		;UNLOCK FREE LIST
	RET

; RELEASE NETWORK BUFFERS

RLNTBF:	MOVE A,NETFRE+4		;GET BUFFER AREA BOUNDARIES
	CAIGE B,0(A)		;RETURNED BUFFER .GE. LOWER BOUND?
	 JRST RLNTER		;NO, CRASH
	MOVSS A
	CAIL B,0(A)		;.LT. UPPER BOUND?
RLNTER:	 BUG (HLT,<RLNTBF: ATTEMPT TO RELEASE BUFFER AT GARBAGE LOCATION>)
	LOCK NETFRE+1		;LOCK FREE LIST
	HRRZ A,0(B)		;GET COUNT FIELD
	CAMLE A,MAXWPM		;MAKE SURE NOT ALREADY ON FREELIST
	BUG (HLT,<RLNTBF: ATTEMPT TO RELEASE BUFFER ALREADY ON FREE LIST>)
	MOVE A,0(P)		;GET PC OF CALLER
	HLL A,NETFRE		;GET POINTER TO CURRENT FIRST BUFFER
	HRLM B,NETFRE		;RETURNED ONE IS NOW FIRST
	MOVEM A,0(B)		;AND POINTS TO OLD FIRST ONE
				;SIZE FIELD IS PC OF CALLER
	MOVE A,MAXWPM		;MAINTAIN TOTAL SPACE COUNT
	ADDM A,NETFRE+2
	UNLOCK NETFRE+1		;UNLOCK FREE LIST
	RET

	USE SWAPPC

; The following code and tables PROVIDE a finite state machine
; Implementation of the transitions and actions produced by various
; Events associated with a connection
; Assumed are that unit indexes the proper local socket

; Events are numbered as follows

RRFC==0		; Received an rfc
CLSR==1		; Cls for a receive socket
CLSS==2		; Cls for a send socket
CLZR==3		; Close done on a receive socket
CLZS==4		; Close done on a send socket
ACPT==5		; Program issued an accept
CONN==6		; Program issued a connect
LISN==7		; Program issued a listen
RRFN==10	; Received a rfnm with no more data outstanding
HUNG==11	; Time out event (happens 2 minutes after last dofsm)
RRFB==12	; RECEIVED RFC WITH NON-MATCHING BYTE SIZE

; Actions are numbered as follows

ANOP==0		; No operation
AFNY==1		; No operation (unexpected event)
ACLS==2		; Send cls
ARFC==3		; Send rfc
AOPB==4		; Send rfc and open link
AOPL==5		; Open link
ACLL==6		; Close link
ACLO==7		; Close link and send cls
AEOR==10	; END OF RECEIVE
AEOS==11	; END OF SEND
AES1==12	; END OF SEND WHEN ABORTED BY FOREIGN HOST
AABT==13	; CONNECTION ABORTED BY FAR END
ACKA==14	; CHECK ALLOCATION

; States are numbered as follows

DEAD==0		; Never used
CLZD==1		; Closed
PNDG==2		; Pending. rfc received while closed
LSNG==3		; Listening. listen issued while closed
RFCR==4		; Rfc received while listening
CLW1==5		; Close wait alternate. clzr from opnd
RFCS==6		; Rfc sent
OPND==7		; Opened
CLSW==10	; Waiting for a cls
DATW==11	; Waiting for all data to be sent
RFN1==12	; Waiting for last rfnm
CLZW==13	; Waiting for program close
RFN2==14	; Waiting for rfnm after clss
NUSE==15	; THIS STATE NO LONGER USED
FREE==16	; Not in use

; The following table of byte pointers is used to get to the next state
; Given the current state and the event
; This table is indexed by event, the table addressed by this table
; Is indexed by old state

RADIX ^D10

QQ==3

CBPFSM:	REPEAT 9,<
	POINT 4,NXTSTT(B),QQ
QQ==QQ+4>
QQ==3
	REPEAT 9,<
	POINT 4,NXTSTT+1(B),QQ
QQ==QQ+4>

; Following table of pointers is used to get the action to be taken
; Given the current state and the event
; This table is indexed by event, the table addressed by this table
; Is indexed by old state

QQ==3
CBAFSM:	REPEAT 9,<
	POINT 4,ACTION(B),QQ
QQ==QQ+4>
QQ==3

	REPEAT 9,<
	POINT 4,ACTION+1(B),QQ
QQ==QQ+4
>

; This is the transition table
; Each word contains the new state for a given old state
; Successive bytes are used for different events

; Event rrfc clsr clss clzr clzs acpt conn lisn rrfe hung  old state

NXTSTT:
BYTE (4)DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD,DEAD	; Dead
BYTE (4)PNDG,CLZD,CLZD,CLZD,CLZD,CLZD,RFCS,LSNG,CLZD,CLZD,CLZD	; Clzd
BYTE (4)PNDG,FREE,FREE,PNDG,PNDG,PNDG,OPND,RFCR,PNDG,CLSW,PNDG	; Pndg
BYTE (4)RFCR,LSNG,LSNG,FREE,FREE,LSNG,LSNG,LSNG,LSNG,LSNG,CLSW	; Lsng
BYTE (4)RFCR,FREE,FREE,CLSW,CLSW,OPND,RFCR,RFCR,RFCR,RFCR,RFCR	; Rfcr
BYTE (4)CLW1,FREE,FREE,CLW1,CLW1,CLW1,CLW1,CLW1,CLW1,FREE,CLW1	; Clw1
BYTE (4)OPND,FREE,FREE,CLSW,CLSW,RFCS,RFCS,RFCS,RFCS,CLSW,CLSW	; Rfcs
BYTE (4)OPND,CLZW,RFN2,CLW1,DATW,OPND,OPND,OPND,OPND,OPND,OPND	; Opnd
BYTE (4)CLSW,FREE,FREE,CLSW,CLSW,CLSW,CLSW,CLSW,CLSW,FREE,CLSW	; Clsw
BYTE (4)DATW,DATW,RFN1,DATW,DATW,DATW,DATW,DATW,CLW1,CLW1,DATW	; Datw
BYTE (4)RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,RFN1,FREE,FREE,RFN1	; Rfn1
BYTE (4)CLZW,CLZW,CLZW,FREE,FREE,CLZW,CLZW,CLZW,CLZW,CLZW,CLZW	; CLZW
BYTE (4)RFN2,RFN2,RFN2,RFN1,RFN1,RFN2,RFN2,RFN2,CLZW,CLZW,RFN2	; Rfn2
BYTE (4)NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE,NUSE	; NUSE
BYTE (4)FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE,FREE	; Free

; This is the action table
; It is referenced the same as the transition table

; Event rrfc clsr clss clzr clzs acpt conn lisn rrfe hung  old state

ACTION:
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY	; Dead
BYTE (4)ANOP,AFNY,AFNY,AFNY,AFNY,ANOP,ARFC,ANOP,AFNY,ANOP,AFNY	; Clzd
BYTE (4)AFNY,ACLS,ACLS,AFNY,AFNY,ANOP,AOPB,ANOP,AFNY,ACLS,AFNY	; Pndg
BYTE (4)ANOP,AFNY,AFNY,ANOP,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,ACLS	; Lsng
BYTE (4)AFNY,ACLS,ACLS,ACLS,ACLS,AOPB,AFNY,AFNY,AFNY,ANOP,AFNY	; Rfcr
BYTE (4)AFNY,ACLL,ACLL,AFNY,AFNY,ANOP,AFNY,AFNY,AFNY,ACLL,AFNY	; Clw1
BYTE (4)AOPL,ACLS,ACLS,ACLS,ACLS,ANOP,AFNY,AFNY,AFNY,ACLS,ACLS	; Rfcs
BYTE (4)AFNY,AEOR,AES1,ACLS,AEOS,ANOP,AFNY,AFNY,AFNY,ACKA,AFNY	; Opnd
BYTE (4)ANOP,ANOP,ANOP,ANOP,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY	; Clsw
BYTE (4)AFNY,AFNY,AES1,AFNY,AFNY,ANOP,AFNY,AFNY,ACLS,ACLS,AFNY	; Datw
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,ANOP,AFNY,AFNY,ACLO,ACLO,AFNY	; Rfn1
BYTE (4)AFNY,AFNY,AFNY,ACLL,ANOP,ANOP,AFNY,AFNY,AFNY,ANOP,AFNY	; CLZW
BYTE (4)AFNY,AFNY,AFNY,ANOP,ANOP,ANOP,AFNY,AFNY,ACLO,ACLO,AFNY	; Rfn2
BYTE (4)AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY,AFNY	; NUSE
BYTE (4)AFNY,AFNY,AFNY,ANOP,ANOP,AABT,AFNY,AFNY,AFNY,ANOP,AFNY	; Free

; Dispatch table for actions
; Routines are called effectively by pushj p,@actab(action#)

ACTAB:	CPOPJ		; Nop
	FUNNY		; Unexpected event
	SNDCLS		; Send cls
	SNDRFC		; Send str or rts
	NETOPB		; Sned rfc and open link
	NETOPL		; Open link
	NETCLL		; Close link
	NETCLB		; Close link and send cls
	DOEOR		; Finish up input
	DOEOS		; FINISH UP OUTPUT
	DOES1		; END OF SEND IF TRANSMISSION ABORTED
	DOABT		; ACCEPT ON ABORTED CONNECTION
	CKALL		; ALLOCATIN CHECK FOR OPENED CONN

RADIX 8

; Unexpected event

FUNNY:	MOVE 2,NETSTS(UNIT)	; Get status
	DPB UNIT,[POINT 8,2,11]	; Include unit
	DPB A,[POINT 6,2,17]	; And event
	LDB A,PFHST
	HRR B,A			; And host
	PUSHJ P,IMPBG0		; And create impbug
	AOS FUNNYC		; Count them
	JRST NCPERR		; AND SEND TYPE 0 ERR

; ACCEPTED AN ABORTED REQUEST

DOABT:	MOVSI IOS,EOTF		; SET FLAG TO CAUSE ERROR
	IORB IOS,NETSTS(UNIT)	; IN STATUS WORD
	POPJ P,

; CHECK ALLOCATION

CKALL:	MOVE A,LSKT(UNIT)
	TRNN A,1		; SEND SOCKET?
	 RET			; NO. DO NOTHING
	TEST(NE,ALLFF)		; Allocation failure??
	TEST(NN,CLZF)		; BEING CLOSED?
	 JRST CKALL1			; NO, IGNORE
	TEST(O,ERRB,EOTF)	; SIGNAL ERROR, AND STOP TRANSMISSION
	MOVEM IOS,NETSTS(UNIT)
	RET

CKALL1:	LDB A,PLIDX
	LDB B,PBPBYT
	CAMG B,NETBAL(UNIT)	; SUFFICIENT BIT ALLOCATION?
	SKIPN IMPLT4(A)		; AND MESSAGE SPACE?
	 JRST CKALL2		; NO
	TEST(Z,ALLFF)
	MOVEM IOS,NETSTS(UNIT)
	RET

CKALL2:	LDB A,PLIDX 
	CALL IMPSYN		; RESYNC ALLOCATION
	MOVSI IOS,ALLFF
	IORB IOS,NETSTS(UNIT)	; REMEMBER WE DID THIS ONCE
	RET
; END OF SEND

DOES1:	PUSHJ P,DOEOS
	PUSHJ P,IMPABL		; FLUSH QUEUED MESSAGES
	POPJ P,

DOEOS:	MOVSI IOS,EOTF
	IORB IOS,NETSTS(UNIT)
	LDB A,PLIDX
	PUSHJ P,IMPSDB		; SET DONE BIT IN LINK TABLE
	POPJ P,

; End of receive

DOEOR:	PUSHJ P,SNDCLS
	HRRZ B,NETBUF(UNIT)
	JUMPE B,DOEOS
	CAIL B,1000
	JRST DOEOS
EORNVT:	PUSHJ P,DOEOS		; DO SAME AS END OF SEND
	NCPON			; NCP BACK ON SO NVTDET CAN USE IT
	HRRZ B,NETBUF(UNIT)	; PICK UP LINE NUMBER
	PUSH P,UNIT
	PUSHJ P,NVTDET
	POP P,UNIT
	NCPOFF			; BACK OFF SO CALLER IS NOT CONFUSED
	POPJ P,

; Close link

NETCLL:	LDB A,PLIDX		; Get link table index
	PUSHJ P,IMPCLL
	POPJ P,

NETCLB:	PUSHJ P,NETCLL
SNDCLS:	LDB A,PFHST		; Get foreign host
	MOVE C,FSKT(UNIT)	; And foreign socket
	MOVE B,LSKT(UNIT)	; And local socket
	TEST(NN,DEDF)
	PUSHJ P,IMPCLS		; Send the control message
	POPJ P,

; OPEN LINK

NETOPL:	LDB A,PFHST
	MOVE B,LSKT(UNIT)
	TRNE B,1		; Send socket?
	 IORI A,1000		; Mak as such
	LDB B,PLINK		; Get link
	LDB C,PBPBYT
	PUSHJ P,IMPOPL
	DPB A,PLIDX		; Save link index
	POPJ P,

; Send rfc and open link

NETOPB:	PUSHJ P,NETOPL
	JRST SNDRFC

; Send rfc

SNDRFC:	TEST(NE,DEDF)
	 POPJ P,
	LDB A,PFHST		; Get foreign host
	MOVE B,LSKT(UNIT)	; And local socket
	MOVE C,FSKT(UNIT)
	LDB D,PBPBYT		; Byte size
	TRNE B,1
	JRST IMPSTR
	LDB D,PLINK
	JRST IMPRTS		; Send control message

; This here is the main fsm routine

DOFSM:	MOVE IOS,NETSTS(UNIT)
	TEST(NN,DEDF)
	 JRST DOFSMA
	PUSHJ P,DOFSMA
	LDB A,PFSM
DOFSMB:	PUSH P,A
	MOVEI A,HUNG
	PUSHJ P,DOFSMA
	LDB A,PFSM
	POP P,B
	CAME A,B
	 JRST DOFSMB
	POPJ P,

DOFSMA:	NCPOFF			; Allow no control messages while here
	PUSH P,A		; Save event for footprints
	MOVEI B,^D24		; Time out in 2 minutes
	DPB B,PCLKS
	LDB B,PFSM		; Get old state
	PUSH P,B
	LSH B,1			; Two words per old state
	LDB C,CBPFSM(A)		; Get new state
	LDB B,CBAFSM(A)		; Get action
	DPB C,PFSM
	PUSH P,B		; Save action
	MOVE B,-1(P)		; Get old state
	CAME C,B		; State changed?
	 PUSHJ P,STCPSI		; GENERATE STATE CHANGE PSI
DOFSM2:	POP P,B			; GET ACTION
	SUB P,BHC+1		; FLUSH OLD STATE
	POP P,A			; Restore event
	PUSHJ P,@ACTAB(B)	; Call action routine
	NCPON
	POPJ P,

; Generate state change PSI

STCPSI:	HRRE A,NETFRK(UNIT)
	JUMPL A,CPOPJ		; No fork for interrupts
	LDB B,PFSMCH		; Get psi channel
	CAIL B,^D36
	 POPJ P,
	EXCH A,B
	PUSHJ P,PSIRQ
	POPJ P,

; Make a socket or find existing one

GETSKT:	TDZA D,D
MAKSKT:	SETO D,
	PUSH P,D
	PUSH P,A		; Save foreign host
	PUSH P,B		; Save foreign socket
	PUSH P,C		; Save local socket
	MOVE UNIT,C
	XOR UNIT,B
	TRNN UNIT,1		; Homosexual?
	JRST MAKSKX		; Yes. error
	ROT C,-4
	MOVS UNIT,C
	IMULI C,123431
	XOR UNIT,C		; Randomize from local socket
	LSH UNIT,-1
	MULI UNIT,NSKT		; Initial probe
	MOVEI D,NSKT
	SETO C,
	NCPOFF
MAKSKL:	LDB A,PFSM		; Get state of this socket
	CAIE A,FREE
	CAIN A,DEAD
	JRST MAKSK1
	CAIN A,CLZW		; WAITING FOR USER TO CLOSE?
	JRST MAKSKN		; YES. DON'T PICK THIS ONE
	MOVE B,LSKT(UNIT)	; What local socket is this for?
	CAME B,(P)
	JRST MAKSKN		; Not the one we're after, try next
MAKSK3:	SKIPGE -2(P)
	JRST MAKSK6
	LDB B,PFHST
	MOVE A,FSKT(UNIT)
	CAIN B,777
	JRST [	SKIPN -3(P)	; Was getskt called?
		JRST MAKSKN	; Yes, getskt called
		POP P,C		; Makskt...suceed
		JRST MAKSKF]
	CAMN B,-2(P)
	CAME A,-1(P)
	 JRST MAKSKN		; Foreign host or socket doesn't match
	AOS -4(P)		; EVERYTHING MATCHES. SKIP RETURN
	SETZ A,
	JRST MAKSKV		; NCPON, POP STACK


MAKSK6:	POP P,C
	SUB P,BHC+3
	MOVE B,FSKT(UNIT)
	LDB A,PFHST
	NCPON
	JRST SKPRET

MAKSKN:	SOJLE D,MAKSKE		; Full, error
	SOJGE UNIT,MAKSKL	; Loop back for next slot
	MOVEI UNIT,NSKT-1
	JRST MAKSKL

MAKSK1:	MOVSI B,PROGF
	TDNE B,NETSTS(UNIT)
	 JRST MAKSKN		; Ignore those assigned to programs
	SKIPGE C
	MOVE C,UNIT		; Save where it's at
	CAIE A,DEAD
	JRST MAKSKN		; Space keeper, test next
MAKSK5:	SKIPN -3(P)
	JRST MAKSKR
	MOVE UNIT,C
	SETZM NETSTS(UNIT)
	SETZM NETBUF(UNIT)
	SETZM NETAWD(UNIT)
	SETZM NETBAL(UNIT)
	SETZM NETBTC(UNIT)
	SETOM NETFRK(UNIT)
	MOVEI A,CLZD
	DPB A,PFSM		; Set its state to be closed
	POP P,C
	MOVEM C,LSKT(UNIT)
MAKSKF:	MOVE A,-1(P)		; Foreign host
	MOVE B,LSKT(UNIT)
	TRNE B,1		; Receive?
	 JRST MAKSKQ
	PUSHJ P,ASNLNK		; Assign link for that host
	 JRST [	LDB A,PFSM
		MOVEI B,FREE
		CAIN A,CLZD	; Just created?
		 DPB B,PFSM	; Yes, delete it
		PUSH P,LSKT(UNIT)
		JRST MAKSKR]	; And fail
MAKSKQ:	POP P,B			; Common for old and new
	MOVEM B,FSKT(UNIT)
	POP P,A
	DPB A,PFHST
	SUB P,BHC+1
	NCPON
	JRST SKPRET

MAKSKE:	JUMPGE C,MAKSK5
MAKSKW:	SKIPA A,[0]		; FULL
MAKSKR:	MOVEI A,4		; NON-EXISTENT
MAKSKV:	NCPON
	SKIPA A,A
MAKSKX:	MOVEI A,3		; BAD PARAMETERS
	HRLM A,-2(P)		; STORE ERROR CODE
	POP P,C
	POP P,B
	POP P,A
	SUB P,BHC+1
	POPJ P,

; Assign link number for this connection

ASNLNK:	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVEI D,1(P)		; Where bits will be
	PUSH P,[<1B<FLINK>-1>_1+1]
	REPEAT NLNKBW-2,<PUSH P,[-1]>
	PUSH P,[-<1B<LLINK-<^D36*<NLNKBW-1>>-1>>]
	PUSH P,UNIT		; Preserve unit
	PUSH P,A
	MOVSI UNIT,-NSKT
ASNLNL:	LDB A,PFSM
	CAIE A,FREE
	CAIN A,DEAD
	 JRST ASNLNN
	LDB A,PFHST
	CAME A,0(P)		; Check all connection to this host
	 JRST ASNLNN		; Get next
	MOVE A,LSKT(UNIT)
	TRNE A,1		; Only receive connections
	 JRST ASNLNN
	LDB A,PLINK		; Get link assigned
	IDIVI A,^D36		; Separate word and bit
	MOVE B,BITS(B)		; Get the bit
	ADD A,D
	ANDCAM B,0(A)		; Clear bits for links in use
ASNLNN:	AOBJN UNIT,ASNLNL	; Loop thru all connections
	HRLI D,-NLNKBW		; Prepare to look at all bits
	SETZ C,
ASNLNC:	MOVE A,0(D)
	JFFO A,ASNLNF
	ADDI C,^D36
	AOBJN D,ASNLNC
	JRST ASNLN1		; Failed

ASNLNF:	ADD B,C
ASNLN0:	POP P,A
	POP P,UNIT
	DPB B,PLINK
	SUB P,BHC+NLNKBW
	AOS -3(P)
ASNLN1:	POP P,D
	POP P,C
	POP P,B
	POPJ P,

; Do a listen (openf for file with no foreign host/socket)

LISTEN:	PUSHJ P,HSTCHK
	POPJ P,
	PUSH P,D		; Save byte size
	PUSHJ P,MAKSKT		; Make a socket
	 JRST [	POP P,D
		MOVEI A,OPNX10
		POPJ P,]	; No room
	MOVEI A,LISN
	JRST CONNE1

; Do a connect (openf for file with foreign host/socket specified)

CONNEC:	PUSHJ P,HSTCHK
	POPJ P,
	PUSH P,D		; Save byte size
	PUSHJ P,MAKSKT		; Make a socket or find existing one
	 JRST [	POP P,D
		MOVEI A,OPNX10
		POPJ P,]	; No room
	MOVEI A,CONN
CONNE1:	NCPOFF
	LDB B,PFSM
	CAIN B,CLZD		; Received any rfc here?
	 JRST CONNE2		; No
	CAIN B,PNDG		; Same question
	 JRST CONNE3		; Yes
	MOVEI A,OPNX9		; Already in use
	POP P,D
	NCPON
	POPJ P,

CONNE2:	MOVSI D,PROGF
	IORM D,NETSTS(UNIT)	; Mark as attached to program
	NCPON
	POP P,D			; My choice of byte size
	DPB D,PBPBYT		; Set byte size
	PUSHJ P,DOFSM		; Send rfc etc
	JRST SKPRET

CONNE3:	TRNE C,1		; Are we sender?
	 JRST CONNE2		; Also our choice
	LDB D,PBPBYT		; Get his byte size
	CAMN D,0(P)		; Does byte size agree?
	 JRST CONNE2		; Yes, same as if my choice
	NCPON
	MOVEI A,HUNG		; Flush his connection attempt
	PUSHJ P,DOFSM
	POP P,D
	MOVEI A,OPNX22		; Bad byte size error
	POPJ P,

; Check if host is available

HSTCHK:	SKIPL IMPRDY
	 JRST [	MOVEI A,OPNX19
		POPJ P,]
	JUMPL 1,SKPRET		; ALWAYS OK IF LISTEN
	PUSH P,B
	PUSH P,A
	IDIVI A,^D36
	MOVE B,BITS(B)
	TDNE B,IMPBHT(A)
	 JRST [	MOVEI A,OPNX20
		JRST HSTCHF]
	TDNE B,IMPHRT(A)
	 JRST HSTCHO
	MOVE A,0(P)
	PUSH P,3
	PUSH P,4
	PUSH P,5
	PUSHJ P,IMSRST		; RESET HIM
	POP P,5
	POP P,4
	POP P,3
	MOVE A,TODCLK		; GET NOW
	ANDI A,377777
	ADDI A,^D5000		; PLUS 5 SECONDS
	ANDI A,777777-377	; LEAVE ROOM FOR HOST
	IOR A,0(P)
	HRLI A,HUPTST		; TEST ADDRESS
	MOVSS A
	JSYS EDISMS
	MOVE A,0(P)
	IDIVI A,^D36
	MOVE B,BITS(B)
	TDNN B,IMPHRT(A)
	 JRST [	MOVEI A,OPNX20
		JRST HSTCHF]
HSTCHO:	POP P,A
	AOSA -1(P)
HSTCHF:	SUB P,BHC+1
	POP P,B
	POPJ P,

	USE	RESPC

HUPTST:	MOVE 2,1
	ANDI 2,377
	IDIVI 2,^D36
	MOVE 3,BITS(3)
	TDNE 3,IMPHRT(2)
	 JRST 1(4)
	ANDCMI 1,377
	JRST BLOCKW		; CHECK TIME RUN OUT

	USE	SWAPPC

; Routines to call when control messages are received

; Receive cls
; Reccls(fhost,fskt,lskt)--nil

RECCLS:	PUSHJ P,GETSKT		; Get the socket entry
	 JRST NCPERR
RECCL1:	MOVE B,LSKT(UNIT)
	TRNN B,1
	SKIPA A,[CLSR]
	MOVEI A,CLSS
	PUSHJ P,DOFSM
	POPJ P,

; RECEIVED INCORRECT MESSAGE
; REPLY WITH ERR

NCPERR:	PUSH P,1		; SAVE AC'S
	PUSH P,2
	PUSH P,3
	PUSH P,4
	PUSH P,5
	MOVE 5,[I8CAL,,3]	; COMPLAIN ABOUT LAST CONTROL MESSAGE
	BLT 5,5
	HLRZ 2,1		; SUBCODE TYPE FOR "ERR" MSG
	HRRZS 1			; AND HOST TO COMPLAIN TO.
	PUSHJ P,IMPERR
	POP P,5
	POP P,4
	POP P,3
	POP P,2
	POP P,1
	HRRZS 1
	POPJ P,

; Receive str
; Recstr(fhost,fskt,lskt)--nil

RECSTR:	PUSH P,D		; Save byte size
RCSTR0:	PUSHJ P,MAKSKT
	 JRST [	POP P,D
		JRST NCPERR]
	MOVE D,0(P)
	PUSHJ P,CHKSKT		; MAKE SURE THIS SOCKET NOT IN USE
	 JRST RCSTR0		; IT WAS. DELETED. NOW TRY AGAIN.
	LDB A,PFSM		; What is state of this connection
	CAIE A,CLZD		; If not clzd
	 JRST [	LDB D,PBPBYT	; Then get user's byte size
		CAMN D,0(P)	; If not the same
		JRST .+1
		MOVEI A,RRFB	; RECEIVED BAD BYTE SIZE
		PUSHJ P,DOFSM
		MOVSI A,ERRB
		IORM A,NETSTS(UNIT)
		POP P,D
		POPJ P,]
	POP P,D
	DPB D,PBPBYT
	MOVEI A,RRFC
	PUSHJ P,DOFSM
	MOVE A,UNIT
	LDB B,PLINK
	POPJ P,

CHKSKT:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	LDB A,PFSM		; GET STATE
	CAIE A,RFCS		; STATES WHERE RFC IS EXPECTED
	CAIN A,CLZD
	 JRST SKTCK1
	CAIN A,LSNG
SKTCK1:	 AOSA -4(P)		; OK, SKIP RETURN
	PUSHJ P,SK2DWN		; ELSE KILL THE OLD ONE
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POPJ P,

CHKLNK:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	MOVSI UNIT,-NSKT
CHKLK1:	LDB B,PLINK		; GET THE LINK
	LDB C,PFHST		; AND HOST
	CAMN B,0(P)
	CAME C,-3(P)
	 JRST CHKLK2
	MOVE B,LSKT(UNIT)
	TRNN B,1
	 JRST CHKLK2		; SKIP SEND CONNECTIONS
	LDB B,PFSM		; LINK-HOST MATCHES. GET STATE
	CAIE B,DEAD
	CAIN B,FREE
	 JRST CHKLK2
	CAIE B,CLZD
	CAIN B,RFCS
	 JRST CHKLK2
	CAIE B,LSNG
	CAIN B,CLZW
	 JRST CHKLK2
	PUSHJ P,SK2DWN
CHKLK2:	AOBJN UNIT,CHKLK1
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POPJ P,

; Receive rts
; Recrts(fhost,fskt,lskt,link)

RECRTS:	PUSHJ P,CHKLNK		; CHECK AND DELETE ANY MATCHING LINKS
	PUSH P,D		; SAVE LINK
	PUSHJ P,MAKSKT		; MAKE SOCKET TABLE ENTRY
	 JRST [	POP P,D		; FAILED, SEND ERR
		JRST NCPERR]
	POP P,D			; RESTORE LINK
	PUSHJ P,CHKSKT		; MAKE SURE NO DUPLICATES
	 JRST RECRTS		; PREVIOUS CONNECTION CLOSED. TRY AGAIN
	DPB D,PLINK
	MOVEI A,RRFC
	PUSHJ P,DOFSM
	POPJ P,

; Receive rfnm

RCFRFN:	MOVEI A,RRFN
	PUSHJ P,DOFSM
	POPJ P,

; Receive ins/inr

RECINR:
RECINS:	LDB B,PINTCH
	LDB A,PFSM
	CAIGE B,^D36		; RETURN IF CHANNEL IS 77 OCTAL
	CAIE A,OPND
	 POPJ P,
	HRRZ A,NETBUF(UNIT)
	SKIPE A
	CAIL A,1000
	CAIA
	 POPJ P,
	HRRE A,NETFRK(UNIT)
	JUMPL A,CPOPJ
	EXCH A,B
	PUSHJ P,PSIRQ
	POPJ P,

; INITIATE SERVICE INTERRUPTION (HOST DEAD)

SVCINT:	MOVSI IOS,SVCIF
	IORB IOS,NETSTS(UNIT)
	PUSHJ P,STCPSI		; GENERATE STATE CHANGE PSI
	POPJ P,

; TERMINATE SERVICE INTERRUPTION

SVCRST:	MOVSI IOS,SVCIF
	ANDCAB IOS,NETSTS(UNIT)
	PUSHJ P,STCPSI
	POPJ P,

; Receive reset message

RECRST:	PUSHJ P,NETHDN
	JRST IMPRRP

; Kill all connection -- net is down

NETDWN:	MOVSI UNIT,-NSKT
	PUSHJ P,SKTDWN
	AOBJN UNIT,.-1

; Periodic check of all connections for time-out

NETCHK:	MOVSI UNIT,-NSKT
NETCKL:	LDB A,PFSM
	CAIE A,DEAD
	CAIN A,FREE
	 JRST NETCKN
	MOVSI A,DEDF
	TDNN A,NETSTS(UNIT)
	SKIPL IMPRDY
	JRST NETCK1
	LDB B,PCLKS
	SOS B
	DPB B,PCLKS
	JUMPG B,NETCKN
NETCK1:	MOVEI A,HUNG
	PUSHJ P,DOFSM
NETCKN:	AOBJN UNIT,NETCKL
	MOVEI A,^D5000
	SKIPL IMPRDY
	MOVEI A,^D500
	ADD A,TODCLK
	MOVEM A,NETTIM
	POPJ P,

; Host has died

NETHDN:	MOVSI UNIT,-NSKT
	PUSH P,A
NETHDL:	LDB A,PFSM
	CAIE A,FREE
	CAIN A,DEAD
	JRST NETHDX
	LDB A,PFHST
	CAMN A,(P)
	PUSHJ P,SKTDWN
NETHDX:	AOBJN UNIT,NETHDL
	POP P,A
	POPJ P,

SK2DWN:	HRRZ B,NETBUF(UNIT)
	CAIG B,NVTHI		; AN NVT?
	CAIGE B,NVTLO
	 JRST SKTDWN		; NO, TREAT NORMALLY
	PUSH P,UNIT
	PUSH P,B
	PUSHJ P,SKTDWN
	POP P,B
	LDB UNIT,PTNETI
	PUSHJ P,SKTDWN
	POP P,UNIT
	POPJ P,

SKTDWN:	LDB A,PFSM		; GET STATE
	CAIN A,LSNG		; IF LSNG
	 POPJ P,		; IGNORE
	MOVSI B,ERRB!DEDF
	IORM B,NETSTS(UNIT)
	CAIE A,CLSW		; IF WAITING FOR CLOSE,
	CAIN A,CLW1
	PUSHJ P,SKTDW2		; PRETEND ONE HAPPENED.
	CAIE A,RFCR
	CAIN A,OPND		; If opnd
SKTDW2:	PUSHJ P,RECCL1		; Simulate receipt of cls
	MOVEI A,HUNG
	PUSHJ P,DOFSM
	POPJ P,
>		; End of ifdef on page 1
	END

