diff options
| -rw-r--r-- | src/vhdl/simulate/elaboration.adb | 67 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.adb | 96 | ||||
| -rw-r--r-- | src/vhdl/simulate/execution.ads | 9 |
3 files changed, 63 insertions, 109 deletions
diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 013a25f..b05f625 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -516,6 +516,56 @@ package body Elaboration is return Res; end Create_Value_For_Type; + procedure Init_To_Default + (Targ : Iir_Value_Literal_Acc; Block: Block_Instance_Acc; Atype : Iir) is + begin + case Get_Kind (Atype) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Integer_Type_Definition + | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Floating_Subtype_Definition + | Iir_Kind_Floating_Type_Definition + | Iir_Kind_Physical_Subtype_Definition + | Iir_Kind_Physical_Type_Definition => + declare + Bounds : Iir_Value_Literal_Acc; + begin + Bounds := Execute_Bounds (Block, Atype); + Store (Targ, Bounds.Left); + end; + + when Iir_Kind_Array_Subtype_Definition + | Iir_Kind_Array_Type_Definition => + declare + El_Type : constant Iir := Get_Element_Subtype (Atype); + begin + for I in 1 .. Targ.Val_Array.Len loop + Init_To_Default (Targ.Val_Array.V (I), Block, El_Type); + end loop; + end; + when Iir_Kind_Record_Type_Definition + | Iir_Kind_Record_Subtype_Definition => + declare + El : Iir_Element_Declaration; + List : constant Iir_List := + Get_Elements_Declaration_List (Get_Base_Type (Atype)); + begin + for I in Natural loop + El := Get_Nth_Element (List, I); + exit when El = Null_Iir; + Init_To_Default (Targ.Val_Record.V (1 + Iir_Index32 (I)), + Block, Get_Type (El)); + end loop; + end; + when Iir_Kind_Access_Type_Definition + | Iir_Kind_Access_Subtype_Definition => + Store (Targ, Null_Lit); + when others => + Error_Kind ("Init_To_Default", Atype); + end case; + end Init_To_Default; + procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) is Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; @@ -1141,6 +1191,8 @@ package body Elaboration is Slot : constant Object_Slot_Type := Get_Info (Inter).Slot; Actual_Sig : Iir_Value_Literal_Acc; + Default_Value : Iir; + Val : Iir_Value_Literal_Acc; begin Actual_Sig := Execute_Name (Actual_Instance, Actual, True); @@ -1151,10 +1203,17 @@ package body Elaboration is (Actual_Sig, Global_Pool'Access); Formal_Instance.Objects (Slot + 1) := Init_Expr; if Get_Mode (Inter) = Iir_Out_Mode then - Assign_Value_To_Object - (Formal_Instance, Init_Expr, Get_Type (Inter), - Elaborate_Default_Value (Formal_Instance, Inter), - Assoc); + Default_Value := Get_Default_Value (Inter); + if Default_Value /= Null_Iir then + Val := Execute_Expression_With_Type + (Formal_Instance, Default_Value, + Get_Type (Inter)); + Store (Formal_Instance.Objects (Slot + 1), Val); + else + Init_To_Default + (Formal_Instance.Objects (Slot + 1), + Formal_Instance, Get_Type (Inter)); + end if; end if; end; else diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 0cc3f2d..f4104f2 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -4038,102 +4038,6 @@ package body Execution is Release (Marker, Expr_Pool); end Execute_Signal_Assignment; - procedure Assign_Simple_Value_To_Object - (Instance: Block_Instance_Acc; - Dest: Iir_Value_Literal_Acc; - Dest_Type: Iir; - Value: Iir_Value_Literal_Acc; - Stmt: Iir) - is - begin - if Dest.Kind /= Value.Kind then - raise Internal_Error; -- literal kind mismatch. - end if; - - Check_Constraints (Instance, Value, Dest_Type, Stmt); - - Store (Dest, Value); - end Assign_Simple_Value_To_Object; - - procedure Assign_Array_Value_To_Object - (Instance: Block_Instance_Acc; - Target: Iir_Value_Literal_Acc; - Target_Type: Iir; - Value: Iir_Value_Literal_Acc; - Stmt: Iir) is - begin - if Target.Val_Array.Len /= Value.Val_Array.Len then - -- Dimension mismatch. - raise Program_Error; - end if; - for I in Target.Val_Array.V'Range loop - Assign_Value_To_Object (Instance, - Target.Val_Array.V (I), - Get_Element_Subtype (Target_Type), - Value.Val_Array.V (I), - Stmt); - end loop; - end Assign_Array_Value_To_Object; - - procedure Assign_Record_Value_To_Object - (Instance: Block_Instance_Acc; - Target: Iir_Value_Literal_Acc; - Target_Type: Iir; - Value: Iir_Value_Literal_Acc; - Stmt: Iir) - is - Element_Type: Iir; - List : Iir_List; - Element: Iir_Element_Declaration; - Pos : Iir_Index32; - begin - if Target.Val_Record.Len /= Value.Val_Record.Len then - -- Dimension mismatch. - raise Program_Error; - end if; - List := Get_Elements_Declaration_List (Target_Type); - for I in Natural loop - Element := Get_Nth_Element (List, I); - exit when Element = Null_Iir; - Element_Type := Get_Type (Element); - Pos := Get_Element_Position (Element); - Assign_Value_To_Object (Instance, - Target.Val_Record.V (1 + Pos), - Element_Type, - Value.Val_Record.V (1 + Pos), - Stmt); - end loop; - end Assign_Record_Value_To_Object; - - procedure Assign_Value_To_Object - (Instance: Block_Instance_Acc; - Target: Iir_Value_Literal_Acc; - Target_Type: Iir; - Value: Iir_Value_Literal_Acc; - Stmt: Iir) - is - begin - case Target.Kind is - when Iir_Value_Array => - Assign_Array_Value_To_Object - (Instance, Target, Target_Type, Value, Stmt); - when Iir_Value_Record => - Assign_Record_Value_To_Object - (Instance, Target, Target_Type, Value, Stmt); - when Iir_Value_Scalars - | Iir_Value_Access => - Assign_Simple_Value_To_Object - (Instance, Target, Target_Type, Value, Stmt); - when Iir_Value_File - | Iir_Value_Signal - | Iir_Value_Protected - | Iir_Value_Range - | Iir_Value_Quantity - | Iir_Value_Terminal => - raise Internal_Error; - end case; - end Assign_Value_To_Object; - -- Display a message when an assertion has failed. -- REPORT is the value (string) to display, or null to use default message. -- SEVERITY is the severity or null to use default (error). diff --git a/src/vhdl/simulate/execution.ads b/src/vhdl/simulate/execution.ads index faed111..033e488 100644 --- a/src/vhdl/simulate/execution.ads +++ b/src/vhdl/simulate/execution.ads @@ -114,15 +114,6 @@ package Execution is function Get_Instance_For_Slot (Instance: Block_Instance_Acc; Decl: Iir) return Block_Instance_Acc; - -- Store VALUE to TARGET. - -- Note: VALUE is not freed. - procedure Assign_Value_To_Object - (Instance: Block_Instance_Acc; - Target: Iir_Value_Literal_Acc; - Target_Type: Iir; - Value: Iir_Value_Literal_Acc; - Stmt: Iir); - -- Check VALUE follows the constraints of DEF. -- INSTANCE,DEF is the definition of a subtype. -- EXPR is just used in case of error to display the location |