home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / demos / hennessy.mod (.txt) < prev    next >
Oberon Text  |  1995-04-06  |  21KB  |  891 lines
  1. Syntax10.Scn.Fnt
  2. MODULE Hennessy;
  3. (*  This is a suite of benchmarks that are relatively short, both in program
  4.     size and execution time.  It requires no input, and prints the execution
  5.     time for each program, using the system- dependent routine Getclock,
  6.     below, to find out the current CPU time.  It does a rudimentary check to
  7.     make sure each program gets the right output.  These programs were
  8.     gathered by John Hennessy and modified by Peter Nye.
  9.     Oberon: J.Templ 26.2.90 *)
  10. IMPORT
  11.     Oberon, Texts, S := SYSTEM;
  12. CONST
  13.     bubblebase = 1.61;
  14.     dnfbase = 3.5;
  15.     permbase = 1.75;
  16.     queensbase = 1.83;
  17.     towersbase = 2.39;
  18.     quickbase = 1.92;
  19.     intmmbase = 1.46;
  20.     treebase =  2.5;
  21.     mmbase = 0.0 (* 0.73 *);
  22.     fpmmbase = 2.92;
  23.     puzzlebase = 0.5;
  24.     fftbase = 0.0 (* 1.11 *);
  25.     fpfftbase = 4.44;
  26.     (* Towers *)
  27.     maxcells = 18;
  28.     stackrange = (*0..*) 3;
  29.     (* Intmm, Mm *)
  30.     rowsize = 40;
  31.     (* Puzzle *)
  32.     size = 511;
  33.     classmax = 3;
  34.     typemax = 12;
  35.     d = 8;
  36.     (* Bubble, Quick *)
  37.     sortelements = 5000;
  38.     srtelements = 500;
  39.     (* fft *)
  40.     fftsize = 256;
  41.     fftsize2 = 129;
  42.     (* Perm *)
  43.     permrange = (*0 ..*)10;
  44.     (* Towers *)
  45.     (* tree *)
  46.     node = POINTER TO nodeDesc;
  47.     nodeDesc = RECORD
  48.         left, right: node;
  49.         val: LONGINT;
  50.     END;
  51.     (* Towers
  52.     discsizrange = 1..maxcells;
  53.     cellcursor = 0..maxcells; *)
  54.     element = RECORD
  55.         discsize: LONGINT;
  56.         next: LONGINT;
  57.     END ;
  58. (*    emsgtype = packed array[1..15] of char;
  59.     (* Intmm, Mm *) (*
  60.     index = 1 .. rowsize; *)
  61.     intmatrix = ARRAY rowsize+1,rowsize+1 OF LONGINT;
  62.     realmatrix = ARRAY rowsize+1,rowsize+1 OF REAL;
  63.     (* Puzzle *) (*
  64.     piececlass = 0..classmax;
  65.     piecetype = 0..typemax;
  66.     position = 0..size;
  67.     (* Bubble, Quick *) (*
  68.     listsize = 0..sortelements;
  69.     sortarray = array [listsize] of integer;
  70.     (* FFT *)
  71.     complex = RECORD
  72.         rp, ip: REAL
  73.     END;
  74.     carray = ARRAY fftsize+1 OF complex ;
  75.     c2array = ARRAY fftsize2+1 OF complex ;
  76.     Proc = PROCEDURE;
  77.     fixed,floated: REAL;
  78.     (* global *)
  79.     seed: LONGINT;
  80.     (* Perm *)
  81.     permarray: ARRAY permrange+1 OF LONGINT;
  82.     pctr: LONGINT;
  83.     (* tree *)
  84.     tree: node;
  85.     (* Towers *)
  86.     stack: ARRAY stackrange+1 OF LONGINT;
  87.     cellspace: ARRAY maxcells+1 OF element;
  88.     freelist: LONGINT;
  89.     movesdone: LONGINT;
  90.     (* Intmm, Mm *)
  91.     ima, imb, imr: intmatrix;
  92.     rma, rmb, rmr: realmatrix;
  93.     (* Puzzle *)
  94.     piececount: ARRAY classmax+1 OF LONGINT;
  95.     class, piecemax: ARRAY typemax+1 OF LONGINT;
  96.     puzzl: ARRAY size+1 OF BOOLEAN;
  97.     p: ARRAY typemax+1, size+1 OF BOOLEAN;
  98.     kount: LONGINT;
  99.     (* Bubble, Quick *)
  100.     sortlist: ARRAY sortelements+1 OF LONGINT;
  101.     biggest, littlest,
  102.     top: LONGINT;
  103.     (* FFT *)
  104.     z, w: carray;
  105.     e: c2array;
  106.     zr, zi: REAL;
  107.       W: Texts.Writer;
  108. (* global procedures *)
  109. PROCEDURE Str*(s: ARRAY OF CHAR);
  110.     VAR i: INTEGER;
  111. BEGIN
  112.     i:=0;
  113.     WHILE s[i] # 0X DO
  114.         IF s[i]="$" THEN Texts.WriteLn(W) ELSE Texts.Write(W, s[i]) END;
  115.         INC(i)
  116.     END;
  117.     Texts.Append(Oberon.Log, W.buf)
  118. END Str;
  119. PROCEDURE Getclock (): LONGINT;
  120. BEGIN
  121.     RETURN Oberon.Time()
  122. END Getclock;
  123. PROCEDURE Initrand ();
  124. BEGIN seed := 74755
  125. END Initrand;
  126. PROCEDURE Rand (): LONGINT;
  127. BEGIN
  128.     seed := (seed * 1309 + 13849) MOD 65535;
  129.     RETURN (seed);
  130. END Rand;
  131.     (* Permutation program, heavily recursive, written by Denny Brown. *)
  132.     PROCEDURE Swap (VAR a,b: LONGINT);
  133.         VAR t: LONGINT;
  134.     BEGIN t := a;  a := b;  b := t;
  135.     END Swap;
  136.     PROCEDURE Initialize ();
  137.         VAR i: LONGINT;
  138.     BEGIN i := 1;
  139.         WHILE i <= 7 DO
  140.             permarray[i] := i-1;
  141.             INC(i)
  142.         END
  143.     END Initialize;
  144.     PROCEDURE Permute (n: LONGINT);
  145.         VAR k: LONGINT;
  146.     BEGIN
  147.         pctr := pctr + 1;
  148.         IF ( n#1 ) THEN
  149.             Permute(n-1);
  150.             k := n-1;
  151.             WHILE k >= 1 DO
  152.                 Swap(permarray[n], permarray[k]);
  153.                 Permute(n-1);
  154.                 Swap(permarray[n], permarray[k]);
  155.                 DEC(k)
  156.             END
  157.        END
  158.     END Permute;
  159. PROCEDURE *Perm ();
  160.     VAR i: LONGINT;
  161. BEGIN
  162.     pctr := 0; i := 1;
  163.     WHILE i <= 5 DO
  164.         Initialize();
  165.         Permute(7);
  166.         INC(i)
  167.     END ;
  168.     IF ( pctr # 43300 ) THEN Str(" Error in Perm.$") END
  169. END Perm;
  170.     (*  Program to Solve the Towers of Hanoi *)
  171.     PROCEDURE Makenull (s: LONGINT);
  172.     BEGIN stack[s] := 0
  173.     END Makenull;
  174.     PROCEDURE Getelement (): LONGINT;
  175.         VAR temp: LONGINT;
  176.     BEGIN
  177.         IF ( freelist>0 ) THEN
  178.             temp := freelist;
  179.             freelist := cellspace[freelist].next;
  180.         ELSE
  181.             Str("out of space   $")
  182.         END ;
  183.         RETURN (temp);
  184.     END Getelement;
  185.     PROCEDURE Push(i,s: LONGINT);
  186.         VAR localel: LONGINT; errorfound: BOOLEAN;
  187.     BEGIN
  188.         errorfound := FALSE;
  189.         IF ( stack[s] > 0 ) THEN
  190.             IF ( cellspace[stack[s]].discsize<=i ) THEN
  191.                 errorfound := TRUE;
  192.                 Str("disc size error$")
  193.             END 
  194.         END ;
  195.         IF ( ~ errorfound ) THEN
  196.             localel := Getelement();
  197.             cellspace[localel].next := stack[s];
  198.             stack[s] := localel;
  199.             cellspace[localel].discsize := i
  200.         END
  201.     END Push;
  202.     PROCEDURE Init (s,n: LONGINT);
  203.         VAR discctr: LONGINT;
  204.     BEGIN
  205.         Makenull(s); discctr := n;
  206.         WHILE discctr >= 1 DO
  207.             Push(discctr,s);
  208.             DEC(discctr)
  209.         END
  210.     END Init;
  211.     PROCEDURE Pop (s: LONGINT): LONGINT;
  212.         VAR temp, temp1: LONGINT;
  213.     BEGIN
  214.         IF ( stack[s] > 0 ) THEN
  215.             temp1 := cellspace[stack[s]].discsize;
  216.             temp := cellspace[stack[s]].next;
  217.             cellspace[stack[s]].next := freelist;
  218.             freelist := stack[s];
  219.             stack[s] := temp;
  220.             RETURN (temp1)
  221.         ELSE
  222.             Str("nothing to pop $")
  223.         END
  224.     END Pop;
  225.     PROCEDURE Move (s1,s2: LONGINT);
  226.     BEGIN
  227.         Push(Pop(s1),s2);
  228.         movesdone := movesdone+1;
  229.     END Move;
  230.     PROCEDURE tower(i,j,k: LONGINT);
  231.         VAR other: LONGINT;
  232.     BEGIN
  233.         IF ( k=1 ) THEN
  234.             Move(i,j);
  235.         ELSE
  236.             other := 6-i-j;
  237.             tower(i,other,k-1);
  238.             Move(i,j);
  239.             tower(other,j,k-1)
  240.         END
  241.     END tower;
  242. PROCEDURE *Towers ();
  243.     VAR i: LONGINT;
  244. BEGIN i := 1;
  245.     WHILE i <= maxcells DO cellspace[i].next := i-1; INC(i) END ;
  246.     freelist := maxcells;
  247.     Init(1,14);
  248.     Makenull(2);
  249.     Makenull(3);
  250.     movesdone := 0;
  251.     tower(1,2,14);
  252.     IF ( movesdone # 16383 ) THEN Str(" Error in Towers.$") END
  253. END Towers;
  254.     (* The eight queens problem, solved 50 times. *)
  255.   type
  256.       doubleboard =   2..16;
  257.       doublenorm  =   -7..7;
  258.       boardrange  =   1..8;
  259.       aarray      =   array [boardrange] of boolean;
  260.       barray      =   array [doubleboard] of boolean;
  261.       carray      =   array [doublenorm] of boolean;
  262.       xarray      =   array [boardrange] of boardrange;
  263.     PROCEDURE Try(i: LONGINT; VAR q: BOOLEAN; VAR a, b, c: ARRAY OF BOOLEAN; VAR x: ARRAY OF LONGINT);
  264.         VAR j: LONGINT;
  265.     BEGIN
  266.         j := 0;
  267.         q := FALSE;
  268.         WHILE (~q) & (j # 8) DO
  269.             j := j + 1;
  270.             q := FALSE;
  271.             IF b[j] & a[i+j] & c[i-j+7] THEN
  272.                 x[i] := j;
  273.                 b[j] := FALSE;
  274.                 a[i+j] := FALSE;
  275.                 c[i-j+7] := FALSE;
  276.                 IF i < 8 THEN
  277.                     Try(i+1,q,a,b,c,x);
  278.                     IF ~q THEN
  279.                         b[j] := TRUE;
  280.                         a[i+j] := TRUE;
  281.                         c[i-j+7] := TRUE
  282.                     END
  283.                 ELSE q := TRUE
  284.                 END
  285.             END
  286.         END
  287.     END Try;
  288.     PROCEDURE Doit ();
  289.         VAR i: LONGINT; q: BOOLEAN;
  290.             a: ARRAY 9 OF BOOLEAN;
  291.             b: ARRAY 17 OF BOOLEAN;
  292.             c: ARRAY 15 OF BOOLEAN;
  293.             x: ARRAY 9 OF LONGINT;
  294.     BEGIN
  295.         i := 0 - 7;
  296.         WHILE i <= 16 DO
  297.             IF (i >= 1) & (i <= 8) THEN a[i] := TRUE END ;
  298.             IF i >= 2 THEN b[i] := TRUE END ;
  299.             IF i <= 7 THEN c[i+7] := TRUE END ;
  300.             i := i + 1;
  301.         END ;
  302.         Try(1, q, b, a, c, x);
  303.         IF ( ~ q ) THEN Str(" Error in Queens.$") END
  304.     END Doit;
  305. PROCEDURE *Queens ();
  306.     VAR i: LONGINT;
  307. BEGIN i := 1;
  308.     WHILE i <= 50 DO Doit(); INC(i) END
  309. END Queens;
  310.     (* Multiplies two integer matrices. *)
  311.     PROCEDURE Initmatrix (VAR m: intmatrix);
  312.         VAR temp, i, j: LONGINT;
  313.     BEGIN i := 1;
  314.         WHILE i <= rowsize DO
  315.             j := 1;
  316.             WHILE j <= rowsize DO
  317.                 temp := Rand();
  318.                 m[i][j] := temp - (temp DIV 120)*120 - 60;
  319.                 INC(j)
  320.             END ;
  321.             INC(i)
  322.         END
  323.     END Initmatrix;
  324.     PROCEDURE Innerproduct(VAR result: LONGINT; VAR a,b: intmatrix; row,column: LONGINT);
  325.         VAR i: LONGINT;
  326.   (* computes the inner product of A[row,*] and B[*,column] *)
  327.     BEGIN
  328.         result := 0; i := 1;
  329.         WHILE i <= rowsize DO result := result+a[row][i]*b[i][column]; INC(i) END
  330.     END Innerproduct;
  331. PROCEDURE *Intmm ();
  332.     VAR i, j: LONGINT;
  333. BEGIN
  334.     Initrand();
  335.     Initmatrix (ima);
  336.     Initmatrix (imb);
  337.     i := 1;
  338.     WHILE i <= rowsize DO j := 1;
  339.         WHILE j <= rowsize DO Innerproduct(imr[i][j],ima,imb,i,j); INC(j) END ;
  340.         INC(i)
  341. END Intmm;
  342.     (* Multiplies two real matrices. *)
  343.     PROCEDURE rInitmatrix (VAR m: realmatrix);
  344.         VAR temp, i, j: LONGINT;
  345.     BEGIN i := 1;
  346.         WHILE i <= rowsize DO j := 1;
  347.             WHILE j <= rowsize DO
  348.                 temp