;<FOONEX>NETWRK.MAC;18 18-Mar-81 20:36:29, Edit by MMCM
;DSK:<134-TENEX>NETWRK.MAC;16 30-May-80 20:08:38, Edit by PETERS
; More needed Tymnet gateway crocks
;<134-TENEX>NETWRK.MAC;15    30-May-80 16:15:16    EDIT BY PETERS
; Add needed EXTERNs to Tymnet gateway stuff
;DSK:<134-TENEX>NETWRK.MAC;14 19-May-80 21:56:04, Edit by PETERS
; Add needed Tymshare crocks to new version
;<134-TENEX>NETWRK.MAC;5      22-Jan-79 10:00:00, EDIT BY GENE
; Installed BBN's NETWRK as part of TCP 2.5 installation.
;<135-TENEX>NETWRK.MAC.10013, 10-Jan-79 21:59:45, EDIT BY JBORCHEK
;FIX BUG IN HOST STRING TO NUMBER CONVERSION
;<135-TENEX>NETWRK.MAC.10009, 17-Nov-78 19:49:33, EDIT BY JBORCHEK
;MAKE GTHST TAKE JFNS ALSO
;<134-TENEX>NETWRK.MAC.100, 11-Oct-78 17:25:24, EDIT BY JBORCHEK
; MERGE IN EXTENDED LEADER CODE
;<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

	SEARCH	STENEX,PROLOG,IMPPAR
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,MSTKOV
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	MRTNE1	; Error return to user (don't store LSTERR) for ERCAL/ERJMP
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,HOSTNN,HSTSTS,NHOSTS,NICKNA
EXTERN	PNAMEP,PNMIDX

; 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,IMPOPS
EXTERN	HSTDED
EXTERN	IMPRTS,IMPSTR,IMPRRP,IMSRST,IMPERR
EXTERN	ASNAVT,NVTDET,IMPRDY,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,CVNHST,CVOHST,HSTHSH,AVTDET,AATNVT
INTERN	.CVSKT,.FLHST,.CVHST,.GTHST,.GTNCP

; 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))
HN=7		; Host index

; Parameters

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

; In Storag.mac

EXTERN LSKT,FSKT,NETAWD,NETBAL,NETDAL,NETBUF,NETSTS,NETFRK,NETBTC
EXTERN NCPLCK,NCPLLK,NCPLCN,NCPLFC,ASNTBC,NETCNC,FUNNYC,NETFRE
EXTERN ASNTHR,NETHST,NLHOST

IFNDEF RNTBFS,<
EXTERN NTBUFS
>

; 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 36,NETHST(UNIT),35; 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
	NOINT
	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
	OKINT
	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
	MOVE A,MAXWPM		; GET SIZE OF EACH BUFFER
	ASH A,3			; TIMES 8
	MOVEM A,ASNTHR		; SETS BUFFER SPACE LOW THRESHOLD


;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,NLHOST
	PUSHJ P,CVOHST
	MOVEM A,NOHOST##
	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:	TEST(NE,STEPF)		; NET:<*> NOT ALLOWED
	 JRST [	MOVEI A,GJFX17
		POPJ P,]
	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:	TEST(NE,VERSF)		; Version wild card?
	 JRST [	MOVEI A,GJFX31	; yes, don't allow it
		JRST ERRET]
	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:	MOVE T4,T1
	ILDB T4,T4
	JUMPE T4,[SETOB T1,T2
		JRST SKPRET]
	MOVE T3,T1			;GET SCRATCH POINTER
	SETZ T4,			;ASSUME NO - FOUND
EXTDE1:	ILDB T2,T3			;GET A BYTE
	CAIN T2,"-"			;SAVE LAST - FOUND
	 MOVE T4,T3
	JUMPN T2,EXTDE1			;DO WHOLE STRING
	JUMPE T4,CPOPJ			;NO - MEANS ERROR
	DPB T2,T4			;END HOST WITH NUL
	CALL HSTLUK			;LOOKUP HOST
	MOVEI T3,"-"			;RESTORE THE -
	DPB T3,T1
	JUMPG T2,CPOPJ			;NO HOST FOUND
	MOVEI T3,10			;GET OCTAL SOCKET NUMBER
	NIN
	 POPJ P,
	MOVE T1,T4
	JRST SKPRET


