;<FOONEX>IMPDV.MAC;24 19-Mar-81 22:23:55, Edit by MMCM
; Separate out generic NVT support code for use by chaosnet also
;<FOONEX>IMPDV.MAC;23 18-Mar-81 19:32:01, Edit by MMCM
; SUMEX ERJMP/ERCAL changes
;<FOONEX>IMPDV.MAC;22 22-Jan-81 17:18:57, Edit by PETERS
; Make TITLE unconditional
;DSK:<134-TENEX>IMPDV.MAC;21 10-Aug-80 17:01:10, Edit by DANG
; Made <cr> handling somewhat more compatible with the rest of the world.
; <cr> in normal mode tranmits <cr><null>, but transmits only <cr> in binary.
; (change to NVTXCR - I am not sure this is right, so temporary fix only)
; Also added Tovar's checking of IMP interface losing interrupts on F2
;DSK:<134-TENEX>IMPDV.MAC;20 23-May-80 17:01:57, Edit by PETERS
; Added support for RNTBFS assembly flag
;DSK:<134-TENEX>IMPDV.MAC;19 19-May-80 21:32:34, Edit by PETERS
; Fix old bug at NETTCS and repeat-zero debugging code
;<134-TENEX>IMPDV.MAC;408     12-Feb-79 15:00:00    EDIT BY GENE
;2 Clear IMPOB pointer at IMODN2, as per Plummer's fix.
;  Unconditionally assemble HOLD code; was keyed off LHOSTN.
;<134-TENEX>IMPDV.MAC;407     22-Jan-79 20:25:06    EDIT BY PLUMMER
;<134-TENEX>IMPDV.MAC;405     22-Jan-79 11:00:00    EDIT BY GENE
;1 Install SRI mods into BBN's 96-bit leader IMP driver:
;  SIQMAX set to 40; SIQTMO set to 120000.; HOLD key code;
;  RFNTMO set to 60000.; proceed on CR right away, and then gobble down
;  NULL or LF if it comes along later.
;  Remove BBN Telenet code.
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.10010, 21-Nov-78 12:10:24, Ed: PLUMMER
; Flush LDR96B flag for TCP
; Remove BBN-specific code
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.10008, 17-Nov-78 15:00:51, Ed: PLUMMER
; Search MACSYM rather than STENEX
;[BBN-TENEXD]<135-PLUMMER>IMPDV.MAC.10007, 15-Nov-78 11:20:37, Ed: PLUMMER
; Merge in Borchek's changes for long leader NCP from IMPDV.MAC.10006
;[BBN-TENEXD]<135-PLUMMER>IMPDV.MAC.402, 13-Nov-78 11:18:36, Ed: PLUMMER
; Convert IMP queue format to match TCPs, which is T20 style
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.396, 15-Sep-78 12:31:13, Ed: OPERATOR
;CORRECTED INCORRECT OVERHEAD WORD CALC NEAR PKBY4   /PEF
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.395, 28-Jul-78 16:04:00, Ed: FRENCH
;FIXED MESSAGE SIZE MAXIMUM CALCULATION IN UPBGNB & PKBY1
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.394, 23-Jun-78 16:28:46, Ed: PLUMMER
; Add high priority output capability for Internet traffic
;<135-TENEX>IMPDV.MAC.393,  7-Jun-78 14:26:28, EDIT BY CLEMENTS
; Correction for previous two edits
;<135-TENEX>IMPDV.MAC.392,  6-Jun-78 16:02:50, EDIT BY CLEMENTS
; Withdraw part of previous edit
;<135-TENEX>IMPDV.MAC.391,  5-Jun-78 15:34:24, EDIT BY CLEMENTS
; Fixes to sp q stuff so pad bits are zeros, not random.
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.390, 26-May-78 12:12:02, Ed: PLUMMER
;[BBN-TENEXD]<XTCP>IMPDV.MAC.390, 25-May-78 21:22:34, Ed: PLUMMER
; repair the TNBFFL bug
;[BBN-TENEXD]<XTCP>IMPDV.MAC.389, 24-May-78 13:36:06, Ed: PLUMMER
; REMOVE CALL TO HSTINI (AND EXTERN) SINCE IT REALLY IS DONE BY EXECSI
;[BBN-TENEXD]<XTCP>IMPDV.MAC.387, 24-May-78 10:36:20, Ed: PLUMMER
; Make IMODN1 know about TCP-owned buffers
;[BBN-TENEXD]<135-TENEX>IMPDV.MAC.386,  7-May-78 22:52:11, EDIT BY PLUMMER
; Merge
;[BBN-TENEXD]<135-DEBUG>IMPDV.MAC.51,  3-May-78 03:27:55, EDIT BY PLUMMER
; Take account of fake hosts when converting 32 bit leaders in ASNS32
;[BBN-TENEXD]<135-DEBUG>IMPDV.MAC.50, 27-Apr-78 11:25:35, EDIT BY PLUMMER
; Get standard AC defs from PROLOG
;<XTCP>IMPDV.MAC.49    26-Apr-78 13:32:07    EDIT BY PLUMMER
;<XTCP>IMPDV.MAC.48    26-Apr-78 11:53:00    EDIT BY PLUMMER
; define tag IMO32X
;<XTCP>IMPDV.MAC.47    26-Apr-78 11:32:10    EDIT BY PLUMMER
; More SNDIM trouble due to bad def of Q3 relative to Q2
;<XTCP>IMPDV.MAC.46    25-Apr-78 22:29:30    EDIT BY PLUMMER
; Take host # given by IMP.  Probably debugging a system on differnt machine
; Repair bug in IMOLDX
;<XTCP>IMPDV.MAC.45    24-Apr-78 11:27:50    EDIT BY PLUMMER
; DBGIM not accessible to OPRs.  OK for NETWIZs
; use "STY%UC" rather than "3" in SNDIM1+
;<XTCP>IMPDV.MAC.44    21-Apr-78 12:09:22    EDIT BY PLUMMER
; Fix THE bug.  IMO362 clobbering T3
;<XTCP>IMPDV.MAC.43    20-Apr-78 22:46:54    EDIT BY PLUMMER
; set input side on tnbffl in imisrt
;<XTCP>IMPDV.MAC.42    20-Apr-78 12:19:23    EDIT BY PLUMMER
; .NBPTR(2) rather than 1(2) in UPBYT1
;<XTCP>IMPDV.MAC.41    18-Apr-78 15:43:10    EDIT BY PLUMMER
; BUGNTE, not INF for failing HSTINI
;<XTCP>IMPDV.MAC.40    18-Apr-78 15:32:45    EDIT BY PLUMMER
; Externs for HSTINI, TCPBEG
;<XTCP>IMPDV.MAC.39    18-Apr-78 15:17:52    EDIT BY PLUMMER
; Fix IDIVI Q2,...  SKIPE Q3 in SNDIXR since somebody made Q3 .ne. Q2+1
;<XTCP>IMPDV.MAC.38    18-Apr-78 15:06:10    EDIT BY PLUMMER
; Init TCPNCP in IMPINI
;<XTCP>IMPDV.MAC.37    18-Apr-78 14:12:28    EDIT BY PLUMMER
; Convert lower case symbol in IM8RA2 to upper
; Merge new code into IMPOSY+
;<XTCP>IMPDV.MAC.36    18-Apr-78 13:57:45    EDIT BY PLUMMER
; Restore host number in T1 in IMPRC1+
; Switch to IMCNVI while unpacking NVT input
; Insert NOINT and OKINT in IMP Lock routines
; Add call to startup TCP in IMPBEG
; Add call to HSTINI in IMPBP0
;<XTCP>IMPDV.MAC.35    18-Apr-78 13:13:33    EDIT BY PLUMMER
; Change SIQTM0 to 30 seconds and SIQMAX to 10
;<XTCP>IMPDV.MAC.34    17-Apr-78 10:37:50    EDIT BY PLUMMER
; Bad instruction in PKBY4+.  AC bad in a LOAD.
; Correct explanation of TNBFFL
; Make TCPNCP an LS like other local storage
; Add warning about changing INETLK.
;<XTCP>IMPDV.MAC.33    12-Apr-78 14:43:39    EDIT BY PLUMMER
;<XTCP>IMPDV.MAC.32    12-Apr-78 13:45:40    EDIT BY PLUMMER
; Correct fake host check in IMIN1 (wrong AC)
;<XTCP>IMPDV.MAC.31    11-Apr-78 22:09:48    EDIT BY PLUMMER
; Revise AC saving on output side to be faster and correct(!)
; Add tag IMOLDX where a BLKO is done with ACs saved
;<XTCP>IMPDV.MAC.30    11-Apr-78 21:21:58    EDIT BY PLUMMER
; Correct exit from IMIN00
;<XTCP>IMPDV.MAC.29    10-Apr-78 12:12:03    EDIT BY PLUMMER
; Add LS's for DBGNCP etc
;<XTCP>IMPDV.MAC.28     7-Apr-78 16:44:08    EDIT BY PLUMMER
; Replace .DBGIM with TCP version
;<XTCP>IMPDV.MAC.27     7-Apr-78 16:39:32    EDIT BY PLUMMER
; Include TCPQOB routine
;<XTCP>IMPDV.MAC.26     7-Apr-78 16:37:42    EDIT BY PLUMMER
; References to MLCHLF under MLCN conditional
;<RCC5>IMPDV.MAC.25     7-Apr-78 15:46:18    EDIT BY PLUMMER
; Include MLC message dispatch in IMPEIN under MLCN coditional
;<RCC5>IMPDV.MAC.24     7-Apr-78 14:35:05    EDIT BY PLUMMER
;<RCC5>IMPDV.MAC.23     7-Apr-78 13:45:27    EDIT BY PLUMMER
; Save ACs at IMOLD1, IMOLD3, IMOBDY, and IMODN2
;<RCC5>IMPDV.MAC.22     7-Apr-78 13:20:05    EDIT BY PLUMMER
; Save ACs at IMIN2, IMIN32, at IMINOF on the way to IMINTL, and IMPEIN
; Expand DMOVEM in IOUHGD
;<RCC5>IMPDV.MAC.21,  3-Apr-78 15:27:59, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.20,  3-Apr-78 15:17:20, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.19,  3-Apr-78 14:01:18, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.18,  3-Apr-78 13:54:38, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.17,  3-Apr-78 13:51:50, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.16,  3-Apr-78 13:44:29, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.15,  3-Apr-78 13:29:13, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.14,  3-Apr-78 13:20:28, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.13,  3-Apr-78 13:13:37, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.12,  3-Apr-78 13:08:14, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.11, 29-Mar-78 16:10:23, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.10, 29-Mar-78 15:53:24, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.9, 27-Mar-78 16:08:21, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.8, 27-Mar-78 15:48:16, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.7, 27-Mar-78 14:55:20, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.6, 27-Mar-78 14:47:25, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.5, 27-Mar-78 14:23:59, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.4, 27-Mar-78 13:58:22, EDIT BY CLEMENTS
;<RCC5>IMPDV.MAC.3, 24-Mar-78 15:57:57, EDIT BY CLEMENTS
; Merge in TOPS20 code for 96-bit leaders at PI and SNDIM levels
;<135-TENEX>IMPDV.MAC.385    22-Nov-77 13:46:20    EDIT BY ALLEN
; FIX ERROR IN NVTRSV CAUSING LOOP TO INCREASE SPACE REQUEST
;<135-TENEX>IMPDV.MAC.384     7-Nov-77 12:07:44    EDIT BY CALVIN
; Patchs for new telnet stuff (per Tomlinson)
;<135-TENEX>IMPDV.MAC.383, 25-Oct-77 16:34:16, EDIT BY CLEMENTS
; Prevent IMPBUG on long-leader NOP's
;<135-TENEX>IMPDV.MAC.382, 12-Oct-77 17:03:15, EDIT BY CLEMENTS
; Impchk calls Im2chk when done
;<135-TENEX>IMPDV.MAC;381    20-Jul-77 17:12:35    EDIT BY CLEMENTS
; DeQueue buffer going into IMIB at IMISRT time
;<135-TENEX>IMPDV.MAC;380     4-Jul-77 23:43:17    EDIT BY CLEMENTS
; Fix typo in previous edit by "operator"
;<135-TENEX>IMPDV.MAC;379    30-Jun-77 11:26:49    EDIT BY OPERATOR
; IMPEIN INSURES THAT NCP FRK KNOWS THAT WE ARE IN DANGER OF RUNNING
; OUT OF INPUT BUFFERS
;<135-TENEX>IMPDV.MAC;378    18-Apr-77 12:23:19    EDIT BY PLUMMER
; SWITCH TO NEW INTERNET HEADER FORMAT
;<135-TENEX>IMPDV.MAC;377    13-Feb-77 18:12:10    EDIT BY CLEMENTS
; Adjust for smaller width MLCHLF for multi-PTIP code
;<135-TENEX>IMPDV.MAC;376    29-Sep-76 19:29:16    EDIT BY ROSENBERG
; Add an EXTERN for NETFRE
;<135-TENEX>IMPDV.MAC;375    29-Sep-76 17:18:12    EDIT BY ROSENBERG
; Put code for the new "Network Queue" Jsyses in a "REPEAT 0" block
;<135-TENEX>IMPDV.MAC;374    30-Aug-76 10:58:19    EDIT BY ALLEN
; Don't do nvt output if buffer space low -- helps avoid lockup.
;<135-TENEX>IMPDV.MAC;373    10-Aug-76 19:55:09    EDIT BY TOMLINSON
;<135-TENEX>IMPDV.MAC;372    10-Aug-76 19:49:59    EDIT BY TOMLINSON
; MODIFY ASNSQ AND FRIENDS TO PERMIT MULTIPLE INTERNET QUEUES
;<135-TENEX>IMPDV.MAC;371    17-Jun-76 13:00:00    EDIT BY TOMLINSON
; FIX NVTMOD STACK REFERENCES (3 PLACES) TO ACCOUNT FOR EXTRA ITEM
;<135-TENEX>IMPDV.MAC;370    27-Apr-76 09:58:36    EDIT BY PLUMMER
; INCREASE NSQ TO 16
;<135-TENEX>IMPDV.MAC;369    30-Mar-76 10:38:58    EDIT BY ALLEN
; FIX TO NEW SPECIAL INPUT QUEUE WAKEUP LOGIC
;<135-TENEX>IMPDV.MAC;368    26-Mar-76 15:58:36    EDIT BY ALLEN
;<135-TENEX>IMPDV.MAC;367    26-Mar-76 14:25:07    EDIT BY ALLEN
; ADD LOGIC TO POKE FORK WAITING IN RCVIM ON ARRIVAL OF A MESSAGE
;<135-TENEX>IMPDV.MAC;366    24-Mar-76 14:14:44    EDIT BY PLUMMER
; IMIPS1+: INSERT RESKED (NOT RESKD1)
; SIQGET+1: ALLOW SIQTM0 TO BE MORE THAN HALFWORD OF MILLISECONDS
; SIQTM0: CHANGE FROM 30 SECONDS TO 120 SECONDS
; SIQMAX: CHANGE FROM 6 TO 40
;<135-TENEX>IMPDV.MAC;365    23-Mar-76 17:34:37    EDIT BY ALLEN
; NTTCSO TESTS FOR DEFUNCT NVT AND FLUSHES BUFFERS ACCORDINGLY
;<135-TENEX>IMPDV.MAC;364    23-FEB-76 23:51:10    EDIT BY CLEMENTS
; Fix for losing buffers at IMPEIN+, bad host number at IMPRC2.
; Make MLC input stuff only take msgs with right links so can
; use own host number in future.
;<135-TENEX>IMPDV.MAC;363     2-FEB-76 17:04:09    EDIT BY CALVIN
; Patch at NVTRSV for nulls after CR's? (i just edited it)
;<135-TENEX>IMPDV.MAC;362    22-JAN-76 22:00:59    EDIT BY CLEMENTS
; ADDED CODE FOR MLC TRAFFIC
;<134-TENEX>IMPDV.MAC;361     2-DEC-75 10:31:23    EDIT BY TOMLINSON
;<134-TENEX>IMPDV.MAC;360     2-DEC-75 10:22:37    EDIT BY TOMLINSON
;<134-TENEX>IMPDV.MAC;359    10-NOV-75 13:44:21    EDIT BY ALLEN
; INCREASE IMPNLK TO ^D200
;<134-TENEX>IMPDV.MAC;358    26-OCT-75 11:48:06    EDIT BY TOMLINSON
;<134-TENEX>IMPDV.MAC;357    21-OCT-75 12:38:48    EDIT BY TOMLINSON
; MORE RCTE FIXUPS
;<134-TENEX>IMPDV.MAC;355     9-OCT-75 13:15:48    EDIT BY ALLEN
; MAKE SURE IMIB NOT ON FREELIST IN IMPEIN
;<134-TENEX>IMPDV.MAC;353    24-SEP-75 09:46:23    EDIT BY TOMLINSON
; DEFER OKINT IN NVTCOB 'TIL AFTER SENDING DATA MARK
;<134-TENEX>IMPDV.MAC;352    22-SEP-75 11:46:31    EDIT BY CLEMENTS
; On startup, (IMPRC1), only send RST's to hosts in name table.
;<134-TENEX>IMPDV.MAC;351    19-SEP-75 12:28:44    EDIT BY TOMLINSON
; MORE RCTE BUG FIXES
;<134-TENEX>IMPDV.MAC;350    17-SEP-75 14:55:18    EDIT BY TOMLINSON
;<134-TENEX>IMPDV.MAC;348    17-SEP-75 14:41:56    EDIT BY TOMLINSON
; RCTE BUG FIXES
;<134-TENEX>IMPDV.MAC;344    15-SEP-75 17:12:18    EDIT BY ALLEN
;<134-TENEX>IMPDV.MAC;343    15-SEP-75 16:39:45    EDIT BY ALLEN
; TEMPORARILY NOP'ED NVTCIB
;<134-TENEX>IMPDV.MAC;342    12-SEP-75 15:31:45    EDIT BY ALLEN
; ADD CHECKS TO BE SURE THAT WE NEVER LOCK OR UNLOCK A BUFFER ON THE
; FREELIST
;<TOMLINSON>IMPDV.MAC;1    10-SEP-75 08:34:36    EDIT BY TOMLINSON
; RCTE FIXES
;<134-TENEX>IMPDV.MAC;336     5-SEP-75 15:48:23    EDIT BY ALLEN
; RESTORE ORIGINAL ACTIVATION CRITERIA
;<134-TENEX>IMPDV.MAC;335     5-SEP-75 15:38:54    EDIT BY ALLEN
;<134-TENEX>IMPDV.MAC;334     3-SEP-75 22:01:33    EDIT BY ALLEN
; NEW ACTIVATION LOGIC AND FIX INPUT BUFFER FETCH LOGIC
;<134-TENEX>IMPDV.MAC;333    28-AUG-75 16:32:26    EDIT BY ALLEN
; SLIGHT MOD DUE TO CHANGE IN LOCK-UNLOCK MACROS
;<134-TENEX>IMPDV.MAC;332    19-AUG-75 15:40:48    EDIT BY ALLEN
; REPAIR TO PKQOB TO STORE ACTUAL WORDS IN USE IN HEADER SO
; OUTPUT ROUTINES DON'T TRY TO SEND THE WHOLE BUFFER
;<134-TENEX>IMPDV.MAC;331    14-AUG-75 15:18:49    EDIT BY ALLEN
; ELIMINATE LOCKUP DUE TO RUNNING OUT OF BUFFERS
;<134-TENEX>IMPDV.MAC;330    12-AUG-75 17:07:12    EDIT BY ALLEN
; FIX AT PKMS5 TO KEEP PKMSG FROM GOING NUTS WHEN ASNTBF FAILS
;<134-TENEX>DCAIMP.MAC;9     6-AUG-75 11:19:35    EDIT BY ALLEN
; END INPUT ROUTINE RECORDS ACTUAL COUNT IN BUFFER HEADER
;<134-TENEX>DCAIMP.MAC;8     5-AUG-75 13:57:29    EDIT BY ALLEN
; Various bug fixes to new buffer management
;<134-TENEX>DCAIMP.MAC;7     4-AUG-75 10:46:05    EDIT BY ALLEN
; VARIOUS CHANGES FOR NEW BUFFER MANAGEMENT
;<134-TENEX>IMPDV.MAC;328    11-JUL-75 17:17:33    EDIT BY ALLEN
; MINOR FIX
;<134-TENEX>IMPDV.MAC;327    11-JUL-75 16:12:43    EDIT BY ALLEN
; DELETE CALL IMPKO1 AT PKMSD 4
;<134-TENEX>DCAIMP.MAC;3    11-JUL-75 09:59:54    EDIT BY ALLEN
; PKMSG USES REMAINING SPACE IN CURRENT OUTPUT BUFFER UNLESS
; THIS WOULD CAUSE A CONTROL MESSAGE TO CROSS A NET MESSAGE BOUNDARY.
; PKMSG1 ADDED -- SAME AS PKMSG BUT DOESN'T ATTEMPT TO SEND THE
; CURRENT MESSAGE. CALLED BY NETTCS SO THAT SIZE OF NET MESSAGE
; IS NOW LIMITED ONLY BY AVAILABLE CHARACTERS IN TTY BUFFERS, 
; BY ALLOCATION, OR BY SIZE OF OUTPUT BUFFER, NOT BY SIZE
; OF NETTCS' STACK BUFFER.
;<134-TENEX>IMPDV.MAC;326    15-MAY-75 07:51:23    EDIT BY TOMLINSON
; CHANGE REFERENCES TO NLINES TO NVTHI
;<134-TENEX>IMPDV.MAC;325    21-APR-75 11:34:59    EDIT BY TOMLINSON
; Limit special queues on message basis rather than buffer space
;<134-TENEX>IMPDV.MAC;324    14-APR-75 17:08:59    EDIT BY OPERATOR
; CORRECT INITIALIZATION OF IDVLCK
;<134-TENEX>IMPDV.MAC;323    14-APR-75 15:37:09    EDIT BY ALLEN
; AVOID SMASHING AC1 IN PIE-SLICE VERSION OF LCKID1
;<134-TENEX>IMPDV.MAC;322    11-APR-75 17:08:19    EDIT BY ALLEN
; REPAIRS TO NEW LOCKING STUFF
;<134-TENEX>IMPDV.MAC;319    10-APR-75 22:18:40    EDIT BY ALLEN
; MAKE USE OF NEW SCHEDULING FOR LCKERS
;<134-TENEX>IMPDV.MAC;318     4-APR-75 18:00:19    EDIT BY CLEMENTS
; FIX TO PREVENT UNKNOWN LINK IMPBUGS IF REMOTE CLOSES A
;  SEND SOCKET WHICH HAS AN OUTSTANDING RFNM
;<134-TENEX>IMPDV.MAC;317    12-MAR-75 14:08:45    EDIT BY PLUMMER
; CHANGE SIQCHK TO FLUSH ENTIRE Q IF NOT ACTIVE
;<134-TENEX>IMPDV.MAC;316    27-FEB-75 15:50:47    EDIT BY CLEMENTS
; INCREASE NUMBER OF CHARACTERS PROCESSED IN NETTCS FROM 32 TO 64
; INCREASE SIZE OF PI-LEVEL STACK, DUE TO DEBUG ROUTINES
;<134-TENEX>IMPDV.MAC;315    10-JAN-75 10:32:56    EDIT BY ALLEN
; REPLENISH INPUT BUFFERS IF IMPNFI .LT. 8
;<133-TENEX>IMPDV.MAC;314    24-DEC-74 08:32:56    EDIT BY TOMLINSON
; DISABLE RCTE UNTIL DEBUGGED THOROUGHLY
;<133-TENEX>IMPDV.MAC;313    18-DEC-74 15:40:48    EDIT BY TOMLINSON
;<133-TENEX>IMPDV.MAC;312    17-DEC-74 16:17:00    EDIT BY TOMLINSON
; CAUSE INITIAL SB STRING FOR RCTE
;MISC BUG FIXES TO RCTE
;<133-TENEX>IMPDV.MAC;311    16-DEC-74 15:50:14    EDIT BY TOMLINSON
; TAKE OUT CODE TO TURN ON RCTE IN ASNNVT. CAN'T DO IT BECAUSE NCPLCK IS SET.
;<133-TENEX>IMPDV.MAC;309    13-DEC-74 12:41:16    EDIT BY TOMLINSON
; INITITATE TURN ON OF RCTE AND SUPPRESS GA
;<133-TENEX>IMPDV.MAC;308    13-DEC-74 12:32:18    EDIT BY TOMLINSON
; BUG FIXES TO RCTE
; PKBY1: MOVE SOS IMPLT4 TO AFTER ASNTBF CALL
; UPBRB: CHANGE BUG MSG
; IM8RAS:  ACCOUNT FOR BUFFERS IN CONNECTION QUEUE WHEN RESETTING ALLOC
;<133-TENEX>IMPDV.MAC;306     8-DEC-74 18:28:13    EDIT BY CLEMENTS
; FIX MISSING EXTERN ON SKPRET
;<133-TENEX>IMPDV.MAC;303     3-DEC-74 10:25:14    EDIT BY TOMLINSON
; Added RCTE code
;<133-TENEX>IMPDV.MAC;300    29-OCT-74 08:22:03    EDIT BY TOMLINSON
; SET UP STACK FOR BUG(IMP) AT IMIMTL
;<133-TENEX>IMPDV.MAC;299     1-OCT-74 13:16:36    EDIT BY TOMLINSON
; REMOVE SUPERFLUOUS INSTRINCTION AT IMPRAP+2
;<133-TENEX>IMPDV.MAC;298    25-SEP-74 12:47:56    EDIT BY TOMLINSON
; (1) MARK HOST USING NEW PROTOCOL AS UNDERSTANDING SAME.
; (2) RELEASE BOTH HALVES OF AN NVT WHEN RECEIVING NXS/R
; (3) FIX BUGIMH ARG IN BADLKS/R
; (4) BUGCHK IF IMPLT4 IS OVERDECREMENTED IN UPBRB
;<133-TENEX>IMPDV.MAC;297    22-AUG-74 16:28:54    EDIT BY CLEMENTS
;<TENEX-132>IMPDV.MAC;296    22-JUN-74 13:07:40    EDIT BY TOMLINSON
; NOP IMPCHK IF IMPRDY = 0

	SEARCH	STENEX,PROLOG,IMPPAR,MACSYM
	TITLE	IMPDV
IFDEF IMPCHN,<	; This whole file is included only if imp exists

; Accumulators

IMPUN==5		; Ac for 'unit'

; Parameters

IMPNLK==^D199		; Size of link table
IMP8XS==40		; Size of irreg mes buffer
NSQ==20			; Size of special q tables
SIQMAX==40		;1 Maximum messages allowed on siq (was 10)
NIMSTK==20		; Pi level stack
RFNTMO==^D60000		;1 Rfnm time-out interval (three of these) (was 20000)
UPROBI==^D300000	; Interval at which to probe every up host
UPROBT==^D60000		; Time to spend probing every down host
SIQTM0==^D120000	;1 Special queue time-out interval (was 30000)


