head     1.1;
access   ;
symbols  ;
locks    ; strict;
comment  @# @;


1.1
date     89.03.08.11.02.48;  author quist;  state Exp;
branches ;
next     ;


desc
@Main program for SPY (monitor operations)
@


1.1
log
@Initial revision
@
text
@$MODCAL$
$STACKCHECK OFF$ $RANGE OFF$ $OVFLCHECK OFF$
PROGRAM SPY(INPUT,OUTPUT,KEYBOARD);
$SEARCH 'TRAP0M'$
IMPORT T0_SUPPORT,LOADER,ASM;
CONST
  maxline  = 65535;
  dmaxline = maxline*2;
  smaxline = (maxline div 4) + 1;
  linename = 'SRCSTATS';
  maxp     = 50;        { limit of proc nesting }
TYPE
  short = 0..maxline;
  byte  = 0..255;
  crec  = packed array[0..31] of boolean;
  lines_type  = packed array [0..maxline] of integer;
  blines_type = packed array [0..maxline] of byte;
  slines_type = packed array [0..dmaxline] of short;
  dlines_type = packed array [0..maxline] of crec;
  string255   = string[255];
  prec        = record
                  a6    : integer;      { stack frame value }
                  rtime : integer;      { last recorded time }
                  index : short;        { index to main recording table }
                end;
  pstack_type = array[1..maxp] of prec;
  pstackp     = ^pstack_type;