HSTLUK:	SAVEQ				;GET SOME ROOM
	MOVE UNIT,T1			;SAVE POINTER
	MOVEI T3,10
	NIN				;TRY TO GET A NUMBER
	 JRST HSTLKI			;TRY A NAME
	MOVE UNIT,T1			;SAVE UPDATED POINTER
	MOVE T1,T2
	CALL CVNHST
	MOVE T4,T1			;RETURN HOST NUMBER
	MOVE T1,UNIT			;AND UPDATED POINTER
	SETZ T2,			;HOST NUMBER FOUND
	POPJ P,

HSTLKI:	HRLZ T2,MHOSTS			;SCAN THE TABLE

HSTLK0:	MOVE T1,UNIT			;DO NAME POINTER
	LDB T3,PNAMEP
	ADD T3,[POINT 7,HSTNAM]

HSTCMP:	ILDB IOS,T1			;COMPARE A STRING
	ILDB HN,T3
	SKIPN IOS
	 JUMPE HN,[LDB T4,PNMIDX
		   MOVE T4,HOSTNN(T4)
		   POPJ P,]
	CAIN IOS,(HN)
	 JRST HSTCMP
	AOBJN T2,HSTLK0			;STEP TO NEXT HOST
	SETZ T4,			;NO HOST FOUND
	POPJ P,

	USE RESPC

HSTHSH::MOVE T2,T1			;DO A HASH
	IDIVI T2,NHOSTS			;GET INITIAL GUESS, DIV BY PRIME
	EXCH T2,T3			;2/ FIRST GUESS
	IDIVI T3,NHOSTS			;DIV BY PRIME AGAIN
	CAIN T4,0			;GET INCREMENT
	 MOVEI T4,1
	MOVEI T3,NHOSTS			;COUNTER FOR GUESSES
HSTHLP:	SKIPG HOSTNN(T2)		;NO HOST THERE?
	 POPJ P,			;NO, 2/ WHERE TO PUT IT
	CAMN T1,HOSTNN(T2)		;MATCH?
	 JRST SKPRET
	ADDI T2,(T4)			;STEP BY INCREMENT
	CAIL T2,NHOSTS			;WRAP AROUND IF NEEDED
	 SUBI T2,NHOSTS
	SOJG T3,HSTHLP			;COUNT DOWN GUESSES
	SETO T2,			;-1 TABLE FULL
	POPJ P,

;CONVERT HOST NUMBER IN AC1 TO NEW FORMAT

CVNHST::CAMN T1,[-1]		;IF -1 USE LOCAL HOST NUMBER
	 MOVE T1,NLHOST
	AND T1,[HSTMSK]		;CUT DOWN TO SIZE
	TLNE T1,37700
	 POPJ P,
	ANDI T1,377
	TRZE T1,100		;SET THE HOST BITS
	 TRO T1,200000
	TRZE T1,200
	 TRO T1,400000
	IOR T1,NETFLD##		;ADD NETWORK NUMBER
	POPJ P,

;CONVERT HOST NUMBER IN AC1 TO OLD FORMAT

CVOHST::CAMN T1,[-1]		;NO HOST?
	 JRST CVOHS1		;RETURN 777
	TDZE T1,[740077,,177700];CHECK TO SEE IF FITS IN OLD FORMAT
	 MOVEI T1,400		;RETURN 400
	TRZE T1,200000		;SET THE HOST BITS
	 TRO T1,100
	TRZE T1,400000
	 TRO T1,200
CVOHS1:	ANDI T1,777
	POPJ P,

	USE	SWAPPC

; 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

