diff options
author | Tristan Gingold | 2015-01-07 08:07:42 +0100 |
---|---|---|
committer | Tristan Gingold | 2015-01-07 08:07:42 +0100 |
commit | 99443212bf78a5d36b693abab225a160a92d097a (patch) | |
tree | 9191d2419b376bd45737e3b23e9b95967c017560 /src/vhdl/translate | |
parent | 3aaf2679a61b4d8bd61c7cccd5ca0ec1f1606de5 (diff) | |
download | ghdl-99443212bf78a5d36b693abab225a160a92d097a.tar.gz ghdl-99443212bf78a5d36b693abab225a160a92d097a.tar.bz2 ghdl-99443212bf78a5d36b693abab225a160a92d097a.zip |
Handle vhdl08 if generate statements
Diffstat (limited to 'src/vhdl/translate')
-rw-r--r-- | src/vhdl/translate/trans-chap1.adb | 40 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap9.adb | 426 | ||||
-rw-r--r-- | src/vhdl/translate/trans-rtis.adb | 488 | ||||
-rw-r--r-- | src/vhdl/translate/trans.ads | 23 |
4 files changed, 596 insertions, 381 deletions
diff --git a/src/vhdl/translate/trans-chap1.adb b/src/vhdl/translate/trans-chap1.adb index ae2b106..1f0e7d3 100644 --- a/src/vhdl/translate/trans-chap1.adb +++ b/src/vhdl/translate/trans-chap1.adb @@ -727,31 +727,39 @@ package body Trans.Chap1 is Parent_Info : Block_Info_Acc) is Spec : constant Iir := Get_Block_Specification (Block_Config); - Block : constant Iir := Get_Block_From_Block_Specification (Spec); - Info : constant Block_Info_Acc := Get_Info (Block); + Bod : constant Iir := Get_Block_From_Block_Specification (Spec); + Gen : constant Iir := Get_Parent (Bod); + Gen_Info : constant Generate_Info_Acc := Get_Info (Gen); + Bod_Info : constant Block_Info_Acc := Get_Info (Bod); Var : O_Dnode; If_Blk : O_If_Block; begin - -- Configure the block only if it was created. - Open_Temp; - Var := Create_Temp_Init - (Info.Block_Decls_Ptr_Type, - New_Value (New_Selected_Element - (Get_Instance_Ref (Parent_Info.Block_Scope), - Info.Block_Parent_Field))); + -- Configure the block only if block id matches. Start_If_Stmt (If_Blk, New_Compare_Op - (ON_Neq, - New_Obj_Value (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)), + (ON_Eq, + New_Value (New_Selected_Element + (Get_Instance_Ref (Parent_Info.Block_Scope), + Gen_Info.Generate_Body_Id)), + New_Lit (New_Index_Lit (Unsigned_64 (Bod_Info.Block_Id))), Ghdl_Bool_Type)); - Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Translate_Block_Configuration_Calls (Block_Config, Block, Info); - Clear_Scope (Info.Block_Scope); - Finish_If_Stmt (If_Blk); + + Open_Temp; + Var := Create_Temp_Init + (Bod_Info.Block_Decls_Ptr_Type, + New_Convert_Ov + (New_Value (New_Selected_Element + (Get_Instance_Ref (Parent_Info.Block_Scope), + Gen_Info.Generate_Parent_Field)), + Bod_Info.Block_Decls_Ptr_Type)); + Set_Scope_Via_Param_Ptr (Bod_Info.Block_Scope, Var); + Translate_Block_Configuration_Calls (Block_Config, Bod, Bod_Info); + Clear_Scope (Bod_Info.Block_Scope); Close_Temp; + + Finish_If_Stmt (If_Blk); end Translate_If_Generate_Block_Configuration_Calls; procedure Translate_Block_Configuration_Calls diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb index 192c8ee..b62b12f 100644 --- a/src/vhdl/translate/trans-chap9.adb +++ b/src/vhdl/translate/trans-chap9.adb @@ -633,6 +633,149 @@ package body Trans.Chap9 is end case; end Translate_Psl_Directive_Statement; + procedure Translate_If_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Clause : Iir; + Bod : Iir; + Info : Block_Info_Acc; + Stmt_Info : Ortho_Info_Acc; + Mark : Id_Mark_Type; + Mark2 : Id_Mark_Type; + Num : Int32; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Stmt_Info := Add_Info (Stmt, Kind_Generate); + Stmt_Info.Generate_Parent_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Stmt), Ghdl_Ptr_Type); + Stmt_Info.Generate_Body_Id := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Get_Identifier (Stmt), "_ID"), + Ghdl_Index_Type); + + -- Translate generate statement body. + Num := 0; + Clause := Stmt; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Info := Add_Info (Bod, Kind_Block); + + Push_Identifier_Prefix (Mark2, Get_Alternative_Label (Bod)); + + Chap1.Start_Block_Decl (Bod); + Push_Instance_Factory (Info.Block_Scope'Access); + + -- Add a parent field in the current instance. + Info.Block_Origin_Field := Add_Instance_Factory_Field + (Get_Identifier ("ORIGIN"), + Get_Info (Origin).Block_Decls_Ptr_Type); + + Info.Block_Id := Num; + + Chap9.Translate_Block_Declarations (Bod, Bod); + + Pop_Instance_Factory (Info.Block_Scope'Access); + + Pop_Identifier_Prefix (Mark2); + Clause := Get_Generate_Else_Clause (Clause); + Num := Num + 1; + end loop; + + Pop_Identifier_Prefix (Mark); + end Translate_If_Generate_Statement; + + procedure Translate_For_Generate_Statement (Stmt : Iir; Origin : Iir) + is + Bod : constant Iir := Get_Generate_Statement_Body (Stmt); + Param : constant Iir := Get_Parameter_Specification (Stmt); + Iter_Type : constant Iir := Get_Type (Param); + Info : Block_Info_Acc; + Mark : Id_Mark_Type; + It_Info : Ortho_Info_Acc; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Chap3.Translate_Object_Subtype (Param, True); + + Info := Add_Info (Bod, Kind_Block); + Chap1.Start_Block_Decl (Bod); + Push_Instance_Factory (Info.Block_Scope'Access); + + -- Add a parent field in the current instance. This is + -- the first field (known by GRT). + Info.Block_Origin_Field := Add_Instance_Factory_Field + (Get_Identifier ("ORIGIN"), + Get_Info (Origin).Block_Decls_Ptr_Type); + + -- Flag (if block was configured). + Info.Block_Configured_Field := Add_Instance_Factory_Field + (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type); + + -- Iterator. + It_Info := Add_Info (Param, Kind_Iterator); + It_Info.Iterator_Var := Create_Var + (Create_Var_Identifier (Param), + Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type (Mode_Value)); + + Chap9.Translate_Block_Declarations (Bod, Bod); + + Pop_Instance_Factory (Info.Block_Scope'Access); + + -- Create array type of block_decls_type + Info.Block_Decls_Array_Type := New_Array_Type + (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type); + New_Type_Decl (Create_Identifier ("INSTARRTYPE"), + Info.Block_Decls_Array_Type); + -- Create access to the array type. + Info.Block_Decls_Array_Ptr_Type := New_Access_Type + (Info.Block_Decls_Array_Type); + New_Type_Decl (Create_Identifier ("INSTARRPTR"), + Info.Block_Decls_Array_Ptr_Type); + + -- Add a field in the parent instance (Pop_Instance_Factory + -- has already been called). This is a pointer INSTARRPTR + -- to an array INSTARRTYPE of instace. The size of each + -- element is stored in the RTI. + Info.Block_Parent_Field := Add_Instance_Factory_Field + (Create_Identifier_Without_Prefix (Stmt), + Info.Block_Decls_Array_Ptr_Type); + + Pop_Identifier_Prefix (Mark); + end Translate_For_Generate_Statement; + + procedure Translate_Block_Statement (Stmt : Iir; Origin : Iir) + is + Hdr : constant Iir_Block_Header := Get_Block_Header (Stmt); + Guard : constant Iir := Get_Guard_Decl (Stmt); + Info : Block_Info_Acc; + Mark : Id_Mark_Type; + begin + Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); + + Info := Add_Info (Stmt, Kind_Block); + Chap1.Start_Block_Decl (Stmt); + Push_Instance_Factory (Info.Block_Scope'Access); + + -- Implicit guard signal. + if Guard /= Null_Iir then + Chap4.Translate_Declaration (Guard); + end if; + + -- generics, ports. + if Hdr /= Null_Iir then + Chap4.Translate_Generic_Chain (Hdr); + Chap4.Translate_Port_Chain (Hdr); + end if; + + Chap9.Translate_Block_Declarations (Stmt, Origin); + + Pop_Instance_Factory (Info.Block_Scope'Access); + Pop_Identifier_Prefix (Mark); + + -- Create a field in the parent record. + Add_Scope_Field (Create_Identifier_Without_Prefix (Stmt), + Info.Block_Scope); + end Translate_Block_Statement; + -- Create the instance for block BLOCK. -- ORIGIN can be either an entity, an architecture or a block statement. procedure Translate_Block_Declarations (Block : Iir; Origin : Iir) @@ -657,128 +800,11 @@ package body Trans.Chap9 is when Iir_Kind_Component_Instantiation_Statement => Translate_Component_Instantiation_Statement (El); when Iir_Kind_Block_Statement => - declare - Info : Block_Info_Acc; - Hdr : Iir_Block_Header; - Guard : Iir; - Mark : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - - Info := Add_Info (El, Kind_Block); - Chap1.Start_Block_Decl (El); - Push_Instance_Factory (Info.Block_Scope'Access); - - Guard := Get_Guard_Decl (El); - if Guard /= Null_Iir then - Chap4.Translate_Declaration (Guard); - end if; - - -- generics, ports. - Hdr := Get_Block_Header (El); - if Hdr /= Null_Iir then - Chap4.Translate_Generic_Chain (Hdr); - Chap4.Translate_Port_Chain (Hdr); - end if; - - Chap9.Translate_Block_Declarations (El, Origin); - - Pop_Instance_Factory (Info.Block_Scope'Access); - Pop_Identifier_Prefix (Mark); - - -- Create a field in the parent record. - Add_Scope_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Scope); - end; + Translate_Block_Statement (El, Origin); when Iir_Kind_For_Generate_Statement => - declare - Bod : constant Iir := Get_Generate_Statement_Body (El); - Param : constant Iir := Get_Parameter_Specification (El); - Info : Block_Info_Acc; - Mark : Id_Mark_Type; - Iter_Type : constant Iir := Get_Type (Param); - It_Info : Ortho_Info_Acc; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - - Chap3.Translate_Object_Subtype (Param, True); - - Info := Add_Info (Bod, Kind_Block); - Chap1.Start_Block_Decl (Bod); - Push_Instance_Factory (Info.Block_Scope'Access); - - -- Add a parent field in the current instance. This is - -- the first field (known by GRT). - Info.Block_Origin_Field := Add_Instance_Factory_Field - (Get_Identifier ("ORIGIN"), - Get_Info (Origin).Block_Decls_Ptr_Type); - - -- Flag (if block was configured). - Info.Block_Configured_Field := - Add_Instance_Factory_Field - (Get_Identifier ("CONFIGURED"), Ghdl_Bool_Type); - - -- Iterator. - It_Info := Add_Info (Param, Kind_Iterator); - It_Info.Iterator_Var := Create_Var - (Create_Var_Identifier (Param), - Get_Info (Get_Base_Type (Iter_Type)).Ortho_Type - (Mode_Value)); - - Chap9.Translate_Block_Declarations (Bod, Bod); - - Pop_Instance_Factory (Info.Block_Scope'Access); - - -- Create array type of block_decls_type - Info.Block_Decls_Array_Type := New_Array_Type - (Get_Scope_Type (Info.Block_Scope), Ghdl_Index_Type); - New_Type_Decl (Create_Identifier ("INSTARRTYPE"), - Info.Block_Decls_Array_Type); - -- Create access to the array type. - Info.Block_Decls_Array_Ptr_Type := New_Access_Type - (Info.Block_Decls_Array_Type); - New_Type_Decl (Create_Identifier ("INSTARRPTR"), - Info.Block_Decls_Array_Ptr_Type); - - -- Add a field in the parent instance (Pop_Instance_Factory - -- has already been called). This is a pointer INSTARRPTR - -- to an array INSTARRTYPE of instace. The size of each - -- element is stored in the RTI. - Info.Block_Parent_Field := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Decls_Array_Ptr_Type); - - Pop_Identifier_Prefix (Mark); - end; + Translate_For_Generate_Statement (El, Origin); when Iir_Kind_If_Generate_Statement => - declare - Bod : constant Iir := Get_Generate_Statement_Body (El); - Info : Block_Info_Acc; - Mark : Id_Mark_Type; - begin - Push_Identifier_Prefix (Mark, Get_Identifier (El)); - - Info := Add_Info (Bod, Kind_Block); - Chap1.Start_Block_Decl (Bod); - Push_Instance_Factory (Info.Block_Scope'Access); - - -- Add a parent field in the current instance. - Info.Block_Origin_Field := Add_Instance_Factory_Field - (Get_Identifier ("ORIGIN"), - Get_Info (Origin).Block_Decls_Ptr_Type); - - Chap9.Translate_Block_Declarations (Bod, Bod); - - Pop_Instance_Factory (Info.Block_Scope'Access); - - -- Create an access field in the parent record. - Info.Block_Parent_Field := Add_Instance_Factory_Field - (Create_Identifier_Without_Prefix (El), - Info.Block_Decls_Ptr_Type); - - Pop_Identifier_Prefix (Mark); - end; + Translate_If_Generate_Statement (El, Origin); when others => Error_Kind ("translate_block_declarations", El); end case; @@ -863,6 +889,24 @@ package body Trans.Chap9 is Finish_Subprogram_Body; end Translate_Component_Instantiation_Subprogram; + procedure Translate_Generate_Statement_Body_Subprograms + (Bod : Iir; Base_Info : Block_Info_Acc) + is + Info : constant Block_Info_Acc := Get_Info (Bod); + Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + begin + Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access, + Info.Block_Decls_Ptr_Type, + Wki_Instance, + Prev_Subprg_Instance); + Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, + Info.Block_Origin_Field, + Info.Block_Scope'Access); + Translate_Block_Subprograms (Bod, Bod); + Clear_Scope (Base_Info.Block_Scope); + Subprgs.Pop_Subprg_Instance (Wki_Instance, Prev_Subprg_Instance); + end Translate_Generate_Statement_Body_Subprograms; + -- Translate concurrent statements into subprograms. procedure Translate_Block_Subprograms (Block : Iir; Base_Block : Iir) is @@ -916,24 +960,25 @@ package body Trans.Chap9 is end if; Translate_Block_Subprograms (Stmt, Base_Block); end; - when Iir_Kind_For_Generate_Statement - | Iir_Kind_If_Generate_Statement => + when Iir_Kind_For_Generate_Statement => + Translate_Generate_Statement_Body_Subprograms + (Get_Generate_Statement_Body (Stmt), Base_Info); + when Iir_Kind_If_Generate_Statement => declare - Bod : constant Iir := Get_Generate_Statement_Body (Stmt); - Info : constant Block_Info_Acc := Get_Info (Bod); - Prev_Subprg_Instance : Subprgs.Subprg_Instance_Stack; + Clause : Iir; + Bod : Iir; + Mark2 : Id_Mark_Type; begin - Subprgs.Push_Subprg_Instance (Info.Block_Scope'Access, - Info.Block_Decls_Ptr_Type, - Wki_Instance, - Prev_Subprg_Instance); - Set_Scope_Via_Field_Ptr (Base_Info.Block_Scope, - Info.Block_Origin_Field, - Info.Block_Scope'Access); - Translate_Block_Subprograms (Bod, Bod); - Clear_Scope (Base_Info.Block_Scope); - Subprgs.Pop_Subprg_Instance - (Wki_Instance, Prev_Subprg_Instance); + Clause := Stmt; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Push_Identifier_Prefix + (Mark2, Get_Alternative_Label (Bod)); + Translate_Generate_Statement_Body_Subprograms + (Bod, Base_Info); + Pop_Identifier_Prefix (Mark2); + Clause := Get_Generate_Else_Clause (Clause); + end loop; end; when others => Error_Kind ("translate_block_subprograms", Stmt); @@ -1522,51 +1567,78 @@ package body Trans.Chap9 is procedure Elab_If_Generate_Statement (Stmt : Iir_Generate_Statement; Parent : Iir; Base_Block : Iir) is - Condition : constant Iir := Get_Condition (Stmt); - Bod : constant Iir := Get_Generate_Statement_Body (Stmt); - Info : constant Block_Info_Acc := Get_Info (Bod); Parent_Info : constant Block_Info_Acc := Get_Info (Parent); - Var : O_Dnode; - Blk : O_If_Block; - V : O_Lnode; - begin - Open_Temp; - Var := Create_Temp (Info.Block_Decls_Ptr_Type); - Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition)); - New_Assign_Stmt - (New_Obj (Var), - Gen_Alloc (Alloc_System, - New_Lit (Get_Scope_Size (Info.Block_Scope)), - Info.Block_Decls_Ptr_Type)); - New_Else_Stmt (Blk); - New_Assign_Stmt - (New_Obj (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type))); - Finish_If_Stmt (Blk); + -- Used to get Block_Parent_Field, set in the first generate statement + -- body. + Stmt_Info : constant Generate_Info_Acc := Get_Info (Stmt); - -- Add a link to child in parent. - V := Get_Instance_Ref (Parent_Info.Block_Scope); - V := New_Selected_Element (V, Info.Block_Parent_Field); - New_Assign_Stmt (V, New_Obj_Value (Var)); + -- Set the instance field in the parent. + procedure Set_Parent_Field (Val : O_Enode; Num : Nat32) + is + V : O_Lnode; + begin + V := Get_Instance_Ref (Parent_Info.Block_Scope); + V := New_Selected_Element (V, Stmt_Info.Generate_Parent_Field); + New_Assign_Stmt (V, Val); - Start_If_Stmt - (Blk, - New_Compare_Op - (ON_Neq, - New_Obj_Value (Var), - New_Lit (New_Null_Access (Info.Block_Decls_Ptr_Type)), - Ghdl_Bool_Type)); - -- Add a link to parent in child. - New_Assign_Stmt - (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field), - Get_Instance_Access (Base_Block)); - -- Elaborate block - Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); - Elab_Block_Declarations (Bod, Bod); - Clear_Scope (Info.Block_Scope); - Finish_If_Stmt (Blk); - Close_Temp; + V := Get_Instance_Ref (Parent_Info.Block_Scope); + V := New_Selected_Element (V, Stmt_Info.Generate_Body_Id); + New_Assign_Stmt (V, New_Lit (New_Index_Lit (Unsigned_64 (Num)))); + end Set_Parent_Field; + + procedure Elab_If_Clause (Clause : Iir) + is + Condition : constant Iir := Get_Condition (Clause); + Bod : constant Iir := Get_Generate_Statement_Body (Clause); + Info : constant Block_Info_Acc := Get_Info (Bod); + Var : O_Dnode; + Blk : O_If_Block; + N_Clause : Iir; + begin + Open_Temp; + + Var := Create_Temp (Info.Block_Decls_Ptr_Type); + if Condition /= Null_Iir then + Start_If_Stmt (Blk, Chap7.Translate_Expression (Condition)); + end if; + New_Assign_Stmt + (New_Obj (Var), + Gen_Alloc (Alloc_System, + New_Lit (Get_Scope_Size (Info.Block_Scope)), + Info.Block_Decls_Ptr_Type)); + + -- Add a link to child in parent. This must be done before + -- elaboration, in case of use. + Set_Parent_Field + (New_Convert_Ov (New_Obj_Value (Var), Ghdl_Ptr_Type), + Info.Block_Id); + + -- Add a link to parent in child. + New_Assign_Stmt + (New_Selected_Acc_Value (New_Obj (Var), Info.Block_Origin_Field), + Get_Instance_Access (Base_Block)); + -- Elaborate block + Set_Scope_Via_Param_Ptr (Info.Block_Scope, Var); + Elab_Block_Declarations (Bod, Bod); + Clear_Scope (Info.Block_Scope); + + if Condition /= Null_Iir then + New_Else_Stmt (Blk); + N_Clause := Get_Generate_Else_Clause (Clause); + if N_Clause /= Null_Iir then + Elab_If_Clause (N_Clause); + else + Set_Parent_Field + (New_Lit (New_Null_Access (Ghdl_Ptr_Type)), + Info.Block_Id + 1); + end if; + Finish_If_Stmt (Blk); + end if; + Close_Temp; + end Elab_If_Clause; + begin + Elab_If_Clause (Stmt); end Elab_If_Generate_Statement; procedure Elab_For_Generate_Statement diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb index ed483fe..a55447a 100644 --- a/src/vhdl/translate/trans-rtis.adb +++ b/src/vhdl/translate/trans-rtis.adb @@ -154,8 +154,8 @@ package body Trans.Rtis is Ghdl_Rtin_Component_Nbr_Child : O_Fnode; Ghdl_Rtin_Component_Children : O_Fnode; - procedure Rti_Initialize - is + -- Create all the declarations for RTIs. + procedure Rti_Initialize is begin -- Create type ghdl_rti_kind is (ghdl_rtik_typedef_bool, ...) declare @@ -708,149 +708,221 @@ package body Trans.Rtis is end Rti_Initialize; - type Rti_Array is array (1 .. 8) of O_Dnode; - type Rti_Array_List; - type Rti_Array_List_Acc is access Rti_Array_List; - type Rti_Array_List is record - Rtis : Rti_Array; - Next : Rti_Array_List_Acc; - end record; + package Rti_Builders is + type Rti_Block is limited private; - type Rti_Block is record - Depth : Rti_Depth_Type; - Nbr : Integer; - List : Rti_Array_List; - Last_List : Rti_Array_List_Acc; - Last_Nbr : Integer; - end record; - - Cur_Block : Rti_Block := (Depth => 0, - Nbr => 0, - List => (Rtis => (others => O_Dnode_Null), - Next => null), - Last_List => null, - Last_Nbr => 0); - - Free_List : Rti_Array_List_Acc := null; - - procedure Push_Rti_Node (Prev : out Rti_Block; Deeper : Boolean := True) - is - Ndepth : Rti_Depth_Type; - begin - if Deeper then - Ndepth := Cur_Block.Depth + 1; - else - Ndepth := Cur_Block.Depth; - end if; - Prev := Cur_Block; - Cur_Block := (Depth => Ndepth, - Nbr => 0, - List => (Rtis => (others => O_Dnode_Null), - Next => null), - Last_List => null, - Last_Nbr => 0); - end Push_Rti_Node; - - procedure Add_Rti_Node (Node : O_Dnode) - is - begin - if Node = O_Dnode_Null then - -- FIXME: temporary for not yet handled types. - return; - end if; - if Cur_Block.Last_Nbr = Rti_Array'Last then - -- Append a new block. - declare - N : Rti_Array_List_Acc; - begin - if Free_List = null then - N := new Rti_Array_List; - else - N := Free_List; - Free_List := N.Next; - end if; - N.Next := null; - if Cur_Block.Last_List = null then - Cur_Block.List.Next := N; - else - Cur_Block.Last_List.Next := N; - end if; - Cur_Block.Last_List := N; - end; - Cur_Block.Last_Nbr := 1; - else - Cur_Block.Last_Nbr := Cur_Block.Last_Nbr + 1; - end if; - if Cur_Block.Last_List = null then - Cur_Block.List.Rtis (Cur_Block.Last_Nbr) := Node; - else - Cur_Block.Last_List.Rtis (Cur_Block.Last_Nbr) := Node; - end if; - Cur_Block.Nbr := Cur_Block.Nbr + 1; - end Add_Rti_Node; + function Get_Depth_From_Var (Var : Var_Type) return Rti_Depth_Type; - function Generate_Rti_Array (Id : O_Ident) return O_Dnode - is - Arr_Type : O_Tnode; - List : O_Array_Aggr_List; - L : Rti_Array_List_Acc; - Nbr : Integer; - Val : O_Cnode; - Res : O_Dnode; - begin - Arr_Type := New_Constrained_Array_Type - (Ghdl_Rti_Array, - New_Unsigned_Literal (Ghdl_Index_Type, - Unsigned_64 (Cur_Block.Nbr + 1))); - New_Const_Decl (Res, Id, O_Storage_Private, Arr_Type); - Start_Const_Value (Res); - Start_Array_Aggr (List, Arr_Type); - Nbr := Cur_Block.Nbr; - for I in Cur_Block.List.Rtis'Range loop - exit when I > Nbr; - New_Array_Aggr_El - (List, New_Global_Unchecked_Address (Cur_Block.List.Rtis (I), - Ghdl_Rti_Access)); - end loop; - L := Cur_Block.List.Next; - while L /= null loop - Nbr := Nbr - Cur_Block.List.Rtis'Length; - for I in L.Rtis'Range loop + procedure Push_Rti_Node (Prev : out Rti_Block; Deeper : Boolean := True); + + -- Save NODE in a list. + procedure Add_Rti_Node (Node : O_Dnode); + + -- Convert the list of nodes into a null-terminated array, declared + -- using ID. + function Generate_Rti_Array (Id : O_Ident) return O_Dnode; + + -- Get the number of nodes in the array (without the last null entry). + function Get_Rti_Array_Length return Unsigned_64; + + procedure Pop_Rti_Node (Prev : Rti_Block); + + private + type Rti_Array is array (1 .. 8) of O_Dnode; + type Rti_Array_List; + type Rti_Array_List_Acc is access Rti_Array_List; + type Rti_Array_List is record + Rtis : Rti_Array; + Next : Rti_Array_List_Acc; + end record; + + type Rti_Block is record + -- Depth of the block. + Depth : Rti_Depth_Type; + + -- Number of children. + Nbr : Integer; + + -- Array for the fist children. + List : Rti_Array_List; + + -- Linked list for the following children. + Last_List : Rti_Array_List_Acc; + + -- Number of entries used in the last array. Used to detect if a + -- new array has to be allocated. + Last_Nbr : Integer; + end record; + end Rti_Builders; + + package body Rti_Builders is + Cur_Block : Rti_Block := (Depth => 0, + Nbr => 0, + List => (Rtis => (others => O_Dnode_Null), + Next => null), + Last_List => null, + Last_Nbr => 0); + + Free_List : Rti_Array_List_Acc := null; + + function Get_Depth_From_Var (Var : Var_Type) return Rti_Depth_Type is + begin + if Var = Null_Var or else Is_Var_Field (Var) then + return Cur_Block.Depth; + else + -- Global variable. No depth. + return 0; + end if; + end Get_Depth_From_Var; + + procedure Push_Rti_Node (Prev : out Rti_Block; Deeper : Boolean := True) + is + Ndepth : Rti_Depth_Type; + begin + -- Save current state. + Prev := Cur_Block; + + if Deeper then + -- Increase depth for nested declarations (usual case). + Ndepth := Cur_Block.Depth + 1; + else + -- Same depth for non-semantically nested declarations (but + -- lexically nested), eg: physical literals, record elements. + Ndepth := Cur_Block.Depth; + end if; + + -- Create new empty state. + Cur_Block := (Depth => Ndepth, + Nbr => 0, + List => (Rtis => (others => O_Dnode_Null), + Next => null), + Last_List => null, + Last_Nbr => 0); + end Push_Rti_Node; + + procedure Add_Rti_Node (Node : O_Dnode) is + begin + if Node = O_Dnode_Null then + -- FIXME: temporary for not yet handled types. + return; + end if; + + if Cur_Block.Last_Nbr = Rti_Array'Last then + -- Append a new block. + declare + N : Rti_Array_List_Acc; + begin + if Free_List = null then + -- Create a new one. + N := new Rti_Array_List; + else + -- Recycle from the free list. + N := Free_List; + Free_List := N.Next; + end if; + + -- Initialize. + N.Next := null; + + -- Link. + if Cur_Block.Last_List = null then + Cur_Block.List.Next := N; + else + Cur_Block.Last_List.Next := N; + end if; + Cur_Block.Last_List := N; + end; + + -- Use first entry. + Cur_Block.Last_Nbr := 1; + else + + -- Allocate new entry in the block. + Cur_Block.Last_Nbr := Cur_Block.Last_Nbr + 1; + end if; + + if Cur_Block.Last_List = null then + -- Entry in the first block. + Cur_Block.List.Rtis (Cur_Block.Last_Nbr) := Node; + else + -- More than one block. + Cur_Block.Last_List.Rtis (Cur_Block.Last_Nbr) := Node; + end if; + + -- An entry was added. + Cur_Block.Nbr := Cur_Block.Nbr + 1; + end Add_Rti_Node; + + function Generate_Rti_Array (Id : O_Ident) return O_Dnode + is + Arr_Type : O_Tnode; + List : O_Array_Aggr_List; + L : Rti_Array_List_Acc; + Nbr : Integer; + Val : O_Cnode; + Res : O_Dnode; + begin + Arr_Type := New_Constrained_Array_Type + (Ghdl_Rti_Array, + New_Unsigned_Literal (Ghdl_Index_Type, + Unsigned_64 (Cur_Block.Nbr + 1))); + New_Const_Decl (Res, Id, O_Storage_Private, Arr_Type); + Start_Const_Value (Res); + Start_Array_Aggr (List, Arr_Type); + Nbr := Cur_Block.Nbr; + + -- First chunk. + for I in Cur_Block.List.Rtis'Range loop exit when I > Nbr; New_Array_Aggr_El - (List, New_Global_Unchecked_Address (L.Rtis (I), - Ghdl_Rti_Access)); + (List, New_Global_Unchecked_Address (Cur_Block.List.Rtis (I), + Ghdl_Rti_Access)); end loop; - L := L.Next; - end loop; - New_Array_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access)); - Finish_Array_Aggr (List, Val); - Finish_Const_Value (Res, Val); - return Res; - end Generate_Rti_Array; - procedure Pop_Rti_Node (Prev : Rti_Block) - is - L : Rti_Array_List_Acc; - begin - L := Cur_Block.List.Next; - if L /= null then - Cur_Block.Last_List.Next := Free_List; - Free_List := Cur_Block.List.Next; - Cur_Block.List.Next := null; - end if; - Cur_Block := Prev; - end Pop_Rti_Node; + -- Next chunks. + L := Cur_Block.List.Next; + while L /= null loop + Nbr := Nbr - Cur_Block.List.Rtis'Length; + for I in L.Rtis'Range loop + exit when I > Nbr; + New_Array_Aggr_El + (List, New_Global_Unchecked_Address (L.Rtis (I), + Ghdl_Rti_Access)); + end loop; + L := L.Next; + end loop; - function Get_Depth_From_Var (Var : Var_Type) return Rti_Depth_Type - is - begin - if Var = Null_Var or else Is_Var_Field (Var) then - return Cur_Block.Depth; - else - return 0; - end if; - end Get_Depth_From_Var; + -- Append a null entry. + New_Array_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access)); + + Finish_Array_Aggr (List, Val); + Finish_Const_Value (Res, Val); + return Res; + end Generate_Rti_Array; + + function Get_Rti_Array_Length return Unsigned_64 is + begin + return Unsigned_64 (Cur_Block.Nbr); + end Get_Rti_Array_Length; + + procedure Pop_Rti_Node (Prev : Rti_Block) + is + L : Rti_Array_List_Acc; + begin + -- Put chunks to Free_List. + L := Cur_Block.List.Next; + if L /= null then + Cur_Block.Last_List.Next := Free_List; + Free_List := Cur_Block.List.Next; + Cur_Block.List.Next := null; + end if; + + -- Restore context. + Cur_Block := Prev; + end Pop_Rti_Node; + end Rti_Builders; + + use Rti_Builders; function Generate_Common (Kind : O_Cnode; Var : Var_Type := Null_Var; Mode : Natural := 0) @@ -1910,7 +1982,8 @@ 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_If_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode); + procedure Generate_For_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode); procedure Generate_Declaration_Chain (Chain : Iir); procedure Generate_Component_Declaration (Comp : Iir) @@ -1946,7 +2019,7 @@ package body Trans.Rtis is New_Global_Address (Name, Char_Ptr_Type)); New_Record_Aggr_El (List, New_Unsigned_Literal (Ghdl_Index_Type, - Unsigned_64 (Cur_Block.Nbr))); + Get_Rti_Array_Length)); New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); @@ -2205,7 +2278,7 @@ package body Trans.Rtis is Pop_Identifier_Prefix (Mark); when Iir_Kind_If_Generate_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); - Generate_Generate_Statement (Stmt, Parent_Rti); + Generate_If_Generate_Statement (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_For_Generate_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); @@ -2227,7 +2300,7 @@ package body Trans.Rtis is Pop_Identifier_Prefix (Mark); end if; end; - Generate_Generate_Statement (Stmt, Parent_Rti); + Generate_For_Generate_Statement (Stmt, Parent_Rti); Pop_Identifier_Prefix (Mark); when Iir_Kind_Component_Instantiation_Statement => Push_Identifier_Prefix (Mark, Get_Identifier (Stmt)); @@ -2248,22 +2321,90 @@ package body Trans.Rtis is end loop; end Generate_Concurrent_Statement_Chain; - procedure Generate_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode) + procedure Generate_If_Generate_Statement (Blk : Iir; Parent_Rti : O_Dnode) + is + Info : constant Generate_Info_Acc := Get_Info (Blk); + Clause : Iir; + Bod : Iir; + + Name : O_Dnode; + List : O_Record_Aggr_List; + Num : Natural; + + Rti : O_Dnode; + Arr : O_Dnode; + + 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_Block); + Push_Rti_Node (Prev); + + Clause := Blk; + Num := 0; + while Clause /= Null_Iir loop + Bod := Get_Generate_Statement_Body (Clause); + Push_Identifier_Prefix (Mark, Get_Identifier (Bod)); + Generate_Block (Bod, Rti); + Pop_Identifier_Prefix (Mark); + Clause := Get_Generate_Else_Clause (Clause); + Num := Num + 1; + end loop; + + Name := Generate_Name (Blk); + + Arr := Generate_Rti_Array (Create_Identifier ("RTIARRAY")); + + Start_Const_Value (Rti); + + Start_Record_Aggr (List, Ghdl_Rtin_Block); + New_Record_Aggr_El (List, Generate_Common (Ghdl_Rtik_If_Generate)); + New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type)); + + -- Field Loc: offset in the instance of the entity. + Field_Off := New_Offsetof + (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), + Get_Info (Blk).Generate_Parent_Field, Ghdl_Ptr_Type); + 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)); + + -- Fields Nbr_Child and Children. + New_Record_Aggr_El + (List, New_Unsigned_Literal (Ghdl_Index_Type, Get_Rti_Array_Length)); + New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); + 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. + Info.Generate_Rti_Const := Rti; + end Generate_If_Generate_Statement; + + procedure Generate_For_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; @@ -2275,43 +2416,22 @@ package body Trans.Rtis is 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; + Push_Identifier_Prefix (Mark, "BOD"); + Generate_Block (Bod, Rti); + Pop_Identifier_Prefix (Mark); 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, Generate_Common (Ghdl_Rtik_For_Generate)); New_Record_Aggr_El (List, New_Global_Address (Name, Char_Ptr_Type)); -- Field Loc: offset in the instance of the entity. + Field_Off := New_Offsetof + (Get_Scope_Type (Get_Info (Get_Parent (Blk)).Block_Scope), + Bod_Info.Block_Parent_Field, Ghdl_Ptr_Type); New_Record_Aggr_El (List, Field_Off); New_Record_Aggr_El (List, Generate_Linecol (Blk)); @@ -2322,15 +2442,12 @@ package body Trans.Rtis is -- 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); + New_Record_Aggr_El + (List, New_Sizeof (Get_Scope_Type (Bod_Info.Block_Scope), + Ghdl_Index_Type)); -- 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); + New_Record_Aggr_El (List, Get_Context_Rti (Bod)); Finish_Record_Aggr (List, Res); @@ -2347,7 +2464,7 @@ package body Trans.Rtis is -- Not sure we need to store it (except maybe for 'path_name ?) Info.Block_Rti_Const := Rti; end if; - end Generate_Generate_Statement; + end Generate_For_Generate_Statement; procedure Generate_Block (Blk : Iir; Parent_Rti : O_Dnode) is @@ -2483,8 +2600,7 @@ package body Trans.Rtis is -- Fields Nbr_Child and Children. New_Record_Aggr_El - (List, New_Unsigned_Literal (Ghdl_Index_Type, - Unsigned_64 (Cur_Block.Nbr))); + (List, New_Unsigned_Literal (Ghdl_Index_Type, Get_Rti_Array_Length)); New_Record_Aggr_El (List, New_Global_Address (Arr, Ghdl_Rti_Arr_Acc)); Finish_Record_Aggr (List, Res); diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads index 79f02c1..9a10b65 100644 --- a/src/vhdl/translate/trans.ads +++ b/src/vhdl/translate/trans.ads @@ -315,8 +315,7 @@ package Trans is procedure Restore_Local_Identifier (Id : Local_Identifier_Type); -- Create an identifier from IIR node ID without the prefix. - function Create_Identifier_Without_Prefix (Id : Iir) - return O_Ident; + function Create_Identifier_Without_Prefix (Id : Iir) return O_Ident; function Create_Identifier_Without_Prefix (Id : Name_Id; Str : String) return O_Ident; @@ -638,6 +637,7 @@ package Trans is Kind_Psl_Directive, Kind_Loop, Kind_Block, + Kind_Generate, Kind_Component, Kind_Field, Kind_Package, @@ -1249,6 +1249,11 @@ package Trans is Block_Decls_Array_Type : O_Tnode; Block_Decls_Array_Ptr_Type : O_Tnode; + -- For if-generate generate statement body: the identifier of the + -- body. Used to know which block_configuration applies to the + -- block. + Block_Id : Nat32; + -- Subprogram which elaborates the block (for entity or arch). Block_Elab_Subprg : O_Dnode; -- Size of the block instance. @@ -1262,6 +1267,19 @@ package Trans is -- RTI constant for the block. Block_Rti_Const : O_Dnode := O_Dnode_Null; + when Kind_Generate => + -- Like Block_Parent_Field: field in the instance for the + -- sub-block. Always a Ghdl_Ptr_Type, as there are many possible + -- types for the sub-block instance (if/case generate). + Generate_Parent_Field : O_Fnode; + + -- Identifier number of the generate statement body. Used for + -- configuring sub-block, and for grt to index the rti. + Generate_Body_Id : O_Fnode; + + -- RTI for the generate statement. + Generate_Rti_Const : O_Dnode := O_Dnode_Null; + when Kind_Component => -- How to access to component interfaces. Comp_Scope : aliased Var_Scope_Type; @@ -1366,6 +1384,7 @@ package Trans is subtype Psl_Info_Acc is Ortho_Info_Acc (Kind_Psl_Directive); subtype Loop_Info_Acc is Ortho_Info_Acc (Kind_Loop); subtype Block_Info_Acc is Ortho_Info_Acc (Kind_Block); + subtype Generate_Info_Acc is Ortho_Info_Acc (Kind_Generate); subtype Comp_Info_Acc is Ortho_Info_Acc (Kind_Component); subtype Field_Info_Acc is Ortho_Info_Acc (Kind_Field); subtype Config_Info_Acc is Ortho_Info_Acc (Kind_Config); |