PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/mon/klpser.mac

TITLE	KLPSER - SERVICE ROUTINES FOR CI20 (KLIPA)	V105
SUBTTL	JOSEPH A. DZIEDZIC/JAD	2 AUG 88

	SEARCH	F,S,DEVPRM,KLPPRM,SCAPRM
	SEARCH	MSCPAR,MACSYM
	$RELOC
	$XHIGH

	PURGEACS		;PURGE DEFAULT (TOPS-10) AC NAMES
	T20SYM			;SWITCH TO TOPS-20 AC NAMES
				;(NEEDED FOR INTERFACE TO SCAMPI)

;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 1984,1986,1988.
;ALL RIGHTS RESERVED.

.CPYRT<1984,1988>


XP	VKLPSR,105		;VERSION NUMBER FOR GLOB AND MAP


KLPSER:!ENTRY	KLPSER		;LOAD IF LIBRARY SEARCH
	SUBTTL	PARAMETERS


;CI OPERATION CODES

OP.SDG==1			;SEND DATAGRAM
OP.SMS==2			;SEND MESSAGE
OP.RCF==3			;CONFIRM RECEIVED
OP.MCR==4			;MAINTENANCE CONFIRM RECEIVED
OP.RID==5			;REQUEST ID
OP.RRS==6			;RESET REMOTE SYSTEM
OP.SRS==7			;START REMOTE SYSTEM
OP.RD0==10			;REQUEST DATA ON QUEUE 0
OP.RD1==11			;REQUEST DATA 1
OP.RD2==12			;REQUEST DATA 2
OP.IDR==13			;ID RECEIVED
OP.LPB==15			;SEND/RECEIVE LOOPBACK
OP.RMD==16			;REQUEST MAINTENANCE DATA
OP.SDT==20			;SEND DATA
OP.RDT==21			;RETURN DATA (DATREC)
OP.SMD==22			;SEND MAINTENANCE DATA
OP.MDR==23			;MAINTENANCE DATA RECEIVED
OP.CKT==200			;SET VIRTUAL CIRCUIT
OP.SPT==201			;SET STATISTICS COUNTER
OP.RCT==202			;READ STATISTICS COUNTER
OP.RRG==203			;READ REGISTER
OP.WRG==204			;WRITE REGISTER
OP.CLB==205			;CLOSE BUFFER
OP.RMT==40			;ON IN REMOTELY GENERATED RESPONSES

INCXID==1B31			;VALUE TO INCREMENT TRANSACTION ID BY

MINUVR==100,,711		;MINIMUM KLIPA MICROCODE VERSION

MAXNOR==77			;NUMBER OF TIME OUTS BEFORE WE DECLARE THE OTHER PORT SICK

RIDTIM==^D2			;TIMEOUT FOR REQUEST-ID (SECONDS)
STSTIM==^D10			;TIMEOUT FOR START SEQUENCE (SECONDS)
CTRTIM==^D60*^D60		;TIMEOUT FOR PERIODIC READ-COUNTERS (SECONDS)

TIMOUT==^D1000			;VALUE OF INTERLOCK WORD AT WHICH WE DECLARE THE KLIPA DEAD
RSTIME==^D60*^D3		;LEAVE KLIPA STOPPED IF 2 ERRORS IN THIS INTERVAL

KAFTIM==^D10*^D1000		;KEEP ALIVE TIMEOUT (MILLISECONDS)
IDLTIM==^D1*^D1000		;IDLE TIME (MILLISECONDS)

CO.BTS==CO.ENA+CO.MRN		;BITS WHICH MUST BE ON IN ALL CONOS

