!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