Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-1-monitor/impdv.mac
There are 16 other files named impdv.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-1-MONITOR>IMPDV.MAC.6, 21-Jan-88 21:56:30, Edit by MKL
; fix bug in stats
;[SRI-NIC]SRC:<6-1-MONITOR>IMPDV.MAC.4, 10-Nov-87 16:52:40, Edit by MKL
; add statistics
;SRC:<6-1-MONITOR>IMPDV.MAC.2, 19-Feb-87 09:56:05, Edit by KNIGHT
; Enable IMPINC BUGINFs.  
;PS:<6-1-MONITOR>IMPDV.MAC.8, 20-Sep-85 19:58:09, Edit by BILLW
; replace XNENT in supposedly resident code with XRENT
;<6-1-MONITOR>IMPDV.MAC.7, 28-Apr-85 14:46:05, Edit by LOUGHEED
;<6-1-MONITOR.FT6>IMPDV.MAC.2, 12-Aug-85 18:15:24, Edit by WHP4
;Stanford changes:
; To co-exist with MEIS, fix assumptions that MAXLDR =4
; Fix off-by-one errors in SNDIM% and RCVIM%
; Allow WOPR's to do ASNSQ% functions
; No more IMPINC buginfs to clutter up SPEAR log
;
; UPD ID= 1600, SNARK:<6.1.MONITOR>IMPDV.MAC.6,   7-Mar-85 15:50:20 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1575, SNARK:<6.1.MONITOR>IMPDV.MAC.5,  26-Feb-85 17:19:25 by PAETZOLD
;Document BUGxxx's
; UPD ID= 1033, SNARK:<6.1.MONITOR>IMPDV.MAC.4,  12-Nov-84 15:23:47 by PAETZOLD
;TCO 6.1041 - Move ARPANET to XCDSEC
; UPD ID= 314, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.11,  18-Oct-84 15:41:59 by PAETZOLD
;Fix up IMPULK for BF18SZ changes.
; UPD ID= 284, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.10,  24-Sep-84 13:53:54 by PURRETTA
;Update copyright notice.
; UPD ID= 261, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.9,  30-Aug-84 16:35:52 by PAETZOLD
;Fix serious brain damage in IMINRB to fix ILULK2s and IOPGFs.
; UPD ID= 220, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.8,  19-Jul-84 14:13:11 by PAETZOLD
;Fix immense brain damage from previous edit
; UPD ID= 208, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.7,  10-Jul-84 12:20:53 by PAETZOLD
;IMPEC9 needs the buffer offset.
; UPD ID= 196, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.6,  17-Jun-84 14:38:53 by PAETZOLD
;MAXWPM in STG now.
; UPD ID= 170, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.5,   9-Jun-84 11:29:30 by PAETZOLD
;No more LLINK.
; UPD ID= 158, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.4,   1-Jun-84 11:31:07 by PAETZOLD
;Missed an RSKP in IMPUP2.
; UPD ID= 152, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.3,  31-May-84 10:58:10 by PAETZOLD
;No more IMPSTT.  Fix up IMPSTS.
; UPD ID= 28, SNARK:<TCPIP.5.4.MONITOR>IMPDV.MAC.2,   5-Apr-84 20:52:45 by PAETZOLD
;Reduce MAXWPM by LCLPKT.
; UPD ID= 4027, SNARK:<6.MONITOR>IMPDV.MAC.14,  31-Mar-84 18:29:32 by PAETZOLD
;More TCO 6.2019 - Fix typo in edit 3988.
; UPD ID= 4018, SNARK:<6.MONITOR>IMPDV.MAC.13,  31-Mar-84 16:19:49 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 4003, SNARK:<6.MONITOR>IMPDV.MAC.12,  28-Mar-84 20:54:57 by PAETZOLD
;More TCO 6.1733 - Move GET18B and RET18B to IPFREE
; UPD ID= 3988, SNARK:<6.MONITOR>IMPDV.MAC.11,  27-Mar-84 17:12:16 by PAETZOLD
;More TCO 6.1733 - Make RET18B more defensive.  Save correct size in ASNTBF.
; UPD ID= 3897, SNARK:<6.MONITOR>IMPDV.MAC.10,  11-Mar-84 10:37:44 by PAETZOLD
;More TCO 6.1733 - Rewrite  CHKI7 for a better message which users will
;understand. Remove hairy host dead code at  IMPEC6.  Don't  drop  into
;HSTDED from IMPEC6. Fix performance bug in IMPHDR. In IMPEIN, give the
;host valid and up status in HSTSTS. Remove IMPSTD.
; UPD ID= 3829, SNARK:<6.MONITOR>IMPDV.MAC.9,  29-Feb-84 18:17:55 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug Fixes.  Cleanup.
;<TCPIP.5.3.MONITOR>IMPDV.MAC.5,  6-Dec-83 23:51:12, Edit by PAETZOLD
;Use IPPDSW and not FT.DBI for .DBGIM control
;Remove IMPFLB and IMPNIT from this module.  Cosmetic changes.
;TCO 6.1796 - Handle TTMSG failures in CHKI7
;More TCO 6.1733 - NCPFRK has gone away
;TCO 6.1630 - MONBK/PSIMB fix.
;<TCPIP.5.1.MONITOR>IMPDV.MAC.55,  5-Jul-83 08:25:03, Edit by PAETZOLD
;TCP Changes for 5.1

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION  1978, 1984.
;ALL RIGHTS RESERVED.


	SEARCH ANAUNV,PROLOG
	TTITLE	(IMPDV,IMPDV,< - ARPANET 1822 Host IMP Communication>)
IFN NICSW,<
	extern .nct0,.nct1
>

IFNDEF REL6,<REL6==1>
SIQTM0==^D30000			;SPECIAL QUEUE TIME-OUT INTERVAL
	SUBTTL IMP Going Down Message Notification Handling

;Broadcast imp going down message
;There are two potential weaknesses here right now
;a) only one buffer for storing reason
;b) nowhere to store which imp it is (though could get that from the NCT)
;These don't seem all that critical since imps don't go down all
;that often, and its unlikely for more than one to go down at once

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

CHKI7::
	STKVAR <<CHKIBF,40>>
	HRROI T1,CHKIBF		;BUFFER ON PDL
	HRROI T2,[ASCIZ/
[From SYSTEM: IMP going down for /]
	SETZ T3,
	SOUT%
	LDB T2,[POINT 10,IMPGDM,31]
	IMULI T2,5		;NUMBER OF MINUTES IT WILL BE DOWN
	MOVEI T3,^D10
	NOUT%
	 NOP
	HRROI T2,[ASCIZ / min in /]
	SETZ T3,
	SOUT%
	LDB T2,[POINT 4,IMPGDM,21]
	MOVEI T3,^D10
	IMULI T2,5		;HOW LONG TILL IT HAPPENS
	NOUT%
	 NOP
	HRROI T2,[ASCIZ / min due to /]
	SETZ T3,
	SOUT%
	LDB T2,[POINT 2,IMPGDM,17]	;GET CODE FOR REASON
	HRRO T2,[[ASCIZ /Panic]
/]
		[ASCIZ /Scheduled Hardware PM]
/]
		[ASCIZ /Software Reload]
/]
		[ASCIZ /Emergency Restart]
/]](T2)
	SOUT%
	HRROI T2,CHKIBF		;POINT TO THE TEXT
	SETO T1,		;TELL EVERYONE
	TTMSG%
	 ERJMP .+1		;IGNORE ERRORS
	SETZM IMPGDM		;DON'T SAY IT AGAIN
	RET
	SUBTTL DBGIM JSYS

IFE REL6,<RESCD>		; THIS CODE IS RESIDENT
IFN REL6,<XRESCD>		; THIS CODE IS RESIDENT

IFN IPPDSW,<

; 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 1822 bugs
;		; B2: Report normal 1822 events
;		; B3: Report Internet stuff

IFE REL6,<.DBGIM::>
IFE STANSW,<
IFN REL6,<XNENT .DBGIM,G>
>;IFE STANSW
IFN STANSW,<	; XNENT does its own XSWAPCD, and this should be resident
IFN REL6,<XRENT .DBGIM,G>
>;IFN STANSW

	MCENT
	HRRZS T1			; DON'T ALLOW BYTE POINTERS
	MOVEI T4,SC%WHL!SC%NWZ
	TDNN T4,CAPENB
	 EMRETN (NTWZX1)
	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 DBGINT
	TLNE T3,(1B3)
	SETOM DBGINT
	OKSKED
	SETZM DBGRP
	AOS DBGRP		;POINT AT FIRST WORD
DBGIM0:	PUSH P,T2		;SAVE COUNT ON STACK
	PUSH P,T1		;AND JFN
