aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/grt-avhpi.adb7
-rw-r--r--translate/grt/grt-disp_rti.adb8
-rw-r--r--translate/grt/grt-files.adb4
-rw-r--r--translate/grt/grt-images.adb7
-rw-r--r--translate/grt/grt-images.ads3
-rw-r--r--translate/grt/grt-rtis_addr.adb5
-rw-r--r--translate/grt/grt-rtis_utils.adb16
-rw-r--r--translate/grt/grt-signals.adb84
-rw-r--r--translate/grt/grt-signals.ads34
9 files changed, 165 insertions, 3 deletions
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index fc38f8792..7c8b10f5a 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -329,7 +329,8 @@ package body Grt.Avhpi is
end if;
end;
when Ghdl_Rtik_Type_B2
- | Ghdl_Rtik_Type_E8 =>
+ | Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32 =>
Res := (Kind => VhpiEnumTypeDeclK,
Ctxt => Ctxt,
Atype => Rti);
@@ -387,6 +388,7 @@ package body Grt.Avhpi is
| Ghdl_Rtik_Subtype_Array
| Ghdl_Rtik_Subtype_Array_Ptr
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Rti_To_Handle (Ch, Iterator.Ctxt, Res);
if Res.Kind /= VhpiUndefined then
@@ -581,6 +583,9 @@ package body Grt.Avhpi is
-- when Ghdl_Rtik_Type_E8 =>
-- Disp_Enum_Value
-- (Stream, Rti, Ghdl_Index_Type (Vptr.E8));
+-- when Ghdl_Rtik_Type_E32 =>
+-- Disp_Enum_Value
+-- (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
-- when Ghdl_Rtik_Type_B2 =>
-- Disp_Enum_Value
-- (Stream, Rti,
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index e9ac3e60d..dded64430 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -73,6 +73,11 @@ package body Grt.Disp_Rti is
if not Is_Sig then
Update (8);
end if;
+ when Ghdl_Rtik_Type_E32 =>
+ Disp_Enum_Value (Stream, Rti, Ghdl_Index_Type (Vptr.E32));
+ if not Is_Sig then
+ Update (32);
+ end if;
when Ghdl_Rtik_Type_B2 =>
Disp_Enum_Value (Stream, Rti,
Ghdl_Index_Type (Ghdl_B2'Pos (Vptr.B2)));
@@ -201,6 +206,7 @@ package body Grt.Disp_Rti is
Obj, Is_Sig);
when Ghdl_Rtik_Type_I32
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Disp_Scalar_Value (Stream, Rti, Obj, Is_Sig);
when Ghdl_Rtik_Type_Array =>
@@ -310,6 +316,8 @@ package body Grt.Disp_Rti is
Put ("ghdl_rtik_type_b2");
when Ghdl_Rtik_Type_E8 =>
Put ("ghdl_rtik_type_e8");
+ when Ghdl_Rtik_Type_E32 =>
+ Put ("ghdl_rtik_type_e32");
when Ghdl_Rtik_Type_P64 =>
Put ("ghdl_rtik_type_p64");
when Ghdl_Rtik_Type_I32 =>
diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb
index 974d5578b..9037fcebe 100644
--- a/translate/grt/grt-files.adb
+++ b/translate/grt/grt-files.adb
@@ -153,8 +153,8 @@ package body Grt.Files is
end if;
-- Copy file name and convert it to a C string (NUL terminated).
- for I in 0 .. Str.Bounds.Dim_1.Length - 1 loop
- Name (1 + Natural (I)) := Str.Base (I);
+ for I in 1 .. Str.Bounds.Dim_1.Length loop
+ Name (Natural (I)) := Str.Base (I - 1);
end loop;
Name (Name'Last) := NUL;
diff --git a/translate/grt/grt-images.adb b/translate/grt/grt-images.adb
index 396a0eade..5f8a081f9 100644
--- a/translate/grt/grt-images.adb
+++ b/translate/grt/grt-images.adb
@@ -68,6 +68,13 @@ package body Grt.Images is
Return_Enum (Res, Rti, Ghdl_E8'Pos (Val));
end Ghdl_Image_E8;
+ procedure Ghdl_Image_E32
+ (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access)
+ is
+ begin
+ Return_Enum (Res, Rti, Ghdl_E32'Pos (Val));
+ end Ghdl_Image_E32;
+
procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
is
Str : String (1 .. 11);
diff --git a/translate/grt/grt-images.ads b/translate/grt/grt-images.ads
index fb33b6376..74a7bd7e9 100644
--- a/translate/grt/grt-images.ads
+++ b/translate/grt/grt-images.ads
@@ -23,6 +23,8 @@ package Grt.Images is
(Res : Std_String_Ptr; Val : Ghdl_B2; Rti : Ghdl_Rti_Access);
procedure Ghdl_Image_E8
(Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access);
+ procedure Ghdl_Image_E32
+ (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access);
procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32);
procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64);
procedure Ghdl_Image_P64
@@ -32,6 +34,7 @@ package Grt.Images is
private
pragma Export (C, Ghdl_Image_B2, "__ghdl_image_b2");
pragma Export (C, Ghdl_Image_E8, "__ghdl_image_e8");
+ pragma Export (C, Ghdl_Image_E32, "__ghdl_image_e32");
pragma Export (C, Ghdl_Image_I32, "__ghdl_image_i32");
pragma Export (C, Ghdl_Image_F64, "__ghdl_image_f64");
pragma Export (C, Ghdl_Image_P64, "__ghdl_image_p64");
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index 4f24fe776..64273b3f3 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -231,6 +231,10 @@ package body Grt.Rtis_Addr is
Align (Ghdl_Range_E8'Alignment);
Res (I) := To_Ghdl_Range_Ptr (Bounds);
Update (Ghdl_Range_E8'Size);
+ when Ghdl_Rtik_Type_E32 =>
+ Align (Ghdl_Range_E32'Alignment);
+ Res (I) := To_Ghdl_Range_Ptr (Bounds);
+ Update (Ghdl_Range_E32'Size);
when others =>
-- Bounds are not known anymore.
Bounds := Null_Address;
@@ -249,6 +253,7 @@ package body Grt.Rtis_Addr is
return To_Ghdl_Rti_Access
(To_Ghdl_Rtin_Subtype_Array_Acc (Atype).Basetype);
when Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
return Atype;
when others =>
diff --git a/translate/grt/grt-rtis_utils.adb b/translate/grt/grt-rtis_utils.adb
index 9754adac8..4fd558e3d 100644
--- a/translate/grt/grt-rtis_utils.adb
+++ b/translate/grt/grt-rtis_utils.adb
@@ -198,6 +198,8 @@ package body Grt.Rtis_Utils is
Update (32);
when Ghdl_Rtik_Type_E8 =>
Update (8);
+ when Ghdl_Rtik_Type_E32 =>
+ Update (32);
when Ghdl_Rtik_Type_B2 =>
Update (8);
when Ghdl_Rtik_Type_F64 =>
@@ -231,6 +233,13 @@ package body Grt.Rtis_Utils is
when Dir_Downto =>
Val.E8 := Rng.E8.Left - Ghdl_E8 (Pos);
end case;
+ when Ghdl_Rtik_Type_E32 =>
+ case Rng.E32.Dir is
+ when Dir_To =>
+ Val.E32 := Rng.E32.Left + Ghdl_E32 (Pos);
+ when Dir_Downto =>
+ Val.E32 := Rng.E32.Left - Ghdl_E32 (Pos);
+ end case;
when Ghdl_Rtik_Type_B2 =>
case Pos is
when 0 =>
@@ -265,6 +274,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Vstr, Rti, Ghdl_Index_Type (V.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value (Vstr, Rti, Ghdl_B2'Pos (V.B2));
when others =>
@@ -348,6 +359,7 @@ package body Grt.Rtis_Utils is
Handle_Scalar (To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype);
when Ghdl_Rtik_Type_I32
| Ghdl_Rtik_Type_E8
+ | Ghdl_Rtik_Type_E32
| Ghdl_Rtik_Type_B2 =>
Handle_Scalar (Rti);
when Ghdl_Rtik_Type_Array =>
@@ -430,6 +442,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Str, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value
(Str, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
@@ -520,6 +534,8 @@ package body Grt.Rtis_Utils is
end;
when Ghdl_Rtik_Type_E8 =>
Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E8));
+ when Ghdl_Rtik_Type_E32 =>
+ Get_Enum_Value (Rstr, Type_Rti, Ghdl_Index_Type (Value.E32));
when Ghdl_Rtik_Type_B2 =>
Get_Enum_Value
(Rstr, Type_Rti, Ghdl_Index_Type (Ghdl_B2'Pos (Value.B2)));
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 5b3a12f94..a165144f4 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -802,6 +802,77 @@ package body Grt.Signals is
(Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After);
end Ghdl_Signal_Next_Assign_E8;
+ function Ghdl_Create_Signal_E32
+ (Init_Val : Ghdl_E32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr
+ is
+ begin
+ return Create_Signal
+ (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val),
+ Get_Current_Mode_Signal,
+ Resolv_Func, Resolv_Inst);
+ end Ghdl_Create_Signal_E32;
+
+ procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32)
+ is
+ begin
+ Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val));
+ end Ghdl_Signal_Init_E32;
+
+ procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32)
+ is
+ begin
+ Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val));
+ end Ghdl_Signal_Associate_E32;
+
+ procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32)
+ is
+ Trans : Transaction_Acc;
+ begin
+ if not Sign.Flags.Has_Active
+ and then Sign.Net = Net_One_Driver
+ and then Val = Sign.Value.E32
+ and then Sign.S.Drivers (0).First_Trans.Next = null
+ then
+ return;
+ end if;
+
+ Trans := new Transaction'
+ (Kind => Trans_Value,
+ Time => 0,
+ Next => null,
+ Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+
+ Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
+ end Ghdl_Signal_Simple_Assign_E32;
+
+ procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Rej : Std_Time;
+ Val : Ghdl_E32;
+ After : Std_Time)
+ is
+ Trans : Transaction_Acc;
+ begin
+ Trans := new Transaction'
+ (Kind => Trans_Value,
+ Time => 0,
+ Next => null,
+ Val => Value_Union'(Mode => Mode_E32, E32 => Val));
+ Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
+ end Ghdl_Signal_Start_Assign_E32;
+
+ procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32;
+ After : Std_Time)
+ is
+ begin
+ Ghdl_Signal_Next_Assign
+ (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After);
+ end Ghdl_Signal_Next_Assign_E32;
+
function Ghdl_Create_Signal_I32
(Init_Val : Ghdl_I32;
Resolv_Func : System.Address;
@@ -1358,6 +1429,19 @@ package body Grt.Signals is
end if;
end Ghdl_Signal_Driving_Value_E8;
+ function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+ return Ghdl_E32
+ is
+ Drv : Driver_Acc;
+ begin
+ Drv := Get_Driver (Sig);
+ if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
+ Error ("'driving_value: no active driver in process for signal");
+ else
+ return Drv.First_Trans.Val.E32;
+ end if;
+ end Ghdl_Signal_Driving_Value_E32;
+
function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
return Ghdl_I32
is
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index c78bf52f2..500cd55a0 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -453,6 +453,25 @@ package Grt.Signals is
function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
return Ghdl_E8;
+ function Ghdl_Create_Signal_E32
+ (Init_Val : Ghdl_E32;
+ Resolv_Func : System.Address;
+ Resolv_Inst : System.Address)
+ return Ghdl_Signal_Ptr;
+ procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32);
+ procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32);
+ procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32);
+ procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Rej : Std_Time;
+ Val : Ghdl_E32;
+ After : Std_Time);
+ procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr;
+ Val : Ghdl_E32;
+ After : Std_Time);
+ function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr)
+ return Ghdl_E32;
+
function Ghdl_Create_Signal_I32
(Init_Val : Ghdl_I32;
Resolv_Func : System.Address;
@@ -634,6 +653,21 @@ private
pragma Export (C, Ghdl_Signal_Driving_Value_E8,
"__ghdl_signal_driving_value_e8");
+ pragma Export (C, Ghdl_Create_Signal_E32,
+ "__ghdl_create_signal_e32");
+ pragma Export (C, Ghdl_Signal_Init_E32,
+ "__ghdl_signal_init_e32");
+ pragma Export (C, Ghdl_Signal_Associate_E32,
+ "__ghdl_signal_associate_e32");
+ pragma Export (C, Ghdl_Signal_Simple_Assign_E32,
+ "__ghdl_signal_simple_assign_e32");
+ pragma Export (C, Ghdl_Signal_Start_Assign_E32,
+ "__ghdl_signal_start_assign_e32");
+ pragma Export (C, Ghdl_Signal_Next_Assign_E32,
+ "__ghdl_signal_next_assign_e32");
+ pragma Export (C, Ghdl_Signal_Driving_Value_E32,
+ "__ghdl_signal_driving_value_e32");
+
pragma Export (C, Ghdl_Create_Signal_I32,
"__ghdl_create_signal_i32");
pragma Export (C, Ghdl_Signal_Init_I32,
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-25 06:16:00 +0000