home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / MOD2MATH.ZIP / MATHLIBS.IMP < prev   
Encoding:
Modula Implementation  |  1986-03-09  |  3.6 KB  |  159 lines
  1.  
  2. IMPLEMENTATION MODULE MathLibS;
  3. (*                                                            *)
  4. (*   Math routines that work with the 8087
  5.      contributed by Steve Eckhart                             *)
  6. (*                                                            *)
  7.   CONST
  8.     pi = 3.14159265358979;
  9.     twopi = pi*2.0;
  10.     piover2 = pi*0.5;
  11.     piover4 = pi*0.25;
  12.     MaxErr = 1.0E-14;
  13.   PROCEDURE sin(x : REAL) : REAL;
  14.     VAR  
  15.       sx, sign : REAL;
  16.     BEGIN
  17.       sign := 1.0;
  18.       IF x<0.0 THEN
  19.         sign := -1.0;
  20.         x := -x;
  21.       END;
  22.       WHILE x>pi DO
  23.         x := x-twopi;
  24.       END;
  25.       IF x<0.0 THEN
  26.         sign := -sign;
  27.         x := -x;
  28.       END;
  29.       IF x>piover2 THEN
  30.         x := pi-x;
  31.       END;
  32.       IF x<=piover4 THEN
  33.         sx := SinExp(x);
  34.       ELSE
  35.         sx := CosExp(piover2-x);
  36.       END;
  37.       RETURN sign*sx;
  38.     END sin;
  39.       (*series expansion for sin(x) *)
  40.   PROCEDURE SinExp(s : REAL) : REAL;
  41.     VAR  
  42.       term, sum, iter : REAL;
  43.     BEGIN
  44.       term := s;
  45.       sum := s;
  46.       iter := 1.0;
  47.       WHILE ABS(term)>MaxErr DO
  48.         iter := iter+1.0;
  49.         term := -term*s*s/((2.0*iter-2.0)*(2.0*iter-1.0));
  50.         sum := sum+term;
  51.       END;
  52.       RETURN sum;
  53.     END SinExp;
  54.   PROCEDURE cos(x : REAL) : REAL;
  55.     VAR  
  56.       cx, sign : REAL;
  57.     BEGIN
  58.       sign := 1.0;
  59.       IF x<0.0 THEN
  60.         x := -x;
  61.       END;
  62.       WHILE x>pi DO
  63.         x := x-twopi;
  64.       END;
  65.       IF x<0.0 THEN
  66.         x := -x;
  67.       END;
  68.       IF x>piover2 THEN
  69.         x := pi-x;
  70.         sign := -1.0;
  71.       END;
  72.       IF x<=piover4 THEN
  73.         cx := CosExp(x);
  74.       ELSE
  75.         cx := SinExp(piover2-x);
  76.       END;
  77.       RETURN sign*cx;
  78.     END cos;
  79.       (*series expansion for cos(x) *)
  80.   PROCEDURE CosExp(c : REAL) : REAL;
  81.     VAR  
  82.       term, sum, iter : REAL;
  83.     BEGIN
  84.       term := 1.0;
  85.       sum := 1.0;
  86.       iter := 1.0;
  87.       WHILE ABS(term)>MaxErr DO
  88.         term := -term*c*c/(2.0*iter*(2.0*iter-1.0));
  89.         sum := sum+term;
  90.         iter := iter+1.0;
  91.       END;
  92.       RETURN sum;
  93.     END CosExp;
  94.   PROCEDURE atan(x : REAL) : REAL;
  95.     VAR  
  96.       i : CARDINAL;
  97.       Sign, Reduc, x2, Term, Sum : REAL;
  98.     BEGIN
  99.       IF x<0.0 THEN
  100.         Sign := -1.0;
  101.         x := -x;
  102.       ELSE
  103.         Sign := 1.0;
  104.       END;
  105.       IF x<0.4142 THEN
  106.         Reduc := 0.0;
  107.       ELSE
  108.         x := (x-1.0)/(x+1.0);
  109.         IF x<0.4142 THEN
  110.           Reduc := 1.0;
  111.         ELSE
  112.           x := (x-1.0)/(x+1.0);
  113.           Reduc := 2.0;
  114.         END;
  115.       END;
  116.       IF ABS(x)<MaxErr THEN
  117.         RETURN Sign*Reduc*piover4;
  118.       END;
  119.       x2 := x*x;
  120.       i := 1;
  121.       Term := 1.0;
  122.       Sum := 1.0;
  123.       WHILE ABS(Term)>MaxErr DO
  124.         INC(i);
  125.         Term := -x2*Term;
  126.         Sum := Sum+Term/FLOAT(2*i-1);
  127.       END;
  128.       Sum := Sign*(x*Sum+Reduc*piover4);
  129.       RETURN Sum;
  130.     END atan;
  131.   PROCEDURE sqrt(x : REAL) : REAL;
  132.     VAR  
  133.       exp, guess, newguess : REAL;
  134.     BEGIN
  135.       IF x<=0.0 THEN
  136.         RETURN 0.0;
  137.       END;
  138.       exp := 1.0;
  139.       WHILE x>=100.0 DO
  140.         x := x*0.01;
  141.         exp := exp*10.0;
  142.       END;
  143.       WHILE x<1.0 DO
  144.         x := x*100.0;
  145.         exp := exp*0.1;
  146.       END;
  147.       IF x=1.0 THEN
  148.         RETURN exp;
  149.       END;
  150.       newguess := 4.0;
  151.       REPEAT
  152.         guess := newguess;
  153.         newguess := (x/guess+guess)*0.5;
  154.       UNTIL ABS(newguess-guess)<MaxErr;
  155.       RETURN newguess*exp;
  156.     END sqrt;
  157.   BEGIN
  158.   END MathLibS.
  159.