TITLE	NMLDPY Network Management Listener Display
	SUBTTL	Robert A. Brown, August 1983
	SUBTTL	Converted to DPY: Philip Budne, December 1983

TOPS==20
DEFINE T20 <IFE TOPS-20>
DEFINE T10 <IFE TOPS-10>

	TWOSEG	400K
T20,<	SEARCH MONSYM,MACSYM >
T10,<	SEARCH UUOSYM,MACSYM >
	SEARCH DPYDEF
	.REQUIRE DPY
	.DIRECT	FLBLST
	SALL

WAITIME==^D3000			;WAIT TIME IN MS.
COLWID==^D10			;COLUMN DISPLAY WIDTH
NUMCOL==5			;NUMBER OF DISPLAY COLUMNS
MAXLIN==25			;MAXIMUM COUNTERS STORD
MAXCOL==20			;MIXIMUM COLS (DEVICES) STORED
SAVSIZ==100			;SIZE OF COUNTER SAVE AREA
SAVOFF==SAVSIZ/2		;OFFSET TO OLD VALUES
HDRWID==^D80-<NUMCOL*COLWID>	;DISPLAY WIDTH FOR COUNTER NAMES

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

P1==5
P2==6

F==11
Q3==12
C==13
L==14
B==15

P==17

OPDEF	PJRST	[JUMPA	11,]
OPDEF	CALL	[PUSHJ	P,]
OPDEF	RET	[POPJ	P,]

T10,<
TTYCHN==1			;CHANNEL FOR TTY OPEN

.PRIOU==101			;TOPS-20 PRIMARY DEVICE DESIGNATOR

;NOUT
NO%MAG==:1B0			;OUTPUT MAGNITUDE
NO%SGN==:1B1			;OUTPUT SIGN
NO%LFL==:1B2			;LEADING FILLER
NO%ZRO==:1B3			;FILL WITH ZERO'S
NO%OOV==:1B4			;OUTPUT ON COLUMN OVERFLOW
NO%AST==:1B5			;OUTPUT ASTERISKS ON OVERFLOW
NO%COL==:177B17			;NUMBER OF COLUMNS TO USE
NO%RDX==:777777			;RADIX

;JSYS conversions for TOPS-20 to TOPS-10
	OPDEF	ERJMP	[JUMP	16,]		;Tops-20 error jump
	DEFINE	BOUT	<CALL	BOUTA>		;Output a byte
	DEFINE	SOUTR	<CALL	.SOUTR>		;Output a record
	DEFINE	SINR	<CALL	.SINR>		;Input decnet data
	DEFINE	NOUT	<CALL	.NOUT>		;Output a number
	DEFINE	NIN	<CALL	.NIN>		;Input a number
>;End of TOPS-10 stuff

D%POC==1B20	;1 - Counter, 0 - Parameter
D%BIT==1B23	;1 - Bit mapped

	SUBTTL	Tables

; TABLE OF BYTE POINTERS TO SYNC LINE DEVICE NAME STRINGS FOR THE COLUMNS
DEVSTR:
...==0
REPEAT MAXCOL,<
	POINT 7,DEVSTT+...
...==...+3
> ;REPEAT

SAVTAB:				;TABLE OF ADDRESSES FOR COUNTER SAVE AREAS
...==0
REPEAT MAXCOL,<
	EXP	SAVBUF+...
	...==...+SAVSIZ
> ;REPEAT
	SUBTTL	IMPURE DATA
	RELOC	0		;IMPURE
DEVSTT:	BLOCK	...		;STRING SPACE FOR DEVSTR...
SAVBUF:	BLOCK	MAXCOL*SAVSIZ	;SAVE AREA
ENDSAV==.-1
LINNUM:	BLOCK	MAXLIN		;Contains the counter number for a line
STRBUF:	BLOCK	10		;STRING BUFFER
ACSAV:	BLOCK	20		;'JSYS' AC SAVE AREA
INC:	BLOCK	1		;INCREMENTAL MODE
DONE:	BLOCK	1
COLMS:	BLOCK	1		;CURRENT NUMBER OF COLMS
COLAOB:	BLOCK	1		;AOBJN PTR FOR COLMS
FIRST:	BLOCK	1		;OFFSET TO FIRST COLM DISPLAYED
TTCOC:	BLOCK	2
TTPAR:	BLOCK	2
PLIST:	BLOCK	30
NUM:	BLOCK	1
CLEN:	BLOCK	1
CTYPE:	BLOCK	1
COUNT:	BLOCK	1
DCNBLK:	BLOCK	10

TENEXU:	XWD	0,3		;LH gets filled in at OPEN
	BLOCK	2
EXECU:	BLOCK	2

WTIM:	BLOCK	1		;WAIT TIME
TTPT:	BLOCK	1		;COMMAND STRING BYTE POINTER
TTBU:	BLOCK	10		;COMMAND STRING BUFFER

BUF:	BLOCK	100		;BUFFER FOR NML DATA
NJFN:	BLOCK	1		;NETWORK CHAN/JFN TO EXECUTOR NML