; Bits in IMPLT1

LT1FRE==1B19		; Bit on if LT entry is free
LT1SND==1B18		; Bit on if this is a send link,
			; except if FRE is on, this tells free from deleted

; Bits in implt2

RFNMC=3B1		; Rfnm outstanding (2 bit count)
LTDF=1B2		; 'done' flag
HIPFLG=1B3		; High priority connection
ILCKB==1B4		; Connection locked (no transmissions)
RXMTF==1B5		; Retransmission after time-out
RARF==1B6		; Rar expected
RARRF==1B7		; Send ras whe no rfnm's out


; DEVICE DEFINITION FOR BBN-STANDARD IMP10 INTERFACE

; Cono-coni bits

IMP==550			; I/O BUS DEVICE ADDRESS

I.IRQ==1B32		; Input word ready, CONI
I.ORQ==1B28		; Ready for next output word, CONI
I.ERQ==1B24		; End of input, CONI
I.ERR==1B21		; The error flop, Imp has been down. CONI
I.DWN==1B20		; Imp is now down. CONI
I.PWR==1B19		; The interface is powered up. CONI

I.GEB==1B23		; Clear eib, CONO
I.EOM==1B22		; End of output message, CONO
I.STO==1B21		; Stop output, CONO
I.NRL==1B20		; Not Ready-line to IMP, CONO
I.CLR==1B19		; Clear error flop, CONO

I.IOF==10B27+10		; E of cono to clear input pi asmt
I.ION==<10+IMPCHN>B27+<10+IMPCHN> ; E of cono to set input pi asmt
I.OOF==10B31			; E of cono to clear output assmnt
I.OON==<10+IMPCHN>B31		; E of cono to set output pi asmt

;1 Begin deletion
REPEAT 0,<
TNETLK:: EXP TNTLNK		; Link for TELENET messages
>
;1 End of deletion

INETLK:: EXP INTLNK		; Link for Internet handling
; WARNING: Changing the contentents of INETLK can have extremely undesireable
; effects if the TCP is running.  Tables in the gateway must be changed, too.
; Clear TCPON to shut off the TCP.


; Pointers to various fields

PTNETI:	POINT 9,TTNETW(2),35	; Input unit
PTNETO:	POINT 9,TTNETW(2),26	; Output unit
IMPLBS:	POINT 8,IMPLT2(1),17	; Connection byte size
LTLINK:	POINT 8,IMPLT1(1),35	; Link
DEFSTR LTHOST,IMPLT5,35,36	; HOST

L1%SND==LT1SND
L1%FRE==LT1FRE

MAXWPM:	Z 400	; Max wds/input msg = (8064/32) + leader + link =
		; 252 + 3 + 1 = 256 = 400(8)

; Following two are a getab table - don't separate

NOHOST::-1	; Old format host number
NVTPTR::XWD -NNVTLN,NVTLO ; -number of nvt's,,first nvt
NLHOST::LHOSTN	; All references to lhostn should be to this cell,
		; So it can be patched if needed.
NETFLD::12B11	; Network number for ARPA (shifted)

; End of getab group

; Linkage into impdv

INTERN	IMPBEG,IMPNLK,CHKNET
INTERN	IMPHLT,IMPOPS
INTERN IMPSV,IMPCHK,IMPOPL,IMPCLL,IMPABL,IMPSYN,IMPRTS,IMPSTR,IMPCLS,IMPALL
INTERN IMPRST,IMPRRP,IMSRST,IMPERR,IMPINR,IMPINS
INTERN HSTDED,IMPBG0,NTTRC3,AVTCAP,AVTCOB,PTNETI,PTNETO,AVTRSV
INTERN IMPSDB,PKBYT,PKCHK,PKULCK,PKMSG,UPBYT,UPMSG,MAXWPM,NLHOST

; Linkage to nvt
EXTERN NEGCHK,CKNNVT,NVTSTD,NETTEO,NETTOO,NETTCF,NVTCHS

; Linkage to swpmon

EXTERN	CHKBG1,CHKH1

; Linkage to forks

EXTERN	CAPENB,LSTERR
; Linkage to pisrv

EXTERN	MENTR,CHNSON,BUGCHK,BUGNTE,BUGHLT,MRETN,SKMRTN,MRETNE,MRTNE1

; Linkage to scheduler

EXTERN	EDISMS,FORKX,JB0FLG,DISNT,ITRAP,IMPTM2

; TCP related, in STORAG

EXTERN	TCPFLG,TCPFRI,TCPIBI,TCPIBO,TCPNFI,TCPON,TCPOBI,TCPOBO,TCPNFB

; Second interface

;EXTERN	IM2CHK			;1 (SRI-KA has no second IMP)

; Miscellaneous

EXTERN	BHC,BITS,R,RSKP
EXTERN	BYTBLT

EXTERN	NETBUF,NETFRE
EXTERN	MAXBPM,HSTHSH,NEWNCP,HOSTNN,HSTSTS
EXTERN RECRTS,RECSTR,RECCLS,DISG,PFHST,PLINK,EOTF,DEDF
EXTERN NETSTS,RLNTBF,ASNTBF,RCFRFN
EXTERN	SK2DWN
EXTERN ERRB,NETDWN,NETHDN,NETCHK,HOSTN,NHOSTS,DISGT
EXTERN RECRST,NETBAL,NETRAL,RECINR,RECINS,PLIDX,DISL,SVCINT,SVCRST
EXTERN	LCKNCP,ULKNCP
EXTERN	JOBRTT,TODCLK

IFNDEF RNTBFS,<
EXTERN MLKMA,MULKMP
>

; Macros

; Lock imp device lock

DEFINE ILOCK (A)
<	CALL LCKIDV
IFB <A>,<0>
IFNB<A>,<A>
>

; Unlock imp device lock

DEFINE IUNLK
<	CALL ULKIDV>

; Call clock switch code

DEFINE	IMSCLK(CLOCK)<
	MOVEI 1,CLOCK
	CALL IMUCLK>

; Storage

; First impgtn are a getab table - don't separate

LS IMPRDY,1		; 0=down, .gtr. 0 =going down, -1=up
LS NETON,1		; 0=network off
LS NETENT,1		; Flags to drive netser. e.g., don't allow login
LS NCPUPT,1		; Gtad of last time ncp cycled up.
LS IGDMSG,1		; Most recent imp-going-down msg
LS IMPDNT,1		; Time of last imp ready line drop
LS IMPUPT,1		; Time of last imp ready line up
LS IGDTIM,1		; Time of above imp-going-down msg
IMPGTN==:8		;LENGTH OF THIS GETAB TABLE
; End of getab group

LS IMPORD,1		; Output ready. non-zero permits outgoing msgs
LS IMPRDL,1		; Ready line noticed off
LS IMPRDT,1		; Todclk when ready line first went off
LS IMPFLG,1		; Service needed by async process
LS NCPFRK,1		; Forkx of ncp fork
LS TTNOF,1		; Scan of net tty lines requested if non-0
LS IMPNOS,1		; Output scan request flag
LS IDVLCK,1		; Local lock
LS IDVLLK,1		; Last idvlck locker
LS IMPDRQ,1		; Reset cycle requested in non-0
LS NETTCH,1		; State of net has changed if non-0
LS IMPFRI,1		; List of free input buffers
LS IMPNFI,1		; Count of free input buffers
LS IMPNIB,1		; NUMBER OF INPUT BUFFERS TO KEEP ON TAP
LS SIQIBI,NSQ		; Special queue
LS SIQIBO,NSQ
LS SIQTIM,NSQ		; Time of first message on special queue
LS SIQSPC,NSQ		; Space occupied by special input q
LS SIQFKX,NSQ		; Forkx of process waiting in RCVIM
LS SQJOB,NSQ		; Job to which special q is assigned
LS SQVAL1,NSQ		; Value to compare against for mux special q
LS SQVAL2,NSQ
LS SQVAL3,NSQ
LS SQVAL4,NSQ
LS SQVAL5,NSQ
LS SQMSK1,NSQ		; Mask to use in compare
LS SQMSK2,NSQ
LS SQMSK3,NSQ
LS SQMSK4,NSQ
LS SQMSK5,NSQ
LS SQLCK,1		; Interlock for assigning special q
LS IMPIBI,1		; In buffers in ptr
LS IMPIBO,1		; In buffers out ptr
LS IMPOBI,1		; Output buffers in pointer
LS IMPOBO,1		; Output buffers out pointer
LS IMPHBI,1		; Hi priority output buffers in pointer
LS IMPHBO,1		; Hi priority output buffers out pointer
LS IIMBUF,3		; Irreg message to send, 3 wds for 96 bits

LS IMIB,1		; Current in bfr, pi level
LS IMPOB,1		; Buffer now being emptied by pi routine
LS IMPINP,1		; Blki pointer on input
LS IMPOUP,1		; Blko pointer
LS IMIDSP,1		; Input pi dispatch
LS IMODSP,1		; Output pi dispatch
LS IMINFB,1		; Buffers made free by pi routines
LS TNBFFL,1		; IMIB,,IMPOB owned by TCP flags
LS TCPNCP,1		; Priority for TCP/NCP output

IFN F3FLG,<
LS IMPCNI,1		; Temporary to hold IMP CONI word
LS IMPLIC,1		; Count of lost interrupts
>


; Storage continued

LS IMPNCL,1		; Number of control input conns
LS IMPNOL,1		; Number of control output conns
LS LNKNDL,1		; Number of deletes in link table
LS IMIS32,1		; Input repacking state word
LS IMOS32,1		; Output repacking state word
LS IMOBDF,1		; Flag needed at IMOBDY due to no AC's available
LS IMPSVX,1		; Pi service return
LS IMPTIM,1		; Time of next clock run down
LS IBPTIM,1		; Time of next impibp run
LS NETTIM,1		; Time of next check of fsm for hangs
LS RFNTIM,1		; Time of next check for lost rfnm's
LS NEGTIM,1		; Negotiation time-out clock
LS IMPCHU,1		; 0 if current control mess host not up
LS IMPCHO,1		; Host number of control msg, must precede i8cal
LS I8CAL,5		; Args of control operation, must follow impcho
LS IMPFLS,1		; Count (neg) of messages to flush
LS NOPCNT,1		; Count of nops left to send
LS IMPGDM,1		; Last imp going down msg
LS HSTGDM,1		; Current host going down message
LS IMPCCH,1		; Index to host number for periodic check

LS IMP8XI,1		; Irreg mes buffer in ptr
LS IMP8XO,1		; .. .. out
LS IMP8XC,1		; .. .. count
LS IMP8XB,IMP8XS*.NBLD2	; Irreg mes buffer

LS IMPBGC,1		; Impbug count
LS IMPBGH,1		; Host involved in last impbug
LS BADHMS,1		; Message associated with header below
LS BADHDR,2		; Header of last funny message received
LS BUGIMP,1		; Impbug w/o host

LS IMPIAC,5		; Pi level ac storage
LS IMSTK,NIMSTK		; Pi level stack
LS IMPIAP,1		; AC P at interrupt level
LS IMPICX,1		; AC CX at interrupt level

; Time accumulators

LS IMCCLK,1		; Run time of last check
LS IMCLST,1		; Pointer to current clock
LS IMCIDL,1		; Time spent idling
LS IMCNRB,1		; Time spent releasing spent buffers
LS IMCGC,1		; Time spent garbage collecting link tables
LS IMCGIB,1		; Time spent assigning input buffers
LS IMCCNP,1		; Time spent processing control messages
LS IMCP1,1		; Time spent dispatching input messages
LS IMC8XM,1		; Time spent processing irregular messages
LS IMCTS,1		; Time spent scanning for nvt output
LS IMCNVI,1		; Time spent unpacking nvt input
LS IMCOS,1		; Time spent scanning for output to do
LS IMCNCK,1		; Time spent probing network
LS IMCRFN,1		; Time spent checking overdue rfnm's
LS IMCNCC,1		; Time spent in ncp checks
LS IMNIDL,1		; Count of idling
LS IMNNRB,1		; Count of releasing spent buffers
LS IMNGC,1		; Count of garbage collecting link tables
LS IMNGIB,1		; Count of assigning input buffers
LS IMNCNP,1		; Count of processing control messages
LS IMNP1,1		; Count of dispatching input messages
LS IMN8XM,1		; Count of processing irregular messages
LS IMNTS,1		; Count of scanning for nvt output
LS IMNNVI,1		; Count of unpacking nvt input
LS IMNOS,1		; Count of scanning for output to do
LS IMNNCK,1		; Count of probing network
LS IMNRFN,1		; Count of checking overdue rfnm's
LS IMNNCC,1		; Count of ncp checks

; Link tables

LS IMPLT1,IMPNLK	; Lh -- UNIT (INDEX TO NCP TABLES)
			;  OR -1 IF CONTROL LINK
			; B18-19/00 -- receive
			;        10 -- SEND
			;        11 -- FREE
			;        01 -- DELETED
			; B28-35 -- link
LS IMPLT2,IMPNLK	; B0-b5 -- flags
			; B5-9 -- unused
			; B10-17 -- byte size
			; Rh -- in bfr ptr
LS IMPLT3,IMPNLK	; Lh -- out bfr ptr
			; Rh -- save message for retransmission
LS IMPLT4,IMPNLK	; Lh -- CURRENT BUFFER
			; Rh -- MSG ALLOCATION
LS IMPLT5,IMPNLK	;FOREIGN HOST

; Pi dispatch

IMPSV:	XWD IMPSVX,.+1
	CONSO IMP,7		; Input turned off?
	JRST IMPSV1		; Yes
	CONSZ IMP,I.IRQ
	JRST @IMIDSP		; Word in
	CONSZ IMP,I.ERQ
	 JRST [	CONSO IMP,I.IRQ; It can happen that last input came in
		 JRST IMPEIN	; Within the last few instructions
		JRST @IMIDSP]	; If so, handle it first
IMPSV1:	CONSZ IMP,7B31		; Do nothing if no channel assigned
	CONSO IMP,I.ORQ
	JRST @IMPSVX		; N.o.t.a
	SKIPE IMPOB
	JRST [	SETOM IMOBDF	; Flag for which path during output
		JRST @IMODSP]	; Dispatch to word out routines
	CONO IMP,I.STO
	JRST @IMPSVX

IMPCHK:	MOVEI 2,^D1000
	MOVEM 2,IMPTM2		; Call this every second
	SKIPN IMPRDY		; Net on?
	 JRST IMPCKX		; No
	CONSZ IMP,I.PWR		; Power not on
	CONSZ IMP,I.ERR!I.DWN	; Or error flop on, or host not ready?
	SKIPL IMPRDT		; And not already noticed?
IFE F3FLG,<
	 JRST IMPCKX
>
IFN F3FLG,<
	 JRST IMPINX
>
	CALL IMIERR		; Be sure it's noticed
	AOS IMPFLG		; No, cause running of ncp fork
IMPCKX:	
;1	CALL IM2CHK		; Check the second interface, if any
	RET

IFN F3FLG,<
; Check to see if IMP is losing interrupts
IMPINX:	CONSZ IMP,I.ORQ		; Output interrupt?
	CONSO IMP,160		; And channel assigned?
	 JRST IMPCKX		;   No, OK
	CONI IMP,IMPCNI		; Save state of lossage
	;;;BUG(CHK,<IMP interface dropped interrupt>)
	AOS IMPLIC		; Count number of lost interrupts for fun
	CONO PI,4000+1B<28+IMPCHN>
	JRST IMPCKX		; Force interrupt on IMP's channel
>;IFN F3FLG



; Called by periodic check routine

	SWAPCD

CHKNET:	SKIPE BUGIMP
	 CALL CHKN1		; Yes
	SKIPE NETTCH		; Change of state?
	 CALL CHKN5		; Yes
	SKIPE IMPGDM		; Any "imp going down" messages?
	  CALL CHKN7		; Yes, go print it
	RET

; Log network change of state

CHKN5:	HRROI 1,[ASCIZ /
***** NETWORK /]
	PSOUT
	HRROI 1,[ASCIZ /ON/]
	SKIPN NETON
	HRROI 1,[ASCIZ /OFF/]
	PSOUT
	HRROI 1,[ASCIZ /, IMP /]
	PSOUT
	HRROI 1,[ASCIZ /ON/]
	SKIPN IMPRDY
	HRROI 1,[ASCIZ /OFF/]
	PSOUT
	MOVEI 1," "
	PBOUT
	CONI IMP,2
	SETZM NETTCH
	CALL CHKH1		; Go print coni word and tod
	RET

; Log impbug/imhbug

CHKN1:	HRROI 1,[ASCIZ /
***IMPBUG /]
	PSOUT
	MOVEI 1,101
	MOVEI 3,^D10
	MOVE 2,IMPBGC
	NOUT
	JFCL
	HRRZ 2,IMPBGH		; Host number if any
	JUMPE 2,CHKN4		; None
	HRROI 1,[ASCIZ / HOST /]
	PSOUT
	MOVEI 1,101
	MOVEI 3,^D8
	CVHST			; Type host name or number
	 NOUT
	  JFCL
CHKN4:	HLRZ 2,IMPBGH		; Status if any
	JUMPE 2,CHKN3		; None
	HRROI 1,[ASCIZ \ STS/LINK \]
	PSOUT
	MOVEI 1,101
	MOVEI 3,10
	NOUT			; Print status in octal
	JFCL
CHKN3:	SKIPN 4,BADHMS		; Any header to print
	 JRST CHKN8		; No
	HRROI 1,[ASCIZ / HEADER: /]
	PSOUT
	MOVE 5,[POINT 4,BADHDR]
	MOVEI 1,101
	MOVEI 3,10
CHKN8L:	ILDB 2,5
	ROT 2,4
	ILDB 6,5
	IOR 2,6
	NOUT
	 JFCL
CHKN8:	MOVEI 2," "
	BOUT
	SOJG 4,CHKN8L
	HRROI 1,[ASCIZ /AT /]
	PSOUT
	SOS 2,BUGIMP		; Back pc up to point at jsr
	SETZM BADHMS
	SETZM BUGIMP
	SETZM IMPBGH
	CALL CHKBG1		; Print address and message
	RET

; Broadcast imp going down message

CHKN7:	HRROI 1,1(P)		; Buffer on pdl
	ADD P,[20,,20]
	HRROI 2,[ASCIZ /IMP GOING DOWN FOR /]
	SETZ 3,
	SOUT
	LDB 2,[POINT 10,IMPGDM,31]
	IMULI 2,5
	MOVEI 3,^D10
	NOUT
	 JFCL
	HRROI 2,[ASCIZ / MIN IN /]
	SETZ 3,
	SOUT
	LDB 2,[POINT 4,IMPGDM,21]
	MOVEI 3,^D10
	IMULI 2,5
	NOUT
	 JFCL
	HRROI 2,[ASCIZ / MIN DUE TO /]
	SETZ 3,
	SOUT
	LDB 2,[POINT 2,IMPGDM,17]
	HRRO 2,[[ASCIZ /PANIC
/]
		[ASCIZ /SCHED HDWRE PM
/]
		[ASCIZ /SOFTWRE RELOAD
/]
		[ASCIZ /EMRGNCY RESTRT
/]](2)
	SOUT
	HRROI 2,-17(P)
	SETO 1,
	TTMSG
	SUB P,[20,,20]
	SETZM IMPGDM
	RET

	RESCD

REPEAT 0,<			; No debug junk at Tymshare

; Routines to make footprints for debugging

; Take imp footprints jsys
; Call:	1	; Jfn of output file
;	2	; Word count (stops at first opportunity past this)
;	3	; B0: Re-init and look at B1,2,3
;		; B1: Report NCP bugs
;		; B2: Report normal NCP events
;		; B3: Report TCP stuff

.DBGIM::MCENT
	HRRZS 1			; Don't allow byte pointers
	MOVEI 4,WHEEL!NETWIZ
	TDNN 4,CAPENB
	 JRST MRETN
	JUMPG T3,DBGIM0		; Skip init stuff
	NOSKED
	SETZM DBGNWD
	SETZM DBGSP
	SETZM DBGFAC
	SETZM DBGERR
	TLNE T3,(1B1)
	SETOM DBGERR
	SETZM DBGNCP
	TLNE T3,(1B2)
	SETOM DBGNCP
	SETZM DBGTCP
	TLNE T3,(1B3)
	SETOM DBGTCP
	OKSKED
	SETZM DBGRP
	AOS DBGRP		; Point at first word
DBGIM0:	PUSH P,2		; Save count on stack
	PUSH P,1
DBGDBL:	SKIPG 3,DBGNWD
	 JRST DBGDBW
	MOVEI 4,DBGNBF
	SUB 4,DBGRP		; Space to end of buffer
	CAMGE 3,4
	 MOVEM 3,4		; Keep min
	MOVN 3,4
	MOVE 2,DBGRP
	ADD 2,[POINT 36,DBGBUF]
	SOUT
	MOVN 3,4
	ADDM 3,DBGNWD
	ADDB 4,DBGRP
	CAIL 4,DBGNBF
	 SETZB 4,DBGRP
	ADDB 3,-1(P)		; Count words written
	JUMPG 3,DBGDBL		; Continue if still .gr. 0
	UMOVEM 3,3		; Else return updated count
	SUB P,BHC+2
	JRST SKMRTN

DBGDBW:	MOVEI 1,DBGNWD
	PUSHJ P,DISG
	MOVE 1,0(P)
	JRST DBGDBL


; Variables

DBGNBF==2000

LS(DBGFAC,1)		; Failure counter
LS(DBGSP,1)		; Store pointer
LS(DBGRP,1)		; Read pointer
LS(DBGNWD,1)		; Number of words in buffer
LS(DBGNCP,1)		; Non-0 if debugging NCP
LS(DBGERR,1)		; Non-0 if debugging error messages
LS(DBGTCP,1)		; Non-0 if debugging TCP
NGS(DBGBUF,DBGNBF)	; Buffer


; Stash input irregular msg

DBGIIM:	SKIPN DBGNCP
	 RET
	PUSH P,T2
	MOVEI T2,3		; Three words of leader
	PUSHJ P,DBGCKS		; Check for space
	 JRST DBGXIT
	PUSHJ P,DBGS2B
	HRLI T1,-3		; Count three words of leader
DBGIIL:	MOVE T2,0(T1)		; Get a word from irreg msg buffer
	PUSHJ P,DBGS1B
	AOBJN T1,DBGIIL		; Do whole leader
DBGXIT:	OKSKED
	POP P,T2
	POPJ P,

DBGINM:	SKIPN DBGNCP
	 RET
	PUSH P,T2
	LOAD T2,IHLNK,(T1)	;Link number of this msg
	SKIPE T2		;Control link?
	 SKIPA T2,[5]		;No. Assume length 5
	  LOAD T2,NBBSZ,(T1)	;Yes, Get its length.
DBGSM:	SOS T2
	PUSHJ P,DBGCKS
	 JRST DBGXIT
	PUSH P,T1
	PUSHJ P,DBGS2B
	MOVNI T1,0(T2)
	HRLZS T1
	HRR T1,0(P)
DBGSLP:	MOVE T2,1(T1)
	PUSHJ P,DBGS1B
	AOBJN T1,DBGSLP
	POP P,T1
	JRST DBGXIT


DBGOM:	SKIPN DBGNCP
	 RET
	PUSH P,T2
	LOAD T2,IHMTY,(T1)	;What type msg is this?
	JUMPN T2,[ HRROI T2,2
		JRST DBGSM]
	LOAD T2,IHLNK,(T1)	;Which link?
	JUMPE T2,DBGOM1
	HRROI T2,5		;Not control link
	JRST DBGSM
DBGOM1:	LOAD T2,NBBSZ,(T1)	;Message size
	HRROS T2
	JRST DBGSM

DBGTM::	SKIPN DBGTCP
	 RET
	PUSH P,T2
	LOAD T2,NBBSZ,(T1)
	HRLI T2,-2
	JRST DBGSM

; Record impbug

DBGBG1:	PUSH P,2
	MOVEI 2,1
	CALL DBGCKS
	 JRST DBGXIT
	MOVE 2,1
	HRLI 2,3
	CALL DBGS2B
	MOVE 2,0(P)
	CALL DBGS1B
	JRST DBGXIT

; Store header word and time stamp

DBGS2B:	PUSHJ P,DBGS1B
	PUSH P,2
	EXCH 1,2
	GTAD
	EXCH 1,2
	PUSHJ P,DBGS1B
	POP P,2
	POPJ P,

; Store 1 word in debug buffer

DBGS1B:	PUSH P,1
	AOS 1,DBGSP
	CAIL 1,DBGNBF
	 SETZB 1,DBGSP
	MOVEM 2,DBGBUF(1)
	AOS DBGNWD
	POP P,1
	POPJ P,

; Check for sufficient space to make new entry

DBGCKS:	SKIPE DBGFAC		; Any intervening failures?
	 AOJA 2,DBGCK2		; Yes
DBGCK1:	PUSH P,1
	NOSKED
	MOVE 1,DBGNWD
	ADDI 1,2(2)
	CAIG 1,DBGNBF
	 AOSA -1(P)
	  AOS DBGFAC
	POP P,1
DBGCK3:	POPJ P,

DBGCK2:	PUSHJ P,DBGCK1
	 SOJA 2,DBGCK3
	EXCH 2,DBGFAC
	HRLI 2,1
	PUSHJ P,DBGS1B
	SOS 2,DBGFAC
	SETZM DBGFAC
	POPJ P,

>				; End of repeat-zero for debug junk

; Imp asynchronous process
; Started once, call from rundd

