COMMENT ⊗   VALID 00026 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	ARPADR S W M U F R T1 T2 T3 T4 P1 P2 P3 P4 ful.wd hlf.wd net.wd net.by msk.hw wd2byt byt2wd oct2by BY2BIT
C00007 00003	SETAC SETT10 SAVAC POPPJ1 POPPOJ TCPCAL
C00010 00004	GET4WD GIV4WD
C00012 00005	INTCOM UILLBS IDERR
C00013 00006	IMPDSP
C00014 00007	IMPSET IMPRET IMPRE1 DDBGET DDBGE1 DDBDEA DDBREL
C00017 00008	IMSINI IMPINI NQUIET IMPIRN
C00021 00009	MTAPE IMPLUZ UUODSP MXUUO
C00025 00010	CONECT NONIP CONNEW IPADR SUP1P2
C00029 00011	LISTEN SETST PUTSTB STATUS
C00031 00012	TERMIN TERMI1 SWAIT SWAIT1
C00033 00013	DUMP WAKEMT QRUN INPSKP SNDINT
C00035 00014	NEWINI NEWLOS KILIMP
C00037 00015	TSINT TSETAL TGETAL TGETFS TGETF1 UGETAL USETTM UGETTM
C00041 00016	GENSYM SNDRST SNDWDN UNWEDG
C00043 00017	IMPRLS IMPRL1 IMPRL3 IMPRL4 RLDI RLDI1
C00045 00018	BUFO DMPO
C00047 00019	NEWOX OUT01 OUT02 OUT025 OUT05 OUT051 OUT052 OUT07 OUT09 OUT06 OUT10 OUT102
C00053 00020	BUFI UUXIT ENDCHK DMPI DMPIT
C00056 00021	INPT INPT01 INPT11 INPT12 INPT02 INPT17 INPT18 INPT19 INPT21 INPT09 INP09A INPT13 INPT14
C00071 00022	CLSO CLSI
C00073 00023	IMPW60 IMPWAT CLRAC1 STTIO1
C00077 00024	DIE
C00079 00025	UUOOOK UUOOK1 ISETEB UUOIOK
C00080 00026	>IFN IMPNUM
C00081 ENDMK
C⊗;
;ARPADR S W M U F R T1 T2 T3 T4 P1 P2 P3 P4 ful.wd hlf.wd net.wd net.by msk.hw wd2byt byt2wd oct2by BY2BIT

	SUBTTL IMP UUO Routines

;JAM	September '71
;MRC	May '78 for extended leaders
;JJW	March '83 for IP/TCP

IFN IMPNUM,<

BEGIN IMPUUO

HISYS

ARPADR←←12				;Network number for ARPAnet

;Tops-10 AC definitions

S←←0		;Same as WAITS IOS
W←←1
M←←2
;P←←3		;Same as WAITS P
;J←←4		;Same as WAITS J
U←←5
F←←6		;Same as WAITS DDB
R←←7
T1←←10
T2←←T1+1
T3←←T2+1
T4←←T3+1
P1←←14
P2←←P1+1
P3←←P2+1
P4←←P3+1

;From NETDEF.MAC:

;constants desirable for their neumonic [sic - JJW] meaning

ful.wd==↑d36		; the number of bits in a dec-10 word
hlf.wd==↑d18		; the number of bits in a half word
net.wd==↑d32		; the number of bits in a net word
net.by==↑d8		; the number of bits in a net byte
msk.hw==mask.(<↑d16>,<↑d35>)	; mask for complementing checksum half word.
wd2byt==2		; how to shift from words to bytes
byt2wd==-wd2byt		; how to shift from bytes to words
oct2by==↑d3		; how to shift from an octet of bytes into bytes.

;Some more

BY2BIT←←3			;How to shift from bytes to bits

;SETAC SETT10 SAVAC POPPJ1 POPPOJ TCPCAL

;Routines to change AC conventions back and forth from WAITS to TOPS10 at UUO
;level.  We assume that P and J will be defined the same in both systems
;(because they have the same name).  The TOPS10 code at IMPUUO (in TCPSER)
;sets the right half of M to the address of the argument block.  For functions
;that we do by MTAPE, register UUO already has that in it so things work right.

;At UUO level, ACs normally start out in WAITS mode.  We do a PUSHACS to save
;them and then SETT10 to set the values in registers expected by TOPS-10 code.
;If other ACs have to be set up, individual calls to SETAC may be used.

DEFINE SETAC(AC,SVAC)<
IFN AC-SVAC,<
	MOVE AC,SVAC-17(P)
>>

DEFINE SETT10<
	SETAC(S,IOS)
	SETAC(F,DDB)
	SETAC(M,UUO)
>

;To get back into WAITS mode, first use SAVAC to save any values that may have
;changed.  Then POPACS to get back ACs that were pushed.

DEFINE SAVAC(SVAC,AC)<
	MOVEM AC,SVAC-17(P)
>

POPPJ1:	POPACS				;Restore and skip return
	AOSA(P)
POPPOJ:	POPACS				;Restore and normal return
	POPJ P,

;Macro to call an IMPUUO handler in TCPSER.  Assume TOPS-10 ACs have been set up.
;Sets up left half of P4 and turns scanner off and on again if needed.  Skip
;returns are ignored - error code in status bits will have been set.

