home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPL60N14.ZIP / TESTPRGS.ZIP / WHETSTON.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1992-05-01  |  6.4 KB  |  229 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.     rlarray = array [ 1 .. 4 ] of real;
  32.  
  33. var
  34.     start, stop: LONGINT;
  35.     wt: integer;  { Determines length of execution }
  36.     x, y, z, norm, t3, estimate: real;
  37.     xx: record
  38.         one, two, three, four: real
  39.         end;
  40.     e1: rlarray;
  41.     i, jj, kk, n1, n2, n3, n4, n5, n6, n7, n8, n9, n10, n11: integer;
  42.     ij, ik, il: 1 .. 4;
  43.     fail: boolean;
  44.  
  45.  
  46.     procedure pa(var e: rlarray);
  47.         label 1;
  48.         var j: integer;
  49.         begin
  50.         j := 0;
  51.       1 :
  52.         e[1] := (e[1] + e[2] + e[3] - e[4]) * t;
  53.         e[2] := (e[1] + e[2] - e[3] + e[4]) * t;
  54.         e[3] := (e[1] - e[2] + e[3] + e[4]) * t;
  55.         e[4] := ( - e[1] + e[2] + e[3] + e[4]) / t3; {changed from t2}
  56.         j := j + 1;
  57.         if j < 6 then
  58.             goto 1
  59.         end; {pa}
  60.  
  61.     procedure p0;
  62.         begin
  63.         e1[ij] := e1[ik];
  64.         e1[ik] := e1[il];
  65.         e1[il] := e1[ij];
  66.         end; {p0}
  67.  
  68.     procedure p3(x, y: real; var z: real);
  69.         begin
  70.         x := t * (z + x);
  71.         y := t * (x + y);
  72.         z := (x + y) / t2
  73.         end; {p3}
  74.  
  75.     procedure Check(ModuleNo: integer; Condition: Boolean);
  76.         begin
  77.         if not Condition then
  78.            begin
  79.            writeln('Module ', ModuleNo:1, ' has not produced the expected',
  80.                    ' results');
  81.            writeln('Check listing and compare with Pascal version');
  82.            fail := true
  83.            end
  84.         end;
  85.  
  86. begin
  87.     wt := 10;   { 10 corresponds to one million Whetstone instructions
  88.                  value shouldbe read to avoid the loop counters being
  89.                  taken as constant. }
  90.     fail := false;
  91.     Check( 0, (wt >= 1) and (wt <= 100) );
  92.     n1 := 2 * wt;
  93.     n2 := 10 * wt;
  94.     n3 := 14 * wt;
  95.     n4 := 345 * wt;
  96.     n5 := 0;
  97.     n6 := 95 * wt;
  98.     n7 := 32 * wt;
  99.     n8 := 800 * wt;
  100.     n9 := 616 * wt;
  101.     n10 := 0;
  102.     n11 := 93 * wt;
  103.  
  104.     start := clock;
  105.  
  106.     { module 1: simple identifiers}
  107.     xx.one := 1.0;
  108.     xx.two := -1.0;  xx.three := -1.0;  xx.four := -1.0;
  109.     for i := 1 to n1 do
  110.         begin
  111.         xx.one := (xx.one + xx.two + xx.three - xx.four) * t;
  112.         xx.two := (xx.one + xx.two - xx.three + xx.four) * t;
  113.         xx.three := (xx.one - xx.two + xx.three + xx.four) * t;
  114.         xx.four := ( - xx.one + xx.two + xx.three + xx.four) * t
  115.         end; {module 1}
  116.     with xx do
  117.         norm := sqrt(sqr(one)+sqr(two)+sqr(three)+sqr(four));
  118.     Check(1, abs(norm - exp(0.35735-n1*6.1e-5))/norm <= 0.1 );
  119.  
  120.     { module 2: array elements}
  121.     e1[1] := 1.0;
  122.     e1[2] := -1.0;  e1[3] := - 1.0;  e1[4] := - 1.0;
  123.     for i := 1 to n2 do
  124.         begin
  125.         e1[1] := (e1[1] + e1[2] + e1[3] - e1[4]) * t;
  126.         e1[2] := (e1[1] + e1[2] - e1[3] + e1[4]) * t;
  127.         e1[3] := (e1[1] - e1[2] + e1[3] + e1[4]) * t;
  128.         e1[4] := ( - e1[1] + e1[2] + e1[3] + e1[4]) * t
  129.         end; {module 2}
  130.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  131.     Check(2, abs(norm - exp(0.35735-n2*6.1e-5))/norm <= 0.1);
  132.  
  133.     { module 3: array as parameter}
  134.     t3 := 1.0/t;
  135.     for i := 1 to n3 do
  136.         pa(e1);
  137.     norm := sqrt(sqr(e1[1])+sqr(e1[2])+sqr(e1[3])+sqr(e1[4]));
  138.     Check(3, abs(norm - exp(0.35735-(n3*5+n2)*6.1e-5))/norm <= 0.1 );
  139.  
  140.     { module 4: conditional jumps}
  141.     jj := 1;
  142.     for i:= 1 to n4 do
  143.         begin
  144.         if jj = 1 then
  145.             jj := 2
  146.         else
  147.             jj := 3;
  148.         if jj > 2 then
  149.             jj := 0
  150.         else
  151.             jj := 1;
  152.         if jj < 1 then
  153.             jj := 1
  154.         else
  155.             jj := 0
  156.         end; {module 4}
  157.     Check( 4, jj = ord(not odd(wt) ) );
  158.  
  159.     { module 5: omitted}
  160.  
  161.     { module 6: integer arithmetic}
  162.     ij := 1;
  163.     ik := 2;
  164.     il := 3;
  165.     for i := 1 to n6 do
  166.         begin
  167.         ij := ij * (ik - ij) * (il - ik);
  168.         ik := il * ik - (il - ij) * ik;
  169.         il := (il - ik) * (ik + ij);
  170.         e1[il - 1] := ij + ik + il;
  171.         e1[ik - 1] := ij * ik * il
  172.         end; {module 6}
  173.     Check( 6, (ij=1) and (ik=2) and (il=3) );
  174.  
  175.     {module 7: trig. functions) }
  176.     x := 0.5;  y := 0.5;
  177.     for i := 1 to n7 do
  178.         begin
  179.         x := t * arctan(t2 * sin(x) * cos(x) /
  180.                         (cos(x + y) + cos (x - y) - 1.0));
  181.         y := t * arctan(t2 * sin(y) * cos(y) /
  182.                         (cos(x + y) + cos (x - y) - 1.0))
  183.         end; {module 7}
  184.     Check(7, (t - wt* 0.0015 <= x) and
  185.              (x <= t - wt* 0.0004) and
  186.              (t - wt* 0.0015 <= y) and
  187.              (y <= t - wt* 0.0004) );
  188.  
  189.     {module 8: procedure calls}
  190.     x := 1.0;  y := 1.0; z := 1.0;
  191.     for i := 1 to n8 do
  192.         p3(y * i, y + z, z);
  193.     Check(8, abs(z - (0.99983352*n8 - 0.999555651)) <= n8*1.0e-6);
  194.  
  195.     (* module 9: array references*)
  196.     ij := 1;
  197.     ik := 2;
  198.     il := 3;
  199.     e1[1] := 1.0;
  200.     e1[2] := 2.0;
  201.     e1[3] := 3.0;
  202.     for i := 1 to n9 do
  203.         p0;
  204.     Check(9, (e1[1] = 3.0) and (e1[2] = 2.0) and (e1[3] = 3.0) );
  205.  
  206.     { module 10: integer arithmetic}
  207.     jj := 2;
  208.     kk := 3;
  209.     for i := 1 to n10 do
  210.         begin
  211.         jj := jj + kk;
  212.         kk := jj + kk;
  213.         jj := kk - jj;
  214.         kk := kk - jj - jj;
  215.         end; {module 10}
  216.     Check(10, (jj=2) and (kk=3) );
  217.  
  218.     { module 11: standard functions}
  219.     x := 0.75;
  220.     for i := 1 to n11 do
  221.         x := sqrt (exp(ln(x) / t1));
  222.     estimate := 1.0 - exp(-0.0447*wt + ln(0.26));
  223.     Check( 11, (abs(estimate-x)/estimate
  224.                   <= 0.0006 + 0.065/(5+wt) ));
  225.  
  226.     stop := clock - start;
  227.     Writeln (100*wt/(stop*1e-3):10:3, ' REAL KWhetstones');
  228. end.
  229.