|##########|
|#MAGIC   #|BNDLOOAD
|#PROJECT #|"NormDhry"
|#PATHS   #|"StdProject"
|#FLAGS   #|xx---x--x-----x-----------------
|#USERSW  #|--------------------------------
|#USERMASK#|--------------------------------
|#SWITCHES#|x----x----------
|##########|
MODULE NormDhry;


(* Ada             : Reinhold P. Weicker, 15-Apr-84
   Modula-2        : Werner Heiz, 27-Sep-87
   Cluster         : Ulrich Sigmund, 30-Sep-90
*)

IMPORT Str,Dos,InOut;

CONST
  Loop = 30000;  (* Loop <= MAX (INTEGER) !!!!!!!! *)
  LOOPS = Loop;

TYPE
  Enumeration = (ident1, ident2, ident3, ident4, ident5);
  OneToThirty = INTEGER;
  OneToFifty = INTEGER;
  CapitalLetter = CHAR;
  String30 = STRING(30);
  Array1DimInteger = ARRAY [0..49] OF INTEGER;
  Array2DimInteger = ARRAY [0..49],[0..49] OF INTEGER;
  RecordPtr = POINTER TO Record;
  Record = RECORD
             ptrComp : RecordPtr;
             IF KEY discr : Enumeration
               OF  ident1 THEN enumComp : Enumeration;
                               intComp : OneToFifty;
                               strComp : String30;
               OF  ident2 THEN enumComp2 : Enumeration;
                               strComp2 : String30;
               OF  ident3 THEN chComp1, chComp2 : CHAR;
             END
           END;

VAR
  intGlob : INTEGER;
  boolGlob : BOOLEAN;
  chGlob1, chGlob2 : CHAR;
  arrayGlob1 : Array1DimInteger;
  arrayGlob2 : Array2DimInteger;
  ptrGlob, ptrGlobNext : RecordPtr;
  iteration : INTEGER;

(* $L- *)
PROCEDURE Func1 (chIn1, chIn2 : CapitalLetter) : Enumeration;
VAR chLoc1,
    chLoc2 : CapitalLetter;
BEGIN
  chLoc1 := chIn1;
  chLoc2 := chLoc1;
  IF chLoc2 # chIn2 THEN
    RETURN ident1;
  ELSE
    RETURN ident2;
  END;
END Func1;

(* $L- *)
PROCEDURE Func2 (VAR strIn1,strIn2 : String30) : BOOLEAN;
VAR intLoc : OneToFifty;
    chLoc  : CapitalLetter;
BEGIN
  intLoc := 2;
  WHILE intLoc <= 2 DO
    IF Func1 (strIn1.data [intLoc], strIn2.data [intLoc + 1]) = ident1 THEN
      chLoc := "A";
      INC (intLoc);  (* intLoc := intLoc + 1 *)
    END;
  END;
  IF (chLoc >= "W") AND (chLoc < "Z") THEN
    intLoc := 7;
  END;
  IF chLoc = "X" THEN
    RETURN TRUE;
  ELSE
    IF Str.Greater(strIn1, strIn2) THEN
      intLoc := intLoc + 7;
      RETURN TRUE;
    ELSE
      RETURN FALSE;
    END;
  END;
END Func2;

(* $L- *)
PROCEDURE Func3 (enumIn : Enumeration) : BOOLEAN;
VAR enumLoc : Enumeration;
BEGIN
  enumLoc := enumIn;
  RETURN enumLoc = ident3;
END Func3;

(* $L- *)
PROCEDURE Proc6 (enumIn : Enumeration; VAR enumOut : Enumeration);
BEGIN
  enumOut := enumIn;
  IF NOT Func3 (enumIn) THEN
    enumOut := ident4;
  END;
  IF KEY enumIn
    OF ident1 THEN enumOut := ident1 END
    OF ident2 THEN
                IF intGlob > 100 THEN
                  enumOut := ident1;
                ELSE
                  enumOut := ident4;
                END;
              END
    OF ident3 THEN enumOut := ident2 END
    OF ident4 THEN END
    OF ident5 THEN enumOut := ident3 END
  END;
END Proc6;

(* $L- *)
PROCEDURE Proc7 (    intIn1,
                     intIn2 : OneToFifty;
                 VAR intOut : OneToFifty);
VAR intLoc : OneToFifty;
BEGIN
  intLoc := intIn2 + 2;
  intOut := intIn2 + intLoc;
END Proc7;

(* $L- *)
PROCEDURE Proc3 (VAR ptrOut : RecordPtr);
BEGIN
  IF ptrGlob # NIL THEN
    ptrOut := ptrGlob^.ptrComp;
  ELSE
    intGlob := 100;
  END;
  Proc7 (10, intGlob, ptrGlob^.intComp);
END Proc3;

(* $L- *)
PROCEDURE Proc1 (ptrIn : RecordPtr);
BEGIN
  WITH ptrIn^.ptrComp^ AS pc DO
    pc := ptrGlob^;
    ptrIn^.intComp := 5;
    pc.intComp := ptrIn^.intComp;
    pc.ptrComp := ptrIn^.ptrComp;
    Proc3 (pc.ptrComp);
    IF pc.discr = ident1 THEN
      pc.intComp := 6;
      Proc6 (ptrIn^.enumComp, pc.enumComp);
      pc.ptrComp := ptrGlob^.ptrComp;
      Proc7 (pc.intComp, 10, pc.intComp);
    ELSE
      ptrIn^ := ptrIn^.ptrComp^;
    END;
  END;
