(*
  :Program.       ProfRunTime.mod (OProf)
  :Author.        Volker Rudolph
  :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  :Phone.         06301/8566
  :Version.       1.22
  :Date.          4.11.90
  :Copyright.     Volker Rudolph (Shareware)
  :Language.      Oberon
  :Translator.    Oberon V1.17.1
  :Imports.       MicroTimer, Printf
  :Contents.      Laufzeit-Statistiken über Programme
*)

(* $StackChk- $OvflChk- $RangeChk- $NilChk- $ReturnChk- $CaseChk- $TypeChk- *)
MODULE ProfRunTime;

IMPORT as:ASCII,l:Lists,st:Strings,ol:OberonLib,Break,io,s:SYSTEM,
       p:Printf,mi:MicroTimer;

(* --- EXPORTED -------------------------------------------------------------- *)

CONST
  ProcNameLen * = 128;
  HashTableSize * = 1023;

TYPE
  ProcNamePtr * = POINTER TO ProcName;
  ProcName * = ARRAY ProcNameLen OF CHAR;

VAR
  Trace *      :INTEGER;
  Quiet *      :BOOLEAN;
  TotalCalls * :LONGINT;

(*
  PROCEDURE Assert(continue:BOOLEAN;msg:ARRAY OF CHAR);
  PROCEDURE Entry(proc:ProcNamePtr;hashNum:INTEGER);
  PROCEDURE Exit(proc:ProcNamePtr;hashNum:INTEGER);
  PROCEDURE Halt;
*)

(* --- NOT EXPORTED ---------------------------------------------------------- *)

CONST

  ProfTicks = 29;   (* Zur Anpassung an schnellere Prozessoren ändern *)
                    (* 29 = Wert für 7.09Mhz 68000 + SmallCode + SmallData *)
  Line = "------------------------------------------------------------------\n";

TYPE
  ProcNodePtr = POINTER TO ProcNode;
  ProcNode =  RECORD (l.Node)
                recursions:LONGINT;
                calls:LONGINT;
                entry:LONGINT;
                ticks:LONGINT;
                proc:ProcName;
              END;

  HashTable = ARRAY HashTableSize OF l.List;

VAR
  hashTable:HashTable;
  totalTicks:LONGINT;
  profTicks:LONGINT;
  endTicks:LONGINT;
  dots:ProcName;
  nest:INTEGER;
  i:INTEGER;
  quick:BOOLEAN;
  close:BOOLEAN;
  halt:BOOLEAN;
  out:p.WriteProcType;
  ch:CHAR;

(* ------------------------------------------------------------------------- *)

(* $CopyArrays- *)
PROCEDURE Assert*(continue:BOOLEAN;msg:ARRAY OF CHAR);
BEGIN
  IF ~continue THEN
    out := p.writeProc;
    p.writeProc := io.WriteString;
    p.Printf1("\[33mASSERT: %s\[31m\n",s.ADR(msg));
    p.writeProc := out;
    HALT(20);
  END; (* IF *)
END Assert;

(* ------------------------------------------------------------------------- *)

(* $CopyArrays- *)
PROCEDURE AddHashTable(proc:ARRAY OF CHAR;ticks:LONGINT;hashNum:INTEGER);
VAR
  newNode:ProcNodePtr;