DBGDBL:	SKIPG T3,DBGNWD		;ANYTHING IN BUFFER?
	 JRST DBGDBW		;NO. WAIT.
	MOVEI T4,DBGNBF		;GET SIZE OF BUFFER
	SUB T4,DBGRP		;SPACE TO END OF BUFFER
	CAMGE T3,T4
	 MOVEM T3,T4		;KEEP MIN COUNT OF HOW MUCH TO WRITE
	MOVN T3,T4		;GET NEG COUNT OF WORDS USED
	MOVE T2,DBGRP		;GET POINTER FOR REMOVING FROM BFR
	ADD T2,[POINT 36,DBGBUF] ;MAKE IT POINT TO BUFFER
	SOUT			;WRITE TO FILE
	MOVN T3,T4		;GET NEG OF AMOUNT WRITTEN
	ADDM T3,DBGNWD		;UPDATE NUMBER OF WORDS USED IN BFR
	ADDB T4,DBGRP		;AND REMOVAL POINTER
	CAIL T4,DBGNBF		;AT END OF BUFFER?
	 SETZB T4,DBGRP		;YES, RESET REMOVAL POINTER
	ADDB T3,-1(P)		;COUNT WORDS WRITTEN
	JUMPG T3,DBGDBL		;CONTINUE IF STILL .GR. 0
	UMOVEM T3,3		;ELSE RETURN UPDATED COUNT
	ADJSP P,-2		;CLEAR STACK
	SMRETN			;SKIP RETURN

DBGDBW:	MOVEI T1,DBGNWD		;SCHEDULER TEST FOR WAIT
	CALL DISG		;WAIT FOR SOME WORDS
	MOVE T1,0(P)		;GET JFN BACK
	JRST DBGDBL		;GO WRITE THEM TO FILE

; DBGIIM - Stash input irregular msg

DBGIIM:	SKIPN DBGNCP		;WANT NCP FORMAT MESSAGES?
	 RET			;IF NOT, RETURN.
	PUSH P,T2		;YES. SAVE AN AC
	MOVEI T2,3		;THREE WORDS OF LEADER
	CALL DBGCKS		;CHECK FOR SPACE
	 JRST DBGXIT		;NOT AVAILABLE
	CALL DBGS2B		;OK, STORE COUNT AND TIMESTAMP
	HRLI T1,-3		;COUNT THREE WORDS OF LEADER
DBGIIL:	MOVE T2,0(T1)		;GET A WORD FROM IRREG MSG BUFFER
	CALL DBGS1B		;PUT IT IN DEBUG BUFFER
	AOBJN T1,DBGIIL		;DO WHOLE LEADER
DBGXIT:	OKSKED
	POP P,T2
	RET

DBGINM:	SKIPN DBGNCP		;WANT NCP FORMAT MESSAGES?
	 RET			;NO.
	PUSH P,T2		;YES. SAVE AN AC
	LOAD T2,IHLNK,(T1)	;LINK NUMBER OF THIS MSG
	SKIPE T2		;CONTROL LINK?
IFE STANSW,<
	 SKIPA T2,[5]		;NO. ASSUME LENGTH 5
>;IFE STANSW
IFN STANSW,<
	 SKIPA T2,[.NBWD0+1]	;No. Assume we have a leader + 1 data word
>;IFN STANSW
	  LOAD T2,NBBSZ,(T1)	;YES, GET ITS LENGTH.
IFE STANSW,<
DBGSM:	SOS T2			;ONE LESS FOR BUFFER HEADER
>;IFE STANSW
IFN STANSW,<
DBGSM:	SUBI T2,.NBLD0		;Subtract off crap preceding the leader
>;IFN STANSW
	CALL DBGCKS		;GO RESERVE SPACE
	 JRST DBGXIT		;NOT AVAILABLE
	PUSH P,T1		;SAVE BUFFER ADDRESS
	CALL DBGS2B		;WRITE HEADER AND TIMESTAMP
	HRRZS T2		;GET COUNT OF WORDS
	MOVE T1,0(P)		;POINT INTO BUFFER
	PUSH P,T2		;SAVE COUNT ON STACK
DBGSLP:	SOSGE 0(P)		;COUNT THE WORDS
	JRST DBGSL1		;FINISHED. QUIT.
IFE STANSW,<
	MOVE T2,1(T1)		;GET A WORD FROM MESSAGE
>;IFE STANSW
IFN STANSW,<
	MOVE T2,.NBLD0(T1)	;Get a word from the message
>;IFN STANSW
	CALL DBGS1B		;PUT IT IN DEBUG BUFFER
	AOJA T1,DBGSLP		;GO DO NEXT WORD
DBGSL1:	POP P,T2		;REMOVE COUNT FROM STACK
	POP P,T1		;RESTORE CALLER'S T1
	JRST DBGXIT

DBGOM:	SKIPN DBGNCP		;WANT NCP FORM MESSAGES?
	 RET			;NO.
	PUSH P,T2		;YES, SAVE CALLER'S AC
	LOAD T2,IHMTY,(T1)	;WHAT TYPE MSG IS THIS?
IFE STANSW,<
	JUMPN T2,[ HRROI T2,2
		JRST DBGSM]
>;IFE STANSW
IFN STANSW,<
	JUMPN T2,[ HRROI T2,<.NBLD0+1> ;Irregular messages are one word long
		JRST DBGSM]
>;IFN STANSW
	LOAD T2,IHLNK,(T1)	;WHICH LINK?
	JUMPE T2,DBGOM1
IFE STANSW,<
	HRROI T2,5		;NOT CONTROL LINK
>;IFE STANSW
IFN STANSW,<
	HRROI T2,<.NBWD0+1>	;Not control link.  Assume we have a leader
				; + 1 data word
>;IFN STANSW
	JRST DBGSM
DBGOM1:	LOAD T2,NBBSZ,(T1)	;MESSAGE SIZE
	HRROS T2		;SET LH TO SHOW OUTPUT SIDE.
	JRST DBGSM

DBGIN::	SKIPN DBGINT		;WANT INTERNET MESSAGES?
	 RET			;NO.
	PUSH P,T2		;YES, SAVE AC2 OF CALLER
	LOAD T2,NBBSZ,(T1)	;GET MSG SIZE
	HRLI T2,-2		;FLAG FOR INTERNET
	JRST DBGSM		;GO STORE MESSAGE

; Store header word (in T2) and time stamp

DBGS2B:	CALL DBGS1B		;STORE ENTRY HEADER WORD
	SAVEAC <T2>
	EXCH T1,T2		;AND SAVE T1
	GTAD			;GET TIMESTAMP
	EXCH T1,T2		;RESTORE T1, TIME TO T2
	CALL DBGS1B		;STASH THE TIMESTAMP
	RET

; Store 1 word (in T2) in debug buffer

DBGS1B:	SAVEAC <T1>
	AOS T1,DBGSP		;STEP THE STORE POINTER
	CAIL T1,DBGNBF		;TO THE END OF BUFFER?
	 SETZB T1,DBGSP		;YES, WRAP AROUND
	MOVEM T2,DBGBUF(T1)	;STORE THE DATUM
	AOS DBGNWD		;COUNT IT
	RET

; Check for sufficient space to make new entry

DBGCKS:	SKIPE DBGFAC		;ANY INTERVENING FAILURES?
	 AOJA T2,DBGCK2		;YES
DBGCK1:	PUSH P,T1		;PRESERVE T1
	NOSKED			;MAKE SURE SPACE STAYS FOR CALLER
	MOVE T1,DBGNWD		;CHECK THE SPACE AVAILABLE
	ADDI T1,2(T2)		;NEED HEADER SPACE, TOO
	CAIG T1,DBGNBF		;IS THERE THIS MUCH?
	 AOSA -1(P)		;YES, SKIP RETURN
	  AOS DBGFAC		;NO, LOG FAILURE.
	POP P,T1
DBGCK3:	RET

DBGCK2:	CALL DBGCK1		;GO AHEAD AND DO CURRENT ENTRY + 1
	 SOJA T2,DBGCK3		;DID NOT HAVE SPACE
	EXCH T2,DBGFAC		;GET COUNT OF LOST ENTRIES
	HRLI T2,T1		;INDICATE TYPE OF ENTRY FOR LOSSES
	CALL DBGS1B		;LOG THE LOSSES
	SOS T2,DBGFAC		;RESTORE T2
	SETZM DBGFAC		;ZERO COUNTER OF LOSSES
	RET
>				;END OF IFN IPPDSW

IFE IPPDSW,<			;THESE ARE SUBSTITUTE ROUTINES
				;TO REPLACE THE CALLS
DGBOM:				;OUTPUT MESSAGE
DBGINM:				;REGULAR MESSAGE
DBGIIM:				;IRREGULAR MESSAGE
DBGIN::				;INTERNET
	RET			;NULL ROUTINES
>				;END OF IFE IPPDSW
	SUBTTL 1822 Input Processing

;IMICHK
;Input  processing,  maintaining  routines,  called  from  INTBP1 and
;occaisionally from CHKR to keep things moving

IFE REL6,<IMICHK::>
IFE STANSW,<
IFN REL6,<XNENT IMICHK,G>
>;IFE STANSW
IFN STANSW,<	; XNENT does its own XSWAPCD, and this should be resident
IFN REL6,<XRENT IMICHK,G>
>;IFN STANSW