T10,<
;Argument blocks for TOPS-10

;Enter active state
EABLK:	NS.WAI!<.NSFEA,,3>	;Wait bit, function code, block length
	BLOCK	1
	CONBLK			;Connect block

;Connect block
CONBLK:	10				;Length of block
	TENEXU				;Pointer to node name string
	SRCPRC				;Source process descriptor block
	DESPRC				;Destination process descriptor block
	0				;User ID
	0				;Password
	0				;Account
	OPTDAT				;Optional data

;Optional data
OPTDAT:	XWD	^D12,4
	BYTE	(8)"0","0","3","0"
	BYTE	(8)"0","0","0","0"
	BYTE	(8)"0","0","0","0"
	0

;Source process block
SRCPRC:	5			;Length of block
	2			;PDB Format
	0
OURPPN:	0			;Our PPN
	SRCSTR			;Our string

;Source string
SRCSTR:	XWD	3,2
	BYTE	(8)"R","A","B"

;Destination process block
DESPRC:	5			;Length of block
	0			;PDB Format
	^D19			;Object
	0			;Their PPN
	0

;Send data block
DSBLK:	NS.WAI!NS.EOM!<.NSFDS,,4>
	0
	0
	0

;Receive data
DRBLK:	NS.WAI!<.NSFDR,,4>
	BLOCK	3

;Close NSP. channel
SDBLK:	NS.WAI!<.NSFSD,,2>	;Wait
	0
>;End of TOPS-10 stuff
	RELOC			;BACK TO PURE
	SUBTTL	MAIN PROGRAM
