🚀 go-pugleaf

RetroBBS NetNews Server

Inspired by RockSolid Light RIP Retro Guy

Article View: comp.lang.modula2
Article #2083

Re: Modula-2 Dhrystone?

#2083
From: Markus Maeder
Date: Mon, 06 May 1991 15:58
335 lines
8125 bytes
Hello Tony!

In a msg of <03 May 91>, Tony writes to All:

 d> Does anyone know if the Dhrystone benchmark has been translated into
 d> Modula-2?  If so, could you point me towards a copy of the source?

Some times ago, I've ported it to Topspeed-Modula 2 1.17:

*************************************************************************
MODULE Dh;

(* Dhrystone *)

(*$B-*)
(*$N*)

(* Ada : Reinhold P. Weicker, 15-Apr-84
   Modula-2 : Werner Heiz, 27-Sep-87
   AMSoft-Modula-2 : Stefan H-M Ludwig, 18-Jan-88
   Topspeed Modula-2:  Markus Maeder

   Timing for Amiga 1000 with several background tasks (Clock, FaccII) running
   (shouldn't influence result more than 15 %):
     Loop = 30000:
   all checks on  : 71.2 secs   ->  421 loops/sec
              -v  : 70.7        ->  425
              -r  : 68.7        ->  437
              -s  : 48.9        ->  614
   all checks off : 45.5        ->  659

*)

FROM SYSTEM IMPORT ADR;
IMPORT Str, Lib, IO;

FROM Time IMPORT GetTime;

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


TYPE
  Enumeration = (ident1, ident2, ident3, ident4, ident5);
  OneToThirty = INTEGER [0..29];
  OneToFifty = INTEGER [0..49];
  CapitalLetter = ['A'..'Z'];
  String30 = ARRAY OneToThirty OF CHAR;
  Array1DimInteger = ARRAY OneToFifty OF INTEGER;
  Array2DimInteger = ARRAY OneToFifty, OneToFifty OF INTEGER;
  RecordPtr = POINTER TO Record;
  Record = RECORD
    ptrComp : RecordPtr;
    CASE discr : Enumeration OF
    | ident1 : enumComp : Enumeration;
        intComp : OneToFifty;
        strComp : String30;
    | ident2 : enumComp2 : Enumeration;
        strComp2 : String30;
    ELSE
      chComp1, chComp2 : CHAR;
    END; (*CASE*)
  END;

VAR
  intGlob : INTEGER;
  boolGlob : BOOLEAN;
  chGlob1, chGlob2 : CHAR;
  arrayGlob1 : Array1DimInteger;
  arrayGlob2 : Array2DimInteger;
  ptrGlob, ptrGlobNext : RecordPtr;
  iteration : INTEGER;
  tm,deltatm:LONGCARD;
  a, b : Record;


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;


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


PROCEDURE Func3 (enumIn : Enumeration) : BOOLEAN;
VAR
  enumLoc : Enumeration;

BEGIN
  enumLoc := enumIn;
  RETURN enumLoc = ident3;
END Func3;


PROCEDURE Proc6 (enumIn : Enumeration; VAR enumOut : Enumeration);
BEGIN
  enumOut := enumIn;
  IF NOT Func3 (enumIn) THEN
    enumOut := ident4;
  END;
  CASE enumIn OF
  | ident1 : enumOut := ident1;
  | ident2 :
      IF intGlob > 100 THEN
        enumOut := ident1;
      ELSE
        enumOut := ident4;
      END;
  | ident3 : enumOut := ident2;
  | ident4 : ;
  | ident5 : enumOut := ident3;
  END;
END Proc6;


PROCEDURE Proc7 (intIn1, intIn2 : OneToFifty; VAR intOut : OneToFifty);
VAR
  intLoc : OneToFifty;

BEGIN
  intLoc := intIn2 + 2;
  intOut := intIn2 + intLoc;
END Proc7;


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


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


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;


PROCEDURE Proc4;
VAR
  boolLoc : BOOLEAN;

BEGIN
  boolLoc := chGlob1 = 'A';
  boolLoc := boolLoc OR boolGlob;
  chGlob2 := 'B';
END Proc4;


PROCEDURE Proc5;
BEGIN
  chGlob1 := 'A';
  boolGlob := FALSE;
END Proc5;


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;


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;
  tm:=GetTime();
(*  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;
  deltatm:=GetTime()-tm;
END Proc0;


PROCEDURE In;

BEGIN
  ptrGlobNext := ADR (a);
  ptrGlob := ADR (b);
  WITH ptrGlob^ DO
    ptrComp := ptrGlobNext;
    discr := ident1;
    enumComp := ident3;
    intComp := 40;
    strComp := 'DHRYSTONE PROGRAM, SOME STRING';
  END;
END In;

PROCEDURE Proc00;
BEGIN
  Proc0;
END Proc00;

BEGIN
  In;
  IO.WrStr('Dhrystones: ');
  iteration := 0;
  Proc00;
  IO.WrInt (iteration, 1);
  IO.WrStr (' in  '); IO.WrReal (REAL(deltatm)/18.2,2,1);
  IO.WrStr (' seconds'); IO.WrLn; IO.WrStr('Dhrystones/second:  ');
  IO.WrCard(CARDINAL(REAL(iteration)/REAL(deltatm)*18.2),1);
END Dh.
**************************************************************************
I think it is easy to adapt it to another Modula-2 compiler.

I hope, I could help you....

CU,
 Markus


--  
uucp: uunet!m2xenix!puddle!2!302!807.2!Markus.Maeder
Internet: Markus.Maeder@p2.f807.n302.z2.fidonet.org
Technical Details
Message-ID: <4450.28296566@puddle.fidonet.org>
Path: arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!uakari.primate.wisc.edu!dali.cs.montana.edu!ogicse!zephyr.ens.tek.com!tektronix!percy!m2xenix!puddle!p2.f807.n302.z2.fidonet.org!Markus.Maeder

Show Full Headers
Complete Article Headers
Path: arc1-ca.pugleaf.net!utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!sdd.hp.com!uakari.primate.wisc.edu!dali.cs.montana.edu!ogicse!zephyr.ens.tek.com!tektronix!percy!m2xenix!puddle!p2.f807.n302.z2.fidonet.org!Markus.Maeder
From: Markus.Maeder@p2.f807.n302.z2.fidonet.org (Markus Maeder)
Newsgroups: comp.lang.modula2
Subject: Re: Modula-2 Dhrystone?
Message-ID: <4450.28296566@puddle.fidonet.org>
Date: 6 May 91 15:58:52 GMT
Sender: ufgate@puddle.fidonet.org (newsout1.26)
Organization: FidoNet node 2:302/807.2 - Seneca, Zuerich
Lines: 335