diff options
Diffstat (limited to 'simulate')
| -rw-r--r-- | simulate/annotations.adb | 3 | ||||
| -rw-r--r-- | simulate/elaboration.adb | 6 | ||||
| -rw-r--r-- | simulate/execution.adb | 587 | ||||
| -rw-r--r-- | simulate/execution.ads | 2 | ||||
| -rw-r--r-- | simulate/file_operation.adb | 5 | ||||
| -rw-r--r-- | simulate/file_operation.ads | 2 | ||||
| -rw-r--r-- | simulate/iir_values.adb | 24 | ||||
| -rw-r--r-- | simulate/iir_values.ads | 3 | ||||
| -rw-r--r-- | simulate/simulation.adb | 2 |
9 files changed, 559 insertions, 75 deletions
diff --git a/simulate/annotations.adb b/simulate/annotations.adb index e4e921aca..00c8f715b 100644 --- a/simulate/annotations.adb +++ b/simulate/annotations.adb @@ -604,8 +604,9 @@ package body Annotations is Add_Quantity_Info (Block_Info, Decl); when Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration | Iir_Kind_Anonymous_Type_Declaration => + Annotate_Type_Definition (Block_Info, Get_Type_Definition (Decl)); + when Iir_Kind_Subtype_Declaration => Annotate_Type_Definition (Block_Info, Get_Type (Decl)); when Iir_Kind_Protected_Type_Body => diff --git a/simulate/elaboration.adb b/simulate/elaboration.adb index 1b7b9cd3a..ec2442acd 100644 --- a/simulate/elaboration.adb +++ b/simulate/elaboration.adb @@ -346,6 +346,8 @@ package body Elaboration is end if; else -- Note: the body can elaborate some packages. + Elaborate_Dependence (Body_Design); + Elaborate_Package_Body (Get_Library_Unit (Body_Design)); end if; @@ -842,7 +844,7 @@ package body Elaboration is -- Elaboration of a type declaration generally consists of the -- elaboration of the definition of the type and the creation of that -- type. - Def := Get_Type (Decl); + Def := Get_Type_Definition (Decl); if Def = Null_Iir then -- FIXME: can this happen ? raise Program_Error; @@ -2177,7 +2179,7 @@ package body Elaboration is | Iir_Kind_Implicit_Procedure_Declaration => null; when Iir_Kind_Anonymous_Type_Declaration => - Elaborate_Type_Definition (Instance, Get_Type (Decl)); + Elaborate_Type_Definition (Instance, Get_Type_Definition (Decl)); when Iir_Kind_Type_Declaration => Elaborate_Type_Declaration (Instance, Decl); when Iir_Kind_Subtype_Declaration => diff --git a/simulate/execution.adb b/simulate/execution.adb index 3be904fd4..a3a29d485 100644 --- a/simulate/execution.adb +++ b/simulate/execution.adb @@ -40,6 +40,7 @@ with Grt.Vstrings; with Grt_Interface; with Grt.Values; with Grt.Errors; +with Grt.Std_Logic_1164; package body Execution is @@ -53,6 +54,11 @@ package body Execution is (Proc : Process_State_Acc; Complex_Stmt : Iir); procedure Update_Next_Statement (Proc : Process_State_Acc); + -- Display a message when an assertion has failed. + procedure Execute_Failed_Assertion (Report : String; + Severity : Natural; + Stmt: Iir); + function Get_Instance_By_Scope_Level (Instance: Block_Instance_Acc; Scope_Level: Scope_Level_Type) return Block_Instance_Acc @@ -150,6 +156,44 @@ package body Execution is return Res; end Create_Bounds_From_Length; + function Execute_High_Limit (Bounds : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + if Bounds.Dir = Iir_To then + return Bounds.Right; + else + return Bounds.Left; + end if; + end Execute_High_Limit; + + function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + if Bounds.Dir = Iir_To then + return Bounds.Left; + else + return Bounds.Right; + end if; + end Execute_Low_Limit; + + function Execute_Left_Limit (Bounds : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + return Bounds.Left; + end Execute_Left_Limit; + + function Execute_Right_Limit (Bounds : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + return Bounds.Right; + end Execute_Right_Limit; + + function Execute_Length (Bounds : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + return Create_I64_Value (Ghdl_I64 (Bounds.Length)); + end Execute_Length; + function Create_Enum_Value (Pos : Natural; Etype : Iir) return Iir_Value_Literal_Acc is @@ -348,6 +392,48 @@ package body Execution is return Res; end Execute_Shift_Operator; + Hex_Chars : constant array (Natural range 0 .. 15) of Character := + "0123456789ABCDEF"; + + function Execute_Bit_Vector_To_String (Val : Iir_Value_Literal_Acc; + Log_Base : Natural) + return Iir_Value_Literal_Acc + is + Base : constant Natural := 2 ** Log_Base; + Blen : constant Natural := Natural (Val.Bounds.D (1).Length); + Str : String (1 .. (Blen + Log_Base - 1) / Log_Base); + Pos : Natural; + V : Natural; + N : Natural; + begin + V := 0; + N := 1; + Pos := Str'Last; + for I in reverse Val.Val_Array.V'Range loop + V := V + Ghdl_B2'Pos (Val.Val_Array.V (I).B2) * N; + N := N * 2; + if N = Base or else I = Val.Val_Array.V'First then + Str (Pos) := Hex_Chars (V); + Pos := Pos - 1; + N := 1; + V := 0; + end if; + end loop; + return String_To_Iir_Value (Str); + end Execute_Bit_Vector_To_String; + + procedure Check_Std_Ulogic_Dc + (Loc : Iir; V : Grt.Std_Logic_1164.Std_Ulogic) + is + use Grt.Std_Logic_1164; + begin + if V = '-' then + Execute_Failed_Assertion + ("STD_LOGIC_1164: '-' operand for matching ordering operator", + 2, Loc); + end if; + end Check_Std_Ulogic_Dc; + -- EXPR is the expression whose implementation is an implicit function. function Execute_Implicit_Function (Block : Block_Instance_Acc; Expr: Iir; @@ -385,12 +471,18 @@ package body Execution is begin Func := Get_Implicit_Definition (Get_Implementation (Expr)); - -- Eval left operand (only if the predefined function is not NOW). - if Func /= Iir_Predefined_Now_Function then - Left := Execute_Expression (Block, Left_Param); - else - Left := null; - end if; + -- Eval left operand. + case Func is + when Iir_Predefined_Now_Function => + Left := null; + when Iir_Predefined_Bit_Rising_Edge + | Iir_Predefined_Boolean_Rising_Edge + | Iir_Predefined_Bit_Falling_Edge + | Iir_Predefined_Boolean_Falling_Edge=> + Operand := Execute_Name (Block, Left_Param, True); + when others => + Left := Execute_Expression (Block, Left_Param); + end case; Right := null; case Func is @@ -521,6 +613,9 @@ package body Execution is | Iir_Predefined_Boolean_Not => Result := Boolean_To_Lit (Operand.B2 = Lit_Enum_0.B2); + when Iir_Predefined_Bit_Condition => + Result := Boolean_To_Lit (Operand.B2 = Lit_Enum_1.B2); + when Iir_Predefined_Array_Sll | Iir_Predefined_Array_Srl | Iir_Predefined_Array_Sla @@ -536,7 +631,9 @@ package body Execution is | Iir_Predefined_Access_Equality | Iir_Predefined_Physical_Equality | Iir_Predefined_Floating_Equality - | Iir_Predefined_Record_Equality => + | Iir_Predefined_Record_Equality + | Iir_Predefined_Bit_Match_Equality + | Iir_Predefined_Bit_Array_Match_Equality => Eval_Right; Result := Boolean_To_Lit (Is_Equal (Left, Right)); when Iir_Predefined_Enum_Inequality @@ -545,7 +642,9 @@ package body Execution is | Iir_Predefined_Access_Inequality | Iir_Predefined_Physical_Inequality | Iir_Predefined_Floating_Inequality - | Iir_Predefined_Record_Inequality => + | Iir_Predefined_Record_Inequality + | Iir_Predefined_Bit_Match_Inequality + | Iir_Predefined_Bit_Array_Match_Inequality => Eval_Right; Result := Boolean_To_Lit (not Is_Equal (Left, Right)); when Iir_Predefined_Integer_Less @@ -625,6 +724,23 @@ package body Execution is raise Internal_Error; end case; + when Iir_Predefined_Enum_Minimum + | Iir_Predefined_Physical_Minimum => + Eval_Right; + if Compare_Value (Left, Right) = Less then + Result := Left; + else + Result := Right; + end if; + when Iir_Predefined_Enum_Maximum + | Iir_Predefined_Physical_Maximum => + Eval_Right; + if Compare_Value (Left, Right) = Less then + Result := Right; + else + Result := Left; + end if; + when Iir_Predefined_Integer_Plus | Iir_Predefined_Physical_Plus => Eval_Right; @@ -834,6 +950,102 @@ package body Execution is Result.Val_Array.V (I).B2 := Result.Val_Array.V (I).B2 xor Right.Val_Array.V (I).B2; end loop; + when Iir_Predefined_TF_Array_Xnor => + Eval_Array; + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 xor Right.Val_Array.V (I).B2); + end loop; + + when Iir_Predefined_TF_Array_Element_And => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 and Right.B2; + end loop; + when Iir_Predefined_TF_Element_Array_And => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 and Left.B2; + end loop; + + when Iir_Predefined_TF_Array_Element_Or => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 or Right.B2; + end loop; + when Iir_Predefined_TF_Element_Array_Or => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 or Left.B2; + end loop; + + when Iir_Predefined_TF_Array_Element_Xor => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 xor Right.B2; + end loop; + when Iir_Predefined_TF_Element_Array_Xor => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + Result.Val_Array.V (I).B2 xor Left.B2; + end loop; + + when Iir_Predefined_TF_Array_Element_Nand => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 and Right.B2); + end loop; + when Iir_Predefined_TF_Element_Array_Nand => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 and Left.B2); + end loop; + + when Iir_Predefined_TF_Array_Element_Nor => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 or Right.B2); + end loop; + when Iir_Predefined_TF_Element_Array_Nor => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 or Left.B2); + end loop; + + when Iir_Predefined_TF_Array_Element_Xnor => + Eval_Right; + Result := Unshare (Left, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 xor Right.B2); + end loop; + when Iir_Predefined_TF_Element_Array_Xnor => + Eval_Right; + Result := Unshare (Right, Expr_Pool'Access); + for I in Result.Val_Array.V'Range loop + Result.Val_Array.V (I).B2 := + not (Result.Val_Array.V (I).B2 xor Left.B2); + end loop; when Iir_Predefined_TF_Array_Not => -- Need to copy as the result is modified. @@ -842,6 +1054,51 @@ package body Execution is Result.Val_Array.V (I).B2 := not Result.Val_Array.V (I).B2; end loop; + when Iir_Predefined_TF_Reduction_And => + Result := Create_B2_Value (True); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 and Operand.Val_Array.V (I).B2; + end loop; + when Iir_Predefined_TF_Reduction_Nand => + Result := Create_B2_Value (True); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 and Operand.Val_Array.V (I).B2; + end loop; + Result.B2 := not Result.B2; + when Iir_Predefined_TF_Reduction_Or => + Result := Create_B2_Value (False); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 or Operand.Val_Array.V (I).B2; + end loop; + when Iir_Predefined_TF_Reduction_Nor => + Result := Create_B2_Value (False); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 or Operand.Val_Array.V (I).B2; + end loop; + Result.B2 := not Result.B2; + when Iir_Predefined_TF_Reduction_Xor => + Result := Create_B2_Value (False); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 xor Operand.Val_Array.V (I).B2; + end loop; + when Iir_Predefined_TF_Reduction_Xnor => + Result := Create_B2_Value (False); + for I in Operand.Val_Array.V'Range loop + Result.B2 := Result.B2 xor Operand.Val_Array.V (I).B2; + end loop; + Result.B2 := not Result.B2; + + when Iir_Predefined_Bit_Rising_Edge + | Iir_Predefined_Boolean_Rising_Edge => + return Boolean_To_Lit + (Execute_Event_Attribute (Operand) + and then Execute_Signal_Value (Operand).B2 = True); + when Iir_Predefined_Bit_Falling_Edge + | Iir_Predefined_Boolean_Falling_Edge => + return Boolean_To_Lit + (Execute_Event_Attribute (Operand) + and then Execute_Signal_Value (Operand).B2 = False); + when Iir_Predefined_Array_Greater => Eval_Right; Result := Boolean_To_Lit (Compare_Value (Left, Right) = Greater); @@ -858,16 +1115,226 @@ package body Execution is Eval_Right; Result := Boolean_To_Lit (Compare_Value (Left, Right) <= Equal); + when Iir_Predefined_Array_Minimum => + Eval_Right; + if Compare_Value (Left, Right) = Less then + Result := Left; + else + Result := Right; + end if; + when Iir_Predefined_Array_Maximum => + Eval_Right; + if Compare_Value (Left, Right) = Less then + Result := Right; + else + Result := Left; + end if; + + when Iir_Predefined_Vector_Maximum => + declare + El_St : constant Iir := + Get_Return_Type (Get_Implementation (Expr)); + V : Iir_Value_Literal_Acc; + begin + Result := Execute_Low_Limit (Execute_Bounds (Block, El_St)); + for I in Left.Val_Array.V'Range loop + V := Left.Val_Array.V (I); + if Compare_Value (V, Result) = Greater then + Result := V; + end if; + end loop; + end; + when Iir_Predefined_Vector_Minimum => + declare + El_St : constant Iir := + Get_Return_Type (Get_Implementation (Expr)); + V : Iir_Value_Literal_Acc; + begin + Result := Execute_High_Limit (Execute_Bounds (Block, El_St)); + for I in Left.Val_Array.V'Range loop + V := Left.Val_Array.V (I); + if Compare_Value (V, Result) = Less then + Result := V; + end if; + end loop; + end; + when Iir_Predefined_Endfile => Result := Boolean_To_Lit (File_Operation.Endfile (Left, Null_Iir)); when Iir_Predefined_Now_Function => Result := Create_I64_Value (Ghdl_I64 (Grt.Types.Current_Time)); - when Iir_Predefined_Integer_To_String => + when Iir_Predefined_Integer_To_String + | Iir_Predefined_Floating_To_String + | Iir_Predefined_Physical_To_String => Result := String_To_Iir_Value (Execute_Image_Attribute (Left, Get_Type (Left_Param))); + when Iir_Predefined_Enum_To_String => + declare + use Name_Table; + Base_Type : constant Iir := + Get_Base_Type (Get_Type (Left_Param)); + Lits : constant Iir_List := + Get_Enumeration_Literal_List (Base_Type); + Pos : constant Natural := Get_Enum_Pos (Left); + Id : Name_Id; + begin + if Base_Type = Std_Package.Character_Type_Definition then + Result := String_To_Iir_Value ((1 => Character'Val (Pos))); + else + Id := Get_Identifier (Get_Nth_Element (Lits, Pos)); + if Is_Character (Id) then + Result := String_To_Iir_Value ((1 => Get_Character (Id))); + else + Result := String_To_Iir_Value (Image (Id)); + end if; + end if; + end; + + when Iir_Predefined_Array_Char_To_String => + declare + Str : String (1 .. Natural (Left.Bounds.D (1).Length)); + Lits : constant Iir_List := + Get_Enumeration_Literal_List + (Get_Base_Type + (Get_Element_Subtype (Get_Type (Left_Param)))); + Pos : Natural; + begin + for I in Left.Val_Array.V'Range loop + Pos := Get_Enum_Pos (Left.Val_Array.V (I)); + Str (Positive (I)) := Name_Table.Get_Character + (Get_Identifier (Get_Nth_Element (Lits, Pos))); + end loop; + Result := String_To_Iir_Value (Str); + end; + + when Iir_Predefined_Bit_Vector_To_Hstring => + return Execute_Bit_Vector_To_String (Left, 4); + + when Iir_Predefined_Bit_Vector_To_Ostring => + return Execute_Bit_Vector_To_String (Left, 3); + + when Iir_Predefined_Real_To_String_Digits => + Eval_Right; + declare + Str : Grt.Vstrings.String_Real_Digits; + Last : Natural; + begin + Grt.Vstrings.To_String + (Str, Last, Left.F64, Ghdl_I32 (Right.I64)); + Result := String_To_Iir_Value (Str (1 .. Last)); + end; + when Iir_Predefined_Real_To_String_Format => + Eval_Right; + declare + Format : String (1 .. Natural (Right.Val_Array.Len) + 1); + Str : Grt.Vstrings.String_Real_Format; + Last : Natural; + begin + for I in Right.Val_Array.V'Range loop + Format (Positive (I)) := + Character'Val (Right.Val_Array.V (I).E32); + end loop; + Format (Format'Last) := ASCII.NUL; + Grt.Vstrings.To_String + (Str, Last, Left.F64, To_Ghdl_C_String (Format'Address)); + Result := String_To_Iir_Value (Str (1 .. Last)); + end; + when Iir_Predefined_Time_To_String_Unit => + Eval_Right; + declare + Str : Grt.Vstrings.String_Time_Unit; + First : Natural; + Unit : Iir; + begin + Unit := Get_Unit_Chain (Std_Package.Time_Type_Definition); + while Unit /= Null_Iir loop + exit when Evaluation.Get_Physical_Value (Unit) + = Iir_Int64 (Right.I64); + Unit := Get_Chain (Unit); + end loop; + if Unit = Null_Iir then + Error_Msg_Exec + ("to_string for time called with wrong unit", Expr); + end if; + Grt.Vstrings.To_String (Str, First, Left.I64, Right.I64); + Result := String_To_Iir_Value + (Str (First .. Str'Last) & ' ' + & Name_Table.Image (Get_Identifier (Unit))); + end; + + when Iir_Predefined_Std_Ulogic_Match_Equality => + Eval_Right; + declare + use Grt.Std_Logic_1164; + begin + Result := Create_E32_Value + (Std_Ulogic'Pos + (Match_Eq_Table (Std_Ulogic'Val (Left.E32), + Std_Ulogic'Val (Right.E32)))); + end; + when Iir_Predefined_Std_Ulogic_Match_Inequality => + Eval_Right; + declare + use Grt.Std_Logic_1164; + begin + Result := Create_E32_Value + (Std_Ulogic'Pos + (Not_Table (Match_Eq_Table (Std_Ulogic'Val (Left.E32), + Std_Ulogic'Val (Right.E32))))); + end; + when Iir_Predefined_Std_Ulogic_Match_Ordering_Functions => + Eval_Right; + declare + use Grt.Std_Logic_1164; + L : constant Std_Ulogic := Std_Ulogic'Val (Left.E32); + R : constant Std_Ulogic := Std_Ulogic'Val (Right.E32); + Res : Std_Ulogic; + begin + Check_Std_Ulogic_Dc (Expr, L); + Check_Std_Ulogic_Dc (Expr, R); + case Iir_Predefined_Std_Ulogic_Match_Ordering_Functions (Func) + is + when Iir_Predefined_Std_Ulogic_Match_Less => + Res := Match_Lt_Table (L, R); + when Iir_Predefined_Std_Ulogic_Match_Less_Equal => + Res := Or_Table (Match_Lt_Table (L, R), + Match_Eq_Table (L, R)); + when Iir_Predefined_Std_Ulogic_Match_Greater => + Res := Not_Table (Or_Table (Match_Lt_Table (L, R), + Match_Eq_Table (L, R))); + when Iir_Predefined_Std_Ulogic_Match_Greater_Equal => + Res := Not_Table (Match_Lt_Table (L, R)); + end case; + Result := Create_E32_Value (Std_Ulogic'Pos (Res)); + end; + + when Iir_Predefined_Std_Ulogic_Array_Match_Equality + | Iir_Predefined_Std_Ulogic_Array_Match_Inequality => + Eval_Right; + if Left.Bounds.D (1).Length /= Right.Bounds.D (1).Length then + Error_Msg_Constraint (Expr); + end if; + declare + use Grt.Std_Logic_1164; + Res : Std_Ulogic := '1'; + begin + Result := Create_E32_Value (Std_Ulogic'Pos ('1')); + for I in Left.Val_Array.V'Range loop + Res := And_Table + (Res, + Match_Eq_Table + (Std_Ulogic'Val (Left.Val_Array.V (I).E32), + Std_Ulogic'Val (Right.Val_Array.V (I).E32))); + end loop; + if Func = Iir_Predefined_Std_Ulogic_Array_Match_Inequality then + Res := Not_Table (Res); + end if; + Result := Create_E32_Value (Std_Ulogic'Pos (Res)); + end; + when others => Error_Msg ("execute_implicit_function: unimplemented " & Iir_Predefined_Functions'Image (Func)); @@ -927,6 +1394,8 @@ package body Execution is end if; when Iir_Predefined_Read => File_Operation.Read_Binary (Args (0), Args (1)); + when Iir_Predefined_Flush => + File_Operation.Flush (Args (0)); when Iir_Predefined_File_Close => if Get_Text_File_Flag (Get_Type (Inter_Chain)) then File_Operation.File_Close_Text (Args (0), Stmt); @@ -961,6 +1430,9 @@ package body Execution is when Std_Names.Name_Untruncated_Text_Read => File_Operation.Untruncated_Text_Read (Args (0), Args (1), Args (2)); + when Std_Names.Name_Control_Simulation => + Put_Line (Standard_Error, "simulation finished"); + raise Simulation_Finished; when others => Error_Msg_Exec ("unsupported foreign procedure call", Stmt); end case; @@ -1727,44 +2199,6 @@ package body Execution is return Bound; end Execute_Bounds; - function Execute_High_Limit (Bounds : Iir_Value_Literal_Acc) - return Iir_Value_Literal_Acc is - begin - if Bounds.Dir = Iir_To then - return Bounds.Right; - else - return Bounds.Left; - end if; - end Execute_High_Limit; - - function Execute_Low_Limit (Bounds : Iir_Value_Literal_Acc) - return Iir_Value_Literal_Acc is - begin - if Bounds.Dir = Iir_To then - return Bounds.Left; - else - return Bounds.Right; - end if; - end Execute_Low_Limit; - - function Execute_Left_Limit (Bounds : Iir_Value_Literal_Acc) - return Iir_Value_Literal_Acc is - begin - return Bounds.Left; - end Execute_Left_Limit; - - function Execute_Right_Limit (Bounds : Iir_Value_Literal_Acc) - return Iir_Value_Literal_Acc is - begin - return Bounds.Right; - end Execute_Right_Limit; - - function Execute_Length (Bounds : Iir_Value_Literal_Acc) - return Iir_Value_Literal_Acc is - begin - return Create_I64_Value (Ghdl_I64 (Bounds.Length)); - end Execute_Length; - -- Perform type conversion as desribed in LRM93 7.3.5 function Execute_Type_Conversion (Block: Block_Instance_Acc; Conv : Iir_Type_Conversion; @@ -1996,8 +2430,13 @@ package body Execution is if Base /= null then Res := Base; else - Slot_Block := Get_Instance_For_Slot (Block, Expr); - Res := Slot_Block.Objects (Get_Info (Expr).Slot); + declare + Info : constant Sim_Info_Acc := Get_Info (Expr); + begin + Slot_Block := + Get_Instance_By_Scope_Level (Block, Info.Scope_Level); + Res := Slot_Block.Objects (Info.Slot); + end; end if; when Iir_Kind_Indexed_Name => @@ -2145,7 +2584,7 @@ package body Execution is return Iir_Value_Literal_Acc is Val : Iir_Value_Literal_Acc; - Attr_Type : constant Iir := Get_Type (Get_Prefix (Expr)); + Attr_Type : constant Iir := Get_Type_Of_Type_Mark (Get_Prefix (Expr)); begin Val := Execute_Expression (Block, Get_Parameter (Expr)); return String_To_Iir_Value @@ -2612,7 +3051,8 @@ package body Execution is when Iir_Kind_Val_Attribute => declare - Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr)); + Prefix_Type: constant Iir := + Get_Type_Of_Type_Mark (Get_Prefix (Expr)); Base_Type : constant Iir := Get_Base_Type (Prefix_Type); Mode : constant Iir_Value_Kind := Get_Info (Base_Type).Scalar_Mode; @@ -2636,7 +3076,8 @@ package body Execution is when Iir_Kind_Pos_Attribute => declare N_Res: Iir_Value_Literal_Acc; - Prefix_Type: constant Iir := Get_Type (Get_Prefix (Expr)); + Prefix_Type: constant Iir := + Get_Type_Of_Type_Mark (Get_Prefix (Expr)); Base_Type : constant Iir := Get_Base_Type (Prefix_Type); Mode : constant Iir_Value_Kind := Get_Info (Base_Type).Scalar_Mode; @@ -2676,7 +3117,8 @@ package body Execution is Bound : Iir_Value_Literal_Acc; begin Res := Execute_Expression (Block, Get_Parameter (Expr)); - Bound := Execute_Bounds (Block, Get_Type (Get_Prefix (Expr))); + Bound := Execute_Bounds + (Block, Get_Type_Of_Type_Mark (Get_Prefix (Expr))); case Bound.Dir is when Iir_To => Res := Execute_Dec (Res, Expr); @@ -2692,7 +3134,8 @@ package body Execution is Bound : Iir_Value_Literal_Acc; begin Res := Execute_Expression (Block, Get_Parameter (Expr)); - Bound := Execute_Bounds (Block, Get_Type (Get_Prefix (Expr))); + Bound := Execute_Bounds + (Block, Get_Type_Of_Type_Mark (Get_Prefix (Expr))); case Bound.Dir is when Iir_Downto => Res := Execute_Dec (Res, Expr); @@ -3638,7 +4081,7 @@ package body Execution is -- REPORT is the value (string) to display, or null to use default message. -- SEVERITY is the severity or null to use default (error). -- STMT is used to display location. - procedure Execute_Failed_Assertion (Report : Iir_Value_Literal_Acc; + procedure Execute_Failed_Assertion (Report : String; Severity : Natural; Stmt: Iir) is begin @@ -3671,17 +4114,7 @@ package body Execution is Put (Standard_Error, "): "); -- 3: the value of the message string. - if Report /= null then - for I in Report.Val_Array.V'Range loop - Put (Standard_Error, Character'Val (Report.Val_Array.V (I).E32)); - end loop; - New_Line (Standard_Error); - else - -- The default value for the message string is: - -- "Assertion violation.". - -- Does the message string include quotes ? - Put_Line (Standard_Error, "Assertion violation."); - end if; + Put_Line (Standard_Error, Report); -- Stop execution if the severity is too high. if Severity >= Grt.Options.Severity_Level then @@ -3690,6 +4123,28 @@ package body Execution is end if; end Execute_Failed_Assertion; + procedure Execute_Failed_Assertion (Report : Iir_Value_Literal_Acc; + Severity : Natural; + Stmt: Iir) is + begin + if Report /= null then + declare + Msg : String (1 .. Natural (Report.Val_Array.Len)); + begin + for I in Report.Val_Array.V'Range loop + Msg (Positive (I)) := + Character'Val (Report.Val_Array.V (I).E32); + end loop; + Execute_Failed_Assertion (Msg, Severity, Stmt); + end; + else + -- The default value for the message string is: + -- "Assertion violation.". + -- Does the message string include quotes ? + Execute_Failed_Assertion ("Assertion violation.", Severity, Stmt); + end if; + end Execute_Failed_Assertion; + procedure Execute_Report_Statement (Instance: Block_Instance_Acc; Stmt: Iir; Default_Severity : Natural) is diff --git a/simulate/execution.ads b/simulate/execution.ads index e6ccd1eb6..faed1111d 100644 --- a/simulate/execution.ads +++ b/simulate/execution.ads @@ -44,6 +44,8 @@ package Execution is end record; type Process_State_Acc is access all Process_State_Type; + Simulation_Finished : exception; + -- Current process being executed. This is only for the debugger. Current_Process : Process_State_Acc; diff --git a/simulate/file_operation.adb b/simulate/file_operation.adb index 03b346908..2404c4066 100644 --- a/simulate/file_operation.adb +++ b/simulate/file_operation.adb @@ -333,4 +333,9 @@ package body File_Operation is end loop; Length.I64 := Ghdl_I64 (Len); end Read_Length_Binary; + + procedure Flush (File : Iir_Value_Literal_Acc) is + begin + Ghdl_File_Flush (File.File); + end Flush; end File_Operation; diff --git a/simulate/file_operation.ads b/simulate/file_operation.ads index 39cbbb486..b66a06756 100644 --- a/simulate/file_operation.ads +++ b/simulate/file_operation.ads @@ -73,6 +73,8 @@ package File_Operation is Str : Iir_Value_Literal_Acc; Length : Iir_Value_Literal_Acc); + procedure Flush (File : Iir_Value_Literal_Acc); + -- Test end of FILE is reached. function Endfile (File : Iir_Value_Literal_Acc; Stmt : Iir) return Boolean; diff --git a/simulate/iir_values.adb b/simulate/iir_values.adb index 1de8b8803..67784df58 100644 --- a/simulate/iir_values.adb +++ b/simulate/iir_values.adb @@ -743,6 +743,18 @@ package body Iir_Values is end case; end Get_Nbr_Of_Scalars; + function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural is + begin + case Val.Kind is + when Iir_Value_E32 => + return Ghdl_E32'Pos (Val.E32); + when Iir_Value_B2 => + return Ghdl_B2'Pos (Val.B2); + when others => + raise Internal_Error; + end case; + end Get_Enum_Pos; + procedure Disp_Value_Tab (Value: Iir_Value_Literal_Acc; Tab: Ada.Text_IO.Count) is @@ -897,7 +909,7 @@ package body Iir_Values is Last_Enum: Last_Enum_Type; El_Type: Iir; Enum_List: Iir_List; - El: Name_Id; + El_Id : Name_Id; El_Pos : Natural; begin if Dim = Value.Bounds.Nbr_Dims then @@ -911,10 +923,10 @@ package body Iir_Values is Last_Enum := None; Enum_List := Get_Enumeration_Literal_List (El_Type); for I in 1 .. Value.Bounds.D (Dim).Length loop - El_Pos := Ghdl_E32'Pos (Value.Val_Array.V (Off).E32); + El_Pos := Get_Enum_Pos (Value.Val_Array.V (Off)); Off := Off + 1; - El := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos)); - if Name_Table.Is_Character (El) then + El_Id := Get_Identifier (Get_Nth_Element (Enum_List, El_Pos)); + if Name_Table.Is_Character (El_Id) then case Last_Enum is when None => Put (""""); @@ -923,7 +935,7 @@ package body Iir_Values is when Char => null; end case; - Put (Name_Table.Get_Character (El)); + Put (Name_Table.Get_Character (El_Id)); Last_Enum := Char; else case Last_Enum is @@ -934,7 +946,7 @@ package body Iir_Values is when Char => Put (""" & "); end case; - Put (Name_Table.Image (El)); + Put (Name_Table.Image (El_Id)); Last_Enum := Identifier; end if; end loop; diff --git a/simulate/iir_values.ads b/simulate/iir_values.ads index 7cbc892fa..54f9dfb4d 100644 --- a/simulate/iir_values.ads +++ b/simulate/iir_values.ads @@ -319,6 +319,9 @@ package Iir_Values is -- Return the number of scalars elements in VALS. function Get_Nbr_Of_Scalars (Val : Iir_Value_Literal_Acc) return Natural; + -- Return the position of an enumerated type value. + function Get_Enum_Pos (Val : Iir_Value_Literal_Acc) return Natural; + -- Well known values. -- Boolean_to_lit can be used to convert a boolean value from Ada to a -- boolean value for vhdl. diff --git a/simulate/simulation.adb b/simulate/simulation.adb index 304faa9b2..6a725ee9d 100644 --- a/simulate/simulation.adb +++ b/simulate/simulation.adb @@ -1661,6 +1661,8 @@ package body Simulation is exception when Debugger_Quit => null; + when Simulation_Finished => + null; end Simulation_Entity; end Simulation; |