summaryrefslogtreecommitdiff
path: root/translate
diff options
context:
space:
mode:
Diffstat (limited to 'translate')
-rw-r--r--translate/gcc/dist-common.sh1
-rw-r--r--translate/ghdldrv/ghdlrun.adb8
-rw-r--r--translate/grt/grt-avhpi.adb2
-rw-r--r--translate/grt/grt-disp_rti.adb10
-rw-r--r--translate/grt/grt-disp_tree.adb4
-rw-r--r--translate/grt/grt-rtis.ads21
-rw-r--r--translate/grt/grt-rtis_addr.adb2
-rw-r--r--translate/trans_decls.ads9
-rw-r--r--translate/translation.adb135
9 files changed, 119 insertions, 73 deletions
diff --git a/translate/gcc/dist-common.sh b/translate/gcc/dist-common.sh
index 479d7ca..51d2893 100644
--- a/translate/gcc/dist-common.sh
+++ b/translate/gcc/dist-common.sh
@@ -204,6 +204,7 @@ grt-options.ads
grt-processes.adb
grt-processes.ads
grt-rtis.ads
+grt-rtis.adb
grt-rtis_addr.adb
grt-rtis_addr.ads
grt-rtis_utils.adb
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb
index 25bd385..0a9fe7a 100644
--- a/translate/ghdldrv/ghdlrun.adb
+++ b/translate/ghdldrv/ghdlrun.adb
@@ -455,10 +455,10 @@ package body Ghdlrun is
Def (Trans_Decls.Ghdl_Create_Delayed_Signal,
Grt.Signals.Ghdl_Create_Delayed_Signal'Address);
- Def (Trans_Decls.Ghdl_Rti_Top_Instance,
- Grt.Rtis.Ghdl_Rti_Top_Instance'Address);
- Def (Trans_Decls.Ghdl_Rti_Top_Ptr,
- Grt.Rtis.Ghdl_Rti_Top_Ptr'Address);
+ Def (Trans_Decls.Ghdl_Rti_Add_Package,
+ Grt.Rtis.Ghdl_Rti_Add_Package'Address);
+ Def (Trans_Decls.Ghdl_Rti_Add_Top,
+ Grt.Rtis.Ghdl_Rti_Add_Top'Address);
Def (Trans_Decls.Ghdl_Protected_Enter,
Grt.Processes.Ghdl_Protected_Enter'Address);
diff --git a/translate/grt/grt-avhpi.adb b/translate/grt/grt-avhpi.adb
index a5c36e5..a6565cf 100644
--- a/translate/grt/grt-avhpi.adb
+++ b/translate/grt/grt-avhpi.adb
@@ -31,7 +31,7 @@ package body Grt.Avhpi is
begin
Res := (Kind => VhpiIteratorK,
Ctxt => (Base => Null_Address,
- Block => To_Ghdl_Rti_Access (Ghdl_Rti_Top_Ptr)),
+ Block => To_Ghdl_Rti_Access (Ghdl_Rti_Top'Address)),
Rel => VhpiPackInsts,
It_Cur => 0,
It2 => 0,
diff --git a/translate/grt/grt-disp_rti.adb b/translate/grt/grt-disp_rti.adb
index d6f891a..cc3d5ff 100644
--- a/translate/grt/grt-disp_rti.adb
+++ b/translate/grt/grt-disp_rti.adb
@@ -999,14 +999,14 @@ package body Grt.Disp_Rti is
end if;
Put ("DISP_RTI.Disp_All: ");
- Disp_Kind (Ghdl_Rti_Top_Ptr.Common.Kind);
+ Disp_Kind (Ghdl_Rti_Top.Common.Kind);
New_Line;
Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
- Block => Ghdl_Rti_Top_Ptr.Parent);
- Disp_Rti_Arr (Ghdl_Rti_Top_Ptr.Nbr_Child,
- Ghdl_Rti_Top_Ptr.Children,
+ Block => Ghdl_Rti_Top.Parent);
+ Disp_Rti_Arr (Ghdl_Rti_Top.Nbr_Child,
+ Ghdl_Rti_Top.Children,
Ctxt, 0);
- Disp_Rti (Ghdl_Rti_Top_Ptr.Parent, Ctxt, 0);
+ Disp_Rti (Ghdl_Rti_Top.Parent, Ctxt, 0);
--Disp_Hierarchy;
end Disp_All;
diff --git a/translate/grt/grt-disp_tree.adb b/translate/grt/grt-disp_tree.adb
index 3f337ab..c72d67b 100644
--- a/translate/grt/grt-disp_tree.adb
+++ b/translate/grt/grt-disp_tree.adb
@@ -397,8 +397,8 @@ package body Grt.Disp_Tree is
New_Line;
Disp_Tree_Block (Parent, Ctxt, "");
- for I in 1 .. Ghdl_Rti_Top_Ptr.Nbr_Child loop
- Child := Ghdl_Rti_Top_Ptr.Children (I - 1);
+ for I in 1 .. Ghdl_Rti_Top.Nbr_Child loop
+ Child := Ghdl_Rti_Top.Children (I - 1);
Ctxt := (Base => Null_Address,
Block => Child);
Disp_Tree_Child (Child, Ctxt);
diff --git a/translate/grt/grt-rtis.ads b/translate/grt/grt-rtis.ads
index 564b397..6caba15 100644
--- a/translate/grt/grt-rtis.ads
+++ b/translate/grt/grt-rtis.ads
@@ -325,7 +325,14 @@ package Grt.Rtis is
(Source => Address, Target => Ghdl_Component_Link_Acc);
-- TOP rti.
- Ghdl_Rti_Top_Ptr : Ghdl_Rtin_Block_Acc;
+ Ghdl_Rti_Top : Ghdl_Rtin_Block :=
+ (Common => (Ghdl_Rtik_Top, 0, 0, 0),
+ Name => null,
+ Loc => (Rel => True, Off => 0),
+ Parent => null,
+ Size => 0,
+ Nbr_Child => 0,
+ Children => null);
-- Address of the top instance.
Ghdl_Rti_Top_Instance : Ghdl_Rti_Access;
@@ -341,7 +348,13 @@ package Grt.Rtis is
function To_Ghdl_Rti_Access is new Ada.Unchecked_Conversion
(Source => Address, Target => Ghdl_Rti_Access);
-private
- pragma Export (C, Ghdl_Rti_Top_Ptr, "__ghdl_rti_top_ptr");
- pragma Export (C, Ghdl_Rti_Top_Instance, "__ghdl_rti_top_instance");
+ procedure Ghdl_Rti_Add_Top (Max_Pkg : Ghdl_Index_Type;
+ Pkgs : Ghdl_Rti_Arr_Acc;
+ Top : Ghdl_Rti_Access;
+ Instance : Address);
+ pragma Export (C, Ghdl_Rti_Add_Top, "__ghdl_rti_add_top");
+
+ -- Register a package
+ procedure Ghdl_Rti_Add_Package (Pkg : Ghdl_Rti_Access);
+ pragma Export (C, Ghdl_Rti_Add_Package, "__ghdl_rti_add_package");
end Grt.Rtis;
diff --git a/translate/grt/grt-rtis_addr.adb b/translate/grt/grt-rtis_addr.adb
index 4488654..0c64d0c 100644
--- a/translate/grt/grt-rtis_addr.adb
+++ b/translate/grt/grt-rtis_addr.adb
@@ -265,7 +265,7 @@ package body Grt.Rtis_Addr is
Ctxt : Rti_Context;
begin
Ctxt := (Base => To_Address (Ghdl_Rti_Top_Instance),
- Block => Ghdl_Rti_Top_Ptr.Parent);
+ Block => Ghdl_Rti_Top.Parent);
return Ctxt;
end Get_Top_Context;
diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads
index 8a93fcf..eadba8b 100644
--- a/translate/trans_decls.ads
+++ b/translate/trans_decls.ads
@@ -170,11 +170,6 @@ package Trans_Decls is
Ghdl_Stack2_Mark : O_Dnode;
Ghdl_Stack2_Release : O_Dnode;
- -- RTI root.
- Ghdl_Rti_Top : O_Dnode;
- Ghdl_Rti_Top_Ptr : O_Dnode;
- Ghdl_Rti_Top_Instance : O_Dnode;
-
Std_Standard_Boolean_Rti : O_Dnode;
Std_Standard_Bit_Rti : O_Dnode;
@@ -228,5 +223,9 @@ package Trans_Decls is
-- For PSL.
Ghdl_Std_Ulogic_To_Boolean_Array : O_Dnode;
+ -- Register a package
+ Ghdl_Rti_Add_Package : O_Dnode;
+ Ghdl_Rti_Add_Top : O_Dnode;
+
Ghdl_Elaborate : O_Dnode;
end Trans_Decls;
diff --git a/translate/translation.adb b/translate/translation.adb
index 572e205..0f2835f 100644
--- a/translate/translation.adb
+++ b/translate/translation.adb
@@ -738,8 +738,9 @@ package body Translation is
procedure Generate_Library (Lib : Iir_Library_Declaration;
Public : Boolean);
- -- Generate RTI for the top of the hierarchy.
- procedure Generate_Top (Arch : Iir);
+ -- Generate RTI for the top of the hierarchy. Return the maximum number
+ -- of packages.
+ procedure Generate_Top (Nbr_Pkgs : out Natural);
-- Add two associations to ASSOC to add an rti_context for NODE.
procedure Associate_Rti_Context
@@ -5286,6 +5287,7 @@ package body Translation is
is
Info : Ortho_Info_Acc;
Final : Boolean;
+ Constr : O_Assoc_List;
pragma Unreferenced (Final);
begin
Info := Get_Info (Spec);
@@ -5294,6 +5296,15 @@ package body Translation is
Elab_Dependence (Get_Design_Unit (Spec));
+ -- Register the package. This is done dynamically, as we know only
+ -- during elaboration that the design depends on a package (a package
+ -- maybe referenced by an entity which is never map due to generate
+ -- statements).
+ Start_Association (Constr, Ghdl_Rti_Add_Package);
+ New_Association
+ (Constr, New_Lit (Rtis.New_Rti_Address (Info.Package_Rti_Const)));
+ New_Procedure_Call (Constr);
+
Open_Temp;
Chap4.Elab_Declaration_Chain (Spec, Final);
Close_Temp;
@@ -27611,20 +27622,18 @@ package body Translation is
end if;
end Generate_Unit;
- procedure Generate_Top (Arch : Iir)
+ procedure Generate_Top (Nbr_Pkgs : out Natural)
is
use Configuration;
Unit : Iir_Design_Unit;
- Lib_Unit : Iir;
Lib : Iir_Library_Declaration;
- Arr : O_Dnode;
- Res : O_Cnode;
- Aggr : O_Record_Aggr_List;
Prev : Rti_Block;
begin
Push_Rti_Node (Prev);
- Add_Rti_Node (Get_Info (Standard_Package).Package_Rti_Const);
+
+ -- Generate RTI for libraries, count number of packages.
+ Nbr_Pkgs := 1; -- At least std.standard.
for I in Design_Units.First .. Design_Units.Last loop
Unit := Design_Units.Table (I);
@@ -27632,31 +27641,13 @@ package body Translation is
Lib := Get_Library (Get_Design_File (Unit));
Generate_Library (Lib, True);
- Lib_Unit := Get_Library_Unit (Unit);
- case Get_Kind (Lib_Unit) is
- when Iir_Kind_Package_Declaration =>
- Add_Rti_Node (Get_Info (Lib_Unit).Package_Rti_Const);
- when others =>
- null;
- end case;
+ if Get_Kind (Get_Library_Unit (Unit))
+ = Iir_Kind_Package_Declaration
+ then
+ Nbr_Pkgs := Nbr_Pkgs + 1;
+ end if;
end loop;
- Arr := Generate_Rti_Array (Get_Identifier ("__ghdl_top_RTIARRAY"));
- New_Const_Decl (Ghdl_Rti_Top, Get_Identifier ("__ghdl_rti_top"),
- O_Storage_Public, Ghdl_Rtin_Block);
- Start_Const_Value (Ghdl_Rti_Top);
- Start_Record_Aggr (Aggr, Ghdl_Rtin_Block);
- New_Record_Aggr_El (Aggr, Generate_Common (Ghdl_Rtik_Top));
- New_Record_Aggr_El (Aggr, New_Null_Access (Char_Ptr_Type));
- New_Record_Aggr_El (Aggr, Get_Null_Loc);
- New_Record_Aggr_El
- (Aggr, New_Rti_Address (Get_Info (Arch).Block_Rti_Const));
- New_Record_Aggr_El (Aggr, Ghdl_Index_0);
- New_Record_Aggr_El
- (Aggr, New_Unsigned_Literal (Ghdl_Index_Type,
- Unsigned_64 (Cur_Block.Nbr)));
- New_Record_Aggr_El (Aggr, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc));
- Finish_Record_Aggr (Aggr, Res);
- Finish_Const_Value (Ghdl_Rti_Top, Res);
+
Pop_Rti_Node (Prev);
end Generate_Top;
@@ -29190,6 +29181,27 @@ package body Translation is
-- name : __ghdl_str_len_ptr);
Create_Get_Name ("__ghdl_get_instance_name", Ghdl_Get_Instance_Name);
end;
+
+ -- procedure __ghdl_rti_add_package (rti : ghdl_rti_access)
+ Start_Procedure_Decl
+ (Interfaces, Get_Identifier ("__ghdl_rti_add_package"),
+ O_Storage_External);
+ New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
+ Finish_Subprogram_Decl (Interfaces, Ghdl_Rti_Add_Package);
+
+ -- procedure __ghdl_rti_add_top (max_pkgs : ghdl_index_type;
+ -- pkgs : ghdl_rti_arr_acc);
+ Start_Procedure_Decl
+ (Interfaces, Get_Identifier ("__ghdl_rti_add_top"),
+ O_Storage_External);
+ New_Interface_Decl (Interfaces, Param, Get_Identifier ("max_pkgs"),
+ Ghdl_Index_Type);
+ New_Interface_Decl (Interfaces, Param, Get_Identifier ("pkgs"),
+ Rtis.Ghdl_Rti_Arr_Acc);
+ New_Interface_Decl (Interfaces, Param, Wki_Rti, Rtis.Ghdl_Rti_Access);
+ New_Interface_Decl
+ (Interfaces, Param, Wki_Instance, Ghdl_Ptr_Type);
+ Finish_Subprogram_Decl (Interfaces, Ghdl_Rti_Add_Top);
end Post_Initialize;
procedure Translate_Std_Type_Declaration (Decl : Iir)
@@ -29405,7 +29417,8 @@ package body Translation is
-- Create __ghdl_ELABORATE
procedure Gen_Main (Entity : Iir_Entity_Declaration;
Arch : Iir_Architecture_Declaration;
- Config_Subprg : O_Dnode)
+ Config_Subprg : O_Dnode;
+ Nbr_Pkgs : Natural)
is
Entity_Info : Block_Info_Acc;
Arch_Info : Block_Info_Acc;
@@ -29414,6 +29427,8 @@ package body Translation is
Instance : O_Dnode;
Arch_Instance : O_Dnode;
Mark : Id_Mark_Type;
+ Arr_Type : O_Tnode;
+ Arr : O_Dnode;
begin
Arch_Info := Get_Info (Arch);
Entity_Info := Get_Info (Entity);
@@ -29421,14 +29436,13 @@ package body Translation is
-- We need to create code.
Set_Global_Storage (O_Storage_Private);
- New_Var_Decl
- (Ghdl_Rti_Top_Instance, Get_Identifier ("__ghdl_rti_top_instance"),
- O_Storage_External, Ghdl_Ptr_Type);
-
- New_Var_Decl (Ghdl_Rti_Top_Ptr,
- Get_Identifier ("__ghdl_rti_top_ptr"),
- O_Storage_External, Ghdl_Ptr_Type);
-
+ -- Create the array of packages (as a variable, dynamically
+ -- initialized).
+ Arr_Type := New_Constrained_Array_Type
+ (Rtis.Ghdl_Rti_Array,
+ New_Unsigned_Literal (Ghdl_Index_Type, Unsigned_64 (Nbr_Pkgs)));
+ New_Var_Decl (Arr, Get_Identifier ("__ghdl_top_RTIARRAY"),
+ O_Storage_Private, Arr_Type);
-- Declare (but do not define):
-- Variable for the hierarchy top instance.
@@ -29470,13 +29484,28 @@ package body Translation is
-- Set top instances and RTI.
-- Do it before the elaboration code, since it may be used to
-- diagnose errors.
- New_Assign_Stmt (New_Obj (Ghdl_Rti_Top_Instance),
- New_Convert_Ov (New_Obj_Value (Arch_Instance),
- Ghdl_Ptr_Type));
+ -- Call ghdl_rti_add_top
+ Start_Association (Assoc, Ghdl_Rti_Add_Top);
+ New_Association
+ (Assoc, New_Lit (New_Unsigned_Literal (Ghdl_Index_Type,
+ Unsigned_64 (Nbr_Pkgs))));
+ New_Association
+ (Assoc, New_Lit (New_Global_Address (Arr, Rtis.Ghdl_Rti_Arr_Acc)));
+ New_Association
+ (Assoc,
+ New_Lit (Rtis.New_Rti_Address (Get_Info (Arch).Block_Rti_Const)));
+ New_Association
+ (Assoc, New_Convert_Ov (New_Obj_Value (Arch_Instance),
+ Ghdl_Ptr_Type));
+ New_Procedure_Call (Assoc);
- New_Assign_Stmt (New_Obj (Ghdl_Rti_Top_Ptr),
- New_Unchecked_Address (New_Obj (Ghdl_Rti_Top),
- Ghdl_Ptr_Type));
+ -- Add std.standard rti
+ Start_Association (Assoc, Ghdl_Rti_Add_Package);
+ New_Association
+ (Assoc,
+ New_Lit (Rtis.New_Rti_Address
+ (Get_Info (Standard_Package).Package_Rti_Const)));
+ New_Procedure_Call (Assoc);
Gen_Filename (Get_Design_File (Get_Design_Unit (Entity)));
@@ -29886,6 +29915,7 @@ package body Translation is
Arch : Iir_Architecture_Declaration;
Conf_Info : Config_Info_Acc;
Last_Design_Unit : Natural;
+ Nbr_Pkgs : Natural;
begin
Primary_Id := Get_Identifier (Primary);
if Secondary /= "" then
@@ -29980,6 +30010,11 @@ package body Translation is
end loop;
-- Generate code to elaboration body-less package.
+ --
+ -- When a package is analyzed, we don't know wether there is body
+ -- or not. Therefore, we assume there is always a body, and will
+ -- elaborate the body (which elaborates its spec). If a package
+ -- has no body, create the body elaboration procedure.
for I in Design_Units.First .. Design_Units.Last loop
Unit := Design_Units.Table (I);
Lib_Unit := Get_Library_Unit (Unit);
@@ -29999,13 +30034,11 @@ package body Translation is
end case;
end loop;
- if Flag_Rti then
- Rtis.Generate_Top (Arch);
- end if;
+ Rtis.Generate_Top (Nbr_Pkgs);
-- Create main code.
Conf_Info := Get_Info (Config_Lib);
- Gen_Main (Entity, Arch, Conf_Info.Config_Subprg);
+ Gen_Main (Entity, Arch, Conf_Info.Config_Subprg, Nbr_Pkgs);
Gen_Setup_Info;
generated by cgit (git 2.34.1) at 2024-12-21 16:17:40 +0000