diff options
author | Tristan Gingold <tgingold@free.fr> | 2022-07-24 08:45:33 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2022-07-24 08:45:33 +0200 |
commit | 88a4798285037a18cb7d27057474d52eca819520 (patch) | |
tree | 6628335cf37a1825c0258a690abbfb7a12cfe12f | |
parent | e0b9240c683ed70eeabaa7ab8b45069f5dd1ffca (diff) | |
download | ghdl-88a4798285037a18cb7d27057474d52eca819520.tar.gz ghdl-88a4798285037a18cb7d27057474d52eca819520.tar.bz2 ghdl-88a4798285037a18cb7d27057474d52eca819520.zip |
src/simul: rewrite of ghdl/simul based on synth
-rw-r--r-- | src/simul/simul-vhdl_debug.adb | 728 | ||||
-rw-r--r-- | src/simul/simul-vhdl_debug.ads | 22 | ||||
-rw-r--r-- | src/simul/simul-vhdl_elab.adb | 677 | ||||
-rw-r--r-- | src/simul/simul-vhdl_elab.ads | 200 | ||||
-rw-r--r-- | src/simul/simul-vhdl_simul.adb | 1992 | ||||
-rw-r--r-- | src/simul/simul-vhdl_simul.ads | 120 | ||||
-rw-r--r-- | src/simul/simul.ads | 20 |
7 files changed, 3759 insertions, 0 deletions
diff --git a/src/simul/simul-vhdl_debug.adb b/src/simul/simul-vhdl_debug.adb new file mode 100644 index 000000000..651302f57 --- /dev/null +++ b/src/simul/simul-vhdl_debug.adb @@ -0,0 +1,728 @@ +-- Debugger for VHDL simulation +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with System; +with Ada.Unchecked_Conversion; + +with GNAT.OS_Lib; + +with Types; use Types; +with Name_Table; use Name_Table; +with Simple_IO; use Simple_IO; +with Utils_IO; use Utils_IO; + +with Vhdl.Nodes; use Vhdl.Nodes; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Errors; + +with Elab.Memtype; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Debugger; use Elab.Debugger; +with Elab.Vhdl_Debug; use Elab.Vhdl_Debug; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Values.Debug; use Elab.Vhdl_Values.Debug; +with Simul.Vhdl_Elab; use Simul.Vhdl_Elab; +with Simul.Vhdl_Simul; + +with Grt.Types; use Grt.Types; +with Grt.Vhdl_Types; use Grt.Vhdl_Types; +with Grt.Options; +with Grt.Processes; +with Grt.Signals; use Grt.Signals; +with Grt.Disp_Signals; +with Grt.Rtis_Addr; + +package body Simul.Vhdl_Debug is + + procedure Put_Time (Time : Std_Time) + is + use Grt.Options; + Unit : Natural_Time_Scale; + T : Std_Time; + begin + if Time = Std_Time'First then + Put ("-Inf"); + else + -- Do not bother with sec, min, and hr. + Unit := Time_Resolution_Scale; + T := Time; + while Unit > 1 and then (T mod 1_000) = 0 loop + T := T / 1000; + Unit := Unit - 1; + end loop; + Put_Int64 (Int64 (T)); + case Unit is + when 0 => + Put ("sec"); + when 1 => + Put ("ms"); + when 2 => + Put ("us"); + when 3 => + Put ("ns"); + when 4 => + Put ("ps"); + when 5 => + Put ("fs"); + end case; + end if; + end Put_Time; + + procedure Disp_Driver_Entry (D : Driver_Entry) is + begin + Put (" ["); + Put_Uns32 (Uns32 (D.Proc)); + Put ("] "); + Disp_Instance_Path (Processes_Table.Table (D.Proc).Inst); + New_Line; + Put (" noff: "); + Put_Uns32 (D.Off.Net_Off); + Put (", moff: "); + Put_Uns32 (Uns32 (D.Off.Mem_Off)); + Put (", len: "); + Put_Uns32 (D.Typ.W); + Put (", typ: "); + Debug_Type_Short (D.Typ); + New_Line; + end Disp_Driver_Entry; + + function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type) + return Int64 is + begin + case Mode is + when Mode_B1 => + return Ghdl_B1'Pos (Value_Ptr.B1); + when Mode_E8 => + return Int64 (Value_Ptr.E8); + when Mode_E32 => + return Int64 (Value_Ptr.E32); + when Mode_I32 => + return Int64 (Value_Ptr.I32); + when Mode_I64 => + return Int64 (Value_Ptr.I64); + when Mode_F64 => + raise Internal_Error; + end case; + end Read_Value; + + function Read_Value (Value : Value_Union; Mode : Mode_Type) + return Int64 is + begin + case Mode is + when Mode_B1 => + return Ghdl_B1'Pos (Value.B1); + when Mode_E8 => + return Int64 (Value.E8); + when Mode_E32 => + return Int64 (Value.E32); + when Mode_I32 => + return Int64 (Value.I32); + when Mode_I64 => + return Int64 (Value.I64); + when Mode_F64 => + raise Internal_Error; + end case; + end Read_Value; + + procedure Disp_Transaction (Trans : Transaction_Acc; + Sig_Type : Node; + Mode : Mode_Type) + is + T : Transaction_Acc; + begin + T := Trans; + loop + case T.Kind is + when Trans_Value => + Disp_Discrete_Value (Read_Value (T.Val, Mode), Sig_Type); + when Trans_Direct => + Disp_Discrete_Value (Read_Value (T.Val_Ptr, Mode), Sig_Type); + when Trans_Null => + Put ("NULL"); + when Trans_Error => + Put ("ERROR"); + end case; + if T.Kind = Trans_Direct then + -- The Time field is not updated for direct transaction. + Put ("[DIRECT]"); + else + Put ("@"); + Put_Time (T.Time); + end if; + T := T.Next; + exit when T = null; + Put (", "); + end loop; + end Disp_Transaction; + + procedure Info_Scalar_Signal_Driver (S : Memtyp; Stype : Node) + is + function To_Address is new Ada.Unchecked_Conversion + (Source => Resolved_Signal_Acc, Target => System.Address); + Sig : Ghdl_Signal_Ptr; + begin + Sig := Simul.Vhdl_Simul.Read_Sig (S.Mem); + Put_Addr (Sig.all'Address); + Put (' '); + Grt.Disp_Signals.Disp_Single_Signal_Attributes (Sig); + Put (" val="); + Disp_Discrete_Value (Read_Value (Sig.Value_Ptr, Sig.Mode), Stype); + Put ("; drv="); + Disp_Discrete_Value (Read_Value (Sig.Driving_Value, Sig.Mode), Stype); + if Sig.Nbr_Ports > 0 then + Put (';'); + Put_Int32 (Int32 (Sig.Nbr_Ports)); + Put (" ports"); + end if; + case Sig.S.Mode_Sig is + when Mode_Signal_User => + if Sig.S.Resolv /= null then + Put (" resolver="); + Put_Addr (To_Address (Sig.S.Resolv)); + end if; + if Sig.S.Nbr_Drivers = 0 then + Put ("; no driver"); + elsif Sig.S.Nbr_Drivers = 1 then + Put ("; trans="); + Disp_Transaction + (Sig.S.Drivers (0).First_Trans, Stype, Sig.Mode); + else + for I in 0 .. Sig.S.Nbr_Drivers - 1 loop + New_Line; + Put (" "); +-- Disp_Context +-- (Processes.Get_Rti_Context (Sig.S.Drivers (I).Proc)); + Put (": "); + Disp_Transaction + (Sig.S.Drivers (I).First_Trans, Stype, Sig.Mode); + end loop; + end if; + + when Mode_Delayed => + Put ("; trans="); + Disp_Transaction (Sig.S.Attr_Trans, Stype, Sig.Mode); + + when others => + null; + end case; + New_Line; + end Info_Scalar_Signal_Driver; + + generic + with procedure For_Scalar_Signal (S : Memtyp; Stype : Node); + procedure For_Each_Scalar_Signal (S : Memtyp; Stype : Node); + + procedure For_Each_Scalar_Signal (S : Memtyp; Stype : Node) is + begin + case S.Typ.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete => + For_Scalar_Signal (S, Get_Base_Type (Stype)); + when Type_Vector + | Type_Array => + declare + use Simul.Vhdl_Simul; + Len : constant Uns32 := S.Typ.Abound.Len; + El_Type : Node; + Stride : Uns32; + begin + if S.Typ.Alast then + El_Type := Get_Element_Subtype (Stype); + else + El_Type := Stype; + end if; + Stride := S.Typ.Arr_El.W; + + for I in 1 .. Len loop + For_Each_Scalar_Signal + ((S.Typ.Arr_El, Sig_Index (S.Mem, (Len - I) * Stride)), + El_Type); + end loop; + end; + when Type_Record => + declare + use Simul.Vhdl_Simul; + El_List : constant Iir_Flist := + Get_Elements_Declaration_List (Stype); + El : Node; + begin + for I in S.Typ.Rec.E'Range loop + El := Get_Nth_Element (El_List, Natural (I - 1)); + Put (Image (Get_Identifier (El))); + Put (": "); + For_Each_Scalar_Signal + ((S.Typ.Rec.E (I).Typ, + Sig_Index (S.Mem, S.Typ.Rec.E (I).Offs.Net_Off)), + Get_Type (El)); + end loop; + end; + when Type_Float + | Type_Unbounded_Vector + | Type_Unbounded_Record + | Type_Unbounded_Array + | Type_Slice + | Type_Protected + | Type_File + | Type_Access => + raise Internal_Error; + end case; + end For_Each_Scalar_Signal; + + procedure Info_Signal_Driver is new For_Each_Scalar_Signal + (Info_Scalar_Signal_Driver); + + procedure Info_Scalar_Signal_Action (S : Memtyp; Stype : Node) + is + pragma Unreferenced (Stype); + use Grt.Rtis_Addr; + use Grt.Processes; + Sig : Ghdl_Signal_Ptr; + Ev : Action_List_Acc; + Ctxt : Rti_Context; + begin + Sig := Simul.Vhdl_Simul.Read_Sig (S.Mem); + Put_Addr (Sig.all'Address); + Put (' '); + Ev := Sig.Event_List; + while Ev /= null loop + Ctxt := Get_Rti_Context (Ev.Proc); + Put (' '); + Put_Addr (Ctxt.Base); + Ev := Ev.Next; + end loop; + New_Line; + end Info_Scalar_Signal_Action; + + procedure Info_Signal_Action is new For_Each_Scalar_Signal + (Info_Scalar_Signal_Action); + + type Info_Signal_Options is record + Value : Boolean; + Drivers : Boolean; + Actions : Boolean; + end record; + + procedure Info_Signal_Opts (Idx : Signal_Index_Type; + Opts : Info_Signal_Options) + is + use Elab.Memtype; + S : Signal_Entry renames Signals_Table.Table (Idx); + Nbr_Drv : Int32; + Nbr_Conn_Drv : Int32; + Nbr_Sens : Int32; + Sens : Sensitivity_Index_Type; + Driver : Driver_Index_Type; + Conn : Connect_Index_Type; + begin + Put_Int32 (Int32 (Idx)); + Put (": "); + if S.Decl = Null_Iir then + Put_Line ("??"); + return; + end if; + + Disp_Instance_Path (S.Inst, True); + Put ('/'); + Put (Image (Get_Identifier (S.Decl))); + + case Get_Kind (S.Decl) is + when Iir_Kind_Signal_Declaration => + Put (" [sig]"); + when Iir_Kind_Interface_Signal_Declaration => + case Get_Mode (S.Decl) is + when Iir_In_Mode => + Put (" [in]"); + when Iir_Out_Mode => + Put (" [out]"); + when Iir_Buffer_Mode => + Put (" [buf]"); + when Iir_Linkage_Mode => + Put (" [lnk]"); + when Iir_Inout_Mode => + Put (" [io]"); + when Iir_Unknown_Mode => + Put (" [??]"); + end case; + when others => + raise Internal_Error; + end case; + New_Line; + + Put (" type: "); + Debug_Type_Short (S.Typ); + Put (", len: "); + Put_Uns32 (S.Typ.W); + New_Line; + + Nbr_Conn_Drv := 0; + Conn := S.Connect; + while Conn /= No_Connect_Index loop + declare + C : Connect_Entry renames Connect_Table.Table (Conn); + begin + if C.Formal_Base = Idx then + if C.Drive_Formal then + Nbr_Conn_Drv := Nbr_Conn_Drv + 1; + end if; + Conn := C.Formal_Link; + else + pragma Assert (C.Actual_Base = Idx); + if C.Drive_Actual then + Nbr_Conn_Drv := Nbr_Conn_Drv + 1; + end if; + Conn := C.Actual_Link; + end if; + end; + end loop; + + Nbr_Drv := 0; + Driver := S.Drivers; + while Driver /= No_Driver_Index loop + Nbr_Drv := Nbr_Drv + 1; + Driver := Drivers_Table.Table (Driver).Prev_Sig; + end loop; + Put (" nbr sources: "); + Put_Int32 (Nbr_Drv + Nbr_Conn_Drv); + + Nbr_Sens := 0; + Sens := S.Sensitivity; + while Sens /= No_Sensitivity_Index loop + Nbr_Sens := Nbr_Sens + 1; + Sens := Sensitivity_Table.Table (Sens).Prev_Sig; + end loop; + + Put (", nbr sensitivity: "); + Put_Int32 (Nbr_Sens); + + Put (", collapsed_by: "); + Put_Uns32 (Uns32 (S.Collapsed_By)); + New_Line; + + if Opts.Value then + Driver := S.Drivers; + while Driver /= No_Driver_Index loop + declare + D : Driver_Entry renames Drivers_Table.Table (Driver); + begin + Put (" driver:"); + Disp_Driver_Entry (D); + + Driver := D.Prev_Sig; + end; + end loop; + + Sens := S.Sensitivity; + while Sens /= No_Sensitivity_Index loop + declare + D : Driver_Entry renames Sensitivity_Table.Table (Sens); + begin + Put (" sensitivity:"); + Disp_Driver_Entry (D); + + Sens := D.Prev_Sig; + end; + end loop; + + Put ("value ("); + Put_Addr (S.Val.all'Address); + Put ("): "); + Disp_Memtyp ((S.Typ, S.Val), Get_Type (S.Decl)); + New_Line; + end if; + + if Opts.Drivers and then S.Sig /= null then + Put ("drivers ("); + Put_Addr (S.Sig.all'Address); + Put ("): "); + New_Line; + Info_Signal_Driver ((S.Typ, S.Sig), Get_Type (S.Decl)); + end if; + + if Opts.Actions and then S.Sig /= null then + Put_Line ("actions:"); + Info_Signal_Action ((S.Typ, S.Sig), Get_Type (S.Decl)); + end if; + end Info_Signal_Opts; + + procedure Info_Signal (Idx : Signal_Index_Type) is + begin + Info_Signal_Opts (Idx, (others => False)); + end Info_Signal; + + -- For gdb. + pragma Unreferenced (Info_Signal); + + procedure Info_Signal_Proc (Line : String) + is + Opts : Info_Signal_Options; + F, L : Natural; + Idx : Uns32; + Valid : Boolean; + begin + Opts := (others => False); + Idx := 0; + + F := Line'First; + loop + F := Skip_Blanks (Line, F); + exit when F > Line'Last; + L := Get_Word (Line, F); + if Line (F .. L) = "-h" then + Put_Line ("info sig [OPTS] [SIG]"); + Put_Line (" -h disp this help"); + Put_Line (" -v disp values"); + Put_Line (" -d disp drivers"); + Put_Line (" -a disp actions"); + return; + elsif Line (F .. L) = "-v" then + Opts.Value := True; + elsif Line (F .. L) = "-d" then + Opts.Drivers := True; + elsif Line (F .. L) = "-a" then + Opts.Actions := True; + elsif Line (F) in '0' .. '9' then + To_Num (Line (F .. L), Idx, Valid); + if not Valid + or else Signal_Index_Type (Idx) > Signals_Table.Last + then + Put_Line ("invalid signal index"); + return; + end if; + else + Put_Line ("unknown option"); + return; + end if; + F := L + 1; + end loop; + + if Idx = 0 then + for I in Signals_Table.First .. Signals_Table.Last loop + Info_Signal_Opts (I, Opts); + end loop; + else + Info_Signal_Opts (Signal_Index_Type (Idx), Opts); + end if; + end Info_Signal_Proc; + + procedure Disp_Quantity_Prefix (Decl : Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Free_Quantity_Declaration => + Put (Image (Get_Identifier (Decl))); + when Iir_Kind_Dot_Attribute => + Disp_Quantity_Prefix (Get_Prefix (Decl)); + Put ("'dot"); + when Iir_Kinds_Denoting_Name => + Disp_Quantity_Prefix (Get_Named_Entity (Decl)); + when others => + Vhdl.Errors.Error_Kind ("disp_quantity_prefix", Decl); + end case; + end Disp_Quantity_Prefix; + + procedure Info_Quantity_Proc (Line : String) + is + pragma Unreferenced (Line); + begin + for I in Quantity_Table.First .. Quantity_Table.Last loop + declare + Q : Quantity_Entry renames Quantity_Table.Table (I); + Idx : Scalar_Quantity_Index; + begin + Put_Int32 (Int32 (I)); + Put (": "); + + Disp_Instance_Path (Q.Inst, True); + Put ('/'); + Disp_Quantity_Prefix (Q.Decl); + Put (" type: "); + Debug_Type_Short (Q.Typ); + Put (", len: "); + Put_Uns32 (Q.Typ.W); + Put (", Idx: "); + Put_Uns32 (Uns32 (Q.Idx)); + Put (", val: "); + Disp_Memtyp ((Q.Typ, Q.Val), Get_Type (Q.Decl)); + New_Line; + Idx := Q.Idx; + for I in 1 .. Q.Typ.W loop + declare + use Simul.Vhdl_Simul; + Sq : Scalar_Quantity_Record renames + Scalar_Quantities_Table.Table (Idx); + begin + Put (" scal #"); + Put_Uns32 (Uns32 (Idx)); + Put (" idx: "); + Put_Uns32 (Uns32 (Sq.Idx)); + Put (", deriv: "); + Put_Uns32 (Uns32 (Sq.Deriv)); + Put (", integ: "); + Put_Uns32 (Uns32 (Sq.Integ)); + New_Line; + end; + Idx := Idx + 1; + end loop; + end; + end loop; + end Info_Quantity_Proc; + + procedure Info_Equations_Proc (Line : String) + is + pragma Unreferenced (Line); + begin + for I in Simultaneous_Table.First .. Simultaneous_Table.Last loop + declare + S : Simultaneous_Record renames Simultaneous_Table.Table (I); + begin + Put_Int32 (Int32 (I)); + Put (": "); + + Disp_Instance_Path (S.Inst, True); + New_Line; + end; + end loop; + end Info_Equations_Proc; + + procedure Info_Time (Line : String) + is + pragma Unreferenced (Line); + begin + Put ("now: "); + Put_Time (Current_Time); + if Grt.Processes.Flag_AMS then + Put (" "); + Put_Fp64 (Fp64 (Current_Time_AMS)); + end if; + New_Line; + Put ("next time: "); + Put_Time (Grt.Processes.Next_Time); + New_Line; + end Info_Time; + + procedure Run_Proc (Line : String) + is + Delta_Time : Std_Time; + P : Positive; + begin + P := Skip_Blanks (Line); + if P <= Line'Last then + Delta_Time := Grt.Options.Parse_Time (Line (P .. Line'Last)); + if Delta_Time = -1 then + return; + end if; + Simul.Vhdl_Simul.Break_Time := Current_Time + Delta_Time; + Grt.Processes.Next_Time := Current_Time + Delta_Time; + end if; + + Elab.Debugger.Prepare_Continue; + end Run_Proc; + + procedure Ps_Proc (Line : String) + is + pragma Unreferenced (Line); + begin + for I in Processes_Table.First .. Processes_Table.Last loop + Put_Uns32 (Uns32 (I)); + Put (": "); + Disp_Instance_Path (Processes_Table.Table (I).Inst); + Put (" ("); + Put (Vhdl.Errors.Disp_Location (Processes_Table.Table (I).Proc)); + Put_Line (")"); + end loop; + end Ps_Proc; + + procedure Trace_Proc (Line : String) + is + Fn, Ln : Natural; + Fv, Lv : Natural; + State : Boolean; + begin + Fn := Skip_Blanks (Line, Line'First); + if Fn > Line'Last then + Put ("missing trace name"); + return; + end if; + Ln := Get_Word (Line, Fn); + + Fv := Skip_Blanks (Line, Ln + 1); + if Fv > Line'Last then + Put ("missing on/off/0/1"); + return; + end if; + Lv := Get_Word (Line, Fv); + if Line (Fv .. Lv) = "on" or Line (Fv .. Lv) = "1" then + State := True; + elsif Line (Fv .. Lv) = "off" or Line (Fv .. Lv) = "0" then + State := False; + else + Put ("expect on/off/0/1"); + return; + end if; + + if Line (Fn .. Ln) = "residues" then + Simul.Vhdl_Simul.Trace_Residues := State; + else + Put_Line ("usage: trace residues on|off|0|1"); + end if; + end Trace_Proc; + + procedure Quit_Proc (Line : String) + is + pragma Unreferenced (Line); + begin + GNAT.OS_Lib.OS_Exit (0); + end Quit_Proc; + + procedure Init is + begin + Elab.Vhdl_Debug.Append_Commands; + Append_Info_Command + (new String'("sig*nal"), + new String'("display info about a signal"), + Info_Signal_Proc'Access); + Append_Info_Command + (new String'("quan*tity"), + new String'("display info about quantities"), + Info_Quantity_Proc'Access); + Append_Info_Command + (new String'("equ*ations"), + new String'("display info about equations"), + Info_Equations_Proc'Access); + Append_Info_Command + (new String'("t*ime"), + new String'("display current time"), + Info_Time'Access); + Append_Menu_Command + (new String'("r*un"), + new String'("resume execution for an amount of time"), + Run_Proc'Access); + Append_Menu_Command + (new String'("ps"), + new String'("print all processes"), + Ps_Proc'Access); + Append_Menu_Command + (new String'("trace"), + new String'("enable/disable a trace"), + Trace_Proc'Access); + Append_Menu_Command + (new String'("q*uit"), + new String'("exit simulation"), + Quit_Proc'Access); + end Init; +end Simul.Vhdl_Debug; diff --git a/src/simul/simul-vhdl_debug.ads b/src/simul/simul-vhdl_debug.ads new file mode 100644 index 000000000..71715fa1d --- /dev/null +++ b/src/simul/simul-vhdl_debug.ads @@ -0,0 +1,22 @@ +-- Debugger for VHDL simulation +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +package Simul.Vhdl_Debug is + -- Append new commands + procedure Init; +end Simul.Vhdl_Debug; diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb new file mode 100644 index 000000000..8530fb99e --- /dev/null +++ b/src/simul/simul-vhdl_elab.adb @@ -0,0 +1,677 @@ +-- Elaboration for VHDL simulation +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Vhdl.Errors; use Vhdl.Errors; +with Vhdl.Utils; use Vhdl.Utils; +with Vhdl.Canon; + +with Synth.Vhdl_Stmts; +with Trans_Analyzes; +with Elab.Vhdl_Decls; + +with Simul.Vhdl_Debug; + +package body Simul.Vhdl_Elab is + procedure Gather_Processes_1 (Inst : Synth_Instance_Acc); + + procedure Convert_Type_Width (T : Type_Acc) is + begin + if T.Wkind = Wkind_Sim then + return; + end if; + case T.Kind is + when Type_Bit + | Type_Logic + | Type_Discrete + | Type_Float => + T.W := 1; + T.Wkind := Wkind_Sim; + when Type_Vector + | Type_Array => + Convert_Type_Width (T.Arr_El); + T.W := T.Abound.Len * T.Arr_El.W; + T.Wkind := Wkind_Sim; + when Type_Record => + T.W := 0; + for I in T.Rec.E'Range loop + T.Rec.E (I).Offs.Net_Off := T.W; + Convert_Type_Width (T.Rec.E (I).Typ); + T.W := T.W + T.Rec.E (I).Typ.W; + end loop; + T.Wkind := Wkind_Sim; + when others => + raise Internal_Error; + end case; + end Convert_Type_Width; + + procedure Gather_Signal (Proto_E : Signal_Entry) + is + Val : constant Valtyp := Get_Value (Proto_E.Inst, Proto_E.Decl); + E : Signal_Entry; + begin + E := Proto_E; + E.Typ := Val.Typ; + Convert_Type_Width (E.Typ); + Current_Pool := Global_Pool'Access; + E.Val := Alloc_Memory (E.Typ); + Current_Pool := Expr_Pool'Access; + if Val.Val.Init /= null then + Copy_Memory (E.Val, Val.Val.Init.Mem, E.Typ.Sz); + else + Write_Value_Default (E.Val, E.Typ); + end if; + E.Sig := null; + + pragma Assert (E.Kind /= Mode_End); + pragma Assert (Signals_Table.Table (Val.Val.S).Kind = Mode_End); + Signals_Table.Table (Val.Val.S) := E; + end Gather_Signal; + + procedure Gather_Quantity (Inst : Synth_Instance_Acc; Decl : Node) + is + Val : constant Valtyp := Get_Value (Inst, Decl); + begin + Convert_Type_Width (Val.Typ); + pragma Assert (Val.Val.Q = No_Quantity_Index); + Quantity_Table.Append ((Decl, Inst, Val.Typ, null, No_Scalar_Quantity)); + Val.Val.Q := Quantity_Table.Last; + end Gather_Quantity; + + procedure Gather_Processes_Decl (Inst : Synth_Instance_Acc; Decl : Node) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Interface_Signal_Declaration => + -- Driver. + case Get_Mode (Decl) is + when Iir_Unknown_Mode => + raise Internal_Error; + when Iir_Linkage_Mode => + Gather_Signal ((Mode_Linkage, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + when Iir_Buffer_Mode => + Gather_Signal ((Mode_Buffer, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + when Iir_Out_Mode => + Gather_Signal ((Mode_Out, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + when Iir_Inout_Mode => + Gather_Signal ((Mode_Inout, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + when Iir_In_Mode => + Gather_Signal ((Mode_In, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + end case; + when Iir_Kind_Signal_Declaration => + Gather_Signal ((Mode_Signal, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index, + No_Driver_Index, No_Connect_Index)); + when Iir_Kind_Configuration_Specification => + null; + when Iir_Kind_Free_Quantity_Declaration + | Iir_Kind_Dot_Attribute => + Gather_Quantity (Inst, Decl); + when Iir_Kind_Attribute_Implicit_Declaration => + declare + Sig : Node; + begin + Sig := Get_Attribute_Implicit_Chain (Decl); + while Sig /= Null_Node loop + Gather_Processes_Decl (Inst, Sig); + Sig := Get_Attr_Chain (Sig); + end loop; + end; + when Iir_Kind_Above_Attribute => + Gather_Signal ((Mode_Above, Decl, Inst, null, null, null, + No_Sensitivity_Index, No_Signal_Index)); + when Iir_Kind_Constant_Declaration + | Iir_Kind_Variable_Declaration + | Iir_Kind_Object_Alias_Declaration + | Iir_Kind_Attribute_Declaration + | Iir_Kind_Attribute_Specification + | Iir_Kind_Type_Declaration + | Iir_Kind_Anonymous_Type_Declaration + | Iir_Kind_Subtype_Declaration + | Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration + | Iir_Kind_Function_Body + | Iir_Kind_Procedure_Body + | Iir_Kind_Component_Declaration => + null; + when others => + Error_Kind ("gather_processes_decl", Decl); + end case; + end Gather_Processes_Decl; + + procedure Gather_Processes_Decls + (Inst : Synth_Instance_Acc; Decls : Node) + is + Decl : Node; + begin + Decl := Decls; + while Decl /= Null_Node loop + Gather_Processes_Decl (Inst, Decl); + Decl := Get_Chain (Decl); + end loop; + end Gather_Processes_Decls; + + procedure Add_Process_Driver (Proc_Idx : Process_Index_Type; + Sig : Signal_Index_Type; + Off : Value_Offsets; + Typ : Type_Acc) is + begin + Drivers_Table.Append + ((Sig => Sig, + Off => Off, + Typ => Typ, + Prev_Sig => Signals_Table.Table (Sig).Drivers, + + Proc => Proc_Idx, + Prev_Proc => Processes_Table.Table (Proc_Idx).Drivers)); + + Signals_Table.Table (Sig).Drivers := Drivers_Table.Last; + Processes_Table.Table (Proc_Idx).Drivers := Drivers_Table.Last; + end Add_Process_Driver; + + procedure Gather_Process_Drivers + (Inst : Synth_Instance_Acc; Proc : Node; Proc_Idx : Process_Index_Type) + is + use Synth.Vhdl_Stmts; + Driver_List: Iir_List; + It : List_Iterator; + Sig : Node; + Base_Vt : Valtyp; + Base : Signal_Index_Type; + Typ : Type_Acc; + Off : Value_Offsets; + Dyn : Dyn_Name; + begin + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); + It := List_Iterate_Safe (Driver_List); + while Is_Valid (It) loop + Sig := Get_Element (It); + exit when Sig = Null_Node; + Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + Base := Base_Vt.Val.S; + + Add_Process_Driver (Proc_Idx, Base, Off, Typ); + + Next (It); + end loop; + Trans_Analyzes.Free_Drivers_List (Driver_List); + end Gather_Process_Drivers; + + procedure Gather_Sensitivity (Inst : Synth_Instance_Acc; + Proc_Idx : Process_Index_Type; + List : Iir_List) + is + use Synth.Vhdl_Stmts; + It : List_Iterator; + Sig : Node; + Base_Vt : Valtyp; + Base : Signal_Index_Type; + Typ : Type_Acc; + Off : Value_Offsets; + Dyn : Dyn_Name; + begin + It := List_Iterate_Safe (List); + while Is_Valid (It) loop + Sig := Get_Element (It); + exit when Sig = Null_Node; + Synth_Assignment_Prefix (Inst, Sig, Base_Vt, Typ, Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + Base := Base_Vt.Val.S; + + Sensitivity_Table.Append + ((Sig => Base, + Off => Off, + Typ => Typ, + Prev_Sig => Signals_Table.Table (Base).Sensitivity, + + Proc => Proc_Idx, + Prev_Proc => Processes_Table.Table (Proc_Idx).Sensitivity)); + + Signals_Table.Table (Base).Sensitivity := Sensitivity_Table.Last; + Processes_Table.Table (Proc_Idx).Sensitivity := + Sensitivity_Table.Last; + + Next (It); + end loop; + end Gather_Sensitivity; + + procedure Gather_Process_Sensitivity + (Inst : Synth_Instance_Acc; Proc : Node; Proc_Idx : Process_Index_Type) + is + List : Iir_List; + begin + case Get_Kind (Proc) is + when Iir_Kind_Process_Statement => + -- No sensitivity list. + -- TODO: extract potential list from wait statements ? + return; + when Iir_Kind_Concurrent_Simple_Signal_Assignment => + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Simple_Signal_Assignment + (Proc, List); + when Iir_Kind_Concurrent_Conditional_Signal_Assignment => + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Conditional_Signal_Assignment + (Proc, List); + when Iir_Kind_Concurrent_Selected_Signal_Assignment => + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Selected_Signal_Assignment + (Proc, List); + when Iir_Kind_Concurrent_Assertion_Statement => + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Assertion_Statement + (Proc, List); + when Iir_Kind_Concurrent_Procedure_Call_Statement => + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Procedure_Call + (Get_Procedure_Call (Proc), List); + when Iir_Kind_Sensitized_Process_Statement => + List := Get_Sensitivity_List (Proc); + if List = Iir_List_All then + List := Vhdl.Canon.Canon_Extract_Sensitivity_Process (Proc); + else + Gather_Sensitivity (Inst, Proc_Idx, List); + return; + end if; + when Iir_Kind_Psl_Assert_Directive => + List := Get_PSL_Clock_Sensitivity (Proc); + Gather_Sensitivity (Inst, Proc_Idx, List); + return; + when Iir_Kind_Concurrent_Break_Statement => + List := Get_Sensitivity_List (Proc); + if List /= Null_Iir_List then + Gather_Sensitivity (Inst, Proc_Idx, List); + return; + else + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Break_Statement + (Proc, List); + end if; + when others => + Error_Kind ("gather_process_sensitivity", Proc); + end case; + Gather_Sensitivity (Inst, Proc_Idx, List); + Destroy_Iir_List (List); + end Gather_Process_Sensitivity; + + procedure Gather_Connections (Port_Inst : Synth_Instance_Acc; + Ports : Node; + Assoc_Inst : Synth_Instance_Acc; + Assocs : Node) + is + use Synth.Vhdl_Stmts; + Assoc_Inter : Node; + Assoc : Node; + Inter : Node; + Formal_Base : Valtyp; + Actual_Base : Valtyp; + Formal_Sig : Signal_Index_Type; + Actual_Sig : Signal_Index_Type; + Typ : Type_Acc; + Off : Value_Offsets; + Dyn : Dyn_Name; + Conn : Connect_Entry; + List : Iir_List; + begin + Assoc := Assocs; + Assoc_Inter := Ports; + while Is_Valid (Assoc) loop + case Get_Kind (Assoc) is + when Iir_Kind_Association_Element_By_Name => + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + Synth_Assignment_Prefix + (Port_Inst, Inter, Formal_Base, Typ, Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + Formal_Sig := Formal_Base.Val.S; + Conn.Formal_Base := Formal_Sig; + Conn.Formal_Offs := Off; + Conn.Formal_Type := Typ; + Conn.Formal_Link := Signals_Table.Table (Formal_Sig).Connect; + + Synth_Assignment_Prefix + (Assoc_Inst, Get_Actual (Assoc), Actual_Base, Typ, Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + Actual_Sig := Actual_Base.Val.S; + Conn.Actual_Base := Actual_Sig; + Conn.Actual_Offs := Off; + Conn.Actual_Type := Typ; + Conn.Actual_Link := Signals_Table.Table (Actual_Sig).Connect; + + Conn.Assoc := Assoc; + Conn.Assoc_Inst := Assoc_Inst; + + -- LRM08 6.4.2.3 Signal declarations + -- [...], each source is either a driver or an OUT, INOUT, + -- BUFFER, or LINKAGE port [...] + case Get_Mode (Inter) is + when Iir_In_Mode => + Conn.Drive_Formal := True; + Conn.Drive_Actual := False; + when Iir_Out_Mode + | Iir_Buffer_Mode => + Conn.Drive_Formal := False; + Conn.Drive_Actual := True; + when Iir_Inout_Mode + | Iir_Linkage_Mode => + Conn.Drive_Formal := True; + Conn.Drive_Actual := True; + when Iir_Unknown_Mode => + raise Internal_Error; + end case; + + Connect_Table.Append (Conn); + + Signals_Table.Table (Formal_Sig).Connect := Connect_Table.Last; + Signals_Table.Table (Actual_Sig).Connect := Connect_Table.Last; + + -- Collapse + if Get_Collapse_Signal_Flag (Assoc) then + pragma Assert (Conn.Formal_Offs.Mem_Off = 0); + pragma Assert (Conn.Actual_Offs.Mem_Off = 0); + pragma Assert (Actual_Base.Typ.W = Typ.W); + pragma Assert (Formal_Base.Typ.W = Typ.W); + pragma Assert (Signals_Table.Table (Formal_Sig).Collapsed_By + = No_Signal_Index); + pragma Assert (Formal_Sig > Actual_Sig); + Signals_Table.Table (Formal_Sig).Collapsed_By := Actual_Sig; + else + -- TODO: handle non-collapsed signals in simul. + raise Internal_Error; + end if; + when Iir_Kind_Association_Element_Open + | Iir_Kind_Association_Element_By_Individual => + null; + when Iir_Kind_Association_Element_By_Expression => + if Get_Expr_Staticness (Get_Actual (Assoc)) < Globally then + Inter := Get_Association_Interface (Assoc, Assoc_Inter); + Synth_Assignment_Prefix + (Port_Inst, Inter, Formal_Base, Typ, Off, Dyn); + pragma Assert (Dyn = No_Dyn_Name); + Formal_Sig := Formal_Base.Val.S; + Conn.Formal_Base := Formal_Sig; + Conn.Formal_Offs := Off; + Conn.Formal_Type := Typ; + Conn.Formal_Link := Signals_Table.Table (Formal_Sig).Connect; + + Conn.Actual_Base := No_Signal_Index; + Conn.Actual_Offs := No_Value_Offsets; + Conn.Actual_Type := null; + Conn.Actual_Link := No_Connect_Index; + + Conn.Assoc := Assoc; + Conn.Assoc_Inst := Assoc_Inst; + + -- Always an IN interface. + Conn.Drive_Formal := True; + Conn.Drive_Actual := False; + + Connect_Table.Append (Conn); + + Signals_Table.Table (Formal_Sig).Connect := + Connect_Table.Last; + + Processes_Table.Append + ((Proc => Assoc, + Inst => Assoc_Inst, + Drivers => No_Driver_Index, + Sensitivity => No_Sensitivity_Index)); + + Add_Process_Driver + (Processes_Table.Last, Formal_Sig, Off, Typ); + + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Expression + (Get_Actual (Assoc), List, False); + Gather_Sensitivity (Assoc_Inst, Processes_Table.Last, List); + Destroy_Iir_List (List); + else + raise Internal_Error; + end if; + when others => + Error_Kind ("gather_connections", Assoc); + end case; + Next_Association_Interface (Assoc, Assoc_Inter); + end loop; + end Gather_Connections; + + procedure Gather_Connections_Instantiation_Statement + (Inst : Synth_Instance_Acc; Stmt : Node; Sub_Inst : Synth_Instance_Acc) + is + Sub_Scope : constant Node := Get_Source_Scope (Sub_Inst); + Comp_Inst : Synth_Instance_Acc; + Arch : Node; + Ent : Node; + Config : Node; + Bind : Node; + begin + if Get_Kind (Sub_Scope) = Iir_Kind_Component_Declaration then + -- Connections with the components. + Gather_Connections (Sub_Inst, Get_Port_Chain (Sub_Scope), + Inst, Get_Port_Map_Aspect_Chain (Stmt)); + -- Connections with the entity + Comp_Inst := Get_Component_Instance (Sub_Inst); + if Comp_Inst = null then + -- Unbounded. + return; + end if; + Arch := Get_Source_Scope (Comp_Inst); + Ent := Get_Entity (Arch); + Config := Get_Instance_Config (Sub_Inst); + Bind := Get_Binding_Indication (Config); + -- Connections of the entity with the component. + Gather_Connections (Comp_Inst, Get_Port_Chain (Ent), + Sub_Inst, Get_Port_Map_Aspect_Chain (Bind)); + else + pragma Assert (Get_Kind (Sub_Scope) = Iir_Kind_Architecture_Body); + Gather_Connections + (Sub_Inst, Get_Port_Chain (Get_Entity (Sub_Scope)), + Inst, Get_Port_Map_Aspect_Chain (Stmt)); + end if; + end Gather_Connections_Instantiation_Statement; + + procedure Gather_Processes_Stmt + (Inst : Synth_Instance_Acc; Stmt : Node) is + begin + case Get_Kind (Stmt) is + when Iir_Kind_Component_Instantiation_Statement => + declare + Sub_Inst : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + begin + Gather_Processes_1 (Sub_Inst); + Gather_Connections_Instantiation_Statement + (Inst, Stmt, Sub_Inst); + end; + when Iir_Kind_If_Generate_Statement => + declare + Sub : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + begin + if Sub /= null then + Gather_Processes_1 (Sub); + end if; + end; + when Iir_Kind_For_Generate_Statement => + declare + It : constant Node := Get_Parameter_Specification (Stmt); + It_Rng : Type_Acc; + It_Len : Natural; + Gen_Inst : Synth_Instance_Acc; + begin + It_Rng := Get_Subtype_Object (Inst, Get_Type (It)); + It_Len := Natural (Get_Range_Length (It_Rng.Drange)); + Gen_Inst := Get_Sub_Instance (Inst, Stmt); + for I in 1 .. It_Len loop + Gather_Processes_1 + (Get_Generate_Sub_Instance (Gen_Inst, I)); + end loop; + end; + when Iir_Kind_Block_Statement => + declare + Sub : constant Synth_Instance_Acc := + Get_Sub_Instance (Inst, Stmt); + begin + Gather_Processes_1 (Sub); + end; + when Iir_Kinds_Concurrent_Signal_Assignment + | Iir_Kind_Concurrent_Assertion_Statement + | Iir_Kind_Concurrent_Procedure_Call_Statement + | Iir_Kinds_Process_Statement => + Processes_Table.Append ((Proc => Stmt, + Inst => Inst, + Drivers => No_Driver_Index, + Sensitivity => No_Sensitivity_Index)); + Gather_Process_Drivers (Inst, Stmt, Processes_Table.Last); + Gather_Process_Sensitivity (Inst, Stmt, Processes_Table.Last); + when Iir_Kind_Psl_Default_Clock => + null; + when Iir_Kind_Psl_Assert_Directive + | Iir_Kind_Concurrent_Break_Statement => + Processes_Table.Append ((Proc => Stmt, + Inst => Inst, + Drivers => No_Driver_Index, + Sensitivity => No_Sensitivity_Index)); + Gather_Process_Sensitivity (Inst, Stmt, Processes_Table.Last); + when Iir_Kind_Simple_Simultaneous_Statement => + Simultaneous_Table.Append ((Stmt => Stmt, Inst => Inst)); + when others => + Vhdl.Errors.Error_Kind ("gather_processes_stmt", Stmt); + end case; + end Gather_Processes_Stmt; + + procedure Gather_Processes_Stmts (Inst : Synth_Instance_Acc; Stmts : Node) + is + Stmt : Node; + begin + Stmt := Stmts; + while Stmt /= Null_Node loop + Gather_Processes_Stmt (Inst, Stmt); + Stmt := Get_Chain (Stmt); + end loop; + end Gather_Processes_Stmts; + + procedure Gather_Processes_1 (Inst : Synth_Instance_Acc) + is + N : constant Node := Get_Source_Scope (Inst); + begin + case Get_Kind (N) is + when Iir_Kind_Architecture_Body => + declare + Ent : constant Node := Get_Entity (N); + begin + Gather_Processes_Decls + (Inst, Get_Port_Chain (Ent)); + Gather_Processes_Decls + (Inst, Get_Declaration_Chain (Ent)); + Gather_Processes_Stmts + (Inst, Get_Concurrent_Statement_Chain (Ent)); + Gather_Processes_Decls + (Inst, Get_Declaration_Chain (N)); + Gather_Processes_Stmts + (Inst, Get_Concurrent_Statement_Chain (N)); + end; + when Iir_Kind_Component_Declaration => + declare + Comp_Inst : constant Synth_Instance_Acc := + Get_Component_Instance (Inst); + begin + Gather_Processes_Decls (Inst, Get_Port_Chain (N)); + if Comp_Inst /= null then + Gather_Processes_1 (Comp_Inst); + end if; + end; + when Iir_Kind_Generate_Statement_Body + | Iir_Kind_Block_Statement => + Gather_Processes_Decls + (Inst, Get_Declaration_Chain (N)); + Gather_Processes_Stmts + (Inst, Get_Concurrent_Statement_Chain (N)); + when Iir_Kind_Package_Declaration => + Gather_Processes_Decls + (Inst, Get_Declaration_Chain (N)); + when others => + Vhdl.Errors.Error_Kind ("gater_processes_1", N); + end case; + end Gather_Processes_1; + + procedure Gather_Processes (Top : Synth_Instance_Acc) is + begin + Processes_Table.Init; + Signals_Table.Init; + Drivers_Table.Init; + + Simul.Vhdl_Debug.Init; + + Signals_Table.Set_Last (Get_Nbr_Signal); + for I in Signals_Table.First .. Signals_Table.Last loop + Signals_Table.Table (I) := + (Mode_End, Null_Node, null, null, null, null, + No_Sensitivity_Index, No_Signal_Index); + end loop; + + -- Gather declarations of top-level packages. + declare + It : Iterator_Top_Level_Type; + Inst : Synth_Instance_Acc; + begin + It := Iterator_Top_Level_Init; + loop + Iterate_Top_Level (It, Inst); + exit when Inst = null; + pragma Assert (Inst /= Top); + Gather_Processes_1 (Inst); + end loop; + end; + + Gather_Processes_1 (Top); + + -- For the debugger. + Top_Instance := Top; + end Gather_Processes; + + procedure Elab_Processes + is + Proc : Node; + Proc_Inst : Synth_Instance_Acc; + begin + 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 + Proc_Inst := Make_Elab_Instance (Processes_Table.Table (I).Inst, + Proc, Null_Node); + Processes_Table.Table (I).Inst := Proc_Inst; + Elab.Vhdl_Decls.Elab_Declarations + (Proc_Inst, Get_Declaration_Chain (Proc), True); + end if; + end loop; + end Elab_Processes; + + procedure Elab_Drivers is + begin + null; + end Elab_Drivers; +end Simul.Vhdl_Elab; diff --git a/src/simul/simul-vhdl_elab.ads b/src/simul/simul-vhdl_elab.ads new file mode 100644 index 000000000..c8bc54e94 --- /dev/null +++ b/src/simul/simul-vhdl_elab.ads @@ -0,0 +1,200 @@ +-- Elaboration for VHDL simulation +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Types; use Types; +with Tables; + +with Grt.Types; use Grt.Types; +with Grt.Vhdl_Types; use Grt.Vhdl_Types; + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +package Simul.Vhdl_Elab is + procedure Gather_Processes (Top : Synth_Instance_Acc); + procedure Elab_Processes; + + -- For the debugger. + Top_Instance : Synth_Instance_Acc; + + -- For each signals: + -- * drivers (process + area), sources + -- * sensitivity + -- * waveform assignments + -- * decomposition level: none, vectors, full. + -- * force/release + -- * need to track activity + -- * need to track events + procedure Elab_Drivers; + + type Process_Index_Type is new Nat32; + type Driver_Index_Type is new Nat32; + subtype Sensitivity_Index_Type is Driver_Index_Type; + + No_Driver_Index : constant Driver_Index_Type := 0; + No_Sensitivity_Index : constant Sensitivity_Index_Type := 0; + + type Proc_Record_Type is record + Proc : Node; + Inst : Synth_Instance_Acc; + Drivers : Driver_Index_Type; + Sensitivity : Sensitivity_Index_Type; + end record; + + -- Table of all processes (explicit or implicit). + package Processes_Table is new Tables + (Table_Component_Type => Proc_Record_Type, + Table_Index_Type => Process_Index_Type, + Table_Low_Bound => 1, + Table_Initial => 128); + + type Simultaneous_Record is record + Stmt : Node; + Inst : Synth_Instance_Acc; + end record; + + type Simultaneous_Index_Type is new Nat32; + + package Simultaneous_Table is new Tables + (Table_Component_Type => Simultaneous_Record, + Table_Index_Type => Simultaneous_Index_Type, + Table_Low_Bound => 1, + Table_Initial => 16); + + type Connect_Index_Type is new Nat32; + No_Connect_Index : constant Connect_Index_Type := 0; + + -- Connections. For each associations (block/component/entry), the + -- elaborator adds an entry in that table. + type Connect_Entry is record + Formal_Base : Signal_Index_Type; + Formal_Offs : Value_Offsets; + Formal_Type : Type_Acc; + -- Next connection for the formal. + Formal_Link : Connect_Index_Type; + + Actual_Base : Signal_Index_Type; + Actual_Offs : Value_Offsets; + Actual_Type : Type_Acc; + -- Next connection for the actual. + Actual_Link : Connect_Index_Type; + + -- Whether it is a source for the actual or/and the actual. + -- The correct word is 'source'. + Drive_Formal : Boolean; + Drive_Actual : Boolean; + + Assoc : Node; + Assoc_Inst : Synth_Instance_Acc; + end record; + + package Connect_Table is new Tables + (Table_Component_Type => Connect_Entry, + Table_Index_Type => Connect_Index_Type, + Table_Low_Bound => No_Connect_Index + 1, + Table_Initial => 32); + + -- Signals. + + type Signal_Entry (Kind : Mode_Signal_Type := Mode_Signal) is record + Decl : Iir; + Inst : Synth_Instance_Acc; + Typ : Type_Acc; + Val : Memory_Ptr; + Sig : Memory_Ptr; + + -- Processes sensitized by this signal. + Sensitivity : Sensitivity_Index_Type; + + -- This signal is identical to Collapsed_By, if set. + Collapsed_By : Signal_Index_Type; + + case Kind is + when Mode_Signal_User => + Drivers : Driver_Index_Type; + Connect : Connect_Index_Type; + when Mode_Quiet | Mode_Stable | Mode_Delayed + | Mode_Transaction => + Time : Std_Time; + Prefix : Memory_Ptr; + when Mode_Above => + null; + when Mode_Guard => + null; + when Mode_Conv_In | Mode_Conv_Out | Mode_End => + -- Unused. + null; + end case; + end record; + + package Signals_Table is new Tables + (Table_Component_Type => Signal_Entry, + Table_Index_Type => Signal_Index_Type, + Table_Low_Bound => No_Signal_Index + 1, + Table_Initial => 128); + + type Driver_Entry is record + -- The signal having a driver. + Sig : Signal_Index_Type; + Off : Value_Offsets; + Typ : Type_Acc; + -- Previous driver for the same signal. + Prev_Sig : Driver_Index_Type; + + -- The process driving this signal. + Proc : Process_Index_Type; + -- Previous driver for the same process. + Prev_Proc : Driver_Index_Type; + end record; + + package Drivers_Table is new Tables + (Table_Component_Type => Driver_Entry, + Table_Index_Type => Driver_Index_Type, + Table_Low_Bound => No_Driver_Index + 1, + Table_Initial => 128); + + subtype Sensitivity_Entry is Driver_Entry; + + package Sensitivity_Table is new Tables + (Table_Component_Type => Driver_Entry, + Table_Index_Type => Sensitivity_Index_Type, + Table_Low_Bound => No_Sensitivity_Index + 1, + Table_Initial => 128); + + type Scalar_Quantity_Index is new Uns32; + No_Scalar_Quantity : constant Scalar_Quantity_Index := 0; + + type Quantity_Entry is record + Decl : Iir; + Inst : Synth_Instance_Acc; + Typ : Type_Acc; + Val : Memory_Ptr; + -- Index in the scalar table. + Idx : Scalar_Quantity_Index; + end record; + + package Quantity_Table is new Tables + (Table_Component_Type => Quantity_Entry, + Table_Index_Type => Quantity_Index_Type, + Table_Low_Bound => No_Quantity_Index + 1, + Table_Initial => 128); +end Simul.Vhdl_Elab; diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb new file mode 100644 index 000000000..5ae5a8c1b --- /dev/null +++ b/src/simul/simul-vhdl_simul.adb @@ -0,0 +1,1992 @@ +-- Simulation of VHDL +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with System; +with Ada.Unchecked_Conversion; + +with Simple_IO; +with Utils_IO; + +with Vhdl.Errors; +with Vhdl.Sem_Inst; +with Vhdl.Canon; + +with Elab.Vhdl_Objtypes; use Elab.Vhdl_Objtypes; +with Elab.Vhdl_Values; use Elab.Vhdl_Values; +with Elab.Vhdl_Decls; +with Elab.Debugger; + +with Trans_Analyzes; + +with Synth.Errors; +with Synth.Vhdl_Stmts; use Synth.Vhdl_Stmts; +with Synth.Vhdl_Expr; +with Synth.Vhdl_Oper; +with Synth.Vhdl_Static_Proc; +with Synth.Flags; +with Synth.Ieee.Std_Logic_1164; use Synth.Ieee.Std_Logic_1164; + +with Grt.Types; use Grt.Types; +with Grt.Signals; use Grt.Signals; +with Grt.Options; +with Grt.Stdio; +with Grt.Processes; +with Grt.Main; +with Grt.Errors; +with Grt.Lib; +with Grt.Analog_Solver; + +package body Simul.Vhdl_Simul is + function To_Instance_Acc is new Ada.Unchecked_Conversion + (System.Address, Grt.Processes.Instance_Acc); + + procedure Process_Executer (Self : Grt.Processes.Instance_Acc); + pragma Convention (C, Process_Executer); + + type Ghdl_Signal_Ptr_Ptr is access all Ghdl_Signal_Ptr; + function To_Ghdl_Signal_Ptr_Ptr is + new Ada.Unchecked_Conversion (Memory_Ptr, Ghdl_Signal_Ptr_Ptr); + + Sig_Size : constant Size_Type := Ghdl_Signal_Ptr'Size / 8; + + subtype F64_C_Arr_Ptr is Grt.Analog_Solver.F64_C_Arr_Ptr; + + procedure Residues (T : Ghdl_F64; + Y : F64_C_Arr_Ptr; + Yp : F64_C_Arr_Ptr; + Res : F64_C_Arr_Ptr); + pragma Export (C, Residues, "grt__analog_solver__residues"); + + procedure Set_Quantities_Values (Y : F64_C_Arr_Ptr; Yp: F64_C_Arr_Ptr); + pragma Export (C, Set_Quantities_Values, "grt__analog_solver__set_values"); + + function Sig_Index (Base : Memory_Ptr; Idx : Uns32) return Memory_Ptr is + begin + return Base + Size_Type (Idx) * Sig_Size; + end Sig_Index; + + procedure Write_Sig (Mem : Memory_Ptr; Val : Ghdl_Signal_Ptr) is + begin + To_Ghdl_Signal_Ptr_Ptr (Mem).all := Val; + end Write_Sig; + + function Read_Sig (Mem : Memory_Ptr) return Ghdl_Signal_Ptr is + begin + return To_Ghdl_Signal_Ptr_Ptr (Mem).all; + end Read_Sig; + + function Exec_Sig_Sig (Val : Value_Acc) return Memory_Ptr + is + E : Signal_Entry renames Signals_Table.Table (Val.S); + begin + return E.Sig; + end Exec_Sig_Sig; + + function Hook_Signal_Expr (Val : Valtyp) return Valtyp is + begin + if Val.Val.Kind = Value_Alias then + declare + E : Signal_Entry renames Signals_Table.Table (Val.Val.A_Obj.S); + begin + return Create_Value_Memtyp + ((Val.Typ, E.Val + Val.Val.A_Off.Mem_Off)); + end; + else + declare + E : Signal_Entry renames Signals_Table.Table (Val.Val.S); + begin + return Create_Value_Memtyp ((E.Typ, E.Val)); + end; + end if; + end Hook_Signal_Expr; + + function Hook_Quantity_Expr (Val : Valtyp) return Valtyp is + begin + if Val.Val.Kind = Value_Alias then + declare + E : Quantity_Entry renames Quantity_Table.Table (Val.Val.A_Obj.Q); + begin + return Create_Value_Memtyp + ((Val.Typ, E.Val + Val.Val.A_Off.Mem_Off)); + end; + else + declare + E : Quantity_Entry renames Quantity_Table.Table (Val.Val.Q); + begin + return Create_Value_Memtyp ((E.Typ, E.Val)); + end; + end if; + end Hook_Quantity_Expr; + + procedure Disp_Iir_Location (N : Iir) + is + use Simple_IO; + begin + if N = Null_Iir then + Put_Err ("??:??:??"); + else + Put_Err (Vhdl.Errors.Disp_Location (N)); + end if; + Put_Err (": "); + end Disp_Iir_Location; + + + procedure Error_Msg_Exec (Loc : Iir; Msg : String) + is + use Simple_IO; + begin + Disp_Iir_Location (Loc); + Put_Line_Err (Msg); + Grt.Errors.Fatal_Error; + end Error_Msg_Exec; + + procedure Start_Assign_Value_To_Signal (Target: Memtyp; + Rej : Std_Time; + After : Std_Time; + Val : Memtyp) is + begin + case Target.Typ.Kind is + when Type_Logic + | Type_Bit => + Ghdl_Signal_Start_Assign_E8 + (Read_Sig (Target.Mem), Rej, Read_U8 (Val), After); + when Type_Discrete => + if Target.Typ.Sz = 1 then + Ghdl_Signal_Start_Assign_E8 + (Read_Sig (Target.Mem), Rej, Read_U8 (Val), After); + elsif Target.Typ.Sz = 4 then + Ghdl_Signal_Start_Assign_I32 + (Read_Sig (Target.Mem), Rej, Read_I32 (Val.Mem), After); + elsif Target.Typ.Sz = 8 then + Ghdl_Signal_Start_Assign_I64 + (Read_Sig (Target.Mem), Rej, Read_I64 (Val.Mem), After); + else + raise Internal_Error; + end if; + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Target.Typ.Abound.Len; + El : constant Type_Acc := Target.Typ.Arr_El; + begin + pragma Assert (Val.Typ.Abound.Len = Len); + for I in 1 .. Len loop + Start_Assign_Value_To_Signal + ((El, Sig_Index (Target.Mem, (Len - I) * El.W)), + Rej, After, + (Val.Typ.Arr_El, Val.Mem + Size_Type (I - 1) * El.Sz)); + end loop; + end; + when Type_Record => + for I in Val.Typ.Rec.E'Range loop + declare + E : Rec_El_Type renames Val.Typ.Rec.E (I); + begin + Start_Assign_Value_To_Signal + ((E.Typ, Sig_Index (Target.Mem, E.Offs.Net_Off)), + Rej, After, + (E.Typ, Val.Mem + E.Offs.Mem_Off)); + end; + end loop; + when others => + raise Internal_Error; + end case; + end Start_Assign_Value_To_Signal; + + procedure Add_Source (Typ : Type_Acc; Sig : Memory_Ptr; Val : Memory_Ptr) is + begin + case Typ.Kind is + when Type_Logic + | Type_Bit => + Grt.Signals.Ghdl_Signal_Add_Port_Driver_E8 + (Read_Sig (Sig), Read_U8 (Val)); + when Type_Discrete => + if Typ.Sz = 1 then + Grt.Signals.Ghdl_Signal_Add_Port_Driver_E8 + (Read_Sig (Sig), Read_U8 (Val)); + elsif Typ.Sz = 4 then + Grt.Signals.Ghdl_Signal_Add_Port_Driver_I32 + (Read_Sig (Sig), Read_I32 (Val)); + elsif Typ.Sz = 8 then + Grt.Signals.Ghdl_Signal_Add_Port_Driver_I64 + (Read_Sig (Sig), Read_I64 (Val)); + else + raise Internal_Error; + end if; + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + begin + for I in 1 .. Len loop + Add_Source (Typ.Arr_El, + Sig_Index (Sig, (Len - I) * Typ.Arr_El.W), + Val + Size_Type (I - 1) * Typ.Arr_El.Sz); + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Add_Source (Typ.Rec.E (I).Typ, + Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off), + Val + Typ.Rec.E (I).Offs.Mem_Off); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Source; + + procedure Create_Process_Drivers (Inst : Synth_Instance_Acc; + Proc : Node; + Driver_List : Iir_List) + is + pragma Unreferenced (Proc); + It : List_Iterator; + El: Iir; + Info : Target_Info; + begin + -- Some processes have no driver list (assertion). + It := List_Iterate_Safe (Driver_List); + while Is_Valid (It) loop + El := Get_Element (It); + + -- Mark (Marker, Expr_Pool); + Info := Synth_Target (Inst, El); + declare + E : Signal_Entry renames Signals_Table.Table (Info.Obj.Val.S); + begin + Add_Source (Info.Targ_Type, + Sig_Index (E.Sig, Info.Off.Net_Off), + E.Val + Info.Off.Mem_Off); + end; + + -- Release (Marker, Expr_Pool); + + Next (It); + end loop; + end Create_Process_Drivers; + + procedure Create_Process_Drivers (Proc : Process_Index_Type) + is + Drv : Driver_Index_Type; + begin + Drv := Processes_Table.Table (Proc).Drivers; + while Drv /= No_Driver_Index loop + declare + D : Driver_Entry renames Drivers_Table.Table (Drv); + S : Signal_Entry renames Signals_Table.Table (D.Sig); + begin + pragma Assert (D.Off = No_Value_Offsets); + Add_Source (S.Typ, S.Sig, S.Val); + + Drv := D.Prev_Proc; + end; + end loop; + end Create_Process_Drivers; + + function Exec_Event_Attribute (Sig : Memtyp) return Boolean is + begin + case Sig.Typ.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete => + return Read_Sig (Sig.Mem).Event; + when others => + raise Internal_Error; + return False; + end case; + end Exec_Event_Attribute; + + function Exec_Event_Attribute (Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp + is + Res : Valtyp; + Pfx : Target_Info; + E : Boolean; + begin + Pfx := Synth_Target (Inst, Get_Prefix (Expr)); + pragma Assert (Pfx.Kind = Target_Simple); + -- TODO: alias. + pragma Assert (Pfx.Obj.Val /= null + and then Pfx.Obj.Val.Kind = Value_Signal); + E := Exec_Event_Attribute + ((Pfx.Targ_Type, + Sig_Index (Signals_Table.Table (Pfx.Obj.Val.S).Sig, + Pfx.Off.Net_Off))); + Res := Create_Value_Memory (Boolean_Type); + Write_U8 (Res.Val.Mem, Boolean'Pos (E)); + return Res; + end Exec_Event_Attribute; + + function Exec_Dot_Attribute (Inst : Synth_Instance_Acc; + Expr : Node) return Valtyp + is + Pfx : Target_Info; + begin + Pfx := Synth_Target (Inst, Expr); + pragma Assert (Pfx.Kind = Target_Simple); + -- TODO: alias. + pragma Assert (Pfx.Obj.Val /= null + and then Pfx.Obj.Val.Kind = Value_Quantity); + return Hook_Quantity_Expr (Pfx.Obj); + end Exec_Dot_Attribute; + + procedure Execute_Sequential_Statements (Process : Process_State_Acc); + + function Execute_Condition (Inst : Synth_Instance_Acc; + Cond : Node) return Boolean + is + Cond_Val : Valtyp; + begin + if Cond = Null_Node then + return True; + end if; + Cond_Val := Synth.Vhdl_Expr.Synth_Expression (Inst, Cond); + return Read_Discrete (Cond_Val) = 1; + end Execute_Condition; + + function Get_Suspend_State_Var (Inst : Synth_Instance_Acc) return Memory_Ptr + is + Src : Node; + Var : Node; + State_Mem : Memory_Ptr; + begin + Src := Get_Source_Scope (Inst); + Var := Get_Declaration_Chain (Src); + pragma Assert (Var /= Null_Node); + pragma Assert (Get_Kind (Var) = Iir_Kind_Suspend_State_Declaration); + State_Mem := Get_Value (Inst, Var).Val.Mem; + return State_Mem; + end Get_Suspend_State_Var; + + -- Return the statement STMT corresponding to the current state from INST. + procedure Get_Suspend_State_Statement + (Inst : Synth_Instance_Acc; Stmt : out Node; Resume : out Boolean) + is + Src : Node; + Var : Node; + State_Mem : Memory_Ptr; + State : Int32; + begin + State_Mem := Get_Suspend_State_Var (Inst); + State := Int32 (Read_I32 (State_Mem)); + Src := Get_Source_Scope (Inst); + if State = 0 then + Stmt := Get_Sequential_Statement_Chain (Src); + Resume := False; + else + Var := Get_Declaration_Chain (Src); + Stmt := Get_Suspend_State_Chain (Var); + loop + pragma Assert (Stmt /= Null_Node); + exit when Get_Suspend_State_Index (Stmt) = State; + Stmt := Get_Suspend_State_Chain (Stmt); + end loop; + Resume := True; + end if; + end Get_Suspend_State_Statement; + + procedure Finish_Procedure_Call (Process : Process_State_Acc; + Bod : Node; + Stmt : out Node) + is + Imp : constant Node := Get_Subprogram_Specification (Bod); + Caller_Inst : constant Synth_Instance_Acc := + Get_Caller_Instance (Process.Instance); + Resume : Boolean; + begin + if not Get_Suspend_Flag (Bod) then + Process.Instance := Caller_Inst; + -- TODO: free old inst. + Stmt := Null_Node; + return; + end if; + Get_Suspend_State_Statement (Caller_Inst, Stmt, Resume); + pragma Assert (Resume); + -- Skip the resume statement. + Stmt := Get_Chain (Stmt); + pragma Assert (Get_Kind (Stmt) = Iir_Kind_Procedure_Call_Statement); + Synth_Subprogram_Back_Association + (Process.Instance, Caller_Inst, + Get_Interface_Declaration_Chain (Imp), + Get_Parameter_Association_Chain + (Get_Procedure_Call (Stmt))); + Process.Instance := Caller_Inst; + -- TODO: free old inst. + end Finish_Procedure_Call; + + procedure Next_Parent_Statement (Process : Process_State_Acc; + First_Parent : Node; + Stmt : out Node) + is + N_Stmt : Node; + Parent : Node; + begin + Parent := First_Parent; + loop + case Get_Kind (Parent) is + when Iir_Kind_Sensitized_Process_Statement => + Stmt := Null_Node; + return; + when Iir_Kind_Process_Statement => + Stmt := Get_Sequential_Statement_Chain (Parent); + return; + when Iir_Kind_If_Statement + | Iir_Kind_Case_Statement => + Stmt := Parent; + when Iir_Kind_For_Loop_Statement => + declare + Param : constant Node := + Get_Parameter_Specification (Parent); + Val : Valtyp; + begin + -- Update index + Val := Get_Value (Process.Instance, Param); + Update_Index (Val.Typ.Drange, Val); + + -- Test. + if Elab.Vhdl_Objtypes.In_Range (Val.Typ.Drange, + Read_Discrete (Val)) + then + Stmt := Get_Sequential_Statement_Chain (Parent); + return; + end if; + + -- End of loop. + Synth.Vhdl_Stmts.Finish_For_Loop_Statement + (Process.Instance, Parent); + Stmt := Parent; + end; + when Iir_Kind_While_Loop_Statement => + if Execute_Condition (Process.Instance, Get_Condition (Parent)) + then + Stmt := Get_Sequential_Statement_Chain (Parent); + return; + else + Stmt := Parent; + end if; + when Iir_Kind_Procedure_Body => + Finish_Procedure_Call (Process, Parent, Stmt); + exit when Stmt = Null_Node; + when others => + Vhdl.Errors.Error_Kind ("next_statement", Parent); + end case; + + N_Stmt := Get_Chain (Stmt); + if N_Stmt /= Null_Node then + Stmt := N_Stmt; + return; + end if; + + Parent := Get_Parent (Stmt); + end loop; + end Next_Parent_Statement; + + procedure Next_Statement (Process : Process_State_Acc; + Stmt : in out Node) + is + N_Stmt : Node; + begin + N_Stmt := Get_Chain (Stmt); + if N_Stmt /= Null_Node then + Stmt := N_Stmt; + return; + end if; + + Next_Parent_Statement (Process, Get_Parent (Stmt), Stmt); + end Next_Statement; + + procedure Add_Wait_Sensitivity (Typ : Type_Acc; Sig : Memory_Ptr) is + begin + case Typ.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete => + Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity (Read_Sig (Sig)); + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + begin + for I in 1 .. Len loop + Add_Wait_Sensitivity + (Typ.Arr_El, Sig_Index (Sig, (Len - I) * Typ.Arr_El.W)); + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Add_Wait_Sensitivity + (Typ.Rec.E (I).Typ, + Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off)); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Wait_Sensitivity; + + procedure Execute_Wait_Statement (Inst : Synth_Instance_Acc; + Stmt : Node) + is + Expr : Node; + List : Node_List; + Val : Valtyp; + Timeout : Int64; + begin + -- LRM93 8.1 + -- The execution of a wait statement causes the time expression to + -- be evaluated to determine the timeout interval. + Expr := Get_Timeout_Clause (Stmt); + if Expr /= Null_Node then + Val := Synth.Vhdl_Expr.Synth_Expression (Inst, Expr); + Timeout := Read_Discrete (Val); + if Timeout < 0 then + Error_Msg_Exec (Stmt, "negative timeout value"); + end if; + Grt.Processes.Ghdl_Process_Wait_Set_Timeout + (Std_Time (Timeout), null, 0); + end if; + + List := Get_Sensitivity_List (Stmt); + + Expr := Get_Condition_Clause (Stmt); + if Expr /= Null_Node and then List = Null_Iir_List then + List := Create_Iir_List; + Vhdl.Canon.Canon_Extract_Sensitivity_Expression (Expr, List); + Set_Sensitivity_List (Stmt, List); + Set_Is_Ref (Stmt, True); + end if; + + if List /= Null_Iir_List then + declare + It : List_Iterator; + El : Node; + Info : Target_Info; + Sig : Memory_Ptr; + begin + It := List_Iterate (List); + while Is_Valid (It) loop + El := Get_Element (It); + Info := Synth_Target (Inst, El); + Sig := Signals_Table.Table (Info.Obj.Val.S).Sig; + Add_Wait_Sensitivity + (Info.Targ_Type, Sig_Index (Sig, Info.Off.Net_Off)); + Next (It); + end loop; + end; + end if; + + -- LRM93 8.1 + -- It also causes the execution of the corresponding process + -- statement to be suspended. + Grt.Processes.Ghdl_Process_Wait_Suspend; + end Execute_Wait_Statement; + + function Resume_Wait_Statement (Inst : Synth_Instance_Acc; + Stmt : Node) return Boolean is + begin + -- LRM93 8.1 + -- The suspended process will resume, at the latest, immediately + -- after the timeout interval has expired. + if not Grt.Processes.Ghdl_Process_Wait_Timed_Out then + -- Compute the condition clause only if the timeout has not + -- expired. + + -- LRM93 8.1 + -- If such an event occurs, the condition in the condition clause + -- is evaluated. + -- + -- if no condition clause appears, the condition clause until true + -- is assumed. + if not Execute_Condition (Inst, Get_Condition_Clause (Stmt)) then + -- LRM93 8.1 + -- If the value of the condition is FALSE, the process will + -- re-suspend. + -- Such re-suspension does not involve the recalculation of + -- the timeout interval. + Grt.Processes.Ghdl_Process_Wait_Suspend; + return True; + end if; + end if; + + -- LRM93 8.1 + -- If the value of the condition is TRUE, the process will resume. + -- next statement. + Grt.Processes.Ghdl_Process_Wait_Close; + + return False; + end Resume_Wait_Statement; + + procedure Execute_Procedure_Call_Statement (Process : Process_State_Acc; + Stmt : Node; + Next_Stmt : out Node) + is + use Vhdl.Errors; + Inst : constant Synth_Instance_Acc := Process.Instance; + Call : constant Node := Get_Procedure_Call (Stmt); + Imp : constant Node := Get_Implementation (Call); + + Assoc_Chain : constant Node := Get_Parameter_Association_Chain (Call); + + Area_Mark : Areapools.Mark_Type; + Sub_Inst : Synth_Instance_Acc; + begin + Areapools.Mark (Area_Mark, Instance_Pool.all); + + if Get_Implicit_Definition (Imp) /= Iir_Predefined_None then + declare + Inter_Chain : constant Node := + Get_Interface_Declaration_Chain (Imp); + begin + Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Imp); + Synth_Subprogram_Association + (Sub_Inst, Inst, Inter_Chain, Assoc_Chain); + + Synth.Vhdl_Static_Proc.Synth_Static_Procedure + (Sub_Inst, Imp, Call); + Synth_Subprogram_Back_Association + (Sub_Inst, Inst, Inter_Chain, Assoc_Chain); + + Next_Stmt := Null_Node; + end; + else + declare + Bod : constant Node := + Vhdl.Sem_Inst.Get_Subprogram_Body_Origin (Imp); + Inter_Chain : constant Node := + Get_Interface_Declaration_Chain (Imp); + begin + if Get_Foreign_Flag (Imp) then + Synth.Errors.Error_Msg_Synth + (+Stmt, "call to foreign %n is not supported", +Imp); + Next_Stmt := Null_Node; + return; + end if; + + Sub_Inst := Synth_Subprogram_Call_Instance (Inst, Imp, Bod); + -- Note: in fact the uninstantiated scope is the instantiated + -- one! + Set_Uninstantiated_Scope (Sub_Inst, Imp); + Synth_Subprogram_Association + (Sub_Inst, Inst, Inter_Chain, Assoc_Chain); + + Process.Instance := Sub_Inst; + Elab.Vhdl_Decls.Elab_Declarations + (Sub_Inst, Get_Declaration_Chain (Bod), True); + + if Get_Suspend_Flag (Bod) then + Next_Stmt := Get_Sequential_Statement_Chain (Bod); + return; + -- TODO: end of call. + else + Execute_Sequential_Statements (Process); + Synth_Subprogram_Back_Association + (Sub_Inst, Inst, Inter_Chain, Assoc_Chain); + Next_Stmt := Null_Node; + end if; + end; + end if; + + if Elab.Debugger.Flag_Need_Debug then + Elab.Debugger.Debug_Leave (Sub_Inst); + end if; + + Free_Elab_Instance (Sub_Inst); + Areapools.Release (Area_Mark, Instance_Pool.all); + end Execute_Procedure_Call_Statement; + + procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc; + Target : Target_Info; + Val : Valtyp; + Loc : Node); + + procedure Execute_Aggregate_Signal_Assignment is + new Assign_Aggregate (Execute_Signal_Assignment); + + procedure Execute_Signal_Assignment (Inst : Synth_Instance_Acc; + Target : Target_Info; + Val : Valtyp; + Loc : Node) + is + use Synth.Vhdl_Expr; + V : Valtyp; + Sig : Memtyp; + begin + V := Synth_Subtype_Conversion (Inst, Val, Target.Targ_Type, False, Loc); + pragma Unreferenced (Val); + + case Target.Kind is + when Target_Aggregate => + Execute_Aggregate_Signal_Assignment + (Inst, Target.Aggr, Target.Targ_Type, V, Loc); + + when Target_Simple => + declare + E : Signal_Entry renames Signals_Table.Table (Target.Obj.Val.S); + begin + Sig := (Target.Targ_Type, + Sig_Index (E.Sig, Target.Off.Net_Off)); + end; + + Start_Assign_Value_To_Signal (Sig, 0, 0, Get_Value_Memtyp (V)); + + when Target_Memory => + raise Internal_Error; + end case; + end Execute_Signal_Assignment; + + procedure Execute_Waveform_Assignment (Inst : Synth_Instance_Acc; + Target : Target_Info; + Waveform : Node) + is + use Synth.Vhdl_Expr; + Wf : Node; + Val : Valtyp; + begin + Wf := Waveform; + Val := Synth_Expression_With_Type + (Inst, Get_We_Value (Wf), Target.Targ_Type); + Execute_Signal_Assignment (Inst, Target, Val, Wf); + Wf := Get_Chain (Wf); + + if Wf /= Null_Node then + raise Internal_Error; + end if; + end Execute_Waveform_Assignment; + + procedure Execute_Simple_Signal_Assignment (Inst : Synth_Instance_Acc; + Stmt : Node) + is + use Synth.Vhdl_Expr; + Target : constant Node := Get_Target (Stmt); + Info : Target_Info; + begin + Info := Synth_Target (Inst, Target); + + Execute_Waveform_Assignment (Inst, Info, Get_Waveform_Chain (Stmt)); + end Execute_Simple_Signal_Assignment; + + procedure Execute_Conditional_Signal_Assignment (Inst : Synth_Instance_Acc; + Stmt : Node) + is + use Synth.Vhdl_Expr; + Target : constant Node := Get_Target (Stmt); + Cw : Node; + Cond : Node; + Info : Target_Info; + begin + Info := Synth_Target (Inst, Target); + + Cw := Get_Conditional_Waveform_Chain (Stmt); + while Cw /= Null_Node loop + Cond := Get_Condition (Cw); + if Cond = Null_Node + or else Execute_Condition (Inst, Cond) + then + Execute_Waveform_Assignment + (Inst, Info, Get_Waveform_Chain (Cw)); + exit; + end if; + Cw := Get_Chain (Cw); + end loop; + end Execute_Conditional_Signal_Assignment; + + procedure Execute_Selected_Signal_Assignment (Inst : Synth_Instance_Acc; + Stmt : Node) + is + use Synth.Vhdl_Expr; + Target : constant Node := Get_Target (Stmt); + Sel : Memtyp; + Sw : Node; + Wf : Node; + Info : Target_Info; + Eq : Boolean; + begin + Info := Synth_Target (Inst, Target); + + Sel := Get_Memtyp (Synth_Expression (Inst, Get_Expression (Stmt))); + + Sw := Get_Selected_Waveform_Chain (Stmt); + while Sw /= Null_Node loop + if not Get_Same_Alternative_Flag (Sw) then + Wf := Get_Associated_Chain (Sw); + else + pragma Assert (Get_Associated_Chain (Sw) = Null_Node); + null; + end if; + case Iir_Kinds_Choice (Get_Kind (Sw)) is + when Iir_Kind_Choice_By_Expression => + declare + Ch : Valtyp; + begin + Ch := Synth_Expression (Inst, Get_Choice_Expression (Sw)); + Eq := Is_Equal (Sel, Get_Memtyp (Ch)); + end; + when Iir_Kind_Choice_By_Others => + Eq := True; + when others => + raise Internal_Error; + end case; + if Eq then + Execute_Waveform_Assignment (Inst, Info, Wf); + exit; + end if; + Sw := Get_Chain (Sw); + end loop; + end Execute_Selected_Signal_Assignment; + + procedure Execute_Sequential_Statements (Process : Process_State_Acc) + is + Inst : Synth_Instance_Acc; + Src : Node; + Stmt : Node; + Resume : Boolean; + begin + Inst := Process.Instance; + Src := Get_Source_Scope (Inst); + if Get_Kind (Src) = Iir_Kind_Sensitized_Process_Statement + or else (Get_Kind (Src) = Iir_Kind_Procedure_Body + and then not Get_Suspend_Flag (Src)) + then + Stmt := Get_Sequential_Statement_Chain (Src); + Resume := True; + else + Get_Suspend_State_Statement (Inst, Stmt, Resume); + end if; + + loop + Inst := Process.Instance; + if Elab.Debugger.Flag_Need_Debug then + Elab.Debugger.Debug_Break (Inst, Stmt); + end if; + + case Get_Kind (Stmt) is + when Iir_Kind_Null_Statement => + Next_Statement (Process, Stmt); + + when Iir_Kind_For_Loop_Statement => + declare + Val : Valtyp; + begin + Synth.Vhdl_Stmts.Init_For_Loop_Statement (Inst, Stmt, Val); + if Elab.Vhdl_Objtypes.In_Range (Val.Typ.Drange, + Read_Discrete (Val)) + then + Stmt := Get_Sequential_Statement_Chain (Stmt); + else + Synth.Vhdl_Stmts.Finish_For_Loop_Statement (Inst, Stmt); + Next_Statement (Process, Stmt); + end if; + end; + when Iir_Kind_While_Loop_Statement => + if Execute_Condition (Inst, Get_Condition (Stmt)) then + Stmt := Get_Sequential_Statement_Chain (Stmt); + else + Next_Statement (Process, Stmt); + end if; + when Iir_Kind_Exit_Statement => + if Execute_Condition (Inst, Get_Condition (Stmt)) then + declare + Label : constant Node := Get_Loop_Label (Stmt); + begin + loop + Stmt := Get_Parent (Stmt); + case Get_Kind (Stmt) is + when Iir_Kind_For_Loop_Statement => + -- Need to finalize for-loop statements. + Synth.Vhdl_Stmts.Finish_For_Loop_Statement + (Inst, Stmt); + exit when Label = Null_Node + or else Label = Stmt; + when Iir_Kind_While_Loop_Statement => + exit when Label = Null_Node + or else Label = Stmt; + when others => + null; + end case; + end loop; + end; + end if; + Next_Statement (Process, Stmt); + when Iir_Kind_Next_Statement => + if Execute_Condition (Inst, Get_Condition (Stmt)) then + declare + Label : constant Node := Get_Loop_Label (Stmt); + begin + loop + Stmt := Get_Parent (Stmt); + case Get_Kind (Stmt) is + when Iir_Kind_For_Loop_Statement => + -- Need to finalize for-loop statements. + if Label = Null_Node or else Label = Stmt + then + Next_Parent_Statement (Process, Stmt, Stmt); + exit; + else + Synth.Vhdl_Stmts.Finish_For_Loop_Statement + (Inst, Stmt); + end if; + when Iir_Kind_While_Loop_Statement => + if Label = Null_Node or else Label = Stmt + then + Next_Parent_Statement (Process, Stmt, Stmt); + exit; + end if; + when others => + null; + end case; + end loop; + end; + else + Next_Statement (Process, Stmt); + end if; + when Iir_Kind_Return_Statement => + pragma Assert (Get_Expression (Stmt) = Null_Node); + loop + Stmt := Get_Parent (Stmt); + case Get_Kind (Stmt) is + when Iir_Kind_For_Loop_Statement => + -- Need to finalize for-loop statements. + Synth.Vhdl_Stmts.Finish_For_Loop_Statement + (Inst, Stmt); + when Iir_Kind_Procedure_Body => + exit; + when others => + null; + end case; + end loop; + Finish_Procedure_Call (Process, Stmt, Stmt); + -- For a non-suspend procedure, return now to the caller. + exit when Stmt = Null_Node; + Next_Statement (Process, Stmt); + + when Iir_Kind_If_Statement => + declare + Els : Node; + begin + Els := Stmt; + loop + if Execute_Condition (Inst, Get_Condition (Els)) then + Stmt := Get_Sequential_Statement_Chain (Els); + exit; + end if; + + Els := Get_Else_Clause (Els); + if Els = Null_Node then + Next_Statement (Process, Stmt); + exit; + end if; + end loop; + end; + when Iir_Kind_Case_Statement => + declare + use Synth.Vhdl_Expr; + Expr : constant Node := Get_Expression (Stmt); + Sel : Valtyp; + begin + Sel := Synth_Expression_With_Basetype (Inst, Expr); + Stmt := Synth.Vhdl_Stmts.Execute_Static_Case_Statement + (Inst, Stmt, Sel); + end; + + when Iir_Kind_Assertion_Statement => + Synth.Vhdl_Stmts.Execute_Assertion_Statement (Inst, Stmt); + Next_Statement (Process, Stmt); + when Iir_Kind_Report_Statement => + Synth.Vhdl_Stmts.Execute_Report_Statement (Inst, Stmt); + Next_Statement (Process, Stmt); + + when Iir_Kind_Variable_Assignment_Statement => + Synth.Vhdl_Stmts.Synth_Variable_Assignment (Inst, Stmt); + Next_Statement (Process, Stmt); + when Iir_Kind_Conditional_Variable_Assignment_Statement => + Synth.Vhdl_Stmts.Synth_Conditional_Variable_Assignment + (Inst, Stmt); + Next_Statement (Process, Stmt); + + when Iir_Kind_Simple_Signal_Assignment_Statement => + Execute_Simple_Signal_Assignment (Inst, Stmt); + Next_Statement (Process, Stmt); + when Iir_Kind_Conditional_Signal_Assignment_Statement => + Execute_Conditional_Signal_Assignment (Inst, Stmt); + Next_Statement (Process, Stmt); + + when Iir_Kind_Wait_Statement => + -- The suspend state is executed instead. + raise Internal_Error; + + when Iir_Kind_Procedure_Call_Statement => + -- Call of a procedure without suspend state. + declare + Next_Stmt : Node; + begin + Execute_Procedure_Call_Statement (Process, Stmt, Next_Stmt); + pragma Assert (Next_Stmt = Null_Node); + Next_Statement (Process, Stmt); + end; + + when Iir_Kind_Suspend_State_Statement => + declare + Stmt2 : constant Node := Get_Chain (Stmt); + Next_Stmt : Node; + State : Int32; + State_Mem : Memory_Ptr; + begin + case Get_Kind (Stmt2) is + when Iir_Kind_Wait_Statement => + if Resume then + Resume := Resume_Wait_Statement + (Process.Instance, Stmt2); + else + Execute_Wait_Statement (Process.Instance, Stmt2); + Resume := True; + end if; + if Resume then + -- Will resume, so first stop! + State_Mem := Get_Suspend_State_Var (Inst); + State := Get_Suspend_State_Index (Stmt); + Write_I32 (State_Mem, Ghdl_I32 (State)); + exit; + else + -- Continue execution + Stmt := Stmt2; + Next_Statement (Process, Stmt); + end if; + when Iir_Kind_Procedure_Call_Statement => + if Resume then + raise Internal_Error; + end if; + Execute_Procedure_Call_Statement + (Process, Stmt2, Next_Stmt); + if Next_Stmt /= Null_Node then + -- User procedure. + -- Save current state. + State_Mem := Get_Suspend_State_Var (Inst); + State := Get_Suspend_State_Index (Stmt); + Write_I32 (State_Mem, Ghdl_I32 (State)); + + -- Start to execute the user procedure. + Inst := Process.Instance; + Stmt := Next_Stmt; + else + -- Implicit procedure, was already executed. + -- Continue execution + Stmt := Stmt2; + Next_Statement (Process, Stmt); + end if; + when others => + raise Internal_Error; + end case; + end; + + when others => + Vhdl.Errors.Error_Kind ("execute_sequential_statements", Stmt); + end case; + + exit when Stmt = Null_Node; + end loop; + end Execute_Sequential_Statements; + + procedure Execute_Expression_Association (Proc_Idx : Process_Index_Type) + is + use Synth.Vhdl_Expr; + 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 + Val := Synth_Expression_With_Type + (Proc.Inst, Get_Actual (Proc.Proc), Drv.Typ); + Start_Assign_Value_To_Signal + ((Drv.Typ, Sig.Sig), 0, 0, Get_Value_Memtyp (Val)); + end Execute_Expression_Association; + + procedure Process_Executer (Self : Grt.Processes.Instance_Acc) + is + use Simple_IO; + + function To_Process_State_Acc is new Ada.Unchecked_Conversion + (Grt.Processes.Instance_Acc, Process_State_Acc); + + Process : Process_State_Acc renames + To_Process_State_Acc (Self); + begin + -- For debugger + Current_Process := Process; + +-- Instance_Pool := Process.Pool'Access; + + if Synth.Flags.Flag_Trace_Statements then + Put (" run process: "); +-- Disp_Instance_Name (Process.Top_Instance); + 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); + when Iir_Kind_Process_Statement => + Execute_Sequential_Statements (Process); + when Iir_Kind_Concurrent_Assertion_Statement => + if Elab.Debugger.Flag_Need_Debug then + Elab.Debugger.Debug_Break (Process.Instance, Process.Proc); + end if; + Synth.Vhdl_Stmts.Execute_Assertion_Statement + (Process.Instance, Process.Proc); + 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); + 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); + 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); + 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); + when others => + raise Internal_Error; + end case; + +-- Instance_Pool := null; + Current_Process := null; + end Process_Executer; + + procedure Add_Sensitivity (Typ : Type_Acc; Sig : Memory_Ptr) is + begin + case Typ.Kind is + when Type_Logic + | Type_Bit + | Type_Discrete => + Grt.Processes.Ghdl_Process_Add_Sensitivity (Read_Sig (Sig)); + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + begin + for I in 1 .. Len loop + Add_Sensitivity + (Typ.Arr_El, Sig_Index (Sig, (Len - I) * Typ.Arr_El.W)); + end loop; + end; + when Type_Record => + for I in Typ.Rec.E'Range loop + Add_Sensitivity (Typ.Rec.E (I).Typ, + Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off)); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Sensitivity; + + procedure Register_Sensitivity (Proc_Idx : Process_Index_Type) + is + Sens : Sensitivity_Index_Type; + begin + Sens := Processes_Table.Table (Proc_Idx).Sensitivity; + while Sens /= No_Sensitivity_Index loop + declare + S : Sensitivity_Entry renames Sensitivity_Table.Table (Sens); + Base : constant Memory_Ptr := Signals_Table.Table (S.Sig).Sig; + begin + Add_Sensitivity (S.Typ, Sig_Index (Base, S.Off.Net_Off)); + Sens := S.Prev_Proc; + end; + end loop; + end Register_Sensitivity; + + function To_Address is new Ada.Unchecked_Conversion + (Process_State_Acc, System.Address); + + procedure Create_Process_Sensitized (Proc : Process_State_Acc) + is + use Grt.Processes; + Instance_Grt : Grt.Processes.Instance_Acc; + begin + Instance_Grt := To_Instance_Acc (Proc.all'Address); + if Get_Postponed_Flag (Proc.Proc) then + 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)); + end if; + end Create_Process_Sensitized; + + procedure Create_Processes + is + use Grt.Processes; + Proc : Node; + Instance : Synth_Instance_Acc; + Instance_Grt : Grt.Processes.Instance_Acc; + Instance_Addr : System.Address; + begin + Processes_State := new Process_State_Array (1 .. Processes_Table.Last); + + for I in Processes_Table.First .. Processes_Table.Last loop + Instance := Processes_Table.Table (I).Inst; + Proc := Processes_Table.Table (I).Proc; + +-- Instance_Pool := Processes_State (I).Pool'Access; +-- Instance.Stmt := Get_Sequential_Statement_Chain (Proc); + + Processes_State (I).Top_Instance := Instance; + Processes_State (I).Proc := Proc; + Processes_State (I).Idx := I; + Processes_State (I).Instance := Instance; + + Current_Process := Processes_State (I)'Access; + Instance_Addr := Processes_State (I)'Address; + Instance_Grt := To_Instance_Acc (Instance_Addr); + case Get_Kind (Proc) is + when Iir_Kind_Concurrent_Assertion_Statement => + Create_Process_Sensitized (Current_Process); + Register_Sensitivity (I); + + when Iir_Kind_Sensitized_Process_Statement + | Iir_Kind_Concurrent_Simple_Signal_Assignment + | Iir_Kind_Concurrent_Conditional_Signal_Assignment + | Iir_Kind_Concurrent_Selected_Signal_Assignment => + declare + Driver_List: Iir_List; + begin + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); + Create_Process_Sensitized (Current_Process); + Register_Sensitivity (I); + Create_Process_Drivers (Instance, Proc, Driver_List); + Trans_Analyzes.Free_Drivers_List (Driver_List); + end; + + when Iir_Kind_Association_Element_By_Expression => + Ghdl_Sensitized_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, Instance_Addr); + Register_Sensitivity (I); + Create_Process_Drivers (I); + + when Iir_Kind_Process_Statement => + declare + Driver_List: Iir_List; + begin + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); + + if Get_Postponed_Flag (Proc) then + Ghdl_Postponed_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, Instance_Addr); + else + Ghdl_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, Instance_Addr); + end if; + Create_Process_Drivers (Instance, Proc, Driver_List); + Trans_Analyzes.Free_Drivers_List (Driver_List); + end; + + when others => + 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; + end loop; + +-- if Trace_Simulation then +-- Disp_Signals_Value; +-- end if; + end Create_Processes; + + type Resolv_Instance_Type is record + Func : Iir; + Inst : Synth_Instance_Acc; + Sig : Memory_Ptr; + end record; + type Resolv_Instance_Acc is access Resolv_Instance_Type; + + -- The resolution procedure for GRT. + procedure Resolution_Proc (Instance_Addr : System.Address; + Val : System.Address; + Bool_Vec : System.Address; + Vec_Len : Ghdl_Index_Type; + Nbr_Drv : Ghdl_Index_Type; + Nbr_Ports : Ghdl_Index_Type); + pragma Convention (C, Resolution_Proc); + + procedure Resolution_Proc (Instance_Addr : System.Address; + Val : System.Address; + Bool_Vec : System.Address; + Vec_Len : Ghdl_Index_Type; + Nbr_Drv : Ghdl_Index_Type; + Nbr_Ports : Ghdl_Index_Type) is + begin + raise Internal_Error; + end Resolution_Proc; + + -- Create a new signal, using DEFAULT as initial value. + -- Set its number. + procedure Create_User_Signal (Inst : Synth_Instance_Acc; + Mode : Mode_Signal_Type; + Signal: Node; + Typ : Type_Acc; + Sig : Memory_Ptr; + Val : Memory_Ptr) + is +-- use Grt.Signals; + + procedure Create_Signal (Val : Memory_Ptr; + Sig : Memory_Ptr; + Sig_Type: Iir; + Typ : Type_Acc; + Already_Resolved : Boolean) + is + Sub_Resolved : Boolean := Already_Resolved; + Resolv_Func : Iir; + Resolv_Instance : Resolv_Instance_Acc; + S : Ghdl_Signal_Ptr; + begin + if not Already_Resolved + and then Get_Kind (Sig_Type) in Iir_Kinds_Subtype_Definition + then + Resolv_Func := Get_Resolution_Indication (Sig_Type); + else + Resolv_Func := Null_Iir; + end if; + if False and Resolv_Func /= Null_Iir then + Sub_Resolved := True; + Resolv_Instance := new Resolv_Instance_Type' + (Func => Get_Named_Entity (Resolv_Func), + Inst => Inst, + Sig => Sig); + Grt.Signals.Ghdl_Signal_Create_Resolution + (Resolution_Proc'Access, + Resolv_Instance.all'Address, + System.Null_Address, + Ghdl_Index_Type (Typ.W)); + end if; + case Typ.Kind is + when Type_Bit => + S := Grt.Signals.Ghdl_Create_Signal_B1 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + Write_Sig (Sig, S); + when Type_Logic => + S := Grt.Signals.Ghdl_Create_Signal_E8 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + Write_Sig (Sig, S); + when Type_Float => + S := Grt.Signals.Ghdl_Create_Signal_F64 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + Write_Sig (Sig, S); + when Type_Discrete => + if Typ.Sz = 1 then + S := Grt.Signals.Ghdl_Create_Signal_E8 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + elsif Typ.Sz = 4 then + S := Grt.Signals.Ghdl_Create_Signal_I32 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + elsif Typ.Sz = 8 then + S := Grt.Signals.Ghdl_Create_Signal_I64 + (To_Ghdl_Value_Ptr (To_Address (Val)), + null, System.Null_Address); + else + raise Internal_Error; + end if; + Write_Sig (Sig, S); + when Type_Vector + | Type_Array => + declare + Len : constant Uns32 := Typ.Abound.Len; + El_Type : Node; + begin + if Typ.Alast then + El_Type := Get_Element_Subtype (Sig_Type); + else + El_Type := Sig_Type; + end if; + for I in 1 .. Len loop + Create_Signal (Val + Size_Type (I - 1) * Typ.Arr_El.Sz, + Sig_Index (Sig, (Len - I) * Typ.Arr_El.W), + El_Type, Typ.Arr_El, Already_Resolved); + end loop; + end; + when Type_Record => + declare + List : constant Iir_Flist := Get_Elements_Declaration_List + (Sig_Type); + El : Iir_Element_Declaration; + begin + for I in Typ.Rec.E'Range loop + El := Get_Nth_Element (List, Natural (I - 1)); + Create_Signal + (Val + Typ.Rec.E (I).Offs.Mem_Off, + Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off), + Get_Type (El), Typ.Rec.E (I).Typ, + Sub_Resolved); + end loop; + end; + + when Type_Slice + | Type_Access + | Type_Unbounded_Vector + | Type_Unbounded_Array + | Type_Unbounded_Record + | Type_File + | Type_Protected => + raise Internal_Error; + end case; + end Create_Signal; + + Sig_Type: constant Iir := Get_Type (Signal); + Kind : Kind_Signal_Type; + + type Iir_Kind_To_Kind_Signal_Type is + array (Iir_Signal_Kind) of Kind_Signal_Type; + Iir_Kind_To_Kind_Signal : constant Iir_Kind_To_Kind_Signal_Type := + (Iir_Register_Kind => Kind_Signal_Register, + Iir_Bus_Kind => Kind_Signal_Bus); + begin + if Get_Guarded_Signal_Flag (Signal) then + Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal)); + else + Kind := Kind_Signal_No; + end if; + + Grt.Signals.Ghdl_Signal_Set_Mode (Mode, Kind, True); + + Create_Signal (Val, Sig, Sig_Type, Typ, False); + end Create_User_Signal; + + function Alloc_Signal_Memory (Vtype : Type_Acc) return Memory_Ptr + is + function To_Memory_Ptr is new Ada.Unchecked_Conversion + (System.Address, Memory_Ptr); + M : System.Address; + begin + Areapools.Allocate (Current_Pool.all, + M, Sig_Size * Size_Type (Vtype.W), Sig_Size); + return To_Memory_Ptr (M); + end Alloc_Signal_Memory; + + procedure Create_Signal (E : in out Signal_Entry) is + begin + E.Sig := Alloc_Signal_Memory (E.Typ); + case E.Kind is + when Mode_Guard => + -- Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl); + raise Internal_Error; + when Mode_Stable | Mode_Quiet | Mode_Transaction => + -- Create_Implicit_Signal + -- (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); + raise Internal_Error; + when Mode_Delayed => + -- Create_Delayed_Signal (E.Sig, E.Val, E.Prefix, E.Time); + raise Internal_Error; + when Mode_Above => + raise Internal_Error; + when Mode_Signal_User => + Create_User_Signal (E.Inst, E.Kind, E.Decl, E.Typ, E.Sig, E.Val); + when Mode_Conv_In | Mode_Conv_Out | Mode_End => + raise Internal_Error; + end case; + end Create_Signal; + + procedure Create_Signals is + begin + for I in Signals_Table.First .. Signals_Table.Last loop + declare + E : Signal_Entry renames Signals_Table.Table (I); + begin + pragma Assert (E.Sig = null); + if E.Collapsed_By /= No_Signal_Index then + E.Sig := Signals_Table.Table (E.Collapsed_By).Sig; + -- TODO: keep val ? + E.Val := Signals_Table.Table (E.Collapsed_By).Val; + else + Create_Signal (E); + end if; + end; + end loop; + end Create_Signals; + + -- Compute solver variables, allocate memory for quantities. + procedure Create_Quantities + is + use Grt.Analog_Solver; + Num : Natural; + Vec : F64_C_Arr_Ptr; + begin + -- Compute number of scalar quantities. + Num := 0; + for I in Quantity_Table.First .. Quantity_Table.Last loop + declare + Q : Quantity_Entry renames Quantity_Table.Table (I); + Def : Node; + Pfx_Info : Target_Info; + begin + case Get_Kind (Q.Decl) is + when Iir_Kind_Free_Quantity_Declaration => + -- For a free or branch quantity: + -- * if it is the actual of a OUT formal, then use the + -- variable from the formal. + -- TODO: handle OUT associations. + pragma Assert (Q.Typ.Kind = Type_Float); -- TODO + Q.Idx := Scalar_Quantities_Table.Last + 1; + Scalar_Quantities_Table.Append + ((Idx => Num, + Deriv => No_Scalar_Quantity, + Integ => No_Scalar_Quantity)); + Num := Num + Natural (Q.Typ.W); + + Def := Get_Default_Value (Q.Decl); + if Def /= Null_Node then + -- TODO + raise Internal_Error; + end if; + Q.Val := Alloc_Memory (Q.Typ); + Write_Fp64 (Q.Val, 0.0); + + when Iir_Kind_Dot_Attribute => + Pfx_Info := Synth_Target (Q.Inst, Get_Prefix (Q.Decl)); + pragma Assert (Pfx_Info.Kind = Target_Simple); + pragma Assert (Pfx_Info.Off = (0, 0)); + pragma Assert (Pfx_Info.Targ_Type.Kind = Type_Float); + declare + Pfx : constant Scalar_Quantity_Index := + Quantity_Table.Table (Pfx_Info.Obj.Val.Q).Idx; + Pfx_Ent : Scalar_Quantity_Record renames + Scalar_Quantities_Table.Table (Pfx); + begin + if Pfx_Ent.Deriv /= No_Scalar_Quantity then + -- There is already a 'Dot, reuse it and done. + Q.Idx := Pfx_Ent.Deriv; + else + -- Create a 'Dot. + Pfx_Ent.Deriv := Scalar_Quantities_Table.Last + 1; + Q.Idx := Pfx_Ent.Deriv; + Scalar_Quantities_Table.Append + ((Idx => Num, + Deriv => No_Scalar_Quantity, + Integ => Pfx)); + Num := Num + 1; + + Augmentations_Set.Append + ((Kind => Aug_Dot, Q => Q.Idx)); + end if; + + Q.Val := Alloc_Memory (Q.Typ); + Write_Fp64 (Q.Val, 0.0); + end; + + when others => + Vhdl.Errors.Error_Kind ("create_quantities", Q.Decl); + end case; + end; + end loop; + + -- TODO: also for the reference quantity of terminals. + + Nbr_Solver_Variables := Num; + + if Num = 0 then + -- No AMS + return; + end if; + + -- AMS simulation. + Grt.Processes.Flag_AMS := True; + + -- + -- For 'Dot: + -- * if the prefix is a quantity, use its corresponding prime. + -- * if the prefix is 'Dot, create an intermediate variable. + + -- Initialize solver. + Grt.Analog_Solver.Init (Ghdl_I32 (Num)); + + -- LRM 1076.1-2007 12.6.4 Simulation cycle + -- The value of each implicit quantity of the form ... Q'Dot ... is + -- set to 0.0 + Vec := Grt.Analog_Solver.Get_Init_Der_Ptr; + for I in 0 .. Num - 1 loop + Vec (I) := 0.0; + end loop; + + -- Set initial values. + Vec := Grt.Analog_Solver.Get_Init_Val_Ptr; + for I in Quantity_Table.First .. Quantity_Table.Last loop + declare + Q : Quantity_Entry renames Quantity_Table.Table (I); + begin + pragma Assert (Q.Typ.Kind = Type_Float); -- TODO + Vec (Scalar_Quantities_Table.Table (Q.Idx).Idx) := + Ghdl_F64 (Read_Fp64 (Q.Val)); + end; + end loop; + end Create_Quantities; + + function Exec_Bit_Edge (Param : Valtyp; Res_Typ : Type_Acc; Val : Ghdl_U8) + return Memtyp + is + Sig : Ghdl_Signal_Ptr; + Res : Boolean; + begin + Sig := Read_Sig (Sig_Index (Exec_Sig_Sig (Param.Val.A_Obj), + Param.Val.A_Off.Net_Off)); + Res := Sig.Event and then Sig.Value_Ptr.E8 = Val; + return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + end Exec_Bit_Edge; + + function Exec_Bit_Rising_Edge (Param : Valtyp; Res_Typ : Type_Acc) + return Memtyp is + begin + return Exec_Bit_Edge (Param, Res_Typ, 1); + end Exec_Bit_Rising_Edge; + + function Exec_Bit_Falling_Edge (Param : Valtyp; Res_Typ : Type_Acc) + return Memtyp is + begin + return Exec_Bit_Edge (Param, Res_Typ, 0); + end Exec_Bit_Falling_Edge; + + function Exec_Std_Edge (Param : Valtyp; + Res_Typ : Type_Acc; + Prev : Std_Ulogic; + Curr : Std_Ulogic) return Memtyp + is + Sig : Ghdl_Signal_Ptr; + Res : Boolean; + begin + Sig := Read_Sig (Sig_Index (Exec_Sig_Sig (Param.Val.A_Obj), + Param.Val.A_Off.Net_Off)); + Res := Sig.Event + and then To_X01 (Std_Ulogic'Val (Sig.Value_Ptr.E8)) = Curr + and then To_X01 (Std_Ulogic'Val (Sig.Last_Value.E8)) = Prev; + return Create_Memory_U8 (Boolean'Pos (Res), Res_Typ); + end Exec_Std_Edge; + + function Exec_Std_Rising_Edge (Param : Valtyp; Res_Typ : Type_Acc) + return Memtyp is + begin + return Exec_Std_Edge (Param, Res_Typ, '0', '1'); + end Exec_Std_Rising_Edge; + + function Exec_Std_Falling_Edge (Param : Valtyp; Res_Typ : Type_Acc) + return Memtyp is + begin + return Exec_Std_Edge (Param, Res_Typ, '1', '0'); + end Exec_Std_Falling_Edge; + + procedure Exec_Finish (Inst : Synth_Instance_Acc; Imp : Node) + is + use Grt.Lib; + Inter : constant Node := Get_Interface_Declaration_Chain (Imp); + Param : Valtyp; + Status : Int64; + begin + if Inter /= Null_Node then + Param := Get_Value (Inst, Inter); + Status := Read_Discrete (Param); + Ghdl_Control_Simulation (False, True, Std_Integer (Status)); + else + Ghdl_Control_Simulation (False, False, 0); + end if; + end Exec_Finish; + + procedure Set_Quantities_Values (Y : F64_C_Arr_Ptr; Yp: F64_C_Arr_Ptr) + is + pragma Unreferenced (Yp); + begin + for I in Quantity_Table.First .. Quantity_Table.Last loop + declare + Q : Quantity_Entry renames Quantity_Table.Table (I); + Idx : Natural; + begin + pragma Assert (Q.Typ.Kind = Type_Float); + Idx := Scalar_Quantities_Table.Table (Q.Idx).Idx; + Write_Fp64 (Q.Val, Fp64 (Y (Idx))); + end; + end loop; + end Set_Quantities_Values; + + procedure Residues (T : Ghdl_F64; + Y : F64_C_Arr_Ptr; + Yp : F64_C_Arr_Ptr; + Res : F64_C_Arr_Ptr) + is + Num : Natural; + L, R : Valtyp; + Prev_Time : Ghdl_F64; + begin + Set_Quantities_Values (Y, Yp); + + -- Apply time. + -- TODO: physical time too. + Prev_Time := Current_Time_AMS; + Current_Time_AMS := T; + + Num := 0; + for I in Simultaneous_Table.First .. Simultaneous_Table.Last loop + declare + S : Simultaneous_Record renames Simultaneous_Table.Table (I); + begin + case Get_Kind (S.Stmt) is + when Iir_Kind_Simple_Simultaneous_Statement => + L := Synth.Vhdl_Expr.Synth_Expression + (S.Inst, Get_Simultaneous_Left (S.Stmt)); + R := Synth.Vhdl_Expr.Synth_Expression + (S.Inst, Get_Simultaneous_Right (S.Stmt)); + pragma Assert (R.Typ.Kind = Type_Float); + pragma Assert (L.Typ.Kind = Type_Float); + Res (Num) := Ghdl_F64 + (Read_Fp64 (L.Val.Mem) - Read_Fp64 (R.Val.Mem)); + Num := Num + 1; + when others => + Vhdl.Errors.Error_Kind ("residues", S.Stmt); + end case; + end; + end loop; + + for I in Augmentations_Set.First .. Augmentations_Set.Last loop + declare + A : Augmentation_Entry renames Augmentations_Set.Table (I); + begin + case A.Kind is + when Aug_Dot => + declare + Q : Scalar_Quantity_Record renames + Scalar_Quantities_Table.Table (A.Q); + pragma Assert (Q.Integ /= No_Scalar_Quantity); + Qi : Scalar_Quantity_Record renames + Scalar_Quantities_Table.Table (Q.Integ); + begin + Res (Num) := Y (Q.Idx) - Yp (Qi.Idx); + Num := Num + 1; + end; + when others => + raise Internal_Error; + end case; + end; + end loop; + + pragma Assert (Nbr_Solver_Variables = Num); + + if Trace_Residues then + declare + use Simple_IO; + use Utils_IO; + begin + Put ("Residues at "); + Put_Fp64 (Fp64 (Current_Time_AMS)); + New_Line; + for I in 0 .. Num -1 loop + Put ("Y"); + Put_Uns32 (Uns32 (I)); + Put ("="); + Put_Fp64 (Fp64 (Y (I))); + Put (", Yp("); + Put_Uns32 (Uns32 (I)); + Put (")="); + Put_Fp64 (Fp64 (Yp (I))); + Put (", R("); + Put_Uns32 (Uns32 (I)); + Put (")="); + Put_Fp64 (Fp64 (Res (I))); + New_Line; + end loop; + end; + end if; + + Current_Time_AMS := Prev_Time; + end Residues; + + procedure Runtime_Elaborate is + begin +-- if Disp_Stats then +-- Disp_Design_Stats; +-- end if; + + -- There is no inputs. + -- All the simulation is done via time, so it must be displayed. + Disp_Time_Before_Values := True; + + Create_Signals; + -- Create_Connects; + -- Create_Disconnections; + Create_Processes; + -- Create_PSL; + Create_Quantities; + + -- Allow Synth_Expression to handle signals. + Synth.Vhdl_Expr.Hook_Signal_Expr := Hook_Signal_Expr'Access; + Synth.Vhdl_Expr.Hook_Event_Attribute := Exec_Event_Attribute'Access; + + Synth.Vhdl_Oper.Hook_Bit_Rising_Edge := Exec_Bit_Rising_Edge'Access; + Synth.Vhdl_Oper.Hook_Bit_Falling_Edge := Exec_Bit_Falling_Edge'Access; + + Synth.Vhdl_Oper.Hook_Std_Rising_Edge := Exec_Std_Rising_Edge'Access; + Synth.Vhdl_Oper.Hook_Std_Falling_Edge := Exec_Std_Falling_Edge'Access; + + Synth.Vhdl_Expr.Hook_Quantity_Expr := Hook_Quantity_Expr'Access; + Synth.Vhdl_Expr.Hook_Dot_Attribute := Exec_Dot_Attribute'Access; + + Synth.Vhdl_Static_Proc.Hook_Finish := Exec_Finish'Access; + + -- if Flag_Interractive then + -- Debug (Reason_Elab); + -- end if; + end Runtime_Elaborate; + + procedure Ghdl_Elaborate; + pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE"); + + procedure Ghdl_Elaborate is + begin + Runtime_Elaborate; + end Ghdl_Elaborate; + + Ghdl_Progname : constant String := "ghdl" & ASCII.Nul; + + procedure Simulation + is + Ok : C_Boolean; + Status : Integer; + begin + Break_Time := Std_Time'Last; + + Grt.Options.Progname := To_Ghdl_C_String (Ghdl_Progname'Address); + Grt.Errors.Set_Error_Stream (Grt.Stdio.stdout); + +-- Grt.Errors.Error_Hook := Debug_Error'Access; + +-- if Flag_Interractive then +-- Debug (Reason_Start); +-- end if; + + Ok := Grt.Main.Run_Elab; + if not Ok then + return; + end if; + + Synth.Flags.Severity_Level := Grt.Options.Severity_Level; + + if Flag_Interractive then + Elab.Debugger.Debug_Elab (Vhdl_Elab.Top_Instance); + end if; + + Status := Grt.Main.Run_Through_Longjump + (Grt.Processes.Simulation_Init'Access); + + if Status = 0 then + if Grt.Processes.Flag_AMS then + Grt.Analog_Solver.Start; + end if; + + loop + if Break_Time < Grt.Processes.Next_Time then + Grt.Processes.Next_Time := Break_Time; + end if; + + Status := Grt.Main.Run_Through_Longjump + (Grt.Processes.Simulation_Cycle'Access); + exit when Status < 0 + or Status = Grt.Errors.Run_Stop + or Status = Grt.Errors.Run_Finished; + + if Current_Time >= Break_Time + and then Break_Time /= Std_Time'Last + then + -- No not break anymore on time, + Break_Time := Std_Time'Last; + Elab.Debugger.Debug_Time; + end if; + + exit when Grt.Processes.Has_Simulation_Timeout; + end loop; + end if; + + Grt.Processes.Simulation_Finish; + + Grt.Main.Run_Finish (Status); + exception +-- when Debugger_Quit => +-- null; + when Simulation_Finished => + null; + end Simulation; +end Simul.Vhdl_Simul; diff --git a/src/simul/simul-vhdl_simul.ads b/src/simul/simul-vhdl_simul.ads new file mode 100644 index 000000000..05d4af757 --- /dev/null +++ b/src/simul/simul-vhdl_simul.ads @@ -0,0 +1,120 @@ +-- Simulation of VHDL +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +with Types; use Types; +with Tables; +with Areapools; use Areapools; + +with Vhdl.Nodes; use Vhdl.Nodes; + +with Grt.Vhdl_Types; use Grt.Vhdl_Types; + +with Elab.Memtype; use Elab.Memtype; +with Elab.Vhdl_Context; use Elab.Vhdl_Context; + +with Simul.Vhdl_Elab; use Simul.Vhdl_Elab; + +with Grt.Signals; + +package Simul.Vhdl_Simul is + Break_Time : Std_Time; + + Trace_Simulation : Boolean := False; + + Flag_Interractive : Boolean := False; + + Trace_Residues : Boolean := False; + + -- State associed with each process. + type Process_State_Type is record + -- The process instance. + Top_Instance : Synth_Instance_Acc := null; + Proc : Node := Null_Node; + + Idx : Process_Index_Type; + + -- Memory pool to allocate objects from. + Pool : aliased Areapool; + + -- The stack of the process. + Instance : Synth_Instance_Acc := null; + end record; + type Process_State_Acc is access all Process_State_Type; + + type Process_State_Array is + array (Process_Index_Type range <>) of aliased Process_State_Type; + type Process_State_Array_Acc is access Process_State_Array; + + -- Array containing all processes. + Processes_State: Process_State_Array_Acc; + + Current_Process: Process_State_Acc; + + -- If true, disp current time in assert message. + Disp_Time_Before_Values: Boolean := False; + + Simulation_Finished : exception; + + procedure Simulation; + + -- Low level functions, for debugger. + function Sig_Index (Base : Memory_Ptr; Idx : Uns32) return Memory_Ptr; + function Read_Sig (Mem : Memory_Ptr) return Grt.Signals.Ghdl_Signal_Ptr; + + + -- Tables visible to the debugger. + + type Scalar_Quantity_Record is record + -- Index in Y or Yp vector. + Idx : Natural; + -- If there is a 'Dot, the corresponding entry. + Deriv : Scalar_Quantity_Index; + -- If there is a 'Integ, the corresponding entry. + Integ : Scalar_Quantity_Index; + end record; + + package Scalar_Quantities_Table is new Tables + (Table_Component_Type => Scalar_Quantity_Record, + Table_Index_Type => Scalar_Quantity_Index, + Table_Low_Bound => No_Scalar_Quantity + 1, + Table_Initial => 128); + + type Augmentation_Kind is + ( + Aug_Noise, + Aug_Spectrum, + Aug_Dot, + Aug_Integ, + Aug_Delayed + ); + + pragma Unreferenced (Aug_Spectrum, Aug_Integ, Aug_Delayed); + + type Augmentation_Entry (Kind : Augmentation_Kind := Aug_Noise) is record + Q : Scalar_Quantity_Index; + end record; + + package Augmentations_Set is new Tables + (Table_Component_Type => Augmentation_Entry, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 64); + + Nbr_Solver_Variables : Natural := 0; + +end Simul.Vhdl_Simul; diff --git a/src/simul/simul.ads b/src/simul/simul.ads new file mode 100644 index 000000000..797876405 --- /dev/null +++ b/src/simul/simul.ads @@ -0,0 +1,20 @@ +-- Simulation +-- Copyright (C) 2022 Tristan Gingold +-- +-- This file is part of GHDL. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 2 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see <gnu.org/licenses>. + +package Simul is +end Simul; |