Google
 

Trailing-Edge - PDP-10 Archives - bb-x130a-sb - dcnspy.mac
There are 11 other files named dcnspy.mac in the archive. Click here to see a list.
	TITLE DCNSPY - Spy on DECnet-36

	SEARCH D36PAR,SCNMAC,S,UUOSYM,DPYDEF,NETPRM,MACSYM

DEFINE RETSKP,<JRST CPOPJ1>	;OVERRIDE UNIVERSAL'S DEFN

	.REQUEST REL:SCAN
	.REQUEST REL:HELPER
	.REQUEST DSK:DPY	;GET THE DPY PACKAGE

	.TEXT	"/LOCALS/SYMSEG:HIGH"

	SALL

	PRGID='DCNSPY'		;NAME OF THIS PROGRAM
	PRGABR='SPY'		;3 CHR ABBREVIATION USED FOR PROG.

	SPYWHO==0
	SPYVER==1		;MAJOR VERSION
	SPYMIN==0		;MINOR VERSION
	SPYEDT==2		;EDIT NUMBER

;This program uses SPY pages.

	$RELOC
	$HIGH
	SUBTTL External Definitions

	EXTERN .ISCAN		;INITIALIZE THE WHOLE SCAN ROUTINE
	EXTERN .OSCAN		;READ SWITCH.INI
	EXTERN .PSCAN		;PARTIAL SCAN INITIALIZER

	EXTERN .TSPAC		;TYPE A SPACE
	EXTERN .TTABC		;TYPE A TAB CHARACTER
	EXTERN .TCOMA		;TYPE OUT A COMMA
	EXTERN .TCRLF		;TYPE A CRLF
	EXTERN .TSTRG		;TYPE A STRING FROM T1
	EXTERN .TOCTW		;TYPE NUMBER IN T1 IN OCTAL
	EXTERN .TDECW		;TYPE NUMBER IN T1 IN DECIMAL
	EXTERN .TSIXN		;TYPE VALUE IN T1 IN SIXBIT
	EXTERN .TCOLN		;TYPE A COLON
	EXTERN .TRBRK		;TYPE A RIGHT BRACKET
	EXTERN .TPPNW		;TYPE T1 AS A PPN
	EXTERN .TXWDW		;TYPE T1 AS HALF-WORDS
	EXTERN .TCHAR		;TYPE CHARACTER IN T1
	EXTERN .TTIME		;TYPE T1 AS A MILLISECOND TIME

	EXTERN .DECNW		;READ IN A DECIMAL NUMBER
	EXTERN .SWDEC		;READ IN A DECIMAL SWITCH ARG
	SUBTTL Build the SCAN switch tables

; See SCNMAC.MAC for definition of macros used here.

;Define the defaults for switches:
;	First arg is 3-chr abbrieviation used for this switch.
;	Second arg is maximum allowed value.
;	Third arg is absent default (AD.xxx)
;		(not used by SCAN, for application use only).
;	Fourth arg is present default (PD.xxx)
;		(used by SCAN unless FS.VRQ specified)

	RADIX	10

;	Name	Max	Absent	Present
;	xxx	MX.xxx	AD.xxx	PD.xxx
;	----	------	------	-------

DM	DPY,	1,	1,	1	;/DPY
DM	COM,	1,	0,	1	;/COM
DM	JOB,	1024,	0,	0	;/JOB
DM	CHN,	1024,	1,	1	;/CHANNEL
DM	DLY,	1024,	5,	5	;/DELAY (SECONDS)
DM	PAG,	512,	10,	15	;/PAGE
DM	SJP,	0,	0,	0	;/SJBPTR:addr (FS.LRG)

	RADIX	8

	LALL

;Remember to update HELP string at HLPSTR

DEFINE	SWTCHS,<
	XLIST
SN	DPY,SCNDPY,FS.NCM!FS.NFS
SP	PAGE,SCNPAG,.SWDEC,PAG,FS.NFS!FS.NCM!FS.VRQ
SP	*JOB,SCNJOB,.SWDEC,JOB,FS.NFS!FS.NCM!FS.VRQ
SP	*CHANNEL,SCNCHN,.SWDEC,CHN,FS.NFS!FS.NCM!FS.VRQ
SN	COMMENT,SCNCOM,FS.NCM!FS.NFS
SP	DELAY,SCNDLY,.SWDEC,DLY,FS.NFS!FS.NCM!FS.VRQ
SP	*NRTSJB,0,SPYNRT
SP	*SJB,0,SPYSJB
SP	*SLB,0,SPYSLB
SP	*ELB,0,SPYELB
SP	*RCB,0,SPYRCB
SP	SJBPTR,SCNSJP,.SWOCT##,SJP,FS.NFS!FS.NCM!FS.VRQ!FS.LRG
SP	KDP,0,SPYKDP
SP	CIRCUIT,,.SWCKT,,FS.NFS!FS.NCM!FS.VRQ
SP	DAYTIME,0,SPYTIM
	LIST
>;END OF SWTCHS
;Now build the tables.

	DOSCAN (SWT)
	SUBTTL HLPSTR -- The HELP string

HLPSTR:	ASCIZ ~

DCNSPY uses verb-mode SCAN.  The commands are:

JOB n		Job number to spy on, no default
		Ignored if SJBPTR is non-zero, see below.
CHANNEL	n	DECnet channel number for that job, default 1
CIRCUIT ckt-id	Set ckt-id for examining circuit blocks.
		(Circuit-ids are of the form DEV-CNT-UNT, ex. DTE-0-1)
[NO]COMMENT	Type out comments for each field displayed
[NO]DPY		Use DPY mode
PAGE		Length by which DPY mode + and - commands shift page
DELAY		Seconds to sleep in DPY mode
SJBPTR n	Address of SJB to use.
		While SJBPTR is non-zero, Job is ignored.

SJB		Action command, type out SCTL's SJB
NRTSJB		Action command, type out NRTSER's SJB
SLB		Action command, type out SCTL's SLB
ELB		Action command, type out NSP's ELB
RCB		Action command, type out RTR's RCB for given circuit-id
KDP		Action command, type out KMC/DUP data base
DAYTIME		Action command, type out current time

In DPY mode, the immediate commands are:

escape		Escape to command mode
^Z		Escape to monitor mode, CONTINUE to return
^C		Escape to monitor mode, CONTINUE to return
R		Refresh the screen
space		Recalculate the screen now
+		Move window forward by PAGE lines
-		Move window backward by PAGE lines
~
	SUBTTL Accumulator Assignments

;Must be after DOSCAN call, for SL is redefined herein

	T1=1
	T2=2
	T3=3
	T4=4

	P1=5
	P2=6

	NUM=7			;NUMBER TO PRINT FOR "OUTNUM"
	N=7			;SCAN CALLS IT THIS
	BAS=10			;BASE FOR "OUTNUM" TO PRINT NUMBER IN
	C=10			;AGAIN FOR SCAN
	WDT=11			;WIDTH OF FIELD FOR OUTNUM. ZERO = ANY,
				;  MINUS MEANS LEFT JUSTIFY.
	FIL=12			;CHAR TO USE FOR FILLER.

;The following ACs are redefined for each display processor's use

	KDL=13			;POINTER TO THE "KDL PAGE" (ALA NETPRM)

	SJ=13			;POINTER TO SCTL JOB BLOCK IN SPY PAGE
	EL=14			;POINTER TO NSP PORT BLOCK IN SPY PAGE
	SL=15			;POINTER TO SCTL LINK BLOCK IN SPY PAGE
	RC=15			;POINTER TO ROUTER'S CIRCUIT BLOCK

;End of redefined ACs

	CX=16			;SUPER-TEMP FOR MACROS
	.SAC==CX		;SOME MACROS USE THIS NAME

	P=17


	OPDEF CALL [PUSHJ P,]
	OPDEF RET  [POPJ  P,]

DEFINE USRSAV,<>		;DON'T LET SAVEAC GET CARRIED AWAY

	$TTY==2			;TTY'S I/O CHANNEL
	TYOBSZ==400		;TTY'S OUTPUT BUFFER SIZE
	subttl macros

	$sp==40			;a space
	$zr==60			;a zero

define text(string)< str$ [asciz |string|] >

define crlf<
	chi$ ^o15		;;cr
	chi$ ^o12		;;lf
>

define number(qnum,qbas,qwid,qfil)<
    ifnb <qnum>,<move num,qnum>	;;use number only if specified
    ifb  <qbas>,<movei bas,10>	;;default base to 10 (decimal)
    ifnb <qbas>,<movei bas,qbas>
    ifb  <qwid>,<movei wdt,0>	;;default width to "any"
    ifnb <qwid>,<movei wdt,qwid>
    ifb  <qfil>,<movei fil,$sp>	;;default filler to "spaces"
    ifnb <qfil>,<movei fil,qfil>
	pushj p,outnum		;;call outnum with args set up
>

define goto(pos)<		;;go to line position "pos"
	movei	t1,pos-1	;;get position to "go to" (1 origined)
	pushj	p,pgoto		;;call "goto" routine to get there
>

define err(text),<
	jrst	[movei	t1,[asciz |text
|]
		 jrst	errstr]
>
	SUBTTL Storage Definitions

;Compile in the storage locations each DECnet-36 will be mapped
;through.

DEFINE ALCPAG(nam),<
	nam'PAG==...PAG		;;ALLOCATE NEXT PAGE AS FIRST OF TWO
	nam'ADR==...PAG * 1000	;;MAKE A SYMBOL FOR ADDRESS TOO
	nam'PG1==...PAG+1
	...PAG==...PAG+2
>;END OF ALCPAG

	...PAG==340		;START ALLOCATING SPY PAGES HERE

	ALCPAG PDB		;TOPS-10 PDB
	ALCPAG SJB		;SCTL JOB BLOCK
	ALCPAG SLB		;SCTL LINK BLOCK
	ALCPAG ELB		;NSP LINK BLOCK
	ALCPAG TMP		;USE THIS PAIR FOR TEMP MAPPING

IFG <...PAG-400>,<PRINTX ?PAGE NUMBER OVERFLOW
		PASS2>
	SUBTTL General Storage

	$LOW

	LN$PDL==100
PDL:	BLOCK	LN$PDL+1

TTYOBF:	BLOCK	3		;TTY OUTPUT BUFFER CONTROL BLOCK
OBF1:	BLOCK	TYOBSZ+3	;TTY OUTPUT BUFFER

CCLF1:	BLOCK 1			;NON-ZERO IF CCL STARTED

KDLPAG:	BLOCK	KDLEST+1	;LONG ENOUGH TO HOLD KDP STATUS

SPYFCN:	EXP 0			;PUT FUNCTION ADDRESS HERE FOR SPYGO
TYPDPY:	EXP 0			;NON-ZERO TO TYPE IN DPY MODE
BIGOUT:	BLOCK 1			;NON-ZERO TO USE TTY OUTPUT BUFFERS

LINGOL:	EXP 0			;USED BY SPYINT'S + AND - COMMANDS
LINCNT:	EXP 0			; DITTO

CKTID: EXP 0			;PLACE TO STORE CIRCUIT ID
NRTSJB:	EXP 0			;POINTER TO NRTSER'S SJB

	;SCAN storage

BEGSCN:!			;START OF REGION TO BE SET TO -1
SCNCHN:	BLOCK 1			;ZERO-RELATIVE CHANNEL NUMBER WE'RE TO SPY ON
SCNJOB:	BLOCK 1			;JOB NUMBER WE'RE TO SPY ON
SCNDPY:	BLOCK 1			;NON-ZERO TO GO INTO DPY MODE
SCNPAG:	BLOCK 1			;SIZE OF A PAGE, FOR "+" SCROLLING
SCNDLY:	BLOCK 1			;DEFAULT DPY TIMER
SCNCOM:	BLOCK 1			;TYPE OUT COMMENTS IF NON-ZERO
SCNSJP:	BLOCK 1			;POINTER TO SJP WE'RE TO EXAMINE
ENDSCN==.-1			;END OF REGION TO BE SET TO -1

	$HIGH
	SUBTTL Block Description Tables -- SJB

;Session Control Job Block