IMPCHK::
	SKIPN INTON		;INTERNET INITIALIZED YET?
	 RET			;NO SO WE CAN NOT DO THIS YET
	CALL IMPGIB		;GET INPUT BUFFERS IF NEEDED
	CALL IMPIST		;START INPUT IF NEEDED
	SKIPE IMP8XC		;IRREG MSGS FOR PROCESSING?
	 CALL IMP8XM		;YES
	RET			;AND RETURN
	SUBTTL Irregular 1822 IMP to Host Message Handling

;Here  at  PI  level  to  queue an irreg Imp-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.(INF,IMPXBO,IMPDV,SOFT,<IMPDV: Irreg msg buffer overflow>,,<

Cause:	The irregular message buffer has overflowed and the monitor has had
	to discard an irregular message (message type non zero) from the IMP.
	This tends to indicate a possible hardware with the AN20 or a problem 
	with the IMP.  Analysis of other BUGxxx information should shed light
	on the real problem.

>)
	MOVE T2,T1		;POINT TO THE BUFFER
	ADDI T2,.NBLD0		;STARTING AT THE LEADER
IFE STANSW,<
	IMULI T3,.NBLD2		;THIS MANY WORDS PER IRREG MSG
	HRLI T3,-.NBLD2		;NUMBER TO COPY
>;IFE STANSW
IFN STANSW,<
	IMULI T3,ILDRSZ		;THIS MANY WORDS PER IRREG MSG
	HRLI T3,-ILDRSZ		;NUMBER TO COPY
>;IFN STANSW
I8XQL1:	MOVE T4,0(T2)		;READ A WORD
	MOVEM T4,IMP8XB(T3)	;PUT IT IN THE BUFFER
	ADDI T2,1		;TO NEXT WORD
	AOBJN T3,I8XQL1		;DO THE WHOLE LEADER
	AOS IMP8XC		;COUNT THIS MESSAGE
	RET

;Routine  to  get irreg messages from above buffering, and act on them.
;Called from INTFRK when IMP8XC says there is stuff to do.

IMP8XM:	TRVAR <IMP8CT,IMP8BA>
	SETZ T3,		;CLEAR
	EXCH T3,IMP8XC		;THE COUNTER
	MOVEM T3,IMP8CT		;SAVE THE OLD COUNTER
IMP8X1:	SOSGE IMP8CT		;DECREMENT COUNTER
	 RET			;DONE
	AOS T3,IMP8XO		;RETRIEVE STUFF FROM QUEUE
	CAIL T3,IMP8XS
	 SETZB T3,IMP8XO	;WRAPAROUND
IFE STANSW,<
	IMULI T3,.NBLD2		;WORDS PER MESSAGE
	MOVEM T3,IMP8BA		;SAVE THE BUFFER OFFSET
	MOVEI P1,IMP8XB-1(T3)	;POINT RIGHT FOR DEFSTRS
>;IFE STANSW
IFN STANSW,<
	IMULI T3,ILDRSZ		;WORDS PER MESSAGE
	MOVEM T3,IMP8BA		;SAVE THE BUFFER OFFSET
	MOVEI P1,IMP8XB-.NBLD0(T3) ;POINT RIGHT FOR DEFSTRS
>;IFN STANSW
	LOAD T1,IHADR,(P1)	;GET ADDRESS
	LOAD T2,IHNET,(P1)	;AND NET
	LSH T2,^D24		;SHIFT OVER AND
	IOR T1,T2		;MERGE THEM
	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
	JRST IMP8X1		;LOOP UNTIL NO MORE

XX==CALL IMP8XX			;UNIMPLEMENTED CODE

IMPMTT:	CALL IMPECB		;REGULAR MESSAGE (ERROR)
	CALL IMPEC1		;ERROR IN LEADER
	CALL IMPDN2		;IMP GOING DOWN
	XX			;FORMERLY BLOCKED LINK
	CALL IMPEC4		;NOP. CHECK HOST ADDRESS.
	CALL IMPEC5		;RFNM
	CALL IMPEC6		;DEAD HOST STATUS
	CALL HSTDED		;DECLARE HOST DEAD
	CALL IMPEC8		;ERROR IN DATA
	CALL IMPEC9		;INCOMPLETE TRANSMISSION
	NOP			;INTERFACE RESET MESSAGE
NIMPMT==.-IMPMTT		;RANGE CHECK FOR DISPATCH

IMPECB:	BUG.(CHK,IMPRMI,IMPDV,SOFT,<IMPDV: Regular message on irreg queue>,,<

Cause:	The monitor has detected a type zero message on the irregular message 
	queue.  This is not supposed to happen and indicates a software problem
	in the monitor.

>)
	RET
	SUBTTL Irregular 1822 Message Processors

;P1 points to message in buffer.
;T1 contains host number
;T2 contains link number
;T3 contains the message type, which caused the dispatch
;T4 contains subtype of this msg

;Error in leader (type 1)

IMPEC1:	TXNN  T1,77777777	;IS HOST FIELD ZERO?
	 RET			;SOME PHONY ONES COME FROM SITE ZERO
	JUMPE T4,IMPEC8		;IF SUBTYPE ZERO, RETRANSMIT
	JRST IMP8XX		;ANYTHING ELSE SHOULD GET PRINTED

;Imp going down (type 2)

IMPDN2:	MOVE T2,.NBLD1(P1)	;GET 16 BITS OF DATA
	MOVE T3,.NBLD2(P1)	;DESCRIBING THE OUTAGE
	LSHC T2,^D12		;BUILD IN ONE WORD
	ANDX T2,<177777B31>
	MOVEM T2,IMPGDM		;SAVE IT FOR PRINTING

;Only one cell for all nets at present

	AOS JB0FLG		;HAVE JOB ZERO WORRY ABOUT IT
	RET

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

IMPEC4: CALL LCLHST 		;SEE IF ITS ONE OF ME
	BUG.(INF,IMPHNW,IMPDV,SOFT,<IMPDV: LHOSTN disagrees with the IMP>,,<

Cause:	The monitor has received a NOP message from the IMP with an address
	that disagrees with our known address.  The IMP has been known to send
	corrupted NOP message in the past but the problem is probably
	that the SYSTEM:INTERNET.ADDRESS file has the wrong address for the 
	AN20 interface.

>)
	RET			;DONE WITH THE NOP

IMPEC5:	RET			;RFNM RECEIVED

;Dead host status (type 6)

IMPEC6:	CALL HSTHSH		;GET TABLE INDEX FOR HOST NUMBER
	 JUMPL T2,R		;NO ROOM, IF JUMP. ELSE NEW.
	MOVEM T1,HOSTNN(T2)	;PUT HOST NUMBER IN HASH TABLE, IF NEW
	MOVE T3,.NBLD1(P1)	;COLLECT REASON AND TIMES FROM IMP
	MOVE T4,.NBLD2(P1)
	LSHC T3,-^D<36-8>
	ANDI T4,177777		;KEEP 16 BITS
	IORI T4,(HS%VAL)	;MARK AS VALID
	HRLM T4,HSTSTS(T2)	;ALL STATS INTO LH
	RET			;AND RETURN

;Destination dead (type 7)
;Host Dead, Host number in T1

HSTDED:	CALL HSTHSH		;FIND HASH INDEX FOR HOST IN T1
	 JUMPL T2,HSTDD1	;IF NO ROOM, JUMP AROUND
	MOVEM T1,HOSTNN(T2)	;UPDATE HOST NUMBER, IN CASE NEW.
	MOVX Q1,HS%UP		;CLEAR THE UP/DOWN FLAG FOR HOST
	ANDCAM Q1,HSTSTS(T2)	;MARK HIM DOWN
HSTDD1:	RET

;Error in data & incomplete transmission (types 8 & 9)

IMPEC8:				;ERROR IN DATA
	BUG.(INF,IMPERN,IMPDV,HARD,<IMPDV: Received error notification message>,<<T1,HOST>,<T2,LINK>,<T3,TYPE>,<T4,SUBTYP>>,<

Cause:	The IMP has detected an error in the last message transmitted to it.
	The error is after the leader but before the end of the message.  This
	may indicate possible hardware problems in the AN20.

>)
	RET

IMPEC9:	ret			;INCOMPLETE TRANSMISSION
	BUG.(INF,IMPINC,IMPDV,SOFT,<IMPDV: Received incomplete transmission message>,<<T1,HOST>,<T2,LINK>,<T3,TYPE>,<T4,SUBTYP>>,<

Cause:	The IMP has declared that the last message transmitted to it
	was incomplete.  This may indicate possible hardware problems 
        with the AN20 or the following conditions (subtypes):

	0.  The destination host did not respond quickly enough to the message.

	1.  The message was too long.

	2.  The AN20 took more than 15 seconds to transmit the message to the
	    IMP.

	3.  The message was lost in the network due to an IMP or circuit failure.

	4.  The IMP could not accept the message within 15 seconds due to a
	    unavailable resources.

	5.  The IMP had an IO failure during the receipt of this message.

>)
	RET

