diff options
Diffstat (limited to 'src/grt')
| -rw-r--r-- | src/grt/grt-lib.adb | 73 | ||||
| -rw-r--r-- | src/grt/grt-lib.ads | 7 | ||||
| -rw-r--r-- | src/grt/grt-types.ads | 3 |
3 files changed, 68 insertions, 15 deletions
diff --git a/src/grt/grt-lib.adb b/src/grt/grt-lib.adb index 2442998fe..3a9a9f6c3 100644 --- a/src/grt/grt-lib.adb +++ b/src/grt/grt-lib.adb @@ -191,16 +191,53 @@ package body Grt.Lib is Error_E_Call_Stack (Bt); end Ghdl_Direction_Check_Failed; - function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32) - return Ghdl_I32 - is - pragma Suppress (Overflow_Check); + function Hi (V : Ghdl_I64) return Ghdl_U32 is + begin + return Ghdl_U32 (Shift_Right (To_Ghdl_U64 (V), 32) and 16#ffff_ffff#); + end Hi; - R : Ghdl_I32; - Res : Ghdl_I32; - P : Ghdl_I32; + function Lo (V : Ghdl_I64) return Ghdl_U32 is + begin + return Ghdl_U32 (To_Ghdl_U64 (V) and 16#ffff_ffff#); + end Lo; + + procedure Mul_I32_Ovf (L, R : Ghdl_I32; + Res : out Ghdl_I32; + Ovf : out Boolean) + is T : Ghdl_I64; begin + T := Ghdl_I64 (L) * Ghdl_I64 (R); + if Hi (T) /= Shift_Right_Arithmetic (Lo (T), 31) then + Ovf := True; + else + Ovf := False; + Res := Ghdl_I32 (T); + end if; + end Mul_I32_Ovf; + + procedure Mul_I64_Ovf (L, R : Ghdl_I64; + Res : out Ghdl_I64; + Ovf : out Boolean) is + begin + -- TODO: check overflow. + Res := L * R; + Ovf := False; + end Mul_I64_Ovf; + + generic + type T is range <>; + with procedure Mul_Ovf (L, R : T; Res : out T; Ovf : out Boolean); + function Gen_Ixx_Exp (V : T; E : Std_Integer) return T; + pragma Convention (C, Gen_Ixx_Exp); + + function Gen_Ixx_Exp (V : T; E : Std_Integer) return T + is + R : Std_Integer; + Res : T; + P : T; + Ovf : Boolean; + begin if E < 0 then Error ("negative exponent"); end if; @@ -209,18 +246,30 @@ package body Grt.Lib is R := E; loop if R mod 2 = 1 then - T := Ghdl_I64 (Res) * Ghdl_I64 (P); - Res := Ghdl_I32 (T); - if Ghdl_I64 (Res) /= T then + Mul_Ovf (Res, P, Res, Ovf); + if Ovf then Error ("overflow in exponentiation"); end if; end if; R := R / 2; exit when R = 0; - P := P * P; + Mul_Ovf (P, P, P, Ovf); + if Ovf then + Error ("overflow in exponentiation"); + end if; end loop; return Res; - end Ghdl_Integer_Exp; + end Gen_Ixx_Exp; + + function Ghdl_I32_Exp_1 is new Gen_Ixx_Exp (Ghdl_I32, Mul_I32_Ovf); + + function Ghdl_I32_Exp (V : Ghdl_I32; E : Std_Integer) return Ghdl_I32 + renames Ghdl_I32_Exp_1; + + function Ghdl_I64_Exp_1 is new Gen_Ixx_Exp (Ghdl_I64, Mul_I64_Ovf); + + function Ghdl_I64_Exp (V : Ghdl_I64; E : Std_Integer) return Ghdl_I64 + renames Ghdl_I64_Exp_1; function C_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr; pragma Import (C, C_Malloc, "malloc"); diff --git a/src/grt/grt-lib.ads b/src/grt/grt-lib.ads index 69c8a4c34..646cdd5fb 100644 --- a/src/grt/grt-lib.ads +++ b/src/grt/grt-lib.ads @@ -67,8 +67,8 @@ package Grt.Lib is Line : Ghdl_I32; Code : Ghdl_Index_Type); - function Ghdl_Integer_Exp (V : Ghdl_I32; E : Ghdl_I32) - return Ghdl_I32; + function Ghdl_I32_Exp (V : Ghdl_I32; E : Std_Integer) return Ghdl_I32; + function Ghdl_I64_Exp (V : Ghdl_I64; E : Std_Integer) return Ghdl_I64; function Ghdl_Malloc (Size : Ghdl_Index_Type) return Ghdl_Ptr; @@ -126,7 +126,8 @@ private pragma Export (C, Ghdl_Malloc0, "__ghdl_malloc0"); pragma Export (C, Ghdl_Deallocate, "__ghdl_deallocate"); - pragma Export (C, Ghdl_Integer_Exp, "__ghdl_integer_exp"); + pragma Export (C, Ghdl_I32_Exp, "__ghdl_i32_exp"); + pragma Export (C, Ghdl_I64_Exp, "__ghdl_i64_exp"); pragma Export (C, Ghdl_Real_Exp, "__ghdl_real_exp"); pragma Export (C, Ghdl_Std_Ulogic_To_Boolean_Array, diff --git a/src/grt/grt-types.ads b/src/grt/grt-types.ads index f75711eeb..fdabf4368 100644 --- a/src/grt/grt-types.ads +++ b/src/grt/grt-types.ads @@ -39,6 +39,9 @@ package Grt.Types is type Ghdl_U64 is new Unsigned_64; type Ghdl_F64 is new IEEE_Float_64; + function To_Ghdl_U64 is new Ada.Unchecked_Conversion + (Ghdl_I64, Ghdl_U64); + type Ghdl_Ptr is new Address; type Ghdl_Index_Type is mod 2 ** 32; subtype Ghdl_Real is Ghdl_F64; |