IMPBEG:	MOVSI 1,(1B1)		; Create fork of job 0
	CFORK
	BUG(HLT,<CAN'T CREATE IMP FORK>)
	MOVEI 2,IMPBP0
	MSFRK			; Start fork in monitor
IFG TCPN,<CALL TCPBEG##>	; Same for TCP
	RET

; Init

IMPBP0:	MOVSI 1,UMODF		; Establish usual jsys context
	MOVEM 1,FPC
	JSYS MENTR
	MOVE 1,FORKX
	MOVEM 1,NCPFRK
	MOVE 1,[XWD ITFPC,IMPUXI]
	MOVEM 1,MONBK		; Trap any interrupts
	MOVE 1,CHNSON
	MOVEM 1,MONCHN

	MOVEI 1,NINBFS
	MOVEM 1,IMPNIB	;INIT NUMBER OF BUFFERS TO KEEP ON TAP


IFE PIESLC,<
	MOVEI 1,202
	MOVEM 1,JOBBIT
>

IFN PIESLC,<CALL SETSPQ##>	;NCPFRK GETS SPECIAL QUEUE

	CALL IMPINI
	CALL NVTINI##
	MOVEI 1,2
	MOVEM 1,IMCLST		; Make last clock be dummy (ac 2)
IMPBP1:	IMSCLK(IMCIDL)		; Start charging time to imcidl
	PUSH P,[IMPBP1]		; Return for following dispatches
	SETZM IMPFLG		; Clear request flag
	CALL IMPSTT		; Check state of net and imp
	JRST IMPBP3		; Down
	SKIPE IMINFB		; Garbage buffers to release?
	JRST IMINRB		; Yes
	MOVE 1,LNKNDL		; Deletes in link table
	CAIL 1,IMPNLK/2		; Time for gc?
	JRST IMPGC		; Yes
	SKIPE IMPNCL		; Control msgs for processing?
	JRST IMPCN0		; Yes
	SKIPE IMPIBO		; Input buffers ready?
	JRST IMIP1		; Yes
	SKIPE IMP8XC		; Irreg msgs for processing?
	JRST IMP8XM		; Yes
	MOVE 1,NETFRE+2		; Get number of words of buffer space 
				; now available
	SKIPE TTNOF		; Scan of net ttys requested?
	CAMG 1,ASNTHR##		; and enough buffer space available?
	 CAIA			; no
	JRST IMPTS		; Yes
	MOVE 1,IMPNFI
	CAMGE 1,IMPNIB	; NEED INPUT BUFFERS?
	CALL IMPGIB		; Yes
	SKIPE IMPNOS		; Need output scan?
	CALL IMPOS		; Yes
	IMSCLK(IMCIDL)		; Back to imcidl for charging

IMPBP2:	MOVE 1,TODCLK
	CAML 1,IMPTIM		; Time for local checks?
	JRST NETCH0		; Yes
	CAML 1,RFNTIM		; Time for overdue rfnm check?
	JRST RFNCHK		; Yes
	CAML 1,NETTIM		; Time for netwrk checks?
	 JRST [	IMSCLK(IMCNCC)
		JRST NETCHK]	; Yes
	CAML 1,NEGTIM
	 JRST NEGCHK		; Check incomplete negotiations
	PUSHJ P,SIQCHK		; Return a TODCLK in T1
	CAMLE 1,IMPTIM
	MOVE 1,IMPTIM		; Compute min clocks as
	CAMLE 1,NETTIM		; Next time to wakeup
	MOVE 1,NETTIM
	CAMLE 1,RFNTIM
	MOVE 1,RFNTIM
	CAMLE 1,NEGTIM
	 MOVE 1,NEGTIM
	MOVEM 1,IBPTIM
	MOVEI 1,IMPBPT
	JSYS EDISMS		; Dismiss until something to do
	RET

IMPBPT:	SKIPE IMPFLG		; Flag set?
	JRST 1(4)		; Yes, wakeup
	MOVE 1,TODCLK		; Check alarm clock
	CAML 1,IBPTIM
	JRST 1(4)
	SKIPGE IDVLCK		; Lock clear and out scan needed?
	SKIPG IMPNOS
	JRST 0(4)
	JRST 1(4)		; Yes, wakeup

IMPBP3:	MOVE 1,TODCLK
	CAML 1,NETTIM
	 CALL NETCHK		; Continue calling netchk if net down
	MOVEI 1,^D10000
	DISMS			; Wait 10 sec
	RET			; Then try again

; Unexpected interrupt

IMPUXI:	BUG(CHK,<IMP JB0 FORK - UNEXPECTED INTERRUPT>)
	MOVSI 1,UMODF		; Reset stack
	MOVEM 1,FPC
	JSYS MENTR
	JRST IMPBP1

; Special raw message routines

	SWAPCD

; Assign a special message queue

.ASNSQ::JSYS MENTR
	PUSHJ P,CKNTWZ
	 JRST ERMRTN
	PUSHJ P,ASNSQ0		; Work routine
	 JRST ERMRTN		; Fail, return error code
	HRRZ T1,P3		; Success. Return queue number
	UMOVEM T1,1		; To user
	JRST SKMRTN		; Return to user

ASNSQ0:	STKVAR <ASMSK0,ASVAL0,ASMSK1,ASVAL1,ASMSK2,ASVAL2,ASIVAL>
	UMOVE Q3,1		; Mask
	UMOVE Q2,2		; Value
	TLNE Q3,-1		; 96 bit format?
	JRST ASNS32		; No. Convert old format.
	UMOVE T1,0(Q3)		; Get user's mask in 32 bit per word
	UMOVE T2,1(Q3)
	LSH T1,-4		; Butt the 64 bits together
	LSHC T1,4
	MOVEM T1,ASMSK0
	LSH T2,-^D8
	UMOVE T3,2(Q3)		; Third 32 bits
	TRZ T3,17		; Make sure no junk from user
	LSHC T2,^D8
	MOVEM T2,ASMSK1
	MOVEM T3,ASMSK2
	UMOVE T1,4(Q3)		; Get user's value in 32 bit per word
	UMOVE T2,5(Q3)
	LSH T1,-4		; Butt the 64 bits together
	LSHC T1,4
	MOVEM T1,ASVAL0
	LSH T2,-^D8
	UMOVE T3,6(Q3)		; Third 32 bits
	TRZ T3,17		; Make sure no junk from user
	LSHC T2,^D8
	MOVEM T2,ASVAL1
	MOVEM T3,ASVAL2
	UMOVE T1,3(Q3)		; Get last two args for internet byte
	UMOVE T3,7(Q3)		; ..
	LSH T1,^D8		; Compress for now into one arg
	IOR T1,T3		; Matching old AC3
	MOVEM T1,ASIVAL		; Save in local block
	JRST ASNS9X		; Join 32-bit code

;Here for old style mask and value arguments

ASNS32:	TRZN Q3,1		; Want internet compare?
	TDZA T2,T2		; No, assume zero
	UMOVE T2,3		; Yes, get mask and value
	ANDI T2,177777		; Just two 8-bit fields
	MOVEM T2,ASIVAL		; Save internet temp
;Long sequence of code to convert 32 to 96 bit leader mask and value
	MOVE T1,Q3		; Build first mask and value words
	MOVE T2,Q2		; ..
	LSH T1,^D<7-31>		; Message type field
	LSH T2,^D<7-31>
	ANDI T1,17B31		; Just four bits of message type
	ANDI T2,17B31		; ..
	MOVEM T1,ASMSK0
	MOVEM T2,ASVAL0
	MOVE T1,Q3		; Now second word of leader
	MOVE T2,Q2
	LSH T1,-^D12		; Align link and imp numbers
	LSH T2,-^D12
	ANDI T1,77B27+377
	ANDI T2,77B27+377	; Link and 6 bits of Imp
	TXNE Q3,<FRMIMP+377B15>	; If looking for some real site(s),
	TXO T1,<374B11+177700B27> ; Make mask be full width on addresses
	LDB T3,[POINT 2,Q3,9]	; Move host bits over
	DPB T3,[POINT 2,T1,11]	; in mask
	LDB T3,[POINT 2,Q2,9]	; and value
	TXNE Q2,FRMIMP	; Talking about a fake host?
	ADDI T3,FKHOST		; Yes.  Convert the host number
	DPB T3,[POINT 8,T2,11]	; Store in value word
	MOVEM T1,ASMSK1		; Save converted mask, second word
	MOVEM T2,ASVAL1		; and corresponding value
	MOVE T1,Q3		; Now build the third word
	MOVE T2,Q2
	ANDI T1,377B31
	ANDI T2,377B31
	LSH T1,^D<31-7>		; Position for 96 bit leader
	LSH T2,^D<31-7>
	MOVEM T1,ASMSK2
	MOVEM T2,ASVAL2		; Save for comparisons
;Fall thru

;Falls thru from above
; Now have converted masks from 32 to 96 bit format if needed

ASNS9X:	NOINT			; Protect lock
	AOSE SQLCK
	 PUSHJ P,SQLWAT
	MOVSI P2,-NSQ		; Search thru special Q tables
	SETZ P3,		; Remember a free slot when found
ASNSQL:	SKIPGE SQJOB(P2)	; Assigned?
	 JRST [	JUMPL P3,ASNSQN
		MOVE P3,P2	; First free one. Remember it.
		JRST ASNSQN]
	HRLZ T3,ASIVAL		; Check internet byte
	AND T3,SQJOB(P2)	; GET JOINT MASK
	LSH T3,-^D26		; RIGHT JUSTIFY
	ANDI T3,377		; FLUSH EXTRANEOUS BITS
	MOVE T2,ASIVAL		; Get value
	TSC T2,SQJOB(P2)	; COMPARE VALUES
	AND T2,T3		; ONLY WHERE IT COUNTS
	JUMPN T2,ASNSQN		; DIFFERENT IS OK
	MOVE T1,ASMSK0		; User's mask
	AND T1,SQMSK1(P2)	; This queue's mask
	MOVE T2,ASVAL0		; User's value
	XOR T2,SQVAL1(P2)	; This queue's value
	TDNE T1,T2		; Must be different in joint mask bits
	JRST ASNSQN		; They are different. Ok.
	MOVE T1,ASMSK1		; User's mask
	AND T1,SQMSK2(P2)	; This queue's mask
	MOVE T2,ASVAL1		; User's value
	XOR T2,SQVAL2(P2)	; This queue's value
	TDNE T1,T2		; Must be different in joint mask bits
	JRST ASNSQN		; They are different. Ok.
	MOVE T1,ASMSK2		; User's mask
	AND T1,SQMSK3(P2)	; This queue's mask
	MOVE T2,ASVAL2		; User's value
	XOR T2,SQVAL3(P2)	; This queue's value
	TDNN T1,T2		; Must be different in joint mask bits
	 JRST ASNSQF		; Else fail
ASNSQN:	AOBJN P2,ASNSQL		; Test all possibilities
; Fall thru

;Falls thru. All possible queues have been scanned for conflict or free.
	MOVEI T1,ASNSX1		; In case no free slots
	JUMPGE P3,ASNSF1	; Jump if none free
	MOVE T1,ASMSK0		; Store the newly assigned masks, vals.
	MOVEM T1,SQMSK1(P3)	; Store mask in table
	MOVE T1,ASVAL0
	AND T1,ASMSK0		; Just meaningful bits
	MOVEM T1,SQVAL1(P3)	; Store value field
	MOVE T1,ASMSK1		; Store the newly assigned masks, vals.
	MOVEM T1,SQMSK2(P3)	; Store mask in table
	MOVE T1,ASVAL1
	AND T1,ASMSK1		; Just meaningful bits
	MOVEM T1,SQVAL2(P3)	; Store value field
	MOVE T1,ASMSK2		; Store the newly assigned masks, vals.
	AND T1,[377B7]		; Only 80 bits are ckecked.
	MOVEM T1,SQMSK3(P3)	; Store mask in table
	MOVE T1,ASVAL2
	AND T1,ASMSK2		; Just meaningful bits
	MOVEM T1,SQVAL3(P3)	; Store value field
	MOVE T2,ASIVAL		; Internet bytes
	HRL T2,JOBNO
	MOVSM T2,SQJOB(P3)
	SETOM SQLCK
	JRST RSKP		; Good return to jacket routine

ASNSQF:	MOVEI T1,ASNSX2
ASNSF1:	SETOM SQLCK
	RET			; Fail return to jacket routine

; Release special q

.RELSQ:: JSYS MENTR
	NOINT
	AOSE SQLCK
	 PUSHJ P,SQLWAT
	CAMN 1,[-1]
	 JRST RELASQ
	CAIL 1,0
	CAIL 1,NSQ
	 JRST RELSQ1
	PUSHJ P,REL1SQ
RELSQ1:	SETOM SQLCK
	JRST MRETN

RELASQ:	MOVSI 4,-NSQ
RELAS1:	HRRZ 1,4
	PUSHJ P,REL1SQ
	AOBJN 4,RELAS1
	JRST RELSQ1

REL1SQ:	HRRZ 2,SQJOB(1)
	CAME 2,JOBNO
	 POPJ P,
	SETOM SQJOB(1)
REL1S1:	PUSHJ P,SIQGET
	 POPJ P,
	PUSH P,1
	PUSHJ P,RLNTBF
	POP P,1
	JRST REL1S1

; .RCVIM, receive raw messages.  B0 off for 32-bit leader format
;  in user area, and B0 on for 96-bit leader format in user area.
;  B1 on for 32 bit data in user area, off for 36 bit data packing.
;  Called by
;	MOVEI 1,SQH
;	TLO 1,(1B0)		; If want 96 bit leader
;	TLO 1,(1B1)		; If want data as 32-bit form in user area
;	MOVEI 2,BUFFER
;	RCVIM
;	 error
;	OK

.RCVIM::JSYS MENTR
RCVIM1:	NOINT
	UMOVE P1,1		; Get user's arguments
	HRRZ T1,P1		; Verify the queue handle
	CALL CHKSQ		; Check for accessibility to special q
	 JRST ERMRTN		; No access
	MOVE T4,T1		; Save SIQ index, in case we wait.
	PUSHJ P,SIQGET		; Get the message
	 JRST [	MOVE T3,FORKX	; Record FORKX for wakeup routine
		MOVEM T3,SIQFKX(T4)
		OKINT		; None there
		JSYS EDISMS	; WAIT
		JRST RCVIM1]	; Try again
	SETOM SIQFKX(T1)	; CLEAR FORKX 
	JUMPGE P1,RCVIM0	; Jump if 32 bit leader
	UMOVE T1,2		; Get user's buffer
	HRL T1,T2		; Message location
	MOVE T3,.NBLD1(T2)	; If 96 bits, make 3 32 bit words
	MOVE T4,.NBLD2(T2)
	LSHC T3,-^D8		; Last 32 bits of leader
	MOVE T3,.NBLD2(T2)	; Possible 4 bits of data in B32-35
	DPB T3,[POINT 4,T4,35]	; ..
	MOVEM T4,.NBLD2(T2)	; Pretty third leader word
	MOVE T3,.NBLD0(T2)	; First 72 bits of leader
	MOVE T4,.NBLD1(T2)
	LSHC T3,-4		; Put bits 32-35 in second word
	LSH T3,4		; Restore bits 0-31
	ANDCMI T4,17		; Turn off four junk bits in second word
	MOVEM T3,.NBLD0(T2)	; Restore 64 bits to buffer
	MOVEM T4,.NBLD1(T2)
RCVIM0:	TLNE P1,(1B1)		; User want data in 32 bit form?
	JRST RCVI1X		; Yes. Don't need to convert it
	MOVEI P2,.NBLD2(T2)	; Need to convert back to 36 bit form
	MOVEI Q2,.NBLD2(T2)	; Make reader and writer pointers
	LOAD Q3,NBBSZ,(T2)	; How many words in buffer
	ADDI Q3,0(T2)		; Word after last one to read
	MOVSI T1,-10		; State counter
RCVIL1:	MOVE T3,0(P2)		; Get some IMP bits
	CAIL P2,-1(Q3)		; Beyond real end of data?
	TDZA T4,T4		; Yes, make zeros for second word
	 MOVE T4,1(P2)		; Else two words of net data
	LSH T3,-4		; Crunch out the 4 bits of junk
	LSHC T3,@RCVIT1(T1)	; Shift together 36 good bits
	MOVEM T3,0(Q2)		; Put them back in buffer
	AOBJN T1,RCVIN1		; Step the state counter
	MOVSI T1,-10		; Restart it
	ADDI P2,1		; Move up 1 of each 9 words
RCVIN1:	ADDI Q2,1		; Step the writer,
	CAIGE P2,0(Q3)		; Read them all?
	AOJA P2,RCVIL1		; No, loop some more.
	SUBI Q2,0(T2)		; When done, find new length, for user.
	SKIPA			; End of converter to 36 bit form
RCVI1X:	LOAD Q2,NBBSZ,(T2)	; For 32 bits, believe interrupt service
	UMOVE T1,2		; Get user's buffer
	MOVE T3,Q2		; Size of buffer in monitor
	SKIPL P1		; User want short leaders?
	SUBI T3,2		; Yes, he will get only this length.
	UMOVEM T3,.NBHDR(T1)	; Give user the size he will see
	HRLI T1,0(T2)		; Message location in monitor
	MOVE T3,T1		; Copy of user's buffer location
	ADDI T3,0(Q2)		; Plus size -- end
	AOBJN T1,.+1		; Don't transfer the buffer header
	JUMPL P1,RCVI1Y		; No corrections if user gets long ldr
	ADD T1,[2,,0]		; Only one word of leader
	SUBI T3,2		; And end earlier, too.
RCVI1Y:	XCTMU [BLT 1,-1(3)]	; Transfer to user
	JUMPL P1,RCVIM2		; If wants long ldr, go give it to user

; Here to convert leader to look like old 32-bit leader format

RCVIM3:	MOVE T4,.NBLD2(T2)	; Get the low 4 bits
	LSH T4,^D32		; Rest of word shifts in from left
	LOAD T3,IHSTY,(T2)	; And build the remaining 32 bits
	LSHC T3,-4		; ..
	LOAD T3,IHMI2,(T2)	; Do all 12 bits of msg ID
	LSHC T3,-4
	LOAD T3,IHLNK,(T2)	; Rest of link
	LSHC T3,-^D8
	LOAD T3,IHIMP,(T2)	; IMP number
	LSHC T3,-6
	LOAD T3,IHHST,(T2)	; Host portion of address
	LSHC T3,-2
	LOAD T3,IHMTY,(T2)	; Message type
	LSHC T3,-^D8
	LOAD T3,IHHST,(T2)	; Check again on host number
	CAIL T3,FKHOST		; Fake host?
	TXO T4,FRMIMP		; Yes, set "From IMP" bit
	UMOVE T1,2		; User's buffer address again
	UMOVE T3,.NBLD0(T1)	; Preserve 4 data bits, if 36 bit
	ANDI T3,17		; That's these
	TRO T4,(T3)		; Put them with leader
	UMOVEM T4,.NBLD0(T1)	; Give user this leader
RCVIM2:	PUSHJ P,RLNTBF		; Release the buffer
	JRST SKMRTN		; Return

ERMRTN:	UMOVEM 1,1
	JRST MRTNE1		; Exit for ERCAL/ERJMP

;Table for shifting 32 bit words back into 36 bits, for rcvim

RCVIT1:	Z 4		; Shifts done indirect thru this table
	Z 10
	Z 14
	Z 20
	Z 24
	Z 30
	Z 34
	Z 40

	RESCD

SIQGET:	MOVE 2,TODCLK
	ADDI 2,SIQTM0
	MOVEM 2,SIQTIM(1)	; Reset time
	NOSKED
	HLRZ 2,SIQIBO(1)
	JUMPE 2,SIQEMT
	HLLZ 3,0(2)
	MOVEM 3,SIQIBO(1)
	JUMPN 3,.+3
	MOVEI 3,SIQIBO(1)
	MOVEM 3,SIQIBI(1)
	SOS SIQSPC(1)		; Credit space used
	OKSKED
	AOS 0(P)
	RET

SIQEMT:	OKSKED
	HRLZI 1,SIQIBO(1)
	HRRI 1,DISNT
	POPJ P,

	SWAPCD

; .sndim: send special message
;	AC1/ RH = SQH, B0 = User wants 96 bit leader, B1 = User wants
;			data left as 32 bits per word

.SNDIM::JSYS MENTR
	UMOVE P1,1		; User's SQH in RH, bits in LH
	UMOVE P2,2		; User's buffer address
	UMOVE P3,.NBHDR(P2)	; Size word of that buffer
	HRRZ T1,P1
	CALL CHKSQ		; Check access to special q
	 JRST ERMRTN
	NOINT
	MOVEI T2,0(P3)		; User's buffer size
	SKIPL P1		; If converting from 32bit in user space,
	ADDI T2,2		; Less two for leader expansion
	CAILE T2,.NBLD2		; At least a full leader?
	CAML T2,MAXWPM		; And not too much?
	 JRST [	MOVEI T1,SNDIX1
		JRST ERMRTN]	; Bad size
	PUSHJ P,ASNTBF		; Get a buffer
	 JRST [	MOVEI T1,SNDIX2
		JRST ERMRTN]	; No buffers available
	PUSH P,T1		; Save buffer address
	HRL T1,P2		; Make blt pointer. From user area
	LOAD T2,NBBSZ,(T1)	; Number of words in monitor buffer
	MOVEI T3,1(T2)		; Save copy of size
	ADD T2,T1		; End of buffer
	CAMGE T3,MAXWPM		; Buffer all used?
	SETZM 0(T2)		; No, so clear possible pad word
	AOBJN T1,.+1		; Don't transfer size word
	SKIPL P1		; If converting from 32 bits,
	ADDI T1,2		; Leave room for bigger leader
	XCTUM [BLT T1,-1(T2)]	; Transfer message to monitor space
	POP P,T2		; The buffer
	JUMPGE P1,SNDIM1	; If need to convert leader fm 32 bit
	MOVE T3,.NBLD0(T2)	; Change from pretty to packed 96 bit ldr
	MOVE T4,.NBLD1(T2)
	LSH T3,-4		; Crunch out 4 unused bits
	LSHC T3,4		; ..
	MOVEM T3,.NBLD0(T2)	; First 36 bits of leader
	MOVE T3,T4		; Second word coming up
	MOVE T4,.NBLD2(T2)	; And third
	LSH T3,-^D8		; Remove unused bits
	LSHC T3,^D8		; Compress, making 8 bits of fill
	MOVEM T3,.NBLD1(T2)	; Put back in buffer
	MOVE T3,.NBLD2(T2)	; Put last 24 bits in right position
	DPB T3,[POINT 24,.NBLD2(T2),23]
	JRST SNDIM2		; Now go consider the data portion

;Here if user is giving us a 32 bit leader. Must make a 96 bit one.

SNDIM1:	MOVE T4,.NBLD2(T2)	; Get 32 bit form leader from user
	SETZM .NBLD0(T2)	; Clear space for the 96 bit leader
	SETZM .NBLD1(T2)
	MOVEI T3,17		; Four bits of data after leader
	ANDM T3,.NBLD2(T2)
	MOVEI T3,0		; Select priority bit
	TXNE T4,IMPHIP		; Old form prio bit
	MOVEI T3,<HTY%HP_-4>	; New form of it
	STOR T3,IHHT2,(T2)	; Put it in new leader
	LDB T3,[POINT 2,T4,3]	; Two low IMP flags
	LSH T3,2		; Room for two new ones
	STOR T3,IHLDF,(T2)	; In leader flags half-byte
	LDB T1,[POINT 4,T4,7]	; Message type
	LDB T3,[POINT 4,T4,31]	; Message subtype
	CAIN T1,3		; Old uncontrolled message?
	JRST [	MOVEI T1,.IHREG	; Becomes regular message
		MOVEI T3,STY%UC	; Of subtype three
		JRST .+1]
	STOR T1,IHMTY,(T2)	; Message type in buffer
	STOR T3,IHSTY,(T2)	; Subtype in buffer
	LSH T4,-^D8		; Now deal with 12 bits of msg ID
	MOVEI T3,(T4)		; Copy it
	STOR T3,IHMI2,(T2)	; The four bits in word LD2
	LSH T4,-4		; The link (top 8 bits)
	STOR T4,IHLNK,(T2)	; Copy link
	LSH T4,-^D8		; Next is the Imp and Host number
	MOVEI T3,(T4)		; Imp number
	ANDI T3,77		; Six bits only
	STOR T3,IHIMP,(T2)	; ..
	LSH T4,-6		; High two bits are host on imp
	MOVEI T3,(T4)
	ANDI T3,3		; Just two bits
	TXNE T4,<FRMIMP_-^D26>	; Was it for a fake host?
	ADDI T3,FKHOST		; Convert to high host number
	STOR T3,IHHST,(T2)	; Put it in leader
SNDIM2:
; Now have message in IMP buffer, converted to compressed
;  96 bit leader format. Now check for legality of addresses.
	MOVE T3,SQJOB(P1)	; GET INTERNET DISPATCH MASK AND VAL
	LSH T3,-2		; ALIGN WITH BYTE OF MESSAGE
	TLNE P1,(1B1)		; IF USER DATA IS 32 BIT LAYOUT,
	LSH T3,-^D12		; IT'S FARTHER OVER.
	XOR T3,.NBDW0+1(T2)	; COMPARE
	LSH T3,^D10		; ALIGN WITH MASK
	TLNE P1,(1B1)		; IF USER DATA IS 32 BIT LAYOUT,
	LSH T3,^D12		; UN-SHIFT THE TWELVE DONE ABOVE
	AND T3,SQJOB(P1)	; ONLY LOOK AT THESE BITS
	TLNE T3,177400		; AND ONLY THESE TOO
	 JRST SNDIXR		; NOT RIGHT
	MOVE T3,.NBLD0(T2)	; And header
	XOR T3,SQVAL1(P1)	; Difference with value
	TDNE T3,SQMSK1(P1)	; Must be equal in masked bits
SNDIXR:	 JRST [	MOVEI T1,SNDIX4
		JRST SNDIXX]
	MOVE T3,.NBLD1(T2)	; All three leader words must be OK
	XOR T3,SQVAL2(P1)	; ..
	TDNE T3,SQMSK2(P1)	; ..
	JRST SNDIXR		; Not right.
	MOVE T3,.NBLD2(T2)	; All three leader words must be OK
	XOR T3,SQVAL3(P1)	; ..
	TDNE T3,SQMSK3(P1)	; ..
	JRST SNDIXR		; Not right.
	MOVEI T3,ITY%LL		; Now tell IMP this is 96-bit msg
	STOR T3,IHFTY,(T2)	; ..
	SETZRO IHNET,(T2)	; Make sure network field is zero
	LOAD T3,IHMTY,(T2)	; Only allow sending regular messages
	LOAD T1,IHLNK,(T2)	; And on non-NCP links
	CAIN T3,.IHREG		; ..
	CAIG T1,LLINK		; ..
	JRST [	MOVEI T1,SNDIX3
		JRST SNDIXX]	; Invalid destination or type
;Now may need to convert 36 bit data to 32 bits.
	TLNE P1,(1B1)		; User gave us 32 bit data form?
	JRST SNDIM5		; Yes. Go send it.
	LOAD P2,NBBSZ,(T2)	; Get number of supplied words
	SUBI P2,.NBHHL		; First word to work on
	MOVEI Q2,0(P2)		; For reading in loop
	IMULI Q2,^D9		; Convert to needed words in 32 bit
	IDIVI Q2,^D8		; ..
	MOVEI P3,.NBLD2(Q2)	; Where to write into
	MOVEI T1,.NBHHL(Q2)	; Figure length to write
	SKIPE Q2+1		; Partial word?
	ADDI T1,1		; One more in destination
	CAML T1,MAXWPM		; Will this fit in buffer?
	 JRST [	MOVEI T1,SNDIX1	; No
		JRST SNDIXX]
	STOR T1,NBBSZ,(T2)	; Update for interrupt routine
	MOVEI Q2,.NBLD2(P2)	; Length to read from
	ADDI P3,0(T2)		; Point into the buffer
	ADDI Q2,0(T2)		; For these pointers
	TRC Q2+1,7		; make aobjn pointer
	HRLI Q2+1,-10(Q2+1)
	SETZM 1(P3)		; Make sure any pad is zero
SNDIL2:	MOVE T1,0(Q2)		; Get 36 bits to shuffle
	DPB T1,SNDIT2(Q2+1)	; Store right part of word
	LSH T1,@SNDIT1(Q2+1)	; Shift left part down
	MOVEM T1,0(P3)		; And store it (B32-B35 are junk)
	AOBJN Q2+1,SNDIN2	; Step the state counter
	MOVSI Q2+1,-10		; Restart it
	SUBI P3,1		; Skip a word in destination
SNDIN2:	SUBI P3,1		; Back up through the buffer
	SUBI Q2,1		; ..
	SOJGE P2,SNDIL2		; Count the words
SNDIM5:	NOSKED
	SKIPL IMPRDY		; Last minute check if imp is up
	 JRST [	OKSKED
		MOVEI 1,SNDIX5
		JRST SNDIXX]
	PUSHJ P,IMPQOA		; Put onto output q
	OKSKED
	JRST SKMRTN

SNDIXX:	PUSH P,T1		; Save error code
	PUSHJ P,RLNTBF		; Release the buffer, don't send it.
	POP P,T1		; Error code
	JRST ERMRTN		; Fail return from SNDIM jsys

; Tables for converting 36 to 32 bit buffer
SNDIT1:	Z -34		;Table used for shifting bits right
	Z -30
	Z -24
	Z -20
	Z -14
	Z -10
	Z -4
	Z 0

SNDIT2:	POINT 32,1(P3),31	;Table for storing right-hand part of word
	POINT 28,1(P3),27
	POINT 24,1(P3),23
	POINT 20,1(P3),19
	POINT 16,1(P3),15
	POINT 12,1(P3),11
	POINT 08,1(P3),07
	POINT 04,1(P3),03

; Check for access to specific special Q

CHKSQ:	MOVEI 2,(1)
	CAIL 2,NSQ
	 JRST [	MOVEI 1,SQX1
		POPJ P,]
	HRRZ 2,SQJOB(1)
	CAMN 2,JOBNO
	 JRST RSKP
	MOVEI 1,SQX2
	POPJ P,

; Check for net wizardry

CKNTWZ:	MOVEI 2,NETWIZ
	TDNE 2,CAPENB
	 JRST RSKP
	MOVEI 1,NTWZX1
	POPJ P,

SQLWAT:	PUSH P,1
	MOVEI 1,SQLTST
	JSYS EDISMS
	POP P,1
	POPJ P,

	RESCD

SQLTST:	AOSE SQLCK
	JRST 0(4)
	JRST 1(4)

; Siqchk: check for unclaimed messages
; Called from NCPFRK with TODCLK in T1

SIQCHK:	HRLOI T3,377777		;If none in use, will return infinite TODCLK
	MOVSI T2,-NSQ
SIQCKL:	SKIPGE SQJOB(T2)	; Is this Q in use?
	 JRST SIQCKE
	CAMG T1,SIQTIM(T2)	; Yes, time to flush stuff?
	 JRST SIQCKX		; No
	PUSH P,T1		; Yes, remove stuff
	PUSH P,T2
	PUSH P,T3
	HRRZ T1,T2
REPEAT 0,<			;CODE TO DELETE JUST ONE BUFFER
	PUSHJ P,SIQGET
	SKIPA
	PUSHJ P,RLNTBF>
REPEAT 1,<			;CODE TO FLUSH THE WHOLE QUEUE
	PUSHJ P,REL1S1>
	POP P,T3
	POP P,T2
	POP P,T1
SIQCKX:	CAML T3,SIQTIM(T2)
	 MOVE T3,SIQTIM(T2)	; T3 := next one which will expire
SIQCKE:	AOBJN T2,SIQCKL
	MOVE T1,T3		; When to call back
	POPJ P,

; Update imp clocks

IMUCLK:	PUSH P,1
	SUBI 1,IMCIDL
	AOS IMNIDL(1)		; Count entries
	MOVE 1,JOBRTT		; Time since last update of fkrt
	ADD 1,FKRT		; Fork cpu to now
	SUB 1,IMCCLK		; Time since last measurement
	ADDM 1,IMCCLK		; Update to be time of this clock measurement
	ADDM 1,@IMCLST		; Charge to current clock
	POP P,IMCLST		; Set to new clock
	RET

; Set idvlck

IFE PIESLC,<		; Version for non-pie slice scheduler
LCKIDV:	NOINT
	PUSH P,1
	MOVEI 1,1
	CALL STMINQ##		; Prevent dropping below q1 while locked
	LOCK IDVLCK,<JRST LCKID1>,SPQ
LCKID0:	POP P,1
	PUSH P,FORKX
	POP P,IDVLLK
	AOS 0(P)
	RET

LCKID1:	SKIPE @-1(P)		; Wait wanted?
	JRST ULKID0		;NO ,RETURN
	MOVEI 1,IDVTST
	JSYS EDISMS
	JRST LCKID0

> ;END NON-PIE-SLICE CONDITIONAL

IFN PIESLC,<		; Version for pie-slice scheduler
LCKIDV:	NOINT
	LOCK IDVLCK,<JRST LCKID1>,SPQ
LCKID0:	PUSH P,FORKX
	POP P,IDVLLK
	AOS 0(P)
	RET

LCKID1:	SKIPE @0(P)		; Wait wanted?
	 JRST [	OKINT
		JRST RELSPQ##]		;RETURN VIA RELSPQ, NORMAL SCHEDULING
	PUSH P,1
	MOVEI 1,IDVTST
	JSYS EDISMS
	POP P,1
	JRST LCKID0
> ; END OF IFN PIESLC CONDITIONAL

; Unlock idvlck

ULKIDV:	UNLOCK IDVLCK,RESIDENT,SPQ

IFE PIESLC,<
	PUSH P,1
ULKID0:	SETZ 1,
	CALL STMINQ
	POP P,1
>
	OKINT
	RET

IDVTST:	AOSE IDVLCK
	 JRST 0(4)
	JRST 1(4)

; Release buffers left by pi routines

IMINRB:	IMSCLK(IMCNRB)		; Charge time to releasing buffers
IMINRF:	SETZ 4,
	EXCH 4,IMINFB		; Get all garbage buffers
IMINR1:	JUMPE 4,R		; Quit when all released
	MOVEI 2,0(4)
	HLRZ 4,0(4)
	CALL RLNTBF		; Release one
	JRST IMINR1

; Get one buffer for input and lock it in core

IMPGIB:	IMSCLK(IMCGIB)		; Charge to imcgib
IMPGI1:	MOVE 2,MAXWPM		; For max input msg
	CALL ASNTBF		; Assign from pool
	JRST IMPB03
	MOVEI 2,0(1)
	CALL IMPLKB		; Lock buffer
	PIOFF
	EXCH 2,IMPFRI		; Put bfr on input free list
	HRLM 2,@IMPFRI
	AOS 2,IMPNFI		; Count number free, if was 0, then
	PION
	SKIPN IMIB		; Input is off?
	SKIPG IMPNFI		; YES, BUFFERS AVAILABLE?
	 CAIA			; NO
	PUSHJ P,IMISRT		; Yes, restart
	MOVE 2,IMPNFI		; GOT ENOUGH BUFFERS?
	CAMGE 2,IMPNIB
	 JRST IMPGI1		; NO
	RET

; Scan net tty lines

IMPTS:	IMSCLK(IMCTS)		; Charge to imcts
	SETZM TTNOF
	MOVSI 10,-NNVTLN	; Count thru nvt lines
IMPTS1:	MOVEI 2,NVTLO(10)
	MOVSI 1,NVTCHS
	TDNE 1,TTNETW(2)
	 JRST IMPTS2		; Not when chaosnet tty
	SKIPN TTOCT(2)		; Output ready?
	SKIPE TTECT(2)
	CALL NETTCS		; Yes
IMPTS2:	AOBJN 10,IMPTS1
	RET

; Scan all connections for output possible
; Called by NCPFRK

IMPOS:	IMSCLK(IMCOS)		; Charge to imcos
	MOVSI 6,-IMPNLK
	SETZM IMPNOS		; Cancel request
IMPOS2:	HRRZ 2,IMPLT1(6)
	TRNE 2,LT1SND		; Output connection has bit 18 on
	TRNE 2,LT1FRE		; And bit 19 off
IMPOS1:	AOBJN 6,IMPOS2
	JUMPGE 6,[SUB P,BHC+1	; Flush .+1 return, go back to top
		RET]
	ILOCK(<JRST [AOS IMPNOS	; Try again later
		RET]>)		; Return if can't set lock
	MOVEI 1,0(6)
	CALL IMPKO1		; Check and send if possible
	JRST IMPOS1

; Asynch process to put buffers on proper connection queues

IMIP1:	IMSCLK(IMCP1)		; Charge to imcp1
	MOVE T2,IMPIBO		; Try to get next buffer
	JUMPE 2,R		; None left
	PIOFF
	LOAD T3,NBQUE,(T2)	; Get successor
	SKIPN T3		; Queue will not become empty
	 SETZM IMPIBI		; Make queue null
	MOVEM T3,IMPIBO		; Update output pointer
	PION
	PUSH P,2		; Save bfr address
	MOVEI 1,0(2)
;;;;	CALL DBGINM
	NOSKED
	LOAD T2,NBBSZ,(T2)	; GET SIZE FIELD
	CAMLE T2,MAXWPM		; MAKE SURE ITS NOT ON FREELIST
	 BUG(HLT,<IMIP1: ATTEMPT TO UNLOCK BUFFER ON FREELIST>)
	MOVE 2,0(P)		; RESTORE 2
IFNDEF RNTBFS,<
	CALL MULKMP		; Unlock head, tail unlocked at pi lev
>
	SETZRO NBQUE,(T2)	; Clear fwd pointer
	LOAD T3,IHHST,(T2)	; Check for high-numbered addresses
	CAIL T3,FKHOST		; Is it a fake host?
	 JRST IMIPSQ		; Yes. Only on special queues.
	LOAD T1,IHADR,(T2)	; Address
	IOR T1,NETFLD		; Net number
	LOAD T3,IHLNK,(T2)	; Tack on the link field
	CAILE T3,LLINK		; Normal link?
	 JRST IMIPSQ		; No, dispatch to special q
	OKSKED
	ILOCK
	MOVE T2,T3
	CALL LNKLUK		; See if connection exists
	 JRST [	TRNE T3,377	; Doesn't, control link?
		 JRST IMIBB	; Link non-existant
		HRLI 3,^D8	; Create connection, byte size is 8
		CALL IMPOP1
		HRROS IMPLT1(1)	; Make unit -1
		MOVEI 3,377777
		HRRM 3,IMPLT4(1) ; Set infinite msg alloc
		AOS IMPNCL	; Count control connections
		JRST .+1]
	POP P,2
	MOVE 3,IMPLT2(1)
	HRLM 2,0(3)		; Put msg on queue for conn
	HRRM 2,IMPLT2(1)
	HLRE IMPUN,IMPLT1(1)
	IUNLK
	JUMPL IMPUN,R		; See if nvt connection
	LDB 2,PNVT
	CAIL 2,NVTLO
	CAILE 2,NVTHI
	RET			; Isn't
	PUSH P,T1		; SAVE LT INDEX
	IMSCLK(IMCNVI)		; ACCOUNT THE TIME FOR NVT INPUT
	POP P,T1		; RESTORE LT INDEX
	CALL NVTUPI		; Unpack nvt input
	RET

IMIPSQ:	MOVSI 3,-NSQ
IMIPS1:	SKIPGE 1,SQJOB(3)	; IN USE?
	 JRST IMIPQA		; NO
	LSH 1,-^D14		; ALIGN VALUE WITH INTERNET DISPATCH
	XOR 1,.NBDW0+1(2)	; COMPARE
	LSH 1,^D22		; ALIGN WITH MASK
	AND 1,SQJOB(3)		; MASK BITS TO COMPARE
	TLNE 1,177400		; ONLY CONSIDER THESE BITS
	 JRST IMIPQA		; NO MATCH
	MOVE T1,.NBLD0(T2)	; Check the leader against the queue
	XOR T1,SQVAL1(T3)	; These bits should become zero
	TDNE T1,SQMSK1(T3)	; In positions where this mask is 1
	JRST IMIPQA		; If not, this isn't for this queue.
	MOVE T1,.NBLD1(T2)	; Check all three words of leader
	XOR T1,SQVAL2(T3)
	TDNE T1,SQMSK2(T3)	; ..
	JRST IMIPQA		; Not right.
	MOVE T1,.NBLD2(T2)	; Last word
	XOR T1,SQVAL3(T3)
	TDNE T1,SQMSK3(T3)
IMIPQA:	AOBJN T3,IMIPS1		; Not for this Q, try another
	JUMPGE T3,IMIPS2	; Found nobody, go throw away
	MOVE 1,SIQSPC(3)	; How much space in use?
	CAIL 1,SIQMAX		; Less than max?
	 JRST IMIPS2		; No, too much, go throw away
	MOVE 1,TODCLK
	ADDI 1,SIQTM0
	SKIPN SIQIBO(3)		; First one (queue empty?)
	 MOVEM 1,SIQTIM(3)	; Record time of arrival
	AOS SIQSPC(3)		; Count messages on queue
	HRLM 2,@SIQIBI(3)
	HRRZM 2,SIQIBI(3)
	SKIPGE 7,SIQFKX(3)	; ANYBODY WAITING FOR THIS MESSAGE?
	 JRST IMIPS4		; NO
	SETOM SIQFKX(3)		; RESET WAITING FORKX
	CALL PRWAKE##		; CALL ROUTINE IN SCHED TO POKE HIM
IMIPS4:	OKSKED
	JRST IMIPS3

IMIPS2:	OKSKED
	PUSHJ P,RLNTBF		; Throw message away
IMIPS3:	SUB P,BHC+1 
	RET

; Cause bad msg to be printed

IMIBB:	IUNLK
	MOVE T2,T3
	ANDI 2,377
	CALL IMPNXR		; Send nxr
	JRST IMIPB1

IMIPB:	IUNLK
IMIPB1:	HRLI 2,9
	BUG(IML,<Received msg for unknown link>,X)
IMIPB2:	POP P,2
	JRST RLNTBF

; Send RST to all named hosts on startup

NETCH0:	IMSCLK(IMCNCK)		; Charge to imcnck
	SKIPGE 7,IMPCCH		; Sending rst's?
	 JRST IMPET		; No.
IMPRC1:	CALL IMPRCC		; Check for space in link table
	 JRST [	MOVEI 1,^D100
		JRST IMPET1]
	MOVE T1,HOSTNN(Q3)	;GET HOST NUMBER
	JUMPA T1,IMPRC2		;NONE
	CAMN T1,NLHOST		;DONT RESET YOURSELF
	 JRST IMPRC2
	SKIPL HSTSTS(Q3)	;ALREADY UP
	CALL IMSRST
IMPRC2:	CAIGE 7,NHOSTS-1
	AOJA 7,IMPRC1
IMPEET:	MOVSI 7,-IMPNLK
	MOVE 1,[UPROBI-UPROBT]
	JRST IMPET1

IMPRCC:	MOVE 1,IMPNOL		; Number of links in use
	CAIG 1,IMPNLK/4-10
	 AOS 0(P)
	RET

; Echo tester

IMPET:	MOVEI 1,^D120000
	SKIPL IMPRDY
	 JRST IMPCC6		; Don't probe if ncp not fully up
	PUSHJ P,IMPRCC		; Check space in link table
	 JRST [	MOVEI 1,^D5000	; Try again in 5 seconds
		JRST IMPCC6]
IMPET3:	MOVE 1,IMPLT1(7)
	TRNE 1,LT1FRE		; Active?
	 JRST IMPET4		; No, get next
	LOAD T1,LTHOST,(7)	; Get host
	CALL IMPNOP		; And send nop (echo might be better)
IMPET4:	AOBJP 7,IMPEET
IMPET0:	TRNE 7,7		; Wait every eighth entry
	 JRST IMPET
	MOVEI 1,UPROBT*8/IMPNLK	; Delay for correct interval
IMPET1:	MOVEM 7,IMPCCH		; Save current state
IMPCC6:	ADD 1,TODCLK		; Compute when to do it again
	MOVEM 1,IMPTIM
	RET

; Check for overdue rfnm's
; Count down rfnmc field if non-zero.
; If it reaches 0, then generate impbug cause rfnm seems lost
RFNCHK:	IMSCLK(IMCRFN)		; Charge imcrfn
	MOVSI 10,-IMPNLK	; Set to scan conn table
RFNCK0:	MOVSI 6,(RFNMC)
	MOVEI 5,LT1FRE
RFNCK2:	TDNN 5,IMPLT1(10)	; Connection in use?
	TDNN 6,IMPLT2(10)	; Rfnm set here?
RFNCK1:	AOBJN 10,RFNCK2		; No
	JUMPGE 10,RFNCK4
	LDB 7,[POINT 2,IMPLT2(10),1]
	SOJE 7,RFNCK5		; Decrement count, jump if exhausted
	DPB 7,[POINT 2,IMPLT2(10),1]
	JRST RFNCK1

RFNCK5:	PIOFF			; Prevent confusion if pi stores buffer
	HRRZ 2,IMPLT3(10)	; While we get message to retransmit
	HLLZS IMPLT3(10)	; And clear the pointer
	PION
	JUMPE 2,RFNCK3		; Apparently hasn't made it thru q yet
	LOAD T3,LTHOST,(10)
	MOVSI 5,(RXMTF)
	CAME 3,NLHOST		; If local host
	TDNE 5,IMPLT2(10)	; Or retransmission wanted?
	 JRST RFNCK7		; Then retransmit
	CALL RLNTBF		; Else release the buffer
	DPB 7,[POINT 2,IMPLT2(10),1]
	HRRZ 2,IMPLT1(10)	; Yes, rfnm lost. get host-link
	CALL IMP8X1		; Reformat for bug msg
	BUG(IMH,<RFNM OVERDUE>,X)
	AOS IMPNOS		; Cause output scan to restart output
RFNCK6:	AOBJN 10,RFNCK0		; Reset ac5 and 6
RFNCK4:	MOVEI 1,RFNTMO
	ADD 1,TODCLK		; Set next check for rfntmo msec.
	MOVEM 1,RFNTIM
	RET

RFNCK7:	IORM 6,IMPLT2(10)	; Set rfnmc again
	CALL IMPQOA		; Put message back on output queue
	JRST RFNCK6		; Go to next item

RFNCK3:	IORM 6,IMPLT2(10)	; Set rfnmc again
	HRRZ 2,IMPLT1(10)	; Get host/link
	CALL IMP8X1		; Format for bug msg
	BUG(IMH,<MESSAGE STUCK IN OUTPUT QUEUE>,X)
	JRST RFNCK6		; Go on to next item

; Here at PI level to queue an irreg Impt-to-Host message.
;  The input buffer address is in T1

IMP8XQ:	AOS T3,IMP8XI		; Increment input index
	CAIL T3,IMP8XS
	SETZB T3,IMP8XI		; Wraparound
	CAMN T3,IMP8XO		; Overflow?
	BUG(NTE,<IRREG MSG BUFFER OVERFLOW>)
	MOVEI T2,.NBLD0(T1)	; Where the leader is
	IMULI T3,.NBLD2		; Number to stash
	HRLI T3,-.NBLD2
I8XQL1:	MOVE T4,0(T2)		; Read a word
	MOVEM T4,IMP8XB(T3)
	ADDI T2,1		; To next source word
	AOBJN T3,I8XQL1		; Do the whole leader
	AOS IMP8XC
	RET

IMP8XM:	IMSCLK(IMC8XM)		; Charge to imc8xm
	AOS T3,IMP8XO		; Retrieve stuff from queue
	CAIL T3,IMP8XS
	 SETZB T3,IMP8XO	; Wraparound
	IMULI T3,.NBLD2		; Size of block
	MOVEI T1,IMP8XB(T3)	; Point to leader for debug routine
;;;;	CALL DBGIIM		; Copy to buffer
	SOS IMP8XC
	MOVEI P1,IMP8XB-1(T3)	; Point right for defstrs
	LOAD T1,IHADR,(P1)	; Get address
	IOR T1,NETFLD		; Net number
	LOAD T2,IHLNK,(P1)	; Get the link number
	LOAD T4,IHSTY,(P1)	; Get the subtype, while we're here.
	LOAD T3,IHMTY,(P1)	; Prepare to dispatch on msg type
	CAIL T3,NIMPMT		; Make sure it's not garbage
	JRST IMP8XX		; If so, give error
	XCT IMPMTT(T3)		; Dispatch to appropriate routine
	RET

XX==JRST IMP8XX			; Unimplemented code

IMPMTT:	BUG(HLT,<IMP - REGULAR MESSAGE ON IRREG QUEUE>)
	JRST IMPEC1		; Error in leader
	JRST IMPEC2		; Imp going down
	XX			; Formerly blocked link
	JRST IMPEC4		; NOP. Check host address.
	JRST IMRFNM		; Rfnm
	JRST IMPEC6		; Dead host status
	JRST IMPEC7		; Destination dead
	JRST IMPEC8		; Error
	JRST IMPEC9		; Incomplete transmission
	JRST IMPE10		; Imp dropped ready line
;	XX			; Cease timeout
;	XX			; Cease sent
;	XX			; Unassigned
;	XX			; "
NIMPMT==.-IMPMTT		; Size of this table

; Irregular message processors

; Error in leader (type 1)

IMPEC1:	TLZ T1,777700
	JUMPE T1,R		;DISCARD IF HOST 0. (JUNK)
	JUMPE T4,IMPEC8		;IF SUBTYPE 0, RETRANSMIT.
	JRST BADIRM		; Go cause it to be printed

; Imp going down (type 2)

IMPEC2:	MOVE T2,.NBLD1(P1)	;BUILD 16 BITS OF DATA
	MOVE T3,.NBLD2(P1)	; ..
	LSHC T2,^D12		;THIS DESCRIBES THE OUTAGE
	ANDX T2,<177777B31>	;FORMATTED AS IN SHORT LEADERS
	MOVEM T2,IMPGDM		; Save it for printing
	AOS JB0FLG		; Have job zero worry about it
	MOVEM T2,IGDMSG
	GTAD
	MOVEM T1,IGDTIM
	RET

; Nop from imp. Contains my net address. Check to make sure I agree.

IMPEC4:	CAME T1,NLHOST		; Does it match?
	BUG(CHK,<LHOSTN DISAGREES WITH THE IMP>)
	MOVEM T1,NLHOST		; Imp knows best
	RET			; Done with the NOP

; Rfnm (type 5)

IMRFNM:	TRO T2,LT1SND		; Host and link, denote send connection
	ILOCK
	CALL LNKLUK		; Lookup in link table
	 JSP 16,BADIRY		; Not found
	PUSH P,1
	MOVSI 2,(RFNMC)
	PIOFF			;  if rfnm returns before msg out done
	ANDCAM 2,IMPLT2(1)	; Clear rfnm and check flags
	HRRZ 2,IMPLT3(1)	; Get retransmit buffer
	HLLZS IMPLT3(1)
	PION
	SKIPE 2
	 CALL RLNTBF
	POP P,1
	HLRE IMPUN,IMPLT1(1)	; Get impun
	MOVSI 2,(RXMTF)
	TDNN 2,IMPLT2(1)	; Have we been retransmitting?
	 JRST IMPKO1		; No. just send next message
	ANDCAM 2,IMPLT2(1)	; Yes. stop retransmitting
	CALL IMPKO1		; Send next message
	JUMPGE IMPUN,SVCRST	; If not ctrl generate service restored
	RET

; Dead host status (type 6)

IMPEC6:	LOAD T3,IHHT2,(P1)	; See if the one we have to ignore,
	TXNE T3,<<HTY%HP>_-4>	; According to 1822
	 RET			; Yes. ignore it
	CALL HSTHSH		; Get table index for host number
	 JUMPL T2,IMPC61	; No room, if jump. Else, new.
	MOVEM T1,HOSTNN(T2)	; In case new, store number.
	MOVE T3,.NBLD1(P1)	; Collect reason and times
	MOVE T4,.NBLD2(P1)
	LSHC T4,-^D<36-8>
	ANDI T4,177777		; Keep 16 bits
	IORI T4,200000		; Mark info valid and dead
	SKIPGE HSTSTS(T2)	; Preserve "up" bit
	IORI T4,400000		; ..
	HRLM T4,HSTSTS(T2)	; No, store in lh
	ANDI T4,17		; Extract sub-type
	CAIE T4,2		; Is it simply tardy?
	CAIN T4,^D10		; Or at a bpt
IMPC61:	 RET			; Yes, no further action
	JRST HSTDED		; And declare it dead

; Destination dead (type 7)

IMPEC7:	TLZ T1,777700
	JUMPE T1,R		; Avoid entering host #0 into hash table
	PUSH P,T1		; Save host
	PUSH P,T2		; And link
	CALL HSTHSH		; Find host in hash table
	 JUMPL T2,IMPC71	; Jump if no room, else new.
	MOVEM T1,HOSTNN(T2)	; In case new, save number.
	SKIPL HSTSTS(T2)	; Is it up?
	 JRST [POP P,T2		; No. restore stack
		POP P,T1
		JRST HSTDED]	; and declare it dead
IMPC71:	POP P,T2		; Restore link
	POP P,T1		; And host
	TXO T2,L1%SND		; Send connection
	ILOCK
	CALL LNKLUK		; Find the link
	 JSP 16,BADIRY
IMPECC:	MOVSI 2,(RXMTF)
	IORM 2,IMPLT2(1)	; Cause retransmission
	HLRE IMPUN,IMPLT1(1)	; Get "unit"
	IUNLK
	JUMPL IMPUN,R		; Done if control connection
	CALL SVCINT		; Else perform service interruption
	RET

HSTDED::CALL HSTHSH		; Find the host in tables
	 JUMPL T2,HSTDD1	; If no room, jump around
	MOVEM T1,HOSTNN(T2)	; Update in case new host
	MOVX IMPUN,<1B0>	; Mark it down
	ANDCAM IMPUN,HSTSTS(T2)	; ..
HSTDD1:	CALL IMPXLT		; Clear link table for dead host
	CALL NETHDN		; Clean up any connections to host
	RET

; Error in data & incomplete transmission (types 8 & 9)

IMPEC8:
IMPEC9:	TXO T2,L1%SND		; This is a send connection
	ILOCK
	CALL LNKLUK		; Get lt index for this one
	 JSP 16,BADIRY		; Not there, can't retransmit
	PIOFF			; Prevent pi from storing in implt3
	HRRZ 2,IMPLT3(1)	; Get buffer for retransmission
	HLLZS IMPLT3(1)
	PION
	JUMPE 2,IMPECC		; None there now. retransmit later
	IUNLK
	CALL IMPQOA		; Put it back on output queue
	RET

; Interface reset (type 10)

IMPE10:	MOVSI 1,-IMPNLK
IMPRSY:	PUSH P,1
	ILOCK
	MOVE 2,IMPLT1(1)
	TRNE 2,LT1FRE		; In use?
	 JRST IMPZSY		; No
	TRNN 2,377
	 JRST IMPZSY		; Control
	TRNE 2,LT1SND		; Send?
	 JRST IMPSSY		; Yes
	LDB 2,LTLINK
	LOAD T1,LTHOST,(T1)
	IUNLK
	CALL IMPRAP
	JRST IMPXSY

IMPSSY:	CALL IMPSYN
IMPZSY:	IUNLK
IMPXSY:	POP P,1
	AOBJN 1,IMPRSY
; Now, for hosts who don't understand the H-H protocol extensions for
; connection reliability,  have to mark them dead.
	MOVNI T4,NHOSTS		; Scan the hash table
	HRLZS T4
IMPOSY:	SKIPN T1,HOSTNN(T4)	; Get a host number
	JRST IMPOSZ		; Slot not in use
	CALL CHKNWP		; DOES THIS HOST UNDERSTAND?
	 JRST [	SKIPGE HSTSTS(T4) ;No. IFF we think it's up,
		CALL HSTDED	; Mark it down.
		JRST .+1]
IMPOSZ:	AOBJN T4,IMPOSY
	AOS IMPNOS		; Scan for output to pick up rarrf's
	RET

; Check if host for control message knows about new protocol stuff

CHKNWP:	SAVET			; Be transparent
	CALL HSTHSH		; See if the host is known
	 RET
	MOVE T2,HSTSTS(T2)	; Get status
	TRNN T2,NEWNCP		; Does it know the new stuff?
	 RET
	JRST RSKP		; Yes. skip return

; MARK NEW PROTOCOL BIT FOR HOST

MRKNWP:	SAVET			; Be transparent
	CALL HSTHSH		; See if host is known
	 JUMPL T2,R		; If full, can't mark it
	MOVEM T1,HOSTNN(T2)	; In case newly known
	MOVEI T3,NEWNCP		; Set the new protocol bit
	IORM T3,HSTSTS(T2)	; For this host
	RET

; Error tail ends for irregular msg processors

BADIRY:	IUNLK
BADIRM:
IMP8XX:	MOVE 2,IMP8XO
	ADD 2,[4,,IMP8XB-1]	; Make pointer to one before message
	BUG(IML,<Received irreg msg with unknown link or type>,X)
	RET

IMP8X1:	DPB 2,[POINT 8,2,9]	; Unpack host-link in b20-35 into
	LSH 2,-^D8		; Xwd link,host
	TRZ 2,777400
	RET


; Scan for input ready on control link connection

IMPCN0:	IMSCLK(IMCCNP)		; Charge to imccnp
	MOVEI 5,LT1SND+LT1FRE+377	; Connection must be receive, link 0
	PUSH P,BHC		; Put a zero on stack
	MOVSI 6,-IMPNLK
IMPCN4:	TDNE 5,IMPLT1(6)	; Desired connection?
	AOBJN 6,.-1		; No
	JUMPGE 6,IMPCN5		; Done
	AOS 0(P)		; Count number of msgs seen
	MOVEI 1,0(6)		; Conn index
	PUSH P,5		; Save these ac's
	PUSH P,6
	CALL IMPCNP		; Go process this host's control msgs
	POP P,6			; Restore ac's
	POP P,5
	MOVEI 1,0(6)
	CALL IMPCLL		; Close "connection"
	JRST IMPCN4
IMPCN5:	POP P,1			; Done. get count of processed msgs
	JUMPN 1,R		; If any, done.
	BUG(IMP,<IMPNCL TOO HIGH>,X)
	SOS IMPNCL		; Count it down so don't loop.
	RET

; Process control message

IMPCNP:	PUSH P,T1		; Save LT index
	LOAD T1,LTHOST,(T1)		; Get host
	MOVEM T1,IMPCHO		; And leave it for following commands
	SETZM IMPCHU		; Say host not ready (no rst/rrp)
	CALL HSTHSH		; See if host is known
	 JUMPL T2,IMPCN1	; No. If table full, jump
	MOVEM T1,HOSTNN(T2)	; In case new, set number
	SKIPGE HSTSTS(T2)	; If known up, say it's up.
	 SETOM IMPCHU		; Then say it's up
IMPCN1:	POP P,T1		; Restore LT index
IMP8T6:	CALL UPBYT		; Get next op code
	 RET			; None left...done
	CAIL 3,I8NCCM		; Legal code?
	JRST IMP8T4		; No, flush whole message
	MOVEI 6,I8CCM(3)	; Address of table entry for this code
	HRLI 6,220300		; Pntr for 3-bit bytes specifying fields
	HLRZ 7,I8CCM(3)		; Get routine dispatch address
	MOVEI 4,I8CAL		; Args buffer
IMP8T1:	ILDB 5,6		; Number of (8-bit) bytes in next arg
	SETZ 2,			; Clear word to construct arg
	JUMPN 5,IMP8T2		; 0 means no more args
	CAIN 7,IM8NOP		; Check for NOP's at this level
	 JRST IMP8T6
	CAIE 7,IM8RST		; Is rst?
	CAIN 7,IM8RRP		; Or rrp?
	 SETOM IMPCHU		; Yes, consider him up
	SKIPN IMPCHU		; Is he up?
	 MOVEI 7,IMSRST		; No. force call to send rst
	PUSH P,1		; Preserve ac1
	MOVE 6,[XWD IMPCHO,1]	; Move args to acs 1-6
	BLT 6,6			; Ac1 (impcho) always gets host number
	CALL 0(7)		; Do function
	POP P,1			; Restore 1 (lt index)
	JRST IMP8T6		; See if another

IMP8T2:	PUSH P,2		; Preserve ac2
	CALL UPBYT		; Get a byte of argument
	 JRST IMP8T5		; Whoops, short message
	POP P,2
	ROT 3,-8		; And shift it
	LSHC 2,8		; Into the arg being accumulated
	SOJG 5,IMP8T2		; All bytes packed?
	MOVEM 2,0(4)		; Yes, store arg in buffer
	AOJA 4,IMP8T1		; And see if more args

IMP8T5:	SUB P,BHC+1
IMP8T4:	MOVE 2,IMPCHO		; Screwed up control msg
	BUG(IMH,<ILL FMT CTL MSG>,X)
	RET			; Let impcll flush rest of message(s)

; Control routines

; Nop (type 0)

IM8NOP:	RET

; Receiver to sender request for connection (type 1)

IM8RTS=RECRTS		; Code in  netwrk

; Sender to receiver request for connection (type 2)

IM8STR=RECSTR		; Code in netwrk

; Close connection (type 3)

IM8CLS=RECCLS		; Code in netwrk

; Allocate (type 4)

IM8ALL:	TRO T2,LT1SND	; Bit for send connection
	ILOCK
	CALL LNKLUK		; Lookup in connect table
	 JSP 16,BADLKS		; Not found
	HLRE IMPUN,IMPLT1(1)	; Get unit
	JUMPL IMPUN,ULKIDV	; Control connection, shouldn't happen
	MOVSI 2,(RARF)		; Waiting for rar?
	TDNE 2,IMPLT2(1)
	 JRST ULKIDV		; Yes, ignore all allocates
	HRRZ 2,IMPLT4(1)	; Get current msg alloc
	ADD 2,3
	CAILE 2,777777		; Bigger than max?
	JRST IMPB06		; Yes
	HRRM 2,IMPLT4(1)
	ADDB 4,NETBAL(IMPUN)	; Update bit allocation
	CAML 4,[1B3]		; Excessive?
	JRST IMPB06
	LDB 2,PNVT
	CAIL 2,NVTLO		; Nvt attached?
	CAILE 2,NVTHI
	JRST IMPKO1		; No, test more output for reg. connet'n
	IUNLK
	CALL NETTCS		; Yes, pack up more characters
	JRST IMPCKO		; And try to send

; Give back (code 5)

IM8GVB:	TRO T2,LT1SND	; Construct host-link for send socket
	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKS		; Not found
	HLRE IMPUN,IMPLT1(1)	; Get unit
	JUMPL IMPUN,ULKIDV	; Control conn, shouldn't happen
	HRRZ 2,IMPLT4(1)	; Msg alloc
	CAIL 3,200		; All?
	JRST .+3		; Yes
	IMUL 2,3		; No, calc how much
	IDIVI 2,200
	HRRZ 3,IMPLT4(1)
	SUB 3,2			; Reduce current msg alloc
	HRRM 3,IMPLT4(1)
	PUSH P,2
	MOVE 2,NETBAL(IMPUN)	; Bit allocation
	CAIL 4,200		; Return all?
	JRST .+3		; Yes
	MUL 2,4			; No, calc how much
	DIVI 2,200
	MOVN 3,2
	ADDM 3,NETBAL(IMPUN)	; Reduce bit alloc
	MOVE 4,2		; Setup call for ret
	POP P,3
	LDB 2,LTLINK
	LOAD T1,LTHOST,(T1)
	IUNLK
	CALL IMPRET		; Send the ret
	RET

; Return (code 6)

IM8RET:	RET			; Never send gvb/ nver get ret

; Interrupt from receiver (code 7)

IM8INR:	TRO T2,LT1SND	; We must be a send connection
	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKS		; No such connection
	HLRE IMPUN,IMPLT1(1)	; Unit
	LOAD T1,LTHOST,(T1)
	IUNLK
	JUMPL IMPUN,R		; Control connection, shouldn't happen
	JRST RECINR		; Not specified for nvt

; Interrupt from sender (code 8)

IM8INS:	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKR
	HLRE IMPUN,IMPLT1(1)
	LOAD T1,LTHOST,(T1)
	IUNLK
	JUMPL IMPUN,R
	LDB 3,PNVT		; Get nvt number
	CAIL 3,NVTLO
	CAILE 3,NVTHI
	JRST RECINS		; Isn't nvt, go do regular connection
	MOVE 2,3
	LDB 1,PTINTC
	SUBI 1,1		; Ins counts -1, sync char counts 1
	DPB 1,PTINTC
	LDB IMPUN,PTNETI
	SKIPN NETBAL(IMPUN)
	 CALL NVTRAL		; Send more allocation
	RET


; Echo and echo reply (code 9 & 10)

IM8ECO:	CALL IMPERP		; Send reply
	RET

IM8ERP:	CAME 1,2		; We send echo with data = host
	JFCL			; Not equal ... oh well
	RET

; Error (code 11)

IM8ERR:	MOVSI 2,0(2)		; Arg
	HRRI 2,0(1)		; Host
	BUG(IMH,<RECD NCP ERR>,X)
	RET

; Reset and reset-reply ctrl msg (codes 12 & 13)

IM8RST:	PUSH P,1
	CALL RECRST		; Notify fsm
	POP P,1
IM8RRP:	CALL HSTHSH		; See if we have a slot for it
	 JUMPL T2,R		; If not, very strange.
	MOVEM T1,HOSTNN(T2)	; Also shouldn't need to create..
	MOVX IMPUN,<1B0+1B1>
	HLLM IMPUN,HSTSTS(T2)	; Mark host alive
	RET

; Reset allocate by receiver (code 14)

IM8RAR:	CALL MRKNWP		; MARK THIS HOST AS USING NEW PROTOCOL
IM8RR1:	TRO T2,LT1SND
	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKS
	HLRE IMPUN,IMPLT1(1)
	JUMPL IMPUN,ULKIDV
	MOVSI 2,(RARF)
	ANDCAM 2,IMPLT2(1)	; Clear resync in progress flag
	JRST ULKIDV

; Reset allocate by sender (code 15)
; Set allocation to zero plus whatever we have received but
;  not yet processed.

IM8RAS:	CALL MRKNWP		; MARK THIS HOST AS USING NEW PROTOCOL
	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKR
	HLRE IMPUN,IMPLT1(1)
	JUMPL IMPUN,ULKIDV
	HLLZS IMPLT4(1)		; Clear message allocation
	HLRZ 4,IMPLT4(1)	; ANY CURRENT BUFFER?
	JUMPE 4,IM8RA1		; NO
	MOVE 4,.NBCNT(4)	; ACCUMULATE BYTES
IM8RA1:	HLRZ 2,IMPLT3(1)	; GET BUFFER
	JUMPE 2,IM8RA3		; NONE
IM8RA2:	LOAD T3,HHCNT,(T2)	; Number of bytes, from H-H leader
	ADD 4,3
	AOS IMPLT4(1)		; COUNT MSGS RCVD ALREADY
	HLRZ 2,0(2)		; NEXT BUFFER
	JUMPN 2,IM8RA2
IM8RA3:	LDB 3,IMPLBS		; BYTE SIZE
	IMUL 3,4
	MOVEM 3,NETBAL(IMPUN)	; Bits we have rcvd already
	IUNLK
	LDB 2,LTLINK
	LOAD T1,LTHOST,(T1)
	CALL IMPRAR
	LDB 2,PNVT
	CAIL 2,NVTLO
	CAILE 2,NVTHI
	 JRST NETRAL
	JRST NVTRAL

; Reset allocate please (code 16)

IM8RAP:	CALL MRKNWP		; MARK THIS HOST AS USING NEW PROTOCOL
	TRO T2,LT1SND
	ILOCK
	CALL LNKLUK
	 JSP 16,BADLKS
	HLRE IMPUN,IMPLT1(1)
	JUMPL IMPUN,ULKIDV
	MOVSI 2,(RARF!RARRF)
	IORM 2,IMPLT2(1)
	JRST IMPKO1

; Non-existent link from receiver and sender (codes 17 & 18)

IM8NXR:	TRO 2,LT1SND
IM8NXS:	CALL MRKNWP		; MARK THIS HOST AS USING NEW PROTOCOL
	ILOCK
	CALL LNKLUK
	 JRST ULKIDV
	HLRE IMPUN,IMPLT1(1)	; Get impun
	JUMPL IMPUN,ULKIDV	; Ignore if control conn
	IUNLK
	CALL SK2DWN
	RET

; Link lookup failure for receivers and senders

BADLKR:	SKIPA 3,[IMPNXR]
BADLKS:	MOVEI 3,IMPNXS
	IUNLK
	PUSH P,16		; SAVE PC FOR INSPECTION
	ANDI 2,377
	PUSH P,1
	HRLM 2,0(P)
	CALL 0(3)
	POP P,2
	BUG(IMH,<RECD CTL MSG FOR UNKNOWN LINK>,X)
	SUB P,BHC+1		; FLUSH SAVED PC
	RET

; Control table for control opcodes

	DEFINE CTOP (A,C)
<	XWD IM8'A,C>

I8CCM:	CTOP NOP,0
	CTOP RTS,441000
	CTOP STR,441000
	CTOP CLS,440000
	CTOP ALL,124000

	CTOP GVB,111000
	CTOP RET,124000
	CTOP INR,100000
	CTOP INS,100000
	CTOP ECO,100000

	CTOP ERP,100000
	CTOP ERR,144200
	CTOP RST,0
	CTOP RRP,0
	CTOP RAR,100000
	CTOP RAS,100000
	CTOP RAP,100000
	CTOP NXR,100000
	CTOP NXS,100000
I8NCCM==.-I8CCM

; Calls from ncp

; Open link, i.e. associate host-link and unit
; 1/ host
; 2/ link
; 3/ byte size

IMPOPS:	TRO 2,LT1SND
IMPOPL:	ILOCK
	CALL LNKLUK		; Now in table?
	 JRST IMPOP0		; No, slot to use returned in 2
	IUNLK
	BUG(IMP,<IMPOPL: Link already exists>,X)
	RET

IMPOP0:	CALL IMPOP1
	IUNLK
	RET

IMPOP1:	MOVEM T1,IMPLT5(T2)
	CALL CVOHST##
	DPB T1,[POINT 8,IMPLT1(T2),27]
	MOVE T1,T2
	HRRZM T3,IMPLT1(1)
	HRLM IMPUN,IMPLT1(1)
	MOVEI 2,IMPLT3(1)	; Init bfr queue
	MOVEM 2,IMPLT2(1)	; Make in point to out
	SETZM IMPLT3(1)
	SETZM IMPLT4(1)
	HLRZS T3
	DPB 3,IMPLBS		; Set byte size
	RET

; Close link, inverse of above
; 1/	LT INDEX

IMPCLL:	ILOCK
	CALL IMPLL0
	IUNLK
	RET

IMPLL0:	MOVEI 2,LT1FRE
	TDNE 2,IMPLT1(1)	; Was in use?
	RET			; No, do nothing else
	EXCH 2,IMPLT1(1)	; Set entry to deleted
	TRNE 2,377		; Control link?
	 JRST IMPLL9		; No, skip this
	TRNE 2,LT1SND		; Send?
	 SOSA IMPNOL		; Yes, decrease count of send cl's
	  SOS IMPNCL		; Else decrease count of recv cl's
IMPLL9:	AOS LNKNDL		; Count deletes
	CALL IMPLL1		; Flush messages
	RET

; Set done flag for connection
; 1/ conn index

IMPSDB:	MOVSI 2,(LTDF)
	IORM 2,IMPLT2(1)
	AOS IMPNOS		; Make output be looked at
	RET

; Abort link (called by ncp if transmission aborted)

IMPABL:	ILOCK
	CALL IMPLL3		;CLEAR QUEUES, DON'T CLEAR RFNMC
	IUNLK
	RET

; Clear link table for particular host, from HSTDED

IMPXLT:	PUSH P,1
	ILOCK
	MOVSI 1,-IMPNLK		; Set to scan conn table
IMPXLL:	LOAD T2,LTHOST,(T1)	; Get host
	CAME 2,0(P)		; Specified one?
	 JRST IMPXLN
	LDB 2,LTLINK		; Get link
	JUMPE 2,[CALL IMPLL0	; If control link, flush all
		JRST IMPXLN]
	CALL IMPLL1		; Else flush queued messages
IMPXLN:	AOBJN 1,IMPXLL
	IUNLK
	POP P,1
	RET

; Resync allocation, from interface reset msg

IMPSYN:	PUSH P,1
	LOAD T1,LTHOST,(T1)
	CALL CHKNWP		; NEW PROTOCOL?
	 JRST [	POP P,1		; No, can't do this
		RET]
	POP P,1
	MOVSI 2,(RARF!RARRF)
	IORM 2,IMPLT2(1)
	AOS IMPNOS
	RET

; Flush all messages for a connection

IMPLL3:	TDZA 2,2		;DON'T CLEAR RFNMC
IMPLL1:	MOVSI 2,(RFNMC)		;CLEAR RFNMC
	PUSH P,2		;A BIT LATER ON
	HLRZ 2,IMPLT4(1)
	HRRZS IMPLT4(1)
	PUSH P,1
	CAIE 2,0		; Is current bfr?
	PUSHJ P,RLNTBF
	MOVE 1,0(P)		; Get back lt index
	MOVEI 2,IMPLT3(1)
	HRRM 2,IMPLT2(1)	; Fix tail pointer
	PIOFF
	MOVE 2,-1(P)		;GET BITS TO CLEAR, EITHER 0 OR RFNMC
	ANDCAM 2,IMPLT2(1)	; Cancel outstanding rfnm
	HRRZ 2,IMPLT3(1)	; Get retransmit buffer
	HLLZS IMPLT3(1)
	PION
	SKIPE 2
IMPLL2:	CALL RLNTBF		; Yes, release it
	POP P,1
	HLRZ 2,IMPLT3(1)	; Release any buffers on queue
	JUMPE 2,[POP P,(P)
		POPJ P,0]
	HLLZ 3,0(2)
	HLLM 3,IMPLT3(1)
	PUSH P,1
	JRST IMPLL2

; Control message senders

; Nop, rts, str, cls, all, gvb, ret, inr, ins, eco, erp

IMPNOP:	PUSH P,[XWD 0,0]	; Nop, no args
	JRST IMPSCM

IMPRTS:	PUSH P,[XWD 441000,1]	; Arg descriptor,,opcode
	JRST IMPSCM		; Construct message and output

IMPSTR:	PUSH P,[XWD 441000,2]
	JRST IMPSCM

IMPCLS:	PUSH P,[XWD 440000,3]
	JRST IMPSCM

;Allocation to sender. Called from NCP with Msgs to
; allocate in T3, Bits to alloc in T4.

IMPALL:	CAIGE 3,0		; Don't send neg allocs
	SETZ 3,
	CAIGE 4,0
	SETZ 4,
	PUSH P,1
	LDB 1,PLIDX		; Get conn index
	PUSH P,2
	MOVSI 2,(RARF)		; Waiting for ras?
	TDNE 2,IMPLT2(1)
	 JRST [	POP P,2		; Yes. do nothing
		POP P,1
		RET]
	POP P,2			; No, get back ac2
	ADDM 3,IMPLT4(1)	; Update msg alloc
	POP P,1
	ADDM 4,NETBAL(IMPUN)	; Bits
	PUSH P,[XWD 124000,4]
	JRST IMPSCM

IMPGVB:	PUSH P,[XWD 111000,5]
	JRST IMPSCM

IMPRET:	PUSH P,[XWD 124000,6]
	JRST IMPSCM

IMPINR:	PUSH P,[XWD 100000,^D7]
	JRST IMPSCM

IMPINS:	PUSH P,[XWD 100000,^D8]
	JRST IMPSCM

IMPECO:	PUSH P,[XWD 100000,^D9]
	JRST IMPSCM

IMPERP:	PUSH P,[XWD 100000,^D10]
	JRST IMPSCM

; Control message senders (continued)

; Err, rst, rrp, rar, ras, rap, nxr, nxs

IMPERR:	PUSH P,[XWD 144200,^D11]
	JRST IMPSCM

IMSRST:	PUSH P,[XWD 0,^D12]
	JRST IMPSCM

IMPRRP:	PUSH P,[XWD 0,^D13]
	JRST IMPSCM

IMPRAR:	CALL CHKNWP
	 RET
	PUSH P,[100000,,^D14]
	JRST IMPSCM

IMPRAS:	CALL CHKNWP
	 JRST IM8RR1		; Resync not implemented -- sim rar
	PUSH P,[100000,,^D15]
	JRST IMPSCM

IMPRAP:	CALL CHKNWP
	 RET			; DOES NOT UNDERSTAND NEW PROTOCOL
	PUSH P,[100000,,^D16]
	JRST IMPSCM

IMPNXR:	CALL CHKNWP
	 RET
	PUSH P,[100000,,^D17]
	JRST IMPSCM

IMPNXS:	CALL CHKNWP
	 RET
	PUSH P,[100000,,^D18]
	JRST IMPSCM

; Send control message
; 1/ dest host
; 0(p) arg descriptor,,opcode

IMPSCM:	EXCH 13,0(P)
	PUSH P,6
	PUSH P,7
	PUSH P,10
	PUSH P,11
	PUSH P,12
	PUSH P,14
	MOVEI 10,0(P)		; Use 3 words on stack as buffer
	ADD P,BHC+3
	HRLI 10,1000		; Construct byte pointer, 8-bits
	PUSH P,10		; Save it for later use
	IDPB 13,10		; Store opcode as first byte of message
	MOVEI 11,1		; Init message byte count
	MOVEI 14,2		; Index to args in AC's 2-5
IMPSC4:	SETZ 12,
	LSHC 12,3		; Next arg descriptor byte
	JUMPN 12,IMPSC3		; 0 means done
	MOVEI T2,LT1SND		;LINK 0
	ILOCK
	CALL LNKLUK		; See if connection now exists
	 JRST [	HRLI 3,^D8	; Doesn't, create it
		CALL IMPOP1
		AOS IMPNOL	; Count open output links
		HRROS IMPLT1(1)	; Set unit neg
		MOVEI 3,377777	; Set infinite msg alloc
		HRRM 3,IMPLT4(1)
		MOVSI 3,(HIPFLG)
		IORM 3,IMPLT2(1)	; Set high priority flag
		JRST .+1]
	POP P,3			; Byte ptr
	MOVEI 4,0(11)		; Count
	CALL PKMSG0		; Does iunlk
	SUB P,BHC+3
	POP P,14
	POP P,12
	POP P,11
	POP P,10
	POP P,7
	POP P,6
	POP P,13
	RET

IMPSC3:	ADDI 11,0(12)		; Accumulate byte count of message
	MOVNI 6,0(12)		; Compute number of bits to left of arg
	IMULI 6,^D8		; Number bytes times bits per byte
	ADDI 6,^D36		; Subtracted from size of word
	MOVE 7,0(14)		; Get next arg
	LSH 7,0(6)		; Shift out unused bits
	ROT 7,^D8		; Shift next byte into place
	IDPB 7,10		; Store it in message buffer
	SOJG 12,.-2		; For all bytes
	AOJA 14,IMPSC4		; Index arg pointer

; Called by nvt from tci
AVTCAP:	PUSH P,IMPUN
	PUSH P,2
	NOINT			; Protect any possible ilocks
	CALL CKNNVT		; If not new nvt
	 JRST AVTCA1		; Skip sending ga
	CALL NVTXGA		; SEND GA IF NEEDED
AVTCA1:	LDB IMPUN,PTNETI
	SKIPN NETBAL(IMPUN)
	 CALL NVTRAL		; Probably only 1st time, or after cfibf
	OKINT
	POP P,2
	POP P,IMPUN
	RET

; Re-allocate if needed to bring allocation up to operating level
; Impun/socket table index (unit)

NTTRC3:				; Known to ncp by this tag
NVTRAL:	CALL LCKNCP		; Prevent ncp changes
	MOVSI 1,DEDF
	TLO 1,EOTF
	TDNE 1,NETSTS(IMPUN)
	 JRST ULKNCP		; Connection dead or done
	LDB 2,PNVT		; Pick up line number
	LDB 3,TTIMAX		; Capacity of line
	SUB 3,TTICT(2)		; Gives space now in line buffer
	JUMPE 3,[LDB 1,PTINTC	; If full, check for ins received
		TRNE 1,4	; Count is sync-ins, 3 bit field
		MOVEI 3,1	; Ins requested, allocate 1 byte
		JRST .+1]
	LSH 3,3			; Imuli 3,8 (byte size)
	SUB 3,NETBAL(IMPUN)	; Desired all less all now out
	MOVE 4,3
	LDB 1,PLIDX		; Get conn index
	HRRZ 3,IMPLT4(1)	; Current msg alloc
	MOVN 3,3
	ADDI 3,^D6		; Raise it to 6
	LDB 1,TTIMAX		; Max space in buffer
	ASH 1,-1		; One-half
	CAMGE 4,1		; Re-allocate if more than half a buffer
	CAIL 3,4		; Or if more than 3 msgs
	SKIPA
	 JRST ULKNCP
	LDB 1,PFHST
	LDB 2,PLINK
	CALL IMPALL
	JRST ULKNCP


; Lookup host-link
; ACCEPTS:  1/ HOST ADDRESS
;	    2/ B28-35, link; B18, direction (1=send)
;	    3/ Bytesize, which must be preserved, but isn't used here
;
;RETURNS	+1  Entry not found
;		 	T1/ Unchanged
;			T2/ Link table index of free item
;			T3/ Size,,Link+SND bit
;		+2  Entry found
;			T1/ Link table index
;			T3/ Unchanged

LNKLPT==P1
LNKLT2==P2
LNKLT3==P3
LNKLT4==P4

LNKLUK:	SAVEP
	MOVEM T2,LNKLT2		; Remember the link and Send bit
	MOVEM T3,LNKLT3		; Preserve this AC
	MOVSI T3,(1B1)		; Bit says no deleted entry found
LNKL6:	MOVEM T4,LNKLT4		; Save another AC
	TLZ T1,777700		; remove possible garbage
	IOR T1,NETFLD		; include network number
	MOVEM T1,LNKLPT		; Save argument
	HRRZ T1,LNKLPT		; Part of host number
	HLRZ T2,LNKLPT		; Other part
	ADD T2,LNKLT2		; Link and send bit
	XOR T1,T2		; Mix them together
	IMUL T1,[5654123]	; Compute hash from argument
	LSH T1,-^D9
	IDIVI T1,IMPNLK		; Remainder gives initial index
	MOVE T1,T2		; Copy the initial probe
	EXCH T1,LNKLPT		; Get host, save initial probe
	HRLI T2,-IMPNLK(T2)	; Setup ptr for remainder of table
LNKL2:	HRRZ T4,IMPLT1(T2)	; Get the link and Send/Free bits
	CAME T4,LNKLT2		; Match the calling arg?
	JRST LNKL7		; No
	LOAD T4,LTHOST,(T2)	; Get host in this table slot
	CAMN T4,T1		; Desired entry?
	JRST [	MOVEI T1,0(T2)	; Yes, get index in T1
		MOVE T3,LNKLT3	; And restore AC's
		MOVE T4,LNKLT4	; ..
		JRST RSKP]	; Return good
	HRRZ T4,IMPLT1(T2)	; Not right. Get back free/send bits
LNKL7:	TRNE T4,L1%FRE		; Special?  I.e. free or deleted?
	JRST [	TLNE T3,(1B2)	; Yes, called by rehash or PI level?
		JRST LNKL4	; Yes
		TXNE T4,L1%SND	; This a free entry?
		JRST LNKL3	; Yes, search done, not found
		TLZE T3,(1B1)	; This first deleted entry encountered?
		HRRI T3,0(T2)	; Yes, save its position
		JRST .+1]
LNKL5:	AOBJN T2,LNKL2		; Try more of table
	JUMPL T3,[TLNN T3,(1B1)	; Table full, was delete seen?
		JRST LNKL3	; Yes, use it
		JRST IMPB01]	; Return not found
	MOVN T2,LNKLPT		; Wraparound ptr, setup count
	MOVSI T2,0(T2)		; To look up to initial index
	TLO T3,(1B0)		; Remember wraparound
	JRST LNKL2		; Check top entry of table

LNKL3:	TLNN T3,(1B1)		; Not found. Delete encountered?
	MOVEI T2,0(T3)		; Yes, use that for new entry
LNKL1:	MOVE T4,LNKLT4		; Restore T4
	HRLZ T3,LNKLT3		; Put bytesize in LH of T3
	HRR T3,LNKLT2		; And caller's T2 in RH of T3
	RET			; Return "not found"

LNKL4:	TLNE T3,(1B3)		; PI level call?
	 JRST LNKL5		; Yes. Ignore deleted/free entries
	MOVX T4,L1%FRE		; No, rehash. Make deleted
	MOVEM T4,IMPLT1(T2)
	SETZM IMPLT5(T2)	; And discard old host
	JRST LNKL5		; Try another slot

; Special entry used only by rehash routine.
; It assumes item will be found, and it sets any 'free' entries
;  encountered to be 'deleted'.

IMPHFL:	SAVEP
	MOVEM T2,LNKLT2		; Remember the link and Send bit
	MOVEM T3,LNKLT3		; Save this AC
	MOVSI T3,(1B2)		; Controls action on special entries
	JRST LNKL6		; Go join scan

; Special entry from IMODN2 to find entry to store retransmit buffer
; Searches entire table for entry regardless of deletes and frees

IMPPIL:	SAVEP
	MOVEM T2,LNKLT2		; Remember the link and Send bit
	MOVEM T3,LNKLT3		; Save this AC
	MOVSI T3,(1B2+1B3)	; Flags that this is the PI entry
	JRST LNKL6		; Go join scan

; Routine to garbage collect hash table.
; Sets all deleted entries to free then calls lookup
; routine to mark all needed entries deleted to enable all entries
; to be found.
; Lookup routine will change any 'free' entries passed over during
; a search to 'deleted'.  Thus all 'deleted' entries not currently
; necessary will be flushed.

IMPGC:	IMSCLK(IMCGC)		; Charge time to IMCGC
	ILOCK
	SETZM LNKNDL		; Clear delete count
	MOVSI Q3,-IMPNLK	; Prepare to scan link table
	MOVX T1,L1%FRE		; Prepare these flags for quick scan
	MOVX T2,L1%FRE!L1%SND	; ..
IMPGC1:	TDNN T1,IMPLT1(Q3)	; Free or deleted?
	 JRST IMPGC0		; No, in use.
	MOVEM T2,IMPLT1(Q3)	; Yes, set it to free
	SETZM IMPLT5(Q3)	; Clear host field, too
IMPGC0:	AOBJN Q3,IMPGC1		; Set all deleted's to free
	MOVSI Q3,-IMPNLK	; Prepare to scan again
IMPGC2:	HRRZ T2,IMPLT1(Q3)	; For every entry
	LOAD T1,LTHOST,(Q3)	;  (two words of argument)
	TXNE T2,L1%FRE		; That is not
	 JRST IMPGC3		; Deleted or free
	CALL IMPHFL		; Marked necessary deleted entries
	 BUG(CHK,<IMPGC-IMPOSSIBLE FAILURE OF IMPHFL>)
IMPGC3:	AOBJN Q3,IMPGC2		; Finish second pass for all slots
	IUNLK
	RET

; Unpack byte from current msg for a connection
; 1/ connection index
; Returns byte in 3
; Called by, among others, the Control Msg processor to get each
; byte of a control message.

UPBYT:	ILOCK
	HLRZ 2,IMPLT4(1)	; Get current buffer
	JUMPN 2,UPBYT1
	CALL UPBGNB		; No buffer, try to get one
	 RET			; Failed, return noskip
UPBYT1:	ILDB 3,.NBPTR(2)	; Get byte, byte ptr in bfr header
	SOSG .NBCNT(2)		; Count down bytes in bfr
	CALL UPBRB		; Now empty, release bfr
	IUNLK
	AOS 0(P)
	RET

; Unpack message
; 1/	LT INDEX
; 3/	STORE BYTE POINTER
; 4/	MAX BYTE COUNT

UPMSG:	ILOCK
	PUSH P,3		; Save store pointer
	HLRZ 2,IMPLT4(1)	; Get current buffer
	JUMPN 2,.+3
	CALL UPBGNB		; None, try to get one
	 JRST UPMSG5		; Failed, return bad
	MOVE 3,.NBCNT(2)		; Get buffer count
	CAML 3,4
	 MOVE 3,4		; Use minimum count
	SUB 4,3			; Update count
	PUSH P,4		; Save updated count
	MOVN 4,3
	ADDM 4,.NBCNT(2)	; Update buffer count
	PUSH P,1		; Save lt index
	MOVE 1,.NBPTR(2)	; Get buffer pointer
	EXCH 2,-2(P)		; Save buffer location, get tgt
	MOVEI 4,0		; Transfer monitor to monitor
	PUSHJ P,BYTBLT		; Transfer the bytes
	EXCH 2,-2(P)		; Save updated tgt, get buffer loc
	MOVEM 1,.NBPTR(2)		; Store update buffer pointer
	POP P,1			; Restore lt index
UPMSG4:	POP P,4
	SKIPG .NBCNT(2)		; Imp bfr now exhausted?
	CALL UPBRB		; Yes, release it
UPMSG2:	AOS -1(P)
	IUNLK
UPMSG5:	POP P,3
	RET

; Try to get next input bfr

UPBGNB:	HLRZ 2,IMPLT3(1)	; Check queue of in bfrs
	JUMPE 2,UPBG1		; None
	PUSH P,4
	LOAD T3,NBQUE,(T2)	; Unqueue this buffer
	JUMPN 3,.+3
	MOVEI 4,IMPLT3(1)
	HRRM 4,IMPLT2(1)	; Make input buffer list empty
	HRLM 3,IMPLT3(1)	; Output buffer pointer
	HRLM 2,IMPLT4(1)	; Save current bfr adr
	PUSH P,.NBPTR(2)	; Save header in case of error
	PUSH P,.NBCNT(2)
	LOAD T4,NBBSZ,(T2)	; Number words in buffer
	CAIGE 4,.NBDW0		; At least overhead words present?
	JRST UPBGNE		; No, msg too short
	LOAD T3,HHCNT,(T2)	; Byte count for this buffer
	JUMPE 3,UPBGNE		; 0 is illegal, but in case...
	LOAD T4,HHSIZ,(T2)	; Get byte size
	MOVEM 3,.NBCNT(2)		; Leave byte count in full word
	LDB 3,IMPLBS		; Byte size for connection
	CAME 3,4		; Same?
	JRST UPBGNE		; No
	LSH 3,^D24		; Shift to s field of byte ptr
	HRRI 3,.NBDW0-1(2)
	MOVEM 3,.NBPTR(2)
	MOVEI 3,^D36		; Compute max bytes which could be
	IDIV 3,4		; As words*(bytes/wd)
	LOAD T4,NBBSZ,(T2)	; Number of words
	IMULI 3,1-.NBDW0(4)	; But not counting overhead
	CAMGE 3,.NBCNT(2)	; Actual greater than max?
	JRST UPBGNE		; Yes, lossage
	SUB P,BHC+2
	POP P,4
	AOS 0(P)
	RET

UPBGNE:	CALL UPBRB
	PUSH P,2
	MOVEI 2,-3(P)		; Pntr to 1 before saved hdr on stack
	HRLI 2,9
	BUG(IML,<Message has bad size or count>,X)
	POP P,2
	SUB P,BHC+2
	POP P,4
	JRST UPBGNB

UPBGNX:	SUB P,BHC+2
	POP P,4
	JRST UPBGNB

; No input ready, return activation test

UPBG1:	MOVSI 1,0(1)		; Connection index
	HRRI 1,UPBGT		; Wait for input or closed conn
	IUNLK
	RET

; Activation test

UPBGT:	MOVSI 3,777777
	MOVSI 2,(LTDF)		; Check done flag
	TDNN 2,IMPLT2(1)	; If set, or
	TDNE 3,IMPLT3(1)		; If bfr(s) appeared
	JRST 1(4)		; Wakeup
	JRST 0(4)

; Release input buffer

UPBRB:	HLRZ 2,IMPLT4(1)	; Get current buffer
	HRRZS IMPLT4(1)		; Clear field
	PUSH P,1
	CALL RLNTBF		; Release bfr back to pool
	POP P,1
	SOSL IMPLT4(1)		; Count msgs processed
	RET
	BUG(CHK,<UPBRB: Received excessive messages>)
	SETZM IMPLT4(1)
	RET

; Check connection for output possible
; Called on receipt of rfnm, allocation, etc.
; 1/ connection index
; Do output if rfnm clear, msg alloc non-0, and output exists

IMPCKO:	ILOCK (JRST IMPROS)	; If can't check now, set request flag
IMPKO1:	MOVSI 3,(RFNMC!ILCKB)
	TDNE 3,IMPLT2(1)	; Rfnm out or connection locked?
	JRST IMPKO2		; Yes, will try again later
	HLRZ 2,IMPLT3(1)
	JUMPN 2,[
		CALL IMPQO1	; If completed bfrs on output queue,
		JRST IMPKO1]	; Give one to imp to send
	HLRZ 2,IMPLT4(1)	; See if partial bfr exists
	JUMPN 2,[
		CALL PKQOB	; Complete it and send
		JRST IMPKO1]
	LDB 2,LTLINK		; Nothing to do here
	JUMPE 2,[CALL IMPLL0
		JRST IMPKO2]	; Flush conn if ctl link
	MOVSI 2,(RARRF)
	TDNN 2,IMPLT2(1)	; Ras requested?
	 JRST IMPKO4		; No
	PUSH P,1		; Yes
	ANDCAM 2,IMPLT2(1)
	HLRZ IMPUN,IMPLT1(1)
	SETZM NETBAL(IMPUN)	; Clear believed allocations
	HLLZS IMPLT4(1)		; Messages, too.
	IUNLK
	LDB 2,LTLINK
	LOAD T1,LTHOST,(T1)
	CALL IMPRAS		; Ask for more
	POP P,1
	JRST IMPKO3

IMPKO4:	IUNLK
IMPKO3:	HLRZ IMPUN,IMPLT1(1)	; Pick up pseudo-unit
	MOVSI 2,(LTDF)
	TDNN 2,IMPLT2(1)	; Done flag set?
	 RET			; No. done
	ANDCAM 2,IMPLT2(1)	; Only see it once
	PUSH P,6		; Preserve ac6
	CALL RCFRFN		; Yes, notify NCP, step FSM
	POP P,6
	RET

IMPKO2:	IUNLK			; Always returns with lock clear
	RET

IMPROS:	AOS IMPNOS
	RET

; Pack byte for output
; 1/	CONNECTION INDEX
; 3/	BYTE

PKBYT:	ILOCK
	HLRZ 2,IMPLT4(1)	; Is there a buffer to put char in?
	JUMPN 2,PKBY2
	CALL PKBY1		; No current buffer, get a new one
	 JRST PKBY5		; No buffers
PKBY2:	IDPB 3,.NBPTR(2)
	MOVSI 3,(ILCKB)
	ANDCAM 3,IMPLT2(1)	; Clear lock
	SOSG .NBCNT(2)		; Or if bfr now full
	CALL PKQOB		; Put bfr on output queue
	CALL IMPKO1		; Send if possible (does iunlk)
	AOS 0(P)
	RET

PKBY5:	IUNLK			; Here if no buffers available
	CALL IMPB03		; Complain and garbage collect
	JRST PKBYT

; Check maximum bytes that can be sent due to msg alloc restriction
; and partial msg already constructed.  Leave connection locked.

PKCHK:	ILOCK
PKCHK0:	PUSH P,3
	SETZ 2,			; Answer in T2
	MOVSI 3,(ILCKB)
	TDNE 3,IMPLT2(1)	; There should only be one fork trying
	 JRST PKCHK2		; at a time since files are interlocked
				; by fillck, nvt transmission is done by
				; Ncp fork and control links have no
				; flow control.
	IORM 3,IMPLT2(1)	; Lock connection so state can't change
	LDB 3,IMPLBS		; Get byte size
	HLRZ 2,IMPLT4(1)	; get current buffer
	JUMPE 2,PKCHK1		; If none, contribution is zero
	MOVE 2,.NBCNT(2)	; Get bytes left
	IMUL 2,3		; Times byte size is bits

PKCHK1:	PUSH P,3
	HRRZ 3,IMPLT4(1)	; GET MSG ALLOCATION
	JUMPG 3,[IMUL 3,MAXBPM	; TIMES BITS PER MESSAGE
		ADD 2,3		; ADD TO CURRENT BUFFER RESIDUE
		JRST .+1]	; AND CHECK AGAINST BIT ALLOCATION
	POP P,3			; NO MSG ALLOC., JUST RESTORE 3
	CAMLE 2,NETBAL(IMPUN)	; More than bit allocation
	 MOVE 2,NETBAL(IMPUN)	; Yes. limit is that
	IDIV 2,3		; Convert to bytes
PKCHK2:	POP P,3
	IUNLK
	RET

; Unlock connection

PKULCK:	MOVSI 2,(ILCKB)
	ANDCAM 2,IMPLT2(1)
	MOVE 2,IMPLT3(1)	; Any buffers to be sent
	IOR 2,IMPLT4(1)
	TLNE 2,-1
	 JRST IMPCKO		; Yes
	RET			; No

; Pack msg
; 1/ connection index
; 2/ byte ptr
; 4/ byte count

PKMSG:	ILOCK
PKMSG0:	CALL PKMSG2		; GET THE MESSAGE PACKED UP
	PUSH P,3
	CALL IMPKO1		; SEND IF POSSIBLE (DOES IUNLK)
	POP P,3
	RET

; SAME AS PKMSG, BUT DOESN'T ATTEMPT TO SEND THE MSG 
PKMSG1:	ILOCK
	CALL PKMSG2		; PACK IT UP
	IUNLK
	RET


; ROUTINE TO MOVE BYTES FROM SOURCE BUFFER TO NETWORK OUTPUT BUFFER
; 1/ CONNECTION INDEX
; 3/ SOURCE BYTE PTR
; 4/ BYTE COUNT
PKMSG2:	MOVSI 2,(ILCKB)		; LOCK CONNECTION
	IORM 2,IMPLT2(1)
	PUSH P,4		; SAVE BYTE COUNT
	HLRZ 2,IMPLT4(1)	; Get current bfr
	JUMPN 2,PKMS2
	PUSH P,4		; Wasn't one, get a new one
PKMS4:	CALL PKBY1
	 JRST PKMS5
	POP P,4
	CAMLE 4,.NBCNT(2)	; New buffer big enough?
	 JRST PKMSL		; Message too long
PKMS3:	PUSH P,1		; Save connection index
	MOVE 1,3		; Source pointer
	MOVE 3,4		; Count to 3
	MOVNS 4
	ADDM 4,.NBCNT(2)	; Update buffer count
	ADDM 4,-1(P)		; MAINTAIN RESIDUAL COUNT
	PUSH P,2		; Save buffer loc
	MOVE 2,.NBPTR(2)	; Target to 2
	MOVEI 4,0		; Mode is monitor to monitor
	PUSHJ P,BYTBLT		; Transfer bytes
	EXCH 2,0(P)		; Get buffer location, save updated ptr
	POP P,.NBPTR(2)		; Store updated pointer
	MOVEM 3,4		; Updated count
	EXCH 1,0(P)		; Save update source and get lt index
PKMSD:	MOVSI 3,(ILCKB)
	ANDCAM 3,IMPLT2(1)
	SKIPG .NBCNT(2)		; Bfr now full?
	CALL PKQOB		; Yes
	POP P,3
	POP P,4			; GET BACK RESIDUAL COUNT
	JUMPG 4,PKMSG2		; GO BACK IF ANYTHING LEFT
	SKIPE 4			; MAKE SURE WE HAVEN'T SCREWED UP
	BUG(HLT,<PKMSG: NEGATIVE RESIDUAL BYTE COUNT>)
	RET

PKMSL:	BUG(CHK,<PKMSG - MSG TOO LARGE>)
	MOVE 4,.NBCNT(2)
	JRST PKMS3

PKMS2:	CAMG 4,.NBCNT(2)	; Enough room in current bfr?
	JRST PKMS3		; Yes
	PUSH P,4
	HLRZ 4,IMPLT1(1)
	CAIN 4,-1		; CONTROL LINK?
	 JRST PKMS6		; YES, CONTROL MESSAGE CAN'T CROSS 
				; NET MESSAGE BOUNDARY
	SUB P,BHC+1		; USE REST OF CURRENT BUFFER
	MOVE 4,.NBCNT(2)	; GET RESIDUAL BYTE COUNT OF BUFFER
	JRST PKMS3		; GO DO IT
PKMS6:	PUSH P,3
	CALL PKQOB		; No, finish current bfr
	POP P,3
	JRST PKMS4		; Start a new one

PKMS5:	IUNLK
	SUB P,BHC+1
	POP P,4
	CALL IMPB03
	ILOCK
	JRST PKMSG2

; Assign and init a bfr for output use

PKBY1:	PUSH P,3
	HRRZ 3,IMPLT4(1)	; Get msg allocation
	JUMPG 3,PKBY4		; Ok
	BUG(CHK,<PKBY1: NO MSG ALLOCATION>)
	AOS IMPLT4(1)
PKBY4:	MOVEI 2,^D36		; Compute number of bits per output wd
	LDB 4,IMPLBS		; As (36/bs)*bs
	IDIVI 2,0(4)
	IMULI 2,0(4)
	MOVEI 4,0(2)
	MOVE 2,IMPLT1(1)	; Get proper size for output msg
	TRNE 2,377		; For link 0?
	SKIPA 2,MAXBPM		; No, usual regular max
	MOVEI 2,^D<120*8>	; For ctrl link, max is 120 bytes
	IDIVI 2,0(4)		; Wds = bits / (bits/wd)
	ADDI 2,.NBDW0		; Plus overhead
	PUSH P,1
	CALL ASNTBF		; Assign bfr
	JRST [	POP P,1
		POP P,3
		RET]
	MOVEI 2,0(1)
	POP P,1
	HRLM 2,IMPLT4(1)	; Set as current buffer
	SOS IMPLT4(1)		; Consume allocate
	MOVEI 3,^D36		; Compute number of bytes
	LDB 4,IMPLBS		; Which will fit in buffer.
	IDIVI 3,0(4)		; I.e. words*(36/bytesize)
	LOAD T4,NBBSZ,(T2)	; Number of words in bfr
	IMULI 3,-.NBDW0(4)	; Less header overhead
	MOVEM 3,.NBCNT(2)	; Setup counter
	HRLM 3,0(2)		; Remember original count
	LDB 3,IMPLBS		; Byte size
	LSH 3,^D24		; Construct byte ptr
	HRRI 3,.NBDW0-1(2)
	MOVEM 3,.NBPTR(2)
	POP P,3
	AOS 0(P)
	RET

; Put output buffer on queue

PKQOB:	HLRZ 2,IMPLT4(1)	; Get current buffer
	HRRZS IMPLT4(1)		; Clear ptr
	HRRZ 4,.NBPTR(2)	; ADDRESS OF LAST WORD CONTAINING DATA
	SUBI 4,-1(2)		; LESS ADDRESS-1 OF BUFFER
	STOR T4,NBBSZ,(T2)	; GIVES ACTUAL WORDS IN USE
	HLRZ 3,0(2)		; Get original byte count
	SUB 3,.NBCNT(2)		; Minus current count gives bytes in bfr
	SETZM .NBHHL(T2)	; Caution! Same word as .NBCNT!!!
	STOR T3,HHCNT,(T2)	; Store for foreign host
	LDB 3,IMPLBS		; Byte size
	STOR T3,HHSIZ,(T2)	; Put in header
	SETZM .NBLD0(T2)	; Clear imp header
	SETZM .NBLD1(T2)	; ..
	SETZM .NBLD2(T2)	; ..
	MOVEI T4,ITY%LL		; Declare format of this message
	STOR T4,IHFTY,(T2)	; ..
	LDB T3,LTLINK		; Build the leader.
	STOR T3,IHLNK,(T2)	; Put in the link
	LOAD T3,LTHOST,(T1)	; Get host
	STOR T3,IHADR,(T2)	; Address
	MOVE T3,IMPLT2(T1)
	MOVEI T4,HTY%NP		; Max number of packets
	TLNE T3,(HIPFLG)	; If high priority connection,
	 TXO T4,HTY%HP		; Set high priority in handling type
	STOR T4,IHHTY,(T2)
	LSH T4,-4		; High part isn't contiguous
	STOR T4,IHHT2,(T2)	; So store it (Hi Prio bit) too
	SETZRO NBQUE,(T2)	; Put bfr on queue
	HRLM 2,0(3)
	HRRM 2,IMPLT2(1)
				; Fall into output check

; Put bfr on imp output queue if no rfnm outstanding

IMPQOB:	MOVSI 3,(RFNMC!ILCKB)
	TDNE 3,IMPLT2(1)	; Rfnm now out?
	RET			; Yes, don't send
	HLRZ 2,IMPLT3(1)
	JUMPE 2,R		; Return if no bfrs to go
IMPQO1:	MOVSI 3,(RFNMC)
	IORM 3,IMPLT2(1)	; Set rfnm flag
	HLLZ 3,0(2)		; Get bfr off queue
	JUMPN 3,.+3
	MOVEI 4,IMPLT3(1)
	HRRM 4,IMPLT2(1)
	HLLM 3,IMPLT3(1)
	CALL IMPQOA		; Actually put it on output queue
	RET

; Entry here for queueing host-imp messages
; Buffer address in T2

IMPQOA:	SKIPN IMPORD		; is output on?
	 JRST RLNTBF		; No. don't queue it up
	PUSH P,1		; Save ac1
	CALL IMPLKB		; Lock bfr for pi service routine
	MOVE 1,2
;;;;	CALL DBGOM
	LOAD T1,IHHT2,(T2)	; Check msg's priority
	PIOFF
	SETZRO NBQUE,(T2)	; Put bfr on imp out queue
TCPQOH:	TRNN T1,<HTY%HP>_-4	; Is priority bit set in message
	 JRST IMPQOL		; No, lo priority queue
	SKIPE T1,IMPHBI		; Yes. Goes on hi priority queue
	JRST IMPQO2		; Already something on that Q
	MOVEM T2,IMPHBO		; First guy on Q. Set head pointer
	SKIPA			; Dont't chain, no successor.
IMPQO2:	STOR T2,NBQUE,(T1)	; Chain from predecessor to new guy
	MOVEM T2,IMPHBI		; This is new tail of queue
	JRST IMPQOC

IMPQOL:	SKIPE T1,IMPOBI		; Anything on low priority Q?
	JRST IMPQO3		; Yes, don't set head pointer
	MOVEM T2,IMPOBO		; No, Set head to this buffer
	SKIPA			; But don't chain it
IMPQO3:	STOR T2,NBQUE,(T1)	; Chain from predecessor to new guy
	MOVEM T2,IMPOBI		; And set tail to this new guy
IMPQOC:	PION
	SKIPN IMPOB		; Output now in progress?
	JSP 4,IMPXOU		; No, start it
	POP P,1
	RET


; Put TCP output buffer on queue for IMP.  2 has pointer to
; the (already locked) buffer.

TCPQOB::SKIPE TCPON		; TCP turned off?
	SKIPN IMPORD		; IMP output side ready?
	 RET			; No.  Forget it. (No skip return)
	AOS (P)			; Arrange for skip return to say Pkt Q'd
	PUSH P,1
	PIOFF
	SETZRO NBQUE,(T2)	; Clear list pointer
	LOAD T1,IHHT2,(T2)	; Check msg's priority
	TRNE T1,<HTY%HP>_-4
	 JRST TCPQOH		; Send via IMP high priority queue
	SKIPE T1,TCPOBI		; Anything on TCP output queue?
	 JRST TCPQO3		; Yes, don't set head pointer
	MOVEM T2,TCPOBO		; No, set head to this buffer
	SKIPA			; But don't chain it
TCPQO3:	STOR T2,NBQUE,(T1)	; Chain from predecessor to new guy
	MOVEM T2,TCPOBI		; And set tail to this new guy
	JRST IMPQOC

; Lock imp bfr. Must lock beginning and end in case crosses page bndry

IMPLKB::PUSH P,1		; Save 1 and 2
	PUSH P,2
	LOAD T1,NBBSZ,(T2)	; GET SIZE FIELD
	CAMLE 1,MAXWPM		; MAKE SURE NOT ON FREELIST
	 BUG(HLT,<IMPLKB: ATTEMPT TO LOCK BUFFER ON FREELIST>)
IFNDEF RNTBFS,<
	MOVEI 1,0(2)
	CALL MLKMA		; Lock beginning
	MOVE 1,0(P)
	ADD 1,0(1)		; Compute end
	MOVEI 1,-1(1)
	CALL MLKMA		; LOCK END
>
	POP P,2
	POP P,1
	RET

; Clear imp queues

IMPCLQ:	NOSKED			; Prevent confusion
	SKIPLE 1,IMPOB		; Anything here?
	 CALL IMPCQ5		; Unlock and release
	SETZB 2,IMPOB
	EXCH 2,IMPHBO
	SETZM IMPHBI
	CALL IMPCQ2		; Dequeue everything
	SETZB 2,IMPOBI
	EXCH 2,IMPOBO
	CALL IMPCQ2
	SKIPE 1,IMIB		; Anything here?
	 CALL IMPCQ5		; Yes, clear it
	SETZB 2,IMIB
	EXCH 2,IMPIBO		; Get things on input queue
	SETZM IMPIBI
	CALL IMPCQ3		; Clear 1 locked things
	SETZ T2,
	EXCH 2,IMPFRI		; Clear input free list
	CALL IMPCQ2		; Clear 2 locked things
	SETZB 2,IMPNFI
	EXCH 2,IMINFB		; Get release queue
	CALL IMPCQ4		; Release 0 locked things
	OKSKED
	RET

; Unlock buffers on a queue twice

IMPCQ2:	MOVEI 3,2
	JRST IMPCQ0

; Unlock buffers on a queue 0 or 1 times

IMPCQ4:	TDZA 3,3		; Zero times
IMPCQ3:	MOVEI 3,1		; Once
IMPCQ0:	JUMPE 2,R		; Common code. 0 -- no buffers left
	HRRZ 1,2
	LOAD T2,NBQUE,(T1)
	CALL IMPCQ1		; Unlock and release
	JRST IMPCQ0		; Continue with next in chain

; Release individual buffer

IMPCQ5:	MOVEI 3,2		; Entry for twice locked buffer
IMPCQ1:	PUSH P,3		; Common routine
	PUSH P,2		; Transparent to 2
	PUSH P,1
	LOAD T1,NBBSZ,(T1)	; GET COUNT FIELD
	CAMLE 1,MAXWPM		; MAKE SURE NOT ON FREELIST
	 BUG(HLT,<IMPCQ: ATTEMPT TO UNLOCK BUFFER ON FREELIST>)
	MOVE 1,0(P)		;RESTORE AC1
	CALL @[	R
IFNDEF RNTBFS,<
		MULKMP
>
IFDEF RNTBFS,<
		R
>
		IMULKB](3)	; Call appropriate routine
	POP P,2
	CALL RLNTBF		; And release
	POP P,2
	POP P,3
	RET

; Unlock imp buffer at pi level

IMULKB::
	PUSH P,1
	LOAD T1,NBBSZ,(T1)	; GET SIZE FIELD
	CAMLE 1,MAXWPM		; MAKE SURE NOT ON FREELIST
	 BUG(HLT,<IMULKB: ATTEMPT TO UNLOCK BUFFER ON FREELIST>)
IFNDEF RNTBFS,<
	MOVE 1,0(P)
	CALL MULKMP		; Unlock first adr in bfr
>
	POP P,1
IFNDEF RNTBFS,<
	ADD 1,0(1)		; COMPUTE END OF BFR
	MOVEI 1,-1(1)
	CALL MULKMP		;UNLOCK END OF BFR IN CASE PAGE BDRY
>
	RET

; Start input
; called from process level when buffers made available and input is off
; and from endin processor if more buffers are available

IMISRT:	CALL IMPRLQ		; Is device up and IMP ready?
	 RET			; No, do nothing
	SOSL IMPNFI
	SKIPN T1,IMPFRI
	 BUG(HLT,<NO IMP INPUT BUFFERS>)
	LOAD T2,NBQUE,(T1)	; Get next free
	MOVEM T2,IMPFRI
	SETZRO NBQUE,(T1)	; DeQueue from any other free buffers
	MOVEM T1,IMIB
	HRRZS TNBFFL		; Indicate NCP ownes IMIB
	SETZM IMIS32		; Flag reading in 36 bit mode
	HRLI T1,-<.NBLD2+1>	; Read thru IMP ldr and one pad word
	MOVEM T1,IMPINP
	MOVEI T1,IMIN0
	MOVEM T1,IMIDSP
	CONSZ IMP,I.ERR		; If error flop is set
	 CALL IMIERR		; Be sure it gets noticed
	CONO IMP,I.ION+I.CLR	; Clear error and start input
	POPJ P,

;For subsequent interrupts, a field will steer the packing and counts.
;Values are named .IIxxx for Imp Interrupt dispatch. Store in IMIDSP,
; which also is indirected thru.

DEFSTR (IIDSP,,5,3)	;Three bits, 3-5, in IMIDSP and IMODSP

.IINC6==0		;This is a 36 bit NCP message
.IINC2==1		;This is a 32 bit NCP message
.IITNT==2		;Telenet link
.IISPQ==3		;Special queue
.IIINT==4		;TCP packing
.IIMLC==5		;MLC (Ptip) format
.IISQ2==6		;False start INT becomes SPQ later

; PI service for input
; Dispatched at impsv to various routines via IMIDSP
; IMPEIN - handles 'end input' signal

IMIN0:	BLKI IMP,IMPINP		; Read in leader portion
	 JRST IMIN1		; Leader all read
	UNBRK IMP

;Here when all leaders and one word of padding have been read.

IMIN1:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	MOVE T1,IMIB		; Get buffer location
	LOAD T2,IHLNK,(T1)	; Get link and host numbers
	LOAD T3,IHHST,(T1)	;  for packing decisions
;1 Begin deletion
REPEAT 0,<
	CAMN T2,TNETLK		; Telenet link?
	JRST IMI1TN		; Yes.
>
;1 End of deletion
	CAMN T2,INETLK		; Internet link?
	JRST IMI1IN		; Yes.
	CAIG T2,LLINK		; Non-NCP link?
	CAIL T3,FKHOST		; Or Fake Host?
	JRST IMI1SQ		; Yes. Pack in 32 bit mode
IMI1NC:	MOVX T4,.IINC6		; Seems to be an NCP message.
IMIN1A:	MOVEI T2,.NBLD2+1(T1)	; Word before next one to read into
	HLL T2,II1WCT(T4)	; Count, for this type of message
	MOVEM T2,IMPINP		; For next BLKI pointer
	HRRZ T2,II1WCT(T4)	; See if want to switch to 32 bit mode
	HRLS T2			; Build a zero or an AOBJN counter
	SKIPE T2		;  ..
	HRRI T2,^D8(T2)		; Counter. Set initial state.
	MOVEM T2,IMIS32		; Save in core for further interrupts
	MOVEI T3,IMIN2		; Where to go on next interrupt
	STOR T4,IIDSP,T3	; Include type code
	MOVEM T3,IMIDSP		; Save for next int time
	JRST IMPUB		; Done this interrupt

IMI1SQ:	MOVX T4,.IISPQ		;Special queues
	JRST IMIN1A		;Join common code

IMI1IN:	MOVX T4,.IIINT		;Internet link
	JRST IMIN1A		;Join common code

IMI1TN:	MOVX T4,.IITNT		;Telenet handling code
	JRST IMIN1A		;And join NCP flavor routine

II1WCT:	XWD -2,0		; TYPE NCP36
	XWD -2,0		; TYPE NCP32
	XWD -2,0		; TYPE TELENET
	XWD -1,-^D8		; TYPE SPECIAL Q, start 32 bit mode
	XWD -5,-^D8		; TYPE INTERNET, start 32 bit mode
	XWD -2,0		; TYPE MLC
	XWD -1,-^D8		; TYPE SQ2, start 32 bit mode

; Here for BLKI's in second group, after leader.

IMIN2:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	SKIPE IMIS32		; Reading 32 bit mode?
	JRST [	PUSHJ P,BLKI32	; Yes, read and distribute 36 bits
		 JRST IMIN20	; Finished
		JRST IMPUB]	; More to go
	BLKI IMP,IMPINP		; Read another word in 36 bit mode
	 JRST IMIN20		; Done.
	JRST IMPUB		; More to go.
IMIN20:	MOVE T1,IMIB		; Point to buffer being read into
	LOAD T4,IIDSP,IMIDSP	; Get the type code for this msg
;Padding removal isn't needed if message isn't that long, but it's
; cheaper to always remove it than to test for needing to.
	MOVE T2,.NBLD2+2(T1)	; Crunch out the padding
	STOR T2,IHPD1,(T1)	; Partial word in .NBLD2
	MOVE T2,.NBHHL+2(T1)	; And H-H leader
	MOVEM T2,.NBHHL(T1)	; to its rightful place
	CAIN T4,.IIINT		; Internet link?
	PUSHJ P,INETIN		; Yes. Special routine, may change T4,T1.
	LOAD T2,NBBSZ,(T1)	; Set up BLKI pointer for rest of msg
	MOVE T3,II2LDT(T4)	; Amount of buffer we have used so far
	SUBI T2,(T3)		; ..
	MOVNS T2		; Negative for BLKI
	HRLZS T2		; Count in left half
	HRR T2,IMPINP		; Address it got to so far
	SUBI T2,2		; Less two for fills removed
	MOVEM T2,IMPINP		; Save for BLKI
	CAIE T4,.IINC6		; NCP message?
	JRST IMIN2A		; No
	LOAD T2,HHSIZ,(T1)	; Yes, see if packing 32 or 8
	CAIN T2,^D36		; Word mode?
	JRST IMIN2A		; Yes, continue that way.
	MOVEI T4,.IINC2		; No, switch to 32 bit mode
	STOR T4,IIDSP,IMIDSP	; Update in core
	MOVSI T3,-^D8		; Start reading in 32 bit mode from here
	MOVEM T3,IMIS32		; ..
IMIN2A:	MOVEI T3,IMIN3		; Dispatch for next interrupts
	HRRM T3,IMIDSP		; ..
	JRST IMPUB

;Table of next word to read into at IMIN2 time, by message type

II2LDT:	EXP .NBDW0		;Type NCP36
	EXP .NBDW0		;Type NCP32
	EXP .NBDW0		;Type TELENET
	EXP .NBHHL		;Type SPECIAL QUEUES
	EXP .NBDW0+2		;Type Internet
	EXP .NBDW0		;Type MLC
	EXP .NBHHL+3		;Type Special Q - false Internet

; Called from IMIN2 when possible Internet message is coming in.
; This routine does the following:
;	1.	Move the 2 remaining H-H words to the right place
;	2.	Check for right message type and subtype
;	3.	Check for right Internet message type
;		(Currently just TCP format is handled)
;	4.	Check for TCP being on -- TCP fork runs the gateway
;	5.	Check for a TCP-supplied buffer being available
; If any of those conditions is lacking, input is resumed and the
; message is handled as a normal special queue message.
; If the message is really destined for the gateway (TCP, XNET, ...),
; it gets copied into a TCP-supplied buffer and input resumes.
; IMPEIN will then queue it for the gateway.

;T1/	Pointer to current NCP-supplied buffer
;	CALL INETIN
;Ret+1:	Always. T4 set to .IIINT if I.N. msg to be completed, or .IISQ2
;		if it will be given to a special Q


INETIN:	MOVE T2,.NBDW0+2(T1)	; Pick up the Internet header
	MOVE T3,.NBDW0+3(T1)	; ..
	MOVEM T2,.NBDW0(T1)	; Stash in proper place
	MOVEM T3,.NBDW0+1(T1)	; ..
	MOVE T2,.NBDW0+4(T1)	; And the twelve bits after it
	MOVEM T2,.NBDW0+2(T1)	; Which have also been read
	LOAD T2,IHFTY,(T1)	; ARPANET message format
	LOAD T3,IHMTY,(T1)	; ARPANET message type
	CAIN T3,.IHREG		; Regular msg?
	CAIE T2,ITY%LL		; Long leader?
	 JRST INETIC		; No. Let normal code handle it.
	LOAD T2,IHSTY		; ARPANET subtype
	CAIE T2,STY%FC		; Normal, flow-controlled?
	CAIN T2,STY%UC		; or uncontrolled?
	SKIPN TCPON		; And TCP is on? (It runs the gateway)
	 JRST INETIC		; No.  Let normal code handle this.
	LOAD T2,INETF,(T1)	; Get Internet Format and Version
	CAIN T2,<.TCPFM_4>+.TCPVR ; OK for TCP (**** Current Limitation)
	SKIPG TCPNFI		; And there is a TCP buffer around?
	 JRST INETIC		; No.  Let normal special queue have it.

; All is OK for the switch to a TCP buffer.  Do it, return the NCP buf.

	SOSL TCPNFI		; Count down number of free TCP bufs
	SKIPN T2,TCPFRI		; Get pointer to buffer to use
	 BUG(HLT,<TCP buffers fouled>)
	HRLI T3,.NBLD0(T1)	; "From" pointer for BLT
	HRRI T3,.NBLD0(T2)	; "To" -- into TCP buffer
	HLRE T4,II1WCT+.IIINT	; Get size of second transfer
	MOVNS T4		; Make it positive
	ADDI T4,.NBHHL-2(T2)	; Compute last addr (-2 for fill crunch)
	BLT T3,0(T4)		; Copy ARPANET and Internet headers
	MOVE T3,IMPINP		; Continue reading at new buffer
	SUBI T3,0(T1)		; Subtract off NCP buffer addr
	ADDI T3,0(T2)		; Add in base of TCP buffer
	MOVEM T3,IMPINP		; New pointer for rest of data
	LOAD T2,NBQUE,(T2)	; Next TCP free buffer
	EXCH T2,TCPFRI		; Becomes head of list
	EXCH T2,IMIB		; Old head is now current input bfr
	EXCH T2,IMPFRI		; Old input bfr goes to NCP free list
	STOR T2,NBQUE,(T1)	; Old list is off of new head
	AOS IMPNFI		; There is now another free input bfr
	HRROS TNBFFL		; The current one is owned by TCP
	MOVEI T1,IMIB		; Now thnk in terms of TCP's buffer
	MOVEI T4,.IIINT		; Return this to caller
	RET

; Here when current input is to be continued.  Fix to be spec. q. input.

INETIC:	MOVEI T2,.IISPQ		; Mark for special Queue dispatch
	STOR T2,IIDSP,IMIDSP
	MOVEI T4,.IISQ2		; Return this to caller
	RET

; Input body of message

IMIN3:	SKIPE IMIS32		; Want 32 bit handling?
	JRST IMIN32		; Yes.
	BLKI IMP,IMPINP
	 JRST IMINOF		; Overflowed buffer
	UNBRK IMP		; Mostly just wait for the end interrupt

IMIN32:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	SKIPL IMPINP		; Room for more?
	JRST IM32TL		; Nope, too long. Clear interface
	PUSHJ P,BKI32B		; Read 36 bits into 32 format
	 JFCL			; Any more bits would be error.
	JRST IMPUB		; Ok, wait for more.

IMINOF:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	JRST IMIMTL		; Go handle message too long condition

IM32TL:	DATAI IMP,T4		; Discard the bits.
IMIMTL:	LOAD T4,IIDSP,IMIDSP	; If Internet, overflow is possible
	CAIE T4,.IIINT		; Because buffers are shorter.
	BUG(NTE,<MSG TOO LONG>)
	MOVEI 1,IMIN00
	MOVEM 1,IMIDSP
	JRST IMPUB

;Here when message has been found to be a loser. Just throw it away
; until the end input interrupt comes along.

IMIN00:	DATAI IMP,IMIS32	;JUST DISCARD ALL WDS UNTIL END INPUT
	UNBRK IMP

PIMSTK::IOWD NIMSTK,IMSTK

; Routine called if IMIS32 is non-zero. Pack 36 bits into
;  two words, 32 bits in each.
; Two versions. BLKI32 for all but body of message, BKI32B for body.
; This is because body may go to last word of 1/2 page buffer, and
;  in that case you can't do the MOVEM of the last partial word.

BKI32B:	TDZA T4,T4		; Remember entry point
BLKI32:	SETO T4,0		; Remember entry point
	PUSH P,T4		; Save on stack
	DATAI IMP,T1		; Get 36 bits from hardware
	MOVE T4,IMPINP		; Get ptr to input buffer
	MOVE T3,IMIS32		; Get unpacking state word
	AOBJP T4,.+1		; Seq bfr ptr
	TRNN T3,777777		; Is this the zero'th state?
	 AOBJP T4,.+1		; Yes point to partial word
	IORM T4,0(P)		; Make stack positive if overflowed.
	MOVEI T2,0		; Any pad bits should be zeros
	LSHC T1,@IMISHT(T3)	; Align input bytes with destination
	DPB T1,IMIPT1(T3)	; High order byte for n-1st word
	SKIPL 0(P)		; Don't overwrite if last word of body.
	JRST [	SUB T4,BHC+1	; And don't make a 401 size!
		JRST BKI32C]	; Skip the MOVEM
	MOVEM T2,0(T4)		; Low order byte for nth word
BKI32C:	SUB P,BHC+1		; Remove flag from stack
	AOBJN T3,BKI32A		; Step state
	MOVSI T3,-^D8		; Reinit state word
BKI32A:	MOVEM T3,IMIS32		; Save state
	MOVEM T4,IMPINP		; Save bfr ptr
	SKIPGE T4		; Any left to go?
	AOS 0(P)		; Yes, skip return.
	POPJ P,0		; Return

; Tables for 36-32 bit conversion, indexed by state word

IMISHT:	XX==4
	REPEAT ^D8,<Z -XX
		XX=XX+4>

IMIPT1:	XX==^D32
	REPEAT ^D8,<POINT XX,-1(T4),31
		XX=XX-4>

; Here when end msg recd from imp

IMPEIN:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	CONSZ IMP,I.ERR		; Error ff set?
	 PUSHJ P,IMIERR		; Take care of it
	CONO IMP,I.GEB!I.IOF	; We got the end bit, turn input off
	SKIPG T1,IMIB		; Bfr address we were reading into
	JRST IMPEI2		; Wasn't one
	SETZRO NBQUE,(T1)	; Clear fwd ptr of this bfr
	AOSG IMPFLS		; Flushing msgs?
	 JRST IMPEI3		; Yes, return to free list
	HRRZ T2,IMIDSP
	CAIN T2,IMIN00		; Were flushing msg?
	JRST IMPEI3		; Yes, skip usual finish up stuff
	CAIN T2,IMIN0		; In first few words?
	JRST [	HRRZ T2,IMPINP	; See whether enough read to be parsed
		CAIGE T2,.NBLD2(T1)
		JRST IMPEI3	; No, so throw away the message
		JRST .+1]	; Yes, continue.
	LOAD T3,IHFTY,(T1)	; Get format type field
	CAIE T3,ITY%LL		; Better be new I-H format
	JRST IMPEI3		; Wasn't. Discard msg completely.
	LOAD T3,IHMTY,(T1)	; Get message type
	CAIE T3,.IHIGD		; IMP going down, or
	CAIN T3,.IHDHS		; Dead host status? (Have no Msg ID's)
	JRST IMPEI4		; One of those. To irreg msg queue
	CAIN T3,.IHNOP		; You also can't believe link on NOPs
	JRST IMPEI4		; Give them to NCP anyhow
	LOAD T2,IHHST,(T1)	; Is message from a fake host?
	LOAD T4,IHLNK,(T1)	; or on non-NCP link?
	CAIGE T2,FKHOST		; ..
	CAILE T4,LLINK		; ..
	CAIA			; Yes, so not irreg msg for NCP
	JUMPN T3,IMPEI4		; NCP link and real host. If irreg, Q it.
;Fall thru to IMPEI0

;Falls thru

IMPEI0:	SKIPL TNBFFL		; Who owns this buffer?
	 JRST IMPE02
	MOVE T3,TCPIBI		; TCP does. Give it to gateway.
	JUMPN T3,IMPE01		; Was queue empty?
	MOVEM T1,TCPIBO		; Point output pointer at it too
	SKIPA			; No chaining to be done
IMPE01:	STOR T1,NBQUE,(T3)	; Tack on end of queue
	MOVEM T1,TCPIBI		; New msg is last on queue
	AOS TCPFLG		; Run it
	JRST IMPEI1

IMPE02:
IMPE04:	MOVE T3,IMPIBI		; Add bfr to regular input queue
	JUMPN T3,IMPE05		; WHENCE NCPFRK WILL DISTRIBUTE IT
	MOVEM T1,IMPIBO
	SKIPA
IMPE05:	STOR T1,NBQUE,(T3)
	MOVEM T1,IMPIBI
	AOS IMPFLG		; Request job 0 service to do that
IMPEI1:	LOAD T3,NBBSZ,(T1)	; Get size field of the buffer
	CAMLE T3,MAXWPM		; Make sure not already released
	 BUG(HLT,<IMPEIN: ATTEMPT TO UNLOCK BUFFER ON FREELIST>)
IFNDEF RNTBFS,<
	PUSH P,T1		; Save address of buffer
	ADD T1,T3		; Compute tail of bfr
	MOVEI T1,-1(T1)
	CALL MULKMP		; Unlock it
	POP P,T1		; Restore address of buffer
>
	HRRZ T3,IMPINP		; GET LAST LOC WITH DATA
	SUBI T3,-1(T1)		; 3=END-(START-1)=ACTUAL COUNT
	STOR T3,NBBSZ,(T1)	; RECORD ACTUAL COUNT IN BUFFER HEADER
IMPEI2:	SETZM IMIB		; There is no buffer for input
	SKIPLE IMPNFI		; More buffers available?
	 PUSHJ P,IMISRT		; Yes, start new input
IMPUB1:	JRST IMPUB

IMPEI4:	CALL IMP8XQ		; Put msg from buffer in T1 on irreg msg q
	AOS IMPFLG		; Cause it to be processed
IMPEI3:	MOVE T2,T1		; Copy bfr address for following
	SKIPL TNBFFL		; Whose buffer is this?
	 JRST IMPEI6		; NCP's.
	EXCH T1,TCPFRI		; TCP's. Give it back.
	STOR T1,NBQUE,(T2)
	AOS TCPNFI		; Flag to collect it
	JRST IMPEI2

IMPEI6:	EXCH T1,IMPFRI		; Put bfr on NCP's freed input list
	STOR T1,NBQUE,(T2)
	AOS IMPNFI		; Flag to collect it
	JRST IMPEI2

IMIERR:	PUSH P,T1
	SETOM IMPRDL		; Be sure this flap gets noticed
	MOVNI T1,2
	MOVEM T1,IMPFLS
	MOVNM T1,NOPCNT		; Send some nops
	CONO IMP,I.CLR		; Clear error flop
	POP P,T1
	POPJ P,

IMPUB:	MOVSI 4,IMPIAC		; Restore ac's
	BLT 4,4
	MOVE P,IMPIAP		; Restore ac's 16 and 17
	MOVE CX,IMPICX		; ..
	UNBRK IMP

;STATUS CHECK SUBROUTINE

IMPRLQ::CONSZ IMP,I.PWR		;IMP INTFC POWER ON?
	CONSZ IMP,1B22		;OK, IMP DOWN NOW OR RECENTLY?
	RET			;YES. NON-SKIP RETURN
	JRST RSKP		;NO, IT'S UP. SKIP RETURN

; Pi service for output
; Dispatched from impsv to one of the following:
; Imo36: doing 36 bit output
; Imo32: doing 32 bit output (second word only)
; Imo321: doing 32 bit output (rest of msg)
; Impdn2: final phase of end-of-msg cleanup
; IMOIRG: Not buffered. Irregular message

IMODN1:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	CONO IMP,I.EOM		; Sent last word, now send end bit
	MOVE 1,IMPOB		; Get buffer location
	HRRE T2,TNBFFL		; See who owns IMPOB
	JUMPL T2,IMODN3		; Jump if TCP rather than NCP
	CALL IMPGHL		; GET HOST/LINK
	 JRST IMODN4		; NON NCP
	CALL IMPPIL		; Get lt index for this
	 JRST IMODN6		; Not there
	MOVSI 2,(RFNMC)		; Be sure rfnm has not returned already
	TDNN 2,IMPLT2(1)
	 JRST IMODN4		; Well what do you know! Free this one
				; RFNM is still out. save for rexmission
	HRRZ 2,IMPLT3(1)	; Be sure nothing is already saved
	JUMPN 2,IMODN6		; Anomalous, but what can you do?
	MOVE 2,IMPOB		; Save this address for retransmission
	HRRM 2,IMPLT3(1)	; In this link table
	JRST IMODN5		; But go unlock it

IMODN3:	MOVE T2,T1		; Save copy for indexing
	EXCH T1,TCPNFB		; Put on TCP free list
	STOR T1,NBQUE,(T2)	; Old list is successor to this item
	AOS TCPFLG		; Get the TCP to see it
	JRST IMODN5		; Go unlock it and start next msg out

IMODN6:	BUG(NTE,<Can't find LT entry for output message>)
IMODN4:	MOVE T1,IMPOB
	MOVE T2,T1		; Save copy for indexing
	EXCH T1,IMINFB		; Put bfr back on free list
	STOR T1,NBQUE,(T2)	; Old tail into new free buffer
	AOS IMPFLG		; Request job 0 service
IMODN5:	MOVE 1,IMPOB
	CALL IMULKB		; Unlock bfr. It's free or on rexmt slot
	MOVEI 1,IMODN2		; Setup dispatch for final step
	MOVEM 1,IMODSP
	JRST IMPUB1

;IMPGHL - GET HOST/LINK ARG FOR LNKLUK FROM BUFFER IN T1
; SKIP IF SUCCEED, NON-SKIP IF NON-NCP HOST OR LINK

IMPGHL:	LOAD T2,IHHST,(T1)	; GET HOST
	CAIL T2,FKHOST		; FAKE?
	RET			; YES
	LOAD T2,IHLNK,(T1)	; GET LINK
	CAILE T2,LLINK		; FOR NCP?
	RET			; NO
	TXO T2,L1%SND		; THIS IS A SEND CONNECTION
	LOAD T1,IHADR,(T1)	; Address
	IOR T1,NETFLD		; Net number
	JRST RSKP		; Return LNKLUK args in T1,T2

; Routine to start msg going out. Called (by JSP T4,) at PI
;  level, and at main level if no output in progress

IMPXOU::PIOFF
	SKIPN IMPOB		; ANY OUTPUT IN PROGRESS?
	 JRST IMPXO1		; NO
	PION			; YES, TURN PI BACK ON
	JRST (T4)		; AND RETURN

IMPXO1:	SETOM IMPOB		; MARK OUTPUT IN PROGRESS
	PION			; NOW IT'S OK TO TURN PI BACK ON
IMPIOU:	SKIPLE NOPCNT		; Any nop's to send?
	 JRST IOUNOP		; Yes, go send them
	HLLZS TNBFFL		; Assume this will be NCP's output bfr
	MOVE T1,IMPHBO		; Hi priority msg waiting?
	JUMPE T1,IMPIOT		; No, check lo priority
	LOAD T2,NBQUE,(T1)	; Get successor
	JUMPN T2,IMPIO1		; Jump if there is one
	SETZM IMPHBI		; Make queue null
IMPIO1:	MOVEM T2,IMPHBO
	JRST IMPIOC

IMPIOT:
	; Select either a TCP buffer or low priority NCP buffer
	; for output.  Either of these will give credit to the
	; other.  When both are present, it is the one with the
	; most credit that is used.  This prevents one from
	; strangling the other in high traffic situations.

	SKIPN TCPOBO
	 JRST IMPIOL		; No TCP waiting.  Go check NCP low pri.
	SKIPN IMPOBO
	 JRST IMPIOO		; Jump if only TCP output waiting
	SKIPG TCPNCP		; Both waiting.  Which gets it?
	 JRST IMPIOZ		; NCP
	HRRZ T1,TNPRIO		; Output from TCP. Credit NCP.
	MOVNS T1
	ADDM T1,TCPNCP		; More negative to favor NCP
IMPIOO:	MOVE T1,TCPOBO		; TCP message for output
	LOAD T2,NBQUE,(T1)	; Get its successor
	SKIPN T2		; Last one?
	 SETZM TCPOBI		; Yes.  Make queue null
	MOVEM T2,TCPOBO		; Update output pointer
	HLLOS TNBFFL		; Remember out buf is TCP owned
	JRST IMPIOC

TNPRIO:	1,,3	; Diddlable constant: TCP,,NCP favoritism

IMPIOZ:	HLRZ T1,TNPRIO		; Get amount of credit for TCP
	ADDM T1,TCPNCP		; More positive to favor TCP next time
IMPIOL:	MOVE T1,IMPOBO		; Msg waiting to go out?
	JUMPN T1,IMPIO9		; Yes.
	SKIPE T2,HSTGDM
	 JRST IOUHGD		; Send the host going down msg
	CONO IMP,I.STO		; No, turn off imp PI req
	SETZM IMPOB
	JRST 0(T4)

IMPIO9:	LOAD T2,NBQUE,(T1)	; Get successor
	SKIPN T2		; Is there one?
	 SETZM IMPOBI		; No.  Make queue null
	MOVEM T2,IMPOBO		; Update output pointer
	
IMPIOC:	MOVEM T1,IMPOB
	SETZRO NBQUE,(T1)	; Remove from any queue
;Now decide on packing via message type
	LOAD T2,IHLNK,(T1)	;Check for MLC traffic
	HRRE T2,TNBFFL		; See who owns the out buffer
	JUMPL T2,[MOVEI T3,.IIINT	; TCP.  Set packing mode
		JRST IMPIOD]
	LOAD T2,IHHST,(T1)	;Check host and link for NCP range
	LOAD T3,IHLNK,(T1)	; ..
	CAIGE T2,FKHOST		;Special to-imp group?
	CAILE T3,LLINK		;Or link out of range?
	JRST [	MOVEI T3,.IISPQ	;Yes, special queue formatting.
		JRST IMPIOD]
	LOAD T2,HHSIZ,(T1)	;NCP will have set up packing mode
	CAIE T2,^D36		;Is it 36 bit mode?
	SKIPA T3,[.IINC2]	;No, it is 8 or 32.
	MOVEI T3,.IINC6		;Select 36 bit mode
IMPIOD:	HRLI T1,-<.NBLD2+1>	; Send up thru first fill wd in 36-bit
	MOVEM T1,IMPOUP
	MOVEI T1,IMOLDR		; Where to go in out-done int level
	STOR T3,IIDSP,T1	; Put in message handling type
	MOVEM T1,IMODSP		; Setup dispatch
	SETZM IMOS32		; Flag to send in 36 bit mode
	BLKO IMP,IMPOUP		; Send first word (always 36-bit)
	JFCL
	JRST 0(T4)

; Pi service for output

IMOLDR:	SKIPL IMPOUP		; All done?
	JRST IMOLD1		; Yes, send some padding
IMO36B:	BLKO IMP,IMPOUP		; Send another word
	 JFCL
	UNBRK IMP

IMOLD1:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	MOVE T1,IMPOB		; Point to buffer
	MOVEI T2,.NBHHL-1-1(T1)	; Resend a word as pad. 2nd -1 for BLKO
	LOAD T4,IIDSP,IMODSP	; Get the packing procedure
	HLL T2,IO1WCT(T4)	; And select a word count for output
	MOVEM T2,IMPOUP		; Now send these words
	HRRZ T2,IO1WCT(T4)	; See if should switch to 32 bit mode
	HRLS T2			; ..
	SKIPE T2		; Skip if staying in 36 bit mode
	HRRI T2,^D8(T2)		; In 32 bits, make AOBJN counter
	MOVEM T2,IMOS32		; Set packing state word
	MOVEI T2,IMOLD3		; Here on next interrupt
	HRRM T2,IMODSP
	JRST IMOLDX		; Send the first one, 36 or 32 bits

IMOLD3:	SKIPGE IMPOUP		; Send all the second group?
	JRST IMO362		; No, send some more.
	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	MOVE T1,IMPOB		; Point to data buffer
	LOAD T4,IIDSP,IMODSP	; Get packing procedure
	LOAD T2,NBBSZ,(T1)	; Set up BLKO pointer
	MOVE T3,IOLDT(T4)	; How many sent already?
	SUBI T2,(T3)		; Allow for sent words in count
	MOVNS T2		; Count is negative for BLKO
	HRLM T2,IMPOUP		; Send this many more words
	MOVSI T3,-^D8		; May need to set packing state
	CAIN T4,.IINC2		; If NCP 32 bit message,
	MOVEM T3,IMOS32		; Switch to 32 bit mode here.
	MOVEI T3,IMOBDY		; For next interrupts, go here.
	HRRM T3,IMODSP		; Set in core dispatch
IMOLDX:	SKIPE IMOS32		; In 32-bit mode?
	 JRST IMO32X		; Yes.  Do a 32-bit output.
	BLKO IMP,IMPOUP		; Send a word
	 JFCL
	JRST IMPUB

IO1WCT:	XWD -2,0		; TYPE NCP36
	XWD -2,0		; TYPE NCP32
	XWD -2,0		; TYPE TELENET
	XWD -1,-^D8		; TYPE SPECIAL Q, start 32 bit mode
	XWD -1,-^D8		; TYPE INTERNET, start 32 bit mode
	XWD -2,0		; TYPE MLC
	XWD -1,-^D8		; TYPE SQ2, start 32 bit mode

;Table of number of words already sent, at IMOLD3 time

IOLDT:	EXP .NBDW0		;Type NCP36
	EXP .NBDW0		;Type NCP32
	EXP .NBDW0		;Type TELENET
	EXP .NBHHL		;Type SPECIAL QUEUES
	EXP .NBHHL		;Type Internet
	EXP .NBDW0		;Type MLC
	EXP .NBHHL		;Type SQ2

; Output body of message, in 32 or 36 bit mode

IMOBDY:	SKIPL IMPOUP		; Data left?
	JRST IMODN1		; No
	SETZM IMOBDF		; Flag came thru IMOBDY
IMO362:	SKIPN IMOS32		; In 32 bit mode?
	JRST IMO36B		; No, send 36 bits.
IMO32:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
IMO32X:	MOVE T4,IMPOUP		; Get pointer to data
	MOVE T3,IMOS32		; Get state word
	AOBJP T4,[MOVEI T2,0	; Padding should be zero
		SKIPN IMOBDF	; Come through IMOBDY?
		JRST IMO32B	; Yes. Don't load T2 from buffer
		JRST .+1]	; No, take bits from buffer.
	MOVE T2,1(T4)		; Get n+1th word
IMO32B:	MOVE T1,0(T4)		; Get nth word
	LSH T1,-4		; Align high-order byte
	LSHC T1,@IMOSHT(T3)	; Shift bytes into output word
	DATAO IMP,T1
	AOBJN T3,IMO32A		; Step state
	AOBJN T4,.+1		; Extra inc of bfr each cycle
	MOVSI T3,-^D8		; Reinit state word
IMO32A:	MOVEM T3,IMOS32		; Save state word
	MOVEM T4,IMPOUP		; Save bfr ptr
	JRST IMPUB

; Table for 32-36 bit conversion, indexed by state word

IMOSHT:	XX==4
	REPEAT ^D8,<Z XX
		XX=XX+4>

IMOIR2:	CONO IMP,I.EOM		; Tell IMP that's all
	MOVEM T1,IMODSP		; When it finishes, start another.
	MOVEI T1,IMODN2
	EXCH T1,IMODSP
	UNBRK(IMP)

IMODN2:	MOVEM T4,IMPIAC+4	;Save some AC's
	MOVEI T4,IMPIAC		; ..
	BLT T4,IMPIAC+3		; ..
	MOVEM P,IMPIAP		; Save stack pointer
	MOVE P,PIMSTK		; Local PI stack
	MOVEM CX,IMPICX		; For structure macros
	SETOM IMPOB		;2 Clear pointer
	JSP T4,IMPIOU		; Start next msg if any
	JRST IMPUB

IOUHGD:	MOVEI T3,0		; Set up 2 words of data
	LSHC T2,-^D8		; From down-time and reason
	MOVEM T2,IIMBUF+1	; In a scratch buffer
	MOVEM T3,IIMBUF+2
	MOVE T1,H2IHGD		; Proto Host-Going-Down msg
	MOVEM T1,IIMBUF		; To the scratch buffer
	MOVE T2,[XWD -3,IIMBUF-1] ; Point to this msg
	JRST IOUIRG		; And go send it.

IOUNOP:	SOS NOPCNT
	MOVE T2,[XWD -3,H2INOP-1] ; Prototype of a NOP/padding request
IOUIRG:	MOVEI T1,IMOIRG
	MOVEM T1,IMODSP
	MOVEM T2,IMPOUP		; Set for further BLKO's
	BLKO IMP,IMPOUP		; Now send first wd of irreg msg
	 JFCL
	JRST (4)

IMOIRG:	SKIPL IMPOUP		; Any more words?
	JRST IMOIR2		; No. Send end-of msg
	JRST IMO36B		; Same as during leader. Send a word.

;Prototype Host-to-Imp NOP msg, with padding control.

H2INOP:	BYTE (4)0,ITY%LL (16)0 (8).IHNOP (4)0
	EXP 0
	BYTE (4)0,STY%NP	; Desired padding amount

;Prototype Host-to-IMP Host-going-down message.

H2IHGD:	BYTE (4)0,ITY%LL (16)0 (8).IHHGD (4)0	;1-36
;	BYTE (4)0 (24)0 (3)DAY-OF-WK (5)HOUR	;37-72
;	BYTE (4)5MIN, REASON

; Various impbug's from above

IMPB01:	BUG(IMP,<IMPLT FULL>,X)
	JRST LNKL1

IMPB03:	SKIPN IMINFB		; ANY BUFFERS RELEASE BY PI ROUTINES?
	 JRST IMPB04		; NO
	PUSH P,1
	PUSH P,2
	PUSH P,4
	CALL IMINRB
	POP P,4
	POP P,2
	POP P,1
	RET

IMPB04:	PUSH P,1
	BUG(IMP,<ASNTBF FAILED>,X)
	MOVEI 1,^D5000
	DISMS			; Wait for 5 sec, then try again
	POP P,1
	RET

IMPB06:	IUNLK
	MOVE 2,1
	CALL IMP8X1
	BUG(IMH,<RECD EXCESS ALL>,X)
	RET

; Bug or untreated net error

BGRIML:	PUSH P,1
	PUSH P,2
	MOVE 1,2
	SETZ 2,
	JRST BGRIM0

IMPBG0:
BGRIMH:	PUSH P,1
	PUSH P,2
	SETZ 1,			; No header
	JRST BGRIM0

BGRIMP:	PUSH P,1
	PUSH P,2
	SETZB 1,2
BGRIM0:	IFDEF DBGBUF,<
	EXCH 1,-2(P)
	CALL DBGBG1		; Store bug info
	EXCH 1,-2(P)>
	AOS IMPBGC		; Count bugs
	SKIPE BUGIMP
	 JRST BGRIM1
	MOVEM 2,IMPBGH		; Save host/link
	HLRZM 1,BADHMS
	MOVE 2,1(1)		; First word ofheader
	MOVEM 2,BADHDR
	MOVE 2,2(1)
	MOVEM 2,BADHDR+1
	HRRZ 2,-2(P)		; Pc of the bug
	MOVEM 2,BUGIMP
BGRIM1:	POP P,2
	POP P,1
	AOS JB0FLG		; Get job 0 started
	RET

; Imp and ncp status check

IMPSTT:	AOSE IMPRDL		; Was error flop noticed set?
	CONSZ IMP,1B22		; Or is ready line off?
	 JRST IMPSTA		; Yes, mark down
	SKIPGE IMPRDT		; Was it down?
	 JRST IMPSTB		; No, continue
	SETOM IMPRDT		; Yes, reset flag
	GTAD
	MOVEM 1,IMPUPT		; Record time back up
	JRST IMPSTB		; Continue

; Imp is or was down.  record time thereof

IMPSTA:	SKIPN IMPRDY
	 JRST IMPSTB		; Don't record imp down if ncp is off
	SKIPL 1,IMPRDT		; Was it down?
	 JRST IMPSTC		; Yes, check how long
	MOVE 1,TODCLK
	MOVEM 1,IMPRDT		; No, record when in went off
	GTAD
	MOVEM 1,IMPDNT
	JRST IMPSTB

IMPSTC:	ADDI 1,^D10000
	CAMG 1,TODCLK		; Down for more than 10 sec?
	 SETOM IMPDRQ		; Yes, declare imp down & recycle ncp
	JRST IMPSTB

; Bring state of ncp into agreement with state of imp and neton/impdrq

IMPSTB:	SKIPLE 1,IMPRDY		; Down cycle in progress?
	 JRST IMPNO1		; Yes. complete it.
	JUMPL 1,IMPSTU		; No. jump if we think imp is up
	SKIPE NETON		; Ncp is shut off.  do we want it off?
	SKIPLE NETTCH		; No. but if state change unreported,
	 RET			;  then wait. do nothing if all agrees.
	JRST IMPRSS		; Else bring ncp back up.

IMPSTU:	SKIPLE NOPCNT		; ARE ANY NOPS NEEDED
	 JSP 4,IMPXOU		; YES, BE SURE OUTPUT IS GOING
	SKIPN IMPDRQ		; We think it's up, want it down
	SKIPN NETON
	 JRST IMPNOF		; Yes, take it down
	SETZM HSTGDM		; Else it's up. be sure to cancel
	JRST RSKP		;  host going down msg and skip

; Shut down ncp

IMPNOF:	SKIPLE NETTCH
	 JRST RSKP		; But not until state change reported
IMPNF1:	MOVEI 1,^D30000		; Begin down sequence
	ADD 1,TODCLK
	MOVEM 1,IMPRDY		; When to give up and turn ncp off.
	CALL NETDWN		; Start clear of ncp
	SETZM IMPCCH		; Send rst's to everyone
	SETZM IMPTIM		; Now.
	AOS NETTCH
	AOS JB0FLG
	JRST IMPSTT

; Down sequence in progress

IMPNO1:	CONSO IMP,1B22		; If imp is dead
	CAMG 1,TODCLK		; or time has run out?
	 JRST IMPNF3		; Yes. just pull the plug.
	SKIPG NETTCH		; Else if change unreported
	SKIPL IMPCCH		;  or rst's not all sent
	 JRST RSKP		;  then wait.
	SETZM IMPORD		; Shut off output
	SKIPN IMPOBO		; Check if both output queues are empty.
	SKIPE IMPHBO
	 JRST RSKP		; If not, then wait.
	SKIPLE IMPOB		; If last message not completely sent
	 JRST RSKP		;  then wait.
	SETZM HSTGDM		; Now stop sending host going down.
	SKIPE IMPOB		; Are all messages sent?
	 JRST RSKP		; No. wait.
IMPNF3:	SETZM IMPRDY		; Now say totally down
	CONO IMP,I.STO!I.IOF!I.OOF!1B20
				; Stop output, in&out off, drop rdy
	AOS NETTCH		; Report final state change
	AOS JB0FLG
	MOVEI 2,NVTLO		; Finish clean up
IMPNO2:	SKIPGE 1,TTNETW(2)
	 SKIPL TTFORK(2)	; Nvt in use
	 SKIPA
	 JRST IMPNO3
	TDNE 1,NVTCHS		; by arpanet?
	 CALL TTCOBI		; Yes, flush output
IMPNO3:	CAIGE 2,NVTHI		; Check all net nvt lines
	 AOJA 2,IMPNO2
	MOVSI 1,-IMPNLK
	CALL IMPCLL		; Clear all entries from link table
	AOBJN 1,.-1
	CALL IMPCLQ		; Clear queues
	RET			; Not up - nonskip return

; Send INS for connection from NVTCOB
AVTCOB:	PUSH P,IMPUN
	PUSH P,2
	LDB IMPUN,PTNETO
	LDB 1,PLIDX
	LDB 2,LTLINK
	LOAD T1,LTHOST,(T1)
	CALL IMPINS
	POP P,2
	POP P,IMPUN
	RET

; Unpack message into tty buffers
; Impun/socket table index (unit)
; 1/	LT INDEX

NVTUPI:	PUSH P,1		; Preserve ac1
	IMSCLK(IMCNVI)		; Charge to imcnvi
	PUSH P,[0]		; Count bytes unpacked
NVTUPL:	MOVE 1,-1(P)		; Get link table index
	CALL UPBYT		; Get  byte
	 JRST NVTUPD
	AOS 0(P)		; Count bytes
	LDB 2,PNVT		; Get line number
	MOVE 1,3
	LDB 3,NVTSTP		; Get the current command state of this
	SETZ 4,
	DPB 4,NVTSTP
	CALL @NVTSTD(3)		; Dispatch on it
	JRST NVTUPL

NVTUPD:	POP P,4			; Bytes unpacked
	POP P,1			; Restore lt index
	IMUL 4,[-8]
	ADDB 4,NETBAL(IMPUN)
	JUMPGE 4,NVTRAL		; Reallocate
	LOAD T2,LTHOST,(T1)	; Get host
	BUG(IMH,<NVT RECEIVED BYTES EXCEEDING ALLOCATION>,X)
	SETZM NETBAL(IMPUN)
	JRST NVTRAL

PNVT:	POINT 18,NETBUF(IMPUN),35	; Used to get nvt line number

; Send as much as possible when we are the imp fork
AVTRSV:	LDB IMPUN,PTNETO	; GET UNIT NUMBER
	PUSH P,1
	LDB 1,PLIDX		; Get lt index
	HRRZ 3,IMPLT4(1)	; Get msg alloc
	SKIPE 3
	 MOVE 3,NETBAL(IMPUN)	; Get bit alloc if non-zero msg alloc
	LSH 3,-3		; Convert to bytes
	CAMGE 3,0(P)		; At least what we need?
	 JRST [	POP P,1		; No. give up
		RET]
	PUSH P,2		; PRESERVE LINE NUMBER
	CALL NETTC8		; send as much as possible
	POP P,2			; RESTORE LINE NUMBER
	POP P,1
	RET

; Move tty output to net buffers

RCTOPT==7		; RCTE option
WILOPT==10		; Offset for requests
NETTCS:	MOVEI 3,(1B<RCTOPT+WILOPT>)
	TDNE 3,NVTOPF(2)
	CALL CKNNVT
	 JRST NETTC7		;1 No RCTE (was JRST NETTC8)
	LDB 3,PBRCNT		; NEED TO SEND RESET?
	SKIPE 3
	 CALL NVTRRR		; YES, TRY TO SEND

;1 Begin insertion
NETTC7:	SKIPGE XTTFLG##(2)	; If screen freeze is on for this line
	 RET			; Then wait for user to unfreeze it
;1 End of insertion

NETTC8:	LDB IMPUN,PTNETO	; Get unit index
	SKIPGE TTNETW(2)	; Still connected?
	 JRST NETTCF		; No, just clear buffer
	SETZ 4,			; Init char count
	MOVEI 6,0(P)		; Use stack as local buffer
	HRLI 6,1000		; Construct 8-bit byte ptr
	MOVE 7,NETSTS(IMPUN)
	TLNN 7,EOTF
	TLNE 7,DEDF
	 JRST NETTCF		; Yes, don't send any more
	PUSH P,2		; Preserve line number
	LDB 1,PLIDX		; Get link index
	PUSHJ P,PKCHK		; Check how many bits can be sent now
	MOVE 7,2
	POP P,2
	JUMPLE 7,PKULCK		; If none, give up
	CAILE 7,100		; But limit to 100 (20 wds on stack)
	MOVEI 7,100
	ADD P,[20,,20]		; Reserve space on stack
	MOVE 3,6		; Save byte ptr
NETTC2:	SOJL 7,NETTC4		; Count down limit
	NOSKED
	SKIPE TTECT(2)		; Chars from echo buffer?
	JRST [	CALL NETTEO	; Yes, get one
		JRST NETTC1]
	SKIPE TTOCT(2)		; Chars from output buffer?
	JRST [	CALL NETTOO	; Yes, get one
		JRST NETTC1]
	PUSH P,3		; Preserve ac3
	CALL TTRLOB		; Buffers empty, release them
	POP P,3
	OKSKED
NETTC4:	JUMPE 4,[SUB P,[20,,20]	; No chars to send, clear stack
		JRST PKULCK]
	MOVNI 1,^D8
	IMUL 1,4		; Adjust allocation
	ADDM 1,NETBAL(IMPUN)
	LDB 1,PLIDX		; Get conn index
	PUSH P,2
	CALL PKMSG1
	POP P,2
	SUB P,[20,,20]		; Clear stack
	JRST NETTC8		; See if any more

NETTC1:	OKSKED
	IDPB 1,6		; Put char on stack buffer
	AOJA 4,NETTC2

NETTCF:	CALL TTCOBI		; FLUSH OUTPUT BUFFER
	LDB 1,PLIDX
	RET

; Initialization
; IMP queues (IMPxBx) are resident variables and are cleared when the
; system starts up.

IMPINI:	SETZM TCPNCP		; Priority of TCP vs NCP for output
	MOVSI 2,-NSQ
	MOVEI 1,SIQIBO(2)
	MOVEM 1,SIQIBI(2)
	SETOM SIQFKX(2)
	SETOM SQJOB(2)
	AOBJN 2,.-4
	SETOM SQLCK
	MOVEI 2,LT1SND+LT1FRE	; Free entry for implt1
	MOVSI 1,-IMPNLK
	MOVEM 2,IMPLT1(1)	; Make all links unused
	AOBJN 1,.-1
	SETOM IDVLCK		; INIT IDVLCK
IMPRSN:	SETZM IMPNCL		; Clear irreg msg q variables
	SETZM IMP8XI
	SETZM IMP8XO
	SETZM IMP8XC
	MOVEI 1,IMIN00		; Setup pi dispatches
	MOVEM 1,IMIDSP
	MOVEI 1,IMODN2
	MOVEM 1,IMODSP
	MOVEI 1,^D120000	; Start timers
	ADD 1,TODCLK		; In two minutes
	MOVEM 1,NETTIM		; Set alarm clocks to infinity
	MOVEM 1,RFNTIM
	SETZM IMPTIM
	SETZM IGDTIM		; Clear time of last imp-going-down msg
	SETZM HSTGDM		; Cancel any residual host going down
	SETZM IMPCCH		; Cause send of rst to all hosts
	RET

; Bring up ncp

IMPRSS:	CONSZ IMP,1B19		; Power on
	CONSZ IMP,1B22		; And ready line on
	 RET			; No, stop here
	CALL IMPRSN		; Reset variables
	CONO IMP,1B19		; Set host ready line, clear imp error
	SETZM IMPRDL		; And notices of b21
	SETZM IMPDRQ		; Forget any intervening down requests
	MOVNI 1,2
	MOVEM 1,IMPFLS		; Init flush count
	MOVEI 1,3
	MOVEM 1,NOPCNT
	MOVEI 1,^D1000
	DISMS			; Allow time for ready line to settle
	AOS NETTCH		; Cause change in state to be noted
	AOS JB0FLG
	GTAD			; Yes
	MOVEM 1,NCPUPT		; Save time whe it came up
	DATAI IMP,1		; Helps to clear interface
	CONO IMP,I.STO+I.GEB
	CONO IMP,I.OON		; Give output pi asmt
	SKIPLE IMPNFI		; If input bfrs available,
	 CALL IMISRT		; Start input
	SETOM IMPRDY
	SETOM IMPORD		; Allow output
	MOVE 1,NLHOST		; Local host
	CALL IMPRRP		; Send ourselves an rrp
	RET

; Take network down
; Accepts in
;	1	; Reason for going down (a la 1822)
;	2	; Time when back up (TENEX standard)

IMPHLT:	SKIPN NETON		; IS IT ON?
	 RET			; NO. DO NOTHING
	ANDI 1,17		; ISOLATE 4-BIT REASON FOR GOING DOWN
	PUSH P,1
	ADDI 2,1000000-^D<24*60*60>+^D150	; ADD 2.5 MINUTES
	TRNE 2,1B18		; DID IT INCREMENT THE DAY?
	 SUBI 2,1000000-^D<24*60*60>	; NO. SUBTRACT EXCESS
	GTAD			; GET NOW
	CAMG 2,1		; IS TIME BACK UP LATER THAN NOW?
	 JRST [	MOVEI 1,7776_4
		JRST IMPHLA]	; TIME BACK UP NOT KNOWN
	ADD 1,[6,,0]
	CAMG 1,2		; MORE THAN 6 DAYS AWAY?
	 JRST [	MOVEI 1,7777_4
		JRST IMPHLA]
	MOVSI 4,(1B0+1B2+0B17)	; USE GMT STANDARD TIME
	ODCNV			; SEPARATE INTO DAY, SECOND ETC
	HRRZI 1,(3)		; DAY OF WEEK
	HRRZI 2,(4)		; SECONDS SINCE MIDNIGHT
	IDIVI 2,^D300		; CONVERT SECONDS TO 5 MIN
	IDIVI 2,^D12		; SEPARATE INTO HOUR AND 5 MIN
	LSH 1,5
	IORI 1,(2)		; INSERT HOUR OF DAY
	LSH 1,4
	IORI 1,(3)		; AND 5 MIN PART OF HOUR
	LSH 1,4
IMPHLA:	IOR 1,0(P)
	TLO 1,(2B7)
	PIOFF
	SETZM NETON		; START NET DOWN
	MOVEM 1,HSTGDM
	PION
	JSP 4,IMPXOU
	SUB P,BHC+1
	RET

; Restart code. called by SYSRST

IMPRST:	SETOM IMPDRQ		; Request down cycle
	MOVEI 1,1
	SKIPLE IMPRDY		; Going down already?
	 MOVEM 1,IMPRDY		; Shorten delay
	RET

>			; End of idfef impchn on page 1

IFNDEF IMPCHN,<
AVTCOB::
AVTCAP::
AATNVT::
AVTDET::
NETTCF::
AVTRSV::

PTNETO::
PTNETI::

LS TTNOF,1			;DUMMY
LS NEGTIM,1		; Negotiation time-out clock

>;IFNDEF IMPCHN

	END