IMP8XX:	BUG.(INF,IMPXUT,IMPDV,SOFT,<IMPDV: Received irreg msg with unknown link or type>,<<T1,HOST>,<T2,LINK>,<T3,TYPE>,<T4,SUBTYP>>,<

Cause:	The monitor received an irregular message that either could not be
	identified or is not supported by the monitor.

>)
	RET
	SUBTTL Output Done Handling - Queue for Retransmission

;Here  on PI level from device routine after sending out last word of
;a buffer. Put it on retransmission queue if regular link,  and  rfnm
;still outstanding. else put it on free list.

; P1 - Contains pointer to NCT

IMODUN::
IFN NICSW,<
	CAMN P1,[6,,.NCT0]	;milnet?
	 AOS IS.IMI
	CAMN P1,[6,,.NCT1]	;arpanet?
	 AOS IS.IAR
>
	MOVE T1,NTOB(P1)	; Get buffer location
	HRRE T2,NTBFFL(P1)	; Find out who owns IMPOB
	JUMPL T2,IMODN3		; Jump if Internet
	MOVE T2,NTOB(P1)	; GET BUFFER ADDRESS
	JRST IMPRBF		; RELEASE OR PUT ON FREE LIST

IMODN3:	MOVE T2,T1		; Copy for indexing
	PIOFF
	EXCH T1,INTNFB		; Put on free list
	STOR T1,NBQUE,(T2)	; Hang old list off of this new head
	PION
	AOS INTFLG		; Get Internet gateway to notice it
	RET

;IMPQOA - Queue host-imp messages on 1822 type nets
;Buffer addr in T2

IMPQOA:	SAVET			; Save some scratch
	CALL IMPLKB		; Lock bfr for pi service routine
	LOAD T1,IHHT2,(T2)	; Check msg's priority
	XMOVEI T3,NTLSND	; Low priority Q routine
	TRNE T1,<HTY%HP>_-4	; Is priority bit set in message
	 XMOVEI T3,NTHSND	; High priority q routine
	LOAD T1,IHADR,(T2)	; get address
	LOAD T4,IHNET,(T2)	; And net
	LSH T4,^D24		; Put in right position
	IOR T1,T4		; put in net field
	CALL @T3		; Put on proper Q
	 SKIPA			; error
	RET			; And return
	MOVE T1,T2		; Put buffer into right reg
	CALLRET IMPRBF		; RELEASE OR PUT ON FREE LIST
	SUBTTL IMPHDR - Create Arpanet local leader from Internet V4 leader

; called w/	T1 - Local address to send to
;		T2 - Pointing MAXLDR (defined in INPAR) words above
;			an Internet buffer,
;			returns with T2 pointing to the local leader
;			(actually the link,,size word just before it)
;		P1 - NCT address

IMPHDR::
	MOVE T4,MAXLDR+.IPKVR(T2) ; Get IP header word containing TOS
IFE STANSW,<
IFL MAXLDR-.NBHHL,<
PRINTX ?ERROR MAXLDR is less than the IMP header
>
IFN MAXLDR-.NBHHL,<		; If we aren't the maximimum leader
	LOAD T3,NBBSZ,(T2)	; Get size word
	SUBI T3,MAXLDR-.NBHHL	; adjust for our header size
	ADDI T2,MAXLDR-.NBHHL	; Point to actual start of our header
	STOR T3,NBBSZ,(T2)	; Store it here
>
>;IFE STANSW
IFN STANSW,<
IFL MAXLDR-HLDRSZ,<
PRINTX ?ERROR MAXLDR is less than the IMP header
>
>;IFN STANSW
	SETZM .NBLD0(T2)	; Clear 1st word of leader
	SETZM .NBLD1(T2)	; Clear other words
	SETZM .NBLD2(T2)	; ..
	TDZ T1,NTNLHM(P1)	; Clear logical host bits from destination
	STOR T1,IHADR,(T2)	; Store destination address

;NOTE:
;we  don't  set  the  network  part  of the leader since it should go
;directly from here to the interface Note T1 now free

	MOVX T3,INTLNK		; Get link
	STOR T3,IHLNK,(T2)	; Set it in leader
	MOVX T3,ITY%LL		; New format flag
	STOR T3,IHFTY,(T2)	; Set it in leader
IFN <PIPRC-7B10>,<PRINTX ? Fix PIPRC mask>
	MOVX T3,<HTY%HP_<-4>>	; Bit in split word
	TXNE T4,<4B10>		; High priority?
	  STOR T3,IHHT2,(T2)	; Yes, set bit
	TXNE T4,<PILDY>		; Unless request "low delay"
	 TXNE T4,<PIHRL>	; and "low reliability"
	  TDZA T1,T1		; Message sub-type 0
	   MOVX T1,3		; If both, message sub-type 3
	LOAD T3,NBBSZ,(T2)	; Get size, bytes
	SUBI T3,.NBHHL		; (Pseudo and real) header words
	ASH T3,2+3		; Make into bits
	CAILE T3,^D1008-1	; Uncontrolled flow must be single packet
	 MOVX T1,STY%FC		; Too big, must use Normal flow-controlled
	RET			; And return
	SUBTTL IMPEIN - End of Input Handling

;Here  from  input  driver after device specific operations done, and
;packet has been recieved called with P1 pointing to NCT  for  device
;This  is  a  common  END  OF  INPUT  routine  for  1822 ARPANet Type
;networks, It is entered both from the IMP10 and the  AN10/20  device
;drivers with P1 Pointing to the active NCT

IMPEIN::
	SKIPG T1,NTIB(P1)	; Bfr address
	 JRST IMPEI2		; Wasn't one
	MNTCALL NTSCHK		; Check status
	 JRST IMPEI3		; error occured, drop it
	AOSG NTFLS(P1)		; Flushing msgs?
	 JRST IMPEI3		; Yes, return to free list
	HRRZ T2,NTINP(P1)	; How much was read?
	CAIGE T2,.NBLD2(T1)	; A full leader?
	 JRST IMPEI3		; No, Discard it as useless
	MOVE T2,NTNET(P1)	; get network number from NCT
	STOR T2,IHNET,(T1)	; Stick it into buffer header
	LOAD T3,IHFTY,(T1)	; Is this a long leader msg?
	CAIE T3,ITY%LL		; ..
	 JRST IMPEI3		; No. Just throw it away.
	LOAD T3,IHMTY,(T1)	; get the message type.
	JUMPN T3,IMPEI4		; Put 1822 Irregular messages on the queue.
IFN NICSW,<
	CAMN P1,[6,,.NCT0]	;milnet?
	 AOS IS.IMI+1
	CAMN P1,[6,,.NCT1]	;arpanet?
	 AOS IS.IAR+1
>
	SKIPL NTBFFL(P1)	; Skip if Internet owns IMIB
	 JRST IMPEI3		; not internet so drop on the floor
	LOAD T3,NBBSZ,(T1)	; Get size of buffer
	CAMLE T3,MAXWPM		; Check size field
	BUG.(HLT,IMPIWW,IMPDV,SOFT,<IMPDV: Internet bfr word size wrong>,,<

Cause:	The monitor has detected an illegal size in the NBBSZ field of an
	internet buffer.  This indicates the buffer is probably smashed.
	This is probably a software problem.

>)
IFE STANSW,<
	SUBI T1,MAXLDR-.NBHHL	; Correct for different leader lengths
	STOR T3,NBBSZ,(T1)	; Put size in right place
>;IFE STANSW
	MOVE T3,INTIBI		; Queue for Internet gateway
	JUMPN T3,IMPE00
	MOVEM T1,INTIBO		; ...

	SKIPA			; ...
IMPE00:
	STOR T1,NBQUE,(T3)
	MOVEM T1,INTIBI
	AOS INTFLG		; Cause Internet process to notice it
	LOAD T3,NBBSZ,(T1)	; Make sure not a released buffer
	CAMLE T3,MAXWPM		; by checking size field for a PC
	 CALL IMPAFB		; Bughlt if so
	LOAD T3,EXPCBT,+NTINP(P1) ; Get last loc with data +1
	SUB T3,NTIB(P1)		; Less base of the buffer
	STOR T3,NBBSZ,(T1)	; RECORD ACTUAL COUNT IN BUFFER HEADER
REPEAT 1,<			; MAY NOT WANT THIS CODE
	LOAD T2,IHNET,(T1)	; GET NET
	LSH T2,^D24		; SHIFT OVER WHERE IT SHOULD BE
	LOAD T1,IHADR,(T1)	; AND ADDRESS
	IOR T1,T2		; MERGE THEM
	CALL HSTHSH		; FIND HASH INDEX FOR HOST IN T1
	 NOP			; NON-SKIP IF NEW OR NO ROOM
	IFGE. T2		; DON'T TRY TO DO IT UNLESS WE HAVE A SLOT
	  MOVEM T1,HOSTNN(T2)	; UPDATE HOST NUMBER, IN CASE NEW
	  MOVX T1,HS%UP!HS%VAL	; SET UP AND VALID FLAGS FOR HOST
	  IORM T1,HSTSTS(T2)
	ENDIF.