DEFINE SJBMAC,<
ENTRY. SJ,NXT,(SJ),.TXWDW,TAB,1, <NEXT JOB BLOCK IN SYSTEM>
ENTRY. SJ,CHT,(SJ),.TXWDW,TAB,1, <PTR TO SLB TABLE (INDEXED BY CHANNEL)>
ENTRY. SJ,CHC,(SJ),.TDECD,CRLF,1,<COUNT OF SPACES ALLOCATED IN SLB TABLE>
ENTRY. SJ,PSJ,(SJ),.TXWDW,TAB,1, <POINTER TO SYSTEM'S POINTER TO THE SJB>
ENTRY. SJ,PRV,(SJ),.TBOOL,TAB,1, <USER IS PRVJ PRIVILEGED>
ENTRY. SJ,RST,(SJ),.TBOOL,CRLF,1,<RESET IN PROGRESS>
ENTRY. SJ,JOB,(SJ),.TDECD,TAB,1, <JOB NUMBER>
ENTRY. SJ,CTA,(SJ),.TDECD,TAB,1, <NUMBER OF CI TIMERS ACTIVE FOR JOB>
ENTRY. SJ,TXQ,(SJ),.TQUE ,CRLF,1,<TRANSACTION QUEUE OF NSPSER CALLS>
ENTRY. SJ,PSQ,(SJ),.TQUE ,TAB,1, <QUEUE OF SLBs WITH PSIs OUTSTANDING>
ENTRY. SJ,GOL,(SJ),.TDECD,TAB,1, <INPUT DATA REQUEST GOAL>
ENTRY. SJ,INQ,(SJ),.TDECD,CRLF,1,<JOB INPUT QUOTA>
ENTRY. SJ,OTQ,(SJ),.TDECD,TAB,1, <JOB OUTPUT QUOTA>
ENTRY. SJ,INU,(SJ),.TDECD,TAB,1, <BUFFERS USED TOWARD INPUT JOB QUOTA>
ENTRY. SJ,OTU,(SJ),.TDECD,CRLF,1,<BUFFERS USED TOWARD OUTPUT JOB QUOTA>
ENTRY. SJ,SAB,(SJ),.TXWDW,TAB,1, <SA BLOCK POINTER>
ENTRY. SJ,MUU,(SJ),.TXWDW,CRLF,2,<SAVE MUUO WORD HERE FOR STOTAC, ETC>
>;END OF SJBMAC
DEFINE SLBMAC,<
ENTRY. SL,NXP,(SL),.TXWDW,TAB,1, <POINTER TO NEXT SL WITH ACTIVE PSI>
ENTRY. SL,JFQ,(SL),.TXWDW,TAB,1, <POINTER TO NEXT SL REQUESTING JIFFY SERVICE>
ENTRY. SL,SLB,(SL),.TXWDW,CRLF,1,<POINTER TO OURSELVES>
ENTRY. SL,SJB,(SL),.TXWDW,TAB,0, <POINTER TO JOB BLOCK>
ENTRY. SL,CHN,(SL),.TDECD,TAB,1, <CHANNEL NUMBER>
ENTRY. SL,PSI,(SL),.TBOOL,CRLF,1,<PSI PENDING FLAG>
ENTRY. SL,PH2,(SL),.TBOOL,TAB,1, <PHASE II HAS NO RESEND CAPABILITY>
ENTRY. SL,ABO,(SL),.TBOOL,TAB,1, <CLOSE PORT AFTER ABORT & RELEASE>
ENTRY. SL,FSL,(SL),.TBOOL,CRLF,1,<FREE SLB WHEN DONE WITH ALL PROCESSING>
ENTRY. SL,BSY,(SL),.TBOOL,TAB,1, <SLB IS BUSY (CANNOT BE FREED)>
ENTRY. SL,LBC,(SL),.TBOOL,TAB,1, <LINK IS BEING CLOSED BY NSP>
ENTRY. SL,JFR,(SL),.TBOOL,CRLF,1,<JIFFY SERVICE REQUESTED FLAG>
ENTRY. SL,STA,(SL),.TSTAS,TAB,1, <SESSION CONTROL STATE>
ENTRY. SL,XFL,(SL),.TOCTW,TAB,1, <TRANSMIT FLOW CONTROL OPTION>
ENTRY. SL,RFL,(SL),.TOCTW,CRLF,1,<RECEIVE FLOW CONTROL OPTION>
ENTRY. SL,GOL,(SL),.TDECD,TAB,1, <RECEIVE DATA REQUEST GOAL>
ENTRY. SL,SST,(SL),.TOCTW,TAB,1, <LINK STATUS WORD>
ENTRY. SL,PSM,(SL),.TOCTW,CRLF,1,<THE PSI MASK>
ENTRY. SL,INQ,(SL),.TDECD,TAB,1, <INPUT QUOTA FOR LINK>
ENTRY. SL,OTQ,(SL),.TDECD,TAB,1, <OUTPUT QUOTA FOR LINK>
ENTRY. SL,INU,(SL),.TDECD,CRLF,1,<INPUT BUFFERS IN USE>
ENTRY. SL,OTU,(SL),.TDECD,TAB,1, <OUTPUT BUFFERS IN USE>
ENTRY. SL,DRR,(SL),.TDECD,TAB,1, <NORMAL DATA REQUESTS TO RESEND>
ENTRY. SL,RSN,(SL),.TDECD,CRLF,1,<REASON CODE OF DISCONNECT OR REJECT>
ENTRY. SL,PID,(SL),.TXWDW,TAB,0, <NSPpid OF PORT>
ENTRY. SL,DNA,(SL),.TDECD,TAB,1, <DESTINATION NODE ADDRESS>
ENTRY. SL,SIZ,(SL),.TDECD,CRLF,1,<SEGMENT SIZE IN BYTES>
ENTRY. SL,CBP,(SL),.TXWDW,TAB,1, <POINTER TO PASSIVE CONNECT BLOCK>
ENTRY. SL,CTM,(SL),.TTIME,TAB,0, <CONNECT INITIATE TIMER>
ENTRY. SL,WKA,(SL),.TXWDW,CRLF,1,<ADDRESS OF WAKEUP ROUTINE>
ENTRY. SL,CDM,(SL),.TXWDW,CRLF,2,<POINTER TO DIS/CONNECT MESSAGE BLOCK
>

ENTRY. SS,OTH,+SL.NSL(SL),.TBOOL,TAB,1, <INDICATES THIS IS "NORMAL" SUB-LINK>
ENTRY. SS,XDO,+SL.NSL(SL),.TDECD,TAB,1, <SUBLINK TRANSMIT DRQS OUTSTANDING>
ENTRY. SS,RDO,+SL.NSL(SL),.TDECD,CRLF,1,<SUBLINK RECEIVE DRQS OUTSTANDING>
ENTRY. SS,INQ,+SL.NSL(SL),.TQUE ,TAB,1, <SUBLINK INPUT QUEUE
>

ENTRY. SS,OTH,+SL.OSL(SL),.TBOOL,TAB,1, <INDICATES THIS IS "OTHER" SUB-LINK>
ENTRY. SS,XDO,+SL.OSL(SL),.TDECD,TAB,1, <SUBLINK TRANSMIT DRQS OUTSTANDING>
ENTRY. SS,RDO,+SL.OSL(SL),.TDECD,CRLF,1,<SUBLINK RECEIVE DRQS OUTSTANDING>
ENTRY. SS,INQ,+SL.OSL(SL),.TQUE ,TAB,1, <SUBLINK INPUT QUEUE>
>;END OF SLBMAC
DEFINE ELBMAC,<
ENTRY. EL,CHK,(EL),.TXWDW,CRLF,1,<ADDRESS OF THIS EL, FOR ADDR CHECK>
ENTRY. EL,LLA,(EL),.TOCTW,TAB,1, <LOCAL LINK ADDRESS>
ENTRY. EL,RLA,(EL),.TOCTW,TAB,1, <REMOTE LINK ADDRESS>
ENTRY. EL,NNM,(EL),.TDECD,CRLF,1,<THE REMOTE'S NODE NUMBER>
ENTRY. EL,STA,(EL),.TSTAN,TAB,1, <NSP STATE OF THIS LINK>
ENTRY. EL,APQ,(EL),.TXWDW,TAB,0, <NEXT IN QUEUE OF ALL LINK BLOCKS>
ENTRY. EL,HBQ,(EL),.TXWDW,CRLF,1,<NEXT IN QUEUE OF LINKS IN A HASH BUCKET>
ENTRY. EL,JFQ,(EL),.TXWDW,TAB,1, <NEXT IN QUEUE OF LINKS NEEDING JIFFY SERVICE>
ENTRY. EL,SNC,(EL),.TBOOL,TAB,1, <SET IF NOT YET TOLD SC ABOUT NO CONF>
ENTRY. EL,CNF,(EL),.TBOOL,CRLF,1,<SET IF WE HAVE CONFIDENCE IN LINK>
ENTRY. EL,SCM,(EL),.TBOOL,TAB,1, <SEND CONNECT MESSAGE NEXT JIFFY>
ENTRY. EL,ABO,(EL),.TBOOL,TAB,1, <ABORTING THIS LOGICAL LINK>
ENTRY. EL,OJQ,(EL),.TBOOL,CRLF,1,<LINK IS ON THE JIFFY-REQUEST QUEUE>
ENTRY. EL,VER,(EL),.TDECD,TAB,1, <VERSION OF REMOTE NSP, SEE VER3.1,VER3.2>
ENTRY. EL,SIZ,(EL),.TDECD,TAB,1, <MAX SIZE OF A SEGMENT ON THIS LINK>
ENTRY. EL,ORC,(EL),.TDECD,CRLF,1,<COUNT OF MSGS OUT IN ROUTER>
ENTRY. EL,DSG,(EL),.TXWDW,TAB,1, <MSG SEGMENT BEING TIMED FOR DELAY CALC>
ENTRY. EL,DTM,(EL),.TTIME,TAB,0, < AND TIME IT WAS FIRST SENT>
ENTRY. EL,NDB,(EL),.TXWDW,CRLF,1,<PTR TO NSP NODE BLOCK>
ENTRY. EL,TMA,(EL),.TTIME,TAB,0, <INACTIVITY TIMER>
ENTRY. EL,SCV,(EL),.TXWDW,TAB,0, <SESSION CONTROL CALL VECTOR BASE ADDRESS>
ENTRY. EL,SCB,(EL),.TXWDW,CRLF,1,<SESSION CONTROL BLOCK ID>
ENTRY. EL,DIM,(EL),.TXWDW,CRLF,2,<PTR TO DI MESSAGE
>

ENTRY. ES,OTH,+EL.NSL(EL),.TBOOL,TAB,1, <FALSE SINCE THIS IS THE "NORMAL" SUBLINK>
ENTRY. ES,ACK,+EL.NSL(EL),.TBOOL,TAB,1, <SEND ACK FOR THIS SUBLINK NEXT JIFFY>
ENTRY. ES,ROF,+EL.NSL(EL),.TBOOL,CRLF,1,<RECEIVE IS OFF>
ENTRY. ES,ROC,+EL.NSL(EL),.TBOOL,TAB,1, <RECEIVE OFF HAS CHANGED>
ENTRY. ES,XOF,+EL.NSL(EL),.TBOOL,TAB,1, <XMIT IS OFF>
ENTRY. ES,BFR,+EL.NSL(EL),.TBOOL,CRLF,1,<REMOTE IS "BUFFER-RICH" ON THIS LINK>
ENTRY. ES,RFL,+EL.NSL(EL),.TOCTW,TAB,1, <RECEIVE FLOW CONTROL TYPE>
ENTRY. ES,XFL,+EL.NSL(EL),.TOCTW,TAB,1, <XMIT FLOW CONTROL TYPE>
ENTRY. ES,GOL,+EL.NSL(EL),.TDECD,CRLF,1,<DATA REQUEST GOAL>
ENTRY. ES,CGL,+EL.NSL(EL),.TDECD,TAB,1, <AFTER-CONGESTION RECOVERY GOAL>
ENTRY. ES,XLD,+EL.NSL(EL),.TDECD,TAB,1, <XMIT DRQS OUTSTANDING TO LOCAL SC>
ENTRY. ES,XRD,+EL.NSL(EL),.TDECD,CRLF,1,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
ENTRY. ES,XSD,+EL.NSL(EL),.TDECD,TAB,1, <XMIT DRQS NEED TO SEND TO SC>
ENTRY. ES,RLD,+EL.NSL(EL),.TDECD,TAB,1, <RECEIVE DRQS OUTSTANDING TO LOCAL SC>
ENTRY. ES,RRD,+EL.NSL(EL),.TDECD,CRLF,1,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
ENTRY. ES,RSD,+EL.NSL(EL),.TDECD,TAB,1, <RECEIVE DRQS NEED TO SEND TO SC>
ENTRY. ES,LMA,+EL.NSL(EL),.TOCTW,TAB,1, <LAST MESSAGE NUMBER ASSIGNED>
ENTRY. ES,LAR,+EL.NSL(EL),.TOCTW,CRLF,1,<LAST ACK RECEIVED (AND PROCESSED)>
ENTRY. ES,LMR,+EL.NSL(EL),.TOCTW,TAB,1, <LAST MESSAGE RECEIVED>
ENTRY. ES,AKQ,+EL.NSL(EL),.TQUE ,TAB,1, <QUEUE HEADER FOR THE TO-BE-ACKED Q>
ENTRY. ES,RCQ,+EL.NSL(EL),.TQUE ,CRLF,1,<QUEUE HEADER FOR THE RECEIVE Q>
ENTRY. ES,XMQ,+EL.NSL(EL),.TQUE ,CRLF,2,<QUEUE HEADER FOR THE XMIT Q
>

