🚀 go-pugleaf

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.