SUBTTL	ARPANET NCP variables and tables

EBLK
IMPMQS==13.	;MESSAGE QUEUE SIZE (LENGTH WORD, 6-WORD LEADER, 6-WORD TEXT)
;MAIN PROGRAM CONTROL MESSAGE VARIABLES
IMPMPU:	-1	;-1 => FREE
	0	;SWTL THREAD
IMPMPL:	-1	;LINK WORD FOR CONTROL LINK QUEUE
IMPMPC:	BLOCK IMPMQS	;FIRST WORD HAS IMPHTB INDEX,,LENGTH OF TEXT

;PI CONTROL MESSAGE VARIABLES
IMNPIC==NNETCH+3	;NUMBER OF BLOCKS IN PI CONTROL QUEUE
;HOPEFULLY THIS IS ENOUGH.  THE CODE RESPONDS VERY UNGRACEFULLY TO THIS
;QUEUE FILLING UP.  IN PARTICULAR, WHEN IT HOLDS UP INPUT IT CAN CAUSE
;A DEADLOCK BY PREVENTING ITSELF FROM SEEING A CONTROL-LINK RFNM IT
;NEEDS IN ORDER TO SEND SOMETHING THAT'S IN THE QUEUE AND FREE UP SOME
;SPACE.  FURTHERMORE THE IMP IS UNGRACEFUL AND WILL SOMETIMES REFUSE TO
;READ INPUT FROM US (EVEN IN THE MIDDLE OF A MESSAGE) UNTIL WE READ
;INPUT FROM IT.  BUT WE DO THE SAME THING WHEN THIS QUEUE FILLS UP.
;FURTHERMORE SOMETIMES THE CORE JOB WILL WAIT FOR A NETWORK
;TRANSMISSION TO COMPLETE SO IT CAN MOVE A NETWORK BUFFER, HANGING THE
;ENTIRE SYSTEM.  THE CORE-JOB WILL UNHANG AFTER THE IMP TIMES OUT AND
;FLASHES ITS READY LINE (SEE IMPBER).
;** BUT SOMETIMES THE IMP NEVER TIMES OUT AND SO THE SYSTEM IS HUNG **

IMPCQ:	REPEAT IMNPIC-1,[
	.+IMPMQS+1	;POINTER TO NEXT FREE OR NEXT IN QUEUE
	BLOCK IMPMQS	;FIRST WORD HAS IMPHTB INDEX,,LENGTH OF TEXT
]
	-1
	BLOCK IMPMQS
IMPNCQ:	-1	;NEXT ENTRY TO BE SENT.  -1 IF NONE
IMPLCQ:	-1	;POINTER TO LAST ENTRY IN CONTROL QUEUE
IMFFCQ:	IMPCQ	;POINTER TO FIRST FREE.  -1 IF NONE
IMFCQL:	IMNPIC	;NUMBER FREE CONTROL QUEUE ENTRIES LEFT

;PENDING RFC QUEUE
IMNPQ==20	;NUMBER OF PENDING QUEUE ENTRIES
;(0)	POINTER TO NEXT IN CHAIN OR NEXT FREE.  -1 IF NONE
;(1)	LOCAL SOCKET NUMBER
;(2)	FOREIGN SOCKET NUMBER
;(3)	4.9 = 1 => RTS  = 0 => STR
;	1.1-1.8 = LINK NUMBER OR BYTE SIZE
;	1.9-2.7 = FOREIGN HOST NUMBER
;	3.1-3.9 = TIME RFC RECEIVED, IN SECONDS MOD 512.
	IMPPQ		;IMPBPQ-1 IS BEGINNING OF GETSYS BLOCK, THIS WORD FOR UNRELOCATION
IMPBPQ:	-1	;BEGINNING OF PENDING QUEUE.  -1 IF EMPTY
IMPPQ:	REPEAT IMNPQ-1,[
	.+4
	BLOCK 3
]
	-1
	BLOCK 3
IMPEPQ:	-1	;END OF PENDING QUEUE.  -1 IF EMPTY (IMPEPQ IS END FOR GETSYS BLOCK)
IMFFPQ:	IMPPQ	;FIRST FREE PENDING QUEUE ENTRY.  -1 IF NONE

;SOCKET TABLE

IMSOKB:	IMPSTL		;BEGIN OF GETSYS BLOCK, LENGTH STORED HERE

IMSOC1:	REPEAT IMPSTL,0		;0 => FREE
				;>0 MEANS ALLOCATED, NOT SET UP YET
				;4.9 = 1 => SOCKET IN USE
				;4.8 = 1 => CHNL TRYING TO BE CLOSED
				;3.1-4.7 = MASK FOR CHANNEL SOCKET IS OPEN ON.
				;RH = USER INDEX

IMSOC2:	BLOCK IMPSTL		;1.1-4.5 = LOCAL SOCKET NUMBER
				;4.6-4.9  0 (MAKES COMPARISONS EASIER)
IMSOC3:	BLOCK IMPSTL		;1.1-4.5 = FOREIGN SOCKET NUMBER
				;4.6-4.9 = 0
IMSOC4:	BLOCK IMPSTL		;3.1-3.8 = LINK NUMBER
				;3.9-4.7 = FOREIGN HOST NUMBER (IMPHTB INDEX)
				;	   377 MEANS NOT USING ANY HOST
				;4.8 = SET BY RCV CLS - MAKES MATCH USING IMSCHD FAIL
				;4.9 = SEND THIS BUFFER NOW
	.SEE %NS		;RH = SOCKET STATE
IMSOC5:	BLOCK IMPSTL		;1.1 - 1.9 => TTY # OF STY, IF CONNECTED TO ONE.
				;2.1-2.9 = CLOSE-REASON
				;3.1-3.8 = CONNECTION BYTE SIZE
				;3.9 => ASCII MODE - 7 BIT
				;4.1 => ASCII MODE - 8 BIT
				;4.2 => 1 BIT BYTES
				;4.3 => NET INT (INR\INS) RECEIVED
				;4.4 => HAVE BEGUN COUNTING THE CLOSE TIME-OUT.
				;4.5 => CLOSED WHILE IN RFNM WAIT, EXPECT ANOTHER RFNM
				;4.6 => CONNECTED DIRECTLY TO A STY.
				;4.7 => DON'T BUFFER MORE OUTPUT THAN ALLOCATION
				;4.8 => STY WANTS WAKEUP AT 1/2 SEC CLK
				;4.9 => TRANSFER IN 32 BIT MODE
IMSOC6:	BLOCK IMPSTL		;RH => BUFFER ADDRESS
				;4.9 => LOCKED BY CORE JOB
				;4.8 => ACTIVE AT PI LEVEL
				;4.7 => INPUT OCCURRED WHILE BUFFER LOCKED
				;3.1-3.8 => IOBFT INDEX (377 IF USING BIG BUFFER)
IMSOC7:	BLOCK IMPSTL		;BIT ALLOCATION
IMSOC8:	BLOCK IMPSTL		;MESSAGE ALLOCATION
IMSC7I:	BLOCK IMPSTL		;AMT TO INCREASE BIT ALLOCATION BY IN NEXT ALLOC MSG (INPUT)
				;FOR OUTPUT, HAS NUMBER OF BITS IN BUFFER
IMSC8I:	BLOCK IMPSTL		;AMT TO INCREASE MESSAGE ALLOCATION BY NEXT ALLOC MSG (INPUT)
IMSOCT:	BLOCK IMPSTL		;TIME WHEN FIRST MESS PUT INTO BUF
				;(DURING INPUT HAS NUMBER OF DATA BYTES LEFT IN CUR MSG)
				;(DURING CLOSE HAS TIME TIME-OUT STARTED)
IMSMPP:	BLOCK IMPSTL		;MAIN PROGRAM POINTER, ILDB OR IDPB FOR NEXT BYTE
IMSMPC:	BLOCK IMPSTL		;MAIN PROGRAM COUNTER, FOR OUTPUT HAS NUMBER OF DATA
				; BYTES OF ROOM LEFT IN BUFFER.  FOR INPUT HAS TOTAL
				; NUMBER OF DATA BYTES IN BUFFER.
IMSPIP:	BLOCK IMPSTL		;INTERRUPT LEVEL POINTER, FOR OUTPUT ILDB TO GET NEXT
				; BYTE OUT AT P.I. LEVEL.  FOR INPUT POINTS TO WHERE
				; HEADER WORD OF NEXT MESSAGE IN WILL BE STORED.
IMSBFE:	BLOCK IMPSTL		;BYTE POINTER TO LAST BYTE IN BUFFER
				;USE CAILE X,@IMSBFE(I) TO CHECK A WORD ADDRESS
IMSOKE==.-1		;END OF BLOCK FOR GETSYS CALL

BBLK

IMSCLN:	221000,,IMSOC4(I)	;LINK NUMBER
IMSCBS:	221000,,IMSOC5(I)	;BYTE SIZE
IMSCLS:	111100,,IMSOC5(I)	;CLOSE REASON
IMSCFH:	321000,,IMSOC4(I)	;FOREIGN HOST
IMSCHD:	222100,,IMSOC4(I)	;FOREIGN HOST AND LINK NUMBER
				; EXTRA BIT, SET WHEN RCV CLS
IMSCHL:	222000,,IMSOC4(I)	;FOREIGN HOST AND LINK WITHOUT EXTRA BIT

NTRFCL:	SIXBIT /NETRFC/		;FOR ICP ON ANY SOCKET < 1000
EBLK
	0

NETSRS==1000	;SMALLEST USER RECEIVE SOCKET NUMBER
NRSOC:	NETSRS	;NUMBER OF NEXT RECEIVE SOCKET TO BE GENERATED
NETOSW:	-1	;SWITCH LOCKED AT NET OPEN
	0
NETHSW:	-1	;SWITCH LOCKED IF HACKING HOST TABLE (IMPHTB)
	0
NETLST:	0	;LIST OF USERS IN NETWORK OPEN CODE

;INPUT BUFFER FORMAT:
;THE BUFFER IS CIRCULAR, AND EITHER 200 OR 2000 WORDS LONG.
;MAY CONTAIN SEVERAL MESSAGES.  EACH CONSISTS OF A HEADER WORD CONTAINING
; THE NUMBER OF BYTES IN THE MESSAGE, FOLLOWED BY THE BYTES, FOLLOWED BY
; UNUSED BITS UP TO THE NEXT WORD BOUNDARY.  THIS WEIRD FORMAT IS USED
; TO AVOID HAVING TO DO BYTE OPERATIONS AT P.I. LEVEL.
;A HEADER WORD OF -1 MEANS THAT THAT MESSAGE HAS NOT YET BEEN STORED.
;IMSPIP(I) ALWAYS CONTAINS THE ADDRESS OF A HEADER WORD OF -1.
;IMSMPP(I) HAS A BYTE POINTER TO THE NEXT DATA BYTE TO BE READ.
;P.I. LEVEL CAN STORE A MESSAGE INTO THE PART OF THE BUFFER FROM
;@IMSPIP TO @IMSMPP-1.
;IMSOCT(I) HAS THE NUMBER OF BYTES THAT MAIN PROGRAM LEVEL CAN
; READ BEFORE IT GETS TO THE END OF THE CURRENT MESSAGE AND HAS
; TO CHECK THE NEXT HEADER.
;IMSMPC(I) HAS THE TOTAL NUMBER OF DATA BYTES IN ALL THE MESSAGES
; IN THE BUFFER.

;OUTPUT BUFFER FORMAT:
;THE BUFFER IS CIRCULAR, AND EITHER 200 OR 2000 WORDS LONG.
;IT SIMPLY CONTAINS A STRING OF BYTES.
;IMSMPP(I) HAS A BYTE POINTER TO WHERE THE NEXT BYTE TO BE OUTPUT WILL BE DEPOSITED.
;IMSPIP(I) HAS A BYTE POINTER TO WHERE THE NEXT BYTE TO BE SENT OUT AT P.I.
; LEVEL WILL COME FROM.  P.I. LEVEL TRIES TO KEEP EVERYTHING ALIGNED ON
; WORD BOUNDARIES SO THAT IT DOESN'T HAVE TO DO BYTE OPERATIONS.
;IMSMPC(I) HAS THE NUMBER OF BYTES THAT MP LEVEL MAY STORE BEFORE RUNNING
; INTO OLD BYTES THAT HAVEN'T YET BEEN TRANSMITTED.
;IMSOCT(I) IS SET TO THE TIME THE FIRST BYTE IS PUT INTO THE BUFFER.
; IT IS CLEARED WHENEVER THE BUFFER GETS EMPTIED.

BBLK

SUBTTL	ARPANET NCP Main Prog system call routines

;NET .CALL RCHST/RFNAME
NETRCH:	MOVEI W,8		;WE RETURN 8 VALUES.
	HRRE I,A
	JUMPL I,NETRC3		;NET WENT DOWN AFTER THIS CHANNEL WAS OPENED.
	MOVE B,IMSOC2(I)	;LOCAL SOCKET NUMBER
	MOVE C,IMSOC3(I)	;FOREIGN SOCKET NUMBER
	LDB TT,IMSCFH		;FOREIGN HOST FOR 4TH WORD.
	CAIN TT,377
	 TDZA D,D		; 377 MEANS NOT USING ANY HOST
IFN 1,[
	  JRST [MOVE D,A
		MOVE A,IMPHTN(TT)	; Get host addr
		TLO A,(NW%ARP)		; Make full HOSTS3 format
		CALL CVH2NA		; Convert to HOSTS2 for compatibility
		EXCH A,D
		JRST .+1]
] ;IFN 1
IFN 0,[
	 TDZA Q,Q
	  MOVE Q,IMPHTN(TT)
	LDB D,[112000,,Q]	;TRANSLATE NEW HOST NUMBER TO OLD
	ANDI Q,377		;IF IT WILL FIT IN OLD NOTATION
	CAIGE D,100
	 CAIL Q,4
	  SKIPA D,IMPHTN(TT)
	   DPB Q,[060200,,D]
] ;IFN 0

	LDB Q,IMSCBS		;GET BYTE SIZE FOR HERE AND BELOW
;FOLLOWING LINE HAS BEEN PUNTED, AN INCOMPATIBLE CHANGE
;	DPB Q,[111100,,D]	;INTO 2.9-2.1 OF 4TH WORD
	MOVE A,IMSOC5(I)	;RANDOM WORD
	TLNE A,4000		;SKIP IF 4.3 BIT OFF (NETWRK INT)
	 TLO D,400000		;SET FOR USER
	PUSHJ P,NETRC1		;GET TIME IMP GOING DOWN,
	HRR TT,IMSOC4(I)	;MERGE IN SOCKET STATE.
	IMUL Q,IMSMPC(I)	;MULTIPLY BYTE SIZE BY BYTES AVAIL TO GET BITS AVAIL
	LDB I,IMSCLS		;CLS REASON
	POPJ P,

NETRC3:	MOVEI I,%NCNCP		;GIVE CLOSE REASON THAT OUR NCP WENT DOWN.
NETRC1:	SKIPG TT,IMPDWN+1	;SYS TIME AT WHICH IMP IS GOING DOWN
	 JRST NETRC2
	SUB TT,TIME		;(TIME TIL IMP DOWN -1=NOT. 0=DOWN, +=GOING DOWN, N/30. SEC)
	SKIPG TT
	 MOVEI TT,1		;IF SET TO GO DOWN, AND TIME "PASSED", SAY SOON IF NOT ALREADY DOWN
NETRC2:	HRLZS TT
	POPJ P,

;NET .CALL STATUS - SOCKET STATE IN BITS 2.4-2.9
STANET:	TRNN A,400000		;SKIP IF NET WENT DOWN ON THIS LOSER
	 SKIPA E,IMSOC4(A)	;GET STATE
	  MOVEI E,0		;IF NCP WENT DOWN, STATE IS "CLOSED"
	DPB E,[140600,,D]
	POPJ P,

;NET .CALL RESET - ONLY RESETS "INT FM NETWORK" BIT (INR/INS)
NETRS:	HLRZ A,(R)		;GET LH IOCHNM
	MOVSI B,4000		;4.3 BIT
	TRNN A,400000		;SKIP IF SET TO -1 (NET WENT DOWN ON THIS CHAN)
	 ANDCAM B,IMSOC5(A)	;CLEAR BIT
	POPJ P,

;NET .CALL IOPUSH/IOPOP - ALTER THE CHANNEL-OPEN MASK IN IMSOC1.
NETIOP:	HRRZ T,UUAC(U)
	IMUL I,CHNBIT(T)	;PUSHING => 0; ELSE BIT FOR CHANNEL BEING POPPED.
	HLRZ T,(R)		;GET SOCKET TABLE IDX
	TRNN T,400000		;SKIP IF NET WENT DOWN ON THIS LOSER
	 DPB I,[222000,,IMSOC1(T)] ;STORE MASK AWAY.
	POPJ P,

;NET .CALL WHYINT
;RESULTS ARE %WYNET, SOCKET STATE, BYTES AVAIL, CLS REASON
NETWHY:	HRRE I,A		;GET IMSOC INDEX
	MOVEI A,%WYNET		;FIRST RESULT IS DEVICE CODE
	SETZB B,C		;SET UP RESULTS 2-4 IN CASE NCP WENT DOWN
	MOVEI D,%NCNCP
	JUMPL I,POPJ1		;RETURN IF NCP WENT DOWN ON THIS LOSER
	HRRZ B,IMSOC4(I)	;SECOND RESULT IS SOCKET STATE
	MOVE Q,IMSOC5(I)
	TLNE Q,4000
	 TLO B,400000		;SIGN OF SECOND RESULT SET IF NETWRK INT
	TLNE Q,40000		;DIRECT CONNECTED?
	 TDZA C,C		;YES, NO BYTES AVAILABLE FOR INPUT
	  MOVE C,IMSMPC(I)	;THIRD RESULT IS BYTES AVAILABLE
	LDB D,IMSCLS		;FOURTH RESULT IS CLOSE REASON
	JRST POPJ1

;AIDS TO NETWORK OPEN AND NETHST CALLS

;SET THINGS UP AND ALLOCATE AN IMSOC INDEX.
;SKIP RETURNS WITH NETLST AND IMSOC1(I) LOCKED.
;OR, RETURNS NO-SKIP WITH NOTHING LOCKED AND AN ERROR SIGNALLED.
NETO00:	PUSHJ P,LSTSET	;ADD THIS JOB TO LIST OF NET OPENERS
	    NETLST
	PUSHJ P,SWTL	;GET AN IMSOC ENTRY TO GC-PROTECT OUR IMPHTB ENTRY
	    NETOSW
	MOVSI I,-IMPSTL
	SKIPE IMSOC1(I)
	 AOBJN I,.-1
	JUMPG I,OPNL6	;DEVICE FULL
	MOVEI H,377	;NO HOST YET
	DPB H,IMSCFH
	HRRZM U,IMSOC1(I) ;IMSOC1 POSITIVE MEANS ALLOCATED BUT NOT INITED YET
	PUSHJ P,LSWPOP	;NETOSW
	PUSHJ P,LOSSET	;RETURN IMSOC ENTRY IF PCLSR
	    NETIRT
	JRST POPJ1

