diff options
Diffstat (limited to 'simulate/simulation.adb')
| -rw-r--r-- | simulate/simulation.adb | 1669 |
1 files changed, 0 insertions, 1669 deletions
diff --git a/simulate/simulation.adb b/simulate/simulation.adb deleted file mode 100644 index 3f3f871..0000000 --- a/simulate/simulation.adb +++ /dev/null @@ -1,1669 +0,0 @@ --- 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; |