[comp.lang.modula2] Modula-2 Dhrystone?

daf@inmet.inmet.com (04/30/91)

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

    Thank You,
	Tony Flanders
	Intermetrics, Inc.
	    daf%inmet@uunet.uu.net

pf@artcom0.north.de (Peter Funk) (05/02/91)

In <22000001@inmet> daf@inmet.inmet.com writes:
> Does anyone know if the Dhrystone benchmark has been translated into
> Modula-2?  If so, could you point me towards a copy of the source?
see below.

Regards, Peter
-=-=-
Peter Funk \\ ArtCom GmbH, Schwachhauser Heerstr. 78, D-2800 Bremen 1
Work at home: Oldenburger Str.86, D-2875 Ganderkesee 1/+49 4222 6018 (8am-6pm)
---
MODULE DHRYSTONE;

  FROM Storage IMPORT ALLOCATE;
  FROM SYSTEM  IMPORT TSIZE;

  FROM Strings           IMPORT Assign, Insert, Delete, Pos, Copy, Concat,
                                Length, CompareStr;




  CONST
    Null = 0;
    Ident1 = 1;
    Ident2 = 2;
    Ident3 = 3;
    Ident4 = 4;
    Ident5 = 5;



  TYPE
    strings = ARRAY [0..30-1] OF CHAR;
    intar51 = ARRAY [0..50] OF INTEGER;
    intar5151 = ARRAY [0..50] OF intar51;

    strptr = POINTER TO structure;
    structure = RECORD
                  ptrcomp: strptr;
                  discr, enumcomp, intcomp: INTEGER;
                  stringcomp: strings;
                END;



  VAR
    records: ARRAY [0..2] OF structure;

    array1: intar51;
    array2: intar5151;

    intglob: INTEGER;
    boolglob: BOOLEAN;
    char1glob, char2glob: CHAR;
    string1loc: strings;
    ptrglb, ptrglbnext: strptr;


  PROCEDURE Func1(charpar1, charpar2: CHAR): INTEGER;

    VAR
      charloc1, charloc2: INTEGER;
    VAR Func1Result: INTEGER;
  BEGIN
    charloc1 := ORD(charpar1);
    charloc2 := charloc1;
    IF (* true *)
    charloc2 <> charloc2 THEN

      Func1Result := Ident2
    ELSE
      Func1Result := Ident1
    END;
    RETURN Func1Result
  END Func1;

  (* once *)

  PROCEDURE Func2(strpari1, strpari2: strings): BOOLEAN;

    PROCEDURE Strcmp(s1, s2: strings): INTEGER;

      VAR
        i, k: INTEGER;
      VAR StrcmpResult: INTEGER;
    BEGIN
      i := 1;
      StrcmpResult := 0;
      k := Length(s1);
      IF Length(s1) > Length(s2) THEN
        k := Length(s2);
        StrcmpResult := 1
      ELSIF Length(s1) = Length(s2) THEN

        StrcmpResult := 0
      ELSE
        StrcmpResult := (-1)
      END;
      WHILE (s1[i] = s2[i]) AND (i <= k) DO
        i := VAL(INTEGER, ORD(i)+1)
      END;
      IF i <= k THEN
        IF s1[i] = s2[i] THEN

          StrcmpResult := 0
        ELSIF s1[i] > s2[i] THEN
          StrcmpResult := 1
        ELSE
          StrcmpResult := (-1)
        END
      END;
      RETURN StrcmpResult
    END Strcmp;


    VAR
      intloc: INTEGER;
      charloc: CHAR;
    VAR Func2Result: BOOLEAN;
  BEGIN
    intloc := 1;
    WHILE intloc <= 1 DO
      (* once *) ;
      IF Func1(strpari1[intloc], strpari2[intloc+1]) = Ident1 THEN

        charloc := 'A';
        intloc := VAL(INTEGER, ORD(intloc)+1);

      END
    END;
    IF (charloc >= 'W') AND (charloc <= 'Z') THEN
      intloc := 7;
    END;
    IF charloc = 'X' THEN
      Func2Result := TRUE;

    ELSIF Strcmp(strpari1, strpari2) > 0 THEN

      INC(intloc, 7);
      Func2Result := TRUE;

    ELSE
      Func2Result := FALSE
    END;
    RETURN Func2Result
  END Func2;


  PROCEDURE Func3(enumparin: INTEGER): BOOLEAN;

    VAR
      enumloc: INTEGER;
    VAR Func3Result: BOOLEAN;
  BEGIN
    enumloc := enumparin;
    Func3Result := enumloc = Ident3;
    RETURN Func3Result
  END Func3;






  (* once *)

  PROCEDURE P8(array1par: intar51;
               array2par: intar5151;
               intpari1, intpari2: INTEGER);

    VAR
      intloc, intindex: INTEGER;
  BEGIN
  (* intpari1=3;   intpari2 = 7 *)
    intloc := intpari1+5;
    array1par[intloc] := intpari2;
    array1par[intloc+1] := array1par[intloc];
    array1par[intloc+30] := intloc;
    FOR intindex := intloc TO 2 BY -1 DO
      array2par[intloc][intindex] := intloc
    END;
    array2par[intloc][intloc-1] := array2par[intloc][intloc-1]+1;
    array2par[intloc+20][intloc] := array1par[intloc];
    intglob := 5;
  END P8;



  PROCEDURE P7(intpari1, intpari2: INTEGER;
               VAR intparout: INTEGER);

    VAR
      intloc: INTEGER;
  BEGIN
    intloc := intpari1+2;
    intparout := intpari2+intloc;
  END P7;




  PROCEDURE P5;
  BEGIN
    char1glob := 'A';
    boolglob := FALSE;
  END P5;


  PROCEDURE P4;

    VAR
      boolloc: BOOLEAN;
  BEGIN
    boolloc := char1glob = 'A';
    boolloc := boolloc OR boolglob;
    char2glob := 'B';
  END P4;

  (* once *)

  PROCEDURE P3(VAR ptrparout: strptr);
  BEGIN
    IF ptrglb <> NIL THEN
      (* true *)
      ptrparout := ptrglb^.ptrcomp
    ELSE
      intglob := 100
    END;
    P7(10, intglob, ptrglb^.intcomp);
  END P3;

  (* once *)

  PROCEDURE P6(enumparin: INTEGER;
               VAR enumparout: INTEGER);

    VAR
      res: BOOLEAN;
  BEGIN
    enumparout := enumparin;
    IF  NOT Func3(enumparin) THEN
      enumparout := Ident4
    END; (* not taken *)
    CASE enumparin OF
        Ident1:
        enumparout := Ident1
      | Ident2:
        IF intglob > 100 THEN

          enumparout := Ident1
        ELSE
          enumparout := Ident4
        END
      | Ident3:
        enumparout := Ident2
      | Ident4:
      | Ident5:
        enumparout := Ident3

      ELSE
    END;
  END P6;


  PROCEDURE P2(VAR intpario: INTEGER);

    VAR
      intloc, enumloc: INTEGER;
      going: BOOLEAN;
  BEGIN
  (* intpario = 3 *)
    intloc := intpario+10;
    going := TRUE;
    WHILE going DO
      (* once *)
      IF char1glob = 'A' THEN

        intloc := VAL(INTEGER, ORD(intloc)-1);
        intpario := intloc-intglob;
        enumloc := Ident1;
      END;
      going := enumloc <> Ident1;
    END;
  END P2;


  PROCEDURE P1(ptrparin: strptr);
  BEGIN
    WITH ptrglb^ DO

      ptrparin^.intcomp := 5;
      intcomp := ptrparin^.intcomp;
      ptrcomp := ptrparin^.ptrcomp;
      P3(ptrcomp);
      IF discr = Ident1 THEN
        (* true *)
        intcomp := 6;
        P6(ptrparin^.enumcomp, enumcomp);
        ptrcomp := ptrglb^.ptrcomp;
        P7(intcomp, 10, intcomp);

      ELSE
        ptrparin^ := ptrglb^.ptrcomp^
      END;
    END;
  END P1;


  PROCEDURE P0(loops: INTEGER);

    VAR
      string2loc: strings;
      intloc1, intloc2, intloc3: INTEGER;
      charindex, charloc: CHAR;
      i, enumloc: INTEGER;

  BEGIN
    FOR i := 1 TO loops DO

      P5;
      P4;
      intloc1 := 2;
      intloc2 := 3;
      string2loc := "DHRYSTONE PROGRAM, 2'nd STRING";
      enumloc := Ident2;
      boolglob :=  NOT Func2(string1loc, string2loc); (*true *)
      WHILE intloc1 < intloc2 DO
        (* 1 *)
        intloc3 := (5*intloc1)-intloc2;
        P7(intloc1, intloc2, intloc3);
        intloc1 := VAL(INTEGER, ORD(intloc1)+1);
      END;
      P8(array1, array2, intloc1, intloc3); (* intglob=5 *)
      P1(ptrglb);
      FOR charindex := 'A' TO char2glob DO (* 2 *)
        IF enumloc = Func1(charindex, 'C') THEN
          P6(Ident1, enumloc)
        END
      END; (* enumloc=ident1  intloc1=3  intloc2=3 intloc3=7 *)
      intloc3 := intloc2*intloc1;
      intloc2 := intloc3 DIV intloc1;
      intloc2 := (7*(intloc3-intloc2))-intloc1;
      P2(intloc1);
    END;
  END P0;


  VAR
    count, i: INTEGER;