;LOSSET ROUTINE TO RETURN IMSOC ENTRY
NETIRT:	MOVE T,AC0S+I(U)
	HRRZ A,U
	CAME A,IMSOC1(T)
	 JRST 4,.
	SETZM IMSOC1(T)
	POPJ P,
	
;SUBROUTINE TO OPEN UP COMMUNICATIONS WITH THE DESIRED HOST.
;ENTER WITH HOST NUMBER IN SRN3(U), SKIP-RETURN WITH HOST
;UP AND IMPHTB INDEX IN H AND IMSCFH.  OR NON-SKIP RETURN WITH ERROR SIGNALLED.
NETOR:	MOVE T,SRN3(U)	;USER-SPECIFIED HOST NUMBER
	JSP J,STDHST	;STANDARDIZE, OPNL25 IF IT IS NO GOOD
	CONO PI,NETOFF
	PUSHJ P,FNDHST	;H GETS HOST TABLE INDEX
	 JRST OPNL6	;DEVICE FULL (HOST TABLE FULL)
	DPB H,IMSCFH	;PROTECT IN IMSOC4
	CONO PI,NETON
	PUSHJ P,SWTL	;POSSIBLY SEND RST TO HOST OPENING CONNECTION TO
	    NETHSW
	LDB J,IMHSBT	;GET STATUS
	SOJG J,NETORS	;-1 => DOWN, 0 => RST SENT, 1 => UP
	JUMPE J,NETOR1	;WAIT FOR REPLY
	PUSHJ P,NETOW	;WAIT FOR IMPMPC TO BE FREE
	LDB W,[051100,,TIME]
	DPB W,[221100,,IMPHTB(H)]
	MOVEI J,1
	DPB J,IMHSBT	;MARK AS SENT
	AOS IMRFCT
	PUSHJ P,STHSTM	;STORE HOST#, LINK 0 , MESSAGE TYPE 0
	MOVE W,[8_24.+1_8]	;BYTE SIZE = 8, BYTE COUNT = 1
	MOVEM W,IMPMPC+6
	MOVE W,[12._28.]	;RST
	MOVEM W,IMPMPC+7
	MOVEI W,1
	HRRM W,IMPMPC	;MESSAGE LENGTH
	PUSHJ P,IMPMPQ	;SEND IT OUT
NETOR1:	PUSHJ P,LSWPOP	;NETHSW
	PCLT
	MOVSI T,1000
	TDNE T,IMPHTB(H) ;RRP -> 2000,  DOWN -> 0000
	 PUSHJ P,UFLS
	LDB J,IMHSBT	;GET STATUS
	SOJL J,OPNL41	;HOST DOWN
	JUMPE J,NETOR	;TRY ALL THIS AGAIN
	JRST POPJ1	;HOST UP

NETORS:	PUSHJ P,LSWPOP	;NETHSW
	JRST POPJ1	;HOST IS UP

;NETWORK OPEN

;	.OPEN CH,BLK
;	ERROR RETURN
;	NORMAL RETURN

;BLK:	MODE BITS,,(SIXBIT /NET/)
;	LOCAL SOCKET NUMBER (1.1-4.5)
;	FOREIGN SOCKET NUMBER (1.1-4.5)
;	FOREIGN HOST NUMBER

;BLK:	3.1-3.3 => STANDARD ASCII/IMAGE, UNIT/BLOCK, INPUT/OUTPUT
;	3.4 = 1 => GENERATE UNIQUE LOCAL RECEIVE (SEND) SOCKET NUMBER
;	3.4 = 0 => USE LOCAL SOCKET NUMBER SPECIFIED IN BLK+1
;	3.5 => OPEN SOCKET IN LISTEN MODE
;	3.6 => IF IMAGE MODE, USE BYTE SIZE IN 4.1-4.6
;	       IF ASCII MODE, USE 8 BIT BYTES RATHER THAN 7
;	3.7 => USE BIG BUFFER (2000 WORDS INSTEAD OF 200)
;	3.8 => DON'T BUFFER MORE OUTPUT THAN ALLOCATION
;	4.1-4.6 = BYTE SIZE IN IMAGE MODE


;OPEN CODE
NETO:	SKIPN IMPUP
	 JRST NETOUP
	SKIPL IMPUP
	 JRST OPNL7	;DEVICE NOT READY
	CONO PI,NETOFF
	SKIPN IMPTCU
	 AOS IMPTCU
	CONO PI,NETON
	MOVSI I,SCLIMP
	IORM I,SUPCOR	;HAVE SYS JOB BRING UP THE NETWORK
	PCLT
	SKIPE IMPTCU	;WAIT WHILE IT TRIES TO COME UP
	 PUSHJ P,UFLS
	SKIPE IMPUP
	 JRST OPNL7	;LOSE IF NOT UP BY NOW
NETOUP:	TLZ A,740000	;IGNORE EXTRA BITS IN SOCKET NUMBERS
	TLZ B,740000
	PUSHJ P,NETO00	;INITIALIZE THINGS
	 POPJ P,	;NETWORK NOT UP OR FULL
	TLNE C,20	;SKIP IF NOT LISTEN
	 JRST NETO10
	PUSHJ P,NETOR	;DO RESET STUFF, OPEN COMMUNICATIONS WITH HOST
	 POPJ P,	;HOST DOWN OR ILLEGAL
	MOVE J,B	;CHECK GENDER OF FOREIGN SOCKET
	ROT J,-1
	XOR J,D
	JUMPGE J,OPNL2	;WRONG DIRECTION
;DROPS THROUGH
;DROPS IN
NETO10:	PUSHJ P,SWTL	;ONLY ONE PROCESS AT A TIME COMPARING SOCKET NUMBERS
	    NETOSW
	TLNN C,20	;SKIP IF LISTEN
	 PUSHJ P,NETOW	;GOBBLE MP CONTROL LINK BLOCK (FOR NETOS)
	TLNN C,10
	 JRST NETO1	;USE SOCKET NUMBER GIVEN IN WORD 2
	MOVEI A,10	;ADVANCE SYSTEM UNIQUE SOCKET NUMBER
	ADDB A,NRSOC
	SUBI A,10	;UNIQUE RECEIVE SOCKET NUMBER
	SKIPGE D	;SKIP IF OPEN IS FOR READ (RECEIVE)
	 IORI A,1	;MAKE INTO SEND SOCKET
	JRST NETO6

NETO1:	MOVE J,A	;USER SPECIFIED SOCKET NUMBER
	ROT J,-1	;J 4.9: 0 => RECEIVE  1 => SEND
	EQV J,D		;D 4.9: 0 => READ  1 => WRITE
	JUMPGE J,OPNL2	;WRONG DIRECTION
	MOVE J,A
	CAIL A,NETSRS	;SKIP IF SPECIAL SOCKET
	 TRZA J,7	;J HAS BASE OF SOCKET GROUP
	  MOVNI J,1	; OR -1 IF NOT IN A GROUP
	MOVSI Q,-IMPSTL
	MOVEI E,0
NETO2:	SKIPL W,IMSOC1(Q)
	 JRST NETO3	;NOT HOOKED UP
	CAMN A,IMSOC2(Q)
	 JRST NETO2A	;DUPLICATE LOCAL SOC #
	MOVE T,IMSOC2(Q)
	TRZ T,7
	CAMN J,T
	 JRST NETO4	;JUMP IF PART OF SOCKET GROUP
NETO3:	AOBJN Q,NETO2
	SKIPL J		;SKIP IF NOT PART OF A SOCKET GROUP
	 JUMPE E,OPNL23	;FOUND NO EVIDENCE THAT THIS GUY OWNS THIS GROUP
	JRST NETO6	;WINNING

NETO2A:	TLNN W,200000	;SKIP IF BEING CLOSED
	 JRST OPNL13	;NO, GIVE ERROR
	TLNN C,20
	 PUSHJ P,LSWPOP	;POP MP CONTROL LINK BLOCK
	PUSHJ P,LSWPOP	;NETOSW
	MOVSI T,200000
	PCLT
	TDNE T,IMSOC1(Q)
	 PUSHJ P,UFLS	;WAIT TILL CLOSED
	JRST NETO10	;TRY AGAIN

NETO4:	CAIE U,(W)
	 JRST OPNL23	;SOMEONE ELSE HAS IT
	MOVNI E,1	;OK IF NO OTHER CONFLICTS
	JRST NETO3

;HERE WITH SUITABLE LOCAL SOCKET IN A
NETO6:	TLNN C,4	;SKIP IF IMAGE MODE
	 JRST NETOC	;ASCII MODE
	MOVEI TT,36.
	TLNN C,40	;SKIP IF BYTE SIZE SUPPLIED
	 JRST NETOB
	LDB E,[330600,,C]	;USE USER SUPPLIED BYTE SIZE
	IDIVI E,36.	;TT GETS BYTE SIZE MOD 36.
	JUMPN TT,NETOB
	MOVEI TT,36.	;36 BITS ANYWAY
NETOB:	PUSH P,TT
	MOVEI E,36.
	IDIV E,TT	;36/BS
	JUMPE TT,NETOB1	;EXACT
	MOVEI E,32.
	IDIV E,(P)	;32/BS
	JUMPE TT,[MOVEI TT,400000	;32BIT MODE FLAG
		 JRST NETOB1]
	MOVEI TT,2000		;FUNNY BYTESIZE FLAG
NETOB1:	POP P,E		;BS
	ADD TT,E	;FLAGS+BS
	JRST NETOA

NETOC:	MOVEI TT,400410		;7 BIT
	TLNE C,40
	 MOVEI TT,401010	;8 BIT
NETOA:	TLNE C,200
	 TRO TT,100000		;DON'T BUFFER MORE OUTPUT THAN ALLOCATION
	HRLZM TT,IMSOC5(I)	;STORE FLAGS AND BC, CLEAR CLOSE REASON
	MOVEM A,IMSOC2(I)	;LOCAL SOCKET NUMBER
	MOVEM B,IMSOC3(I)	;FOREIGN SOCKET NUMBER
	SETZM IMSOCT(I)		;IF INPUT, NOT IN MIDDLE OF A MESSAGE
	MOVEI W,%NSRFS
	TLNE C,20		;3.5 LISTEN
	 MOVEI W,%NSLSN
	DPB H,[321000,,W]	;DON'T CHANGE HOST NUMBER FIELD OF IMSOC4
	MOVEM W,IMSOC4(I)	;SET INITIAL STATE, CLEAR FLAGS
	SKIPE IMSOC6(I)		;SKIP IF HAVEN'T ASSIGNED BUFFER YET
	 JRST 4,.
	PUSH P,A
	PUSH P,B
	PUSH P,D
NETOE1:	TLNN C,100		;LAST PLACE TO PCLSR (REALLY NETMW)
	 JRST NETOE7
	PUSHJ P,TCALL		;GET FULL-PAGE BUFFER
	    JRST IOMQ
	 JRST NETMW
	MOVEI W,MUNET
	DPB W,[MUR,,MEMBLT(A)]
	DPB I,[MNUMB,,MEMBLT(A)]
	LSH A,10.
	MOVE W,A		;BUFFER START ADDRESS
	HRLI W,377		;NOT AN IOBFT-TYPE BUFFER
	MOVEI A,1777(A)		;BUFFER END ADDRESS
	JRST NETOE4

NETOE7:	MOVEI D,NFNETC(I)
	PUSHJ P,TCALL
	    JRST IUTCO1		;GET 200-WD BUFFER
	 JRST NETMW		;NO MEM AVAIL
	LDB W,[IOSA,,IOBFT(A)]
	LSH W,6			;STARTING ADDRESS
	HRL W,A			;IOBFT INDEX
	MOVEI A,177(W)		;BUFFER END ADDRESS
NETOE4:	MOVEM A,IMSBFE(I)	;(LH WILL BE STORED LATER)
	MOVEM W,IMSOC6(I)
;CLEAR THE BUFFER FOR EASE IN DEBUGGING.  COMMENT USED TO CLAIM
;THAT CLEARING IT WAS NECESSARY IN ORDER TO OUTPUT CORRECT HEADERS,
;BUT THAT WAS FRAUDULENT SINCE HEADERS NEVER COME FROM THE BUFFER.
	MOVEI D,1(W)
	HRLI D,(W)
	SETZM (W)
	BLT D,(A)
	POP P,D
	POP P,B
	POP P,A
;DROPS THROUGH
;DROPS IN

	MOVSI Q,000100		;SET UP THE VARIOUS BYTE POINTERS
	LDB TT,IMSCBS		;TO POINT TO END OF BUFFER
	MOVE E,IMSOC5(I)	;SO ILDB WILL GET FIRST BYTE IN BUFFER
	TLNN E,2000		;SKIP IF ONE BIT BYTES
	 DPB TT,[300600,,Q]	;OTHERWISE USE USER BYTE SIZE
	SKIPGE E
	 TLO Q,040000		;32 BIT WORD ENDS 4 BITS OVER
	HRR Q,IMSBFE(I)
	MOVEM Q,IMSMPP(I)
	MOVEM Q,IMSPIP(I)
	MOVEM Q,IMSBFE(I)
	MOVE T,C		;GET 3.5 BIT OF C INTO
	LSH T,13.		;4.9 OF T
	JUMPL D,NETOE5		;JUMP IF SENDER
	SETOM (W)		;NULL FIRST HEADER WORD
	TLO Q,440000		;-> LEFT END OF WORD
	HRR Q,W
	MOVEM Q,IMSPIP(I)	;SET PI PNTR TO POINT TO FIRST MESSAGE HEADER
	SETZM IMSMPC(I)		;NO INPUT BYTES AVAILABLE YET
	MOVEI TT,20.		;MESSAGE ALLOCATION ALWAYS 20
	MOVEM TT,IMSOC8(I)
	HRRZ TT,IMSBFE(I)	;COMPUTE BIT ALLOCATION
	SUBI TT,2*20.(W)	;TT := # WORDS IN BUFFER, -1 FOR LUCK, -2 FOR EACH MSG
	SKIPGE IMSOC5(I)	; (-1 FOR HEADER WORD, AND -1 FOR BREAKAGE)
	 IMULI TT,32.		;CONVERT TO # BITS
	SKIPL IMSOC5(I)
	 IMULI TT,36.
	LDB Q,IMSCBS		;BREAKAGE WAS OVER-ESTIMATED BY 1 BYTE PER MSG
	IMULI Q,20.
	ADD TT,Q
	MOVEM TT,IMSOC7(I)	;STORE CORRECT BIT ALLOCATION
	SETZM IMSC8I(I)
	SETZM IMSC7I(I)
	MOVEI Q,2(I)		;LINK #
	DPB Q,IMSCLN		;STORE IN LINK # FIELD
	JRST NETOE6

NETOE5:	SETZM IMSOC7(I)		;INITIALIZE SENDER'S ALLOCATIONS
	SETZM IMSC7I(I)
	SETZM IMSOC8(I)
	HRRZ TT,IMSBFE(I)
	SUBI TT,(W)		;# BUFFER WORDS, -1 FOR LUCK
	SKIPGE IMSOC5(I)	;SKIP IF 36BIT
	 IMULI TT,32.		;ALLOW 32 BITS PER WORD
	SKIPL IMSOC5(I)
	 IMULI TT,36.		;OR 36 BITS PER WORD
	LDB E,IMSCBS
	IDIVM TT,E		;CONVERT TO NUMBER OF BYTES
	MOVEM E,IMSMPC(I)	;THAT MANY ARE FREE AT FIRST
NETOE6:	PUSHJ P,IMPSPQ		;SEARCH PENDING QUEUE (LEAVES UTCOFF)
	 JRST NETOG		;NOTHING THERE
	JUMPGE T,NETOH		;JUMP IF NOT LISTENING STATE
	MOVE W,2(Q)		;FOREIGN SOCKET NUMBER
	MOVEM W,IMSOC3(I)
	LDB H,[101000,,3(Q)]	;FOREIGN HOST IMPHTB INDEX
	DPB H,IMSCFH
	SKIPA W,[%NSRFC]
NETOH:	 MOVEI W,%NSOPN
	HRRM W,IMSOC4(I)
	JUMPGE D,NETOD1		;JUMP IF RECEIVER
	SKIPL W,3(Q)		;SKIP IF RTS, GET LINK #
	 JRST 4,.		;HE SENT STR
	DPB W,IMSCLN		;STORE LINK NUMBER
NETOD:	HRRZ Q,UUAC(U)		;CHANNEL OPEN ON
	MOVE Q,CHNBIT(Q)
	PUSHJ P,IMPUIM		;INTERRUPT SELF
	JRST NETOG		;GO FINISH THE OPEN

NETOD1:	SKIPGE W,3(Q)		;SKIP IF STR, GET BYTE SIZE
	 JRST 4,.		;HE SENT RTS
	ANDI W,377
	LDB Q,IMSCBS
	CAMN W,Q
	 JRST NETOD		;BYTE SIZES DIFFER, LOSE
	PUSHJ P,IMPBRT		;RETURN THE BUFFER
	JRST OPNL22		;SELF-CONTRADICTORY OPEN?