BEGIN
  IF l.Head(hashTable[hashNum]) # NIL THEN
    quick := FALSE;
  END; (* IF *)
  NEW(newNode);
  Assert(newNode # NIL,"No memory for hash-table");
  newNode.entry := ticks-profTicks;
  newNode.recursions := 1;
  newNode.calls := 1;
  newNode.ticks := 0;
  COPY(proc,newNode.proc);
  l.AddHead(hashTable[hashNum],newNode);
END AddHashTable;

(* ------------------------------------------------------------------------- *)

(* $CopyArrays- *)
PROCEDURE Entry*(proc:ARRAY OF CHAR;hashNum:INTEGER);
VAR
  node:l.NodePtr;
  ticks:LONGINT;
  ok:BOOLEAN;
BEGIN
  mi.Stop(ticks);
  IF Trace # 0 THEN
    dots[nest] := as.nul;
    out := p.writeProc;
    p.writeProc := io.WriteString;
    p.Printf2("%s> %s\n",s.ADR(dots),s.ADR(proc));
    p.writeProc := out;
    dots[nest] := '.';
  END; (* IF *)
  INC(nest);
  INC(TotalCalls);
  node := l.Head(hashTable[hashNum]);
  WHILE (node # NIL) & (proc # node(ProcNode).proc) DO
    ok := l.Next(node);
  END; (* WHILE *)
  IF (node # NIL) THEN
    WITH node:ProcNode DO
      INC(node.calls);
      INC(node.recursions);
      IF node.recursions = 1 THEN
        node.entry := ticks-profTicks;
      END; (* IF *)
    END; (* WITH *)
  ELSE
    AddHashTable(proc,ticks,hashNum);
  END; (* IF *)
  INC(profTicks,ProfTicks);
  mi.Continue;
END Entry;

(* ------------------------------------------------------------------------- *)

(* $CopyArrays- *)
PROCEDURE Exit*(proc:ARRAY OF CHAR;hashNum:INTEGER);
VAR
  node:l.NodePtr;
  ticks:LONGINT;
  inc:LONGINT;
  ok:BOOLEAN;
BEGIN
  mi.Stop(ticks);
  totalTicks := ticks;
  DEC(nest);
  IF Trace = 2 THEN
    dots[nest] := as.nul;
    out := p.writeProc;
    p.writeProc := io.WriteString;
    p.Printf2("%s< %s\n",s.ADR(dots),s.ADR(proc));
    p.writeProc := out;
    dots[nest] := '.';
  END; (* IF *)
  node := l.Head(hashTable[hashNum]);
  IF ~quick THEN
    WHILE (proc # node(ProcNode).proc) DO
      ok := l.Next(node);
    END; (* WHILE *)
  END; (* IF *)
  WITH node:ProcNode DO
    IF node.recursions = 1 THEN
      inc := ticks-node.entry-profTicks;
      IF inc > 0 THEN
        INC(node.ticks,inc);
      END; (* IF *)
      node.entry := 0;
    END; (* IF *)
    DEC(node.recursions);
    INC(profTicks,ProfTicks);
  END; (* WITH *)
  mi.Continue;
END Exit;

(* ------------------------------------------------------------------------- *)

PROCEDURE Halt*;
VAR
  node:l.NodePtr;
  inc:LONGINT;
  i:INTEGER;
  ok:BOOLEAN;
BEGIN
  halt := TRUE;
  mi.Stop(endTicks);
  i := 0;
  WHILE i < HashTableSize DO
    node := l.Head(hashTable[i]);
    WHILE node # NIL DO
      WITH node:ProcNode DO
        IF node.ticks < 0 THEN
          node.ticks := 0;
        END; (* IF *)
        IF ~close THEN
          node.recursions := 0;
        END; (* IF *)
        IF node.entry # 0 THEN
          totalTicks := endTicks;
          inc := endTicks-node.entry-profTicks;
          IF inc > 0 THEN
            INC(node.ticks,inc);
          END; (* IF *)
        END; (* IF *)
      END; (* WITH *)
      ok := l.Next(node);
    END; (* WHILE *)
    INC(i);
  END; (* WHILE *)
END Halt;

(* ------------------------------------------------------------------------- *)

PROCEDURE ShowHash;
VAR
  i:INTEGER;
  node:l.NodePtr;
  minutes:INTEGER;
  seconds:INTEGER;
  micros:LONGINT;
  ch:CHAR;
  ok:BOOLEAN;
BEGIN
  out := p.writeProc;
  p.writeProc := io.WriteString;
  p.Printf0("\[33mOProf statistics\[31m\n\n");

  DEC(totalTicks,profTicks);
  mi.TicksToTime(minutes,seconds,micros,totalTicks);
  p.Printf3("Total time: %ld min. %ld sec. %03ld msec.\n\n",minutes,seconds,micros DIV 1000);

  p.Printf0("| procedure                                |calls | sec.   |perc.|\n");
  p.Printf0(Line);
  i := 0;
  WHILE i < HashTableSize DO
    node := l.Head(hashTable[i]);
    WHILE node # NIL DO
      WITH node:ProcNode DO
        mi.TicksToTime(minutes,seconds,micros,node.ticks);
        IF node.recursions = 0 THEN
          ch := ' ';
        ELSE
          ch := '*';
        END; (* IF *)
        IF totalTicks < 100 THEN
          totalTicks := 100
        END; (* END *)
        p.Printf6("|%lc%-40s |%5ld |%3ld.%03ld | %3ld |\n",
          ORD(ch),
          s.ADR(node.proc),
          node.calls,
          LONG(minutes) * 60 + seconds,
          micros DIV 1000,
          node.ticks DIV (totalTicks DIV 100));
      END; (* WITH *)
      ok := l.Next(node);
    END; (* WHILE *)
    INC(i);
  END; (* WHILE *)
  p.Printf0(Line);
  p.writeProc := out;
END ShowHash;

(* ------------------------------------------------------------------------- *)

BEGIN
  Trace := 0;
  Quiet := FALSE;
  TotalCalls := 0;
  quick := TRUE;
  halt := FALSE;
  close := FALSE;
  profTicks := 0;
  nest := 0;

  i := 0;
  WHILE i < HashTableSize DO
    l.Init(hashTable[i]);
    INC(i);
  END; (* WHILE *)

  i := 0;
  WHILE i < ProcNameLen DO
    dots[i] := '.';
    INC(i);
  END; (* WHILE *)

  mi.Start;

(* ------------------------------------------------------------------------- *)

CLOSE
  IF ~halt THEN
    close := TRUE;
    Halt;
  END; (* IF *)
  IF ~Quiet THEN
    ShowHash;
    IF ol.wbStarted THEN
      io.WriteString("\n>> RETURN << ");
      io.Read(ch);
    END; (* IF *)
  END; (* IF *)
END ProfRunTime.