WebSVN – Kolibri OS – Diff – /programs/develop/oberon07/Lib/KolibriOS/Math.ob07

 (*
-    Copyright 2016 Anton Krotov
+    Copyright 2013, 2014, 2018 Anton Krotov
     This program is free software: you can redistribute it and/or modify
     it under the terms of the GNU Lesser General Public License as published by
     the Free Software Foundation, either version 3 of the License, or
     along with this program.  If not, see .
 *)
 MODULE Math;
-IMPORT sys := SYSTEM;
+IMPORT SYSTEM;
+CONST
+    pi* = 3.141592653589793;
+    e*  = 2.718281828459045;
-CONST pi* = 3.141592653589793D+00;
-      e*  = 2.718281828459045D+00;
-VAR Inf*, nInf*: LONGREAL;
+PROCEDURE IsNan* (x: REAL): BOOLEAN;
+VAR
-PROCEDURE IsNan*(x: LONGREAL): BOOLEAN;
+    h, l: SET;
 VAR h, l: SET;
+BEGIN
-BEGIN
+    SYSTEM.GET(SYSTEM.ADR(x), l);
-  sys.GET(sys.ADR(x), l);
+    SYSTEM.GET(SYSTEM.ADR(x) + 4, h)
-  sys.GET(sys.ADR(x) + 4, h);
+    RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
+END IsNan;
-  RETURN (h * {20..30} = {20..30}) & ((h * {0..19} # {}) OR (l * {0..31} # {}))
-END IsNan;
+PROCEDURE IsInf* (x: REAL): BOOLEAN;
+    RETURN ABS(x) = SYSTEM.INF()
 END IsInf;
-PROCEDURE IsInf*(x: LONGREAL): BOOLEAN;
-  RETURN ABS(x) = sys.INF(LONGREAL)
-END IsInf;
+PROCEDURE Max (a, b: REAL): REAL;
+VAR
-PROCEDURE Max(A, B: LONGREAL): LONGREAL;
+    res: REAL;
-VAR Res: LONGREAL;
 BEGIN
+    IF a > b THEN
-  IF A > B THEN
+        res := a
+    ELSE
-    Res := A
+        res := b
+    END
-  ELSE
+    RETURN res
-    Res := B
+END Max;
-  END
   RETURN Res
-END Max;
+PROCEDURE Min (a, b: REAL): REAL;
 VAR
-PROCEDURE Min(A, B: LONGREAL): LONGREAL;
+    res: REAL;
 VAR Res: LONGREAL;
+BEGIN
-BEGIN
+    IF a < b THEN
+        res := a
+    ELSE
-  IF A < B THEN
+        res := b
+    END
-    Res := A
+    RETURN res
-  ELSE
+END Min;
-    Res := B
-  END
-  RETURN Res
+PROCEDURE SameValue (a, b: REAL): BOOLEAN;
-END Min;
+VAR
     eps: REAL;
-PROCEDURE SameValue(A, B: LONGREAL): BOOLEAN;
+    res: BOOLEAN;
 VAR Epsilon: LONGREAL; Res: BOOLEAN;
+BEGIN
-BEGIN
+    eps := Max(Min(ABS(a), ABS(b)) * 1.0E-12, 1.0E-12);
-  Epsilon := Max(Min(ABS(A), ABS(B)) * 1.0D-12, 1.0D-12);
+    IF a > b THEN
-  IF A > B THEN
+        res := (a - b) <= eps
+    ELSE
-    Res := (A - B) <= Epsilon
+        res := (b - a) <= eps
-  ELSE
+    END
-    Res := (B - A) <= Epsilon
+    RETURN res
+END SameValue;
+PROCEDURE IsZero (x: REAL): BOOLEAN;
+    RETURN ABS(x) <= 1.0E-12
-  END
+END IsZero;
   RETURN Res
-END SameValue;
+PROCEDURE [stdcall] sqrt* (x: REAL): REAL;
 BEGIN
-PROCEDURE IsZero(x: LONGREAL): BOOLEAN;
+    SYSTEM.CODE(
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0FAH,                    (*  fsqrt                      *)
+C9H,                          (*  leave                      *)
+C2H, 008H, 000H               (*  ret     08h                *)
+    )
-  RETURN ABS(x) <= 1.0D-12
+    RETURN 0.0
-END IsZero;
+END sqrt;
-PROCEDURE [stdcall] sqrt*(x: LONGREAL): LONGREAL;
+PROCEDURE [stdcall] sin* (x: REAL): REAL;
 BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0FEH,                    (*  fsin                       *)
+C9H,                          (*  leave                      *)
+C2H, 008H, 000H               (*  ret     08h                *)
-  sys.CODE("DD4508D9FAC9C20800")
+    )
-  RETURN 0.0D0
+    RETURN 0.0
+END sin;
-END sqrt;
-PROCEDURE [stdcall] sin*(x: LONGREAL): LONGREAL;
+PROCEDURE [stdcall] cos* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0FFH,                    (*  fcos                       *)
+C9H,                          (*  leave                      *)
+C2H, 008H, 000H               (*  ret     08h                *)
-BEGIN
+    )
-  sys.CODE("DD4508D9FEC9C20800")
+    RETURN 0.0
+END cos;
-  RETURN 0.0D0
 END sin;