BEGIN
  ALLOCATE(ptrglb,TSIZE(structure));
  WITH ptrglb^ DO

    ALLOCATE(ptrcomp,TSIZE(structure));
    discr := Ident1;
    enumcomp := Ident3;
    intcomp := 40;
    stringcomp := 'DHRYSTONE PROGRAM, SOME STRING';
  END;
  string1loc := "DHRYSTONE PROGRAM, 1'ST STRING";
  count := 1000;
  P0(count);
END DHRYSTONE.

TRG@WATDCS.UWATERLOO.CA (Trevor Grove) (05/03/91)

I have done such a conversion.  I will send you private mail with
details.  If the group at large is interested, let me know and I
will take further action here.

Trevor Grove               trg@watcsg.uwaterloo.ca -or- TRG at WATCSG (BITNet)
Computer Systems Group     trg@watdcs.uwaterloo.ca
University of Waterloo     trg@csg.uwaterloo.ca

Markus.Maeder@p2.f807.n302.z2.fidonet.org (Markus Maeder) (05/06/91)

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

Ben.Coleman@f15.n277.z1.fidonet.org (Ben Coleman) (05/11/91)

 MM>> FROM Time IMPORT GetTime;
     
 JT> My version of JPI 1.17 cannot find this library.  Is it one of 
 JT> your own? 

 JT> There is a GetTime in Misc.MOD but it doesn't like that at all!