AVTDET:	LDB IMPUN,PTNETI	; Input unit
	CALL NVTCLZ		; Close it
	MOVE 2,0(P)
	LDB IMPUN,PTNETO	; Output unit

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		; Bits per word
	LDB C,PBPBYT		; Connection byte size
	IDIV A,C		; Connection bytes per word
	IMUL C,A		; Used bits per word
	MOVE B,MAXBPM		; Max bits per net message
	IDIVM B,C		; Max words per net message
	MOVEI A,^D36		; Bits per machine word
	LDB B,PBYTSZ		; File byte size
	IDIVM A,B		; File bytes per word
	PUSH P,B		; Save file bytes per word
	LDB A,PBFSIZ		; Desired bytes per buffer
	IDIV A,B		; Number of 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)		; Words in this buffer
	SUBI C,1		; Less overhead
	POP P,A			; Restore file bytes per word
	IMUL A,C		; File bytes which fit in this buffer
	LDB B,PBFSIZ		; RETURN AS VALUE
	DPB A,PBFSIZ		; REAL BYTES PER BUFFER
	TEST(Z,WNDF)
	POPJ P,

AATNVT:	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,ASNAVT		; 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

; 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


;ROUTINE TO PRODUCE THE OLD HOSTN TABLE

GHOSTN::LDB T4,PNMIDX			;GET INDEX
	MOVE T1,HOSTNN(T4)		;GET THE HOST NUMBER
	CALL CVOHST			;CONVERT TO OLD FORMAT
	MOVE T3,HSTSTS(T4)		;GET HOST STATUS
	ANDI T3,777000			;GET THE RIGHT BITS
	IORI T1,(T3)			;BUILD LH
	SKIPGE HOSTN(T2)		;NICKNAME?
	 TRO T1,NICKNA
	MOVSI T1,(T1)
	LDB T3,PNAMEP			;GET THE NAME POINTER
	HRRI T1,(T3)
	RET

;ROUTINE TO PRODUCE THE OLD NETAWD TABLE

GNTAWD::HRRZ UNIT,T2			;GET THE HOST NUMBER
	LDB T1,PFHST
	CALL CVOHST			;CONVERT TO OLD FORMAT
	MOVSI T1,(T1)			;HOST NUMBER TO LH
	MOVE T3,NETAWD(T2)		;GET REST OF WORD
	TLZ T3,777			;CLEAR OUT SLOT FOR HOST
	IOR T1,T3			;PUT IT TOGETHER
	RET

;ROUTINE TO PRODUCE OLD IMPHRT GETAB TABLE.

GTBHRT::HRRZ 5,T2		;GET INDEX
	IMULI 5,^D36		;CONVERT TO 1ST HOST NUMBER
	HRLI 5,-^D36		;LOOP COUNTER
	SETO 6,			;SET TO ALL UP

GTBHR1:	ROT 6,1			;MAKE ROOM FOR NEXT BIT
	HRRZ T1,5		;GET NEXT HOST NUMBER
	CAIL T1,400		;OUT OF RANGE
	 JRST GTBHR2
	CALL CVNHST		;CONVERT TO NEW FORMAT
	CALL HSTHSH		;LOOKUP HOST INDEX
	 TRNA			;NOT THERE SO NOT UP
	SKIPL HSTSTS(T2)	;UP?
GTBHR2:	 TRZ 6,1		;NO, CLEAR BIT
	AOBJN 5,GTBHR1		;LOOP FOR ALL 36 HOSTS IN THIS WORD
	MOVE T1,6		;RETURN WORD FOR GETAB
	POPJ P,

;ROUTINE TO PRODUCE OLD HSTSTS GETAB TABLE.

GTBHSS::HRRZ 6,T2		;GET INDEX
	LSH 6,1			;TURN INTO HOST NUMBER
	MOVE T1,6		;HOST N
	CALL GTBHSH		;GET RIGHT STATUS
	HLLZ 5,T1		;RESULT FOR HOST N IN LEFT HALF
	AOS T1,6		;HOST N+1
	CALL GTBHSH		;GET RIGHT STATUS
	HLR 5,T1		;RESULT FOR HOST N+1 IN RIGHT HALF
	MOVE T1,5		;RETURN WORD FOR GETAB
	POPJ P,

GTBHSH:	CALL CVNHST		;CONVERT TO NEW FORMAT
	CALL HSTHSH		;LOOKUP HOST INDEX
	 JRST [	SETZ T1,
		RET]		;NO SUCH HOST, RETURN 0
	SKIPL T1,HSTSTS(T2)	;UP?
	 TLOA T1,(1B0+1B1)	;SET VALID AND DEAD BITS
	MOVSI T1,(1B0)		;OTHERWISE JUST SET VALID
	RET