>
IMPEI2:	SETZM NTIB(P1)
	MNTCALL NTISRT		; Start new input
	RET			; And done

IMPAFB:	BUG.(HLT,IMPULF,IMPDV,SOFT,<IMPDV: attempt to unlock buffer on freelist>,,<

Cause:	The monitor has either attempted to unlock a buffer on the free
	buffer list or the buffer is smashed.  This probably indicates a 
        software problem.

>)
	RET			; If comes back

IMPEI4:	CALL IMP8XQ		; Put on irreg msg Q for 1822 stuff
	AOS INTFLG		; Awaken INTFRK
IMPEI3:	MOVE T2,T1		; Copy for indexing below
	SKIPL NTBFFL(P1)	; NTIB owned by 1822 stuff?
	 JRST IMPEI6		; Yes.  Release to normal area
	EXCH T1,INTFRI		; Release to Internet
	STOR T1,NBQUE,(T2)
	AOS INTNFI		; Count another free buffer
	JRST IMPEI2
IMPEI6:
	CALL IMPRBF		; Release buffer
	JRST IMPEI2
	SUBTTL 1822 Buffer Handling Routines

RELBUF:	SAVET			; Release an 1822 buffer
	MOVE T3,T2		; Get the Buffer address
	XMOVEI T1,FRELCK	; The lock address
	XMOVEI T2,RET18B	; The Release routine
	CALL LCKCAL		; Lock the lock and call the routine
	RET			; Return to caller

ASNTBF:				;ASSIGN 1822 BUFFERS
	STKVAR <ATBSZ>
	MOVEM T2,ATBSZ		;SAVE THE SIZE
	CAMLE T2,MAXWPM		;BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
	 JRST ASNTBX		;REFUSE, TOO LARGE
	XMOVEI T1,FRELCK	;USE FRELCK FOR THIS 
	XMOVEI T2,GET18B	;GET AN 1822 BUFFER
	CALL LCKCAL		;LOCK THE LOCK AND CALL THE FUNCTION
	JUMPE T1,ASNTBX		;ZERO ADDRESS, NONE AVAILABLE
	MOVE T2,ATBSZ		;GET THE SIZE
	STOR T2,NBBSZ,(T1)     	;STASH REQUESTED SIZE
	RETSKP			;SKIP RETURN FOR SUCCESS
ASNTBX:	BUG.(INF,NETABF,IMPDV,SOFT,<IMPDV: Assign of buffer failed>,,<

Cause:	The monitor has tried to assign an 1822 buffer and has failed or
	an illegal size for the buffer was requested.  This probably indicates
	a software problem.

>)
	RET			;FAILURE RETURN

IMPGIB:				;GET 1822 INPUT BUFFERS
	SKIPG T2,IMPNFI		;ARE THERE ANY BUFFERS NOW?
	 SETOM NOIBFS		;NO FLAG THAT COUNT HIT ZERO
	CAML T2,IMPNIB		;DO WE NEED SOME?
	 RET			;NO SO RETURN
	MOVE T2,MAXWPM		;GET THE SIZE OF A BUFFER
	CALL ASNTBF		;YES SO GET A BUFFER
	 JRST IMPGB2		;FAILED
	MOVE T2,T1		;GOT ONE.  PUT THE ADDRESS INTO T2
	CALL IMPLKB		;LOCK DOWN THE BUFFER
	PIOFF			;SIEZE THE MACHINE
	EXCH T2,IMPFRI		;PUT BFR ON INPUT FREE LIST
	STOR T2,NBQUE,(T1)     	;PUT OLD TOP OF LIST IN NEW BUFFER
	AOS IMPNFI		;COUNT THE FREE BUFFERS
	PION			;GIVE BACK THE MACHINE
	JRST IMPGIB		;SEE IF WE NEED MORE

IMPGB2:				;HERE WHENWE FAILED TO GET A BUFFER
	SKIPN IMINFB		;ANY BUFFERS RELEASE BY PI ROUTINES?
	 RET			;NO SO WE ARE DONE
	SAVET			;YES SO SAVE SOME ACS
	CALL IMINRB		;AND RELEASE THE BUFFERS
	RET			;AND RETURN TO CALLER
	SUBTTL More 1822 Buffer Handling Routines

RLNTBF:	SAVET			;RELEASE 1822 BUFFER (Address in T2)
	SETSEC T2,INTSEC	;THIS IS IN INTSEC
	LOAD T3,NBBSZ,(T2)     	;GET COUNT FIELD
	CAMLE T3,MAXWPM		;MAKE SURE NOT ALREADY ON FREELIST
	BUG.(INF,NETRBF,IMPDV,SOFT,<IMPDV: Release of 1822 buffer failed>,,<

Cause:	The monitor has attempted to release an 1822 buffer and has determined 
	that the buffer is already released or has been smashed.  This 
	probably indicates a software problem.
>)
	CALL RELBUF		;RELEASE THE BUFFER
	RET			;AND RETURN TO CALLER

IMINRB::SETZ T1,		;RELEASE BUFFERS LEFT BY PI ROUTINES
	EXCH T1,IMINFB		;GET ALL GARBAGE BUFFERS
IMINR1:	TRNN T1,777777		;ALL RELEASED?
	 RET			;YES SO ALL DONE
	SETSEC T1,INTSEC	;IN THE RIGHT SECTION
	LOAD T2,NBQUE,(T1)     	;FOLLOW DOWN ANY CHAIN
	CALL IMPULK		;UNLOCK AND RELEASE THE BUFFER
	MOVE T1,T2		;GET THE NEXT BUFFER ADDRESS
	JRST IMINR1		;SEE IF ANY MORE ON CHAIN

IMPRBF:				;PUT BUFFER ON RELEASED QUEUE OR FREELIST
	PIOFF			;SIEZE THE MACHINE
	MOVE T1,IMPNFI		;GET NUMBER OF FREE BUFFERS
	CAML T1,IMPNIB		;DO WE HAVE ENOUGH?
	 JRST IMPRB1		;YES
	MOVE T1,MAXWPM		;NO. THIS IS A FULL SIZE BUFFER
	STOR T1,NBBSZ,(T2)     	;MARK THE BUFFER AS FREE
	MOVE T1,T2		;COPY ADDRESS
	EXCH T1,IMPFRI		;PUT ON THE FREE LIST
	STOR T1,NBQUE,(T2)     	;FIX UP THE TAIL POINTER
	AOS IMPNFI		;KEEP COUNT OF THEM
	PION			;GIVE BACK THE MACHINE
	RET			;AND RETURN TO CALLER

IMPRB1:				;HERE WHEN WE ALLREADY HAVE ENOUGH ON FREELIST
	MOVE T1,T2		;COPY ADDRESS
	EXCH T1,IMINFB		;TO BE GARBAGE COLLECTED 
	STOR T1,NBQUE,(T2)     	;FIXUP THE TAIL POINTER
	PION			;GIVE BACK THE MACHINE
	AOS INTFLG		;CAUSE INTERNET FORK TO RELEASE THESE
	RET			;AND RETURN TO CALLER
	SUBTTL IMPCLQ - Clear IMP Queues

;Called with P1 pointing to an NCT for an 1822 type net

IMPCLQ:
	NOSKED			;PREVENT CONFUSION
	PIOFF			;GRAB ENTIRE MACHINE
	SETZB T2,NTHOBI(P1)	;ZERO THE TAIL POINTER
	EXCH T2,NTHOBO(P1)	;DISCARD EVERYTHING ON OUTPUT QUEUES
	PION			;LET IT GO AGAIN NO THAT Q IS SAFE
	CALL IMPMUL		;DEQUEUE EVERYTHING ON HIGH Q
	PIOFF			;GRAB ENTIRE MACHINE
	SETZB T2,NTLOBI(P1)	;ZERO THE TAIL POINTER
	EXCH T2,NTLOBO(P1)	;GRAB THE LOW PRIORITY OUTPUT Q
	PION			;GIVE BACK THE MACHINE
	CALL IMPMUL		;DISCARD THESE
	PIOFF			;TAKE THE MACHINE AGAIN
	SETZB T2,NTIOBI(P1)	;CLEAR INTERNET Q INPUT TAIL POINTER
	EXCH T2,NTIOBO(P1)	;GET THINGS ON INPUT QUEUE
	PION			;GIVE IT BACK
	CALL IMPMUL		;CLEAR 1 LOCKED THINGS (INTERNET)
	SKIPLE T1,NTOB(P1)	;ANYTHING HERE?
	 CALL IMPULK		;UNLOCK AND RELEASE
	SETZM NTOB(P1)		;NOW NO OUTPUT IN PROGRESS
	SKIPE T1,NTIB(P1)	;ANYTHING IN INPUT PI SLOT??
	 CALL IMPULK		;YES, CLEAR IT
	SETZB NTIB(P1)		;NOTHING THERE NOW
	OKSKED			;LET THE SCHEDULER RUN
	RET			;AND RETURN TO CALLER
	SUBTTL 1822 Buffer Unlocking and Locking

