Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	title KDPDPY -- DPY program to display KMC/DUP status

	sall
	search	jobdat		;get job-data area definitions
	search	dpydef		;get dbell's dpy definitions
	search	uuosym		;get tops-10's uuo definitions
	search	netprm		;get kmc/dup block offsets
	search	macten		;get macro definitions

	.text	"/locals/symseg:high"	;keep symbols around
	.require dpy		;make sure dpy gets loaded

	twoseg	600000		;two segment assembly

	kdywho==0		;who edited kld.mac last
	kdyver==1		;major version number
	kdymin==0		;minor version number
	kdyedt==12		;edit number

	loc	<.jbver>	;go to the version number
	vrsn.	kdy		;assemble in the version number

	purge	kdywho, kdyver, kdymin, kdyedt

	reloc	600000		;start in the high seg.

	radix	10		;beware...

;registers

	p=15			;required by dpy

	t1=1			;temporary registers
	t2=2			;  ususally used by the
	t3=3			;  print routines
	t4=4

	num=5			;number to print for "outnum"
	bas=6			;base for "outnum" to print number in
	wid=7			;width of field for outnum. zero = any,
				;  minus means left justify.
	fil=8			;char to use for filler.

	kdl=9			;pointer to the "kdl page" (ala netprm)

	pdllen==100		;use a big stack
	$tty==2			;tty's I/O channel
	tyobsz==400		;tty's output buffer size


;character definitions

	$cr==^o15		;carriage return
	$lf==^o12		;line feed
	$sp==^o40		;space
	$zr==^o60		;zero

	subttl macros

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 wid,0>	;;default width to "any"
    ifnb <qwid>,<movei wid,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 origioned)
	pushj	p,pgoto		;;call "goto" routine to get there
>

define err(text)<		;;call if fatal error (no kdp. uuo etc.)
	jrst	[outstr [asciz |text|]
		 exit]
>

	subttl byte pointers into the kdl block

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

;this is the konstant that determines how long we sleep

sltime:	exp	10		;ten seconds

	subttl 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	initialization

go:	jfcl
	reset			;close all dev's
	move	p,[iowd pdllen,pdl] ;set up stack pointer
	move	t1,[pushj p,dpyuuo]	;pushj to the uuo handler
	movem	t1,.jb41	;set up the uuo  handler

	pushj	p,ttyini	;initialize the tty.

	ini$	[exp 2		;2 more args
		 exp 0		;use dpy's impure storage
		 exp dpyerr]	;here if dpy screws up
	set$	[xwd $sechr,ttyouc] ;use our character output routine
	set$	[xwd $seuda,1]	;have dpy not save it's ac's when it calls
	siz$			;use full screen
	ref$	re$clr		;clear the screen


loop:	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.
	dpy$	dp$noh		;update the screen, but don't home up
	pushj	p,ttyfrc	;force out any buffered chars
	move	t1,sltime	;get number of seconds to sleep
	imuli	t1,1000		; and convert to ms
	skipg	t1		;if time is unreasonable,
	movei	t1,1		; then be as quick as possible.
	tlo	t1,(hb.rtc)	;wake on char ready from tty
	hiber	t1,		;now go to sleep
	  err	? KDL. Hiber UUO failed.
	inchrs	t1		;see if the user typed a char
	jrst	loop		;if no char, do it again
	andi	t1,^O177		;mask of parity
	caie	t1,"Z"-^O100	;if it's an ^Z, or
	cain	t1,"C"-^O100	; an ^c,
	caia			; then exit
	jrst	loop		;other wise just refresh the screen
	ini$	[exp 0]		;clean up & clear the screen
	monrt.			;exit if a char was typed
	jrst	go		;re-start on a "continue"

	subttl	kdldpy -- routine to output 11 lines of kdl information

;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

	subttl	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
	crlf				;end of the first line.

	subttl	Line 2.

line2:	goto	ctocol+2		;go to the 62nd column
	text	<KMC Control Outs>	;write header
	crlf				;end of line 2

	subttl	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	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	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	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	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 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	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	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	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

cpopj1:	aos	(p)			;give good return
cpopj:	popj	p,			;end of display

	subttl utility routines called by macros

;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
	sojl	t1,cpopj	;exit if we've got there
	chi$	$sp		;print a space
	jrst	.-2		;loop till all characters are out


;outnum	prints a number.  Called by the "number" macro
;call	num := number to print
;	bas := base to print number in
;	wid := 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	wid,outnu2	;if not right justified, don't pad beginning

	movei	t2,(wid)	;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	wid,cpopj3	;exit if not left justified

	add	t3,wid		;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.



;dpyerr	here on a error from dpy
dpyerr:	err	? Random dpyerr.

	subttl	terminal handling routines

ttyini:	open	$tty,[exp .iopim
		      sixbit /TTY/
		      xwd ttyobf,0] ;open tty in packed image mode.
	  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 8,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:	exch	t1,(p)		;get the char, save t1
ttyou1:	sosge	ttyobf+.bfctr	;count out the next character
	jrst	[pushj p,ttyfrc	;if no room, force out the current buffer
		 jrst ttyou1]	;  and try again
	idpb	t1,ttyobf+.bfptr;store the character
	pop	p,t1		;restore DPY's ac
	popj	p,		;  and return

ttyfrc:	out	$tty,		;do the output
	popj	p,		;return if successful
	err	? TTY output I/O error.

	subttl impure storage

	reloc	0		;go to the low seg

pdl:	block	pdllen+1	;our stack
kdlpag:	block	kdlest+1	;just long enough to hold status
ttyobf:	block	3		;tty output buffer control block
obf1:	block	tyobsz+3	;tty output buffer

	end	go