diff options
author | Tristan Gingold <gingold@adacore.com> | 2015-12-20 13:56:08 +0100 |
---|---|---|
committer | Tristan Gingold <gingold@adacore.com> | 2015-12-20 13:58:11 +0100 |
commit | 92ac42fcf39d5dac4529d939a49437b2a7afe4c2 (patch) | |
tree | 2ec07dca7950bdc9ab67bba23700ccc42f8c2385 | |
parent | d3623693949f9bcfe7917f9d059e839a95843519 (diff) | |
download | ghdl-92ac42fcf39d5dac4529d939a49437b2a7afe4c2.tar.gz ghdl-92ac42fcf39d5dac4529d939a49437b2a7afe4c2.tar.bz2 ghdl-92ac42fcf39d5dac4529d939a49437b2a7afe4c2.zip |
openieee: complete math_real (and fix uniform).
-rw-r--r-- | libraries/openieee/math_real-body.vhdl | 155 | ||||
-rw-r--r-- | libraries/openieee/math_real.vhdl | 96 | ||||
-rw-r--r-- | src/ghdldrv/foreigns.adb | 62 |
3 files changed, 296 insertions, 17 deletions
diff --git a/libraries/openieee/math_real-body.vhdl b/libraries/openieee/math_real-body.vhdl index 1d7a154af..e825a7801 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 b2814f534..b8c2150d9 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 0d6b19aec..b8b49efe7 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 |