;N.B.
;These routines assume that MAXWPM will never be greater than a page.

;IMPMUL	Same as IMPULK, but for a whole list

IMPMUL:	TRNN T2,-1		;ANY MORE ON LIST?
	 RET			;NO.
	MOVE T1,T2		;YES, GET CURRENT ONE
	LOAD T2,NBQUE,(T1)	;GET ITS SUCCESSOR, IF ANY
	SETSEC T2,INTSEC	;IN THE RIGHT SECTION
	CALL IMPULK		;RELEASE IT.
	JRST IMPMUL		;TRUCK ON DOWN THE CHAIN

; Unlock and Release individual buffers

IMPULK:	SAVEAC <T2,T3>		; common routine
	STKVAR <IULKB,IULIM>
	MOVEM T1,IULKB
	LOAD T1,NBBSZ,(T1)	; Get count field
	CAMLE T1,MAXWPM		; Make sure not on freelist
	 CALL IMPAFB		; Attempt to unlock buffer on freelist
	MOVEM T1,IULIM		; save the limit
	MOVE T1,IULKB		; get the buffer address again
	CAML T1,[INTSEC,,BF1822] ; Does this buffer look ok?
	 CAML T1,[INTSEC,,BF1822+<BF18SZ*INTBSZ>] ; ?
	  SKIPA			; nope.
	   JRST IMPULN		; handle 1822 buffers differently
	MOVE T2,IULKB		; Pointer to IMP part of packet
	CALL INTRBF		; Release to Internet area
	RET

IMPULN:				; unlock a buffer
	IFE REL6,<CALL MULKSP>	; unlock the first part of the buffer
	IFN REL6,<CALLX (MSEC1,MULKSP)> ; unlock the first part of the buffer
	MOVE T1,IULKB		; get the buffer address
	ADD T1,IULIM		; add in the length
	SUBI T1,1		; determine last word of the buffer
	IFE REL6,<CALL MULKSP>	; unlock the last part of the buffer
	IFN REL6,<CALLX (MSEC1,MULKSP)> ; unlock the last part of the buffer
	MOVE T2,IULKB		; Get back buffer address
	CALL RLNTBF		; And release the buffer
	RET

IMPLKB:				; lock an 1822 buffer
	SAVEAC <T1,T2>
	LOAD T1,NBBSZ,(T2)	; GET SIZE FIELD
	CAMLE T1,MAXWPM		; MAKE SURE NOT ON FREELIST
	BUG.(HLT,IMPLKF,IMPDV,SOFT,<IMPDV: Attempt to lock buffer on freelist>,,<

Cause:	The monitor has attempted to lock a buffer into memory in preparation 
	for IO and has determined that the buffer is not assigned or has been 
	smashed.  This probably indicates a software problem.

>)
	ADD T1,T2		; determine the last word of the buffer
	SUBI T1,1		; off by one
	CALL INTLKW		; Lock the end
	MOVE T1,T2		; get the beginning address
	CALL INTLKW		; Lock the beginning
	RET			; and return to caller
	SUBTTL 1822 Interface State Handling

;IMPSTS - Check status of AN 1822 interface
;P1/	NCT address
;CALL IMPSTS

IMPSTS::AOSE NTERRF(P1)		; Was error flop noticed set?
	 MNTCALL NTSCHK		; No,  Is ready line up?
	  JRST IMPSTA		; Error flop set or we are now down.
	SKIPGE NTXDNT(P1)	; Was it down before?
         JRST IMPSTB		; No, so continue
	SETOM NTXDNT(P1)	; Was down before.  Not down now.
	GTAD%			; Get the time
	MOVEM T1,NTXUPP(P1)	; Record time back up
	JRST IMPSTB		; Continue

IMPSTA:				; Here when Imp had an error or is or was down.  
	SKIPN NTRDY(P1)		; Do we think its supposed to be up?
         JRST IMPSTB		; we think it is down. Don't record it.
	SKIPL T1,NTXDNT(P1)	; Was it down?
         JRST IMPSTC		; Yes so cycle NCP
	GTAD%			; no so get get time now
	MOVEM T1,NTXDNT(P1)	; record when in went off
	JRST IMPSTB		; Continue
; Bring state of NCP into agreement with state of IMP and NETON/IMPDRQ

IMPSTC:	HRRZS NETON(P1)		; declare IMP down, cycle 1822
IMPSTB:	SKIPLE T1,NTRDY(P1)	; Down cycle in progress?
	 JRST IMPDWN		; Yes. Complete it.
	JUMPL T1,IMPUP		; Jump if we think IMP is up
	SKIPE NETON(P1)		; IMP is off. Do we want it off?
	 SKIPLE NTSTCH(P1)	; No.  But wait if state change unreported
	  RET			; Off and we want it off.  Do nothing.
	MNTCALL NTRSRT		; Off and we want it on.  Restart it.
	RET			; return

IMPUP:	 			; Here when IMP is up
	SKIPLE NTNOP(P1)	; Should we be sending any NOPs?
         MNTCALL NTOSRT		; Yes so start up output.
	SKIPL NETON(P1)		; Do we want it down?
         JRST IMPUP2		; Yes go make it down
	SETZM HSTGDM(P1)	; Else it's up. Cancel going down message.
	RET
IMPUP2:				; Shut down IMP &  NCP for a net
	SKIPLE NTSTCH(P1)	; Unreported state change left?
	 RET		       	; If so, wait for that to type out
	MOVX T1,^D15000		; Begin down sequence
	ADD T1,TODCLK
	MOVEM T1,NTRDY(P1)	; When to give up and turn NCP off.
	SETZM IMPTIM		; Now
	AOS NTSTCH(P1)		; Note state change.
	AOS JB0FLG		; Get JOB0 to print it.
	RET
	SUBTTL IMPDWN -  Down Sequence in Progress

;T1/ NTRDY .ge. 0 is time to abort

IMPDWN:	CAMLE T1,TODCLK		; Has time run out?
	 MNTCALL NTSCHK		; No.  Check Hardware status
	  JRST IMPDW2		; Yes. IMP is down. Just pull the plug.
	SKIPG NTSTCH(P1)	; Else if change unreported
	 SKIPL IMPCCH(P1)	;  or RST's not all sent
	  RET			;  then wait.
	SETZM NTORDY(P1)	; Shut off output (No more output queued)
	SKIPN NTHOBO(P1)	; Check if both output queues are empty.
	 SKIPE NTLOBO(P1)	; ..
	  RET			; If not, then wait.
	SKIPLE NTOB(P1)		; If last message not completely sent
	  RET			;  then wait.
	SETZM HSTGDM(P1)	; Now stop sending host going down.
IMPDW2:	SETZM NTRDY(P1)		; Now say totally down
	SETO T1,		; Entry to abort
	MNTCALL NTKILL		; Disable hardware completely
	AOS NTSTCH(P1)		; Report final state change
	AOS JB0FLG
	CALL IMPCLQ		; Clear queues
	RET
	SUBTTL Start input and Initialization

IMPIST:	SKIPN NOIBFS		; Did we ever run out of input buffers?
	 RET			; No, must be running
	SETZM NOIBFS		; Clear flag
	SKIPA P1,NCTVT		; Get first address
IMPIS1:	LOAD P1,NTLNK,(P1)	; Get link to next
	JUMPE P1,R		; If done
	LOAD T1,NTTYP,(P1)	; Get type
	CAIN T1,NT.NCP		; NCP?
	 MNTCALL NTISRT		; Yes, start input if needed
	JRST IMPIS1		; Loop through all

; Initialization -  Called at process level by INTFRK
; Initializes all common variables and each NCP type network

IMPIN0::
	MOVEI T1,NIMPIB		; Reduced number of input buffer
	MOVEM T1,IMPNIB		; Save number of 1822 buffers to keep around
	MOVSI T2,-NSQ		; Empty and free all special queues
IMPIN2:	SETOM SQJOB(T2)		; Free special queue
	AOBJN T2,IMPIN2		; if not done continue
	SETOM SQLCK		; reset the special queue lock
	CALL IMPRSN		; Reset variables
	SKIPA P1,NCTVT		; Point to first NCT
IMPIN1:	LOAD P1,NTLNK,(P1)	; Get next on list
	JUMPE P1,R		; If done
	LOAD T1,NTTYP,(P1)	; Get type
	CAIE T1,NT.NCP		; 1822?
	 JRST IMPIN1		; No, try next
	SETZM HSTGDM(P1)	; Cancel any residual host going down
	GTAD%			; get time now
	MOVEM T1,NTXDNT(P1)	; Store as last time net went off
	JRST IMPIN1		; And loop

IMPRSN:	SETZM IMP8XI		; Clear irreg msg q variables
	SETZM IMP8XO
	SETZM IMP8XC
	MOVEI T1,^D1000		; Start probeing hosts
	ADD T1,TODCLK		; After NOPs etc ave had a chance to settle
	MOVEM T1,IMPTIM		; ...
	RET
      SUBTTL IMPHLT - Take network down

