program whetstone(output);

{
   To run the Whetstone benchmark, first choose how many million
   Whetstones to perform and set the CONST IM. Larger values for IM
   will give greater precision and require more patience.

   Run Whetstone and time how long it takes. The results are reported
   as Whetstones / second. If IM = 1.0 and it takes 2.0 seconds to run,
   then report 500,000 whetstones per second.

   The output from Whetstone should look like:


      0     0     0      1.000      -1.000      -1.000      -1.000
    120   140   120      -.068       -.463       -.730      -1.124
    140   120   120      -.055       -.447       -.711      -1.103
   3450     1     1      1.000      -1.000      -1.000      -1.000
   2100     1     2      6.000       6.000       -.711      -1.103
    320     1     2       .490        .490        .490        .490
   8990     1     2      1.000       1.000       1.000       1.000
   6160     1     2      3.000       2.000       3.000      -1.103
      0     2     3      1.000      -1.000      -1.000      -1.000
    930     2     3       .835        .835        .835        .835
END OF WHETSTONE,  1 Million Whetstones Performed


}


const

      im = 1.0;        { how many million whetstones to perform }
      t=0.499975;
      t1=0.50025;
      t2=2.0;

type argarray = array[1..4] of real;

var e1 : argarray;
    x,y,z,x1,x2,x3,x4 : real;
        i,
        j,
        k,
        l,
        n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11 : integer;

{$r-}               {disable range checking}

procedure pa(var e:argarray);

label 1;
var j : integer;

begin
   j:=0;

1:
   e[1]:=(e[1]+e[2]+e[3]-e[4])*t;
   e[2]:=(e[1]+e[2]-e[3]+e[4])*t;
   e[3]:=(e[1]-e[2]+e[3]+e[4])*t;
   e[4]:=(-e[1]+e[2]+e[3]+e[4])/t2;
   j:=j+1;
   if j<6 then
    goto 1
end;  { procedure pa}


procedure p0;

begin
   e1[j]:=e1[k];
   e1[k]:=e1[l];
   e1[l]:=e1[j]
end;   { procedure p0 }

procedure p3(x,y:real;var z:real);

begin
   x:=t*(x+y);
   y:=t*(x+y);
   z:=(x+y)/t2
end;  { procedure p3 }

procedure module1; { module 1: simple identifiers }
var
        i : integer;

begin
  x1:=1.0;
  x2:=-1.0; x3:=-1.0; x4:=-1.0;

  for i:=1 to n1 do
  begin
    x1:=(x1+x2+x3-x4)*t;
    x2:=(x1+x2-x3+x4)*t;
    x3:=(x1-x2+x3+x4)*t;
    x4:=(-x1+x2+x3+x4)*t
  end;

end; { module 1 }

procedure module2; { module 2: array elements }

var
        i : integer;

begin
e1[1]:=1.0;
e1[2]:=-1.0; e1[3]:=-1.0; e1[4]:=-1.0;

for i:=1 to n2 do
  begin
  e1[1]:=(e1[1]+e1[2]+e1[3]-e1[4])*t;
  e1[2]:=(e1[1]+e1[2]-e1[3]+e1[4])*t;
  e1[3]:=(e1[1]-e1[2]+e1[3]+e1[4])*t;
  e1[4]:=(-e1[1]+e1[2]+e1[3]+e1[4])*t
  end;
end;  { module 2 }

procedure module4; { module 4: conditional jumps }

var
        i : integer;

begin
j:=1;
for i:=1 to n4 do
  begin
    if j=1 then
      j:=2
    else
      j:=3;
    if j>1 then
      j:=0
    else
      j:=1;
    if j<2 then
      j:=1
    else
      j:=0
  end;
end; { module 4 }

procedure module6; { integer arithmetic }

var
        i : integer;

begin
  j:=1;
  k:=2;
  l:=3;

  for i:= 1 to n6 do
  begin
    j:=j*(k-j)*(l-k);
    k:=l*k-(l-j)*k;
    l:=(l-k)*k+j;
    e1[l-1]:=j+k+l;
    e1[k-1]:=j*k*l
  end;
end; { module 6 }

procedure module7; { module 7: trig functions }

var i    : integer;
    temp : real;

begin
x:=0.5; y:=0.5;
for i:=1 to n7 do
  begin
    temp:=cos(x+y)+cos(x-y)-1.0;
    x:=t*arctan(t2*sin(x)*cos(x)/temp);
    temp:=cos(x+y)+cos(x-y)-1.0;
    y:=t*arctan(t2*sin(y)*cos(y)/temp);
  end;
end; { module 7 }

procedure module8; { module 8: procedure calls }
var
        i  : integer;

begin
  x:=1.0; y:=1.0; z:=1.0;

  for i:=1 to n8 do
    p3(x,y,z)
end; { module 8 }

procedure module10; { module 10: integer artihmetic }

var
        i  : integer;

begin
  j:=2;
  k:=3;
  for i:=1 to n10 do
    begin
    j:=j+k;
    k:=j+k;
    j:=k-j;
    k:=k-j-j
  end;
end; { module 10 }

procedure module11; { module 11: standard functions }

var
        i  : integer;

begin
  x:=0.75;

  for i:=1 to n11 do
    x:=sqrt(exp(ln(x)/t1));
end; { module 11 }

procedure pout(var n,j,k:integer; var x1,x2,x3,x4:real);

begin
  write(n:7,j:6,k:6);
  writeln(x1:11:3,x2:12:3,x3:12:3,x4:12:3);
end;   { procedure pout }

begin  { start whetstone }

  i := trunc( 10.0 * im);
  n1:=0;
  n2:=12*i;
  n3:=14*i;
  n4:=345*i;
  n5:=0;
  n6:=210*i;
  n7:=32*i;
  n8:=899*i;
  n9:=616*i;
  n10:=0;
  n11:=93*i;

{ modular programming is used to reduce the length of main code }

module1; { simple identifiers }
pout(n1,n1,n1,x1,x2,x3,x4);

module2; { array elements }
pout(n2,n3,n2,e1[1],e1[2],e1[3],e1[4]);

{ module 3: array as a parameter }

for i:= 1 to n3 do

  pa(e1);
pout(n3,n2,n2,e1[1],e1[2],e1[3],e1[4]);


{ end of module 3 }

module4; { conditional jumps }
pout(n4,j,j,x1,x2,x3,x4);

module6; { integer arithmetic }
pout(n6,j,k,e1[1],e1[2],e1[3],e1[4]);

module7; { trig functions }
pout(n7,j,k,x,x,y,y);

module8; { procedure calls }
pout(n8,j,k,x,y,z,z);

{ module 9: array references }

  j:=1;
  k:=2;
  l:=3;
  e1[1]:=1.0;
  e1[2]:=2.0;
  e1[3]:=3.0;

  for i:=1 to n9 do p0;

pout(n9,j,k,e1[1],e1[2],e1[3],e1[4]);

module10; { integer arithmetic }
pout(n10,j,k,x1,x2,x3,x4);

module11; { standard functions }
pout(n11,j,k,x,x,x,x);


writeln('end of whetstone, ', trunc(im * 10.0)/10.0:4:1,
        ' Million Whetstones performed');
end. { end whetstone }


{%%%%%%%%%%%%%%%%%%%%%%%%%%%%% end of whet.pas %%%%%%%%%%%%%%%%%%%%%%%%%%%%%}