;GTNCP RETURNS A TABLE OF DATA FOR AN NCP CONNECTION

.GTNCP::JSYS MENTR
	SKIPL T1			;CHECK RANGE OF FUNCTION
	 CAIL T1,GTNMAX
	  RETERR (GTNCX1)		;BAD FUNCTION NUMBER
	XCT GTNDSP(T1)			;DO FUNCTION
GTNCPX:	SKIPL UNIT			;GET THE INDEX
	 CAIL UNIT,NSKT
	  RETERR (GTNCX2)		;BAD INDEX
	UMOVE T3,3			;GET AC3 AND AC4 FROM USER
	UMOVE T4,4
GTNCPL:	HRRZ T1,T4			;OUT OF THINGS?
	CAIL T1,NCPLEN
	 JRST GTNCLX			;YES
	XCT NCPTAB(T1)			;LOAD DATA WORD
	UMOVEM T1,(T3)			;RETURN TO USER
	AOJ T3,
	AOBJN T4,GTNCPL			;LOOP
GTNCLX:	UMOVEM T4,4			;UPDATE COUNTER
	JRST SKMRTN

NCPTAB:	MOVE T1,UNIT			;(00)NCP UNIT
	LDB T1,PFHST			;(01)FOREIGN HOST
	MOVE T1,LSKT(UNIT)		;(02)LOCAL SOCKET
	MOVE T1,FSKT(UNIT)		;(03)FOREIGN SOCKET
	LDB T1,PFSM			;(04)FINITE STATE
	LDB T1,PLINK			;(05)LINK
	CALL [	HRRZ T1,NETBUF(UNIT)	;(06)RETURN NVT IF
		SKIPE T1		;THERE IS ONE
		CAIL T1,1000
		 SETO T1,		;NONE
		RET]
	LDB T1,PBPBYT			;(07)BYTE SIZE OF CONNECTION
	CALL [	LDB T1,PLIDX		;(10)MSG ALLOC
		HRRZ T1,IMPLT4(T1)
		RET]
	MOVE T1,NETBAL(UNIT)		;(11)BIT ALLOC
	MOVE T1,NETDAL(UNIT)		;(12)DESIRED ALLOC
	MOVE T1,NETBTC(UNIT)		;(13)BITS XFERRED
	HLRZ T1,NETBUF(UNIT)		;(14)BYTES/BUFFER
	LDB T1,PCLKS			;(15)TIMEOUT
	MOVE T1,NETSTS(UNIT)		;(16)STATUS OF CONN
NCPLEN==.-NCPTAB

GTNDSP:	JRST GTNSIZ			;(00)GET TABLE SIZE
	HRRZ UNIT,T2			;(01)INDEX GIVEN
	JRST GTNNVI			;(02)INPUT NVT
	JRST GTNNVO			;(03)OUTPUT NVT
	JRST GTNJFN			;(04)JFN
GTNMAX==.-GTNDSP			;NUMBER OF FUNCTIONS

GTNSIZ:	MOVSI T2,-NSKT			;-LENGTH,,1ST INDEX
	UMOVEM T2,2			;RETURN TO USER
	MOVE T3,NVTPTR##		;-# NVTS,,1ST NVT
	UMOVEM T3,3
	JRST SKMRTN			;DONE

GTNJFN:	MOVE JFN,T2			;CHECK THE JFN
	CALL CHKJFN
	 RETERR (GTNCX3)
	 RETERR (GTNCX3)
	 RETERR (GTNCX3)
	HLRZ UNIT,DEV			;GET THE UNIT
	CALL UNLCKF
	HRRZ T1,DEV
	CAIE T1,NETDTB			;MAKE SURE IS NET:
	 RETERR (GTNCX3)
	JRST GTNCPX			;REJOIN MAIN CODE

GTNNVI:	SKIPA UNIT,PTNETI		;GET INPUT UNIT
GTNNVO:	MOVE UNIT,PTNETO		;USE OUTPUT UNIT
	CAIN T2,-1			;WANT CONTROLLING TTY?
	 MOVE T2,CTRLTT			;YES
	ANDI T2,377777			;CLEAR 400000
	CAIL T2,NVTLO			;CHECK RANGE
	CAILE T2,NVTHI
	 RETERR (GTNCX4)		;BAD NVT
	LDB UNIT,UNIT			;GET THE UNIT
	JRST GTNCPX			;REJOIN MAIN CODE