; Accepts in
;	T1/	; Reason for going down (a la 1822)
;	T2/	; Time when back up (GTAD standard form)
;	P1/	; Pointer to NCT

IMPHLT::
	SKIPN NETON(P1)		; Is it on?
         RET			; No. Do nothing
	ANDI T1,17		; Isolate 4-bit reason for going down
	PUSH P,T1		; Save it
	GTAD%			; Get now
	CAMG T2,T1		; Is time back up later than now?
	 JRST [	MOVEI T1,177776	; No
		JRST IMPHL1]	; Time back up not known
	ADD T1,[6,,0]
	CAMG T1,T2		; More than 6 days away?
	 JRST [	MOVEI T1,177777	; Yes
		JRST IMPHL1]
	MOVX T4,<IC%DSA!IC%UTZ>	; Use GMT standard time
	ODCNV			; Separate into day, second etc
	HRRZ T1,T3		; Day of week
	HRRZ T2,T4		; Seconds since midnight
	IDIVI T2,^D300		; Convert seconds to 5 min
	IDIVI T2,^D12		; Separate into hour and 5 min
	LSH T1,5
	IORI T1,(T2)		; Insert hour of day
	LSH T1,4
	IORI T1,(T3)		; And 5 min part of hour
IMPHL1:	LSH T1,4		; Room for reason
	IOR T1,0(P)
	PIOFF
	SETZM NETON(P1)		; Start net down
	MOVEM T1,HSTGDM(P1)
	PION
	MNTCALL NTOSRT		; Go start output
	ADJSP P,-1		; FIX UP THE STACK
	RET
	SUBTTL IMP Special Queue Stuff - ASNSQ% JSYS

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

IFE REL6,<.ASNSQ::>
IFN REL6,<XNENT .ASNSQ,G>
	MCENT			; Assign a special message queue
	SKIPN NETSUP		; Things initialized yet?
	  RETERR(ASNSX1)	; No, cannot have a queue
	CALL CKNTWZ
	 RETERR
	CALL ASNSQ0		; Work routine
	 RETERR			; Fail, return error code
	XCTU [HRRZM P3,1]	; Success, return a queue number
	SMRETN			; 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

ASNS32:				; Here for old style mask and value arguments
	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
	 CALL 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
	RETSKP			; Good return to jacket routine

ASNSQF:	MOVEI T1,ASNSX2
ASNSF1:	SETOM SQLCK
	RET			; Fail return to jacket routine
	SUBTTL RELSQ% JSYS - Release Special Q

;T1/  SPECIAL QUEUE HANDLE, OR -1 FOR ALL

IFE REL6,<.RELSQ::>
IFN REL6,<XNENT .RELSQ,G>
	MCENT			; Enter monitor context
				; Need following to keep LOGOUT from hanging on SQLCK
	SKIPN NETSUP		; Things initialized yet?
	  MRETNG		; No, cannot have queue to release
	NOINT			; Cover the use of SQLCK
	AOSE SQLCK		; Try to get it
	 CALL SQLWAT		; Failed. Wait.
	CAMN T1,[-1]		; User want to release all Q's?
	 JRST RELASQ		; Yes.
	CAIL T1,0		; No. Legal Q number?
	CAIL T1,NSQ		; ..
	 JRST RELSQ1		; No. Just ignore the call
	CALL REL1SQ		; Release just one.
RELSQ1:	SETOM SQLCK		; Free the lock
	MRETNG

RELASQ:	MOVSI T4,-NSQ		; Here to release all Q's for this job
RELAS1:	HRRZ T1,T4		; Try to release this one
	CALL REL1SQ		; ..
	AOBJN T4,RELAS1		; Now try the rest
	JRST RELSQ1		; Release lock and return good.

REL1SQ:	HRRZ T2,SQJOB(T1)	; Who owns this queue?
	CAME T2,JOBNO		; Is it me?
	 RET			; No, so just forget it
	SETOM SQJOB(T1)		; Yes. Release it
REL1S1:	CALL SIQGET		; Better discard any messages
	 RET			; No more.
	CALL RLNTBF		; Release this one
	JRST REL1S1		; Keep on till all released
	SUBTTL RCVIM% JSYS - Receive Raw Message

;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

IFN REL6,<
	SWAPCD
.RCVIM::XCALLRET (XCDSEC,RCVIMM)
	XSWAPCD
RCVIMM:>       			; END OF IFN REL6
IFE REL6,<.RCVIM::>
	MCENT			; Standard JSYS entry
	SKIPN NETSUP		; Things initialized yet?
	 RETERR(SQX2)		; No, cannot have a queue to read
RCVIM1:	NOINT			; Cover lock of SQLCK
	UMOVE P1,1		; Get user's arguments
	HRRZ T1,P1		; Verify the queue handle
	CALL CHKSQ		; Check for accessibility to special Q
	 JRST MRETNE		; No access
	CALL SIQGET		; Get the message, full addr in T2
	 JRST [	OKINT		; None there
		MDISMS		; Wait for one to arrive
		JRST RCVIM1]	; Try again
	JUMPGE P1,RCVIM0	; Jump if 32 bit leader
	DMOVE T3,.NBLD1(T2)	; If 96 bits, make 3 32 bit words
	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
	DMOVE T3,.NBLD0(T2)	; First 72 bits of leader
	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
	DMOVEM T3,.NBLD0(T2)	; Restore 64 bits to buffer
RCVIM0:	TLNE P1,(1B1)		; User want data in 32 bit form?
	JRST RCVI1X		; Yes. Don't need to convert it
	MOVE P2,T2		; Need to convert back to 36 bit form
	ADDI P2,.NBLD2+1	; Point to second word of data
	MOVE Q2,T2		; And make writer pointer, too
	ADDI Q2,.NBLD2		; But points to first word of data
	LOAD Q3,NBBSZ,(T2)	; How many words in buffer
	ADD Q3,T2		; Word after last one to read
	MOVSI T1,-10		; State counter
RCVIL1:	DMOVE T3,-1(P2)		; Get some IMP bits
	CAML P2,Q3		; Beyond real end of data?
	MOVEI T4,0		; If so, make zeros for padding
	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,
	CAMG P2,Q3		; Read them all?
	AOJA P2,RCVIL1		; No, loop some more.
	SUB Q2,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
IFN STANSW,<
	SUBI Q2,.NBLD0		; Get size of message + leader
>;IFN STANSW
	UMOVE T1,2		; Get user's buffer
	HRRZ T3,Q2		; Size of buffer in monitor
	SKIPL P1		; User want short leaders?
	SUBI T3,2		; Yes, he will get only this length.
IFE STANSW,<
	UMOVEM T3,.NBHDR(T1)	; Give user the size he will see
>;IFE STANSW
IFN STANSW,<
	UMOVEM T3,0(T1)		; Give user the size he will see
>;IFN STANSW
	PUSH P,T2		; Don't clobber buffer address
	MOVEI T3,1(T1)		; Word after user's header
IFE STANSW,<
	AOS T2			; Word after monitor bfr header
>;IFE STANSW
IFN STANSW,<
	ADDI T2,.NBLD0		; Get address of beginning of the leader
>;IFN STANSW
	MOVEI T1,0(Q2)		; Count to move to user space
	JUMPL P1,RCVI1Y		; No corrections if user gets long ldr
	ADDI T2,2		; Start two words later in buffer
	SUBI T1,2		; And xfer two fewer, if old style leader
RCVI1Y:	CALL BLTMU		; Give words to user
	POP P,T2		; Get back pointer to buffer
	JUMPL P1,RCVIM2		; If wants long ldr, go give it to user

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

	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
IFE STANSW,<
	UMOVE T3,.NBLD0(T1)	; Preserve 4 data bits, if 36 bit
>;IFE STANSW
IFN STANSW,<
	UMOVE T3,1(T1)		; Preserve 4 data bits, if 36 bit
>;IFN STANSW
	ANDI T3,17		; That's these
	TRO T4,(T3)		; Put them with leader
IFE STANSW,<
	UMOVEM T4,.NBLD0(T1)	; Give user this leader
>;IFE STANSW
IFN STANSW,<
	UMOVEM T4,1(T1)		; Give user this leader
>;IFN STANSW
RCVIM2:	CALL RLNTBF		; Release the buffer
	SMRETN			; Return

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

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

IFE REL6,<RESCD>		; THIS CODE IS RESIDENT
IFN REL6,<XRESCD>		; THIS CODE IS RESIDENT

SIQGET:	MOVE T2,TODCLK		; Update time to discard msgs
	ADDI T2,SIQTM0		; Since this user has been active
	MOVEM T2,SIQTIM(T1)	; Reset time
	NOSKED			; Protect these queues from MLCFRK
	MOVE T2,SIQIBO(T1)	; Get buffer address for this Q
	JUMPE T2,SIQEMT		; Jump if none there
	LOAD T3,NBQUE,(T2)     	; There is one. Get it's successor.
	JUMPN T3,SIQGT1		; Jump if there is a successor too
	SETZM SIQIBI(T1)	; No successor. Clear tail pointer
	SKIPA			; Don't put in section number