DEFINE	TCPCAL ' (DD)<
	MOVE P4,[.W'DD]
	TLNN P4,UU.INT
	 OFFSCN
	PUSHJ P,(P4)
	 JFCL
	TLNN P4,UU.INT
	 ONSCN
>
;GET4WD GIV4WD

;Storage management - WAITS simulation of TOPS-10 code.

;Here to allocate a multiple of 4 words.
;
;Calling:
;		MOVEI T2,<# of 4-word blocks>
;		PUSHJ P,GET4WD
;		<not available - largest possible in T2>
;		<OK - address of block is in T1>
;
;NOTE: Not implemented putting address of largest possible block in T2.  Calls
;to here from NETSUB and TCPSER never use this feature.

GET4WD:	PUSHACS				;Save TOPS-10 ACs
	SETAC(AC3,T2)			;Set up the right AC
	LSH AC3,2			;Number of words
	PUSHJ P,FSGET
	 JRST POPPOJ
	SAVAV(T1,AC1)			;Address of block
	JRST POPPJ1

	
;Here to release blocks allocated by GET4WD.
;
;Calling:
;		MOVEI T1,<# of 4-word blocks>
;		MOVEI T2,<starting address>
;		PUSHJ P,GIV4WD
;		<return here always>

GIV4WD:	PUSHACS				;Save TOPS-10 ACs
	SETAC(AC1,T2)
	PUSHJ P,FSGIVE
	POPACS
	POPJ P,

;INTCOM UILLBS IDERR

;Routine to plant an interrupt request.  Called from TOPS-10 AC's with F
;set up and interrupt bit in T1.

INTCOM:	LDB J,PJOBN
	JUMPE J,CPOPJ			;Make sure it's a real job
	TDNN T1,JBTIEN(J)
	 POPJ P,
	IORM T1,JBTIRQ(J)
	TDNE T1,JBTMSK(J)	; ANY BIT MASKED ON?
	 SETOM INTREQ		; YES, RUN INTERRUPTS
	POPJ P,

;Here to return error codes to user.

UILLBS:	SKIPA TAC,[ILB]
IDERR:	MOVEI TAC,IDD
	XCTR XW,[MOVEM TAC,STLOC(UUO)]
	POPJ P,

;IMPDSP

; UUO DISPATCH TABLE

	POPJ P,		; Don't flush DDB - let TCPSER code do that
	JRST IMPSET	; DDB MAKE
	JRST IMSINI	; SYSTEM INITIALIZATION
	POPJ P,		; NO HUNG TIMEOUT
↑IMPDSP:JRST IMPRLS	; RELEASE
	JRST CLSO	; CLOSE OUTPUT
	JRST BUFO	; BUFFERED OUTPUT
	JRST BUFI	; BUFFERED INPUT
	JRST CPOPJ1	; ENTER
	JRST CPOPJ1	; LOOKUP
	JRST DMPO	; DUMP MODE OUTPUT
	JRST DMPI	; DUMP MODE INPUT
	POPJ P,		; USETO
	POPJ P,		; USETI
	POPJ P,		; UGETF
	JRST CPOPJ1	; RENAME
	JRST CLSI	; CLOSE INPUT
	POPJ P,		; UTPCLR
	JRST MTAPE	; MTAPE

;IMPSET IMPRET IMPRE1 DDBGET DDBGE1 DDBDEA DDBREL

; ROUTINES TO MAKE AND RELEASE IMP DEVICE DATA BLOCKS

↑IMPSET:MOVEI AC3,IMPDLN	; MAKE A BLOCK
	PUSHJ P,FSGET
	 JRST [	ADJSP P,-3
		JRST DLYCM1]
	HRRI DDB,DDBSKW(AC1)	; POINT DDB AT DEVICE NAME
	HRLI AC1,IMPDDB-DDBSKW	; COPY DDB FROM PROTOTYPE
	BLT AC1,IMPDLS(DDB)
	MOVEI AC1,DEVIOS(DDB)	; SET UP SPT
	MOVEM AC1,DEVSPT(DDB)
	HRLM DDB,IMPDDB+DEVSER	; LINK IN DDB CHAIN
	POPJ P,

↑IMPRET:SETZB IOS,DEVIOS(DDB)	; FLUSH IOS
	MOVEI AC1,IMPDDB	; FIND DDB
IMPRE1:	MOVE TAC1,AC1
	HLRZ AC1,DEVSER(TAC1)
	JUMPE AC1,CPOPJ		; DDB NOT FOUND? (SHOULDN'T HAPPEN BUT IT DOES)
	CAIE AC1,(DDB)
	 JRST IMPRE1
	MOVE DDB,DEVSER(AC1)	; DELETE DDB FROM CHAIN
	HLLM DDB,DEVSER(TAC1)
	SUBI AC1,DDBSKW		; RETURN TO FS
	JRST FSGIVE

;The following replaces DDBGET in NETSUB.  May be called at interrupt level.
;Never waits.  Skip returns if successful.

DDBGET:	PUSHACS			;Don't damage AC's TOPS-10 may use
	MOVEI AC3,IMPDLN	; MAKE A BLOCK
	PUSHJ P,FSGET
	 JRST DDBGE1
	AOS -20(P)		; Indicate our success
	HRRI DDB,DDBSKW(AC1)	; POINT DDB AT DEVICE NAME
	HRLI AC1,IMPDDB-DDBSKW	; COPY DDB FROM PROTOTYPE
	BLT AC1,IMPDLS(DDB)
	MOVEI AC1,DEVIOS(DDB)	; SET UP SPT
	MOVEM AC1,DEVSPT(DDB)
	HRLM DDB,IMPDDB+DEVSER	; LINK IN DDB CHAIN
	SAVAC(F,DDB)		;Make POPACS pop DDB into F
DDBGE1:	POPACS
	POPJ P,

;Here from TOPS-10 code to release a DDB.

DDBDEA:
DDBREL:	PUSHACS				;Save away TOPS-10 ACs
	SETAC(DDB,F)
	PUSHJ P,IMPRET
	POPACS				;Get ACs back
	POPJ P,
;IMSINI IMPINI NQUIET IMPIRN

; SYSTEM INITIALIZE ROUTINE

IMSINI:	SETOM IMPINF			; SYSTEM INITIALIZATION
	SETZM OURHST			; don't know our host/imp number yet
	SETZM DIFHST			; and it hasn't changed yet either
	PUSHACS				;Get into TOPS-10 mode
	SETT10
	PUSHJ P,INI↑			;(in IMPSER.MAC)
	POPACS				;back to WAITS mode
	POPJ P,

; NCP RE-INITIALIZE ROUTINE

IMPINI:	SETZM IMPST		; CLEAR DATA AREA
	MOVE AC1,[IMPST,,IMPST+1]
	BLT AC1,IMPEND-1
NQUIET←←5	;NUMBER OF MINUTES OF SUPPRESSION OF IMP ERROR MESSAGES
	MOVEI AC1,NQUIET	; NUMBER OF MINUTES OF SILENCE FOR CTY
	MOVEM AC1,IQUIET	; SUPPRESS ERROR MESSAGES FOR A WHILE
	SKIPE IMPDIE		; DO WE KEEP THE IMP DOWN TODAY?
	 JRST [	SETOM IMPDEAD	; YES
		POPJ P,]
	MOVEI AC1,P1PID
	MOVEM AC1,IMPPID
	MOVEI AC1,IBEGIN	; INITIALIZE THE I-LEVEL DISPATCH ADDRESSES
	MOVEM AC1,IMPIDSP
	HRLOI AC1,377777	; SET OUTPUT COUNT-DOWN TO RANDOM LARGE NUMBER
	MOVEM AC1,IMPOCT
	MOVEI AC1,DONOP
	MOVEM AC1,IMPODSP	; start outputting no-ops to IMP interface
	MOVEI AC1,10		; GIVE A LITTLE WHILE FOR THE IMP RELAY TO COOL OFF
	MOVEM AC1,HCLCNT
	MOVEI AC1,IMPSPL	; PICK UP A BUNCH OF SPARE FREE STORAGE BLOCKS
	MOVEM AC1,IMPSPN
	PUSHJ P,IMPREP
	MOVE AC1,[-INTPLN,,IMPIPL-1]
	MOVEM AC1,IMPIPD
	MOVE AC1,[-INTPLN,,IMPOPL-1]
	MOVEM AC1,IMPOPD
	MOVEI AC1,5*JIFSEC
	MOVEM AC1,UPWCNT	; RESET INTERFACE RESET CLOCK
IFE FTF2,<
	CONO IMP,ODPIEN		; Clear PIA for output (why? it's set just below!)
	CONO IMP,STRIN!CLRWT!IDPIEN!IEPIEN!IMPCHN ;Set PIAs for input
>;IFE FTF2
IFN FTF2,<
	CONO IMP,IDPIEN!IEPIEN!IMPCHN!<IMPCHN⊗8> ;Set PIAs for input
>;IFN FTF2
	MOVEI AC3,4		; SEND THE IMP SOME NOPS
	MOVEM AC3,NOPCNT
	SETOM IMPOACT
	MOVEI AC3,MAXCNT
	MOVEM AC3,IMPOCT
	CONO PI,IMPOFF
IFN FTF2,<
	CONO IMP,ODPIEN!<IMPCHN⊗4> ; set output PIA
>;IFN FTF2
IFE FTF2,<
	CONO IMP,STROUT!ODPIEN!IMPCHN!O32 ; 32 BIT output MODE, DAMNIT!
;The following DATAO must occur here, not at interrupt level, for system
;initialization to be able to get the IMP interface going after a power up on
;the IMP interface.  For simplicity, we'll do the DATAO here for all WAITS.
>;IFE FTF2
	DATAO IMP,[BYTE (4)0 (4)17 (16)0 (8)4]	; NOP
	CONO PI,IMPON
IMPIRN:	MOVEI TAC,['IMPRST' ↔ '  1  2' ↔ UPGPRV,,0]
	PUSHJ P,FIREUP		; RUN MAGIC WORLD RESETTER
	 CAIA
	  POPJ P,
	MOVSI TAC,IMPIRN
	CONO PI,PIOFF
	IDPB TAC,CLKQ
	CONO PI,PION
	POPJ P,
;MTAPE IMPLUZ UUODSP MXUUO

; MTAPE DISPATCH

MTAPE:	XCTR XR,[HRRZ TAC,(UUO)]	; GET FUNCTION CODE
	CAIL TAC,MXUUO			; FUNCTION IN BOUNDS?
	 JRST UUOERR			; ILLEGAL FUNCTION
	SKIPG STATE(DDB)		; is it a closed DDB?
	 PUSHJ P,CLRIMP↑		; yes.  CLEAR THE DDB (in NETSUB.MAC)
	SKIPL TAC1,UUODSP(TAC)		; GET DISPATCH ADDRESS
	 SKIPE IMPUP↑			; FUNCTION REQUIRES LIVING IMP
	  JRST (TAC1)			; ALIVE OR FOR A DEAD IMP
	TLNE TAC1,200000		; DOES THIS MTAPE EXPECT STATUS BITS?
	 JRST IDERR			; YES, RETURN IDD ERROR
	TLNE TAC1,100000		; FUNCTION NO-OP WHEN IMP DOWN?
	 POPJ P,
IMPLUZ:	JSP TAC,UUOMES			; NOPE, BLAST USER'S JOB
	 ASCIZ/IMP dead, UUO/


; IMP MTAPE UUO DISPATCH TABLE.  LH BITS ARE:
; 400000 → THIS MTAPE ALWAYS WINS WHETHER OR NOT IMP IS DEAD
; 200000 → THIS MTAPE RETURNS STATUS BITS IN ARG BLOCK+STLOC, SO SET IDD IF IMP DEAD
; 100000 → THIS MTAPE IS A NO-OP IF THE IMP IS DEAD
; IF NONE OF THESE BITS ARE SET USER GETS AN "IMP DEAD" MESSAGE.

UUODSP:	200000,,CONECT			; 0 ESTABLISH CONNECTION
	200000,,LISTEN			; 1 LISTEN ON A SOCKET
	200000,,STATUS			; 2 GET STATUS BITS
	200000,,TERMIN			; 3 TERMINATE CONNECTION (LIKE CLOSE UUO)
	200000,,SWAIT			; 4 WAIT FOR CONNECTION
	400000,,DUMP			; 5 GET POINTERS TO SYSTEM SYMBOLS
	WAKEMT				; 6 WAKE UP USER PROCESS FROM I-LEVEL
	200000,,SETST			; 7 GET STATUS BLOCK (USED AFTER LISTEN)
	INPSKP				; 10 SKIP IF IMP INPUT
	200000,,SNDINT			; 11 SEND INR/INS
	400000,,NEWINI			; 12 TURN ON IMP
	100000,,KILIMP			; 13 TURN OFF IMP
	TSINT				; 14 TEST AND CLEAR INTERRUPT STATUS
	100000,,TSETAL			; 15 SET ALLOCATION
	100000,,TGETAL			; 16 GET ALLOCATION
	100000,,USETTM			; 17 SET TIMEOUTS
	100000,,UGETTM			; 20 GET TIMEOUTS
	100000,,GENSYM			; 21 GENSYM A SOCKET FOR ICP
	SNDRST				; 22 SEND A RESET
	100000,,SNDWDN			; 23 SEND HOST DOWN STATUS MESSAGE
	UNWEDG				; 24 ATTEMPT TO UNWEDGE AN IMP CONNECTION
MXUUO←←.-UUODSP
;CONECT NONIP CONNEW IPADR SUP1P2

;Here we try to distinguish between NCP host/IMP numbers and IP addresses.
;If an IP address is given, it must include a valid net number (ARPADR).

CONECT:	XCTR XR,[MOVE AC2,HLOC(UUO)]	;Get host number from user
	TLNE AC2,740000			;Left 4 bits 0?
	 JRST NONIP			;No.  Can't be an IP address.
	LDB AC3,[POINT 8,AC2,11]	;Network number in IP format
	CAIN AC3,ARPADR			;ARPAnet?
	 JRST IPADR			;Yes.  Wouldn't be legal in NCP format.
	CAIE AC3,ARPADR⊗3		;ARPAnet in NCP format?
	 JUMPN AC3,UUOERR		;No.  If not 0, punt.
NONIP:	LDB AC3,[POINT 8,AC2,8]		;Network number in NCP format
	SKIPN AC3
	 MOVEI AC3,ARPADR		;Default to ARPAnet
	CAIE AC3,ARPADR			;Check network for legality
	 JRST UUOERR			;Unknown network
	TDNE AC2,[400600,,000400]	; LEGAL NUMBER?
	 JRST UUOERR			; BLAST THIS LOSER OUT OF THE WATER!
	TDNE AC2,[000177,,777000]	; OLD OR NEW STYLE NUMBER?
	 JRST CONNEW
	DPB AC2,[POINT 6,AC2,20]	; STORE IMP NUMBER IN NEW FORMAT
	LSH AC2,-6			; RIGHT-ALIGN HOST NUMBER
;Host/IMP number is now in "new" NCP form in AC2, net number in AC3.
;Form IP address in AC1.
CONNEW:	DPB AC3,[POINT 11,AC1,11]	;Net number in IP address
	LDB AC3,[POINT 8,AC2,35]
	DPB AC3,[POINT 8,AC1,19] 	;Host number
	LDB AC3,[POINT 16,AC2,26]
	DPB AC3,[POINT 16,AC1,35]	;IMP number
	XCTR XW,[MOVEM AC1,HLOC(UUO)]	;Return it to the user
;Check byte size.  0 or =8 is accepted, =8 always returned.
IPADR:	XCTR XR,[SKIPN DAT,BSLOC(UUO)]
	 MOVEI DAT,=8			;Default 0 to =8
	CAIE DAT,=8
	 JRST UILLBS			;Bad byte size
	XCTR XW,[MOVEM DAT,BSLOC(UUO)]
;Call TCPSER code to make the connection.
	PUSHACS				;Get into TOPS-10 mode
	SETT10
	PUSHJ P,SUP1P2
	TCPCAL(CONN)
;TCPSER will have stored generated port number, if any, in LSLOC(UUO).
	POPACS				;Back to WAITS mode
	JRST PUTSTB			;Give user status bits and return


;Here to set up P1 and P2 for TOPS10 code, after doing SETT10.  P1 gets flags
;in left half; P2 gets TOPS10 version of local port number in MTAPE block,
;to allow generation of new port numbers.

SUP1P2:	SETZ P1,			;All flags off initially
	XCTR XR,[SKIPN WFLOC(M)]	;See if we should wait
	 TLO P1,(IF.NWT)		;No wait.
	MOVSI T1,UPGPRV			;Is UPG enabled?
	TDNE T1,JBTPRV(J)
	 TLO P1,(IF.PRV)		;Yes.
	XCTR XR,[MOVE P2,LSLOC(M)]	;Get local port supplied by user
	CAME P2,[-1]			;Is he asking for a gensymmed port?
	 TLOA P1,(IF.ALS)		;No, absolute.
	  SETZ P2,			;Yes.  Ask for 0 in lower 3 bits.
	POPJ P,
;LISTEN SETST PUTSTB STATUS

LISTEN:	XCTR XRW,[MOVES HLOC(UUO)]	;Address check
	XCTR XW,[SETOM FSLOC(UUO)]	;Show no connection yet
	PUSHACS				;Get into TOPS-10 mode
	SETT10
	PUSHJ P,SUP1P2			;Set wait flag and others
	TCPCAL(REQU)			;This stores info in the DDB
	POPACS				;Back to WAITS mode
SETST:	MOVE AC2,LCLPRT(DDB)		;Store local port if we got one
	XCTR XW,[MOVEM AC2,LSLOC(UUO)]
	MOVEI AC2,=8			;Return fixed byte size
	XCTR XW,[MOVEM AC2,BSLOC(UUO)]
	MOVE AC2,RMTPRT(DDB)		;Remote port will be -1 if none yet
	XCTR XW,[MOVEM AC2,FSLOC(UUO)]
	MOVE AC2,RMTADR(DDB)		;Store remote host
	XCTR XW,[MOVEM AC2,HLOC(UUO)]
;	JRST PUTSTB			;Give him status bits and return

;Here to store status in usual return location.

PUTSTB:	MOVE AC2,STB(DDB)		;Current status
	MOVE AC3,STATE(DDB)		;Get TCP state
	DPB AC3,[POINT 4,AC2,9]		;Add to status word
	XCTR XW,[MOVEM AC2,1(UUO)]	;Give it to user
	POPJ P,

;STATUS call returns same values in both words.

STATUS:	PUSHJ P,PUTSTB
	XCTR XW,[MOVEM AC2,2(UUO)]
	POPJ P,

;TERMIN TERMI1 SWAIT SWAIT1

; TERMINATE CONNECTION

TERMIN:	XCTR XR,[SKIPE AC2,LSLOC(UUO)]	;Get desired port
	CAMN AC2,LCLPRT(DDB)		;Is it ours?
	 JRST TERMI1
	JSP TAC,UUOMES
	 ASCIZ/Illegal port in terminate, UUO/

TERMI1:	PUSHACS				;Get into TOPS-10 mode
	SETT10
	TCPCAL(CLOS)
	POPACS				;Back to WAITS mode
	JRST PUTSTB			;Give him status bits and return

; ROUTINE TO WAIT FOR CONNECTION

SWAIT:	XCTR XR,[SKIPE AC2,LSLOC(UUO)]	;Get desired port
	CAMN AC2,LCLPRT(DDB)		;Is it ours?
	 JRST SWAIT1
	JSP TAC,UUOMES
	 ASCIZ/Illegal port in wait, UUO/

SWAIT1:	PUSHACS				;Get into TOPS-10 mode
	SETT10
	MOVEI T1,S%LIST			;Waiting to get out of listen state
	OFFSCN				;ESTBWT (in TCPSER.MAC) expects this
	PUSHJ P,ESTBWT↑			;Wait to get into established or better.
	 JFCL				;Error return nothing special
	ONSCN
	POPACS				;Back to WAITS mode
	JRST PUTSTB

;DUMP WAKEMT QRUN INPSKP SNDINT

;DUMP not implemented yet for IP/TCP.

DUMP:	JRST UUOERR

; WAKE UP MONITOR IF WAITING FOR IMP. SETS TMO IN IOS TO INDICATE ERROR CONDITION
;(Unchanged from old IMPSER, so PUPSER can still call this.)

↑WAKEMT:SKIPN INTACT
	 POPJ P,
	MOVE IOS,DEVIOS(DDB)
	TLNN IOS,ANYW
	 POPJ P,
	TRO IOS,TMO
	MOVEM IOS,DEVIOS(DDB)
;	JRST QRUN

; ROUTINE TO REQUEUE SOMEONE INTO THE RUN QUEUE
; ENTER WITH DDB CONTAINING THE DDB

QRUN:	LDB J,PJOBN
	SKIPL IMPTIM(DDB)	; MAKE SURE TIMEOUT IS CLEARED
	 SOS TIMWAIT		; NOTE ONE LESS WAITOR
	SETOM IMPTIM(DDB)
	JRST STTIOD		; NOW RUN HER

; ROUTINE TO SKIP IF THERE IS ANY INPUT PRESENT

INPSKP:	SKIPE IBFTHS(DDB)		;Any input?
	 AOS (P)			;Yes.
	POPJ P,

;SNDINT not implemented for IP/TCP.  No interrupt is sent, but status bits are
;returned.

SNDINT:	JRST PUTSTB

;NEWINI NEWLOS KILIMP

; REINITIALIZE THE IMP SYSTEM, BRING UP THE IMP

NEWINI:	MOVSI AC2,UPGPRV
	SKIPE IMPDIE		; CLOCK LEVEL DOES IT IF IMPDIE=0
	 TDNN AC2,JBTPRV(J)
	  JRST UUOERR
	SKIPE IMPUP↑
	 JRST NEWLOS
	PUSHJ P,DISUSR
	 SIXBIT/NET/
	PUSHJ P,DISMES
	 ASCIZ/IMP on, user=/
	MOVE TAC1,PRJPRG(J)
	PUSHJ P,DISSIX
	PUSHJ P,DISMES
	 ASCIZ/, job=/
	PUSHJ P,DISJOB
	PUSHJ P,DISCRLF
	SETZM IMPDIE
	SETOM IMPUP↑		;JJW - for IP/TCP code
	JRST IMPINI

NEWLOS:	PUSHJ P,TTYERR
	JSP TAC,UUOMES
	 ASCIZ/IMP already alive, UUO/

; BRING THE IMP DOWN

KILIMP:	MOVSI AC2,UPGPRV
	TDNN AC2,JBTPRV(J)
	 JRST UUOERR
	PUSHJ P,DISUSR
	 SIXBIT/NET/
	PUSHJ P,DISMES
	 ASCIZ/IMP off, user=/
	MOVE TAC1,PRJPRG(J)
	PUSHJ P,DISSIX
	PUSHJ P,DISMES
	 ASCIZ/, job=/
	PUSHJ P,DISJOB
	PUSHJ P,DISCRLF
	SETOM IMPDIE		; KEEP IT DOWN!
	MOVEI TAC,1		;JJW - for IP/TCP
	MOVEM TAC,IMPUP↑
	POPJ P,
;JJW - previously there was the following instruction:
;	JRST IMPDD0
;which went to some code in IMPSER.  It appears that setting IMPUP to 1 may
;be sufficient since the clock-level code in IMPSER.MAC takes some action based
;on this (like sending a "going down" message).
;TSINT TSETAL TGETAL TGETFS TGETF1 UGETAL USETTM UGETTM

; TEST AND CLEAR INTERRUPT BITS - SET SYSTEM DEFAULT TIMEOUTS
; RETURNS FLAG FOR SEND SIDE IN 1(UUO), RECEIVE SIDE IN 2(UUO)
;JJW - now always returns 0.

TSINT:	ANDI DDB,-1
	XCTR XW,[SETZM 1(UUO)]
	XCTR XW,[SETZM 2(UUO)]
	POPJ P,

;SET ALLOCATION is not yet supported by the code in TCPSER.  Until it is,
;this MTAPE will be a no-op.

TSETAL:	POPJ P,

;GET ALLOCATIONS - This code only sets the bit allocation fields, and
;always to a multiple of 8 bits.  The message allocation fields are zeroed.

TGETAL:	MOVE TAC,RCVWND(DDB)
	LSH TAC,BY2BIT			;convert bytes to bits
	XCTR XW,[MOVEM TAC,1(UUO)]
	XCTR XW,[SETZM 2(UUO)]
	;JJW - I'm not sure how to compute the value for 3(UUO)
	XCTR XW,[SETZM 4(UUO)]
	PUSHJ P,TGETFS
	LSH TAC,BY2BIT
	XCTR XW,[MOVEM TAC,5(UUO)]
	XCTR XW,[SETZM 6(UUO)]
	MOVE TAC,SNDWND(DDB)
	LSH TAC,BY2BIT
	XCTR XW,[MOVEM TAC,7(UUO)]
	XCTR XW,[SETZM 10(UUO)]
	POPJ P,

;Here to add up number of bytes in free storage (i.e., on input list)
;and return in TAC.

TGETFS:	MOVE TAC,IBFBC(DDB)		;Bytes in current buffer
	MOVE AC1,IBFTHS(DDB)		;Current buffer
TGETF1:	HRRZ AC1,AC1			;Advance to next buffer
	JUMPE AC1,CPOPJ
	HLRZ TAC1,AC1			;Get byte count
	ADDI TAC,(TAC1)			;Add it in
	JRST TGETF1

;Following should be moved to PUPSER since IMPSER no longer uses it.

; MTAPE 14 - GIVE USER THE CURRENT ALLOCATIONS
; THIS CODE IS ALSO USED BY PUPSER

↑UGETAL:MOVE TAC,NHBA(DDB)
	XCTR XW,[MOVEM TAC,1(UUO)]
	MOVE TAC,NHMA(DDB)
	XCTR XW,[MOVEM TAC,2(UUO)]
	MOVE TAC,HBA(DDB)
	XCTR XW,[MOVEM TAC,3(UUO)]
	MOVE TAC,HMA(DDB)
	XCTR XW,[MOVEM TAC,4(UUO)]
	MOVE TAC,BIIL(DDB)
	XCTR XW,[MOVEM TAC,5(UUO)]
	MOVE TAC,MIIL(DDB)
	XCTR XW,[MOVEM TAC,6(UUO)]
	MOVE TAC,BAL(DDB)
	XCTR XW,[MOVEM TAC,7(UUO)]
	MOVE TAC,MAL(DDB)
	XCTR XW,[MOVEM TAC,10(UUO)]
	POPJ P,

; SET SYSTEM DEFAULT TIMEOUTS. PUT WORD OF 6-BIT FIELDS IN 1(UUO).
; THE FIELDS ARE IN UNITS OF 2-SECONDS. I.E., THE MAXIMUM WAIT IS 126 SECONDS
; AND THE MINIMUM WAIT IS 2 SECONDS.

; THIS CODE IS ALSO USED BY PUPSER

↑USETTM:XCTR XR,[MOVE AC1,1(UUO)]
	MOVEM AC1,TIMES(DDB)
	POPJ P,

; ROUTINE TO GET CURRENT TIMEOUTS

↑UGETTM:MOVE AC1,TIMES(DDB)
	XCTR XW,[MOVEM AC1,1(UUO)]
	POPJ P,

;GENSYM SNDRST SNDWDN UNWEDG

;Generate a local port number.  This is done by calling the appropriate
;routine in TCPSER.

GENSYM:	XCTR XRW,[MOVES 1(UUO)]		;Address check
	PUSHACS				;Get into TOPS-10 mode
	SETT10
	SETZB P1,P2			;To ask for a free socket
	PUSHJ P,MAKMYS↑
	XCTR XW,[MOVEM T1,1(M)]		;Store result in argument block
	POPACS				;Back to WAITS mode
	POPJ P,

;SEND RESET - not possible in TCP.

SNDRST:	JRST UUOERR

;Send a HOST GOING DOWN message - not implemented yet in IMPSER.MAC.

SNDWDN:	MOVSI AC1,UPGPRV
	TDNN AC1,JBTPRV(J)	; ENABLED UPG?
	 JRST UUOERR
	POPJ P,

;Unwedge a connection - no longer legal.

UNWEDG:	JRST UUOERR

;IMPRLS IMPRL1 IMPRL3 IMPRL4 RLDI RLDI1

;JJW - needs work.

; RELEAS CODE. SEND OUT CLSS IF NOT ALREADY.

IMPRLS:	SKIPL IMPTIM(DDB)	; TIME INITIALIZED?
	 SOS TIMWAIT		; YES, NOT ANY MORE
	SETOM IMPTIM(DDB)
	SKIPE AC1,INL(DDB)	; ANYTHING STILL ON INPUT LIST?
	 PUSHJ P,RELBLS		; YES, GIVE IT BACK
	SKIPN IMPUP↑
	 JRST RLDI
	MOVE IOS,DEVIOS(DDB)
	TRNE IOS,BLOK
	 PUSHJ P,RFNMWT		; IF STILL DATA ON THE LINK, WAIT FOR IT
	PUSHJ P,UUSIDX
	 JRST IMPRL3
	MOVE AC1,IMPSTB-1(AC3)
	TLNE AC1,RFCS
	 TLNE AC1,CLSS
	  JRST IMPRL1
	PUSHJ P,USCLS
	PUSHJ P,UUSIDX
	 JRST IMPRL3
IMPRL1:	SETZM LNKDDB-1(AC3)
	PUSHJ P,ZEROLK
IMPRL3:	PUSHJ P,UURIDX
	 POPJ P,
	MOVE AC1,IMPSTB-1(AC3)
	TLNE AC1,RFCS
	 TLNE AC1,CLSS
	  JRST IMPRL4
	PUSHJ P,URCLS
	PUSHJ P,UURIDX
	 POPJ P,
IMPRL4:	SETZM LNKDDB-1(AC3)
	JRST ZEROLK		; RELEASE CONNECTION IF ALL CLSS ARE PROPERLY EXCHANGED

; WE GET HERE IF THE IMP IS DEAD

RLDI:	PUSHJ P,UUSIDX		; SEE IF HE HAS A SEND SOCKET
	 JRST RLDI1
	SETZM LNKDDB-1(AC3)	; YES, KILL IT
	PUSHJ P,ZEROLK
RLDI1:	PUSHJ P,UURIDX
	 POPJ P,
	SETZM LNKDDB-1(AC3)
	JRST ZEROLK
;BUFO DMPO

;BUFFERED OUTPUT, DUMP MODE OUTPUT

;JJW - because the TOPS-10 IMPSER.MAC implements only buffered mode (and even
;that in a slightly different way from WAITS), the code here is a hybrid of that
;and the old NCP code in WAITS. The same holds for input UUO code.

BUFO:	PUSHJ P,UUOOOK		; IS HOST ALIVE AND ALL?
	 JRST UUXIT		; NO, LEAVE WITH ERROR BITS
	HRRZ TAC1,DEVOAD(DDB)	; PICK UP OUT BUFFER ADDRESS
	XCTR XR,[HRRZ ITEM,1(TAC1)]	; PICK UP WORD COUNT
	PUSHJ P,ITMCNT		;Count number of bytes
	HRRZ TAC1,DEVOAD(DDB)	;Buffer address
	ADDI TAC1,2		; MOVE POINTER TO DATA AREA
	PUSHJ P,NEWOX		;Do transfer with user addr in TAC1 and byte
				;count in ITEM
	PUSHJ P,ADVBFE		; ADVANCE BUFFER
	 JRST UUXIT
	JRST BUFO		; TRY FOR ANOTHER ONE

; DUMP MODE OUTPUT

DMPO:	PUSHJ P,UUOOOK
	 JRST UUXIT
	PUSHJ P,DMPCMD		;FETCH NEXT IOWD.
	 POPJ P,		;END OF COMMAND LIST
	MOVN ITEM,TAC		;POSITIVE WC
	LSH ITEM,WD2BYT		;Byte count
	HRRZ TAC1,TAC1		;TAC1←USER-RELATIVE STARTING ADDRESS
	PUSH P,UUO		;SAVE POINTER TO COMMAND LIST
	PUSHJ P,NEWOX		;DO TRANSFER
	POP P,UUO
	AOJA UUO,DMPO		;DO NEXT COMMAND
;NEWOX OUT01 OUT02 OUT025 OUT05 OUT051 OUT052 OUT07 OUT09 OUT06 OUT10 OUT102

; ROUTINE TO ACTUALLY DO THE OUTPUT
; ENTER WITH byte COUNT IN ITEM AND USER ADDRESS IN TAC1

NEWOX:	JUMPE ITEM,CPOPJ		; LEAVE IF USER byte COUNT=0
	HRLI TAC1,441000		; MAKE INPUT POINTER INTO BYTE POINTER
PRINTX IMP output only reads 8-bit bytes from user core

;JJW - all output is done byte-by-byte.  This doesn't add much in the way of
;inefficiency, because checksumming has to get done sometime, and OUBYTE handles
;this.  (We could possibly use the code that checksums words, but for now that
;looks too hairy.)  Code here is derived from OUTPT in IMPSER.MAC.

	PUSHACS				;Get into TOPS-10 mode
	SETT10
	SETAC(P1,TAC1)			;User address of data
	SETAC(P2,ITEM)			;Desired byte count
	;P3 is used to keep the running checksum.  P4 is the coroutine pointer.

OUT01:	SKIPE OKFLAG			;ALL OK?
	SKIPE STOPFL
	 JRST OUT09			;NO
OUT02:	PUSHJ P,TCPOCK↑			;OPEN FOR OUTPUT? (in TCPSER.MAC)
	 JRST OUT102			;NO
	MOVEI P4,OUBYTE↑		;ASSUME BYTE MODE (in IMPSER.MAC)
	MOVSI S,IO
	IORB S,DEVIOS(F)
	JUMPLE P2,OUT051		;Jump if no data

;TEST FOR ALLOCATION
	MOVSI S,ALLCWT			;SET WAIT FLAG
	IORM S,IMPIOS(F)
	IORB S,DEVIOS(F)
	PUSHJ P,TCPTCK↑			; is there enough window available?
	 JRST OUT07			; no window or not enough.  wait.

;OUTPUT LOOP
OUT025:	XCTR XR,[ILDB T1,P1]		;Get a character
	OFFSCN
	PUSHJ P,OTBYTE↑			;BUFFER AND COUNT IT
	 JRST OUT06			;LOSE!!!
	ONSCN
	SOJG P2,OUT025			;Loop for more
	SKIPG OBFBYT(F)			;DID WE BUFFER ANYTHING?
	 JRST OUT051			;NO, SO DON'T SEND ANYTHING

;HERE WHEN TRANSFER TO MONITOR BUFFER STOPPED.
OUT05:	SKIPG P2			; is this the last byte in the buffer?
	 PUSHJ P,TCPPSH↑		; yes.  let TCP do push handling.
	OFFSCN
	PUSHJ P,OUTPRE↑			; predict if we will have enough buffers
					;  for this message. (in IMPSER.MAC)
	 JRST [				; not enough room.
		ONSCN			; interrupts back on
		JRST OUT10]		; indicate error
	PUSHJ P,OUTBYT↑			; send it out (in IMPSER.MAC)
	ONSCN
	JUMPG P2,OUT02			;Jump if any bytes left

;Here when done a transfer.
OUT051:
	MOVSI S,IOBEG
	SKIPE IBFTHS(F)			;ANY INPUT DATA?
	TDNN S,DEVIOS(F)		;AND STILL VIRGIN INPUT SIDE?
	 JRST OUT052			;NO
	MOVEI S,IODATA			;YES
	IORB S,DEVIOS(F)		;SET DATA BIT
OUT052:	PUSHJ P,IMPWK1↑			;(in IMPSER.MAC)
	SAVAC(IOS,S)
	POPACS				;Back to WAITS mode
	POPJ P,

;HERE TO WAIT
OUT07:	OFFSCN				; interlock so IMPW60 doesn't damage some
					;  one else's lock.  (lock the lock)
	PUSHJ P,IMPW60↑			;WAIT A MINUTE
	JRST OUT02			;TRY AGAIN

;HERE IF IMP OFF LINE OR SOME SUCH
OUT09:	SAVAC(IOS,S)
	POPACS				;Back to WAITS mode
	PUSHJ P,HNGSTP			;TYPE USER MESSAGE AND STOP
	JRST OUT01			;TRY AGAIN IF HE CONTINUES

;HERE IF FAILED TO PACK BYTE INTO BUFFER.  T2 CONTAINS CERROR FLAG
OUT06:	ONSCN				; allow interrupts again
	LDB T1,[POINT 6,P1,11]		;GET BYTE SIZE
	ROT T1,-6
	ADD P1,T1			;BACK UP BYTE POINTER
	JUMPN T2,OUT05			;IF NON-ZERO, MESSAGE SIZE OR ALLOCATION

;HERE IF NO BUFFERS LEFT
OUT10:	MOVEI S,IODERR			;DEVICE ERROR
	SKIPA
OUT102:	MOVEI S,IOIMPM			;IMPROPER MODE
	IORB S,DEVIOS(F)
	OFFSCN
	SKIPE T1,OBFFST(F)		;IS THERE A STREAM?
	 PUSHJ P,RELBUF↑		;YES,  CLEAR IT (in NETSUB.MAC)
	SETZM OBFFST(F)			; clear pointer to stream.
	ONSCN
	JRST OUT051

;BUFI UUXIT ENDCHK DMPI DMPIT

; IMP INPUT UUOS - BUFFERED MODE AND DUMP MODE

BUFI:	HRRZ TAC1,DEVIAD(DDB)	; ADDRESS OF USER'S BUFFER
	XCTR XR,[HLRZ TAC,(TAC1)]; TAC←BUFFER SIZE
	ANDCMI TAC,400000	; IGNORE BUFFER USE BIT
	MOVEI DSER,(TAC1)
	ADDI DSER,(TAC)		; ADDRESS OF LAST DATA WORD IN BUFFER
	XCTR XRW,[MOVES (DSER)]	; ADDRESS CHECK
	SUBI TAC,1		; REDUCE BUFFER WC TO SKIP 1 OVERHEAD WORD
	ADDI TAC1,2		; ADVANCE TO POINT TO FIRST DATA WORD.
	PUSHJ P,INPT		; DO THE INPUT.
	 JRST ENDCHK		; ERROR OR EOF
	HRRZ AC2,DEVIAD(DDB)	; PICK UP BUFFER ADDRESS
	XCTR XW,[MOVEM DAT,1(AC2)] ; SET WORD COUNT IN BUFFER
	PUSHJ P,ADVBFF		; ADVANCE THE BUFFER
	 CAI
UUXIT:	MOVE IOS,DEVIOS(DDB)	; UUOCON EXPECTS THIS
	POPJ P,

ENDCHK:	TLZE IOS,IOEND		; DID WE HIT EOF?
	 IORI IOS,IODEND	; YES, SET EOF BIT
	TRNE IOS,TMO		; TIMED OUT?
	 IORI IOS,IODERR	; NEED TO SET ERROR BIT FOR UUOCON.
	MOVEM IOS,DEVIOS(DDB)
	POPJ P,

; DUMP MODE INPUT

DMPI:	PUSHJ P,DMPCMD		; FETCH AND CHECK NEXT IOWD FROM COMMAND LIST
	 POPJ P,		; END OF COMMAND LIST
	MOVN TAC,TAC		; TAC←POSITIVE WC.
	TLZE TAC1,-1		; MAKE SURE THIS ISN'T WRITE PROTECTED
	 JRST UADRER		; ADDRESS ERROR - CAN'T INPUT TO WRITE PROT AREA
DMPIT:	PUSHJ P,INPT		; DO AN INPUT
	 JRST ENDCHK
	JUMPG TAC,DMPIT		; IF WE HAVEN'T GOTTEN IT, GO BACK FOR MORE
	AOJA UUO,DMPI		; CHECK FOR MORE COMMANDS
;INPT INPT01 INPT11 INPT12 INPT02 INPT17 INPT18 INPT19 INPT21 INPT09 INP09A INPT13 INPT14

;Common input routine.  Enter with user address in TAC1 and desired word count
;in TAC. Returns count of words transferred in RH(DAT) and LH of byte ptr to
;last byte transferred in LH(DAT).  Returns +1 if error or no data available,
;+2 on some data transferred.

INPT:	PUSHJ P,UUOIOK		; MAKE SURE HOST ALIVE AND ALL
	 POPJ P,		; HOST DEAD

;Read data out of input list and into user core.  Some of this code similar to
;INPT in IMPSER.MAC, though cleaned up a bit.  Labels have been kept the same
;when possible, for easy reference.

	PUSHACS				;Get into TOPS-10 mode
	SETT10
	SETAC(P1,TAC1)			;User address to store data
	HRLI P1,441000			;Make into byte pointer
PRINTX IMP input only writes 8-bit bytes into user core
	SETAC(P2,TAC)			;Desired word count
	LSH P2,WD2BYT			;Make it a byte count
	SETZ P3,			;Words transferred
	MOVSI S,ALLWAT!IOBRKF!IO!IOFST
	ANDCAM S,IMPIOS(F)
	HRRI S,IODATA
	ANDCAB S,DEVIOS(F)		;CLEAR FLAGS
	TLNN S,IOBEG			;FIRST TIME AROUND?
	JRST INPT01			;NO
	SETZM ISHREG(F)			;YES
	MOVSI S,IOFST!IOBEG		;FIRST IO FLAG
	XORB S,DEVIOS(F)
INPT01:	MOVSI S,IDATWT
	IORM S,IMPIOS(F)
	IORB S,DEVIOS(F)		;SET IO WAIT FLAGS
	OFFSCN				; avoid anarchy
	PUSHJ P,INBYTC			;CALL CHECK ROUTINE
	 JRST INPT02			;DATA!

INPT11:	PUSHJ P,TCPICK↑			;OPEN? (in TCPSER.MAC)
	 JRST [ PUSHJ P,INPT13		;No.
		SAVAC(IOS,S)
		POPACS
		POPJ P,]		;Return error to caller.
	SKIPE OKFLAG
	SKIPE STOPFLG			;IMP OK?
	 JRST INPT12			;NO
	PUSHJ P,IMPW60			;WAIT
	JRST INPT01			;TRY FROM TOP

;Here if IMP not OK.
INPT12:	ONSCN
	SAVAC(IOS,S)
	POPACS				;Back to WAITS mode
	JRST IMPLUZ

;Here we move data from the input stream into user core.
INPT02:	ONSCN
	MOVEI P4,0
	EXCH P4,IBFPC(F)		;Get coroutine link, if any.
	JUMPN P4,INPT17			;Proceed if already set
	MOVEI P4,INBYTE			;Assume text

;Here to get an input byte
INPT17:	MOVSI S,IDATWT			;Set wait flag
	IORM S,IMPIOS(F)
	IORB S,DEVIOS(F)
	OFFSCN
	JSP P4,(P4)			;Get a byte
	 JRST INPT19			;No more
	AOS IBFBYT(F)			;Count bytes read
	ONSCN
	MOVSI S,IOFST			;Clear first data flg
	ANDCAB S,DEVIOS(F)
	XCTR XW,[IDPB T1,P1]		;Store it
	SOJG P2,INPT17			;Count and loop

;Here when user data area exhausted
INPT18:	SKIPLE IBFBC(F)			;Any input left?
	 HRRZM P4,IBFPC(F)		;Yes, save linkage
	OFFSCN				;avoid confusion
	PUSHJ P,INBYTC			;Make sure no more
	 SKIPA
	JRST INPT21			;Empty
	MOVEI S,IODATA			;Set data flag
	IORB S,DEVIOS(F)
	JRST INPT09			;DONE: tell NCP and free interrupts

;Here when stream exhausted before user data area
INPT19:	MOVEI S,IODATA			;Clear input data flag
	ANDCAB S,DEVIOS(F)

;Here when input exhausted
INPT21:	PUSHJ P,TCPIFN↑			;Test for closed (in TCPSER.MAC)
	 JRST [				;Closed. Interrupts are on.
		PUSHJ P,INPT14		;  Tell user about EOF.
		JRST INP09A]

;Here when done.
INPT09:	PUSHJ P,TCPWUP↑			;Update window information (in TCPSER.MAC)
	ONSCN				;Allow interrupts again
	PUSHJ P,IMPWK1↑			;Clear flags and such (in IMPSER.MAC)
INP09A:	SETAC(T1,TAC)			;Number of words user wanted
	LSH P2,BYT2WD			;Number of full words not transferred
	SUB T1,P2			;Number of words transferred
	HLL T1,P1			;Left half of byte ptr
	SAVAC(DAT,T1)			;Return to caller here
	SAVAC(IOS,S)			;Also make sure IOS is right
	JRST POPPJ1			;Indicate success


;Here if socket not open.

INPT13:	ONSCN				;interrupts are safe for democracy.
INPT14:	MOVSI S,IOEND			;End of file
	IORB S,DEVIOS(F)
	SKIPN IBFTHS(F)			;Any data in buffers?
	TLNN S,IOFST			;No. Was any input?
	 JRST IMPWK1↑
	MOVEI S,IOIMPM			;No. Error
	IORB S,DEVIOS(F)
	JRST IMPWK1↑

;CLSO CLSI

CLSO:	SKIPN IMPUP↑
	 POPJ P,
	PUSHACS				;Get into TOPS-10 mode
	SETT10
	PUSHJ P,TCPCLS↑			; tell TCP about the close.
					;  close does a TCP push.
	TLNN F,OUTBFB!OUTPB		;Output buffer set up?
	 JRST CLSO1			;No, forget about flushing last buffer
	LDB T1,PIOMOD			;What mode are we in?
	CAIGE T1,DR			;Dump maybe?
	 JRST [ POPACS			;No, do last output for buffered mode
		PUSHJ P,OUT
		PUSHACS]
	MOVSI S,IO			;set flag
	IORM S,IMPIOS(F)
	IORB S,DEVIOS(F)
CLSO1:	PUSHJ P,IMPWK1↑			;clear flags
	JRST POPPOJ

; CLOSE INPUT

CLSI:	POPJ P,MPUP↑

;IMPW60 IMPWAT CLRAC1 STTIO1

;ROUTINE TO WAIT FOR INTERRUPT ACTIVITY.  RETURNS WHEN WOKEN AT
;   INTERRUPT LEVEL OR WHEN WAIT TIMES OUT.
;	(SET SOME WAIT FLAG IN IMPIOS)
;	MOVE	T1,[TIMEOUT SECS]
;	PUSHJ	P,IMPWAT
;	RETURN WHEN I/O DONE OR TIMER TIMES OUT (TIMFLG SET)
;	  WITH INTERRUPTS TURNED BACK ON!

;JJW - This is an adapted version of the TOPS-10 code in IMPSER.MAC.  Timeout
;field in DDB is different and ACs have to be dealt with.  Times of more than =63
;seconds are reduced to =63.  I don't think it ever gets that high anyway.  ACs
;are in TOPS-10 mode when this code is called and when it returns.

	ENTRY	IMPW60,IMPWAT		;For calls from IMPSER.MAC

IMPW60:	MOVEI T1,=60			;60 SECOND SLEEP
IMPWAT:	CAILE T1,77			;More than maximum?
	 MOVEI T1,77			;Yes, set to max (=63 sec)
	DPB T1,PDVTIM
	ONSCN				;TURN ON INTERRUPTS
	MOVEI T3,TIMFLG			;CLEAR TIMEOUT FLAG
	ANDCAM T3,IMPIOS(F)
IFN IOS-S,<PUSH P,IOS>			;SETACT uses IOS and TAC, so save these
IFN TAC-T1,<PUSH P,TAC>			; if necessary
	MOVE IOS,DEVIOS(F)		;PICK UP I/O STATUS WORD
	PUSHJ P,SETACT			;SET IOACT
IFN TAC-T1,<POP P,TAC>			;Restore ACs
IFN IOS-S,<POP P,IOS>
	MOVSI T4,ALLWAT			;TEST ALL WAIT FLAGS
	TDNN T4,IMPIOS(F)		;WAIT FLAG(S) STILL SET?
	 JRST IMPWK1↑			;No, clear flags and return
IFN DDB-F,<SAVAC(DDB,F)>
	POPACS				;WAITS mode for WSYNC
	PUSHJ P,WSYNC			;YES, WAIT
	PUSHACS				;Back to TOPS-10 mode
	SETT10
	MOVEI T3,TIMFLG
	MOVSI T4,ALLWAT
	TDNE T4,IMPIOS(F)		;WAIT FLAG STILL SET?
	IORM T3,IMPIOS(F)		;YES, SET TIMEOUT FLAG
	JRST IMPWK1↑			;ENSURE FLAGS ARE CLEAR AND RETURN

;Here from TOPS-10 code to execute CLRACT.  S has already been set up.
;Saves IOS and TAC if necessary since these are the only ACs used by CLRACT.

CLRAC1:
IFN IOS-S,<PUSH P,IOS
	MOVE IOS,S>
IFN TAC-T1,<PUSH P,TAC>
	PUSHJ P,CLRACT
IFN TAC-T1,<POP P,TAC>
IFN IOS-S<POP P,IOS>
	POPJ P,

;Here from TOPS-10 code to execure STTIOD.

STTIO1:	PUSHACS				;J stays set up right.
	SETT10
	PUSHJ P,STIIOD
	POPACS
	POPJ P,
;DIE

;Here from TOPS-10 errors that want the system to stop.

DIE:	PUSHACS
	PUSHJ P,DISUSR
	 SIXBIT/NET/
	PUSHJ P,DISMES
	 ASCIZ/IMPBUG (/
	HRLZ TAC1,P-17(P)	;Get error mnemonic stored in code
	PUSHJ P,DISSIX
	PUSHJ P,DISMES
	 ASCIZ/) called from /
	MOVE TAC,P-17(P)
	SOS TAC			;Back up to the call to DIE
	PUSHJ P,DISLOC
	PUSHJ P,DISCRLF
	PUSHJ P,DISFLUSH
	POPACS
	PUSHJ P,DDTCALL
	JRST CPOPJ1		;Try to continue

;UUOOOK UUOOK1 ISETEB UUOIOK

;ROUTINE TO BLESS UUO LEVEL I/O BASED ON HOST STATUS.

UUOOOK:	PUSHACS			;Get into TOPS-10 mode
	SETT10
	MOVEI P1,TCPOCK↑	;Routine to call
UUOOK1:	SKIPN IMPUP↑
	 JRST ISETEB		;Host dead
	PUSHJ P,(P1)		;Is connection in legal state?
	 JRST ISETEB
	JRST POPPJ1

ISETEB:	POPACS			;Back to WAITS mode
	MOVEI IOS,IOIMPM	; SET ERROR BIT SO GET OUT OF UUOCON
	IORB IOS,DEVIOS(DDB)
	POPJ P,

UUOIOK:	PUSHACS			;Get into TOPS-10 mode
	SETT10
	MOVEI P1,TCPICK↑
	JRST UUOOK1
>;IFN IMPNUM