;GET INFOMATION ABOUT HOSTS

.GTHST::JSYS MENTR
	SKIPL T1			;CHECK RANGE OF FUNCTION CODE
	 CAIL T1,GTHMAX
	  RETERR (GTHSX1)		;BAD FUNCTION CODE
	SETOB HN,DEV			;NO NUMBER NOR NAME
	XCT GTHDSP(T1)			;DO THE FUNCTION

GTHSXX:	MOVEI T4,NICKNA			;SET THE NICKNAME FLAG
	SKIPL HN			;NO NAME
	SKIPL HOSTN(HN)			;DID WE HAVE ONE?
	 SKIPA T4,HSTSTS(DEV)		;NO
	IOR T4,HSTSTS(DEV)		;RETURN STATUS
	UMOVEM T4,4
	MOVE T3,HOSTNN(DEV)		;RETURN HOST NUMBER
	UMOVEM T3,3
	JRST SKMRTN			;SKIP RETURN

GTHDSP:	JRST GTHSIZ			;(00)GET NAME TABLE SIZE
	JRST GTHIDX			;(01)INDEX INTO NAME SPACE
	JRST GTHNUM			;(02)CONVERT NUMBER TO STRING
	JRST GTHSTR			;(03)CONVERT STRING TO NUMBER
	JRST GTHHNN			;(04)STATUS BY NUMBER
	JRST GTHHNI			;(05)STATUS BY INDEX
GTHMAX==.-GTHDSP			;NUMBER OF FUNCTIONS

GTHSIZ:	HRLZ T2,MHOSTS			;-LENGTH,,1ST INDEX
	UMOVEM T2,2			;RETURN TO USER
	MOVNI T3,NHOSTS			;NUMBER OF HOST SLOTS
	HRLZS T3
	UMOVEM T3,3			;RETURN TO USER
	MOVE T4,NLHOST			;LOCAL HOST
	UMOVEM T4,4			;RETURN TO USER
	JRST SKMRTN			;DONE

GTHIDX:	MOVN T1,MHOSTS			;GET NUMBER OF HOST NAMES IN USE
	HRRZ HN,T3			;CHECK RANGE OF HOST NAME INDEX
	CAML HN,T1
	 RETERR (GTHSX4)		;BAD INDEX TO HOSTN
	HRRZ T2,HN
	LDB DEV,PNMIDX			;GET INDEX INTO HOSTNN
	JRST GTHTUS			;WRITE THE STRING

GTHNUM:	MOVE T1,T3			;GET HOST NUMBER
	CALL GTHNTS			;CONVERT NUMBER TO STRING
	JUMPL HN,[RETERR(GTHSX5)]	;NO STRING FOR THAT NUMBER

GTHTUS:	HRRZ T2,HN
	LDB UNIT,PNAMEP			;GET THE NAME POINTER
	MOVEI UNIT,HSTNAM(UNIT)		;POINT TO NAME
	HRLI UNIT,(<POINT 7,0>)
	CALL GTHSOU			;WRITE STRING
	JRST GTHSXX			;EXIT

GTHNTS:	CALL CVNHST			;MAKE IT NEW FORMAT
	CALL HSTHSH			;GET ITS INDEX
	 RET				;NOT THERE
	HRRZ DEV,T2			;INDEX TO DEV
	HRLZ T2,MHOSTS			;SCAN TABLE FOR THIS INDEX
GTHSLP:	LDB T3,PNMIDX			;GET INDEX
	CAMN T3,DEV			;THE SAME?
	 JRST [	HRRZ HN,T2		;GET NAME INDEX
		POPJ P,]
	AOBJN T2,GTHSLP			;LOOP
	POPJ P,				;ONLY NUMBER FOUND

GTHSTR:	CALL GTHSTN			;CONVERT STRING TO NUMBER	
	SKIPGE T2			;VAILD STRING FOUND?
	 HRRZ HN,T2			;SAVE POINTER TO HOSTN
	MOVE T1,T4			;GET INDEX TO HOSTNN
	CALL CVNHST
	CALL HSTHSH
	 RETERR(GTHSX3)
	HRRZ DEV,T2
	JRST GTHSXX			;EXIT