SIQGT1:	SETSEC T3,INTSEC	; Section goes with address
	MOVEM T3,SIQIBO(T1)	; New next-out
	SOS SIQSPC(T1)		; Credit space used
	OKSKED			; Queues may be touched now
	RETSKP			; Success return from SIQGET
				; Return with buffer addr in T2

SIQEMT:	OKSKED			; None on queue.
	HRLZI T1,SIQIBO(T1)	; Cell which will become non-zero
	HRRI T1,DISNT		; When a message arrives
	RET			; For caller to do MDISMS with
	SUBTTL SNDIM% JSYS - Send Special Message

;T1/ RH = SQH, B0 = User wants 96 bit leader, B1 = User wants
;		data left as 32 bits per word

IFE REL6,<SWAPCD>

IFN REL6,<
	SWAPCD
.SNDIM::XCALLRET (XCDSEC,SNDIMM)
	XSWAPCD
SNDIMM:>       			; END OF IFN REL6
IFE REL6,<.SNDIM::>
	MCENT
	SKIPN NETSUP		; Things initialized yet?
	  RETERR(SQX2)		; No, cannot have a queue to write
	UMOVE P1,1		; User's SQH in RH, bits in LH
	UMOVE P2,2		; User's buffer address
IFE STANSW,<
	UMOVE P3,.NBHDR(P2)	; Size word of that buffer
>;IFE STANSW
IFN STANSW,<
	UMOVE P3,0(P2)		; Size word of that buffer
>;IFN STANSW
	HRRZ T1,P1
	CALL CHKSQ		; Check access to special q
	 RETERR
	NOINT
	MOVEI T2,0(P3)		; User's buffer size
IFN STANSW,<
	ADDI T2,.NBLD0		; Allow space for monitor headers
>;IFN STANSW
	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?
	 RETERR (SNDIX1)	; Bad size
	CALL ASNTBF		; Get a buffer
	 RETERR (SNDIX2)	; No buffers available
	PUSH P,T1		; Save buffer address
	MOVEI T2,1(P2)		; Source in user area, after header
	MOVE T3,T1		; Destination in monitor space,
IFE STANSW,<
	ADDI T3,1		; Skip the header here, too
>;IFE STANSW
IFN STANSW,<
	ADDI T3,.NBLD0		; Skip the header here, too
>;IFN STANSW
	SKIPL P1		; But if have to convert leader from 32bit
	ADDI T3,2		; Leave room for more leader
IFE STANSW,<
	LOAD T1,NBBSZ,(T1)	; Number of words to transfer,
	SUBI T1,1		; Less the header
	SKIPL P1		; And if converting leader,
	SUBI T1,2		; Two less for that
>;IFE STANSW
IFN STANSW,<
	MOVEI T1,0(P3)		; Get back size of user's data
>;IFN STANSW
	CALL BLTUM		; Move from user space
	POP P,T2		; The buffer addr again
	LOAD T1,NBBSZ,(T2)	; Check size
	MOVEI T3,1(T1)		; Point just after data
	ADD T1,T2		; Address the buffer
	CAMGE T3,MAXWPM		; Is buffer full?
	SETZM 0(T1)		; No, so clear any possible pad bits
	JUMPGE P1,SNDIM1	; If need to convert leader fm 32 bit
	DMOVE T3,.NBLD0(T2)	; Change from pretty to packed 96 bit ldr
	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
	MOVEM T4,.NBLD2(T2)	; And stash last 36 (24) bits
	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,3	; 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
	TLNN P1,(1B1)		; IF USER DATA IS 36-BIT LAYOUT,
	 JRST SNDIMO		; handle differently
	MOVE T3,.NBHHL+2(T2)	; Get word with protocol field from pkt
	LSH T3,-2		; Align with byte of queue spec
	JRST SNDIMQ		; Go check it

SNDIMO:	DMOVE T3,.NBHHL+1(T2)	; Get words with protocol field
	LSHC T3,^D22		; Align with byte of mask
SNDIMQ:	XOR T3,SQJOB(P1)	; Compare with queue spec
	LSH T3,8		; Align with mask
	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)	; ..
	LOAD T3,IHMTY,(T2)	; Only allow sending regular messages
	CAIE T3,.IHREG		; is this a regular message?
	 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 Q3		; 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
	ADD P3,T2		; Point into the buffer
	ADD Q2,T2		; For these pointers
	TRC Q3,7		; make aobjn pointer
	HRLI Q3,-10(Q3)		; ..
	SETZM 1(P3)		; Make sure any padding is 0.
				; ...
				; ...
SNDIL2:	MOVE T1,0(Q2)		; Get 36 bits to shuffle
	DPB T1,SNDIT2(Q3)	; Store right part of word
	LSH T1,@SNDIT1(Q3)	; Shift left part down
	MOVEM T1,0(P3)		; And store it (B32-B35 are junk)
	AOBJN Q3,SNDIN2		; Step the state counter
	MOVSI Q3,-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:	MOVE T4,NETFLD		; Get default network
	LSH T4,-4		; put in proper field
	MOVE T1,.NBLD0(T2)	; get first word
	TXNN T1,<377B15>	; Is the net specified?
	 IOR T1,T4		; No, put one in
	MOVEM T1,.NBLD0(T2)	; Replace word
	NOSKED
	CALL IMPQOA		; Put onto output q
	OKSKED
	JRST SKMRTN

SNDIXX:	CALL RLNTBF		; Release the buffer, don't send it.
	JRST MRETNE		; Fail return from SNDIM jsys

; Tables for converting 36 to 32 bit buffer

SNDIT1:	IFIW!<0,,-34>		;Table used for shifting bits right
	IFIW!<0,,-30>
	IFIW!<0,,-24>
	IFIW!<0,,-20>
	IFIW!<0,,-14>
	IFIW!<0,,-10>
	IFIW!<0,,-4>
	IFIW!<0,,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
	SUBTTL Special Queues Random Routines

; ACCEPTS:
;	T1/ SPECIAL QUEUE HANDLE
; RETURNS
;	+1 FAILURE
;	   T1/  ERROR CODE
;	+2 SUCCESS
; CLOBBERS T2

CHKSQ:	HRRZ T2,T1		; Check RH only
	CAIL T2,NSQ		; Is it in range?
	 JRST [	MOVEI T1,SQX1	; No, give error code
		RET]		; And fail return
	HRRZ T2,SQJOB(T1)	; It's a legal number. Who owns it?
	CAMN T2,JOBNO		; Is it me?
	 JRST RSKP		; Yes, give success return
	MOVEI T1,SQX2		; No, give error code
	RET			; And fail return

; CKNTWZ - Check for net wizardry
; RETURNS:
;	+1 Not Net Wizard. Error code in T1
;	+2 Net Wizard

IFE STANSW,<
CKNTWZ:	MOVEI T2,SC%NWZ		; Required capability bit2,SC%NWZ
>;IFE STANSW
IFN STANSW,<
CKNTWZ:	MOVX T2,SC%NWZ!SC%WHL!SC%OPR	; Net wiz or WOPR
>;IFN STANSW
	TDNE T2,CAPENB		; Do we have it?
	 JRST RSKP		; Yes. Success return
	MOVEI T1,NTWZX1		; No, give failure code
	RET			; And non-skip return

				; SQLWAT - Wait for SQ Lock to clear
SQLWAT:	SAVEAC <T1>
	MOVEI T1,SQLTST		; Scheduler test
	MDISMS			; Wait for it
	RET			; And return

; The Sched test itself, must be resident

	RESCD				

SQLTST:	AOSE SQLCK		; Try to get the lock
	JRST 0(T4)		; Didn't get it
	JRST 1(T4)		; Have the lock. Run the fork

IFE REL6,<SWAPCD>
IFN REL6,<XSWAPCD>

IFE REL6,<NETLGO::>
IFN REL6,<XNENT NETLGO,G>
	SETO T1,0		;Release all special queues
	RELSQ%
	RET			;That's all
	SUBTTL SIQCHK - SIQCHK - check for unclaimed messages

; Called from NCPFRK with TODCLK in T1
; Returns T1/ Time to come back here again

SIQCHK::MOVX T3,^D31000		; Check back in 31 seconds if none
	ADD T3,T1		; ..
	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
	CALL SIQWRK		; call worker routine
SIQCKX:	CAML T3,SIQTIM(T2)	; This next one to expire?
	 MOVE T3,SIQTIM(T2)	; T3 := next one which will expire
SIQCKE:	AOBJN T2,SIQCKL		; Check all queues
	MOVE T1,T3		; When to call back
	RET

SIQWRK:	SAVEAC <T1,T2,T3>
	HRRZ T1,T2
	CALL REL1S1		; release all messages on this queue
	RET

	TNXEND
	END