diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/vhdl/simulate/annotations.adb | 76 | ||||
| -rw-r--r-- | src/vhdl/simulate/debugger.adb | 40 | ||||
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 203 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 167 | ||||
| -rw-r--r-- | src/vhdl/simulate/iir_values.adb | 1 | ||||
| -rw-r--r-- | src/vhdl/simulate/simulation.adb | 14 |
6 files changed, 233 insertions, 268 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index d07a998..93d731b 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -429,11 +429,11 @@ package body Annotations is El := Decl_Chain; while El /= Null_Iir loop case Get_Kind (El) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El)); - when Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => Annotate_Anonymous_Type_Definition (Block_Info, Get_Type (El)); when others => Error_Kind ("annotate_interface_list", El); @@ -455,11 +455,11 @@ package body Annotations is end if; Assert_No_Info (Decl); case Get_Kind (Decl) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Add_Signal_Info (Block_Info, Decl); - when Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => Create_Object_Info (Block_Info, Decl); when others => Error_Kind ("annotate_create_interface_list", Decl); @@ -483,7 +483,7 @@ package body Annotations is -- of the interfaces are elaborated in the outer context. Annotate_Interface_List_Subtype (Block_Info, Interfaces); - if Get_Kind (Subprg) in Iir_Kinds_Function_Declaration then + if Get_Kind (Subprg) = Iir_Kind_Function_Declaration then -- FIXME: can this create a new annotation ? Annotate_Anonymous_Type_Definition (Block_Info, Get_Return_Type (Subprg)); @@ -622,7 +622,9 @@ package body Annotations is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - if not Is_Second_Subprogram_Specification (Decl) then + if Get_Implicit_Definition (Decl) in Iir_Predefined_Explicit + and then not Is_Second_Subprogram_Specification (Decl) + then Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); Annotate_Subprogram_Specification (Block_Info, Decl); end if; @@ -652,8 +654,6 @@ package body Annotations is when Iir_Kind_Disconnection_Specification => null; - when Iir_Kind_Implicit_Procedure_Declaration => - null; when Iir_Kind_Group_Template_Declaration => null; when Iir_Kind_Group_Declaration => @@ -676,9 +676,6 @@ package body Annotations is -- end loop; -- end; - when Iir_Kind_Implicit_Function_Declaration => - null; - when Iir_Kind_Nature_Declaration => null; @@ -827,15 +824,12 @@ package body Annotations is Current_Scope_Level := Current_Scope_Level - 1; end Annotate_Block_Statement; - procedure Annotate_Generate_Statement - (Block_Info : Sim_Info_Acc; Stmt : Iir) + procedure Annotate_Generate_Statement_Body + (Block_Info : Sim_Info_Acc; Bod : Iir; It : Iir) is Info : Sim_Info_Acc; - Scheme : constant Iir := Get_Generation_Scheme (Stmt); - Is_Iterative : constant Boolean := - Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration; begin - Assert_No_Info (Stmt); + Assert_No_Info (Bod); Increment_Current_Scope_Level; @@ -844,19 +838,41 @@ package body Annotations is Frame_Scope_Level => Current_Scope_Level, Nbr_Objects => 0, Nbr_Instances => 0); - Set_Info (Stmt, Info); + Set_Info (Bod, Info); Block_Info.Nbr_Instances := Block_Info.Nbr_Instances + 1; - if Is_Iterative then - Annotate_Declaration (Info, Scheme); + if It /= Null_Iir then + Annotate_Declaration (Info, It); end if; - Annotate_Declaration_List (Info, Get_Declaration_Chain (Stmt)); + Annotate_Declaration_List (Info, Get_Declaration_Chain (Bod)); Annotate_Concurrent_Statements_List - (Info, Get_Concurrent_Statement_Chain (Stmt)); + (Info, Get_Concurrent_Statement_Chain (Bod)); Current_Scope_Level := Current_Scope_Level - 1; - end Annotate_Generate_Statement; + end Annotate_Generate_Statement_Body; + + procedure Annotate_If_Generate_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) + is + Clause : Iir; + begin + Clause := Stmt; + while Clause /= Null_Iir loop + Annotate_Generate_Statement_Body + (Block_Info, Get_Generate_Statement_Body (Clause), Null_Iir); + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end Annotate_If_Generate_Statement; + + procedure Annotate_For_Generate_Statement + (Block_Info : Sim_Info_Acc; Stmt : Iir) is + begin + Annotate_Generate_Statement_Body + (Block_Info, + Get_Generate_Statement_Body (Stmt), + Get_Parameter_Specification (Stmt)); + end Annotate_For_Generate_Statement; procedure Annotate_Component_Instantiation_Statement (Block_Info : Sim_Info_Acc; Stmt : Iir) @@ -917,8 +933,10 @@ package body Annotations is when Iir_Kind_Block_Statement => Annotate_Block_Statement (Block_Info, El); - when Iir_Kind_Generate_Statement => - Annotate_Generate_Statement (Block_Info, El); + when Iir_Kind_If_Generate_Statement => + Annotate_If_Generate_Statement (Block_Info, El); + when Iir_Kind_For_Generate_Statement => + Annotate_For_Generate_Statement (Block_Info, El); when Iir_Kind_Simple_Simultaneous_Statement => null; diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index 5a43533..a62a541 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -122,7 +122,7 @@ package body Debugger is Put_Line (Standard_Error, " in the ""-"" operation"); when Iir_Kind_Integer_Literal => Put_Line (Standard_Error, ", literal out of range"); - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration => Put_Line (Standard_Error, " for " & Disp_Node (Expr)); when others => @@ -144,7 +144,8 @@ package body Debugger is case Get_Kind (Name) is when Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement | Iir_Kind_Component_Instantiation_Statement | Iir_Kind_Procedure_Declaration | Iir_Kinds_Process_Statement => @@ -204,7 +205,8 @@ package body Debugger is case Get_Kind (Inst.Label) is when Iir_Kind_Block_Statement => Put ("[block]"); - when Iir_Kind_Generate_Statement => + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => Put ("[generate]"); when Iir_Kind_Iterator_Declaration => Put ("[iterator]"); @@ -357,7 +359,7 @@ package body Debugger is while El /= Null_Iir loop case Get_Kind (El) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Interface_Signal_Declaration => Disp_Instance_Signal (Instance, El); when others => null; @@ -391,10 +393,13 @@ package body Debugger is -- FIXME: ports. Disp_Instance_Signals_Of_Chain (Instance, Get_Declaration_Chain (Blk)); - when Iir_Kind_Generate_Statement => + + when Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement => Disp_Instance_Name (Instance); Put_Line (" [generate]:"); + when Iir_Kind_Generate_Statement_Body => Disp_Instance_Signals_Of_Chain (Instance, Get_Declaration_Chain (Blk)); when Iir_Kind_Component_Instantiation_Statement => @@ -463,14 +468,14 @@ package body Debugger is case Get_Kind (El) is when Iir_Kind_Constant_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_Object_Alias_Declaration => Put (Disp_Node (El)); Put (" = "); Disp_Value_Tab (Instance.Objects (Get_Info (El).Slot), 3); - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => declare Sig : Iir_Value_Literal_Acc; begin @@ -485,8 +490,6 @@ package body Debugger is | Iir_Kind_Subtype_Declaration => -- FIXME: disp ranges null; - when Iir_Kind_Implicit_Function_Declaration => - null; when others => Error_Kind ("disp_declaration_objects", El); end case; @@ -1149,7 +1152,7 @@ package body Debugger is Decl := Chain; while Decl /= Null_Iir loop case Get_Kind (Decl) is - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration => Put_Line (" " & Name_Table.Image (Get_Identifier (Decl))); when others => @@ -1243,7 +1246,9 @@ package body Debugger is when Iir_Kind_For_Loop_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body => Foreach_Scopes (Get_Parent (N), Handler); Handler.all (N); @@ -1296,14 +1301,15 @@ package body Debugger is | Iir_Kind_Sensitized_Process_Statement => Open_Declarative_Region; Add_Declarations (Get_Declaration_Chain (N), False); - when Iir_Kind_For_Loop_Statement => + when Iir_Kind_For_Loop_Statement + | Iir_Kind_For_Generate_Statement => Open_Declarative_Region; Add_Name (Get_Parameter_Specification (N)); when Iir_Kind_Block_Statement => Open_Declarative_Region; Add_Declarations (Get_Declaration_Chain (N), False); Add_Declarations_Of_Concurrent_Statement (N); - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => Open_Declarative_Region; Add_Declarations (Get_Declaration_Chain (N), False); Add_Declarations_Of_Concurrent_Statement (N); @@ -1342,7 +1348,9 @@ package body Debugger is | Iir_Kind_Function_Body | Iir_Kind_For_Loop_Statement | Iir_Kind_Block_Statement - | Iir_Kind_Generate_Statement => + | Iir_Kind_If_Generate_Statement + | Iir_Kind_For_Generate_Statement + | Iir_Kind_Generate_Statement_Body => Close_Declarative_Region; when others => Error_Kind ("Decl_Decls_For", N); diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index dd405ec..d3e157d 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -877,7 +877,7 @@ package body Elaboration is procedure Elaborate_Generic_Clause (Instance : Block_Instance_Acc; Generic_Chain : Iir) is - Decl : Iir_Constant_Interface_Declaration; + Decl : Iir_Interface_Constant_Declaration; begin -- Elaboration of a generic clause consists of the elaboration of each -- of the equivalent single generic declarations contained in the @@ -902,7 +902,7 @@ package body Elaboration is procedure Elaborate_Port_Clause (Instance : Block_Instance_Acc; Port_Chain : Iir) is - Decl : Iir_Signal_Interface_Declaration; + Decl : Iir_Interface_Signal_Declaration; begin Decl := Port_Chain; while Decl /= Null_Iir loop @@ -925,7 +925,7 @@ package body Elaboration is Map : Iir) is Assoc : Iir; - Inter : Iir_Constant_Interface_Declaration; + Inter : Iir_Interface_Constant_Declaration; Value : Iir; Val : Iir_Value_Literal_Acc; Last_Individual : Iir_Value_Literal_Acc; @@ -1025,7 +1025,7 @@ package body Elaboration is -- LRM93 12.2.3 The Port Clause procedure Elaborate_Port_Declaration (Instance : Block_Instance_Acc; - Decl : Iir_Signal_Interface_Declaration; + Decl : Iir_Interface_Signal_Declaration; Default_Value : Iir_Value_Literal_Acc) is Val : Iir_Value_Literal_Acc; @@ -1076,7 +1076,7 @@ package body Elaboration is Map : Iir) is Assoc : Iir; - Inter : Iir_Signal_Interface_Declaration; + Inter : Iir_Interface_Signal_Declaration; Actual_Expr : Iir_Value_Literal_Acc; Init_Expr : Iir_Value_Literal_Acc; Actual : Iir; @@ -1457,10 +1457,12 @@ package body Elaboration is end Elaborate_Component_Instantiation; -- LRM93 12.4.2 Generate Statements - procedure Elaborate_Conditional_Generate_Statement + procedure Elaborate_If_Generate_Statement (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement) is - Scheme : Iir; + Clause : Iir; + Cond : Iir; + Bod : Iir; Ninstance : Block_Instance_Acc; Lit : Iir_Value_Literal_Acc; begin @@ -1469,32 +1471,41 @@ package body Elaboration is -- consists of the evaluation of the boolean expression, followed by -- the generation of exactly one block statement if the expression -- evaluates to TRUE, and no block statement otherwise. - Scheme := Get_Generation_Scheme (Generate); - Lit := Execute_Expression (Instance, Scheme); - if Lit.B1 /= True then - return; - end if; + Clause := Generate; + while Clause /= Null_Iir loop + Cond := Get_Condition (Generate); + if Cond /= Null_Iir then + Lit := Execute_Expression (Instance, Cond); + end if; + if Cond = Null_Iir or else Lit.B1 = True then + -- LRM93 12.4.2 + -- If generated, the block statement has the following form: + -- 1. The block label is the same as the label of the generate + -- statement. + -- 2. The block declarative part consists of a copy of the + -- declarative items contained within the generate statement. + -- 3. The block statement part consists of a copy of the + -- concurrent statement contained within the generate + -- statement. + Bod := Get_Generate_Statement_Body (Clause); + Ninstance := Create_Block_Instance (Instance, Bod, Bod); + Elaborate_Declarative_Part + (Ninstance, Get_Declaration_Chain (Bod)); + Elaborate_Statement_Part + (Ninstance, Get_Concurrent_Statement_Chain (Bod)); - -- LRM93 12.4.2 - -- If generated, the block statement has the following form: - -- 1. The block label is the same as the label of the generate - -- statement. - -- 2. The block declarative part consists of a copy of the declarative - -- items contained within the generate statement. - -- 3. The block statement part consists of a copy of the concurrent - -- statement contained within the generate statement. - Ninstance := Create_Block_Instance (Instance, Generate, Generate); - Elaborate_Declarative_Part (Ninstance, Get_Declaration_Chain (Generate)); - Elaborate_Statement_Part - (Ninstance, Get_Concurrent_Statement_Chain (Generate)); - end Elaborate_Conditional_Generate_Statement; + exit; + end if; + Clause := Get_Generate_Else_Clause (Clause); + end loop; + end Elaborate_If_Generate_Statement; -- LRM93 12.4.2 Generate Statements - procedure Elaborate_Iterative_Generate_Statement + procedure Elaborate_For_Generate_Statement (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement) is - Scheme : constant Iir_Iterator_Declaration := - Get_Generation_Scheme (Generate); + Iter : constant Iir := Get_Parameter_Specification (Generate); + Bod : constant Iir := Get_Generate_Statement_Body (Generate); Ninstance : Block_Instance_Acc; Sub_Instance : Block_Instance_Acc; Bound, Index : Iir_Value_Literal_Acc; @@ -1503,12 +1514,12 @@ package body Elaboration is -- For a generate statement with a for generation scheme, elaboration -- consists of the elaboration of the discrete range - Ninstance := Create_Block_Instance (Instance, Generate, Generate); - Elaborate_Declaration (Ninstance, Scheme); - Bound := Execute_Bounds (Ninstance, Get_Type (Scheme)); + Ninstance := Create_Block_Instance (Instance, Bod, Bod); + Elaborate_Declaration (Ninstance, Iter); + Bound := Execute_Bounds (Ninstance, Get_Type (Iter)); -- Index is the iterator value. - Index := Unshare (Ninstance.Objects (Get_Info (Scheme).Slot), + Index := Unshare (Ninstance.Objects (Get_Info (Iter).Slot), Current_Pool); -- Initialize the iterator. @@ -1522,38 +1533,25 @@ package body Elaboration is end if; loop - Sub_Instance := Create_Block_Instance (Ninstance, Generate, Scheme); + Sub_Instance := Create_Block_Instance (Ninstance, Bod, Iter); -- FIXME: this is needed to copy iterator type (if any). But this -- elaborates the subtype several times (what about side effects). - Elaborate_Declaration (Sub_Instance, Scheme); + Elaborate_Declaration (Sub_Instance, Iter); -- Store index. - Store (Sub_Instance.Objects (Get_Info (Scheme).Slot), Index); + Store (Sub_Instance.Objects (Get_Info (Iter).Slot), Index); Elaborate_Declarative_Part - (Sub_Instance, Get_Declaration_Chain (Generate)); + (Sub_Instance, Get_Declaration_Chain (Bod)); Elaborate_Statement_Part - (Sub_Instance, Get_Concurrent_Statement_Chain (Generate)); + (Sub_Instance, Get_Concurrent_Statement_Chain (Bod)); Update_Loop_Index (Index, Bound); exit when not Is_In_Range (Index, Bound); end loop; -- FIXME: destroy index ? - end Elaborate_Iterative_Generate_Statement; - - procedure Elaborate_Generate_Statement - (Instance : Block_Instance_Acc; Generate : Iir_Generate_Statement) - is - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (Generate); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Elaborate_Iterative_Generate_Statement (Instance, Generate); - else - Elaborate_Conditional_Generate_Statement (Instance, Generate); - end if; - end Elaborate_Generate_Statement; + end Elaborate_For_Generate_Statement; procedure Elaborate_Process_Statement (Instance : Block_Instance_Acc; Stmt : Iir) @@ -1591,8 +1589,11 @@ package body Elaboration is when Iir_Kind_Component_Instantiation_Statement => Elaborate_Component_Instantiation (Instance, Stmt); - when Iir_Kind_Generate_Statement => - Elaborate_Generate_Statement (Instance, Stmt); + when Iir_Kind_If_Generate_Statement => + Elaborate_If_Generate_Statement (Instance, Stmt); + + when Iir_Kind_For_Generate_Statement => + Elaborate_For_Generate_Statement (Instance, Stmt); when Iir_Kind_Simple_Simultaneous_Statement => Add_Characteristic_Expression @@ -1640,10 +1641,10 @@ package body Elaboration is Inter := Inter_Chain; while Inter /= Null_Iir loop case Get_Kind (Inter) is - when Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => Elaborate_Subtype_Indication_If_Anonymous (Instance, Get_Type (Inter)); when others => @@ -1814,7 +1815,7 @@ package body Elaboration is procedure Apply_Block_Configuration_To_Iterative_Generate (Stmt : Iir; Conf_Chain : Iir; Instance : Block_Instance_Acc) is - Scheme : constant Iir := Get_Generation_Scheme (Stmt); + Scheme : constant Iir := Get_Parameter_Specification (Stmt); Bounds : constant Iir_Value_Literal_Acc := Execute_Bounds (Instance, Get_Type (Scheme)); @@ -1834,7 +1835,7 @@ package body Elaboration is Expr : Iir_Value_Literal_Acc; Ind : Instance_Slot_Type; begin - -- Gather children + -- Gather children (were prepended, so in reverse order). Child := Instance.Children; for I in reverse Sub_Instances'Range loop Sub_Instances (I) := Child; @@ -1847,10 +1848,7 @@ package body Elaboration is -- Apply configuration items Item := Conf_Chain; while Item /= Null_Iir loop - Spec := Get_Block_Specification (Item); - if Get_Kind (Spec) = Iir_Kind_Simple_Name then - Spec := Get_Named_Entity (Spec); - end if; + Spec := Strip_Denoting_Name (Get_Block_Specification (Item)); Prev_Item := Get_Prev_Block_Configuration (Item); case Get_Kind (Spec) is @@ -1876,7 +1874,7 @@ package body Elaboration is Sub_Conf (Ind) := True; Elaborate_Block_Configuration (Item, Sub_Instances (Ind)); end if; - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => -- Must be the only block configuration pragma Assert (Item = Conf_Chain); pragma Assert (Prev_Item = Null_Iir); @@ -1939,7 +1937,7 @@ package body Elaboration is Set_Prev_Block_Configuration (Item, Sub_Conf (Info.Inst_Slot)); Sub_Conf (Info.Inst_Slot) := Item; - when Iir_Kind_Generate_Statement => + when Iir_Kind_Generate_Statement_Body => Info := Get_Info (Spec); if Sub_Conf (Info.Inst_Slot) /= Null_Iir then raise Internal_Error; @@ -1996,9 +1994,7 @@ package body Elaboration is begin if Slot /= Invalid_Instance_Slot then -- Processes have no slot. - if Sub_Instances (Slot) /= null then - raise Internal_Error; - end if; + pragma Assert (Sub_Instances (Slot) = null); Sub_Instances (Slot) := Child; end if; end; @@ -2007,52 +2003,44 @@ package body Elaboration is end; -- Configure sub instances. - declare - Stmt : Iir; - Info : Sim_Info_Acc; - Slot : Instance_Slot_Type; - begin - Stmt := Get_Concurrent_Statement_Chain (Instance.Stmt); - while Stmt /= Null_Iir loop - case Get_Kind (Stmt) is - when Iir_Kind_Generate_Statement => - Info := Get_Info (Stmt); - Slot := Info.Inst_Slot; - if Get_Kind (Get_Generation_Scheme (Stmt)) - = Iir_Kind_Iterator_Declaration - then - -- Iterative generate: apply to all instances - Apply_Block_Configuration_To_Iterative_Generate - (Stmt, Sub_Conf (Slot), Sub_Instances (Slot)); - else - -- Conditional generate: may not be instantiated - if Sub_Instances (Slot) /= null then - Elaborate_Block_Configuration - (Sub_Conf (Slot), Sub_Instances (Slot)); - end if; - end if; + for I in Sub_Instances'Range loop + declare + Sub_Inst : constant Block_Instance_Acc := Sub_Instances (I); + Stmt : Iir; + begin + if Sub_Inst /= null then + Stmt := Sub_Inst.Label; + case Get_Kind (Stmt) is + when Iir_Kind_Generate_Statement_Body => + Stmt := Get_Parent (Stmt); + case Get_Kind (Stmt) is + when Iir_Kind_For_Generate_Statement => + Apply_Block_Configuration_To_Iterative_Generate + (Stmt, Sub_Conf (I), Sub_Inst); + when Iir_Kind_If_Generate_Statement + | Iir_Kind_If_Generate_Else_Clause => + Elaborate_Block_Configuration + (Sub_Conf (I), Sub_Inst); + when others => + raise Internal_Error; + end case; when Iir_Kind_Block_Statement => - Info := Get_Info (Stmt); - Slot := Info.Inst_Slot; - Elaborate_Block_Configuration - (Sub_Conf (Slot), Sub_Instances (Slot)); + Elaborate_Block_Configuration (Sub_Conf (I), Sub_Inst); when Iir_Kind_Component_Instantiation_Statement => if Is_Component_Instantiation (Stmt) then - Info := Get_Info (Stmt); - Slot := Info.Inst_Slot; Elaborate_Component_Configuration - (Stmt, Sub_Instances (Slot), Sub_Conf (Slot)); + (Stmt, Sub_Inst, Sub_Conf (I)); else -- Nothing to do for entity instantiation, will be -- done during elaboration of statements. null; end if; when others => - null; - end case; - Stmt := Get_Chain (Stmt); - end loop; - end; + Error_Kind ("elaborate_block_configuration", Stmt); + end case; + end if; + end; + end loop; end Elaborate_Block_Configuration; procedure Elaborate_Alias_Declaration @@ -2186,12 +2174,11 @@ package body Elaboration is case Get_Kind (Decl) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - if not Is_Second_Subprogram_Specification (Decl) then + if Get_Implicit_Definition (Decl) in Iir_Predefined_Explicit + and then not Is_Second_Subprogram_Specification (Decl) + then Elaborate_Subprogram_Declaration (Instance, Decl); end if; - when Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - null; when Iir_Kind_Anonymous_Type_Declaration => Elaborate_Type_Definition (Instance, Get_Type_Definition (Decl)); when Iir_Kind_Type_Declaration => diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index ef4cccc..995cb17 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -1354,8 +1354,7 @@ package body Execution is procedure Execute_Implicit_Procedure (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call) is - Imp : constant Iir_Implicit_Procedure_Declaration := - Get_Named_Entity (Get_Implementation (Stmt)); + Imp : constant Iir := Get_Implementation (Stmt); Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt); Assoc: Iir; Args: Iir_Value_Literal_Array (0 .. 3); @@ -1417,8 +1416,7 @@ package body Execution is procedure Execute_Foreign_Procedure (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call) is - Imp : constant Iir_Implicit_Procedure_Declaration := - Get_Implementation (Stmt); + Imp : constant Iir := Get_Implementation (Stmt); Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt); Assoc: Iir; Args: Iir_Value_Literal_Array (0 .. 3) := (others => null); @@ -1572,81 +1570,35 @@ package body Execution is function String_To_Enumeration_Array_1 (Str: Iir; El_Type : Iir) return Iir_Value_Literal_Acc is + pragma Assert (Get_Kind (Str) = Iir_Kind_String_Literal8); + Id : constant String8_Id := Get_String8_Id (Str); + Len : constant Iir_Index32 := Iir_Index32 (Get_String_Length (Str)); + + El_Btype : constant Iir := Get_Base_Type (El_Type); + Lit: Iir_Value_Literal_Acc; + El : Iir_Value_Literal_Acc; Element_Mode : Iir_Value_Scalars; - procedure Create_Lit_El - (Index : Iir_Index32; Literal: Iir_Enumeration_Literal) - is - R : Iir_Value_Literal_Acc; - P : constant Iir_Int32 := Get_Enum_Pos (Literal); - begin + Pos : Nat8; + begin + Element_Mode := Get_Info (El_Btype).Scalar_Mode; + + Lit := Create_Array_Value (Len, 1); + + for I in Lit.Val_Array.V'Range loop + -- FIXME: use literal from type ?? + Pos := Str_Table.Element_String8 (Id, Pos32 (I)); case Element_Mode is when Iir_Value_B1 => - R := Create_B1_Value (Ghdl_B1'Val (P)); + El := Create_B1_Value (Ghdl_B1'Val (Pos)); when Iir_Value_E32 => - R := Create_E32_Value (Ghdl_E32'Val (P)); + El := Create_E32_Value (Ghdl_E32'Val (Pos)); when others => raise Internal_Error; end case; - Lit.Val_Array.V (Index) := R; - end Create_Lit_El; - - El_Btype : constant Iir := Get_Base_Type (El_Type); - Literal_List: constant Iir_List := - Get_Enumeration_Literal_List (El_Btype); - Len: Iir_Index32; - Str_As_Str: constant String := Iirs_Utils.Image_String_Lit (Str); - El : Iir; - begin - Element_Mode := Get_Info (El_Btype).Scalar_Mode; - - case Get_Kind (Str) is - when Iir_Kind_String_Literal => - Len := Iir_Index32 (Str_As_Str'Length); - Lit := Create_Array_Value (Len, 1); - - for I in Lit.Val_Array.V'Range loop - -- FIXME: use literal from type ?? - El := Find_Name_In_List - (Literal_List, - Name_Table.Get_Identifier (Str_As_Str (Natural (I)))); - if El = Null_Iir then - -- FIXME: could free what was already built. - return null; - end if; - Create_Lit_El (I, El); - end loop; - - when Iir_Kind_Bit_String_Literal => - declare - Lit_0, Lit_1 : Iir; - Buf : String_Fat_Acc; - Len1 : Int32; - begin - Lit_0 := Get_Bit_String_0 (Str); - Lit_1 := Get_Bit_String_1 (Str); - Buf := Str_Table.Get_String_Fat_Acc (Get_String_Id (Str)); - Len1 := Get_String_Length (Str); - Lit := Create_Array_Value (Iir_Index32 (Len1), 1); - - if Lit_0 = Null_Iir or Lit_1 = Null_Iir then - raise Internal_Error; - end if; - for I in 1 .. Len1 loop - case Buf (I) is - when '0' => - Create_Lit_El (Iir_Index32 (I), Lit_0); - when '1' => - Create_Lit_El (Iir_Index32 (I), Lit_1); - when others => - raise Internal_Error; - end case; - end loop; - end; - when others => - raise Internal_Error; - end case; + Lit.Val_Array.V (I) := El; + end loop; return Lit; end String_To_Enumeration_Array_1; @@ -1742,8 +1694,7 @@ package body Execution is Orig + Pos * Step, Step / Res.Bounds.D (Dim + 1).Length, Dim + 1, Nbr_Dim, El_Type); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => pragma Assert (Dim + 1 = Nbr_Dim); Val := String_To_Enumeration_Array_1 (Value, El_Type); if Val.Val_Array.Len /= Res.Bounds.D (Nbr_Dim).Length then @@ -2397,7 +2348,7 @@ package body Execution is Is_Sig := False; case Get_Kind (Expr) is - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Stable_Attribute @@ -2417,7 +2368,7 @@ package body Execution is -- FIXME: add a flag ? case Get_Kind (Get_Object_Prefix (Expr)) is when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration => Is_Sig := True; when others => @@ -2426,11 +2377,11 @@ package body Execution is Slot_Block := Get_Instance_For_Slot (Block, Expr); Res := Slot_Block.Objects (Get_Info (Expr).Slot); - when Iir_Kind_Constant_Interface_Declaration + when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Iterator_Declaration @@ -2790,8 +2741,8 @@ package body Execution is Prepend (Rstr, '('); end; Instance := Instance.Parent; - when Iir_Kind_Generate_Statement => - Prepend (Rstr, Image (Get_Label (Instance.Label))); + when Iir_Kind_Generate_Statement_Body => + Prepend (Rstr, Image (Get_Label (Get_Parent (Instance.Label)))); Prepend (Rstr, ':'); Instance := Instance.Parent; when Iir_Kind_Component_Instantiation_Statement => @@ -2836,7 +2787,7 @@ package body Execution is Res: Iir_Value_Literal_Acc; begin case Get_Kind (Expr) is - when Iir_Kind_Signal_Interface_Declaration + when Iir_Kind_Interface_Signal_Declaration | Iir_Kind_Signal_Declaration | Iir_Kind_Guard_Signal_Declaration | Iir_Kind_Stable_Attribute @@ -2847,11 +2798,11 @@ package body Execution is Res := Execute_Name (Block, Expr); return Res; - when Iir_Kind_Constant_Interface_Declaration + when Iir_Kind_Interface_Constant_Declaration | Iir_Kind_Constant_Declaration - | Iir_Kind_Variable_Interface_Declaration + | Iir_Kind_Interface_Variable_Declaration | Iir_Kind_Variable_Declaration - | Iir_Kind_File_Interface_Declaration + | Iir_Kind_Interface_File_Declaration | Iir_Kind_File_Declaration | Iir_Kind_Attribute_Value | Iir_Kind_Iterator_Declaration @@ -2874,10 +2825,9 @@ package body Execution is when Iir_Kinds_Dyadic_Operator | Iir_Kinds_Monadic_Operator => declare - Imp : Iir; + Imp : constant Iir := Get_Implementation (Expr); begin - Imp := Get_Implementation (Expr); - if Get_Kind (Imp) = Iir_Kind_Function_Declaration then + if Get_Implicit_Definition (Imp) in Iir_Predefined_Explicit then return Execute_Function_Call (Block, Expr, Imp); else if Get_Kind (Expr) in Iir_Kinds_Dyadic_Operator then @@ -2895,12 +2845,11 @@ package body Execution is when Iir_Kind_Function_Call => declare - Imp : constant Iir := - Get_Named_Entity (Get_Implementation (Expr)); + Imp : constant Iir := Get_Implementation (Expr); Assoc : Iir; Args : Iir_Array (0 .. 1); begin - if Get_Kind (Imp) = Iir_Kind_Function_Declaration then + if Get_Implicit_Definition (Imp) in Iir_Predefined_Explicit then return Execute_Function_Call (Block, Expr, Imp); else Assoc := Get_Parameter_Association_Chain (Expr); @@ -2957,8 +2906,7 @@ package body Execution is return Create_I64_Value (Ghdl_I64 (Evaluation.Get_Physical_Value (Expr))); - when Iir_Kind_String_Literal - | Iir_Kind_Bit_String_Literal => + when Iir_Kind_String_Literal8 => return String_To_Enumeration_Array (Block, Expr); when Iir_Kind_Null_Literal => @@ -3337,12 +3285,13 @@ package body Execution is when Iir_Kind_Function_Call => -- FIXME: shouldn't CONV always be a denoting_name ? return Execute_Assoc_Function_Conversion - (Block, Get_Named_Entity (Get_Implementation (Conv)), Val); + (Block, Get_Implementation (Conv), Val); when Iir_Kind_Type_Conversion => -- FIXME: shouldn't CONV always be a denoting_name ? return Execute_Type_Conversion (Block, Conv, Val); - when Iir_Kinds_Denoting_Name => - Ent := Get_Named_Entity (Conv); + when Iir_Kinds_Denoting_Name + | Iir_Kind_Function_Declaration => + Ent := Strip_Denoting_Name (Conv); if Get_Kind (Ent) = Iir_Kind_Function_Declaration then return Execute_Assoc_Function_Conversion (Block, Ent, Val); elsif Get_Kind (Ent) in Iir_Kinds_Type_Declaration then @@ -3395,7 +3344,7 @@ package body Execution is when Iir_Kind_Association_Element_By_Individual => -- FIXME: signals ? pragma Assert - (Get_Kind (Inter) /= Iir_Kind_Signal_Interface_Declaration); + (Get_Kind (Inter) /= Iir_Kind_Interface_Signal_Declaration); Last_Individual := Create_Value_For_Type (Out_Block, Get_Actual_Type (Assoc), False); Last_Individual := Unshare (Last_Individual, Instance_Pool); @@ -3409,17 +3358,17 @@ package body Execution is -- Compute actual value. case Get_Kind (Inter) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_File_Declaration => Val := Execute_Expression (Out_Block, Actual); Implicit_Array_Conversion (Subprg_Block, Val, Get_Type (Formal), Assoc); Check_Constraints (Subprg_Block, Val, Get_Type (Formal), Assoc); - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Val := Execute_Name (Out_Block, Actual, True); Implicit_Array_Conversion (Subprg_Block, Val, Get_Type (Formal), Assoc); - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => Mode := Get_Mode (Inter); if Mode = Iir_In_Mode then -- FIXME: Ref ? @@ -3490,14 +3439,14 @@ package body Execution is if Get_Whole_Association_Flag (Assoc) then case Get_Kind (Inter) is - when Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_Constant_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_File_Declaration => -- FIXME: Arguments are passed by copy. Elaboration.Create_Object (Subprg_Block, Inter); Subprg_Block.Objects (Get_Info (Inter).Slot) := Unshare (Val, Instance_Pool); - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Elaboration.Create_Signal (Subprg_Block, Inter); Subprg_Block.Objects (Get_Info (Inter).Slot) := Unshare_Bounds (Val, Instance_Pool); @@ -3539,7 +3488,7 @@ package body Execution is Formal := Get_Formal (Assoc); Inter := Get_Association_Interface (Assoc); case Get_Kind (Inter) is - when Iir_Kind_Variable_Interface_Declaration => + when Iir_Kind_Interface_Variable_Declaration => if Get_Mode (Inter) /= Iir_In_Mode and then Get_Kind (Get_Type (Inter)) /= Iir_Kind_File_Type_Definition @@ -3572,10 +3521,10 @@ package body Execution is Release (Expr_Mark, Expr_Pool); end; end if; - when Iir_Kind_File_Interface_Declaration => + when Iir_Kind_Interface_File_Declaration => null; - when Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Constant_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Interface_Constant_Declaration => null; when others => Error_Kind ("execute_back_association", Inter); @@ -4540,12 +4489,12 @@ package body Execution is Instance : constant Block_Instance_Acc := Proc.Instance; Stmt : constant Iir := Instance.Stmt; Call : constant Iir := Get_Procedure_Call (Stmt); - Imp : constant Iir := Get_Named_Entity (Get_Implementation (Call)); + Imp : constant Iir := Get_Implementation (Call); Subprg_Instance : Block_Instance_Acc; Assoc_Chain: Iir; Subprg_Body : Iir; begin - if Get_Kind (Imp) = Iir_Kind_Implicit_Procedure_Declaration then + if Get_Implicit_Definition (Imp) in Iir_Predefined_Implicit then Execute_Implicit_Procedure (Instance, Call); Update_Next_Statement (Proc); elsif Get_Foreign_Flag (Imp) then diff --git a/src/vhdl/simulate/iir_values.adb b/src/vhdl/simulate/iir_values.adb index d80f3bf..0408799 100644 --- a/src/vhdl/simulate/iir_values.adb +++ b/src/vhdl/simulate/iir_values.adb @@ -21,7 +21,6 @@ with Ada.Unchecked_Conversion; with GNAT.Debug_Utilities; with Name_Table; with Debugger; use Debugger; -with Iirs_Utils; use Iirs_Utils; package body Iir_Values is diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb index 3f3f871..b3a0160 100644 --- a/src/vhdl/simulate/simulation.adb +++ b/src/vhdl/simulate/simulation.adb @@ -1447,6 +1447,7 @@ package body Simulation is Default : Iir_Value_Literal_Acc) is use Grt.Rtis; + use Grt.Signals; procedure Create_Signal (Lit: Iir_Value_Literal_Acc; Sig : Iir_Value_Literal_Acc; @@ -1460,7 +1461,7 @@ package body Simulation is if not Already_Resolved and then Get_Kind (Sig_Type) in Iir_Kinds_Subtype_Definition then - Resolv_Func := Get_Resolution_Function (Sig_Type); + Resolv_Func := Get_Resolution_Indication (Sig_Type); else Resolv_Func := Null_Iir; end if; @@ -1542,12 +1543,11 @@ package body Simulation is type Iir_Kind_To_Kind_Signal_Type is array (Iir_Signal_Kind) of Kind_Signal_Type; Iir_Kind_To_Kind_Signal : constant Iir_Kind_To_Kind_Signal_Type := - (Iir_No_Signal_Kind => Kind_Signal_No, - Iir_Register_Kind => Kind_Signal_Register, + (Iir_Register_Kind => Kind_Signal_Register, Iir_Bus_Kind => Kind_Signal_Bus); begin case Get_Kind (Signal) is - when Iir_Kind_Signal_Interface_Declaration => + when Iir_Kind_Interface_Signal_Declaration => Mode := Iir_Mode_To_Mode_Signal (Get_Mode (Signal)); when Iir_Kind_Signal_Declaration => Mode := Mode_Signal; @@ -1555,7 +1555,11 @@ package body Simulation is Error_Kind ("elaborate_signal", Signal); end case; - Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal)); + if Get_Guarded_Signal_Flag (Signal) then + Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal)); + else + Kind := Kind_Signal_No; + end if; Grt.Signals.Ghdl_Signal_Set_Mode (Mode, Kind, True); |