+PROCEDURE [stdcall] tan* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0FBH,                    (*  fsincos                    *)
+DEH, 0F9H,                    (*  fdivp st1, st              *)
+C9H,                          (*  leave                      *)
-PROCEDURE [stdcall] cos*(x: LONGREAL): LONGREAL;
+C2H, 008H, 000H               (*  ret     08h                *)
 BEGIN
+    RETURN 0.0
-  sys.CODE("DD4508D9FFC9C20800")
+END tan;
   RETURN 0.0D0
-END cos;
+PROCEDURE [stdcall] arctan2* (y, x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+D9H, 0F3H,                    (*  fpatan                     *)
+C9H,                          (*  leave                      *)
-PROCEDURE [stdcall] tan*(x: LONGREAL): LONGREAL;
+C2H, 010H, 000H               (*  ret     10h                *)
+    )
-BEGIN
+    RETURN 0.0
-  sys.CODE("DD4508D9F2DEC9C9C20800")
+END arctan2;
+PROCEDURE [stdcall] ln* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
-  RETURN 0.0D0
+D9H, 0EDH,                    (*  fldln2                     *)
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0F1H,                    (*  fyl2x                      *)
+C9H,                          (*  leave                      *)
+C2H, 008H, 000H               (*  ret     08h                *)
+    )
-END tan;
+    RETURN 0.0
 END ln;
-PROCEDURE [stdcall] arctan2*(y, x: LONGREAL): LONGREAL;
-BEGIN
+PROCEDURE [stdcall] log* (base, x: REAL): REAL;
+BEGIN
-  sys.CODE("DD4508DD4510D9F3C9C21000")
+    SYSTEM.CODE(
+D9H, 0E8H,                    (*  fld1                       *)
+DDH, 045H, 010H,              (*  fld     qword [ebp + 10h]  *)
+D9H, 0F1H,                    (*  fyl2x                      *)
+D9H, 0E8H,                    (*  fld1                       *)
+DDH, 045H, 008H,              (*  fld     qword [ebp + 08h]  *)
+D9H, 0F1H,                    (*  fyl2x                      *)
+DEH, 0F9H,                    (*  fdivp st1, st              *)
+C9H,                          (*  leave                      *)
+C2H, 010H, 000H               (*  ret     10h                *)
-  RETURN 0.0D0
+    )
-END arctan2;
+    RETURN 0.0
+END log;
 PROCEDURE [stdcall] ln*(x: LONGREAL): LONGREAL;
+PROCEDURE [stdcall] exp* (x: REAL): REAL;
 BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+D9H, 0EAH,                 (*  fldl2e                     *)
+DEH, 0C9H, 0D9H, 0C0H,
+D9H, 0FCH, 0DCH, 0E9H,
+D9H, 0C9H, 0D9H, 0F0H,
+D9H, 0E8H, 0DEH, 0C1H,
+D9H, 0FDH, 0DDH, 0D9H,
-  sys.CODE("D9EDDD4508D9F1C9C20800")
+C9H,                       (*  leave                      *)
-  RETURN 0.0D0
+C2H, 008H, 000H            (*  ret     08h                *)
+    )
-END ln;
+    RETURN 0.0
 END exp;
