home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / TPL60N11.ZIP / TESTPRGS.ZIP / WHETST87.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-24  |  6.5 KB  |  236 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N+,O-,R-,S-,V-,X-}
  2. {$M 16384,0,655360}
  3.  
  4. { (C) Copyright, A H J Sale and British Standards Institution, 1982 }
  5. {TEST 1.2-1, CLASS=QUALITY}
  6.  
  7. {: This program is a general check on execution speed. }
  8. {  For details, see Computer Journal article, 'A Synthetic
  9.    Benchmark', Jan 1976  pp43-49. }
  10. {V3.0: New test. }
  11. {V5.1: Modified to introduce validation checks, 88-02-24}
  12. program tlp2d1(output);
  13.  
  14. { The validation checks added have been made to avoid printing
  15. values out which have no obvious purpose. In conversion to other
  16. languages, the printing may cause timing problems. Merely
  17. removing the printing statements is inadequate since then an
  18. optimizing compiler could remove many of the modules completely. }
  19.  
  20. { For details of checks and changes to avoid some problems,
  21.   see NPL report DITC 107/88. }
  22.  
  23. uses time;
  24.  
  25. const
  26.     t = 0.499975;
  27.     t1 = 0.50025;
  28.     t2 = 2.0;
  29.  
  30. type
  31.     real = double;
  32.     rlarray = array [ 1 .. 4 ] of real;
  33.  
  34. var
  35.     start, stop: LONGINT;
  36.     wt: integer;  { Determines length of execution }
  37.     x, y, z, norm, t3, estimate: real;
  38.     xx: record
  39.         one, two, three, four: real
  40.         end;
  41.     e1: rlarray;
  42.     i, jj, kk, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: integer;
  43.     ij, ik, il: 1 .. 4;
  44.     fail: boolean;
  45.  
  46.  
  47.     procedure pa(var e: rlarray);
  48.         label 1;
  49.         var j: integer;
  50.         begin
  51.         j := 0;
  52.       1 :
  53.         e[1] := (e[1] + e[2] + e[3] - e[4]) * t;
  54.         e[2] := (e[1] + e[2] - e[3] + e[4]) * t;
  55.         e[3] := (e[1] - e[2] + e[3] + e[4]) * t;
  56.         e[4] := ( - e[1] + e[2] + e[3] + e[4]) / t3; {changed from t2}
  57.         j := j + 1;
  58.         if j < 6 then
  59.             goto 1
  60.         end; {pa}
  61.  
  62.     procedure p0;
  63.         begin
  64.         e1[ij] := e1[ik];
  65.         e1[ik] := e1[il];
  66.         e1[il] := e1[ij];
  67.         end; {p0}
  68.  
  69.     procedure p3(x, y: real; var z: real);
  70.         begin
  71.         x := t * (z + x);
  72.         y := t * (x + y);
  73.         z := (x + y) / t2
  74.         end; {p3}
  75.  
  76.     procedure Check(ModuleNo: integer; Condition: Boolean);
  77.         begin
  78.         if not Condition then
  79.            begin
  80.            writeln('Module ', ModuleNo:1, ' has not produced the expected',
  81.                    ' results');
  82.            writeln('Check listing and compare with Pascal version');
  83.            fail := true
  84.            end
  85.         end;
  86.  
  87. begin
  88.     wt := 10;   { 10 corresponds to one million Whetstone instructions
  89.                  value shouldbe read to avoid the loop counters being
  90.                  taken as constant. }
  91.     fail := false;
  92.     Check( 0, (wt >= 1) and (wt <= 100) );
  93.     n1 := 2 * wt;
  94.     n2 := 10 * wt;
  95.     n3 := 14 * wt;
  96.     n4 := 345 * wt;
  97.     n5 := 0;
  98.     n6 := 95 * wt;
  99.     n7 := 32 * wt;
  100.     n8 := 800 * wt;
  101.     n9 := 616 * wt;
  102.     n10 := 0;
  103.     n11 := 93 * wt;
  104.  
  105.     start := clock;
  106.  
  107.     { module 1: simple identifiers}
  108.     xx.one := 1.0;
  109.     xx.two := -1.0;  xx.three := -1.0;  xx.four := -1.0;
  110.     for i := 1 to n1 do
  111.         begin
  112.         xx.one := (xx.one + xx.two + xx.three - xx.four) * t;
  113.         xx.two := (xx.one + xx.two - xx.three + xx.four) * t;
  114.         xx.three := (xx.one - xx.two + xx.three + xx.four) * t;
  115.         xx.four := ( - xx.one + xx.two + xx.three + xx.four) * t
  116.         end; {module 1}
  117.     inline ($fa/$fb);
  118.     with xx do
  119.         norm := sqrt(sqr(one)+sqr(two)+sqr(three)+sqr(four));
  120.     Check(1, abs(norm - exp(0.35735-n1*6.1e-5))/norm <= 0.1 );
  121.  
  122.     { module 2: array elements}
  123.     e1[1] := 1.0;
  124.     e1[2] := -1.0;  e1[3] := - 1.0;  e1[4] := - 1.0;
  125.     for i := 1 to n2 do
  126.         begin
  127.         e1[1] := (e1[1] + e1[2] + e1[3] - e1[4]) * t;
  128.         e1[2] := (e1[1] + e1[2] - e1[3] + e1[4]) * t;
  129.         e1[3] := (e1[1] - e1[2] + e1[3] + e1[4]) * t;
  130.         e1[4] := ( - e1[1] + e1[2] + e1[3] + e1[4]) * t
  131.         end; {module 2}
  132.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  133.     Check(2, abs(norm - exp(0.35735-n2*6.1e-5))/norm <= 0.1);
  134.  
  135.     { module 3: array as parameter}
  136.     t3 := 1.0/t;
  137.     for i := 1 to n3 do
  138.         pa(e1);
  139.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  140.     Check(3, abs(norm - exp(0.35735-(n3*5+n2)*6.1e-5))/norm <= 0.1 );
  141.  
  142.     { module 4: conditional jumps}
  143.     jj := 1;
  144.     for i:= 1 to n4 do
  145.         begin
  146.         if jj = 1 then
  147.             jj := 2
  148.         else
  149.             jj := 3;
  150.         if jj > 2 then
  151.             jj := 0
  152.         else
  153.             jj := 1;
  154.         if jj < 1 then
  155.             jj := 1
  156.         else
  157.             jj := 0
  158.         end; {module 4}
  159.     Check( 4, jj = ord(not odd(wt) ) );
  160.  
  161.     { module 5: omitted}
  162.  
  163.     { module 6: integer arithmetic}
  164.     ij := 1;
  165.     ik := 2;
  166.     il := 3;
  167.     for i := 1 to n6 do
  168.         begin
  169.         ij := ij * (ik - ij) * (il - ik);
  170.         ik := il * ik - (il - ij) * ik;
  171.         il := (il - ik) * (ik + ij);
  172.         e1[il - 1] := ij + ik + il;
  173.         e1[ik - 1] := ij * ik * il
  174.         end; {module 6}
  175.     Check( 6, (ij=1) and (ik=2) and (il=3) );
  176.  
  177.     {module 7: trig. functions) }
  178.     x := 0.5;  y := 0.5;
  179.     for i := 1 to n7 do
  180.         begin
  181.         x := t * arctan(t2 * sin(x) * cos(x) /
  182.                         (cos(x + y) + cos (x - y) - 1.0));
  183.         y := t * arctan(t2 * sin(y) * cos(y) /
  184.                         (cos(x + y) + cos (x - y) - 1.0))
  185.         end; {module 7}
  186.     Check(7, (t - wt* 0.0015 <= x) and
  187.              (x <= t - wt* 0.0004) and
  188.              (t - wt* 0.0015 <= y) and
  189.              (y <= t - wt* 0.0004) );
  190.  
  191.     {module 8: procedure calls}
  192.     x := 1.0;  y := 1.0; z := 1.0;
  193.     for i := 1 to n8 do
  194.         p3(y * i, y + z, z);
  195.     Check(8, abs(z - (0.99983352*n8 - 0.999555651)) <= n8*1.0e-6);
  196.  
  197.     (* module 9: array references*)
  198.     ij := 1;
  199.     ik := 2;
  200.     il := 3;
  201.     e1[1] := 1.0;
  202.     e1[2] := 2.0;
  203.     e1[3] := 3.0;
  204.     for i := 1 to n9 do
  205.         p0;
  206.     Check(9, (e1[1] = 3.0) and (e1[2] = 2.0) and (e1[3] = 3.0) );
  207.  
  208.     { module 10: integer arithmetic}
  209.     jj := 2;
  210.     kk := 3;
  211.     for i := 1 to n10 do
  212.         begin
  213.         jj := jj + kk;
  214.         kk := jj + kk;
  215.         jj := kk - jj;
  216.         kk := kk - jj - jj;
  217.         end; {module 10}
  218.     Check(10, (jj=2) and (kk=3) );
  219.  
  220.     { module 11: standard functions}
  221.     x := 0.75;
  222.     for i := 1 to n11 do
  223.         x := sqrt (exp(ln(x) / t1));
  224.     estimate := 1.0 - exp(-0.0447*wt + ln(0.26));
  225.     Check( 11, (abs(estimate-x)/estimate
  226.                   <= 0.0006 + 0.065/(5+wt) ));
  227.  
  228.     stop := clock - start;
  229.     Writeln (100*wt/(stop*1e-3):10:3, ' DOUBLE KWhetstones');
  230. end.
  231.  
  232.  
  233.  
  234.  
  235.  
  236.