diff options
Diffstat (limited to 'simulate')
| -rw-r--r-- | simulate/annotations.adb | 8 | ||||
| -rw-r--r-- | simulate/elaboration.adb | 4 | ||||
| -rw-r--r-- | simulate/execution.adb | 92 | ||||
| -rw-r--r-- | simulate/iir_values.adb | 1 | ||||
| -rw-r--r-- | simulate/simulation.adb | 3 |
5 files changed, 69 insertions, 39 deletions
diff --git a/simulate/annotations.adb b/simulate/annotations.adb index b447ba374..4508d8373 100644 --- a/simulate/annotations.adb +++ b/simulate/annotations.adb @@ -380,7 +380,7 @@ package body Annotations is when Iir_Kind_File_Type_Definition => declare - Type_Name : constant Iir := Get_Type_Mark (Def); + Type_Name : constant Iir := Get_Type (Get_File_Type_Mark (Def)); Res : String_Acc; begin if Get_Text_File_Flag (Def) @@ -617,8 +617,10 @@ package body Annotations is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => - Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); - Annotate_Subprogram_Specification (Block_Info, Decl); + if not Is_Second_Subprogram_Specification (Decl) then + Annotate_Subprogram_Interfaces_Type (Block_Info, Decl); + Annotate_Subprogram_Specification (Block_Info, Decl); + end if; when Iir_Kind_Function_Body | Iir_Kind_Procedure_Body => Annotate_Subprogram_Body (Block_Info, Decl); diff --git a/simulate/elaboration.adb b/simulate/elaboration.adb index d968389f7..4808b4589 100644 --- a/simulate/elaboration.adb +++ b/simulate/elaboration.adb @@ -945,7 +945,7 @@ package body Elaboration is -- elaboration of the formal part and the evaluation of the actual -- part. -- FIXME: elaboration of the formal part. - Inter := Get_Formal (Assoc); + Inter := Get_Association_Interface (Assoc); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_Open => -- The generic association list contains an implicit @@ -1110,7 +1110,7 @@ package body Elaboration is -- Elaboration of a port association list consists of the elaboration -- of each port association element in the association list whose -- actual is not the reserved word OPEN. - Inter := Get_Formal (Assoc); + Inter := Get_Association_Interface (Assoc); case Get_Kind (Assoc) is when Iir_Kind_Association_Element_By_Expression => if Get_In_Conversion (Assoc) = Null_Iir diff --git a/simulate/execution.adb b/simulate/execution.adb index a8a73b13a..d82f32f80 100644 --- a/simulate/execution.adb +++ b/simulate/execution.adb @@ -468,8 +468,13 @@ package body Execution is Result := Unshare (Left, Expr_Pool'Access); end Eval_Array; + Imp : Iir; begin - Func := Get_Implicit_Definition (Get_Implementation (Expr)); + Imp := Get_Implementation (Expr); + if Get_Kind (Imp) in Iir_Kinds_Denoting_Name then + Imp := Get_Named_Entity (Imp); + end if; + Func := Get_Implicit_Definition (Imp); -- Eval left operand. case Func is @@ -1350,7 +1355,7 @@ package body Execution is (Block: Block_Instance_Acc; Stmt: Iir_Procedure_Call) is Imp : constant Iir_Implicit_Procedure_Declaration := - Get_Implementation (Stmt); + Get_Named_Entity (Get_Implementation (Stmt)); Assoc_Chain : constant Iir := Get_Parameter_Association_Chain (Stmt); Assoc: Iir; Args: Iir_Value_Literal_Array (0 .. 3); @@ -1663,7 +1668,7 @@ package body Execution is -- When created from static evaluation, a string may still have an -- unconstrained type. - if Get_Kind (Array_Type) = Iir_Kind_Array_Type_Definition then + if Get_Constraint_State (Array_Type) /= Fully_Constrained then Res.Bounds.D (1) := Create_Range_Value (Create_I64_Value (1), Create_I64_Value (Ghdl_I64 (Res.Val_Array.Len)), @@ -2105,6 +2110,8 @@ package body Execution is Natural (Dim - 1)); return Execute_Bounds (Block, Index); end; + when Iir_Kinds_Denoting_Name => + return Execute_Indexes (Block, Get_Named_Entity (Prefix), Dim); when Iir_Kind_Array_Type_Definition | Iir_Kind_Array_Subtype_Definition => Error_Kind ("execute_indexes", Prefix); @@ -2126,9 +2133,8 @@ package body Execution is case Get_Kind (Prefix) is when Iir_Kind_Range_Expression => declare - Info : Sim_Info_Acc; + Info : constant Sim_Info_Acc := Get_Info (Prefix); begin - Info := Get_Info (Prefix); if Info = null then Bound := Create_Range_Value (Execute_Expression (Block, Get_Left_Limit (Prefix)), @@ -2184,6 +2190,9 @@ package body Execution is (Block, Get_Range_Constraint (Get_Type (Get_Type_Declarator (Prefix)))); + when Iir_Kinds_Denoting_Name => + return Execute_Bounds (Block, Get_Named_Entity (Prefix)); + when others => -- Error_Kind ("execute_bounds", Get_Kind (Prefix)); declare @@ -2362,7 +2371,7 @@ package body Execution is function Execute_Signal_Init_Value (Block : Block_Instance_Acc; Expr : Iir) return Iir_Value_Literal_Acc is - Base : constant Iir := Get_Base_Name (Expr); + Base : constant Iir := Get_Object_Prefix (Expr); Info : constant Sim_Info_Acc := Get_Info (Base); Bblk : Block_Instance_Acc; Base_Val : Iir_Value_Literal_Acc; @@ -2543,8 +2552,8 @@ package body Execution is end if; end; - when Iir_Kind_Simple_Name - | Iir_Kind_Selected_Name => + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => Execute_Name_With_Base (Block, Get_Named_Entity (Expr), Base, Res, Is_Sig); @@ -2584,7 +2593,7 @@ package body Execution is return Iir_Value_Literal_Acc is Val : Iir_Value_Literal_Acc; - Attr_Type : constant Iir := Get_Type_Of_Type_Mark (Get_Prefix (Expr)); + Attr_Type : constant Iir := Get_Type (Get_Prefix (Expr)); begin Val := Execute_Expression (Block, Get_Parameter (Expr)); return String_To_Iir_Value @@ -2853,9 +2862,8 @@ package body Execution is | Iir_Kind_Implicit_Dereference => return Execute_Name (Block, Expr); - when Iir_Kind_Simple_Name - | Iir_Kind_Character_Literal - | Iir_Kind_Selected_Name => + when Iir_Kinds_Denoting_Name + | Iir_Kind_Attribute_Name => return Execute_Expression (Block, Get_Named_Entity (Expr)); when Iir_Kind_Aggregate => @@ -2887,11 +2895,11 @@ package body Execution is when Iir_Kind_Function_Call => declare - Imp : Iir; + Imp : constant Iir := + Get_Named_Entity (Get_Implementation (Expr)); Assoc : Iir; Args : Iir_Array (0 .. 1); begin - Imp := Get_Implementation (Expr); if Get_Kind (Imp) = Iir_Kind_Function_Declaration then return Execute_Function_Call (Block, Expr, Imp); else @@ -2956,6 +2964,10 @@ package body Execution is when Iir_Kind_Null_Literal => return Null_Lit; + when Iir_Kind_Overflow_Literal => + Error_Msg_Constraint (Expr); + return null; + when Iir_Kind_Type_Conversion => return Execute_Type_Conversion (Block, Expr, @@ -2963,7 +2975,7 @@ package body Execution is when Iir_Kind_Qualified_Expression => Res := Execute_Expression_With_Type - (Block, Get_Expression (Expr), Get_Type_Mark (Expr)); + (Block, Get_Expression (Expr), Get_Type (Get_Type_Mark (Expr))); return Res; when Iir_Kind_Allocator_By_Expression => @@ -2972,7 +2984,10 @@ package body Execution is return Create_Access_Value (Res); when Iir_Kind_Allocator_By_Subtype => - Res := Create_Value_For_Type (Block, Get_Expression (Expr), True); + Res := Create_Value_For_Type + (Block, + Get_Type_Of_Subtype_Indication (Get_Subtype_Indication (Expr)), + True); Res := Unshare_Heap (Res); return Create_Access_Value (Res); @@ -3052,8 +3067,7 @@ package body Execution is when Iir_Kind_Val_Attribute => declare - Prefix_Type: constant Iir := - Get_Type_Of_Type_Mark (Get_Prefix (Expr)); + Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr)); Base_Type : constant Iir := Get_Base_Type (Prefix_Type); Mode : constant Iir_Value_Kind := Get_Info (Base_Type).Scalar_Mode; @@ -3077,8 +3091,7 @@ package body Execution is when Iir_Kind_Pos_Attribute => declare N_Res: Iir_Value_Literal_Acc; - Prefix_Type: constant Iir := - Get_Type_Of_Type_Mark (Get_Prefix (Expr)); + Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr)); Base_Type : constant Iir := Get_Base_Type (Prefix_Type); Mode : constant Iir_Value_Kind := Get_Info (Base_Type).Scalar_Mode; @@ -3119,7 +3132,7 @@ package body Execution is begin Res := Execute_Expression (Block, Get_Parameter (Expr)); Bound := Execute_Bounds - (Block, Get_Type_Of_Type_Mark (Get_Prefix (Expr))); + (Block, Get_Type (Get_Prefix (Expr))); case Bound.Dir is when Iir_To => Res := Execute_Dec (Res, Expr); @@ -3136,7 +3149,7 @@ package body Execution is begin Res := Execute_Expression (Block, Get_Parameter (Expr)); Bound := Execute_Bounds - (Block, Get_Type_Of_Type_Mark (Get_Prefix (Expr))); + (Block, Get_Type (Get_Prefix (Expr))); case Bound.Dir is when Iir_Downto => Res := Execute_Dec (Res, Expr); @@ -3315,15 +3328,28 @@ package body Execution is (Block : Block_Instance_Acc; Conv : Iir; Val : Iir_Value_Literal_Acc) return Iir_Value_Literal_Acc is + Ent : Iir; begin - if Get_Kind (Conv) = Iir_Kind_Function_Call then - return Execute_Assoc_Function_Conversion - (Block, Get_Implementation (Conv), Val); - elsif Get_Kind (Conv) = Iir_Kind_Function_Declaration then - return Execute_Assoc_Function_Conversion (Block, Conv, Val); - else - return Execute_Type_Conversion (Block, Conv, Val); - end if; + case Get_Kind (Conv) 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); + 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); + 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 + return Execute_Type_Conversion (Block, Ent, Val); + else + Error_Kind ("execute_assoc_conversion(1)", Ent); + end if; + when others => + Error_Kind ("execute_assoc_conversion(2)", Conv); + end case; end Execute_Assoc_Conversion; -- Establish correspondance for association list ASSOC_LIST from block @@ -3352,7 +3378,7 @@ package body Execution is Assoc_Idx := 1; while Assoc /= Null_Iir loop Formal := Get_Formal (Assoc); - Inter := Get_Base_Name (Formal); + Inter := Get_Association_Interface (Assoc); -- Extract the actual value. case Get_Kind (Assoc) is @@ -3508,7 +3534,7 @@ package body Execution is while Assoc /= Null_Iir loop if Get_Kind (Assoc) /= Iir_Kind_Association_Element_By_Individual then Formal := Get_Formal (Assoc); - Inter := Get_Base_Name (Formal); + Inter := Get_Association_Interface (Assoc); case Get_Kind (Inter) is when Iir_Kind_Variable_Interface_Declaration => if Get_Mode (Inter) /= Iir_In_Mode @@ -4511,7 +4537,7 @@ 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_Implementation (Call); + Imp : constant Iir := Get_Named_Entity (Get_Implementation (Call)); Subprg_Instance : Block_Instance_Acc; Assoc_Chain: Iir; Subprg_Body : Iir; diff --git a/simulate/iir_values.adb b/simulate/iir_values.adb index 67784df58..93c0ade7c 100644 --- a/simulate/iir_values.adb +++ b/simulate/iir_values.adb @@ -21,6 +21,7 @@ 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/simulate/simulation.adb b/simulate/simulation.adb index 6a725ee9d..350192ab3 100644 --- a/simulate/simulation.adb +++ b/simulate/simulation.adb @@ -19,6 +19,7 @@ with Ada.Unchecked_Conversion; with Ada.Text_IO; use Ada.Text_IO; with Errorout; use Errorout; +with Iirs_Utils; use Iirs_Utils; with Trans_Analyzes; with Types; use Types; with Debugger; use Debugger; @@ -1592,7 +1593,7 @@ package body Simulation is Instance_Pool := Global_Pool'Access; Elaboration.Elaborate_Design (Top_Config); - Entity := Get_Entity (Get_Library_Unit (Top_Config)); + Entity := Iirs_Utils.Get_Entity (Get_Library_Unit (Top_Config)); if not Is_Empty (Expr_Pool) then raise Internal_Error; |