bmbench.mi

(*
 * BM Bench - bmbench.p (Modula-2)
 * (c) Marco Vieth, 2002
 * http://www.benchmarko.de
 *
 * 06.05.2002  0.01
 * 11.05.2002  0.02  bench1 = (sum 1..n) mod 65536
 * 20.07.2002  0.04  more benchmarks
 * 24.01.2003  0.05  output format changed
 *
 * Usage:
 * bmbench [bench1] [bench2] [n]
 *
 *)

(*
 * Compile:
 * mocka -noindex -norange -nog -c bmbench
 * mocka -p bmbench
 * ./bmbench
 * Or: makemake > Makefile ; make  (mtc, does not work for me)
 * (See definitions in: /usr/lib/mocka/lib/*.md)
 *
 * More information:
 * /usr/share/doc/packages/mocka/UserMan.ps.gz
 * /usr/share/doc/packages/mocka/example/bench1.mi , bench2.mi
 *
 * Notes:
 * - <neg. number> MOD 65536  seems to be different than in Pascal
 * - LREAL::LFLOAT() seems to be faster than MathLib::realL()
 *
 *)

MODULE bmbench;

  FROM InOut IMPORT WriteInt, Write, WriteString, WriteLn (*, WriteLongReal *);
  FROM Clock IMPORT ResetClock, UserTime, SystemTime;

  (* FROM MathLib IMPORT realL; *)
  FROM LREAL IMPORT LTRUNC, LFLOAT;

  FROM Arguments IMPORT GetArgs, ArgTable;
  FROM NumConv IMPORT Str2Num; (* to convert args *)
  VAR argc: SHORTCARD; VAR argv: ArgTable;

  (*
   * General description for benchmark test functions
   * benchxx - benchmark
   * <description>
   * in: loops = number of loops
   *         n = maximum number (assumed even, normally n=1000000)
   * out:    x = <output decription>
   *
   * loops may be increased to produce a longer runtime without changing the result.
   *)


  (*
   * bench00 (Integer 16 bit)
   * (sum of 1..n) mod 65536
   *)
  PROCEDURE bench00(loops, n: INTEGER): INTEGER;
  VAR x : SHORTCARD;
      sum1 : SHORTCARD;
      n_div_65536, n_mod_65536, i, j : CARDINAL;

  BEGIN
    x := 0;
    sum1 := (n DIV 2) * (n + 1);
    (* (sum1..1000000 depends on type: 500000500000 (floating point), 1784293664 (32bit), 10528 (16 bit) *)
    n_div_65536 := n DIV 65536;
    n_mod_65536 := n MOD 65536;
    (* fprintf(stderr, "Test(bench%d): x=%f, %ld, %ld\n", 1, (double)sum, (long)fmod(sum, 2147483648L), (long)fmod(sum, 65536L)); *)
    WHILE (loops > 0) DO
      DEC(loops);
      FOR i := n_div_65536 TO 1 BY -1 DO
        FOR j := 65536 TO 1 BY -1 DO
          x := x + j;
        END;
      END;
      FOR j := n_mod_65536 TO 1 BY -1 DO
        x := x + j;
      END;
      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - sum1;     (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0) THEN   (* now x must be 0 again *)
          INC(x);          (* force error for many wrong computations *)
          RETURN x; (* HALT; *)
        END;
      END;
    END;
    RETURN x;
  END bench00;


  (*
   * bench01 (Integer 16/32 bit)
   * (sum of 1..n) mod 65536
   *)
  PROCEDURE bench01(loops, n: INTEGER): INTEGER;
  VAR x : INTEGER;
      sum1 : INTEGER;
      i : INTEGER;

  BEGIN
    x := 0;
    sum1 := (n DIV 2) * (n + 1);
    WHILE (loops > 0) DO
      DEC(loops);
      FOR i := n TO 1 BY -1 DO
        x := x + i;
      END;
      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - sum1;     (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0) THEN   (* now x must be 0 again *)
          INC(x);          (* force error for many wrong computations *)
          RETURN x MOD 65536; (* HALT; *)
        END;
      END;
    END;
    RETURN x MOD 65536;
  END bench01;


  (*
   * bench02 (Floating Point, normally 64 bit)
   * (sum of 1..n) mod 65536
   *)
  PROCEDURE bench02(loops, n: INTEGER): INTEGER;
  VAR x : LONGREAL;
      sum1 : LONGREAL;
      i : INTEGER;

  BEGIN
    x := 0.0;
    sum1 := (LFLOAT(n) / 2.0) * (LFLOAT(n) + 1.0);
    (* WriteLongReal(sum1, 10, 1); *)
    WHILE (loops > 0) DO
      DEC(loops);
      FOR i := n TO 1 BY -1 DO
        x := x + LFLOAT(i);
      END;
      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - sum1;     (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0.0) THEN (* now x must be 0 again *)
          x := x + 1.0;    (* force error for many wrong computations *)
          RETURN LTRUNC(x); (* HALT; *)
        END;
      END;
    END;
    RETURN LTRUNC(x - (LFLOAT(LTRUNC(x / 65536.0)) * 65536.0));
  END bench02;


  (*
   * bench03 (Integer)
   * number of primes below n (Sieve of Eratosthenes)
   * Example: n=500000 => x=41538 (expected), n=1000000 => x=78498
   *)
  PROCEDURE bench03(loops, n_p: INTEGER): INTEGER;
  CONST MAX_N = 500000; (* highest number for sieve div 2 *)
  VAR x : INTEGER;
      n, i, i_mul_i, j : INTEGER;
      sieve1 : ARRAY[0..MAX_N] OF BOOLEAN;
  BEGIN
    n := n_p DIV 2; (* compute only up to n/2 *)
    IF (n > MAX_N) THEN
      WriteString('Error: n too large: '); WriteInt(n, 1); WriteLn;
      RETURN -1; (* error *)
    END;
    x := 0; (* number of primes below n *)
    sieve1[0] := FALSE;
    sieve1[1] := FALSE;
    WHILE (loops > 0) DO
      DEC(loops);
      (* initialize sieve *)
      FOR i := 2 TO n DO
        sieve1[i] := TRUE;
      END;
      (* compute primes *)
      i := 2;
      i_mul_i := i * i;
      WHILE (i_mul_i <= n) DO
        IF (sieve1[i]) THEN
          (* FOR j := i_mul_i TO n BY i DO *)
          j := i_mul_i;
          WHILE (j <= n) DO
            sieve1[j] := FALSE;
            j := j + i;
          END;
        END;
        INC(i);
        i_mul_i := i * i;
      END;
      (* count primes *)
      FOR i := 0 TO n DO
        IF (sieve1[i]) THEN
          INC(x);
        END;
      END;
      (* check prime count *)
      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - 41538;    (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0) THEN   (* now x must be 0 again *)
          INC(x);          (* force error for many wrong computations *)
          RETURN x;
        END;
      END;
    END;
    RETURN x;
  END bench03;


  (*
   * bench04 (Integer 32 bit)
   * nth random number number
   * Random number generator taken from
   * Raj Jain: The Art of Computer Systems Performance Analysis, John Wiley & Sons, 1991, page 442-444.
   * It needs longs with at least 32 bit.
   * Starting with x0=1, x10000 should be 1043618065, x1000000 = 1227283347.
   *)
  PROCEDURE bench04(loops, n: INTEGER): INTEGER;
    CONST m = 2147483647; (* modulus, do not change! *)
          a = 16807;      (* multiplier *)
          q = 127773;     (* m div a *)
          r = 2836;       (* m mod a *)
    VAR x, i, x_div_q, x_mod_q : INTEGER;
    BEGIN
    x := 1; (* last random value *)
    WHILE (loops > 0) DO
      DEC(loops);
      FOR i := n TO 1 BY -1 DO
        x_div_q := x DIV q;
        x_mod_q := x - q * x_div_q;
        x := a * x_mod_q - r * x_div_q;
        IF (x <= 0) THEN
          x := x + m; (* x is new random number *)
        END;
      END;
      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - 1227283347; (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0) THEN   (* now x must be 0 again *)
          INC(x);          (* force error for many wrong computations *)
          RETURN x; (* HALT; *)
        END;
        INC(x); (* start with 1 again *)
      END;
    END;
    RETURN x;
  END bench04;


  (*
   * bench05 (Integer 32 bit)
   * n over n/2 mod 65536 (Pascal's triangle)
   *)
  PROCEDURE bench05(loops, n_p: INTEGER): INTEGER;  (* to do!!! *)
  CONST MAX_N = 1000000 DIV (500 * 2); (* highest number for array *)
  VAR x : INTEGER;
      n, k, i, i_mod_2, min1, i_mod_2_1, j : INTEGER;
      pas1 : ARRAY[0..1],[0..MAX_N] OF INTEGER; (* same as ARRAY[0..1] OF ARRAY[0..MAX_N] OF INTEGER; *)

  BEGIN
    x := 0;
    n := n_p DIV 500;
    k := n DIV 2;
    IF ((n - k) < k) THEN
      k := n - k; (* keep k minimal with  n over k  =  n over n-k *)
    END;

    IF (k > MAX_N) THEN
      WriteString('Error: k too large: '); WriteInt(k, 1); WriteLn;
      RETURN -1; (* error *)
    END;

    pas1[0][0] := 1; pas1[1][0] := 1; (* set first column *)
    (* WriteString('DEBUG: loops='); WriteInt(loops, 1); WriteLn; *)
    WHILE (loops > 0) DO
      DEC(loops);
      FOR i := 2 TO n DO
        i_mod_2 := i MOD 2;
        min1 := (i - 1) DIV 2;
        IF (k < min1) THEN
          min1 := k;
        END;
        i_mod_2_1 := (i + 1) MOD 2;
        pas1[i_mod_2][1] := i; (* second column is i *)
        FOR j := 2 TO min1 DO (* up to min((i-1)/2, k) *)
          pas1[i_mod_2][j] := (pas1[i_mod_2_1][j - 1] + pas1[i_mod_2_1][j]);
        END;
        IF ((min1 < k) AND (i_mod_2 = 0)) THEN (* new element *)
          pas1[i_mod_2][min1 + 1] := 2 * pas1[i_mod_2_1][min1];
        END;
      END;

      (* WriteString('DEBUG: pas1[n MOD 2]='); WriteInt(pas1[n MOD 2][k], 1); WriteLn; *) (* -531600832 *)
      x := x + (pas1[n MOD 2][k] - (pas1[n MOD 2][k] DIV 65536) * 65536); (* MOD 65536 seems to be different... *)
      (* WriteString('DEBUG: curr_x='); WriteInt(x, 1); WriteLn; *) (* 27200 *)

      IF (loops > 0) THEN  (* some more loops left? *)
        x := x - 27200;    (* yes, set x back to 0 (assuming n even) *)
        IF (x <> 0) THEN   (* now x must be 0 again *)
          INC(x);          (* force error for many wrong computations *)
          RETURN x;
        END;
      END;
    END;
    RETURN x;
  END bench05;



 (*
  * run a benchmark
  * in: bench = benchmark to use
  *     loops = number of loops
  *         n = maximum number (used in some benchmarks to define size of workload)
  * out:    x = result
  *)
  PROCEDURE run_bench(bench, loops, n: INTEGER) : INTEGER;
  VAR x : INTEGER;
      check1 : INTEGER;

  BEGIN
    x := 0;
    check1 := 0;
    CASE bench OF
      0:  x := bench00(loops, n);  check1 := 10528; |
      1:  x := bench01(loops, n);  check1 := 10528; |
      2:  x := bench02(loops, n);  check1 := 10528; |
      3:  x := bench03(loops, n);  check1 := 41538; |
      4:  x := bench04(loops, n);  check1 := 1227283347; |
      5:  x := bench05(loops, n);  check1 := 27200;
      ELSE
        WriteString('Error: Unknown benchmark: '); WriteInt(bench, 1); WriteLn;
        check1 := x + 1; (* force error *) (* HALT; *)
    END;
    IF (check1 <> x) THEN
      WriteString('Error(bench'); WriteInt(bench, 1); WriteString('): x='); WriteInt(x, 1); WriteLn;
      x := -1; (* exit *)
    END;
    RETURN(x);
  END run_bench;


  PROCEDURE init_ms();
  BEGIN
    ResetClock();
  END init_ms;

 (*
  * get timestamp in milliseconds
  * out: x = time in ms
  *
  * This function is intended for short measurements only so we
  * can return it as an integer.
  *)
  PROCEDURE get_ms() : INTEGER;
  BEGIN
    RETURN((UserTime() + SystemTime()) * 10);
  END get_ms;


  PROCEDURE atoi(VAR s: ARRAY OF CHAR) : INTEGER;
  VAR num: LONGCARD;
  VAR done: BOOLEAN;
  BEGIN
    Str2Num(num, 10, s, done);
    RETURN(num);
  END atoi;


  (* Here we compute the number of "significant" bits for positive numbers (which means 53 for double) *)
  PROCEDURE checkbits_short1() : INTEGER;
  VAR num, last_num : SHORTCARD;
  VAR bits : INTEGER;
  BEGIN
    num := 1;
    last_num := 0;
    bits := 0;
    REPEAT
      last_num := num;
      num := num * 2;
      num := num + 1;
      bits := bits + 1;
    UNTIL ( (((num - 1) DIV 2) <> last_num) OR (bits >= 101) );
    RETURN(bits);
  END checkbits_short1;


  PROCEDURE checkbits_int1() : INTEGER;
  VAR num, last_num : INTEGER;
  VAR bits : INTEGER;
  BEGIN
    num := 1;
    last_num := 0;
    bits := 0;
    REPEAT
      last_num := num;
      num := num * 2;
      num := num + 1;
      bits := bits + 1;
    UNTIL ( (((num - 1) DIV 2) <> last_num) OR (bits >= 101) );
    RETURN(bits);
  END checkbits_int1;


  PROCEDURE checkbits_float1() : INTEGER;
  VAR num, last_num : REAL;
  VAR bits : INTEGER;
  BEGIN
    num := 1.0;
    last_num := 0.0;
    bits := 0;
    REPEAT
      last_num := num;
      num := num * 2.0;
      num := num + 1.0;
      bits := bits + 1;
    UNTIL ( (((num - 1.0) / 2.0) <> last_num) OR (bits >= 101) );
    RETURN(bits);
  END checkbits_float1;


  PROCEDURE checkbits_double1() : INTEGER;
  VAR num, last_num : LONGREAL;
  VAR bits : INTEGER;
  BEGIN
    num := 1.0;
    last_num := 0.0;
    bits := 0;
    REPEAT
      last_num := num;
      num := num * 2.0;
      num := num + 1.0;
      bits := bits + 1;
    UNTIL ( (((num - 1.0) / 2.0) <> last_num) OR (bits >= 101) );
    RETURN(bits);
  END checkbits_double1;


  PROCEDURE main(argc: SHORTCARD; VAR argv: ArgTable);
    CONST min_ms = 10000;  (* minimum runtime for measurement in ms *)
          MAX_BENCH = 5;

    VAR start_t : INTEGER; (* memorize start time *)
        bench1, bench2 : INTEGER;
        bench : INTEGER;   (* benchmark to test *)
        n : INTEGER;       (* maximum number *)

        loops : INTEGER;   (* number of loops *)
        x : INTEGER;       (* result from benchmark *)
        t1 : INTEGER;      (* timestamp *)
        bench_res1 : ARRAY[0..MAX_BENCH] OF INTEGER;
  BEGIN
    init_ms();
    start_t := get_ms();
    bench1 := 0;
    bench2 := 5;
    n := 1000000;

    IF (argc > 1) THEN
      bench1 := atoi(argv^[1]^);
      bench2 := bench1; (* set also last benchmark *)
    END;
    IF (argc > 2) THEN
      bench2 := atoi(argv^[2]^);
    END;
    IF (argc > 3) THEN
      n := atoi(argv^[3]^);
    END;

    IF (bench1 > MAX_BENCH) OR (bench2 > MAX_BENCH) THEN
      WriteString('Error: benchmark out of range!'); WriteLn;
      HALT; (* error *)
    END;

    WriteString('BM Bench v0.5 (Modula-2) -- (short:'); WriteInt(checkbits_short1(), 1);
    WriteString(' int:'); WriteInt(checkbits_int1(), 1);
    WriteString(' float:'); WriteInt(checkbits_float1(), 1);
    WriteString(' double:'); WriteInt(checkbits_double1(), 1);
    WriteString(') version: ?'); WriteLn;
    WriteString('(c) Marco Vieth, 2002'); WriteLn;

    FOR bench := bench1 TO bench2 DO
      loops := 1;
      x := 0;
      t1 := 0;
      (* calibration *)
      WHILE (t1 < 1001) AND (x <> -1) DO  (* we want at least 1001 ms calibration time *)
        WriteString('Calibrating benchmark '); WriteInt(bench, 1); WriteString(' with loops=');
        WriteInt(loops, 1); WriteString(', n='); WriteInt(n, 1); WriteLn;

        t1 := get_ms();
        x := run_bench(bench, loops, n);
        t1 := get_ms() - t1;
        WriteString('x='); WriteInt(x, 1); WriteString(' (time: '); WriteInt(t1, 1); WriteString(' ms)'); WriteLn;
        loops := loops * 2;
      END;
      IF (x <> -1) THEN
        loops := loops DIV 2;
        loops := loops * (min_ms DIV t1) + 1; (* integer division! *)
        WriteString('Calibration done. Starting measurement with '); WriteInt(loops, 1);
        WriteString(' loops to get >='); WriteInt(min_ms, 1); WriteString(' ms'); WriteLn;

        (* measurement *)
        t1 := get_ms();
        x := run_bench(bench, loops, n);
        t1 := get_ms() - t1;
        WriteString('x='); WriteInt(x, 1); WriteString(' (time: '); WriteInt(t1, 1); WriteString(' ms)'); WriteLn;

        WriteString('Elapsed time for '); WriteInt(loops, 1); WriteString(' loops: '); WriteInt(t1, 1);
        bench_res1[bench] := t1 * 10 DIV loops;
        WriteString(' ms; estimation for 10 loops: '); WriteInt(bench_res1[bench], 1); WriteString(' ms'); WriteLn;
      ELSE
        bench_res1[bench] := -1;
      END;
    END;
    WriteString('Times for all benchmarks (10 loops, ms):'); WriteLn;
    WriteString('BM Results (Modula-2)  : ');
    FOR bench := bench1 TO bench2 DO
      WriteInt(bench_res1[bench], 7); WriteString(' ');
    END;
    WriteLn;
    WriteString('Total elapsed time: '); WriteInt(get_ms() - start_t, 1); WriteString(' ms'); WriteLn;
  END main;


BEGIN (* module bmbench *)
  GetArgs(argc, argv);
  main(argc, argv);
END bmbench.