diff options
Diffstat (limited to 'src/simulate/simulation.adb')
| -rw-r--r-- | src/simulate/simulation.adb | 1669 |
1 files changed, 1669 insertions, 0 deletions
diff --git a/src/simulate/simulation.adb b/src/simulate/simulation.adb new file mode 100644 index 0000000..3f3f871 --- /dev/null +++ b/src/simulate/simulation.adb @@ -0,0 +1,1669 @@ +-- Interpreted simulation +-- Copyright (C) 2014 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 Errorout; use Errorout; +with Iirs_Utils; use Iirs_Utils; +with Trans_Analyzes; +with Types; use Types; +with Debugger; use Debugger; +with Simulation.AMS.Debugger; +with Areapools; use Areapools; +with Grt.Stacks; +with Grt.Signals; +with Grt.Processes; +with Grt.Main; +with Grt.Errors; +with Grt.Rtis; + +package body Simulation is + + function Value_To_Iir_Value (Mode : Mode_Type; Val : Value_Union) + return Iir_Value_Literal_Acc is + begin + case Mode is + when Mode_B1 => + return Create_B1_Value (Val.B1); + when Mode_E32 => + return Create_E32_Value (Val.E32); + when Mode_I64 => + return Create_I64_Value (Val.I64); + when Mode_F64 => + return Create_F64_Value (Val.F64); + when others => + raise Internal_Error; -- FIXME + end case; + end Value_To_Iir_Value; + + procedure Iir_Value_To_Value (Src : Iir_Value_Literal_Acc; + Dst : out Value_Union) is + begin + case Src.Kind is + when Iir_Value_B1 => + Dst.B1 := Src.B1; + when Iir_Value_E32 => + Dst.E32 := Src.E32; + when Iir_Value_I64 => + Dst.I64 := Src.I64; + when Iir_Value_F64 => + Dst.F64 := Src.F64; + when others => + raise Internal_Error; -- FIXME + end case; + end Iir_Value_To_Value; + + type Read_Signal_Flag_Enum is + (Read_Signal_Event, + Read_Signal_Active, + -- In order to reuse the same code (that returns immediately if the + -- attribute is true), we use not driving. + Read_Signal_Not_Driving); + + function Read_Signal_Flag (Lit: Iir_Value_Literal_Acc; + Kind : Read_Signal_Flag_Enum) + return Boolean + is + begin + case Lit.Kind is + when Iir_Value_Array => + for I in Lit.Val_Array.V'Range loop + if Read_Signal_Flag (Lit.Val_Array.V (I), Kind) then + return True; + end if; + end loop; + return False; + when Iir_Value_Record => + for I in Lit.Val_Record.V'Range loop + if Read_Signal_Flag (Lit.Val_Record.V (I), Kind) then + return True; + end if; + end loop; + return False; + when Iir_Value_Signal => + case Kind is + when Read_Signal_Event => + return Lit.Sig.Event; + when Read_Signal_Active => + return Lit.Sig.Active; + when Read_Signal_Not_Driving => + if Grt.Signals.Ghdl_Signal_Driving (Lit.Sig) = True then + return False; + else + return True; + end if; + end case; + when others => + raise Internal_Error; + end case; + end Read_Signal_Flag; + + function Execute_Event_Attribute (Lit: Iir_Value_Literal_Acc) + return Boolean is + begin + return Read_Signal_Flag (Lit, Read_Signal_Event); + end Execute_Event_Attribute; + + function Execute_Active_Attribute (Lit: Iir_Value_Literal_Acc) + return Boolean is + begin + return Read_Signal_Flag (Lit, Read_Signal_Active); + end Execute_Active_Attribute; + + function Execute_Driving_Attribute (Lit: Iir_Value_Literal_Acc) + return Boolean is + begin + return not Read_Signal_Flag (Lit, Read_Signal_Not_Driving); + end Execute_Driving_Attribute; + + type Read_Signal_Value_Enum is + (Read_Signal_Last_Value, + + -- For conversion functions. + Read_Signal_Driving_Value, + Read_Signal_Effective_Value, + + -- 'Driving_Value + Read_Signal_Driver_Value); + + function Execute_Read_Signal_Value (Sig: Iir_Value_Literal_Acc; + Attr : Read_Signal_Value_Enum) + return Iir_Value_Literal_Acc + is + Res: Iir_Value_Literal_Acc; + begin + case Sig.Kind is + when Iir_Value_Array => + Res := Copy_Array_Bound (Sig); + for I in Sig.Val_Array.V'Range loop + Res.Val_Array.V (I) := + Execute_Read_Signal_Value (Sig.Val_Array.V (I), Attr); + end loop; + return Res; + when Iir_Value_Record => + Res := Create_Record_Value (Sig.Val_Record.Len); + for I in Sig.Val_Record.V'Range loop + Res.Val_Record.V (I) := + Execute_Read_Signal_Value (Sig.Val_Record.V (I), Attr); + end loop; + return Res; + when Iir_Value_Signal => + case Attr is + when Read_Signal_Last_Value => + return Value_To_Iir_Value + (Sig.Sig.Mode, Sig.Sig.Last_Value); + when Read_Signal_Driver_Value => + case Sig.Sig.Mode is + when Mode_F64 => + return Create_F64_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_F64 + (Sig.Sig)); + when Mode_I64 => + return Create_I64_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_I64 + (Sig.Sig)); + when Mode_E32 => + return Create_E32_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_E32 + (Sig.Sig)); + when Mode_B1 => + return Create_B1_Value + (Grt.Signals.Ghdl_Signal_Driving_Value_B1 + (Sig.Sig)); + when others => + raise Internal_Error; + end case; + when Read_Signal_Effective_Value => + return Value_To_Iir_Value + (Sig.Sig.Mode, Sig.Sig.Value); + when Read_Signal_Driving_Value => + return Value_To_Iir_Value + (Sig.Sig.Mode, Sig.Sig.Driving_Value); + end case; + when others => + raise Internal_Error; + end case; + end Execute_Read_Signal_Value; + + type Write_Signal_Enum is + (Write_Signal_Driving_Value, + Write_Signal_Effective_Value); + + procedure Execute_Write_Signal (Sig: Iir_Value_Literal_Acc; + Val : Iir_Value_Literal_Acc; + Attr : Write_Signal_Enum) is + begin + case Sig.Kind is + when Iir_Value_Array => + pragma Assert (Val.Kind = Iir_Value_Array); + pragma Assert (Sig.Val_Array.Len = Val.Val_Array.Len); + for I in Sig.Val_Array.V'Range loop + Execute_Write_Signal + (Sig.Val_Array.V (I), Val.Val_Array.V (I), Attr); + end loop; + when Iir_Value_Record => + pragma Assert (Val.Kind = Iir_Value_Record); + pragma Assert (Sig.Val_Record.Len = Val.Val_Record.Len); + for I in Sig.Val_Record.V'Range loop + Execute_Write_Signal + (Sig.Val_Record.V (I), Val.Val_Record.V (I), Attr); + end loop; + when Iir_Value_Signal => + pragma Assert (Val.Kind in Iir_Value_Scalars); + case Attr is + when Write_Signal_Driving_Value => + Iir_Value_To_Value (Val, Sig.Sig.Driving_Value); + when Write_Signal_Effective_Value => + Iir_Value_To_Value (Val, Sig.Sig.Value); + end case; + when others => + raise Internal_Error; + end case; + end Execute_Write_Signal; + + function Execute_Last_Value_Attribute (Indirect: Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + return Execute_Read_Signal_Value (Indirect, Read_Signal_Last_Value); + end Execute_Last_Value_Attribute; + + function Execute_Driving_Value_Attribute (Indirect: Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc is + begin + return Execute_Read_Signal_Value (Indirect, Read_Signal_Driver_Value); + end Execute_Driving_Value_Attribute; + + type Signal_Read_Last_Type is + (Read_Last_Event, + Read_Last_Active); + + -- Return the Last_Event absolute time. + function Execute_Read_Signal_Last (Indirect: Iir_Value_Literal_Acc; + Kind : Signal_Read_Last_Type) + return Ghdl_I64 + is + Res: Ghdl_I64; + begin + case Indirect.Kind is + when Iir_Value_Array => + Res := Ghdl_I64'First; + for I in Indirect.Val_Array.V'Range loop + Res := Ghdl_I64'Max + (Res, Execute_Read_Signal_Last (Indirect.Val_Array.V (I), + Kind)); + end loop; + return Res; + when Iir_Value_Signal => + case Kind is + when Read_Last_Event => + return Ghdl_I64 (Indirect.Sig.Last_Event); + when Read_Last_Active => + return Ghdl_I64 (Indirect.Sig.Last_Active); + end case; + when others => + raise Internal_Error; + end case; + end Execute_Read_Signal_Last; + + function Execute_Last_Event_Attribute (Indirect: Iir_Value_Literal_Acc) + return Ghdl_I64 is + begin + return Execute_Read_Signal_Last (Indirect, Read_Last_Event); + end Execute_Last_Event_Attribute; + + function Execute_Last_Active_Attribute (Indirect: Iir_Value_Literal_Acc) + return Ghdl_I64 is + begin + return Execute_Read_Signal_Last (Indirect, Read_Last_Active); + end Execute_Last_Active_Attribute; + + function Execute_Signal_Value (Indirect: Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc + is + Res: Iir_Value_Literal_Acc; + begin + case Indirect.Kind is + when Iir_Value_Array => + Res := Copy_Array_Bound (Indirect); + for I in Indirect.Val_Array.V'Range loop + Res.Val_Array.V (I) := + Execute_Signal_Value (Indirect.Val_Array.V (I)); + end loop; + return Res; + when Iir_Value_Record => + Res := Create_Record_Value (Indirect.Val_Record.Len); + for I in Indirect.Val_Record.V'Range loop + Res.Val_Record.V (I) := + Execute_Signal_Value (Indirect.Val_Record.V (I)); + end loop; + return Res; + when Iir_Value_Signal => + return Value_To_Iir_Value (Indirect.Sig.Mode, Indirect.Sig.Value); + when others => + raise Internal_Error; + end case; + end Execute_Signal_Value; + + procedure Assign_Value_To_Array_Signal + (Instance: Block_Instance_Acc; + Target: Iir_Value_Literal_Acc; + Transactions: Transaction_Type) + is + Sub_Trans : Transaction_Type (Transactions.Len); + begin + Sub_Trans.Stmt := Transactions.Stmt; + Sub_Trans.Reject := Transactions.Reject; + + for J in Target.Val_Array.V'Range loop + for K in Transactions.Els'Range loop + declare + T : Transaction_El_Type renames Transactions.Els (K); + S : Transaction_El_Type renames Sub_Trans.Els (K); + begin + S.After := T.After; + + if T.Value = null then + S.Value := null; + else + S.Value := T.Value.Val_Array.V (J); + end if; + end; + end loop; + + Assign_Value_To_Signal + (Instance, Target.Val_Array.V (J), Sub_Trans); + end loop; + end Assign_Value_To_Array_Signal; + + procedure Assign_Value_To_Record_Signal + (Instance: Block_Instance_Acc; + Target: Iir_Value_Literal_Acc; + Transactions: Transaction_Type) + is + Sub_Trans : Transaction_Type (Transactions.Len); + begin + Sub_Trans.Stmt := Transactions.Stmt; + Sub_Trans.Reject := Transactions.Reject; + + for J in Target.Val_Record.V'Range loop + for K in Transactions.Els'Range loop + declare + T : Transaction_El_Type renames Transactions.Els (K); + S : Transaction_El_Type renames Sub_Trans.Els (K); + begin + S.After := T.After; + + if T.Value = null then + S.Value := null; + else + S.Value := T.Value.Val_Record.V (J); + end if; + end; + end loop; + + Assign_Value_To_Signal + (Instance, Target.Val_Record.V (J), Sub_Trans); + end loop; + end Assign_Value_To_Record_Signal; + + procedure Assign_Value_To_Scalar_Signal + (Instance: Block_Instance_Acc; + Target: Iir_Value_Literal_Acc; + Transactions: Transaction_Type) + is + pragma Unreferenced (Instance); + use Grt.Signals; + begin + declare + El : Transaction_El_Type renames Transactions.Els (1); + begin + if El.Value = null then + Ghdl_Signal_Start_Assign_Null + (Target.Sig, Transactions.Reject, El.After); + if Transactions.Els'Last /= 1 then + raise Internal_Error; + end if; + return; + end if; + + -- FIXME: null transaction, check constraints. + case Iir_Value_Scalars (El.Value.Kind) is + when Iir_Value_B1 => + Ghdl_Signal_Start_Assign_B1 + (Target.Sig, Transactions.Reject, El.Value.B1, El.After); + when Iir_Value_E32 => + Ghdl_Signal_Start_Assign_E32 + (Target.Sig, Transactions.Reject, El.Value.E32, El.After); + when Iir_Value_I64 => + Ghdl_Signal_Start_Assign_I64 + (Target.Sig, Transactions.Reject, El.Value.I64, El.After); + when Iir_Value_F64 => + Ghdl_Signal_Start_Assign_F64 + (Target.Sig, Transactions.Reject, El.Value.F64, El.After); + end case; + end; + + for I in 2 .. Transactions.Els'Last loop + declare + El : Transaction_El_Type renames Transactions.Els (I); + begin + case Iir_Value_Scalars (El.Value.Kind) is + when Iir_Value_B1 => + Ghdl_Signal_Next_Assign_B1 + (Target.Sig, El.Value.B1, El.After); + when Iir_Value_E32 => + Ghdl_Signal_Next_Assign_E32 + (Target.Sig, El.Value.E32, El.After); + when Iir_Value_I64 => + Ghdl_Signal_Next_Assign_I64 + (Target.Sig, El.Value.I64, El.After); + when Iir_Value_F64 => + Ghdl_Signal_Next_Assign_F64 + (Target.Sig, El.Value.F64, El.After); + end case; + end; + end loop; + end Assign_Value_To_Scalar_Signal; + + procedure Assign_Value_To_Signal + (Instance: Block_Instance_Acc; + Target: Iir_Value_Literal_Acc; + Transaction: Transaction_Type) + is + begin + case Target.Kind is + when Iir_Value_Array => + Assign_Value_To_Array_Signal + (Instance, Target, Transaction); + when Iir_Value_Record => + Assign_Value_To_Record_Signal + (Instance, Target, Transaction); + when Iir_Value_Signal => + Assign_Value_To_Scalar_Signal + (Instance, Target, Transaction); + when Iir_Value_Scalars + | Iir_Value_Range + | Iir_Value_File + | Iir_Value_Access + | Iir_Value_Protected + | Iir_Value_Quantity + | Iir_Value_Terminal => + raise Internal_Error; + end case; + end Assign_Value_To_Signal; + + procedure Disconnect_Signal (Sig : Iir_Value_Literal_Acc) is + begin + case Sig.Kind is + when Iir_Value_Array => + for I in Sig.Val_Array.V'Range loop + Disconnect_Signal (Sig.Val_Array.V (I)); + end loop; + when Iir_Value_Record => + for I in Sig.Val_Array.V'Range loop + Disconnect_Signal (Sig.Val_Record.V (I)); + end loop; + when Iir_Value_Signal => + Grt.Signals.Ghdl_Signal_Disconnect (Sig.Sig); + when others => + raise Internal_Error; + end case; + end Disconnect_Signal; + + -- Call Ghdl_Process_Wait_Add_Sensitivity for each scalar subelement of + -- SIG. + procedure Wait_Add_Sensitivity (Sig: Iir_Value_Literal_Acc) + is + begin + case Sig.Kind is + when Iir_Value_Signal => + Grt.Processes.Ghdl_Process_Wait_Add_Sensitivity (Sig.Sig); + when Iir_Value_Array => + for I in Sig.Val_Array.V'Range loop + Wait_Add_Sensitivity (Sig.Val_Array.V (I)); + end loop; + when Iir_Value_Record => + for I in Sig.Val_Record.V'Range loop + Wait_Add_Sensitivity (Sig.Val_Record.V (I)); + end loop; + when others => + raise Internal_Error; + end case; + end Wait_Add_Sensitivity; + + -- Return true if the process should be suspended. + function Execute_Wait_Statement (Instance : Block_Instance_Acc; + Stmt: Iir_Wait_Statement) + return Boolean + is + Expr: Iir; + El : Iir; + List: Iir_List; + Res: Iir_Value_Literal_Acc; + Status : Boolean; + Marker : Mark_Type; + begin + if not Instance.In_Wait_Flag then + Mark (Marker, Expr_Pool); + + -- 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_Iir then + Res := Execute_Expression (Instance, Expr); + Grt.Processes.Ghdl_Process_Wait_Set_Timeout (Std_Time (Res.I64)); + end if; + + -- LRM93 8.1 + -- The suspended process may also resume as a result of an event + -- occuring on any signal in the sensitivity set of the wait + -- statement. + List := Get_Sensitivity_List (Stmt); + if List /= Null_Iir_List then + for J in Natural loop + El := Get_Nth_Element (List, J); + exit when El = Null_Iir; + Wait_Add_Sensitivity (Execute_Name (Instance, El, True)); + end loop; + end if; + + -- LRM93 8.1 + -- It also causes the execution of the corresponding process + -- statement to be suspended. + Grt.Processes.Ghdl_Process_Wait_Wait; + Instance.In_Wait_Flag := True; + Release (Marker, Expr_Pool); + return True; + else + -- 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_Has_Timeout 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. + Status := + Execute_Condition (Instance, Get_Condition_Clause (Stmt)); + if not Status 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_Wait; + 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; + + Instance.In_Wait_Flag := False; + return False; + end if; + end Execute_Wait_Statement; + + function To_Instance_Acc is new Ada.Unchecked_Conversion + (System.Address, Grt.Stacks.Instance_Acc); + + procedure Process_Executer (Self : Grt.Stacks.Instance_Acc); + pragma Convention (C, Process_Executer); + + procedure Process_Executer (Self : Grt.Stacks.Instance_Acc) + is + function To_Process_State_Acc is new Ada.Unchecked_Conversion + (Grt.Stacks.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 Resolver_Read_Mode is (Read_Port, Read_Driver); + + function Resolver_Read_Value (Sig : Iir_Value_Literal_Acc; + Mode : Resolver_Read_Mode; + Index : Ghdl_Index_Type) + return Iir_Value_Literal_Acc + is + use Grt.Signals; + Val : Ghdl_Value_Ptr; + Res : Iir_Value_Literal_Acc; + begin + case Sig.Kind is + when Iir_Value_Array => + Res := Copy_Array_Bound (Sig); + for I in Sig.Val_Array.V'Range loop + Res.Val_Array.V (I) := + Resolver_Read_Value (Sig.Val_Array.V (I), Mode, Index); + end loop; + when Iir_Value_Record => + Res := Create_Record_Value (Sig.Val_Record.Len); + for I in Sig.Val_Record.V'Range loop + Res.Val_Record.V (I) := + Resolver_Read_Value (Sig.Val_Record.V (I), Mode, Index); + end loop; + when Iir_Value_Signal => + case Mode is + when Read_Port => + Val := Ghdl_Signal_Read_Port (Sig.Sig, Index); + when Read_Driver => + Val := Ghdl_Signal_Read_Driver (Sig.Sig, Index); + end case; + Res := Value_To_Iir_Value (Sig.Sig.Mode, Val.all); + when others => + raise Internal_Error; + end case; + return Res; + end Resolver_Read_Value; + + 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 + pragma Unreferenced (Val); + + Instance : Resolv_Instance_Type; + pragma Import (Ada, Instance); + for Instance'Address use Instance_Addr; + + type Bool_Array is array (1 .. Nbr_Drv) of Boolean; + Vec : Bool_Array; + pragma Import (Ada, Vec); + for Vec'Address use Bool_Vec; + Off : Iir_Index32; + + Arr : Iir_Value_Literal_Acc; + Arr_Type : constant Iir := + Get_Type (Get_Interface_Declaration_Chain (Instance.Func)); + + Res : Iir_Value_Literal_Acc; + + Len : constant Iir_Index32 := Iir_Index32 (Vec_Len + Nbr_Ports); + Instance_Mark, Expr_Mark : Mark_Type; + begin + pragma Assert (Instance_Pool = null); + Instance_Pool := Global_Pool'Access; + Mark (Instance_Mark, Instance_Pool.all); + Mark (Expr_Mark, Expr_Pool); + Current_Process := No_Process; + + Arr := Create_Array_Value (Len, 1); + Arr.Bounds.D (1) := Create_Bounds_From_Length + (Instance.Block, + Get_First_Element (Get_Index_Subtype_List (Arr_Type)), + Len); + + -- First ports + for I in 1 .. Nbr_Ports loop + Arr.Val_Array.V (Iir_Index32 (I)) := Resolver_Read_Value + (Instance.Sig, Read_Port, I - 1); + end loop; + + -- Then drivers. + Off := Iir_Index32 (Nbr_Ports) + 1; + for I in 1 .. Nbr_Drv loop + if Vec (I) then + Arr.Val_Array.V (Off) := Resolver_Read_Value + (Instance.Sig, Read_Driver, I - 1); + Off := Off + 1; + end if; + end loop; + + -- Call resolution function. + Res := Execute_Resolution_Function (Instance.Block, Instance.Func, Arr); + + -- Set driving value. + Execute_Write_Signal (Instance.Sig, Res, Write_Signal_Driving_Value); + + Release (Instance_Mark, Instance_Pool.all); + Release (Expr_Mark, Expr_Pool); + Instance_Pool := null; + end Resolution_Proc; + + 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; + + function Guard_Func (Data : System.Address) return Ghdl_B1 + is + Guard : Guard_Instance_Type; + pragma Import (Ada, Guard); + for Guard'Address use Data; + + Val : Boolean; + + Prev_Instance_Pool : Areapool_Acc; + begin + pragma Assert (Instance_Pool = null + or else Instance_Pool = Global_Pool'Access); + Prev_Instance_Pool := Instance_Pool; + + Instance_Pool := Global_Pool'Access; + Current_Process := No_Process; + + Val := Execute_Condition + (Guard.Instance, Get_Guard_Expression (Guard.Guard)); + + Instance_Pool := Prev_Instance_Pool; + + return Ghdl_B1'Val (Boolean'Pos (Val)); + end Guard_Func; + + -- 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; + 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). + if Driver_List = Null_Iir_List then + return; + end if; + + for I in Natural loop + El := Get_Nth_Element (Driver_List, I); + exit when El = Null_Iir; + 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); + 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 Create_Processes + is + use Grt.Processes; + El : Iir; + Instance : Block_Instance_Acc; + Instance_Grt : Grt.Stacks.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. + declare + Sig_List : Iir_List; + Sig : Iir; + Marker : Mark_Type; + begin + Sig_List := Get_Sensitivity_List (El); + for J in Natural loop + Sig := Get_Nth_Element (Sig_List, J); + exit when Sig = Null_Iir; + Mark (Marker, Expr_Pool); + Process_Add_Sensitivity + (Execute_Name (Instance, Sig, True)); + Release (Marker, Expr_Pool); + end loop; + end; + + 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; + + -- Configuration for the whole design + Top_Config : Iir_Design_Unit; + + -- Elaborate the design + procedure Ghdl_Elaborate; + pragma Export (C, Ghdl_Elaborate, "__ghdl_ELABORATE"); + + 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; + + 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 => + case Port.Kind is + when 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_Access + | Iir_Value_File + | Iir_Value_Range + | Iir_Value_Scalars -- FIXME: by value + | Iir_Value_Record + | Iir_Value_Array + | Iir_Value_Protected + | Iir_Value_Quantity + | Iir_Value_Terminal => + -- These cannot be driving value for a signal. + raise Internal_Error; + 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 others => + raise Internal_Error; + end case; + end Connect; + + 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; + + function Create_Shadow_Signal (Sig : Iir_Value_Literal_Acc) + return Iir_Value_Literal_Acc + is + begin + case Sig.Kind is + when Iir_Value_Signal => + case Sig.Sig.Mode is + when Mode_I64 => + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_I64 + (0, null, System.Null_Address)); + when Mode_B1 => + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_B1 + (False, null, System.Null_Address)); + when Mode_E32 => + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_E32 + (0, null, System.Null_Address)); + when Mode_F64 => + return Create_Signal_Value + (Grt.Signals.Ghdl_Create_Signal_F64 + (0.0, null, System.Null_Address)); + when Mode_E8 + | 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 => + raise Internal_Error; + end case; + end Create_Shadow_Signal; + + 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; + Assoc : Iir_Association_Element_By_Expression) + is + pragma Unreferenced (Formal_Instance); + Formal : constant Iir := Get_Formal (Assoc); + Inter : constant Iir := Get_Association_Interface (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_Out_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_In_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.Assoc); + end; + end loop; + + Instance_Pool := null; + end Create_Connects; + + procedure Create_Guard_Signal + (Instance : Block_Instance_Acc; + Sig_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 : Iir; + Data : Guard_Instance_Acc; + begin + Data := new Guard_Instance_Type'(Instance => Instance, + Guard => Guard); + Sig_Guard.Sig := Grt.Signals.Ghdl_Signal_Create_Guard + (Data.all'Address, Guard_Func'Access); + Dep_List := Get_Guard_Sensitivity_List (Guard); + for I in Natural loop + Dep := Get_Nth_Element (Dep_List, I); + exit when Dep = Null_Iir; + Add_Guard_Sensitivity (Execute_Name (Instance, Dep, True)); + end loop; + + -- FIXME: free mem + end Create_Guard_Signal; + + procedure Create_Implicit_Signal (Sig : Iir_Value_Literal_Acc; + Time : Ghdl_I64; + Prefix : Iir_Value_Literal_Acc; + Kind : Signal_Type_Kind) + 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 Implicit_Stable => + Sig.Sig := Grt.Signals.Ghdl_Create_Stable_Signal (Std_Time (Time)); + when Implicit_Quiet => + Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal (Std_Time (Time)); + when Implicit_Transaction => + Sig.Sig := Grt.Signals.Ghdl_Create_Transaction_Signal; + when others => + raise Internal_Error; + end case; + Register_Prefix (Prefix); + end Create_Implicit_Signal; + + procedure Create_Delayed_Signal + (Sig : Iir_Value_Literal_Acc; Pfx : Iir_Value_Literal_Acc; Val : Std_Time) + is + 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), Pfx.Val_Array.V (I), Val); + end loop; + when Iir_Value_Record => + for I in Pfx.Val_Record.V'Range loop + Create_Delayed_Signal + (Sig.Val_Record.V (I), Pfx.Val_Array.V (I), Val); + end loop; + when Iir_Value_Signal => + Sig.Sig := Grt.Signals.Ghdl_Create_Delayed_Signal (Pfx.Sig, Val); + 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; + Signal: Iir; + Sig : Iir_Value_Literal_Acc; + Default : Iir_Value_Literal_Acc) + is + use Grt.Rtis; + + procedure Create_Signal (Lit: 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_Function (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 (Lit))); + end if; + case Lit.Kind is + when Iir_Value_Array => + declare + Sig_El_Type : constant Iir := + Get_Element_Subtype (Get_Base_Type (Sig_Type)); + begin + for I in Lit.Val_Array.V'Range loop + Create_Signal (Lit.Val_Array.V (I), Sig.Val_Array.V (I), + Sig_El_Type, Sub_Resolved); + end loop; + end; + when Iir_Value_Record => + declare + El : Iir_Element_Declaration; + List : Iir_List; + begin + List := Get_Elements_Declaration_List + (Get_Base_Type (Sig_Type)); + for I in Lit.Val_Record.V'Range loop + El := Get_Nth_Element (List, Natural (I - 1)); + Create_Signal (Lit.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 + (Lit.I64, null, System.Null_Address); + when Iir_Value_B1 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_B1 + (Lit.B1, null, System.Null_Address); + when Iir_Value_E32 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_E32 + (Lit.E32, null, System.Null_Address); + when Iir_Value_F64 => + Sig.Sig := Grt.Signals.Ghdl_Create_Signal_F64 + (Lit.F64, 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 => + raise Internal_Error; + end case; + end Create_Signal; + + Sig_Type: constant Iir := Get_Type (Signal); + Mode : Mode_Signal_Type; + Kind : Kind_Signal_Type; + + type Iir_Mode_To_Mode_Signal_Type is + array (Iir_Mode) of Mode_Signal_Type; + Iir_Mode_To_Mode_Signal : constant Iir_Mode_To_Mode_Signal_Type := + (Iir_Unknown_Mode => Mode_Signal, + Iir_Linkage_Mode => Mode_Linkage, + Iir_Buffer_Mode => Mode_Buffer, + Iir_Out_Mode => Mode_Out, + Iir_Inout_Mode => Mode_Inout, + Iir_In_Mode => Mode_In); + + 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_No_Signal_Kind => Kind_Signal_No, + Iir_Register_Kind => Kind_Signal_Register, + Iir_Bus_Kind => Kind_Signal_Bus); + begin + case Get_Kind (Signal) is + when Iir_Kind_Signal_Interface_Declaration => + Mode := Iir_Mode_To_Mode_Signal (Get_Mode (Signal)); + when Iir_Kind_Signal_Declaration => + Mode := Mode_Signal; + when others => + Error_Kind ("elaborate_signal", Signal); + end case; + + Kind := Iir_Kind_To_Kind_Signal (Get_Signal_Kind (Signal)); + + Grt.Signals.Ghdl_Signal_Set_Mode (Mode, Kind, True); + + Create_Signal (Default, 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 Guard_Signal => + Create_Guard_Signal (E.Instance, E.Sig, E.Decl); + when Implicit_Stable | Implicit_Quiet | Implicit_Transaction => + Create_Implicit_Signal (E.Sig, E.Time, E.Prefix, E.Kind); + when Implicit_Delayed => + Create_Delayed_Signal (E.Sig, E.Prefix, Std_Time (E.Time)); + when User_Signal => + Create_User_Signal (E.Instance, E.Decl, E.Sig, E.Init); + end case; + end; + end loop; + end Create_Signals; + + procedure Ghdl_Elaborate + is + Entity: Iir_Entity_Declaration; + + -- Number of input ports of the top entity. + In_Signals: Natural; + El : Iir; + begin + Instance_Pool := Global_Pool'Access; + + Elaboration.Elaborate_Design (Top_Config); + Entity := Iirs_Utils.Get_Entity (Get_Library_Unit (Top_Config)); + + if not Is_Empty (Expr_Pool) then + raise Internal_Error; + end if; + + Instance_Pool := null; + + -- Be sure there is no IN ports in the top entity. + El := Get_Port_Chain (Entity); + In_Signals := 0; + while El /= Null_Iir loop + if Get_Mode (El) = Iir_In_Mode then + In_Signals := In_Signals + 1; + end if; + El := Get_Chain (El); + end loop; + + if In_Signals /= 0 then + Error_Msg ("top entity should not have inputs signals"); + -- raise Simulation_Error; + end if; + + if Disp_Stats then + Disp_Design_Stats; + end if; + + if Disp_Ams then + Simulation.AMS.Debugger.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; + + 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.Processes.One_Stack := True; + + 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 Simulation; |