Google
 

Trailing-Edge - PDP-10 Archives - BB-M780B-SM - monitor-sources/netwrk.mac
There are 6 other files named netwrk.mac in the archive. Click here to see a list.
; UPD ID= 42, FARK:<5-WORKING-SOURCES.MONITOR>NETWRK.MAC.2,  11-May-82 16:00:25 by ZIMA
;Edit 2618 - Fix extra nulls from GTHST JSYS.
; UPD ID= 518, SNARK:<5.MONITOR>NETWRK.MAC.17,   7-Mar-82 00:55:28 by PAETZOLD
;More TCO 5.1750 - Fix bad test in NETRAL/NETRAX
; UPD ID= 511, SNARK:<5.MONITOR>NETWRK.MAC.16,   6-Mar-82 21:12:37 by PAETZOLD
;More TCO 5.1750 - Remove NCPON and NCPOFF.  They are in IMPPAR now
; UPD ID= 506, SNARK:<5.MONITOR>NETWRK.MAC.15,   6-Mar-82 20:51:58 by PAETZOLD
;TCO 5.1750 - Reflect that IMPALL unlocks NCPLCK in NETRAL/NETRAX
; UPD ID= 499, SNARK:<5.MONITOR>NETWRK.MAC.14,   5-Mar-82 01:53:44 by PAETZOLD
;TCO 5.1746 - Fix literal in RLNTBF for NETRBG 
; UPD ID= 487, SNARK:<5.MONITOR>NETWRK.MAC.13,  25-Feb-82 20:51:26 by PAETZOLD
;More TCO 5.1739 - Fix bizarre wording in previous edit history
; UPD ID= 486, SNARK:<5.MONITOR>NETWRK.MAC.12,  25-Feb-82 17:00:11 by PAETZOLD
;TCO 5.1739 - Dont set ANBSEC for NETFRE in ASNTBF if it is last buffer 
; on the NETFRE chain.  This prevents NETBAUs.
; UPD ID= 126, SNARK:<5.MONITOR>NETWRK.MAC.11,  27-Aug-81 20:15:32 by PAETZOLD
;change TCO 5.1010X to 5.1473
; UPD ID= 116, SNARK:<5.MONITOR>NETWRK.MAC.10,  23-Aug-81 13:31:10 by PAETZOLD
;TCO 5.1010X - STORE PC OF CALLER TO LCKNCP IN NCPLPC
; UPD ID= 79, SNARK:<5.MONITOR>NETWRK.MAC.9,  27-Jul-81 09:09:51 by PAETZOLD
;UPDATE COPYRIGHT NOTICE
; UPD ID= 1989, SNARK:<5.MONITOR>NETWRK.MAC.8,  14-May-81 11:22:17 by PAETZOLD
;TCO 5.1321 MAKE ARPANET WORK IN RELEASE 5 
;MOVE LINKF DEFINITION TO RIGHT HALF OF NETSTS
;ADD IMPBLK BUGCHK
;CHANGE ORDER OF SEARCHS OF UNV FILES
;CHANGE FLINK TO FNLINK TO AVOID CONFUSION WITH ICCS
;CHANGE NVTDET REFERENCE TO NVTDTT SO WE RETURN
; UPD ID= 1883, SNARK:<5.MONITOR>NETWRK.MAC.7,  24-Apr-81 10:48:29 by LYONS
;fix bug - tips lose network connection
; UPD ID= 967, SNARK:<5.MONITOR>NETWRK.MAC.6,  25-Aug-80 16:28:38 by ENGEL
;TCO 5.1136 - ADD DEVLKK
; UPD ID= 725, SNARK:<5.MONITOR>NETWRK.MAC.5,   2-Jul-80 12:08:48 by LYONS
;Remove NETIEF bughlt as it was possible to get to quite easily
; UPD ID= 724, SNARK:<5.MONITOR>NETWRK.MAC.4,   2-Jul-80 11:55:21 by LYONS
;Fix possible RELRNG buglhts
; UPD ID= 505, SNARK:<5.MONITOR>NETWRK.MAC.3,   4-May-80 00:12:59 by LYONS
; UPD ID= 452, SNARK:<5.MONITOR>NETWRK.MAC.2,  21-Apr-80 16:30:40 by LYONS
;ADD CALL TO ACJ FOR NETWORK LINK OPEN
; UPD ID= 186, SNARK:<4.MONITOR>NETWRK.MAC.55,   4-Jan-80 09:15:18 by R.ACE
;UPDATE COPYRIGHT DATE
;MAKE RLNTBF PRESERVE T1
; UPD ID= 73, SNARK:<4.MONITOR>NETWRK.MAC.54,  30-Nov-79 13:50:27 by ZIMA
;TCO 4.2585 - Make NETRBG into a BUGCHK.
;<4.MONITOR>NETWRK.MAC.53,  8-Oct-79 12:27:33, Edit by LCAMPBELL
; Proper case in HSTINI error messages
;<OSMAN.MON>NETWRK.MAC.1, 10-Sep-79 15:46:03, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>NETWRK.MAC.51, 29-May-79 17:27:39, Edit by LCAMPBELL
; Don't return error code in 1 for CVHST
;<4.MONITOR>NETWRK.MAC.14, 13-Apr-79 20:52:09, EDIT BY JBORCHEK
;FIX BYTE POINTER SETUP IN DMPBUF
;<4.MONITOR>NETWRK.MAC.41, 11-Jan-79 23:13:47, EDIT BY ZIMA
;FIX SPELLING IN BUG MESSAGE
;<4.MONITOR>NETWRK.MAC.40,  9-Jan-79 13:55:11, Edit by LCAMPBELL
; Update copyright notice
;<4.MONITOR>NETWRK.MAC.39, 21-Dec-78 11:22:51, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.38, 13-Dec-78 17:32:59, Edit by LCAMPBELL
; Remove redundant error mnemonics
;<BBN-3A-MONITOR>NETWRK.MAC.10006, 17-Nov-78 19:12:31, EDIT BY JBORCHEK
;ADD HOST TYPES FOR TOPS-20 AND UNIX
;<JBORCHEK>NETWRK.MAC.1, 16-Nov-78 18:26:43, EDIT BY JBORCHEK
;GTHST NOW TAKES JFNS
;<4.MONITOR>NETWRK.MAC.34,  6-Nov-78 16:26:44, EDIT BY JBORCHEK
;GTNCP WILL NOW TAKE .CTTRM AS NVT
;<BBN-3A-MONITOR>NETWRK.MAC.206, 26-Oct-78 19:03:32, EDIT BY JBORCHEK
;CHANGES TO LHOSTN
;<BBN-3A-MONITOR>NETWRK.MAC.202,  2-Oct-78 05:18:36, EDIT BY JBORCHEK
;HSTCHK DID NOT RETURN ERROR CODE ALL THE TIME
;<BBN-3A-MONITOR>NETWRK.MAC.201, 23-Sep-78 18:06:41, EDIT BY JBORCHEK
;SAVE THE EVENT AND OLD STATE AT DOFSM
;CLEAR HOST TABLES COMPLETELY AT HSTINI
;<4.MONITOR>NETWRK.MAC.23,  2-Sep-78 17:45:32, EDIT BY JBORCHEK
;<4.MONITOR>NETWRK.MAC.3,  1-Sep-78 18:43:19, EDIT BY JBORCHEK
;FIX MORE BUGS IN IMPHRT AND HSTSTS
;<4.MONITOR>NETWRK.MAC.21,  1-Sep-78 15:09:50, EDIT BY JBORCHEK
;FIX BUGS IN IMPHRT AND HSTSTS SIMULATIONS
;<4.MONITOR>NETWRK.MAC.20,  1-Sep-78 13:03:47, EDIT BY JBORCHEK
;LOAD JFN INTO T1 BEFORE RLJFN AT HSTINI
;<4.MONITOR>NETWRK.MAC.19,  1-Sep-78 10:45:51, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.18, 30-Aug-78 14:14:21, Edit by LCAMPBELL
; Change ERCALs to CALLs after GTHST and GTNCP, and make
;  GDSTS return old-style host number
;<4.MONITOR>NETWRK.MAC.17, 29-Aug-78 14:37:55, Edit by LCAMPBELL
;<4.MONITOR>NETWRK.MAC.16, 28-Aug-78 19:21:48, Edit by LCAMPBELL
; Simulate IMPHRT and HSTSTS GETABs so old utilites still work
;<4.MONITOR>NETWRK.MAC.15, 26-Aug-78 21:23:47, EDIT BY JBORCHEK
;ANFHS MUST BE 36 BITS WIDE
;<3A-JBORCHEK>NETWRK.MAC.3, 24-Aug-78 19:55:30, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.21, 21-Aug-78 13:20:07, EDIT BY JBORCHEK
;FIX BUGS IN GTHST
;<3-CLEMENTS>NETWRK.MAC.20, 19-Aug-78 00:53:34, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.16, 18-Aug-78 18:44:25, EDIT BY JBORCHEK
;ADD NEW GTHST FUNCTIONS
;<3-CLEMENTS>NETWRK.MAC.12, 16-Aug-78 16:18:01, EDIT BY CLEMENTS
; Add STHSTJ routine
;<3-CLEMENTS>NETWRK.MAC.11, 16-Aug-78 15:54:21, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.10, 16-Aug-78 15:38:20, EDIT BY CLEMENTS
; Make MAXBPM and MAXWPM back into constants, from literals
;<JBORCHEK>NETWRK.MAC.2, 16-Aug-78 13:38:23, EDIT BY JBORCHEK
;<4-JBORCHEK>NETWRK.MAC.2, 14-Aug-78 12:54:05, EDIT BY JBORCHEK
;<3-CLEMENTS>NETWRK.MAC.6, 11-Aug-78 23:44:53, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.5, 11-Aug-78 22:56:41, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.4, 11-Aug-78 16:20:42, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.3, 11-Aug-78 16:18:45, EDIT BY CLEMENTS
;<3-CLEMENTS>NETWRK.MAC.2, 11-Aug-78 15:09:27, EDIT BY CLEMENTS
; Remove use of local IMPLT bit
;<4.MONITOR>NETWRK.MAC.10,  7-Jul-78 01:15:43, Edit by JBORCHEK
;ADD GTNCP JSYS
;<4.MONITOR>NETWRK.NEW.7,  6-Jul-78 08:01:14, Edit by JBORCHEK
;ADD GTHST JSYS
;<4.MONITOR>NETWRK.MAC.3, 26-Jun-78 16:43:46, Edit by JBORCHEK
;<4.MONITOR>NETWRK.MAC.1, 26-Jun-78 02:48:39, Edit by JBORCHEK
;ADD HASH LOOKUP OF HOSTS
;<4.MONITOR>NETWRK.NEW.11, 18-Jun-78 14:54:55, Edit by JBORCHEK
;MORE NEW HOST STUFF
;<4.MONITOR>NETWRK.MAC.8,  9-Jun-78 23:01:08, Edit by JBORCHEK
;USE IMPPAR DEFINITIONS
;<4.MONITOR>NETWRK.MAC.2,  6-Jun-78 01:32:06, Edit by JBORCHEK
;ADD SEARCH OF IMPPAR
;<3A.MONITOR>NETWRK.MAC.6, 28-May-78 01:48:11, Edit by BORCHEK
;REMOVE OPENING NET IN 7 BIT MODE
;<3A-MONITOR>NETWRK.MAC.4, 22-Apr-78 20:37:51, Edit by BORCHEK
;SPEED UP NETWORK FTP
;<HACKS>NETWRK.MAC.8,  2-Apr-78 02:27:39, EDIT BY JBORCHEK
;USE AN ADJBP AT DMPBUF
;<3A.MONITOR>NETWRK.MAC.2, 19-Mar-78 13:07:41, Edit by BORCHEK
;GET DIR # FROM JSBSDN IN NETVER
;ONLY 8, 32, 36 BIT CONNECTIONS ALLOWED
;<4.MONITOR>NETWRK.MAC.2, 29-Jan-78 16:59:49, Edit by BORCHEK
;FIX DIR NET:<*> FROM HANGING JOB. CHECK AT NETSET FOR <*>

;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1976,1977,1978,1979,1980,1981 Digital Equipment Corporation
; Maynard, Mass.

	SEARCH IMPPAR,PROLOG,MACSYM,MONSYM
	TTITLE	NETWRK

; Local accumulators

DEFAC (UNIT,Q1)			;PSEUDO-UNIT NUMBER
DEFAC (IOS,Q2)			;STATUS FLAGS (FROM NETSTS(UNIT))
DEFAC (HN,Q3)
DEFAC (STS,P1)
DEFAC (JFN,P2)
DEFAC (PTR,P3)
DEFAC (DEV,P4)
DEFAC (F1,P5)

