aboutsummaryrefslogtreecommitdiffstats
path: root/src/vhdl/translate/trans-rtis.adb
diff options
context:
space:
mode:
Diffstat (limited to 'src/vhdl/translate/trans-rtis.adb')
-rw-r--r--src/vhdl/translate/trans-rtis.adb275
1 files changed, 193 insertions, 82 deletions
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 6fd7c25c2..ed483fe17 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -34,7 +34,6 @@ package body Trans.Rtis is
Ghdl_Rtin_Block_Loc : O_Fnode;
Ghdl_Rtin_Block_Linecol : O_Fnode;
Ghdl_Rtin_Block_Parent : O_Fnode;
- Ghdl_Rtin_Block_Size : O_Fnode;
Ghdl_Rtin_Block_Nbr_Child : O_Fnode;
Ghdl_Rtin_Block_Children : O_Fnode;
@@ -43,6 +42,16 @@ package body Trans.Rtis is
Ghdl_Rtin_Block_File_Block : O_Fnode;
Ghdl_Rtin_Block_File_Filename : O_Fnode;
+ -- For generate statement.
+ Ghdl_Rtin_Generate : O_Tnode;
+ Ghdl_Rtin_Generate_Common : O_Fnode;
+ Ghdl_Rtin_Generate_Name : O_Fnode;
+ Ghdl_Rtin_Generate_Loc : O_Fnode;
+ Ghdl_Rtin_Generate_Linecol : O_Fnode;
+ Ghdl_Rtin_Generate_Parent : O_Fnode;
+ Ghdl_Rtin_Generate_Size : O_Fnode;
+ Ghdl_Rtin_Generate_Child : O_Fnode;
+
-- Node for scalar type decls.
Ghdl_Rtin_Type_Scalar : O_Tnode;
Ghdl_Rtin_Type_Scalar_Common : O_Fnode;
@@ -184,6 +193,9 @@ package body Trans.Rtis is
(Constr, Get_Identifier ("__ghdl_rtik_for_generate"),
Ghdl_Rtik_For_Generate);
New_Enum_Literal
+ (Constr, Get_Identifier ("__ghdl_rtik_generate_body"),
+ Ghdl_Rtik_Generate_Body);
+ New_Enum_Literal
(Constr, Get_Identifier ("__ghdl_rtik_instance"),
Ghdl_Rtik_Instance);
@@ -390,8 +402,6 @@ package body Trans.Rtis is
Get_Identifier ("linecol"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Parent,
Wki_Parent, Ghdl_Rti_Access);
- New_Record_Field (Constr, Ghdl_Rtin_Block_Size,
- Get_Identifier ("size"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Nbr_Child,
Get_Identifier ("nbr_child"), Ghdl_Index_Type);
New_Record_Field (Constr, Ghdl_Rtin_Block_Children,
@@ -401,6 +411,30 @@ package body Trans.Rtis is
Ghdl_Rtin_Block);
end;
+ -- Create type ghdl_rtin_generate
+ declare
+ Constr : O_Element_List;
+ begin
+ Start_Record_Type (Constr);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Common,
+ Get_Identifier ("common"), Ghdl_Rti_Common);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Name,
+ Get_Identifier ("name"), Char_Ptr_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Loc,
+ Get_Identifier ("loc"), Ghdl_Ptr_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Linecol,
+ Get_Identifier ("linecol"), Ghdl_Index_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Parent,
+ Wki_Parent, Ghdl_Rti_Access);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Size,
+ Get_Identifier ("size"), Ghdl_Index_Type);
+ New_Record_Field (Constr, Ghdl_Rtin_Generate_Child,
+ Get_Identifier ("child"), Ghdl_Rti_Access);
+ Finish_Record_Type (Constr, Ghdl_Rtin_Generate);
+ New_Type_Decl (Get_Identifier ("__ghdl_rtin_generate"),
+ Ghdl_Rtin_Generate);
+ end;
+
-- Create type ghdl_rtin_block_file
declare
Constr : O_Element_List;
@@ -1876,6 +1910,7 @@ package body Trans.Rtis is
end Generate_Object;
procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode);
+ procedure Generate_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode);
procedure Generate_Declaration_Chain (Chain : Iir);
procedure Generate_Component_Declaration (Comp : Iir)
@@ -2164,12 +2199,36 @@ package body Trans.Rtis is
case Get_Kind (Stmt) is
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement
- | Iir_Kind_Block_Statement
- | Iir_Kind_If_Generate_Statement
- | Iir_Kind_For_Generate_Statement =>
+ | Iir_Kind_Block_Statement =>
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Generate_Block (Stmt, Parent_Rti);
Pop_Identifier_Prefix (Mark);
+ when Iir_Kind_If_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+ Generate_Generate_Statement (Stmt, Parent_Rti);
+ Pop_Identifier_Prefix (Mark);
+ when Iir_Kind_For_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
+ -- Create the RTI for the iterator type, in the parent of the
+ -- generate statement.
+ declare
+ Param : constant Iir := Get_Parameter_Specification (Stmt);
+ Iter_Type : constant Iir := Get_Type (Param);
+ Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type);
+ Mark : Id_Mark_Type;
+ Iter_Rti : O_Dnode;
+ begin
+ if Type_Info.Type_Rti = O_Dnode_Null then
+ Push_Identifier_Prefix (Mark, "ITERATOR");
+ Iter_Rti := Generate_Type_Definition (Iter_Type);
+ -- The RTIs for the parent are being defined, so append
+ -- to the parent.
+ Add_Rti_Node (Iter_Rti);
+ Pop_Identifier_Prefix (Mark);
+ end if;
+ end;
+ Generate_Generate_Statement (Stmt, Parent_Rti);
+ Pop_Identifier_Prefix (Mark);
when Iir_Kind_Component_Instantiation_Statement =>
Push_Identifier_Prefix (Mark, Get_Identifier (Stmt));
Generate_Instance (Stmt, Parent_Rti);
@@ -2189,8 +2248,110 @@ package body Trans.Rtis is
end loop;
end Generate_Concurrent_Statement_Chain;
+ procedure Generate_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode)
+ is
+ Info : constant Ortho_Info_Acc := Get_Info (Blk);
+ Bod : constant Iir := Get_Generate_Statement_Body (Blk);
+ Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+
+ Child : Iir;
+ Child_Rti : O_Cnode;
+ Name : O_Dnode;
+ List : O_Record_Aggr_List;
+
+ Rti : O_Dnode;
+
+ Kind : O_Cnode;
+ Size : O_Cnode;
+
+ Prev : Rti_Block;
+
+ Field_Off : O_Cnode;
+ Res : O_Cnode;
+
+ Mark : Id_Mark_Type;
+ begin
+ New_Const_Decl (Rti, Create_Identifier ("RTI"),
+ O_Storage_Public, Ghdl_Rtin_Generate);
+ Push_Rti_Node (Prev);
+
+ Field_Off := New_Offsetof
+ (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
+ Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
+
+ case Get_Kind (Blk) is
+ when Iir_Kind_If_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, "BOD");
+ Generate_Block (Bod, Rti);
+ Pop_Identifier_Prefix (Mark);
+ Kind := Ghdl_Rtik_If_Generate;
+ Size := Ghdl_Index_0;
+ if Get_Generate_Else_Clause (Blk) = Null_Iir then
+ Child := Bod;
+ else
+ Child := Null_Iir;
+ end if;
+ when Iir_Kind_For_Generate_Statement =>
+ Push_Identifier_Prefix (Mark, "BOD");
+ Generate_Block (Bod, Rti);
+ Pop_Identifier_Prefix (Mark);
+ Kind := Ghdl_Rtik_For_Generate;
+ Size := New_Sizeof (Get_Scope_Type (Bod_Info.Block_Scope),
+ Ghdl_Index_Type);
+ Child := Bod;
+ when others =>
+ Error_Kind ("rti.generate_generate", Blk);
+ end case;
+
+ Name := Generate_Name (Blk);
+
+ Start_Const_Value (Rti);
+
+ Start_Record_Aggr (List, Ghdl_Rtin_Generate);
+ New_Record_Aggr_El (List, Generate_Common (Kind));
+ New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+
+ -- Field Loc: offset in the instance of the entity.
+ New_Record_Aggr_El (List, Field_Off);
+
+ New_Record_Aggr_El (List, Generate_Linecol (Blk));
+
+ -- Field Parent: RTI of the parent.
+ New_Record_Aggr_El (List, New_Rti_Address (Parent_Rti));
+
+ -- Field Size: size of the instance.
+ -- For for-generate: size of instance, which gives the stride in the
+ -- sub-blocks array.
+ New_Record_Aggr_El (List, Size);
+
+ -- Child.
+ if Child = Null_Iir then
+ Child_Rti := New_Null_Access (Ghdl_Rti_Access);
+ else
+ Child_Rti := Get_Context_Rti (Child);
+ end if;
+ New_Record_Aggr_El (List, Child_Rti);
+
+ Finish_Record_Aggr (List, Res);
+
+ Finish_Const_Value (Rti, Res);
+
+ Pop_Rti_Node (Prev);
+
+ -- Put the result in the parent list.
+ Add_Rti_Node (Rti);
+
+ -- Store the RTI.
+ if False then
+ -- TODO: there is no info for if_generate/for_generate.
+ -- Not sure we need to store it (except maybe for 'path_name ?)
+ Info.Block_Rti_Const := Rti;
+ end if;
+ end Generate_Generate_Statement;
+
procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode)
is
+ Info : constant Ortho_Info_Acc := Get_Info (Blk);
Name : O_Dnode;
Arr : O_Dnode;
List : O_Record_Aggr_List;
@@ -2203,31 +2364,9 @@ package body Trans.Rtis is
Res : O_Cnode;
Prev : Rti_Block;
- Info : Ortho_Info_Acc;
Field_Off : O_Cnode;
- Inst : O_Tnode;
begin
- -- The type of a generator iterator is elaborated in the parent.
- if Get_Kind (Blk) = Iir_Kind_For_Generate_Statement then
- declare
- Param : constant Iir := Get_Parameter_Specification (Blk);
- Iter_Type : constant Iir := Get_Type (Param);
- Type_Info : constant Type_Info_Acc := Get_Info (Iter_Type);
- Mark : Id_Mark_Type;
- Iter_Rti : O_Dnode;
- begin
- if Type_Info.Type_Rti = O_Dnode_Null then
- Push_Identifier_Prefix (Mark, "ITERATOR");
- Iter_Rti := Generate_Type_Definition (Iter_Type);
- -- The RTIs for the parent are being defined, so append to the
- -- parent.
- Add_Rti_Node (Iter_Rti);
- Pop_Identifier_Prefix (Mark);
- end if;
- end;
- end if;
-
if Get_Kind (Get_Parent (Blk)) = Iir_Kind_Design_Unit then
-- Also include filename for units.
Rti_Type := Ghdl_Rtin_Block_File;
@@ -2240,8 +2379,6 @@ package body Trans.Rtis is
Push_Rti_Node (Prev);
Field_Off := O_Cnode_Null;
- Inst := O_Tnode_Null;
- Info := Get_Info (Blk);
case Get_Kind (Blk) is
when Iir_Kind_Package_Declaration =>
Kind := Ghdl_Rtik_Package;
@@ -2255,7 +2392,6 @@ package body Trans.Rtis is
Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
Generate_Concurrent_Statement_Chain
(Get_Concurrent_Statement_Chain (Blk), Rti);
- Inst := Get_Scope_Type (Info.Block_Scope);
Field_Off := New_Offsetof
(Get_Scope_Type (Info.Block_Scope),
Info.Block_Parent_Field, Ghdl_Ptr_Type);
@@ -2266,14 +2402,12 @@ package body Trans.Rtis is
Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
Generate_Concurrent_Statement_Chain
(Get_Concurrent_Statement_Chain (Blk), Rti);
- Inst := Get_Scope_Type (Info.Block_Scope);
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Kind := Ghdl_Rtik_Process;
Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
Field_Off :=
Get_Scope_Offset (Info.Process_Scope, Ghdl_Ptr_Type);
- Inst := Get_Scope_Type (Info.Process_Scope);
when Iir_Kind_Block_Statement =>
Kind := Ghdl_Rtik_Block;
declare
@@ -2295,38 +2429,24 @@ package body Trans.Rtis is
Generate_Concurrent_Statement_Chain
(Get_Concurrent_Statement_Chain (Blk), Rti);
Field_Off := Get_Scope_Offset (Info.Block_Scope, Ghdl_Ptr_Type);
- Inst := Get_Scope_Type (Info.Block_Scope);
- when Iir_Kind_If_Generate_Statement =>
- Kind := Ghdl_Rtik_If_Generate;
+ when Iir_Kind_Generate_Statement_Body =>
+ Kind := Ghdl_Rtik_Generate_Body;
+ -- Also includes iterator of for_generate_statement.
declare
- Bod : constant Iir := Get_Generate_Statement_Body (Blk);
- Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
+ Parent : constant Iir := Get_Parent (Blk);
+ Param_Rti : O_Dnode;
begin
- Generate_Declaration_Chain (Get_Declaration_Chain (Bod));
- Generate_Concurrent_Statement_Chain
- (Get_Concurrent_Statement_Chain (Bod), Rti);
- Field_Off := New_Offsetof
- (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
- Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
- end;
- when Iir_Kind_For_Generate_Statement =>
- Kind := Ghdl_Rtik_For_Generate;
- declare
- Bod : constant Iir := Get_Generate_Statement_Body (Blk);
- Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
- Param : constant Iir := Get_Parameter_Specification (Blk);
- Param_Rti : O_Dnode := O_Dnode_Null;
- begin
- Generate_Object (Param, Param_Rti);
- Add_Rti_Node (Param_Rti);
- Generate_Declaration_Chain (Get_Declaration_Chain (Bod));
- Generate_Concurrent_Statement_Chain
- (Get_Concurrent_Statement_Chain (Bod), Rti);
- Inst := Get_Scope_Type (Bod_Info.Block_Scope);
- Field_Off := New_Offsetof
- (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope),
- Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type);
+ if Get_Kind (Parent) = Iir_Kind_For_Generate_Statement then
+ -- Must be set to null, as this isn't a completion.
+ Param_Rti := O_Dnode_Null;
+ Generate_Object
+ (Get_Parameter_Specification (Parent), Param_Rti);
+ Add_Rti_Node (Param_Rti);
+ end if;
end;
+ Generate_Declaration_Chain (Get_Declaration_Chain (Blk));
+ Generate_Concurrent_Statement_Chain
+ (Get_Concurrent_Statement_Chain (Blk), Rti);
when others =>
Error_Kind ("rti.generate_block", Blk);
end case;
@@ -2344,25 +2464,24 @@ package body Trans.Rtis is
Start_Record_Aggr (List, Ghdl_Rtin_Block);
New_Record_Aggr_El (List, Generate_Common (Kind));
New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type));
+
+ -- Field Loc: offset in the instance of the entity.
if Field_Off = O_Cnode_Null then
Field_Off := Get_Null_Loc;
end if;
New_Record_Aggr_El (List, Field_Off);
+
New_Record_Aggr_El (List, Generate_Linecol (Blk));
+
+ -- Field Parent: RTI of the parent.
if Parent_Rti = O_Dnode_Null then
Res := New_Null_Access (Ghdl_Rti_Access);
else
Res := New_Rti_Address (Parent_Rti);
end if;
New_Record_Aggr_El (List, Res);
- if Inst = O_Tnode_Null then
- Res := Ghdl_Index_0;
- else
- -- For for-generate: size of instance, which gives the stride in the
- -- sub-blocks array.
- Res := New_Sizeof (Inst, Ghdl_Index_Type);
- end if;
- New_Record_Aggr_El (List, Res);
+
+ -- Fields Nbr_Child and Children.
New_Record_Aggr_El
(List, New_Unsigned_Literal (Ghdl_Index_Type,
Unsigned_64 (Cur_Block.Nbr)));
@@ -2381,11 +2500,10 @@ package body Trans.Rtis is
Pop_Rti_Node (Prev);
- -- Put children in the parent list.
+ -- Put result in the parent list.
case Get_Kind (Blk) is
when Iir_Kind_Block_Statement
- | Iir_Kind_For_Generate_Statement
- | Iir_Kind_If_Generate_Statement
+ | Iir_Kind_Generate_Statement_Body
| Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Add_Rti_Node (Rti);
@@ -2397,16 +2515,9 @@ package body Trans.Rtis is
case Get_Kind (Blk) is
when Iir_Kind_Entity_Declaration
| Iir_Kind_Architecture_Body
- | Iir_Kind_Block_Statement =>
+ | Iir_Kind_Block_Statement
+ | Iir_Kind_Generate_Statement_Body =>
Info.Block_Rti_Const := Rti;
- when Iir_Kind_If_Generate_Statement
- | Iir_Kind_For_Generate_Statement =>
- declare
- Bod : constant Iir := Get_Generate_Statement_Body (Blk);
- Bod_Info : constant Block_Info_Acc := Get_Info (Bod);
- begin
- Bod_Info.Block_Rti_Const := Rti;
- end;
when Iir_Kind_Process_Statement
| Iir_Kind_Sensitized_Process_Statement =>
Info.Process_Rti_Const := Rti;