-PROCEDURE [stdcall] log*(base, x: LONGREAL): LONGREAL;
+PROCEDURE [stdcall] round* (x: REAL): REAL;
+BEGIN
+    SYSTEM.CODE(
+DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+D9H, 07DH, 0F4H, 0D9H,
+DH, 0F6H, 066H, 081H,
+DH, 0F6H, 000H, 003H,
+D9H, 06DH, 0F6H, 0D9H,
+FCH, 0D9H, 06DH, 0F4H,
+C9H,                       (*  leave                     *)
+C2H, 008H, 000H            (*  ret     08h               *)
-BEGIN
+    )
-  sys.CODE("D9E8DD4510D9F1D9E8DD4508D9F1DEF9C9C21000")
+    RETURN 0.0
+END round;
-  RETURN 0.0D0
-END log;
 PROCEDURE [stdcall] frac* (x: REAL): REAL;
+BEGIN
-PROCEDURE [stdcall] exp*(x: LONGREAL): LONGREAL;
+    SYSTEM.CODE(
-BEGIN
+H,
-  sys.CODE("DD4508D9EADEC9D9C0D9FCDCE9D9C9D9F0D9E8DEC1D9FDDDD9C9C20800")
+DDH, 045H, 008H,           (*  fld     qword [ebp + 08h]  *)
+D9H, 0C0H, 0D9H, 03CH,
-  RETURN 0.0D0
+H, 0D9H, 07CH, 024H,
-END exp;
+H, 066H, 081H, 04CH,
 H, 002H, 000H, 00FH,
+D9H, 06CH, 024H, 002H,
-PROCEDURE [stdcall] round*(x: LONGREAL): LONGREAL;
+D9H, 0FCH, 0D9H, 02CH,
+H, 0DEH, 0E9H,
-BEGIN
+C9H,                       (*  leave                     *)
+C2H, 008H, 000H            (*  ret     08h               *)
   sys.CODE("DD4508D97DF4D97DF666814DF60003D96DF6D9FCD96DF4C9C20800")
-  RETURN 0.0D0
+    RETURN 0.0
-END round;
+END frac;
-PROCEDURE [stdcall] frac*(x: LONGREAL): LONGREAL;
-BEGIN
+PROCEDURE arcsin* (x: REAL): REAL;
-  sys.CODE("50DD4508D9C0D93C24D97C240266814C2402000FD96C2402D9FCD92C24DEE9C9C20800")
+    RETURN arctan2(x, sqrt(1.0 - x * x))
-  RETURN 0.0D0
+END arcsin;
-END frac;
+PROCEDURE arccos* (x: REAL): REAL;
+    RETURN arctan2(sqrt(1.0 - x * x), x)
+END arccos;
 PROCEDURE arcsin*(x: LONGREAL): LONGREAL;
   RETURN arctan2(x, sqrt(1.0D0 - x * x))
-END arcsin;
+PROCEDURE arctan* (x: REAL): REAL;
     RETURN arctan2(x, 1.0)
-PROCEDURE arccos*(x: LONGREAL): LONGREAL;
+END arctan;
   RETURN arctan2(sqrt(1.0D0 - x * x), x)
-END arccos;
 PROCEDURE sinh* (x: REAL): REAL;
+VAR
-PROCEDURE arctan*(x: LONGREAL): LONGREAL;
+    res: REAL;
-  RETURN arctan2(x, 1.0D0)
+BEGIN
+    IF IsZero(x) THEN
-END arctan;
+        res := 0.0
     ELSE
-PROCEDURE sinh*(x: LONGREAL): LONGREAL;
+        res := (exp(x) - exp(-x)) / 2.0
-VAR Res: LONGREAL;
+    END
-BEGIN
+    RETURN res
-  IF IsZero(x) THEN
+END sinh;
-    Res := 0.0D0
   ELSE
+PROCEDURE cosh* (x: REAL): REAL;
-    Res := (exp(x) - exp(-x)) / 2.0D0
+VAR
-  END
+    res: REAL;
   RETURN Res
+BEGIN
-END sinh;
+    IF IsZero(x) THEN
+        res := 1.0
-PROCEDURE cosh*(x: LONGREAL): LONGREAL;
+    ELSE
+        res := (exp(x) + exp(-x)) / 2.0
-VAR Res: LONGREAL;
+    END
+    RETURN res
-BEGIN
+END cosh;
   IF IsZero(x) THEN
-    Res := 1.0D0
+PROCEDURE tanh* (x: REAL): REAL;
-  ELSE
+VAR
-    Res := (exp(x) + exp(-x)) / 2.0D0
+    res: REAL;
-  END
-  RETURN Res
+BEGIN
-END cosh;
+    IF IsZero(x) THEN
         res := 0.0
-PROCEDURE tanh*(x: LONGREAL): LONGREAL;
+    ELSE
-VAR Res: LONGREAL;
+        res := sinh(x) / cosh(x)
+    END
-BEGIN
+    RETURN res
+END tanh;
-  IF IsZero(x) THEN
-    Res := 0.0D0
+PROCEDURE arcsinh* (x: REAL): REAL;
-  ELSE
+    RETURN ln(x + sqrt((x * x) + 1.0))
-    Res := sinh(x) / cosh(x)
+END arcsinh;
-  END
-  RETURN Res
-END tanh;
+PROCEDURE arccosh* (x: REAL): REAL;
     RETURN ln(x + sqrt((x - 1.0) / (x + 1.0)) * (x + 1.0))
-PROCEDURE arcsinh*(x: LONGREAL): LONGREAL;
+END arccosh;
-  RETURN ln(x + sqrt((x * x) + 1.0D0))
+PROCEDURE arctanh* (x: REAL): REAL;
-END arcsinh;
+VAR
+    res: REAL;
-PROCEDURE arccosh*(x: LONGREAL): LONGREAL;
+BEGIN
-  RETURN ln(x + sqrt((x - 1.0D0) / (x + 1.0D0)) * (x + 1.0D0))
+    IF SameValue(x, 1.0) THEN
-END arccosh;
+        res := SYSTEM.INF()
+    ELSIF SameValue(x, -1.0) THEN
-PROCEDURE arctanh*(x: LONGREAL): LONGREAL;
+        res := -SYSTEM.INF()
-VAR Res: LONGREAL;
+    ELSE
-BEGIN
+        res := 0.5 * ln((1.0 + x) / (1.0 - x))
+    END
-  IF SameValue(x, 1.0D0) THEN
+    RETURN res
+END arctanh;
-    Res := Inf
-  ELSIF SameValue(x, -1.0D0) THEN
+PROCEDURE floor* (x: REAL): REAL;
-    Res := nInf
+VAR
-  ELSE
+    f: REAL;
-    Res := 0.5D0 * ln((1.0D0 + x) / (1.0D0 - x))
-  END
+BEGIN
-  RETURN Res
+    f := frac(x);
-END arctanh;
+    x := x - f;
     IF f < 0.0 THEN
-PROCEDURE floor*(x: LONGREAL): LONGREAL;
+        x := x - 1.0
-VAR f: LONGREAL;
+    END
+    RETURN x
-BEGIN
+END floor;
-  f := frac(x);
+PROCEDURE ceil* (x: REAL): REAL;
-  x := x - f;
+VAR
-  IF f < 0.0D0 THEN
+    f: REAL;
-    x := x - 1.0D0
-  END
+BEGIN
-  RETURN x
+    f := frac(x);
-END floor;
+    x := x - f;
+    IF f > 0.0 THEN
-PROCEDURE ceil*(x: LONGREAL): LONGREAL;
+        x := x + 1.0
-VAR f: LONGREAL;
+    END
-BEGIN
+    RETURN x
-  f := frac(x);
+END ceil;
-  x := x - f;
-  IF f > 0.0D0 THEN
     x := x + 1.0D0
   END

Subversion Repositories Kolibri OS

(root)/programs/develop/oberon07/Lib/KolibriOS/Math.ob07 – Rev 6613 → 7597