VAR
  op,
  rop,
  mop,oldmop  : char;
  linefile : file of byte;
  srclines : ^blines_type;
  lines    : ^lines_type;
  slines   : ^slines_type;
  dlines   : ^dlines_type;
  i,i2     : integer;
  min,max,
  num1,num2   : integer;
  hit,miss    : integer;
  marked      : boolean;
  dots        : boolean;
  ll,lcount   : integer;
  KEYBOARD    : TEXT;
  
  nprocs      : 0..maxp;
  uprocs,
  sprocs      : 0..maxp;
  procs       : pstackp;
  was_super   : boolean;
  
  olda6       : integer;
  
  procedure record_c(lnum : integer);
    begin
      lines^[lnum] := lines^[lnum] + 1;
    end; { record_c }
  
  procedure record_d(lnum : integer);
    var
      num, pos : integer;
    begin
      pos := lnum div smaxline;
      dlines^[lnum mod smaxline][pos]:=true;
    end; { record_d }
    
  procedure record_h(lnum : integer);
    begin
      if ll<dmaxline then ll := ll + 1;
      slines^[ll]:=lnum;
    end;
  
  procedure cleanup_time;
    var
      t : integer;
    begin
      t := lines^[1];
      while nprocs>0 do
      with procs^[nprocs] do
      begin
        lines^[index] := lines^[index] + (rtime - t);
        nprocs := nprocs - 1;
      end;
    end; { cleanup_time }
  
  procedure record_t(lnum : integer);
    label 1,2;
    var
      t      : integer;
      super  : boolean;
      newproc: boolean;
      
    begin
      t := ticker;
      lines^[1] := t;   { last recorded time }
      if a6reg=olda6 then goto 2
      else
      if olda6=0 then
      begin { startup conditions }
        lines^[0]:=t;
        nprocs := 1;
        with procs^[1] do
        begin
          a6    := a6reg;
          rtime := t;
          index := lnum;
          was_super := a6reg>userstack;
          goto 1;
        end;
      end;
      
      super := (a6reg>userstack);
      if super=was_super then
      begin { same stack }
        newproc := a6reg<olda6;
      end
      else { switched stacks }
      if super then
      begin { switched to supervisor stack }
        newproc := true;
      end
      else
      begin { switched to user stack }
        newproc := false;
      end;
      was_super := super;
      
      if newproc then { new proc }
      begin
        nprocs := nprocs + 1;
        with procs^[nprocs] do
        begin
          a6    := a6reg;
          rtime := t;
          index := lnum;
        end;
      end
      else
      begin { old proc }
        repeat
          with procs^[nprocs] do
          begin
            if a6=a6reg then goto 1
                        else nprocs := nprocs - 1;
            lines^[index] := lines^[index] + (rtime - t);
            if nprocs = 0 then
            begin { add in the current one }
              nprocs := 1;
              with procs^[1] do
              begin
                a6    := a6reg;
                rtime := t;
                index := lnum;
                goto 1;
              end;
            end;
          end;
        until false;
      end;
      1:
      olda6 := a6reg;
      2:
    end; { record_t }
  
  procedure show_dead_lines;
    var
      srcfile : text;
      srcname : string255;
      inline  : string255;
      i,i2,c,
      lnum    : integer;
    begin
      write('Name of Listing file = '); readln(srcname);
      reset(srcfile,srcname);
      while not eof(srcfile) do
      begin
        readln(srcfile,inline);
        if strlen(inline)>7 then
        if inline[7]='*' then
        begin
          strread(inline,1,i,lnum);
          if lines^[lnum]=0 then writeln(inline)
          else
          begin
            if srclines^[lnum]>1 then
            begin
              c := 0;
              for i2 := 0 to srclines^[lnum]-1 do
                if not dlines^[lnum][i2] then
                  begin
                    if c=0 then
                    begin writeln(inline);
                          c:=1;
                          write('--- missed');
                    end;
                    write(' stmt ',i2+1:1);
                  end;
              if c<>0 then writeln;
            end;
          end;
        end;
      end;
    end; { show_dead_lines }
  
  procedure do_source_step;
    const
      max_recs = 41;
    type
      one_rec = record
                 rec_no : integer;
                 data   : string255;
               end;
      cache_rec = array[1..max_recs] of one_rec;
    var
      srcfile : text;
      srcname : string255;
      inline  : string255;
      i,old,dir,lnum  : integer;
      last_rec: integer;
      cache   : cache_rec;
      sop     : char;
  
    procedure init_cache;
      var
        i : integer;
      begin
        last_rec := 0;
        for i := 1 to max_recs do cache[i].rec_no := 0;
      end; { init_cache }
 
    function dumprec(rnum:integer):string255;
      var
        test,temp : integer;
      begin
        test := rnum mod max_recs + 1;
        if cache[test].rec_no = rnum then dumprec:=cache[test].data
        else
        begin
          if rnum<=last_rec then
          begin
            reset(srcfile);
            last_rec := 0;
          end;
          with cache[test] do
          begin
            rec_no := rnum;
            while not eof(srcfile) and (last_rec<rnum) do
            begin
              readln(srcfile,data);
              if strlen(data)>7 then
                if data[7]='*' then
                  strread(data,1,temp,last_rec);
            end;
            if last_rec<>rnum then
            begin
              writeln('line ',rnum:1,' not found');
              dumprec:='';
              rec_no := 0;
            end
            else dumprec := data;
          end;
        end;
      end; { dumprec }
       
    begin { do_source_step }
      write('Name of Listing file = '); readln(srcname);
      reset(srcfile,srcname);
      init_cache;
      i := 0;
      writeln(i:5,' ',dumprec(slines^[0]));
      repeat
        read(KEYBOARD,sop);
        case sop of
        #0: begin
            end;
        #10,' ':{lf} i := i + 1;
        #31    :{us} i := i - 1;
        'F': begin
               old := i;
               write('Find # ? '); readln(lnum);
               if lnum>=0 then dir := 1
                          else dir :=-1;
               lnum := abs(lnum);
               while (slines^[i]<>lnum) and
                     (sop='F') do
               begin
                 i := i + dir;
                 if dir=-1 then
                 begin if i<0 then sop:=#0;end
                 else
                 begin if i>ll then sop:=#0;end;
                 if sop=#0 then
                 begin
                   writeln('line ',lnum:1,' not found');
                   i := old;
                 end;
               end; 
             end;
        'Q':;
        otherwise
        end;
        if sop<>'Q' then
        begin
          if i<0 then i:=0
          else
          if i>ll then i:=ll;
          writeln(i:5,' ',dumprec(slines^[i]));
        end;
      until sop='Q';
      close(srcfile);
    end; { do_source_step }
  
  procedure save_data;
    var
      fname : string255;
      fyle  : text;
      i,c   : integer;
    begin
      write('File to write to = ? '); readln(fname);
      rewrite(fyle,fname);
      c := 0;
      writeln(fyle,mop,' ',ll);
      if mop='P' then cleanup_time;
      for i := 0 to maxline do
      begin
        if lines^[i]<>0 then
        begin c := c + 1;
              writeln(fyle,i,lines^[i]);
        end;
      end;
      close(fyle,'SAVE');
      writeln(c:1,' lines written to ',fname);
    end; { save_data }
  
  procedure load_data;
    var
      fname : string255;
      fyle  : text;
      i,j,c : integer;
    begin
      write('File to read from = ? '); readln(fname);
      reset(fyle,fname);
      readln(fyle,mop,ll);
      writeln('report code = ',mop);
      for i := 0 to maxline do lines^[i]:= 0;
      c := 0;
      for i := 0 to maxline do
      begin
        if not eof(fyle) then
        begin
          c := c + 1;
          readln(fyle,j,lines^[j]);
        end;
      end;
      close(fyle);
      writeln(c:1,' lines read from ',fname);
    end; { load_data }
    