;PARAMETERS

NLNKBW==<LLINK+^D35>/^D36	;LENGTH OF LINK BITTABLE

; NCP DATA CLUSTER

DEFSTR ANFHS,NETHST,35,36	;FOREIGN HOST
DEFSTR ANLNK,NETAWD,8,9		;LINK
DEFSTR ANCLKS,NETAWD,23,6	;TIME-OUT COUNTDOWN
DEFSTR ANINPI,NETFRK,5,6	;INS/INR PSI CHAN
DEFSTR ANFSPI,NETFRK,17,6	;FSM PSI CHAN
DEFSTR ANFSM,NETSTS,3,4		;FSM STATE
DEFSTR ANBSIZ,NETSTS,17,6	;BIT STREAM BYTE SIZE
DEFSTR ANPVST,NETSTS,35,16	;PREVIOUS 4 STATES
DEFSTR HSTIDX,HOSTN,35,18	;INDEX TO STATUS TABLE
DEFSTR HSTNMP,HOSTN,17,16	;POINTER TO NAME STRING

MSGALL==2			;DESIRED MESSAGE ALLOCATION LEVEL

;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

;FLAGS IN RIGHT HALF OF NETSTS

FLG(LINKF,R,IOS,400000)		;LINK TABLE INDEX VALID FLAG
				;ONLY FREE BIT LEFT IN NETSTS IS B19
; 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

	SWAPCD

NETDTB::DTBDSP (NETSET)		;DIRECTORY SETUP
	DTBDSP (NETNAM)		;NAME LOOKUP
	DTBDSP (NETEXT)		;EXTENSION LOOKUP
	DTBDSP (NETVER)		;VERSION LOOKUP
	DTBBAD (DESX9)		;PROTECTION INSERT
	DTBBAD (DESX9)		;ACCOUNT INSERT
	DTBBAD (DESX9)		;STATUS INSERT
	DTBDSP (NETOPN)		;OPEN
	DTBDSP (NETSQI)		;BYTE INPUT
	DTBDSP (NETSQO)		;BYTE OUTPUT
	DTBDSP (NETCLZ)		;CLOSE
	DTBBAD (DESX9)		;RENAME
	DTBBAD (DESX9)		;DELETE
	DTBBAD (DESX9)		;DUMP
	DTBBAD (DESX9)	
	DTBBAD (DESX9)		;MOUNT
	DTBBAD (DESX9)		;DISMOUNT
	DTBBAD (DESX9)		;INITIALIZE
	DTBDSP (NETMTP)		;MTOPR
	DTBDSP (NETGST)		;GET STATUS
	DTBDSP (NETSST)		;SET STATUS
	DTBSKP			;RECORD OUT
	DTBDSP (RFTADN)		;READ TAD
	DTBDSP (SFTADN)		;SET TAD
	DTBDSP (BIOINP)		;SET JFN FOR INPUT
	DTBDSP (BIOOUT)		;SET JFN FOR OUTPUT
	DTBBAD (GJFX49)		;CHECK ATTRIBUTE

	DTBLEN==:.-NETDTB	;GLOBAL LENGTH OF DISPATCH TABLE

; Network lock and unlock

LCKNCP::AOS NCPLCN		; COUNT CALLS TO THIS ROUTINE
	NOINT
	LOCK NCPLCK,<JRST LCKNC1>
LCKNC2:				; HERE WHEN WE GOT THE LOCK
	PUSH P,T1		; SAVE AN AC
	MOVE T1,FORKX		; GET OUR FORK NUMBER
	MOVEM T1,NCPLLK		; SAVE THE FORK NUMBER
	MOVE T1,-1(P)		; GET OUT RETURN PC
	MOVEM T1,NCPLPC		; SAVE THE PC OF THE LAST LOCKER
	POP P,T1		; RESTORE THE SAVED AC
	RET			; RETURN TO CALLER

LCKNC1: AOS NCPLFC		; COUNT FAILURES
	PUSH P,T1
	MOVEI T1,NCPLKT
	MDISMS
	POP P,T1
	JRST LCKNC2

	RESCD

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

	SWAPCD

ULKNCP::UNLOCK NCPLCK
	OKINT
	RET
; Initialize network stuff

NETINI::SE1CAL			;ENTER SECTION 1 FOR THIS ROUTINE
	SETZM NETSTS
	MOVE T1,[NETSTS,,NETSTS+1]
	BLT T1,NETSTS+NSKT-1
	SETZM NETCNC
	SETZM FUNNYC
	MOVE T1,[ANBSEC,,NTBUFS]
	MOVEM T1,NETFRE		;INITIAL FREE LIST
	MOVEI T2,NNTBFS		 ; SIZE OF BUFFER AREA
	IDIV T2,MAXWPM		;IN CASE NOT AN EVEN MULTIPLE
	IMUL T2,MAXWPM		; ..
	MOVEM T2,NETFRE+2	;FREE SPACE LEFT IN BUFFER AREA
	MOVEM T1,NETFRE+3	;START OF BUFFER AREA
	ADDI T1,-1(T2)		;END OF BUFFER AREA
	MOVEM T1,NETFRE+4

;INITIALIZE FREE LIST INTO ITEMS OF MAXWPM EACH

	MOVEI T2,NNTBFS		;SIZE OF BUFFER REGION
	IDIV T2,MAXWPM		;NUMBER OF BUFFERS IN REGION
	MOVE T3,[ANBSEC,,NTBUFS] ;SET UP C TO POINT TO NET BUFFERS
NETIN2:	MOVE T1,T3		;COPY C INTO A
	ADD T3,MAXWPM		;RH(T3) POINTS TO NEXT BUFFER
	HRLOM T3,0(T1)		;STORE THAT IN LEFT HALF IN CURRENT BUFFER
	SOJG T2,NETIN2		;DO ANOTHER
	HRRZS 0(T1)		;LAST ITEM POINTER IS 0

	SETOM NETFRE+1		;NETWORK BUFFER LOCK
	SETOM NCPLCK
	MOVE T1,DBUGSW		;IN SYSTEM DEBUG MODE?
	CAIGE T1,2		;IF SO, DON'T TURN ON NET.
	SETOM NETON		;NET ON
	MOVE T1,MAXWPM		;GET SIZE OF EACH BUFFER
	IMULI T1,^D16		;TIMES RESERVE
	MOVEM T1,ASNTHR		;SETS BUFFER SPACE LOW THRESHOLD
	RET
; Prepare to lookup network names

NETSET:	TQNE <STEPF>		;WANT TO STEP?
	RETBAD (GJFX17)		;YES. CAN'T DO IT
	NOINT			;PREVENT INTS
	JRST SK2RET		;AND SAY IT IS SET

; Name lookup routine

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

NAMBAD:	MOVEI T1,GJFX18
	JRST ERRET		; Error return

ERRET:	OKINT
	RET

; Extension lookup routine

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

EXTBAD:	MOVEI T1,GJFX19
	JRST ERRET

; Version lookup

NETVER:	HRRES T1		; Extend sign
	CAIL T1,^D100000	; If geq 100000
	 JRST NETVR1		; Use job related socket
	HLLZ T1,JSBSDN		; Get structure
	LSH T1,-6
	ADD T1,JSBSDN		; Add in directory
	ANDI T1,177777		; Clear junk
NETVR1:	TQNE <UNLKF>
	RETSKP
	OKINT
	RETSKP
; 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
		RETSKP]
	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,R			;NO - MEANS ERROR
	DPB T2,T4			;END HOST WITH NUL
	CALL HSTLUK			;LOOKUP HOST
	MOVEI T3,"-"			;RESTORE THE -
	DPB T3,T1
	JUMPG T2,R			;NO HOST FOUND
	MOVEI T3,10			;GET OCTAL SOCKET NUMBER
	NIN
	 RET
	MOVE T1,T4
	RETSKP
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
	RET

HSTLKI:	HRLZ T2,MHOSTS			;SCAN THE TABLE

HSTLK0:	MOVE T1,UNIT			;DO NAME POINTER
	LOAD T3,HSTNMP,(T2)
	ADD T3,[POINT 7,HSTNAM]

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

	RESCD

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?
	 RET				;NO, 2/ WHERE TO PUT IT
	CAMN T1,HOSTNN(T2)		;MATCH?
	 RETSKP
	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
	RET

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

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

	SWAPCD
; Decode name string
; Called both at gtjfn and openf to decode name string into
; Local socket number

NAMDEC:	MOVEI T3,10		; Perhaps this should be decimal?
	NIN			; Convert to a number
	JRST NAMDE1		; Failure: no number there
	LDB T3,T1		; Get terminator
	CAIE T3,"#"		; If not number sign
	JRST NAMDE2		; Then ordinary
	MOVE T3,CAPMSK		; Else system socket
	TRNN T3,SC%WHL!SC%OPR!SC%NAS;MUST BE WHEEL, OPR, OR
				; HAVE ABSOLUTE SOCKET CAPABILITY
	RET			; Else fail
	ILDB T3,T1		; Get next ch
	TDZA T1,T1		; Zero for high 17 bits
NAMDE2:	HRRZ T1,FILVER(JFN)	; Use filver for high 17 bits
	JUMPN T3,R		; String too long
	SKIPE T1
	 ANDI T2,77777		; If not system socket, retain 15 bits
	TRZ T2,1		; Clear gender
	ROT T1,^D15
	IOR T1,T2
	RETSKP

NAMDE1:	MOVE T2,JFN		; Default to jfn
	IDIVI T2,MLJFN		; Get the jfn
	LSH T2,1		; Jfn will end up lsh'ed 1
	LDB T3,T1
	JRST NAMDE2

NETDED::MOVE T1,NETSTS(UNIT)	; GET STATUS
	TXNE T1,DEDF+EOTF	; HOST DEAD OR DONE
	 RET
	RETSKP

NETHLK::LOAD T1,ANFHS,(UNIT)	; HOST
	LOAD T2,ANLNK,(UNIT)	; LINK
	RET
; Open network file

NETOPN:	TQNE <XCTF,RNDF>
	JRST ILLACC		; Illegal to access in append or xct
	TQNE <READF>
	TQNN <WRTF>
	TQNN <READF,WRTF>
	JRST ILLACC		; Must be only one of read or write
	GTOKM (.GOANA,,[RETERR ()]) ; Ask ACJ for its blessing on the open
	LDB T1,PBYTSZ
	CAIN T1,^D8		; Check for 8 32 or 36 bit bytes
	 CAIA
	CAIN T1,^D32
	 CAIA
	CAIN T1,^D36
	 CAIA
	JRST [	MOVEI T1,SFBSX2
		RET]		; Bad byte size
	HLRZ T1,FILNEN(JFN)
	HRLI T1,(<POINT 7,0,35>)
	CALL NAMDEC		; Decode name
	JRST ILLACC		; Can only happen if wheel lost
	TQNE <WRTF>
	TROA T1,1		; If writing set gender bit for local
	TRZ T1,1		; Else clear it
	PUSH P,T1		; Save for later
	HRRZ T1,FILNEN(JFN)
	HRLI T1,(<POINT 7,0,35>)
	CALL EXTDEC		; Decode extension
	 JRST [	POP P,T1	; Return T1 to its place
		RET]		; And return.  We can go thru here if the
				; host went away between the GTJFN and OPENF.
	TQNE <READF>
	TROA T2,1		; If reading set gender bit for forskt
	TRZ T2,1		; Else clear
	POP P,T3
	LDB T4,PBYTSZ		; Get file byte size
	JUMPL T1,OPNLSN		; No foreign socket, do a listen
	CALL CONNECT		; Connect
	 RET
	TQZ <WNDF>