NETOG:	HRRZ W,UUAC(U)
	MOVS W,CHNBIT(W)
	TLO W,400000		;IN USE
	HRR W,U			;SETZ+<<INT MASK>,,<USER WHO HAS SOCKET>>
	MOVEM W,IMSOC1(I)	;WE ARE NOW FULLY SET UP TO THIS SOCKET
	CONO PI,NETON
	TLNN C,20		;SKIP IF LISTENING TYPE SOCKET
	 PUSHJ P,NETOS		;SEND RFC (CAN'T HANG, ALREADY GOT NETOW)
	PUSHJ P,LSWPOP		;UNLOCK NETOSW, NOW THAT IMSOC1 4.9 IS SET
	PUSHJ P,LSWDEL		;UNLOCK IMSOC1(I)
	PUSHJ P,LSWPOP		;REMOVE FROM LIST OF NETWORK OPENS IN PROGRESS
	HRLZ A,I		;LEFT HALF OF IOCHNM GETS SOCKET INDEX
	HLRZS C
	JSP Q,OPSLC7
	    NETDUI,,NETDUO
	    NETDBI,,NETDBO
	    NETDUI,,NETDUO
	    NETDBI,,NETDBO

;GOBBLE MAIN PROGRAM CONTROL LINK BLOCK

NETOW:	JUMPL U,NETOW1		;FROM STYNET CLOCK LEVEL
	PCLT
	SKIPGE IMPHTB(H)	;SKIP IF NOT RFNM WAIT ON LINK 0
	 PUSHJ P,UFLS
	PUSHJ P,SWTL		;GRAB CONTROL LINK BLOCK
	    IMPMPU
	SKIPL IMPHTB(H)		;DID CTL LINK TO THIS HOST GET BACK INTO RFNM WAIT?
	 POPJ P,		;NO, OK
	PUSHJ P,LSWPOP		;YES, RELEASE RESOURCE WHILE AWAITING RFNM
	JRST NETOW

;FROM NETIDC (AT CLOCK INTERRUPT LEVEL)
NETOW1:	SKIPL IMPHTB(H)
	 AOSE IMPMPU
	  CAIA		;INPUT CAN'T BE READ YET.
	   POPJ P,
	CONO PI,NETOFF
	PUSHJ P,IMPUIN	;REACTIVATE SO WILL CHECK AGAIN
	SUB P,[2,,2]	;THROW THROUGH NETI6, NETID
	JRST NETOJ1	;TAKE NO-INPUT-AVAILABLE EXIT

;WAIT FOR MEMORY SO CAN ALLOCATE BUFFER

NETMW:	PCLT			
	MOVEI T,3
	CAMG T,LMEMFR
	 JRST [	PUSHJ P,UDELAY	;MAYBE MEMORY FROZEN, GIVE CORE JOB
		JRST NETOE1 ]	;A CHANCE TO PCLSR US, THEN TRY AGAIN
	CAMLE T,LMEMFR	;SKIP WHEN MORE THAN 3K FREE
	 PUSHJ P,UFLS
	JRST NETOE1

;SEND RFC AND MAYBE ALLOCATE.  IMSOC INDEX IN I, HOST INDEX IN H.

NETOS:	PUSHJ P,STHSTM		;STORE HOST ADDRESS IN IMPMPC+n, ALSO MESSAGE TYPE
	MOVE J,[8_24.+13._8]	;BYTE SIZE = 8, BYTE COUNT = 13.
	MOVEM J,IMPMPC+6
	MOVEI J,1_4		;3 NOPS + RTS
	SKIPGE D		;SKIP IF INPUT
	 MOVEI J,2_4		;3 NOPS + STR
	MOVEM J,IMPMPC+7
	LSH A,4			;LOCAL SOCKET NUMBER
	MOVEM A,IMPMPC+10
	LSH B,4			;FOREIGN SOCKET NUMBER
	MOVEM B,IMPMPC+11
	MOVEI TT,2(I)		;LINK NUMBER FOR RECEIVE SOCKET
	SKIPGE D
	 LDB TT,IMSCBS		;BYTE SIZE FOR SEND SOCKET
	LSH TT,28.
	HRRZ J,IMSOC4(I)
	CAIE J,%NSRFC
	 CAIN J,%NSOPN		;SKIP IF CONNECTION NOT YET OPEN
	  JUMPGE D,NETOS2	;JUMP IF CONNECTION OPEN AND READ
	MOVEM TT,IMPMPC+12
	MOVEI TT,4		;TEXT LENGTH
NETOS3:	HRRM TT,IMPMPC
	JRST IMPMPQ

NETOS2:	MOVEI J,<4_8>+2(I)	;NOP + ALL + LINK #
	LSH J,4
	IOR TT,J
	MOVEM TT,IMPMPC+12
	MOVE TT,IMSOC8(I)	;SEND MESSAGE ALLOC
	LSH TT,16.+4
	MOVEM TT,IMPMPC+13
	MOVE TT,IMSOC7(I)	;SEND BIT ALLOC
	LSH TT,16.+4
	MOVEM TT,IMPMPC+14
	MOVE TT,[8_24.+22._8]	;BYTE COUNT = 22.
	MOVEM TT,IMPMPC+6
	MOVEI TT,6		;MESSAGE LENGTH
	JRST NETOS3

;.NETAC CH,	;ACCEPT CONNECTION
;ERROR RETURN
;NORMAL RETURN

ANETAC:	JSP T,NETCHK
	HRRZ T,IMSOC4(I)	;SOCKET STATE
	CAIE T,%NSRFC
	 JRST OPNL41		;NOT IN RFC RECEIVED STATE
	LDB H,IMSCFH
	PUSHJ P,NETOW		;GET IMPMPC
	MOVE A,IMSOC2(I)	;LOCAL SOCKET NUMBER
	MOVE B,IMSOC3(I)	;FOREIGN SOCKET NUMBER
	MOVE D,A
	ROT D,-1
	PUSHJ P,NETOS		;SEND RFC (AND MAYBE ALL)
	CONO PI,NETOFF
	HRRZ T,IMSOC4(I)
	MOVEI TT,%NSOPN
	CAIN T,%NSRFC
	 HRRM TT,IMSOC4(I)	;CONNECTION OPEN
	JRST NETOJ1

NETCHK:	HRRZ A,(R)
	CAIL A,NETDUI
	CAILE A,NETDBO
	 JRST OPNL34	;NOT A NETWORK CHANNEL
	HLRE I,(R)	;SOCKET TABLE INDEX
	JUMPGE I,(T)
	JRST OPNL41	;OTHER END OF PIPELINE GONE (NET WENT DOWN)
	
;.NETS CH,	;SEND BUFFER NOW
;RETURN

NETFRC:	JSP T,NETCHK	;ENTRY FROM .CALL FORCE
	MOVE T,IMSOC2(I)
	TRNN T,1
	 JRST OPNL2	;NOT SEND SOCKET
	CONO PI,NETOFF
	MOVE T,IMSMPP(I)
	CAMN T,IMSPIP(I)
	 JRST NETOJ1	;BUF EMPTY
	MOVSI TT,400000	;TURN ON SEND BUFFER BIT
	IORM TT,IMSOC4(I)
	PUSHJ P,IMPOST	;TURNS NETON
	JRST POPJ1

NETFIN:	HRRZ TT,IMSBFE(I)	;ENTRY FROM .CALL FINISH (NETFRC HAS BEEN CALLED)
	SUB TT,IMSOC6(I)	.SEE NETOE5 ;FOR COMMENTS FOR THIS CODE
	HRRZS TT
	SKIPGE IMSOC5(I)
	 IMULI TT,32.
	SKIPL IMSOC5(I)
	 IMULI TT,36.
	LDB T,IMSCBS
	IDIVM TT,T		;T NOW HAS SIZE OF OUTPUT BUFFER IN BYTES
	CAME T,IMSMPC(I)	;WAIT FOR BUFFER TO EMPTY OUT
	 PUSHJ P,UFLS
	MOVEI T,%NSRFN		;WAIT FOR RFNM
	HLL T,IMSOC4(I)		;4.9 IS KNOWN TO BE OFF NOW!
	CAMN T,IMSOC4(I)
	 PUSHJ P,UFLS
	JRST POPJ1

;.NETINT CH,	;SEND NETWORK INTERRUPT "INR" OR "INS"
	;INR FROM RECEIVER TO SENDER (LOCAL SOCKET EVEN, FOREIGN ODD)
	;INS FROM SND TO RCV ( -", -")
;ALSO .CALL NETINT, ARG 1 IS CH

NNETINT:JSP T,NETCHK
	AOSA (P)	;GOING TO WIN, SKIP RETURN
ANETINT: JSP T,NETCHK	;I<- SOCKET TABLE INDEX
	LDB H,IMSCFH	;HOST INDEX FOR NETOW
	PUSHJ P,NETOW	;WAIT FOR IMPMPU
	MOVEI A,1	;SET COUNT
	MOVEM A,IMPMPC
	PUSHJ P,STHSTM	;STORE HOST ADDRESS
	MOVE A,[8_24.+2_8]	;BYTE SIZE 8, COUNT 2
	MOVEM A,IMPMPC+6
	MOVE A,IMSOC2(I)	;LCL SOCK #
	MOVSI B,7_10.	;INR
	TRNE A,1	;SKIP IF RCV
	 MOVSI B,8_10.	;INS
	LDB A,IMSCLN	;LINK #
	DPB A,[241000,,B]
	MOVEM B,IMPMPC+7
	JRST IMPMPQ	;QUE IT, START OUTPUT (IMPOST)

;STORE HOST ADDRESS FROM H INTO LEADER IN IMPMPC.  BASHES W, Q.
STHSTM:	MOVEI Q,IMPMPL
	HRLM H,IMPMPC		;ALSO SAVE HOST INDEX FOR PI LEVEL
;STORE HOST ADDRESS FROM H INTO LEADER IN (Q), BASHES W.
STHSTP:	MOVE W,IMPHTN(H)	;FOREIGN HOST NUMBER
IFN 1,	DPB W,[103000,,3(Q)]	; Store host address
IFN 0,[	DPB W,[301000,,3(Q)]	;STORE HOST NUMBER
	LSH W,-9
	DPB W,[102000,,3(Q)]	;STORE IMP NUMBER
] ;IFN 0
	MOVSI W,17_10.		;NEW-FORMAT FLAG
	MOVEM W,2(Q)		;MESSAGE TYPE 0 (LINK, ETC. ARE ALWAYS ZERO)
	POPJ P,

;.CALL NETBLK		;WAIT FOR STATE TO CHANGE OR TIME OUT
; ARG 1 - CHANNEL
; ARG 2 - STATE
; ARG 3 - TIME, AS IN .SLEEP (OPTIONAL) (WRITTEN BACK)
; VAL 1 - NEW STATE
; VAL 2 - TIME LEFT

ANETBLK:JSP T,NETCHK
	MOVE T,I	;SAVE INDEX IN T
	HRL T,B		;STATE ALSO
	CAIGE W,3	;SKIP IF 3 ARGS (TIME GIVEN)
	 JRST ANETB3	;USE DEFAULT TIME
	TLNE C,1000	;SKIP IF POINTER, RATHER THAN IMMEDIATE
	 JRST ANETB5
	XCTR XRW,[MOVES B,(C)]	;GET TIME FROM USER (CHECK WRITE ALSO)
	JUMPL B,ANETB1	;NEG MEANS ALREADY ABS TIME
	MOVNS B		;MAKE NEG
	SUB B,TIME	;-TIME TO GO TO
ANETB1:	UMOVEM B,(C)	;STORE NEG TIME FOR PCLSR
	MOVNS B		;MAKE +
ANETB4:	MOVEM B,EPDL(U)	;ALSO USED IN B LATER
	PUSHJ P,ANETB2	;SKIP IF STATE CHANGE OR TIMEOUT
	 PUSHJ P,UFLS
	SUB B,TIME	;HOW MUCH USED?
	HRRZ A,IMSOC4(I)	;RETURN STATE
	JRST POPJ1

ANETB2:	HLR A,T		;DESIRED STATE
	XOR A,IMSOC4(T)	;CURRENT STATE
	TRNE A,-1	;SKIP IF STILL MATCH
	 JRST POPJ1
	MOVE A,EPDL(U)	;SAVED TIME HERE
	CAMG A,TIME
	 AOS (P)	;TIME OUT!
	POPJ P,

ANETB3:	HRLOI B,377777	;NO TIME SUPPLIED, USE INFINITY
	JRST ANETB4

ANETB5: HRRZ B,C	;IMMEDIATE TIME SUPPLIED
	ADD B,TIME	;(TIMEOUT WILL RESTART ON EACH PCLSR, TOO BAD)
	JRST ANETB4

IFE INETP,[
;.CALL STYNET
;ARG 1 - STY CHANNEL
;ARG 2 - NET INPUT CHANNEL TO CONNECT STY OUTPUT TO, OR -1 TO DISCONNECT
;ARG 3 - NET OUTPUT CHANNEL TO CONNECT STY INPUT TO
;ARG 4 - CHARS TO SEND WHEN OUTPUT .RESET HAPPENS ON STY'S TTY
;	   UP TO 3 8-BIT CHARACTERS, LEFT JUSTIFIED.

NSTYNT:	TLNN R,%CLSST
	 JRST OPNL34		;1ST ARG NOT A STY CHANNEL.
	HLRZ I,(R)		;GET TTY # OF STY
	HRRES B			;ALLOW IMMEDIATE -1
	JUMPGE B,NSTYN2		;JUMP IF CONNECTING.
	PUSHJ P,NSTYN0		;DISCONNECT
	 JRST OPNL41		;WASN'T CONNECTED
	JRST POPJ1

;VARIOUS ROUTINES CALL HERE WITH THE TTY# OF A STY IN I, TO DISCONNECT THE
; STY FROM THE NETWORK.  NOTE THIS ROUTINE MUST NOT CHANGE U AND MUST NOT
; LSWCLR, SINCE IT COULD BE CALLED FROM IODCL VIA STYCLS OR NETCLS.

NSTYN0:	MOVSI B,%SSNET		;DISCONNECTING BOTH SIDES.
	CONO PI,NETOFF
	TDNN B,STYSTS-NFSTTY(I)
	 POPJ P,			;THIS STY NOT CONNECTED?
	ANDCAB B,STYSTS-NFSTTY(I)	;MARK AS NO LONGER CONNECTED
	MOVE C,STYNTL-NFSTTY(I)		;REMOVE THIS STY FROM ACTIVATION LIST
	MOVEI D,STYNTA-STYNTL+NFSTTY
NSTYN1:	CAMN I,STYNTL-NFSTTY(D)		;FIND THE STY THAT POINTS TO THIS ONE,
	 MOVEM C,STYNTL-NFSTTY(D)	;AND PATCH US OUT OF THE LIST.
	SKIPE D,STYNTL-NFSTTY(D) 	;SEARCH WHOLE LIST TILL FIND WHO POINTS TO US.
	 JRST NSTYN1
	SETOB C,STYNTL-NFSTTY(I)
	EXCH C,STYNTI-NFSTTY(I)	;MARK THIS STY AS HAVING NO CONNECTION, GET SOCKET INDICES
IFN CHAOSP,[
	TLNE B,%SSCHA
	 JRST [	MOVSI B,%SSCHA	;DISCONNECT FROM CHAOS NET
		ANDCAM B,STYSTS-NFSTTY(I)
		MOVSI B,%CFSTY
		TDNN B,CHSSTA(C)
		 JRST 4,.	;CHAOS DOESN'T THINK IT WAS CONNECTED?
		ANDCAM B,CHSSTA(C)
		JRST NETOJ1 ]
];CHAOSP
	MOVE B,[40000,,777]
	TDNN B,IMSOC5(C)
	 JRST 4,.		;SOCKET DOESN'T THINK IT WAS CONNECTED?
	ANDCAM B,IMSOC5(C)	;AND MARK SOCKETS WE WERE CONNECTED TO AS DISCONNECTED
	MOVSS C
	TDNN B,IMSOC5(C)
	 JRST 4,.		;SOCKET DOESN'T THINK IT WAS CONNECTED?
	ANDCAM B,IMSOC5(C)
	JRST NETOJ1

NSTYN2:	MOVE Q,I		;SAVE TTY # OF STY
	MOVEI E,1
	MOVE A,B		;DECODE THE NETWORK INPUT CHANNEL
	JSP T,CHNDCD
IFN CHAOSP,[
	HRRZ A,(R)
	CAIE A,CHAIDN
	 CAIN A,CHAODN
	  JRST [ HLRZ I,(R)	;CONNECT TO CHAOS NET
		 CONO PI,NETOFF
		 MOVSI B,%CFSTY
		 TDNE B,CHSSTA(I)
		  JRST OPNL23	;ALREADY CONNECTED, FILE LOCKED
		 MOVSI C,%SSNET+%SSCHA
		 TDNE C,STYSTS-NFSTTY(Q)
		  JRST OPNL23	;ALREADY CONNECTED, FILE LOCKED
		 IORM B,CHSSTA(I)	;OK, HOOK UP
		 DPB Q,[$CFTTN,,CHSSTA(I)]
		 JRST NSTYN3 ]
];CHAOSP
	JSP T,NETCHK	;TEST LEGALITY;  OPNL IF LOSES
	TDNE E,IMSOC2(I)
	 JRST OPNL2		;WRONG DIRECTION IF IT'S AN OUTPUT CHANNEL
	MOVE B,I		;SAVE INPUT IMSOC INDEX
	MOVE A,C		;DECODE OUTPUT CHANNEL
	JSP T,CHNDCD
	JSP T,NETCHK
	TDNN E,IMSOC2(I)
	 JRST OPNL2		;WRONG DIRECTION IF INPUT SOCKET
	CONO PI,NETOFF
	MOVE E,[40000,,777]
	TDNN E,IMSOC5(B)	;ERROR IF EITHER CHANNEL ALREADY CONNECTED
	 TDNE E,IMSOC5(I)
	  JRST OPNL23		;"FILE LOCKED"
	MOVSI C,%SSNET
	TDNE C,STYSTS-NFSTTY(Q)
	 JRST OPNL23		;SIMILAR ERROR IF STY ALREADY CONNECTED
	HRR E,Q			;GET 40000,,TTY #
	IORM E,IMSOC5(I)
	IORM E,IMSOC5(B)	;MARK SOCKETS AS CONNECTED
NSTYN3:	SKIPGE STYNTL-NFSTTY(Q)	;HALT IF STY'S VARS ARE NOT CORRECT FOR A 
	 SKIPL STYNTI-NFSTTY(Q)	;NON-CONNECTED STY.
	  JRST 4,.
	IORM C,STYSTS-NFSTTY(Q)	;ALL ERROR CAUGHT, SO MARK STY CONNECTED.
	HRL B,I			;PUT INPUT IMSOC IDX,, OUTPUT IMSOC IDX
	MOVSM B,STYNTI-NFSTTY(Q) ;INTO THE STY
	TRZ D,7777		;STORE THE OUTPUT RESET CHARACTERS - AT MOST 3
	MOVEM D,STYORC-NFSTTY(Q)
IFN CHAOSP,[			;ACTIVATE IN CASE HAS UNREAD INPUT
	TLNN C,%SSCHA
	 PUSHJ P,IMPUIN
	TLNE C,%SSCHA
	 PUSHJ P,CHINTI
];CHAOSP
.ELSE	PUSHJ P,IMPUIN
	JRST NETOJ1
] ;IFE INETP

SUBTTL	ARPANET MP I/O ROUTINES

IFE INETP,[
;CALL STYNTC AT CLOCK LEVEL TO PROCESS ALL NECESSARY TRANSFERS OF DATA
;BETWEEN CONNECTED STYS AND NET SOCKETS

STYNTC:	CONO PI,NETOFF
	SKIPN I,STYNTA		;GET HEAD OF ACTIVATE LIST
	 JRST NETONJ		;EMPTY
	SETZM STYNTA		;COPY LIST IN CASE A STY IS PUT BACK ON
	CONO PI,NETON
STYNT7:	MOVE A,STYNTL-NFSTTY(I)	;GET NEXT ON LIST
	MOVEM A,STYNTB		;SAVE FOR NEXT TIME AROUND LOOP
	SETOM STYNTL-NFSTTY(I)	;THIS ONE IS NO LONGER ON ACTIVATE LIST
	MOVE A,STYSTS-NFSTTY(I)
	TLNN A,%SSNET
	 JRST 4,.		;STY CLAIMS NOT TO BE CONNECTED??
	MOVE R,I		;SAVE TTY #
IFN CHAOSP,[
	TLNE A,%SSCHA
	 JRST STYCHA		;CONNECTED TO CHAOS NET
];CHAOSP
] ;IFE INETP
IFN INETP,STYNCP:

	SKIPGE TTYOAC(I)
	 JRST STYNT1		;NO OUTPUT, CHECK FOR INPUT
;HANDLE OUTPUT TO NET
	HRRZ I,STYNTI-NFSTTY(I)	;GET IMSOC IDX OF OUTPUT CHANNEL
	MOVSI A,40000
	TDNN A,IMSOC5(I)
	 JRST 4,.		;SOCKET CLAIMS NOT TO BE CONNECTED??
STYNT5:	CONO PI,NETOFF		;INCLUDES TTYOFF
	PUSHJ P,NSOSE0		;CAN WE OUTPUT TO NET NOW?
	 JRST STYNT6		;NO, WAIT TILL LATER, PI LVL WILL REACTIVATE WHEN STATE CHANGES
	LDB T,IMSCBS		;SINCE THIS IS PI LEVEL,
	MOVE Q,IMSOC7(I)	;NO POINT IN SENDING MORE OUTPUT THAN ALLOCATED
	SUB Q,IMSC7I(I)
	IDIVM Q,T		;T GETS NUMBER OF BYTES ALLOCATED AND NOT BUFFERED
	CAMLE E,T
	 MOVE E,T
	JUMPLE E,STYNT6		;NO ALLOC, SEND NOTHING
	EXCH R,I		;BEFORE EXCH, R HAS TTY #, I HAS NET IMSOC IDX
	MOVEM D,DBBBP		;SET UP BUFFER-POINTING VARS FOR TTY OUTPUT INTERRUPT LEVEL
	MOVEM E,DBBCC
	MOVEM E,DBBCC1
	PUSH P,R
	SETOM TYPNTF
	PUSHJ P,TYP		;OUTPUT THROUGH THOSE POINTERS, INTO THE NET CHNL BUFFER
	SETZM TYPNTF
	POP P,R
	EXCH I,R
	MOVE D,DBBBP
	MOVE E,DBBCC
	MOVE Q,DBBCC1
	PUSHJ P,NSOFIN		;FIGURE OUT HOW MANY CHARS WERE TYPED, AND UPDATE SOCKET.
	 JRST STYNT4		;MORE ROOM IN BUFFER => MAYBE TYPE SOME MORE.
	JRST STYNT6		;ELSE TRY INPUT FROM NET, BUT SEND WHATEVER WE GOT

STYNT4:	SKIPL TTYOAC(R)		;MORE OUTPUT IN TTY BUFFER?
	 JRST STYNT5		;YES, PROCESS IT
STYNT6:	PUSHJ P,NSOFN1		;NO, BE SURE NET BUFFER GETS SENT SOON

;HERE TO TRY TO HANDLE INPUT FROM NET
STYNT1:	HLRZ I,STYNTI-NFSTTY(R)	;INPUT IMSOC INDEX
	MOVSI A,40000
	TDNN A,IMSOC5(I)
	 JRST 4,.		;SOCKET CLAIMS NOT TO BE CONNECTED?
STYNT2:	PUSHJ P,NETIDC		;GET CHAR FROM NET SOCKET
	 JRST STYNT3		 ;GOT CHAR IN W
	 JRST STYNT8		 ;NO CHAR AVAIL, HANDLE OTHER STYS
				 ;2 SKIPS => GIVE UP, SPECIAL CHARACTER SEEN, OR BAD STATE
	PUSHJ P,IMPUIP		;WAKE UP THE TELNET SERVER
	MOVE I,R		;DISCONNECT THE STY AND SOCKETS
	PUSHJ P,NSTYN0
	 JRST 4,.
IFE INETP,[
STYNT8:	SKIPE I,STYNTB		;GET NEXT STY FROM COPIED ACTIVATION LIST
	 JRST STYNT7
	POPJ P,
] ;IFE INETP
.ELSE	JRST STYNT8

STYNT3:	EXCH I,R		;HERE IF GET CHAR FROM NET IN W.  I GETS TTY #.
	PUSH P,R
	PUSH P,I
	MOVE A,W
	CONO PI,TTYOFF
	PUSHJ P,NTYI5		;GIVE CHARACTER TO TTY INPUT INTERRUPT LEVEL.
	CONO PI,TTYON
	POP P,R			;TTY #;  POP IN REVERSE ORDER TO UNDO THE EXCH
	POP P,I			;IMSOC IDX
	JRST STYNT2		;TRY TO GET ANOTHER INPUT CHARACTER.

;STYNTC'S INTERFACE TO NET INPUT IOT.
;I HAS IMSOC IDX OF INPUT SOCKET.
;1 SKIP => NO DATA AVAILABLE.
;2 SKIPS => TELNET CONTROL CHARACTER FOUND, SO DISCONNECT STY AND
;INTERRUPT THE USER PROGRAM.
NETIDC:	MOVNI U,1		;U=-1 TELLS NETI IT CAME FROM HERE
	HRRZ H,IMSOC4(I)	;CHECK SOCKET STATE
	CAIN H,%NSOPN
	 JRST POPJ1		;NO DATA
	CAIGE H,%NSCLI		;SKIP IF IN ONE OF THE TWO INPUT AVAILABLE STATES
	 JRST POPJ2		;STATE IS ABNORMAL, SO DISCONNECT FROM STY.
	JRST NETID		;ELSE TRY AN IOT.

;NETWORK UNIT INPUT.
NETI:	HRRE I,A	;SOCKET TABLE INDEX
	JUMPL I,IOCER1
NETIB:	MOVE A,IMSOC5(I) ;ENTER HERE FROM BLOCK-MODE INPUT
	TLNE A,40000
	 JRST IOCR10	;CAN'T IOT AT M.P. LEVEL WHILE SOCKET CONNECTED TO A STY.
NETID:	MOVE A,IMSC8I(I)
	LDB B,IMSCBS
	IMUL B,IMSMPC(I)
	ADD B,IMSOC7(I)	;TOTAL NUMBER OF BITS YET TO BE READ
	CAIGE A,8.	;IF MESS REALL OF 8 OR MORE
	 CAMG B,IMSC7I(I) ;OR BIT REALL SATISFIES "DOUBLE BUFFERING" CRITERION
	  PUSHJ P,NETI6	;THEN SEND ALLOCATE
	JUMPL U,NETI4	;JUMP IF READING INPUT TO GIVE DIRECTLY TO A STY
NETI0:	CONO PI,NETOFF	;DON'T ALLOW INTO IMPUIN WHILE CHECKING STATE, #BITS
	HRRZ A,IMSOC4(I)
	JUMPE A,NETIB1	;CONNECTION CLOSED
	CAIE A,%NSINP
	 CAIN A,%NSCLI
	  JRST .+3
	   CAIE A,%NSOPN
	    JRST IOCR10		;SOCKET IN BAD STATE
	PCLT
	SKIPG IMSMPC(I) 	;WAIT FOR BITS TO ARRIVE
	 PUSHJ P,UFLS
	CONO PI,NETON	  	;NETON IN CASE DIDN'T UFLS
	SKIPG IMSMPC(I) 	;DID THEY?
	 JRST NETI0		;NO, STATE MUST HAVE CHANGED, CHECK IT AGAIN

NETI4:	SOSL IMSOCT(I)		;TAKE BYTE
	 JRST NETI4A
	MOVE A,IMSMPP(I)	;END OF MESSAGE, FIND ADDRESS OF NEXT HEADER WORD
	MOVEI A,1(A)		;WHICH IS IN NEXT WORD AFTER LAST BYTE LOADED
	CAILE A,@IMSBFE(I)
	 HRRZ A,IMSOC6(I)	;WRAP AROUND
	SOSGE B,(A)		;GET HEADER WORD, COUNT DOWN FOR BYTE ABOUT TO TAKE
	 JRST 4,.		;NO MESSAGE, ALTHOUGH IMSMPC > 0
	MOVEM B,IMSOCT(I)	;SAVE # BYTES LEFT IN THIS MESSAGE
	HLL A,IMSBFE(I)		;SET UP BYTE POINTER LH TO LAST BYTE IN WORD
	MOVEM A,IMSMPP(I)	; SO ILDB WILL GET FIRST DATA BYTE OF THIS MSG
	AOS IMSC8I(I)		;INCREASE MESSAGE ALLOCATION
NETI4A:	MOVE TT,IMSMPP(I)	;CHECK FOR WRAP-AROUND
	MOVE H,IMSOC5(I)
	TLNE H,2000
	 JRST NETI2		;JUMP IF ONE BIT BYTES
	CAMN TT,IMSBFE(I)
	 JRST [	HRRZ TT,IMSOC6(I)
		HLL TT,IMSPIP(I)	;B.P. TO FIRST BYTE IN BUFFER
		JRST .+1 ]
	ILDB W,TT
	JRST NETI3

NETI2:	LDB E,IMSCBS		;BITS PER BYTE
	MOVEI W,0
NETI1:	CAME TT,IMSBFE(I)
	 JRST NETI1A
	HRRZ TT,IMSOC6(I)	;WRAP AROUND
	HLL TT,IMSPIP(I)
NETI1A:	ILDB A,TT
	LSH W,1
	IORI W,(A)
	SOJG E,NETI1
;DROPS THROUGH
;DROPS IN

NETI3:	TRNN W,200		;IS THIS A TELNET CONTROL CHAR (>= 200)?
	 JRST NETI3A
	JUMPL U,[AOS IMSOCT(I)	;YES;  IF DIRECT-CONNECTED TO A STY, BREAK CONNECTION.
		 JRST POPJ2]	; WITHOUT GOBBLING THAT CHARACTER
	TLNE H,400		;IF 7-BIT ASCII MODE, REPLACE CHARACTER BY ^@.
	 SETZ W,
NETI3A:	MOVEM TT,IMSMPP(I)
	LDB TT,IMSCBS
	ADDM TT,IMSC7I(I)	;INCREASE BIT ALLOCATION
	CONO PI,NETOFF		;WHILE CHANGING STATE
	SOSLE IMSMPC(I)		;ONE LESS BYTE IN BUFFER
	 JRST NETONJ		;OK, THERE IS MORE IN BUFFER
	MOVNI E,1		;YES, STATE IS CHANGING.
	HRRZ A,IMSOC4(I)
	CAIN A,%NSCLI
	 MOVEI E,%NSCLS
	CAIN A,%NSINP
	 MOVEI E,%NSOPN		;NO INPUT AVAILABLE
	JUMPL E,[JRST 4,.]	;WAS IN SOME RANDOM STATE
	CAIN E,%NSCLS
	 PUSHJ P,IMPUIP		;IF STATE CHANGING TO "CLOSED", GIVE USER AN INTERRUPT.
	HRRM E,IMSOC4(I)
	JRST NETONJ

;COME HERE WHEN INPUT IOT FINDS THAT CONNECTION IS CLOSED
NETIB1:	CONO PI,NETON
	LDB D,IMSCLS
	CAIE D,%NCFRN
	 JRST IOCR10	;ABNORMAL CLOSURE, GIVE IOCER INSTEAD OF EOF
	MOVE TT,IMSOC5(I)
	POP P,D		;GET OUR RETURN ADDRESS.
	ANDI D,-1
	CAIE D,AIOT3	;IF WE ARE NOT DOING A UNIT MODE IOT,
	 JRST 1(D)	;JUST RETURN WITH 1 SKIP.
	TLNN TT,1400	;SKIP IF ASCII MODE
	 JRST IOCER2	;EOF IN IMAGE MODE IS IOCERROR.
	HRROI W,EOFCH	;EOF IN ASCII MODE RETURNS ^C.
	JRST 1(D)

NETI6:	HRRZ H,IMSOC4(I)	;SEND ALL MSG
	CAIE H,%NSINP
	 CAIN H,%NSOPN
	  CAIA
	   POPJ P,	;CLOSED, DON'T SEND ALLOCATE
	LDB H,IMSCFH	;HOST INDEX FOR NETOW
	PUSHJ P,NETOW	;GOBBLE MAIN PROG CONTROL LINK BLOCK
	MOVEI J,2(I)	;LINK #
	IORI J,<4_8>	;SEND ALLOC
	LSH J,16.
	ADD J,IMSC8I(I)
	LSH J,4
	MOVEM J,IMPMPC+7
	MOVE J,IMSC7I(I)
	LSH J,4
	MOVEM J,IMPMPC+10
	PUSHJ P,STHSTM		;STORE HOST ADDRESS, MESSAGE TYPE
	MOVE J,[8_24.+8_8]
	MOVEM J,IMPMPC+6
	MOVEI J,2
	HRRM J,IMPMPC	;TEXT LENGTH
	SETZB A,TT
	EXCH A,IMSC8I(I)
	EXCH TT,IMSC7I(I)
	ADDM A,IMSOC8(I)
	ADDM TT,IMSOC7(I)
	JRST IMPMPQ

;UNIT MODE NETWORK OUTPUT (DOESN'T CLOBBER C)
	JRST NETSIO	;SIOT VECTOR
NETW:	HRRE I,A	;SOCKET TABLE INDEX
	JUMPL I,IOCER1
	SKIPGE C
	 SKIPA A,(C)
	  UMOVE A,(C)
NETWB:	CONO PI,NETOFF		;BYTE TO OUTPUT IN A. HERE FROM BLOCK MODE.
	HRRZ B,IMSOC4(I)
	CAIE B,%NSOPN
	CAIN B,%NSRFN
	 JRST .+2
	  JRST IOCR10
	SKIPG IMSMPC(I)		;SKIP IF ROOM TO PUT BYTE IN BUF
	 JRST [	MOVSI B,400000
		IORM B,IMSOC4(I) ;SET TO SEND IT NOW
	IFN DMIMP,CONSZ FI,70
		 PUSHJ P,IMPIOS
		SKIPG IMSMPC(I)  ;WAIT FOR AT LEAST ONE BYTE OF ROOM
		 PUSHJ P,UFLS
		CONO PI,NETON
		SKIPG IMSMPC(I)
		 JRST NETWB	;NO ROOM, STATE MUST HAVE CHANGED
		JRST .+1]
	MOVE E,IMSOC5(I)
	MOVE T,IMSOC7(I)
	TLNE E,100000
	 CAML T,IMSC7I(I)
	  JRST NETW4
	MOVSI B,400000		;ALLOCATION USED UP (AND FEATURE ENABLED)
	IORM B,IMSOC4(I)	;SEND BUFFER NOW
	PUSHJ P,IMPOST
	CAMN T,IMSOC7(I)	;WAIT FOR DATA TO GO OUT OR ALLOC TO COME IN
	 PUSHJ P,UFLS
	JRST NETWB		;TRY AGAIN

NETW4:	MOVE T,IMSMPP(I)	;GET POINTER
	MOVE E,TIME
	CAMN T,IMSPIP(I)	;SKIP UNLESS BUFFER EMPTY
	 MOVEM E,IMSOCT(I)	;SET TIME FOR FIRST BITS INTO BUF
	LDB B,IMSCBS		;BYTE SIZE
	MOVE E,IMSOC5(I)	;FLAGS
	CONO PI,NETOFF		;WANT TO MUNG POINTERS WITHOUT PI INTERFERENCE
	TLNE E,2000		;SKIP IF BYTES FIT EXACTLY IN WORD
	 TLNN T,770000		;SKIP IF NOT AT RIGHT END OF WORD
	  JRST NETW2		;IDPB, CHECK FOR POINTER WRAP
	LDB TT,[360600,,T]	;GET BYTE POS
	CAML TT,B		;SKIP IF BYTE SPLITS ACROSS WORDS
	 JRST NETW1		;JUST DO IDPB
	DPB TT,[301400,,T]	;SET BYTE TO STORE IN RIGHT OF THIS WORD
	SUB TT,B		;=> -(# OVERFLOW BITS)
	ROT A,(TT)		;HIGH PART OF BYTE IN RIGHT END OF A
	DPB A,T			;STORE PART BYTE
	AOS T,IMSMPP(I)		;INCR TO NEXT WORD
	MOVEI E,(T)
	CAILE E,@IMSBFE(I)
	 HRR T,IMSOC6(I)	;WRAP
	MOVEM A,@T		;STASH REST OF BYTE IN LEFT PART OF NEXT WORD
	ADDI TT,36.		;SET TO NEW POSITION
	DPB TT,[360600,,T]	;NEW BYT POS
	MOVEM T,IMSMPP(I)	;STORE UPDATED PTR
	JRST NETW3		;WRAP UP

;DEPOSIT A BYTE WHICH MAY WRAP AROUND

NETW2:	CAME T,IMSBFE(I)
	 JRST NETW1		;NO WRAP
	HRR T,IMSOC6(I)
	TLO T,440000
	MOVEM T,IMSMPP(I)

;DEPOSIT BYTE KNOWN TO FIT IN WORD

NETW1:	IDPB A,IMSMPP(I)	;STORE IT

;COUNT THE BITS NOW

NETW3:	SOS IMSMPC(I)		;1 BYTE LESS FREE
	LDB T,IMSCBS
	ADDM T,IMSC7I(I)
	JRST NETONJ

;NETWORK OUTPUT SIOT
NETSIO:	CONO PI,NETOFF
	PUSHJ P,NSOSET		;SET UP FOR FAST SIOT
	 JRST NSIOT1		;CHANNEL ISN'T SET UP FOR IT => USE NORMAL SIOT LOOP.
	PUSH P,B
	PUSH P,C
NETSO0:	XCTR XRW,[MOVES B,@-1(P)]	;COPY ARGS
	XCTR XRW,[MOVES C,@(P)]
NETSO1:	IBP B		.SEE NSIOOL ;FOR WHY THIS HAIR IS NEEDED
	XCTRI XR,[MOVE TT,(B)]
	 SKIPA T,B
	  JRST NETSO3		;PAGE FAULT, CLEAN UP IMSMPP BEFORE TAKING IT
	HRRI T,TT
	LDB TT,T
	IDPB TT,D
	SOS E
	UMOVEM B,@-1(P)		;UPDATE USER'S ARGS
	XCTR XRW,[SOSLE C,@(P)]
	 JUMPG E,NETSO1		;LOOP IF BOTH USER AND SYSTEM WILLING
	SKIPL E
	 SKIPGE C
	  JRST 4,.		;WENT TOO FAR!!
	PUSHJ P,NSOFIN		;FINISH UP HACKING NET CHANNEL.
	 JRST NETSO2		;OUTPUT BUFFER HAS MORE ROOM
	JUMPLE C,PPBAJ1		;NO ROOM BUT DON'T WANT ANY MORE ANYWAY, SO RETURN
	SKIPG IMSMPC(I)		;NO ROOM, WAIT FOR SOME
	 PUSHJ P,UFLS		;NOTE ANY STATE CHANGE WILL UNHANG
	POP P,C			;NOW TRY TO SIOT SOME MORE
	POP P,B
	MOVE D,IOTTB(H)		;RESTORE D IN CASE GOES TO NSIOT1
	JRST NETSIO

NETSO3:	PUSHJ P,NSOFIN		;TOOK PAGE FAULT, CLEAN UP
	 JFCL
	PUSHJ P,TPFLT
NETSO2:	JUMPLE C,PPBAJ1		;BUFFER HAS ROOM BUT NO DESIRE TO SEND ANY MORE, RETURN
	CONO PI,NETOFF
	PUSHJ P,NSOSE0		;SET UP TO SEND MORE
	 JRST IOCR10		;STATE MUST HAVE GONE BAD
	JRST NETSO0		;OK, SEND MORE

;SET UP FOR NET OUTPUT SIOT, OR (NSOSE0) FOR DIRECT OUTPUT FROM STY.
;AT ENTRY, A HAS LH(IOCHNM).
;CALL WITH NETOFF, AND DON'T TURN IT BACK ON BEFORE CALLING NSOFIN,
;BECAUSE WE HAVE A COPY OF IMSMPP IN D, AND PI LEVEL MIGHT BE TRYING TO MUNG IT.
;SETS D TO POINTER, E TO COUNT OF CHARS OF SPACE, AND Q TO COPY OF COUNT.
;SETS I TO IMSOC IDX.  CLOBBERS T AND TT.
;NO SKIP => CAN'T USE FAST SIOT, OR CAN'T DO DIRECT OUTPUT AT THIS MOMENT.
;IN THAT CASE, D HASN'T BEEN CLOBBERED YET.
NSOSET:	HRRE I,A
	JUMPL I,IOCER1
NSOSE0:	MOVE E,IMSOC5(I)
	HRRZ T,IMSOC4(I)
	CAIE T,%NSOPN
	 CAIN T,%NSRFN		;STATE BAD, OR BYTES CROSS WORD BOUNDARIES,
	  TLNE E,2000
	   JRST NETONJ		;IMPLIES CAN'T WIN THIS WAY.
	SKIPG E,IMSMPC(I)
	 JRST NSOFN1		;JUMP IF BUFFER FULL, SET SEND BUFFER AND NETONJ
	MOVE D,IMSMPP(I)
	CAME D,IMSBFE(I)
	 JRST NSOSE2
	HRR D,IMSOC6(I)		;IF BUFFER STORING PTR POINTS AT END OF BUFFER,
	TLO D,440000		;WRAP AROUND.
NSOSE2:	LDB Q,IMSCBS
	MOVEI TT,36.
	SKIPGE IMSOC5(I)
	 MOVEI TT,32.
	IDIVM TT,Q		;GET # BYTES/WD OF CONNECTION.
	HRRZ TT,IMSBFE(I)
	SUBI TT,(D)
	IMUL TT,Q		;# BYTES BETWEEN POINTER AND END OF BUFFER.
	LDB T,[360600,,D]
	LDB Q,IMSCBS
	IDIVM T,Q		;# BYTES NOT STORED IN WORD POINTER POINTS AT
	ADD TT,Q		;THEY ARE AVAILABLE, TOO.
	CAML E,TT
	 MOVE E,TT		;GET MINIMUM OF FULL BYTES AND BYTES AFTER THE POINTER.
	MOVE T,TIME
	MOVE Q,IMSMPP(I)
	CAMN Q,IMSPIP(I)	;SKIP IF BUFFER NOT EMPTY
	 MOVEM T,IMSOCT(I)	;TIME FOR FIRST BITS INTO BUF.
	CAILE E,600		;DON'T LEAVE NETOFF FOR MORE THAN ONE CLOCK TICK OR SO
	 MOVEI E,600
	MOVE Q,E		;ORIGINAL E. (FOR NSOFIN)
	JRST POPJ1

;FINISH UP AFTER NET OUTPUT SIOT OR DIRECT OUTPUT FROM STY.
;SKIP IF BUFFER FULL
;ASSUME Q,I LEFT OVER FROM NSOSET, AND D,E ADVANCED BY STORING CHARS.
NSOFIN:	PI2SAF			;NETOFF SHOULD STILL BE IN EFFECT FROM NSOSET
	SUBM E,Q		;- <# BYTES XFERED>
	JUMPE Q,NETONJ		;IF OUTPUT NO BYTES, DON'T CHANGE IMSMPP (IMPORTANT!)
	MOVEM D,IMSMPP(I)	;UPDATE STORING POINTER OF SOCKET BUFFER
	LDB TT,IMSCBS
	IMUL TT,Q
	MOVNS TT
	ADDM TT,IMSC7I(I)	;INCREASE COUNT OF BITS IN BUFFER
	ADDB Q,IMSMPC(I)	;UPDATE COUNT OF FREE SPACE IN BUFFER.
	JUMPG Q,.+2		;ANY SPACE LEFT => NO SKIP.
	 AOS (P)		
	JUMPG E,NETONJ		;ONLY SEND BUFFER IF CALL OUTPUT ALL IT COULD
NSOFN1:	MOVSI TT,400000		;SEND BUFFER NOW.
	IORM TT,IMSOC4(I)
	JRST IMPOST		;TURNS NETON

NETBO:	HRRE I,A
	JUMPL I,IOCER1
	XCTR XRW,[MOVES D,(C)]	;TAKE TRAP GETTING POINTER IF SWAPPED OUT
	MOVE E,IMSOC5(I)
	TLNE E,1400	;SKIP IF IMAGE MODE
	 JRST NETBOA	;ASCII MODE
	JUMPGE D,CPOPJ		;TRANSFER NO WORDS
NETBO1:	UMOVEM D,(C)
	UMOVE A,(D)
	PUSHJ P,NETWB
	UMOVE D,(C)
	AOBJN D,NETBO1
	UMOVEM D,(C)
	POPJ P,

NETBOA:	TLNN E,400	;SKIP IF 7 BIT
	 JRST NETBA8
	MOVEI E,NETBOR
	JRST NBTOCH

NETBOR:	PUSH P,D
	PUSH P,TT
	PUSHJ P,NETWB
	POP P,TT
	POP P,D
	MOVEI E,NETBOR
	POPJ P,

NETBA8:	XCTR XRW,[MOVES D,(C)]
	LDB TT,[410300,,D]
	CAIGE TT,4	;ONLY 4 BYTES PER WORD (3 < CNT < 8)
	 POPJ P,
	SKIPA TT,NETCHT-4(TT)
NTBA8A:	 UMOVEM D,(C)
	UMOVE W,(D)
	ILDB A,TT
	PUSH P,TT
	PUSHJ P,NETWB
	POP P,TT
	UMOVE D,(C)
	ADD D,[700000,,]	;ADVANCE CHAR CNT
	JUMPL D,NTBA8A		;GO TO NEXT CHAR
	MOVE TT,NETCHT+3
	ADD D,[400001,,1]	;INCR TO NEXT WORD
	JUMPL D,NTBA8A
	UMOVEM D,(C)
	POPJ P,

NETCHT:	REPEAT 4,<44-<3-.RPCNT>*10>_12.+1000,,W

NETBI:	HRRE I,A
	JUMPL I,IOCER1
	XCTR XRW,[MOVES D,(C)]	;ENSURE POINTER WILL BE WRITABLE
	MOVE E,IMSOC5(I)
	TLNE E,1400	;SKIP IF IMAGE MODE
	 JRST NETBIA	;ASCII MODE
NETBI1:	UMOVEM D,(C)	;STORE BACK POINTER
	XCTR XRW,[MOVES (D)]	;ENSURE BYTE WILL BE WRITABLE
	PUSH P,C
	PUSHJ P,NETIB	;GET NEXT BYTE
	 CAIA		;NORMAL RETURN.
	  JRST POP1J	;NO INPUT AVAIL.
	POP P,C
	UMOVE D,(C)
	UMOVEM W,(D)
	AOBJN D,NETBI1
	UMOVEM D,(C)
	POPJ P,

NETBIA:	TLNN E,400	;SKIP IF 7 BIT ASCII
	 JRST NTBIA8
	MOVEI E,NETBIR
	JRST INBTCH

NETBIR:	PUSHJ P,NETI
	 JRST [ MOVEI E,NETBIR	;INPUT IN W
		POPJ P, ]
	MOVE E,[600000,,NETBCC] ;NO INPUT AVAIL
	JRST POPJ1

NETBCC:	MOVEI H,EOFCH
	JRST POPJ2

NTBIA8:	HRRZS E			;8-BIT ASCII BLOCK MODE
	XCTR XRW,[MOVES D,(C)]
	LDB TT,[410300,,D]
	CAIGE TT,4
	 POPJ P,
	SKIPA TT,NETCHT-4(TT)
NTBI8A:	 UMOVEM D,(C)
	XCTR XRW,[MOVES (D)]
	JUMPL E,NTBI8B
	PUSH P,C
	PUSH P,TT
	PUSHJ P,NETIB
	 JRST [ MOVEI E,0
		JRST NETBI5 ]	;NORMAL RETURN - BYTE IN W.
	MOVSI E,600000		;NO BYTES AVAIL - SOCKET CLOSED.
NETBI5:	MOVE H,W
	POP P,TT
	POP P,C
	UMOVE D,(C)
	LDB W,[410300,,D]
	CAIN W,7
	 TLNN E,200000
	  JRST NTBI8C
	POPJ P,
NTBI8C:	UMOVE W,(D)
	IDPB H,TT
	UMOVEM W,(D)
	ADD D,[700000,,]
	JUMPL D,NTBI8A
	MOVE TT,NETCHT+3
	ADD D,[400001,,1]
	SKIPL E
	 JUMPL D,NTBI8A
	UMOVEM D,(C)
	POPJ P,

NTBI8B:	MOVEI H,EOFCH
	UMOVE D,(C)
	JRST NTBI8C

NETCLS:	HRRE I,A	;SOCKET TABLE INDEX
	JUMPL I,CPOPJ
	MOVE T,IMSOC2(I)
	TRNN T,1	;SKIP IF SEND SOCKET
	 JRST NETCL2
	MOVSI T,400000
	IORM T,IMSOC4(I)	;CAUSE BUFFER TO BE SENT
	PUSHJ P,IMPOST
NETCL2:	MOVSI B,600000
	CONO PI,CLKOFF
	IORM B,IMSOC1(I)	;MARK CHANNEL TO BE CLOSED
	AOS IMNCS
	HRRZ R,UUAC(U)
	MOVE A,CHNBIT(R)
	TDNE A,MSKST2(U)
	 ANDCAM A,IFPIR(U)
	MOVE I,IMSOC5(I)	;IF CHANNEL CONNECTED TO A STY,
	TLNN I,40000
	 JRST CLKONJ
	ANDI I,777		;DISCONNECT THEM.
	PUSHJ P,NSTYN0
	 JRST 4,.
	JRST CLKONJ

;SEARCH PENDING QUEUE FOR LOCAL SOCKET NUMBER IN A,
;T 4.9 = 1 => LISTENING, 4.9 => 0 => ALSO CHECK
;FOREIGN SOCKET NUMBER IN B AND FOREIGN HOST NUMBER (IMPHTB INDEX) IN H
;SKIPS IF ENTRY IS FOUND.  RETURNS ENTRY TO FREE LIST.
;Q GETS ADDRESS OF ENTRY BLOCK.  RETURN WITH NETOFF

IMPSPQ:	CONO PI,NETOFF
IMSPQP:	SKIPGE Q,IMPBPQ	;BEGINNING OF QUEUE
	 POPJ P,	;QUEUE EMPTY
	MOVNI J,1	;PREVIOUS ENTRY
IMSPQL:	CAME A,1(Q)	;SKIP IF SAME LOCAL SOCKET NUMBER
	 JRST IMSPQ1	;TRY NEXT
	JUMPL T,IMSPQW	;WIN IF LISTENING SOCKET
	LDB W,[101000,,3(Q)]	;FOREIGN HOST IMPHTB INDEX
	CAMN W,H	;SKIP IF WRONG FOREIGN HOST
	 CAME B,2(Q)	;SKIP IF FOREIGN SOCKET NUMBER AGREES
	  JRST IMSPQ1	;TRY NEXT
IMSPQW:	SKIPGE W,(Q)	;FOUND IT
	 MOVEM J,IMPEPQ	;PATCH OUT OF THE QUEUE
	SKIPGE J
	 MOVEI J,IMPBPQ
	MOVEM W,(J)
	MOVE W,IMFFPQ	;ADD TO FREE LIST
	MOVEM W,(Q)
	MOVEM Q,IMFFPQ
	JRST POPJ1

IMSPQ1:	MOVE J,Q	;PREVIOUS ENTRY
	SKIPL Q,(Q)	;NEXT ENTRY
	 JRST IMSPQL	;LOOP
	POPJ P,		;NOT FOUND

SUBTTL	ARPANET CLOCK LEVEL

OVHMTR IMP	;NETWORK INTERRUPT LEVEL (NOT STYNET STUFF)

;HERE TO TIME OUT THE RFC QUEUE
IMFCT1:	CONO PI,NETOFF
	SKIPGE Q,IMPBPQ
	 JRST NETONJ	;... IF QUEUE IS EMPTY
	MOVNI J,1	;J HAS PTR TO PREV ELT OF LIST, FOR IMSPQW TO PATCH (DELQ).
IMFCT2:	LDB E,[221100,,3(Q)]	;TIME IN 16/15'THS, MOD 512., THAT RFC WAS RECEIVED
	LDB TT,[051100,,TIME]	;TIME, IN SAME UNITS, NOW.
	CAMLE E,TT		;MAKE SURE THE SUB TT,E GIVES A POSITIVE ANSWER.
	 ADDI TT,1_9		;WE ASSUME THAT TIME >= TIME OF RECEIPT.
	SUB TT,E
	CAIGE TT,IMFCTO_<-5>
	 JRST IMFCT3		;THIS RFC HASN'T TIMED OUT - LOOK AT NEXT
	PUSHJ P,IMSPQW		;IT HAS - FLUSH IT
	 JFCL
	JRST IMFCT1		;AND START AGAIN LOOKING FOR RFC'S TO FLUSH

IMFCT3:	MOVE J,Q
	SKIPL Q,(Q)
	 JRST IMFCT2
	JRST NETONJ	;END OF QUEUE

;FLUSH CLOSED NETWORK CHANNELS (CALLED AT HALF SEC CLOCK)
IMPCCL:	MOVSI I,-IMPSTL
IMPCCR:	CONO PI,NETON
	MOVSI T,200000
IMPCCZ:	TDNN T,IMSOC1(I)	;LOOK FOR CHANNELS NO LONGER OPEN.
	 AOBJN I,IMPCCZ
	JUMPL I,IMPCCA
	POPJ P,

IMPCCA:	CONO PI,NETOFF
	MOVE B,IMSOC6(I)
	TLNE B,600000	;ACTIVE AT PI LEVEL OR LOCKED BY CORE JOB
	 JRST IMPCCS
	HRRZ B,IMSOC4(I) ;DISPATCH ON SOCKET STATE.
	JRST @IMPCCT(B)

IMPCCT:	OFFSET -.
%NSCLS::IMPCC1
%NSLSN::IMPCC1
%NSRFC::IMPCC2
%NSRCL::IMPCC1
%NSRFS::IMPCC2
%NSOPN::IMPCC5
%NSRFN::IMPCC6
%NSCLW::IMPCC7
%NSCLI::IMPCC1
%NSINP::IMPCC2
	OFFSET 0

;IMP BUFFER RETURN
IMPBRT:	SKIPN IMSOC6(I)
	 POPJ P,	;NO BUF??
	LDB A,[221000,,IMSOC6(I)]
	CAIE A,377
	 JRST IMBRT1
	LDB A,[121000,,IMSOC6(I)]
	PUSHJ P,IMEMR
	CAIA
IMBRT1:	 PUSHJ P,IBRTN
	SETZM IMSOC6(I)
	POPJ P,

IMPCC1:	PUSHJ P,IMPBRT
	MOVSI A,20000
	TDNE A,IMSOC5(I)
	 JSP T,IMPC5D	;WAITING FOR FINAL RFNM
	SETZM IMSOC1(I)
	SOS IMNCS	;WE HAVE FINISHED CLOSING ONE SOCKET
IMPCCS:	AOBJN I,IMPCCR	;WE CLOSED ONE, OR GAVE UP ON ONE; LOOK AT NEXT
	JRST NETONJ	;OR WE'RE FINISHED LOOKING AT ALL.

IMPCC2:	PUSHJ P,IMPBRT
	SKIPLE T,IMFCQL
	 CAIG T,2	;SKIP IF MORE THAN 2 FREE
	  JRST IMPCCS	;NOT ENUF PI CONTROL QUEUE BLOCKS AVAIL
	LDB A,IMSCFH	;GET HOST#
	SKIPGE IMPHTB(A)	;SKIP IF NO RFNM WAIT ON LINK 0
	 JRST IMPCCS	;NOT NOW!
	PUSH P,IMPCSH
	MOVEM A,IMPCSH
	JSP T,IMSTCM
	    12.,,3	;12. BYTES, 3 WORDS
	 JRST 4,.	;NO SLOTS AVAIL.  CHECKED BEFORE
	MOVEI H,3_4	;3 NOPS + CLS
	MOVEM H,10(Q)
	MOVE H,IMSOC2(I)	;LOCAL SOCKET
	LSH H,4		;MOVE INTO 32 BIT FIELD
	MOVEM H,11(Q)
	MOVE H,IMSOC3(I)	;FOREIGN SOCKET
	LSH H,4
	MOVEM H,12(Q)
	PUSHJ P,IMWCQ	;SEND CLS
	POP P,IMPCSH
	MOVEI H,%NSCLW
	HRRM H,IMSOC4(I)
	MOVE H,TIME
	MOVEM H,IMSOCT(I)	;TIME CLS SENT
	JRST IMPCCS

IMPCC5:	MOVE H,IMSOC2(I)
	TRNN H,1	;SKIP IF SEND SOCKET
	 JRST IMPC5B	;RECEIVE SOCKET
	MOVE A,IMSPIP(I)
	CAMN A,IMSMPP(I) ;IS THERE STILL DATA TO SEND? AT MP LEVEL
	 CAMN I,IMPOPI	;OR PI LEVEL? OR RFNM WAIT?
IMPCC6:	  JSP T,IMPC5D	;YES, SEND IT AND GET RFNM BEFORE SENDING CLS
IMPC5B:	MOVEI H,%NSRFS	;NO, OK TO SEND A CLS NOW.
	HRRM H,IMSOC4(I);SET STATE SO WILL LOOP BACK TO IMPCC2
	JRST @IMPCCT(H)

IMPC5A:	IORM H,IMSOC5(I)
	MOVE H,TIME
	MOVEM H,IMSOCT(I)
	JRST IMPCCS

IMPC5D:	MOVSI H,10000
	TDNN H,IMSOC5(I)
	 JRST IMPC5A	;TIME-OUT NOT ALREADY STARTED - START IT.
IMPC7A:	MOVE H,TIME	;ALREADY STARTED, OVER YET?
	SUB H,IMSOCT(I)
	CAIG H,IMPCTO	;SKIP IF TIMED OUT
	 JRST IMPCCS	;NOT YET
	JRST (T)

IMPCC7:	JSP T,IMPC7A	;IF CLOSE TIME-OUT ISN'T UP, GIVE UP TO IMPCCS.
	JRST IMPCC1	;ELSE FLUSH.

;HERE FROM 1/2 SECOND CLOCK IF IMNAS IS NON-ZERO.
;WE WAKE UP ANY STYNET CHANNELS THAT NEED IT.
IMPAAA:	SOS IMNAS	;DECREASE NEED-THIS-ROUTINE COUNT
	MOVSI I,-IMPSTL
IMPAA1:	MOVSI T,200000
	TDNN T,IMSOC5(I)
	 AOBJN I,.-1
	JUMPGE I,CPOPJ
	CONO PI,NETOFF
	ANDCAM T,IMSOC5(I)
	PUSHJ P,IMPUIN
	CONO PI,NETON
	JRST IMPAA1

SUBTTL	ARPANET NCP INPUT INTERRUPT LEVEL

;GET HERE PI IN PROG ON NETCHN
;IMP HAS NETCHN PIA, TT HAS CONI WORD, A HAS LAST WD OF CONTROL LINK MSG
;PROCESS THE CONTROL LINK HOST-HOST PROTOCOL OPCODES.
IMPBK3:	AOS B,IMBLKI	;STORE LAST WORD AS IF BLKI HAD
	MOVEM A,(B)
	MOVEI B,-IMPINB+1(B)	;B HAS NUMBER OF WORDS READ
	CAMGE B,IMPNIW
	 JRST IMPCIS	;MESSAGE IS SHORT
	MOVE A,IMPCBC	;NUMBER OF BYTES
	MOVE B,[441000,,IMPINB]	;8 BIT BYTE POINTER TO MESSAGE
	SETZM IMPNEA
	SETZM IMPNRA
IMPBKL:	SOJL A,IMPIR1	;LOOP HERE TO PROCESS CONTROL MESSAGE
	MOVE H,IMPCSH	;RESTORE HOST INDEX
	ILDB C,B
	CAIL C,IMPCDL
	 JRST IMPCIG	;ILLEGAL OPCODE
	AOS IMPCMR(C)	;COUNT CTL MSG RCD
	JRST @IMPCDT(C)	;DISPATCH ON OPCODE

IMPCIG:	BUG INFO,[NET: NEW CTL MSG FM HST ],OCT,IMPHTN(H),[COD=],OCT,C,[CT=],OCT,A
	JRST IMPIR1

IMPCIS:	MOVE H,IMPCSH
	BUG INFO,[NET: SHORT CTL MSG FM HST ],OCT,IMPHTN(H)
	AOS IMNSCM
	JRST IMPIR1

IMPCDT:	IMPBKL	;NOP	( 0)
	IMPRFC	;RTS	( 1)
	IMPRFC	;STR	( 2)
	IMPCLS	;CLS	( 3)
	IMPALL	;ALL	( 4)
	IMPCIG	;GVB	( 5)
	IMPCIG	;RET	( 6)
	IMPINR	;INR	( 7)
	IMPINS	;INS	(10)
	IMPECO	;ECO	(11)
	IMPCIG	;ERP	(12)
	IMPERM	;ERR	(13)
	IMPRST	;RST	(14)
	IMPRRP	;RRP	(15)
	IMPCIG	;RAR	(16)
	IMPCIG	;RAS	(17)
	IMPCIG	;RAP	(20)
	IMPNXR	;NXR	(21)
	IMPNXR	;NXS	(22)
IMPCDL==.-IMPCDT

IMSHRT:	MOVNS A
	BUG INFO,[NET: SHORT CTL MSG HST ],OCT,IMPHTN(H),[COD=],OCT,C,[MISSING],OCT,A
	JRST IMPIR1

IMPNXR:	ILDB C,B	;LINK NUMBER FOR NXR OR NXS
	SOJA A,IMPBKL	;JUST IGNORE IT, USELESS ANYWAY

;RFC RECEIVED  C HAS OPCODE
IMPRFC:	SUBI A,9	;MUST BE AT LEAST 9 MORE BYTES
	JUMPL A,IMSHRT	;MESSAGE IS SHORT
	ILDB D,B	;D GETS 32 BIT FOREIGN SOCKET NUMBER
REPEAT 3,[
	LSH D,8
	ILDB T,B
	IORI D,(T)
]
	ILDB E,B	;E GETS 32 BIT LOCAL SOCKET NUMBER
REPEAT 3,[
	LSH E,8
	ILDB T,B
	IORI E,(T)
]
	ILDB R,B	;LINK NUMBER OR BYTE SIZE
	MOVE Q,E
	EQVI Q,(C)	;Q 1.1 = 1 IF E 1.1 = C 1.1
	ANDI Q,1
	JUMPE Q,IMPRF3	;WRONG DIRECTION RFC
	CAIE C,2	;SKIP IF STR
	 JRST IMPRF5
	CAILE R,36.	;SKIP IF STR AND BYTE SIZE < 37
	 JRST IMREFU	;REFUSE CONNECTION
IMPRF5:	PUSHJ P,IMPLLS	;LOOK FOR LOCAL SOCKET (RET INDEX IN I)
	 JRST IMPRFQ	;NO SUCH SOCKET.  QUEUE IT
	HRRZ W,IMSOC4(I)	;SOCKET STATE
	CAIE W,%NSLSN	;SKIP IF LISTENING
	 JRST IMPRF4
	MOVEM D,IMSOC3(I)	;STORE FOREIGN SOCKET NUMBER
	DPB H,IMSCFH		;STORE FOREIGN HOST INDEX
	MOVEI Q,%NSRFC
	HRRM Q,IMSOC4(I)	;RFC RECEIVED STATE
	CAIN C,2	;SKIP IF RTS
	 JRST [	LDB Q,IMSCBS	;STR, CHECK CONNECTION BYTE SIZE
		CAME Q,R
		 JRST IMCLDA
		JRST .+2 ]
	  DPB R,IMSCLN	;RTS, STORE LINK #
	PUSHJ P,IMPUIN	;INTERRUPT USER
IMRFCX:	LDB Q,IMHSBT
	CAIN Q,1
	 SOS IMRFCT
	MOVEI Q,2
	DPB Q,IMHSBT	;MARK HOST UP
	JRST IMPBKL

IMPRF3:	BUG INFO,[NET: WRONG DIR RFC HST ],OCT,IMPHTN(H),[OP ],SIXBIT,[(C)[SIXBIT /RTS   STR/]-1],[SOK],OCT,E
	JRST IMPBKL

IMPRF4:	CAIE W,%NSRFS	;SKIP IF IN RFC SENT STATE
	 JRST IMPRFQ	;QUEUE IT
	LDB Q,IMSCFH
	CAMN Q,IMPCSH
	 CAME D,IMSOC3(I)	;FROM CORRECT FOREIGN SOCKET?
	  JRST IMREFU	;NO, REFUSE
	AOS IMSOC4(I)	;PUT INTO STATE 5 - OPEN
	CAIE C,1	;SKIP IF RTS
	 JRST IMPRF2	;STR
	DPB R,IMSCLN	;STORE LINK #
IMPRF1:	PUSHJ P,IMPUIN	;INTERRUPT USER
	JRST IMPBKL

IMPRF2:	LDB Q,IMSCBS
	CAME Q,R
	 JRST IMCLDA	;BYTE SIZES DIFFER, REFUSE
	JSP T,IMSTCM
	    8,,2	;TEXT: 8 BYTES, 2 WORDS
	 JRST [	AOS IMNANS
		JRST IMPRF1 ]
	MOVEI H,2(I)
	LSH H,16.	;LINK #
	IOR H,IMSOC8(I) ;MSG ALLOC
	LSH H,4
	TLO H,(4_28.)	;ALL
	MOVEM H,10(Q)
	MOVE H,IMSOC7(I) ;BIT ALLOC
	LSH H,4
	MOVEM H,11(Q)
	PUSHJ P,IMWCQ	;SEND IT OUT
	JRST IMPRF1

IMPRFQ:	CAIL E,NETSRS	;IF < 1000, START JOB "NETRFC"
	 JRST IMRFQ5
	MOVE T,IMPHTN(H)
;	CAIE T,<IMPUS_-6>+<IMPUS&77>_9
	CAME T,[IMPUS3-NW%ARP]	; Compare with our own host (minus net #)
	 SKIPL NETUSW
	  CAIA
	   JRST IMREFU	;REFUSE CONNECTION
	HRROI T,NTRFCL
	PUSHJ P,NUJBST	;LOAD SERVER
	 JRST IMREFU	;RING BUFFER FULL
IMRFQ5:	SKIPGE Q,IMFFPQ	;SKIP IF ANY FREE SLOTS
	 JRST IMRFQ1	;CLS OLDEST
	MOVE W,(Q)
	MOVEM W,IMFFPQ	;NEW FIRST FREE
IMRFQ9:	SETOM (Q)	;END OF QUEUE
	MOVEM E,1(Q)	;LOCAL SOCKET NUMBER
	MOVEM D,2(Q)	;FOREIGN SOCKET NUMBER
	CAIE C,2	;SKIP IF STR
	 TLO R,400000	;MARK AS RTS
	MOVEM R,3(Q)	;LINK NUMBER OR BYTE SIZE
	DPB H,[101000,,3(Q)]	;FOREIGN HOST INDEX
	LDB W,[051100,,TIME]	;STORE TIME OF RECEIPT, IN 16/15 MOD 512.
	DPB W,[221100,,3(Q)]
	SKIPGE W,IMPEPQ	;END OF QUEUE
	 JRST IMRFQ2	;QUEUE EMPTY
	MOVEM Q,(W)	;PUT IN AT END OF QUEUE
	MOVEM Q,IMPEPQ	;NEW END OF QUEUE
	JRST IMRFCX

IMRFQ2:	MOVEM Q,IMPEPQ	;END OF QUEUE
	MOVEM Q,IMPBPQ	;AND BEGINNING OF QUEUE
	JRST IMRFCX

IMRFQ1:	MOVE J,IMPBPQ	;BEGINNING OF PENDING QUEUE
	MOVE E,1(J)	;LOCAL SOCKET
	MOVE D,2(J)	;FOREIGN SOCKET
	PUSH P,IMPCSH
	LDB H,[101000,,3(J)]	;FOREIGN HOST INDEX
	MOVEM H,IMPCSH
	PUSHJ P,IMPSCL	;SEND CLS
	 JRST IMRFQ3	;NO BUFFERS AVAILABLE
	AOSA IMNRFC	;# RFCS CLOSED
IMRFQ3:	 AOS IMNRFI	;# RFCS IGNORED
	POP P,IMPCSH
	MOVE H,IMPCSH
	MOVE Q,IMPBPQ	;FLUSH FIRST ENTRY ON PENDING QUEUE
	MOVE W,(Q)
	MOVEM W,IMPBPQ
	JRST IMRFQ9

IMREFU:	PUSHJ P,IMPSCL	;SEND CLS
	 AOS IMNCNS	;CAN'T
	AOS IMNRFI
	JRST IMPBKL

IMPCLS:	SUBI A,8	;MUST BE AT LEAST 8 MORE BYTES
	JUMPL A,IMSHRT	;MESSAGE IS SHORT
	ILDB D,B	;D GETS 32 BIT FOREIGN SOCKET NUMBER
REPEAT 3,[
	LSH D,8
	ILDB T,B
	IORI D,(T)
]
	ILDB E,B	;E GETS 32 BIT LOCAL SOCKET NUMBER
REPEAT 3,[
	LSH E,8
	ILDB T,B
	IORI E,(T)
]
	PUSHJ P,IMPLC	;LOOK FOR CONNECTION
	 JRST IMCLSQ	;LOOK IN QUEUE
	MOVSI W,200000	;SET CLS RCD BIT
	IORB W,IMSOC4(I)	;RH IS STATE FOR DISPATCH
	JRST @IMCLDT(W)

IMCLDT:	OFFSET -.
%NSCLS::IMPCLI
%NSLSN::IMPCLI
%NSRFC::IM2CLS
%NSRCL::IMPCLI
%NSRFS::IM4CLS
%NSOPN::IM5CLS
%NSRFN::IM6CLS
%NSCLW::IM7CLS
%NSCLI::IMPCLI
%NSINP::IMECLS
	OFFSET 0

IM4CLS:	HLLZS IMSOC4(I)	.SEE %NSCLS
	MOVEI W,%NCRFS
	JRST IMCLDB

IMECLS:	MOVEI W,%NSCLI
	JRST IMCCLS

IMCLDA:	HLLZS IMSOC4(I)	.SEE %NSCLS
	MOVEI W,%NCBYT	;BYTE MISMATCH
	JRST IMCLDB

IM6CLS:	MOVSI W,20000	;CLSED DURING RFNM WAIT
	IORM W,IMSOC5(I)
IM5CLS:	TDZA W,W	.SEE %NSCLS
IM2CLS:	 MOVEI W,%NSRCL
IMCCLS:	HRRM W,IMSOC4(I)	;CHANGE STATE
	MOVEI W,%NCFRN
IMCLDB:	DPB W,IMSCLS	;CLS REASON
	PUSHJ P,IMPUIN	;INTERRUPT USER
IMCLQ2:	PUSHJ P,IMPSCL	;SEND CLS
	 AOS IMNCNS
	JRST IMPBKL

IMPSCL:	JSP T,IMSTCM	;SEND A CLS TO LOCAL SOCKET IN E AND FOREIGN SOCKET IN D (CLOBBERS D AND E)
	    12.,,3	;TEXT: 12 BYTES, 3 WORDS
	 POPJ P,
	MOVEI H,3_4	;3 NOPS + CLS
	MOVEM H,10(Q)
	LSH E,4
	MOVEM E,11(Q)	;LOCAL SOCKET NUMBER
	LSH D,4
	MOVEM D,12(Q)	;FOREIGN SOCKET NUMBER
	PUSHJ P,IMWCQ	;SEND CLS
	JRST POPJ1

IMPCLI:	AOS IMNCLI
	JRST IMPBKL

IM7CLS:	HLLZS IMSOC4(I)	.SEE %NSCLS
	JRST IMPBKL

IMCLSQ:	PUSH P,A
	PUSH P,B
	MOVE A,E	;LOCAL SOCKET NUMBER
	MOVEI T,0
	MOVE B,D	;FOREIGN SOCKET NUMBER
	PUSHJ P,IMSPQP	;SEARCH PENDING QUEUE
	 JRST IMCLQ1	;NOT THERE
	MOVE E,A
	POP P,B
	POP P,A
	JRST IMCLQ2	;SEND HIM A CLS

IMCLQ1:	POP P,B
	POP P,A
	JRST IMPCLI	;CAN'T FIND HIM.  IGNORE

IMPALL:	SUBI A,7	;MUST BE AT LEAST 7 MORE BYTES
	JUMPL A,IMSHRT	;MESSAGE IS SHORT
	ILDB R,B	;LINK #
	ILDB D,B
	LSH D,8
	ILDB T,B
	IORI D,(T)	;D GETS MESSAGE ALLOCATION
	ILDB E,B	;E GETS BIT ALLOCATION
REPEAT 3,[
	LSH E,8
	ILDB T,B
	IORI E,(T)
]
	MOVE T,IMPCSH	;FOREIGN HOST
	LSH T,8
	IOR R,T		;HEADER (HOST AND LINK #)
	MOVEI W,1	;TO TEST DIRECTION OF SOCKET
	MOVSI I,-IMPSTL
IMPAL2:	LDB T,IMSCHD	;FOREIGN HOST AND LINK NUMBER
	SKIPGE IMSOC1(I)	;SKIP IF SLOT NOT IN USE
	 CAME T,R	;SKIP IF HEADER AGREES
	  JRST IMPAL1
	TDNE W,IMSOC2(I)	;SKIP IF NOT SEND
	 JRST IMPAL3
IMPAL1:	AOBJN I,IMPAL2
	ANDI R,377
	BUG INFO,[NET: IGNORED ALLOC HST ],OCT,IMPHTN(H),[LNK],OCT,R
	AOS IMNALI
	JRST IMPBKL	;IGNORE

IMPAL3:	SKIPL D
	 SKIPGE E
	  JRST 4,.
	LDB T,IMSCBS		;GET BYTESIZE
	IDIV E,T		;TRUNCATE TO 0 MODULO BYTESIZE
	IMUL E,T		;(CLOBBER TT)
	SKIPL IMSOC8(I)
	 SKIPGE IMSOC7(I)
	  JRST 4,.
	ADDB D,IMSOC8(I)	;INCREASE ALLOCATIONS
	ADDB E,IMSOC7(I)
	MOVE Q,IMSOC5(I)
	TLNE Q,140000		;ACTIVATE IF USER (OR DIRECT CONN) CHECKING ALLOC
	 PUSHJ P,IMPUIN
	MOVE T,IMSPIP(I)
	CAME T,IMSMPP(I)	;SKIP IF OUTPUT BUFFER EMPTY
	 PUSHJ P,IMPIOS		;THIS GUY MAY HAVE STUFF TO GO OUT
	JRST IMPBKL

IMPLLS:	MOVSI I,-IMPSTL	;LOOK FOR SOCKET IN E
	MOVSI W,200000
IMPLL2:	TDNN W,IMSOC1(I)
	 SKIPL IMSOC1(I)	;NOT IN USE
	  JRST IMPLL1
	CAME E,IMSOC2(I)	;SKIP IF RIGHT LOCAL SOCKET NUMBER
IMPLL1:	 AOBJN I,IMPLL2
	JUMPL I,POPJ1	;RETURN SOCKET TABLE INDEX IN RH OF I
	POPJ P,		;NOT FOUND

;INTERRUPT USER ASSOCIATED WITH CHANNEL IN I
IMPUIN:	MOVSI U,200000
	TDNE U,IMSOC1(I)
	 POPJ P,		;CHNL BEING CLOSED
	MOVE U,IMSOC5(I)
	TLNE U,40000
	 JRST IMPUIS		;JUMP IF SOCKET IS CONNECTED TO A STY.
IMPUIP:	HRRZ U,IMSOC1(I)	;USER INDEX
	LDB Q,[222000,,IMSOC1(I)]	;MASK FOR CHANNEL OPEN ON
IMPUIM:	AND Q,MSKST2(U)		;ONLY ENABLED CHANNELS.
	PUSH P,T		;VALIDATE THE USER INDEX
	MOVEI T,LUBLK
	IDIVM U,T
	IMULI T,LUBLK
	CAMN T,U
	 CAML U,USRHI
	  JRST 4,.
	MOVSI T,(SETZ)		;PCLSR SO IT GETS IOC ERROR IF NEEDFUL
	IORM T,PIRQC(U)		; EVEN IF IT DOESN'T HAVE NORMAL INTERRUPTS ENABLED
	POP P,T
	IORM Q,IFPIR(U)		;GEN SECOND WORD INTERRUPT
	POPJ P,

IMPUIS:	PI2SAF			;HERE FOR INT. ON SOCKET CONNECTED TO A STY:
	ANDI U,777
	SKIPL STYNTL-NFSTTY(U)
	 POPJ P,		;ALREADY ACTIVATED
	MOVE Q,STYNTA		;PUT THAT STY ON THE XFER ACTIVATION LIST.
	MOVEM Q,STYNTL-NFSTTY(U)
	MOVEM U,STYNTA		;THEN RETURN.  DON'T ACTUALLY INTERRUPT THE JOB;
	POPJ P,			;IF ANYTHING FUNNY HAS HAPPENED, STYNTC WILL INTERRUPT.

;LOOK FOR CONNECTION: LOCAL SOCKET IN E, FOREIGN SOCKET IN D, FOREIGN HOST IN H
IMPLC:	MOVSI I,-IMPSTL
IMPLC2:	SKIPGE IMSOC1(I)	;NOT IN USE
	 CAME E,IMSOC2(I)	;LOCAL SOCKET NUMBER
	  JRST IMPLC1
	LDB T,IMSCFH
	CAMN D,IMSOC3(I)	;FOREIGN SOCKET NUMBER
	 CAME H,T
IMPLC1:	  AOBJN I,IMPLC2
	JUMPL I,POPJ1
	POPJ P,

IMPINR:	SOJL A,IMSHRT	;SHORT COUNT
	ILDB D,B	;LINK #
	DPB H,[101000,,D] ;CONCAT HOST&LINK
	MOVSI I,-IMPSTL
	LDB E,IMSCHD	;GET HOST FOR SOCKET
	CAME D,E
	 AOBJN I,.-2	;SEARCH FOR MATCHING HOST&LINK
	JUMPGE I,IMPILS	;NOT FOUND
NCPIRS:	HRRZ E,IMSOC4(I)	;STATE
	MOVE E,CHNBIT(E)	;BIT TO CORRESPOND
	TRNN E,1_%NSRFC+1_%NSRFS+1_%NSOPN+1_%NSRFN+1_%NSCLW+1_%NSINP
			;OK STATES RFCRCV, RFCSNT, OPEN, RNMWT, CLSSNT, DATA
	 JRST IMPILS	;IN BAD STATE
	TRNE E,1_%NSCLW	;IGNORE INT IF CLSSNT STATE (NOT ERROR)
	 JRST IMPBKL
	MOVSI D,4000
	IORM D,IMSOC5(I)	;INT FLAG 4.3 BIT OF IMSOC5(SOCK)
	PUSHJ P,IMPUIN	;INT TO USER
	JRST IMPBKL

IMPINS:	SOJL A,IMSHRT	;SHORT
	ILDB D,B	;LINK
	MOVEI I,-2(D)	;0,1 -> 777776,777777 ILLEGAL LINKS
	CAIGE I,IMPSTL	;CHECK IN RANGE 2 TO IMPSTL+1
	 SKIPL IMSOC1(I);AND IN USE
	  JRST IMPILS	;BAD LINK
	LDB T,IMSCFH
	CAMN T,IMPCSH	;SKIP IF HOST NOT MATCHED BY MSG
	 JRST NCPIRS
IMPILS:	BUG INFO,[NET: BAD INT CTL MSG HST ],OCT,IMPHTN(H),[LNK ],OCT,D,[IMSOC4],OCT,IMSOC4(I)
	JRST IMPBKL	;NOTE- I MAY BE -1 OR -2  OR UP TO 256, IF LNK BAD, IGNORE

IMPECI:	AOS IMPNEI	;WILL EVENTUALLY GIVE JOB TO MAIN PROG
	JRST IMPBKL

IMPECO:	ILDB D,B	;GET 8 BIT DATA TO ECHO
	SOJL A,IMSHRT
	SKIPE IMPNEA
	 JRST IMPECI	;ONLY ONE TO A CUSTOMER
	JSP T,IMSTCM
	    2,,1	;TEXT: 2 BYTES, 1 WORD
	 JRST IMPECI
	LSH D,20.	;DATA TO BE ECHOED
	TLO D,(10._28.)	;ERP
	MOVEM D,10(Q)
	PUSHJ P,IMWCQ	;SEND IT OUT
	AOS IMPNEA
	JRST IMPBKL

IMPERM:	SUBI A,11.	;COUNT BYTES
	MOVE C,TIME
	MOVEM C,IMPERB
	MOVE C,IMPHTN(H)	;REAL HOST NUMBER
	MOVEM C,IMPERB+1
	MOVE C,[441100,,IMPERB+2]
	MOVEI D,11.	;BYTES TO COPY
	ILDB T,B	;COPY BYTES FROM THEIR MSG
	IDPB T,C
	SOJG D,.-2
	BUG INFO,[NET: ERR MSG FM HST ],OCT,IMPERB+1,[MSG],OCT,IMPERB+2,OCT,IMPERB+3
			;ONLY PRINTS FIRST 8 BYTES OF ERR INFO
	JUMPGE A,IMPBKL	;IF COUNT OK, GET MORE
	JRST IMSHRT	;SHORT COUNT

IMPRSI:	AOS IMPNRI
	JRST IMPBKL

IMPRST:	MOVE T,IMPHTN(H)
;	CAIE T,<IMPUS_-6>+<IMPUS&77>_9	;IF RST FROM OURSELVES, JUST SEND RRP
	CAME T,[IMPUS3-NW%ARP]
	 PUSHJ P,IMPRSR
	SKIPE IMPNRA
	 JRST IMPRSI
	JSP T,IMSTCM
	    1,,1	;TEXT: 1 BYTE, 1 WORD
	 JRST IMPRSI
	MOVSI D,(13._28.)	;RRP
	MOVEM D,10(Q)
	PUSHJ P,IMWCQ	;SEND IT OUT
	PUSHJ P,IMPIOS
	AOS IMPNRA
	JRST IMPBKL

IMPRSR:	MOVSI I,-IMPSTL	;LOOK FOR USERS OF THIS HOST
	MOVSI TT,200000
IMPRS2:	TDNN TT,IMSOC1(I)	;GUY GOING AWAY ANYHOW
	 SKIPL IMSOC1(I)
	  JRST IMPRS1
	LDB C,IMSCFH	;FOREIGN HOST
	CAME C,IMPCSH
	 JRST IMPRS1	;WRONG HOST
	HRRZ C,IMSOC4(I)
	MOVEI D,%NSCLS
	CAIN C,%NSINP
	 MOVEI D,%NSCLI	;INPUT STILL AVAILABLE
	HRRM D,IMSOC4(I)
	MOVEI D,%NCRST
	DPB D,IMSCLS	;CLS REASON IS RST
	PUSHJ P,IMPUIN	;INTERRUPT USER
IMPRS1:	AOBJN I,IMPRS2
	;IF HOST CAN SEND A RST, IT IS UP, BUT DON'T
	;REALLY CONSIDER IT UP UNTIL RRP, RTS, OR STR IS RECEIVED
	;I DON'T KNOW WHY IT'S DONE THIS WAY
	POPJ P,

IMPRRP:	LDB J,IMHSBT
	SOJL J,IMPRR1
	JUMPG J,IMPBKL	;ALREADY UP, MAYBE BECAUSE OF PRIOR RTS,STR
	MOVEI J,2
	DPB J,IMHSBT	;MARK HIM UP
	SOS IMRFCT
	JRST IMPBKL

IMPRR1:	BUG INFO,[NET: RRP W-O RST HST],OCT,IMPHTN(H)
	JRST IMPBKL

;GET CONTROL QUEUE SLOT
IMGCQS:	SKIPG IMFCQL	;SKIP IF ANY LEFT
	 JRST IMGCQL	;NONE
	SKIPG Q,IMFFCQ	;POINTER TO SLOT
	 JRST 4,.
	MOVE W,(Q)
	MOVEM W,IMFFCQ	;PATCH OUT OF FREE LIST
	SETOM (Q)
	SOS W,IMFCQL	;NUMBER FREE LEFT
	CAIN W,1	;SKIP IF MORE THAN ONE LEFT
	 SETOM IMPHI	;SET FLAG TO HOLD UP INPUT
	JRST POPJ1

IMGCQL:	AOS IMNPIL
	POPJ P,

IMWCQ:	PUSHJ P,IMWPCQ
	JRST IMPIOS	;START OUTPUT

;ADD BLOCK IN Q TO OUTPUT CONTROL QUEUE, BASHES W
IMWPCQ:	SETOM (Q)
	SKIPGE W,IMPLCQ
	 JRST IMWCQ1	;CONTROL QUEUE EMPTY
	AOSE (W)
	 JRST 4,.	;END OF QUEUE DIDN'T POINT TO -1
	MOVEM Q,(W)
	MOVEM Q,IMPLCQ
	POPJ P,

IMWCQ1:	MOVEM Q,IMPLCQ
	MOVEM Q,IMPNCQ
	POPJ P,

;ADD MAIN PROGRAM BLOCK TO PI QUEUE (CALL AT MP LEVEL)
IMPMPQ:	MOVSI Q,777
	IORM Q,IMPMPU+1	;NOT LOCKED BY THIS JOB ANY MORE
	SKIPL U		;SKIP IF CALLED FROM DIRECT-CONNECT CLOCK LEVEL
	 PUSHJ P,LSWDEL	;PI LEVEL WILL UNLOCK
	CONO PI,NETOFF
	MOVEI Q,IMPMPL
	PUSHJ P,IMWPCQ
	CONO PI,NETON
	JRST IMPOST

;CALL BY JSP T,IMSTCM
;SET UP STANDARD PI CONTROL MESSAGE
;BYTE COUNT,,TEXT LENGTH 
;ERROR RETURN

IMSTCM:	PUSHJ P,IMGCQS	;GET CONTROL QUEUE SLOT IN Q
	 JRST 1(T)	;NONE AVAILABLE
	MOVSI H,17_10.	;MESSAGE TYPE = 0, LINK # = 0, NEW FMT
	MOVEM H,2(Q)
	MOVE H,IMPCSH	;GET IMP AND HOST
	MOVE H,IMPHTN(H)
IFN 1,	DPB H,[103000,,3(Q)]	; Store host addr
IFN 0,[	DPB H,[301000,,3(Q)] ;STORE HOST
	LSH H,-9
	DPB H,[102000,,3(Q)] ;STORE IMP
] ;IFN 0
	HLRZ H,(T)	;BYTE COUNT
	LSH H,8
	IOR H,[8_24.]	;BYTE SIZE = 8
	MOVEM H,7(Q)
	HRLZ H,(T)
	HRR H,IMPCSH
	MOVSM H,1(Q)	;HOST INDEX,,TEXT LENGTH
	JRST 2(T)	;NORMAL RETURN (NOTE THAT H HAS BEEN RESTORED TO IMPCSH)

;RECEIVED LEADER OF REGULAR MESSAGE NOT ON CONTROL LINK
;THE HOST-HOST LEADER WORD (WD 6) HAS NOT YET BEEN DATAI'ED.
;SWITCH TO 32-BIT MODE FIRST IF NECESSARY.
IMPRMD:	
IFN INETP,[
	CAIE B,IMPILB+4	; Verify that NCP leader is next word
	 JRST IMPLD3	; Barf...
]
	MOVE D,IMPCSH
	LSH D,8
	MOVE I,IMPCLN
	IOR D,I		;HEADER
	SUBI I,2	;SOCKET TABLE INDEX
	JUMPL I,IMPRM7	;BAD LINK #
	SKIPGE A,IMSOC1(I)
	 TLNE A,200000	;SKIP IF NOT BEING CLOSED
	  JRST IMPRM7	;SOCKET DOESNT EXIST OR BEING CLOSED
	MOVEI A,1
	CAIGE I,IMPSTL
	 TDNE A,IMSOC2(I)	;SKIP IF RECEIVER
	  JRST IMPRM7	;BAD LINK # OR MESSAGE FOR A SENDER
	LDB C,IMSCHD	;HEADER
	CAME D,C	;SEE IF HEADERS AGREE
	 JRST IMPRM7	;NOPE, I.E. FROM WRONG HOST OR CLOSED
	HRRZ D,IMSOC4(I)
	CAIE D,%NSOPN
	 CAIN D,%NSINP
	  JRST IMPRMA
	JRST IMPRM7
IMPRMA:	SKIPGE IMSOC6(I)	;SKIP IF NOT LOCKED BY CORE JOB
	 JRST IMPRMP		;LOCKED, COME BACK LATER
IFN KAIMP,[
	SKIPL IMSOC5(I)		;SKIP IF 32 BIT TRANSFER
	 CONO IMP,IMI32C	;SET 36 BIT INPUT
	SKIPGE IMSOC5(I)	;SKIP IF NOT 32 BIT TRANSFER
	 CONO IMP,IMI32S	;SET 32 BIT INPUT
]IFN DMIMP,[
	SKIPL IMSOC5(I)		;SKIP IF 32BIT
	 CONO FI,FII32C		;SET 36BIT
	SKIPGE IMSOC5(I)	;SKIP IF 36 BIT
	 CONO FI,FII32S		;SET 32 BIT
]
	DATAI IMP,IMPILB+5	;GET THE HEADER WORD
	LDB A,IMCBBP
	MOVEM A,IMPCBS
	LDB B,IMSCBS		;Check for fraudulent byte size
	CAME A,B
	 JRST IMPRMZ		;Discard message
	LDB B,IMBCBP
	MOVEM B,IMPCBC
	MOVEM B,IMPNBI		;SAVE BYTE COUNT FOR LATER
	SOSGE IMSOC8(I)
	 JRST IMRMAF		;MESSAGE ALLOCATION EXCEEDED
	JUMPE B,IMPIRT		;ZERO LENGTH MESSAGE
	IMUL A,B		;BIT COUNT
	MOVN D,A
	ADDB D,IMSOC7(I)	;REMAINING BIT ALLOCATION
	JUMPL D,IMRMAH		;BIT ALLOCATION EXCEEDED
	TRNE TT,IMPLW
	 JRST IMRMAG		;MESSAGE IS SHORT
	MOVSI D,200000
	IORB D,IMSOC6(I)	;ACTIVE AT PI LEVEL
	SKIPGE IMSOC5(I)
	 IDIVI A,32.
	SKIPL IMSOC5(I)
	 IDIVI A,36.
	SKIPE B
	 ADDI A,1		;NUMBER OF WORDS MESSAGE WILL TAKE
	HRRZ B,IMSPIP(I) 	;ADDRESS WHERE MESSAGE HEADER WILL GO
	SKIPL (B)
	 JRST 4,.		;HEADER WORD SHOULD BE -1
	HRRZ C,IMSBFE(I)	;GET ADDRESS OF LAST WORD IN BUFFER
	CAML B,C
	 MOVEI B,-1(D)		;HEADER IS LAST IN BUFFER, SO DATA IS FIRST
	MOVE E,B		;RH(BLKI POINTER) IN E
	ADD A,B			;ADDRESS WHERE LAST WORD OF MESSAGE WILL GET STORED
	SETZM IMNWSI		;ASSUME WILL ONLY NEED ONE BLKI
	CAMG A,C
	 JRST IMPRM8		;JUMP IF NO WRAP
;DROPS THROUGH
;DROPS IN
	SUB B,C			;- # WDS TO READ FIRST TIME
	SUB A,C			;+ # WDS TO READ SECOND TIME
	SKIPGE B
	 SKIPG A
	  JRST 4,.		;SCREW
	MOVN C,A		;NEG OF REMAINING WORD COUNT
	MOVSS C			;TO LEFT HALF FOR BLKI POINTER
	HRRI C,-1(D)		;RING AROUND TO BEGIN OF BUFFER
	MOVEM C,IMNWSI		;STORE FOR INTCHN BLKI RUNOUT (FLAG IF -)
	ADD C,A			;ADR+COUNT
	HRRZM C,IMPNIW		;EXPECTED END OF BLKI
	SKIPA A,B
IMPRM8:	 SUBM B,A		;A GETS - # WORDS TO READ
	MOVE B,E
	HRL B,A			;BLKI POINTER
	SUB E,A			;EXPECTED LAST WORD
	SKIPE IMNWSI		;IF DOING 2 BLKIS, EXPECTED END ALREADY STORED
	 SKIPA E,IMPNIW
	  MOVEM E,IMPNIW	;EXPECTED LAST BLKI ADDRESS
	HRRZ A,IMSPIP(I)	;SEE IF CLOBBERING GOOD-DATA PART OF BUFFER
	CAIL A,@IMSMPP(I)	;SKIP IF MPP > PIP
	 JRST [	CAIG E,(A)
		 CAIGE E,@IMSMPP(I)
		  JRST IMPRMT
		JRST 4,. ]
	CAIGE E,@IMSMPP(I)
	 CAIG E,(A)
	  JRST 4,.
IMPRMT:	HRRZ A,IMSOC6(I)	;SEE IF CLOBBERING CORE NOT PART OF BUFFER
	CAIL E,(A)
	 CAILE E,@IMSBFE(I)
	  JRST 4,.
	HRRZM I,IMPIPI		;THIS SOCKET NOW ACTIVE AT P.I. LEVEL
	MOVEI C,%ISIND		; New state = reading NCP data message
	JRST IMPRM9		; Start reading

IMPRMP:	MOVSI D,100000		;SET INPUT HELD UP BY CORE JOB
	IORM D,IMSOC6(I)
IFN KAIMP,[
	MOVE D,IMPPIA
	MOVEM D,IMPSVP
	SETZM IMPPIA	;TURN OFF NETWORK FOR A WHILE
]
IFN DMIMP,CONO FI,FIIN+0	;SET PIA TO 0 FOR A WHILE, CORE JOB WILL GET BACK
	JRST IMPRET

IMRMAH:	AOSA IMNBAE
IMRMAF:	 AOS IMNMAE
	JRST IMPIRT

IMPRM7:	AOSA IMNMNC
IMRMAG:	 AOS IMNMSS
	JRST IMPIRT

; Got Last Imp Word (in A) of regular NCP data message
; Comes here from IMPBKX.

IMPRMB:	MOVE I,IMPIPI
	MOVE B,IMBLKI
	CAMN B,IMPNIW
	 JRST IMPRMC	;ONE EXTRA WORD OF IMP PADDING, IGNORE IT
	ADD B,[1,,1]	;ADDR TO NEXT WORD, COUNT TO ZERO
	CAME B,IMPNIW
	 JRST IMPRMY
	MOVEM A,(B)	;STORE LAST WORD
IMPRMC:	MOVE E,IMPNBI		;# BYTES IN
	ADDM E,IMSMPC(I)	;MAKE AVAIL TO M.P.
	MOVEM E,@IMSPIP(I)	;STORE HEADER
	AOS E,IMPNIW		;WORD AFTER MSG WILL BE NEXT HEADER
	CAILE E,@IMSBFE(I)
	 HRRZ E,IMSOC6(I)	;WRAP
	HRRM E,IMSPIP(I)	;LEAVE LH OF IMSPIP ALONE
	CAIN E,@IMSMPP(I)
	 JRST 4,.		;BUFFER 1 WORD TOO SMALL?
	SETOM (E)
	MOVEI E,%NSINP
	HRRM E,IMSOC4(I)	;INPUT AVAILABLE
	PUSHJ P,IMPUIN		;INTERRUPT USER
	MOVSI D,200000		;CLEAR ACTIVE AT P.I. LEVEL
	ANDCAM D,IMSOC6(I)
	SETOM IMPIPI
	JRST IMPIR1

IMPRMY:	HRRZ E,IMPNIW		;NOT ENDING WHERE IT'S SUPPOSED TO
	SUBI E,(B)		;E GETS NUMBER OF MISSING WORDS
	MOVE H,IMPCSH
	BUG INFO,[NET: MSG FM HST ],OCT,IMPHTN(H),[SHORT ],DEC,E,[WDS, BC],DEC,IMPCBC
	JRST IMPRMC		;PRETEND HOST TRANSMITTING GARBAGE

IMPRMZ:	MOVE H,IMPCSH
	BUG INFO,[NET: HST ],OCT,IMPHTN(H),[SENT BYTE SIZE ],DEC,A,[SHOULD BE],DEC,B
	JRST IMPIRT		;Discard message

SUBTTL	ARPANET NCP OUTPUT INTERRUPT LEVEL

;HERE ON COMPLETION OF TRANSMISSION OF CONTROL MESSAGE

IMPOB6:	SETZM IMPOS
	SKIPN A,IMPSVQ
	 JRST IMPRET		;THAT WAS A NOP
	HLRZ B,1(A)		;HOST TABLE INDEX
	MOVSI D,400000
	IORM D,IMPHTB(B)	;SET RFNM WAIT BIT
	AOS IMRFCT
	LDB D,[051100,,TIME]
	DPB D,[221100,,IMPHTB(B)] ;STORE TIME TOO
	HLRZ T,A
	HRRZS A
	MOVE B,(A)
	MOVEM B,(T)
	JUMPGE B,IMOB7A
	CAME A,IMPLCQ
	 JRST 4,.	;IMPLCQ GAVE WRONG LAST MESS NO.
	MOVEM T,IMPLCQ
	CAIN T,IMPNCQ
	 SETOM IMPLCQ
IMOB7A:	CAIN A,IMPMPL	;SKIP IF NOT MAIN PROG BLOCK
	 JRST [	SETOM IMPMPU
		JRST IMPRET ]
	MOVE B,IMFFCQ
	CAIN B,(A)
	 JRST 4,.	;MAKING INFINITE LOOP
	MOVEM B,(A)
	MOVEM A,IMFFCQ
	AOS A,IMFCQL
	SKIPGE B,IMPHI	;RETURN IF INPUT NOT HELD UP
	 CAIG A,1	;SKIP IF INPUT HELD UP AND NOW ENOUGH FREE
	  JRST IMPRET
	SETZM IMPHI
	AOJE B,IMPRET	;INPUT WAS NOT YET SUCCESSFULLY HELD UP
	AOJN B,[JRST 4,.]	;IMPHI SHOULD HAVE BEEN -2
	AOS IMPNUH
	MOVE TT,IMSTAS	;GET OLD CONI
	TRNE TT,IMPLW
IFN KAIMP,[
	 CONO IMP,IMI32C
	DATAI IMP,A
];KAIMP
IFN DMIMP,[
	 CONO FI,FII32C
	MOVE A,IMPSUS
];DMIMP
	TRNE TT,IMPLW	;RESUME INPUT
	 JRST IMPBKV
	SKIPE IMPIS
	 JRST 4,.
	JRST IMSTRT

;HERE ON COMPLETION OF TRANSMISSION OF DATA MESSAGE

IMPOBG:	SETZM IMPOS
	MOVE I,IMPOPI
	HRRZ Q,IMSOC4(I)
	CAIN Q,%NSOPN
	 AOS IMSOC4(I) .SEE %NSRFN	;PUT INTO RFNM WAIT STATE
	MOVSI A,20000
	CAIN Q,%NSCLS
	 IORM A,IMSOC5(I)
	MOVSI Q,200000
	ANDCAB Q,IMSOC6(I)	;NO LONGER ACTIVE AT P.I. LEVEL
	SETOM IMPOPI
	MOVN A,IMPNBT		;BITS SENT
	ADDM A,IMSC7I(I)	;DECREASE BITS IN BUFFER
	ADDB A,IMSOC7(I)	;DECREASE ALLOCATION
	SKIPL A			;SKIP IF ALLOC LOST
	SOSGE IMSOC8(I)		;SKIP IF MSG ALLOC DIDN'T LOSE
	 JRST 4,.		;LOST
	MOVE Q,IMSOC5(I)
	TLNN Q,140000		;INTERRUPT USER IF DIRECT CONNECT (CHEAP), DEPEND ON ALLOC,
	 SKIPN IMSMPC(I)	; OR IF OUTPUT BUFFER WAS FULL,
	  PUSHJ P,IMPUIN	; SINCE HE MAY WANT TO SEND MORE
	MOVE A,IMPNBO		;# BYTES FREED IN BUFFER BY REMOVAL OF MSG
	ADDM A,IMSMPC(I)	;SPACE USED BY MESSAGE NOW FREE
	MOVE A,IMPNPT		;UPDATE IMSPIP
	HRRZ Q,IMSOC6(I)	;VALIDATE THIS
	CAILE Q,(A)
	 JRST 4,.		;POINTS BEFORE BUFFER
	HRRZ Q,IMSBFE(I)
	CAIGE Q,(A)
	 JRST 4,.		;POINTS AFTER BUFFER
	MOVEM A,IMSPIP(I)	;..
	JRST IMPRET

;OUTPUT A DATA MESSAGE.

IMPOBD:	MOVE T,TIME
	SUB T,IMSOCT(I)
	SKIPL IMSOC4(I)	;SKIP IF WANT TO SEND THIS BUFFER
	 CAIL T,30.*2	;SKIP IF BUFFER FIRST WRITTEN LESS THAN 2 SEC AGO
	  JRST IMOBD1
	JRST IMPOBA	;DON'T SEND NOW, GO BACK AND LOOK FOR OTHERS

IMOBD1:	MOVE TT,IMSPIP(I)
	CAMN TT,IMSMPP(I)	;SKIP IF ANY BITS TO SEND
	 JRST IMPOBA		;NO
	SKIPE IMSOC7(I)		;SKIP IF NO BITS ALLOCATED
	 SKIPN IMSOC8(I)	;SKIP IF MSG ALLOCATED
	  JRST IMPOBA		;NO BITS OR NO MSGS ALLOWED
	MOVSI Q,200000
	IORB Q,IMSOC6(I)	;ACTIVE AT PI LEVEL

;CODE TO SEND OUT A BUFFER OR PARTIAL BUFFER
;ON ENTRY - I/ SOCKET TABLE INDEX
;	    Q/ BUFFER POINTER FROM IMSOC6
;	   TT/ BYTE POINTER TO FIRST BYTE TO SEND
;SETS UP  - T/ WORD SIZE (32 OR 36)
;	    E/ FLAGS FROM IMSOC5
;	    B/ BYTE SIZE
;	    C/ # BITS TO SEND

	SETZM IMPNBO
	MOVE T,IMSMPP(I)
	MOVEM T,IMOB0Z		;SAVE FOR DEBUGGING
	MOVEI T,32.
	SKIPL E,IMSOC5(I)	;SKIP IF IN 32BIT MODE
	 MOVEI T,36.		;SET 36BIT
	LDB B,IMSCBS		;BYTE SIZE
	HRRZ C,IMSMPP(I)	;COMPUTE # OF BYTES TO SEND
	SUBI C,(TT)
	JUMPL C,[MOVE D,IMSBFE(I) ;WRAPS AROUND
		 SUB D,Q
		 ADDI C,1(D)	;SO ADD # WDS IN BUFFER
		 JRST .+1]
	IMUL C,T		;FIRST GUESS AT NUMBER OF BITS
	LDB A,[360600,,TT]	;GETS POSITION FIELD OF BYTE PTR
	LDB D,[360600,,IMSMPP(I)]
	SUBM A,D		;CORRECTION TO NUMBER OF BITS
	ADD C,D			;C NOW HAS NUMBER OF SENDABLE BITS IN BUFFER
	SKIPL E			;SKIP IF 32BIT
	 JUMPN A,IMOB5A		;36BIT - JUMP IF NOT 0 (MIDDLE OF WORD)
	CAILE A,4		;32BIT - SKIP IF 4, OR 36BIT 0 - SKIP IF NOT MID-WORD
	 JRST IMOB5B		;32BIT MID-WORD - SEND PART OR REST OF WORD
	CAME TT,IMSBFE(I)	;AT RIGHT OF WORD, IS IT LAST WORD?
	 AOSA TT		;NO, ADVANCE TO NEXT
	  HRR TT,Q		;YES, WRAP AROUND TO FIRST	 
	TLO TT,440000		;SWITCH FROM RIGHT OF WORD TO LEFT OF WORD
	CAMG C,IMSOC7(I)	;SKIP IF TOO BIG FOR ALLOCATE
	 CAILE C,8000.		;FITS IN ALLOCATE, SKIP IF FITS IN IMP MESSAGE
	  JRST IMOB1		;MUST SEND LESS THAN ALL THE BITS IN BUFFER
IMOB0F:	MOVE D,IMSMPP(I)	;SENDING WHOLE BUFFER
	LDB J,[360600,,D]	;ADVANCE IMSMPP TO NEXT WORD BOUNDARY
	ADDI J,-36.(T)		;RH(J) := # BITS TO ADVANCE TO WORD BOUNDARY
	MOVNI J,(J)
	IDIV J,B
	ADDM J,IMSMPC(I)	;SUBTRACT FROM FREE THE BYTES SKIPPED OVER
	MOVNM J,IMPNBO		;BUT RETURN TO FREE AFTER TRANSMISSION
	HLL D,IMSBFE(I)		;NOW ADVANCE IMSMPP TO RIGHT END OF WORD
	MOVEM D,IMSMPP(I)	;AND IMSPIP WILL GET SET EQUAL TO IMSMPP
IMOB0A:	MOVEM D,IMPNPT		;ILDB -> FIRST BYTE TO SEND OUT NEXT TIME
	JUMPLE C,[JRST 4,.]	;SOMEBODY COMPUTED BAD # BITS
	MOVE A,C
	IDIV C,B		;C := # BYTES GETTING SENT
	JUMPN D,[JRST 4,.]	;LOSS, TRYING TO SEND PARTIAL BYTE
	ADDM C,IMPNBO		;# BYTES TO RETURN TO FREE AFTER MSG SENT
	MOVEM A,IMPNBT		;# BITS TO SUBTRACT FROM ALLOCATION THEN
;DROPS THROUGH
;DROPS IN
;NOW SET UP BUFFER HEADER FOR IMP MESSAGE IN IMOLDR
; TT -> FIRST WORD TO SEND
; A NUMBER OF BITS TO SEND
; C NUMBER OF BYTES
; B BYTE SIZE
; T WORD SIZE
; E FLAGS

	LDB H,IMSCFH		;HOST TABLE INDEX
	MOVEI Q,IMOLDR-2	;HACK HACK
	PUSHJ P,STHSTP		;STORE HOST NUMBER, MESSAGE TYPE 0
	LDB Q,IMSCLN		;LINK NUMBER
	DPB Q,[001000,,IMOLDR+1]
	LDB Q,[221000,,IMSOC6(I)] ;GET BUFFER TYPE
	MOVEI D,4
	CAIN Q,377
	 MOVEI D,7
	DPB D,[400400,,IMOLDR+1]	;STORE HANDLING TYPE, DEPENDING ON BUFFER SIZE
	DPB B,[201000,,C]	;STORE SIZE IN SAME WD AS COUNT
	LSH C,8
	MOVEM C,IMOLDR+5	;HOST-HOST HEADER - 00,SIZE,BYTE-COUNT,0000
IFN KAIMP,CONO IMP,IMO32C
IFN DMIMP,CONO FI,FIO32C		;36BIT MODE FOR HEADER, AND NO PIA YET
	DATAO IMP,IMOLDR	;OUTPUT THE FIRST LEADER WORD
	SETZM IMOPNT		;START AT BEGINNING OF IMOLST
	MOVE B,[-5,,IMOLDR]	;SEND REST OF LEADER
	MOVEM B,IMOLST
	MOVEI B,3
	SKIPGE E
	 MOVEI B,2
	MOVEM B,IMOMOD		;SEND DATA IN 32 OR 36 BIT MODE AS APPROPRIATE
	ADDI A,-1(T)		;ROUND UP IF NOT EXACT
	IDIV A,T		;# WDS TO SEND
	MOVEI D,-1(TT)		;FIRST WORD TO SEND MINUS ONE
	ADDI D,(A)		;LAST WORD TO SEND
	CAIG D,@IMSBFE(I)	;SKIP IF WRAP
	 JRST IMOB7
	HRRZ B,IMSBFE(I)	;COMPUTE # TO SEND FIRST TIME
	SUBI B,-1(TT)		;B GETS PLUS NUMBER TO SEND FIRST TIME
	SUBM B,A		;A GETS MINUS NUMBER TO SEND SECOND TIME
	MOVNI C,(B)
	HRLI C,-1(TT)		;C GETS SWAPPED BLKO POINTER FOR FIRST TIME
	MOVE Q,IMSOC6(I)	;POINTER TO BUFFER
IFN KAIMP,[
	MOVEI B,3		;SEND LAST WORD SEPARATELY
	MOVEM B,IMOBK2
	AOJE A,.+3
]	 HRLI A,-1(Q)		;BLKO POINTER FOR SECOND TIME	
	 MOVSM A,IMOBK2
IFN KAIMP,[
	MOVNI A,(A)
	ADDI A,-1(Q)
	HRROM A,IMOBK3		;STORE BLKO POINTER TO LAST WORD
]
	JRST IMOB8		

IMOB7:	MOVSI C,3		;NO WRAP, SO NO SECOND BLKO
	MOVSM C,IMOBK2
IFN KAIMP,[
	SOS D
	HRROM D,IMOBK3		;DO LAST WORD SEPARATELY
	SOJE A,IMOB8		;SPECIAL CASE LAST WORD IS ONLY WORD
]
	MOVNI C,(A)		;MAKE BLKO POINTER
	HRLI C,-1(TT)
IMOB8:	MOVSM C,IMOBK1
	MOVSI TT,400000		;TURN OFF "SEND ME"
	ANDCAM TT,IMSOC4(I)
	HRRZM I,IMPOPI		;SAVE INDEX FOR BLKO RUNOUT
	AOS IMPMSS+0
	MOVEI C,%ISOND		;STATE FOR "END OF DATA"
	JRST IMOB9

;BUFFER CANNOT BE SENT AS 1 MSG.  GRT ALLOC OR 8000 BITS.

IMOB1:	MOVE C,IMSOC7(I)	;ALLOC
	CAILE C,8000.
	 MOVEI C,8000.		;C := MIN(BITS IN BUFFER, ALLOC, MAX IMP MSG SIZE)
	TLNE E,2000		;SKIP IF BYTES EXACTLY FIT IN WORD
	 JRST IMOB3		;MUST SEND MULTI WORDS
	CAMGE C,T		;SKIP IF ALLOC GEQ WDSIZ
	 JRST IMOB2		;MUST SEND PART WORD
	IDIV C,T		;#WDS
	MOVE D,C
	IMUL C,T		;#BITS IN THOSE WDS
IMOB1A:	ADDI D,-1(TT)		;LAST WORD OUTPUT
	CAIG D,@IMSBFE(I)
	 JRST .+3
	  SUBI D,@IMSBFE(I)	;WRAP AROUND
	  ADDI D,-1(Q)
	HLL D,IMSBFE(I)		;PUT IN BYTE PART (RIGHT END OF WORD)
	JRST IMOB0A		;BUILD HEADER AND OUTPUT

;SEND PART OF WORD BECAUSE ALLOC IS TOO SMALL

IMOB2:	MOVE D,TT		;-> FIRST BYTE TO BE SENT
	MOVNI A,-36.(C)		;36-BITS SENT
	DPB A,[360600,,D]	;IS NEXT BYTE TO GO
	JRST IMOB0A

;SEND PARTIAL BUFFER OF BYTES WHICH DO NOT FIT EXACTLY IN WORDS (E.G. 7BIT BYTES)
;MUST SEND A "QUANTUM" WHICH FOR LAZINESS' SAKE IS 36 BYTES

IMOB3:	MOVEI A,36.		;#BITS IN A WORD
	IMUL A,B		;#BITS IN A QUANTUM
	IDIV C,A		;# QUANTA
	JUMPE C,IMOB4		;NOT ENOUGH ALLOC FOR EVEN 1 QUANTUM, SORRY CHARLIE
	MOVE D,C
	IMUL C,A		;#BITS TO SEND
	IMUL D,B		;#WDS TO SEND (36 BYTES TAKE <BYTESIZE> WDS)
	JRST IMOB1A

;NEED MORE ALLOCATE TO SEND A BUFFER FOR THIS ODD-SIZE CONNECTION

IMOB4:	MOVSI T,200000
	ANDCAM T,IMSOC6(I)	;CLEAR "ACTIVE AT PI LEVEL" BIT
	JRST IMPOBA		;MAYBE TRY ANOTHER ONE

;SENDING REST OF PARTIAL WORD (PI PTR NOT AT WORD BOUNDARY)
;A/ BITS LEFT IN WORD

IMOB5A:	SKIPA C,A		;36BIT GETS WHOLE WD
IMOB5B:	 HRREI C,-4(A)		;32BIT GETS 4 LESS
	MOVNI J,-36.(A)		;# BITS SHIFT TO LEFT JUSTIFY
	HRRZ D,TT
	CAIN D,@IMSMPP(I)	;IF WHOLE REST OF BUFFER IS IN THIS WORD
	 JRST [	LDB D,[360600,,IMSMPP(I)]
		SUB A,D		;A := NUMBER OF BITS TO SEND
		MOVE C,(TT)	;ALIGN BITS TO BE SENT IN LEFT OF WORD
		LSH C,(J)
		MOVEM C,(TT)
		MOVE C,A
		JRST IMOB0F ]	;RE-ALIGN POINTERS TO WORD BOUNDARY
	CAMLE C,IMSOC7(I)	;SKIP IF WILL FIT IN ALLOC
	 JRST IMOB6		;MUST SEND BYTES NOT LEFT JUST IN WD, AND MORE TO RIGHT
	MOVE D,(TT)		;GET WORD
	LSH D,(J)		;LEFT JUSTIFY
	MOVEM D,(TT)
	MOVE D,TT
	HLL D,IMSBFE(I)		;ADVANCE PI POINTER TO END OF THIS WORD
	JRST IMOB0A		;BUILD HDR & SEND

;SEND MIDDLE PART OF WORD. BECAUSE OF SMALL ALLOCATES, THE LEFT END OF THE
;   WORD WAS SENT AND ALSO THERE IS NOT ENOUGH ALLOCATE TO SEND THE REST
;   OF THE ONE WORD.  THIS MIGHT NEVER OCCUR EXCEPT FOR 8 BIT BYTES.
;MUST MOVE GOOD BITS TO LEFT END OF WORD, WITHOUT DISTURBING BITS TO THE RIGHT

IMOB6:	MOVE C,IMSOC7(I)	;CAN ONLY SEND ALLOC BITS
	SUB A,C			;POS OF LO BIT TO PICK UP
	DPB A,[360600,,TT]	;POS IN BYTE PTR
	MOVE D,TT		;SAVE ADVANCED PI PNTR
	DPB C,[300600,,TT]	;STORE AS SIZE OF BYTE
	LDB R,TT		;GET BYTE
	MOVNI A,-36.(C)		;POS OF LO BIT TO STORE
	DPB A,[360600,,TT]	;POS IN B PTR
	DPB R,TT		;STORE BYTE AWAY
	JRST IMOB0A		;SEND THE BYTE(S)

OVHMTR UUO	;YET MORE RANDOM UUOS