GTHSTN:	ADD P,BHC+10
	JUMPGE P,MSTKOV
	MOVEI UNIT,-7(P)		;POINT TO BUFFER
	HRLI UNIT,(<POINT 7,0>)
	CALL GTHSIN			;GET STRING FROM USER
	MOVEI T1,-7(P)			;MAKE BYTE POINTER
	HRLI T1,(<POINT 7,0>)		;MAKE BYTE POINTER
	CALL HSTLUK			;LOOKUP NAME
	SUB P,BHC+10
	POPJ P,

GTHHNI:	HRRZ T1,T3			;GET INDEX
	CAIL T1,NHOSTS
	 RETERR (GTHSX4)		;BAD INDEX
	SKIPA T1,HOSTNN(T1)		;GET THE NUMBER

GTHHNN:	MOVE T1,T3			;GET HOST NUMBER
	CALL GTHNTS			;CONVERT NUMBER TO INDEX
	JUMPL DEV,[RETERR (GTHSX2)]	;UNKNOWN HOST
	JRST GTHSXX			;EXIT

GTHSIN:	UMOVE T1,2		; GET POINTER
	MOVE JFN,[XCTBU [ILDB T2,T1]]
	TLNN T1,777777		; IF JFN DO THE JSYS
	 MOVE JFN,[BIN]
	TLC T1,777777		; CHECK FOR LH -1
	TLCN T1,777777
	 HRLI T1,(<POINT 7,0>)	; USE STANDARD POINTER
	MOVEI STS,^D39		; UP TO 39 CHARS
GTHSIL:	XCT JFN			; DO RIGHT OPERATION
	SOSG STS
	 MOVEI T2,0		; AFTER MAXLC CHARS FORCE NULL
	CAIL T2,140		; LOWER CASE?
	 TRZ T2,40		; YES, RAISE
	CAIG T2,40		; END ON SPACE OR LESS
	 MOVEI T2,0
	IDPB T2,UNIT
	JUMPG T2,GTHSIL
	BKJFN
	 JFCL
	UMOVEM T1,2
	POPJ P,

GTHSOU:	UMOVE T1,2		; GET POINTER
	MOVE JFN,[XCTBU [IDPB T2,T1]]
	TLNN T1,777777		; IF JFN DO THE JSYS
	 MOVE JFN,[BOUT]
	TLC T1,777777		; CHECK FOR LH -1
	TLCN T1,777777
	 HRLI T1,(<POINT 7,0>)	; USE STANDARD POINTER
GTHSOL:	ILDB T2,UNIT
	XCT JFN			; DO RIGHT OPERATION
	JUMPG T2,GTHSOL		; END ON NULL
	BKJFN
	 JFCL
	UMOVEM T1,2
	POPJ P,

; Flush host

.FLHST::JSYS MENTR
	MOVEI T2,WHEEL!OPR
	TDNN T2,CAPENB
	 JRST MRETN
	 JRST MRTNE1		; ERCAL/ERJMP return
	CALL CVNHST		;CONVERT HOST NUMBER
	CALL HSTDED
	CALL IMSRST
	JRST MRETN

; Convert host number to string

.CVHST::JSYS MENTR
	SETOB HN,DEV		;NO NUMBER NOR NAME
	MOVE T1,T2		;GET HOST NUMBER IN RIGHT PLACE
	CALL GTHNTS		;CONVERT NUMBER TO STRING
	JUMPL HN,MRETN
	MOVE T2,HN
	LDB T1,PNAMEP
	MOVEI T1,HSTNAM-1(T1)
	CALL JFNSS
	JRST SKMRTN

; Get net status

NETGST:	HLRZ UNIT,DEV
	LDB A,PFHST			;RETURN HOST
	CALL CVOHST			;CONVERT TO OLD FORMAT
	UMOVEM A,3
	MOVE A,NETSTS(UNIT)
	MOVE B,FSKT(UNIT)
	UMOVEM B,4
	POPJ P,

; Set net status

NETSST:	POPJ P,



; ASSIGN BUFFERS IN NETWORK AREA

	USE RESPC

