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 , ;;use number only if specified ifb , ;;default base to 10 (decimal) ifnb , ifb , ;;default width to "any" ifnb , ifb , ;;default filler to "spaces" ifnb , 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>+ > 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 +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 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 ;write header crlf ;end of line 2 subttl Line 3. line3: goto msgcol-2 ;message column text goto nakcol+2 text goto ctocol ;go to control out column text ;abort message counts number kdlcto+0(kdl),10,5 ;5 char number right justify crlf ;end of line 3 subttl Line 4. line4: text ;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 ;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 ;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 ;illegal header is next number kdlcto+1(kdl),10,5 ;5 digits crlf subttl line 5. line5: text ;last message assigned ldb t1,kdllma ;get the value number t1,8,3,$zr ;three digit octal goto msgcol ;message counts next text ;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 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 ;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 ;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 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 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 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 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 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 ;dataset ready changed number kdlcto+4(kdl),10,5 ;output transition count crlf ;end of line 7 subttl line 8. line8: text ;rep counter ldb t1,kdlrpc ;get the count number t1 ;output it goto msgcol ;messages next text ;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 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 ;we screwed the kmc? number kdlcto+5(kdl),10,5 ;output nxm count crlf ;end of line 8 subttl Line 9. line9: text ;the line's timer ldb t1,kdltim ;get the time number t1 ;decimal goto msgcol ;message counts text ;data messages number kdldtr(kdl),10,7 ;received chi$ $sp ;space number kdldtx(kdl),10,7 ;sent goto nakcol ;nak count text ;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 ;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 ;maintenance messages number kdlmar(kdl),10,7 ;received chi$ $sp ;space number kdlmax(kdl),10,7 ;and sent goto nakcol ;nak counts next text ;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 ;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 ;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 ;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