ENTRY. ES,OTH,+EL.OSL(EL),.TBOOL,TAB,1, <TRUE SINCE THIS IS THE "OTHER" SUBLINK>
ENTRY. ES,ACK,+EL.OSL(EL),.TBOOL,TAB,1, <SEND ACK FOR THIS SUBLINK NEXT JIFFY>
ENTRY. ES,ROF,+EL.OSL(EL),.TBOOL,CRLF,1,<RECEIVE IS OFF>
ENTRY. ES,ROC,+EL.OSL(EL),.TBOOL,TAB,1, <RECEIVE OFF HAS CHANGED>
ENTRY. ES,XOF,+EL.OSL(EL),.TBOOL,TAB,1, <XMIT IS OFF>
ENTRY. ES,BFR,+EL.OSL(EL),.TBOOL,CRLF,1,<REMOTE IS "BUFFER-RICH" ON THIS LINK>
ENTRY. ES,RFL,+EL.OSL(EL),.TOCTW,TAB,1, <RECEIVE FLOW CONTROL TYPE>
ENTRY. ES,XFL,+EL.OSL(EL),.TOCTW,TAB,1, <XMIT FLOW CONTROL TYPE>
ENTRY. ES,GOL,+EL.OSL(EL),.TDECD,CRLF,1,<DATA REQUEST GOAL>
ENTRY. ES,CGL,+EL.OSL(EL),.TDECD,TAB,1, <AFTER-CONGESTION RECOVERY GOAL>
ENTRY. ES,XLD,+EL.OSL(EL),.TDECD,TAB,1, <XMIT DRQS OUTSTANDING TO LOCAL SC>
ENTRY. ES,XRD,+EL.OSL(EL),.TDECD,CRLF,1,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
ENTRY. ES,XSD,+EL.OSL(EL),.TDECD,TAB,1, <XMIT DRQS NEED TO SEND TO SC>
ENTRY. ES,RLD,+EL.OSL(EL),.TDECD,TAB,1, <RECEIVE DRQS OUTSTANDING TO LOCAL SC>
ENTRY. ES,RRD,+EL.OSL(EL),.TDECD,CRLF,1,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
ENTRY. ES,RSD,+EL.OSL(EL),.TDECD,TAB,1, <RECEIVE DRQS NEED TO SEND TO SC>
ENTRY. ES,LMA,+EL.OSL(EL),.TOCTW,TAB,1, <LAST MESSAGE NUMBER ASSIGNED>
ENTRY. ES,LAR,+EL.OSL(EL),.TOCTW,CRLF,1,<LAST ACK RECEIVED (AND PROCESSED)>
ENTRY. ES,LMR,+EL.OSL(EL),.TOCTW,TAB,1, <LAST MESSAGE RECEIVED>
ENTRY. ES,AKQ,+EL.OSL(EL),.TQUE ,TAB,1, <QUEUE HEADER FOR THE TO-BE-ACKED Q>
ENTRY. ES,RCQ,+EL.OSL(EL),.TQUE ,CRLF,1,<QUEUE HEADER FOR THE RECEIVE Q>
ENTRY. ES,XMQ,+EL.OSL(EL),.TQUE ,CRLF,2,<QUEUE HEADER FOR THE XMIT Q>
>;END OF ELBMAC
	SUBTTL Block Description Tables -- RCB (Router Circuit Block)

DEFINE RCBMAC,<
ENTRY. RC,LID,(RC),.TCKT,TAB,1, <CIRCUIT ID>
ENTRY. RC,KBA,(RC),.TXWDW,TAB,1, <KONTROLLER LINE BLOCK ADDRESS>
ENTRY. RC,STA,(RC),.TSTAR,CRLF,1,<CIRCUIT STATE>
ENTRY. RC,CST,(RC),.TDECD,TAB,1, <CIRCUIT COST>
ENTRY. RC,NTY,(RC),.TOCTW,TAB,1, <NEIGHBOR'S NODE TYPE>
ENTRY. RC,NAD,(RC),.TDECD,CRLF,1,<NEIGHBOR'S NODE ADDRESS>
ENTRY. RC,SRM,(RC),.TBOOL,TAB,1, <SEND ROUTING MESSAGE FLAG>
ENTRY. RC,VRQ,(RC),.TBOOL,TAB,1, <VERIFICATION REQUIRED FROM NEIGHBOR>
ENTRY. RC,EBU,(RC),.TBOOL,CRLF,1,<EMERGENCY BUFFER IS IN USE>
ENTRY. RC,VER,(RC),.TOCTW,TAB,1, <VERSION OF NEIGHBOR'S ROUTER>
ENTRY. RC,ECO,(RC),.TOCTW,TAB,1, <ECO NUMBER OF NEIGHBOR'S ROUTER>
ENTRY. RC,CUS,(RC),.TOCTW,CRLF,1,<CUSTOMER VERSION OF NEIGHBOR'S ROUTER>
ENTRY. RC,BSZ,(RC),.TDECD,TAB,1, <MAXIMUM BLOCK SIZE>
ENTRY. RC,JSQ,(RC),.TQUE,TAB,1,  <QUEUE HEADER FOR JIFFY RESEND QUEUE>
ENTRY. RC,LRM,(RC),.TXWDW,CRLF,1,<PTR TO LAST ROUTING MESSAGE SENT>
ENTRY. RC,TLR,(RC),.TTIME,TAB,0, <TIME LAST ROUTING MESSAGE WAS SENT>
ENTRY. RC,TLM,(RC),.TTIME,TAB,0, <TIME LAST MESSAGE WAS RCVD ON LINE>
ENTRY. RC,TIN,(RC),.TTIME,CRLF,1,<TIME WE GOT PROTOCOL UP FROM CONTROLLER>
ENTRY. RC,TM3,(RC),.TDECD,TAB,1, <HELLO MESSAGE TIMER>
ENTRY. RC,TM4,(RC),.TDECD,CRLF,2,<NODE LISTENER TIMEOUT TIMER>
ENTRY. RC,CMQ,(RC),.TDECD,TAB,1, <MESSAGES QUEUED>
ENTRY. RC,CLC,(RC),.TDECD,CRLF,2,<LOCAL MESSAGES>
ENTRY. RC,SLZ,(RC),.TTIME,CRLF,1, <(000) SECONDS SINCE LAST ZEROED>
ENTRY. RC,CAP,(RC),.TDECD,TAB,1, <(800) ARRIVING PACKETS RECIEVED (TO NSP)>
ENTRY. RC,CDP,(RC),.TDECD,TAB,1, <(801) DEPARTING PACKETS SENT (FROM NSP)>
ENTRY. RC,CAL,(RC),.TDECD,CRLF,1,<(802) ARRIVING CONGESTION LOSS (TO NSP)>
ENTRY. RC,CTR,(RC),.TDECD,TAB,1, <(810) TRANSIT PACKETS RECIEVED>
ENTRY. RC,CTS,(RC),.TDECD,TAB,1, <(811) TRANSIT PACKETS SENT>
ENTRY. RC,CTL,(RC),.TDECD,CRLF,1,<(812) TRANSIT CONGESTION LOSS>
ENTRY. RC,CCD,(RC),.TDECD,TAB,1, <(820) CIRCUIT DOWN EVENTS>
ENTRY. RC,CIF,(RC),.TDECD,TAB,1, <(821) INITIALIZATION FAILURES>
ENTRY. RC,BYR,(RC),.TDECD,CRLF,1,<(1000) TOTAL BYTES RECEIVED>
ENTRY. RC,BYS,(RC),.TDECD,TAB,1, <(1001) TOTAL BYTES SENT>
ENTRY. RC,DBR,(RC),.TDECD,TAB,1, <(1010) TOTAL DATA BLOCKS RECEIVED>
ENTRY. RC,DBS,(RC),.TDECD,CRLF,1,<(1011) TOTAL DATA BLOCKS SENT>
>
	SUBTTL Expand the Block Description Macros

;The tables set on this page are used by the TYPBLK routine

;Define the offsets into the first-level tables, these offsets
;correspond to the ordering of the ENTRY. calls in the DOBLK macro.

	DO.NAM==0
	DO.PTR==1
	DO.RTN==2
	DO.TXT==3
	DO.STX==4

