aboutsummaryrefslogtreecommitdiffstats
path: root/simulate
diff options
context:
space:
mode:
Diffstat (limited to 'simulate')
-rw-r--r--simulate/annotations.adb8
-rw-r--r--simulate/elaboration.adb4
-rw-r--r--simulate/execution.adb92
-rw-r--r--simulate/iir_values.adb1
-rw-r--r--simulate/simulation.adb3
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;