diff options
Diffstat (limited to 'src/simul')
-rw-r--r-- | src/simul/simul-vhdl_elab.adb | 36 | ||||
-rw-r--r-- | src/simul/simul-vhdl_simul.adb | 189 | ||||
-rw-r--r-- | src/simul/simul-vhdl_simul.ads | 4 |
3 files changed, 139 insertions, 90 deletions
diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb index 3870f6a11..2a254279c 100644 --- a/src/simul/simul-vhdl_elab.adb +++ b/src/simul/simul-vhdl_elab.adb @@ -16,6 +16,8 @@ -- You should have received a copy of the GNU General Public License -- along with this program. If not, see <gnu.org/licenses>. +with Areapools; + with Vhdl.Errors; use Vhdl.Errors; with Vhdl.Utils; use Vhdl.Utils; with Vhdl.Canon; @@ -141,9 +143,7 @@ package body Simul.Vhdl_Elab is Convert_Type_Width (E.Typ); -- Allocate the value in global pool. - Current_Pool := Global_Pool'Access; - E.Val := Alloc_Memory (E.Typ); - Current_Pool := Expr_Pool'Access; + E.Val := Alloc_Memory (E.Typ, Global_Pool'Access); -- Set it to the default value. if Val.Val.Init /= null then @@ -287,6 +287,7 @@ package body Simul.Vhdl_Elab is when others => Error_Kind ("gather_processes_decl", Decl); end case; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); end Gather_Processes_Decl; procedure Gather_Processes_Decls @@ -362,6 +363,7 @@ package body Simul.Vhdl_Elab is (Inst : Synth_Instance_Acc; Proc : Node; Proc_Idx : Process_Index_Type) is use Synth.Vhdl_Stmts; + Marker : Mark_Type; Driver_List: Iir_List; It : List_Iterator; Sig : Node; @@ -371,6 +373,8 @@ package body Simul.Vhdl_Elab is Off : Value_Offsets; Dyn : Dyn_Name; begin + Mark_Expr_Pool (Marker); + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); It := List_Iterate_Safe (Driver_List); while Is_Valid (It) loop @@ -379,12 +383,14 @@ package body Simul.Vhdl_Elab is Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); pragma Assert (Dyn = No_Dyn_Name); Base := Base_Vt.Val.S; + Typ := Unshare (Typ, Global_Pool'Access); Add_Process_Driver (Proc_Idx, Base, Off, Typ, Sig); Next (It); end loop; Trans_Analyzes.Free_Drivers_List (Driver_List); + Release_Expr_Pool (Marker); end Gather_Process_Drivers; procedure Gather_Sensitivity (Inst : Synth_Instance_Acc; @@ -392,6 +398,7 @@ package body Simul.Vhdl_Elab is List : Iir_List) is use Synth.Vhdl_Stmts; + Marker : Mark_Type; It : List_Iterator; Sig : Node; Base_Vt : Valtyp; @@ -400,6 +407,8 @@ package body Simul.Vhdl_Elab is Off : Value_Offsets; Dyn : Dyn_Name; begin + Mark_Expr_Pool (Marker); + It := List_Iterate_Safe (List); while Is_Valid (It) loop Sig := Get_Element (It); @@ -407,6 +416,7 @@ package body Simul.Vhdl_Elab is Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); pragma Assert (Dyn = No_Dyn_Name); Base := Base_Vt.Val.S; + Typ := Unshare (Typ, Global_Pool'Access); Sensitivity_Table.Append ((Sig => Base, @@ -423,6 +433,7 @@ package body Simul.Vhdl_Elab is Next (It); end loop; + Release_Expr_Pool (Marker); end Gather_Sensitivity; procedure Gather_Process_Sensitivity @@ -506,6 +517,7 @@ package body Simul.Vhdl_Elab is Assocs : Node) is use Synth.Vhdl_Stmts; + Marker : Mark_Type; Assoc_Inter : Node; Assoc : Node; Inter : Node; @@ -521,6 +533,7 @@ package body Simul.Vhdl_Elab is List : Iir_List; Formal_Ep, Actual_Ep : Connect_Endpoint; begin + Mark_Expr_Pool (Marker); Assoc := Assocs; Assoc_Inter := Ports; while Is_Valid (Assoc) loop @@ -534,12 +547,14 @@ package body Simul.Vhdl_Elab is Synth_Assignment_Prefix (Port_Inst, Formal, Formal_Base, Typ, Off, Dyn); pragma Assert (Dyn = No_Dyn_Name); + Typ := Unshare (Typ, Global_Pool'Access); Formal_Sig := Formal_Base.Val.S; Formal_Ep := (Formal_Sig, Off, Typ); Synth_Assignment_Prefix (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off, Dyn); pragma Assert (Dyn = No_Dyn_Name); + Typ := Unshare (Typ, Global_Pool'Access); Actual_Sig := Actual_Base.Val.S; Actual_Ep := (Actual_Sig, Off, Typ); @@ -642,6 +657,7 @@ package body Simul.Vhdl_Elab is when others => Error_Kind ("gather_connections", Assoc); end case; + Release_Expr_Pool (Marker); Next_Association_Interface (Assoc, Assoc_Inter); end loop; end Gather_Connections; @@ -679,6 +695,7 @@ package body Simul.Vhdl_Elab is (Sub_Inst, Get_Port_Chain (Get_Entity (Sub_Scope)), Inst, Get_Port_Map_Aspect_Chain (Stmt)); end if; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); end Gather_Connections_Instantiation_Statement; procedure Gather_Processes_Stmt @@ -691,6 +708,7 @@ package body Simul.Vhdl_Elab is Get_Sub_Instance (Inst, Stmt); begin Gather_Processes_1 (Sub_Inst); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); Gather_Connections_Instantiation_Statement (Inst, Stmt, Sub_Inst); end; @@ -733,7 +751,9 @@ package body Simul.Vhdl_Elab is Inst => Inst, Drivers => No_Driver_Index, Sensitivity => No_Sensitivity_Index)); + pragma Assert (Is_Expr_Pool_Empty); Gather_Process_Drivers (Inst, Stmt, Processes_Table.Last); + pragma Assert (Is_Expr_Pool_Empty); Gather_Process_Sensitivity (Inst, Stmt, Processes_Table.Last); when Iir_Kind_Psl_Default_Clock => null; @@ -749,6 +769,7 @@ package body Simul.Vhdl_Elab is when others => Vhdl.Errors.Error_Kind ("gather_processes_stmt", Stmt); end case; + pragma Assert (Is_Expr_Pool_Empty); end Gather_Processes_Stmt; procedure Gather_Processes_Stmts (Inst : Synth_Instance_Acc; Stmts : Node) @@ -804,10 +825,14 @@ package body Simul.Vhdl_Elab is when others => Vhdl.Errors.Error_Kind ("gater_processes_1", N); end case; + + pragma Assert (Areapools.Is_Empty (Expr_Pool)); end Gather_Processes_1; procedure Gather_Processes (Top : Synth_Instance_Acc) is begin + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Processes_Table.Init; Signals_Table.Init; Drivers_Table.Init; @@ -872,7 +897,6 @@ package body Simul.Vhdl_Elab is end loop; end; end loop; - end Gather_Processes; procedure Elab_Processes @@ -880,6 +904,9 @@ package body Simul.Vhdl_Elab is Proc : Node; Proc_Inst : Synth_Instance_Acc; begin + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + + Instance_Pool := Global_Pool'Access; for I in Processes_Table.First .. Processes_Table.Last loop Proc := Processes_Table.Table (I).Proc; if Get_Kind (Proc) in Iir_Kinds_Process_Statement then @@ -890,6 +917,7 @@ package body Simul.Vhdl_Elab is (Proc_Inst, Get_Declaration_Chain (Proc), True); end if; end loop; + Instance_Pool := null; end Elab_Processes; procedure Elab_Drivers is diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb index 1fe1f76a3..0e19a3159 100644 --- a/src/simul/simul-vhdl_simul.adb +++ b/src/simul/simul-vhdl_simul.adb @@ -303,6 +303,7 @@ package body Simul.Vhdl_Simul is Driver_List : Iir_List) is pragma Unreferenced (Proc); + Marker : Mark_Type; It : List_Iterator; El: Iir; Info : Target_Info; @@ -312,7 +313,8 @@ package body Simul.Vhdl_Simul is while Is_Valid (It) loop El := Get_Element (It); - -- Mark (Marker, Expr_Pool); + Mark_Expr_Pool (Marker); + Info := Synth_Target (Inst, El); declare E : Signal_Entry renames Signals_Table.Table (Info.Obj.Val.S); @@ -322,7 +324,7 @@ package body Simul.Vhdl_Simul is E.Val + Info.Off.Mem_Off); end; - -- Release (Marker, Expr_Pool); + Release_Expr_Pool (Marker); Next (It); end loop; @@ -375,7 +377,7 @@ package body Simul.Vhdl_Simul is ((Pfx.Targ_Type, Sig_Index (Signals_Table.Table (Pfx.Obj.Val.S).Sig, Pfx.Off.Net_Off))); - Res := Create_Value_Memory (Boolean_Type); + Res := Create_Value_Memory (Boolean_Type, Expr_Pool'Access); Write_U8 (Res.Val.Mem, Boolean'Pos (E)); return Res; end Exec_Event_Attribute; @@ -398,13 +400,20 @@ package body Simul.Vhdl_Simul is function Execute_Condition (Inst : Synth_Instance_Acc; Cond : Node) return Boolean is + Mark : Mark_Type; Cond_Val : Valtyp; + Res : Boolean; begin if Cond = Null_Node then return True; end if; + + Mark_Expr_Pool (Mark); Cond_Val := Synth.Vhdl_Expr.Synth_Expression (Inst, Cond); - return Read_Discrete (Cond_Val) = 1; + Res := Read_Discrete (Cond_Val) = 1; + Release_Expr_Pool (Mark); + + return Res; end Execute_Condition; function Get_Suspend_State_Var (Inst : Synth_Instance_Acc) return Memory_Ptr @@ -589,11 +598,14 @@ package body Simul.Vhdl_Simul is procedure Execute_Wait_Statement (Inst : Synth_Instance_Acc; Stmt : Node) is + Marker : Mark_Type; Expr : Node; List : Node_List; Val : Valtyp; Timeout : Int64; begin + Mark_Expr_Pool (Marker); + -- LRM93 8.1 -- The execution of a wait statement causes the time expression to -- be evaluated to determine the timeout interval. @@ -637,6 +649,8 @@ package body Simul.Vhdl_Simul is end; end if; + Release_Expr_Pool (Marker); + -- LRM93 8.1 -- It also causes the execution of the corresponding process -- statement to be suspended. @@ -689,7 +703,7 @@ package body Simul.Vhdl_Simul is Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); - Area_Mark : Areapools.Mark_Type; + Area_Mark : Mark_Type; Sub_Inst : Synth_Instance_Acc; begin Areapools.Mark (Area_Mark, Instance_Pool.all); @@ -840,12 +854,15 @@ package body Simul.Vhdl_Simul is is use Synth.Vhdl_Expr; Target : constant Node := Get_Target (Stmt); + Marker : Mark_Type; Info : Target_Info; begin + Mark_Expr_Pool (Marker); Info := Synth_Target (Inst, Target); Execute_Waveform_Assignment (Inst, Info, Stmt, Get_Waveform_Chain (Stmt)); + Release_Expr_Pool (Marker); end Execute_Simple_Signal_Assignment; procedure Execute_Conditional_Signal_Assignment (Inst : Synth_Instance_Acc; @@ -853,10 +870,12 @@ package body Simul.Vhdl_Simul is is use Synth.Vhdl_Expr; Target : constant Node := Get_Target (Stmt); + Marker : Mark_Type; Cw : Node; Cond : Node; Info : Target_Info; begin + Mark_Expr_Pool (Marker); Info := Synth_Target (Inst, Target); Cw := Get_Conditional_Waveform_Chain (Stmt); @@ -871,6 +890,7 @@ package body Simul.Vhdl_Simul is end if; Cw := Get_Chain (Cw); end loop; + Release_Expr_Pool (Marker); end Execute_Conditional_Signal_Assignment; procedure Execute_Selected_Signal_Assignment (Inst : Synth_Instance_Acc; @@ -878,12 +898,14 @@ package body Simul.Vhdl_Simul is is use Synth.Vhdl_Expr; Target : constant Node := Get_Target (Stmt); + Marker : Mark_Type; Sel : Memtyp; Sw : Node; Wf : Node; Info : Target_Info; Eq : Boolean; begin + Mark_Expr_Pool (Marker); Info := Synth_Target (Inst, Target); Sel := Get_Memtyp (Synth_Expression (Inst, Get_Expression (Stmt))); @@ -915,6 +937,7 @@ package body Simul.Vhdl_Simul is end if; Sw := Get_Chain (Sw); end loop; + Release_Expr_Pool (Marker); end Execute_Selected_Signal_Assignment; procedure Execute_Assertion_Statement (Inst : Synth_Instance_Acc; @@ -962,6 +985,8 @@ package body Simul.Vhdl_Simul is Elab.Debugger.Debug_Break (Inst, Stmt); end if; + pragma Assert (Is_Expr_Pool_Empty); + case Get_Kind (Stmt) is when Iir_Kind_Null_Statement => Next_Statement (Process, Stmt); @@ -1058,6 +1083,7 @@ package body Simul.Vhdl_Simul is end case; end loop; Finish_Procedure_Call (Process, Stmt, Stmt); + pragma Assert (Is_Expr_Pool_Empty); -- For a non-suspend procedure, return now to the caller. exit when Stmt = Null_Node; Next_Statement (Process, Stmt); @@ -1084,11 +1110,14 @@ package body Simul.Vhdl_Simul is declare use Synth.Vhdl_Expr; Expr : constant Node := Get_Expression (Stmt); + Marker : Mark_Type; Sel : Valtyp; begin + Mark_Expr_Pool (Marker); Sel := Synth_Expression_With_Basetype (Inst, Expr); Stmt := Synth.Vhdl_Stmts.Execute_Static_Case_Statement (Inst, Stmt, Sel); + Release_Expr_Pool (Marker); end; when Iir_Kind_Assertion_Statement => @@ -1124,6 +1153,7 @@ package body Simul.Vhdl_Simul is begin Execute_Procedure_Call_Statement (Process, Stmt, Next_Stmt); pragma Assert (Next_Stmt = Null_Node); + pragma Assert (Is_Expr_Pool_Empty); Next_Statement (Process, Stmt); end; @@ -1160,6 +1190,7 @@ package body Simul.Vhdl_Simul is end if; Execute_Procedure_Call_Statement (Process, Stmt2, Next_Stmt); + pragma Assert (Is_Expr_Pool_Empty); if Next_Stmt /= Null_Node then -- User procedure. -- Save current state. @@ -1249,15 +1280,18 @@ package body Simul.Vhdl_Simul is procedure Execute_Expression_Association (Proc_Idx : Process_Index_Type) is use Synth.Vhdl_Expr; + Mark : Mark_Type; Proc : Proc_Record_Type renames Processes_Table.Table (Proc_Idx); Drv : Driver_Entry renames Drivers_Table.Table (Proc.Drivers); Sig : Signal_Entry renames Signals_Table.Table (Drv.Sig); Val : Valtyp; begin + Mark_Expr_Pool (Mark); Val := Synth_Expression_With_Type (Proc.Inst, Get_Actual (Proc.Proc), Drv.Typ); Assign_Value_To_Signal ((Drv.Typ, Sig.Sig), True, 0, 0, Get_Value_Memtyp (Val)); + Release_Expr_Pool (Mark); end Execute_Expression_Association; function To_Process_State_Acc is new Ada.Unchecked_Conversion @@ -1273,7 +1307,10 @@ package body Simul.Vhdl_Simul is -- For debugger Current_Process := Process; --- Instance_Pool := Process.Pool'Access; + Instance_Pool := Process.Pool; + + -- Sanity checks. + pragma Assert (Is_Expr_Pool_Empty); if Synth.Flags.Flag_Trace_Statements then Put ("run process: "); @@ -1281,19 +1318,13 @@ package body Simul.Vhdl_Simul is Put_Line (" (" & Vhdl.Errors.Disp_Location (Process.Proc) & ")"); end if; --- Execute_Sequential_Statements (Process); - - -- Sanity checks. --- if not Is_Empty (Expr_Pool) then --- raise Internal_Error; --- end if; - case Get_Kind (Process.Proc) is when Iir_Kind_Sensitized_Process_Statement => -- if Process.Instance.In_Wait_Flag then -- raise Internal_Error; -- end if; Execute_Sequential_Statements (Process); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Process_Statement => Execute_Sequential_Statements (Process); when Iir_Kind_Concurrent_Assertion_Statement => @@ -1301,28 +1332,33 @@ package body Simul.Vhdl_Simul is Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); end if; Execute_Assertion_Statement (Process.Instance, Process.Proc); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Concurrent_Simple_Signal_Assignment => if Elab.Debugger.Flag_Need_Debug then Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); end if; Execute_Simple_Signal_Assignment (Process.Instance, Process.Proc); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Concurrent_Conditional_Signal_Assignment => if Elab.Debugger.Flag_Need_Debug then Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); end if; Execute_Conditional_Signal_Assignment (Process.Instance, Process.Proc); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Concurrent_Selected_Signal_Assignment => if Elab.Debugger.Flag_Need_Debug then Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); end if; Execute_Selected_Signal_Assignment (Process.Instance, Process.Proc); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Association_Element_By_Expression => if Elab.Debugger.Flag_Need_Debug then Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); end if; Execute_Expression_Association (Process.Idx); + pragma Assert (Areapools.Is_Empty (Instance_Pool.all)); when Iir_Kind_Concurrent_Procedure_Call_Statement => if Elab.Debugger.Flag_Need_Debug then Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); @@ -1332,7 +1368,7 @@ package body Simul.Vhdl_Simul is raise Internal_Error; end case; --- Instance_Pool := null; + Instance_Pool := null; Current_Process := null; end Process_Executer; @@ -1386,19 +1422,21 @@ package body Simul.Vhdl_Simul is procedure Create_Process_Sensitized (Proc : Process_State_Acc) is use Grt.Processes; - Instance_Grt : Grt.Processes.Instance_Acc; + Instance_Grt : constant Grt.Processes.Instance_Acc := + To_Instance_Acc (Proc.all'Address); begin - Instance_Grt := To_Instance_Acc (Proc.all'Address); + -- As those processes only suspend at the end, they don't need a + -- specific stack and can share the same stack. + Proc.Pool := Process_Pool'Access; + if Get_Postponed_Flag (Proc.Proc) then - Ghdl_Postponed_Sensitized_Process_Register - (Instance_Grt, - Process_Executer'Access, - null, To_Address (Proc)); + Ghdl_Postponed_Sensitized_Process_Register (Instance_Grt, + Process_Executer'Access, + null, To_Address (Proc)); else - Ghdl_Sensitized_Process_Register - (Instance_Grt, - Process_Executer'Access, - null, To_Address (Proc)); + Ghdl_Sensitized_Process_Register (Instance_Grt, + Process_Executer'Access, + null, To_Address (Proc)); end if; end Create_Process_Sensitized; @@ -1474,12 +1512,12 @@ package body Simul.Vhdl_Simul is return; end if; --- Instance_Pool := Global_Pool'Access; + Instance_Pool := Process_Pool'Access; -- Current_Process := No_Process; - Mark (Marker, Expr_Pool); + Mark_Expr_Pool (Marker); V := Execute_Psl_Expr (E.Instance, Get_PSL_Clock (E.Proc), False); - Release (Marker, Expr_Pool); + Release_Expr_Pool (Marker); if V then Nvec := (others => False); case Get_Kind (E.Proc) is @@ -1503,10 +1541,10 @@ package body Simul.Vhdl_Simul is Sd_Num := Get_State_Label (Sd); if not Nvec (Sd_Num) then - Mark (Marker, Expr_Pool); + Mark_Expr_Pool (Marker); V := Execute_Psl_Expr (E.Instance, Get_Edge_Expr (Ed), False); - Release (Marker, Expr_Pool); + Release_Expr_Pool (Marker); if V then Nvec (Sd_Num) := True; end if; @@ -1558,7 +1596,7 @@ package body Simul.Vhdl_Simul is E.States.all := Nvec; end if; --- Instance_Pool := null; + Instance_Pool := null; -- Current_Process := null; end PSL_Process_Executer; @@ -1664,12 +1702,16 @@ package body Simul.Vhdl_Simul is begin Driver_List := Trans_Analyzes.Extract_Drivers (Proc); Create_Process_Sensitized (Current_Process); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); Register_Sensitivity (I); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); Create_Process_Drivers (Instance, Proc, Driver_List); + pragma Assert (Areapools.Is_Empty (Expr_Pool)); Trans_Analyzes.Free_Drivers_List (Driver_List); end; when Iir_Kind_Association_Element_By_Expression => + Processes_State (I).Pool := Process_Pool'Access; Ghdl_Sensitized_Process_Register (Instance_Grt, Process_Executer'Access, @@ -1682,6 +1724,10 @@ package body Simul.Vhdl_Simul is declare Driver_List: Iir_List; begin + -- As those processes can suspend, they need a dedicated + -- stack. + Processes_State (I).Pool := new Areapools.Areapool; + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); if Get_Postponed_Flag (Proc) then @@ -1713,44 +1759,8 @@ package body Simul.Vhdl_Simul is Vhdl.Errors.Error_Kind ("create_processes", Proc); end case; - -- LRM93 12.4.4 Other Concurrent Statements - -- All other concurrent statements are either process - -- statements or are statements for which there is an - -- equivalent process statement. - -- Elaboration of a process statement proceeds as follows: - -- 1. The process declarative part is elaborated. --- Elaborate_Declarative_Part --- (Instance, Get_Declaration_Chain (Proc)); - - -- 2. The drivers required by the process statement - -- are created. - -- 3. The initial transaction defined by the default value - -- associated with each scalar signal driven by the - -- process statement is inserted into the corresponding - -- driver. - -- FIXME: do it for drivers in called subprograms too. --- Elaborate_Drivers (Instance, Proc); - --- if not Is_Empty (Expr_Pool) then --- raise Internal_Error; --- end if; - - -- Elaboration of all concurrent signal assignment - -- statements and concurrent assertion statements consists - -- of the construction of the equivalent process statement - -- followed by the elaboration of the equivalent process - -- statement. - -- [GHDL: this is done by canonicalize. ] - - -- FIXME: check passive statements, - -- check no wait statement in sensitized processes. - --- Instance_Pool := null; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); end loop; - --- if Trace_Simulation then --- Disp_Signals_Value; --- end if; end Create_Processes; type Resolver_Read_Mode is (Read_Port, Read_Driver); @@ -1917,10 +1927,10 @@ package body Simul.Vhdl_Simul is Res : Valtyp; - Instance_Mark, Expr_Mark : Mark_Type; + Marker : Mark_Type; begin - Mark (Expr_Mark, Expr_Pool); - Mark (Instance_Mark, Instance_Pool.all); + Mark_Expr_Pool (Marker); + Instance_Pool := Process_Pool'Access; -- Create the type. Bnd := Elab.Vhdl_Types.Create_Bounds_From_Length (R.Idx_Typ.Drange, Len); @@ -1953,8 +1963,8 @@ package body Simul.Vhdl_Simul is Exec_Write_Signal (R.Sig, (Res.Typ, Res.Val.Mem), Write_Signal_Driving_Value); - Release (Expr_Mark, Expr_Pool); - Release (Instance_Mark, Instance_Pool.all); + Release_Expr_Pool (Marker); + pragma Assert (Is_Expr_Pool_Empty); end Resolution_Proc; function Create_Scalar_Signal (Typ : Type_Acc; Val : Ghdl_Value_Ptr) @@ -2108,7 +2118,7 @@ package body Simul.Vhdl_Simul is (System.Address, Memory_Ptr); M : System.Address; begin - Areapools.Allocate (Current_Pool.all, + Areapools.Allocate (Global_Pool, M, Sig_Size * Size_Type (Vtype.W), Sig_Size); return To_Memory_Ptr (M); end Alloc_Signal_Memory; @@ -2357,11 +2367,10 @@ package body Simul.Vhdl_Simul is Val : Memtyp; Dst : Memtyp; - Expr_Mark : Mark_Type; + Marker : Mark_Type; begin --- pragma Assert (Instance_Pool = null); --- Instance_Pool := Global_Pool'Access; - Mark (Expr_Mark, Expr_Pool); + Instance_Pool := Process_Pool'Access; + Mark_Expr_Pool (Marker); Current_Process := null; Val := Create_Memory (Conv.Src_Typ); @@ -2384,8 +2393,8 @@ package body Simul.Vhdl_Simul is (Conv.Dst_Sig, Dst, Write_Signal_Driving_Value); end case; - Release (Expr_Mark, Expr_Pool); --- Instance_Pool := null; + Release_Expr_Pool (Marker); + Instance_Pool := null; end Conversion_Proc; function Get_Leftest_Signal (Sig : Memory_Ptr; Typ : Type_Acc) @@ -2462,7 +2471,7 @@ package body Simul.Vhdl_Simul is if In_Conv /= Null_Iir then Ctyp := C.Formal.Typ; Csig := Alloc_Signal_Memory (Ctyp); - Cval := Alloc_Memory (Ctyp); + Cval := Alloc_Memory (Ctyp, Global_Pool'Access); Create_Shadow_Signal (Csig, Cval, Ctyp); Act2 := (Ctyp, Csig); Add_Conversion @@ -2566,7 +2575,7 @@ package body Simul.Vhdl_Simul is begin -- Allocate Ref_Val and set it to 0. pragma Assert (T.Across_Typ.Kind = Type_Float); - T.Ref_Val := Alloc_Memory (T.Across_Typ); + T.Ref_Val := Alloc_Memory (T.Across_Typ, Global_Pool'Access); Write_Fp64 (T.Ref_Val, 0.0); if not Get_Reference_Terminal_Flag (T.Decl) then @@ -2624,7 +2633,7 @@ package body Simul.Vhdl_Simul is -- TODO raise Internal_Error; end if; - Q.Val := Alloc_Memory (Q.Typ); + Q.Val := Alloc_Memory (Q.Typ, Global_Pool'Access); Write_Fp64 (Q.Val, 0.0); -- TODO: @@ -2661,7 +2670,7 @@ package body Simul.Vhdl_Simul is ((Kind => Aug_Dot, Q => Q.Idx)); end if; - Q.Val := Alloc_Memory (Q.Typ); + Q.Val := Alloc_Memory (Q.Typ, Global_Pool'Access); Write_Fp64 (Q.Val, 0.0); end; @@ -2900,15 +2909,25 @@ package body Simul.Vhdl_Simul is -- All the simulation is done via time, so it must be displayed. Disp_Time_Before_Values := True; + pragma Assert (Is_Expr_Pool_Empty); + Create_Signals; + pragma Assert (Is_Expr_Pool_Empty); Create_Connects; -- Create_Disconnections; + pragma Assert (Is_Expr_Pool_Empty); Create_Processes; + pragma Assert (Is_Expr_Pool_Empty); Create_Terminals; Create_Quantities; + pragma Assert (Is_Expr_Pool_Empty); Collapse_Signals; + pragma Assert (Is_Expr_Pool_Empty); + -- Allow Synth_Expression to handle signals. + -- This is done after elaboration as signals are available only after + -- elaboration. Synth.Vhdl_Expr.Hook_Signal_Expr := Hook_Signal_Expr'Access; Synth.Vhdl_Expr.Hook_Event_Attribute := Exec_Event_Attribute'Access; @@ -2950,7 +2969,7 @@ package body Simul.Vhdl_Simul is Elab.Debugger.Error_Hook := Grt.Errors.Fatal_Error'Access; --- Grt.Errors.Error_Hook := Debug_Error'Access; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); if Flag_Debug_Elab then Elab.Debugger.Debug_Elab (Vhdl_Elab.Top_Instance); @@ -2961,6 +2980,8 @@ package body Simul.Vhdl_Simul is return; end if; + pragma Assert (Areapools.Is_Empty (Expr_Pool)); + Synth.Flags.Severity_Level := Grt.Options.Severity_Level; if Flag_Interractive then diff --git a/src/simul/simul-vhdl_simul.ads b/src/simul/simul-vhdl_simul.ads index 38d3173f0..f2cf98212 100644 --- a/src/simul/simul-vhdl_simul.ads +++ b/src/simul/simul-vhdl_simul.ads @@ -18,7 +18,7 @@ with Types; use Types; with Tables; -with Areapools; use Areapools; +with Areapools; with Vhdl.Nodes; use Vhdl.Nodes; @@ -60,7 +60,7 @@ package Simul.Vhdl_Simul is case Kind is when Kind_Process => -- Memory pool to allocate objects from. - Pool : Areapool_Acc; + Pool : Areapools.Areapool_Acc; when Kind_PSL => Done : Boolean; States: Boolean_Vector_Acc; |