diff options
author | Tristan Gingold <tgingold@free.fr> | 2017-11-24 06:21:01 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2017-11-24 06:21:01 +0100 |
commit | 49294a83ee67eef83180721c578f69855bf96cad (patch) | |
tree | 89d3eab1be8bcc27a64340a6d69ad71a2b51adea /src/vhdl/simulate/simul-simulation-main.adb | |
parent | 947d5b8876198dda1cf8e0c65a554e5dbd5e80f2 (diff) | |
download | ghdl-49294a83ee67eef83180721c578f69855bf96cad.tar.gz ghdl-49294a83ee67eef83180721c578f69855bf96cad.tar.bz2 ghdl-49294a83ee67eef83180721c578f69855bf96cad.zip |
Create the simul.ads package (for a namespace).
Diffstat (limited to 'src/vhdl/simulate/simul-simulation-main.adb')
-rw-r--r-- | src/vhdl/simulate/simul-simulation-main.adb | 1145 |
1 files changed, 1145 insertions, 0 deletions
diff --git a/src/vhdl/simulate/simul-simulation-main.adb b/src/vhdl/simulate/simul-simulation-main.adb new file mode 100644 index 000000000..4614b2746 --- /dev/null +++ b/src/vhdl/simulate/simul-simulation-main.adb @@ -0,0 +1,1145 @@ +-- Interpreted simulation +-- Copyright (C) 2014-2017 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Ada.Unchecked_Conversion; +with Ada.Text_IO; use Ada.Text_IO; +with Types; use Types; +with Iirs_Utils; use Iirs_Utils; +with Errorout; use Errorout; +with PSL.Nodes; +with PSL.NFAs; +with Std_Package; +with Trans_Analyzes; +with Simul.Elaboration; use Simul.Elaboration; +with Simul.Execution; use Simul.Execution; +with Ieee.Std_Logic_1164; +with Grt.Main; +with Simul.Debugger; use Simul.Debugger; +with Simul.Debugger.AMS; +with Grt.Errors; +with Grt.Rtis; +with Grt.Processes; +with Grt.Signals; +with Areapools; use Areapools; + +package body Simul.Simulation.Main is + -- Configuration for the whole design + Top_Config : Iir_Design_Unit; + + -- Elaborate the design + procedure Ghdl_Elaborate; + pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE"); + + 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); + + procedure Process_Executer (Self : Grt.Processes.Instance_Acc) + is + 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 Trace_Simulation then + Put (" run process: "); + Disp_Instance_Name (Process.Top_Instance); + Put_Line (" (" & 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; + if Process.Instance.Stmt = Null_Iir then + Process.Instance.Stmt := + Get_Sequential_Statement_Chain (Process.Proc); + end if; + when Iir_Kind_Process_Statement => + if not Process.Instance.In_Wait_Flag then + raise Internal_Error; + end if; + when others => + raise Internal_Error; + end case; + + Instance_Pool := null; + Current_Process := null; + end Process_Executer; + + type Convert_Mode is (Convert_In, Convert_Out); + + type Convert_Instance_Type is record + Mode : Convert_Mode; + Instance : Block_Instance_Acc; + Func : Iir; + Src : Iir_Value_Literal_Acc; + Dst : Iir_Value_Literal_Acc; + end record; + + type Convert_Instance_Acc is access Convert_Instance_Type; + + procedure Conversion_Proc (Data : System.Address) is + Conv : Convert_Instance_Type; + pragma Import (Ada, Conv); + for Conv'Address use Data; + + Src : Iir_Value_Literal_Acc; + Dst : Iir_Value_Literal_Acc; + + Expr_Mark : Mark_Type; + begin + pragma Assert (Instance_Pool = null); + Instance_Pool := Global_Pool'Access; + Mark (Expr_Mark, Expr_Pool); + Current_Process := No_Process; + + case Conv.Mode is + when Convert_In => + Src := Execute_Read_Signal_Value + (Conv.Src, Read_Signal_Effective_Value); + when Convert_Out => + Src := Execute_Read_Signal_Value + (Conv.Src, Read_Signal_Driving_Value); + end case; + + Dst := Execute_Assoc_Conversion (Conv.Instance, Conv.Func, Src); + + Check_Bounds (Conv.Dst, Dst, Conv.Func); + + case Conv.Mode is + when Convert_In => + Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Effective_Value); + when Convert_Out => + Execute_Write_Signal (Conv.Dst, Dst, Write_Signal_Driving_Value); + end case; + + Release (Expr_Mark, Expr_Pool); + Instance_Pool := null; + end Conversion_Proc; + + -- Add a driver for signal designed by VAL (via index field) for instance + -- INSTANCE of process PROC. + -- FIXME: default value. + procedure Add_Source + (Instance: Block_Instance_Acc; Val: Iir_Value_Literal_Acc; Proc: Iir) + is + begin + case Val.Kind is + when Iir_Value_Signal => + if Proc = Null_Iir then + -- Can this happen ? + raise Internal_Error; + end if; + Grt.Signals.Ghdl_Process_Add_Driver (Val.Sig); + when Iir_Value_Array => + for I in Val.Val_Array.V'Range loop + Add_Source (Instance, Val.Val_Array.V (I), Proc); + end loop; + when Iir_Value_Record => + for I in Val.Val_Record.V'Range loop + Add_Source (Instance, Val.Val_Record.V (I), Proc); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Source; + + -- Add drivers for process PROC. + -- Note: this is done recursively on the callees of PROC. + procedure Elaborate_Drivers (Instance: Block_Instance_Acc; Proc: Iir) + is + Driver_List: Iir_List; + It : List_Iterator; + El: Iir; + Val: Iir_Value_Literal_Acc; + Marker : Mark_Type; + begin + if Trace_Drivers then + Ada.Text_IO.Put ("Drivers for "); + Disp_Instance_Name (Instance); + Ada.Text_IO.Put_Line (": " & Disp_Node (Proc)); + end if; + + Driver_List := Trans_Analyzes.Extract_Drivers (Proc); + + -- Some processes have no driver list (assertion). + It := List_Iterate_Safe (Driver_List); + while Is_Valid (It) loop + El := Get_Element (It); + if Trace_Drivers then + Put_Line (' ' & Disp_Node (El)); + end if; + + Mark (Marker, Expr_Pool); + Val := Execute_Name (Instance, El, True); + Add_Source (Instance, Val, Proc); + Release (Marker, Expr_Pool); + + Next (It); + end loop; + end Elaborate_Drivers; + + -- Call Ghdl_Process_Add_Sensitivity for each scalar subelement of + -- SIG. + procedure Process_Add_Sensitivity (Sig: Iir_Value_Literal_Acc) is + begin + case Sig.Kind is + when Iir_Value_Signal => + Grt.Processes.Ghdl_Process_Add_Sensitivity (Sig.Sig); + when Iir_Value_Array => + for I in Sig.Val_Array.V'Range loop + Process_Add_Sensitivity (Sig.Val_Array.V (I)); + end loop; + when Iir_Value_Record => + for I in Sig.Val_Record.V'Range loop + Process_Add_Sensitivity (Sig.Val_Record.V (I)); + end loop; + when others => + raise Internal_Error; + end case; + end Process_Add_Sensitivity; + + procedure Register_Sensitivity + (Instance : Block_Instance_Acc; List : Iir_List) + is + It : List_Iterator; + Sig : Iir; + Marker : Mark_Type; + begin + It := List_Iterate (List); + while Is_Valid (It) loop + Sig := Get_Element (It); + Mark (Marker, Expr_Pool); + Process_Add_Sensitivity (Execute_Name (Instance, Sig, True)); + Release (Marker, Expr_Pool); + Next (It); + end loop; + end Register_Sensitivity; + + procedure Create_Processes + is + use Grt.Processes; + El : Iir; + Instance : Block_Instance_Acc; + Instance_Grt : Grt.Processes.Instance_Acc; + 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); + El := Instance.Label; + + Instance_Pool := Processes_State (I).Pool'Access; + Instance.Stmt := Get_Sequential_Statement_Chain (El); + + Processes_State (I).Top_Instance := Instance; + Processes_State (I).Proc := El; + Processes_State (I).Instance := Instance; + + Current_Process := Processes_State (I)'Access; + Instance_Grt := To_Instance_Acc (Processes_State (I)'Address); + case Get_Kind (El) is + when Iir_Kind_Sensitized_Process_Statement => + if Get_Postponed_Flag (El) then + Ghdl_Postponed_Sensitized_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, System.Null_Address); + else + Ghdl_Sensitized_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, System.Null_Address); + end if; + + -- Register sensitivity. + Register_Sensitivity (Instance, Get_Sensitivity_List (El)); + + when Iir_Kind_Process_Statement => + if Get_Postponed_Flag (El) then + Ghdl_Postponed_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, System.Null_Address); + else + Ghdl_Process_Register + (Instance_Grt, + Process_Executer'Access, + null, System.Null_Address); + end if; + + when others => + raise Internal_Error; + 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 (El)); + + -- 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, El); + + 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; + + procedure PSL_Process_Executer (Self : Grt.Processes.Instance_Acc); + pragma Convention (C, PSL_Process_Executer); + + function Execute_Psl_Expr (Instance : Block_Instance_Acc; + Expr : PSL_Node; + Eos : Boolean) + return Boolean + is + use PSL.Nodes; + begin + case Get_Kind (Expr) is + when N_HDL_Expr => + declare + E : constant Iir := Get_HDL_Node (Expr); + Rtype : constant Iir := Get_Base_Type (Get_Type (E)); + Res : Iir_Value_Literal_Acc; + begin + Res := Execute_Expression (Instance, E); + if Rtype = Std_Package.Boolean_Type_Definition then + return Res.B1 = True; + elsif Rtype = Ieee.Std_Logic_1164.Std_Ulogic_Type then + return Res.E8 = 3 or Res.E8 = 7; -- 1 or H + else + Error_Kind ("execute_psl_expr", Expr); + end if; + end; + when N_True => + return True; + when N_EOS => + return Eos; + when N_Not_Bool => + return not Execute_Psl_Expr (Instance, Get_Boolean (Expr), Eos); + when N_And_Bool => + return Execute_Psl_Expr (Instance, Get_Left (Expr), Eos) + and Execute_Psl_Expr (Instance, Get_Right (Expr), Eos); + when N_Or_Bool => + return Execute_Psl_Expr (Instance, Get_Left (Expr), Eos) + or Execute_Psl_Expr (Instance, Get_Right (Expr), Eos); + when others => + Error_Kind ("execute_psl_expr", Expr); + end case; + end Execute_Psl_Expr; + + procedure PSL_Process_Executer (Self : Grt.Processes.Instance_Acc) + is + type PSL_Entry_Acc is access all PSL_Entry; + function To_PSL_Entry_Acc is new Ada.Unchecked_Conversion + (Grt.Processes.Instance_Acc, PSL_Entry_Acc); + + use PSL.NFAs; + + E : constant PSL_Entry_Acc := To_PSL_Entry_Acc (Self); + Nvec : Boolean_Vector (E.States.all'Range); + Marker : Mark_Type; + V : Boolean; + + NFA : PSL_NFA; + S : NFA_State; + S_Num : Nat32; + Ed : NFA_Edge; + Sd : NFA_State; + Sd_Num : Nat32; + begin + -- Exit now if already covered (never set for assertion). + if E.Done then + return; + end if; + + Instance_Pool := Global_Pool'Access; + Current_Process := No_Process; + + Mark (Marker, Expr_Pool); + V := Execute_Psl_Expr (E.Instance, Get_PSL_Clock (E.Stmt), False); + Release (Marker, Expr_Pool); + if V then + Nvec := (others => False); + if Get_Kind (E.Stmt) = Iir_Kind_Psl_Cover_Statement then + Nvec (0) := True; + end if; + + -- For each state: if set, evaluate all outgoing edges. + NFA := Get_PSL_NFA (E.Stmt); + S := Get_First_State (NFA); + while S /= No_State loop + S_Num := Get_State_Label (S); + + if E.States (S_Num) then + Ed := Get_First_Src_Edge (S); + while Ed /= No_Edge loop + Sd := Get_Edge_Dest (Ed); + Sd_Num := Get_State_Label (Sd); + + if not Nvec (Sd_Num) then + Mark (Marker, Expr_Pool); + V := Execute_Psl_Expr + (E.Instance, Get_Edge_Expr (Ed), False); + Release (Marker, Expr_Pool); + if V then + Nvec (Sd_Num) := True; + end if; + end if; + + Ed := Get_Next_Src_Edge (Ed); + end loop; + end if; + + S := Get_Next_State (S); + end loop; + + -- Check fail state. + S := Get_Final_State (NFA); + S_Num := Get_State_Label (S); + pragma Assert (S_Num = Get_PSL_Nbr_States (E.Stmt) - 1); + if Nvec (S_Num) then + case Get_Kind (E.Stmt) is + when Iir_Kind_Psl_Assert_Statement => + Execute_Failed_Assertion + (E.Instance, "psl assertion", E.Stmt, + "assertion violation", 2); + when Iir_Kind_Psl_Cover_Statement => + Execute_Failed_Assertion + (E.Instance, "psl cover", E.Stmt, + "sequence covered", 0); + E.Done := True; + when others => + Error_Kind ("PSL_Process_Executer", E.Stmt); + end case; + end if; + + E.States.all := Nvec; + end if; + + Instance_Pool := null; + Current_Process := null; + end PSL_Process_Executer; + + procedure Create_PSL is + begin + for I in PSL_Table.First .. PSL_Table.Last loop + declare + E : PSL_Entry renames PSL_Table.Table (I); + begin + -- Create the vector. + E.States := new Boolean_Vector' + (0 .. Get_PSL_Nbr_States (E.Stmt) - 1 => False); + E.States (0) := True; + + Grt.Processes.Ghdl_Process_Register + (To_Instance_Acc (E'Address), PSL_Process_Executer'Access, + null, System.Null_Address); + + Register_Sensitivity + (E.Instance, Get_PSL_Clock_Sensitivity (E.Stmt)); + end; + end loop; + + -- Finalizer ? + end Create_PSL; + + function Create_Shadow_Signal (Sig : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc + is + Val : Ghdl_Value_Ptr; + begin + case Sig.Kind is + when Iir_Value_Signal => + Val := new Value_Union; + case Sig.Sig.Mode is + when Mode_I64 => + Val.I64 := 0; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_I64 + (Val, null, System.Null_Address)); + when Mode_B1 => + Val.B1 := False; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_B1 + (Val, null, System.Null_Address)); + when Mode_E8 => + Val.E8 := 0; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_E8 + (Val, null, System.Null_Address)); + when Mode_E32 => + Val.E32 := 0; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_E32 + (Val, null, System.Null_Address)); + when Mode_F64 => + Val.F64 := 0.0; + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_F64 + (Val, null, System.Null_Address)); + when Mode_I32 => + raise Internal_Error; + end case; + when Iir_Value_Array => + declare + Res : Iir_Value_Literal_Acc; + begin + Res := Unshare_Bounds (Sig, Instance_Pool); + for I in Res.Val_Array.V'Range loop + Res.Val_Array.V (I) := + Create_Shadow_Signal (Sig.Val_Array.V (I)); + end loop; + return Res; + end; + when Iir_Value_Record => + declare + Res : Iir_Value_Literal_Acc; + begin + Res := Create_Record_Value + (Sig.Val_Record.Len, Instance_Pool); + for I in Res.Val_Record.V'Range loop + Res.Val_Record.V (I) := + Create_Shadow_Signal (Sig.Val_Record.V (I)); + end loop; + return Res; + end; + when Iir_Value_Scalars + | Iir_Value_Access + | Iir_Value_Range + | Iir_Value_Protected + | Iir_Value_Terminal + | Iir_Value_Quantity + | Iir_Value_File + | Iir_Value_Environment => + raise Internal_Error; + end case; + end Create_Shadow_Signal; + + function Get_Leftest_Signal (Val : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + case Val.Kind is + when Iir_Value_Signal => + return Val; + when Iir_Value_Array => + return Get_Leftest_Signal (Val.Val_Array.V (1)); + when Iir_Value_Record => + return Get_Leftest_Signal (Val.Val_Record.V (1)); + when others => + raise Internal_Error; + end case; + end Get_Leftest_Signal; + + procedure Add_Conversion (Conv : Convert_Instance_Acc) + is + Src_Left : Grt.Signals.Ghdl_Signal_Ptr; + Src_Len : Ghdl_Index_Type; + Dst_Left : Grt.Signals.Ghdl_Signal_Ptr; + Dst_Len : Ghdl_Index_Type; + begin + Conv.Src := Unshare_Bounds (Conv.Src, Instance_Pool); + Conv.Dst := Unshare_Bounds (Conv.Dst, Instance_Pool); + + Src_Left := Get_Leftest_Signal (Conv.Src).Sig; + Src_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Src)); + + Dst_Left := Get_Leftest_Signal (Conv.Dst).Sig; + Dst_Len := Ghdl_Index_Type (Get_Nbr_Of_Scalars (Conv.Dst)); + + case Conv.Mode is + when Convert_In => + Grt.Signals.Ghdl_Signal_In_Conversion (Conversion_Proc'Address, + Conv.all'Address, + Src_Left, Src_Len, + Dst_Left, Dst_Len); + when Convert_Out => + Grt.Signals.Ghdl_Signal_Out_Conversion (Conversion_Proc'Address, + Conv.all'Address, + Src_Left, Src_Len, + Dst_Left, Dst_Len); + end case; + end Add_Conversion; + + type Connect_Mode is (Connect_Source, Connect_Effective); + + -- Add a driving value PORT to signal SIG, ie: PORT is a source for SIG. + -- As a side effect, this connect the signal SIG with the port PORT. + -- PORT is the formal, while SIG is the actual. + procedure Connect (Sig: Iir_Value_Literal_Acc; + Port: Iir_Value_Literal_Acc; + Mode : Connect_Mode) + is + begin + case Sig.Kind is + when Iir_Value_Array => + if Port.Kind /= Sig.Kind then + raise Internal_Error; + end if; + + if Sig.Val_Array.Len /= Port.Val_Array.Len then + raise Internal_Error; + end if; + for I in Sig.Val_Array.V'Range loop + Connect (Sig.Val_Array.V (I), Port.Val_Array.V (I), Mode); + end loop; + return; + when Iir_Value_Record => + if Port.Kind /= Sig.Kind then + raise Internal_Error; + end if; + if Sig.Val_Record.Len /= Port.Val_Record.Len then + raise Internal_Error; + end if; + for I in Sig.Val_Record.V'Range loop + Connect (Sig.Val_Record.V (I), Port.Val_Record.V (I), Mode); + end loop; + return; + when Iir_Value_Signal => + pragma Assert (Port.Kind = Iir_Value_Signal); + -- Here, SIG and PORT are simple signals (not composite). + -- PORT is a source for SIG. + case Mode is + when Connect_Source => + Grt.Signals.Ghdl_Signal_Add_Source + (Sig.Sig, Port.Sig); + when Connect_Effective => + Grt.Signals.Ghdl_Signal_Effective_Value + (Port.Sig, Sig.Sig); + end case; + when Iir_Value_E32 => + if Mode = Connect_Source then + raise Internal_Error; + end if; + Grt.Signals.Ghdl_Signal_Associate_E32 (Port.Sig, Sig.E32); + when Iir_Value_I64 => + if Mode = Connect_Source then + raise Internal_Error; + end if; + Grt.Signals.Ghdl_Signal_Associate_I64 (Port.Sig, Sig.I64); + when Iir_Value_B1 => + if Mode = Connect_Source then + raise Internal_Error; + end if; + Grt.Signals.Ghdl_Signal_Associate_B1 (Port.Sig, Sig.B1); + when Iir_Value_E8 => + if Mode = Connect_Source then + raise Internal_Error; + end if; + Grt.Signals.Ghdl_Signal_Associate_E8 (Port.Sig, Sig.E8); + when others => + raise Internal_Error; + end case; + end Connect; + + procedure Set_Connect + (Formal_Instance : Block_Instance_Acc; + Formal_Expr : Iir_Value_Literal_Acc; + Local_Instance : Block_Instance_Acc; + Local_Expr : Iir_Value_Literal_Acc; + Inter : Iir; + Assoc : Iir_Association_Element_By_Expression) + is + pragma Unreferenced (Formal_Instance); + Formal : constant Iir := Get_Formal (Assoc); + begin + if False and Trace_Elaboration then + Put ("connect formal "); + Put (Iir_Mode'Image (Get_Mode (Inter))); + Put (" "); + Disp_Iir_Value (Formal_Expr, Get_Type (Formal)); + Put (" with actual "); + Disp_Iir_Value (Local_Expr, Get_Type (Get_Actual (Assoc))); + New_Line; + end if; + + case Get_Mode (Inter) is + when Iir_Out_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode + | Iir_Linkage_Mode => + -- FORMAL_EXPR is a source for LOCAL_EXPR. + declare + Out_Conv : constant Iir := Get_Formal_Conversion (Assoc); + Src : Iir_Value_Literal_Acc; + begin + if Out_Conv /= Null_Iir then + Src := Create_Shadow_Signal (Local_Expr); + Add_Conversion + (new Convert_Instance_Type' + (Mode => Convert_Out, + Instance => Local_Instance, + Func => Out_Conv, + Src => Formal_Expr, + Dst => Src)); + else + Src := Formal_Expr; + end if; + -- LRM93 §12.6.2 + -- A signal is said to be active [...] if one of its source + -- is active. + Connect (Local_Expr, Src, Connect_Source); + end; + + when Iir_In_Mode => + null; + when Iir_Unknown_Mode => + raise Internal_Error; + end case; + + case Get_Mode (Inter) is + when Iir_In_Mode + | Iir_Inout_Mode + | Iir_Buffer_Mode + | Iir_Linkage_Mode => + declare + In_Conv : constant Iir := Get_Actual_Conversion (Assoc); + Src : Iir_Value_Literal_Acc; + begin + if In_Conv /= Null_Iir then + Src := Create_Shadow_Signal (Formal_Expr); + Add_Conversion + (new Convert_Instance_Type' + (Mode => Convert_In, + Instance => Local_Instance, + Func => Get_Implementation (In_Conv), + Src => Local_Expr, + Dst => Src)); + else + Src := Local_Expr; + end if; + Connect (Src, Formal_Expr, Connect_Effective); + end; + when Iir_Out_Mode => + null; + when Iir_Unknown_Mode => + raise Internal_Error; + end case; + end Set_Connect; + + procedure Create_Connects is + begin + -- New signals may be created (because of conversions). + Instance_Pool := Global_Pool'Access; + + for I in Connect_Table.First .. Connect_Table.Last loop + declare + E : Connect_Entry renames Connect_Table.Table (I); + begin + Set_Connect (E.Formal_Instance, E.Formal, + E.Actual_Instance, E.Actual, + E.Inter, E.Assoc); + end; + end loop; + + Instance_Pool := null; + end Create_Connects; + + procedure Set_Disconnection (Val : Iir_Value_Literal_Acc; + Time : Iir_Value_Time) + is + begin + case Val.Kind is + when Iir_Value_Signal => + Grt.Signals.Ghdl_Signal_Set_Disconnect (Val.Sig, Std_Time (Time)); + when Iir_Value_Record => + for I in Val.Val_Record.V'Range loop + Set_Disconnection (Val.Val_Record.V (I), Time); + end loop; + when Iir_Value_Array => + for I in Val.Val_Array.V'Range loop + Set_Disconnection (Val.Val_Array.V (I), Time); + end loop; + when others => + raise Internal_Error; + end case; + end Set_Disconnection; + + procedure Create_Disconnections is + begin + for I in Disconnection_Table.First .. Disconnection_Table.Last loop + declare + E : Disconnection_Entry renames Disconnection_Table.Table (I); + begin + Set_Disconnection (E.Sig, E.Time); + end; + end loop; + end Create_Disconnections; + + procedure Create_Guard_Signal (Instance : Block_Instance_Acc; + Sig_Guard : Iir_Value_Literal_Acc; + Val_Guard : Iir_Value_Literal_Acc; + Guard : Iir) + is + procedure Add_Guard_Sensitivity (Sig : Iir_Value_Literal_Acc) is + begin + case Sig.Kind is + when Iir_Value_Signal => + Grt.Signals.Ghdl_Signal_Guard_Dependence (Sig.Sig); + when Iir_Value_Array => + for I in Sig.Val_Array.V'Range loop + Add_Guard_Sensitivity (Sig.Val_Array.V (I)); + end loop; + when Iir_Value_Record => + for I in Sig.Val_Record.V'Range loop + Add_Guard_Sensitivity (Sig.Val_Record.V (I)); + end loop; + when others => + raise Internal_Error; + end case; + end Add_Guard_Sensitivity; + + Dep_List : Iir_List; + Dep_It : List_Iterator; + Dep : Iir; + Data : Guard_Instance_Acc; + begin + Data := new Guard_Instance_Type'(Instance => Instance, + Guard => Guard); + Sig_Guard.Sig := Grt.Signals.Ghdl_Signal_Create_Guard + (To_Ghdl_Value_Ptr (Val_Guard.B1'Address), + Data.all'Address, Guard_Func'Access); + Dep_List := Get_Guard_Sensitivity_List (Guard); + Dep_It := List_Iterate (Dep_List); + while Is_Valid (Dep_It) loop + Dep := Get_Element (Dep_It); + Add_Guard_Sensitivity (Execute_Name (Instance, Dep, True)); + Next (Dep_It); + end loop; + + -- FIXME: free mem + end Create_Guard_Signal; + + procedure Create_Implicit_Signal (Sig : Iir_Value_Literal_Acc; + Val : Iir_Value_Literal_Acc; + Time : Std_Time; + Prefix : Iir_Value_Literal_Acc; + Kind : Mode_Signal_Type) + is + procedure Register_Prefix (Pfx : Iir_Value_Literal_Acc) is + begin + case Pfx.Kind is + when Iir_Value_Signal => + Grt.Signals.Ghdl_Signal_Attribute_Register_Prefix (Pfx.Sig); + when Iir_Value_Array => + for I in Pfx.Val_Array.V'Range loop + Register_Prefix (Pfx.Val_Array.V (I)); + end loop; + when Iir_Value_Record => + for I in Pfx.Val_Record.V'Range loop + Register_Prefix (Pfx.Val_Record.V (I)); + end loop; + when others => + raise Internal_Error; + end case; + end Register_Prefix; + begin + case Kind is + when Mode_Stable => + Sig.Sig := Grt.Signals.Ghdl_Create_Stable_Signal + (To_Ghdl_Value_Ptr (Val.B1'Address), Time); + when Mode_Quiet => + Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal + (To_Ghdl_Value_Ptr (Val.B1'Address), Time); + when Mode_Transaction => + Sig.Sig := Grt.Signals.Ghdl_Create_Transaction_Signal + (To_Ghdl_Value_Ptr (Val.B1'Address)); + when others => + raise Internal_Error; + end case; + Register_Prefix (Prefix); + end Create_Implicit_Signal; + + procedure Create_Delayed_Signal (Sig : Iir_Value_Literal_Acc; + Val : Iir_Value_Literal_Acc; + Pfx : Iir_Value_Literal_Acc; + Time : Std_Time) + is + Val_Ptr : Ghdl_Value_Ptr; + begin + case Pfx.Kind is + when Iir_Value_Array => + for I in Sig.Val_Array.V'Range loop + Create_Delayed_Signal + (Sig.Val_Array.V (I), Val.Val_Array.V (I), + Pfx.Val_Array.V (I), Time); + end loop; + when Iir_Value_Record => + for I in Pfx.Val_Record.V'Range loop + Create_Delayed_Signal + (Sig.Val_Record.V (I), Val.Val_Record.V (I), + Pfx.Val_Array.V (I), Time); + end loop; + when Iir_Value_Signal => + case Iir_Value_Scalars (Val.Kind) is + when Iir_Value_I64 => + Val_Ptr := To_Ghdl_Value_Ptr (Val.I64'Address); + when Iir_Value_E32 => + Val_Ptr := To_Ghdl_Value_Ptr (Val.E32'Address); + when Iir_Value_F64 => + Val_Ptr := To_Ghdl_Value_Ptr (Val.F64'Address); + when Iir_Value_B1 => + Val_Ptr := To_Ghdl_Value_Ptr (Val.B1'Address); + when Iir_Value_E8 => + Val_Ptr := To_Ghdl_Value_Ptr (Val.E8'Address); + end case; + Sig.Sig := Grt.Signals.Ghdl_Create_Delayed_Signal + (Pfx.Sig, Val_Ptr, Time); + when others => + raise Internal_Error; + end case; + end Create_Delayed_Signal; + + -- Create a new signal, using DEFAULT as initial value. + -- Set its number. + procedure Create_User_Signal (Block: Block_Instance_Acc; + Mode : Mode_Signal_Type; + Signal: Iir; + Sig : Iir_Value_Literal_Acc; + Val : Iir_Value_Literal_Acc) + is + use Grt.Rtis; + use Grt.Signals; + + procedure Create_Signal (Val : Iir_Value_Literal_Acc; + Sig : Iir_Value_Literal_Acc; + Sig_Type: Iir; + Already_Resolved : Boolean) + is + Sub_Resolved : Boolean := Already_Resolved; + Resolv_Func : Iir; + Resolv_Instance : Resolv_Instance_Acc; + 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 Resolv_Func /= Null_Iir then + Sub_Resolved := True; + Resolv_Instance := new Resolv_Instance_Type' + (Func => Get_Named_Entity (Resolv_Func), + Block => Block, + Sig => Sig); + Grt.Signals.Ghdl_Signal_Create_Resolution + (Resolution_Proc'Access, + Resolv_Instance.all'Address, + System.Null_Address, + Ghdl_Index_Type (Get_Nbr_Of_Scalars (Val))); + end if; + case Val.Kind is + when Iir_Value_Array => + declare + Sig_El_Type : constant Iir := + Get_Element_Subtype (Get_Base_Type (Sig_Type)); + begin + for I in Val.Val_Array.V'Range loop + Create_Signal (Val.Val_Array.V (I), Sig.Val_Array.V (I), + Sig_El_Type, Sub_Resolved); + end loop; + end; + when Iir_Value_Record => + declare + List : constant Iir_Flist := Get_Elements_Declaration_List + (Get_Base_Type (Sig_Type)); + El : Iir_Element_Declaration; + begin + for I in Val.Val_Record.V'Range loop + El := Get_Nth_Element (List, Natural (I - 1)); + Create_Signal (Val.Val_Record.V (I), Sig.Val_Record.V (I), + Get_Type (El), Sub_Resolved); + end loop; + end; + + when Iir_Value_I64 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_I64 + (To_Ghdl_Value_Ptr (Val.I64'Address), + null, System.Null_Address); + when Iir_Value_B1 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_B1 + (To_Ghdl_Value_Ptr (Val.B1'Address), + null, System.Null_Address); + when Iir_Value_E8 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E8 + (To_Ghdl_Value_Ptr (Val.E8'Address), + null, System.Null_Address); + when Iir_Value_E32 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E32 + (To_Ghdl_Value_Ptr (Val.E32'Address), + null, System.Null_Address); + when Iir_Value_F64 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_F64 + (To_Ghdl_Value_Ptr (Val.F64'Address), + null, System.Null_Address); + + when Iir_Value_Signal + | Iir_Value_Range + | Iir_Value_File + | Iir_Value_Access + | Iir_Value_Protected + | Iir_Value_Quantity + | Iir_Value_Terminal + | Iir_Value_Environment => + 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, False); + end Create_User_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 + case E.Kind is + when Mode_Guard => + Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl); + when Mode_Stable | Mode_Quiet | Mode_Transaction => + Create_Implicit_Signal + (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); + when Mode_Delayed => + Create_Delayed_Signal (E.Sig, E.Val, E.Prefix, E.Time); + when Mode_Signal_User => + Create_User_Signal + (E.Instance, E.Kind, E.Decl, E.Sig, E.Val); + when Mode_Conv_In | Mode_Conv_Out | Mode_End => + raise Internal_Error; + end case; + end; + end loop; + end Create_Signals; + + procedure Ghdl_Elaborate is + begin + Elaboration.Elaborate_Design (Top_Config); + + if Disp_Stats then + Disp_Design_Stats; + end if; + + if Disp_Ams then + Debugger.AMS.Disp_Characteristic_Expressions; + end if; + + -- There is no inputs. + -- All the simulation is done via time, so it must be displayed. + Disp_Time_Before_Values := True; + + -- Initialisation. + if Trace_Simulation then + Put_Line ("Initialisation:"); + end if; + + Create_Signals; + Create_Connects; + Create_Disconnections; + Create_Processes; + Create_PSL; + + if Disp_Tree then + Debugger.Disp_Instances_Tree; + end if; + + if Flag_Interractive then + Debug (Reason_Elab); + end if; + end Ghdl_Elaborate; + + procedure Simulation_Entity (Top_Conf : Iir_Design_Unit) is + begin + Top_Config := Top_Conf; + + Grt.Errors.Error_Hook := Debug_Error'Access; + + if Flag_Interractive then + Debug (Reason_Start); + end if; + + Grt.Main.Run; + exception + when Debugger_Quit => + null; + when Simulation_Finished => + null; + end Simulation_Entity; +end Simul.Simulation.Main; |