{ ANALYZE:  Analyze and summarize execution time performance measurements
            from an AUGMENTed Pascal program.

        PROGRAM HISTORY:

  S. Matwin and M. Missala, 1975:
    Polish Academy of Sciences Computer Centre, Pkin, Warsaw, Poland.
  
  Modified, Generalized, and Renamed by:
    A. B. Mickel and H. U. Rubenstein, 1977.
    University of Minnesota Computer Center, Minneapolis, MN 55455 USA.
    
  Published in Pascal News, No. 12., 1978 June.
  
  Overhauled for UCSD Pascal and interactive environment by:
    James L. Gagne, September, 1981.
    Datamed Research, Inc., 1433 Roscomare Road, Los Angeles, CA 90077 USA.
    JLG's changes from the PUG version are denoted with empty comment braces.
    
  Patched by George Schreyer,  lines changed noted by gws    Oct 1981
  
  The names and organizations given here must not be deleted in any use of
    this program. (Note added 9/81: this program is not known to be copyright.)
    
Internal documentation:
  
    Analyze reads two files.  Inter2 (UCSD filename is fixed: "AUG.PROCNAMES")
  is the file containing the "module" (procedure/function) names which are used
  when the results are sorted and written out (up to 10 characters only).
  Timing (UCSD filename: "TIMING.DAT") is the file containing the execution
  trace of the program being monitored.  Both files are expected to be on the
  default disk.
  
    Within ANALYZE, the procedure named processbody does the actual analysis
  by determining every time interval:
        time interval = time of exit - time of entry

    Gotoexits were handled specially in the PUG version.  These features have
  been removed from the UCSD version, but for now special provisions for
  the EXIT procedure have not been installed.
}

PROGRAM Analyze;

CONST   AlfaLeng = 10;
        MaxNames = 1000;

TYPE    Alfa = PACKED ARRAY [1..AlfaLeng] OF Char;
        TagRange = 0..MaxNames;
        Measurement = PACKED RECORD
                        Tag: TagRange;
                        Mark: (Entry, ExitP, GotoEntry);
                        HiTime, LoTime: integer
                      END;
{}      DblInt = RECORD
                   Hi, Lo: integer
                 END;
        Counter = RECORD
                    Count, SubRtnCount: integer;
                    Name: Alfa;
{}                  TimeSpent: DblInt
                  END;

VAR     MaxTag: TagRange;
{}      LastDot: char;
{}      JustOne, TotalCalls, TotalTime, StartingTime:  DblInt;
        ch: char;
        FudgeFactor, TimeOverhead: real;
        Modules:  ARRAY [TagRange] OF Counter;
        Timing:  FILE OF Measurement;
{}      OutFile: text;


PROCEDURE Sort(min, max: tagrange);
{Quicksort with bounded recursion depth, used to alphebatize module names.
 Requires min < max.}
VAR     low, high: integer;
        MidKey: Alfa;
        Temp: Counter;

BEGIN
  REPEAT        {pick split point}
    MidKey := Modules[(min + max) DIV 2].Name;  low := min;  high := max;
    REPEAT      {partition}
      WHILE Modules[low].Name < MidKey DO low := low + 1;
      WHILE Modules[high].Name > MidKey DO high := high - 1;
      IF low <= high
        THEN BEGIN
          Temp := Modules[low];  Modules[low] := Modules[high];
          Modules[high] := Temp;  low := low + 1;  high := high - 1
        END
    UNTIL low > high;
{recursively sort shorter sub-segment}
    IF high - min < max - low
      THEN BEGIN IF min < high THEN Sort(min,high);  min := low END
      ELSE BEGIN IF low < max THEN Sort(low,max);  max := high END
  UNTIL max <= min
END;


