aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdlrun.adb6
-rw-r--r--src/grt/grt-lib.adb73
-rw-r--r--src/grt/grt-lib.ads7
-rw-r--r--src/grt/grt-types.ads3
-rw-r--r--src/vhdl/translate/trans-chap3.adb3
-rw-r--r--src/vhdl/translate/trans-chap7.adb23
-rw-r--r--src/vhdl/translate/trans.ads3
-rw-r--r--src/vhdl/translate/trans_decls.ads3
-rw-r--r--src/vhdl/translate/translation.adb23
9 files changed, 112 insertions, 32 deletions
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index d612095f7..9d1e14343 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -318,8 +318,10 @@ package body Ghdlrun is
Grt.Lib.Ghdl_Deallocate'Address);
Def (Trans_Decls.Ghdl_Real_Exp,
Grt.Lib.Ghdl_Real_Exp'Address);
- Def (Trans_Decls.Ghdl_Integer_Exp,
- Grt.Lib.Ghdl_Integer_Exp'Address);
+ Def (Trans_Decls.Ghdl_I32_Exp,
+ Grt.Lib.Ghdl_I32_Exp'Address);
+ Def (Trans_Decls.Ghdl_I64_Exp,
+ Grt.Lib.Ghdl_I64_Exp'Address);
Def (Trans_Decls.Ghdl_Sensitized_Process_Register,
Grt.Processes.Ghdl_Sensitized_Process_Register'Address);
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;
diff --git a/src/vhdl/translate/trans-chap3.adb b/src/vhdl/translate/trans-chap3.adb
index c9e639dd1..7938a278d 100644
--- a/src/vhdl/translate/trans-chap3.adb
+++ b/src/vhdl/translate/trans-chap3.adb
@@ -3233,8 +3233,7 @@ package body Trans.Chap3 is
Allocate_Unbounded_Composite_Bounds (Alloc_Kind, Res, Obj_Type);
Copy_Bounds (Chap3.Get_Composite_Bounds (Res), Bounds, Obj_Type);
-- Allocate base.
- Allocate_Unbounded_Composite_Base
- (Alloc_Kind, Res, Obj_Type);
+ Allocate_Unbounded_Composite_Base (Alloc_Kind, Res, Obj_Type);
else
New_Assign_Stmt
(M2Lp (Res),
diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb
index 20f7185d1..a0352a4dd 100644
--- a/src/vhdl/translate/trans-chap7.adb
+++ b/src/vhdl/translate/trans-chap7.adb
@@ -2456,11 +2456,24 @@ package body Trans.Chap7 is
Right_Tree, Ghdl_Real_Exp);
return New_Convert_Ov (Res, Res_Otype);
when Iir_Predefined_Integer_Exp =>
- Res := Translate_Lib_Operator
- (New_Convert_Ov (Left_Tree, Std_Integer_Otype),
- Right_Tree,
- Ghdl_Integer_Exp);
- return New_Convert_Ov (Res, Res_Otype);
+ declare
+ Left_Tinfo : constant Type_Info_Acc :=
+ Get_Info (Get_Type (Left));
+ Opr : O_Dnode;
+ Etype : O_Tnode;
+ begin
+ case Type_Mode_Integers (Left_Tinfo.Type_Mode) is
+ when Type_Mode_I32 =>
+ Opr := Ghdl_I32_Exp;
+ Etype := Ghdl_I32_Type;
+ when Type_Mode_I64 =>
+ Opr := Ghdl_I64_Exp;
+ Etype := Ghdl_I64_Type;
+ end case;
+ Res := Translate_Lib_Operator
+ (New_Convert_Ov (Left_Tree, Etype), Right_Tree, Opr);
+ return New_Convert_Ov (Res, Res_Otype);
+ end;
when Iir_Predefined_Array_Inequality
| Iir_Predefined_Record_Inequality =>
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 960323ee8..f154d6d5d 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1063,6 +1063,9 @@ package Trans is
subtype Type_Mode_Scalar is Type_Mode_Type range
Type_Mode_B1 .. Type_Mode_F64;
+ subtype Type_Mode_Integers is Type_Mode_Type range
+ Type_Mode_I32 .. Type_Mode_I64;
+
-- Composite types, with the vhdl meaning: record and arrays.
subtype Type_Mode_Composite is Type_Mode_Type range
Type_Mode_Static_Record .. Type_Mode_Protected;
diff --git a/src/vhdl/translate/trans_decls.ads b/src/vhdl/translate/trans_decls.ads
index d0011e653..2f9fa539a 100644
--- a/src/vhdl/translate/trans_decls.ads
+++ b/src/vhdl/translate/trans_decls.ads
@@ -164,7 +164,8 @@ package Trans_Decls is
Ghdl_Malloc : O_Dnode;
Ghdl_Malloc0 : O_Dnode;
Ghdl_Real_Exp : O_Dnode;
- Ghdl_Integer_Exp : O_Dnode;
+ Ghdl_I32_Exp : O_Dnode;
+ Ghdl_I64_Exp : O_Dnode;
-- Procedure called in case of check failed.
Ghdl_Program_Error : O_Dnode;
diff --git a/src/vhdl/translate/translation.adb b/src/vhdl/translate/translation.adb
index 68dd9a300..2edeba0be 100644
--- a/src/vhdl/translate/translation.adb
+++ b/src/vhdl/translate/translation.adb
@@ -1139,16 +1139,25 @@ package body Translation is
Std_Integer_Otype);
Finish_Subprogram_Decl (Interfaces, Ghdl_Real_Exp);
- -- function __ghdl_integer_exp (left : std__standard__integer;
- -- right : std__standard__integer)
- -- return std__standard__integer;
+ -- function __ghdl_i32_exp (left : ghdl_i32;
+ -- right : std__standard__integer)
+ -- return ghdl_i32;
Start_Function_Decl
- (Interfaces, Get_Identifier ("__ghdl_integer_exp"), O_Storage_External,
- Std_Integer_Otype);
- New_Interface_Decl (Interfaces, Param, Wki_Left, Std_Integer_Otype);
+ (Interfaces, Get_Identifier ("__ghdl_i32_exp"), O_Storage_External,
+ Ghdl_I32_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Left, Ghdl_I32_Type);
New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype);
- Finish_Subprogram_Decl (Interfaces, Ghdl_Integer_Exp);
+ Finish_Subprogram_Decl (Interfaces, Ghdl_I32_Exp);
+ -- function __ghdl_i64_exp (left : ghdl_i64;
+ -- right : std__standard__integer)
+ -- return ghdl_i64;
+ Start_Function_Decl
+ (Interfaces, Get_Identifier ("__ghdl_i64_exp"), O_Storage_External,
+ Ghdl_I64_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Left, Ghdl_I64_Type);
+ New_Interface_Decl (Interfaces, Param, Wki_Right, Std_Integer_Otype);
+ Finish_Subprogram_Decl (Interfaces, Ghdl_I64_Exp);
-- procedure __ghdl_image_b1 (res : std_string_ptr_node;
-- val : ghdl_bool_type;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 07:01:10 +0000