!Program to interpret the $:TRACE special file.
!J. Butler Sep 1984
!Parameters are <context>,<infile>/<outfile>
! defaults: context = current one, infile = $:TRACE, outfile = TT:
include "system:config.inc"
include "inc:fs.imp"
include "inc:util.imp"
ownbyte disflag = 0
ownstring (15) infile = "$:TRACE", outfile = "", param = ""
conststring (7) this fs = "BRAVO"
constinteger trace in length = 23
constinteger repct tab = 56
conststring (19) nocomm = "*** No command ***"
conststring (19) norply = "*** No reply ***"
conststring (19) error = "*** Error ***"
conststring (3) nulltxt = "..."
recordformat trace fm(integer context, inout, string (55) text)
recordformat tbuff fm(integer q,
record (trace fm)array t(0 : tbuffs),
integer p)
constinteger trace in = 0
constinteger trace out = 1
constinteger null = 16_80
constinteger null in = 16_80
constinteger null out = 16_81
constinteger eof = 2
constinteger wait in = 0
constinteger wait out = 1
begin
record (tbuff fm)name tbuff
record (trace fm)name t
record (trace fm) tlast
owninteger s, l, i, blockcount, tbuffptr, first, last, state, type = 0
owninteger context = 0, lowcon = 0, highcon = 0, firstline=0, lastprim = 0
owninteger lastcont = -1, lastinout = -1, col = 1
string (127) command = "", text = "", lastcomm = "", lasttext = ""
routine dumpcount(integername count)
!Dump the count in square brackets tabbed to a constant value, if > 1
!and throw a newline
if count > 0 start
spaces(repct tab - col)
printstring("[") and write(count, 0) and printsymbol(']') unless count = 1
finish
newline; col = 1
end
routine maybe dump header or count
!dumps a heading on-the-fly for the first call, dumps a count otherwise.
!Program will stop printing after printing it if the user has typed a space.
!Program will resume if user types another space, newline etc.
integer c
if firstline = 0 start
newline; col = 1
printstring(this fs); col = col + length(this fs)
printstring(": Trace for context"); write(context, 2)
col = col + 22; spaces(repct tab - col - 4)
printstring("[repeat count]")
newlines(2); col = 1
firstline = 1
else
dumpcount(blockcount)
finish
c = testsymbol
if c <= ' ' start
if c = ' ' start
cycle
c = testsymbol
exit if 0 <= c <= ' '
repeat
finish
finish
end
routine printname(string (*) name command)
!Print the primitive name contained in the supplied string. Two funnies..
!Note if it doesn't recognise the primitive it dumps the first char.
integer primitive
string (63) s
conststring (7) array prim('A':']') = c
"Openmod","Rename ","C ","Delete ","Permit ","Finfo ","General","Uclose ",
"Readbak","Setdir ","Close ","Logon ","Logoff ","Ninfo ","Copyfil","Pass ",
"Quote ","Readda ","Openr ","Openw ","Reset ","V ","Writeda","Readsq ",
"Writesq","Readfil","[ ","¬ ","FSCntrl"
if command = nulltxt start
printstring(" ")
elseif command -> ("Connect").s
printstring("*Conn* ")
elseif command -> ("Disconnect").s
printstring("*Disc* ")
else
primitive = charno(command, 1)
primitive = primitive & 16_df if 'a' <= primitive <= 'z'
if 'A' <= primitive <= ']' then printstring(prim(primitive)) else c
printsymbol(primitive) and spaces(6)
finish
col = col + 7
end
predicate same as last
!Returns true if the command/response pair just read in is the same as
!the last one printed.
false if blockcount = 0 ;!Only true for first time around
true if command = lastcomm and text = lasttext
false
end
record (trace fm) map next valid record(integer state, context,
integername type)
!Return the next interesting record. Ignore records for other contexts
!and flag one of a few error conditions via TYPE.
!TYPE: Tracein, Traceout - normal input records. Return ptr to record and
! advance buffer pointer.
!TYPE: null in, null out - expected an input & got output or vice versa
! Usually indicates missing reply.
!TYPE: eof - End of file.
record (trace fm) name t
while tbuffptr <= last cycle
t == tbuff_t(tbuffptr & tbuffs); tbuffptr = tbuffptr + 1
if context < 0 start
!Intermingled format
type = t_inout ; result == t
elseif t_context = context
if (t_inout = trace in and state = wait in) or c
(t_inout = trace out and state = wait out) start
type = t_inout; result == t
else
tbuffptr = tbuffptr - 1
type = 16_80 ! state ; result == nil
finish
finish
repeat
type = eof; result == nil
end
on 3,9 start ; stop ; finish
! context = rsap
! define int param("Context", context, 0)
! define param("INfile", infile, 0)
! define param("OUTfile", outfile, pam newgroup)
! define param("DISplay", disflag, 0)
! process parameters(cli param)
! open output(1, outfile) %if outfile # ""
param = cli param
to upper(param)
open output(1, outfile) if param -> param.("/").outfile
infile = "$:TRACE" unless param -> param.(",").infile
length(param) = length(param)-1 while charno(param, length(param)) = ' '
param = substring(param, 2, length(param)) while charno(param, 1) = ' '
if param = "" then context = rsap else context = stoi(param)
connect file(infile, 0, s, l)
tbuff == record(s)
if context < 0 then context = 0 and disflag = 1
newline
if disflag = 0 start ;!Display each context in turn
if context = 0 then lowcon = 0 and highcon = 31 else c
lowcon = context and highcon = context
if lowcon # highcon start
printstring("Searching contexts 0-31: You are context")
write(rsap, 3)
newline
finish
for context = lowcon, 1, highcon cycle
blockcount = 0; lastprim = 0
firstline = 0; command = nocomm; lastcomm = "Z"; lasttext = norply
!Note lastcomm. By setting it to "Z" (which there's a good chance it was)
!if the first reply has no command, it will show as a blank not a <nocomm>
first = tbuff_p; last = tbuffs + tbuff_q
state = wait in; tbuffptr = first
!t! write(first, 3); write(last, 3)
cycle
!t! write(state, 3)
t == next valid record(state, context, type)
!t! write(type, 3); write(tbuffptr, 3); newline
if type & 16_7f = trace out start ;!Reply coming back
if type = null out start
if command -> ("Disconnect").text then text = nulltxt else text = norply
finishelse text = t_text
if same as last start
blockcount = blockcount + 1
else
maybe dump header or count
printname(command)
spaces(trace in length - length(command))
printstring(command); lastcomm = command
printstring(" / ")
col = col + trace in length + 3
printstring(text); lasttext = text
col = col + length(text)
blockcount = 1
finish
state = wait in
elseif type & 16_7f = trace in
if type = null in start
if lastprim & 16_5f = 'X' or lastprim = 'Z' then c
command = nulltxt else command = nocomm
else
command = t_text
lastprim = charno(command, 1)
finish
state = wait out
elseif type = eof
exit
else
command = error
finish
repeat
if state = wait out start
maybe dump header or count
printname(command)
spaces(trace in length - length(command))
printstring(command)
printstring(" / ".norply)
newlines(2)
else
newline if firstline # 0
finish
repeat
elseif disflag = 1 ;!Intermingled
first = tbuff_p; last = tbuffs + tbuff_q
tbuffptr = first
tlast = 0; tlast_inout = 999
cycle
t == next valid record(0, -1, type)
!t! write(t_inout, 3); write(t_context, 3)
exit if type = eof
if t_inout = lastinout and t_context = lastcont and t_text = lasttext start
blockcount = blockcount + 1
else
dumpcount(blockcount); blockcount = 1
write(t_context, 3); printstring(": "); col = 7
if type = trace in start
printname(t_text)
spaces(trace in length - length(t_text))
printstring(t_text)
col = col + trace in length
elseif type = trace out
spaces(34); printstring("/ ")
printstring(t_text)
col = col + length(t_text) + 36
finish
lastinout = t_inout; lastcont = t_context; lasttext = t_text
finish
repeat
dumpcount(blockcount)
finish
newline
if infile="$:TRACE" start
Prompt("Keep raw trace (Y/N):")
skipsymbol while nextsymbol&16_5f # 'Y' and nextsymbol&16_5f # 'N'
readsymbol(i)
if i&16_5f = 'Y' start
prompt("Where?:")
skip symbol while next symbol <= ' '
read line(out file)
open output(1, out file)
for i = 0, 1, l-1 cycle
printsymbol(byteinteger(s+i))
repeat
close output
selectoutput(0)
finish
finish
end of program