The GetTime provided with TSM2 1.17(in my case, it's in DIVERSE.TXT) gets the
time from DOS.  It looks like DH.MOD wants the time in timer ticks(18.2/second),
which is a BIOS function.  The following should get it:


DEFINITION MODULE Time;

PROCEDURE GetTime(): LONGCARD;

END Time.


IMPLEMENTATION MODULE Time;

FROM SYSTEM IMPORT Registers;
FROM Lib IMPORT Intr;

PROCEDURE GetTime(): LONGCARD;
VAR
    r: Registers;

BEGIN
    r.AH := 0;
    Intr(r, 1AH);
    RETURN (LONGCARD(r.CX) * 65536) + LONGCARD(r.DX);
END GetTime;

END Time.



Ben


--  
uucp: uunet!m2xenix!puddle!277!15!Ben.Coleman
Internet: Ben.Coleman@f15.n277.z1.fidonet.org

John.Taylor@f68.n253.z2.fidonet.org (John Taylor) (05/12/91)

Hi Mike

 MC>  MM>> FROM Time IMPORT GetTime;
 MC> 
 MC> 
 MC>  JT> There is a GetTime in Misc.MOD but it doesn't like that at all!
 MC> 
 MC> If you Define:
 MC> 
 MC> VAR Ticks[0:46CH] : LONGCARD;
 MC> 
 MC> and Substitute:
 MC> tm:=Ticks; for tm:=GetTime();
 MC> 
 MC> and substitute:
 MC> deltatm:=Ticks-tm; for deltatm:=GetTime-tm;
 MC> 
 MC> It seems to work OK. It might have a bit of a problem across midnight!

Many thanks.  Works very well.

Cheers,
John


--  
uucp: uunet!m2xenix!puddle!2!253!68!John.Taylor
Internet: John.Taylor@f68.n253.z2.fidonet.org