ASNTBF:	MOVE A,FORKX		; IS THIS THE NCP FORK?
	CAMN A,NCPFRK##
	 JRST ASNTB3		; YES, GIVE HIM BUFFER IF WE CAN
	MOVE A,NETFRE+2		; NO, GIVE BUFFER ONLY IF ABOVE ASNTHR
	CAMG A,ASNTHR
	 RET			; REFUSE REQUEST -- NOT ENOUGH SPACE

ASNTB3:	CAMLE B,MAXWPM		; BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
	 RET			; REFUSE REQUEST -- TOO BIG
	AOS ASNTBC		; COUNT CALLS
	LOCK NETFRE+1,,SPQ		;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,RESIDENT,SPQ		;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,,SPQ		;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,RESIDENT,SPQ		;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:	AOS FUNNYC		; Count them
	LDB A,PFHST		; GET FOREIGN HOST
	SETZ B,
	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
	LDB B,PLINK		; Get link
	LDB C,PBPBYT
	MOVE D,LSKT(UNIT)
	TRNE D,1		; Send socket?
	 JRST NETOPS
	PUSHJ P,IMPOPL
	SKIPA
NETOPS:	PUSHJ P,IMPOPS
	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)
	JUMPL B,[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 NETHST(UNIT)
	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
	MOVEM A,-1(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>>>>]
	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 T1,OPNX19
		RET]
	JUMPL T1,SKPRET		; ALWAYS OK IF LISTEN
	CALL HSTCK0		; CHECK THE HOST
	 JRST [	MOVEI T1,OPNX20	; NO RESPONSE
		RET]
	JRST SKPRET		; UP AND READY

HSTCK0:	SAVET
	MOVE T2,T1		; Check for fake hosts
	LDB T2,[POINT 8,T1,19]
	CAIL T2,FKHOST
	 RET
	CALL HSTHSH		; Get the host index
	 JRST SKPRET		; No room, try anyway
	SKIPGE HSTSTS(T2)	; Up?
	 JRST SKPRET			; Yes
	PUSH P,T2
	CALL IMSRST		; RESET HIM
	POP P,T2
	MOVEI T3,^D10		; Wait 5 sec
HSTCK1:	MOVEI T1,^D500		; Wait
	DISMS
	SKIPGE HSTSTS(T2)	; Up?
	 JRST SKPRET
	SOJG T3,HSTCK1
	RET

; 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:	SAVET
	SAVEQ
	MOVE 7,[I8CAL,,3]	; COMPLAIN ABOUT LAST CONTROL MESSAGE
	BLT 7,7
	PUSHJ P,IMPERR
	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:	SAVET
	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
	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
	SKIPL TTNETW##(B)	;DON'T SET BITS IF SOCKET NOW GONE.
	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


IFNDEF NETN,<

;SEMI DUMMY MODULE FOR FOONLYS ON TYMNET BUT NOT ON ARPANET
;SO GATEWAY STUFF WORKS AND MAILING PROGRAMS CAN LOOK UP
;HOSTNAMES AND NUMBERS
;SOME STUFF PULLED FROM IMPDV ALSO.  THIS MODULE AND HOSTS ARE
;ALL THAT IS NECESSARY FOR GATEWAY ASSEMBLY

	TITLE NETWRK
	SUBTTL ARPANET - TYMNET GATEWAY STUFF / PHIL FRENCH

IFLE NNVTLN,<
GS NOHOST,2			;GETAB TABLE FOR HOST NUMBER
>

IFG NNVTLN,<
NOHOST::0
NVTPTR::XWD -NNVTLN,NVTLO	; -number of nvt's,,first nvt
>

HN=7				;HOST INDEX

	RESCD

;FOLLOWING IS GETTAB GROUP

NLHOST::LHOSTN			;ARPANET # OF GATEWAY MACHINE


	SWAPCD
; Convert host number to string

