DataMuseum.dk

top - download

    Length: 5376 (0x1500)
    Types: Rc489k_TapeFile, TextFile

└─⟦aa55fa693⟧ Bits:30007479 SW8110/1 TAS/SOS/PRIMO Rel 2.3
    └─⟦this⟧ 

TextFile

;             ***  ttrace  ***
;
;
; program for analyzing testoutput
;
; release 3.0 oct. 1981  edith rosenberg
;


begin
  zone z(128,1,eof);
  integer i,file,b,wanted,filesize,oldtime,olduser,rest,kind,size;
  integer field h,u,f;
  real array arr(1:2);
  integer array tail(1:10);
  real time,r;
  boolean startup;

  procedure eof(z,s,b);
  zone z; integer s,b;
  begin
    setposition(z,0,1);
    s:=0;
    b:=0;
    startup:=false;
  end eof;

  procedure callerror(errorno);
  integer errorno;
  begin
    write(out,<:<10>***trace :>, case errorno of
             (<:sizeparam illegal:>,
              <:call:>),<:<10>:>);
    goto abend;
  end callerror;

  procedure writechar(char);
  integer char;
  begin
    outchar(out,char);
    if char=10 then write(out,false add 32,23);
  end writechar;

  procedure printrecord;
  begin
    outchar(out,if rest=510 then 62 else 32);   <* 62 = '>' denotes segment start *>
    if kind < 70 then
    write(out,case kind+1 of (
      <:text:>,<:pbrk:>,<:send:>,<:swop:>,<:stop:>,
      <:strt:>,<:evnt:>,<:****:>,<:reso:>,<:link:>,
      <:evnt:>,<:exit:>,<:lock:>,<:open:>,<:send:>,
      <:****:>,<:0016:>,<:0017:>,<:0018:>,<:0019:>,
      <:getv:>,<:rtms:>,<:0022:>,<:0023:>,<:0024:>,
      <:0025:>,<:evtr:>,<:0027:>,<:0028:>,<:0029:>,
      <:strt:>,<:-br-:>,<:-bt-:>,<:-dr-:>,<:-dt-:>,
      <:-pr-:>,<:-pt-:>,<:-sc-:>,<:-op-:>,<:0039:>,
      <:opbr:>,<:opbt:>,<:opdr:>,<:opdt:>,<:oppr:>,
      <:oppt:>,<:0046:>,<:0047:>,<:0048:>,<:clos:>,
      <:getr:>,<:putr:>,<:trns:>,<:crph:>,<:reph:>,
      <:crth:>,<:reth:>,<:cnct:>,<:dscn:>,<:0059:>,
      <:unin:>,<:answ:>,<:wmes:>,<:sndw:>,<:opms:>,
      <:0065:>,<:data:>,<:wans:>,<:dscr:>,<:trim:>),
      <: :>) else write(out,<<zddd>,kind,<: :>);
    write(out,<<ddddddd>,z.h,<<-dddddd>,z.u);
    if kind=0 then
    begin
      write(out,false add 32,3);
      for f:=6 step 2 until size-2 do
      begin
        writechar(z.f shift (-16));
        writechar(z.f shift (-8) extract 8);
        writechar(z.f extract 8);
      end;
    end else
    begin
      for f:=6 step 2 until size-2 do
      begin
        write(out,<<-ddddddd>,z.f);
        if (f-4) mod 24 = 0 then write(out,false add 10,1,false add 32,20);
      end;
    end;
    outchar(out,10);
  end printrecord;

  if system(4,2,arr) <> 8 shift 12 + 4 then callerror(1);
  wanted:=arr(1);
  if system(4,1,arr) <> 4 shift 12 + 10 then callerror(2);
  i:=1;
  open(z,4,string arr(increase(i)),1 shift 18);
  monitor(42,z,0,tail);
  filesize:=tail(1);
  systime(1,0,time);
  write(out,<:<10>testoutput from :>);
  for i:=0 step 1 until 10 do
    outchar(out,arr(i//6+1) shift (-40+(i mod 6)*8) extract 8);
  write(out,<:  :>,<<  dd dd dd>,systime(4,time,r),r,<:<10><10>:>);

  u:=4; h:=2;
  oldtime:=0;
  olduser:=-1;

  for rest:=inrec6(z,2) while rest > 0 and z.h > 0 do
  begin
    size:=z.h shift (-12) extract 12;
    kind:=z.h extract 12;
    inrec6(z,size-2);
    oldtime:=z.h;
    printrecord;
  end;
  write(out,<:<10><10>end of fixed part<12><10>:>);
  setposition(z,0,1);
  inrec6(z,4);
  if z.u-oldtime < 2000 then startup:=true else startup:=false;
  setposition(z,0,1);
  for i:=0 while true do
  begin
    rest:=inrec6(z,2);
    if z.h = -2 then
    begin
      inrec6(z,rest);
      inrec6(z,2);
      goto startfound;
    end else
    if z.h = -1 then
    begin
      inrec6(z,rest);
    end else
    begin
      size:=z.h shift (-12) extract 12;
      if size-2 > rest or size-2 < 4 then
      begin
        inrec6(z,rest);
        goto nextsegm;
      end;
      inrec6(z,size-2);
      if z.h < oldtime then goto startfound;
      oldtime:=z.h;
    end;
nextsegm:
  end;

startfound:
  getposition(z,file,b);
  if wanted >= filesize then wanted:=filesize-1;
  b:=b-wanted;
  if b < 1 then
  begin
    if startup then
    begin
      wanted:=wanted+b-1;
      b:=1;
    end else
    b:=b+filesize-1;
  end;
  setposition(z,file,b);
  write(out,<:startsegment: :>,<<ddd>,b,<:<10><10>:>);;

  oldtime:=0;
  i:=0;
  for i:=i while i < wanted do
  begin
    rest:=inrec6(z,2);
    if z.h = -2 then goto stop;
    if z.h = -1 then
    begin
      inrec6(z,rest);
      i:=i+1;
      goto nextrecord;
    end;
    size:=z.h shift (-12) extract 12;
    kind:=z.h extract 12;
    if size-2 > rest or size-2 < 4 then
    begin
      getposition(z,file,b);
      write(out,<:***troubles on segment: :>,b,<:  size: :>,size,<:<10>:>);
      inrec6(z,rest);
      goto nextrecord;
      i:=i+1;
    end;
    inrec6(z,size-2);
    if z.h < oldtime then goto stop else oldtime:=z.h;
    if z.u <> olduser then outchar(out,10);
    olduser:=z.u;
    printrecord;
nextrecord:
  end;
stop:
  getposition(z,file,b);
  write(out,<:<10>endsegment:   :>,<<ddd>,b,<:<10>:>);
  close(z,true);
abend:
end

▶EOF◀