Trailing-Edge
-
PDP-10 Archives
-
bb-x130a-sb
-
d36trc.mac
There are 5 other files named d36trc.mac in the archive. Click here to see a list.
TITLE D36TRC DECnet-10 Trace program
SEARCH DCN,SNUP
XP $ONLY,I.LUO!I.PRM!I.GTT
XP FTDEBUG,0
$INIT TRC
.REQUI REL:SNUP
XP BUFLEN,50000
XP BUFMAX,BUFLEN-5
XP TAKBYT,0
XP LSTBYT,2
$BLOCK BUFFER,<BUFLEN/5>+3 ;The buffer to be used by trace code
$BLOCK FOPBLK,.FOMAX
$BLOCK BUFF,3 ;Buffer header ring
$BLOCK SCBLK,.FXLEN ;Scan block storage
$BLOCK LKBLK,.RBMAX
$BLOCK PTBLK,.PTMAX
$BLOCK NAME,5 ;system's configuration name
$LVAR S.TRAC
$LVAR S.ETRA
$LVAR LOKADR
$LVAR CURBPT
$LVAR CURBYT
$LVAR DWNCNT
$LVAR TIMFLG
$LVAR LINBLK
$LVAR MYJOB
DEFINE POINTS,<
ZZ=.
AT DCNTRA,[MOVEI %T2,BUFFER] ;Snooped in. Add relocation
AT ZERBPT,[POINT 7,BUFFER+3] ;Poked in - add relocation
AT CURBPT,[POINT 7,BUFFER+3] ;Poked in - add relocation
ADDERR=.-ZZ
AT LASBYT,[BUFLEN] ;Poked in - absolute quantity
AT MAXBYT,[BUFMAX] ;poked in - absolute quantity
AT CURBYT,[0] ;poked in - absolute quantity
AT TRAJOB,MYJOB ;Poked in - absolute quantity
AT S.TRAC,S.TRAC ;Poked in - mask
AT S.ETRA,S.ETRA ;Poked in - mask
TOTPNT=.-ZZ
>
DEFINE AT(NAME,STUFF),<
RADIX50 0,NAME
>
$LOSEG
OUTARG: XWD 1,OUTFIL
OUTFIL: .FOOUT
ADVANC 9,9 ;Max 8 breakpoints, 8 symbols
LOCS: POINTS
$BLOCK SNPARG,2+2 ;Argument block for snoop uuo
DEFINE AT(NAME,STUFF),<
EXP STUFF
>
VALS: POINTS
DEFINE SWTCHS,<
SL ETRACE,S.ETRA,TRNM,,FS.OBV
SL TRACE,S.TRAC,TRNM,,FS.OBV
SS ALLTRA,S.TRAC,-1,fs.obv
SS ALLETR,S.ETRA,-1,fs.obv
SS LINEBL,LINBLK,,
>
DOSCAN(MX.)
KEYS TRNM,<TST,XPT,NSP,SCT,USR,NMX>
D36TRC: $SETUP ;Initialize the world
GETFIL:
SETOM LINBLK ;Set only real scan switch to null
MOVE T1,[XWD 4,[
XWD 12,%%FXVE
IOWD MX.L,MX.N
XWD MX.D,MX.M
XWD 0,MX.P]]
CALL .PSCAN## ;intialize for FILIN
TSTRG. [ASCIZ \D36TRC>\]
CALL .FILIN## ;Get a filespec.
SKIPL T1 ;make sure we got a filespec
$WARN FSR,<File spec required>,,,GETFIL
MOVEI T1,SCBLK ;address of my scan block
MOVEI T2,.FXLEN ;length of my scan block
CALL .GTSPC## ;get the specification
MOVE T1,[.FXLEN,,SCBLK] ;args for .STOPB
MOVEI T2,FOPBLK+1 ;open block is hidden in the filop block
MOVE T3,[.RBMAX,,LKBLK] ;lookup block
MOVEI T4,PTBLK ;path block
CALL .STOPB## ;create the lookup and open block stuff
$ERROR BFS,<Bad file spec>
MOVE T1,SCBLK+.FXFLD ;Get the fields field
TXNN T1,FX.UNM ;did he specify a filename?
JRST [MOVSI T1,'TTY' ;No, default to tty
MOVEM T1,FOPBLK+.FODEV
SETZM LINBLK ;Flag line blocking mode
$INFORM DFL,<Defaulting to TTY:/LINEBL>,,,FOSET]
FOSET: MOVX T1,.FOWRT ;function, write it out
MOVX T2,<UU.LBF!.IOASC> ;mode
DMOVEM T1,FOPBLK+.FOFNC ;save as function for filop
MOVSI T1,BUFF ;Output buffer only
MOVSI T2,^D6 ;16 of 'em
DMOVEM T1,FOPBLK+.FOBRH ;Point to the ring headers
MOVEI T1,LKBLK ;Pointer to the lookup block
MOVEM T1,FOPBLK+.FOLEB
;Get our monitor symbols.
MOVE T1,[TOTPNT,,LOCS] ;Pointer to our symbol names
CALL GETADR## ;ask snup what the symbol values are
;Now open our file
MOVE T1,[.FOMAX,,FOPBLK]
FILOP. T1, ;do the enter on the file
$ERROR FEF,<Filop enter failure, >,<flerr. t1,>,t1
MOVE T1,OUTARG ;Output argument
FILOP. T1, ;do the output, to set up the buffer rings.
$ERROR OUF,<Out UUO failed, >,<lerr. t1,>,t1
;Initialize all the various byte pointers and byte counts
SETZM BUFFER+TAKBYT ;Current bytes taken == 0
SETZM BUFFER+LSTBYT ;Current lost bytes == 0
MOVE T1,[POINT 7,BUFFER+3] ;get byte pointer to start of buffer
MOVEM T1,CURBPT ;save as current byte pointer
SETZM CURBYT ;Current byte is byte 0
SETOM DWNCNT ;set downcounter to countedown
PJOB T1, ;Find out what job I am
MOVEM T1,MYJOB ;save it for later pokes.
MOVEI T1,1 ;An HPQ to put us into
HPQ T1, ;WHAM!
$WARN HPQ,<HPQ set failed>
;Following code must be nailed down.
MOVX T1,1 ;Loseg only, and nail us down to the max
LOCK T1, ;Lock!
$ERROR CNL,<Could not lock, code >,.TOCTW##,T1,ABORT
LSH T1,^D9 ;make it an address, rather than a page
HRRZM T1,LOKADR ;save as displacement into the monitor
MOVEI T4,TOTPNT ;number of addresses to transfer
MOVEI T1,2+1 ;Size of argument block we are feeding it
MOVE T2,CHKSUM ;Get the checksum that GETADR left us
DMOVEM T1,SNPARG ;Save double word in argument list
MOVE T1,LOCS ;get the single breakpoint location
MOVEM T1,SNPARG+2 ;save as address to put first thingy
MOVE T1,@VALS ;get the single breakpoint value
ADD T1,LOKADR ;relocate it.
MOVEM T1,SNPARG+3 ;Save as instruction to execute
MOVE T1,[.SODBP,,SNPARG] ;Argument to define breakpoints
SNOOP. T1, ;define them!
$ERROR BDF,<Breakpoint define failed! Code >,.TOCTW##,T1,ABORT
VALPOK: SUBI T4,1 ;decrement diplacement of word
MOVE T1,LOCS(T4) ;get address of breakpoint
MOVE T3,@VALS(T4) ;get value to put in it
CAIGE T4,ADDERR ;are we processing an addr, or a value?
ADD T3,LOKADR ;address, adjust correspondingly
CAIGE T4,1 ;Is this the last one?
JRST INSBRK ;Yes, go do the snoop this time
MOVE T2,T1 ;Get copy of address
PEEK T2, ;Find out what the monitor has there.
MOVE [3,,T1] ;Arg for poke
POKE. ;poke the location to our value
$ERROR PUF,<Poke UUO failed, Code >,.TOCTW##,T1,ABORT
JRST VALPOK
INSBRK: MOVSI T1,.SOIBP ;Insert the breakpoints!
SNOOP. T1,
$ERROR BIF,<Breakpoint insert failed! Code >,.TOCTW##,T1,ABORT
;Set up for output to our file.
XMOVEI T1,PUTBYT ;address to call on a scan typout
CALL .TYOCH## ;tell scan about it
TLINE. [ASCIZ \DECnet-36 monitor mode trace facility, initialized at\]
SETZM TIMFLG
TCRLF.
SETZM TIMFLG
GTTAB. T1,[%CNFG0] ;get configuration name
MOVEM T1,NAME ;save
GTTAB. T1,[%CNFG1] ;..
MOVEM T1,NAME+1
GTTAB. T1,[%CNFG2]
MOVEM T1,NAME+2
GTTAB. T1,[%CNFG3]
MOVEM T1,NAME+3
GTTAB. T1,[%CNFG4]
MOVEM T1,NAME+4
TSTRG. NAME ;type out system name
TCHRI. 11 ;Indent
TDATN. ;type out today's date
TCHRI. ":"
TTIMN. ;And current time
TCRLF.
SETZM TIMFLG
TCRLF.
;This is where we will spend most of our time
G:
LOOP: SOSL BUFFER+TAKBYT ;get meself a byte
JRST [ CALL GETBYT ;Go move a byte from the buffer to disk
JRST LOOP] ;And do another
AOSLE T1,BUFFER+TAKBYT ;no byte, put it back the way it was
JRST LOOP ;Ah! a byte appeared! try again!
JUMPL T1,[$ERROR BFU,<Buffer fukked up! aborting!>,,,ABORT]
INCHRS T1 ;Get a character if there is one
JRST SNOOZE ;nope, sleep for a while
caie t1,"q" ;quit command?
CAIN T1,"Q" ;Is this a quit command?
JRST ABORT ;yes, exit!!!
SKIPE .JBBPT ;Do we have DDT loaded?
JRST [CAIN T1,"D" ;do we want to do DDT?
JSR @.JBBPT ;Yes, go do it.
JRST LOOP] ;Be forgiving of bad commands if DDT loaded.
OUTSTR [ASCIZ \Unknown command
\]
JRST LOOP
;Note - I want to fix this to have the monitor wake us up.
SNOOZE: MOVX T1,<HB.RTL!HB.RTC!HB.RWJ!HB.RWP!HB.RWT> ;Wake on anything
HIBER T1, ;Go to sleep for a minute
$ERROR HUF,<Hiber UUO failed, aborting>,,,ABORT
JRST LOOP ;Got woken up for something
GETBYT: SKIPN BUFFER+LSTBYT ;did we lose any bytes?
JRST GETBY1 ;nope, proceed
SETZM BUFFER+LSTBYT ;Clean it out.
SKIPL DWNCNT ;Are we already downcounting?
JRST GETBY1 ;yes, we are in sad shape. Ignore this one
MOVX T1,BUFMAX ;Get buffer size
MOVEM T1,DWNCNT ;nastygram that many characters down the road.
GETBY1: SOSN DWNCNT ;number of charracters until nastygrgram
CALL NASTYG ;output a nastygram first
AOS T1,CURBYT ;increment current byte position
CAIGE T1,BUFLEN ;make sure we haven't hit end of buffer
JRST GETBY0 ;get the actual byte
MOVE T1,[POINT 7,BUFFER+3] ;get byte pointer to bottom of buffer
MOVEM T1,CURBPT ;save as current bpt
SETZM T1,CURBYT ;zero current byte position
GETBY0: ILDB T1,CURBPT ;get current byte
PUTBYT: AOSN TIMFLG ;Flag to put out a time-stamp?
JRST [ MOVE P1,T1 ;save the character for a sec
CALL .TTIMN## ;time stamp this line
CALL .TSPAC## ;Separate the message from the timestamp
MOVE T1,P1 ;get character back
JRST .+1] ;fall through
SOSG BUFF+2 ;Decrement count of words avail in buffer
JRST PUTBUF ;put the buffer to ....
DRPBYT: IDPB T1,BUFF+1 ;put the actual byte in the buffer
CAIE T1,^D10 ;Was this a line feed?
POPJ P, ;ordinary character, return now
SETOM TIMFLG ;Yes, flag to do a time-stamp next character
SKIPE LINBLK ;are we in line blocking mode?
POPJ P, ;no.
MOVE T1,OUTARG ;do the output, to get typeout in real time
FILOP. T1, ;OUT!
OUTSTR [ASCIZ \An OUT uuo failed!\]
POPJ P, ;go get another byte
PUTBUF: MOVE T1,OUTARG
FILOP. T1, ;do the output, to set up the buffer rings.
OUTSTR [ASCIZ \An OUT uuo failed!!\]
JRST PUTBYT ;Go put the byte
NASTYG: MOVEI T1,[ASCIZ \
Monitor characters lost.
\]
JRST .TSTRG##
ABORT: CLOSE
EXIT
LIT
END D36TRC