home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / BPL70N12.ZIP / TESTPRGS.ZIP / ULPERR.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-03-07  |  4.5 KB  |  138 lines
  1. PROGRAM ULPerr; { Copyright (c) 1993 Norbert Juffa }
  2.  
  3. { ULPErr tests the software routines for REAL arithmetic transcendental
  4.   functions against the coprocessors EXTENDED precision routines. }
  5.  
  6. {$N+,E-,A+}
  7.  
  8. USES FUN1_TP6, CRT;
  9.  
  10. TYPE  ExtMathFun =  FUNCTION (X: EXTENDED): EXTENDED;
  11.       TestFunctions = (Sine, Cosine, Atan, Log, Expo);
  12.       Bounds = ARRAY [1..2] OF EXTENDED;
  13.  
  14. VAR   Z:  EXTENDED;
  15.       ZA: ARRAY [1..10] OF BYTE ABSOLUTE Z;
  16.       ZW: ARRAY [1..5] OF WORD ABSOLUTE Z;
  17.       Y:  EXTENDED;
  18.       YA: ARRAY [1..10] OF BYTE ABSOLUTE Y;
  19.       YW: ARRAY [1..5] OF WORD ABSOLUTE Y;
  20.       X:  REAL;
  21.       Step,UlpError, MinUlpErr, MaxUlpErr: EXTENDED;
  22.       YR, ZR:REAL;
  23.       Total, Wrong: LONGINT;
  24.       CoproFun:     ARRAY [Sine..Expo] OF ExtMathFun;
  25.       SoftwareFun:  ARRAY [Sine..Expo] OF RealMathFun;
  26.       L: TestFunctions;
  27.  
  28. CONST Trials = 1000000;
  29.       FunName:    ARRAY [Sine..Expo] OF STRING =
  30.                   ('SIN', 'COS', 'ARCTAN', 'LN', 'EXP');
  31.       FunIntvl:   ARRAY [Sine..Expo] OF Bounds =
  32.                   ((-0.5*PI, 0.5*PI), (-0.5*PI, 0.5*PI), (-20.0, 20.0),
  33.                    (0.001, 20.0), (-88.0, 88.0));
  34.  
  35. FUNCTION CoproSin (X: EXTENDED): EXTENDED; FAR;
  36. BEGIN
  37.    CoproSin := Sin (X);
  38. END;
  39.  
  40. FUNCTION CoproCos (X: EXTENDED): EXTENDED; FAR;
  41. BEGIN
  42.    CoproCos := Cos (X);
  43. END;
  44.  
  45. FUNCTION CoproExp (X: EXTENDED): EXTENDED; FAR;
  46. BEGIN
  47.    CoproExp := Exp (X);
  48. END;
  49.  
  50. FUNCTION CoproLn (X: EXTENDED): EXTENDED; FAR;
  51. BEGIN
  52.    CoproLn := Ln (X);
  53. END;
  54.  
  55. FUNCTION CoproArctan (X: EXTENDED): EXTENDED; FAR;
  56. BEGIN
  57.    CoproArcTan := ArcTan (X);
  58. END;
  59.  
  60.  
  61. BEGIN
  62.    CoproFun [Sine]   := CoproSin;
  63.    CoproFun [Cosine] := CoproCos;
  64.    CoproFun [Atan]   := CoproArctan;
  65.    CoproFun [Log]    := CoproLn;
  66.    CoproFun [Expo]   := CoproExp;
  67.  
  68.    SoftwareFun [Sine]   := SW_Sin;
  69.    SoftwareFun [Cosine] := SW_Cos;
  70.    SoftwareFun [Atan]   := SW_Arctan;
  71.    SoftwareFun [Log]    := SW_Ln;
  72.    SoftwareFun [Expo]   := SW_Exp;
  73.  
  74.  
  75.    WriteLn ('******** Test of REAL transcendental function using coprocessor ********');
  76.  
  77.    FOR L := Sine TO Expo DO BEGIN
  78.       WriteLn;
  79.       WriteLn;
  80.       WriteLn;
  81.       WriteLn ('Test of function ', FunName [L]:6, ' in interval (',
  82.                FunIntvl [L, 1]:15, ' .. ', FunIntvl [L, 2]:15, ')');
  83.       WriteLn;
  84.       WriteLn ('       x             total     wrong       -ULPerr         + ULPerr');
  85.       WriteLn;
  86.       X := FunIntvl [L, 1];
  87.       Step := (FunIntvl [L, 2] - FunIntvl [L, 1]) / (Trials);
  88.       MinUlpErr := 0;
  89.       MaxUlpErr := 0;
  90.       Total := 0;
  91.       Wrong := 0;
  92.       WHILE X <= FunIntvl [L, 2] DO BEGIN
  93.          Inc (Total);
  94.          Y := SoftwareFun [L] (X);
  95.          Z := CoproFun [L] (X);
  96.          YR := Y;
  97.          ZR := Z;
  98.          IF YR <> ZR THEN
  99.             Inc (Wrong);
  100.  
  101.          IF YW[5] > ZW[5] THEN
  102.             UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  103.                         *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1])*2-
  104.                         (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  105.                         *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1]))/
  106.                         16777216.0
  107.          ELSE IF YW[5] < ZW[5] THEN
  108.             UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  109.                         *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1])-
  110.                         (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  111.                         *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1])*2)/
  112.                         16777216.0
  113.          ELSE UlpError := ((((((((YA[8]*256.0+YA[7])*256.0+YA[6])*256.0+YA[5])
  114.                           *256.0+YA[4])*256.0+YA[3])*256.0+YA[2])*256.0+YA[1]) -
  115.                           (((((((ZA[8]*256.0+ZA[7])*256.0+ZA[6])*256.0+ZA[5])
  116.                           *256.0+ZA[4])*256.0+ZA[3])*256.0+ZA[2])*256.0+ZA[1])) /
  117.                           16777216.0;
  118.  
  119.          IF (YR <> 0) AND (ZR <> 0) THEN
  120.             IF (UlpError < MinUlpErr) THEN
  121.                MinUlpErr := UlpError
  122.             ELSE IF (UlpError > MaxUlpErr) THEN
  123.                MaxUlpErr := UlpError;
  124.  
  125.          X := X + (Step);
  126.  
  127.          IF Total AND $FFF = 0 THEN BEGIN
  128.             GotoXY (1, WhereY);
  129.             ClrEol;
  130.             Write (X:16, Total:10, Wrong:10, '  ', MinUlpErr:16, '  ', MaxUlpErr:16);
  131.          END;
  132.       END;
  133.       GotoXY (1, WhereY);
  134.       ClrEol;
  135.       WriteLn (X:16, Total:10, Wrong:10, '  ', MinUlpErr:16, '  ', MaxUlpErr:16);
  136.    END;
  137. END.
  138.