KLPBTS==CI.CPE!CI.MER!CI.EPE!CI.FQE!CI.RQA ;BITS TO TEST FOR ON INTERRUPT
;MACRO TO DEFINE SNOOP POINT (SINCE SNOOP. CAN'T HACK EXTENDED CODE SECTIONS)

DEFINE	SNOOP(LABEL,%DUMMY),<
	..EXTH==0		;;ASSUME NOT IN EXTENDED HIGH SEGMENT
IFE	PSECT.-.XHGH.,..EXTH==1	;;BUT IF WE ARE, REMEMBER THE FACT
IFN ..EXTH,<			;;IF IN EXTENDED HIGH SEGMENT,
	XJRST	[MCSEC0+LABEL]	;;CALL THE TRACKING ROUTINE IN SECTION 0
	$HIGH			;;SWITCH PSECTS
LABEL::!JFCL			;;RANDOM NO-OP
	XJRST	[%DUMMY]	;;RETURN TO EXTENDED HIGH SEGMENT
	$XHIGH			;;AS YOU WERE
%DUMMY:!			;;USELESS LABEL
>;; END IFN ..EXTH
IFE	..EXTH,<		;;IF NOT IN EXTENDED HIGH SEGMENT,
LABEL::!JFCL			;; THINGS ARE MUCH EASIER
>;; END IFE ..EXTH
>; END DEFINE SNOOP


;KLIPA TOPS-20 ERROR CODES

KLPX1==602547
KLPX2==602050
KLPX5==602027
KLPX7==602031
KLPX9==602033
KLPX10==602734
KLPX11==602735
KLPX13==602052
KLPX14==602054
	SUBTTL	AUTOCONFIGURATION TABLES

;DRIVER CHARARCTERISTICS
;	KLP	= KLPCNF
;	KLP	= KLIPA
;	M.CPU	= MAXIMUM DEVICES IN SYSTEM
;	0	= KONTROLLER TYPE
;	0	= MAXIMUM DRIVES PER KONTROLLER
;	0	= HIGHEST DRIVE NUMBER ON KONTROLLER
;	MDSEC0	= SECTION FOR KDB/UDB
;	MDSEC0	= SECTION FOR DDB
DRVCHR	(KLP,KLP,M.CPU##,0,0,0,MDSEC0,MDSEC0,<DR.XAD!DR.MCD!DR.NMC>)


	.ORG	IPKSIZ
	BLOCK	.PCLEN			;PCB
KLPKLN:!				;LENGTH OF KDB
	.ORG


KLPKDB:	KDBBEG	(KLP,KLPKLN)
	SETWRD	(KDBNAM,<SIXBIT/KLP/>)	;KONTROLLER NAME
	SETWRD	(KDBPCC,<.PCPCL,,.PCPCB>) ;PHYSICALLY CONTIGUOUS CORE
	SETWRD	(.PCOLD,<EXP -1>)	;FULL CONFIGURE FIRST TIME
	KDBEND


EQUATE	(LOCAL,0,<KLPCKT,KLPUDB,KLPULN>)
EQUATE	(LOCAL,CPOPJ##,<KLPINI>)

KLPULB==.PCULB		;OFFSET OF UCODE LOADER BLOCK
KLPICD==IPAICD##	;PROTOTYPE INTERRUPT CODE ADDRESS
KLPICL==IPAICL##	;PROTOTYPE INTERRUPT CODE LENGTH

	$HIGH			;MUST BE IN .HIGH. DUE TO 18-BIT .LINK PSEUDO-OP

KLPDSP:	DRVDSP	(KLP,DSKCHN##,,,KLPDIA)

;DEFAULT MONGEN'ED DEVICE TABLE
DEFMDT:	MDKL10	(7,574,0,0,<MD.KON>)	;DEVICE CODE 574
	MDTERM				;TERMINATE TABLE

	$XHIGH

;PROTOTYPE MICROCODE PARAMETER BLOCK
KLPULP:	EXP	.BTKLP##	;MICROCODE INDEX
	XWD	000,0		;DEVICE CODE,,MASSBUS UNIT NUMBER
	SIXBIT	/KLIPA/		;INTERFACE NAME
	SIXBIT	/CI20/		;CHANNEL NAME
	EXP	MINUVR		;MINIMUM MICROCODE VERSION
	EXP	0		;DATE/TIME OF LOAD SUCCESS OR FAILURE
	EXP	0		;MICROCODE VERSION
	EXP	0		;POINTER TO MAGIC TABLE
	EXP	0		;MICROCODE LENGTH
	EXP	0		;MICROCODE ADDRESS
	SUBTTL	BHD/BSD INITIALIZATION


;ROUTINE TO GET SPACE FOR BHD'S AND BSD'S. CALLED DURING ONCE BEFORE
;THE CALL TO PPDINX SO BHDADR IS VALID.  NOTE ALL KLIPAS IN THE
;SYSTEM SHARE THE SAME POOL OF BHD'S AND BSD'S.
;CALL:
;	PUSHJ	P,BHDINI
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(BHDINI::)
	SKIPE	BHDIPT		;ALREADY HAVE A BUFFER DESCRIPTOR TABLE SET UP?
	POPJ	P,		;YES, NOTHING ELSE TO DO
	SE1ENT			;ENTER NON-ZERO SECTION
	MOVEI	T1,C%BHDN*.BHSIZ ;NUMBER OF WORDS FOR BUFFER HEADER DESCRIPTORS
	IDIVI	T1,PAGSIZ	;DETERMINE NUMBER OF PAGES
	SKIPE	T2		;IF A REMAINDER,
	AOS	T1		; ROUND UP
	PUSH	P,T1		;SAVE THE COUNT FOR LATER
	PUSHJ	P,PGRSKD	;GET THE RESIDENT SPACE
	  JRST	TPOPJ##		;NOT AVAILABLE?!
	MOVEM	T1,BHDIPT	;STORE INITIAL POINTER FOR BHD SEARCHES
	POP	P,T2		;RESTORE NUMBER OF PAGES REQUESTED
	MOVEM	T2,BHDPGS	;STORE FOR MEMORY OFFLINE CODE
	LSH	T2,P2WLSH	;HOW MANY WORDS WERE ALLOCATED
	MOVE	T3,T2		;SAVE A COPY FOR LATER
	ADD	T2,T1		;COMPUTE LAST ADDRESS IN BUFFER DESCRIPTOR TABLE
	SUBI	T2,1		;...
	MOVEM	T2,BHDEND	;STORE FOR BHD SEARCHES
	MOVEM	T3,BHDMTI	;SAVE MAXIMUM BDT INDEX
	IDIVI	T3,.BHSIZ	;COMPUTE HOW MANY BHD'S WILL FIT IN SPACE ALLOCATED
	MOVEM	T3,BHDNUM	;STORE FOR POSSIBLE FUTURE BHD RE-INIT
	PUSHJ	P,BHDCLR	;CLEAR ALL BHD'S

	MOVEI	T1,C%BSDN*.BSSIZ ;NUMBER OF WORDS FOR BUFFER SEGMENT DESCRIPTORS
	IDIVI	T1,PAGSIZ	;DETERMINE NUMBER OF PAGES
	SKIPE	T2		;IF A REMAINDER,
	AOS	T1		; ROUND UP
	PUSH	P,T1		;SAVE THE COUNT FOR LATER
	PUSHJ	P,PGRSKD	;GET THE RESIDENT SPACE
	  JRST	TPOPJ##		;NOT AVAILABLE?!
	MOVEM	T1,BSDVRT	;SAVE VIRTUAL ADDRESS OF START OF BSD CHAIN
	POP	P,T2		;RESTORE NUMBER OF PAGES REQUESTED
	MOVEM	T2,BSDPGS	;SAVE FOR MEMORY OFFLINE CODE
	LSH	T2,P2WLSH	;HOW MANY WORDS WERE ALLOCATED
	IDIVI	T2,.BSSIZ	;COMPUTE HOW MANY BSD'S WILL FIT IN SPACE ALLOCATED
	MOVEM	T2,BSDNUM	;STORE FOR POSSIBLE FUTURE BSD RE-INIT
	PJRST	BSDLNK		;LINK ALL THE BSD'S AND RETURN
;ROUTINE TO CLEAR ALL BHD'S.  CALLED BY BHDINI OR SET MEMORY OFFLINE
;CODE AFTER MEMORY HAS BEEN DIDDLED AS NECESSARY.
;CALL:
;	PUSHJ	P,BHDCLR
;RETURN:
;	CPOPJ ALWAYS

BHDCLR:	MOVE	T1,BHDIPT	;START OF BUFFER DESCRIPTOR TABLE
	MOVEM	T1,BHDCPT	;RESET CURRENT POINTER FOR BHD SEARCHES
	MAP	T2,0(T1)	;GET THE PHYSICAL ADDRESS FOR THE KLIPA
	TXZ	T2,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T2,BHDADR	;SAVE PHYSICAL ADDRESS OF BDT FOR PCBINI
	MOVE	T2,BHDNUM	;NUMBER OF BHD'S IN BDT
BHDCL1:	SETZM	.BHKEY(T1)	;ZERO VALID WORD
	SETZM	.BHBSA(T1)	;DITTO FOR POINTER TO FIRST BSD
	ADDI	T1,.BHSIZ	;ADVANCE POINTER
	SOJG	T2,BHDCL1	;INITIALIZE ALL BHD'S
	POPJ	P,		;RETURN


;ROUTINE TO LINK ALL BSD'S.  CALLED BY BHDINI OR SET MEMORY OFFLINE
;CODE AFTER MEMORY HAS BEEN DIDDLED AS NECESSARY.
;CALL:
;	PUSHJ	P,BSDLNK
;RETURN:
;	CPOPJ ALWAYS

BSDLNK:	MOVE	T1,BSDVRT	;GET VIRTUAL ADDRESS OF START OF BSD CHAIN
	MAP	T2,(T1)		;GET THE PHYSICAL ADDRESS
	TXZ	T2,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T2,BSDADR	;SAVE PHYSICAL ADDRESS OF START OF BSD CHAIN
	MOVEM	T2,BSDLOC	;ALSO SAVE AS START OF FREE BSD CHAIN
	MOVE	T2,BSDNUM	;NUMBER OF BSD'S WHICH WERE ALLOCATED
	SUBI	T2,1		;MINUS ONE
BHDIN2:	MAP	T3,.BSSIZ(T1)	;GET PHYSICAL ADDRESS OF NEXT BSD
	TXZ	T3,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T3,.BSNXT(T1)	;LINK NEXT TO THIS
	ADDI	T1,.BSSIZ	;GET ADDRESS OF NEXT BSD
	SOJG	T2,BHDIN2	;LOOP FOR ALL BSD'S
	SETZM	.BSNXT(T1)	;CLEAR LINK TO NEXT IN LAST BSD
	POPJ	P,		;RETURN
	SUBTTL	BHD/BSD MANIPULATION


;ROUTINE TO GET A BUFFER HEADER DESCRIPTOR.
;CALL:
;	PUSHJ	P,PPDGBH
;RETURN:
;	CPOPJ IF NO FREE BHDS
;	CPOPJ1 WITH:
;	T1/ INDEX INTO BUFFER DESCRIPTOR TABLE
;	T2/ VIRTUAL ADDRESS OF BHD

	$XSENT	(PPDGBH::)
	SKIPN	BSDLOC		;ANY FREE BSDS?
	RETBAD	(KLPX2)		;NO, NO SENSE IN TRYING
	CIOFF			;PREVENT RACES
	MOVE	T1,BHDCPT	;GET CURRENT POINTER FOR BHD SEARCHES
PPDGH1:	SKIPN	.BHKEY(T1)	;THIS BHD FREE?
	JRST	PPDGH2		;YES
	XMOVEI	T1,.BHSIZ(T1)	;ADDRESS OF NEXT BHD
	CAML	T1,BHDEND	;PAST THE END OF THE TABLE?
	MOVE	T1,BHDIPT	;YES, RESET TO BEGINNING
	CAME	T1,BHDCPT	;HAVE WE LOOPED OVER THE ENTIRE TABLE?
	JRST	PPDGH1		;NO, KEEP LOOKING
	RETBAD	(KLPX1,<CION>)	;YOU LOSE

PPDGH2:	MOVX	T2,1B0		;GET A TEMPORARY FLAG
	IORM	T2,.BHKEY(T1)	;(OVERWRITTEN WITH KEY LATER)
	XMOVEI	T2,.BHSIZ(T1)	;ADDRESS OF NEXT BHD
	CAML	T2,BHDEND	;PAST THE END OF THE TABLE?
	MOVE	T2,BHDIPT	;YES, RESET TO BEGINNING
	MOVEM	T2,BHDCPT	;WHERE TO RESUME SEARCHING
	CION			;OK TO INTERRUPT
	MOVE	T2,T1		;COPY THE BHD ADDRESS
	SUB	T1,BHDIPT	;COMPUTE INDEX INTO TABLE
	JRST	CPOPJ1##	;SKIP RETURN


;ROUTINE TO RETURN A BUFFER HEADER DESCRIPTOR.
;CALL:
;	T1/ BUFFER NAME
;	PUSHJ	P,PPDRBH
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T2/ ADDRESS OF FIRST BSD (IF ANY)
;	T4/ CONTENTS OF .BHKEY WORD

	$XSENT	(PPDRBH::)
	LDB	T2,[POINT BHSIDX,T1,BHPIDX] ;GET INDEX INTO TABLE
	CAML	T2,BHDMTI	;INDEX WITHIN REASON?
	STOPCD	.,STOP,KLPBIO,	;++BHD TABLE INDEX OUT OF RANGE
	MOVE	T1,T2		;COPY INDEX
	ADD	T1,BHDIPT	;COMPUTE VIRTUAL BHD ADDRESS
	MOVE	T2,.BHBSA(T1)	;SAVE POINTER TO ANY BSDS
	MOVE	T4,.BHKEY(T1)	;RETURN THE KEY WORD FOR ERROR CHECKING
	SETZM	.BHKEY(T1)	;MARK THIS BHD AS FREE
	POPJ	P,		;RETURN
;ROUTINE TO GET A BUFFER SEGMENT DESCRIPTOR.
;CALL:
;	PUSHJ	P,PPDGBD
;RETURN:
;	CPOPJ IF NO FREE BSDS
;	CPOPJ1 WITH:
;	T1/ PHYSICAL ADDRESS OF BSD
;	T2/ VIRTUAL ADDRESS OF BSD

	$XSENT	(PPDGBD::)
	CIOFF			;PREVENT RACES
	SKIPN	T1,BSDLOC	;GET HEAD OF FREE LIST
	RETBAD	(KLPX2,<CION>)	;NONE FREE, RETURN ERROR
	MOVE	T2,T1		;COPY ADDRESS
	ADDI	T2,.BSNXT	;OFFSET TO WORD WE WANT
	PMOVE	T2,T2		;FETCH THE LINK WORD
;***
;SUPPOSED TO RESERVE 1 BHD/BSD FOR DIAGNOSTIC FOLKS' USE
;***
	JUMPE	T2,[JFCL	;DIAGNOSTIC?
		    JRST .+1	;YES, GO AHEAD AND USE THIS BSD
		    RETBAD (KLPX2,<CION>)] ;NO, DON'T USE LAST BSD
	MOVEM	T2,BSDLOC	;NEW HEAD OF FREE LIST
	MOVE	T2,T1		;COPY PHYSICAL BSD ADDRESS
	SUB	T2,BSDADR	;CALCULATE OFFSET FROM START OF AREA
	ADD	T2,BSDVRT	;MAKE THIS A VIRTUAL ADDRESS
	PJRST	CINPJ1##	;INTERRUPTS BACK ON AND SKIP RETURN


;ROUTINE TO RETURN A BUFFER SEGMENT DESCRIPTOR.
;CALL:
;	T1/ PHYSICAL ADDRESS OF BSD
;	PUSHJ	P,PPDRBD
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDRBD::)
	CIOFF			;PREVENT RACES
	MOVE	T3,BSDLOC	;GET HEAD OF FREE LIST
	MOVE	T2,T1		;COPY ADDRESS
	ADDI	T2,.BSNXT	;OFFSET TO WORD WE WANT
	PMOVEM	T3,T2		;LINK THE FREE LIST TO THIS BSD
	MOVEM	T1,BSDLOC	;NEW HEAD OF THE FREE LIST
	PJRST	CIONPJ##	;INTERRUPTS BACK ON AND RETURN
;ROUTINE TO RETURN A BUFFER HEADER DESCRIPTOR AND ANY BUFFER SEGMENT
;DESCRIPTORS LINKED TO THE BHD.
;CALL:
;	T1/ BUFFER NAME
;	PUSHJ	P,PPDRHD
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T4/ CONTENTS OF .BHKEY WORD FROM BHD

	$XSENT	(PPDRHD::)
	PUSHJ	P,PPDRBH	;RETURN THE BHD
	PUSH	P,T4		;SAVE THE KEY WORD FOR RETURN TO CALLER
	SKIPA	T4,T2		;COPY ADDRESS OF FIRST BSD TO T4 AND SKIP
PPDRH1:	PUSHJ	P,PPDRBD	;RETURN THE BSD
	SKIPN	T1,T4		;IS THERE A NEXT BSD?
	JRST	T4POPJ##	;NO, DONE
	MOVE	T2,T1		;COPY ADDRESS
	ADDI	T2,.BSNXT	;OFFSET TO WORD WE WANT
	PMOVE	T2,T2		;FETCH THE LINK
	MOVE	T4,T2		;COPY NEXT BSD ADDRESS TO T4
	JRST	PPDRH1		;RETURN THIS BSD
	SUBTTL	KLIPA CONFIGURATION


;ROUTINE CALLED FROM AUTCON
;LINKAGE:
;	T1/ DEVICE CODE
;	T2/ CONI BITS
;	PUSHJ	P,KLPCFG
;RETURNS:
;	CPOPJ TO STOP SCANNING DRIVERS
;	CPOPJ1 TO SCAN OTHER DRIVERS

	$HIGH

KLPCFG:	CAIL	T1,FSTICD/4	;AN RH20?
	CAILE	T1,LSTICD/4	;...
	JRST	CPOPJ1##	;WRONG DRIVER
	TLNN	T2,(CI.PPT)	;IPA CHANNEL?
	JRST	CPOPJ1##	;NO
	PUSHJ	P,TYIPA##	;TRY TO DETERMINE THE PORT TYPE
	  JRST	KLPCF1		;CAN'T
	CAIN	T1,.CIKLP	;KLIPA?
	JRST	KLPCF2		;YES
	JRST	CPOPJ1##	;ON TO THE NEXT DRIVER

KLPCF1:	XMOVEI	T1,KLPMDT##	;MONGEN'ED DEVICE TABLE
	XMOVEI	T2,DEFMDT	;DEFAULT TABLE
	MOVNI	T3,1		;NO MASSBUS UNIT OR DRIVE INFORMATION
	MOVEI	T4,MD.KON	;MATCH ON KONTROLLER DEFINITION
	PUSHJ	P,AUTMDT##	;SCAN THE TABLES
	  JRST	CPOPJ1##	;NO MATCHES

KLPCF2:	MOVSI	T1,CP.KLP	;KLIPA CHANNEL
	PUSHJ	P,AUTCHN##	;BUILD A CHANNEL DATA BLOCK
	  POPJ	P,		;NO CORE
	MOVNI	T1,1		;NOT MULTI-UNIT, BUT MUST DO ANYWAY
	PUSHJ	P,AUTKDB##	;BUILD A KDB
	  POPJ	P,		;GIVE UP IF NO CORE
	AOSE	.PCOLD(W)	;BEEN HERE BEFORE?
	POPJ	P,		;YES--DO NOTHING OR I/O WILL STOP

	MOVE	T1,.CPCHA##	;GET CHANNEL DATA BLOCK ADDRESS
	MOVEM	T1,.PCCDB(W)	;SAVE IN THE PCB

	HRRZ	T1,@KDBCSO(W)	;ADDRESS OF CONI BITS TO TEST IN SKIP CHAIN
	MOVEM	T1,.PCBIT(W)	;UPDATE
	MOVE	T1,[KLPBTS]	;BITS TO TEST FOR ON INTERRUPT
	MOVEM	T1,@.PCBIT(W)	;SET IN THE CONSO SKIP CHAIN CODE

IFN FTMP,<
	MOVE	T1,.CPCPN##	;GET OUR CPU NUMBER
	MOVEM	T1,.PCCPU(W)	;SAVE FOR QUEUED I/O TESTS IN KLPSND
>; END IFN FTMP
	MOVEI	T1,DSKCHN##	;GET PI CHANNEL KLIPA WILL RESIDE ON
	MOVEM	T1,.PCPIA(W)	;STORE IN PCB
	MOVX	T1,C%MGSZ	;GET MAXIMUM MESSAGE SIZE
	MOVEM	T1,.PCMQE(W)	;STORE FOR THE KLIPA
	MOVX	T1,C%DGSZ	;GET MAXIMUM DATAGRAM SIZE
	MOVEM	T1,.PCDQE(W)	;STORE FOR THE KLIPA
;	MOVX	T1,C%RGSZ	;GET MAXIMUM RESERVED SIZE
;	MOVEM	T1,.PCRQE(W)	;STORE FOR THE KLIPA
	PUSHJ	P,IPAADB##	;ALLOCATE DRAM DUMP BUFFER
	MOVE	Q3,W		;SET UP PCB POINTER
	XJRST	[KLPCFH]	;FINISH IN EXTENDED HIGH SEGMENT

	$XHIGH

KLPCFH:	PUSHJ	P,PCBINI	;INITIALIZE QUEUE STRUCTURES IN THE PCB
	PJRST	PPDINX		;LOAD MICROCODE, ETC.
	SUBTTL	KLIPA INITIALIZATION


;ROUTINE TO INITIALIZE THE KLIPA ON THIS CPU.  MUST BE CALLED
;AFTER DSKCHN PI CHANNEL AND PI SYSTEM ARE TURNED ON.
;CALL:
;	PUSHJ	P,PPDINX
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDINX::)
	PUSHJ	P,SAVPQ##	;SAVE LOTS OF ACS
	XMOVEI	P1,SYSCHN##-CHNSYS ;SET PREDECESSOR
	MOVEI	T1,CP.KLP	;KLIPA CHANNEL BITS

PPDIN1:	MOVE	P1,CHNSYS(P1)	;GET CHANNEL ADDRESS
	HLRZS	P1		;ADDRESS IN LH QUANTITY
	JUMPE	P1,CPOPJ##	;THERE MUST BE ONE!
	HLRZ	T2,CHNTYP(P1)	;GET INTERESTING BITS
	CAIE	T1,(T2)		;A KLIPA?
	JRST	PPDIN1		;TRY AGAIN
	LDB	T2,CHYCPU##	;GET CPU NUMBER
	CAME	T2,.CPCPN##	;OURS?
	JRST	PPDIN1		;NO
	MOVE	T1,CHNTBP(P1)	;FETCH THE KDB (PCB) TABLE POINTER
	SKIPN	Q3,(T1)		;AND GET THE PORT CONTROL BLOCK
	POPJ	P,		;NO KLNI ON THIS CPU
	PUSHJ	P,PCBINI	;INITIALIZE THE PCB
	SKIPE	.CPPCB##	;RESTART?
	SKIPN	.PCFQC(Q3)	;YES, DO WE HAVE RESTOCK COUNTS?
	JRST	PPDIN2		;RESTART OR NO RESTOCK COUNTS
	PUSHJ	P,RSTKQS	;RESTOCK THE QUEUES
	JRST	PPDIN3		;CONTINUE

PPDIN2:	MOVEM	Q3,.CPPCB##	;STORE PCB ADDRESS IN CPU DATA BLOCK
	PUSHJ	P,STKDFQ	;STOCK THE DATAGRAM FREE QUEUE

;ENABLE THE KLIPA BUT DON'T GIVE IT ITS PI ASSIGNMENT YET

PPDIN3:	SETZM	.PCFQE(Q3)	;CLEAR COUNT OF FREE QUEUE ERRORS
	SETOM	.PCONN(Q3)	;WE DON'T KNOW OUR NODE NUMBER
	MOVE	T1,.CPBIT##	;GET OUR CPU'S BIT
	TSNN	T1,IPAMSK##	;WANT TO SKIP STARTING THE CI?
	PUSHJ	P,RLDKLI	;LOAD AND START KLIPA MICROCODE
	  POPJ	P,		;FAILED, SKIP REST OF INITIALIZATION

;EMPTY THE RESPONSE QUEUE AND RETURN THE PACKET(S) TO THE FREE QUEUE(S)

PPDIN4:	PUSHJ	P,CLEANQ	;CLEAN OUT SOME RESPONSES
	  SKIPA			;NONE FOUND, DONE
	JRST	PPDIN4		;FOUND SOME, LOOK FOR MORE
;ENABLE INTERRUPTS AND CLEAN UP ANY RESPONSES THAT COULD HAVE COME IN
;AFTER THE QUEUE WAS CLEANED UP

	CONO	PI,PI.OFF	;STOP INTERRUPTS
	PUSHJ	P,PIAKLP	;GIVE THE KLIPA A PI ASSIGNMENT
	XCT	KDBCNI(Q3)	;READ STATUS
	TRNE	T1,CI.RQA	;RESPONSE AVAILABLE?
	JRST	[MOVEI	T1,CO.BTS+CO.RQA ;YES, CLEAR PI AND RESP AVAILABLE
		 XCT	KDBCNO(Q3) ;...
		 CONO PI,PI.ON	;ENABLE INTERRUPTS
		 JRST PPDIN4]	;GO TOSS THE RESPONSES
	CONO	PI,PI.ON	;ENABLE INTERRUPTS

;FINISH INITIALIZATION STUFF USING COMMON ROUTINE

	PJRST	PPDCSS		;DO COMMON STARTUP STUFF
;ROUTINE TO REMOVE PACKETS FROM THE RESPONSE QUEUE AND RETURN
;THEM TO THE APPROPRIATE FREE QUEUE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CLEANQ
;RETURN:
;	CPOPJ IF DIDN'T FIND ANY
;	CPOPJ1 IF FOUND SOME

CLEANQ:	STKVAR	<QEMPTY>	;ALLOCATE A WORD OF STACK STORAGE
	SETZM	QEMPTY		;AND ZERO IT
CLENQ1:	MOVEI	T1,CO.BTS!CO.RQA!CO.FQE ;RESP QUEUE AVAILABLE, FREE QUEUE ERR
	XCT	KDBCNO(Q3)	;CLEAR BITS
CLENQ2:	XMOVEI	T1,.PCRSQ(Q3)	;RESPONSE QUEUE
	PUSHJ	P,REMQUE	;REMOVE THE TOP PACKET
	  JRST	CLENQ3		;EMPTY, WE'RE DONE
	AOS	QEMPTY		;FOUND ONE, COUNT IT
	PUSHJ	P,RMASAG	;BYTE SWAP THE PPD BYTE
	PUSHJ	P,TOSSIT	;RETURN IT TO THE PROPER FREE QUEUE
	JRST	CLENQ2		;LOOP FOR MORE

CLENQ3:	XCT	KDBCNI(Q3)	;READ STATUS
	TRNE	T1,CI.RQA	;SOMETHING SHOW UP WHILE WE WERE WORKING?
	JRST	CLENQ1		;YES, GO GET IT
	SKIPE	QEMPTY		;DID WE GET ANY RESPONSES?
	AOS	(P)		;YES, SET FOR SKIP RETURN
	POPJ	P,		;RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE


;ROUTINE TO RETURN A PACKET TO THE PROPER FREE QUEUE.
;CALL:
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,TOSSIT
;RETURN:
;	CPOPJ ALWAYS

TOSSIT:	MOVX	T1,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	ANDCAM	T1,.PKVRT(Q2)	;...
	LDB	T1,PKYOP	;OP CODE
	TXZ	T1,OP.RMT	;MINUS REMOTE BIT
	CAIE	T1,OP.SMS	;IS IT A MESSAGE?
	PJRST	RETDG		;NO, RETURN THE DATAGRAM
	PJRST	RETMSG		;RETURN THE MESSAGE
	SUBTTL	PCB INITIALIZATION


;ROUTINE TO INITIALIZE A PCB.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,PCBINI
;RETURN:
;	CPOPJ ALWAYS
;
;NOTE:  PCBINI SHOULD INITIALIZE ANY INFORMATION IN THE PCB WHICH
;MIGHT CHANGE IF THE PCB IS MOVED IN PHYSICAL MEMORY.  CONSTANTS
;(SUCH AS MAXIMUM DG/MSG SIZE) SHOULD BE SET AT PPDINX.

PCBINI:	SKIPN	T1,BHDADR	;GET PHYSICAL ADDR OF BUFFER DESCRIPTOR TABLE
	BUG.	(HLT,KLPNBD,KLPSER,SOFT,<No buffer descriptor table>,,)
	MOVEM	T1,.PCBDT(Q3)	;STORE FOR THE KLIPA
	MAP	T1,.PCPCB(Q3)	;DETERMINE PHYSICAL ADDRESS OF PCB
	TXZ	T1,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T1,.PCPBA(Q3)	;STORE PHYSICAL PCB ADDRESS FOR THE KLIPA
	MOVX	T1,ST.DED	;INITIALLY IT IS ASSUMED TO BE DEAD
	IORM	T1,.PCSTS(Q3)	; WILL GET CLEARED WHEN RESTARTED
	LDB	T1,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	LSH	T1,2		;COMPUTE EPT OFFSET TO CHANNEL LOGOUT AREA
	ADD	T1,.CPEPT##	;PLUS ADDRESS OF EPT
	MOVEM	T1,.PCLGO(Q3)	;STORE IN PORT CONTROL BLOCK
	MAP	T1,.CSCLP(T1)	;GET PHYSICAL ADDRESS OF CHANNEL LOGOUT WORD 1
	TXZ	T1,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T1,.PCAL1(Q3)	;STORE IT FOR THE KLIPA
	PJRST	RSTQS		;RESET PCB QUEUES AND RETURN
	SUBTTL	INTERRUPT SERVICE


;DISPATCH HERE FROM THE CONSO SKIP CHAIN ON A KLIPA INTERRUPT.
;THE SKIP CHAIN CODE HAS ALREADY SAVED ALL ACS, AND LOADED T1
;WITH THE CONI STATUS BITS AND T2 WITH THE ADDRESS OF THE PORT
;CONTROL BLOCK.

KLPINT::MOVX	T2,ST.MAI	;SEE IF IN MAINTENANCE MODE
	TDNE	T2,.PCSTS(W)	;...
	POPJ	P,		;YES, DON'T GET IN THE WAY
	MOVE	Q3,W		;COPY PCB ADDRESS TO "STANDARD" REGISTER
	MOVEM	T1,.PCCSR(Q3)	;SAVE CONI STATUS FOR LATER EXAMINATION
	TXNN	T1,CI.CPE!CI.MER ;CRAM PARITY ERROR OR MBUS ERROR?
	JRST	KLPIN1		;NO
	PUSHJ	P,REPORT	;MAKE ERROR.SYS ENTRY
	MOVX	T1,CI.CPE	;GET CRAM PARITY ERROR BIT
	TDNE	T1,.PCCSR(Q3)	;CRAM PARITY ERROR?
	PUSHJ	P,KLECPE	;OUTPUT DESCRIPTIVE TEXT
	PUSHJ	P,NONODS	;TELL SCA ABOUT NODES GOING AWAY
	PUSHJ	P,RSTLKS	;RESET THE PCB QUEUE INTERLOCKS
	PUSHJ	P,RSTRID	;RESET REQUEST-ID DATA
	MOVX	T1,CI.CPE	;GET CRAM PARITY ERROR BIT
	TDNE	T1,.PCCSR(Q3)	;CRAM PARITY ERROR?
	PUSHJ	P,KLPCPD	;YES (KLPCPD MAY CALL KLPRQC)
	MOVX	T1,CI.MER	;GET MBUS ERROR BIT
	TDNE	T1,.PCCSR(Q3)	;MBUS ERROR?
	PUSHJ	P,KLPMBD	;YES (KLPRQC WON'T BE CALLED)
	POPJ	P,		;DISMISS THE INTERRUPT

;NEITHER A CRAM PARITY ERROR OR AN MBUS ERROR

KLPIN1:	TXNE	T1,CI.RQA	;RESPONSE QUEUE AVAILABLE?
	PUSHJ	P,KLPRQA	;YES, PROCESS THE PACKETS
	MOVX	T1,CI.FQE	;GET FREE QUEUE ERROR BIT
	TDNE	T1,.PCCSR(Q3)	;FREE QUEUE ERROR?
	PUSHJ	P,KLPFQE	;YES, FIND OUT WHICH ONE
	POPJ	P,		;DISMISS THE INTERRUPT
;ROUTINE CALLED WHEN RESPONSE QUEUE IS AVAILABLE.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLPRQA
;RETURN:
;	CPOPJ ALWAYS

;COMMON USE OF THE ACS IN KLPRQA:
;	Q1/ CI NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	P1/ PCB ADDRESS OFFSET BY CI NODE NUMBER
;	P2/ OPCODE FROM PACKET
;	P3/ -1 IF LOCALLY GENERATED, 0 IF REMOTELY GENERATED
;	P4/ SBK ADDRESS
;	P5/ PBK ADDRESS
;	P6/ PPD BYTE

KLPRQC:	MOVEI	T1,CO.EPE!CO.RQA ;RESPONSE AVAILABLE, EBUS PARITY
	XCT	KDBCNO(Q3)	;CLEAR BITS
	JRST	KLPRQ1		;JOIN COMMON CODE

KLPRQA:	MOVE	T1,.PCPIA(Q3)	;GET KLIPA PI ASSIGNMENT
	TRO	T1,CO.EPE!CO.RQA!CO.BTS ;PLUS RESPONSE AVAILABLE & EBUS PARITY
	XCT	KDBCNO(Q3)	;CLEAR BITS

KLPRQ1:	XMOVEI	T1,.PCRSQ(Q3)	;WHICH QUEUE
	PUSHJ	P,REMQUE	;REMOVE FIRST PACKET FROM QUEUE
	  POPJ	P,		;QUEUE IS EMPTY, DISMISS INTERRUPT AND RETURN

	SNOOP	(CISPKR)	;CISNUP SNOOP POINT - PACKET RECEIVED
				;Q2/ PACKET ADDRESS
				;Q3/ PCB ADDRESS

	MOVE	T1,.CPUPT##	;GET CPU UPTIME
	MOVEM	T1,.PCKRT(Q3)	;REMEMBER WHEN LAST PACKET WAS RECEIVED
	PUSHJ	P,RMASAG	;SWAP THE PPD BYTE AND ADJUST LENGTH
	LDB	Q1,PKYNOD	;GET CI NODE NUMBER
	CAIL	Q1,0		;A LEGAL CI
	CAIL	Q1,MAXNDS	; NODE NUMBER?
	JRST	KLPRQ6		;NODE NUMBER OUT OF RANGE
	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET FOR THIS NODE
	LDB	P2,PKYOP	;GET OP CODE
	TXZE	P2,OP.RMT	;REMOTELY GENERATED?
	TDZA	P3,P3		;YES, CLEAR P3 (LOCALLY GENERATED FLAG) AND SKIP
	SETO	P3,		;NO, SAY LOCALLY GENERATED
	MOVE	P4,.PCSBK(P1)	;GET THE SYSTEM BLOCK ADDRESS
	MOVE	P5,.PCPBK(P1)	;GET THE PATH BLOCK ADDRESS
;HERE TO DISPATCH THE PACKET BASED ON OP CODE (IN P2)

	MOVSI	T2,-KLPOPL	;GET LENGTH OF TABLE FOR OPCODE SEARCH
KLPRQ2:	CAMN	P2,KLPOPS(T2)	;THIS THE ONE?
	JRST	KLPRQ3		;YES, GO TO IT
	AOBJN	T2,KLPRQ2	;NO, TRY NEXT ONE
	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(INF,KLPOPC,KLPSER,SOFT,<Packet with bad opcode>,<<P2,OPCODE>,<T1,STATUS>,<T2,FLAGS>,<Q1,NODE>>,)
	PUSHJ	P,RETMSG	;RETURN PACKET TO MESSAGE FREE QUEUE
	JRST	KLPRQ1		;TRY FOR ANOTHER

;ALL ACS ARE SET UP AT THIS POINT EXCEPT FOR THE PPD BYTE.
;T2 CONTAINS THE DISPATCH INDEX.

KLPRQ3:	SETO	P6,		;NO PPD BYTE
	MOVE	T1,.PKSTS(Q2)	;GET PACKET STATUS WORD
	TXNN	T1,PS.ERR!PS.CLO ;ERRORS OR PATH CLOSED?
	JRST	KLPRQ5		;NO
	TXNN	T1,PS.ERR	;YES, ERROR?
	JRST	KLPRQ4		;NO, PATH CLOSED
	PUSHJ	P,@KLPERB(T2)	;DO ERROR PROCESSING
	JRST	KLPRQ1		;GO FOR NEXT PACKET

KLPRQ4:	PUSH	P,T2		;SAVE INDEX INTO DISPATCH TABLES
	PUSHJ	P,CLOPTH	;PATH CLOSED, UPDATE PATH INFO
	POP	P,T2		;RESTORE DISPATCH INDEX
	MOVX	T1,PK.SRB	;WERE WE EXPECTING A RESPONSE?
	TDNE	T1,.PKVRT(Q2)	;...
	JRST	KLPRQ5		;YES
	PUSHJ	P,@KLPRET(T2)	;RETURN THE PACKET
	JRST	KLPRQ1		;GO FOR NEXT PACKET

KLPRQ5:	PUSHJ	P,@KLPROU(T2)	;PROCESS THE PACKET
	JRST	KLPRQ1		;GO FOR NEXT PACKET


;THE CI NODE NUMBER IN THE RECEIVED PACKET IS BAD

KLPRQ6:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	LDB	T3,PKYOP	;GET OPCODE
	BUG.	(INF,KLPNDE,KLPSER,SOFT,<Packet with bad node number>,<<Q1,NODE>,<T1,STATUS>,<T2,FLAGS>,<T3,OPCODE>>,)
	PUSHJ	P,TOSSIT	;RETURN TO APPROPRIATE FREE QUEUE
	JRST	KLPRQ1		;TRY FOR ANOTHER RESPONSE
;ROUTINE TO PROCESS A PACKET RECEIVED WITH THE PATH CLOSED BIT SET.
;CALL:
;	T1/ PACKET STATUS WORD
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	P1/ PCB ADDRESS OFFSET BY CI NODE NUMBER

CLOPTH:	PUSHJ	P,SAVQ##	;SAVE REGISTERS WHICH WILL GET STEPPED ON
	STKVAR	<AFLAG>		;ALLOCATE A WORD OF STACK STORAGE
	SETZM	AFLAG		;ASSUME ACKED ON PATH A
	TXNE	T1,PS.AKA	;ACKED ON PATH A?
	SETOM	AFLAG		;NO, REMEMBER THAT
	MOVX	T1,RI.PBO	;ASSUME ACKED ON PATH A (I.E., PATH B CLOSED)
	SKIPE	AFLAG		;RIGHT GUESS?
	MOVX	T1,RI.PAO	;NO, SO PATH A WAS CLOSED
	ANDCAM	T1,.PCRIS(P1)	;CLEAR THE BIT
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;CAN'T, MUST WAIT FOR POLLER
	MOVX	T3,PF.PT0	;ASSUME PATH A WAS CLOSED
	SKIPE	AFLAG		;WAS IT?
	MOVX	T3,PF.PT1	;NO, PATH B
	PJRST	KLPRID		;SEND A REQUEST-ID AND RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE
;MACRO TO DEFINE OPCODE AND CORRESPONDING DISPATCH ROUTINE.
;ALSO INCLUDES DISPATCH FOR PACKETS WITH ERRORS AND THE
;PATH CLOSED BIT ON.

DEFINE	OPS,<

DISP	OP.SMS,GIVSCA,GIVERR,RETMSG	;SEND MESSAGE
DISP	OP.SDG,INTDG,DGERR,RETDG	;SEND DATAGRAM
DISP	OP.RCF,INTNBF,NBFERR,RETMSG	;DATA CONFIRM RECEIVED
DISP	OP.RDT,INTNBF,NBFERR,RETMSG	;RETURN DATA (DATREC)
DISP	OP.RID,INTRID,RIDERR,RETDG	;REQUEST-ID
DISP	OP.IDR,INTIDR,RETDG,RETDG	;ID RECEIVED
DISP	OP.LPB,INTLPB,LPBERR,RETDG	;SEND/RECEIVE LOOPBACK
DISP	OP.RD1,INTRD1,RD1ERR,RETMSG	;REQUEST DATA ON COMMAND QUEUE 1
DISP	OP.CKT,INTCKT,CKTERR,RETDG	;SET VIRTUAL CIRCUIT
DISP	OP.RCT,INTRCT,RCTERR,RETDG	;READ STATISTICS COUNTERS
DISP	OP.MCR,INTMCR,MCRERR,RETDG	;MAINTENANCE CONFIRM RECEIVED
DISP	OP.MDR,INTMDR,MDRERR,RETDG	;MAINTENANCE DATA RECEIVED
DISP	OP.RRG,INTRRG,RRGERR,RETDG	;READ REGISTER
DISP	OP.RD0,INTRD0,RD0ERR,RETMSG	;REQUEST DATA ON COMMAND QUEUE 0
DISP	OP.RD2,INTRD2,RD2ERR,RETMSG	;REQUEST DATA ON COMMAND QUEUE 2
DISP	OP.SDT,INTSDT,SDTERR,RETMSG	;SEND DATA
DISP	OP.RRS,RETDG,RETDG,RETDG	;RESET REMOTE SYSTEM
DISP	OP.SRS,RETDG,RETDG,RETDG	;START REMOTE SYSTEM
DISP	OP.RMD,RETDG,RETDG,RETDG	;REQUEST MAINTENANCE DATA
DISP	OP.SMD,RETDG,RETDG,RETDG	;SEND MAINTENANCE DATA
DISP	OP.SPT,RETDG,RETDG,RETDG	;SET STATISTICS COUNTERS
DISP	OP.WRG,RETDG,RETDG,RETDG	;WRITE REGISTER
DISP	OP.CLB,INTCLB,CLBERR,RETDG	;CLOSE BUFFER

>; END DEFINE OPS
;GENERATE OPCODE LOOKUP TABLE

DEFINE	DISP(CODE,ROU,ERB,RET),<
	CODE
>; END DEFINE DISP

KLPOPS:	OPS			;GENERATE OPCODE LOOKUP TABLE
KLPOPL==.-KLPOPS		;LENGTH OF TABLE

;GENERATE PARALLEL DISPATCH TABLE

DEFINE	DISP(CODE,ROU,ERB,RET),<
	IFIW	ROU
>; END DEFINE DISP

KLPROU:	OPS			;GENERATE DISPATCH TABLE

;GENERATE PARALLEL DISPATCH TABLE FOR PACKETS WITH ERROR BIT ON

DEFINE	DISP(CODE,ROU,ERB,RET),<
	IFIW	ERB
>; END DEFINE DISP

KLPERB:	OPS

;GENERATE PARALLEL DISPATCH TABLE FOR PACKETS WITH ERROR BIT OFF
;BUT THE CLOSED PATH BIT ON AND NO RESPONSE WAS REQUESTED

DEFINE	DISP(CODE,ROU,ERB,RET),<
	IFIW	RET
>; END DEFINE DISP

KLPRET:	OPS
;RECEIVED EITHER AN APPLICATION DATAGRAM OR AN APPLICATION MESSAGE

GIVSCA:	JUMPN	P5,GIVSC1	;PROCEED IF HAVE A PATH BLOCK
	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(INF,KLPIPA,KLPSER,SOFT,<Invalid packet arrived>,<<T1,STATUS>,<T2,FLAGS>,<P2,OPCODE>,<Q1,NODE>>,)
	CAIN	P2,OP.SDG	;A DATAGRAM?
	PJRST	RETDG		;YES, RETURN TO DATAGRAM FREE QUEUE
	PJRST	RETMSG		;NO, RETURN TO MESSAGE FREE QUEUE

GIVSC1:	JUMPN	P3,GV2SCA	;JUMP IF LOCALLY GENERATED
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.STR	;START-RECEIVED?
	JRST	GV2SCA		;NO
	SETZM	.PBSST(P5)	;TURN OFF START SEQUENCE TIMER
	PUSHJ	P,OPNSCA	;TELL SCA ABOUT NEW NODE
;FALL INTO GV2SCA
;HERE TO ACTUALLY HAND THE PACKET TO SCA.
;CALL:
;	Q2/ PACKET ADDRESS
;	P3/ FLAGS
;	P5/ PBK ADDRESS

GV2SCA:	MOVX	T1,PK.SCA	;SCA REQUEST A RESPONSE?
	TDNN	T1,.PKVRT(Q2)	;...
	JRST	GV2SC1		;NO
	SKIPL	P3		;YES, THIS SHOULD BE LOCALLY GENERATED, THEN
	BUG.	(INF,KLPIRP,KLPSER,HARD,<Software response bit on in remotely-generated packet>,<<Q1,NODE>,<T1,STATUS>>,)
	MOVX	P3,F.RSP	;TELL SCA THIS IS A RETURNED BUFFER
	MOVX	T1,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	ANDCAM	T1,.PKVRT(Q2)	;...
	JRST	GV2SC2		;PROCEED

GV2SC1:	JUMPE	P3,GV2SC2	;NO RESPONSE REQUESTED, THIS SHOULD BE REMOTE THEN

;THE PORT SHOULDN'T HAVE GIVEN US THIS BUFFER.  SCASER DOESN'T
;WANT IT, SO PUT IT BACK ON THE FREE QUEUE.

	BUG.	(INF,KLPILP,KLPSER,HARD,<Software response bit off in locally-generated packet>,<<Q1,NODE>,<T1,STATUS>>,)
	CAIN	P2,OP.SDG	;IS THIS A DATAGRAM?
	PJRST	RETDG		;YES, RETURN TO DATAGRAM FREE QUEUE
	PJRST	RETMSG		;NO, RETURN TO MESSAGE FREE QUEUE

GV2SC2:	MOVE	T1,.PKSTS(Q2)	;GET STATUS FLAGS
	LDB	T2,PKYLEN	;GET THE PACKET LENGTH
	TXNN	T1,PF.FMT	;HIGH DENSITY?
	JRST	GV2SC3		;NO
	TXO	P3,F.SPM	;YES, SET FLAG
	MOVEI	T2,3(T2)	;ROUND UP BYTE COUNT IN CASE OF PARTIAL WORD
	IMULI	T2,2		;CONVERT BYTE COUNT TO WORD COUNT
	IDIVI	T2,^D9		; (BYTE COUNT/4.5) = WORD COUNT
GV2SC3:	LOAD	T1,PBPBI,(P5)	;GET THE PATH BLOCK INDEX
	BLCAL.	(SC.INT##,<T1,Q2,T2,P3>) ;TELL SCA
	POPJ	P,		;RETURN
;RECEIVED A PACKET FOR SCA WITH THE ERROR FLAG SET

GIVERR:	JUMPE	P3,GIVER1	;IF REMOTELY-GENERATED, WE'RE DONE
	MOVX	T1,PK.SCA	;WAS A RESPONSE REQUESTED?
	TDNE	T1,.PKVRT(Q2)	;...
	JRST	GIVER2		;NO

;ERROR IN A REMOTELY-GENERATED PACKET, OR IN A LOCALLY-GENERATED
;PACKET AND NO RESPONSE WAS REQUESTED

GIVER1:	CAIN	P2,OP.SDG	;IS IT A DATAGRAM?
	PJRST	RETDG		;YES, RETURN IT TO FREE QUEUE
	PUSHJ	P,SCAERR	;NO, A MESSAGE, REPORT THE FAILURE
	PJRST	RETMSG		;RETURN IT TO FREE QUEUE

;ERROR IN A LOCALLY-GENERATED PACKET AND A RESPONSE WAS REQUESTED

GIVER2:	CAIN	P2,OP.SMS	;IS IT A MESSAGE?
	PUSHJ	P,SCAERR	;YES, SPEAR ENTRY, TELL SCA
	PJRST	GV2SCA		;GIVE THE PACKET TO SCA
;WE GOT A PACKET FOR SCA WITH AN ERROR AND IT WILL CLOSE AN OPEN VC.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	P5/ PBK ADDRESS

SCAERR:	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.OPN	;OPEN?
	POPJ	P,		;NO, DON'T NEED TO REPORT ANYTHING
	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	LDB	T3,PKYOP	;GET OPCODE
	BUG.	(INF,KLPERR,KLPSER,SOFT,<Received packet with error>,<<T1,STATUS>,<T2,FLAGS>,<T3,OPCODE>,<Q1,NODE>>,)
	SAVEAC	(Q2)		;PRESERVE EXISTING PACKET ADDRESS
	SETZB	Q2,P4		;WE NEED A BUFFER TO DO THE SET CIRCUIT
	PJRST	CLOSV1		;CLOSE THE VC, TELL SCA, AND RETURN
;RECEIVED A DATAGRAM

INTDG:	PUSHJ	P,CHKPPD	;CHECK THE PPD BYTE
	  PJRST	RETDG		;BAD PPD, RETURN PACKET TO FREE QUEUE AND RETURN
	PJRST	@DGDSP(P6)	;PROCESS THE PACKET AND RETURN

DGDSP:	IFIW	INTSTR		;START
	IFIW	INTSTK		;STACK
	IFIW	INTACK		;ACK
	IFIW	GIVSCA		;APPLICATION DATAGRAM
	IFIW	CHKPP1		;APPLICATION MESSAGE (OPCODE/PPD BYTE MISMATCH)
	IFIW	INTERP		;ERROR PACKET
	IFIW	INTSHT		;SHUTDOWN


;RECEIVED A DATAGRAM WITH AN ERROR

DGERR:	PUSHJ	P,CHKPPD	;CHECK THE PPD BYTE
	  PJRST	RETDG		;BAD PPD, RETURN PACKET TO FREE QUEUE AND RETURN
	PJRST	@DGEDSP(P6)	;PROCESS THE PACKET AND RETURN

DGEDSP:	IFIW	RETDG		;START
	IFIW	RETDG		;STACK
	IFIW	RETDG		;ACK
	IFIW	GIVERR		;APPLICATION DATAGRAM
	IFIW	CHKPP1		;APPLICATION MESSAGE (OPCODE/PPD BYTE MISMATCH)
	IFIW	ERPERR		;ERROR PACKET
	IFIW	RETDG		;SHUTDOWN WHICH FAILED
;HERE ON RECEIPT OF A START DATAGRAM

INTSTR:	JUMPN	P5,INTSR1	;MUST HAVE BOTH A SYSTEM BLOCK AND PATH BLOCK
				; TO HANDLE THE START
	PUSHJ	P,CHKIDT	;REQUEST-ID TIMER RUNNING?
	  PJRST	RETDG		;YES, ONE OUTSTANDING IS ENOUGH
	PUSHJ	P,GTCPTH	;GET CURRENT PATH
	PJRST	KLPRID		;SEND A REQUEST-ID IN THIS PACKET AND RETURN

INTSR1:	PUSHJ	P,FILLSB	;FILL IN THE SYSTEM BLOCK
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	PJRST	@STRDSP(T1)	;GO DO THE WORK

STRDSP:	IFIW	RETDG		;CLOSED
	IFIW	STRSSN		;START-SENT
	IFIW	STRSTR		;START-RECEIVED
	IFIW	STROPN		;OPEN


;ROUTINE TO COPY DATA FROM THE START PACKET TO THE SYSTEM BLOCK.

FILLSB:	MOVEI	T1,.SBBLE-.SBDSA ;AMOUNT OF DATA TO MOVE
	XMOVEI	T2,.SRSSY(Q2)	;FROM THE PACKET
	XMOVEI	T3,.SBDSA(P4)	; TO THE SYSTEM BLOCK
	EXTEND	T1,[XBLT]	;FILL IN THE DATA
	MOVE	T1,.SBMMS(P4)	;GET MAXIMUM MESSAGE SIZE
	PUSHJ	P,REVFUL	;REVERSE THE BYTES TO MAKE THEM MEANINGFUL
	MOVEM	T1,.SBMMS(P4)	;PUT IT BACK
	POPJ	P,		;RETURN
;RECEIVED A START WHEN IN EITHER START-SENT OR START-RECEIVED STATE.
;RESET THE TIMER, NEW STATE IS START-RECEIVED, AND SEND A STACK.

STRSSN:	PUSHJ	P,KLPOPN	;TELL PORT TO OPEN ITS CIRCUIT
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	STRST1		;NO BIG DEAL, JUST LIKE THE STACK GETTING LOST
STRSTR:	MOVEI	T1,PP.STK	;GET STACK CODE
	PUSHJ	P,STRTDT	;MAKE A STACK
	PUSHJ	P,KLPSDG	;SEND IT
STRST1:	MOVEI	T1,VC.STR	;GET START-RECEIVED CODE
	STOR	T1,PBVCST,(P5)	;UPDATE STATE
	PJRST	STSST		;SET TIMER AND RETURN


;RECEIVED A START WHEN IN OPEN STATE.
;CLOSE VC AND TELL SCA OF THE ERROR.

STROPN:	BUG.	(INF,KLPSWO,KLPSER,SOFT,<Received a START when VC was open>,<<Q1,NODE>>,)
	SETZ	P4,		;WE NEED TO SEND A SETCKT
	PJRST	CLOSV1		;CLOSE THE VC AND TELL SCA
;RECEIVED A STACK

INTSTK:	PUSHJ	P,FILLSB	;FILL IN THE SYSTEM BLOCK
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	PJRST	@STKDSP(T1)	;GO DO THE WORK

STKDSP:	IFIW	RETDG		;CLOSED
	IFIW	STKSTS		;START-SENT
	IFIW	STKSTR		;START-RECEIVED
	IFIW	STKOPN		;OPEN


;RECEIVED A STACK WHEN IN START-SENT OR START-RECEIVED STATE.
;STOP TIMER, SEND ACK, NEW STATE IS OPEN.

STKSTS:	PUSHJ	P,KLPOPN	;TELL PORT TO OPEN ITS CIRCUIT
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	STKST1		;NO SWEAT, JUST LIKE ACK GETTING LOST
STKSTR:	MOVEI	T1,PP.ACK	;GET ACK CODE
	DPB	T1,PKYPPD	;STORE PPD BYTE
	PUSHJ	P,KLPSDG	;SEND THE DATAGRAM
STKST1:	SETZM	.PBSST(P5)	;TURN OFF THE TIMER
	PJRST	OPNSCA		;TELL SCA ABOUT THE NEW PATH


;RECEIVED A STACK WHEN IN OPEN STATE.  SEND AN ACK.

STKOPN:	MOVEI	T1,PP.ACK	;GET ACK CODE
	DPB	T1,PKYPPD	;PUT IT IN
	PJRST	KLPSDG		;SEND IT AND RETURN
;RECEIVED AN ACK

INTACK:	LOAD	T1,PBVCST,(P5)	;GET STATE OF VC
	PJRST	@ACKDSP(T1)	;GO DO THE WORK

ACKDSP:	IFIW	RETDG		;CLOSED
	IFIW	RETDG		;START-SENT
	IFIW	ACKSTR		;START-RECEIVED
	IFIW	RETDG		;OPEN

;RECEIVED AN ACK WHEN IN START-RECEIVED STATE.  STOP TIMER AND
;SET NEW STATE TO OPEN.

ACKSTR:	SETZM	.PBSST(P5)	;TURN OFF THE START SEQUENCE TIMER
	PJRST	OPNSCA		;TELL SCA ABOUT THE NEW PATH
;RECEIVED AN ERROR LOG PACKET

INTERP:	LDB	P4,PKYLEN	;GET LENGTH OF PACKET IN BYTES
	ADDI	P4,3		;ROUND ODD BYTES TO AN EVEN NUMBER OF WORDS
	LSH	P4,-2		;...
	ADDI	P4,KE%LEN	;INCLUDE THE ADDITIONAL WORD(S) WE SUPPLY
	MOVE	T1,P4		;COPY LENGTH REQUIRED TO T1
	PUSHJ	P,ALCSEB##	;ALLOCATE A SYSTEM ERROR BLOCK
	  PJRST	RETDG		;NOT AVAILABLE, JUST TOSS PACKET
	MOVEI	T2,SEC%KE	;GET THE BLOCK TYPE
	DPB	T2,[POINT 9,.EBTYP(T1),8] ;STORE IN HEADER
	MOVE	T2,Q1		;COPY THE SOURCE NODE NUMBER
	LDB	T3,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	DPB	T3,[POINTR (T2,KE%CHN)] ;INCLUDE INTERNAL CHANNEL NUMBER
	MOVEM	T2,.EBHDR+KE%SRC(T1) ;STORE IN BODY
	MOVEI	T2,-KE%ELG(P4)	;NUMBER OF WORDS TO MOVE (EXCLUDING HEADER)
	XMOVEI	T3,.PKLEN+1(Q2)	;SOURCE
	MOVEI	T4,.EBHDR+KE%ELG(T1) ;DESTINATION
	EXTEND	T2,[XBLT]	;MOVE THE DATA
	PUSHJ	P,QUESEB##	;QUEUE THE ERROR BLOCK
	PJRST	RETDG		;RETURN THE PACKET UNTIL WE KNOW WHAT TO DO


;RECEIVED AN ERROR LOG PACKET WITH AN ERROR

ERPERR:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(CHK,KLPEPB,KLPSER,SOFT,<Received bad error logging packet>,<<T2,STATUS>,<T3,FLAGS>,<P2,OPCODE>,<Q1,NODE>>,)
	PJRST	RETDG		;RETURN PACKET TO FREE QUEUE


;RECEIVED A SHUTDOWN

INTSHT:	BUG.	(INF,KLPRSH,KLPSER,SOFT,<Received shutdown message>,<<Q1,NODE>>,)
	SETZ	P4,		;WE NEED TO SEND A SETCKT
	PJRST	CLOSV1		;CLOSE THE VC, TELL SCA, AND RETURN
;ROUTINE TO TELL SCA A PATH HAS COME ON LINE (A VC IS NOW OPEN).
;CALL:
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;	P5/ PBK ADDRESS
;	PUSHJ	P,OPNSCA
;RETURN:
;	CPOPJ ALWAYS

OPNSCA:	MOVEI	T1,VC.OPN	;GET OPEN CODE
	STOR	T1,PBVCST,(P5)	;SET NEW VC STATE
	MOVX	T1,PB.OKO	;NO LONGER OK TO OPEN THE VC
	ANDCAM	T1,.PBFLG(P5)	;...
	LOAD	T1,PBPBI,(P5)	;GET PATH BLOCK INDEX
	BLCAL.	(SC.ONL##,<T1>)	;TELL SCA ABOUT NEW PATH
	POPJ	P,		;RETURN
;ROUTINE THE CHECK THE PPD BYTE FROM A RECEIVED PACKET.
;CALL:
;	Q2/ PACKET ADDRESS
;	PUSHJ	P,CHKPPD
;RETURN:
;	CPOPJ IF BAD PPD BYTE
;	CPOPJ1 IF GOOD PPD BYTE
;
;PPD BYTE IS RETURNED IN P6.

CHKPPD:	LDB	P6,PKYPPD	;GET THE PPD BYTE
	CAIL	P6,PP.STA	;LEGAL
	CAILE	P6,PP.MAX	; PPD BYTE?
	JRST	CHKPP1		;NO
	JRST	CPOPJ1##	;YES


;SPECIAL ENTRY POINT FOR OPCODE/PPD BYTE MISMATCH.

CHKPP1:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYOP	;GET OPCODE
	LDB	T3,PKYNOD	;GET NODE
	BUG.	(INF,KLPPPD,KLPSER,SOFT,<Packet with bad PPD byte>,<<T1,STATUS>,<T2,OPCODE>,<T3,NODE>,<P6,PPD>>,)
	POPJ	P,		;RETURN
;RECEIVED A CONFIRM OR A DATA RECEIVED

INTNBF:	CAMN	P3,[-1]		;LOCALLY GENERATED?
	PJRST	RETMSG		;YES, GIVE PACKET BACK TO FREE QUEUE
	DMOVE	T1,.PKXID(Q2)	;T1 = BUFFER NAME, T2 = CID
	BLCAL.	(SC.DMA##,<T1,T2>) ;TELL SCA, GIVE BUFFER NAME AND CID
	MOVE	T1,Q2		;POSITION BUFFER ADDRESS
	PJRST	SC.RBF##	;RETURN THE BUFFER AND RETURN
;RECEIVED A REQUEST-ID

;NOTE:  WE ONLY GET HERE IF THE REQUEST-ID WE SENT WAS RETURNED DUE
;       TO SOME KIND OF ERROR, AS THE KLIPA RESPONDS TO IDREQ PACKETS
;       FROM OTHER NODES WITHOUT OUR INTERVENTION.

INTRID:	MOVX	T1,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	ANDCAM	T1,.PKVRT(Q2)	;...
	MOVX	T1,RI.WFR	;NO LONGER WAITING FOR RESPONSE
	ANDCAM	T1,.PCRIS(P1)	; (IN CASE IT WAS SECOND TRY)
	PJRST	RETDG		;RETURN THE PACKET TO FREE QUEUE AND RETURN


;RECEIVED A REQUEST-ID WITH AN ERROR

RIDERR:	PUSH	P,.PKSTS(Q2)	;SAVE THE ERROR BITS
	LDB	T1,PKYSTS	;GET THE STATUS FIELD
	PUSH	P,T1		;SAVE THAT TOO
	PUSHJ	P,INTRID	;CLEAR BITS AND RETURN BUFFER
	POP	P,T2		;RESTORE THE STATUS FIELD
	POP	P,T1		;GET THE ERROR BITS BACK
	SETZM	.PCRIT(P1)	;TURN OFF TIMER
	TXNN	T1,PF.PT0	;RECEIVED ON PATH A??
	JRST	RIDER2		;NO
	CAIE	T2,PS.NRA	;WAS IT A NO RESPONSE?
	JRST	RIDER1		;NO
	MOVX	T1,RI.NRA	;YES, UPDATE STATUS
	IORB	T1,.PCRIS(P1)	;...
	PJRST	RIDERX		;GO SEE IF WE SHOULD DO SOMETHING

RIDER1:	MOVX	T1,RI.NRA	;NO LONGER NO-RESPONSE
	ANDCAM	T1,.PCRIS(P1)	;...
	POPJ	P,		;RETURN

RIDER2:	CAIE	T2,PS.NRB	;WAS IT A NO RESPONSE?
	JRST	RIDER3		;NO
	MOVX	T1,RI.NRB	;YES, UPDATE STATUS
	IORB	T1,.PCRIS(P1)	;...
	PJRST	RIDERX		;GO SEE IF WE SHOULD DO SOMETHING

RIDER3:	MOVX	T1,RI.NRB	;NO LONGER NO-RESPONSE
	ANDCAM	T1,.PCRIS(P1)	;...
	POPJ	P,		;RETURN
;HERE WHEN WE'VE RECEIVED A NO RESPONSE.  IF WE'VE RECEIVED ONE ON
;BOTH PATHS WE'LL ASSUME THE LISTENER HAS DIED AND CLOSE THE VC.

RIDERX:	JUMPE	P5,CPOPJ##	;MAY NOT HAVE A PATH BLOCK (NON-EXISTANT NODE)
	TXC	T1,RI.NRA!RI.NRB ;COMPLEMENT THE BITS
	TXCE	T1,RI.NRA!RI.NRB ;BOTH ON?
	POPJ	P,		;NO, RETURN
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.OPN	;OPEN?
	POPJ	P,		;NO, DON'T NEED TO DO ANYTHING
	BUG.	(INF,KLPNRS,KLPSER,SOFT,<Closing VC due to No Response>,<<Q1,NODE>>,)
	SETZB	Q2,P4		;WE NEED A BUFFER TO DO THE SET CIRCUIT
	PJRST	CLOSV1		;CLOSE THE VC, TELL SCA, AND RETURN
;RECEIVED AN IDREC

INTIDR:	STKVAR	<WFIFL>		;ALLOCATE SOME STACK STORAGE
	SETZM	WFIFL		;ASSUME NOT WAITING FOR IDREC
	SETZM	.PCRIT(P1)	;TURN OFF REQUEST-ID TIMER FOR THIS NODE
	MOVE	T1,.PKSTS(Q2)	;GET THE PACKET STATUS
	TXNN	T1,PF.PT0	;DID IT ARRIVE ON PATH A?
	JRST	INTID3		;NO, PATH B
	PUSHJ	P,CHKVCO	;DO WE HAVE AN OPEN VC?
	  JRST	INTID2		;NO, ONWARD
	MOVX	T1,RI.PAO	;IS PATH A ALREADY OPEN?
	TDNE	T1,.PCRIS(P1)	;...
	JRST	INTID2		;YES
	PUSH	P,Q2		;SAVE ADDRESS OF IDREC PACKET
	PUSHJ	P,KLPGDB	;GET A BUFFER
	  JRST	INTID1		;NOT AVAILABLE
	MOVX	T1,CK.LPT!CK.PAA!CK.PBA ;TELL PORT TO USE BOTH PATHS AGAIN
	MOVEM	T1,.PKCKT(Q2)	;...
	PUSHJ	P,KLPSCK	;SEND THE SET-CIRCUIT
	MOVX	T1,RI.PAO!RI.PBO ;BOTH PATHS ARE NOW OPEN
	IORM	T1,.PCRIS(P1)	;...
INTID1:	POP	P,Q2		;RESTORE ADDRESS OF IDREC PACKET
INTID2:	MOVX	T1,RI.NRA	;CLEAR NO-RESPONSE FLAG
	ANDCAM	T1,.PCRIS(P1)	;...
	JRST	INTID6		;PROCEED

INTID3:	PUSHJ	P,CHKVCO	;DO WE HAVE AN OPEN VC?
	  JRST	INTID5		;NO, ONWARD
	MOVX	T1,RI.PBO	;IS PATH B ALREADY OPEN?
	TDNE	T1,.PCRIS(P1)	;...
	JRST	INTID5		;YES
	PUSH	P,Q2		;SAVE ADDRESS OF IDREC PACKET
	PUSHJ	P,KLPGDB	;GET A BUFFER
	  JRST	INTID4		;NOT AVAILABLE
	MOVX	T1,CK.LPT!CK.PAA!CK.PBA ;TELL PORT TO USE BOTH PATHS AGAIN
	MOVEM	T1,.PKCKT(Q2)	;...
	PUSHJ	P,KLPSCK	;SEND THE SET-CIRCUIT
	MOVX	T1,RI.PAO!RI.PBO ;BOTH PATHS ARE NOW OPEN
	IORM	T1,.PCRIS(P1)	;...
INTID4:	POP	P,Q2		;RESTORE ADDRESS OF IDREC PACKET
INTID5:	MOVX	T1,RI.NRB	;CLEAR NO-RESPONSE FLAG
	ANDCAM	T1,.PCRIS(P1)	;...
INTID6:	JUMPE	P5,INTID7	;JUMP IF NO PATH BLOCK (BUILD ONE)
	MOVE	T1,.PKPST(Q2)	;GET THE PORT STATE
	MOVEM	T1,.PBDPS(P5)	;STORE IT IN THE PBK
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.CLO	;CLOSED?
	PJRST	RETDG		;NO, THAT'S ALL WE HAVE TO DO
	MOVX	T1,PB.WFI	;NO LONGER WAITING FOR AN IDREC
	ANDCAB	T1,.PBFLG(P5)	;CLEAR FLAGS AND COPY TO T1
	SETOM	WFIFL		;SAY WE TURNED IT OFF
	TXNE	T1,PB.NTC	;STILL NEED TO CLOSE VC?
	PJRST	RETDG		;YES, CAN'T DO ANYTHING ELSE NOW
	TXNN	T1,PB.OKO	;IS IT OK TO OPEN THIS VC?
	PJRST	RETDG		;NO, DONE
INTID7:	LDB	T1,PKYPST	;GET OTHER PORT'S STATE
	CAIE	T1,PS.ENB	;ENABLED?
	PJRST	RETDG		;NO, DON'T TRY TO SEND NOW

	JUMPN	P4,INTID8	;JUMP IF WE HAVE A SYSTEM BLOCK FOR THIS NODE
	PUSHJ	P,BLDSBK	;BUILD A SYSTEM BLOCK
	  PJRST	RETDG		;CAN'T, RETURN THE DATAGRAM AND TRY AGAIN LATER
INTID8:	JUMPN	P5,INTID9	;JUMP IF WE HAVE A PATH BLOCK FOR THIS NODE
	PUSHJ	P,BLDPBK	;BUILD A PATH BLOCK
	  PJRST	RETDG		;CAN'T, RETURN THE DATAGRAM AND TRY AGAIN LATER
INTID9:	PJRST	SNDSTA		;SEND A START AND RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE
;ROUTINE TO CHECK FOR AN OPEN VC.
;CALL:
;	P5/ PBK ADDRESS
;	PUSHJ	P,CHKVCO
;RETURN:
;	CPOPJ IF VC NOT OPEN (OR NO PB)
;	CPOPJ1 IF VC OPEN

CHKVCO:	JUMPE	P5,CPOPJ##	;RETURN IF NO PATH BLOCK
	LOAD	T1,PBVCST,(P5)	;GET VC STATE
	CAIN	T1,VC.OPN	;VC OPEN?
	AOS	(P)		;YES, SET FOR SKIP
	POPJ	P,		;RETURN
;ROUTINE TO BUILD A SYSTEM BLOCK.
;CALL:
;	Q1/ CI NODE NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,BLDSBK
;RETURN:
;	CPOPJ ON FAILURE
;	CPOPJ1 ON SUCCESS WITH:
;	P4/ SBK ADDRESS

BLDSBK:	CIOFF			;PREVENT RACES
	MOVSI	T1,-C%SBLL	;-VE LENGTH OF SYSTEM BLOCK LIST
BLDSB1:	SKIPN	P4,SBLIST##(T1)	;GET AN ENTRY
	JRST	BLDSB2		;NONE, TRY NEXT
	LOAD	T2,SBDPN,(P4)	;GET DESTINATION PORT NUMBER
	CAMN	T2,Q1		;A MATCH?
	JRST	BLDSB3		;YES, USE THIS ONE
BLDSB2:	AOBJN	T1,BLDSB1	;LOOP FOR ANY OTHER SYSTEM BLOCKS

	MOVEI	T2,.SBLEN	;NUMBER OF WORDS REQUIRED
	PUSHJ	P,GETCOR	;GET THE SPACE
	  PJRST	CIONPJ##	;NOT AVAILABLE, INTERRUPTS BACK ON AND RETURN
	MOVE	P4,T1		;COPY ADDRESS TO PROPER AC
	MOVSI	T1,-C%SBLL	;-VE LENGTH OF SYSTEM BLOCK LIST
	SKIPE	SBLIST##(T1)	;LOOK FOR A FREE SLOT
	AOBJN	T1,.-1		;...
	JUMPGE	T1,BLDSBE	;ERROR RETURN IF NO FREE SLOTS
	MOVEM	P4,SBLIST##(T1)	;CLAIM THIS SLOT
	ADDI	T1,1		;MAKE SYSTEM BLOCK INDEX 1-BASED TO COMPLY WITH SCA SPEC
	STOR	T1,SBSBI,(P4)	;SAVE SYSTEM BLOCK INDEX
	STOR	Q1,SBDPN,(P4)	;STORE DESTINATION PORT NUMBER (CI NODE NUMBER)
BLDSB3:	MOVE	T1,Q3		;GET PCB ADDRESS
	ADD	T1,Q1		; OFFSET FOR THIS NODE
	MOVEM	P4,.PCSBK(T1)	;STORE SYSTEM BLOCK ADDRESS IN PCB
	PJRST	CINPJ1##	;INTERRUPTS BACK ON AND SKIP RETURN

BLDSBE:	CION			;OK TO INTERRUPT AGAIN
	MOVEI	T1,.SBLEN	;LENGTH OF BLOCK
	MOVE	T2,P4		;COPY SYSTEM BLOCK ADDRESS
	PUSHJ	P,GIVSWS##	;RETURN THE SPACE
	SETZ	P4,		;GET A ZERO
	POPJ	P,		;TAKE THE ERROR RETURN
;ROUTINE TO BUILD A PATH BLOCK.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ ADDRESS OF IDREC PACKET
;	Q3/ PCB ADDRESS
;	P4/ SBK ADDRESS
;	PUSHJ	P,BLDPBK
;RETURN:
;	CPOPJ ON FAILURE
;	CPOPJ1 ON SUCCESS WITH:
;	P5/ PBK ADDRESS

BLDPBK:	MOVEI	T2,.PBLEN	;NUMBER OF WORDS REQUIRED
	PUSHJ	P,GETCOR	;GET THE SPACE
	  POPJ	P,		;NOT AVAILABLE
	MOVE	P5,T1		;COPY ADDRESS TO PROPER AC
	CIOFF			;PREVENT RACES
	MOVSI	T1,-C%PBLL	;-VE LENGTH OF PATH BLOCK LIST
	SKIPE	PBLIST##(T1)	;LOOK FOR A FREE SLOT
	AOBJN	T1,.-1		;...
	JUMPGE	T1,BLDPBE	;ERROR RETURN IF NO FREE SLOTS
	MOVEM	P5,PBLIST##(T1)	;CLAIM THIS SLOT
	ADDI	T1,1		;MAKE PATH BLOCK INDEX 1-BASED TO COMPLY WITH SCA SPEC
	STOR	T1,PBPBI,(P5)	;SAVE PATH BLOCK INDEX
	MOVE	T1,Q3		;GET PB ADDRESS
	ADD	T1,Q1		; OFFSET FOR THIS NODE
	MOVEM	P5,.PCPBK(T1)	;STORE PATH BLOCK ADDRESS IN PCB
	LOAD	T1,SBPBI,(P4)	;GET INDEX OF FIRST PATH BLOCK
	STOR	T1,PBNPI,(P5)	;LINK THAT PATH BLOCK TO THIS ONE
	LOAD	T1,PBPBI,(P5)	;GET OUR PATH BLOCK INDEX
	STOR	T1,SBPBI,(P4)	;INSERT THIS PATH BLOCK AS HEAD OF LIST
	INCR	SBDPC,(P4)	;INCREMENT DESTINATION PORT COUNT
	LOAD	T1,SBSBI,(P4)	;GET SYSTEM BLOCK INDEX
	STOR	T1,PBSBI,(P5)	;STORE IN PATH BLOCK
	STOR	Q1,PBDPN,(P5)	;STORE DESTINATION PORT NUMBER (CI NODE NUMBER)
	CION			;ALLOW INTERRUPTS AGAIN
	XMOVEI	T1,.PBFCB(P5)	;POINTER TO FIRST CONNECTION BLOCK
	MOVEM	T1,.PBLCB(P5)	;STORE IN BLINK
	SETZM	.PBFCB(P5)	;CLEAR FLINK
	XMOVEI	T1,.PBTWQ(P5)	;POINTER TO TOP OF WORK QUEUE
	MOVEM	T1,.PBBWQ(P5)	;STORE IN BLINK
	SETZM	.PBTWQ(P5)	;CLEAR FLINK
	SETZM	.PBOBB(P5)	;ZERO THE SCA OUTBOUND MESSAGE WORD
	MOVE	T1,.PKMID(Q2)	;TYPE OF NODE
	MOVEM	T1,.PBDPC(P5)	;SAVE IT IN SYSTEM BLOCK
	MOVE	T1,.PKCOD(Q2)	;GET PORT CODE REVISION
	MOVEM	T1,.PBDCR(P5)	;SAVE IN SYSTEM BLOCK
	MOVE	T1,.PKFUN(Q2)	;PORT FUNCTIONALITY
	MOVEM	T1,.PBDPF(P5)	;SAVE IN SYSTEM BLOCK
	MOVE	T1,.PKPST(Q2)	;GET PORT STATE
	MOVEM	T1,.PBDPS(P5)	;SAVE IN SYSTEM BLOCK
	MOVEM	Q3,.PBPCB(P5)	;STORE ADDRESS OF PORT CONTROL BLOCK
IFN FTMP,<
	MOVE	T1,.CPCPN##	;OUR CPU NUMBER
	MOVEM	T1,.PBCPU(P5)	;STORE
>; END IFN FTMP
	JRST	CPOPJ1##	;SKIP RETURN

BLDPBE:	CION			;OK TO INTERRUPT
	MOVEI	T1,.PBLEN	;LENGTH OF BLOCK
	MOVE	T2,P5		;COPY PATH BLOCK ADDRESS
	PUSHJ	P,GIVSWS##	;RETURN THE SPACE
	SETZ	P5,		;GET A ZERO
	POPJ	P,		;TAKE THE ERROR RETURN
;ROUTINE TO SEND A START.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	P5/ PBK ADDRESS
;	PUSHJ	P,SNDSTA
;RETURN:
;	CPOPJ ALWAYS

SNDSTA:	MOVEI	T1,VC.STS	;GET START-SENT CODE
	STOR	T1,PBVCST,(P5)	;SET INITIAL VC STATE
	MOVEI	T1,PP.STA	;GET START CODE
	PUSHJ	P,STRTDT	;MAKE A START PACKET
	PUSHJ	P,KLPSDG	;SEND THE DATAGRAM
	PJRST	STSST		;SET THE TIMER AND RETURN
;ROUTINE TO PUT START DATA INTO A BUFFER.
;CALL:
;	T1/ FUNCTION (START OR STACK)
;	Q2/ PACKET ADDRESS
;	PUSHJ	P,SRTRDT
;RETURN:
;	CPOPJ ALWAYS

STRTDT:	DPB	T1,PKYPPD	;OPCODE = SCA PPD FIELD
	SETZM	.SRSSY(Q2)	;CLEAR SENDING SYSTEM
	SETZM	.SRRSV(Q2)	;CLEAR RESERVED WORD
	MOVEI	T1,1		;CI PROTOCOL VERSION
	STOR	T1,SRVRS,(Q2)	;SAVE IN PACKET
	MOVE	T1,.SRRSV(Q2)	;GET THE WORD
	PUSHJ	P,REVFUL	;REVERSE IT
	MOVEM	T1,.SRRSV(Q2)	;PUT IT BACK
	MOVE	T1,[C%MXMP_2,,C%MXDP_4] ;MAX MESSAGE, DG SIZES
	PUSHJ	P,REVFUL	;REVERSE THEM FOR THE HSC
	MOVEM	T1,.SRMMS(Q2)	;SAVE IN PACKET
	MOVE	T1,[BYTE (8) "T","-","1","0"] ;"T-10" IS SOFTWARE TYPE
	MOVEM	T1,.SRSWT(Q2)	;SAVE IN PACKET
	MOVE	T1,[POINT 3,.JBVER##] ;POINTER TO RELEASE NUMBER
	MOVEI	T2,.SRSWV(Q2)	;WHERE IN PACKET TO STORE IT
	MOVEI	T3,4		;4 BYTES
	PUSHJ	P,STORNO	;SAVE SW VERSION
	MOVE	T1,[POINT 3,SCASIN##,35-<8*3>] ;POINTER TO SOFTWARE INCARNATION
	MOVEI	T2,.SRSWI(Q2)	;WHERE IN PACKET TO STORE IT
	MOVEI	T3,8		;8 BYTES
	PUSHJ	P,STORNO	;SAVE SW INCARNATION
	MOVE	T1,[BYTE (8) "K","L","1","0"] ;"KL10"
	MOVEM	T1,.SRHWT(Q2)	;IS HARDWARE TYPE
	PUSHJ	P,SAVE1##	;FREE UP P1
	APRID	P1		;READ MICROCODE VERSION (APRID)
	ANDX	P1,ID.UVN	;KEEP JUST VERSION
	MOVE	T1,[POINT 3,P1,5] ;POINT TO START OF VERSION
	MOVEI	T2,.SRHWV(Q2)	;WHERE TO STORE IT
	MOVEI	T3,4		;4 BYTES
	PUSHJ	P,STORNO	;SAVE MICROCODE VERSION
	MOVE	T1,[BYTE (8) " "," "," "," "] ;PAD LAST 2 WORDS OF HARDWARE VERSION
	MOVEM	T1,.SRHWV+1(Q2)	;...
	MOVEM	T1,.SRHWV+2(Q2)	;...
	MOVE	T1,[BYTE (8)"K","L","-"] ;NODE NAME
	MOVEM	T1,.SRNNM(Q2)
	SETZM	.SRNNM+1(Q2)
	MOVE	T3,Q2
	ADDI	T3,.SRNNM
	MOVSI	CX,(POINT 8,(T3),23)
	MOVE	T1,.CPASN##
	PUSHJ	P,STRDEC
	PUSHJ	P,VAXTOD	;COMPUTE VAX-STYLE TIME OF DAY
	DMOVEM	T1,.SRTOD(Q2)	;SAVE
	POPJ	P,		;RETURN
;ROUTINE TO STORE AN OCTAL NUMBER AS 8-BIT ASCII BYTES IN A PACKET.
;CALL:
;	T1/ POINTER TO DATA
;	T2/ ADDRESS OF WHERE TO STORE
;	T3/ COUNT OF BYTES TO STORE
;	Q2/ PACKET ADDRESS
;	PUSHJ	P,STORNO
;RETURN:
;	CPOPJ ALWAYS

STORNO:	MOVSI	CX,(POINT 8,0(T2)) ;SET CX AS A BYTE POINTER
	HLL	T2,Q2		;TURN ON RIGHT SECTION BITS
STORN1:	ILDB	T4,T1		;GET A BYTE
	ADDI	T4,"0"		;CONVERT TO ASCII
	IDPB	T4,CX		;SAVE IN PACKET
	SOJG	T3,STORN1	;FOR ALL CHARACTERS
	POPJ	P,		;RETURN


;ROUTINE TO STORE A DECIMAL NUMBER AS 8-BIT ASCII BYTES IN A PACKET.
;CALL:
;	T1/ NUMBER
;	T3/ CX POINTER WHERE TO STORE
;	PUSHJ	P,STRDEC
;RETURN:
;	CPOPJ ALWAYS

STRDEC:	IDIVI	T1,^D10		;BASE 10
	PUSH	P,T2
	SKIPE	T1
	PUSHJ	P,STRDEC
	POP	P,T2
	ADDI	T2,"0"
	IDPB	T2,CX
	POPJ	P,
;ROUTINE TO COMPUTE VAX-STYLE TIME OF DAY.
;CALL:
;	PUSHJ	P,VAXTOD
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T1 & T2/ 64-BIT VAX-STYLE TIME OF DAY

	$XSENT	(VAXTOD::)
	SKIPN	DATE##		;HAS UNIVERSAL DATE/TIME BEEN SET UP?
	SNCALL	(SUDATE##,MCSEC0) ;NO, VERY NICE OF US TO DO SO
	MOVE	T1,DATE##	;GET UNIVERSAL DATE/TIME
	MUL	T1,VAXTIM	;CONVERT TIME TO VAX'S REPRESENTATION
	LSH	T2,1		;KILL OFF THE SIGN BIT SO WE HAVE A 70-BIT
				; QUANTITY IN T1 AND T2
	LSHC	T1,-5		;RIGHT JUSTIFY LOW ORDER TIME
	MOVE	T3,T2		;COPY THE LOW ORDER PART
	LSH	T3,4		;POSITION IT
	LSHC	T1,-^D28	;GET HIGH ORDER PART IN T2
	MOVE	T1,T2		;BACK TO T1
	TRZ	T1,17		;CLEAR THE JUNK BITS
	PUSHJ	P,REVFUL	;REVERSE THE BYTES
	PUSH	P,T1		;SAVE THE HIGH ORDER PART
	MOVE	T1,T3		;GET THE LOW ORDER PART
	PUSHJ	P,REVFUL	;REVERSE THE BYTES
	PJRST	T2POPJ##	;RESTORE HIGH ORDER PART TO T2, LOW ORDER PART
				; ALREADY IN T1

VAXTIM:	DEC	52734375	;MAGIC CONSTANT TO CONVERT UDT TO VAX TIME BASE

	$XHIGH
;RECEIVED A REQUEST DATA ON QUEUE 0 (WE NEVER USE 0)
;RECEIVED A REQUEST DATA ON QUEUE 1 (WE ALWAYS USE 1)
;RECEIVED A REQUEST DATA ON QUEUE 2 (WE NEVER USE 2)
;RECEIVED A SEND-DATA (WE NEVER SET THE RESPONSE BIT)

INTRD0:	JRST	INTSDT		;USE COMMON ROUTINE
INTRD1:	JRST	INTSDT		;USE COMMON ROUTINE
INTRD2:	JRST	INTSDT		;USE COMMON ROUTINE
INTSDT:	JUMPE	P3,INTSD1	;JUMP IF REMOTELY-GENERATED
	MOVE	T1,Q2		;POSITION BUFFER ADDRESS
	PJRST	SC.RBF##	;GIVE BUFFER BACK TO SCA POOL

;REMOTELY-GENERATED PACKET

INTSD1:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(INF,KLPIRD,KLPSER,SOFT,<Invalid remotely-generated data request>,<<T1,STATUS>,<T2,FLAGS>,<P2,OPCODE>,<Q1,NODE>>,)
	PJRST	RETMSG		;RETURN PACKET TO MESSAGE FREE QUEUE
;RECEIVE ONE OF THE FOLLOWING WITH AN ERROR:
;REQUEST DATA ON QUEUE 0 (WE NEVER USE 0)
;REQUEST DATA ON QUEUE 1 (WE ALWAYS USE 1)
;REQUEST DATA ON QUEUE 2 (WE NEVER USE 2)
;SEND-DATA (WE NEVER SET THE RESPONSE BIT)

NBFERR:	JRST	SDTERR		;USE COMMON ROUTINE
RD0ERR:	JRST	SDTERR		;USE COMMON ROUTINE
RD1ERR:	JRST	SDTERR		;USE COMMON ROUTINE
RD2ERR:	JRST	SDTERR		;USE COMMON ROUTINE
SDTERR:	PUSHJ	P,SCAERR	;TELL SCA
	JUMPE	P3,RETMSG	;IF NOT LOCALLY-GENERATED, RETURN PACKET AND RETURN
	MOVE	T1,Q2		;GET THE BUFFER ADDRESS
	PJRST	SC.RBF##	;RETURN THE BUFFER TO SCA POOL AND RETURN
;RECEIVED A LOOP-BACK

INTLPB:	MOVE	T1,.PKSTS(Q2)	;GET PACKET STATUS WORD
	TXNN	T1,PF.PT0	;DID IT ARRIVE ON PATH A?
	JRST	INTLP1		;NO
	MOVX	T1,ST.WAB	;YES, IS WIRE A FLAGGED AS BAD?
	TDNN	T1,.PCSTS(Q3)	;...
	PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	BUG.	(INF,KLPWAG,KLPSER,HARD,<CI wire A has gone from bad to good>,,)
	ANDCAM	T1,.PCSTS(Q3)	;CLEAR THE FLAG
	MOVEI	T2,KS%ABG	;GET READ-COUNTERS REASON CODE
	PUSHJ	P,KLPRPT	;DO A READ-COUNTERS
	JRST	INTLP2		;CONTINUE

INTLP1:	MOVX	T1,ST.WBB	;IS WIRE B FLAGGED AS BAD?
	TDNN	T1,.PCSTS(Q3)	;...
	PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	BUG.	(INF,KLPWBG,KLPSER,HARD,<CI wire B has gone from bad to good>,,)
	ANDCAM	T1,.PCSTS(Q3)	;CLEAR THE FLAG
	MOVEI	T2,KS%BBG	;GET READ-COUNTERS REASON CODE
	PUSHJ	P,KLPRPT	;DO A READ-COUNTERS

INTLP2:	SETZ	Q1,		;START WITH NODE ZERO
INTLP3:	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET BY CI NODE NUMBER
	SKIPN	P5,.PCPBK(P1)	;IS THERE A PATH BLOCK?
	JRST	INTLP4		;NO
	LOAD	T1,PBVCST,(P5)	;GET VC STATE
	CAIE	T1,VC.OPN	;IS VC OPEN?
	JRST	INTLP4		;NO
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;CAN'T, NEXT REQID WILL DO THIS
	MOVX	T1,CK.LPT!CK.PAA!CK.PBA ;BOTH PATHS ALLOWED
	MOVEM	T1,.PKCKT(Q2)	;...
	PUSHJ	P,KLPSCK	;SEND A SET-CIRCUIT
	MOVX	T1,RI.PAO!RI.PBO ;MARK BOTH PATHS AS OPEN
	IORM	T1,.PCRIS(P1)	;...
INTLP4:	CAIL	Q1,MAXNDS-1	;DONE THEM ALL?
	POPJ	P,		;YES, RETURN
	AOJA	Q1,INTLP3	;NO, LOOP TO NEXT ONE
;RECEIVED A LOOP-BACK WITH AN ERROR

LPBERR:	MOVE	T1,.PKSTS(Q2)	;GET STATUS FLAGS
	TXNE	T1,PS.PAE!PS.PBE ;PATH ERROR?
	JRST	LPBER1		;YES
	LDB	T2,PKYSTS	;GET STATUS
	LDB	T3,PKYFLG	;GET FLAGS
	MOVE	T4,.PCCSR(Q3)	;GET CSR
	BUG.	(INF,KLPLBF,KLPSER,HARD,<Loopback failed>,<<T2,STATUS>,<T3,FLAGS>,<P2,OPCODE>,<T4,CSR>>,)
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN

;PATH ERROR

LPBER1:	TXNN	T1,PS.PAE	;PATH A ERROR?
	JRST	LPBER2		;NO, MUST BE PATH B
	MOVX	T1,ST.WAB	;IS WIRE A FLAGGED AS BAD?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	RETDG		;YES, RETURN THE DATAGRAM AND RETURN
	BUG.	(INF,KLPWAB,KLPSER,HARD,<CI wire A has gone from good to bad>,,)
	IORM	T1,.PCSTS(Q3)	;SET THE FLAG
	MOVEI	T2,KS%AGB	;GET READ-COUNTERS REASON CODE
	PJRST	KLPRPT		;DO A READ-COUNTERS AND RETURN

LPBER2:	MOVX	T1,ST.WBB	;IS WIRE B FLAGGED AS BAD?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	RETDG		;YES, RETURN THE DATAGRAM AND RETURN
	BUG.	(INF,KLPWBB,KLPSER,HARD,<CI wire B has gone from good to bad>,,)
	IORM	T1,.PCSTS(Q3)	;SET THE FLAG
	MOVEI	T2,KS%BGB	;GET READ-COUNTERS REASON CODE
	PJRST	KLPRPT		;DO A READ-COUNTERS AND RETURN
;RECEIVED A SET-CIRCUIT

INTCKT:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(CHK,KLPSCR,KLPSER,HARD,<SET-CIRCUIT command received>,<<T1,STATUS>,<T2,FLAGS>,<P2,OPCODE>>,)
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN


;RECEIVED A SET-CIRCUIT WITH AN ERROR

CKTERR:	LDB	T1,PKYSTS	;GET STATUS
	LDB	T2,PKYFLG	;GET FLAGS
	BUG.	(CHK,KLPCKE,KLPSER,HARD,<SET-CIRCUIT command error>,<<T1,STATUS>,<T2,FLAGS>,<P2,OPCODE>>,)
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN
;RECEIVED A READ STATISTICS COUNTERS

INTRCT:	MOVE	T1,.PKSTS(Q2)	;GET PACKET STATUS
	TXNE	T1,PF.CPE	;PORT GENERATE PACKET AFTER A CRAM PARITY ERROR?
	SKIPA	Q1,[KS%PCP]	;YES, GET SPECIAL REASON CODE AND SKIP
	HRRZ	Q1,.PKXID(Q2)	;NO, GET REASON CODE FROM PACKET
	SKIPL	Q1		;CHECK FOR VALIDITY
	CAILE	Q1,RCTMAX	;...
	MOVEI	Q1,RCTMAX+1	;OUT OF RANGE, SET ERROR DISPATCH
	PJRST	@RCTDSP(Q1)	;GO PROCESS THE PACKET

RCTDSP:	IFIW	RCTBUG		;       ILLEGAL
	IFIW	RCTSPR		;KS%PCP PORT CRAM PARITY ERROR
	IFIW	RCTSPR		;KS%AGB PORT A WENT FROM GOOD TO BAD
	IFIW	RCTSPR		;KS%ABG PORT A WENT FROM BAD TO GOOD
	IFIW	RCTSPR		;KS%BGB PORT B WENT FROM GOOD TO BAD
	IFIW	RCTSPR		;KS%BBG PORT B WENT FROM BAD TO GOOD
	IFIW	RCTSPR		;KS%PER PERIODIC READ
	IFIW	RCTBUG		;KS%UCD GET MICROCODE VERSION NUMBER (NOT USED)
	IFIW	RCTDIA		;KS%DIA DIAG. UUO REQUEST
RCTMAX==.-RCTDSP-1		;MAXIMUM REASON CODE
	IFIW	RCTBUG		;OUT OF RANGE


;HERE IF TRANSACTION ID IN PACKET WAS OUT OF RANGE

RCTBUG:	BUG.	(INF,KLPBRC,KLPSER,HARD,<Bad READ-COUNTERS packet>,,)
	PJRST	RETDG		;RETURN THE PACKET


;RECEIVED A READ-STATISTICS-COUNTERS WITH AN ERROR

RCTERR:	BUG.	(CHK,KLPRCE,KLPSER,HARD,<READ-COUNTERS command failed>,,)
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN
;HERE TO MAKE A SPEAR ENTRY (TYPE 241)

RCTSPR:	MOVEI	T1,KS%LEN	;LENGTH OF ERROR BLOCK
	PUSHJ	P,ALCSEB##	;ALLOCATE SYSTEM ERROR BLOCK
	  PJRST	RETDG		;ERROR, JUST TOSS PACKET AND RETURN
	MOVEI	T2,SEC%KS	;GET THE ERROR CODE
	DPB	T2,[POINT 9,.EBTYP(T1),8] ;STORE THE TYPE IN THE HEADER
	MOVEI	T2,2		;OFFSET TO DATA
	MOVEM	T2,.EBHDR+KS%OFF(T1) ;STORE IT
	MOVE	T2,.PKUCD(Q2)	;MICROCODE VERSION
	MOVE	T3,.PKXID(Q2)	;GET TRANSACTION ID (REASON FOR READ COUNTERS)
	DPB	T3,[POINTR T2,KS%RSN] ;STORE IT
	LDB	T4,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	DPB	T4,[POINTR (T2,KS%CHN)] ;SET INTERNAL CHANNEL NUMBER
	MOVEM	T2,.EBHDR+KS%VER(T1) ;STORE IT
	MOVEI	T2,NOSTCT-<.PKUCD-.PKPDA+1> ;NUMBER OF WORDS TO MOVE
	XMOVEI	T3,.PKUCD+1(Q2)	;SOURCE ADDRESS
	MOVEI	T4,.EBHDR+KS%VER+1(T1) ;DESTINATION
	EXTEND	T2,[XBLT]	;MOVE THE REMAINDER
	PUSHJ	P,QUESEB##	;QUEUE THE BLOCK
	PJRST	RETDG		;RETURN THE PACKET AND RETURN


;HERE WHEN DIAG. UUO ASKED TO READ THE COUNTERS

RCTDIA:	MOVE	T1,DATE##	;GET NOW
	MOVEM	T1,.PCCTR(Q3)	;SAVE AS FIRST WORD OF BLOCK
	MOVEI	T1,NOSTCT	;NUMBER OF COUNTERS TO STORE
	XMOVEI	T2,.PKPDA(Q2)	;SOURCE
	XMOVEI	T3,.PCCTR+1(Q3)	;DESTINATION
	EXTEND	T1,[XBLT]	;MOVE THE DATA
	HLRZ	T1,.PKXID(Q2)	;GET JOB WHICH READ COUNTERS
	SNCALL	(WAKJOB##,MCSEC0) ;WAKE THEM UP
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN
;RECEIVED A READ-REGISTER

INTRRG:	LDB	T1,PKYREG	;GET THE REGISTER NUMBER
	CAIE	T1,.RGNOD	;RIGHT ONE?
	BUG.	(HLT,KLPKRW,KLPSER,HARD,<CI20 read the wrong register>,<<T1,REG>>,)
	LDB	T1,PKYDTA	;GET THE DATA (OUR NODE NUMBER)
	MOVEM	T1,.PCONN(Q3)	;STUFF IN PCB
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN


;RECEIVED A READ-REGISTER WITH AN ERROR

RRGERR:	BUG.	(CHK,KLPCRR,KLPSER,HARD,<READ-REGISTER command failed>,,)
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN
;RECEIVED A MAINTENANCE CONFIRM
;RECEIVED A MAINTENANCE DATA RECEIVED

INTMDR:
INTMCR:	PUSHJ	P,CHKMAI	;ARE WE EXPECTING THIS?
	  PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	SETZM	.PCMFL(Q3)	;YES, THERE IS NO ERROR
	PUSHJ	P,WAKMAI	;WAKE THE WAITING JOB
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN


;RECEIVED A MAINTENANCE CONFIRM WITH AN ERROR
;RECEIVED A MAINTENANCE DATA RECEIVED WITH AN ERROR

MDRERR:
MCRERR:	PUSHJ	P,CHKMAI	;ARE WE EXPECTING THIS?
	  PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	BUG.	(INF,KLPMCE,KLPSER,HARD,<Received an MCNF or an MDATREC with an error>,<<T1,NODE>,<T2,STATUS>>,)
	MOVEI	T1,1		;GET ERROR INDICATOR
	MOVEM	T1,.PCMFL(Q3)	;SET THE ERROR FLAG
	PUSHJ	P,WAKMAI	;WAKE THE WAITING JOB
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN


;ROUTINE TO CHECK FOR MAINTENANCE TYPE MESSAGES EXPECTED.
;CALL:
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKMAI
;RETURN:
;	CPOPJ IF NOT EXPECTED
;	CPOPJ1 IF EXPECTED

CHKMAI:	SKIPE	.PCMJB(Q3)	;IS A MAINTENANCE TYPE MESSAGE EXPECTED?
	JRST	CPOPJ1##	;YES
	BUG.	(CHK,KLPMCR,KLPSER,HARD,<Received an unexpected MCNF or MDATREC>,<<Q1,NODE>>,)
	POPJ	P,		;RETURN
;RECEIVED A CLOSE BUFFER FINISHED INTERRUPT

INTCLB:	SKIPN	.PCMCN(Q3)	;IS THE DIAG. UUO EXPECTING THIS?
	PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	MOVE	T1,.PKBNM(Q2)	;YES, GET THE BUFFER NAME
	CAME	T1,.PCMCN(Q3)	;IS THIS THE ONE THE DIAG. EXPECTS?
	PJRST	RETDG		;NO, RETURN THE DATAGRAM AND RETURN
	AOS	.PCMCF(Q3)	;YES, SET THE FLAG
	PUSHJ	P,WAKMAI	;WAKE THE WAITING JOB
	PJRST	RETDG		;RETURN THE DATAGRAM AND RETURN


;RECEIVED A CLOSE-BUFFER WITH AN ERROR

CLBERR:	LDB	T2,PKYSFD	;GET STATUS FIELD LESS ERROR BIT
	CAIE	T2,PS.IBN	;IS IT AN INVALID BUFFER NAME ERROR?
	BUG.	(INF,KLPCLB,KLPSER,HARD,<Close buffer function failed>,<<T1,STATUS>>,)
	PJRST	INTCLB		;FINISH UP LIKE IT SUCCEEDED


;ROUTINE TO WAKE THE JOB WAITING FOR A MAINTENANCE OPERATION TO COMPLETE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,WAKMAI
;RETURN:
;	CPOPJ ALWAYS

WAKMAI:	MOVE	T1,.PCMJB(Q3)	;GET THE JOB
	SNCALL	(WAKJOB##,MCSEC0) ;WAKE THEM UP
	POPJ	P,		;RETURN
;ROUTINE TO PUT A PACKET ON THE DATAGRAM FREE QUEUE.
;CALL:
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,RETDG
;RETURN:
;	CPOPJ ALWAYS

RETDG:	XMOVEI	T1,.PCDFQ(Q3)	;POINT AT THE PROPER QUEUE
	PJRST	PUTQUE		;RETURN THE PACKET AND RETURN


;ROUTINE TO PUT A PACKET ON THE MESSAGE FREE QUEUE.
;CALL:
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,RETMSG
;RETURN:
;	CPOPJ ALWAYS

RETMSG:	XMOVEI	T1,.PCMFQ(Q3)	;POINT AT THE PROPER QUEUE
	PJRST	PUTQUE		;RETURN THE PACKET AND RETURN
	SUBTTL	INTERRUPT LEVEL ERROR PROCESSING


;ROUTINE CALLED TO PRINT AN ERROR TEXT ON A CRAM PARITY ERROR.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLECPE
;RETURN:
;	CPOPJ ALWAYS

KLECPE:	XJRST	[MCSEC1+KLECP1]	;MUST EXECUTE IN SECTION 1 FOR INLMES CALLS

	$HIGH
KLECP1:	MOVE	T1,.PCCRA(Q3)	;GET THE CRAM ADDRESS
	CAIL	T1,PPEFST	;IS THIS A PLANNED CRAM PARITY ERROR?
	CAILE	T1,PPELST	;...
	STOPCD	CPOPJ,INFO,KLPCPE,CPETYP ;++KLIPA CRAM PARITY ERROR
	STOPCD	CPOPJ,INFO,KLPHLT,HLTTYP ;++KLIPA MICROPROCESSOR HALT

;ROUTINE CALLED FROM DIE ON AN UNPLANNED CRAM PARITY ERROR

CPETYP:	PUSHJ	P,INLMES##	;PRINT TEXT
	  ASCIZ	/CI20 CRAM parity error
CRAM location /
	MOVE	T1,.PCCRA(Q3)	;GET THE CRAM ADDRESS
	PUSHJ	P,PRTDI8##	;PRINT IN OCTAL
	PUSHJ	P,INLMES##	;TYPE OUT CRAM CONTENTS
	  ASCIZ	/, CRAM contents /
	MOVE	T1,.PCCDL(Q3)	;GET FIRST CRAM HALFWORD
	PUSHJ	P,HWDPNT##	;PRINT AS HALFWORDS
	PUSHJ	P,PRSPC##	;SPACE OVER
	MOVE	T1,.PCCDR(Q3)	;GET SECOND CRAM HALFWORD
	PJRST	HWDPNT##	;PRINT AS HALFWORDS AND RETURN (DIE ADDS CRLF)

;ROUTINE CALLED FROM DIE ON A PLANNED CRAM PARITY ERROR

HLTTYP:	PUSHJ	P,INLMES##	;PRINT TEXT
	  ASCIZ	/CI20 microprocessor halted - /
	MOVE	T1,.PCCRA(Q3)	;GET THE CRAM ADDRESS
	HRRZ	T1,CPETXT-PPEFST(T1) ;GET ERROR TEXT ADDRESS
	PJRST	CONMES##	;PRINT AND RETURN (DIE ADDS CRLF)

	$XHIGH
;ROUTINE TO FINISH UP PROCESSING OF A CRAM PARITY ERROR.
;MUST BE CALLED AFTER REPORT AS IT DEPENDS ON SOME
;OF THE DATA WHICH REPORT STORES IN THE PCB.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLPCPD
;RETURN:
;	CPOPJ ALWAYS

KLPCPD:	MOVE	T1,.PCCRA(Q3)	;GET THE LAR
	SUBI	T1,PPEFST	;OFFSET TO FIRST PLANNED CRAM PARITY ERROR
	SKIPGE	T1		;PLANNED CRAM PARITY ERROR?
	MOVEI	T1,CPEUNP	;NO, SET DISPATCH FOR UNPLANNED CRAM PARITY ERROR
	PUSHJ	P,@CPEDSP(T1)	;CALL THE APPROPRIATE ROUTINE
	PJRST	RSTEWD		;ZERO THE PCB ERROR WORDS AND RETURN
;MACRO TO DEFINE CLEAN-UP ROUTINE AND TEXT STRING FOR CRAM PARITY ERRORS.

DEFINE	ERRS,<

	XALL			;;LIST GENERATED TABLE

	CPE	7750, CPEDON, <Internal port error>
	CPE	7751, CPEDON, <Self test failed>
	CPE	7752, CPEDON, <EBUS parity error>
	CPE	7753, EPEDON, <EBUS parity error>
	CPE	7754, CPEDON, <PLI parity error>
	CPE	7755, CPEDON, <CBUS parity error>
	CPE	7756, CPEDON, <Data path error>
	CPE	7757, CPEDON, <CBUS request error>
	CPE	7760, CPEDON, <EBUS request error>
	CPE	7761, CPEDON, <Grant CSR error>
	CPE	7762, CPEDON, <Short word count>
	CPE	7763, CPEDON, <Spurious channel error>
	CPE	7764, CPEDON, <Spurious transmit attention error>
	CPE	7765, CPEDON, <Spurious receive attention error>
	CPE	7766, CPEDON, <Transmitter timeout>
	CPE	7767, CPEDON, <Unknown halt code 7767>
	CPE	7770, CPEDON, <Unknown halt code 7770>
	CPE	7771, CPEDON, <Unknown halt code 7771>
	CPE	7772, CPEDON, <Unknown halt code 7772>
	CPE	7773, CPEDON, <Unknown halt code 7773>
	CPE	7774, CPEDON, <Unknown halt code 7774>
	CPE	7775, CPEDON, <Unknown halt code 7775>
	CPE	7776, CPEDON, <Unknown halt code 7776>
	CPE	7777, CPEDON, <Unknown halt code 7777>

	SALL

>; END DEFINE ERRS
;GENERATE CLEAN-UP ROUTINE TABLE

DEFINE	CPE(LOC,ADDR,TEXT),<
IF1,<IFN <<LOC-PPEFST>-<.-CPEDSP>>,<PRINTX ?Table CPEDSP entry LOC is out of order>>
	IFIW	ADDR		;'LOC' 'TEXT
>; END DEFINE CPE

CPEDSP:	ERRS			;GENERATE CLEAN-UP ROUTINE ADDRESS
CPEUNP==.-CPEDSP		;OFFSET FOR UNPLANNED CRAM PARITY ERROR
	IFIW	KLPUNP		;XXXX UNPLANNED CRAM PARITY ERROR
;GENERATE ERROR TEXT TABLE

DEFINE	CPE(LOC,ADDR,TEXT),<
IF1,<IFN <<LOC-PPEFST>-<.-CPETXT>>,<PRINTX ?Table CPETXT entry LOC is out of order>>
	[ASCIZ	|TEXT|]		;'LOC'
>; END DEFINE CPE

	$HIGH			;MUST BE TYPE-ABLE
CPETXT:	ERRS			;GENERATE ERROR TEXT TABLE
	$XHIGH
;HERE WHEN CRAM PARITY ERROR PROCESSING IS DONE

CPEDON:	PUSHJ	P,CLNKLP	;CLEAN UP THE QUEUES
CPEDN1:	PUSHJ	P,STRKLP	;RESTART THE KLIPA
	  PJRST	RLDKLP		;FAILED, RELOAD IT
	POPJ	P,		;RETURN


;EBUS PARITY ERROR (QUEUES MESSED UP)

EPEDON:	MOVX	T1,E0.RES	;RESPONSE QUEUE HAVE ERROR?
	TDNN	T1,.PCER0(Q3)	;...
	JRST	EPEDN1		;NO
	XMOVEI	T1,.PCRSQ(Q3)	;YES, GET RESPONSE QUEUE INTERLOCK WORD
	MAP	T2,.PQFLI(T1)	;GET THE FLINK
	TXZ	T2,MP.NAD	;CLEAR JUNK BITS
	MOVEM	T2,.PQFLI(T1)	;MAKE FLINK POINT AT ITSELF
	MOVEM	T2,.PQBLI(T1)	;MAKE BLINK POINT AT FLINK
	JRST	EPEDN2		;CONTINUE

EPEDN1:	MOVX	T1,CI.RQA	;IS A RESPONSE QUEUE AVAILABLE?
	TDNE	T1,.PCCSR(Q3)	;...
	PUSHJ	P,KLPRQC	;YES, PROCESS THE RESPONSES
EPEDN2:	MOVX	T1,E0.CMD	;COMMAND QUEUE ERROR?
	TDNN	T1,.PCER0(Q3)	;...
	PJRST	CPEDN1		;NO, DONE
	LOAD	T2,E0QUE,(Q3)	;YES, GET THE COMMAND QUEUE NUMBER
	IMULI	T2,.PQLEN	;TIMES LENGTH OF AN ENTRY
	XMOVEI	T1,.PCCQ0(Q3)	;ADDRESS OF COMMAND QUEUE 0 INTERLOCK WORD
	SUB	T1,T2		;MOVE TO THE CORRECT INTERLOCK WORD
	PUSHJ	P,CLENCQ	;CLEAN ALL QUEUES EXCEPT THE BAD ONE
	PJRST	CPEDN1		;RESTART THE KLIPA
;UNPLANNED CRAM PARITY ERROR (0000-7747)

KLPUNP:	XMOVEI	T1,.PCQBG(Q3)	;START OF THE QUEUES
	XMOVEI	T4,.PCQND(Q3)	;END OF THE QUEUES
KLPUN1:	MAP	T2,.PQFLI(T1)	;GET FLINK
	TXZ	T2,MP.NAD	;CLEAR JUNK BITS
	MOVEM	T2,.PQFLI(T1)	;MAKE FLINK POINT AT ITSELF
	MOVEM	T2,.PQBLI(T1)	;MAKE BLINK POINT AT FLINK
	ADDI	T1,.PQLEN	;ADVANCE TO NEXT QUEUE
	CAMGE	T1,T4		;DONE THEM ALL?
	JRST	KLPUN1		;NO
	PUSHJ	P,STKDFQ	;RE-STOCK THE DATAGRAM FREE QUEUE
	PJRST	RLDKLP		;RELOAD THE KLIPA AND RETURN
;ROUTINE TO CLEAN ALL QUEUES AND PROCESS ANY RESPONSES.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,CLNKLP
;RETURN:
;	CPOPJ ALWAYS

CLNKLP:	XMOVEI	T1,.PCRSQ(Q3)	;GET ADDRESS OF RESPONSE QUEUE
	PUSHJ	P,CHKMPT	;IS RESPONSE QUEUE EMPTY?
	  SKIPA			;YES
	PUSHJ	P,KLPRQC	;NO, CLEAN THE RESPONSE QUEUE
	SETZ	T1,		;FLAG WE SHOULD CLEAN ALL QUEUES
	PJRST	CLENCQ		;CLEAN THE COMMAND QUEUES AND RETURN


;ROUTINE TO CLEAN THE COMMAND QUEUES
;CALL:
;	T1/ 0 OR ADDRESS OF QUEUE WHICH IS BAD
;	Q3/ PCB
;	PUSHJ	P,CLENCQ
;RETURN:
;	CPOPJ ALWAYS

CLENCQ:	STKVAR	<IWORD,BADQI>	;ALLOCATE SOME STACK STORAGE
	MOVEM	T1,BADQI	;SAVE ADDRESS OF .PQIWD FOR BAD QUEUE
	XMOVEI	T1,.PCCQB(Q3)	;GET ADDRESS OF FIRST COMMAND QUEUE
CLENC1:	MOVEM	T1,IWORD	;SAVE ACROSS CALLS TO CLNCOM
	SETOM	.PQIWD(T1)	;RESET THE INTERLOCK
	CAME	T1,BADQI	;IS THIS THE BAD ONE?
	JRST	CLENC2		;NO
	MAP	T2,.PQFLI(T1)	;YES, GET ADDRESS OF FLINK
	TXZ	T2,MP.NAD	;CLEAR JUNK BITS
	MOVEM	T2,.PQFLI(T1)	;MAKE FLINK POINT AT ITSELF
	MOVEM	T2,.PQBLI(T1)	;MAKE BLINK POINT AT FLINK
	JRST	CLENC3		;CONTINUE

CLENC2:	PUSHJ	P,CLNCOM	;CLEAN THE COMMAND QUEUE
CLENC3:	MOVE	T1,IWORD	;WHERE WE WERE
	ADDI	T1,.PQLEN	;STEP TO NEXT QUEUE ENTRY
	XMOVEI	T2,.PCCQE(Q3)	;END OF THE COMMAND QUEUES
	CAMGE	T1,T2		;GONE PAST THE END?
	JRST	CLENC1		;NO, DO NEXT COMMAND QUEUE
	POPJ	P,		;RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE
;ROUTINE TO CLEAN AN INDIVIDUAL COMMAND QUEUE
;CALL:
;	T1/ ADDRESS OF QUEUE'S INTERLOCK WORD
;	Q3/ PCB
;	PUSHJ	P,CLNCOM
;RETURN:
;	CPOPJ ALWAYS

CLNCOM:	STKVAR	<IWORD>		;ALLOCATE A WORD OF STACK STORAGE
	MOVEM	T1,IWORD	;STASH ADDRESS OF INTERLOCK WORD
CLNCM1:	PUSHJ	P,REMQUE	;GET A PACKET FROM THE QUEUE
	  POPJ	P,		;QUEUE EMPTY, DONE
	MOVX	T1,PK.SCA	;IS PACKET TO BE RETURNED TO SCA?
	TDNE	T1,.PKVRT(Q2)	;...
	JRST	CLNCM2		;YES
	PUSHJ	P,TOSSIT	;NO, RETURN IT TO PROPER FREE QUEUE
	JRST	CLNCM3		;CONTINUE

CLNCM2:	SETO	P3,		;SAY PACKET WAS LOCALLY GENERATED
	MOVE	P5,Q3		;GET PCB ADDRESS
	LDB	T1,PKYNOD	; OFFSET FOR THIS NODE
	ADD	P5,T1		;...
	MOVE	P5,.PCPBK(P5)	;GET PBK ADDRESS
	CIOFF			;PREVENT INTERRUPTS WHILE IN SCA LAND
	PUSHJ	P,GV2SCA	;GIVE THE PACKET TO SCA
	CION			;OK TO INTERRUPT
CLNCM3:	MOVE	T1,IWORD	;RESTORE ADDRESS OF INTERLOCK WORD
	JRST	CLNCM1		;GO GET NEXT PACKET

	ENDSV.			;END OF STACK VARIABLE RANGE
;ROUTINE TO STOP, RESET, AND RESTART THE KLIPA
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,URDEAD
;RETURN:
;	CPOPJ ALWAYS

URDEAD:	CIOFF			;PREVENT RACES
	PUSHJ	P,STPKLP	;STOP THE KLIPA
	PUSHJ	P,CIGONE	;RESET ALL CI ACTIVITY
	PUSH	P,W		;SAVE AN AC
	MOVE	W,Q3		;COPY KDB ADDRESS
	PUSHJ	P,DMPIPA##	;DUMP THE KLIPA DRAM
	  JFCL			;FAILED, DON'T REALLY CARE
	POP	P,W		;RESTORE W
	PUSHJ	P,RLDKLP	;RELOAD THE KLIPA
	PJRST	CIONPJ##	;TURN INTERRUPTS BACK ON AND RETURN


;ROUTINE TO RESET ALL CI ACTIVITY.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CIGONE
;RETURN:
;	CPOPJ ALWAYS

CIGONE:	PUSHJ	P,NONODS	;INFORM SCA OF DEPARTED NODES
	PUSHJ	P,RSTRID	;RESET REQUEST-ID STATUS
	PUSHJ	P,RSTLKS	;RESET QUEUE INTERLOCKS IN PCB
	PJRST	CLNKLP		;CLEAN THE QUEUES AND RETURN


;ROUTINE TO TELL SCA ABOUT THE DISAPPEARANCE OF EACH NODE
;WITH AN OPEN VC WHEN THE KLIPA CROAKS.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,NONODS
;RETURN:
;	CPOPJ ALWAYS

NONODS:	SAVEAC	<P1,P2,P4,P5>	;SAVE THE AC'S WE NEED
	MOVE	P1,Q3		;GET PCB ADDRESS
	MOVEI	P2,MAXNDS	;NUMBER OF ENTRIES
NONOD1:	SKIPN	P5,.PCPBK(P1)	;GET A PATH BLOCK ADDRESS
	JRST	NONOD2		;NONE?
	SETZ	Q2,		;GET YOUR OWN PACKET
	SETO	P4,		;WE NEED A SHUTDOWN PACKET
	PUSHJ	P,CLOSV1	;CLOSE THE VC AND TELL SCA
NONOD2:	SOJLE	P2,CPOPJ##	;RETURN IF NO MORE NODES LEFT
	AOJA	P1,NONOD1	;YES, OFFSET TO NEXT NODE AND LOOP
;CLEAR QUEUE INTERLOCKS
;CALL WITH:
;	Q3/ PCB
;	PUSHJ	P,RSTLKS
;RETURN:
;	CPOPJ ALWAYS

RSTLKS:	SETOM	.PCCQ3+.PQIWD(Q3) ;COMMAND QUEUE 3
	SETOM	.PCCQ2+.PQIWD(Q3) ;COMMAND QUEUE 2
	SETOM	.PCCQ1+.PQIWD(Q3) ;COMMAND QUEUE 1
	SETOM	.PCCQ0+.PQIWD(Q3) ;COMMAND QUEUE 0
	SETOM	.PCRSQ+.PQIWD(Q3) ;RESPONSE QUEUE
	SETOM	.PCMFQ+.PQIWD(Q3) ;MESSAGE FREE QUEUE
	SETOM	.PCDFQ+.PQIWD(Q3) ;DATAGRAM FREE QUEUE
	SETOM	.PCRFQ+.PQIWD(Q3) ;RESERVED FREE QUEUE
	POPJ	P,		;RETURN


;CLEAR THE ERROR WORDS
;CALL:
;	Q3/ PCB
;	PUSHJ	P,RSTEWD
;RETURN:
;	CPOPJ ALWAYS

RSTEWD:	SETZM	.PCER0(Q3)	;ERROR WORD 0
	SETZM	.PCER1(Q3)	;ERROR WORD 1
	SETZM	.PCER2(Q3)	;ERROR WORD 2
	SETZM	.PCER3(Q3)	;ERROR WORD 3
	SETZM	.PCER4(Q3)	;ERROR WORD 4
	POPJ	P,		;RETURN
;ROUTINE TO RESET THE PCB QUEUES.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,RSTQS
;RETURN:
;	CPOPJ ALWAYS

RSTQS:	XMOVEI	T1,.PCQBG(Q3)	;POINT AT FIRST QUEUE ENTRY TRIPLET
	XMOVEI	T4,.PCQND(Q3)	;POINT AT END OF QUEUE ENTRY TRIPLETS
RSTQS1:	SETOM	.PQIWD(T1)	;SET THE INTERLOCK WORD
	MAP	T2,.PQFLI(T1)	;GET VIRTUAL ADDRESS OF FORWARD LINK
	TXZ	T2,MP.NAD	;CLEAR JUNK BITS
	MOVEM	T2,.PQFLI(T1)	;MAKE FLINK POINT AT ITSELF
	MOVEM	T2,.PQBLI(T1)	;MAKE BLINK POINT AT FLINK
	ADDI	T1,.PQLEN	;ADD LENGTH OF THE QUEUE ENTRY TRIPLET
	CAMGE	T1,T4		;PAST THE END?
	JRST	RSTQS1		;NO, LOOP FOR OTHER QUEUE ENTRY TRIPLETS
	POPJ	P,		;RETURN


;ROUTINE TO STOCK THE DATAGRAM FREE QUEUE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,STKDFQ
;RETURN:
;	CPOPJ ONLY IF SUCCEEDED

STKDFQ:	MOVNI	T1,2*MAXNDS	;GET TWO DATAGRAM BUFFERS FOR EACH NODE
				; (INDICATE WE WANT TO OVER-RIDE THRESHOLD CHECK)
	PUSHJ	P,SC.ALD##	;GET THEM FROM SCA
	  BUG.	(HLT,KLPNOD,KLPSER,SOFT,<Can't stock datagram free queue>,,)
	MOVE	Q2,T1		;POSITION THE FIRST BUFFER ADDRESS
	XMOVEI	T1,.PCDFQ(Q3)	;QUEUE ON WHICH TO INSERT PACKET
	PJRST	LNKQUE		;LINK THE PACKETS ON THE FREE QUEUE AND RETURN
;ROUTINE CALLED TO PROCESS AN MBUS ERROR.
;MUST BE CALLED AFTER REPORT AS IT DEPENDS ON SOME
;OF THE DATA WHICH REPORT STORES IN THE PCB.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLPMBD
;RETURN:
;	CPOPJ ALWAYS

KLPMBD:	MOVE	T1,.PCCSR(Q3)	;GET CONI
	MOVE	T2,.PCCRA(Q3)	;GET LAR
	DMOVE	T3,.PCCDL(Q3)	;GET TWO DATA WORDS
	BUG.	(INF,KLPMBE,KLPSER,HARD,<MBUS error>,<<T1,CSR>,<T2,LAR>,<T3,CRAM1>,<T4,CRAM2>>,)
	PUSHJ	P,STRKLP	;RESTART THE KLIPA
	  PJRST	RLDKLP		;FAILED, RELOAD THE MICROCODE
	POPJ	P,		;RETURN
;ROUTINE CALLED TO PROCESS A FREE QUEUE ERROR.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLPFQE
;RETURN:
;	CPOPJ ALWAYS

KLPFQE:	MOVE	T1,.PCPIA(Q3)	;GET PI ASSIGNMENT
	TRO	T1,CO.EPE!CO.FQE!CO.BTS ;FREE QUEUE ERROR, EBUS PARITY
	XCT	KDBCNO(Q3)	;CLEAR BITS
	XMOVEI	T1,.PCDFQ(Q3)	;ADDRESS OF QUEUE
	PUSHJ	P,CHKMPT	;IS QUEUE EMPTY?
	  SKIPA			;YES
	JRST	KLPFQ2		;NO
	BUG.	(INF,KLPDFQ,KLPSER,SOFT,<Datagram free queue empty>,,)
	MOVEI	T1,1		;GET A DATAGRAM BUFFER
	PUSHJ	P,SC.ALD##	;ASK SCA
	  JRST	KLPFQ1		;COULDN'T
	MOVE	Q2,T1		;POSITION THE BUFFER ADDRESS
	PUSHJ	P,RETDG		;PUT IT ON THE DATAGRAM FREE QUEUE
KLPFQ1:	MOVSI	T1,1		;COUNT A DATAGRAM FREE QUEUE ERROR
	ADDM	T1,.PCFQE(Q3)	;...
	POPJ	P,		;RETURN

KLPFQ2:	XMOVEI	T1,.PCMFQ(Q3)	;ADDRESS OF QUEUE
	PUSHJ	P,CHKMPT	;IS QUEUE EMPTY?
	  SKIPA			;YES
	JRST	KLPFQ4		;NO
	BUG.	(INF,KLPMFQ,KLPSER,SOFT,<Message free queue empty>,,)
	MOVEI	T1,1		;GET A MESSAGE BUFFER
	PUSHJ	P,SC.ABF##	;ASK SCA
	  JRST	KLPFQ3		;COULDN'T
	MOVE	Q2,T1		;POSITION THE BUFFER ADDRESS
	PUSHJ	P,RETMSG	;PUT IT ON THE MESSAGE FREE QUEUE
KLPFQ3:	MOVEI	T1,1		;COUNT A MESSAGE FREE QUEUE ERROR
	ADDM	T1,.PCFQE(Q3)	;...
	POPJ	P,		;RETURN

KLPFQ4:	BUG.	(INF,KLPSFQ,KLPSER,SOFT,<Spurious free queue error>,,)
	POPJ	P,		;RETURN
;ROUTINE TO RECORD PORT ERROR INFORMATION IN THE PCB AND
;MAKE A SPEAR ENTRY.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,REPORT
;RETURN:
;	CPOPJ ALWAYS

REPORT:	PUSHJ	P,SAVE1##	;SAVE P1 FOR A BIT
	MOVE	P1,DATE##	;GET NOW
	SUB	P1,.PCLKE(Q3)	;HOW LONG SINCE LAST ERROR
	CAIGE	P1,RSTIME	;HAS IT SCREWED UP LATELY?
	TDZA	P1,P1		;NO, WE'LL RESTART IT
	MOVEI	P1,1		;YES, WE'LL LEAVE IT STOPPED
	MOVE	T1,DATE##	;GET NOW
	MOVEM	T1,.PCLKE(Q3)	;UPDATE TIME OF LAST ERROR
	PUSH	P,W		;SAVE W
	MOVE	W,Q3		;SET UP KDB ADDRESS
	PUSHJ	P,RDLAR##	;READ LATCHED ADDRESS REGISTER
	  SETZ	T1,		;IGNORE ERRORS
	MOVEM	T1,.PCCRA(Q3)	;SAVE IT
	PUSHJ	P,RDIPA##	;READ THAT CRAM ADDRESS
	  SETZB	T2,T3		;CHANNEL RUNNING?
	MOVEM	T2,.PCCDL(Q3)	;SAVE LH CRAM WORD
	MOVEM	T3,.PCCDR(Q3)	;SAVE RH CRAM WORD
	POP	P,W		;RESTORE W
	MOVE	T1,.PCLGO(Q3)	;CHANNEL LOGOUT AREA ADDRESS
	DMOVE	T2,0(T1)	;GET FIRST TWO WORDS OF CHANNEL LOGOUT AREA
	DMOVEM	T2,.PCLG0(Q3)	;SAVE THEM
	MOVE	T2,2(T1)	;GET THIRD WORD
	MOVEM	T2,.PCLG2(Q3)	;SAVE IT
	MOVE	T1,.PCCCW(Q3)	;GET PORT'S CCW
	MOVEM	T1,.PCECW(Q3)	;SAVE IT

;WITH THE NECESSARY DATA GATHERED TRY TO MAKE A SPEAR ENTRY
	MOVEI	T1,KP%LEN	;LENGTH OF ERROR BLOCK
	PUSHJ	P,ALCSEB##	;ALLOCATE SYSTEM ERROR BLOCK
	  POPJ	P,		;SORRY, WE TRIED
	MOVEI	T2,SEC%KP	;GET THE ERROR CODE
	DPB	T2,[POINT 9,.EBTYP(T1),8] ;STORE THE TYPE IN THE HEADER
	MOVE	T2,.PCCSR(Q3)	;GET CONI AT INTERRUPT
	MOVEM	T2,.EBHDR+KP%CSR(T1) ;STORE IT
	HRRZ	T2,.PCULB+.ULVER(Q3) ;GET KLIPA MICROCODE VERSION
	LDB	T3,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	DPB	T3,[POINTR (T2,KP%CHN)] ;SET INTERNAL CHANNEL NUMBER
	MOVEM	T2,.EBHDR+KP%VER(T1) ;STORE IT
;	MOVEI	T2,2(P1)	;GET DISPOSITION CODE
	SETZ	T2,		;STORE A ZERO LIKE TOPS-20 DOES
	MOVEM	T2,.EBHDR+KP%DSP(T1) ;STORE IT
	MOVE	T2,.PCCRA(Q3)	;GET CRAM ADDRESS
	MOVEM	T2,.EBHDR+KP%CRA(T1) ;STORE IT
	DMOVE	T2,.PCCDL(Q3)	;GET CRAM DATA
	DMOVEM	T2,.EBHDR+KP%CRD(T1) ;STORE IT
	DMOVE	T2,.PCLG0(Q3)	;GET FIRST TWO LOGOUT WORDS
	DMOVEM	T2,.EBHDR+KP%LG0(T1) ;STORE THEM
	MOVE	T2,.PCLG2(Q3)	;GET THIRD LOGOUT WORD
	MOVEM	T2,.EBHDR+KP%LG2(T1) ;STORE IT
	MOVE	T2,.PCECW(Q3)	;GET PORT'S CCW AT ERROR
	MOVEM	T2,.EBHDR+KP%ECW(T1) ;STORE IT
	DMOVE	T2,.PCER0(Q3)	;GET ERROR WORDS
	DMOVEM	T2,.EBHDR+KP%PE0(T1) ;STORE THEM
	PJRST	QUESEB##	;QUEUE THE BLOCK AND RETURN
	SUBTTL	MISCELLANEOUS KLIPA ROUTINES


;ROUTINE TO START THE KLIPA.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,STRKLP
;RETURN:
;	CPOPJ IF COULDN'T START KLIPA
;	CPOPJ1 IF KLIPA STARTED

STRKLP:	PUSHJ	P,RSTEWD	;RESET THE PCB ERROR WORDS
	PUSHJ	P,KIKKLP	;KICK THE KLIPA
	  JRST	STRKL1		;IT FAILED
	PUSHJ	P,PIAKLP	;GIVE THE KLIPA A PI ASSIGNMENT
	BUG.	(INF,KLPSTR,KLPSER,HARD,<CI20 restarted>,,)
	MOVX	T1,ST.RDY	;KLIPA NEEDS TO SEND REQUEST-IDS
	ANDCAM	T1,.PCSTS(Q3)	;CLEAR FLAG SO PPDSEC KNOWS
	JRST	CPOPJ1##	;SKIP RETURN

STRKL1:	MOVX	T1,ST.DED	;IS THE SECOND TIME WE'VE TRIED TO START THE KLIPA?
	TDNE	T1,.PCSTS(Q3)	;...
	JRST	STRKL2		;YES, IT MUST BE DEAD
	IORM	T1,.PCSTS(Q3)	;NO, SET THE FLAG FOR NEXT TIME
	BUG.	(INF,KLPRSF,KLPSER,HARD,<CI20 restart failed>,,)
	POPJ	P,		;RETURN

STRKL2:	BUG.	(INF,KLPDED,KLPSER,HARD,<CI20 is dead>,,)
	POPJ	P,		;RETURN


;ROUTINE TO STOP THE KLIPA.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,STPKLP
;RETURN:
;	CPOPJ ALWAYS

STPKLP:	PUSHJ	P,DISKLP	;PUT KLIPA IN DISABLED STATE
	  JFCL			;DON'T REALLY CARE
	MOVEI	T1,CO.CPT	;CLEAR PORT
	XCT	KDBCNO(Q3)	;...
	MOVX	T1,ST.DED	;SAY IT'S DEAD
	IORM	T1,.PCSTS(Q3)	;...
	POPJ	P,		;RETURN
;ROUTINE TO RELOAD THE KLIPA MICROCODE AND START THE KLIPA.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,RLDKLP
;RETURN:
;	CPOPJ ALWAYS


;ROUTINE TO RELOAD THE KLIPA MICROCODE AND START THE KLIPA.
;SIMILAR TO RLDKLP BUT TAKES SKIP RETURN IF RELOAD SUCCEEDED.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,RLDKLI
;RETURN:
;	CPOPJ IF RELOAD FAILED
;	CPOPJ1 IF RELOAD SUCCEEDED

RLDKLP:	TDZA	T1,T1		;INDICATE RLDKLP ENTRY
RLDKLI:	MOVEI	T1,1		;INDICATE RLDKLI ENTRY
	PUSHJ	P,SAVE1##	;SAVE P1
	MOVE	P1,T1		;SAVE ENTRY INDICATOR
	PUSHJ	P,KLPLOD	;LOAD THE KLIPA MICROCODE
	JUMPE	T1,RLDKL3	;NO VERSION MEANS NO UCODE LOADED
	PUSHJ	P,KIKKLP	;KICK THE KLIPA
	  JRST	RLDKL2		;FAILED
	JUMPN	P1,CPOPJ1##	;SKIP PI ASSIGNMENT, ETC., IF INITIALIZATION
	PJRST	PIAKLP		;GIVE THE KLIPA A PI ASSIGNMENT AND RETURN

RLDKL2:	BUG.	(INF,KLPRLF,KLPSER,HARD,<CI20 microcode reload failed>,,)

RLDKL3:	MOVX	T1,ST.DED	;SAY IT'S DEAD
	IORM	T1,.PCSTS(Q3)	;...
	POPJ	P,		;RETURN
;ROUTINE TO GET THE KLIPA READY TO RUN.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KIKKLP
;RETURN:
;	CPOPJ IF COULDN'T GET IT READ
;	CPOPJ1 IF KLIPA READY TO RUN
;
;CLEARS ST.DED IF KLIPA ENTERED ENABLED STATE.

KIKKLP:	PUSHJ	P,RSTRID	;RESET REQUEST-ID INFO
	MOVE	T1,.PCLGO(Q3)	;ADDRESS OF CHANNEL LOGOUT AREA
	MOVE	T2,.PCPBA(Q3)	;GET PHYSICAL ADDRESS OF PCB
	ADD	T2,[FLD(.CCFTH,CC.OPC)!FLD(3,CC.WDC)!FLD(<.PCPBA-.PCPCB>,CC.ADR)]
				; SET INITIAL CCW TO TRANSFER .PCPBA, .PCPIA,
				; AND .PCAL1 TO THE KLIPA
	MOVEM	T2,.CSICW(T1)	;STORE IN THE CHANNEL LOGOUT AREA
	MOVSI	T2,(.DOLRA)	;ADDRESS = 0
	XCT	KDBDTO(Q3)	;SET START ADDRESS
	PUSHJ	P,DISKLX	;PUT KLIPA IN DISABLED STATE
	  POPJ	P,		;WE COULDN'T MAKE IT
	MOVE	T1,.PCLGO(Q3)	;ADDRESS OF CHANNEL LOGOUT AREA AGAIN
	MOVE	T2,.PCPBA(Q3)	;GET PHYSICAL ADDRESS OF PCB
	ADD	T2,[FLD(.CCJMP,CC.OPC)!FLD(<.PCCCW-.PCPCB>,CC.ADR)] ;JUMP CCW
				; FOR THE KLIPA TO USE
	MOVEM	T2,.CSICW(T1)	;STORE IN THE CHANNEL LOGOUT AREA
	PUSHJ	P,ENAKLP	;PUT KLIPA IN ENABLED STATE
	  POPJ	P,		;WE COULND'T MAKE IT
	MOVE	T1,.CPUPT##	;RESET KEEP-ALIVE TIMER
	MOVEM	T1,.PCKRT(Q3)	; TO PREVENT SPURIOUS KLPKAF
	MOVX	T1,ST.DED	;KLIPA ISN'T DEAD
	ANDCAM	T1,.PCSTS(Q3)	;...
	JRST	CPOPJ1##	;SUCCESS


;ROUTINE TO GIVE THE KLIPA ITS PI ASSIGNMENT.
;CALL:
;	Q3/ PCB
;	PUSHJ	P,PIAKLP
;RETURN:
;	CPOPJ ALWAYS

PIAKLP:	MOVE	T1,.PCPIA(Q3)	;GET PI ASSIGNMENT
	TRO	T1,CO.BTS	;PLUS GOOD BITS
	XCT	KDBCNO(Q3)	;BIT IT ITS PI ASSIGNMENT
	POPJ	P,		;RETURN
;ROUTINE TO MAKE THE KLIPA ENTER THE DISABLED STATE.
;CALL:
;	PUSHJ	P,DISKLP
;RETURN:
;	CPOPJ IF DIDN'T ENTER DISABLED STATE
;	CPOPJ1 IF KLIPA IN DISABLED STATE

DISKLP:	XCT	KDBCNI(Q3)	;READ STATUS
	TRNN	T1,CI.MRN	;MICROCODE RUNNING?
	JRST	CPOPJ1##	;NO, THEN DON'T NEED TO STOP IT

DISKLX:	MOVEI	T1,CO.DIS+CO.MRN ;GO FROM UNINITIALIZED TO DISABLED
	XCT	KDBCNO(Q3)	;...
	MOVEI	T2,5000		;LOOP COUNT
DISKL1:	XCT	KDBCNI(Q3)	;READ STATUS
	TXNE	T1,CI.DCP	;DISABLE COMPLETE?
	AOSA	(P)		;YES, SET FOR SKIP RETURN
	SOJG	T2,DISKL1	;NO, WAIT A BIT
	POPJ	P,		;DIDN'T MAKE IT


;ROUTINE TO MAKE THE KLIPA ENTER THE ENABLED STATE.
;CALL:
;	PUSHJ	P,ENAKLP
;RETURN:
;	CPOPJ IF DIDN'T ENTER ENABLED STATE
;	CPOPJ1 IF KLIPA ENABLED

ENAKLP:	MOVEI	T1,CO.RQA!CO.BTS ;GO FROM DISABLED TO ENABLED
	XCT	KDBCNO(Q3)	;...
	MOVEI	T2,5000		;LOOP COUNT
ENAKL1:	XCT	KDBCNI(Q3)	;READ STATUS
	TXNE	T1,CI.ECP	;ENABLE COMPLETE?
	AOSA	(P)		;YES, SET FOR SKIP RETURN
	SOJG	T2,ENAKL1	;NO, WAIT A BIT
	POPJ	P,		;DIDN'T MAKE IT
	SUBTTL	LOAD KLIPA MICROCODE


;ROUTINE TO LOAD THE KLIPA MICROCODE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,KLPLOD
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T1/ MICROCODE VERSION LOADED

KLPLOD:	MOVEI	T1,CO.CPT	;CLEAR PORT
	XCT	KDBCNO(Q3)	;...
	PUSHJ	P,SAVE4##	;SAVE P1-P4
	XMOVEI	P1,.PCULB(Q3)	;POINT TO MICROCODE LOADER BLOCK
	MOVE	T1,P1		;COPY ADDRESS
	PUSHJ	P,BTUCOD##	;FIND THE MICROCODE
	  TDZA	T1,T1		;NOT AVAILABLE
	JRST	KLPLD1		;ONWARD
	PUSH	P,T1		;SAVE FAILURE FLAG
	JRST	KLPLD2		;FINISH UP

KLPLD1:	PUSH	P,W		;SAVE W
	MOVE	W,Q3		;SET UP KDB ADDRESS
	MOVE	T1,.ULADR(P1)	;GET ADDRESS OF MICROCODE STORAGE
	PUSHJ	P,LDIPA##	;LOAD THE CRAM
	  TDZA	W,W		;CHANNEL IS RUNNING
	MOVE	W,.ULVER(P1)	;GET VERSION NUMBER
	EXCH	W,(P)		;RESTORE W, SAVE FLAG
	MOVEI	T1,.UEMPC	;MICROPROCESSOR CHECK
	SKIPN	(P)		;ANY ERRORS?
	DPB	T1,ULBEBP##	;STORE ERROR CODE

KLPLD2:	MOVE	T1,P1		;COPY LOADER BLOCK ADDRESS
	PUSHJ	P,BTURPT##	;REPORT A SUCESSFUL LOAD OR FAILURE
	POP	P,T1		;GET SUCCESS/FAILURE FLAG (VERSION WORD)
	POPJ	P,		;RETURN
	SUBTTL	SET MEMORY OFFLINE SUPPORT


;ROUTINE CALLED WHEN MONITOR MEMORY WILL BE SET OFFLINE.
;MARK EACH KLIPA TO BE SHUT DOWN BY THE ONCE/SECOND CODE.
;CALL:
;	PUSHJ	P,PPDMFL
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDMFL::)
	XMOVEI	T1,PPDMF1	;GET ROUTINE TO EXECUTE FOR EACH CPU
	PJRST	CPUAPP##	;DO IT

PPDMF1:	MOVE	T1,.CPBIT##-.CPCDB##(P1) ;GET CPU'S BIT
	TSNN	T1,IPAMSK##	;KLIPA START-UP INHIBITED?
	SKIPN	T2,.CPPCB##-.CPCDB##(P1) ;THIS CPU HAVE A KLIPA?
	POPJ	P,		;NO, RETURN
	MOVX	T1,ST.MFL	;GET THE APPROPRIATE FLAG
	IORM	T1,.PCSTS(T2)	;REMEMBER TO SHUTDOWN THE KLIPA
	POPJ	P,		;RETURN
;ROUTINE CALLED WHEN MONITOR MEMORY HAS BEEN SET OFFLINE AND IT
;IS SAFE TO RESTORE THE STATE OF THE WORLD.
;CALL:
;	PUSHJ	P,PPDMON
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDMON::)
	PUSHJ	P,BHDCLR	;CLEAR THE BHD AREA
	PUSHJ	P,BSDLNK	;RE-LINK THE BSD AREA
	XMOVEI	T1,PPDMO1	;GET ROUTINE TO EXECUTE FOR EACH CPU
	PJRST	CPUAPP##	;DO IT

PPDMO1:	MOVE	T1,.CPBIT##-.CPCDB##(P1) ;GET CPU'S BIT
	TSNN	T1,IPAMSK##	;KLIPA START-UP INHIBITED?
	SKIPN	T2,.CPPCB##-.CPCDB##(P1) ;THIS CPU HAVE A KLIPA?
	POPJ	P,		;NO, RETURN NOW
	MOVX	T1,ST.MFL	;GET THE MEMORY OFFLINE FLAG
	TDNN	T1,.PCSTS(T2)	;WAS THE KLIPA SHUT DOWN?
	POPJ	P,		;NO
	ANDCAM	T1,.PCSTS(T2)	;CLEAR THE MEMORY OFFLINE FLAG
	MOVX	T1,ST.RES	;FLAG WE CAN RESTART THE KLIPA NOW
	IORM	T1,.PCSTS(T2)	;...
	POPJ	P,		;RETURN
	SUBTTL	REMOVE A CPU


;ROUTINE CALLED WHEN REMOVING A CPU.
;CALL:
;	PUSHJ	P,PPDRMV
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDRMV::)
	PUSHJ	P,SAVQ##	;SAVE THE "Q" REGISTERS
	SKIPN	Q3,.CPPCB##	;GET PCB ADDRESS
	POPJ	P,		;NO KLIPA ON THIS CPU
	MOVX	T1,ST.MAI	;SEE IF IN MAINTENANCE MODE
	TDNE	T1,.PCSTS(Q3)	;...
	POPJ	P,		;DON'T CAUSE OTHER PROBLEMS
	PJRST	PPDS10		;SHUT DOWN THE KLIPA, TELL SCA, ETC, AND RETURN
	SUBTTL	KLIPA ONCE PER TICK CODE


;ONCE A TICK CODE FOR THE KLIPA.
;CALL:
;	PUSHJ	P,PPDTIC
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDTIC::)
	PUSHJ	P,SAVQ##	;SAVE THE "Q" REGISTERS
	SKIPN	Q3,.CPPCB##	;GET PCB ADDRESS
	POPJ	P,		;NO KLIPA ON THIS CPU
	MOVE	T1,.PCSTS(Q3)	;GET STATUS
	TXNN	T1,ST.DED!ST.MAI ;SKIP IF DEAD OR IN MAINTENANCE MODE
	TXNN	T1,ST.CQA	;DO WE NEED TO KICK THE KLIPA?
	POPJ	P,		;RETURN
	MOVX	T1,ST.CQA	;GET THE "KICK KLIPA" BIT
	ANDCAM	T1,.PCSTS(Q3)	;CLEAR THE BIT
	MOVE	T1,.PCPIA(Q3)	;GET PI ASSIGNMENT
	TRO	T1,CO.CQA+CO.BTS ;COMMAND QUEUE AVAILABLE
	XCT	KDBCNO(Q3)	;KICK THE PORT
	POPJ	P,		;NOT MUCH ELSE TO DO
	SUBTTL	KLIPA ONCE PER SECOND CODE


;ONCE A SECOND CODE FOR THE KLIPA.
;CALL:
;	PUSHJ	P,PPDSEC
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDSEC::)
	MOVSI	T1,(CR.ATO)	;BIT TO TEST
	TDNE	T1,.CPRUN##	;WAITING FOR AUTCON TO RUN?
	POPJ	P,		;THEN DO NOTHING
	PUSHJ	P,SAVPQ##	;SAVE LOTS OF AC'S
	SKIPN	Q3,.CPPCB##	;GET PCB ADDRESS
	POPJ	P,		;NO KLIPA ON THIS CPU?

;FIRST CHECK FOR UNUSUAL CONDITIONS

	MOVE	T1,.PCSTS(Q3)	;GET THE IMPORTANT FLAGS
	TXNE	T1,ST.MAI	;IS KLIPA IN MAINTENANCE MODE?
	POPJ	P,		;YES, GO AWAY
	TXNE	T1,ST.MFL	;MEMORY GOING OFFLINE?
	JRST	PPDS10		;YES
	TXNE	T1,ST.RES	;TIME TO RESTART KLIPA?
	JRST	PPDS20		;YES

;NOTHING UNUSUAL, SEE IF KLIPA IS READY TO ROLL

	TXNE	T1,ST.DED	;KLIPA DEAD?
	POPJ	P,		;YES, QUIT
	XCT	KDBCNI(Q3)	;GET KLIPA STATUS
	TXNE	T1,CI.ENA	;YES, ENABLED?
	JRST	PPDSC1		;YES
	STOPCD	.+1,INFO,KLPNEN	;++KLIPA NOT ENABLED (LOST PI ASSIGNMENT)
	PJRST	URDEAD		;START OVER

;KLIPA IS RUNNING, DO ALL THE CHECKS

PPDSC1:	MOVX	T1,ST.RDY	;IS KLIPA READY TO ROLL?
	TDNN	T1,.PCSTS(Q3)	;...
	PJRST	PPDCSS		;NO, MUST DO COMMON START-UP STUFF
	PUSHJ	P,CHKKAF	;CHECK FOR KEEP ALIVE FAILURE
	  POPJ	P,		;SKIP REST OF CHECKS THIS SECOND
	PUSHJ	P,CHKPCB	;CHECK THE PCB
	PUSHJ	P,CHKWIR	;CHECK CI WIRES
	PUSHJ	P,CHKRTO	;CHECK FOR REQUEST-ID TIMEOUTS
	PUSHJ	P,CHKSTO	;CHECK FOR START SEQUENCE TIMEOUTS
	PUSHJ	P,CHKOPC	;CHECK FOR DEFERRED OPENS AND CLOSES
	PUSHJ	P,CHKPOL	;POLL THE NEXT NODE WITH A REQUEST-ID
	PUSHJ	P,CHKCTR	;CHECK FOR PERIODIC READ-COUNTERS
	POPJ	P,		;RETURN
;HERE IF JUST (RE)STARTED THE KLIPA - MUST ASK FOR IT'S CI NODE
;NUMBER AND SEND REQUEST-ID PACKETS TO EACH NODE ON THE NETWORK.

PPDCSS:	SKIPL	.PCONN(Q3)	;OUR NODE NUMBER KNOWN?
	JRST	PPDCS2		;YES, DO REQUEST-ID POLLING
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;TRY AGAIN LATER
	MOVEI	T1,.RGNOD	;REGISTER TO READ
	PUSHJ	P,KLPRRG	;SEND A READ REGISTER PACKET
	MOVEI	T1,100000	;GET A SPIN COUNT
PPDCS1:	SKIPL	.PCONN(Q3)	;OUR NODE NUMBER RETURNED YET?
	JRST	PPDCS2		;YES, PROCEED
	SOJG	T1,PPDCS1	;NO, WAIT FOR A WHILE
	POPJ	P,		;SORRY

PPDCS2:	PUSHJ	P,RSTRID	;ZERO TIMERS AND STATUS
	SETZ	Q1,		;START WITH FIRST NODE NUMBER
PPDCS3:	CAMN	Q1,.PCONN(Q3)	;SAME AS OUR NODE NUMBER?
	JRST	PPDCS4		;YES, DON'T ASK
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	PPDCS5		;NONE AVAILABLE, LET PPDSEC DO IT
	SETZ	T3,		;LET THE KLIPA SELECT A PATH, NO RESPONSE NEEDED
	PUSHJ	P,KLPRID	;SEND A REQUEST-ID

PPDCS4:	CAIGE	Q1,MAXNDS-1	;TRIED ALL NODES?
	AOJA	Q1,PPDCS3	;NO, LOOP FOR REMAINDER

PPDCS5:	MOVEI	T1,CTRTIM	;SECONDS UNTIL FIRST PERIODIC READ-COUNTERS
	MOVEM	T1,.PCCTM(Q3)	;START IT OFF RIGHT
	MOVX	T1,ST.RDY	;SHOW KLIPA IS READY FOR USE
	IORM	T1,.PCSTS(Q3)	;...
	POPJ	P,		;RETURN
;ROUTINE TO CHECK FOR KLIPA KEEP ALIVE FAILURE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKKAF
;RETURN:
;	CPOPJ IF KLIPA RESTARTED/RELOADED
;	CPOPJ1 IF KLIPA STILL APPEARS TO BE RUNNING

CHKKAF:	MOVE	T1,.CPUPT##	;GET CPU UPTIME
	SUB	T1,.PCKRT(Q3)	;CALCULATE TIME SINCE LAST KLIPA RESPONSE
	IMULI	T1,^D1000	;CONVERT TO MILLISECONDS
	IDIV	T1,TICSEC##	;...
	CAIGE	T1,KAFTIM	;TOO LONG SINCE LAST RESPONSE?
	JRST	CHKKF1		;NO, GO CHECK KLIPA IDLE TIMER
	XCT	KDBCNI(Q3)	;READ STATUS
	MOVEM	T1,.PCKCI(Q3)	;SAVE CONI FOR LATER SNOOPING
	MOVEI	T1,CO.CPT	;CLEAR PORT
	XCT	KDBCNO(Q3)	;...
	STOPCD	.+1,INFO,KLPKAF	;++KLIPA KEEP ALIVE FAILED
	AOS	.PCKAC(Q3)	;UPDATE COUNT OF KLIPA KEEP ALIVE FAILURES
	MOVE	T1,SYSUPT##	;GET SYSTEM UPTIME
	MOVEM	T1,.PCKAT(Q3)	;REMEMBER TIME OF LAST KEEP ALIVE FAILURE
	PJRST	URDEAD		;DO KLIPA ERROR STOP PROCESSING AND RETURN

CHKKF1:	AOS	(P)		;SET FOR SKIP RETURN, LOOKS LIKE KLIPA IS RUNNING
	MOVE	T1,.CPUPT##	;GET CPU UPTIME
	SUB	T1,.PCKCT(Q3)	;CALCULATE TIME SINCE LAST COMMAND QUEUED
	IMULI	T1,^D1000	;CONVERT TO MILLISECONDS
	IDIV	T1,TICSEC##	;...
	CAIGE	T1,IDLTIM	;TOO LONG SINCE LAST COMMAND?
	POPJ	P,		;NO, ALL DONE
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;WE TRIED, TRY AGAIN NEXT SECOND
	MOVEI	T1,.RGNOD	;WHICH REGISTER TO READ
	PJRST	KLPRRG		;SEND THE READ-REGISTER PACKET AND RETURN
;ROUTINE TO CHECK SOME LOCATIONS IN THE PCB.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKPCB
;RETURN:
;	CPOPJ ALWAYS

CHKPCB:	MAP	T1,.PCPCB(Q3)	;GET PHYSICAL ADDRESS
	TXZ	T1,MP.NAD	;CLEAR NON-ADDRESS BITS
	CAME	T1,.PCPBA(Q3)	;HAS IT CHANGED WITHOUT US KNOWING?
CHKPC1:	BUG.	(HLT,KLPPIC,KLPSER,SOFT,<PCB is corrupted>,,)
	MOVE	T1,.PCMQE(Q3)	;GET MESSAGE SIZE
	CAIE	T1,C%MGSZ	;PCB STILL CORRECT?
	JRST	CHKPC1		;NO
	XCT	KDBCNI(Q3)	;READ STATUS
	ANDI	T1,CI.PIA	;KEEP JUST PI ASSIGNMENT
	CAMN	T1,.PCPIA(Q3)	;SAME AS WHAT PCB SAYS IT IS?
	POPJ	P,		;YES, OK
	BUG.	(INF,KLPPIA,KLPSER,HARD,<CI20 has lost its PI assignment>,,)
	PJRST	URDEAD		;TRY TO START OVER
;ROUTINE TO CHECK THE CI WIRES BY SENDING LOOPBACK PACKETS.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKWIR
;RETURN:
;	CPOPJ ALWAYS

CHKWIR:	MOVE	Q1,.PCONN(Q3)	;GET OUR NODE NUMBER
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;DON'T SWEAT IT
	MOVE	T2,LPBCRC(Q1)	;GET THE PROPER CRC
	MOVEM	T2,LPBLEN-1(Q2)	;STASH THE CRC
	MOVEI	T1,OP.LPB	;OPCODE
	MOVEI	T2,KLPDRG	;PRIORITY
	MOVX	T3,ST.PTH	;WHICH PATH WAS LAST LOOPBACK SENT ON?
	TDNN	T3,.PCSTS(Q3)	;...
	JRST	CHKWI1		;PATH A, USE PATH B THIS TIME
	ANDCAM	T3,.PCSTS(Q3)	;CLEAR FLAG
	MOVX	T3,PF.PT0	;GET THE PATH SELECT BIT
	JRST	CHKWI2		;SEND THE PACKET

CHKWI1:	IORM	T3,.PCSTS(Q3)	;SET FLAG
	MOVX	T3,PF.PT1	;GET THE PATH SELECT BIT
CHKWI2:	SETZM	.PKLEN(Q2)	;NO LENGTH
	PJRST	DRVSND		;SEND THE PACKET AND RETURN
;ROUTINE TO CHECK FOR REQUEST-ID TIMEOUTS.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKRTO
;RETURN:
;	CPOPJ ALWAYS

CHKRTO:	SETZ	Q1,		;START WITH NODE NUMBER ZERO
CHKRT1:	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET BY CI NODE NUMBER
	SKIPE	T1,.PCRIT(P1)	;TIMER ON?
	CAMLE	T1,DATE##	;YES, TIMED OUT?
	JRST	CHKRT6		;NO, NEXT NODE
	MOVE	T1,.PCRIS(P1)	;GET REQUEST-ID STATUS
	TXNN	T1,RI.TRY	;WAS THIS THE FIRST TIME?
	JRST	CHKRT5		;YES, TRY A SECOND TIME
	TXNN	T1,RI.WFR	;STILL WAITING FOR PORT TO RESPOND?
	JRST	CHKRT2		;NO
	BUG.	(INF,KLPHNG,KLPSER,HARD,<CI20 is hung>,,)
	PJRST	URDEAD		;TRY TO START OVER

;LOOKS LIKE THE REMOTE PORT IS SICK

CHKRT2:	LOAD	T1,IDNOR,(P1)	;GET NUMBER OF NO RESPONSES
	CAIGE	T1,MAXNOR	;HAVE WE TRIED ENOUGH?
	JRST	CHKRT3		;NO, TRY AGAIN
	BUG.	(INF,KLPNOR,KLPSER,SOFT,<Remote port is sick>,<<Q1,NODE>>,)
	SETZRO	IDNOR,(P1)	;START OVER
	JRST	CHKRT4		;...

CHKRT3:	ADDI	T1,1		;INCREMENT COUNT
	STOR	T1,IDNOR,(P1)	;...
CHKRT4:	MOVX	T1,RI.TRY!RI.WFR ;CLEAR SECOND TRY FLAG, WAITING FOR RESPONSE
	ANDCAM	T1,.PCRIS(P1)	;...
	POPJ	P,		;WAIT FOR MORE HAVOC
;THE FIRST REQUEST-ID TRY HAS TIMED OUT

CHKRT5:	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE, TRY AGAIN LATER
	MOVX	T1,RI.TRY!RI.WFR ;SECOND TRY, WAITING FOR RESPONSE
	IORB	T1,.PCRIS(P1)	;SET THE FLAGS
	MOVX	T3,PF.RSP	;SAY WE WANT A RESPONSE
	TXNN	T1,RI.PTH	;WHICH PATH SHOULD WE SEND IT ON?
	TXOA	T3,PF.PT0	;PATH A
	TXO	T3,PF.PT1	;PATH B
	PUSHJ	P,KLPRID	;SEND THE REQUEST-ID
	PUSHJ	P,NXTRID	;MOVE POLLER TO NEXT NODE
CHKRT6:	CAIL	Q1,MAXNDS-1	;WAS THIS THE LAST NODE?
	POPJ	P,		;YES, RETURN
	AOJA	Q1,CHKRT1	;CHECK NEXT NODE
;ROUTINE TO CHECK START SEQUENCE TIMERS.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKSTO
;RETURN:
;	CPOPJ ALWAYS

CHKSTO:	SETZ	Q1,		;START WITH NODE NUMBER ZERO
CHKST1:	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET BY CI NODE NUMBER
	SKIPN	P5,.PCPBK(P1)	;GET A PATH BLOCK ADDRESS
	JRST	CHKST2		;NOTHING THERE
	SKIPE	T1,.PBSST(P5)	;GET EXPIRATION TIME, SKIP IF NOT RUNNING
	CAMLE	T1,DATE##	;TIMER EXPIRED?
	JRST	CHKST2		;NO, TRY NEXT ONE
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	CHKST2		;NONE AVAILABLE, TRY AGAIN NEXT SECOND
	LOAD	T1,PBVCST,(P5)	;GET VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.STS	;START-SENT?
	SKIPA	T1,[PP.STK]	;NO, GET STACK CODE
	MOVEI	T1,PP.STA	;YES, GET START CODE
	PUSHJ	P,STRTDT	;MAKE THE PACKET
	PUSHJ	P,KLPSDG	;SEND IT
	PUSHJ	P,STSST		;START THE TIMER
CHKST2:	CAIL	Q1,MAXNDS-1	;WAS THIS THE LAST NODE?
	POPJ	P,		;YES, RETURN
	AOJA	Q1,CHKST1	;CHECK NEXT NODE
;ROUTINE TO PERFORM REGULAR REQUEST-ID POLLING.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKPOL
;RETURN:
;	CPOPJ ALWAYS

CHKPOL:	MOVE	Q1,.PCRIN(Q3)	;GET POLLER'S NEXT NODE
	PUSHJ	P,CHKIDT	;IS REQUEST-ID TIMER ALREADY RUNNING?
	  PJRST	INCRID		;YES, MOVE POLLER TO NEXT NODE
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE, TRY AGAIN LATER
	PUSHJ	P,GTNPTH	;GET NEXT PATH FOR REQUEST-ID
	PUSHJ	P,KLPRID	;SEND THE REQUEST-ID
	PJRST	INCRID		;MOVE POLLER TO NEXT NODE AND RETURN


;ROUTINE TO PERFORM PERIODIC READ-COUNTERS COMMAND.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKCTR
;RETURN:
;	CPOPJ ALWAYS

CHKCTR:	SOSLE	.PCCTM(Q3)	;TIME TO SEND THE NEXT ONE?
	POPJ	P,		;NOT YET
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE, TRY AGAIN NEXT SECOND
	MOVEI	T1,CTRTIM	;RESET TIMEOUT
	MOVEM	T1,.PCCTM(Q3)	;...
	MOVX	T2,KS%PER	;REASON FOR READ-COUNTERS
	PJRST	KLPRPT		;SEND THE PACKET AND RETURN
;ROUTINE TO CHECK FOR DEFERRED CLOSES AND OPENS.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKOPC
;RETURN:
;	CPOPJ ALWAYS

CHKOPC:	SETZ	Q1,		;START WITH NODE NUMBER ZERO
CHKOP1:	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET BY CI NODE NUMBER
	SKIPN	P5,.PCPBK(P1)	;IS THERE PATH TO THIS NODE?
	JRST	CHKOP3		;NO
	MOVX	T1,PB.NTC	;DOES IT NEED TO BE CLOSED?
	TDNN	T1,.PBFLG(P5)	;...
	JRST	CHKOP2		;NO
	PUSHJ	P,KLPGDB	;YES, GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE, TRY AGAIN LATER
	PUSHJ	P,KLPCLO	;TELL PORT TO CLOSE THE VC
	MOVX	T1,PB.NTC	;NO LONGER TRYING TO CLOSE
	ANDCAM	T1,.PBFLG(P5)	;...
	MOVX	T1,PB.WFI	;FLAG WAITING FOR IDREC
	IORM	T1,.PBFLG(P5)	;...

CHKOP2:	MOVE	T1,.PBFLG(P5)	;GET FLAGS BACK
	TXNE	T1,PB.OKO	;OK TO OPEN?
	TXNN	T1,PB.WFI	;YES, STILL WAITING FOR A NEW IDREC?
	JRST	CHKOP3		;NOT OK TO OPEN OR NOT WAITING FOR AN IDREC
	PUSHJ	P,CHKIDT	;ALREADY HAVE A REQUEST-ID OUTSTANDING?
	  JRST	CHKOP3		;YES, DON'T SEND ANOTHER
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE, TRY AGAIN LATER
	PUSHJ	P,GTNPTH	;GET NEXT PATH FOR REQUEST-ID
	PUSHJ	P,KLPRID	;SEND THE REQUEST-ID
CHKOP3:	CAIL	Q1,MAXNDS-1	;WAS THIS THE LAST NODE?
	POPJ	P,		;YES, RETURN
	AOJA	Q1,CHKOP1	;CHECK NEXT NODE

;MEMORY IS GOING TO BE SET OFFLINE WHICH WILL AFFECT THE KLIPA.
;SHUT IT DOWN IN AN ORDERLY FASHION SO IT CAN BE RESTARTED LATER.

PPDS10:	MOVX	T1,ST.DED	;HAVE WE ALREADY DONE THIS?
	TDNE	T1,.PCSTS(Q3)	;...
	POPJ	P,		;YES, NOTHING MORE TO DO
	CIOFF			;PREVENT RACES
	PUSHJ	P,STPKLP	;STOP THE KLIPA
	PUSHJ	P,CIGONE	;RESET ALL CI ACTIVITY
	CION			;ALLOW INTERRUPTS AGAIN
	SETZM	.PCFQC(Q3)	;INITIALIZE THE COUNTER
PPDS12:	XMOVEI	T1,.PCDFQ(Q3)	;POINT AT DATAGRAM FREE QUEUE
	PUSHJ	P,REMQUE	;GET AN ENTRY FROM THE QUEUE
	  JRST	PPDS13		;EMPTY
	MOVE	T1,Q2		;COPY PACKET ADDRESS
	PUSHJ	P,SC.RLD##	;GIVE IT BACK TO SCA
	MOVSI	T1,1		;COUNT ANOTHER ONE
	ADDM	T1,.PCFQC(Q3)	;...
	JRST	PPDS12		;LOOP FOR MORE

PPDS13:	XMOVEI	T1,.PCMFQ(Q3)	;POINT AT MESSAGE FREE QUEUE
	PUSHJ	P,REMQUE	;GET AN ENTRY FROM THE QUEUE
	  JRST	PPDS14		;EMPTY
	MOVE	T1,Q2		;COPY PACKET ADDRESS
	PUSHJ	P,SC.RBF##	;GIVE IT BACK TO SCA
	MOVEI	T1,1		;COUNT ANOTHER ONE
	ADDM	T1,.PCFQC(Q3)	;...
	JRST	PPDS13		;LOOP FOR MORE

PPDS14:
;	XMOVEI	T1,.PCRFQ(Q3)	;POINT AT RESERVED FREE QUEUE
;	PUSHJ	P,REMQUE	;GET AN ENTRY FROM THE QUEUE
;	  JRST	PPDS15		;EMPTY
;	MOVE	T1,Q2		;COPY PACKET ADDRESS
;	PUSHJ	P,SC.RRD##	;GIVE IT BACK TO SCA
;	MOVEI	T1,1		;COUNT ANOTHER ONE
;	ADDM	T1,.PCXXX(Q3)	;...
;	JRST	PPDS14		;LOOP FOR MORE

;PPDS15:
	POPJ	P,		;RETURN
;MEMORY IS STABLE AFTER BEING SET OFFLINE.  RESTART THE KLIPA
;AFTER POSSIBLY RE-LINKING THE FREE QUEUES.

PPDS20:	PUSHJ	P,PCBINI	;INITIALIZE THE PCB
	PUSHJ	P,RSTKQS	;RESTOCK THE DATAGRAM/MESSAGE FREE QUEUES
	MOVX	T1,ST.RES	;GET THE RESTART FLAG
	ANDCAM	T1,.PCSTS(Q3)	;KLIPA NO LONGER NEEDS RESTARTING
	PJRST	RLDKLP		;RELOAD THE KLIPA AND GET IT GOING
;ROUTINE TO RESTOCK THE DATAGRAM AND MESSAGE FREE QUEUES.  CALLED AFTER
;KLIPA HAS BEEN SHUT DOWN.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,RSTKQS
;RETURN:

RSTKQS:	HLRZ	T1,.PCFQC(Q3)	;GET RESTOCK COUNT
	JUMPE	T1,RSTKQ1	;JUMP IF NOTHING THERE ORIGINALLY
	PUSHJ	P,SC.ALD##	;ASK SCA FOR THE DATAGRAMS BACK
	 STOPCD RSTKQ1,INFO,KLPCRD, ;++CAN'T RESTOCK DATAGRAM FREE QUEUE
	MOVE	Q2,T1		;COPY ADDRESS OF FIRST PACKET
	XMOVEI	T1,.PCDFQ(Q3)	;POINT AT DATAGRAM FREE QUEUE
	PUSHJ	P,LNKQUE	;PUT THE PACKETS BACK ON THE FREE QUEUE
RSTKQ1:	HRRZ	T1,.PCFQC(Q3)	;GET RESTOCK COUNT
	JUMPE	T1,RSTKQ2	;JUMP IF NOTHING THERE ORIGINALLY
	PUSHJ	P,SC.ABF##	;ASK SCA FOR THE MESSAGES BACK
	 STOPCD	RSTKQ2,INFO,KLPCRM, ;++CAN'T RESTOCK MESSAGE FREE QUEUE
	MOVE	Q2,T1		;COPY ADDRESS OF FIRST PACKET
	XMOVEI	T1,.PCMFQ(Q3)	;POINT AT MESSAGE FREE QUEUE
	PUSHJ	P,LNKQUE	;PUT THE PACKETS BACK ON THE FREE QUEUE
RSTKQ2:
;GET COUNT, GET DATAGRAMS HERE
;	XMOVEI	T1,.PCRFQ(Q3)	;POINT AT RESERVED FREE QUEUE
;	PUSHJ	P,LNKQUE	;PUT THE PACKETS BACK ON THE FREE QUEUE
RSTKQ3:	SETZM	.PCFQC(Q3)	;ZAP OUT RESTOCK COUNT
	POPJ	P,		;RETURN
;ROUTINE TO UPDATE REQUEST-ID POLLER'S NEXT NODE.
;CALL:
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,NXTRID
;RETURN:
;	CPOPJ ALWAYS

NXTRID:	CAMN	Q1,.PCRIN(Q3)	;IS THIS THE NEXT NODE TO POLL?
	PJRST	INCRID		;YES, INCREMENT AND RETURN
	POPJ	P,		;RETURN


;ROUTINE TO INCREMENT THE POLLER'S NEXT NODE NUMBER.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,INCRID
;RETURN:
;	CPOPJ ALWAYS

INCRID:	AOS	T1,.PCRIN(Q3)	;BUMP THE NEXT NODE NUMBER
	CAILE	T1,MAXNDS-1	;TOO HIGH?
INCRI1:	SETZB	T1,.PCRIN(Q3)	;YES, WRAP TO ZERO
	CAMN	T1,.PCONN(Q3)	;IS IT OUR NODE?
	JRST	INCRID		;YES, DON'T TALK TO OURSELVES
	POPJ	P,		;RETURN


;ROUTINE TO RESET THE REQUEST-ID DATA IN THE PCB.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,RSTRID
;RETURN:
;	CPOPJ ALWAYS

RSTRID:	MOVEI	T1,MAXNDS-1	;NUMBER OF WORDS TO ZERO
	XMOVEI	T2,.PCRIS(Q3)	;POINT AT REQUEST-ID STATUS WORDS
	XMOVEI	T3,.PCRIS+1(Q3)	;POINT AT SECOND WORD OF IT
	SETZM	(T2)		;ZERO FIRST WORD
	EXTEND	T1,[XBLT]	;ZERO THE REMAINDER
	MOVEI	T1,MAXNDS-1	;NUMBER OF WORDS TO ZERO
	XMOVEI	T2,.PCRIT(Q3)	;POINT AT REQUEST-ID TIMER WORDS
	XMOVEI	T3,.PCRIT+1(Q3)	;POINT AT SECOND WORD OF IT
	SETZM	(T2)		;ZERO FIRST WORD
	EXTEND	T1,[XBLT]	;ZERO THE REMAINDER
	PJRST	INCRI1		;RESET POLLER'S NEXT NODE TO ZERO AND RETURN
;GET CURRENT PATH FOR REQUEST-ID.
;CALL:
;	T1/ PACKET STATUS WORD
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T3/ FLAGS FIELD SET WITH PATH SELECT

GTCPTH:	MOVE	T2,Q3		;GET PCB ADDRESS
	ADD	T2,Q1		; OFFSET FOR THIS NODE
	TXNN	T1,PF.PT0	;DID PACKET ARRIVE ON PATH A?
	JRST	GTCPT1		;NO
	MOVX	T1,RI.PTH	;INDICATE PATH A USED (CLEAR FLAG)
	ANDCAM	T1,.PCRIS(T2)	;...
	MOVX	T3,PF.PT0	;USE PATH A FOR NEXT REQUEST-ID
	POPJ	P,		;RETURN

GTCPT1:	MOVX	T1,RI.PTH	;INDICATE PATH B USED (SET FLAG)
	IORM	T1,.PCRIS(T2)	;...
	MOVX	T3,PF.PT1	;USE PATH B FOR NEXT REQUEST-ID
	POPJ	P,		;RETURN


;GET NEXT PATH FOR REQUEST-ID.
;CALL:
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,GTNPTH
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T3/ FLAGS FIELD SET WITH PATH SELECT

GTNPTH:	MOVE	T1,Q3		;GET PCB ADDRESS
	ADD	T1,Q1		; OFFSET FOR THIS NODE
	MOVX	T2,RI.PTH	;WAS LAST REQUEST-ID ON PATH A?
	TDNN	T2,.PCRIS(T1)	;...
	JRST	GTNPT1		;YES, USE PATH B THIS TIME
	ANDCAM	T2,.PCRIS(T1)	;CLEAR FLAG
	MOVX	T3,PF.PT0	;GET PATH SELECT BIT
	POPJ	P,		;RETURN

GTNPT1:	IORM	T2,.PCRIS(T1)	;SET FLAG
	MOVX	T3,PF.PT1	;GET PATH SELECT BIT
	POPJ	P,		;RETURN
;ROUTINE TO CHECK IF THE REQUEST-ID TIMER IS RUNNING FOR A NODE.
;CALL:
;	Q1/ NODE NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,CHKRIT
;RETURN:
;	CPOPJ IF TIMER IS RUNNING
;	CPOPJ1 IF TIMER IS NOT RUNNING

CHKIDT:	MOVE	T1,Q3		;GET PCB ADDRESS
	ADD	T1,Q1		; OFFSET FOR THIS NODE
	SKIPN	.PCRIT(T1)	;TIMER RUNNING?
	AOS	(P)		;NO, SET FOR SKIP RETURN
	POPJ	P,		;RETURN


;ROUTINE TO SET START SEQUENCE TIMER.
;CALL:
;	P5/ PBK ADDRESS
;	PUSHJ	P,STSST
;RETURN:
;	CPOPJ ALWAYS

STSST:	MOVEI	T1,STSTIM*3	;CONVERT TIMER LENGTH TO UDT INCREMENTS
	ADD	T1,DATE##	;WHEN TIMER WILL EXPIRE
	MOVEM	T1,.PBSST(P5)	;SET THE EXPIRATION TIME
	POPJ	P,		;RETURN
	SUBTTL	SCS-PPD INTERFACE - SEND DATAGRAM/MESSAGE


;ROUTINE TO SEND A DATAGRAM.
;CALL:
;	BLCAL.	(PPDSDG,<SS.PBI,SS.PKT,SS.LEN,SS.FLG,SS.PRI,SS.PTH>)
;
;WHERE:
;	SS.PBI - DESTINATION PATH BLOCK INDEX
;	SS.PKT - ADDRESS OF PACKET
;	SS.LEN - LENGTH OF PACKET
;	SS.FLG - FLAGS (F.XXX)
;	SS.PRI - COMMAND QUEUE PRIORITY
;	SS.PTH - PATH SELECT (0 = AUTO, 1 = A, 2 = B)
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDSDG::,<SS.PBI,SS.PKT,SS.LEN,SS.FLG,SS.PRI,SS.PTH>)
	MOVEI	T1,OP.SDG	;OPCODE = SEND DATAGRAM
	JRST	SNDPKT		;JOIN COMMON CODE


;ROUTINE TO SEND A MESSAGE.
;CALL:
;	BLCAL.	(PPDSMS,<SS.PBI,SS.PKT,SS.LEN,SS.FLG,SS.PRI,SS.PTH>)
;
;WHERE:
;	SS.PBI - DESTINATION PATH BLOCK INDEX
;	SS.PKT - ADDRESS OF PACKET
;	SS.LEN - LENGTH OF PACKET
;	SS.FLG - FLAGS (F.XXX)
;	SS.PRI - COMMAND QUEUE PRIORITY
;	SS.PTH - PATH SELECT (0 = AUTO, 1 = A, 2 = B)
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDSMS::,<SS.PBI,SS.PKT,SS.LEN,SS.FLG,SS.PRI,SS.PTH>)
	MOVEI	T1,OP.SMS	;OPCODE = SEND MESSAGE
;	JRST	SNDPKT		;JOIN COMMON CODE
;HERE TO SEND THE PACKET - OPCODE IN T1

SNDPKT:	PUSHJ	P,SAVPQ##	;MIND YOUR P'S AND Q'S
	MOVE	P4,T1		;SAVE THE OPCODE IN P4
	SKIPLE	P5,SS.PBI	;GET PATH BLOCK INDEX
	CAIL	P5,C%PBLL	;LEGAL?
	POPJ	P,		;NO, ERROR
	SKIPN	P5,PBLIST##-1(P5) ;GET PATH BLOCK ADDRESS
	POPJ	P,		;NONE?  AN ERROR
	MOVE	Q2,SS.PKT	;GET THE PACKET ADDRESS
	MOVE	Q3,SS.FLG	;GET THE FLAGS
	MOVE	T4,SS.LEN	;GET THE PACKET LENGTH
	TXNN	Q3,F.SPM	;IS THIS HIGH DENSITY, I.E., LENGTH IN WORDS?
	JRST	SNDPK1		;NO
	MOVEI	T1,1(T4)	;YES, GET A COPY, ROUNDED UP FOR LATER DIVIDE
	IMULI	T4,4		;CONVERT WORD COUNT TO BYTE COUNT
	IDIVI	T1,2		;GET THE NUMBER OF EXTRA BYTES LEFT OVER
	ADD	T4,T1		;ADD FRACTIONAL PART TO WHOLE TO GET TOTAL
SNDPK1:	DPB	T4,PKYLEN	;STORE LENGTH IN PACKET
	MOVEI	T4,PP.DG-OP.SDG(P4) ;COMPUTE PPD BYTE
	DPB	T4,PKYPPD	;SAVE IT IN THE PACKET
	PUSHJ	P,MASAGE	;SWAP THE PPD BYTE AND ADJUST PACKET LENGTH
	MOVE	T1,P4		;GET OPCODE IN T1
	MOVE	T2,SS.PRI	;PRIORITY
	SETZ	T3,		;CLEAR FLAGS REGISTER
	TXNE	Q3,F.RTB	;WANT A RESPONSE?
	TXO	T3,PF.RSP	;YES
	TXNE	Q3,F.SPM	;WANT HIGH DENSITY MODE?
	TXO	T3,PF.FMT	;YES
	MOVE	T4,SS.PTH	;GET PATH SELECT INFO
	CAIN	T4,1		;WANT PATH A?
	TXO	T3,PF.PT0	;YES
	CAIN	T4,2		;WANT PATH B?
	TXO	T3,PF.PT1	;YES
	PJRST	SENDVC		;SEND THE PACKET UNDER VIRTUAL CIRCUIT CONTROL
				;NON-SKIP RETURN IF ERROR, SKIP RETURN IF SUCCESS

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - BLOCK DATA SERVICE


;ROUTINE TO SEND DATA.
;CALL:
;	BLCAL.	(PPDSND,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.CID>)
;
;WHERE:
;	SS.SNM - SENDER'S BUFFER NAME
;	SS.RNM - RECEIVER'S BUFFER NAME
;	SS.SOF - SENDER'S BUFFER OFFSET
;	SS.ROF - RECEIVER'S BUFFER OFFSET
;	SS.CID - CONNECTION-ID
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDSND::,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.CID>)
	MOVEI	T1,OP.SDT	;OPCODE FOR SEND DATA
	JRST	SNDREC		;JOIN COMMON CODE


;ROUTINE TO REQUEST DATA.
;CALL:
;	BLCAL.	(PPDREQ,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.CID>)
;
;WHERE:
;	SS.SNM - SENDER'S BUFFER NAME
;	SS.RNM - RECEIVER'S BUFFER NAME
;	SS.SOF - SENDER'S BUFFER OFFSET
;	SS.ROF - RECEIVER'S BUFFER OFFSET
;	SS.CID - CONNECTION-ID
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDREQ::,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.CID>)
	MOVEI	T1,OP.RD1	;OPCODE FOR READ DATA
;	JRST	SNDREC		;JOIN COMMON CODE
;HERE TO FILL IN THE PACKET AND SEND IT OFF

SNDREC:	PUSHJ	P,SAVPQ##	;SAVE LOTS OF ACS
	MOVE	Q2,T1		;SAVE OPCODE
	MOVEI	T1,1		;GET ONE BUFFER
	PUSHJ	P,SC.ABF##	; FROM SCA
	  RETBAD ()		;YOU LOST
	EXCH	T1,Q2		;BUFFER ADDRESS IN Q2, OPCODE IN T1
	MOVE	T2,SS.SNM	;SENDER NAME
	MOVE	T3,T2		;IF DOING A SEND, THIS IS OUR BUFFER NAME
	MOVEM	T2,.PKSNM(Q2)	;SAVE WHERE PORT WANTS SENDER NAME
	MOVE	T2,SS.RNM	;RECEIVER'S NAME
	CAIN	T1,OP.RD1	;REQUEST DATA?
	MOVE	T3,T2		;YES, THIS IS OUR BUFFER NAME
	MOVEM	T2,.PKRNM(Q2)	;SAVE WHERE PORT WANTS RECEIVER NAME
	MOVE	T2,SS.SOF	;SENDER OFFSET
	MOVEM	T2,.PKSOF(Q2)	;INTO PACKET
	MOVE	T2,SS.ROF	;RECEIVER OFFSET
	MOVEM	T2,.PKROF(Q2)	;INTO PACKET
	MOVEM	T3,.PKXID(Q2)	;SENDER OR RECEIVER BUFFER NAME INTO XID
	MOVE	T2,SS.CID	;CID INTO OTHER XID
	MOVEM	T2,.PKXID+1(Q2)	;SO WE CAN TELL SCA ON THE INTERRUPT
	$LDCID	T2,T2		;GET CONNECTION BLOCK ADDRESS
	MOVE	P5,.CBPBK(T2)	;PATH BLOCK ADDRESS
	LDB	T2,[POINT BHSIDX,T3,BHPIDX] ;BHD INDEX FROM BUFFER NAME
	ADD	T2,BHDIPT	;POINT AT BHD TABLE ENTRY
	MOVE	T2,.BHLEN(T2)	;GET NIBBLE COUNT FROM BHD
	LSH	T2,-1+4		;CONVERT TO BYTE COUNT AND THEN SHIFT IT
	MOVEM	T2,.PKXLN(Q2)	;SAVE AS TRANSACTION LENGTH
	MOVEI	T2,KLPMED	;PRIORITY
	MOVX	T3,PF.SIZ	;INDICATE 576-BYTE PACKETS
	PUSHJ	P,SENDVC	;SEND UNDER VIRTUAL CIRCUIT CONTROL
	  SKIPA			;IT FAILED
	JRST	CPOPJ1##	;IT SUCCEEDED
	EXCH	T1,Q2		;SAVE ERROR CODE, GET BUFFER ADDRESS BACK
	PUSHJ	P,SC.RBF##	;RETURN BUFFER TO SCA
	MOVE	T1,Q2		;RESTORE ERROR CODE
	RETBAD	()		;PASS ALONG THE ERROR

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	MAINTENANCE INTERFACE - SEND/REQUEST DATA


;ROUTINE TO SEND MAINTENANCE DATA.
;CALL:
;	BLCAL.	(PPDSMD,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.NOD>)
;
;WHERE:
;	SS.SNM - SENDER'S BUFFER NAME
;	SS.RNM - RECEIVER'S BUFFER NAME
;	SS.SOF - SENDER'S BUFFER OFFSET
;	SS.ROF - RECEIVER'S BUFFER OFFSET
;	SS.NOD - NODE TO SEND PACKET TO
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDSMD::,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.NOD>)
	MOVEI	T1,OP.SMD	;OPCODE FOR SEND MAINTENANCE DATA
	JRST	SNDMAI		;JOIN COMMON CODE


;ROUTINE TO REQUEST MAINTENANCE DATA.
;CALL:
;	BLCAL.	(PPDRMD,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.NOD>)
;
;WHERE:
;	SS.SNM - SENDER'S BUFFER NAME
;	SS.RNM - RECEIVER'S BUFFER NAME
;	SS.SOF - SENDER'S BUFFER OFFSET
;	SS.ROF - RECEIVER'S BUFFER OFFSET
;	SS.NOD - NODE TO SEND PACKET TO
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS

	$XBSUB	(PPDRMD::,<SS.SNM,SS.RNM,SS.SOF,SS.ROF,SS.NOD>)
	MOVEI	T1,OP.RMD	;OPCODE FOR SEND MAINTENANCE DATA
;	JRST	SNDMAI		;JOIN COMMON CODE
;HERE TO FILL IN THE PACKET AND SEND IT OFF

SNDMAI:	PUSHJ	P,SAVPQ##	;SAVE LOTS OF ACS
	MOVE	Q2,T1		;SAVE OPCODE
	SKIPN	Q3,.CPPCB##	;GET PCB ADDRESS
	RETBAD	()		;ERROR
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  RETBAD ()		;YOU LOST
	EXCH	T1,Q2		;BUFFER ADDRESS IN Q2, OPCODE IN T1
	MOVE	T2,SS.SNM	;SENDER NAME
	MOVE	T3,T2		;IF DOING A SEND, THIS IS OUR BUFFER NAME
	MOVEM	T2,.PKSNM(Q2)	;SAVE WHERE PORT WANTS SENDER NAME
	MOVE	T2,SS.RNM	;RECEIVER'S NAME
	CAIN	T1,OP.RD1	;REQUEST DATA?
	MOVE	T3,T2		;YES, THIS IS OUR BUFFER NAME
	MOVEM	T2,.PKRNM(Q2)	;SAVE WHERE PORT WANTS RECEIVER NAME
	MOVE	T2,SS.SOF	;SENDER OFFSET
	MOVEM	T2,.PKSOF(Q2)	;INTO PACKET
	MOVE	T2,SS.ROF	;RECEIVER OFFSET
	MOVEM	T2,.PKROF(Q2)	;INTO PACKET
	MOVEM	T3,.PKXID(Q2)	;SENDER OR RECEIVER BUFFER NAME INTO XID
	LDB	T2,[POINT BHSIDX,T3,BHPIDX] ;BHD INDEX FROM BUFFER NAME
	ADD	T2,BHDIPT	;POINT AT BHD TABLE ENTRY
	MOVE	T2,.BHLEN(T2)	;GET NIBBLE COUNT FROM BHD
	LSH	T2,-1+4		;CONVERT TO BYTE COUNT AND THEN SHIFT IT
	MOVEM	T2,.PKXLN(Q2)	;SAVE AS TRANSACTION LENGTH
	SETZ	T3,		;NO FLAGS
	MOVE	Q1,SS.NOD	;GET THE NODE NUMBER
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	DIASND		;SEND THE DATAGRAM AND RETURN

	ENDBS.			;END OF BLSUB. RANGE
;ROUTINE TO SEND A CLOSE BUFFER COMMAND.
;CALL:
;	BLCAL.	(PPDCLB,<SS.BNM,SS.PKT>)
;
;WHERE:
;	SS.BNM - BUFFER NAME
;	SS.PKT - PACKET ADDRESS
;
;RETURN:
;	CPOPJ ALWAYS

	$XBSUB	(PPDCLB::,<SS.BNM,SS.PKT>)
	PUSHJ	P,SAVQ##	;SAVE THE Q REGISTERS
	SKIPN	Q3,.CPPCB##	;GET PCB ADDRESS
	POPJ	P,		;NO PCB?
	MOVE	Q2,SS.PKT	;GET THE PACKET ADDRESS
	MOVE	T1,SS.BNM	;GET THE BUFFER NAME
	MOVEM	T1,.PKBNM(Q2)	;STORE THE BUFFER NAME
	MOVEI	T1,OP.CLB	;GET OPCODE
	MOVEI	T2,KLPMED	;GET PRIORITY
	SETZ	Q1,		;CLEAR NODE NUMBER
	MOVX	T3,PF.RSP	;RESPONSE IS REQUESTED
	PJRST	DRVSND		;SEND THE PACKET AND RETURN

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - DEQUEUE BUFFERS


;ROUTINE TO DEQUEUE A DATAGRAM/MESSAGE BUFFER FROM THE PCB FREE QUEUE.
;CALL:
;	BLCAL.	(PPDD?B,<SS.PBI>)
;
;WHERE:
;	SS.PBI - PATH BLOCK INDEX
;
;RETURN:
;	CPOPJ IF ERRORS
;	CPOPJ1 IF SUCCESS WITH:
;	T1/ ADDRESS OF BUFFER

	$XBSUB	(PPDDDB::,<SS.PBI>)
	MOVEI	T2,.PCDFQ	;THE DATAGRAM FREE QUEUE
	JRST	PPDDD1		;JOIN COMMON ROUTINE

	$XBSUB	(PPDDMB::,<SS.PBI>)
	MOVEI	T2,.PCMFQ	;THE MESSAGE FREE QUEUE
PPDDD1:	SKIPLE	T1,SS.PBI	;CHECK FOR VALID PBI
	CAIL	T1,C%PBLL	;...
	POPJ	P,		;ERROR, INVALID PBI
	PUSHJ	P,SAVQ##	;SAVE THE Q REGISTERS
	MOVE	T1,PBLIST##-1(T1) ;GET THE PATH BLOCK ADDRESS IN T1
	MOVE	Q3,.PBPCB(T1)	;GET THE PCB ADDRESS FROM THE PATH BLOCK
	MOVX	T1,ST.MFL	;MEMORY OFFLINE IN PROGRESS?
	TDNE	T1,.PCSTS(Q3)	;...
	JRST	PPDDD2		;YES, WE HAVE TO PLAY SOME GAMES TO MAKE SCA
				; HAPPY SINCE WE'VE ALREADY GIVEN EVERYTHING
				; ON OUR FREE QUEUE BACK TO SCA
	MOVE	T1,Q3		;GET A COPY IN T1
	ADD	T1,T2		;OFFSET TO PROPER QUEUE
	PUSHJ	P,REMQUE	;REMOVE THE FIRST PACKET
	  JRST	PPDDD3		;EMPTY
	MOVE	T1,Q2		;COPY PACKET ADDRESS
	JRST	CPOPJ1##	;SKIP RETURN

PPDDD2:	CAIE	T2,.PCDFQ	;LOOKING FOR A DATAGRAM?
	JRST	PPDDD6		;NO, GET A MESSAGE
	JRST	PPDDD4		;YES, GET A DATAGRAM

PPDDD3:	XMOVEI	T2,.PCDFQ(Q3)	;GET ADDRESS OF DATAGRAM FREE QUEUE
	CAME	T1,T2		;IS THAT THE QUEUE WE TRIED?
	JRST	PPDDD5		;NO, IT WAS THE MESSAGE FREE QUEUE
	BUG.	(INF,KLPNDB,KLPSER,SOFT,<No datagram buffer>,,)
PPDDD4:	MOVEI	T1,1		;GET A DATAGRAM BUFFER
	PUSHJ	P,SC.ALD##	; FROM SCA'S POOL
	  RETBAD (KLPX11)	;ERROR, RETURN AN ERROR CODE
	JRST	CPOPJ1##	;SUCCESS

PPDDD5:	BUG.	(INF,KLPNMG,KLPSER,SOFT,<No message buffer>,,)
PPDDD6:	MOVEI	T1,1		;GET A MESSAGE BUFFER
	PUSHJ	P,SC.ABF##	; FROM SCA'S POOL
	  RETBAD (KLPX11)	;ERROR, RETURN AN ERROR CODE
	JRST	CPOPJ1##	;SUCCESS

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - QUEUE BUFFERS


;ROUTINE TO QUEUE (A) DATAGRAM/MESSAGE BUFFER(S) TO THE PCB FREE QUEUE.
;CALL:
;	BLCAL.	(PPDQ?B,<SS.PBI,SS.PKT>)
;
;WHERE:
;	SS.PBI - PATH BLOCK INDEX
;	SS.PKT - ADDRESS OF FIRST PACKET
;
;RETURN:
;	CPOPJ ALWAYS

	$XBSUB	(PPDQDB::,<SS.PBI,SS.PKT>)
	MOVEI	T3,.PCDFQ	;THE DATAGRAM FREE QUEUE
	JRST	PPDQD1		;JOIN COMMON ROUTINE

	$XBSUB	(PPDQMB::,<SS.PBI,SS.PKT>)
	MOVEI	T3,.PCMFQ	;THE MESSAGE FREE QUEUE
PPDQD1:	SKIPLE	T1,SS.PBI	;CHECK FOR VALID PBI
	CAIL	T1,C%PBLL	;...
	PUSHJ	P,KLPFOO	;ERROR, INVALID PBI
	PUSHJ	P,SAVQ##	;SAVE THE Q REGISTERS
	MOVE	T1,PBLIST##-1(T1) ;GET THE PATH BLOCK ADDRESS IN T1
	MOVE	Q3,.PBPCB(T1)	;GET THE PCB ADDRESS FROM THE PATH BLOCK
	MOVX	T1,ST.MFL	;MEMORY OFFLINE IN PROGRESS?
	TDNE	T1,.PCSTS(Q3)	;...
	JRST	PPDQD2		;YES
	MOVE	T1,Q3		;GET A COPY IN T1
	ADD	T1,T3		;OFFSET TO PROPER QUEUE
	MOVE	Q2,SS.PKT	;COPY ADDRESS OF FIRST PACKET
	PJRST	LNKQUE		;LINK THE PACKETS ONTO THE FREE QUEUE AND RETURN

;HERE IF SETTING MEMORY OFFLINE - PROBABLY CALLED FROM SCATMO GIVING BACK
;THE 2 FLOW CONTROL BUFFERS IT QUEUED.  COUNT THE NUMBER OF BUFFERS AND
;REMEMBER TO ASK SCA FOR THAT MANY MORE WHEN RESTARTING.

PPDQD2:	MOVE	T1,SS.PKT	;GET ADDRESS OF FIRST PACKET
	MOVEI	T2,1		;INIT COUNT OF PACKETS
	SKIPE	T1,(T1)		;IS THERE ANOTHER PACKET?
	AOJA	T2,.-1		;YES, COUNT AND LOOP
	CAIN	T3,.PCDFQ	;DATAGRAMS?
	MOVSS	T2		;YES, MOVE COUNT TO LH
	ADDM	T2,.PCFQC(Q3)	;INCLUDE IN RESTOCK COUNT
	MOVE	T1,SS.PKT	;GET ADDRESS OF FIRST PACKET
	CAIE	T3,.PCDFQ	;DATAGRAMS?
	PJRST	SC.RBF##	;NO
	PJRST	SC.RLD##	;YES

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - OPEN VIRTUAL CIRCUIT


;ROUTINE TO REQUEST THE OPENING OF A VIRTUAL CIRCUIT.
;CALL:
;	BLCAL.	(PPDOVC,<SS.PBI>)
;
;WHERE:
;	SS.PBI - DESTINATION PATH BLOCK INDEX
;
;RETURN:
;	CPOPJ ALWAYS

	$XBSUB	(PPDOVC::,<SS.PBI>)
	SKIPLE	T1,SS.PBI	;CHECK FOR VALID PBI
	CAIL	T1,C%PBLL	;...
	PUSHJ	P,KLPFOO	;ERROR, INVALID PBI
	PUSHJ	P,SAVPQ##	;SAVE THE P & Q REGISTERS
	SKIPN	P5,PBLIST##-1(T1) ;GET THE PATH BLOCK ADDRESS
	BUG.	(HLT,KLPNPB,KLPSER,SOFT,<No path block at PPDOVC>,,)
	LOAD	T1,PBVCST,(P5)	;GET THE VIRTUAL CIRCUIT STATE
	CAIE	T1,VC.CLO	;SHOULD BE CLOSED
	BUG.	(HLT,KLPONC,KLPSER,SOFT,<Trying to open a virtual circuit which isn't closed>,,)
	MOVX	T1,PB.OKO	;SAY IT'S OK TO OPEN
	IORB	T1,.PBFLG(P5)	;...
	TXNE	T1,PB.NTC	;TRYING TO CLOSE THE VC?
	POPJ	P,		;YES, THAT'S IT FOR NOW, ONCE/SECOND CODE WILL
				; COMPLETE OUR WORK
	LOAD	Q1,PBDPN,(P5)	;GET DESTINATION PORT NUMBER
	MOVE	Q3,.PBPCB(P5)	;GET THE PCB ADDRESS
	MOVX	T1,ST.DED	;SEE IF THE PORT IS IN THE PROCESS OF RELOADING
	TDNE	T1,.PCSTS(Q3)
	POPJ	P,		;YES, DON'T RESTART THE PORT BY CALLING ONE OF
				; THE SEND PACKET ROUTINES
	PUSHJ	P,CHKIDT	;IS THE REQUEST-ID TIMER RUNNING?
	  POPJ	P,		;YES, DON'T BOTHER SENDING ANOTHER
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  POPJ	P,		;NONE AVAILABLE
	PUSHJ	P,GTNPTH	;GET NEXT PATH FOR REQUEST-ID
	PJRST	KLPRID		;SEND A REQUEST-ID AND RETURN

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - CLOSE VIRTUAL CIRCUIT


;ROUTINE TO REQUEST A VIRTUAL CIRCUIT BE CLOSED.
;CALL:
;	BLCAL.	(PPDCVC,<SS.PBI>)
;
;WHERE:
;	SS.PBI - DESTINATION PATH BLOCK INDEX
;
;RETURN:
;	CPOPJ ALWAYS

	$XBSUB	(PPDCVC::,<SS.PBI>)
	SKIPLE	T1,SS.PBI	;CHECK FOR VALID PBI
	CAIL	T1,C%PBLL	;...
	PUSHJ	P,KLPFOO	;ERROR, INVALID PBI
	PUSHJ	P,SAVPQ##	;SAVE THE P & Q REGISTERS
	SKIPN	P5,PBLIST##-1(T1) ;GET THE PATH BLOCK ADDRESS
	PUSHJ	P,KLPFOO	;ERROR, INVALID PBI
	SETZB	Q2,P4		;NEED TO GET A BUFFER AND DO A SET CIRCUIT
	SETZ	T2,		;FLAG THAT WE WANT TO SEND A SHUTDOWN MESSAGE
	JRST	CLOSV2		;JOIN COMMON CODE


;ROUTINE TO REQUEST A VIRTUAL CIRCUIT BE CLOSED.  CALLED INTERNALLY
;FROM WITHIN KLPSER AS OPPOSED TO PPDCVC.
;CALL:
;	Q2/ ADDRESS OF BUFFER FOR KLPCLO
;	    0 = NEED TO GET A BUFFER
;	P4/ 0 = DO A SET CIRCUIT
;	   -1 = DON'T NEED TO DO A SET CIRCUIT
;	P5/ PBK
;	PUSHJ	P,CLOSV1
;RETURN:
;	CPOPJ ALWAYS

CLOSV1:	SETO	T2,		;NO SHUTDOWN REQUIRED
CLOSV2:	STKVAR	<BUFADR>	;ALLOCATE A WORD OF STACK STORAGE
	MOVEM	Q2,BUFADR	;SAVE ADDRESS OF BUFFER (IF ANY)
;AT THIS POINT, T2 = 0 IF SCA INITIATED THE CLOSING.  IN THAT CASE,
;WE'LL SEND A SHUTDOWN TO THE OTHER SIDE.  OTHERWISE, T2 = -1 AND THE
;OTHER SIDE PROBABLY KNOWS ABOUT THE FAILURE.

	CIOFF			;DON'T LET INTERRUPT LEVEL CHANGE VC STATE
	LOAD	T1,PBVCST,(P5)	;GET VC STATE
	CAIE	T1,VC.OPN	;OPEN?
	JRST	CLOSV7		;NO, DONE
	MOVEI	T1,VC.CLO	;GET CLOSED CODE
	STOR	T1,PBVCST,(P5)	;SET IT

;TRY TO SEND A SHUTDOWN IF SCA ASKED FOR THE CLOSING.  IF THERE'S NO
;BUFFER, WE CAN CONTINUE, AND THE OTHER SIDE WILL FIND OUT WHEN IT
;GETS A START PACKET SOMETIME LATER.

	LOAD	Q1,PBDPN,(P5)	;GET DESTINATION PORT NUMBER
	MOVE	Q3,.PBPCB(P5)	;GET THE PCB ADDRESS
	MOVE	P1,Q3		;GET PCB ADDRESS
	ADD	P1,Q1		; OFFSET BY CI NODE NUMBER
	JUMPN	T2,CLOSV3	;JUMP IF INTERNAL CALL (NO SHUTDOWN)
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFER
	  JRST	CLOSV3		;NO BUFFER, NOT A DISASTER
	MOVEI	T1,PP.SHT	;GET PPD BYTE FOR SHUTDOWN
	DPB	T1,PKYPPD	;STORE IN PACKET
	PUSHJ	P,KLPSDG	;SEND THE DATAGRAM
CLOSV3:	JUMPN	P4,CLOSV5	;JUMP IF WE DON'T NEED A SET CIRCUIT
	SKIPE	Q2,BUFADR	;DO WE HAVE A BUFFER FOR THE SETCKT?
	JRST	CLOSV4		;YES, GO DO IT
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  SKIPA			;COULDN'T
	JRST	CLOSV4		;OK
	MOVX	T1,PB.NTC	;FAILED, SAY WE STILL NEED TO CLOSE VC
	IORM	T1,.PBFLG(P5)	;...
	JRST	CLOSV6		;TELL SCA WE'RE CLOSED

CLOSV4:	PUSHJ	P,KLPCLO	;SEND THE PACKET
CLOSV5:	MOVX	T1,PB.WFI	;WAITING FOR A FRESH IDREC
	IORM	T1,.PBFLG(P5)	;...
CLOSV6:	LOAD	T1,PBPBI,(P5)	;GET THE PATH BLOCK INDEX
	BLCAL.	(SC.ERR##,<T1>)	;TELL SCA
CLOSV7:	PJRST	CIONPJ##	;INTERRUPTS BACK ON AND RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE
	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - MAP A BUFFER


;ROUTINE TO MAP A BUFFER FOR A SUBSEQUENT DMA/MAINTENANCE OPERATION.
;CALL:
;	BLCAL.	(PPDMAP,<SS.BDA>)
;
;WHERE:
;	SS.BDA - ADDRESS OF THE BUFFER DESCRIPTOR
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS WITH:
;	T1/ BUFFER NAME

	$XBSUB	(PPDMAP::,<SS.BDA>)
	PUSHJ	P,SAVPQ##	;SAVE THE P & Q REGISTERS
	PUSHJ	P,PPDGBH	;GET A BHD
	  RETBAD ()		;NONE AVAILABLE, RETURN ERROR
	MOVE	P1,T2		;SAVE BHD ADDRESS IN P1
	HRRZ	P2,T1		;GET BHD INDEX
	LSH	P2,^D35-BHPIDX	;POSITION IT WHERE THE KLIPA WANTS IT
	PUSHJ	P,PPDGCN	;GET A COMMAND REFERENCE NUMBER
	LSH	T4,^D35-BHPKEY-4 ;POSITION IT WHERE THE PORT WANTS IT
	IOR	P2,T4		;SAVE BUFFER NAME IN P2
	MOVE	T1,SS.BDA	;GET ADDRESS OF BUFFER DESCRIPTOR LIST
	MOVE	T1,.MDFLG(T1)	;GET THE FLAGS WORD
	TXNE	T1,SQ%WRT	;ALLOW WRITE OF HOST MEMORY?
	TXO	T4,BH.WRT	;YES, SET THE WRITABLE BIT IN THE BHD
	TXNE	T1,SQ%CVD	;ALLOW CLEARING OF THE VALID BIT?
	TXO	T4,BH.PRE	;NO, SET THE DO NOT CLEAR VALID BIT IN THE BHD
	TXO	T4,BH.VAL	;SET THE VALID BIT
	MOVEM	T4,.BHKEY(P1)	;SAVE KEY/VALID BITS IN BHD
	SETZM	.BHLEN(P1)	;ZERO NIBBLE COUNT IN BHD
	XMOVEI	P3,.BHBSA-.BSNXT(P1) ;INIT FIRST BSD LINK WORD
	SETZM	.BHBSA(P3)	;ZERO THE POINTER IN CASE NO BSDS
	PUSHJ	P,PPDGBD	;GET A BSD
	  JRST	MAPBU8		;NONE AVAILABLE
	MOVEM	T1,.BHBSA(P3)	;POINT BHD AT FIRST BSD (PHYSICAL ADDRESS)
	MOVE	P3,T2		;SAVE THE POINTER TO THE CURRENT BSD
	MOVE	Q1,SS.BDA	;GET ADDRESS OF FIRST BUFFER DESCRIPTOR
	MOVE	P5,.MDNXT(Q1)	;SAVE THE POINTER TO THE NEXT DESCRIPTOR
	ADDI	Q1,.MDSSD	;SET Q1 TO START OF LENGTH/ADDRESS PAIRS
	JRST	MAPBU2		;ALREADY HAVE A BSD
MAPBU1:	SKIPN	.MDLEN(Q1)	;ANOTHER BSD NEEDED?
	JRST	MAPBU6		;NO, FINISH UP
	PUSHJ	P,PPDGBD	;GET A BSD
	  JRST	MAPBU8		;NONE AVAILABLE
	MOVEM	T1,.BSNXT(P3)	;POINT PREVIOUS BSD AT THIS ONE (PHYSICAL ADDRESS)
	MOVE	P3,T2		;SAVE THE POINTER TO THE CURRENT BSD
MAPBU2:	MOVE	T1,.MDLEN(Q1)	;GET LENGTH OF THIS SEGMENT
	MOVE	T3,SS.BDA	;GET DESCRIPTOR ADDRESS
	LOAD	T3,MD%DMD,.MDFLG(T3) ;GET THE MODE
	CAIE	T3,MD%DIC	;INDUSTRY COMPATIBLE?
	JRST	MAPBU3		;NO
	LSH	T1,1		;YES, LENGTH IN BYTES, CHANGE TO NIBBLES
	MOVX	T2,BS.ICM	;GET INDUSTRY COMPATIBLE MODE BIT
	JRST	MAPBU5		;CONTINUE

MAPBU3:	CAIE	T3,MD%DHD	;HIGH DENSITY?
	JRST	MAPBU4		;NO
	LSH	T1,1		;YES, LENGTH IN BYTES, CHANGE TO NIBBLES
	MOVX	T2,BS.HDM	;GET HIGH DENSITY MODE BIT
	JRST	MAPBU5		;CONTINUE

MAPBU4:	IMULI	T1,CDNPW	;CALCULATE NIBBLES/WORD FOR CORE DUMP
	MOVX	T2,BS.CDM	;GET CORE DUMP MODE BIT
MAPBU5:	MOVEM	T1,.BSLEN(P3)	;SAVE LENGTH OF THIS SEGMENT IN NIBBLES
	ADDM	T1,.BHLEN(P1)	;ACCUMULATE TOTAL LENGTH IN BHD
	IOR	T2,.MDADR(Q1)	;INCLUDE ADDRESS IN MODE BIT
	MOVEM	T2,.BSADR(P3)	;SET MODE AND BASE ADDRESS IN BSD
	SETZM	.BSNXT(P3)	;ASSUME WE'RE DONE
	ADDI	Q1,.MDLSD	;STEP TO NEXT DESCRIPTOR LENGTH PAIR
	JRST	MAPBU1		;HANDLE IT

MAPBU6:	SKIPN	Q1,P5		;IS THERE ANOTHER BUFFER DESCRIPTOR BLOCK?
	JRST	MAPBU7		;NO
	MOVE	P5,.MDNXT(Q1)	;YES, POINT TO ITS NEXT DESCRIPTOR BLOCK
	ADDI	Q1,.MDSSD	;POINT TO START OF THE DESCRIPTOR PAIRS
	JRST	MAPBU1		;GO SET UP THE BSDS

MAPBU7:	MOVE	T1,P2		;GET THE BUFFER NAME
	JRST	CPOPJ1##	;SKIP RETURN

MAPBU8:	MOVE	T1,P2		;GET THE BUFFER NAME
	PUSHJ	P,PPDRHD	;RETURN BHD AND BSD(S)
	RETBAD	(KLPX2)		;RETURN ERROR

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	SCS-PPD INTERFACE - UNMAP A BUFFER


;ROUTINE TO UNMAP (RETURN ASSOCIATED BHD AND BSD(S) FOR) A BUFFER.
;CALL:
;	BLCAL.	(PPDUMP,<SS.NAM>)
;
;WHERE:
;	SS.NAM - BUFFER NAME
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

	$XBSUB	(PPDUMP::,<SS.NAM>)
	MOVE	T1,SS.NAM	;GET THE BUFFER NAME
	PUSHJ	P,PPDRHD	;RETURN BUFFER HEADER AND SEGMENT DESCRIPTOR(S)
	TXNN	T4,BH.ERR	;WERE THERE ANY ERRORS?
	JRST	CPOPJ1##	;NO, SKIP RETURN
	RETBAD	(KLPX13)	;YES, RETURN BUFFER TRANSFER ERROR CODE

	ENDBS.			;END OF BLSUB. RANGE
	SUBTTL	DIAGNOSTIC UUO INTERFACE


;HERE ON DIAG. UUO FUNCTIONS FOR A CHANNEL WHICH DID NOT HAVE A KDB.
;IF IT IS THE KLIPA CHANNEL, AND THE PCB EXISTS, ALLOW THE USER ACCESS.
;CALL:
;	P1/ NUMBER OF ARGUMENTS
;	P2/ DIAG. UUO FUNCTION CODE
;	P3/ SUBROUTINE (FROM KLPDIA)
;	W/  KDB (PCB) ADDRESS
;	PUSHJ	P,@KLPDIA
;RETURN:
;	CPOPJ ON ERROR (ERROR CODE STORED)
;	CPOPJ1 ON SUCCESS

KLPDIA:	EXP	KLPPPR		;PREPROCESSOR ROUTINE
	DIAFNC	(AAU,DIAAAU,)	;ASSIGN ALL UNITS
	DIAFNC	(RAU,DIARAU,)	;RELEASE CHANNEL AND ALL UNITS
	DIAFNC	(SCP,DIASCP,)	;SPECIFY CHANNEL PROGRAM
	DIAFNC	(RCP,DIARCP,)	;RELEASE CHANNEL PROGRAM
	DIAFNC	(GCS,DIACST,)	;GET CHANNEL STATUS
	DIAFNC	(ELD,DIAELD,)	;ENABLE MICROCODE LOADING
	DIAFNC	(DLD,DIADLD,)	;DISABLE MICROCODE LOADING
	DIAFNC	(LOD,DIALOD,)	;LOAD MICROCODE
	DIAFNC	(ISM,DIAISM,)	;SET MAINTENANCE MODE
	DIAFNC	(ICM,DIAICM,)	;CLEAR MAINTENANCE MODE
	DIAFNC			;TERMINATE TABLE

;PREPROCESSOR ROUTINE
	$XSENT	(KLPPPR:)
	PUSHJ	P,DIACHP	;SEE IF THERE IS A PCB
	  POPJ	P,		;NO, ERROR CODE ALREADY STORED
	CAIL	P2,.DIELD	;THSE FUNCTIONS DON'T REQUIRE MAINTENANCE MODE
	CAILE	P2,.DIICM	;...
	SKIPA			;NOT A SPECIAL FUNCTION
	PJRST	(P3)		;YES, DISPATCH NOW
	MOVX	T1,ST.MAI	;IN MAINTENANCE MODE?
	TDNN	T1,.PCSTS(Q3)	;...
	JRST	DIAADM##	;NO, RETURN AN ERROR
	PJRST	(P3)		;DISPATCH BASED ON FUNCTION CODE
;(2) ASSIGN "CHANNEL" AND ALL UNITS

DIAAAU:	PUSHJ	P,MAILOK	;ENSURE NO ONE ELSE GETS THE USE OF THE PCB
	  JRST	DIAAAJ##	;SOMEONE ELSE IS ALREADY USING IT
	JRST	CPOPJ1##	;SKIP RETURN


;(3) RELEASE "CHANNEL" AND ALL UNITS

DIARAU:	PUSHJ	P,MAIULK	;LET GO OF EXCLUSIVE OWNERSHIP
	  JRST	DIAAAJ##	;WE DON'T OWN INTERLOCK
	JRST	CPOPJ1##	;SKIP RETURN


;(4) SPECIFY CHANNEL PROGRAM

DIASCP:	CAME	J,.PCMJB(Q3)	;THIS JOB OWN MAINTENANCE INTERLOCK?
	JRST	DIAAAJ##	;NO
	MOVE	P3,.PCCDB(Q3)	;GET CDB ADDRESS
	PUSHJ	P,DIARCP	;RETURN ANY IOWD
	PUSHJ	P,GETWD1##	;GET IOWD
	HLRE	T2,T1		;LENGTH OF IOWD
	JUMPE	T2,DIAACP##	;TOO BIG IF 0
	MOVEM	T1,CHNICW(P3)	;UNRELOCATED IOWD
	MOVEI	T1,1(T1)	;START ADDRESS
	MOVNS	T2		;+LENGTH
	PUSHJ	P,ARNGE##	;MAKE SURE THE PAGES ARE OK
	 JFCL			;ERROR
	  JRST	[SETZM CHNICW(P3) ;PAGE NOT THERE
		 JRST  DIAACP##] ;BOMB HIM OUT
	SETZB	P1,P4		;SAY FIRST CALL, NOT A DX10
	MOVE	T2,CHNICW(P3)	;GET IOWD
	SNCALL	(MAPIO##,MCSEC1) ;RELOCATE THE IOWD
	  JRST	[SETZM CHNICW(P3)
		 JRST   DIAAFC##] ;NO LOW-CORE BLOCKS
	MOVSI	T1,(CC.HLT)	;LIGHT HALT BIT IN LAST CCW
	IORM	T1,-1(P1)	;...
	SETZM	(P1)		;TERMINATE LIST
	MOVEM	P2,CHNICW(P3)	;STORE ADDRESS OF CHANNEL PROGRAM
	TLO	P2,(FLD(.CCJMP,CC.OPC)) ;MAKE ICW BE A JUMP
	MOVE	T1,.PCLGO(Q3)	;ADDRESS OF CHANNEL LOGOUT AREA
	MOVEM	P2,.CSICW(T1)	;POINT ICWA AT CORE-BLOCK
	SETZM	.CSCLP(T1)	;CLEAR OTHER WORDS
	SETZM	.CSDBA(T1)	;...
	PUSHJ	P,STOTAC##	;TELL USER ICWA
	JRST	CPOPJ1##	;AND TAKE GOOD RETURN
;(5) RELEASE CHANNEL PROGRAM

DIARCP:	CAME	J,.PCMJB(Q3)	;THIS JOB OWN MAINTENANCE INTERLOCK?
	JRST	DIAAAJ##	;NO
	MOVE	P3,.PCCDB(Q3)	;GET CHANNEL DATA BLOCK ADDRESS
	SKIPN	T1,CHNICW(P3)	;NOTHING TO DO IF NO IOWD
	POPJ	P,
	SETZM	CHNICW(P3)	;FORGET WE HAD IT
	XJRST	[MCSEC1+RTNIOW##] ;RETURN THE SPACE AND RETURN


;(6) TELL USER FINAL CHANNEL STATS

DIACST:	CAME	J,.PCMJB(Q3)	;THIS JOB OWN MAINTENANCE INTERLOCK?
	JRST	DIAAAJ##	;NO
	MOVE	P2,.PCLGO(Q3)	;ADDRESS OF CHANNEL LOGOUT AREA
	ADDI	P2,.CSICW	;OFFSET TO ICWA ADDRESS
	XJRST	[MCSEC1+DIAGCS##] ;FINISH UP IN UUOCON
;(17/20) ENABLE/DISABLE MICROCODE LOADING

DIADLD:	TDZA	T2,T2		;DISABLE
DIAELD:	MOVEI	T2,1		;ENABLE
	XMOVEI	T1,.PCULB(Q3)	;ADDRESS OF MICRO LOADER BLOCK
	PUSHJ	P,BTUEDL##	;ENABLE OR DISABLE
	  JRST	DIAANM##	;ERROR
	JRST	CPOPJ1##	;SUCCESS


;(21) LOAD MICROCODE

DIALOD:	PUSHJ	P,URDEAD	;STOP, RELOAD, AND RESTART THE KLIPA
	MOVX	T1,ST.DED	;DID IT SUCCEED?
	TDNN	T1,.PCSTS(Q3)	;...
	JRST	CPOPJ1##	;YES, SKIP RETURN
	JRST	DIAARF##	;RETURN ERROR
;(22) SET MAINTENANCE MODE

DIAISM:	MOVX	T1,ST.MAI	;GET MAINTENANCE MODE FLAG
	TDNE	T1,.PCSTS(Q3)	;WAS IT ALREADY IN MAINTENANCE MODE?
	JRST	CPOPJ1##	;YES, SO NOTHING ELSE TO DO
	IORM	T1,.PCSTS(Q3)	;FLAG FOR NOSY ROUTINES
	PUSHJ	P,STPKLP	;STOP THE KLIPA
	PUSHJ	P,CIGONE	;RESET ALL CI ACTIVITY
	MOVE	P1,.PCCDB(Q3)	;P1 HAS BEEN STOMPED BY CIGONE (KLPRQC)
	SETZM	@.PCBIT(Q3)	;ZAP BITS TO TEST FOR ON INTERRUPT
	HRLZ	T1,.CPBIT##	;GET OUR CPU'S BIT
	IORM	T1,IPAMSK##	;DON'T LET THIS CHANNEL START IF SUSPENDED
	JRST	CPOPJ1##	;SKIP RETURN

;(23) CLEAR MAINTENANCE MODE

DIAICM:	MOVX	T1,ST.MAI	;GET MAINTENANCE MODE FLAG
	TDNE	T1,.PCSTS(Q3)	;WAS IT IN MAINTENANCE MODE?
	JRST	DIAIC1		;YES
	MOVX	T1,ST.DED	;NOT IN MAINTENANCE MODE, IS IT DEAD?
	TDNN	T1,.PCSTS(Q3)	;...
	JRST	CPOPJ1##	;NO, NOTHING ELSE TO DO
	SKIPA			;YES, TRY TO GET IT GOING AGAIN
DIAIC1:	ANDCAM	T1,.PCSTS(Q3)	;CLEAR THE FLAG
	PUSHJ	P,STPKLP	;STOP THE KLIPA
	MOVE	T1,[KLPBTS]	;BITS TO TEST FOR ON INTERRUPT
	MOVEM	T1,@.PCBIT(Q3)	;SET THEM IN CHANNEL DATA BLOCK
	HRLZ	T1,.CPBIT##	;GET OUR CPU'S BIT
	ANDCAM	T1,IPAMSK##	;LET THIS CHANNEL START IF SUSPENDED
	PUSHJ	P,URDEAD	;DO ALL THE RESTART STUFF
	MOVX	T1,ST.DED	;DID IT SUCCEED?
	TDNN	T1,.PCSTS(Q3)	;...
	JRST	CPOPJ1##	;YES, SKIP RETURN
	JRST	DIAARF##	;RETURN ERROR
;DIAG. UUO FUNCTION TO RESET A REMOTE NODE.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	M/ POINTER TO USER ARGUMENT LIST
;	P1/ NUMBER OF ARGUMENTS IN LIST
;
;LIST:	CPU #,,105
;	CHAN,,NODE
;	FORCE FLAG (OPTIONAL)
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

	$XSENT	(DIARRS::)
	PUSHJ	P,DIACHK	;SET UP FOR DIAG. FUNCTION, CHECK PCB, ETC.
	  POPJ	P,		;ERROR, ERROR CODE ALREADY STORED
	CAIGE	P1,2		;AT LEAST 2 ARGUMENTS?
	JRST	DIAAIA##	;NO
	MOVX	T1,ST.DED	;IS IT RUNNING?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	DIAAPN##	;NO, ERROR
	SETZ	P2,		;ASSUME NO FLAGS
	CAIGE	P1,3		;INCLUDE THE OPTIONAL FORCE RESET FLAG?
	JRST	DIARS1		;NO
	PUSHJ	P,GETWD1##	;GET THE FORCE FLAG
	SKIPE	T1		;WANT TO FORCE A RESET?
	TXO	P2,PF.FRC	;YES, SET THE FLAG
DIARS1:	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	DIAAFC##	;NONE AVAILABLE, GIVE AN ERROR
	MOVEI	T1,OP.RRS	;OPCODE = RESET REMOTE SYSTEM
	MOVE	T3,P2		;MOVE THE FLAGS TO T3
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	DIASND		;SEND THE PACKET AND RETURN
;DIAG. UUO FUNCTION TO START A REMOTE NODE.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	M/ POINTER TO USER ARGUMENT LIST
;	P1/ NUMBER OF ARGUMENTS IN LIST
;
;LIST:	CPU #,,106
;	CHAN,,NODE
;	STARTING ADDRESS (ZERO IMPLIES DEFAULT)
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

	$XSENT	(DIASRS::)
	PUSHJ	P,DIACHK	;SET UP FOR DIAG. FUNCTION, CHECK PCB, ETC.
	  POPJ	P,		;ERROR, ERROR CODE ALREADY STORED
	CAIGE	P1,2		;AT LEAST 2 ARGUMENTS?
	JRST	DIAAIA##	;NO
	MOVX	T1,ST.DED	;IS IT RUNNING?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	DIAAPN##	;NO, ERROR
	SETZ	P2,		;ASSUME DEFAULT STARTING ADDRESS
	CAIGE	P1,3		;INCLUDE THE OPTIONAL STARTING ADDRESS?
	JRST	DIASR1		;NO
	PUSHJ	P,GETWD1##	;GET THE STARTING ADDRESS
	MOVE	P2,T1		;COPY TO P2
DIASR1:	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	DIAAFC##	;NONE AVAILABLE, GIVE AN ERROR
	MOVEM	P2,.PKSAD(Q2)	;STORE STARTING ADDRESS IN PACKET
	MOVEI	T1,OP.RRS	;OPCODE = RESET REMOTE SYSTEM
	SETZ	T3,		;ASSUME NO FLAGS
	SKIPN	P2		;WAS THERE A NON-ZERO STARTING ADDRESS?
	TXO	T3,PF.DSA	;NO, ASK FOR DEFAULT STARTING ADDRESS
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	DIASND		;SEND THE PACKET AND RETURN
;DIAG. UUO FUNCTION TO MANIPULATE THE PORT COUNTERS.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	M/ POINTER TO USER ARGUMENT LIST
;	P1/ NUMBER OF ARGUMENTS IN LIST
;
;LIST:	CPU #,,107
;	CHAN,,COUNTERS SUB-FUNCTION
;	SUB-FUNCTION SPECIFIC DATA
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

	$XSENT	(DIACTR::)
	SKIPN	Q3,.CPPCB##	;IS THERE A CI PORT ON THIS CPU?
	JRST	DIAACI##	;NO, ERROR
	CAIGE	P1,2		;AT LEAST 2 ARGUMENTS?
	JRST	DIAAIA##	;NO
	MOVX	T1,ST.DED	;IS IT RUNNING?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	DIAAPN##	;NO, ERROR
	PUSHJ	P,GETWD1##	;GET FIRST ARGUMENT
	HRRE	Q1,T1		;SAVE SUB-FUNCTION CODE HERE FOR DISPATCH
	HLRZS	T1		;ISOLATE CHANNEL
	LDB	T2,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	CAIE	T1,(T2)		;THE KLIPA CHANNEL?
	JRST	DIAACI##	;NO
	MOVSI	T1,JP.POK	;PRIVILEGE BIT THEY NEED
	CAIE	Q1,CTRRCT	;THE UNPRIVILEGED FUNCTION?
	SNCALL	(PRVBIT##,MCSEC1) ;NO, MAKE SURE USER IS PRIVILEGED
	  SKIPA			;OK, UNPRIVILEGED FUNCTION OR PRIVILEGED USER
	JRST	DIAANP##	;GIVE AN ERROR
	SKIPL	Q1		;NEGATIVE SUB-FUNCTIONS ARE ILLEGAL
	CAILE	Q1,CTRFLN	;LEGAL SUB-FUNCTION?
	JRST	DIAABA##	;NO, RETURN AN ERROR
	PJRST	@CTRFCN(Q1)	;DISPATCH BASED ON SUB-FUNCTION CODE

CTRFCN:	IFIW	CTRGET		;0 - GET COUNTERS
	IFIW	CTRGIV		;1 - RELEASE COUNTERS
	IFIW	CTRPNT		;2 - POINT COUNTERS
CTRRCT==.-CTRFCN		;THE "READ COUNTERS" SUB-FUNCTION
	IFIW	CTRRED		;3 - READ COUNTERS
CTRFLN==.-CTRFCN-1		;MAXIMUM LEGAL SUB-FUNCTION
;GET CONTROL OF THE COUNTERS

CTRGET:	SKIPE	T1,.PCCJB(Q3)	;DOES SOME JOB ALREADY OWN THE COUNTERS?
	CAMN	T1,J		;YES, IS IT THE CALLER'S JOB?
	SKIPA			;NOT OWNED, OR OWNED BY CALLER
	JRST	DIAAAJ##	;SORRY, THEY'RE ALREADY IN USE
	MOVEM	J,.PCCJB(Q3)	;YOU'RE THE LUCKY OWNER
	JRST	CPOPJ1##	;SKIP RETURN


;RELINQUISH CONTROL OF THE COUNTERS

CTRGIV:	CAMN	J,.PCCJB(Q3)	;DOES CALLER'S JOB OWN THE COUNTERS?
	JRST	CTRGV1		;YES
	CAIGE	P1,3		;ROOM FOR THE FORCE FLAG?
	JRST	DIAAAJ##	;NO, GIVE AN ERROR
	PUSHJ	P,GETWD1##	;GET THE FORCE FLAG
	SKIPG	T1		;FORCE THE RELEASE?
	PJRST	DIAAAJ##	;NO, GIVE AN ERROR
CTRGV1:	SETZM	.PCCJB(Q3)	;NO ONE OWNS THE COUNTERS ANY MORE
	JRST	CPOPJ1##	;SKIP RETURN


;POINT THE COUNTERS AT A PARTICULAR NODE

CTRPNT:	CAME	J,.PCCJB(Q3)	;DOES CALLER'S JOB OWN THE COUNTERS?
	JRST	DIAAAJ##	;NO, GIVE AN ERROR
	CAIGE	P1,4		;NEED AT LEAST THIS MANY WORDS
	JRST	DIAAIA##	;NOPE, WE'RE A BIT LATE AND A WORD SHORT
	PUSHJ	P,GETWD1##	;GET THE MASK ARGUMENT
	MOVE	P2,T1		;SAVE A MOMENT
	PUSHJ	P,GETWD1##	;GET THE NODE ARGUMENT
	MOVE	P3,T1		;SAVE A MOMENT
				;*** NO CALLS TO GETWD1 AFTER CALLING KLPGDB
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	DIAAFC##	;NONE AVAILABLE, GIVE AN ERROR
	MOVEM	P2,.PKMSK(Q2)	;STORE THE MASK IN THE PACKET
	SETZM	.PKPND(Q2)	;CLEAR PORT WORD
	DPB	P3,PKYCND	;WHICH NODE TO MONITOR
	MOVEI	T1,OP.SPT	;OPERATION IS SET POINTERS
	SETZB	T3,Q1		;NO FLAGS, CLEAR NODE NUMBER
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	DIASND		;SEND THE PACKET AND RETURN
;READ THE COUNTERS

CTRRED:	PUSH	P,M		;WE WANT TO CALL PUTWD1 LATER
	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	[POP  P,M	;NONE AVAILABLE, CLEAN STACK
		 JRST DIAAFC##]	;GIVE AN ERROR
	SETZM	.PCCTR(Q3)	;ZERO DATE/TIME COUNTERS WERE LAST READ
	MOVX	T2,KS%DIA	;REASON FOR READING COUNTERS
	HRL	T2,J		;PLUG IN OUR JOB NUMBER
	PUSHJ	P,KLPRPT	;SEND A READ-COUNTERS
	POP	P,M		;RESTORE ADDRESS FOR PUTWD1

;NOW WAIT FOR A RESPONSE - WAIT UP TO 5 SECONDS

	MOVEI	T1,^D5		;HOW LONG TO WAIT
	SNCALL	(SLEEPF##,MCSEC0) ;PUT THE JOB TO SLEEP FOR A WHILE
	SKIPN	.PCCTR(Q3)	;ANYTHING GET RETURNED?
	JRST	DIAATO##	;NO, ERROR

;SOMETHING HAS ARRIVED, ASSUME IT IS THE DATA WE REQUESTED

	SUBI	P1,2		;ACCOUNT FOR FUNCTION AND SUB-FUNCTION WORDS
	CAILE	P1,NOSTCT+1	;ASKING FOR MORE THAN WE HAVE?
	MOVEI	P1,NOSTCT+1	;YES, REDUCE THEIR REQUEST
	SOJLE	P1,CPOPJ1##	;RETURN IF ARGUMENT LIST EXHAUSTED
	MOVE	T1,.PCCJB(Q3)	;GET JOB WHICH OWNS THE COUNTERS
	PUSHJ	P,PUTWD1##	;STORE FOR USER

;THE BLOCK OF DATA RETURNED BY THE READ COUNTERS PACKET

	MOVE	P2,Q3		;COPY THE PCB ADDRESS TO P2
CTRRD2:	SOJLE	P1,CPOPJ1##	;RETURN WHEN ARGUMENT LIST EXHAUSTED
	MOVE	T1,.PCCTR+1(P2)	;GET A COUNTER ITEM (SKIP DATE/TIME)
	PUSHJ	P,PUTWD1##	;STORE FOR THE USER
	AOJA	P2,CTRRD2	;LOOP FOR MORE DATA
;DIAG. UUO FUNCTIONS TO REQUEST (READ) AND WRITE MAINTENANCE DATA.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	M/ POINTER TO USER ARGUMENT LIST
;	P1/ NUMBER OF ARGUMENTS IN LIST
;
;LIST:	CPU #,,112 FOR WRITE, 113 FOR READ
;	CHAN,,NODE
;	LENGTH OF TRANSFER IN BYTES
;	RECEIVER'S BUFFER NAME
;	ADDRESS OF USER BUFFER
;
;RETURN:
;	CPOPJ ON ERROR WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

	$XSENT	(DIARMD::)
	STKVAR	<RWFLAG,RTDG>	;ALLOCATE SOME STACK STORAGE
	SETZM	RWFLAG		;FLAG THIS IS A READ FUNCTION
	JRST	DIARWM		;JOIN COMMON CODE

	$XSENT	(DIAWMD::)
	STKVAR	<RWFLAG,RTDG>	;ALLOCATE SOME STACK STORAGE
	SETOM	RWFLAG		;FLAG THIS IS A WRITE FUNCTION
DIARWM:	CAIGE	P1,5		;ALL THE ARGUMENTS THERE?
	JRST	DIAAIA##	;NO, GIVE ERROR
	PUSHJ	P,DIACHK	;SET UP FOR DIAG. FUNCTION, CHECK PCB, ETC.
	  POPJ	P,		;ERROR, ERROR CODE ALREADY STORED
	MOVX	T1,ST.DED	;IS IT RUNNING?
	TDNE	T1,.PCSTS(Q3)	;...
	PJRST	DIAAPN##	;NO, ERROR
	CAIL	Q1,0		;LEGAL CI NODE NUMBER?
	CAIL	Q1,MAXNDS	;...
	JRST	DIAABA##	;NO
	MOVE	T1,Q3		;GET PCB ADDRESS
	ADD	T1,Q1		; OFFSET BY CI NODE NUMBER
	SKIPN	P5,.PCPBK(T1)	;GET PATH BLOCK ADDRESS
	JRST	DIAABA##	;ERROR
	MOVE	T1,.PBDPF(P5)	;GET DESTINATION PORT FUNCTIONALITY
	SKIPN	RWFLAG		;READ OR WRITE?
	SKIPA	T2,[TXNN T1,PK.RMD] ;READ, GET THE APPROPRIATE TEST
	MOVE	T2,[TXNN T1,PK.SMD] ;WRITE, GET THE APPROPRIATE TEST
	XCT	T2		;DOES IT SUPPORT THE DESIRED FUNCTION?
	JRST	DIAABA##	;NO
	LDB	T1,[POINT PKSRST,.PBDPS(P5),PKPRST] ;GET THE PORT STATE
	CAIE	T1,PS.UMS	;IS IT IN UNITIALIZED MAINTENANCE MODE?
	JRST	DIAABA##	;NO
	LDB	T1,[POINT PKSRND,.PBDPS(P5),PKPRND] ;GET THE RESETTING NODE
	CAME	T1,.PCONN(Q3)	;SAME AS OUR NODE NUMBER?
	JRST	DIAABA##	;NO
	PUSHJ	P,GETWD1##	;GET THE NUMBER OF 8 BIT BYTES TO READ/WRITE
	CAILE	T1,0		;MUST BE GREATER THAN 0
	CAILE	T1,^D512	; AND LESS THAN 513
	JRST	DIAABA##	;ERROR
	MOVE	P2,T1		;SAVE COUNT IN P2

	PUSHJ	P,GETWD1##	;GET THE DESTINATION NODE'S BUFFER NAME
	MOVE	P3,T1		;SAVE IN P3

	PUSHJ	P,GETWD1##	;GET THE ADDRESS OF THE USER'S BUFFER
	MOVE	P4,T1		;SAVE IN P4

;AT THIS POINT THE CALLING ARGUMENTS LOOK GOOD.  NOW START THE REAL
;WORK.  AFTER THIS POINT, AC "M" IS NO LONGER USABLE, AS IT IS THE
;SAME AS AC "Q2".

	PUSHJ	P,MAILOK	;GAIN OWNERSHIP OF THE SEND/RECEIVE INTERLOCK
	  JRST	DIAAAJ##	;SOMEONE ELSE IS ALREADY USING IT

	MOVEI	T1,1		;ASK FOR A BUFFER
	PUSHJ	P,SC.ALD##	;GET A DATAGRAM BUFFER
	  JRST	[HRLM T1,.PCMFL(Q3) ;ERROR, STORE ERROR CODE
		 JRST DIRWF4]	;FINISH UP
	MOVE	Q2,T1		;SAVE BUFFER ADDRESS
	MOVEM	T3,RTDG		;SAVE ADDRESS OF ROUTINE TO RETURN BUFFER

	SETZM	.MDNXT(Q2)	;NO NEXT DESCRIPTOR IN CHAIN
	SETZM	.MDFLG(Q2)	;START WITH A FRESH FLAGS WORD
	MOVX	T1,MD%DIC	;GET INDUSTRY COMPATIBLE MODE BITS
	STOR	T1,MD%DMD,.MDFLG(Q2) ;STORE IN BUFFER DESCRIPTOR BLOCK
	MOVX	T1,SQ%WRT	;GET THE WRITE FLAG
	SKIPN	RWFLAG		;READ OR WRITE?
	IORM	T1,.MDFLG(Q2)	;READ, ALLOW KLIPA TO WRITE HOST MEMORY
	MOVE	T1,P2		;GET SIZE (IN 8-BIT BYTES)
	MOVEM	T1,.MDSSD+.MDLEN(Q2) ;STORE IN BUFFER DESCRIPTOR BLOCK
	MAP	T1,.MDSSD+.MDLSD+1(Q2) ;GET PHYSICAL ADDRESS OF SEGMENT
	TXZ	T1,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T1,.MDSSD+.MDADR(Q2) ;STORE IN BUFFER DESCRIPTOR BLOCK
	SETZM	.MDSSD+.MDLSD(Q2) ;ZERO LAST WORD OF DESCRIPTOR BLOCK
	BLCAL.	(PPDMAP,<Q2>)	;SET UP BHD AND BSD(S), RETURN BUFFER NAME
	  JRST	[HRLM T1,.PCMFL(Q3) ;ERROR, STORE ERROR CODE
		 JRST DIRWF3]	;FINISH UP
	MOVE	P1,T1		;SAVE BUFFER NAME
	SKIPN	RWFLAG		;READ OR WRITE?
	JRST	DIARW1		;READ
	MOVEI	T1,3(P2)	;WRITE, GET NUMBER OF BYTES AND ROUND UP
	LSH	T1,-2		;CONVERT TO WORDS
	MOVE	T2,P4		;COPY USER'S BUFFER ADDRESS
	EXCTUX	<SKIP (T2)>	;IS USER ADDRESS VALID?
	  ERJMP	DIRWA1		;NO, GO CLEAN UP
	ADD	T2,T1		;GET ENDING USER ADDRESS
	EXCTUX	<SKIP (T2)>	;IS ENDING USER ADDRESS VALID?
	  ERJMP	DIRWA1		;NO, GO CLEAN UP
	MOVE	T2,P4		;GET SOURCE ADDRESS
	XMOVEI	T3,.MDSSD+.MDLSD+1(Q2) ;GET DESTINATION ADDRESS
	EXCTUX	<EXTEND T1,[XBLT]> ;TRANSFER THE DATA
DIARW1:	SETOM	.PCMFL(Q3)	;SET THE FLAG: -1 MEANS NOT COMPLETE, 0 MEANS
				; COMPLETED, 1 MEANS COMPLETED WITH ERROR
	LSH	P3,4		;POSITION THE BUFFER NAME FOR KLPSER
	SKIPN	RWFLAG		;READ OR WRITE?
	JRST	DIARW2		;READ
	BLCAL.	(PPDSMD,<P1,P3,[0],[0]>)
	  JRST	[HRLM T1,.PCMFL(Q3) ;ERROR, SAVE ERROR CODE
		 JRST DIRWF2]	;ERROR ONLY IF UNABLE TO GET A BUFFER
	JRST	DIARW3		;REJOIN COMMON CODE

DIARW2:	BLCAL.	(PPDRMD,<P3,P1,[0],[0]>)
	  JRST	[HRLM T1,.PCMFL(Q3) ;ERROR, SAVE ERROR CODE
		 JRST DIRWF2]	;ERROR ONLY IF UNABLE TO GET A BUFFER
DIARW3:	PUSHJ	P,MAIRWT	;WAIT FOR THE WRITE TO FINISH
	  JRST	[SKIPG .PCMFL(Q3) ;TIMED OUT OR FINISHED WITH ERROR?
		 SKIPA T1,[27]	;TIMED OUT
		 MOVEI T1,30	;FINISHED WITH ERROR
		 HRLM  T1,.PCMFL(Q3) ;SAVE ERROR CODE
		 JRST  .+1]	;CONTINUE ON
	SKIPE	RWFLAG		;READ OR WRITE?
	JRST	DIRWF1		;WRITE, FINISH UP
	MOVEI	T1,3(P2)	;READ, GET NUMBER OF BYTES AND ROUND UP
	LSH	T1,-2		;CONVERT TO WORDS
	XMOVEI	T2,.MDSSD+.MDLSD+1(Q2) ;GET SOURCE ADDRESS
	MOVE	T3,P4		;GET DESTINATION
	EXCTUU	<MOVES (T3)>	;IS USER ADDRESS VALID?
	  ERJMP	DIRWA2		;NO
	ADD	T3,T1		;GET ENDING ADDRESS
	EXCTUU	<MOVES (T3)>	;IS USER ADDRESS VALID?
	  ERJMP	DIRWA2		;NO
	MOVE	T3,P4		;GET DESTINATION AGAIN
	EXCTXU	<EXTEND T1,[XBLT]> ;TRANSFER THE DATA
	JRST	DIRWF1		;FINISH UP

DIRWA1:	MOVEI	T1,ECOD1##	;GET ILLEGAL ADDRESS ERROR CODE
	HRLM	T1,.PCMFL(Q3)	;STORE ERROR CODE
	JRST	DIRWF2		;GO CLEAN UP

DIRWA2:	MOVEI	T1,ECOD1##	;GET ILLEGAL ADDRESS ERROR CODE
	HRLM	T1,.PCMFL(Q3)	;STORE ERROR CODE
	JRST	DIRWF1		;GO CLEAN UP
;HERE TO FINISH UP FOLLOWING A READ/WRITE FUNCTION.

DIRWF1:	PUSHJ	P,MAICLB	;CLEAN UP
DIRWF2:	BLCAL.	(PPDUMP,<Q3>)	;CLEAN UP THE BHD AND BSD (Q3 HAS BUFFER NAME)
	  JRST	[HRLM T1,.PCMFL(Q3) ;ERROR, STORE ERROR CODE
		 JRST DIRWF4]	;FINISH UP
DIRWF3:	MOVE	T1,Q2		;GET THE ADDRESS OF THE BUFFER TO RELEASE
	PUSHJ	P,@RTDG		;RELEASE THE BUFFER
	SKIPE	.PCMFL(Q3)	;DID MAINTENANCE OPERATION COMPLETE SUCCESSFULLY?
	JRST	DIRWF4		;NO
	PUSHJ	P,MAIULK	;RELINQUISH OWNERSHIP OF THE INTERLOCK
	  JFCL			;SHOULDN'T HAPPEN
	JRST	CPOPJ1##	;SKIP RETURN

DIRWF4:	HLRZ	T1,.PCMFL(Q3)	;GET THE ERROR CODE
	PUSH	P,T1		;SAVE IT FOR A MOMENT
	PUSHJ	P,MAIULK	;RELINQUISH OWNERSHIP OF THE SEND/RECEIVE INTERLOCK
	  JFCL			;SHOULDN'T HAPPEN
	POP	P,T1		;RESTORE ERROR CODE
	JRST	STOTAC##	;STORE AND RETURN

	ENDSV.			;END OF STACK VARIABLE RANGE
	ENDSV.			;END OF STACK VARIABLE RANGE
;ROUTINE TO GAIN OWNERSHIP OF THE CI PORT MAINTENANCE
;SEND/RECEIVE INTERLOCK.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,MAILOK
;RETURN:
;	CPOPJ IF ERROR
;	CPOPJ1 IF SUCCESS

MAILOK:	CIOFF			;PREVENT RACES
	SKIPE	.PCMJB(Q3)	;IS SOMEONE ELSE DOING A MAINTENANCE SEND/RECEIVE?
	PJRST	CIONPJ##	;YES, GIVE UP INTERLOCK AND NON-SKIP RETURN
	MOVEM	J,.PCMJB(Q3)	;NO, THEN WE ARE THE LUCKY ONES
	PJRST	CINPJ1##	;INTERRUPS BACK ON AND SKIP RETURN


;ROUTINE TO RELINQUISH OWNERSHIP OF THE CI PORT MAINTENANCE
;SEND/RECEIVE INTERLOCK.
;CALL:
;	J/ CALLER'S JOB NUMBER
;	Q3/ PCB ADDRESS
;	PUSHJ	P,MAIULK
;RETURN:
;	CPOPJ IF DIDN'T OWN INTERLOCK
;	CPOPJ1 IF INTERLOCK RELEASED

MAIULK:	CAME	J,.PCMJB(Q3)	;THIS JOB OWN MAINTENANCE INTERLOCK?
	POPJ	P,		;NO
	SETZM	.PCMJB(Q3)	;QUITE EASY
	JRST	CPOPJ1##	;SKIP RETURN
;ROUTINE TO TELL THE KLIPA TO CLOSE THE BUFFER SO THE KLIPA WILL
;DELETE THE OPERATION FROM ITS QUEUES.
;CALL:
;	P1/ BUFFER NAME
;	PUSHJ	P,MAICLB
;RETURN:
;	CPOPJ ALWAYS

MAICLB:	PUSHJ	P,SAVQ##	;SAVE THE Q REGISTERS
MAICL1:	PUSHJ	P,KLPGDB	;GET A DATAGRAM BUFFER
	  JRST	MAICL2		;ERROR, WAIT A BIT AND TRY AGAIN
	SETZM	.PCMCF(Q3)	;ZERO THE FLAG
	MOVEM	P1,.PCMCN(Q3)	;SAVE THE BUFFER NAME
	BLCAL.	(PPDCLB,<P1,Q2>) ;DO THE CLOSE BUFFER COMMAND
	PJRST	MAIRWT		;WAIT FOR COMPLETION AND RETURN

MAICL2:	MOVEI	T1,1		;FAILED TO GET A BUFFER, SLEEP A SECOND
	SNCALL	(SLEEPF##,MCSEC0)
	JRST	MAICL1		;TRY AGAIN


;ROUTINE TO WAIT FOR A MAINTENANCE OPERATION TO COMPLETE.
;CALL:
;	Q3/ PCB ADDRESS
;	PUSHJ	P,MAIRWT
;RETURN:
;	CPOPJ ALWAYS

MAIRWT:	MOVEI	T1,^D5		;HOW LONG TO WAIT
	SNCALL	(SLEEPF##,MCSEC0) ;KNOCK OFF FOR A WHILE
	POPJ	P,		;RETURN
;ROUTINE TO SET UP FOR A DIAG. UUO FUNCTION.
;CALL:
;	M/ POINTER TO FUNCTION WORD OF USER ARGUMENT LIST
;	P1/ NUMBER OF ARGUMENTS
;	PUSHJ	P,DIACHK
;RETURN:
;	CPOPJ IF ERRORS (ERROR CODE ALREADY STORED)
;	CPOPJ1 IF SUCCESS WITH:
;	Q1/ RIGHT HALF OF FIRST ARGUMENT (PROBABLY NODE NUMBER)
;	Q3/ PCB ADDRESS
;
;NOTE:  ALL KLIPA DIAG. UUO FUNCTIONS HAVE THE CHANNEL ARGUMENT IN
;THE LEFT HALF OF THE FIRST ARGUMENT FOLLOWING THE FUNCTION.  IF A
;FUNCTION IS ADDED WHICH DOESN'T FOLLOW THIS CONVENTION, DIACHK AND
;ALL CALLERS WILL HAVE TO BE MODIFIED SO THE CHANNEL IS CHECKED BY
;THE CALLER INSTEAD OF DIACHK.

DIACHK:	PUSHJ	P,DIACHP	;CHECK FOR PRIVILEGES AND A PCB
	  POPJ	P,		;ERROR, CODE ALREADY STORED
	CAIGE	P1,2		;AT LEAST 2 ARGUMENTS?
	JRST	DIAAIA##	;NO
	PUSHJ	P,GETWD1##	;GET FIRST ARGUMENT
	HRRZ	Q1,T1		;RETURN AS ADVERTISED
	HLRZS	T1		;ISOLATE CHANNEL
	LDB	T2,[POINT 3,KDBDVC(Q3),35] ;GET RH20 NUMBER
	CAIE	T1,(T2)		;THE KLIPA CHANNEL?
	JRST	DIAACI##	;NO
	JRST	CPOPJ1##	;YES, SKIP RETURN


;ROUTINE TO CHECK FOR EXISTANCE OF PCB AND PRIVILEGES.  LIKE
;DIACHK BUT IT DOESN'T CHECK THE CHAN,,NODE WORD.
;CALL:
;	M/ POINTER TO FUNCTION WORD OF ARGUMENT LIST
;	PUSHJ	P,DIACHP
;RETURN:
;	CPOPJ IF ERRORS (ERROR CODE ALREADY STORED)
;	CPOPJ1 IF SUCCESS WITH:
;	Q3/ PCB ADDRESS

DIACHP:	MOVSI	T1,JP.POK	;MUST HAVE PRIVILEGES
	SNCALL	(PRVBIT##,MCSEC1) ;DO THEY?
	  SKIPA	Q3,W		;YES, GET PCB ADDRESS AND SKIP
	JRST	DIAANP##	;NO
	JUMPE	Q3,DIAACI##	;IF NO CI PORT, GIVE AN ERROR
	JRST	CPOPJ1##	;TAKE SKIP RETURN
;HERE FROM UUOCON FROM DIACLR DISPATCH (^C, HALT, ETC., TYPED)
;CALL:
;	J/ JOB NUMBER
;	PUSHJ	P,PPDCLR
;RETURN:
;	CPOPJ ALWAYS

	$XSENT	(PPDCLR::)
	XMOVEI	T1,CLRJOB	;LOAD ADDRESS OF SUBROUTINE TO CLEAR JOB IN PCB
	PJRST	CPUAPP##	;DO IT ON ALL CPUS AND RETURN


;ROUTINE EXECUTED TO CLEAR JOB NUMBER FIELDS IN PCB FOR ALL CPUS.
;ZEROS .PCCJB AND .PCMJB IN THE PCB.
;CALL:
;	P1/ CDB ADDRESS
;	J/ JOB NUMBER
;	PUSHJ	P,CLRJOB
;RETURN:
;	CPOPJ ALWAYS

CLRJOB:	SKIPN	T1,.CPPCB##-.CPCDB##(P1) ;IS THERE A KLIPA ON THIS CPU?
	POPJ	P,		;NO, RETURN
	CAMN	J,.PCCJB(T1)	;DOES THIS JOB OWN THE COUNTERS?
	SETZM	.PCCJB(T1)	;YES, BUT NOT ANY LONGER
	CAMN	J,.PCMJB(T1)	;DOES THIS JOB OWN THE MAINTENANCE SEND/RECEIVE INTERLOCK?
	SETZM	.PCMJB(T1)	;YES, BUT NOT ANY LONGER
	POPJ	P,		;RETURN
	SUBTTL	ROUTINE TO SEND A PACKET UNDER VIRTUAL CIRCUIT CONTROL


;ROUTINE TO SEND A PACKET UNDER VIRTUAL CIRCUIT CONTROL.
;CALL:
;	T1/ OPCODE
;	T2/ PRIORITY
;	T3/ FLAGS
;	Q2/ PACKET ADDRESS
;	P5/ PBK ADDRESS
;	PUSHJ	P,SENDVC
;RETURN:
;	CPOPJ ON ERRORS WITH:
;	T1/ ERROR CODE
;	CPOPJ1 ON SUCCESS

SENDVC:	LOAD	T4,PBVCST,(P5)	;GET VC STATE
	CAIE	T4,VC.OPN	;IS IT OPEN?
	RETBAD	(KLPX9)		;NO
	LOAD	Q1,PBDPN,(P5)	;GET THE DESTINATION NODE NUMBER
	MOVE	Q3,.PBPCB(P5)	;GET THE PCB ADDRESS
	MOVX	T4,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	ANDCAM	T4,.PKVRT(Q2)	;...
	MOVX	T4,PK.SCA	;GET THE SCA SOFTWARE RESPONSE FLAG
	TXNE	T3,PF.RSP	;WANT A RESPONSE?
	IORM	T4,.PKVRT(Q2)	;YES, SET THE FLAG
	AOS	(P)		;SET FOR SKIP RETURN
	PJRST	KLPSND		;SEND THE PACKET AND RETURN
	SUBTTL	ROUTINES TO SEND DATAGRAMS


;ROUTINES TO SEND A SET CIRCUIT DATAGRAM.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,KLPSCK/KLPOPN/KLPCLO
;RETURN:
;	CPOPJ ALWAYS

KLPCLO:	MOVX	T1,RI.PAO!RI.PBO ;NEITHER PATH NOW OPEN
	ANDCAM	T1,.PCRIS(P1)	;...
	MOVX	T1,CK.LST	;CLOSE VIRTUAL CIRCUIT
	JRST	KLPOCC		;JOIN COMMON CODE

KLPOPN:	MOVX	T1,RI.PAO!RI.PBO ;START WITH BOTH PATHS OPEN
	IORM	T1,.PCRIS(P1)	;...
	MOVX	T1,CK.LST!CK.CST!CK.LPT!CK.PAA!CK.PBA ;OPEN VIRTUAL CIRCUIT
KLPOCC:	MOVEM	T1,.PKCKT(Q2)	;ASSUME NR-NS=0 INITIALLY
KLPSCK:	MOVEI	T1,OP.CKT	;OPCODE = SET VIRTUAL CIRCUIT
	MOVEI	T2,INCXID	;GET NEW TRANSACTION ID
	ADDB	T2,KLPXID	;...
	MOVEM	T2,.PKXID(Q2)	;STORE IN PACKET
	MOVEM	T2,.PKXID+1(Q2)	; (SAME THING IN BOTH WORDS)
	JRST	KLPSX1		;JOIN COMMON CODE


;ROUTINE TO SEND A READ REGISTER DATAGRAM.
;CALL:
;	T1/ REGISTER TO READ
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,KLPRRG
;RETURN:
;	CPOPJ ALWAYS

KLPRRG:	SETZB	Q1,.PKREG(Q2)	;ZERO NODE NUMBER AND MUST BE ZERO FIELDS
	DPB	T1,PKYREG	;STORE THE REGISTER TO READ
	MOVEI	T1,OP.RRG	;OPCODE = READ REGISTER
	JRST	KLPSX1		;JOIN COMMON CODE
;ROUTINE TO SEND A START DATAGRAM.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,KLPSDG
;RETURN:
;	CPOPJ ALWAYS

KLPSDG:	LDB	T1,PKYPPD	;GET PACKET TYPE
	MOVE	T2,STRLEN(T1)	;GET APPROPRIATE LENGTH
	DPB	T2,PKYLEN	;STORE THE PACKET LENGTH
	PUSHJ	P,MASAGE	;SWAP THE PPD BYTE AND ADJUST LENGTH
	MOVEI	T1,OP.SDG	;OPCODE = SEND DATAGRAM
KLPSX1:	MOVEI	T2,KLPDRG	;PRIORITY
	SETZ	T3,		;NO FLAGS
	PJRST	DRVSND		;SEND PACKET AND RETURN

;START PACKET LENGTH TABLE

STRLEN:	SR.LEN			;(PPD = 0) START LENGTH
	SR.LEN			;(PPD = 1) STACK LENGTH
	SR.ALN			;(PPD = 2) ACK LENGTH
	0			;(PPD = 3) APPLICATION DATAGRAM
	0			;(PPD = 4) APPLICATION MESSAGE
	0			;(PPD = 5) ERROR PACKET DOESN'T COME HERE
	SR.ALN			;(PPD = 6) SHUTDOWN
;ROUTINE TO SEND A REQUEST-ID DATAGRAM.
;CALL:
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB
;	T3/ PATH BIT
;	PUSHJ	P,KLPRID
;RETURN:
;	CPOPJ ALWAYS

KLPRID:	MOVE	T1,Q3		;GET PCB ADDRESS
	ADD	T1,Q1		; OFFSET FOR THIS NODE
	MOVEI	T2,RIDTIM*3	;CONVERT TIMER LENGTH TO UDT INCREMENTS
	ADD	T2,DATE##	;WHEN TIMER WILL EXPIRE
	MOVEM	T2,.PCRIT(T1)	;SET THE EXPIRATION TIME
	MOVEI	T1,OP.RID	;OPCODE = REQUEST ID
	MOVEI	T2,INCXID	;GET NEW TRANSACTION ID
	ADDB	T2,KLPXID	;...
	MOVEM	T2,.PKXID(Q2)	;STORE IN PACKET
	MOVEM	T2,.PKXID+1(Q2)	; (SAME THING IN BOTH WORDS)
	MOVEI	T2,KLPDRG	;PRIORITY
	PJRST	DRVSND		;SEND THE PACKET AND RETURN


;ROUTINE TO SEND A READ-COUNTERS PACKET.
;CALL:
;	T2/ REASON CODE
;	Q2/ PACKET ADDRESS
;	Q3/ PCB
;	PUSHJ	P,KLPRPT
;RETURN:
;	CPOPJ ALWAYS

KLPRPT:	MOVEM	T2,.PKXID(Q2)	;PUT REASON IN PACKET
	MOVEI	T1,OP.RCT	;OPERATION = READ COUNTERS
	MOVEI	T2,KLPDRG	;PRIORITY
	SETZB	T3,Q1		;NO FLAGS, CLEAR NODE NUMBER
	PJRST	DRVSND		;SEND THE PACKET AND RETURN
;ROUTINE TO SEND A DATAGRAM FOR A DIAGNOSTIC FUNCTION.
;CALL:
;	T1/ OPCODE
;	T3/ FLAGS
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,DIASND
;RETURN:
;	CPOPJ ALWAYS

DIASND:	MOVEI	T4,INCXID	;GET NEW TRANSACTION ID
	ADDB	T4,KLPXID	;...
	MOVEM	T4,.PKXID(Q2)	;SAVE FIRST WORD
	MOVEM	T4,.PKXID+1(Q2)	; AND SECOND WORD
	MOVEI	T2,KLPDRG	;PRIORITY
	PJRST	DRVSND		;FINISH UP VIA DRVSND


;ROUTINE TO SEND A DATAGRAM FROM THE DRIVER.
;CALL:
;	T1/ OPCODE
;	T2/ PRIORITY
;	T3/ FLAGS
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,DRVSND
;RETURN:
;	CPOPJ ALWAYS

DRVSND:	MOVX	T4,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	ANDCAM	T4,.PKVRT(Q2)	;...
	MOVX	T4,PK.DRV	;GET THE DRIVER RESPONSE BIT
	TXNE	T3,PF.RSP	;DOES THE DRIVER WANT THE BUFFER BACK?
	IORM	T4,.PKVRT(Q2)	;YES, SET THE FLAG
	PJRST	KLPSND		;SEND THE PACKET AND RETURN
;ROUTINE TO SEND A MESSAGE/DATAGRAM.
;CALL:
;	T1/ OPCODE
;	T2/ PRIORITY
;	T3/ FLAGS
;	Q1/ NODE NUMBER
;	Q2/ PACKET ADDRESS
;	Q3/ PCB ADDRESS
;	PUSHJ	P,KLPSND
;RETURN:
;	CPOPJ ALWAYS

KLPSND:	MOVEM	T3,.PKSTS(Q2)	;SAVE FLAGS AND INITIALIZE THIS WORD
	DPB	T1,PKYOP	;SAVE OPCODE
	DPB	Q1,PKYNOD	;SAVE NODE NUMBER

	SNOOP	(CISPKX)	;CISNUP SNOOP POINT - PACKET TRANSMITTED
				;Q2/ PACKET ADDRESS
				;Q3/ PCB ADDRESS

	MOVE	T1,T2		;GET PRIORITY (WHICH COMMAND QUEUE)
	CAILE	T1,MAXQUE	;TOO LOW?
	MOVEI	T1,MAXQUE	;YES, REDUCE IT TO LOWEST PRIORITY WE HAVE
	IMULI	T1,.PQLEN	;COMPUTE ADDRESS OF QUEUE
	ADDI	T1,.PCCQB	;OFFSET TO CORRECT QUEUE
	ADD	T1,Q3		;ADD IN PCB ADDRESS
	PUSHJ	P,PUTQUE	;INSERT THE PACKET ON QUEUE
IFN FTMP,<
	MOVE	T1,.PCCPU(Q3)	;GET CPU WHO OWNS PORT
	CAMN	T1,.CPCPN##	;ANOTHER CPU?
	JRST	KLPSN1		;NO, NO BOTHER
	MOVX	T1,ST.CQA	;GET THE BIT
	IORM	T1,.PCSTS(Q3)	;LET OTHER CPU KNOW AT ONCE/TICK LEVEL
	MOVE	T1,.CPQPC##	;GET THIS CPU'S QUEUED I/O FLAG
	IORM	T1,DOORBL##	;SET QUEUED I/O FLAG
	POPJ	P,		;RETURN

KLPSN1:	MOVX	T1,ST.CQA	;CLEAR THE BIT
	ANDCAM	T1,.PCSTS(Q3)	; IN CASE OTHER CPU SET IT
>; END IFN FTMP
	MOVE	T1,.CPUPT##	;GET CPU UPTIME WHEN PACKET QUEUED
	MOVEM	T1,.PCKCT(Q3)	;SAVE FOR KEEP ALIVE FAILURE CHECKS
	MOVE	T1,.PCPIA(Q3)	;GET KLIPA PI ASSIGNMENT
	TRO	T1,CO.CQA+CO.BTS ;COMMAND QUEUE AVAILABLE
	XCT	KDBCNO(Q3)	;KICK THE PORT
	POPJ	P,		;RETURN TO CALLER
;ROUTINE TO GET A BUFFER FROM THE DATAGRAM FREE QUEUE
;CALL:
;	Q3/ PCB
;	PUSHJ	P,KLPGDB
;RETURN:
;	CPOPJ IF NONE AVAILABLE
;	CPOPJ1 IF OK WITH:
;	Q2/ ADDRESS OF BUFFER

KLPGDB:	XMOVEI	T1,.PCDFQ(Q3)	;WHICH QUEUE
	PUSHJ	P,REMQUE	;GET BUFFER
	  POPJ	P,		;EMPTY
	JRST	CPOPJ1##	;SKIP RETURN
	SUBTTL	LINK/DELINK PACKET ROUTINES


;ROUTINE TO LINK PACKETS ONTO A FREE QUEUE.
;CALL:
;	T1/ ADDRESS OF QUEUE
;	Q2/ ADDRESS OF FIRST PACKET
;	PUSHJ	P,LNKQUE
;RETURN:
;	CPOPJ ALWAYS

LNKQUE:	PUSH	P,(Q2)		;SAVE ADDRESS OF NEXT PACKET
	PUSHJ	P,PUTQUE	;STUFF THE PACKET ONTO THE FREE QUEUE
	POP	P,Q2		;GET ADDRESS OF NEXT PACKET BACK
	JUMPN	Q2,LNKQUE	;KEEP LOOPING UNTIL ALL ARE LINKED
	POPJ	P,		;RETURN
	SUBTTL	THREE-WORD QUEUE MANIPULATION ROUTINES


;ROUTINE TO REMOVE FIRST PACKET FROM A QUEUE.
;CALL:
;	T1/ ADDRESS OF QUEUE
;	PUSHJ	P,REMQUE
;RETURN:
;	CPOPJ IF QUEUE WAS EMPTY
;	CPOPJ1 WITH:
;	Q2/ PACKET ADDRESS

REMQUE:	CIOFF			;NO INTERRUPTS
	SETZ	T3,		;INITIALIZE COUNT
REMQU1:	SKIPGE	.PQIWD(T1)	;SKIP IF INTERLOCK NOT AVAILABLE
	AOSE	.PQIWD(T1)	;AVAILABLE, TRY TO GET IT
	AOSA	T3		;NOT AVAILABLE, INCREMENT COUNT AND SKIP
	JRST	REMQU2		;GOT IT
	CAIGE	T3,TIMOUT	;WAITED LONG ENOUGH?
	JRST	REMQU1		;NO, TRY AGAIN
	AOS	BRKCNT		;YES. DO IT ANYWAY. BUMP COUNTER
	BUG.	(INF,KLPRMQ,KLPSER,HARD,<Queue interlock timeout>,,)

REMQU2:	PUSHJ	P,CHKMPT	;IS QUEUE ALREADY EMPTY?
	  JRST	QRET		;EMPTY
	AOS	(P)		;NOT EMPTY. SET FOR SKIP/SKIP2 RETURN
	MOVE	T2,.PQFLI(T1)	;GET 1ST PACKET FROM QUEUE
	PUSHJ	P,CHKPAK	;GET ITS VIRTUAL ADDRESS
	  JRST	REMQU4		;VIRTUAL ADDR DOESN'T MATCH PHYSICAL!
	MOVE	Q2,T2		;VIRTUAL ADDR OF PACKET IN Q2
	DMOVE	T2,.PKFLI(Q2)	;GET FLINK, BLINK OF THIS PACKET
	CAME	T2,T3		;FLINK=BLINK?
	JRST	REMQU3		;NO, QUEUE IS STILL NON-EMPTY
	DMOVEM	T2,.PQFLI(T1)	;YES. QUEUE IS EMPTY. POINT HEADER AT ITSELF
QRET:	SETOM	.PQIWD(T1)	;RELEASE INTERLOCK
	PJRST	CIONPJ##	;INTERRUPTS BACK ON AND RETURN

REMQU3:	MOVEM	T2,.PQFLI(T1)	;POINT QUEUE HEADER AT NEXT PACKET
	ADDI	T2,.PKBLI	;POINT AT FLINK OF NEXT PACKET
	PMOVEM	T3,T2		;POINT NEXT PACKET BACK AT HEADER
	JRST	QRET		;NON-SKIP RETURN

;HERE IF VIRTUAL ADDR IN PACKET ISN'T WHAT IT SHOULD BE

REMQU4:	MOVE	T4,.PQFLI(T1)	;GET THE FLINK WORD
	BUG.	(CHK,KLPVIR,KLPSER,HARD,<Virtual address in packet is wrong>,<<T1,QUEUE>,<T2,VMA>,<T3,PMA>,<T4,FLINK>>,)
	MAP	T2,.PQFLI(T1)	;GET PHYSICAL ADDR OF QUEUE HEADER
	TXZ	T2,MP.NAD	;CLEAR NON-ADDRESS BITS
	MOVEM	T2,.PQFLI(T1)	;RESET QUEUE TO EMPTY
	MOVEM	T2,.PQBLI(T1)	;...
	SOS	(P)		;GIVE EMPTY-QUEUE RETURN
	JRST	QRET		;NON-SKIP RETURN
;ROUTINE TO INSERT A PACKET ONTO A QUEUE.
;CALL:
;	Q2/ ADDRESS OF PACKET
;	T1/ ADDRESS OF QUEUE
;	PUSHJ	P,PUTQUE
;RETURN:
;	CPOPJ ALWAYS

PUTQUE:	CIOFF			;NO INTERRUPTS
	SETZ	T3,		;INITIALIZE COUNT
PUTQU1:	SKIPGE	.PQIWD(T1)	;SKIP IF INTERLOCK NOT AVAILABLE
	AOSE	.PQIWD(T1)	;AVAILABLE, TRY TO GET IT
	AOSA	T3		;NOT AVAILABLE, INCREMENT COUNT AND SKIP
	JRST	PUTQU2		;GOT IT
	CAIGE	T3,TIMOUT	;WAITED LONG ENOUGH?
	JRST	PUTQU1		;NO, TRY AGAIN
	AOS	BRKCNT		;YES. DO IT ANYWAY. BUMP COUNTER
	BUG.	(INF,KLPPTQ,KLPSER,HARD,<Queue interlock timeout>,,)
PUTQU2:	STOR	Q2,PKVRT,(Q2)	;SAVE VIRTUAL ADDR IN PACKET
	MAP	T3,.PKFLI(Q2)	;PHYSICAL ADDR OF PACKET
	TXZ	T3,MP.NAD	;CLEAR NON-ADDRESS BITS
	MAP	T2,.PQFLI(T1)	;PHYSICAL ADDR OF QUEUE HEADER
	TXZ	T2,MP.NAD	;CLEAR NON-ADDRESS BITS
	CAME	T2,.PQFLI(T1)	;FLINK POINT AT ITSELF (EMPTY QUEUE)?
	JRST	PUTQU3		;NO
	MOVEM	T2,.PKFLI(Q2)	;YES. POINT PACKET BACK AT QUEUE HEADER
	MOVEM	T2,.PKBLI(Q2)
	MOVEM	T3,.PQBLI(T1)	;POINT PCB FLINK AND BLINK AT PACKET
	MOVEM	T3,.PQFLI(T1)
	JRST	QRET

PUTQU3:	MOVEM	T2,.PKFLI(Q2)	;POINT FLINK OF PACKET AT PCB
	MOVE	T2,.PQBLI(T1)	;GET FORMER END OF QUEUE
	MOVEM	T3,.PQBLI(T1)	;POINT QUEUE TAIL AT THIS PACKET
	MOVEM	T2,.PKBLI(Q2)	;POINT BLINK OF THIS PACKET AT FORMER END
	PMOVEM	T3,T2		;POINT BLINK OF FORMER END AT THIS PACKET
	JRST	QRET
;ROUTINE TO CHECK IF A QUEUE IS EMPTY.
;CALL:
;	T1/ ADDRESS OF QUEUE
;	PUSHJ	P,CHKMPT
;RETURN:
;	CPOPJ IF QUEUE IS EMPTY
;	CPOPJ1 IF QUEUE ISN'T EMPTY

CHKMPT:	MAP	T2,.PQFLI(T1)	;GET PHYSICAL ADDRESS OF QUEUE HEADER
	TXZ	T2,MP.NAD	;CLEAR NON-ADDRESS BITS
	CAME	T2,.PQFLI(T1)	;DOES QUEUE POINT AT ITSELF (EMPTY)?
	AOS	(P)		;NO, SET FOR SKIP
	POPJ	P,		;RETURN


;ROUTINE TO RETURN THE VIRTUAL ADDRESS OF A PACKET.
;CALL:
;	T2/ PACKET PHYSICAL ADDRESS
;	PUSHJ	P,CHKPAK
;RETURN:
;	CPOPJ IF PACKET IS BAD (VIRT ADDR IN PACKET DOESN'T MATCH PHYS ADDR)
;	CPOPJ1 IF PACKET OK, WITH:
;	T2/ PACKET VIRTUAL ADDRESS
;THIS ROUTINE MUST PRESERVE T1.

CHKPAK:	SAVEAC	(Q1)		;SAVE Q1
	MOVE	Q1,T2		;COPY PHYSICAL ADDRESS
	ADDI	T2,.PKVRT	;POINT AT VIRTUAL ADDRESS WORD WITHIN PACKET
	PMOVE	T2,T2		;FETCH THE CONTENTS
	TXZ	T2,PK.SRB	;CLEAR ALL SOFTWARE RESPONSE BITS
	MAP	T3,(T2)		;COMPUTE PHYSICAL ADDRESS OF THAT VIRTUAL ADDRESS
	TXZ	T3,MP.NAD	;CLEAR NON-ADDRESS BITS
	CAMN	T3,Q1		;PHYSICAL ADDRESS MATCH?
	AOS	(P)		;YES, SET FOR SKIP RETURN
	POPJ	P,		;RETURN TO CALLER
	SUBTTL	MISCELLANEOUS ROUTINES


;ROUTINE TO REVERSE THE FULL WORD IN T1, PRESERVING OTHER AC'S.
;CALL:
;	T1/ WORD TO REVERSE
;	PUSHJ	P,REVFUL
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T1/ WORD REVERSED
;PRESERVES OTHER AC'S

	$CSUB

SRVFUL::!			;ANOTHER NAME FOR THIS ROUTINE
REVFUL::PUSHJ	P,SAVE3##	;SAVE P1-P3
	LDB	P1,PBYTE1	;PICK UP THE BYTES
	LDB	P2,PBYTE2	;...
	LDB	P3,PBYTE3	;...
	LSH	T1,^D24		;POSITION LEFT OVER BYTE
	DPB	P3,PBYTE2	;PUT THEM IN BACKWARDS
	DPB	P2,PBYTE3	;...
	DPB	P1,PBYTE4	;...
	POPJ	P,		;RETURN


;BYTE POINTERS USED BY REVFUL

PBYTE1:	POINT	8,T1,7
PBYTE3:	POINT	8,T1,23
PBYTE2:	POINT	8,T1,15
PBYTE4:	POINT	8,T1,31

	$XHIGH
;ROUTINE TO ACCOUNT FOR PPD BYTE WHICH PORT WILL ADD.
;WE MUST SWAP THE BYTES INTO ELEVEN FORMAT AND ACCOUNT
;FOR THE PPD FIELD IN THE TEXT LENGTH.
;CALL:
;	Q2/ PACKET ADDRESS
;	PUSHJ	P,MASAGE
;RETURN:
;	CPOPJ ALWAYS WITH:
;	Q2/ PACKET ADDRESS

MASAGE:	MOVEI	T1,C%PPDL	;GET # OF BYTES IN PPD FIELD
	ADDM	T1,.PKLEN(Q2)	;ACCOUNT FOR THE PPD BYTE
	LDB	T1,PKYPPM	;GET THE MOST SIGNIFICANT BYTE OF THE PPD
	LDB	T2,PKYPPL	; AND THE LEAST SIGNIFICANT
	DPB	T2,PKYPPM	;SWAP THE TWO BYTES
	DPB	T1,PKYPPL	; INTO THE CORRECT FORMAT
	POPJ	P,		;RETURN


;ROUTINE TO SWAP THE BYTES IN THE PPD FIELD OF A PACKET WHICH HAS COME
;OFF THE BUS.  WE CAN ALWAYS ASSUME THE PPD BYTE IS IN ELEVEN FORMAT
;SINCE THE HSC SENDS IT THAT WAY AND OUR PORT SWAPS IT THAT WAY ON A
;SEND OPERATION.
;CALL:
;	Q2/ PACKET ADDRESS
;	PUSHJ	P,RMASAG
;RETURN:
;	CPOPJ ALWAYS WITH:
;	Q2/ PACKET ADDRESS

RMASAG:	LDB	T1,PKYOP	;GET THE OPCODE
	TRZ	T1,OP.RMT	;MAKE SURE THE REMOTE BIT IS OFF
	CAIE	T1,OP.SMS	;IS THIS A MESSAGE?
	CAIN	T1,OP.SDG	; OR A DATAGRAM?
	SKIPA	T1,[-C%PPDL]	;YES, GET NEGATIVE LENGTH OF PPD FIELD AND SKIP
	POPJ	P,		;NOT A MESSAGE OR DATAGRAM, RETURN
	ADDM	T1,.PKLEN(Q2)	;ACCOUNT FOR THE PPD FIELD LENGTH
	LDB	T1,PKYPPM	;GET MOST SIGNIFICANT BYTE OF THE PPD FIELD
	LDB	T2,PKYPPL	; AND THE LEAST SIGNIFICANT
	DPB	T2,PKYPPM	;SWAP THE TWO BYTES
	DPB	T1,PKYPPL	; INTO TEN FORMAT
	POPJ	P,		;RETURN
;ROUTINE TO GET THE NEXT COMMAND REFERENCE NUMBER.
;CALL:
;	PUSHJ	P,PPDGCN
;RETURN:
;	CPOPJ ALWAYS WITH:
;	T4/ COMMAND REFERENCE NUMBER
;PRESERVES ALL OTHER AC'S.

	$CSUB

PPDGCN::AOS	T4,CRFNUM	;BUMP COMMAND REFERENCE NUMBER
	ANDI	T4,37777	;KEEP JUST 14 BITS WORTH
	JUMPE	T4,PPDGCN	;DON'T ALLOW COMMAND REFERENCE NUMBER OF ZERO
	LSH	T4,4		;POSITION FOR SCA LAND
	POPJ	P,		;RETURN

	$XHIGH
	SUBTTL	MEMORY ALLOCATION ROUTINE


;ROUTINE TO ALLOCATE NON-ZERO SECTION MEMORY FOR SCA DATA STRUCTURES.
;CALL:
;	T2/ NUMBER OF WORDS DESIRED
;	PUSHJ	P,GETCOR
;RETURN:
;	CPOPJ IF NOT AVAILABLE
;	CPOPJ1 IF SUCCESS WITH:
;	T1/ ADDRESS OF CHUNK ALLOCATED

GETCOR:	PUSHJ	P,SAVE3##	;SAVE XBLT ACS
	MOVEI	P1,-1(T2)	;SAVE COUNT MINUS ONE
	PUSHJ	P,GETSWS##	;GET THE SPACE
	  POPJ	P,		;SORRY
	MOVE	P2,T1		;START OF CHUNK
	XMOVEI	P3,1(P2)	;SECOND WORD OF CHUNK
	SETZM	(P2)		;ZERO FIRST WORD
	EXTEND	P1,[XBLT]	;AND THE REMAINDER
	JRST	CPOPJ1##	;SKIP RETURN
;SUBROUTINE LIKE ONCMAP BUT ALWAYS CREATES PAGES WRITABLE AND NON-CACHED
;(FOR INTERFACING TO TOPS-20 CODE).
;CALL:
;	T1/ NUMBER OF PAGES
;	PUSHJ	P,PGRSKD
;RETURN:
;	CPOPJ IF NOT ENOUGH FREE PAGES
;	CPOPJ1 WITH:
;	T1/ ADDRESS OF THE FIRST PAGE ALLOCATED

	$CSENT	(PGRSKD::)
	MOVE	T2,T1		;COPY NUMBER OF PAGES REQUESTED
	LSH	T2,P2WLSH	;CONVERT TO WORDS
	PUSH	P,T2		;SAVE A BIT
	MOVEI	T1,(MS.SCA)	;SECTION NUMBER
				;*** FLAG TO INDICATE ALLOCATE ON A PAGE BOUNDARY?
	PUSHJ	P,GFWNZN##	;ALLOCATE THE SPACE
	  HALT	.		;*** FOR NOW

;LINK THE PAGES TOGETHER VIA THE FIRST WORD OF THE PAGE.
;THE LINK WORD OF THE LAST PAGE IS ZERO.

	POP	P,T2		;NUMBER OF WORDS REQUESTED
	LSH	T2,W2PLSH	;CONVERT TO THE NUMBER OF PAGES
	PUSH	P,T1		;SAVE STARTING ADDRESS
PGRSK1:	SETZM	(T1)		;ZERO LINK TO NEXT PAGE
	PUSH	P,T2		;SAVE COUNT
	MOVEI	T2,PG.BDY	;NUMBER OF WORDS TO ZERO
	MOVE	T3,T1		;FIRST WORD TO COPY
	XMOVEI	T4,1(T1)	;DESTINATION
	EXTEND	T2,[XBLT]	;ZERO THE PAGE
	POP	P,T2		;RESTORE COUNT
	SOJLE	T2,TPOPJ1##	;JUMP WHEN DONE
	XMOVEI	T3,PAGSIZ(T1)	;ADDRESS OF NEXT PAGE
	MOVEM	T3,0(T1)	;LINK THAT PAGE TO THIS
	MOVE	T1,T3		;COPY NEXT PAGE ADDRESS
	JRST	PGRSK1		;LOOP FOR REMAINING PAGES

	$XHIGH
	SUBTTL	BYTE POINTERS


;POINTERS APPLICABLE TO ALL TYPES OF PACKETS

PKYSTS:	POINT PKSSTS,.PKSTS(Q2),PKPSTS ;STATUS
PKYSFD:	POINT PKSSTS-1,.PKSTS(Q2),PKPSTS ;STATUS MINUS ERROR BIT
PKYFLG:	POINT PKSFLG,.PKSTS(Q2),PKPFLG ;FLAGS
PKYOP:	POINT PKSOP,.PKSTS(Q2),PKPOP   ;OP CODE
PKYNOD:	POINT PKSNOD,.PKSTS(Q2),PKPNOD ;NODE TO SEND TO

;POINTERS SPECIFIC TO SPECIFIC PACKETS

PKYREG:	POINT PKSREG,.PKREG(Q2),PKPREG ;REGISTER TO READ
PKYDTA:	POINT PKSDTA,.PKREG(Q2),PKPDTA ;DATA FROM REGISTER READ
PKYCND:	POINT PKSCND,.PKPND(Q2),PKPCND ;NODE TO POINT PERFORMANCE COUNTER AT
PKYPST:	POINT PKSPST,.PKPST(Q2),PKPPST ;REMOTE PORT STATE
PKYRST:	POINT PKSRST,.PKPST(Q2),PKPRST	;REMOTE PORT STATE AND MAINTENANCE FIELD
PKYRND:	POINT PKSRND,.PKPST(Q2),PKPRND ;RESETTING NODE NUMBER

;PPD BYTE POINTERS

PKYPPM:	POINT 8,.PKLEN(Q2),7	       ;MOST SIG BYTE OF PPD FIELD IN 10 FORMAT
PKYPPL:	POINT 8,.PKLEN(Q2),15	       ;LEAST SIG BYTE OF PPD FIELD IN 10 FORMAT
PKYPPD:	POINT PKSPPD,.PKLEN(Q2),PKPPPD ;CI.PPD

;LENGTH BYTE

PKYLEN:	POINT PKSLEN,.PKLEN(Q2),PKPLEN	;LENGTH FOR DATAGRAMS AND MESSAGES
	SUBTTL	LOOPBACK CRC CODES


;THIS TABLE CONTAINS THE CRC CODES NEEDED FOR A LOOPBACK PACKET.
;THE TABLE IS INDEXED BY THE CI NODE NUMBER.

LPBLEN==6			;LENGTH OF LOOPBACK PACKET

LPBCRC:	365137,,27260		;NODE 0
	461317,,343360		;NODE 1
	777542,,171600		;NODE 2
	73762,,215700		;NODE 3
	142070,,514540		;NODE 4
	646250,,670440		;NODE 5
	550405,,442120		;NODE 6
	254625,,726020		;NODE 7
	731224,,250400		;NODE 8
	35004,,134500		;NODE 9
	323651,,306060		;NODE 10
	427471,,62160		;NODE 11
	516363,,763320		;NODE 12
	212143,,407220		;NODE 13
	104716,,635740		;NODE 14
	600536,,551640		;NODE 15
	SUBTTL	IMPURE STORAGE


	$LOW

BHDIPT:	EXP	0		;INITIAL POINTER FOR BHD SEARCHES
BHDCPT:	EXP	0		;CURRENT POINTER FOR BHD SEARCHES
BHDEND:	EXP	0		;LAST ADDRESS IN BUFFER DESCRIPTOR TABLE
BHDADR::EXP	0		;PHYSICAL ADDRESS OF BUFFER DESCRIPTOR TABLE
				; (USED TO SET UP .PCBDT IN THE PCB)
BHDPGS::EXP	0		;NUMBER OF PAGES IN BUFFER DESCRIPTOR TABLE
BHDMTI:	EXP	0		;MAXIMUM BDT INDEX
BHDNUM:	EXP	0		;NUMBER OF BUFFER HEADER DESCRIPTORS

BSDVRT:	EXP	0		;VIRTUAL ADDRESS OF START OF BSD AREA
BSDADR::EXP	0		;PHYSICAL ADDRESS OF START OF BSD AREA
BSDLOC:	EXP	0		;POINTER TO FREE BSD CHAIN
BSDPGS::EXP	0		;NUMBER OF PAGES FOR BUFFER SEGMENT DESCRIPTORS
BSDNUM:	EXP	0		;NUMBER OF BUFFER SEGMENT DESCRIPTORS

BRKCNT:	EXP	0		;NUMBER OF TIMES A PCB INTERLOCK WAS BROKEN

KLPXID:	EXP	0		;TRANSACTION ID COUNTER

CRFNUM:	EXP	0		;COMMAND REFERENCE NUMBER

	$XHIGH
	SUBTTL	THE END


KLPFOO:	BUG.	(HLT,KLPOHF,KLPSER,SOFT,<Oh foo!>,,)

KLPEND::!END