NETOP1:	HRLM UNIT,FILSKT(JFN)	;REMEMBER UNIT NUMBER
	SETZ IOS,		; Clear status bits
	LDB T1,[POINT 4,STS,35]
	CAIE T1,5		; In modes 5
	CAIN T1,7		; Or 7
	TQO <BFSND>		; DO BUFFERED TRANSMISSION
	IORB IOS,NETSTS(UNIT)	; Set it in status word
	MOVEI T1,^D36
	LDB T2,PBYTSZ
	IDIV T1,T2		; Get bytes per WORD
	XCTBU [LDB T3,[POINT 6,2,17]];GET DESIRED SIZE OF BUFFER
	IMUL T1,T3		; DESIRED BYTES
	HRLM T1,NETBUF(UNIT)	; Gives bytes per buffer
	SETZM FILBYN(JFN)	; About to reference byte 0 of buffer
	SETZM FILOFN(JFN)	; NEXT BYTE TO XMIT = 0
	TQO <SIZF>		; CANNOT CHANGE BYTE SIZE
	TQOE <WNDF>		; NO BUFFER YET. ALSO IF LISTEN
	RETSKP			; Return immediately
	LDB T1,[POINT 4,STS,35]
	CAIE T1,6		; Also in modes 6
	CAIN T1,7		; And 7
	RETSKP			; Return immediately
	LOAD T1,ANFSM,(UNIT)	; No. get current state
	CAIN T1,RFCS		; Will usually be rfcs
	CALL WATNOT		; If so, wait for it to not be
	LOAD T1,ANFSM,(UNIT)	; Get state
	MOVE IOS,NETSTS(UNIT)
	TQNN <EOTF>		; IF LEFT OPND
	CAIN T1,OPND		; OR STILL OPENED
	 RETSKP			; THEN SUCCEED
	MOVX T2,PROGF
	ANDCAM T2,NETSTS(UNIT)	; Program not watching
	CALL NETCLD		; FSM close
	TQNE <ERRB>		; ERRB REMEMBERS BAD BYTE SIZE
	SKIPA T1,[OPNX22]	; MAKE THAT THE ERROR CODE
	MOVEI T1,OPNX21		; ELSE IT WAS REJECTED
	RET			; And give bad return

OPNLSN:	CALL LISTEN
	 RET			; Can't listen
	TQO <WNDF>		; TO REMEMBER THAT THIS WAS A LISTEN
	JRST NETOP1		; First bin/out is accept

ILLACC:	MOVEI T1,OPNX14
	RET
; Wait for fsm to leave state given in a

WATNOT:	HRLI T1,NOTTST		; TEST ROUTINE ADDRESS
WATNO1:	MOVE T2,UNIT		; COMPUTE SCHEDULER TEST ARGUMENT
	ROT T2,-9
	MOVSS T1
	IOR T1,T2
	SKIPE INSKED
	BUG(NETWNS)
	MDISMS
	RET

; Wait for fsm to enter a particular state

WATFOR:	HRLI T1,WATTST
	JRST WATNO1

	RESCD