START:	RESET
	MOVE	P,[IOWD	30,PLIST]
	MOVE	T1,[CALL DPYUUO##] ;LUUO INSTR
	MOVEM	T1,41		;STORE
	INI$			;INITIALIZE LUUO PACKAGE
	CALL	INIT		;DO OTHER STUFF

	SUBTTL	Display of ACTIVE CIRCUITS

DSPAC:	CALL	OPN
DSPAC1:	MOVE	T1,NJFN		;Got connection, make request for data
	MOVE	T2,[POINT 8,[BYTE (8)24,63,376,0]]
	MOVNI	T3,4
	SETZ	T4,
	SOUTR
	 ERJMP	ERR

	CALL	REABUF		;Read the buffer
	CALL	DISPLAY		;Dump on screen
	CALL	CHK		;Wait
	JRST	DSPAC1
	SUBTTL	Check for new commands
T20,<
CHK:	MOVEI	T1,.PRIOU	;Primary input device
	SIBE			;Anything ?
	 JRST	CHK2		;Yes
CHK1:	MOVE	T1,WTIM
	DISMS
	RET
> ;TOPS-20

T10,<
CHK:	SKPINC			;ANYTHING ?
	 TRNA
	  JRST	CHK2		;YES
CHK1:	MOVE	T1,WTIM
	TLO	T1,(HB.RTL)	;WAKE ON TTY LINE ACTIVITY
	HIBER	T1,
	 TRN
	RET
> ;TOPS-10

CHK2:
T20,	PBIN			;Get character
T10,	INCHWL	T1
	CAIN	T1,"M"-100	;CARRIAGE RETURN?
	 JRST	CHK2		; TOSS
	CAIN	T1,"J"-100	;LINE FEED?
	 JRST	CHK3		; TRY TO PARSE
	CAIN	T1,177		;RUB-OUT
	 JRST	PBELL
	CAIGE	T1," "		;Space or greater ?
	 JRST	PBELL
	CAIL	T1,"A"
	 TRZ	T1,40		;Ensure uppercase
	IDPB	T1,TTPT		;Store the character
	JRST	CHK		;Get more

PBELL:
T20,<	MOVEI	T1,7
	PBOUT
> ;TOPS-20
T10,	OUTCHR	[7]
	MOVE	[POINT 7,TTBU]	;Reset byte pointer
	MOVEM	TTPT
	JRST	CHK1		;Wait and return

CHK3:	SETZ	T0,
	IDPB	T0,TTPT		;Ensure a null

	MOVE	T1,[POINT 7,TTBU] ;Read back the string
	MOVEM	T1,TTPT		;Reset for next time
	ILDB	T0,T1		;Get first character

	CAIN	T0,"W"		;Wait
	 JRST	.WAIT		; Yes
	CAIN	T0,"S"		;Set
	 JRST	.SETEX		; Yes
	CAIN	T0,"A"		;Accumulative
	 JRST	.ACC
	CAIN	T0,"I"		;Incremental
	 JRST	.INC
	CAIN	T0,"E"		;Exit
	 JRST	.EXIT
	CAIN	T0,"H"		;Help
	 JRST	.HELP
	CAIN	T0,"R"		;Refresh
	 JRST	.REF
	CAIN	T0,"<"
	 JRST	.LSS
	CAIN	T0,">"
	 JRST	.GTR
	JRST	PBELL

.HELP:	TTY$	$TTCLR		;CLEAR SCREEN
	STR$	HELPM		;TYPE HELP STRING
	DPY$			;DISPLAY IT
T20,	PBIN			;WAIT FOR A CHAR
T10,	INCHRW	T1
	CAIN	T1,"M"-100	;CR?
T20,	 PBIN			; YES, SNARF LF
T10,	 INCHRW	T1
	JRST	SETEX1

HELPM:	ASCIZ	&         Network Management Listener Display program (NMLDPY)
                        (SHOW ACTIVE CIRCUITS)

	A	Set accumulative mode (default)
	E	Exit
	H	Help
	I	Set incremental mode
	R	Refresh
	SEnode	Set executor (default = self)
	Wn	Wait n seconds between samples (default = 3 seconds)
	>	Scroll devices to the left
	<	Scroll devices to the right

	Flags:
	I	Incremental mode
	>	More devices to the right
	<	More devices to the left

Bugs/suggestions to:	Bob Brown <RBROWN@MRSMEG> or Phil Budne	<BUDNE@MRFORT>

                    o  Type something to continue&

.REF:	REF$
	JRST	CHK

.INC:	SETOM	INC		;Set incremental flag
	TRNA
.ACC:	 SETZM	INC		;Set accumulative output
	JRST	CHK

.GTR:	AOSA	FIRST
.LSS:	 SOSL	FIRST
	  JRST	CHK
	SETZM	FIRST
	JRST	PBELL

.EXIT:	CALL	CLOSN		;Close link
	CALL	OECH		;Turn on echo
	TTY$	$TTCLR		;CLEAR SCREEN
T20,	HALTF
T10,	EXIT	1,
	JRST	START

;Adjust wait time
.WAIT:	MOVEI	T3,^D10		;Decimal
	NIN
	 ERJMP	PBELL		;Error
	CAIG	T2,^D<60*5>	;Less than 5 minutes
	 SKIPG	T2		;Must be positive, non-zero
	  JRST	PBELL
	IMULI	T2,^D1000	;Make into milli-seconds
	MOVEM	T2,WTIM		;Set up ne time
	JRST	CHK		;All ok

;Set EXEC
.SETEX:	ILDB	T1		;Get next character
	CAIE	"E"		;SE?
	 JRST	PBELL		; Nope
	MOVE	T2,[POINT 7,EXECU]
	ILDB	T0,T1
	IDPB	T0,T2
	JUMPN	T0,.-2		;Copy node name
	SETZM	INC		;DUE TO BUG IN FIRST REFRESH! /PLB
	SETZM	FIRST		;NO SCROLL

SETEX1:	CALL	CLOSN
	CALL	RES
	CALL	OPN
	RET

;Read a buffer from the NML
REABUF:	MOVEI	C,0		;Start with line 0
REABF1:	MOVE	T1,NJFN		;Network JFN
	MOVE	T2,[POINT 8,BUF]
	MOVNI	T3,400
	SINR
	 ERJMP	ERR
	MOVE	B,[POINT 8,BUF]	;Set up buffer pointer
	ILDB	T1,B		;Get status of buffer
	CAIN	T1,2		;Continuation bit set ?
	 JRST	REABUF		;Yes, read next buffer

	CAIE	T1,1		;All ok ?
	 JRST [	SETOM	DONE
		MOVEM	C,COLMS
		RET ]

	IBP	B		;GET
	IBP	B		;GET
	IBP	B		;NULL
	CALL	GETD		;Get device name

REABF2:	CALL	REAP		;Read the parameters (counters)
	 JRST	REABF3
	CALL	BLDN
	MOVEM	T2,NUM
	CALL	OUTVAL
	JRST	REABF2		;Loop

REABF3:	AOJA	C,REABF1

;Check if counter has a line number assigned

OUTVAL:	MOVEI	L,0		;Line number
OUTVA0:	CAIL	L,MAXLIN	;IN RANGE?
	 HALT	.		; DIE AWFUL DEATH
	SKIPGE	T2,LINNUM(L)	;End of list ?
	 JRST	OUTVA3		; Not in current table
	CAME	T2,CTYPE	;Match our register number ?
	 AOJA	L,OUTVA0	; No, loop
	MOVE	T4,L
	ADD	T4,SAVTAB(C)	;Compute address of entry

OUTVA2:	MOVE	T0,NUM		;GET NUMBER
	SKIPE	INC		;INCREMENTAL?
	 SUB	T0,SAVOFF(T4)	; YES, FIND CHANGE
	MOVEM	T0,(T4)		;STORE NEW VALUE
	MOVE	T2,NUM		;GET NEW NUMBER
	MOVEM	T2,SAVOFF(T4)	;SAVE AS OLD
	RET

;Found a counter we have not seen before
OUTVA3:	MOVE	T0,CTYPE	;Get counter number
; ***** EXPERIMENTAL
	MOVSI	T4,-ITEMS
	CAME	T0,NUMTAB(T4)
	 AOBJN	T4,.-1
	JUMPGE	T4,CPOPJ	;IF NOT KNOWN, IGNORE
; ***** EXPERIMENTAL
	MOVEM	T0,LINNUM(L)	;Store it
	MOVE	T4,SAVTAB(C)	;Compute address of entry
	ADDI	T4,(L)
	JRST	OUTVA2

DISPLAY:
	STR$	[ASCIZ /Node: /]
	STR$	EXECU

T20,<	STR$	[ASCIZ/		Load: /]
	MOVE	T1,[14,,14]	;1 MIN LOAD AVG
	GETAB
	 ERJMP	ERR
	MOVE	T2,T1
	CALL	.PFLT
>;End of TOPS-20 stuff

	STR$	[ASCIZ /	/]
	CALL	.PTIM		;TYPE THE TIME
	STR$	[ASCIZ /   /]
	MOVE	T1,WTIM		;GET WAIT TIME
	CAIN	T1,WAITIME	;DEFAULT?
	 JRST	DISP.I		; YEP
	HRROI	T1,STRBUF
	MOVE	T2,WTIM
	IDIVI	T2,^D1000
	MOVEI	T3,^D10
	NOUT
	 JRST	DISP.I
	SETZ	T2,
	IDPB	T2,T1
	CHI$	"W"
	STR$	STRBUF

DISP.I:	SKIPE	INC
	 CHI$	"I"
	SKIPE	FIRST
	 CHI$	"<"		;>
	MOVE	T1,FIRST	;GET FIRST DISPLAYED
	ADDI	T1,NUMCOL	;GET LAST DISPLAYED
	CAMGE	T1,COLMS	;MORE TO SEE? <
	 CHI$	">"		;SAY SO
	CALL	CRLF		;END LINE 1
	CALL	DODISP
	DPY$			;REDISPLAY
	RET

CRLF:	STR$	[ASCIZ /
/]
	RET

DODISP:	SKIPN	C,COLMS		;ANY COLMS TO DISPLAY?
	 RET			; NOPE
	CAMGE	C,FIRST		;IN RANGE OF DISPLAYED COLMS?
	 RET			; NOPE
	SUB	C,FIRST		;GET COUNT OF COLMS
	CAILE	C,NUMCOL	;LESS THAN MAX?
	 MOVEI	C,NUMCOL	; NO, LIMIT TO <N> PER SCREEN
	MOVNI	C,(C)		;GET -N
	MOVSI	C,(C)		;GET -N,,0
	HRR	C,FIRST		;GET -N,,FIRST
	MOVEM	C,COLAOB	;SAVE AOBJN PTR
	CALL	HEADER
	SETZ	L,
LINLOP:	MOVE	C,COLAOB
	SKIPGE	T1,LINNUM(L)	;GET COUNTER NUMBER
	 PJRST	CRLF		; DONE
	CALL	TYPNAM		;TYPE COUNTER NAME
DSPLOP:	MOVE	T2,SAVTAB(C)	;GET ADDRESS OF SAVE BLOCK
	ADDI	T2,(L)		;ADD INDEX
	SKIPE	T2,(T2)		;COUNTER VALUE IS ZERO?
	 JRST	DL.1		; NO
	MOVEI	T1,COLWID	;YES, PAD WITH SPACES
DL.0:	CHI$	" "
	SOJG	T1,DL.0
	JRST	DSPBOT

DL.1:	CHI$	" "		;LEADING SPACE
	HRROI	T1,STRBUF	;STORE RESULT HERE
	MOVX	T3,<NO%MAG!NO%AST!FLD(<COLWID-1>,NO%COL)!^D10> ;MAGNITUDE
	NOUT			;* ON ERROR, N-1 COLS, DECIMAL NUMBER OUTPUT
	 ERJMP	ERR		; SIGH!
	SETZ	T2,		;ENSURE
	IDPB	T2,T1		;ASCIZ
	STR$	STRBUF		;OUTPUT TO SCREEN IMAGE

DSPBOT:	AOBJN	C,DSPLOP	;LOOP FOR ALL COLS
	CALL	CRLF		;TERMINATE LINE
	AOJA	L,LINLOP	;LOOP FOR ALL LINES

HEADER:	MOVEI	T1,HDRWID
HD.0:	CHI$	" "
	SOJG	T1,HD.0
HDRLOP:	MOVE	T1,DEVSTR(C)	;GET DEVICE NAME BP
	MOVEI	T3,COLWID-1	;WIDTH
	CHI$	" "
HD.1:	ILDB	T2,T1
	JUMPE	T2,HD.2
	CHI$	(T2)
	SOJG	T3,HD.1
	JRST	HD.3
HD.2:	CHI$	" "
	SOJG	T3,HD.2
HD.3:	AOBJN	C,HDRLOP
	CALL	CRLF
	RET

; T1/ COUNTER NUMBER
TYPNAM:	MOVSI	T2,-ITEMS
TYN.1:	CAME	T1,NUMTAB(T2)
	 AOBJN	T2,TYN.1
	JUMPGE	T2,TYN.2
	MOVE	T1,STRTAB(T2)
	JRST	TYN.3

TYN.2:	MOVE	T2,T1
	HRROI	T1,STRBUF
	MOVX	T3,<NO%MAG!^D10>
	NOUT			;UNKNOWN REGISTER PRINT NUMBER
	 ERJMP	ERR
	MOVEI	T2,"."
	IDPB	T2,T1
	SETZ	T2,
	IDPB	T2,T1
	MOVEI	T1,STRBUF
TYN.3:	HRLI	T1,(POINT 7,)
	MOVEI	T2,HDRWID-1
TYN.5:	ILDB	T3,T1
	JUMPE	T3,TYN.4
	CHI$	(T3)
	SOJG	T2,TYN.5
	CHI$	"!"		;RAN OUT OF SPACE
	RET

TYN.4:	CHI$	" "
	SOJG	T2,TYN.4
	CHI$	" "
	RET

CLOSN:	MOVE	T1,NJFN		;Close the network connection
T20,<	CLOSF
	 ERJMP	.+1
>;End of TOPS-20 stuff

T10,<	HRRM	T1,SDBLK+.NSACH	;Store channel number
	MOVEI	T1,SDBLK
	NSP.	T1,
	 JRST	ERR
>;End of TOPS-10 stuff

	SETZM	NJFN
	RET

;Turn off OR back to orginal echo
T20,<
OECH:	TDZA	T2,T2
NECH:	 MOVEI	T2,TT%ECO	;Kill echo
	ANDCA	T2,TTPAR	;Original settings
	MOVEI	T1,.PRIIN	;Get JFN
	SFMOD			;Do it
	RET
>;End of TOPS-20 stuff

T10,<
OECH:	TDZA	T1,T1
NECH:	 MOVEI	T1,IO.SUP
	SETSTS	TTYCHN,(T1)
	 TRN
	RET
>;End of TOPS-10 stuff

;Reset the data base
RES:	SETZM	DONE

	SETOM	LINNUM
	MOVE	T1,[LINNUM,,LINNUM+1]
	BLT	T1,LINNUM+MAXLIN-1 ;No counters as yet

	SETZM	SAVBUF
	MOVE	T1,[SAVBUF,,SAVBUF+1]
	BLT	T1,ENDSAV
	RET

;Open the network connection

OPN:	SETZM	DONE
T20,<	MOVE	T1,[POINT 7,DCNBLK] ;Destination
	MOVE	T2,[POINT 7,[ASCIZ/DCN:/]]
	CALL	OPN1
	MOVE	T2,[POINT 7,EXECU]
	CALL	OPN1
	MOVE	T2,[POINT 7,[ASCIZ/-19;BDATA:003000000/]]
	CALL	OPN1
	SETZ	T0,
	IDPB	T0,T1

	MOVSI	T1,(GJ%SHT)
	HRROI	T2,DCNBLK
	GTJFN			;Open link to node
	 ERJMP	ERR
	HRRM	T1,NJFN
	MOVX	T2,<FLD(^D8,OF%BSZ)+OF%RD+OF%WR>
	OPENF
	 ERJMP	ERR

;Wait for DECNET connection to complete
WATCON:	MOVE	T1,NJFN
	MOVEI	T2,.MORLS	;READ LINK STATE
	MTOPR
	 ERJMP	ERR
	TXNE	T3,MO%CON	;CONNECTED?
	 RET			; All ok.
	TXNN	T3,<MO%WFC!MO%WCC>
	 JRST	OPNERR		;Still waiting ?
	MOVEI	T1,^D500
	DISMS
	JRST	WATCON		;Wait some more

OPNERR:	TMSG	<CONNECT FAILED, REASON >
	MOVEI	T1,.PRIOU
	MOVEI	T2,(T3)
	MOVEI	T3,^D10
	NOUT
	 TRN
	TMSG	<
>
	JRST	ERR

OPN1:	ILDB	T0,T2
	JUMPE	T0,CPOPJ
	IDPB	T0,T1
	JRST	OPN1
>;End of TOPS20 stuff

T10,<	MOVE	T1,[POINT 7,EXECU] ;Copy node name over
	MOVE	T2,[POINT 8,TENEXU+1] ;Into TOPS-10 land
	MOVEI	T3,0		;None, yet
OPN1:	ILDB	T0,T1		;GET CHARACTER
	IDPB	T0,T2		;STORE
	CAIE	T0,0		;DONE?
	 AOJA	T3,OPN1		; NO, LOOP
	HRLM	T3,TENEXU	;DESTINATION NODE NAME CHAR COUNT

;Establish the link
	MOVEI	T1,EABLK	;Point to argument block
	NSP.	T1,		;Open link
	 JRST	ERR		;Sorry
	HRRZ	T1,EABLK+.NSACH	;Get channel number
	MOVEM	T1,NJFN		;Save
	RET			;DONE
>;End of TOPS-10 stuff

ERR:
T20,<
	MOVEI	T1,.PRIOU
	HRLOI	T2,.FHSLF
	SETZ	T3,
	ERSTR
	 ERJMP	.+2
	 ERJMP	.+1
	HALTF
>;End of TOPS-20 stuff

T10,<
	OUTSTR	[ASCIZ/DEATH!!!!/]
	EXIT	1,
>
	JRST	START
	SUBTTL	GETD - Get device name and set up a column

GETD:	SKIPE	DONE		;Still setting up ?
	 JRST	GETD1		; No
	MOVE	T4,DEVSTR(C)	;Get byte pointer
	ILDB	T3,B		;Get length of string

GETD0:	ILDB	T0,B		;Get character
	IDPB	T0,T4		;Store
	SOJG	T3,GETD0	;Loop
	SETZ	T0,
	IDPB	T0,T4		;Ensure null
	RET

GETD1:	ILDB	T3,B		;Get length of string
GETD2:	IBP	B		;Get character
	SOJG	T3,GETD2	;Loop
	RET
	SUBTTL	REAP - Read a parameter

REAP:	ILDB	P1,B		;Get low order byte
	ILDB	T2,B		;Get high order byte
	DPB	T2,[POINT 8,P1,27] ;Combine into 16 bit field
	TRNN	P1,D%POC	;Parameter or counter?
	 RET			; None

;We have some counter data
	LDB	T1,[POINT 12,P1,35] ;Get type of counter
	MOVEM	T1,CTYPE
;;	TRNE	P1,D%BIT	;Bit mapped field ?
;;	 JRST	ERR		;Yes, sorry
	AOS	(P)
	RET


	SUBTTL	BLDN - Build number
BLDN:	LDB	T1,[POINT 2,P1,22] ;Get counter size
	SETZ	T2,		;Start with zero
	JUMPE	T1,CPOPJ	;None

	ILDB	T0,B		;Get byte
	DPB	T0,[POINT 8,T2,35] ;Low order byte
	SOJE	T1,CPOPJ	;Any more?

	ILDB	T0,B		;Get byte
	DPB	T0,[POINT 8,T2,27] ;2nd order bit
	SOJE	T1,CPOPJ	;more?

	ILDB	T0,B		;Get byte
	DPB	T0,[POINT 8,T2,19] ;3rd order bit
	ILDB	T0,B
	DPB	T0,[POINT 8,T2,11]
CPOPJ:	RET
	SUBTTL	Text and tables

DEFINE	SSS <
	SS	0,   <Seconds since last zeroed>
	SS	800, <Terminating packets received>
	SS	801, <Originating packets sent>
	SS	802, <Terminating congestion loss>
	SS	805, <Corruption loss>
	SS	810, <Transit packets received>
	SS	811, <Transit packets sent>
	SS	812, <Transit congestion loss>
	SS	820, <Circuit down>
	SS	821, <Initialization failure>
	SS	1000,<Bytes received>
	SS	1001,<Bytes sent>
	SS	1002,<Multicast bytes reeived>
	SS	1010,<Data blocks received>
	SS	1011,<Data blocks sent>
	SS	1012,<Multicast blocks received>
	SS	1013,<Blocks sent, deferred>
	SS	1014,<Blocks sent, single collisions>
	SS	1015,<Blocks sent, multiple collisions>
	SS	1020,<Data errors inbound>
	SS	1021,<Data errors outbound>
	SS	1030,<Remote reply timeouts>
	SS	1031,<Local reply timeouts>
	SS	1040,<Remote buffer errors>
	SS	1041,<Local buffer errors>
	SS	1050,<Selection intv. elapsed>
	SS	1051,<Selection timeouts>
	SS	1060,<Send failure>
	SS	1061,<Collision detect failure>
	SS	1062,<Receive failure>
	SS	1063,<Unrec. frame destination>
	SS	1064,<Data overun>
	SS	1065,<System buffer unavailable>
	SS	1066,<User buffer unavailable>
	SS	1100,<Remote station errors>
	SS	1101,<Local station errors>
	SS	1240,<Locally init. resets>
	SS	1241,<Remotely init. resets>
	SS	1242,<Network init. resets>
	SS	-1,<SHOULD NEVER HAPPEN>
> ;SSS

DEFINE	SS(N,S) <DEC N>
NUMTAB:	XLIST
	SSS
	LIST

DEFINE	SS(N,S) <[ASCIZ /S/]>
STRTAB:	XLIST
	SSS
	LIST
ITEMS==.-STRTAB-1
	SUBTTL	Initialization

INIT:	MOVEI	T1,WAITIME
	MOVEM	T1,WTIM

T20,<	MOVEI	T1,.NDGLN	;GET LOCAL NODE STRING
	MOVEI	T2,T3		;ARG BLOCK
	HRROI	T3,EXECU	;SET EXECUTOR TO OURSELF
	NODE
	 ERJMP	ERR
	MOVEI	T1,.PRIOU
	RFMOD			;Get ORIGINAL TTY paramters
	MOVEM	T2,TTPAR	;Store them
>;End of TOPS-20 stuff

T10,<	DMOVE	T1, [T2		;ADDR OF ARG BLOCK
		     DN.FLE!<.DNLNN,,3>] ;LIST KNOWN NODES/EXECUTOR,,LEN
	DNET.	T1,
	 TRNA			; FAILURE!
	  SKIPN	T3, T4		;  GET ANYTHING?
	   HALT	.		;   DIE!!

	MOVE	T1, [POINT 7, EXECU] ;CONVERT SIXBIT TO ASCIZ
SU.LOP:	SETZ	T2,
	LSHC	T2, 6
	ADDI	T2, " "
	IDPB	T2, T1
	JUMPN	T3, SU.LOP
	IDPB	T3, T1

	GETPPN	T1,		;GET OUR PPN
	 TRN			;STUPID SKIP
	MOVEM	T1,OURPPN	;STORE FOR PDB

	OPEN	TTYCHN,[.IOASC!IO.SUP ;ASCII MODE, NO ECHO
			SIXBIT /TTY/ ;OUR TTY
			0,,0]	;NO BUFFERS
	 HALT	.
>;End of TOPS-10 stuff

	MOVE	T0,[POINT 7,TTBU]
	MOVEM	T0,TTPT
	CALL	RES		;CLEAR TABLES
	CALL	NECH		;TURN OFF ECHO
	RET

T20,<
;Print floating number (used for Load avg)
.PFLT:	HRROI	T1,STRBUF
	MOVX	T3,<FL%ONE!FL%PNT!FLD(2,FL%FST)!FLD(2,FL%SND)>
	FLOUT
	 ERJMP	R
	SETZ	T2,
	IDPB	T2,T1
	STR$	STRBUF
R:	RET

.PTIM:	HRROI	T1,STRBUF
	SETO	T2,
	SETZ	T3,
	ODTIM
	SETZ	T2,
	IDPB	T2,T1
	STR$	STRBUF
	RET
>;End of TOPS-20 stuff

SUBTTL TOPS-10 routines

T10,<
;Output date/time (stolen from SCAN)
.PTIM:	DATE	T1,		;GET TODAY'S DATE
	IDIVI	T1,^D31		;GET DAYS
	MOVE	T4,T1		;SAVE REST
	MOVEI	T1,1(T2)	;GET DAYS AS 1-31
	MOVEI	T2," "		;FILL WITH SPACE
	PUSHJ	P,.TDEC2	;TYPE IN DECIMAL
	IDIVI	T4,^D12		;GET MONTHS
	STR$ [	ASCIZ /-Jan/
		ASCIZ /-Feb/
		ASCIZ /-Mar/
		ASCIZ /-Apr/
		ASCIZ /-May/
		ASCIZ /-Jun/
		ASCIZ /-Jul/
		ASCIZ /-Aug/
		ASCIZ /-Sep/
		ASCIZ /-Oct/
		ASCIZ /-Nov/
		ASCIZ /-Dec/ ](P1) ;GET ASCII
	MOVEI	T1,^D64(T4)	;GET YEAR SINCE 1900
	IDIVI	T1,^D100	;GET JUST YEARS IN CENTURY	[257]
	MOVE	T1,T2
	CHI$	"-"
	CALL	TDEC2Z
	CHI$	" "

	MSTIME	T1,		;GET CURRENT TIME
	IDIV	T1,[^D3600000]	;GET HOURS
	MOVE	T4,T2		;SAVE REST
	MOVEI	T2," "		;FILL WITH SPACE
	PUSHJ	P,.TDEC2	;TYPE TWO DIGITS
	CHI$	":"
	MOVE	T1,T4		;RESTORE REST
	IDIVI	T1,^D60000	;GET MINS
	MOVE	T4,T2		;SAVE REST
	PUSHJ	P,TDEC2Z	;TYPE TWO DIGITS WITH 0 FILLER
	CHI$	":"
	MOVE	T1,T4		;RESTORE THE REST
	IDIVI	T1,^D1000	;GET SECONDS
TDEC2Z:	MOVEI	T2,"0"		;FILL WITH 0
				;FALL INTO .TDEC2

;.TDEC2 -- TYPE DECIMAL AT LEAST TWO DIGITS
;CALL:	SAME AS .TDECW WITH T2=FILLER CHAR (" " OR "0")

.TDEC2:	CAIG	T1,^D9		;SEE IF ONE DIGIT
	 JRST	DEC2.1
	IDIVI	T1,^D10
	CHI$	"0"(T1)
	JRST	DEC2.2
DEC2.1:	EXCH	T1,T2		;GET FILLER
	CHI$	(T1)
DEC2.2:	CHI$	"0"(T2)		;CONVERT DIGIT
	RET

;Input a DECNET record
.SINR:	MOVEM	T2,DRBLK+.NSAA2	;Byte pointer to buffer
	MOVNM	T3,DRBLK+.NSAA1	;Max byte count
	MOVE	T3,NJFN		;Get channel number
	HRRM	T3,DRBLK+.NSACH
	MOVEI	T1,DRBLK
	NSP.	T1,
	 JRST	ERR
	RET

;Output a record
.SOUTR:	MOVNM	T3,DSBLK+.NSAA1		;Byte count
	MOVEM	T2,DSBLK+.NSAA2		;Byte pointer
	MOVE	T1,NJFN			;Get output channel
	HRRM	T1,DSBLK+.NSACH		;Store in NSP argument block
	MOVEI	T1,DSBLK		;Point to block
	NSP.	T1,
	 JRST	ERR
	RET

;Input a number
.NIN:	SETZ	T2,		;Clear number field
.NIN1:	ILDB	T0,T1		;Get character
	CAIG	T0,"9"		;Above 9
	 CAIGE	T0,"0"		; Or less than 0 ?
	  JRST	.NIN2		;  Yes
	SUBI	T0,"0"		;Make into a number
	IMULI	T2,^D10		;MAKE ROOM
	ADD	T2,T0		;Add in
	JRST	.NIN1

.NIN2:	CAIN	T0,15		;Carriage return
	 RET			;Yep, done
	JRST	ERR		;No, error

;Fake out the NOUT jsys

.NOUT:	CALL SAVAC		;SAVE ACS DURING "JSYS"
	HRRZ T4,T3		; Get radix
	CAIL T4,2
	CAILE T4,^D10+^D26	; Must be 2 - 36
	 JRST ERR
	HLL T4,T3		; Save flags in T4 too
	LDB F,[POINT 8,T4,17]	; Extract column width
	MOVEI Q3,1		; Initilize digit counter
	TLNN T4,(1B0)		; Magnitude printout?
	CAIL T2,0		; Or positive number?
	TLZA T4,(1B6)		; Yes, remember not minus sign
	TLO T4,(1B6+1B1)		; No, remember minus sign
	TLNE T4,(1B6)		; - sign to be printed?
	MOVMS T2			; Yes complement number
	TLNE T4,(1B1)		; A sign of some sort to be printed?
NOUT1:	AOS Q3			; Yes, count as digit
	LSHC T2,-^D35		; Make into double
	LSH T3,-1		; Length dividend
	DIVI T2,(T4)		; Produce a digit
	PUSH P,T3		; Save on stack
	JUMPN T2,NOUT1		; Repeat until all digits generated
	CAIN F,0		; Zero field width specified?
	MOVE F,Q3		; Yes, make it same as number of digits
	TLNE T4,(1B2)		; Right justify number?
NOUT2:	CAML Q3,F		; And filler needed?
	JRST NOUT3		; No
	TLNE T4,(1B3)		; Yes. leading 0's?
	CALL SGNOUT		; Yes, output sign now
	MOVEI T2," "		; Get a space
	TLNE T4,(1B3)		; Unless 0's wanted
	MOVEI T2,"0"		; Then get a 0
	CALL BOUTA		; Call bout so strings will work
	SOJA F,NOUT2		; Decrease remaining width and loop

NOUT3:	CAML F,Q3		; Sufficient room?
	JRST NOUT4		; Yes
	JRST	ERR
;	MOVEI T2,NOUTX2		; Error
;	MOVEM T2,LSTERR
	TLNN T4,(1B4)		; Print something anyway?
	JRST NOUT7		; No, go away
	TLNN T4,(1B5)		; Asterisks?
	JRST NOUT4		; No, print the whole number
	MOVEI T2,"*"		; Yes,
NOUT6:	SOJL F,NOUT7		; Column filled
	CALL BOUTA
	JRST NOUT6

NOUT7:	TLNE T4,(1B1)		; If one position reserved for -,
	SOS Q3			; One less thing on stack
NOUT71:	SOJL Q3,RESAC		; Return if done
	POP P,T2
	JRST NOUT71

NOUT4:	CALL SGNOUT		; Output sign before number
NOUT5:	SOJL Q3,NOUT8		; Any digits left?
	POP P,T2			; Yes, get one
	ADDI T2,"0"
	CAILE T2,"9"
	ADDI T2,"A"-"9"-1
	CALL BOUTA		; Print it
	SOJA F,NOUT5		; Decrease field width

NOUT8:	SKIPL F
	AOS (P)			; Skip if no error
	MOVEI T2," "
	JRST NOUT6		; Insert trailing blanks if necessary

SGNOUT:	TLZN T4,(1B1)		; Sign still needed?
	RET			; No, return immediately
	MOVEI T2,"-"
	TLNN T4,(1B6)
	MOVEI T2,"+"
	CALL BOUTA
	SOS Q3			; Decrement digit count
	SOS F			; Decrement remaining field width
	RET

;Output byte to buffer
BOUTA:	CAIN	T1,.PRIOU	;Primary output device ?
	 JRST [	OUTCHR	T2	;Yes, just send to terminal
		RET ]
	TLCE	T1,-1
	 TLCN	T1,-1
	  HRLI	T1,(POINT 7,)
	IDPB	T2,T1		;Store character in buffer
	RET

;Save AC's during JSYS (T3 - 16)
SAVAC:	MOVEM	T3,ACSAV+T3
	MOVE	T3,[XWD T4,ACSAV+T4]
	BLT	T3,ACSAV+16
	MOVE	T3,ACSAV+T3
	RET

RESAC:	MOVE	T3,[XWD ACSAV+T4,T4]
	BLT	T3,16
	MOVE	T3,ACSAV+T3
	RET
>;End of TOPS-10 routines

JUNK:	END	START