END Proc1;

(* $L- *)
PROCEDURE Proc2 (VAR intInOut : OneToFifty);
VAR intLoc  : OneToFifty;
    enumLoc : Enumeration;
BEGIN
  intLoc := intInOut + 10;
  REPEAT
    IF chGlob1 = "A" THEN
      DEC (intLoc);
      intInOut := intLoc - intGlob;
      enumLoc := ident1;
    END;
  UNTIL enumLoc = ident1;
END Proc2;

(* $L- *)
PROCEDURE Proc4;
VAR boolLoc : BOOLEAN;
BEGIN
  boolLoc := chGlob1 = "A";
  boolLoc := boolLoc OR boolGlob;
  chGlob2 := "B";
END Proc4;

(* $L- *)
PROCEDURE Proc5;
BEGIN
  chGlob1 := "A";
  boolGlob := FALSE;
END Proc5;

(* $L- *)
PROCEDURE Proc8 (VAR arrayInOut1 : Array1DimInteger;
                 VAR arrayInOut2 : Array2DimInteger;
                 intIn1,intIn2 : INTEGER);
VAR intLoc   : OneToFifty;
    intIndex : INTEGER;
BEGIN
  intLoc := intIn1 + 5;
  arrayInOut1 [intLoc] := intIn2;
  arrayInOut1 [intLoc + 1] := arrayInOut1 [intLoc];
  arrayInOut1 [intLoc + 30] := intLoc;
  FOR intIndex := intLoc TO intLoc + 1 DO
    arrayInOut2 [intLoc, intIndex] := intLoc
  END;
  INC (arrayInOut2 [intLoc, intLoc - 1]);
  arrayInOut2 [intLoc + 20, intLoc] := arrayInOut1 [intLoc];
  intGlob := 5;
END Proc8;

VAR starttime,nulltime,benchtime : LONGINT;

PROCEDURE time(): LONGINT;
VAR date: Dos.Date;
BEGIN
  Dos.DateStamp(date);
  RETURN date.tick+50*60*date.minute;
END time;

(* $L- *)
PROCEDURE Proc0;
VAR
  intLoc1, intLoc2, intLoc3 : OneToFifty;
  chLoc : CHAR;
  enumLoc : Enumeration;
  strLoc1, strLoc2 : String30;
  chIndex : CHAR;
  t, n : INTEGER;
BEGIN
  strLoc1 := "DHRYSTONE PROGRAM, 1'ST STRING";
  arrayGlob2 [8, 7] := 10;
  starttime:=time();
(*  REPEAT*)
    (*n := 80;*)
    REPEAT
      Proc5;
      Proc4;
      intLoc1 := 2;
      intLoc2 := 3;
      strLoc2 := "DHRYSTONE PROGRAM, 2'ND STRING";
      enumLoc := ident2;
      boolGlob := NOT Func2 (strLoc1, strLoc2);
      WHILE intLoc1 < intLoc2 DO
        intLoc3 := 5 * intLoc1 - intLoc2;
        Proc7 (intLoc1, intLoc2, intLoc3);
        INC (intLoc1);  (*intLoc1 := intLoc1 + 1*)
      END;
      Proc8 (arrayGlob1, arrayGlob2, intLoc1, intLoc3);
      Proc1 (ptrGlob);
      FOR chIndex := "A" TO chGlob2 DO
        IF enumLoc = Func1 (chIndex, "C") THEN
          Proc6 (ident1, enumLoc);
        END;
      END;
      intLoc3 := intLoc2 * intLoc1;
      intLoc2 := intLoc3 DIV intLoc1;
      intLoc2 := 7 * (intLoc3 - intLoc2) - intLoc1;
      Proc2 (intLoc1);
(*      DEC (n);*)
(*    UNTIL n = 0;*)
    INC (iteration);
  UNTIL iteration = Loop;
  benchtime := time() - starttime - nulltime;

END Proc0;


VAR
  a, b : Record;

(* $L- *)
PROCEDURE Proc00;
BEGIN
  Proc0;
END Proc00;


VAR i : INTEGER;

BEGIN
  starttime := time();
  i := 0;
  WHILE i<=LOOPS-1 DO INC(i) END;
  nulltime := time() - starttime; (* Computes overhead of loop *)

  ptrGlobNext := a'PTR;
  ptrGlob := b'PTR;
  (* $W- *)
  WITH ptrGlob^ AS p DO
    p.ptrComp := ptrGlobNext;
    p.discr := ident1;
    p.enumComp := ident3;
    p.intComp := 40;
    p.strComp := "DHRYSTONE PROGRAM, SOME STRING";
  END;
  iteration := 0;
  Proc00;

  InOut.WriteString("Cluster Dhrystone (V1.0) time for ");
  InOut.WriteInt(LOOPS,6);
  InOut.WriteString(" passes is ");
  InOut.WriteInt(benchtime DIV 50, 5);
  InOut.WriteLn;
  InOut.WriteString("This machine benchmarks at ");
  InOut.WriteInt(LOOPS * 50 DIV benchtime,6);
  InOut.WriteString(" dhrystones/second");
  InOut.WriteLn;

CLOSE
END NormDhry.