summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--libraries/openieee/math_real-body.vhdl155
-rw-r--r--libraries/openieee/math_real.vhdl96
-rw-r--r--src/ghdldrv/foreigns.adb62
3 files changed, 296 insertions, 17 deletions
diff --git a/libraries/openieee/math_real-body.vhdl b/libraries/openieee/math_real-body.vhdl
index 1d7a154..e825a78 100644
--- a/libraries/openieee/math_real-body.vhdl
+++ b/libraries/openieee/math_real-body.vhdl
@@ -46,22 +46,60 @@ package body MATH_REAL is
function TRUNC (X : REAL) return REAL is
begin
assert false severity failure;
- end TRUNC;
+ end;
+
+ function fmod (X, Y : REAL) return REAL;
+ attribute foreign of fmod : function is "VHPIDIRECT fmod";
+
+ function fmod (X, Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function "mod" (X, Y : REAL) return REAL
+ is
+ variable res : real;
+ begin
+ assert y /= 0.0 report "ieee.math_real.""mod"": dividend is 0.0"
+ severity failure;
+ res := fmod (x, y);
+ if res /= 0.0 then
+ if x > 0.0 xor y > 0.0 then
+ res := res + y;
+ end if;
+ end if;
+ return res;
+ end "mod";
+
+ function REALMAX (X, Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function REALMIN (X, Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
procedure UNIFORM (SEED1, SEED2 : inout POSITIVE; X : out REAL)
is
variable z, k : Integer;
+ variable s1, s2 : Integer;
begin
k := seed1 / 53668;
- seed1 := 40014 * (seed1 - k * 53668) - k * 12211;
- if seed1 < 0 then
- seed1 := seed1 + 2147483563;
+ s1 := 40014 * (seed1 - k * 53668) - k * 12211;
+ if s1 < 0 then
+ seed1 := s1 + 2147483563;
+ else
+ seed1 := s1;
end if;
k := seed2 / 52774;
- seed2 := 40692 * (seed2 - k * 52774) - k * 3791;
- if seed2 < 0 then
- seed2 := seed2 + 2147483399;
+ s2 := 40692 * (seed2 - k * 52774) - k * 3791;
+ if s2 < 0 then
+ seed2 := s2 + 2147483399;
+ else
+ seed2 := s2;
end if;
z := seed1 - seed2;
@@ -72,15 +110,114 @@ package body MATH_REAL is
x := real (z) * 4.656613e-10;
end UNIFORM;
+ function SQRT (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function CBRT (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function "**" (X : INTEGER; Y : REAL) return REAL is
+ begin
+ return real (x) ** y;
+ end "**";
+
+ function "**" (X : REAL; Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function EXP (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function LOG (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function LOG2 (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function LOG10 (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function LOG (X : REAL; BASE : REAL) return REAL is
+ begin
+ return log (x) / log (base);
+ end log;
+
function SIN (X : REAL) return REAL is
begin
assert false severity failure;
- end SIN;
+ end;
function COS (X : REAL) return REAL is
begin
assert false severity failure;
- end COS;
+ end;
+
+ function TAN (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCSIN (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCCOS (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCTAN (Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCTAN (Y, X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function SINH (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function COSH (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function TANH (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+ function ARCSINH (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCCOSH (X : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
+
+ function ARCTANH (Y : REAL) return REAL is
+ begin
+ assert false severity failure;
+ end;
end MATH_REAL;
diff --git a/libraries/openieee/math_real.vhdl b/libraries/openieee/math_real.vhdl
index b2814f5..b8c2150 100644
--- a/libraries/openieee/math_real.vhdl
+++ b/libraries/openieee/math_real.vhdl
@@ -17,7 +17,31 @@
-- <http://www.gnu.org/licenses/>.
package MATH_REAL is
- constant math_pi : real := 3.14159_26535_89793_23846;
+ -- The values were computed with at least 40 digits and rounded to
+ -- 20 digits after the dot. They were checked with the original ieee
+ -- specification (log2_of_e has an extra digit from the spec).
+ constant math_e : real := 2.71828_18284_59045_23536;
+ constant math_1_over_e : real := 0.36787_94411_71442_321596;
+
+ constant math_pi : real := 3.14159_26535_89793_23846;
+ constant math_2_pi : real := 6.28318_53071_79586_47693;
+ constant math_pi_over_2 : real := 1.57079_63267_94896_61923;
+ constant math_pi_over_3 : real := 1.04719_75511_96597_74615;
+ constant math_pi_over_4 : real := 0.78539_81633_97448_30962;
+ constant math_3_pi_over_2 : real := 4.71238_89803_84689_85769;
+
+ constant math_log_of_2 : real := 0.69314_71805_59945_30942;
+ constant math_log_of_10 : real := 2.30258_50929_94045_68402;
+ constant math_log2_of_e : real := 1.44269_50408_88963_40736;
+ constant math_log10_of_e : real := 0.43429_44819_03251_82765;
+
+ constant math_sqrt_2 : real := 1.41421_35623_73095_04880;
+ constant math_1_over_sqrt_2 : real := 0.70710_67811_86547_52440;
+ constant math_sqrt_pi : real := 1.77245_38509_05516_02730;
+
+ constant math_deg_to_rad : real := 0.01745_32925_19943_29577;
+ constant math_rad_to_deg : real := 57.29577_95130_82320_87680;
+
function SIGN (X : REAL) return REAL;
function CEIL (X : REAL) return REAL;
@@ -32,13 +56,83 @@ package MATH_REAL is
function TRUNC (X : REAL) return REAL;
attribute foreign of trunc : function is "VHPIDIRECT trunc";
+ function "mod" (X, Y : REAL) return REAL;
+ -- Contrary to fmod, the sign of the result is the sign of Y.
+
+ function REALMAX (X, Y : REAL) return REAL;
+ attribute foreign of REALMAX : function is "VHPIDIRECT fmax";
+
+ function REALMIN (X, Y : REAL) return REAL;
+ attribute foreign of REALMIN : function is "VHPIDIRECT fmin";
+
procedure UNIFORM (SEED1, SEED2 : inout POSITIVE; X : out REAL);
-- Algorithm from: Pierre L'Ecuyer, CACM June 1988 Volume 31 Number 6
-- page 747 figure 3.
+ function SQRT (X : REAL) return REAL;
+ attribute foreign of SQRT : function is "VHPIDIRECT sqrt";
+
+ function CBRT (X : REAL) return REAL;
+ attribute foreign of CBRT : function is "VHPIDIRECT cbrt";
+
+ function "**" (X : INTEGER; Y : REAL) return REAL;
+
+ function "**" (X : REAL; Y : REAL) return REAL;
+ attribute foreign of "**" [ REAL, REAL return REAL ]: function is
+ "VHPIDIRECT pow";
+
+ function EXP (X : REAL) return REAL;
+ attribute foreign of EXP : function is "VHPIDIRECT exp";
+
+ function LOG (X : REAL) return REAL;
+ attribute foreign of LOG [ REAL return REAL ] : function is "VHPIDIRECT log";
+
+ function LOG2 (X : REAL) return REAL;
+ attribute foreign of LOG2 : function is "VHPIDIRECT log2";
+
+ function LOG10 (X : REAL) return REAL;
+ attribute foreign of LOG10 : function is "VHPIDIRECT log10";
+
+ function LOG (X : REAL; BASE : REAL) return REAL;
+
function SIN (X : REAL) return REAL;
attribute foreign of SIN : function is "VHPIDIRECT sin";
function COS (X : REAL) return REAL;
attribute foreign of COS : function is "VHPIDIRECT cos";
+
+ function TAN (X : REAL) return REAL;
+ attribute foreign of TAN : function is "VHPIDIRECT tan";
+
+ function ARCSIN (X : REAL) return REAL;
+ attribute foreign of ARCSIN : function is "VHPIDIRECT asin";
+
+ function ARCCOS (X : REAL) return REAL;
+ attribute foreign of ARCCOS : function is "VHPIDIRECT acos";
+
+ function ARCTAN (Y : REAL) return REAL;
+ attribute foreign of ARCTAN [ REAL return REAL ]: function is
+ "VHPIDIRECT atan";
+
+ function ARCTAN (Y, X : REAL) return REAL;
+ attribute foreign of ARCTAN [ REAL, REAL return REAL ]: function is
+ "VHPIDIRECT atan2";
+
+ function SINH (X : REAL) return REAL;
+ attribute foreign of SINH : function is "VHPIDIRECT sinh";
+
+ function COSH (X : REAL) return REAL;
+ attribute foreign of COSH : function is "VHPIDIRECT cosh";
+
+ function TANH (X : REAL) return REAL;
+ attribute foreign of TANH : function is "VHPIDIRECT tanh";
+
+ function ARCSINH (X : REAL) return REAL;
+ attribute foreign of ARCSINH : function is "VHPIDIRECT asinh";
+
+ function ARCCOSH (X : REAL) return REAL;
+ attribute foreign of ARCCOSH : function is "VHPIDIRECT acosh";
+
+ function ARCTANH (Y : REAL) return REAL;
+ attribute foreign of ARCTANH : function is "VHPIDIRECT atanh";
end MATH_REAL;
diff --git a/src/ghdldrv/foreigns.adb b/src/ghdldrv/foreigns.adb
index 0d6b19a..b8b49ef 100644
--- a/src/ghdldrv/foreigns.adb
+++ b/src/ghdldrv/foreigns.adb
@@ -30,27 +30,66 @@ package body Foreigns is
function Trunc (Arg : double) return double;
pragma Import (C, Trunc);
+ function Fmod (X, Y : double) return double;
+ pragma Import (C, Fmod);
+
+ function Fmin (X, Y : double) return double;
+ pragma Import (C, Fmin);
+
+ function Fmax (X, Y : double) return double;
+ pragma Import (C, Fmax);
+
function Sin (Arg : double) return double;
pragma Import (C, Sin);
function Cos (Arg : double) return double;
pragma Import (C, Cos);
+ function Tan (Arg : double) return double;
+ pragma Import (C, Tan);
+
+ function Atan (Y : double) return double;
+ pragma Import (C, Atan);
+
+ function Atan2 (X, Y : double) return double;
+ pragma Import (C, Atan2);
+
function Log (Arg : double) return double;
pragma Import (C, Log);
+ function Log2 (Arg : double) return double;
+ pragma Import (C, Log2);
+
+ function Log10 (Arg : double) return double;
+ pragma Import (C, Log10);
+
function Exp (Arg : double) return double;
pragma Import (C, Exp);
+ function Pow (X, Y : double) return double;
+ pragma Import (C, Pow);
+
function Sqrt (Arg : double) return double;
pragma Import (C, Sqrt);
+ function Cbrt (Arg : double) return double;
+ pragma Import (C, Cbrt);
+
function Asin (Arg : double) return double;
pragma Import (C, Asin);
function Acos (Arg : double) return double;
pragma Import (C, Acos);
+ function Sinh (Arg : double) return double;
+ pragma Import (C, Sinh);
+
+ function Cosh (Arg : double) return double;
+ pragma Import (C, Cosh);
+
+ function Tanh (Arg : double) return double;
+ pragma Import (C, Tanh);
+
function Asinh (Arg : double) return double;
pragma Import (C, Asinh);
@@ -60,9 +99,6 @@ package body Foreigns is
function Atanh (X : double) return double;
pragma Import (C, Atanh);
- function Atan2 (X, Y : double) return double;
- pragma Import (C, Atan2);
-
type String_Cacc is access constant String;
type Foreign_Record is record
Name : String_Cacc;
@@ -75,17 +111,29 @@ package body Foreigns is
(new String'("floor"), Floor'Address),
(new String'("round"), Round'Address),
(new String'("trunc"), Trunc'Address),
- (new String'("sin"), Sin'Address),
- (new String'("cos"), Cos'Address),
+ (new String'("fmod"), Fmod'Address),
+ (new String'("fmin"), Fmin'Address),
+ (new String'("fmax"), Fmax'Address),
(new String'("log"), Log'Address),
+ (new String'("log2"), Log2'Address),
+ (new String'("log10"), Log10'Address),
(new String'("exp"), Exp'Address),
(new String'("sqrt"), Sqrt'Address),
+ (new String'("cbrt"), Cbrt'Address),
+ (new String'("pow"), Pow'Address),
+ (new String'("sin"), Sin'Address),
+ (new String'("cos"), Cos'Address),
+ (new String'("tan"), Tan'Address),
(new String'("asin"), Asin'Address),
(new String'("acos"), Acos'Address),
+ (new String'("atan"), Atan'Address),
+ (new String'("atan2"), Atan2'Address),
+ (new String'("sinh"), Sinh'Address),
+ (new String'("cosh"), Cosh'Address),
+ (new String'("tanh"), Tanh'Address),
(new String'("asinh"), Asinh'Address),
(new String'("acosh"), Acosh'Address),
- (new String'("atanh"), Atanh'Address),
- (new String'("atan2"), Atan2'Address)
+ (new String'("atanh"), Atanh'Address)
);
function Find_Foreign (Name : String) return Address is
generated by cgit (git 2.34.1) at 2024-12-20 08:12:20 +0000