BEGIN
  if srclines=nil then new(srclines);
  if lines=nil then new(lines);
  slines := anyptr(lines);
  dlines := anyptr(lines);
  { peformance tracking structures }
  if procs=nil then new(procs);
  
  writeln('THE SPY PROGRAM Rev 1.3  28 FEB 89');
  repeat
    write('Begin, End, Report, Save, Load, Quit ');
    read(op); writeln;
    case op of
    'Q':;
    'S': if mop in ['A'..'Z'] then save_data
                              else writeln('No data to save');
    'L': load_data;
    'B': begin { being monitoring }
           write('Count, Dead_code_check, History, Performance ');
           read(mop); writeln;
           if mop<>oldmop then writeln('Run stats will be cleared');
           case mop of
           'C':begin
                 if mop=oldmop then
                 begin
                   write('Clear stats (Y/N) ? ');
                   read(rop); writeln;
                   if rop='Y' then oldmop := ' ';
                 end;
                 if mop<>oldmop then
                   for i := 0 to maxline do lines^[i]:=0;
                 oldmop := mop;
                 trap0hook := record_c;
               end;
           'D':begin
                 if mop=oldmop then
                 begin
                   write('Clear stats (Y/N) ? ');
                   read(rop); writeln;
                   if rop='Y' then oldmop := ' ';
                 end;
                 if mop<>oldmop then
                   for i := 0 to maxline do lines^[i]:=0;
                 oldmop := mop;
                 trap0hook := record_d;
               end;
           'H':begin
                 if mop=oldmop then
                 begin
                   write('Clear stats (Y/N) ? ');
                   read(rop); writeln;
                   if rop='Y' then oldmop := ' ';
                 end;
                 if mop<>oldmop then ll := -1;
                 oldmop := mop;
                 trap0hook := record_h;
               end;
           'P':begin
                 nprocs := 0; uprocs := 0; sprocs := 0;
                 olda6  := 0;
                 if mop=oldmop then
                 begin
                   write('Clear stats (Y/N) ? ');
                   read(rop); writeln;
                   if rop='Y' then oldmop := ' ';
                 end;
                 if mop<>oldmop then
                   for i := 0 to maxline do lines^[i]:=0;
                 oldmop := mop;
                 trap0hook := record_t;
               end;
           otherwise
             writeln('don''t understand ',mop);
             mop := '?';
           end;
            
           if mop<>'?' then
           begin
             start_monitor;
             writeln('Monitor started');
           end;
         end;
    'E': begin
           end_monitor;
           writeln('Monitoring ended');
         end;
    'R': begin { reports }
           case mop of
           'H': begin { history }
                  writeln(ll:1,' lines recorded');
                  write('Source step (Y/N) ? ');
                  read(rop); writeln;
                  if rop='Y' then do_source_step
                  else
                  begin
                    mop := ' '; i := 0;
                    while i<=ll do
                    begin
                      if i mod 10 = 0 then writeln;
                      if i mod 50 = 0 then readln(mop);
                      if mop=' ' then write(slines^[i]:7)
                                 else i := ll;
                      i := i + 1;
                    end;
                    writeln;
                  end;
                  mop := 'H';
                end;
           'C': begin { line count }
                  writeln('Line Count Report');
                  writeln(' line  ..  line    count'); 
                  num1 := -1; num2 := -1; dots := false;
                  for i := 0 to maxline do
                  begin
                    if lines^[i]>0 then
                    begin
                      if (i=(num1+1)) and (num2=lines^[i]) then dots := true
                      else
                      begin
                        if dots then writeln(' .. ',num1:6,' ',num2)
                                else
                                if num2>=0 then writeln('    ','  ':6,' ',num2);
                        write(i:6); dots := false;
                      end;
                      num1 := i;
                      num2 := lines^[i];
                    end;
                  end;
                  if dots then writeln(' .. ',num1:6,' ',num2)
                          else writeln('    ','  ':6,' ',num2);
                end;
           'P': begin { performance }
                  writeln('Performance Report');
                  writeln('line    milli seconds  percent'); 
                  cleanup_time;
                  num1 := lines^[0]-lines^[1];
                  for i := 2 to maxline do
                  begin
                    if lines^[i]<>0 then
                    begin
                      writeln(i:4,(lines^[i]/4)/1000:16:6,
                                  ' ',(lines^[i]/num1)*100:8:2);
                    end;
                  end;
                  writeln('total time');
                  writeln(num1/4/1000:20:6);
                end;
           'D': begin { Dead_code_check }
                  writeln('Execution Coverage Report');
                  write('Report ');
                  write('Source statements not executed (Y/N) ? ');
                  read(rop); writeln;
                  reset(linefile,linename);
                  min := maxint; max := minint; num1 := 0;
                  writeln('reading SRCSTATS file');
                  for i := 0 to maxline do
                  begin
                    read(linefile,srclines^[i]);
                    if srclines^[i]<>0 then
                    begin
                      num1 := num1 + srclines^[i];
                      if i < min then min := i
                      else
                      if i > max then max := i;
                      if rop='Y' then
                        if lines^[i]=0 then writeln(i);
                    end;
                    if num1=1 then max := min;
                  end;
                  writeln('Source stats');
                  write('min # = ',min:5);
                  write(' max # = ',max:5);
                  write(' total # = ',num1:5);
                  writeln;
                  writeln;
           
                  min := maxint; max := minint; num2 := 0;
                  hit := 0; miss := 0;
                  write('Report ');
                  write('executed statements with no source (Y/N) ? ');
                  read(rop); writeln;
                  for i := 0 to maxline do
                  begin
                    if lines^[i]<>0 then
                    begin
                      for i2 := 0 to 3 do
                        if dlines^[i][i2] then num2 := num2 + 1;
                      if i < min then min := i
                      else
                      if i > max then max := i;
                      if srclines^[i]<>0 then
                      begin
                        for i2 := 0 to 3 do
                          if dlines^[i][i2] then hit := hit + 1;
                      end
                      else
                      begin
                        if rop='Y' then writeln('no src for ',i:1);
                        miss := miss + 1;
                      end;
                    end;
                  end;
                  if num2 = 1 then max := min;
                  writeln('Execution stats');
                  write('min # = ',min:5);
                  write(' max # = ',max:5);
                  write(' total # = ',num2:5);
                  writeln;
                  write('hits = ',hit:5);
                  write(' miss = ',miss:5);
                  write(' covered ',hit/num1*100:5:2,'% of the statements');
                  writeln;
                  writeln;
                  write('Show unexecuted source (Y/N) ? ');
                  read(rop); writeln;
                  if rop='Y' then show_dead_lines;
                end;
           otherwise
              writeln('No Data collected');
           end; { end case }
         end; { end Reports }
    otherwise
       writeln('type B E R S L or Q');
    end; { end case }
  until op='Q';
  if not marked then markuser;
  marked := true;
END.
@