.CVHST::JSYS MENTR##
	SETOB HN,DEV		;NO NUMBER NOR NAME
	MOVE T1,T2		;GET HOST NUMBER IN RIGHT PLACE
	CALL CVNHST		;MAKE INTO NEW FORMAT
	CAMN T1,NLHOST		;IS IT US?
	 JRST .CVFOO		;YES...
	MOVE T1,T2		;GET HOST NUMBER IN RIGHT PLACE
	CALL GTHNTS		;CONVERT NUMBER TO STRING
	JUMPL HN,MRETN##
	MOVE T2,HN
	LDB T1,PNAMEP##
	MOVEI T1,HSTNAM##-1(T1)
	CALL JFNSS##
	JRST SKMRTN##
.CVFOO:	MOVEI A,FOOLHN##-1	;USE FOONLEY LOCAL HOST NAME
	CALL JFNSS
	JRST SKMRTN

GTHNTS:	CALL CVNHST			;MAKE IT NEW FORMAT
	CALL HSTHSH			;GET ITS INDEX
	 RET				;NOT THERE
	HRRZ DEV,T2			;INDEX TO DEV
	HRLZ T2,MHOSTS##		;SCAN TABLE FOR THIS INDEX
GTHSLP:	LDB T3,PNMIDX##			;GET INDEX
	CAMN T3,DEV			;THE SAME?
	 JRST [	HRRZ HN,T2		;GET NAME INDEX
		POPJ P,]
	AOBJN T2,GTHSLP			;LOOP
	POPJ P,				;ONLY NUMBER FOUND

HSTHSH::MOVE T2,T1			;DO A HASH
	IDIVI T2,NHOSTS##		;GET INITIAL GUESS, DIV BY PRIME
	EXCH T2,T3			;2/ FIRST GUESS
	IDIVI T3,NHOSTS			;DIV BY PRIME AGAIN
	CAIN T4,0			;GET INCREMENT
	 MOVEI T4,1
	MOVEI T3,NHOSTS			;COUNTER FOR GUESSES
HSTHLP:	SKIPG HOSTNN##(T2)		;NO HOST THERE?
	 POPJ P,			;NO, 2/ WHERE TO PUT IT
	CAMN T1,HOSTNN(T2)		;MATCH?
	 JRST SKPRET##
	ADDI T2,(T4)			;STEP BY INCREMENT
	CAIL T2,NHOSTS			;WRAP AROUND IF NEEDED
	 SUBI T2,NHOSTS
	SOJG T3,HSTHLP			;COUNT DOWN GUESSES
	SETO T2,			;-1 TABLE FULL
	POPJ P,

;CONVERT HOST NUMBER IN AC1 TO NEW FORMAT

CVNHST::CAMN T1,[-1]		;IF -1 USE LOCAL HOST NUMBER
	 MOVE T1,NLHOST
	AND T1,[HSTMSK]		;CUT DOWN TO SIZE
	TLNE T1,37700
	 POPJ P,
	ANDI T1,377
	TRZE T1,100		;SET THE HOST BITS
	 TRO T1,200000
	TRZE T1,200
	 TRO T1,400000
	IOR T1,[12B11]		;ADD NETWORK NUMBER FOR ARPANET
	POPJ P,

;CONVERT HOST NUMBER IN AC1 TO OLD FORMAT

CVOHST::CAMN T1,[-1]		;NO HOST?
	 JRST CVOHS1		;RETURN 777
	TDZE T1,[740077,,177700];CHECK TO SEE IF FITS IN OLD FORMAT
	 MOVEI T1,400		;RETURN 400
	TRZE T1,200000		;SET THE HOST BITS
	 TRO T1,100
	TRZE T1,400000
	 TRO T1,200
CVOHS1:	ANDI T1,777
	POPJ P,

;ROUTINE TO PRODUCE THE OLD HOSTN TABLE

GHOSTN::LDB T4,PNMIDX			;GET INDEX
	MOVE T1,HOSTNN(T4)		;GET THE HOST NUMBER
	CALL CVOHST			;CONVERT TO OLD FORMAT
	MOVE T3,HSTSTS##(T4)		;GET HOST STATUS
	ANDI T3,777000			;GET THE RIGHT BITS
	IORI T1,(T3)			;BUILD LH
	SKIPGE HOSTN##(T2)		;NICKNAME?
	 TRO T1,NICKNA##
	MOVSI T1,(T1)
	LDB T3,PNAMEP			;GET THE NAME POINTER
	HRRI T1,(T3)
	RET

> ;END IFNDEF NETN

	END