DEFINE DOBLK1(aa),<
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<EXP <SIXBIT /pfx'name/>>
	Z [aa'MAC](P2)
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<POINTR(pfx'.'name'offset,pfx'name)>
	Z [aa'MAC](P2)
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<EXP routine>
	Z @[aa'MAC](P2)
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<LTXMAC(<ltxt>,count)>
	Z [aa'MAC](P2)
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<STXMAC(<stxt>,count)>
	Z [aa'MAC](P2)
DEFINE ENTRY.(pfx,name,offset,routine,stxt,count,ltxt),<aa'LEN==aa'LEN+1>
	aa'LEN==0
	aa'MAC
>;END OF DEFINE DOBLK1

DEFINE STXMAC(stxt,count),<
IFE count,<[EXP 0]>
IFG count,<EXP stxt'count>
>

DEFINE LTXMAC(ltxt,count),<
IFE count,<[ASCIZ ~ltxt
~]>
IFG count,<[ASCIZ ~	ltxt
~]>
>

SPC1:	BYTE (7) 40,0
SPC2:	BYTE (7) 40,40,0
SPC3:	BYTE (7) 40,40,40,0
TAB1:	BYTE (7) 11,0
TAB2:	BYTE (7) 11,11,0
TAB3:	BYTE (7) 11,11,11,0
CRLF1:	BYTE (7) 15,12,0
CRLF2:	BYTE (7) 15,12,12,0
CRLF3:	BYTE (7) 15,12,12,12,0

DEFINE DOBLK(aa),<
aa'TBL:	DOBLK1(aa)
aa'PTR: XWD -aa'LEN,aa'TBL
>
LALL
	DOBLK SJB
	DOBLK SLB
	DOBLK ELB
	DOBLK RCB
	SUBTTL Start Here

DCNSPY::TDZA T1,T1
	MOVEI T1,1
	MOVEM T1,CCLF1		;SET CCL FLAG FOR SCAN
	OUTSTR [ASCIZ /Type HELP for HELP

/]
	MOVE	T1,[PUSHJ P,DPYUUO##]	;GET CALLING INSTRUCTION
	MOVEM	T1,.JB41		;AND SET UP LUUO DISATCH
	MOVE P,[IOWD LN$PDL,PDL]	;STACK

RESTART:RESET
	MOVE P,[IOWD LN$PDL,PDL]	;STACK

	SETOM	BEGSCN			;SET SCAN SWITCHES TO -1
	MOVE	T1,[BEGSCN,,BEGSCN+1]	;SMEAR THE -1
	BLT	T1,ENDSCN
	CALL	TTYINI			;GET READY FOR TTY OUTPUT

;Fall through to next page
	SUBTTL	Call .ISCAN

;From previous page

;The comment from SCN7B.MAC about call to .ISCAN
;.ISCAN--SUBROUTINE TO INITIALIZE COMMAND SCANNER
;CALL	AC1=XWD LENGTH,BLOCK
;	BLOCK+0=0 OR IOWD PTR TO A LIST OF LEGAL MONITOR COMMANDS
;		IF 0, NO RESCAN IS DONE
;	BLOCK+1=RH 0 OR SIXBIT CCL NAME
;		  IF 0, NO CCL MODE
;		LH 0 OR ADDRESS OF STARTING OFFSET
;	BLOCK+2=RH 0 OR ADDRESS OF CHARACTER TYPEOUT ROUTINE
;		  IF 0, OUTCHR WILL BE DONE FROM T1
;		LH 0 OR ADDRESS OF CHARACTER INPUT ROUTINE
;			MUST SAVE ALL ACS, CHAR IN P4
;	BLOCK+3=0 OR POINTER (XWD LEN,BLOCK) TO INDIRECT FILE BLOCK
;		  A.DEV NE 0 TO USE BLOCK
;	BLOCK+4=RH 0 OR ADDRESS OF MONRET ROUTINE
;		LH 0 OR ADDRESS OF PROMPT ROUTINE
;			CALLED WITH CHAR IN RH(T1), LH(T1) HAS
;			    0 FOR FIRST LINE, -1 FOR CONTINUATION LINES
;	BLOCK+5=LH FLAGS
;		RH (FUTURE)
;VALUE	AC1=INDEX IN TABLE OF COMMANDS IF FOUND(0,1,...), ELSE -1


	MOVE T1,[3,,[ IOWD 2,[EXP PRGID, SIXBIT "SPY"]
		      CCLF1,,PRGABR
		      0,,SCNOUC]]
	CALL .ISCAN##

;Fall through to next page
	SUBTTL	Call .OSCAN


;.OSCAN -- SUBROUTINE TO SCAN OPTIONS FILE (DSK:SWITCH.INI[,])
;	RETURNS CPOPJ AFTER UPDATING GLOBAL SWITCHES FROM FILE
;	THIS ROUTINE SHOULD BE CALLED AFTER TSCAN OR PSCAN
;		BUT BEFORE DEFAULTING.
;	CALL THIS ONLY AT END OF LINE.
;	IT SHOULD BE CALLED BETWEEN ISCAN AND VSCAN FOR VERBS.
;ARGS:	AC1=XWD LENGTH,BLOCK
;	BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES (IOWD XXXXXL,XXXXXN)
;	BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
;		RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
;	BLOCK+2=LH ADDRESS OF (FUTURE)
;		RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
;	BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
;		  IF GT 77, NAME OF PROGRAM IN WHOLE WORD
;		  IF -1 IN WORD, USE JOB TABLE
;		RH LOCATION OF HELP
;	BLOCK+4=NAME OF OPTIONS TO SELECT IN FILE (0 IF NAME OF PROGRAM)
;			OR LENGTH,,LIST OF OPTION NAMES
;IF CALL FROM VSCAN, C(T3)= SAME AS BLOCK+4 ABOVE

	MOVE	T1, [4,,[	IOWD SWTL,SWTN ;SHORT LIST OF SWITCHES
				SWTD,,SWTM
				0,,SWTP
				1,,HLPSTR]]	;HELP STRING

	CALL	.OSCAN##	;OPTION (SWITCH.INI) SCANNER

;Now fill in from internal defaults set up with DM macro

DEFINE DFT,(name),<
	MOVX	T1,AD.'name
	SKIPGE	SCN'name
	  MOVEM	T1,SCN'name
>

	DFT DPY			;/DPY mode
	DFT PAG			;/PAGE length
	DFT DLY			;/DELAY seconds
	DFT COM			;/COMMENTS
	DFT CHN			;/CHANNEL number
	DFT SJP			;/SJBPTR pointer

;Fall through to next page
	SUBTTL Find out what user wants to see

;.VSCAN --SUBROUTINE FOR VERB ARGS FORM OF COMMAND SCANNER
;	RETURNS CPOPJ IF EOF DURING COMMAND OR CCL AT TOP LEVEL
;ARGS	AC1=XWD LENGTH,BLOCK
;	BLOCK+0=IOWD POINTER TO LIST OF SWITCH NAMES
;			(IOWD XXXXXL,XXXXXN)
;	BLOCK+1=LH ADDRESS OF DEFAULT SWITCH TABLE (XXXXXD)
;		RH ADDRESS OF PROCESSOR SWITCH TABLE (XXXXXM)
;	BLOCK+2=LH ADDRESS OF (FUTURE)
;		RH ADDRESS OF SWITCH POINTERS FOR STORING (XXXXXP)
;	BLOCK+3=LH TYPE OF HELP (0=NONE, 1=STRING, 2=SUBROUTINE)
;		  IF GT 77, NAME OF PROGRAM IN WHOLE WORD
;		  IF -1 IN WORD, USE JOB TABLE
;		RH LOCATION OF HELP
;	BLOCK+4=LH LENGTH OF FXXX AND PXXX AREAS
;		RH START OF FXXX (PER FILE SWITCHES)
;	BLOCK+5=LH (FUTURE)
;		RH START OF PXXX (STICKY FORM OF FXXX)
;	BLOCK+6=NAME OF OPTION LINES (0 IF THIS PROGRAM'S NAME)


;From previous page

	MOVE	T1, [4,,[	IOWD SWTL,SWTN ;SHORT LIST OF SWITCHES
				SWTD,,SWTM
				0,,SWTP
				1,,HLPSTR]]	;HELP STRING

	CALL	.VSCAN##	;VERB SCANNER
	JRST	RESTART
	SUBTTL Action Commands

SPYSJB:	MOVEI T1,TYPSJB		;TYPE OUT THE SJB
	CALLRET SPYGO

SPYSLB:	MOVEI T1,TYPSLB		;TYPE OUT THE SLB
	CALLRET SPYGO

SPYELB:	MOVEI T1,TYPELB		;TYPE OUT THE ELB
	CALLRET SPYGO

SPYRCB:	MOVEI T1,TYPRCB		;TYPE OUT ROUTER CIRCUIT BLOCK
	CALLRET SPYGO

SPYKDP:	MOVEI T1,TYPKDP		;TYPE OUT KDPE (FOR DPY DEBUG)
	CALLRET SPYGO

SPYTIM:	MOVEI T1,TYPTIM		;TYPE OUT TIME (FOR DPY DEBUG)
	CALLRET SPYGO

SPYNRT:	MOVX T1,%DNNSJ		;GETTAB TO GET NRT SJP POINTER
	GETTAB T1,		;DO IT
	ERR ?GETTAB for NRT SJB failed
	HRRZS T1

	PEEK T1,		;GET THE VALUE
	SKIPN T1		;DID WE GET SOMETHING?
	ERR ?PEEK UUO failed
	MOVEM T1,NRTSJB		;SAVE THE POINTER TO THE NRTSJB

	SETOM SCNJOB		;NRT INVALIDATED JOB NUMBER
	SETOM SCNSJP		; AND SPB POINTER
	CALLRET SPYSJB		;HANDLE LIKE SJB THING
	SUBTTL SPYGO - Called by Action Commands

;Call:
;	CALL SPYGO
;	Only Return

SPYGO:	MOVEM T1,SPYFCN		;ADDRESS OF OUTPUT ROUTINE
	SKIPLE	SCNDPY		;IN DPY MODE?
	  CALLRET SPYDPY	;YES, GO LOOP FOR A WHILE

;Here for non-DPY mode

	SETZM TYPDPY		;TELL SCNOUC NOT TO USE DPY MODE
	CALL	@SPYFCN		;TYPE OUT THE DATA ONCE
	  JFCL			;IGNORE ERROR RETURN
	RET			;RETURN TO VSCAN


;Here to loop for DPY mode

SPYDPY:	RELEASE	$TTY,		;CLOSE ASCII MODE TTY
	SETZM	LINGOL		;START AT TOP OF LOGICAL SCREEN
	SETOM	TYPDPY		;TELL SCNOUC TO USE DPY MODE
	SETOM	BIGOUT		;USE BUFFERS INSTEAD OF OUTCHRS
	SETZM	TTYOBF+.BFPTR	;PREPARE FOR 8-BIT BYTES AFTER OPEN
	OPEN	$TTY,[.IOPIM	;PACKED IMAGE MODE FOR DPYPAK
		      SIXBIT /TTY/
		      XWD TTYOBF,0]
	  ERR	? OPEN OF TTY FAILED.

	CALL	SPYRFH		;DO THE DPY DISPLAY LOOP

	SKIPE	TYPDPY		;STILL IN DPY MODE?
	  TTY$	$TTCLR		;YES, HOME UP AND CLEAR SCREEN
	CALL	TTYFRC		;FORCE OUT LAST OF PIM MODE DATA
	RELEASE	$TTY,		;CLOSE OFF PACKED IMAGE MODE
	SETZM	TYPDPY		;REFRAIN FROM DPY DISPLAYS NOW
	SETZM	BIGOUT		;NOW USE OUTCHRS INSTEAD OF BUFFERS
	SETZM	TTYOBF+.BFPTR	;PREPARE FOR 7-BIT BYTES AFTER OPEN
	OPEN	$TTY,[.IOASC	;ASCII MODE FOR SCAN
		      SIXBIT /TTY/
		      XWD TTYOBF,0]
	  ERR	? OPEN OF TTY FAILED.
	RET			;RETURN TO VSCAN
	SUBTTL	DPY Driver

SPYRFH:	INI$			;INITIALIZE AND BLANK THE SCREEN
	SET$	[XWD $SECHR,TTYOUC] ;USE OUR CHARACTER OUTPUT ROUTINE
SPYDPL:	SETZM	LINCNT		;TELL SCNOUC WE'RE STARTING ANEW
	CALL	@SPYFCN		;CAUSE SOME TTY OUTPUT
	  RET			;RETURN NOW IF ERROR ENCOUNTERED
	DPY$			;SUCCESS, UPDATE THE SCREEN
	CALL	TTYFRC		;FORCE OUT REMAINDER OF BUFFER
	INCHRS	T1		;USER TRYING TO TELL ME SOMETHING?
	 TRNA			;NO, HIBER FOR A WHILE
	  JRST	SPYINT		;YES, INTERPRET THE COMMAND
	MOVE	T1,SCNDLY	;PICK UP USER'S IDEA OF A GOOD WAIT TIME
	IMULI	T1,^D1000	;MAKE SECONDS INTO MILLISECONDS
	TXO	T1,HB.RTC	;WAKE UP ON CHARACTER TYPED TOO
	HIBER	T1,		;SLEEP FOR SCNDLY MILLISECONDS
	  JFCL			;HIBERS NEVER FAIL, HAHA
	JRST	SPYDPL		;TIME TO GO CHECK THINGS AGAIN


SPYINT:	CAIL	T1,"A"+40	;LOWER CASE?
	 CAILE	T1,"Z"+40	;...
	  CAIA			;NO
	   SUBI	T1,40		;YES, MAKE UPPER CASE
	CAIN	T1,33		;ESCAPE?
	  RET			;BACK TO VSCAN
	CAIN	T1,"R"		;REFRESH?
	  JRST	SPYRFH		;YES
	CAIN	T1," "		;RECALC SCREEN?
	  JRST	SPYDPL		;YES
	CAIE	T1,"C"-100	;CONTROL-C
	 CAIN	T1,"Z"-100	; OR CONTROL Z
	  JRST	[TTY$	1	;HOME UP & CLEAR SCREEN
		 CALL	TTYFRC	;FORCE OUT REST OF TTY BUFFER
		 EXIT	1,	;MONRT
		 GETSTS $TTY,T1	;REPLACE PIM MODE ON TTY
		 TXO T1,.IOPIM
		 SETSTS $TTY,(T1)
		 JRST	SPYRFH]	;REFRESH SCREEN ON CONTINUE
	CAIE	T1,"="		;LOWER CASE VERSION OF "+"
	 CAIN	T1,"+"		;GO TO NEXT PART OF SCREEN
	  JRST	[MOVE T2,SCNPAG
		 ADDM  T2,LINGOL
		 JRST  SPYRFH]
	CAIN	T1,"-"		;GO TO PREVIOUS PAGE
	  JRST	[MOVN T2,SCNPAG
		 ADDB  T2,LINGOL
		 SKIPGE T2
		   SETZM LINGOL	;DON'T LET GOAL GO NEGATIVE
		 JRST  SPYRFH]

	ERR	?Unknown DPY command
	SUBTTL	TYPTIM - Type out current time

;For debugging the DPY driver
;
;Call:
;	CALL TYPTIM		;NO ARGS IN ACS
;	  Error Return to stop DPY loop
;	Normal Return

TYPTIM:	CALL .TTIMN##		;TYPE OUT CURRENT TIME
	CALL .TCRLF##		;CARRIAGE RETURN
	RETSKP			;SUCCESS RETURN
	SUBTTL	TYPSJB - Type out contents of an SJB

;Call:
;	CALL TYPSJB		;NO ARGS IN ACS
;	  Error Return to stop DPY loop
;	Normal Return

TYPSJB:	CALL SETSJB		;SET UP POINTERS TO DECNET BLOCKS
	JUMPE SJ,CPOPJ		;LEAVE IF NO SJB (ERROR ALREADY GIVEN)
	CALL .TCRLF		;CRLF
	SKIPE NRTSJB		;DID WE GET A NRT SJB POINTER?
	JRST [MOVEI T1,[ASCIZ/SJB for NRTSER/]
	      CALL .TSTRG	;YES, OUTPUT A DIFFERENT HEADER
	      JRST TYPSJ1]	; AND MREGE WITH OTHER CODE
	MOVEI T1,[ASCIZ /SJB for job /]
	CALL .TSTRG
	MOVE T1,SCNJOB
	CALL .TDECD		;TYPE IN DECIMAL, WITH DECIMAL POINT
TYPSJ1:	CALL .TCRLF		;CRLF
	CALL .TCRLF		;AND YET ANOTHER

	MOVE T1,SJBPTR		;GET AOBJN POINTER TO SJBTBL
	CALL TYPBLK		;YES, TYPE OUT THE SJB
	  JFCL			;IGNORE ERROR FOR NOW
	RETSKP			;SUCCESS RETURN
	SUBTTL TYPSLB - Type out an SLB

;Call:
;	CALL TYPSLB		;NO ARGS IN ACS
;	  Error Return to stop DPY loop
;	Normal Return

TYPSLB:	CALL SETSJB		;SET UP POINTERS TO DECNET BLOCKS
	JUMPE SJ,CPOPJ		;NO CHANNEL, NO TYPEOUT
	CALL SETSLB		;SETUP POINTER TO SLB
	JUMPE SL,CPOPJ		;NO CHANNEL, NO TYPEOUT

	CALL .TCRLF		;CRLF
	MOVEI T1,[ASCIZ /SLB for channel /]
	CALL .TSTRG
	MOVE T1,SCNCHN
	CALL .TDECD		;TYPE IN DECIMAL, WITH DECIMAL POINT
	CALL .TCRLF		;CRLF
	CALL .TCRLF		;AND YET ANOTHER

	MOVE T1,SLBPTR		;GET AOBJN POINTER TO SLBTBL
	CALL TYPBLK		;TYPE OUT THE SLB
	  JFCL			;IGNORE ERROR FOR NOW
	RETSKP			;SUCCESS RETURN
	SUBTTL TYPELB - Type out the ELB

;Call:
;	CALL TYPELB		;NO ARGS IN ACS
;	  Error Return to stop DPY loop
;	Normal Return

TYPELB:	CALL SETSJB		;SET UP POINTERS TO DECNET BLOCKS
	JUMPE SJ,CPOPJ		;NO SJB, NO ELB FOR TYPEOUT
	CALL SETSLB		;SETUP POINTER TO SLB
	JUMPE SL,CPOPJ		;NO CHANNEL, NO TYPEOUT
	CALL SETELB		;GET PTR TO ELB
	JUMPE EL,CPOPJ		;NO USE IF NO BLOCK

	CALL .TCRLF		;CRLF
	MOVEI T1,[ASCIZ /NSP's ELB for channel /]
	CALL .TSTRG
	MOVE T1,SCNCHN
	CALL .TDECD		;TYPE IN DECIMAL, WITH DECIMAL POINT
	CALL .TCRLF		;CRLF
	CALL .TCRLF		;AND YET ANOTHER

	MOVE T1,ELBPTR		;GET AOBJN POINTER TO ELBTBL
	CALL TYPBLK		;TYPE OUT THE ELB
	  JFCL			;IGNORE ERROR FOR NOW
	RETSKP			;SUCCESS RETURN
	SUBTTL TYPRCB - Type out the Router Circuit Block

;Call:
;	CALL TYPRCB		;NO ARGS IN ACS
;	  Error Return to stop DPY loop
;	Normal Return

TYPRCB:	CALL SETRCB		;GET PTR TO RCB
	JUMPE RC,NORCB		;NO USE IF NO BLOCK

	MOVEI T1,[ASCIZ /Router's circuit block for circuit /]
	CALL .TSTRG
	MOVE T1,CKTID
	CALL .TCKT		;TYPE IN OCTAL
	CALL .TCOLN		;TYPE THE ":"
	CALL .TCRLF		;CRLF
	CALL .TCRLF		;CRLF
	MOVEI T1,[ASCIZ /Current uptime: /]
	CALL .TSTRG
	MOVX T1,%NSUPT		;GET THE CURRENT UPTIME
	GETTAB T1,
	 ERR ?GETTAB failed for uptime
	CALL .TTIME		;OUTPUT THE TIME
	CALL .TCRLF		;AND YET ANOTHER
	CALL .TCRLF		;CRLF

	MOVE T1,RCBPTR		;GET AOBJN POINTER TO RCBTBL
	CALL TYPBLK		;TYPE OUT THE RCB
	  JFCL			;IGNORE ERROR FOR NOW
	RETSKP			;SUCCESS RETURN
	SUBTTL SETSJB - Set up SJB pointers

;Call:
;	CALL SETSJB
;	Normal Return with SJ setup as appropriate
;		           AC is zero if no block to point to

SETSJB:	SETZM	SJ		;ASSUME ALL BLOCKS HAVE ERRORS
	SETZB	SL,EL		;JUST FOR GOOD MEASURE

	SKIPG SCNSJP		;DID USER SPEC A SJB?
	SKIPLE SCNJOB		;OR DID HE SPEC A JOB?
	SETZM NRTSJB		;YES, DON'T USE THE NRT SJB ANY MORE

	SKIPN T1,NRTSJB		;DID WE GET THE NRT COMMAND?
	SKIPLE T1,SCNSJP	;OR DID USER SPECIFY AN SJB POINTER?
	JRST SETSJ1		;YES, USE IT DIRECTLY

	SKIPG	SCNJOB		;ANY JOB SPEC'D?
	  ERR ?Job number must be specified

	HRL T1,SCNJOB		;GET TARGET JOB NUMBER
	HRRI T1,.GTPDB		;GET PTR TO PDB
	GETTAB T1,
	  CALLRET NOPDB

;T1 now holds XWD <number of funny pages>,<PDB address>

	HRRZS T1		;ISOLATE THE PDB ADDRESS
	MOVEI T2,PDBADR		;LOAD UP TARGET PDB ADDRESS
	CALL SPYPAG		;MAP SPY PAGES
	  CALLRET NOSPY		;OOPS
				;T1 NOW HOLDS UVA OF PDB

	HRL T1,SCNJOB		;GET TARGET JOB NUMBER
	HRRI T1,.GTSJB		;GET PTR TO SJB
	GETTAB T1,
	  CALLRET NOPDB

SETSJ1:	JUMPE T1,NOSJB		;ERROR IF SJB PTR IS ZERO
	MOVEI T2,SJBADR		;LOAD UP TARGET SJB ADDRESS
	CALL SPYPAG		;MAP SPY PAGES
	  CALLRET NOSPY		;OOPS
	MOVE SJ,T1		;SJ NOW POINTS TO SJB

;Now tell the user which channels this job has open

	LOAD T1,SJCHT,(SJ)	;GET POINTER TO CHANNEL TABLE
	JUMPE T1,NOCHT
	MOVEI T2,TMPADR		;MAP THE CHANNEL TABLE INTO THE TEMP PAGES
	CALL SPYPAG		;...
	  CALLRET NOSPY		;OOPS
	PUSH P,T1		;T1 NOW HOLDS THE UVA OF OUR CHT ENTRY
	LOAD T2,SJCHC,(SJ)	;GET NUMBER OF CHANNEL SLOTS IN USE AGAIN
	CALL ENMCHN		;ENUMERATE OPEN CHANNELS FOR USER
	POP P,T1
	RET			;DONE
	SUBTTL	SETSLB - Set up Pointer to SLB

;Called after SETSJB
;Call:
;	CALL SETSJB
;	Normal Return with SJ,SL and EL setup as appropriate
;		           AC is zero if no block to point to
;Also types out list of open channels while it has that info

SETSLB:	SETZM SL		;ASSUME NO SLB
	JUMPE SJ,CPOPJ		;NO SLB IF NO SJB

	SKIPG SCNCHN		;USER SPECIFY LEGAL CHN NUMBER?
	CALLRET ILLCHN		;NO, BOO
	LOAD T2,SJCHC,(SJ)	;GET NUMBER OF OPEN CHANNELS
	JUMPLE T2,NOCHN
	CAMGE T2,SCNCHN		;LEGAL CHANNEL NUMBER?
	CALLRET NOCHN		;NO, SAY ITS CLOSED
				;YES, LETS LOOK AT IT
	ADD T1,SCNCHN		;POINT AT OUR SLB POINTER
	SKIPN T1,-1(T1)		;GET POINTER TO SLB FOR THIS CHANNEL
	CALLRET NOCHN		;OOPS, ITS CLOSED
	MOVEI T2,SLBADR		;POINT AT THE UVA I'D LIKE TO MAP IT AT
	CALL SPYPAG		;MAP SLB INTO MY UVA
	  CALLRET NOSPY		;CAN'T
	MOVE SL,T1		;SL NOW POINTS AT INDICATED SLB
	RET			;END
	SUBTTL	SETELB - Set up Pointer to ELB

;Called after SETSLB
;Call:
;	CALL SETSJB
;	Normal Return with SJ,SL and EL setup as appropriate
;		           AC is zero if no block to point to
;Also types out list of open channels while it has that info

SETELB:	SETZM EL		;ASSUME NO ELB
	JUMPE SL,CPOPJ		;NO ELB IF NO SLB

	SKIPN T1,SL.PID(SL)	;GET POINTER TO NSP LINK BLOCK
	CALLRET NOELB		;OOPS, ITS CLOSED
	MOVEI T2,ELBADR		;POINT AT THE UVA I'D LIKE TO MAP IT AT
	CALL SPYPAG		;MAP ELB INTO MY UVA
	  CALLRET NOSPY		;CAN'T
	MOVE EL,T1		;EL NOW POINTS AT INDICATED ELB
	RET			;END
	SUBTTL	SETRCB - Set up Pointer to RCB

;Call:
;	CALL SETRCB
;	Normal Return with RC setup
;		           AC is zero if no block to point to

SETRCB:	SETZM RC		;ASSUME NO RCB
	SKIPG T1,CKTID
	ERR ?Bad Circuit ID

	MOVE P1,T1		;SAVE THE CIRCUIT ID
	MOVX T1,%DNRCH		;GETTAB TO GET RTR QUEUE HEADER
	GETTAB T1,		;GET THE PTR TO HEAD OF CIRCUIT LIST
	ERR ?GETTAB UUO failed
	HRRZS T1

	PEEK T1,		;POINT TO FIRST RCB
	SKIPN T1		;DID UUO FAIL?
	ERR ?PEEK UUO failed

SETRC1:	MOVEI T2,TMPADR
	CALL SPYPAG		;MAP RCB INTO TEMP UVA
	 CALLRET NOSPY		;CAN'T

	CAMN P1,RC.LID(T1)	;DOES IT MATCH THE CIRCUIT-ID GIVEN?
	JRST [MOVE RC,T1	;YES, SET UP RC
	      RET]		; AND RETURN

	SKIPN T1,RC.NXT(T1)	;LOOK AT THE NEXT CIRCUIT-ID
	RET			;NOT THERE, PUNT WITH RC ZERO
	JRST SETRC1		;CHECK OUT THE NEXT CIRCUIT BLOCK
	SUBTTL Error Message Routines

NOSPY:	ERR	?Spy pages UUO failed

NOSJB:	ERR	?Job has no SJB

NOPDB:	ERR	?Job has no PDB

ILLCHN:	MOVEI T1,[ASCIZ /?Channel /]
	CALL ERRSTR
	MOVE T1,SCNCHN			;GET CHANNEL USER REQUESTED
	CALL .TDECD			;TYPE IN DECIMAL
	MOVEI T1,[ASCIZ / is illegal
/]
	CALLRET .TSTRG##


NOCHT:	MOVEI T1,[ASCIZ /?Channel /]
	CALL ERRSTR
	MOVE T1,SCNCHN			;GET CHANNEL USER REQUESTED
	CALL .TDECD			;TYPE IN DECIMAL
	MOVEI T1,[ASCIZ /'s SJB has no channel table
/]
	CALLRET .TSTRG##

NOELB:	MOVEI T1,[ASCIZ /?Channel /]
	CALL ERRSTR
	MOVE T1,SCNCHN			;GET CHANNEL USER REQUESTED
	CALL .TDECD			;TYPE IN DECIMAL
	MOVEI T1,[ASCIZ / has no NSP Link Block (ELB)
/]
	CALLRET .TSTRG##

NOCHN:	MOVEI T1,[ASCIZ /?Channel /]
	CALL ERRSTR
	MOVE T1,SCNCHN			;GET CHANNEL USER REQUESTED
	CALL .TDECD			;TYPE IN DECIMAL
	MOVEI T1,[ASCIZ / is not open
/]
	CALLRET .TSTRG##

NORCB:	ERR ?No circuit-id found to match /CIRCUIT switch
	SUBTTL ERRSTR - Type out an error string

;	T1/ pointer to error string (asciz)

ERRSTR:	CLRBFI			;IGNORE REST OF ERRONEOUS TYPIN
	SKIPE	TYPDPY		;IN DPY MODE?
	  TTY$	$TTCLR		;HOME UP AND CLEAR SCREEN
	SETZM	TYPDPY		;LEAVE DPY MODE
	CALLRET .TSTRG##	;TELL SCAN TO TYPE IT OUT NOW
	SUBTTL SPYPAG - Subroutine to Set up a SPY Page

;Call:	T1/ Monitor address of Block to be mapped
;	T2/ User address of page on which to map it
;	CALL SPYPAG
;	  Error Return
;	Normal Return with UVA of block in T1
;

SPYPAG:	SAVEAC P1
	LDB P1,[POINT 9,T1,35]	;SAVE OFFSET INTO PAGE
	IOR P1,T2		;POINT TO OUR SPY PAGE
	LSH T2,-^D9		;MAKE UVA INTO A PAGE NUMBER
	LDB T3,[POINT 13,T1,26]	;GET EVA PAGE NUMBER PDB STARTS IN
	HRL T2,T3		;MONITOR'S PAGE NUMBER FOR PDB
	TXO T2,1B0		;DESTROY THE PAGE FIRST
	MOVNI T1,2		;NUMBER OF PAGES TO DO
	MOVE T4,[.PAGSP,,T1]	;SPY PAGES FUNCTION
	PAGE. T4,		;FIRST, CLEAN OUT PREVIOUS ATTEMPTS
	  JFCL			;DON'T CARE IF DESTROY FAILED

	TXZ T2,1B0		;NOW CREATE THE PAGE
	MOVE T4,[.PAGSP,,T1]	;SPY PAGES FUNCTION
	PAGE. T4,		;MAP MONITOR'S PAGE INTO MY UVA
	  RET			;ERROR RETURN

	MOVE T1,P1		;RETURN UVA IN T1
RSKP:
CPOPJ1:	AOS (P)			;SUCCESS RETURN
CPOPJ:	RET
	SUBTTL ENMCHN - Type out a data block

;Call:	T1/ Pointer to the job block's channel table
;	T2/ Number of channel slots in use
;	CALL ENMCHN
;	  Error Return
;	Normal Return, no value

ENMCHN:	SAVEAC <P1,P2>
	MOVE P1,T1		;POINTER TO CHANNEL TABLE
	MOVNS T2		;NEGATE THE SLOT COUNT
	HRL P1,T2		;MAKE AN AOBJN POINTER

	SKIPLE NRTSJB		;IS NRTSJB OVERRIDING JOB?
	JRST [	MOVEI T1,[ASCIZ /NRTSER/]
		CALL .TSTRG
		JRST ENMBL1]	;MERGE WITH THE REST
	SKIPLE SCNSJP		;IS SJBPTR OVERRIDING JOB?
	JRST [	MOVEI T1,[ASCIZ /SJB at /]
		CALL .TSTRG
		MOVE T1,SCNSJP	;TYPE OUT SJB ADDRESS
		CALL .TXWDW##	; IN OCTAL
		JRST ENMBL1]	;BACK TO MAINSTREAM
	MOVEI T1,[ASCIZ /Job /]
	CALL .TSTRG
	MOVE T1,SCNJOB		;NO, USE JOB #
	CALL .TDECD
ENMBL1:
	MOVEI T1,[ASCIZ / has the following channels open: /]
	CALL .TSTRG
	MOVEI P2,0		;FIRST CHANNEL NUMBER IS 1
ENMBL2:	AOS T1,P2		;INCREMENT USER'S CHANNEL NUMBER
	SKIPN (P1)		;IS THIS SLOT IN USE?
	JRST ENMBL3		;NO
	CALL .TDECW		;YES, TYPE OUT ITS NUMBER FROM T1
	CALL .TSPAC		;SEPARATE WITH SPACES
ENMBL3:	AOBJN P1,ENMBL2		;TRY THE NEXT
	CALLRET .TCRLF		;THAT'S ALL
	SUBTTL TYPBLK - Type out a data block

;Call:	T1/ AOBJN Pointer to the DOBLK table for this block type
;	SJ,SL,EL/ Points to the block to be typed
;	CALL TYPBLK
;	  Error Return
;	Normal Return, no value

TYPBLK:	SAVEAC <P1,P2>
	HRRZ P1,T1		;POINTER TO DESCRIPTOR TABLES TABLE
	HLLZ P2,T1		;AOBJN POINTER TO INDEX THRU TABLES

;Note that the DOBLK macro (above) depends on P2 being set up here

TYPBL1:	MOVE T1,@DO.NAM(P1)	;GET THE SIXBIT NAME OF ENTRY
	CALL .TSIXN		;TYPE IT OUT
	CALL .TCOLN		;TYPE A COLON
	CALL .TTABC		;TYPE OUT A TAB
	MOVE T2,@DO.PTR(P1)	;PASS THE BYTE POINTER IN T2
	HRRI T2,@T2		;RESOLVE INDIRECTION AND EXTRA INDEXING
	TLZ T2,37		;WE RESOLVED IT, LEAVE BYTE PTRS P & S FIELDS
	LDB T1,T2		;THE VALUE IN T1

;Call the typeout routine with
;	T1/ Value in Location, most typeout routines will type this
;	T2/ UVA Byte Ptr to Location, indexing and indirection resolved

	CALL @DO.RTN(P1)	;CALL TYPEOUT ROUTINE
	CALL .TTABC		;TYPE OUT A TAB
	MOVE T1,@DO.TXT(P1)	;GET PTR TO THE TEXT STRING (COMMENT)
	SKIPG SCNCOM		;USER WANT THE COMMENTS?
	  MOVE T1,@DO.STX(P1)	;NO, GET THE SHORT TEXT
	CALL .TSTRG		;TYPE IT OUT, CRLF INCLUDED IN TEXT

	AOBJN P2,TYPBL1		;DO THE REST
	RETSKP			;ALL DONE
	SUBTTL .Txxx - Local Typeout Routines

;Call:	T2/ Resolved UVA Byte Pointer to first word of queue header
;	CALL .TQUE
;	Normal Return

.TQUE:	MOVE T1,QH.CNT(T2)	;GET MAX,,COUNT
	PUSH P,T1
	HLRZS T1		;ISOLATE THE MAX FIELD
	CALL .TDECD		;TYPE OUT IN DECIMAL
	MOVEI T1,","		;LOAD A COMMA
	CALL .TCHAR		; TO SEPARATE MAX FROM COUNT
	POP P,T1
	HRRZS T1		;ISOLATE THE COUNT FIELD
	CALLRET .TDECD		;TYPE OUT IN DECIMAL


;Call:	T1/ value
;	CALL .TDECD
;	Normal Return

.TDECD:	CALL .TDECW		;TYPE T1 IN DECIMAL
	MOVEI T1,"."		;LOAD UP A DECIMAL POINT
	CALLRET .TCHAR		;FOLLOWED BY A DECIMAL POINT


;Call:	T1/ value
;	CALL .TBOOL
;	Normal Return

.TBOOL:	TRNN T1,1		;TRUE?
	 SKIPA T1,[[ASCIZ /false/]] ;NO
	  MOVEI T1,[ASCIZ /true/]   ;YES
	CALLRET .TSTRG
;Call:	T1/ Session Control State code
;	CALL .TSTAS
;	Normal Return

.TSTAS:	PUSH P,T1		;SAVE STATE CODE
	CALL .TDECW		;TYPE STATE IN DECIMAL
	MOVEI T1,"("
	CALL .TCHAR
	POP P,T1
	CAILE T1,STASLN		;WE UNDERSTAND THE STATE?
	MOVEI T1,0		;NO, USE ILLEGAL STATE
	MOVEI T1,STASBL(T1)	;GET POINTER TO ASCIZ STRING
	CALL .TSTRG		;TYPE IT OUT
	MOVEI T1,")"
	CALLRET .TCHAR

DEFINE STACOD(code),<
  IFN .NSS'code-.+STASBL,<PRINTX ?STASBL table defined wrong>
	EXP ASCIZ /code/
>


STASBL:	ASCIZ /??/
	STACOD CW		;CONNECT WAIT
	STACOD CR		;CONNECT RECEIVED
	STACOD CS		;CONNECT SENT
	STACOD RJ		;REMOTE REJECTED CONNECT INIT
	STACOD RN		;LINK IS UP AND RUNNING
	STACOD DR		;DISCONNECT RECEIVED
	STACOD DS		;DISCONNECT SENT
	STACOD DC		;DISCONNECT CONFIRMED
	STACOD CF		;NO CONFIDENCE
	STACOD LK		;NO LINK
	STACOD CM		;NO COMMUNICATION
	STACOD NR		;NO RESOURCES
STASLN==.-STASBL-1
;Call:	T1/ NSP State code
;	CALL .TSTAN
;	Normal Return

.TSTAN:	PUSH P,T1		;SAVE STATE CODE
	CALL .TDECD		;TYPE STATE IN DECIMAL
	MOVEI T1,"("
	CALL .TCHAR
	POP P,T1
	CAILE T1,STANLN		;WE UNDERSTAND THE STATE?
	MOVEI T1,0		;NO, USE ILLEGAL STATE
	MOVEI T1,STANBL(T1)	;GET POINTER TO ASCIZ STRING
	CALL .TSTRG		;TYPE IT OUT
	MOVEI T1,")"
	CALLRET .TCHAR

DEFINE STACOD(code),<
  IFN NPS.'code-.+STANBL,<PRINTX ?STANBL table defined wrong>
	EXP ASCIZ /code/
>


STANBL:	ASCIZ /??/
	STACOD	OP	;OPEN, WAITING FOR ENTER ACTIVE FROM SC
	STACOD	CI	;CONNECT INITIATE SENT
	STACOD	CD	;CONNECT DELIVERED
	STACOD	CR	;CONNECT RECEIVED
	STACOD	CC	;CONNECT CONFIRM
	STACOD	DR	;DISCONNECT REJECT
	STACOD	RC	;DISCONNECT REJECT COMPLETE (DRC)
	STACOD	RN	;RUN
	STACOD	RJ	;REJECT
	STACOD	DI	;DISCONNECT INITIATE
	STACOD	IC	;DISCONNECT INITIATE COMPLETE (DIC)
	STACOD	DN	;DISCONNECT NOTIFICATION
	STACOD	CN	;CLOSE NOTIFICATION
	STACOD	NR	;NO RESOURCES
	STACOD	NC	;NO COMMUNICATION
	STACOD	CL	;CLOSED
	STACOD	DP	;DESTROY PORT
STANLN==.-STANBL-1
;Call:	T1/ Router state code
;	CALL .TSTAR
;	Normal Return

.TSTAR:	PUSH P,T1		;SAVE STATE CODE
	CALL .TDECW		;TYPE STATE IN DECIMAL
	MOVEI T1,"("
	CALL .TCHAR
	POP P,T1
	CAILE T1,STARLN		;WE UNDERSTAND THE STATE?
	MOVEI T1,0		;NO, USE ILLEGAL STATE
	MOVEI T1,STARBL(T1)	;GET POINTER TO ASCIZ STRING
	CALL .TSTRG		;TYPE IT OUT
	MOVEI T1,")"
	CALLRET .TCHAR

DEFINE STACOD(code),<
  IFN RCS.'code-.+STARBL,<PRINTX ?STARBL table defined wrong>
	EXP ASCIZ /code/
>

STARBL:	STACOD OF		;OFF
	STACOD WT		;WAITING FOR PROTOCOL UP
	STACOD TI		;WAITING FOR TI
	STACOD TV		;WAITING FOR TV
	STACOD TT		;TESTING
	STACOD RN		;RUNNING
STARLN==.-STARBL-1
;Call:	T1/ Circuit ID
;	CALL .TCKT
;	Normal Return

.TCKT:	SAVEAC P1
	MOVE P1,T1		;PRESERVE CIRCUIT-ID
	LSH T1,-^D18		;GET THE DEVICE TYPE RIGHT JUSTIFIED
	CAIL T1,0		;RANGE CHECK
	CAILE T1,DEVTLN		; THE DEVICE TYPE
	RET			;OOPS, DON'T PRINT ANYTHING
	MOVE T1,DEVTAB(T1)	;GET THE NAME OF THE DEVICE
	CALL .TSIXN##		;TYPE IT OUT

	MOVEI T1,"-"		;TYPE THE "-"
	CALL .TCHAR##

	HRRZ T1,P1		;NOW GET THE CONTROLLER (CPU) NUMBER
	LSH T1,-^D9		; OUT SEPARATELY
	CALL .TOCTW##		;TYPE IT OUT

	MOVEI T1,"-"		;TYPE THE "-"
	CALL .TCHAR##

	HRRZ T1,P1		;AND LAST DO THE
	ANDI T1,777		; UNIT NUMBER
	CALL .TOCTW##		;TYPE IT
	RET			; AND RETURN
	SUBTTL .SWxxx - Local Switch Value Processors

;Call:	CALL .SWLIN
;	Normal return
;Returns with Circuit block pointer in T1.

.SWCKT:	SAVEAC <P1,N>
	CALL .SIXSW##		;GET THE DEVICE NAME
	MOVE T3,[XWD -DEVTLN,DEVTAB] ;SET UP FOR DEVICE NAME SEARCH
SWCKT1:	MOVE T2,(T3)		;GET A DEVICE NAME
	CAMN N,T2		;HAVE WE GOT IT?
	JRST SWCKT2		;YES, GO DO THE REST
	AOBJN T3,SWCKT1		;NO, CHECK THE NEXT ONE
SWCKTE:	SETZ T1,		;RETURN SILLY NUMBER
	POPJ P,			; TO CALLER

SWCKT2:	HRRZ P1,T3		;GET THE POINTER TO DEV NAME
	SUBI P1,DEVTAB		;CALCULATE THE NUMBER VALUE
	LSH P1,^D18		;PUT THE DEVICE TYPE IN THE RIGHT FIELD

	CAIE C,"-"		;WAS IT A LEGAL SEPERATOR?
	JRST SWCKTE		;NO, GIVE THE ERROR RETURN

	CALL .OCTNW##		;GET THE CONTROLLER (CPU) NUMBER
	LSH N,^D9		;PUT IT IN THE CORRECT FIELD
	IOR P1,N		;FORM MORE OF CIRCUIT-ID

	CAIE C,"-"		;WAS IT THE SEPERATOR?
	JRST SWCKTE		;GIVE THE ERROR RETURN

	CALL .OCTNW		;GET THE UNIT NUMBER
	IOR P1,N		;FINISH THE CIRCUIT-ID
	LSH P1,^D9		;SHIFT INTO CORRECT POSITION
	MOVE T1,P1		;ALSO RETURN IN T1
	MOVEM T1,CKTID		;SAVE THE CIRCUIT-ID
	POPJ P,			; AND RETURN

DEFINE DEVTYP(TYPE),<
	SIXBIT/TYPE/
>

DEVTAB:	DEVTYP TST
	DEVTYP DTE
	DEVTYP KDP
	DEVTYP DDP
DEVTLN==.-DEVTAB

;Routine to allocate output spec area
SCNAOT:	OUTSTR	[ASCIZ /?SCAN called for output space???
/]
	RET			;RETURN

;Routine to allocate input spec area
SCNAIN:	OUTSTR	[ASCIZ /?SCAN called for input spec space???
/]
	RET			;RETURN
	SUBTTL KDP Display

	radix	10		;the kdp display is in radix 10

;byte pointers into the kdl block

;xbyte takes the macro for a field from NETPRM and changes the
;index field from F to KDL

define xbyte(bp)<		;;routine to translate the index field
kdl'bp:	exp <<^-<15_18>>&kd%'bp>+<kdl_18>
>
	xbyte	sta		;line state
	xbyte	tim		;line timer (rep & start/stack)
	xbyte	xnk		;last nak sent
	xbyte	rpc		;rep counter
	xbyte	rmn		;receive message number
	xbyte	lmx		;last message xmitted (assigned)
	xbyte	lma		;last message ack'ed
	subttl KDP Display -  screen layout

                           Comment @

         1111111111222222222233333333334444444444555555555566666666667777777777
1234567890123456789012345678901234567890123456789012345678901234567890123456789
===============================================================================
1Line #9, State = INITED, Last Zeroed - HH:MM:SS
2                                                             KMC CONTROL OUTS
3         MESSAGES  RCVD   SENT      NAKS    RCVD  SENT    ABORT    (06) 99999
4LMX 777   START  9999999 9999999  HDR BCC  99999 99999    BAD HDR  (10) 99999
5LMA 777   STACK  9999999 9999999  DATA BCC 99999 99999    BAD CRC  (12) 99999
6RMN 777   ACK    9999999 9999999  REP RESP 99999 99999    NO RBUF  (14) 99999
7          NAK    9999999 9999999  NO RCVBF 99999 99999    DSR CHNG (16) 99999
8RPC 999   REP    9999999 9999999  RCV OVER 99999 99999    KMC NXM  (20) 99999
9TIM 999   DATA   9999999 9999999  MSG2LONG 99999 99999    XMT UNDR (22) 99999
0          MAINT  9999999 9999999  BAD HDR  99999 99999    RCV OVER (24) 99999
1                                  RANDOM   99999 99999    BFR KILL (26) 99999
2------------------------------------------------------------------------------
3Line #9, State = INITED, Last Zeroed - HH:MM:SS
4                                                             KMC CONTROL OUTS
5         MESSAGES  RCVD   SENT      NAKS    RCVD  SENT    ABORT    (06) 99999
6LMX 777   START  9999999 9999999  HDR BCC  99999 99999    BAD HDR  (10) 99999
7LMA 777   STACK  9999999 9999999  DATA BCC 99999 99999    BAD CRC  (12) 99999
8RMN 777   ACK    9999999 9999999  REP RESP 99999 99999    NO RBUF  (14) 99999
9          NAK    9999999 9999999  NO RCVBF 99999 99999    DSR CHNG (16) 99999
0RPC 999   REP    9999999 9999999  RCV OVER 99999 99999    KMC NXM  (20) 99999
1TIM 999   DATA   9999999 9999999  MSG2LONG 99999 99999    XMT UNDR (22) 99999
2          MAINT  9999999 9999999  BAD HDR  99999 99999    RCV OVER (24) 99999
3                                  RANDOM   99999 99999    BFR KILL (26) 99999
4

                         End Comment @


	msgcol==12		;column to start message counts in
	nakcol==36		;column to start nak counts in
	ctocol==60		;column to start control out info in
	subttl KDP Display - 	initialization

typkdp:	skipn	typdpy		;in DPY mode?
	  err	?KDP display only supported in DPY mode for now
	movei	kdl,kdlpag	;get address of the kdl page
	movei	t1,0		;get line #0
	movem	t1,kdline(kdl)	;set the line for kdldpy
	pushj	p,kdldpy	;go output the first line
	  err ? KDL. Read status failed for line #0.
	movei	t1,79		;output a dividing line of 79 dashes
	sojge	t1,[chi$ "-"	;output a dash
		    jrst .]	;do all 79 of them
	crlf			;go to next line
	aos	kdline(kdl)	;increment the line number
	pushj	p,kdldpy	;output the next dup's data
	  text	No line #1.
	retskp			;success return to DPY loop
	subttl KDP Display - kdldpy -- output 11 lines of kdl info

;kdldpy
;call	kdl := pointer to block with line number filled in
;	screen at upper left hand corner of region to fill
;return	cpopj	if no such line.
;	cpopj1	with 11 lines of kdl data output

kdldpy:	movei	t1,1(p)		;address of uuo arguments
	hrli	t1,4		;there are 4 args to status function
	push	p,[exp .kdlrs]	;fcn: get dup-11's status
	push	p,[exp 0]	;arg1: kdp #0 (others aren't supported)
	push	p,kdline(kdl)	;arg2: kdl line number
	push	p,[xwd <kdlest-kdlsts>+1,kdlpag+kdlsts] ;leng,addr of rtn area
	kdp.	t1,		;get the status
	  jrst	[adjsp p,-4	;if no DMC-11, fixup the stack
		 popj p,]	;  and give an error return
	adjsp	p,-4		;pop off the 4 arguments

	movei	t1,1(p)		;address of uuo arguments
	hrli	t1,4		;there are 4 args to status function
	push	p,[exp .kdlru]	;fcn: read dup-11's sixbit user name
	push	p,[exp 0]	;arg1: kdp #0 (others aren't supported)
	push	p,kdline(kdl)	;arg2: kdl line number
	push	p,[exp 0]	;uuo returns user name here
	kdp.	t1,		;get the status
	  setzm (p)		;error, we don't know user name
	pop	p,kdlpag+kdlusr ;store name for display later
	adjsp	p,-3		;pop off the 4 arguments
	subttl KDP Display - 	line 1.

					;line
line1:	text	<Line #>
	number	kdline(kdl)		;output the line number
					;state
	text	<,  State = >
	ldb	t1,kdlsta		;get the state
	setz	t2,			;get a "zero"
	cain	t1,kd%dwn		;if it's down
	movei	t2,[asciz |Down|]	;  then get that "state"
	cain	t1,kd%ini
	movei	t2,[asciz |Initial|]
	cain	t1,kd%fls
	movei	t2,[asciz |Flushing|]
	cain	t1,kd%mai
	movei	t2,[asciz |Maint|]
	cain	t1,kd%str
	movei	t2,[asciz |Starts|]
	cain	t1,kd%stk
	movei	t2,[asciz |Stacks|]
	cain	t1,kd%run
	movei	t2,[asciz |Running|]
	skipn	t2			;make sure we got a valid state
	movei	t2,[asciz |?????|]
	hrli	t2,(str$)		;make it a "str$ uuo)
	xct	t2			;output the string
					;up-time
	text	<,  Last zeroed - >
	move	t1,kdlztm(kdl)		;get uptime
	idivi	t1,3600			;get "hours"
	number	t1,10,2,$zr		;2 digits long, fill with zero's
	chi$	":"			;output the colon
	move	t1,t2			;get the remainder
	idivi	t1,60			;get "minutes"
	number	t1,10,2,$zr		;output the minutes
	chi$	":"			;output the colon
	number	t2,10,2,$zr		;output the seconds

	text	<,   User - >
	skipn t1,kdlusr(kdl)		;get sixbit user name
	  movsi t1,'?  '		;don't know it yet
	call outsix			;tell DPY about sixbit word
	crlf				;end of the first line.

	subttl KDP Display - 	Line 2.

line2:	goto	ctocol+2		;go to the 62nd column
	text	<KMC Control Outs>	;write header
	crlf				;end of line 2
	subttl KDP Display - 	Line 3.

line3:	goto	msgcol-2		;message column
	text	<Messages   Rcvd    Sent>
	goto	nakcol+2
	text	<Naks    Rcvd  Sent>
	goto	ctocol			;go to control out column
	text	<Abort    (06) >	;abort message counts
	number	kdlcto+0(kdl),10,5	;5 char number right justify
	crlf				;end of line 3


	subttl KDP Display - 	Line 4.

line4:	text	<LMX >			;last message assigned
	ldb	t1,kdllmx		;get the byte
	number	t1,8,3,$zr	;output in octal for debugging

	goto	msgcol			;messages counts next
	text	<Start  >		;first is "start count"
	number	kdlctr+5(kdl),10,7	;seven digit field.  left justified
	chi$	$sp			;one space
	number	kdlctx+5(kdl),10,7	;get the xmit field too.

	goto	nakcol			;nak counts now
	text	<Random   >		;first type is "random"
	number	kdlnkr+0(kdl),10,5	;5 digit field left justified
	chi$	$sp			;output the space
	number	kdlnkx+0(kdl),10,5	;output the xmit field too

	goto	ctocol			;control out's now.
	text	<Bad Hdr  (10) >	;illegal header is next
	number	kdlcto+1(kdl),10,5	;5 digits
	crlf
	subttl KDP Display - 	line 5.

line5:	text	<LMA >			;last message assigned
	ldb	t1,kdllma		;get the value
	number	t1,8,3,$zr		;three digit octal

	goto	msgcol			;message counts next
	text	<Stack  >		;stack counts
	number	kdlctr+6(kdl),10,7	;7 digit number (received)
	chi$	$sp			;space
	number	kdlctx+6(kdl),10,7	;xmitted

	goto	nakcol			;nak counts
	text	<Hdr BCC  >
	number	kdlnkr+1(kdl),10,5	;received header bcc naks
	chi$	$sp			;space
	number	kdlnkx+1(kdl),10,5	;xmitted header bcc naks

	goto	ctocol			;control out column
	text	<Bad CRC  (12) >	;data or header crc error
	number	kdlcto+2(kdl),10,5	;count of crc control outs
	crlf				;end of line 5
	subttl KDP Display - 	line 6.

line6:	text	<RMN >			;last message received
	ldb	t1,kdlrmn		;get the byte
	number	t1,8,3,$zr		;octal 3 chars zero filled

	goto	msgcol			;messages next
	text	<Ack    >		;ack message count
	number	kdlctr+0(kdl),10,7	;output received ack count
	chi$	$sp			;space
	number	kdlctx+0(kdl),10,7	;output xmitted ack count

	goto	nakcol			;nak counts next
	text	<Data BCC >		;data crc error
	number	kdlnkr+2(kdl),10,5	;output receive counts
	chi$	$sp			;space
	number	kdlnkx+2(kdl),10,5	;output xmit count

	goto	ctocol			;control outs next
	text	<No Rbuf  (14) >	;no receive buffer
	number	kdlcto+3(kdl),10,5	;output control out count
	crlf				;end of line 6
	subttl KDP Display - 	Line 7.

line7:	goto	msgcol			;start with message column this time
	text	<Nak    >
	number	kdlctr+1(kdl),10,7	;received naks
	chi$	$sp			;space
	number	kdlctx+1(kdl),10,7	;sent naks

	goto	nakcol			;specific nak counts
	text	<Rep resp >		;rep response nak
	number	kdlnkr+3(kdl),10,5	;received rep naks
	chi$	$sp			;space
	number	kdlnkx+3(kdl),10,5	;sent naks

	goto	ctocol			;control outs
	text	<DSR chng (16) >	;dataset ready changed
	number	kdlcto+4(kdl),10,5	;output transition count
	crlf				;end of line 7
	subttl KDP Display -  line 8.

line8:	text	<RPC >			;rep counter
	ldb	t1,kdlrpc		;get the count
	number	t1			;output it

	goto	msgcol			;messages next
	text	<Rep    >		;rep counts
	number	kdlctr+2(kdl),10,7	;received reps
	chi$	$sp			;space
	number	kdlctx+2(kdl),10,7	;xmitted reps

	goto	nakcol			;nak's next
	text	<No Rcvbf >		;no receive buffer nak
	number	kdlnkr+4(kdl),10,5	;received
	chi$	$sp			;space
	number	kdlnkx+4(kdl),10,5	;sent

	goto	ctocol			;control out's last
	text	<Kmc NXM  (20) >	;we screwed the kmc?
	number	kdlcto+5(kdl),10,5	;output nxm count
	crlf				;end of line 8
	subttl KDP Display - 	Line 9.

line9:	text	<TIM >			;the line's timer
	ldb	t1,kdltim		;get the time
	number	t1			;decimal

	goto	msgcol			;message counts
	text	<Data   >		;data messages
	number	kdldtr(kdl),10,7	;received
	chi$	$sp			;space
	number	kdldtx(kdl),10,7	;sent

	goto	nakcol			;nak count
	text	<Rcv over >		;receiver over run
	number	kdlnkr+5(kdl),10,5	;received
	chi$	$sp			;space
	number	kdlnkx+5(kdl),10,5	;and sent

	goto	ctocol			;control outs last
	text	<Xmt undr (22) >	;transmitter under-run
	number	kdlcto+6(kdl),10,5	;output that
	crlf				;end of line 9
	subttl KDP Display - 	Line 10.

line10:	goto	msgcol			;start with messages
	text	<Maint  >		;maintenance messages
	number	kdlmar(kdl),10,7	;received
	chi$	$sp			;space
	number	kdlmax(kdl),10,7	;and sent

	goto	nakcol			;nak counts next
	text	<Msg2long >		;message too long naks
	number	kdlnkr+6(kdl),10,5	;received
	chi$	$sp			;space
	number	kdlnkx+6(kdl),10,5	;and sent

	goto	ctocol			;control out
	text	<Rcv over (24) >	;receiver over runs
	number	kdlcto+7(kdl),10,5	;output that
	crlf				;end of line 10
	subttl KDP Display - 	Line 11.

line11:	goto	nakcol			;no messages. start with nak's
	text	<Bad hdr  >		;header naks
	number	kdlnkr+7(kdl),10,5	;received
	chi$	$sp			;space
	number	kdlnkx+7(kdl),10,5	;and sent

	goto	ctocol			;control out column
	text	<Bfr kill (26) >	;buffer kill
	number	kdlcto+8(kdl),10,5	;output that
	crlf				;end of line 11
	retskp				;success return to typkdp


	radix	8		;end of KDP display processor
	SUBTTL UTILITY ROUTINES

;PGOTO	MOVES FORWARD TO APPROIATE HORIZONTAL POSITION.
;CALL	T1 := POSITION TO GO TO
;RETURN	CPOPJ
PGOTO:	LOC$	T2		;GET OUR CURRENT "XWD LINE,POS"
	SUBI	T1,(T2)		;GET NUMBER OF CHARACTERS TO GO
	SKIPLE	T1		;ALWAYS PRINT AT LEAST ONE SPACE
PGOTO1:	SOJL	T1,CPOPJ	;EXIT IF WE'VE GOT THERE
	CHI$	$SP		;PRINT A SPACE
	JRST	PGOTO1		;LOOP TILL ALL CHARACTERS ARE OUT


;OUTSIX	OUTPUT THE WORD IN T1 AS SIXBIT
;RETURN CPOPJ

OUTSIX:	PUSH P,T2
	PUSH P,T3
	MOVEI T3,6
	MOVE T2,T1		;PREPARE FOR LSHC
OUTSI1:	SETZ T1,
	LSHC T1,6		;GET NEXT CHR FROM T2
	ADDI T1,$SP		;MAKE SIXBIT INTO ASCII
	CHR$ T1			;OUTPUT CHR TO DPY PACKAGE
	SOJG T3,OUTSI1		;OUTPUT ALL SIX CHRS (EVEN IF BLANK)
	POP P,T3
	POP P,T2
	POPJ P,
;OUTNUM	PRINTS A NUMBER.  CALLED BY THE "NUMBER" MACRO
;CALL	NUM := NUMBER TO PRINT
;	BAS := BASE TO PRINT NUMBER IN
;	WDT := WIDTH OF FIELD. (- MEANS LEFT JUSTIFY, 0 MEANS ANY WIDTH)
;	FIL := CHAR TO USE TO FILL OUT THE FIELD

OUTNUM:	PUSH	P,T1		;SAVE THE T'S
	PUSH	P,T2
	PUSH	P,T3
	MOVE	T1,NUM		;COPY THE NUMBER
	MOVEI	T3,1		;INITIALIZE THE COUNT OF DIGITS IN NUMBER
OUTNU1:	IDIVI	T1,(BAS)	;GET THE NEXT DIGIT IN T1+1
	ADDI	T1+1,$ZR	;MAKE REMAINDER A DIGIT
	PUSH	P,T1+1		;SAVE THE NEXT DIGIT
	SKIPE	T1		;SKIP IF ALL DIGITS PRINTED
	AOJA	T3,OUTNU1	;LOOP TAKING NUMBER APART. EXIT WITH T3 = COUNT
	JUMPLE	WDT,OUTNU2	;IF NOT RIGHT JUSTIFIED, DON'T PAD BEGINNING

	MOVEI	T2,(WDT)	;GET THE "WIDTH"
	SUBI	T2,(T3)		;SUBTRACT THE "SIZE"
	SOJGE	T2,[CHR$ FIL	;LOOP OUTPUTTING "FILL"
		    JRST .]	;  UNTIL T2 COUNTED DOWN

OUTNU2:	MOVEI	T2,(T3)		;GET THE "LENGTH" OF THE NUMBER
	SOJGE	T2,[POP P,T1	;GET THE NEXT DIGIT TO OUTPUT
		    CHR$ T1	;OUTPUT IT
		    JRST .]	;LOOP OVER ALL DIGITS
	JUMPGE	WDT,CPOPJ3	;EXIT IF NOT LEFT JUSTIFIED

	ADD	T3,WDT		;GET MINUS THE NUMBER OF FILL CHARS
	AOJGE	T3,[CHR$ FIL	;OUTPUT THE FILL
		    JRST .]	;OUTPUT ALL THE FILL
CPOPJ3:	POP	P,T3		;RESTORE CALLERS T'S
	POP	P,T2
	POP	P,T1
	POPJ	P,		;ALL DONE.
	SUBTTL	Terminal Handling Routines

;TTYINI - Init our TTY

TTYINI:	OPEN	$TTY,[EXP .IOASC
		      SIXBIT /TTY/
		      XWD TTYOBF,0]
	  ERR	? OPEN OF TTY FAILED.
	MOVE	T1,[XWD ^O400000,OBF1+1] ;GET THE "MAGIC" TO SET
	MOVEM	T1,TTYOBF+0	;  AND SET UP THE FIRST WORD OF THE HEADER
	MOVE	T1,[POINT 7,0,35] ;GET THE PATTERN BYTE POINTER
	MOVEM	T1,TTYOBF+.BFPTR  ;  AND SET UP THE POINTER
	SETZM	TTYOBF+.BFCNT	;CLEAR THE COUNT


	SETZM	OBF1		;CLEAR FIRST WORD OF THE OUTPUT BUFFER
	MOVE	T1,[XWD OBF1,OBF1+1] ;GET BLT POINTER TO THE REST
	BLT	T1,OBF1+TYOBSZ+2;CLEAR THE BUFFER
	MOVE	T1,[XWD TYOBSZ+1,OBF1+1]
	MOVEM	T1,OBF1+1	;SET UP THE RING BUFFER POINTER
	POPJ	P,		;ALL DONE


;TTYOUC - Output a character to TTY

TTYOUC:	EXCH	T1,(P)		;GET THE CHAR, SAVE T1
				;JUMP IF SIGNAL FOR LAST
	JUMPL	T1,TTYOU2	;IGNORE SIGNAL & RETURN
TTYOU1:	SOSGE	TTYOBF+.BFCTR	;COUNT OUT THE NEXT CHARACTER
	JRST	[PUSHJ P,TTYFRC	;IF NO ROOM, FORCE OUT CURRENT BUFFER
		 JRST TTYOU1]	;  AND TRY AGAIN
	IDPB	T1,TTYOBF+.BFPTR;STORE THE CHARACTER
TTYOU2:	POP	P,T1		;RESTORE DPY'S AC
	POPJ	P,		;  AND RETURN


;TTYFRC - Force out the current TTY buffer

TTYFRC:	OUT	$TTY,		;DO THE OUTPUT
	  POPJ	P,		;RETURN IF SUCCESSFUL
	ERR	? TTY output I/O error.
;TTY output routine called from SCAN's .TCHAR

SCNOUC:	SKIPN	BIGOUT		;USE BIG BUFFER OUTPUT?
	JRST	[OUTCHR	T1	;NO, PUSH SCAN'S MSGS OUT NOW
		 RET]
	SKIPN	TYPDPY		;USER WANT DPY MODE?
	JRST	SCNOU1		;NO, OUTPUT STRAIGHT TO TTY

;Here to output a character to DPY package

	PUSH	P,T2		;CALLERS EXPECT ALL ACS TO BE SAVED
	MOVE	T2,LINCNT	;GET CURRENT LINE COUNT
	CAML	T2,LINGOL	;UP TO BEGINNING OF LOGICAL SCREEN YET?
	  CHR$	T1		;YES, TELL DPY
	POP	P,T2		;RESTORE CALLER'S T2
	CAIN	T1,12		;A LINE FEED?
	  AOS	LINCNT		;YES, ONE MORE LINE FEED OVER DAM
	RET			;RETURN TO SCAN

SCNOU1:	SOSGE	TTYOBF+.BFCTR	;COUNT OUT NEXT CHARACTER
	JRST	[PUSHJ P,TTYFRC	;IF NO ROOM, FORCE OUT CURRENT BUFFER
		 JRST SCNOU1]	;  AND TRY AGAIN
	IDPB	T1,TTYOBF+.BFPTR;STORE CHARACTER
	POPJ	P,		;  AND RETURN
	SUBTTL	End of Program

	END DCNSPY