PROCEDURE ConvertTime(VAR i: DblInt);  {convert time to signed dbl int'rs}
BEGIN
  WITH i, Timing^ DO IF Tag > 0
    THEN BEGIN
      Hi := HiTime*2;  Lo := LoTime;
      IF ((HiTime > 0) AND (Hi < 0)) OR ((HiTime < 0) AND (Hi > 0))
        THEN Hi := Hi + 32767 + 1;           {throw away sign bit if a carry}
      IF (Hi < 0) AND (Lo > 0)
        THEN BEGIN Lo := Lo + 32767 + 1;  Hi := Hi - 1 END
      ELSE IF (Hi > 0) AND (Lo < 0)
        THEN BEGIN Lo := Lo + 32767 + 1;  Hi := Hi + 1 END
    END
END;


PROCEDURE AddDblInt(VAR i1, i2: DblInt);   {add i1 and i2; sum in i1}
VAR     Sum: DblInt;
BEGIN
  WITH Sum DO
    BEGIN
      Hi := i1.Hi + i2.Hi;  Lo := i1.Lo + i2.Lo;
      IF (i1.Hi > 0) AND (i2.Hi > 0) AND (Hi < 0)
        THEN Hi := Hi + 32767 + 1;
      IF (i1.Lo > 0) AND (i2.Lo > 0) AND (Lo < 0)
        THEN BEGIN Lo := Lo + 32765 + 3;  Hi := Hi + 1 END
    END;
  i1 := Sum;
END;


PROCEDURE SubDblInt(VAR i1, i2: DblInt);   {subtract i2 from i1; diffrnc in i1}
VAR     Diff: DblInt;
BEGIN
  WITH Diff DO
    BEGIN
      Hi := i1.Hi - i2.Hi;  Lo := i1.Lo - i2.Lo;
      IF (i1.Hi < 0) AND (i2.Hi < 0) AND (Hi > 0) THEN Hi := Hi + 32767 + 1;
      IF (i1.Lo < 0) AND (i2.Lo < 0) AND (Lo > 0)
        THEN BEGIN Lo := Lo + 32765 + 3;  Hi := Hi - 1 END
    END;
  i1 := Diff
END;

{
PROCEDURE WriteTime(i: DblInt; Stop: boolean);
VAR     r: real;
BEGIN
  WITH i DO
    BEGIN
      Write(Hi, '/', Lo, ' = ');  r := (Lo/60) + Hi * (32768.0/60);
      Write(r, '; ');  IF Stop THEN Readln
    END
END;
}

PROCEDURE ProcessBody;
{process timing file of dynamic measurements.}
VAR     ModuleTag: TagRange;
        SubCnt: integer;
        NoGoto, SameModule: boolean;
{}      Temp1, Temp2, ModulTime: DblInt;

BEGIN
   ModuleTag := Timing^.Tag;  SubCnt := 0;
{} WITH ModulTime DO BEGIN Hi := 0;  Lo := 0 END;
   ConvertTime(Temp1);  Get(Timing);
   WHILE (Timing^.Mark = entry) AND (Timing^.Tag > 0) AND NOT EOF(Timing) DO
     BEGIN
{}     ConvertTime(Temp2);  AddDblInt(ModulTime,Temp2);
{}     SubDblInt(ModulTime, Temp1);  ProcessBody;
{}     ConvertTime(Temp1);  SubCnt := SubCnt + 1;
{}     NoGoto := Timing^.Mark <> GotoEntry;
{}     SameModule := Timing^.Tag = ModuleTag;
{gws}  {IF SameModule OR NoGoto THEN} Get(timing);
     END;
{} ConvertTime(Temp2);  AddDblInt(ModulTime,Temp2);
{} SubDblInt(ModulTime, Temp1);  AddDblInt(TotalCalls,JustOne);
{} IF TotalCalls.Lo MOD 50 = 0 THEN Write('.');
{} IF TotalCalls.Lo MOD 2500 = 0 THEN Writeln;
   WITH Modules[ModuleTag] DO
     BEGIN
       Count := Count + 1;  AddDblInt(TimeSpent, ModulTime);
       SubRtnCount := SubRtnCount + SubCnt;
     END
END;


PROCEDURE Initialize;           {initialization placed here: JLG}
VAR     Tag: TagRange;
        i: integer;
        s: string;
        Inter2: FILE OF Alfa;
BEGIN
{} Writeln('Welcome to ANALYZE, the program timing analyzer.');  Writeln;
{} Writeln(
'     You should be using this program only after having run Pascal source');
{} Writeln(
'text through AUGMENT to add the time-keeping function, then compiled and run');
{} Writeln(
'the new program.  The data files AUG.PROCNAMES and TIMING.DAT must both be');
{} Writeln(
'the default disk, or the program will die.');  Writeln;
{} Reset(Inter2, 'AUG.PROCNAMES');  Reset(Timing,'TIMING.DAT');
  IF EOF(Timing)
{}  THEN BEGIN Writeln('*FATAL ERROR* timing file empty');  Exit(Program) END;
{} Writeln(
'Please enter the destination of the timing analysis (e.g., "PRINTER:"):');
{} Write('--> ':12);  Readln(s);
{} FOR i := 1 TO Length(s) DO
{}  IF s[i] IN ['a'..'z'] THEN s[i] := CHR(ORD(s[i]) + ORD('A') - ORD('a'));
{} IF POS('.TEXT',s) = 0 THEN s := CONCAT(s,'.TEXT');
  Rewrite(OutFile, s);  Tag := 1;
  WHILE NOT EOF(Inter2) DO
    BEGIN
      WITH Modules[Tag] DO
        BEGIN
          Name := Inter2^;  Get(Inter2);  Count := 0;  SubRtnCount := 0;
          TimeSpent.Hi := 0;  TimeSpent.Lo := 0
        END;
      Tag := Tag + 1
    END;
  MaxTag := Tag - 1;
  Writeln (MaxTag,' module names found.');  Writeln;
  Write('How many msec overhead per timing record write?  ');
  Readln(TimeOverhead);  Writeln;  FudgeFactor := TimeOverhead * 60.0 / 1000.0;
{} TotalCalls.Hi := 0;  TotalCalls.Lo := 0;
{} JustOne.Hi := 0;  JustOne.Lo := 1;  ConvertTime(StartingTime);
{} Writeln('Reading timing data (one dot = 100 entries):');
END;


PROCEDURE PrintResults;         {all output pulled into this procedure: JLG}
VAR     Tag: TagRange;
        i, j: integer;
{}      TotalT, TCalls, TSpent, PerCent: Real;
BEGIN
  Writeln(OutFile,'      Performance Measurement Summary for Pascal Program:  ',
                  Modules[1].Name);
  Writeln(OutFile);
  Writeln(OutFile,'execution time':62);
  Writeln(OutFile,'calls':27, '(msec)':21, '(sec)':9);
  Writeln(OutFile,'module':9, 'times':13, 'percent':11, 'subroutn':12, 
                  'average':14,'module':10, 'percent':11);
  Writeln(OutFile,'name':8, 'called':15, 'of total':11, 'calls':11,
                  'per call':15,'total':8, 'of total': 13);
  Writeln(OutFile,' ----------', '------':12, '--------':11,'------':11,
                  '--------':15, '------':9, '--------':12);
{} WITH TotalCalls DO TCalls := 1.0 + Lo - 1.0 + (32768.0 * Hi);
{} WITH TotalTime DO
     TotalT := (Lo/60.0) + Hi*(32768.0/60.0) - (FudgeFactor * 2.0 * TCalls);
{} IF TotalCalls.Lo + TotalCalls.Hi = 0
{}   THEN Writeln(OutFile,'Program did not execute; no timing data.')
{} ELSE FOR Tag := 1 TO MaxTag DO WITH Modules[Tag] DO
     BEGIN
{}     PerCent := (Count / TCalls) * 100.0;
{}     Write(OutFile,Name:11, Count:12);
{}     IF Count = 0
         THEN Write(Outfile,'-----':11, '-----':11)
         ELSE Write(Outfile, PerCent:11:3, SubRtnCount:11);
{}     WITH TimeSpent DO
         TSpent := (Lo/60.0) + (Hi/60.0)*32768.0
           - FudgeFactor * (1.0 + SubRtnCount);
{}     IF Count = 0
         THEN Writeln(OutFile,'-----':15, '-----':9, '-----':12)
{}       ELSE BEGIN
           Write(OutFile,((TSpent/Count)*1000.0):15:2,TSpent:9:3);
           IF TotalT = 0 THEN Writeln(OutFile,'-----':12)
{}           ELSE Writeln(OutFile,((TSpent / TotalT) *100.0):12:3)
         END
     END;
   Writeln(OutFile,' ==========', '======':12, '========':11, '======':11,
                   '========':15, '======':9, '========':12);
   Writeln(OutFile,'TOTALS':9, TCalls:14:1, '100.000':11,
{}                 ((TotalT/TCalls)*1000.0):26:2, TotalT:9:3, '100.000':12)
END;


BEGIN {program}
{} Initialize;  ProcessBody;
{} ConvertTime(TotalTime);  SubDblInt(TotalTime, StartingTime);
   IF MaxTag > 1
     THEN BEGIN
       Writeln(CHR(7));
       Write('Do you want your report alphabetized by procedure name (Y/N)?  ');
       REPEAT READ(ch) UNTIL (ch IN ['y','Y','n','N']);
       IF (ch IN ['y','Y']) THEN Sort(1, MaxTag)
     END;
  PrintResults;  Close(OutFile, LOCK);
END.