NOTTST:	LDB T2,[POINT 9,T1,26]	; EXTRACT UNIT
	ANDI T1,777		; AND STATE TO TEST AGAINST
	LOAD T3,ANFSM,(T2)	; GET CURRENT STA(E
	CAME T1,T3		; IS IT THE SAME
	JRST 1(T4)		; NO, READY TO GO
	JRST WATTS1		; YES, MAKE OTHER TESTS

; SCHEDULER TEST WAITING FOR CONNECTION TO GET TO A STATE

WATTST:	LDB T2,[POINT 9,T1,26]	; EXTRACT UNIT
	ANDI T1,777		; AND STATE
	LOAD T3,ANFSM,(T2)	; GET CURRENT STATE
	CAMN T3,T1		; SAME?
	JRST 1(T4)		; YES, READY TO GO
WATTS1:	MOVE T3,FKINT(HN)	; Look for deferred interrupts
	TLNN T3,(1B1)
	JRST 0(T4)		; None. return no skip
	SETZ T3,
	STOR T3,ANCLKS,(T2)	; Set clock to zero to hasten time-out
	JRST 0(T4)

;SCHEDULER TEST FOR BIT ALLOCATION

;CONNECTION NUMBER IN T1

BALTST:	LOAD T2,ANBSIZ,(T1)	;GET BIT STREAM BYTE SIZE
	LOAD T3,LTIDX,(T1)	;GET LINK TABLE INDEX
	SKIPN IMPLT4(T3)	;SKIP IF NEITHER MSG ALLOC OR BUFFER
	 JRST BALTS1
	CAMG T2,NETBAL(T1)	;MSG OK, HOW ABOUT BITS?
	 JRST 1(T4)
BALTS1:	MOVE T3,NETSTS(T1)	;GET STATUS INFO
	TXNE T3,DEDF+EOTF	;ALLOC BAD. BUT IF DEAD..STILL OK
	 JRST 1(T4)		;TAKE SKIP RETURN
	JRST 0(T4)		;RETURN
	SWAPCD

; Close network file

NETCLZ:	HLRZ UNIT,FILSKT(JFN)
	TQNN <WNDF>		; IF NO BUFFER EVER ASSIGNED
	TQNN <WRTF>		; OR IF READING
	JRST NETCL1		; Then skip the following
	CALL DMPBUF		; Dump last buffer
	 JRST NETCLW		; NOT ALL SENT. GO WAIT.
NETCL1:
   REPEAT 0,<
	TQNE <ERRF>		; ANY FINAL ERRORS
	 JRST [	MOVEI T1,IOX5
		RET]		; DON'T CLOSE IF ANY UN-HANDLED ERRORS
   >
	HRROS FILSKT(JFN)	; IN CASE JFN RE-OPENED, SET UNIT TO -1
	SETOM NETFRK(UNIT)
	HRRZ T2,NETBUF(UNIT)	;GET BUFFER ADDRESS
	CAIGE T2,1000		;IS THERE A BUFFER
	 JRST NETCL3		;NO BUFFER OF NVT
	MOVEI T1,JSBFRE		;THIS IS ALSO THE BLOCK TO FREE
	CALL RELFRE		;YES. RELEASE IT
NETCL3:	CALL NETCLD		; FSM close
	UMOVE T1,1
	TDNN T1,[1,,400000]
	TLNN T1,(1B1)
	 JRST NETCL2		; Return immediately if no bit 1
	LOAD T2,ANFSM,(UNIT)
	MOVEI T1,FREE
	CAIE T2,FREE
	CALL WATFOR
NETCL2:	MOVX T1,PROGF
	ANDCAM T1,NETSTS(UNIT)	; No program wants this any more
	RETSKP

NETCLD:	TQNN <WRTF>		; IF NOT SENDING
	SKIPA T1,[CLZR]		; THEN DO CLZR
	MOVEI T1,CLZS		; ELSE do clzs
	CALLRET DOFSM

NETCLW:	MOVEI T2,^D60		; 5 MINUTES OF TICKS
	STOR T2,ANCLKS,(UNIT)
	MOVX IOS,CLZF
	IORB IOS,NETSTS(UNIT)
	MDISMS
	JRST NETCLZ		; AND GO TRY AGAIN

; Close nvt

NVTCLZ::MOVE T1,LSKT(UNIT)
	TRNN T1,1
	SKIPA T1,[CLZR]
	MOVEI T1,CLZS
	CALLRET DOFSM
; Network mtopr routines

NETMTP:	TQNN <OPNF>		;CHECK TO SEE IF OPENED
	RETBAD (CLSX1)		;NOT OPENED
	HLRZ UNIT,FILSKT(JFN)
	MOVE IOS,NETSTS(UNIT)
	CAIG T2,26
	CAIGE T2,20
	 RETSKP			; ANYTHING ELSE IS A NOP
	JRST .+1-20(T2)
	JRST NETACP
	JRST NETDMP
	JRST SNDINT
	JRST ABTCON
	JRST NETINT
	JRST NETRDY
	JRST NETFAL

NETACP:	LOAD T2,ANFSM,(UNIT)
	MOVEI T1,ACPT
	CAIN T2,RFCR
	 CALL DOFSM
	RETSKP

NETDMP:	TQNE <BFSND>		;SENDING BY BUFFER?
	TQNN <WRTF>		;AND A SEND CONNECTION?
	 RETSKP			;NO, A NOP
	TQNE <WNDF>		;YES. BUFFER SET UP?
	 RETSKP			;NO, NOTHING TO SEND
	CALL DMPBUF
	 JRST WATXXX
	RETSKP

SNDINT:	LOAD T1,ANFHS,(UNIT)
	LOAD T2,ANLNK,(UNIT)
	MOVE T4,LSKT(UNIT)
	TRNE T4,1
	SKIPA T4,[IMPINS]
	MOVEI T4,IMPINR
	NCPOFF
	LOAD T3,ANFSM,(UNIT)
	CAIN T3,OPND
	CALL (T4)
	NCPON
	RETSKP
; WAIT FOR READY TO SEND AT LEAST ONE BYTE

ABTCON:	MOVE T1,CAPENB
	TXNN T1,SC%NWZ
	 JRST [	MOVEI T1,NTWZX1	; NOT A NET WIZARD. FAIL.
		RET]
	CALL SKTDWN
	RETSKP

NETRDY:	TQNN <WRTF>		; RECEIVE OR SEND?
	 JRST NETRD1		; RECEIVE. SEND ALLOCATES OUT
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL PKCHK		; GET BYTES THAT CAN BE SENT
	JUMPE T2,[CALL WATBAL	; COMPUTE ACTIVATION TEST
		JRST WATXXX]	; AND WAIT
	CALL PKULCK
	RETSKP

NETRD1:	TQNN <WNDF>		;HAS ALLOCATION ALREADY BEEN SENT?
	RETSKP
	CALL FIRSTI		;NO. SEND IT OUT.
	RET			;PASS ON DOWN BLOCK
	RETSKP

NETINT:	UMOVE T2,3
	HRR T2,FORKX		; REMEMBER THIS FORK, AND USER'S
	MOVEM T2,NETFRK(UNIT)	;  REQUESTED PI CHANNELS
	RETSKP

NETFAL:	TQNE <WNDF,WRTF>	; IF READ AND FIRSTI NOT DONE
	RETSKP
	CALL FIRSTI		;  SET UP BUFFERS AND SEND ALLOCATE
	RET			;PASS ON DOWN BLOCK
	RETSKP

; HERE WHEN A FORK IS KILLED, TO FORGET THE PSI INFO

NETKFK::SAVEQ
	MOVSI UNIT,-NSKT
NETKF1:	HRRE IOS,NETFRK(UNIT)
	CAMN IOS,FORKX
	 SETOM NETFRK(UNIT)
	AOBJN UNIT,NETKF1
	RET
; HERE FROM LOGOUT CODE TO RELEASE JOB-WIDE NET RESOURCES

NETLGO::SETO T1,0		;RELEASE ALL SPECIAL QUEUES
	RELSQ
	RET			; THAT'S ALL

; SKIP IF NET INPUT BUFFER EMPTY

NTSIBE::HRRZ T1,DEV		;SEE IF NETWORK JFN
	CAIE T1,NETDTB
	 RETSKP
	HLRZ UNIT,FILSKT(JFN)
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	MOVSI T2,777777
	TDNN T2,IMPLT4(T1)
	TDNE T2,IMPLT3(T1)
	 RET
	RETSKP
; Network file sequential byte input

NETSQI:	HLRZ UNIT,FILSKT(JFN)
	MOVE IOS,NETSTS(UNIT)
	TQNN <WNDF>
	JRST NTSQI1
	CALL FIRSTI		; Wait for listen set up buffers etc.
	RET			;PASS ON DOWN BLOCK
NTSQI1:	SOSL FILCNT(JFN)
	JRST NTSQI2
	CALL LODBUF		; Get another bufferful
	RET			;PASS ON DOWN BLOCK
NTSQI2:	TQNE <EOFF>
	RET
	ILDB T1,FILBYT(JFN)
	AOS FILBYN(JFN)
	RET

LODBUF:	MOVX IOS,ERRB
	TDNE IOS,NETSTS(UNIT)
	TQO <ERRF>
	ANDCAB IOS,NETSTS(UNIT)
	MOVE T3,NETBUF(UNIT)	;GET ADDRESS OF BUFFER
	HLL T3,FILBYT(JFN)	;GET THE BYTE SIZE
	TLZ T3,770000		;SET AT END OF FIRST WORD
	TLNN T3,700		;36 BIT MODE?
	 TLO T3,40000		;NO GET BYTE OFFSET RIGHT
	MOVEM T3,FILBYT(JFN)	;SAVE BYTE POINTER
	HLRZ T4,NETBUF(UNIT)	;GET BUFFER SIZE
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL UPMSG		;UNPACK MESSAGE(S) INTO BUFFER
	 JRST [MOVX IOS,EOTF	;GET END OF FILE FLAG
		TDNE IOS,NETSTS(UNIT) ;IS IT SET FOR THIS CONNECTION
		 JRST [ TQO <EOFF> ;YES SET FOR THIS JFN
			RETSKP]	;AND RETURN
		JRST WATXXX]	;BACK OUT AND WAIT THEN START OVER
	HLRZ T2,NETBUF(UNIT)	;GET BUFFER SIZE IN BYTES
	SUB T2,T4		;BYTES LOADED
	MOVEM T2,FILCNT(JFN)	;SET BYTES IN BUFFER FOR THIS JFN
	ADDM T2,FILLEN(JFN)	;UPDATE NUMBER OF BYTES ON THIS CONN.
	LOAD T4,ANBSIZ,(UNIT)	;GET BYTE SIZE
	IMUL T4,T2		;BITS RECEIVED
	ADDM T4,NETBTC(UNIT)	;KEEP COUNT OF BITS RECEIVED
	MOVN T2,T4		;GET NEGATIVE OF BITS RECIEVED
	ADDM T2,NETBAL(UNIT)	;DEBIT ALLOCATION FOR MESSAGE RECEIVED
	CALL NETRAL		;RE-ALLOCATE IF NEEDED
	SOSGE FILCNT(JFN)	;DID WE GET ANYTHING?
	JRST LODBUF		;NO BYTES GO TRY AGAIN
	RETSKP

NETRAL::NCPOFF			; PREVENT CONFUSION
	MOVE IOS,NETSTS(UNIT)
	TQNE <EOTF,DEDF>
	 JRST NETRAX		; DON'T BOTHER IF DEAD OR DONE
	STKVAR<NETRBA,NETRMA>
	MOVE T4,NETDAL(UNIT)	; GET DESIRED BIT ALLOCATION
	MOVE T2,T4
	ASH T2,-1		; HALVE
	MOVEM T2,NETRBA
	MOVEI T3,MSGALL		; DESIRED LEVEL OF MSG ALLOC
	MOVE T2,T3
	ASH T2,-1		; HALVE
	MOVEM T2,NETRMA
	LOAD T2,LTIDX,(UNIT)	; GET LINK TABLE INDEX
	HRRZ T2,IMPLT4(T2)	; OUTSTANDING MSG ALLOC
	SUB T3,T2		; NEEDED INCREMENT
	SUB T4,NETBAL(UNIT)	; NEEDED INCREMENT
	LOAD T1,ANFHS,(UNIT)
	LOAD T2,ANLNK,(UNIT)
	CAMGE T4,NETRBA		; IF GREATER THAN HALF
	CAML T3,NETRMA		; FOR EITHER ONE
	 JRST NETRX2		; THEN SEND AN ALLOCATE
NETRAX:	NCPON			; turn network back on
	RET
NETRX2:	CALL IMPALL		; SEND ALLOCATE MESSAGE
	RET			; IMPALL NLOCKED NCPLCK FOR US

FIRSTI:	CALL FRSTIO		; SET UP BUFFER
	RET			;PASS ON DOWN BLOCK
	JUMPG T2,FRSTI1		; BUFFER SPECIFIED. USE FOR ALLOCATION
	PUSH P,T1
	MOVE T1,MAXBPM		; MAXIMUM BITS IN A MESSAGE
	LOAD T2,ANBSIZ,(UNIT)	; CONNECTION BYTE SIZE
	IDIV T1,T2		; BYTES
	IMULI T1,MSGALL		; TIMES MESSAGE ALLOCATION
	POP P,T2		; THAT PLUS FILE BUFFER BYTES
	ADD T2,T1		; IS WHAT TO USE
FRSTI1:	LOAD T4,ANBSIZ,(UNIT)	; GET BYTES SIZE
	IMUL T4,T2		; BITS IN BUFFERS
	MOVEM T4,NETDAL(UNIT)	; SAVE DESIRED LEVEL
	CALL NETRAL		; SEND ALLOCATE AS NEEDED
	RETSKP
WATLSN:	LOAD T1,ANFSM,(UNIT)	; Get state of this connection
	CAIN T1,OPND
	 RETSKP
	CAIN T1,RFCR
	 JRST [	MOVEI T1,ACPT
		CALL DOFSM
		RETSKP]
	CAIN T1,RFCS		; If still waiting for rfc
	 JRST WATLS1		; Continue waiting
	CAIE T1,LSNG
	 JRST [	MOVX IOS,EOTF
		TDNE IOS,NETSTS(UNIT)
		 RETSKP		; Null file sent
		MOVX IOS,ERRB!EOTF ; Connection never actually opened
		IORB IOS,NETSTS(UNIT)
		RETSKP]


WATLS1:	MOVE T2,UNIT		;GET UNIT
	ROT T2,-9		;PUT IN BITS 0-8
	HRLI T1,NOTTST		;TEST ROUTINE ADDRESS,,STATE 
	MOVSS T1		;STATE TO WAIT FOR,,TEST ROUTINE ADDRESS
	IOR T1,T2		;UNIT/STATE,,TEST ROUTINE
	TQO <BLKF>		;BLOCK FOR STATE CHANGE
	RET



WATXXX:	TQO <BLKF>		;TELL LOWER LEVEL TO BLOCK
	RET
; Network file sequential byte output

NETSQO:	HLRZ UNIT,FILSKT(JFN)
	MOVE IOS,NETSTS(UNIT)
	TQNE <DEDF,ERRB>
	 TQO <ERRF>
	TQNE <DEDF,EOTF>
	 RET
	PUSH P,T1
	TQNN <WNDF>
	JRST NTSQO4
	CALL FIRSTO
	 JRST [POP P,0(P)	;CLEAN UP STACK
		RET]		;PASS ON DOWN BLOCK
NTSQO4:	TQNE <BFSND>		; IMMEDIATE SEND?
	 JRST NTSQO1		; No
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL PKCHK		; HOW MANY BYTES CAN WE SEND?
	POP P,T3
	JUMPE T2,NTSQO3		; NOT ENOUGH
	CALL PKBYT
	 TRN
	LOAD T1,ANBSIZ,(UNIT)
	ADDM T1,NETBTC(UNIT)
	MOVNS T1
	ADDM T1,NETBAL(UNIT)
	MOVEI T1,^D24
	STOR T1,ANCLKS,(UNIT)	; RESET CLOCK TO TWO MINUTES
	RET

NTSQO1:	SOSL FILCNT(JFN)
	 JRST NTSQO2
	CALL DMPBUF
	 JRST [POP P,T3		;CLEAN UP STACK
		JRST WATXXX]	; Can't dump now, wait
NTSQO2:	AOS FILBYN(JFN)
	POP P,T1
	IDPB T1,FILBYT(JFN)
	RET

NTSQO3:	CALL WATBAL		;WAIT FOR BITS AND A MSG TO BE ALLOCATED
	JRST WATXXX		; ..
DMPBUF:	MOVX IOS,ERRB		;GET ERROR HAS OCCURED FLAG
	TDNE IOS,NETSTS(UNIT)	;HAS ERROR OCCURED?
	 TQO <ERRF>		;YES.  INDICATE IT FOR THE JFN
	ANDCAB IOS,NETSTS(UNIT)	;CLEAR ERROR FLAG FOR CONNECTION
	MOVE T4,FILOFN(JFN)	;GET CURRENT OUTPUT POINT
	CAML T4,FILBYN(JFN)	;DONE?
	 JRST DMPDUN		;YES
	TQNE <EOTF,DEDF>	;END OF FILE OR DEAD HOST
	 JRST [ TQO <ERRF>	;YES.  SET ERROR FOR JFN
		SETZM FILBYT(JFN) ;ZERO BYTE POINTER
		SETZM FILBYN(JFN) ;BYTE COUNT
		SETZM FILOFN(JFN) ;AND CURRENT POSITION IN FILE
		HRLOI T1,377777	;AND SET NUMBER OF BYTES TO INFINITY
		MOVEM T1,FILCNT(JFN)
		RETSKP]
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL PKCHK		;HOW MANY BYTES CAN WE SEND?
	JUMPE T2,WATBAL		;NONE, WAIT
	MOVE T4,FILBYN(JFN)	;GET BYTE COUNT
	SUB T4,FILOFN(JFN)	;GET NUMBER OF BYTES IN BUFFER
	CAML T4,T2
	MOVE T4,T2		;TAKE MIN OF THE TWO
	MOVE T3,NETBUF(UNIT)	;GET BUFFER ADR
	HLL T3,FILBYT(JFN)	;GET BYTE SIZE
	TLZ T3,770000		;END OF FIRST WORD
	TLNN T3,700		;36 BIT MODE?
	 TLO T3,40000		;NO GET BYTE OFFSET RIGHT
	MOVE T1,FILOFN(JFN)	;GET BYTE OFFSET
	TLNE T3,6700		;8 BIT?
	 JRST DMPBF1		;NO
	IDIVI T1,4		;GET WORDS TO ADJUST IN T1
	HRRZS T3		;WE WILL ADD IN THE PROPER LH
	ADD T3,[041000,,0	;CASE 0. POINT TO PREVIOUS WORD
		341000,,1	;SO PKMSG WILL DO A BLT
		241000,,1	;OTHERS CASES USE STD. PTR
		141000,,1](T2)
DMPBF1:	ADDI T3,(T1)		;DO WORD OFFSET
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	PUSH P,T4		;SAVE COUNT WE ARE ASKING FOR
	CALL PKMSG		;GO PACK MESSAGE AND SEND IT
	POP P,T4		;GET BYTE COUNT BACK
	ADDM T4,FILOFN(JFN)	;UPDATE BYTE COUNT OF BUFFER
	LOAD T3,ANBSIZ,(UNIT)	;GET BYTE SIZE
	IMUL T4,T3		;GIVES BITS JUST SENT
	ADDM T4,NETBTC(UNIT)	;KEEP COUNT OF BITS SENT
	MOVNS T4		;GET NEGATIVE OF BITS SENT
	ADDM T4,NETBAL(UNIT)	;UPDATE BIT ALLOCATION
	MOVEI T1,^D24
	STOR T1,ANCLKS,(UNIT)	;RESET CLOCK FOR THIS CONNECTION
	JRST DMPBUF		;GO CHECK FOR ERRORS
DMPDUN:	SETZM FILBYN(JFN)	;ZERO BYTE COUNT FOR BUFFER
	SETZM FILOFN(JFN)	;ZERO CURRENT OUTPUT POINT
	MOVE T1,NETBUF(UNIT)	;GET ADDRESS OF BUFFER
	HLL T1,FILBYT(JFN)	;GET THE BYTE SIZE
	TLZ T1,770000		;SET AT END OF FIRST WORD
	TLNN T1,700		;36 BIT MODE?
	 TLO T1,40000		;NO GET BYTE OFFSET RIGHT
	MOVEM T1,FILBYT(JFN)	;SAVE BYTE POINTER
	HLRZ T1,NETBUF(UNIT)	;GET BUFFER SIZE
	SUBI T1,1		;DECREMENT IT BY ONE
	MOVEM T1,FILCNT(JFN)	;AND SAVE IT AS BYTES IN BUFFER
	RETSKP

WATBAL:	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL PKULCK		;UNLOCK CONNECTION TOO
	MOVEI T1,BALTST		;GET ADDRESS OF TEST ROUTINE
	HRL T1,UNIT		;AND UNIT TO WAIT ON
	RET
FIRSTO:	TQNN <BFSND>		; BUFFERED?
	 JRST [	CALL WATLSN	; NO, WAIT FOR CONNECTION TO OPEN
		RET		;PASS ON DOWN BLOCK
		TQZ <WNDF>
		RETSKP]
	CALL FRSTIO		; YES, SET UP BUFFER ETC
	RET			;PASS ON DOWN BLOCK
	RETSKP

;FRSTIO -  SET UP BUFFER IN JSB FREE SPACE

;ACCEPTS  UNIT/   NETWORK PSEUDO UNIT NUMBER

;RETURNS +1  FAILURE
;	 +2  SUCCESS   
;		RH NETBUF(UNIT)  HAS BUFFER ADDRESS

FRSTIO:	CALL WATLSN		; Wait for connection complete
	 RET			; Pass on down block
	STKVAR <FRSTBY,FRSTBF>
	MOVEI T1,^D36		; Bits per word
	LOAD T3,ANBSIZ,(UNIT)	; Connection byte size
	IDIV T1,T3		; Connection bytes per word
	IMUL T3,T1		; Used bits per word
	MOVE T2,MAXBPM		; Max bits per net message
	IDIVM T2,T3		; Max words per net message
	MOVEI T1,^D36		; Bits per machine word
	LDB T2,PBYTSZ		; File byte size
	IDIVM T1,T2		; File bytes per word
	MOVEM T2,FRSTBY		; Save file bytes per word
	HLRZ T1,NETBUF(UNIT)	; Desired bytes per buffer
	IDIV T1,T2		; Number of words needed
	SKIPE T1		; If zero
	CAML T1,T3		; Or bigger than max
	 MOVE T1,T3		; Use max
	MOVEM T1,FRSTBF		; Save bytes per buffer
	AOS T2,T1		; Plus header
	CALL ASGJFR		;ASSIGN A PAGE IN JOB AREA
	 JRST [TQO <ERRF>	;INDICATE AN ERROR
		RETBAD]		;RETURN
	HRRM T1,NETBUF(UNIT)	;SAVE BUFFER ADDRESS
	MOVE T3,FRSTBF		;GET SIZE AVAILABLE FOR BUFFER
	MOVE T1,FRSTBY		;GET BYTES/WORD BACK
	IMUL T1,T3		;CALCULATE BYTES BUFFER WILL HOLD
	HLRZ T2,NETBUF(UNIT)	;RETURN AS VALUE
	HRLM T1,NETBUF(UNIT)	;REAL BYTES PER BUFFER
	TQZ <WNDF>
	RETSKP
; 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.

.ATNVT::MCENT
	STKVAR <ATUNTS,ATRCJF,ATNDAD>
	UMOVE JFN,1
	HRRZS JFN
	CALL CHKJFN		; Check jfn of receive connection
	 JRST ATPER0		; Only real jfns are legal
	 JRST ATPER0
	 JRST ATPER0
	MOVEI T1,ATNX2		; Error code if test skips
	TQNE <READF>		; MUST BE OPENED FOR READING
	CALL CHKATP		; Check for dev=net, open, no buffer
	 JRST ATPER1		; Failed one of the above
	HLRZ UNIT,FILSKT(JFN)
	MOVEM UNIT,ATUNTS	;SAVE DEV AND JFN
	MOVEM JFN,ATRCJF
	UMOVE JFN,2		; Get send jfn
	CALL CHKJFN		; Check it
	JRST ATPER2		; Must also be a real jfn
	JRST ATPER2
	JRST ATPER2
	MOVEI T1,ATNX2		; Becomes atNx8 at atper3
	TQNE <WRTF>		; THIS ONE MUST BE FOR WRITING
	CALL CHKATP		; And dev=net, open, no buffer
	 JRST ATPER3		; Failed above tests
	HLRZ UNIT,FILSKT(JFN)
	LOAD T1,ANFSM,(UNIT)
	CAIN T1,RFCS
	CALL WATNOT		; Wait for response from foreign host
	MOVEI T1,ATNX12		; Error code for refused send
	LOAD T2,ANFSM,(UNIT)	; Now get state
	CAIE T2,OPND		; If not opnd
	JRST ATPER4		; Then fail
	HRLM UNIT,ATUNTS	;SAVE SEND JFN IN LEFT HALF
	HRRZ UNIT,ATUNTS	;SWITCH TO RECEIVE CONNECTION
	LOAD T1,ANFSM,(UNIT)	; Get its state
	CAIN T1,RFCS
	CALL WATNOT		; Wait for response from foreign host
	MOVEI T1,ATNX6		; Error code for refused receive
	LOAD T2,ANFSM,(UNIT)
	CAIE T2,OPND		; If not opnd
	JRST ATPER4		; Then fail
	NCPOFF
	LOAD T1,ANFSM,(UNIT)
	CAIE T1,OPND
	 JRST [	MOVEI T1,ATNX6
		JRST ATPERZ]
	HLRZ UNIT,ATUNTS	;GET SEND UNIT
	LOAD T1,ANFSM,(UNIT)
	CAIE T1,OPND
	 JRST [	MOVEI T1,ATNX12
		JRST ATPERZ]
	UMOVE 1,1		; GET OPTION FLAGS
	HRR T1,ATUNTS		;SET UP ARGS, RECEIVE UNIT IN 1
	HLRZ T2,ATUNTS		;SEND UNIT IN 2
	CALL ASNNVT		; Assign NVT to these units
	 JRST [	MOVEI T1,ATNX13	; Can't, no pty's
		JRST ATPERZ]
	MOVEM T2,ATNDAD		;SAVE ADDRESS OF DYNAMIC DATA
	HRRZ UNIT,ATUNTS	;RECIEVE UNIT
	MOVX T3,PROGF
	ANDCAM T3,NETSTS(UNIT)	; PROGRAM NO LONGER LOOKING
	HRRM T1,NETBUF(UNIT)	; Store pty number here
	HLRZ UNIT,ATUNTS	;SEND UNIT
	ANDCAM T3,NETSTS(UNIT)	; NOT HERE EITHER
	HRRM T1,NETBUF(UNIT)	; Also here
	NCPON
	IORI T1,400000		; Convert pty to tty designator
	UMOVEM T1,1		; Return to user
	CALL RELJFN		; Release send jfn
	MOVE JFN,ATRCJF
	CALL RELJFN		; And receive jfn
	HRRZ UNIT,ATUNTS	;GET RECIEVE UNIT
	MOVE T2,ATNDAD		;GET ADDRESS OF DYNAMIC DATA
	CALL NVTRAL		;GO REALLOCATE
	MOVE T2,ATNDAD		;GET ADDRESS OF DYNAMIC DATA
	CALL ULKTTY		;UNLOCK DATA BASE
	SMRETN			;RETURN SKIPPING
; Check validity of jfn for atpty

CHKATP:	MOVEI T1,ATNX3		; Receive not open
	TQNN <OPNF>		; IS IT OPEN?
	RET			; NO
	HRRZ T2,DEV
	MOVEI T1,ATNX4
	CAIE T2,NETDTB
	RET
	MOVEI T1,ATNX5
	TQNN <WNDF>
	RET
	RETSKP

ATPERZ:	NCPON
	JRST ATPER4

ATPER2:	MOVEI T1,ATNX7		; Bad send jfn
	JRST ATPER5

ATPER3:	ADDI T1,ATNX7-ATNX1	; Convert receive errors to send errors
ATPER4:	CALL UNLCKF
ATPER5:	MOVE JFN,ATRCJF		;GET RECIEV JFN
	MOVE STS,FILSTS(JFN)
ATPER1:	CALL UNLCKF
	JRST MRETNE		; Save error return in ac1

ATPER0:	MOVEI T1,ATNX1		; 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::MCENT
	MOVE JFN,T1
	CALL CHKJFN
	 RETERR (CVSKX1)
	 RETERR (CVSKX1)
	 RETERR (CVSKX1)
	CAIE PTR,NETDTB
	 RETERR (CVSKX1,<CALL UNLCKF>)
	HLRZ T1,FILNEN(JFN)
	HRLI T1,(<POINT 7,0,35>)
	CALL NAMDEC
	 RETERR (CVSKX2,<CALL UNLCKF>)
	CALL UNLCKF
	UMOVEM T1,2
	JRST SKMRTN

;ROUTINE TO PRODUCE THE OLD HOSTN TABLE

GHOSTN::LOAD T4,HSTIDX,(T2)		;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?
	 TXO T1,HS%NCK
	MOVSI T1,(T1)
	LOAD T3,HSTNMP,(T2)		;GET THE NAME POINTER
	HRRI T1,(T3)
	RET
;ROUTINE TO PRODUCE THE OLD NETAWD TABLE

GNTAWD::LOAD T1,ANFHS,(T2)		;GET THE HOST NUMBER
	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::SAVEQ			;NEED SOME ACS
	HRRZ UNIT,T2		;GET INDEX
	IMULI UNIT,^D36		;CONVERT TO 1ST HOST NUMBER
	HRLI UNIT,-^D36		;LOOP COUNTER
	SETO IOS,		;SET TO ALL UP

GTBHR1:	ROT IOS,1		;MAKE ROOM FOR NEXT BIT
	HRRZ T1,UNIT		;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:	 TXZ IOS,1		;NO, CLEAR BIT
	AOBJN UNIT,GTBHR1	;LOOP FOR ALL 36 HOSTS IN THIS WORD
	MOVE T1,IOS		;RETURN WORD FOR GETAB
	RET

;ROUTINE TO PRODUCE OLD HSTSTS GETAB TABLE.

GTBHSS::SAVEQ			;NEED WORK SPACE
	HRRZ IOS,T2		;GET INDEX
	LSH IOS,1		;TURN INTO HOST NUMBER
	MOVE T1,IOS		;HOST N
	CALL GTBHSH		;GET RIGHT STATUS
	HLLZ UNIT,T1		;RESULT FOR HOST N IN LEFT HALF
	AOS T1,IOS		;HOST N+1
	CALL GTBHSH		;GET RIGHT STATUS
	HLR UNIT,T1		;RESULT FOR HOST N+1 IN RIGHT HALF
	MOVE T1,UNIT		;RETURN WORD FOR GETAB
	RET

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

.GTNCP::MCENT
	SKIPL T1			;CHECK RANGE OF FUNCTION
	 CAIL T1,GTNMAX
	  RETERR (ARGX02)		;BAD FUNCTION NUMBER
	XCT GTNDSP(T1)			;DO FUNCTION
GTNCPX:	SKIPL UNIT			;GET THE INDEX
	 CAIL UNIT,NSKT
	  RETERR (GTJIX1)		;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
	LOAD T1,ANFHS,(UNIT)		;(01)FOREIGN HOST
	MOVE T1,LSKT(UNIT)		;(02)LOCAL SOCKET
	MOVE T1,FSKT(UNIT)		;(03)FOREIGN SOCKET
	LOAD T1,ANFSM,(UNIT)		;(04)FINITE STATE
	LOAD T1,ANLNK,(UNIT)		;(05)LINK
	CALL [	HRRZ T1,NETBUF(UNIT)	;(06)RETURN NVT IF
		CAIGE T1,1000		;THERE IS ONE
		 JUMPN T1,R
		JRST RTRUE]
	LOAD T1,ANBSIZ,(UNIT)		;(07)BYTE SIZE OF CONNECTION
	CALL [	LOAD T1,LTIDX,(UNIT)	;(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
	LOAD T1,ANCLKS,(UNIT)		;(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 (GTNCX1)
	 RETERR (GTNCX1)
	 RETERR (GTNCX1)
	HLRZ UNIT,FILSKT(JFN)		;GET THE UNIT
	CALL UNLCKF
	CAIE PTR,NETDTB			;MAKE SURE IS NET:
	 RETERR (GTNCX1)
	JRST GTNCPX			;REJOIN MAIN CODE

GTNNVI:	SKIPA UNIT,[NVTIPU]		;GET INPUT UNIT
GTNNVO:	MOVEI UNIT,NVTOPU		;USE OUTPUT UNIT
	CAIN T2,.CTTRM			;WANT CONTROLLING TTY?
	 MOVE T2,CTRLTT			;YES
	ANDI T2,377777			;CLEAR 400000
	CALL NVTCHK
	 RETERR (GTNCX2)		;BAD NVT
	CALL (UNIT)			;CALL ROUTINE
	 SETO UNIT,			;CATCH ERROR AS BAD UNIT
	CALL ULKTTY			;UNLOCK TTY DATA BASE
	JRST GTNCPX			;REJOIN MAIN CODE
;GET INFOMATION ABOUT HOSTS

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

GTHSXX:	MOVX T4,HS%NCK			;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
	MOVSI T3,-NHOSTS		;NUMBER OF HOST SLOTS
	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 (GTJIX1)		;BAD INDEX TO HOSTN
	LOAD DEV,HSTIDX,(HN)		;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(GTHSX3)]	;NO STRING FOR THAT NUMBER

GTHTUS:	LOAD PTR,HSTNMP,(HN)		;GET THE NAME POINTER
	MOVEI PTR,HSTNAM(PTR)		;POINT TO NAME
	HRLI PTR,(<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:	LOAD T3,HSTIDX,(T2)		;GET INDEX
	CAMN T3,DEV			;THE SAME?
	 JRST [	HRRZ HN,T2		;GET NAME INDEX
		RET]
	AOBJN T2,GTHSLP			;LOOP
	RET				;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(GTHSX2)
	HRRZ DEV,T2
	JRST GTHSXX			;EXIT

GTHSTN:	STKVAR <<GTHSBF,10>>
	MOVEI PTR,GTHSBF		;MAKE BYTE POINTER
	HRLI PTR,(<POINT 7,0>)
	CALL GTHSIN			;GET STRING FROM USER
	MOVEI T1,GTHSBF			;MAKE BYTE POINTER
	HRLI T1,(<POINT 7,0>)
	CALLRET HSTLUK			;LOOKUP NAME

GTHHNI:	HRRZ T1,T3			;GET INDEX
	CAIL T1,NHOSTS
	 RETERR (GTJIX1)		;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 (GTHSX1)]	;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,MAXLC		; 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,PTR
	JUMPG T2,GTHSIL
	BKJFN
	 JFCL
	UMOVEM T1,2
	RET

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,PTR
;**;[2618] Revamp code at GTHSOL: +1L	JGZ	11-MAY-82
	JUMPE T2,GTHSOX		;[2618] FINISH UP ON NULL
	XCT JFN			;[2618] DO RIGHT OPERATION
	JRST GTHSOL		;[2618] LOOP FOR ALL BYTES
GTHSOX:	UMOVEM T1,2		;[2618] UPDATE THE USER'S DESIGNATOR
	TLNE	T1,777777	;[2618] JFN?
	XCT JFN			;[2618] NO, STRING - DO THE NULL
	RET			;[2618] 
; Flush host

.FLHST::MCENT
	MOVEI T2,SC%WHL!SC%OPR
	TDNN T2,CAPENB
	 ITERR (WHELX1)
	CALL CVNHST		;CONVERT HOST NUMBER
	CALL HSTDED
	CALL IMSRST
	JRST MRETN

; Convert host number to string

.CVHST::MCENT
	SETOB HN,DEV		;NO NAME YET
	MOVE T1,T2		;GET HOST NUMBER IN RIGHT PLACE
	CALL GTHNTS		;CONVERT NUMBER TO STRING
	JUMPL HN,[EMRETN(CVHST1)] ;STRING NOT FOUND
	LOAD T1,HSTNMP,(HN)
	MOVEI T1,HSTNAM-1(T1)
	CALL JFNSS
	JRST SKMRTN

; Set local host number routine. Takes old or new style number.
; Sets to new style, and puts it in NLHOST.

STHSTJ::MOVE T1,T2		; To right AC
	CALL CVNHST		; Put T1 into new host format
	MOVEM T1,NLHOST		; Store it
	CALL CVOHST		; Set the old format number too
	MOVEM T1,NOHOST
	RET

; Get net status

NETGST:	HLRZ UNIT,FILSKT(JFN)
	LOAD T1,ANFHS,(UNIT)
	CALL CVOHST		; Convert to old host format
	UMOVEM T1,3
	HLLZ T1,NETSTS(UNIT)
	MOVE T2,FSKT(UNIT)
	UMOVEM T2,4

; Set net status

NETSST:	RET

; ASSIGN BUFFERS IN NETWORK AREA

	RESCD

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

ASNTB3:	CAMLE T2,MAXWPM		; BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
	 BUG (NETRBL)
	AOS ASNTBC		; COUNT CALLS
	NOINT
	LOCK NETFRE+1		;LOCK NETWORK BUFFER FREE LIST
	MOVE T1,NETFRE		;GET POINTER TO CURRENT BUFFER
	JUMPE T1,ASNTB2		;THERE ISN'T ONE
	HRL T2,0(T1)		;GET CURRENT SIZE FIELD
	HRRM T2,0(T1)		;STASH REQUESTED SIZE
	HLRZS T2		;MOVE OLD SIZE FIELD TO RH, CLEARING LH
	CAMG T2,MAXWPM		;MAKE SURE ITS NOT IN USE
	 BUG (NETBAU)
	HLRZ T2,0(T1)		;GET POINTER TO NEXT ONE IN LIST
	SKIPE T2		;IS THIS LAST BUFFER ON CHAIN?
	HRLI T2,ANBSEC		;NO...PUT ON SECTION ADDRESS
	MOVEM T2,NETFRE		;THAT BECOMES FIRST ONE
	AOS 0(P)		;INDICATE SUCCESS
	MOVN T2,MAXWPM		;MAINTAIN TOTAL SPACE AS A MATTER
				;OF INTEREST
	ADDM T2,NETFRE+2
ASNTB2:	UNLOCK NETFRE+1		;UNLOCK FREE LIST
	OKINT
	RET

; RELEASE NETWORK BUFFERS
; (ALL AC'S PRESERVED)

RLNTBF::PUSH P,T1		;SAVE T1
	MOVE T1,NETFRE+3	;GET LOWER BUFFER AREA BOUNDARIES
	 CAMGE T2,T1		;RETURNED BUFFER .GE. LOWER BOUND?
	JRST RLNTER		;NO, CRASH
	MOVE T1,NETFRE+4	;GET UPPER BOUND
	CAML T2,T1		;.LT. UPPER BOUND?
	JRST RLNTER		;REPORT THE PASSING OF BAD ARGUMENTS
	NOINT
	LOCK NETFRE+1		;LOCK FREE LIST
	HRRZ T1,0(T2)		;GET COUNT FIELD
	CAMLE T1,MAXWPM		;MAKE SURE NOT ALREADY ON FREELIST
	BUG (NETBAF)
	MOVE T1,-1(P)		;GET PC OF CALLER
	HRL T1,NETFRE		;GET POINTER TO CURRENT FIRST BUFFER
	MOVEM T2,NETFRE		;RETURNED ONE IS NOW FIRST
	MOVEM T1,0(T2)		;AND POINTS TO OLD FIRST ONE
				;SIZE FIELD IS PC OF CALLER
	MOVE T1,MAXWPM		;MAINTAIN TOTAL SPACE COUNT
	ADDM T1,NETFRE+2
	UNLOCK NETFRE+1		;UNLOCK FREE LIST
	OKINT
	JRST PA1		;RESTORE T1 AND RETURN
RLNTER:				;HERE ON BAD ARGUMENTS TO RLNTBF
	BUG(NETRBG)		;REPORT PASSING OF BAD ARGS
	JRST PA1		;RESTORE T1 AND RETURN

	SWAPCD
; 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(T2),QQ
QQ==QQ+4>
QQ==3
	REPEAT 9,<
	POINT 4,NXTSTT+1(T2),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(T2),QQ
QQ==QQ+4>
QQ==3

	REPEAT 9,<
	POINT 4,ACTION+1(T2),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 rrfb 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,CLW1,PNDG	; Pndg
BYTE (4)RFCR,LSNG,LSNG,FREE,FREE,LSNG,LSNG,LSNG,LSNG,LSNG,CLSW	; Lsng
BYTE (4)RFCR,CLZW,CLZW,CLW1,CLW1,OPND,RFCR,RFCR,RFCR,RFCR,RFCR	; Rfcr
BYTE (4)CLW1,FREE,FREE,CLW1,CLW1,CLW1,CLW1,CLW1,CLW1,FREE,CLW1	; Clw1
BYTE (4)OPND,CLZW,CLZW,CLW1,CLW1,RFCS,RFCS,RFCS,RFCS,CLSW,CLSW	; Rfcs
BYTE (4)OPND,CLZW,RFN2,CLW1,DATW,OPND,OPND,OPND,OPND,OPND,OPND	; Opnd
BYTE (4)CLSW,CLZW,CLZW,CLW1,CLW1,CLSW,CLSW,CLSW,CLSW,CLZW,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 rrfb 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 CALL @ACTAB(ACTION#)

ACTAB:	IFIW!R			;NOP
	IFIW!FUNNY		;UNEXPECTED EVENT
	IFIW!SNDCLS		;SEND CLS
	IFIW!SNDRFC		;SEND STR OR RTS
	IFIW!NETOPB		;SNED RFC AND OPEN LINK
	IFIW!NETOPL		;OPEN LINK
	IFIW!NETCLL		;CLOSE LINK
	IFIW!NETCLB		;CLOSE LINK AND SEND CLS
	IFIW!DOEOR		;FINISH UP INPUT
	IFIW!DOEOS		;FINISH UP OUTPUT
	IFIW!DOES1		;END OF SEND IF TRANSMISSION ABORTED
	IFIW!DOABT		;ACCEPT ON ABORTED CONNECTION
	IFIW!CKALL		;ALLOCATIN CHECK FOR OPENED CONN

RADIX 8
;UNEXPECTED EVENT

;	T1/   EVENT 
;	UNIT/ UNIT INDEX

FUNNY:	HLL T1,NETSTS(UNIT)	;GET STATUS
	LOAD T2,ANFHS,(UNIT)	;GET FOREIGN HOST
	BUG(NCPFUN,<<T1,D>,<T2,D>,<UNIT,D>>)
	AOS FUNNYC		;COUNT THEM
	MOVE T1,T2
	SETZ T2,
	JRST NCPERR		;AND SEND TYPE 0 ERR

; ACCEPTED AN ABORTED REQUEST

DOABT:	MOVX IOS,EOTF		; SET FLAG TO CAUSE ERROR
	IORB IOS,NETSTS(UNIT)	; IN STATUS WORD
	RET

; CHECK ALLOCATION

CKALL:	MOVE T1,LSKT(UNIT)
	TRNN T1,1		; SEND SOCKET?
	 RET			; NO. DO NOTHING
	TQNE <ALLFF>		; Allocation failure??
	TQNN <CLZF>		; BEING CLOSED?
	 JRST CKALL1		; NO, IGNORE
	TQO <ERRB,EOTF>		; SIGNAL ERROR, AND STOP TRANSMISSION
	HLLM IOS,NETSTS(UNIT)
	RET

CKALL1:	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	LOAD T2,ANBSIZ,(UNIT)
	CAMG T2,NETBAL(UNIT)	; SUFFICIENT BIT ALLOCATION?
	SKIPN IMPLT4(T1)	; AND MESSAGE SPACE?
	 JRST CKALL2		; NO
	TQZ <ALLFF>
	HLLM IOS,NETSTS(UNIT)
	RET

CKALL2:	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALL IMPSYN		; RESYNC ALLOCATION
	MOVX IOS,ALLFF
	IORB IOS,NETSTS(UNIT)	; REMEMBER WE DID THIS ONCE
	RET
; END OF SEND

DOES1:	CALL DOEOS
	CALLRET IMPABL		; FLUSH QUEUED MESSAGES

DOEOS:	MOVX IOS,EOTF
	IORB IOS,NETSTS(UNIT)
	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	CALLRET IMPSDB		; SET DONE BIT IN LINK TABLE

; End of receive

DOEOR:	CALL SNDCLS
	HRRZ T2,NETBUF(UNIT)
	JUMPE T2,DOEOS
	CAIL T2,1000
	JRST DOEOS
	CALL DOEOS		; DO SAME AS END OF SEND
	NCPON			; NCP BACK ON SO NVTDET CAN USE IT
EORNV0:	HRRZ T2,NETBUF(UNIT)	; PICK UP LINE NUMBER
	JUMPE T2,EORNV1		;ALREADY GONE
	PUSH P,UNIT
	CALL LCKDVL		;LOCK DEVICE LOCK, GO NOINT
	CALL NVTDTT
	 JRST EORNV2		;FAILURE
EORNV3:	UNLOKK DEVLKK		;UNLOCK THE DEVICE LOCK
	OKINT			;DEVLCK WENT NOINT
	POP P,UNIT
EORNV1:	NCPOFF			; BACK OFF SO CALLER IS NOT CONFUSED
	RET

EORNV2:	TXZN T1,1B0		;WAIT OR ERROR?
	JRST [	BUG (NETDET,<<T1,D>>)
		JRST EORNV3]	;GO CLEAN UP
	UNLOKK DEVLKK		;UNLOCK THE DEVICE LOCK
	OKINT			;DEVLKK WENT NOINT
	POP P,UNIT
	HRL T1,NETBUF(UNIT)	;GET TTY NUMBER
	MDISMS			;WAIT UNTIL DEALLOCATE IS POSSIBLE
	JRST EORNV0		;GO TRY AGAIN

; Close link

NETCLL:	LOAD T1,LTIDX,(UNIT)	;GET LINK TABLE INDEX
	TQZE <LINKF>		;IS IT VALID?
	 CALL IMPCLL		;YES
	MOVEM IOS,NETSTS(UNIT)	;SAVE STATUS
	RET

NETCLB:	CALL NETCLL
SNDCLS:	LOAD T1,ANFHS,(UNIT)	; Get foreign host
	MOVE T2,LSKT(UNIT)	; And local socket
	MOVE T3,FSKT(UNIT)	; And foreign socket
	TQNN <DEDF>
	 CALL IMPCLS		; Send the control message
	RET
; OPEN LINK

NETOPL:	LOAD T1,ANFHS,(UNIT)
	LOAD T2,ANLNK,(UNIT)
	LOAD T3,ANBSIZ,(UNIT)
	MOVE T4,LSKT(UNIT)
	TRNE T4,1		; Send socket?
	 JRST NETOPS		; Yes, open send link
	CALL IMPOPL		; No, open a receive link
	SKIPA
NETOPS:	CALL IMPOPS		; Open a send link
	STOR T1,LTIDX,(UNIT)	; Keep the link index
	MOVX IOS,LINKF		;GET VALID BIT
	IORB IOS,NETSTS(UNIT)	;MARK IT AS VALID
	RET

; Send rfc and open link

NETOPB:	CALL NETOPL

; Send rfc

SNDRFC:	TQNE <DEDF>
	 RET
	LOAD T1,ANFHS,(UNIT)	; Get foreign host
	MOVE T2,LSKT(UNIT)	; And local socket
	MOVE T3,FSKT(UNIT)
	LOAD T4,ANBSIZ,(UNIT)	; Byte size
	TRNE T2,1
	JRST IMPSTR
	LOAD T4,ANLNK,(UNIT)
	CAIG T4,LLINK		; is this a legal NCP link number?
	 CAIGE T4,FNLINK
	  BUG(IMPBLK,<<T4,LINK>>) ; no 
	JRST IMPRTS		; Send control message
; This here is the main fsm routine

DOFSM:	MOVE IOS,NETSTS(UNIT)
	TQNN <DEDF>
	 JRST DOFSMA
	CALL DOFSMA
	LOAD T1,ANFSM,(UNIT)
DOFSMB:	PUSH P,T1
	MOVEI T1,HUNG
	CALL DOFSMA
	LOAD T1,ANFSM,(UNIT)
	POP P,T2
	CAME T1,T2
	 JRST DOFSMB
	RET

DOFSMA:	NCPOFF			; Allow no control messages while here
	MOVEI T2,^D24		; Time out in 2 minutes
	STOR T2,ANCLKS,(UNIT)
	LOAD T2,ANFSM,(UNIT)	; Get old state
	MOVE T4,T2		; Save old state
	LSH T2,1		; Two words per old state
	LDB T3,CBPFSM(T1)	; Get new state
	STOR T3,ANFSM,(UNIT)
	LDB T2,CBAFSM(T1)	; Get action
	CAME T3,T4		; State changed?
	 CALL STCPSI		; GENERATE STATE CHANGE PSI
	MOVE IOS,NETSTS(UNIT)	;GET STATUS OF THE LINK
	CALL @ACTAB(T2)		; Call action routine
	NCPON
	RET

; Generate state change PSI

STCPSI:	SAVET
	LOAD T1,ANPVST,(UNIT)	; Save previous 4 states
	LSH T1,4
	IOR T1,T4
	STOR T1,ANPVST,(UNIT)	; Save previous state
	HRRE T1,NETFRK(UNIT)
	JUMPL T1,R		; No fork for interrupts
	LOAD T2,ANFSPI,(UNIT)	; Get psi channel
	CAIL T2,^D36
	 RET
	EXCH T1,T2
	CALLRET PSIRQ
; Make a socket or find existing one

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


MAKSK6:	POP P,T3
	SUB P,BHC+3
	MOVE T2,FSKT(UNIT)
	LOAD T1,ANFHS,(UNIT)
	NCPON
	RETSKP

MAKSKN:	SOJLE T4,MAKSKE		; Full, error
	SOJGE UNIT,MAKSKL	; Loop back for next slot
	MOVEI UNIT,NSKT-1
	JRST MAKSKL
MAKSK1:	SKIPGE T3
	MOVE T3,UNIT		; Save where it's at
	CAIE T1,DEAD
	JRST MAKSKN		; Space keeper, test next
MAKSK5:	SKIPN -3(P)
	JRST MAKSKR
	MOVE UNIT,T3
	SETZM NETHST(UNIT)
	SETZM NETSTS(UNIT)
	SETZM NETBUF(UNIT)
	SETZM NETAWD(UNIT)
	SETZM NETBAL(UNIT)
	SETZM NETBTC(UNIT)
	SETOM NETFRK(UNIT)
	MOVEI T1,CLZD
	STOR T1,ANFSM,(UNIT)	; Set its state to be closed
	POP P,T3
	MOVEM T3,LSKT(UNIT)
MAKSKF:	MOVE T1,-1(P)		; Foreign host
	MOVE T2,LSKT(UNIT)
	TRNE T2,1		; Receive?
	 JRST MAKSKQ
	CALL ASNLNK		; Assign link for that host
	 JRST [	LOAD T1,ANFSM,(UNIT)
		MOVEI T2,FREE
		CAIN T1,CLZD	; Just created?
		STOR T2,ANFSM,(UNIT) ; Yes, delete it
		PUSH P,LSKT(UNIT)
		JRST MAKSKR]	; And fail
MAKSKQ:	POP P,T2		; Common for old and new
	MOVEM T2,FSKT(UNIT)
	POP P,T1
	STOR T1,ANFHS,(UNIT)
	SUB P,BHC+1
	NCPON
	RETSKP

MAKSKE:	JUMPGE T3,MAKSK5
	TDZA T1,T1		; FULL
MAKSKR:	MOVEI T1,4		; NON-EXISTENT
	NCPON
	SKIPA			; RETURN 0 OR FOUR ERROR CODE
MAKSKX:	MOVEI T1,3		; BAD PARAMETERS
	MOVEM T1,-1(P)		; STORE ERROR CODE
MAKSKV:	POP P,T3
	POP P,T2
	POP P,T1
	SUB P,BHC+1
	RET
; Assign link number for this connection

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

ASNLNF:	ADD T2,T3
	POP P,T1
	POP P,UNIT
	STOR T2,ANLNK,(UNIT)
	SUB P,BHC+NLNKBW
	RETSKP
; Do a listen (openf for file with no foreign host/socket)

LISTEN:	CALL HSTCHK
	RET
	PUSH P,T4		; Save byte size
	CALL MAKSKT		; Make a socket
	 JRST [	POP P,T4
		MOVEI T1,OPNX10
		RET]		; No room
	MOVEI T1,LISN
	JRST CONNE1

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

CONNEC:	CALL HSTCHK
	RET
	PUSH P,T4		; Save byte size
	CALL MAKSKT		; Make a socket or find existing one
	 JRST [	POP P,T4
		MOVEI T1,OPNX10
		RET]		; No room
	MOVEI T1,CONN
CONNE1:	NCPOFF
	LOAD T2,ANFSM,(UNIT)
	CAIN T2,CLZD		; Received any rfc here?
	 JRST CONNE2		; No
	CAIN T2,PNDG		; Same question
	 JRST CONNE3		; Yes
	MOVEI T1,OPNX9		; Already in use
	POP P,T4
	NCPON
	RET

CONNE2:	MOVX T4,PROGF
	IORM T4,NETSTS(UNIT)	; Mark as attached to program
	NCPON
	POP P,T4		; My choice of byte size
	STOR T4,ANBSIZ,(UNIT)	; Set byte size
	CALL DOFSM		; Send rfc etc
	RETSKP

CONNE3:	TRNE T3,1		; Are we sender?
	 JRST CONNE2		; Also our choice
	LOAD T4,ANBSIZ,(UNIT)	; Get his byte size
	CAMN T4,0(P)		; Does byte size agree?
	 JRST CONNE2		; Yes, same as if my choice
	NCPON
	MOVEI T1,HUNG		; Flush his connection attempt
	CALL DOFSM
	POP P,T4
	MOVEI T1,OPNX22		; Bad byte size error
	RET
; Check if host is available

HSTCHK:	SKIPL IMPRDY
	 JRST [	MOVEI T1,OPNX19
		RET]
	JUMPL T1,RSKP		; ALWAYS OK IF LISTEN
	CALL HSTCK0		; CHECK THE HOST
	 JRST [	MOVEI T1,OPNX20	; NO RESPONSE
		RET]
	JRST RSKP		; UP AND READY

HSTCK0:	SAVET
	LDB T2,[POINT 8,T1,19]
	CAIL T2,FKHOST
	 RET
	CALL HSTHSH		; Get the host index
	 JRST RSKP		; No room, try anyway
	SKIPGE HSTSTS(T2)	; Up?
	 RETSKP			; 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?
	 RETSKP
	SOJG T3,HSTCK1
	RET
; Routines to call when control messages are received

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

RECCLS::CALL GETSKT		; Get the socket entry
	 JRST NCPERR
RECCL1:	MOVE T2,LSKT(UNIT)
	TRNN T2,1
	SKIPA T1,[CLSR]
	MOVEI T1,CLSS
	CALLRET DOFSM

; RECEIVED INCORRECT MESSAGE
; REPLY WITH ERR

NCPERR:	SAVET
	SAVEQ
	MOVE T3,I8COP		; GET LAST OP CODE
	MOVE HN,[I8CAL,,T4]	; COMPLAIN ABOUT LAST CONTROL MESSAGE
	BLT HN,HN
	CALLRET IMPERR

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

RECSTR::PUSH P,T4		; Save byte size
RCSTR0:	CALL MAKSKT
	 JRST [	POP P,T4
		JRST NCPERR]
	MOVE T4,0(P)
	CALL CHKSKT		; MAKE SURE THIS SOCKET NOT IN USE
	 JRST RCSTR0		; IT WAS. DELETED. NOW TRY AGAIN.
	LOAD T1,ANFSM,(UNIT)	; What is state of this connection
	CAIE T1,CLZD		; If not clzd
	 JRST [	LOAD T4,ANBSIZ,(UNIT) ; Then get user's byte size
		CAMN T4,0(P)	; If not the same
		JRST .+1
		MOVEI T1,RRFB	; RECEIVED BAD BYTE SIZE
		CALL DOFSM
		MOVX T1,ERRB
		IORM T1,NETSTS(UNIT)
		POP P,T4
		RET]
	POP P,T4
	STOR T4,ANBSIZ,(UNIT)
	MOVEI T1,RRFC
	CALL DOFSM
	MOVE T1,UNIT
	LOAD T2,ANLNK,(UNIT)
	RET

CHKSKT:	SAVET
	LOAD T1,ANFSM,(UNIT)	; GET STATE
	CAIE T1,RFCS		; STATES WHERE RFC IS EXPECTED
	CAIN T1,CLZD
	 RETSKP
	CAIN T1,LSNG
	 RETSKP
	CALLRET SK2DWN		; KILL THE OLD ONE

CHKLNK:	SAVET
	STKVAR<CHKLLK,CHKLHS>
	MOVEM T1,CHKLHS
	MOVEM T4,CHKLLK
	MOVSI UNIT,-NSKT
CHKLK1:	LOAD T2,ANLNK,(UNIT)	; GET THE LINK
	LOAD T3,ANFHS,(UNIT)	; AND HOST
	CAMN T2,CHKLLK
	CAME T3,CHKLHS
	 JRST CHKLK2
	MOVE T2,LSKT(UNIT)
	TRNN T2,1
	 JRST CHKLK2		; SKIP SEND CONNECTIONS
	LOAD T2,ANFSM,(UNIT)	; LINK-HOST MATCHES. GET STATE
	CAIE T2,DEAD
	CAIN T2,FREE
	 JRST CHKLK2
	CAIE T2,CLZD
	CAIN T2,RFCS
	 JRST CHKLK2
	CAIE T2,LSNG
	CAIN T2,CLZW
	 JRST CHKLK2
	CALL SK2DWN
CHKLK2:	AOBJN UNIT,CHKLK1
	RET
; Receive rts
; Recrts(fhost,fskt,lskt,link)

RECRTS::CALL CHKLNK		; CHECK AND DELETE ANY MATCHING LINKS
	PUSH P,T4		; SAVE LINK
	CALL MAKSKT		; MAKE SOCKET TABLE ENTRY
	 JRST [	POP P,T4	; FAILED, SEND ERR
		JRST NCPERR]
	POP P,T4		; RESTORE LINK
	CALL CHKSKT		; MAKE SURE NO DUPLICATES
	 JRST RECRTS		; PREVIOUS CONNECTION CLOSED. TRY AGAIN
	STOR T4,ANLNK,(UNIT)
	MOVEI T1,RRFC
	CALLRET DOFSM

; Receive rfnm

RCFRFN::MOVEI T1,RRFN
	CALLRET DOFSM

; Receive ins/inr

RECINR::
RECINS::LOAD T2,ANINPI,(UNIT)
	LOAD T1,ANFSM,(UNIT)
	CAIGE T2,^D36		; RETURN IF CHANNEL IS 77 OCTAL
	CAIE T1,OPND
	 RET
	HRRZ T1,NETBUF(UNIT)
	SKIPE T1
	CAIL T1,1000
	CAIA
	 RET
	HRRE T1,NETFRK(UNIT)
	JUMPL T1,R
	EXCH T1,T2
	CALLRET PSIRQ

; INITIATE SERVICE INTERRUPTION (HOST DEAD)

SVCINT::MOVX IOS,SVCIF
	IORB IOS,NETSTS(UNIT)
	CALLRET STCPSI		; GENERATE STATE CHANGE PSI

; TERMINATE SERVICE INTERRUPTION

SVCRST::MOVX IOS,SVCIF
	ANDCAB IOS,NETSTS(UNIT)
	CALLRET STCPSI
; Receive reset message

RECRST::CALL NETHDN
	JRST IMPRRP

; Kill all connection -- net is down

NETDWN::MOVSI UNIT,-NSKT
	CALL SKTDWN
	AOBJN UNIT,.-1

; Periodic check of all connections for time-out

NETCHK::MOVSI UNIT,-NSKT
NETCKL:	LOAD T1,ANFSM,(UNIT)
	CAIE T1,DEAD
	CAIN T1,FREE
	 JRST NETCKN
	MOVX T1,DEDF
	TDNN T1,NETSTS(UNIT)
	SKIPL IMPRDY
	JRST NETCK1
	LOAD T2,ANCLKS,(UNIT)
	SOS T2
	STOR T2,ANCLKS,(UNIT)
	JUMPG T2,NETCKN
NETCK1:	MOVEI T1,HUNG
	CALL DOFSM
NETCKN:	AOBJN UNIT,NETCKL
	MOVEI T1,^D5000
	SKIPL IMPRDY
	MOVEI T1,^D500
	ADD T1,TODCLK
	MOVEM T1,NETTIM
	RET
; Host has died

NETHDN::MOVSI UNIT,-NSKT
	PUSH P,T1
NETHDL:	LOAD T1,ANFSM,(UNIT)
	CAIE T1,FREE
	CAIN T1,DEAD
	JRST NETHDX
	LOAD T1,ANFHS,(UNIT)
	CAMN T1,(P)
	CALL SKTDWN
NETHDX:	AOBJN UNIT,NETHDL
	POP P,T1
	RET

SK2DWN::HRRZ T2,NETBUF(UNIT)
	CALL NVTCHK		; AN NVT?
	 JRST SKTDWN		; NO, TREAT NORMALLY
	PUSH P,UNIT
	PUSH P,T2
	CALL SKTDWN
	MOVE T2,0(P)
	CALL NVTIPU		;GET INPUT UNIT
	 TRNA			;NO UNITS FOR THIS LINE
	CALL SKTDWN		; CLOSE THE OTHER HALF
	POP P,T2		;GET ADDRESS OF DYNAMIC DATA FOR TTY
	CALL ULKTTY		;UNLOCK DATA BASE
	POP P,UNIT
	RET

SKTDWN:	LOAD T1,ANFSM,(UNIT)	; GET STATE
	CAIN T1,LSNG		; IF LSNG
	 RET			; IGNORE
	MOVX T2,ERRB!DEDF
	IORM T2,NETSTS(UNIT)
	CAIE T1,CLSW		; IF WAITING FOR CLOSE,
	CAIN T1,CLW1
	CALL SKTDW2		; PRETEND ONE HAPPENED.
	CAIE T1,RFCR
	CAIN T1,OPND		; If opnd
SKTDW2:	CALL RECCL1		; Simulate receipt of cls
	MOVEI T1,HUNG
	CALLRET DOFSM
HSTINI::SAVEPQ
	MOVX T1,<GJ%OLD+GJ%SHT>
	HRROI T2,[ASCIZ /SYSTEM:HSTNAM.TXT/]
	GTJFN
	 RET
	MOVE JFN,T1
	MOVE T2,[7B5+OF%RD]
	OPENF
	 JRST [	MOVE T1,JFN
		RLJFN
		TRN
		RET]
	SETZB HN,HSTNAM		; CLEAR OLD STUFF IN TABLE
	MOVSI T4,HSTNAM		; (TELNET FAILS IF THIS ISN'T DONE
	HRRI T4,HSTNAM+1	; AND IT LOOKS NEATER TO HAVE WHOLE
	BLT T4,HSTNAM+NHSTN-1	; WORD OF NULL AFTER EACH NAME)
	MOVSI T4,-NHOSTS	; CLEAR HOST TABLES
HSTCLR:	SETZM HOSTN(T4)
	HLLZS HSTSTS(T4)	; PRESERVE HOST UP BIT
	SKIPGE IMPRDY		; IF NET IS UP
	 JRST HSTCL1
	SETZM HOSTNN(T4)
	SETZM HSTSTS(T4)
HSTCL1:	AOBJN T4,HSTCLR
	SETZ PTR,
LUP0:	MOVE T1,JFN
	CALL GCH
	 JRST DONE
	MOVE UNIT,T3		; SAVE IN CASE THIS IS ALINE
	CAIN T2,.CHLFD
	 JRST LUP0
	CAIGE HN,NHOSTS
	 CAIL PTR,NHSTN
	  JRST FULL
	BKJFN
	 TRN
	RFPTR
	 TRN
	MOVE STS,T2
	MOVEI T3,10
	NIN
	 JRST [	HRLI T4,[ASCIZ /Bad number/]
		MOVE T3,STS
		JRST SYNERR]
	MOVE T1,T2
	CALL CVNHST			;GET NEW FORMAT IF NEEDED
	CALL HSTHSH
	 JUMPL T2,FULL
	MOVE DEV,T2
	MOVEM T1,HOSTNN(DEV)
	STOR DEV,HSTIDX,(HN)
	MOVE T1,JFN
	BKJFN
	 TRN
	CALL GCH
	 JRST PEOF
	CAIE T2,","
	 JRST [	HRLI T4,[ASCIZ /Missing comma after host number/]
		JRST SYNERR]
	MOVEI T4,HSTNAM(PTR)
	HRLI T4,(<POINT 7,0>)
	MOVEI STS,MAXLC		; MAX OF 39 CHAR IN HOST NAME
LUP1:	CALL GCH		; READ NEXT CHARACTER
	 JRST PEOF
	CAIE T2,.CHLFD		; TERMINATE ON END OF LINE
	CAIN T2,","
	 SETZ T2,		; OR COMMA
	IBP T4
	HRRZ T1,T4		; WHERE ARE WE GOING TO PUT THIS?
	CAIL T1,HSTNAM+NHSTN	; OFF END OF TABLE?
	 JRST FULL		; YES, SAY FULL
	DPB T2,T4		; STORE THE BYTE
	SOSLE STS		; DON'T STORE ANYMORE CHARACTERS
	 JUMPN T2,LUP1		; LOOP IF NOT THE END
	MOVE T1,JFN
	BKJFN			; GET THE TERMINATOR AGAIN
	 TRN
	MOVX STS,HS%NAM		; THIS HOST HAS A NAME
LUP2:	CALL GCH
	 JRST PEOF
LUP2A:	CAIN T2,.CHLFD
	 JRST LUP2X		; DONE IF END OF LINE
	CAIE T2,","		; SCAN UNTIL COMMA FOUND
	 JRST LUP2
	CALL GCH		; GET FIRST LETTER OF WORD
	 JRST PEOF
	CAIN T2,","
	 JRST LUP2A		; JUMP IF NULL WORD
	CAIN T2,12
	 JRST LUP2X		; DONE IF END OF LINE
	SETZ T1,		; PUT VALUE OF WORD HERE
	CAIN T2,"A"
	 MOVX T1,.HSANT
	CAIN T2,"D"
	 MOVX T1,.HSDEC
	CAIN T2,"E"
	 MOVX T1,.HSELF
	CAIN T2,"I"
	 MOVX T1,.HSITS
	CAIN T2,"M"
	 JRST [	CALL GCH
		 JRST PEOF
		CAIN T2,"U"
		 MOVX T1,.HSMLT
		CAIN T2,"T"
		 MOVX T1,.HSMTP
		JRST ELUP3]
	CAIN T2,"N"
	 JRST [	CALL GCH
		 JRST PEOF
		CAIN T2,"E"
		 MOVX T1,HS%NEW
		CAIN T2,"I"
		 MOVX T1,HS%NCK		;FLAG AS NICKNAME
		JRST ELUP3]
	CAIN T2,"S"
	 MOVX T1,HS%SRV
	CAIN T2,"T"
	 JRST [	CALL GCH
		 JRST PEOF
		CAIN T2,"E"
		 MOVX T1,.HS10X
		CAIN T2,"I"
		 MOVX T1,.HSTIP
		CAIN T2,"O"
		 MOVX T1,.HST20
		JRST ELUP3]
	CAIN T2,"U"
	 JRST [	CALL GCH
		 JRST PEOF
		CAIN T2,"N"
		 MOVX T1,.HSUNX
		CAIN T2,"S"
		 MOVX T1,HS%USR
		JRST ELUP3]
ELUP3:	HRLI T4,[ASCIZ /Unrecognized flag name/]
	JUMPE T1,SYNERR		; JUMP IF NO MATCH FOUND
	MOVX T2,HS%STY
	HRLI T4,[ASCIZ /Multiple system type specification/]
	TDNE T2,STS		; ALREADY HAVE A SYSTEM TYPE?
	TDNN T2,T1		; YES AND IS THIS TRYING TO SET IT?
	 TRNA
	  JRST SYNERR		; YES. ERROR
	IOR STS,T1		; ACCUMULATE BITS
	JRST LUP2		; AND SKIP TO COMMA/EOL

LUP2X:	STOR PTR,HSTNMP,(HN)	; STORE NAME POINTER
	MOVEI PTR,1-HSTNAM(T4)
	MOVX T4,<1B0>		; NICKNAME FLAG (MUST BE B0)
	TXZE STS,HS%NCK		; A NICKNAME?
	 IORM T4,HOSTN(HN)	; SET FLAGS
	HRRM STS,HSTSTS(DEV)	; STORE STATUS
	AOJA HN,LUP0
PEOF:	MOVE T1,JFN
	RFPTR
	 TRN
	MOVE T3,T2
	HRLI T4,[ASCIZ /Premature end of file/]
SYNERR:	HLRO T1,T4
	PSOUT
	HRROI T1,[ASCIZ / in host descriptor file
/]
	PSOUT
	MOVE T2,UNIT
	MOVE T1,JFN
	SFPTR			; SET BACK TO BEGINNING OF LINE
	 TRN
	SETO UNIT,
PERLP:	MOVE T1,JFN
	RFPTR
	 TRN
	CAME T2,T3
	 JRST PERLP1
	MOVEI T1,.PRIOU
	RFPOS
	HRRZ UNIT,T2
PERLP1:	MOVE T1,JFN
	CALL GCH1
	 MOVEI T2,.CHLFD
	CAIN T2,.CHLFD
	 JRST PERLPX
	MOVE T1,T2
	PBOUT
	JRST PERLP

PERLPX:	HRROI T1,[ASCIZ /
/]
	PSOUT
	JUMPLE UNIT,PMRK
	MOVEI T1," "
	PBOUT
	SOJG UNIT,.-1
PMRK:	MOVEI T1,"^"
	PBOUT
	HRROI T1,[ASCIZ /

/]
	PSOUT
	JRST LUP0

FULL:	HRROI T1,[ASCIZ /Host tables full before end of file
/]
	PSOUT
DONE:	CLOSF
	 TRN
	MOVNM HN,MHOSTS		; SAVE -NUMBER OF HOST NAMES
	CALL SWPMWE		; WRITE ENABLE SWAP MON
	MOVN HN,MHOSTS		; SWPMWE CLOBBERES IT
	HRLM HN,GTTAB+.HOSTN	; LENGTH OF HOSTN TABLE
	HRLM PTR,GTTAB+.HSTNA	; LENGTH OF HSTNAM TABLE
	CALL SWPMWP		; WRITE PROTECT
	RETSKP

GCH:	MOVE T1,JFN
	RFPTR
	 TRN
	MOVE T3,T2
GCH2:	CALL GCH1
	 RET
	CAIN T2,";"
	 JRST GCHSMC
	CAIE T2,.CHTAB
	CAIN T2," "
	 JRST GCH2
	RETSKP

GCH1:	CALL GBIN
	 RET
	CAIE T2,.CHCRT
	CAIN T2,.CHFFD
	 JRST GCH1
	RETSKP

GCHSMC:	CALL GBIN
	 RET
	CAIN T2,.CHLFD
	 RETSKP
	JRST GCHSMC

GBIN:	BIN				;GET A CHAR
	JUMPN T2,RSKP
	GTSTS				;NULL SO CHECK FOR ERR OR EOF
	TXNN T2,<GS%EOF+GS%ERR>
	 JRST GBIN			;FLUSH NULLS
	RET

	TNXEND
	END