From 002d948aeead104b745e3175e1c684ec7b928847 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Sat, 20 Feb 2016 06:48:03 +0100 Subject: Refactoring in simulate in order to link with ortho. --- src/ghdldrv/ghdlsimul.adb | 11 +- src/ghdldrv/grtlink.ads | 39 - src/grt/grtlink.ads | 39 + src/vhdl/configuration.adb | 14 + src/vhdl/configuration.ads | 3 + src/vhdl/simulate/debugger-ams.adb | 85 ++ src/vhdl/simulate/debugger-ams.ads | 29 + src/vhdl/simulate/debugger.adb | 2 +- src/vhdl/simulate/debugger.ads | 3 + src/vhdl/simulate/elaboration-ams.adb | 199 +++++ src/vhdl/simulate/elaboration-ams.ads | 164 ++++ src/vhdl/simulate/elaboration.adb | 8 +- src/vhdl/simulate/execution.ads | 7 + src/vhdl/simulate/simulation-ams-debugger.adb | 87 -- src/vhdl/simulate/simulation-ams-debugger.ads | 27 - src/vhdl/simulate/simulation-ams.adb | 199 ----- src/vhdl/simulate/simulation-ams.ads | 163 ---- src/vhdl/simulate/simulation-main.adb | 1141 ++++++++++++++++++++++++ src/vhdl/simulate/simulation-main.ads | 4 + src/vhdl/simulate/simulation.adb | 1186 +------------------------ src/vhdl/simulate/simulation.ads | 35 +- src/vhdl/translate/trans-preelab.adb | 58 ++ src/vhdl/translate/trans-preelab.ads | 26 + 23 files changed, 1812 insertions(+), 1717 deletions(-) delete mode 100644 src/ghdldrv/grtlink.ads create mode 100644 src/grt/grtlink.ads create mode 100644 src/vhdl/simulate/debugger-ams.adb create mode 100644 src/vhdl/simulate/debugger-ams.ads create mode 100644 src/vhdl/simulate/elaboration-ams.adb create mode 100644 src/vhdl/simulate/elaboration-ams.ads delete mode 100644 src/vhdl/simulate/simulation-ams-debugger.adb delete mode 100644 src/vhdl/simulate/simulation-ams-debugger.ads delete mode 100644 src/vhdl/simulate/simulation-ams.adb delete mode 100644 src/vhdl/simulate/simulation-ams.ads create mode 100644 src/vhdl/simulate/simulation-main.adb create mode 100644 src/vhdl/simulate/simulation-main.ads create mode 100644 src/vhdl/translate/trans-preelab.adb create mode 100644 src/vhdl/translate/trans-preelab.ads (limited to 'src') diff --git a/src/ghdldrv/ghdlsimul.adb b/src/ghdldrv/ghdlsimul.adb index 2f28e7c09..e17d83c2f 100644 --- a/src/ghdldrv/ghdlsimul.adb +++ b/src/ghdldrv/ghdlsimul.adb @@ -36,7 +36,8 @@ with Iirs_Utils; with Annotations; with Elaboration; with Sim_Be; -with Simulation; +with Simulation.Main; +with Debugger; with Execution; with Ghdlcomp; @@ -153,8 +154,8 @@ package body Ghdlsimul is elsif Arg.all = "--stats" then Simulation.Disp_Stats := True; elsif Arg.all = "-i" then - Simulation.Flag_Debugger := True; - Simulation.Flag_Interractive := True; + Debugger.Flag_Debugger := True; + Debugger.Flag_Interractive := True; else Decode_Option (Arg.all, Status); case Status is @@ -183,7 +184,7 @@ package body Ghdlsimul is Grtlink.Flag_String := Flags.Flag_String; - Simulation.Simulation_Entity (Top_Conf); + Simulation.Main.Simulation_Entity (Top_Conf); Set_Exit_Status (Exit_Status (Grt.Errors.Exit_Status)); end Run; @@ -192,7 +193,7 @@ package body Ghdlsimul is is begin if Option = "--debug" or Option = "-g" then - Simulation.Flag_Debugger := True; + Debugger.Flag_Debugger := True; else return False; end if; diff --git a/src/ghdldrv/grtlink.ads b/src/ghdldrv/grtlink.ads deleted file mode 100644 index 4b3951e78..000000000 --- a/src/ghdldrv/grtlink.ads +++ /dev/null @@ -1,39 +0,0 @@ --- GHDL driver - shared variables with grt. --- Copyright (C) 2011 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 GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with System; use System; - -package Grtlink is - - Flag_String : String (1 .. 5); - pragma Export (C, Flag_String, "__ghdl_flag_string"); - - Std_Standard_Bit_RTI_Ptr : Address := Null_Address; - - Std_Standard_Boolean_RTI_Ptr : Address := Null_Address; - - pragma Export (C, Std_Standard_Bit_RTI_Ptr, - "std__standard__bit__RTI_ptr"); - - pragma Export (C, Std_Standard_Boolean_RTI_Ptr, - "std__standard__boolean__RTI_ptr"); - - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address := Null_Address; - pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr, - "ieee__std_logic_1164__resolved_RESOLV_ptr"); - -end Grtlink; diff --git a/src/grt/grtlink.ads b/src/grt/grtlink.ads new file mode 100644 index 000000000..4b3951e78 --- /dev/null +++ b/src/grt/grtlink.ads @@ -0,0 +1,39 @@ +-- GHDL driver - shared variables with grt. +-- Copyright (C) 2011 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. +with System; use System; + +package Grtlink is + + Flag_String : String (1 .. 5); + pragma Export (C, Flag_String, "__ghdl_flag_string"); + + Std_Standard_Bit_RTI_Ptr : Address := Null_Address; + + Std_Standard_Boolean_RTI_Ptr : Address := Null_Address; + + pragma Export (C, Std_Standard_Bit_RTI_Ptr, + "std__standard__bit__RTI_ptr"); + + pragma Export (C, Std_Standard_Boolean_RTI_Ptr, + "std__standard__boolean__RTI_ptr"); + + Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address := Null_Address; + pragma Export (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr, + "ieee__std_logic_1164__resolved_RESOLV_ptr"); + +end Grtlink; diff --git a/src/vhdl/configuration.adb b/src/vhdl/configuration.adb index 0d11da37b..e7890da62 100644 --- a/src/vhdl/configuration.adb +++ b/src/vhdl/configuration.adb @@ -604,6 +604,20 @@ package body Configuration is return Top; end Configure; + function Configure (Primary : String; Secondary : String) return Iir + is + Primary_Id : Name_Id; + Secondary_Id : Name_Id; + begin + Primary_Id := Get_Identifier (Primary); + if Secondary /= "" then + Secondary_Id := Get_Identifier (Secondary); + else + Secondary_Id := Null_Identifier; + end if; + return Configure (Primary_Id, Secondary_Id); + end Configure; + procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) is Has_Error : Boolean := False; diff --git a/src/vhdl/configuration.ads b/src/vhdl/configuration.ads index 8545c224c..ddd6206d4 100644 --- a/src/vhdl/configuration.ads +++ b/src/vhdl/configuration.ads @@ -38,6 +38,9 @@ package Configuration is function Configure (Primary_Id : Name_Id; Secondary_Id : Name_Id) return Iir; + -- Likewise but directly from strings. + function Configure (Primary : String; Secondary : String) return Iir; + -- Add design unit UNIT (with its dependences) in the design_units table. procedure Add_Design_Unit (Unit : Iir_Design_Unit; From : Iir); diff --git a/src/vhdl/simulate/debugger-ams.adb b/src/vhdl/simulate/debugger-ams.adb new file mode 100644 index 000000000..fec635048 --- /dev/null +++ b/src/vhdl/simulate/debugger-ams.adb @@ -0,0 +1,85 @@ +-- Interpreter AMS 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 Iirs_Utils; use Iirs_Utils; +with Ada.Text_IO; use Ada.Text_IO; +with Disp_Vhdl; + +package body Debugger.AMS is + procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type) + is + Obj : Scalar_Quantity renames Scalar_Quantities.Table (Quantity); + begin + Disp_Instance_Name (Obj.Instance, True); + Put ('.'); + Put (Image_Identifier (Obj.Decl)); + if Obj.Kind = Quantity_Reference then + Put ("'Ref"); + end if; + end Disp_Quantity_Name; + + procedure Disp_Term (Term : Ams_Term_Acc) is + begin + case Term.Sign is + when Op_Plus => + Put (" + "); + when Op_Minus => + Put (" - "); + end case; + + case Term.Op is + when Op_Quantity => + Disp_Quantity_Name (Term.Quantity); + when Op_Vhdl_Expr => + Disp_Vhdl.Disp_Expression (Term.Vhdl_Expr); + end case; + end Disp_Term; + + procedure Disp_Characteristic_Expression + (Ce : Characteristic_Expressions_Index) + is + Obj : Characteristic_Expr renames + Characteristic_Expressions.Table (Ce); + Expr : Ams_Term_Acc := Obj.Expr; + begin + case Obj.Kind is + when Explicit => + Put ("Explic:"); + when Contribution => + Put ("Contri:"); + when Structural => + Put ("Struct:"); + end case; + + while Expr /= null loop + Disp_Term (Expr); + Expr := Expr.Next; + end loop; + New_Line; + end Disp_Characteristic_Expression; + + procedure Disp_Characteristic_Expressions is + begin + Put_Line ("Characteristic expressions:"); + for I in Characteristic_Expressions.First + .. Characteristic_Expressions.Last + loop + Disp_Characteristic_Expression (I); + end loop; + end Disp_Characteristic_Expressions; +end Debugger.AMS; diff --git a/src/vhdl/simulate/debugger-ams.ads b/src/vhdl/simulate/debugger-ams.ads new file mode 100644 index 000000000..4b9de8fed --- /dev/null +++ b/src/vhdl/simulate/debugger-ams.ads @@ -0,0 +1,29 @@ +-- Interpreter AMS 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 Iir_Values; use Iir_Values; +with Elaboration.AMS; use Elaboration.AMS; + +package Debugger.AMS is + procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type); + + procedure Disp_Characteristic_Expression + (Ce : Characteristic_Expressions_Index); + + procedure Disp_Characteristic_Expressions; +end Debugger.AMS; diff --git a/src/vhdl/simulate/debugger.adb b/src/vhdl/simulate/debugger.adb index 4ff7e4488..3acced4ab 100644 --- a/src/vhdl/simulate/debugger.adb +++ b/src/vhdl/simulate/debugger.adb @@ -38,7 +38,7 @@ with Iirs_Utils; use Iirs_Utils; with Errorout; use Errorout; with Disp_Vhdl; with Execution; use Execution; -with Simulation; use Simulation; +--with Simulation; use Simulation; with Iirs_Walk; use Iirs_Walk; with Areapools; use Areapools; with Grt.Disp; diff --git a/src/vhdl/simulate/debugger.ads b/src/vhdl/simulate/debugger.ads index b6ba1dccf..b8b5c8e9e 100644 --- a/src/vhdl/simulate/debugger.ads +++ b/src/vhdl/simulate/debugger.ads @@ -20,6 +20,9 @@ with Elaboration; use Elaboration; with Iirs; use Iirs; package Debugger is + Flag_Debugger : Boolean := False; + Flag_Interractive : Boolean := False; + Flag_Need_Debug : Boolean := False; -- Disp a message for a constraint error. diff --git a/src/vhdl/simulate/elaboration-ams.adb b/src/vhdl/simulate/elaboration-ams.adb new file mode 100644 index 000000000..de4edc980 --- /dev/null +++ b/src/vhdl/simulate/elaboration-ams.adb @@ -0,0 +1,199 @@ +-- Interpreter AMS 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 Errorout; use Errorout; +with Execution; + +package body Elaboration.AMS is + function Create_Characteristic_Expression + (Kind : Characteristic_Expr_Kind) return Characteristic_Expressions_Index + is + begin + case Kind is + when Contribution => + Characteristic_Expressions.Append + ((Kind => Contribution, + Expr => null, + Tolerance => 0, + Dependencies => null)); + when others => + raise Program_Error; + end case; + return Characteristic_Expressions.Last; + end Create_Characteristic_Expression; + + function Create_Scalar_Quantity (Kind : Quantity_Kind; + Decl : Iir; + Instance : Block_Instance_Acc) + return Quantity_Index_Type + is + begin + case Kind is + when Quantity_Reference => + Scalar_Quantities.Append + ((Kind => Quantity_Reference, + Value => 0.0, + Decl => Decl, + Instance => Instance, + Contribution => + Create_Characteristic_Expression (Contribution))); + when Quantity_Across => + Scalar_Quantities.Append + ((Kind => Quantity_Across, + Value => 0.0, + Decl => Decl, + Instance => Instance)); + when Quantity_Through => + Scalar_Quantities.Append + ((Kind => Quantity_Through, + Value => 0.0, + Decl => Decl, + Instance => Instance)); + when others => + raise Program_Error; + end case; + return Scalar_Quantities.Last; + end Create_Scalar_Quantity; + + function Create_Scalar_Terminal (Decl : Iir; + Instance : Block_Instance_Acc) + return Terminal_Index_Type + is + begin + -- Simply create the reference quantity for a terminal + return Terminal_Index_Type + (Create_Scalar_Quantity (Quantity_Reference, Decl, Instance)); + end Create_Scalar_Terminal; + + function Get_Terminal_Reference (Terminal : Terminal_Index_Type) + return Quantity_Index_Type is + begin + return Quantity_Index_Type (Terminal); + end Get_Terminal_Reference; + + procedure Add_Characteristic_Expression + (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc) + is + begin + Characteristic_Expressions.Append + ((Kind => Kind, + Expr => Expr, + Tolerance => Default_Tolerance_Index, + Dependencies => null)); + end Add_Characteristic_Expression; + + procedure Compute_Dependencies (Idx : Characteristic_Expressions_Index) + is + package Quantity_Table is new Tables + (Table_Component_Type => Quantity_Index_Type, + Table_Index_Type => Natural, + Table_Low_Bound => 1, + Table_Initial => 16); + + El : Characteristic_Expr renames Characteristic_Expressions.Table (Idx); + Res : Quantity_Dependency_Acc := null; + + procedure Add_Dependency (Block : Block_Instance_Acc; N : Iir) + is + Q : Iir_Value_Literal_Acc; + begin + case Get_Kind (N) is + when Iir_Kinds_Branch_Quantity_Declaration => + Q := Execution.Execute_Name (Block, N, True); + Quantity_Table.Append (Q.Quantity); + when Iir_Kind_Simple_Name => + Add_Dependency (Block, Get_Named_Entity (N)); + when Iir_Kinds_Dyadic_Operator => + Add_Dependency (Block, Get_Left (N)); + Add_Dependency (Block, Get_Right (N)); + when Iir_Kinds_Literal => + null; + when others => + Error_Kind ("compute_dependencies", N); + end case; + end Add_Dependency; + + Term : Ams_Term_Acc := El.Expr; + begin + pragma Assert (El.Dependencies = null); + + while Term /= null loop + case Term.Op is + when Op_Quantity => + Quantity_Table.Append (Term.Quantity); + when Op_Vhdl_Expr => + Add_Dependency (Term.Vhdl_Instance, Term.Vhdl_Expr); + end case; + Term := Term.Next; + end loop; + Res := new Quantity_Dependency_Type (Nbr => Quantity_Table.Last); + for I in Quantity_Table.First .. Quantity_Table.Last loop + Res.Quantities (I) := Quantity_Table.Table (I); + end loop; + Quantity_Table.Free; + El.Dependencies := Res; + end Compute_Dependencies; + + function Build (Op : Ams_Sign; + Val : Quantity_Index_Type; + Right : Ams_Term_Acc := null) + return Ams_Term_Acc + is + begin + return new Ams_Term'(Op => Op_Quantity, + Sign => Op, + Next => Right, + Quantity => Val); + end Build; + + function Build (Op : Ams_Sign; + Instance : Block_Instance_Acc; + Expr : Iir; + Right : Ams_Term_Acc := null) + return Ams_Term_Acc + is + begin + return new Ams_Term' + (Op => Op_Vhdl_Expr, + Sign => Op, + Vhdl_Expr => Expr, + Vhdl_Instance => Instance, + Next => Right); + end Build; + + procedure Append_Characteristic_Expression + (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc) + is + Ref : constant Quantity_Index_Type := Get_Terminal_Reference (Terminal); + Ce : constant Characteristic_Expressions_Index := + Scalar_Quantities.Table (Ref).Contribution; + begin + pragma Assert (Expr.Next = null); + Expr.Next := Characteristic_Expressions.Table (Ce).Expr; + Characteristic_Expressions.Table (Ce).Expr := Expr; + end Append_Characteristic_Expression; + + procedure Create_Tables is + begin + for I in Characteristic_Expressions.First + .. Characteristic_Expressions.Last + loop + Compute_Dependencies (I); + end loop; + end Create_Tables; +end Elaboration.AMS; diff --git a/src/vhdl/simulate/elaboration-ams.ads b/src/vhdl/simulate/elaboration-ams.ads new file mode 100644 index 000000000..8c786969e --- /dev/null +++ b/src/vhdl/simulate/elaboration-ams.ads @@ -0,0 +1,164 @@ +-- Interpreter AMS 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 Grt.Types; use Grt.Types; +with Tables; + +package Elaboration.AMS is + -- AMS expressions + -- + -- At many places during elaboration, the LRM defines characteristic + -- expressions that aren't present in source code: + -- * contribution expression (12.3.1.4) + -- * characteristic expression for an across quantity declaration + -- (12.3.1.4) + -- * characteristic expression for simple simultaneous statement (the + -- expression is in the source in that case) (15.1) + -- + -- They are represented using a list of Ams_Expression elements. The value + -- is the sum of each element, using the + or - sign. + + type Ams_Sign is (Op_Plus, Op_Minus); + -- Sign for the operand + + type Ams_Operand is (Op_Quantity, Op_Vhdl_Expr); + -- The operand is one of: + -- Op_Quantity: a quantity + -- Op_Vhdl_Expr: an expression from the design. This expression may contain + -- quantities + + type Ams_Term; + type Ams_Term_Acc is access Ams_Term; + -- A term of a characteristic expression + + type Characteristic_Expr_Kind is + (Explicit, + Contribution, + Structural); + + type Tolerance_Index_Type is new Natural; + Default_Tolerance_Index : constant Tolerance_Index_Type := 0; + -- Tolerance + + type Characteristic_Expressions_Index is new Natural; + + type Quantity_Kind is + (Quantity_Reference, + -- The potential of a terminal. This is an across quantity between the + -- terminal and the reference terminal of the nature. + + Quantity_Across, + Quantity_Through, + Quantity_Free + -- Explicitly declared quantities + ); + + function Create_Scalar_Quantity (Kind : Quantity_Kind; + Decl : Iir; + Instance : Block_Instance_Acc) + return Quantity_Index_Type; + -- Create a new scalar quantity + + function Create_Scalar_Terminal (Decl : Iir; + Instance : Block_Instance_Acc) + return Terminal_Index_Type; + -- Create a new scalar terminal + + function Get_Terminal_Reference (Terminal : Terminal_Index_Type) + return Quantity_Index_Type; + -- Get the reference quantity of a terminal + + procedure Add_Characteristic_Expression + (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc); + -- Add a new characteristic expression + + function Build (Op : Ams_Sign; + Val : Quantity_Index_Type; + Right : Ams_Term_Acc := null) + return Ams_Term_Acc; + function Build (Op : Ams_Sign; + Instance : Block_Instance_Acc; + Expr : Iir; + Right : Ams_Term_Acc := null) + return Ams_Term_Acc; + -- Build a term of a characteristic expression + + procedure Append_Characteristic_Expression + (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc); + -- Append an expression to the contribution of a terminal + + procedure Create_Tables; + + type Quantity_Index_Array is array (Positive range <>) + of Quantity_Index_Type; + + type Quantity_Dependency_Type (Nbr : Natural); + type Quantity_Dependency_Acc is access Quantity_Dependency_Type; + + type Quantity_Dependency_Type (Nbr : Natural) is record + Quantities : Quantity_Index_Array (1 .. Nbr); + end record; + + type Ams_Term (Op : Ams_Operand) is record + Sign : Ams_Sign; + Next : Ams_Term_Acc; + + case Op is + when Op_Quantity => + Quantity : Quantity_Index_Type; + when Op_Vhdl_Expr => + Vhdl_Expr : Iir; + Vhdl_Instance : Block_Instance_Acc; + end case; + end record; + + type Characteristic_Expr is record + Kind : Characteristic_Expr_Kind; + Expr : Ams_Term_Acc; + Tolerance : Tolerance_Index_Type; + Dependencies : Quantity_Dependency_Acc; + end record; + + package Characteristic_Expressions is new Tables + (Table_Index_Type => Characteristic_Expressions_Index, + Table_Component_Type => Characteristic_Expr, + Table_Low_Bound => 1, + Table_Initial => 128); + + type Scalar_Quantity (Kind : Quantity_Kind := Quantity_Reference) is record + Value : Ghdl_F64; + -- The value of the quantity + + Decl : Iir; + Instance : Block_Instance_Acc; + -- Declaration for the quantity + + case Kind is + when Quantity_Reference => + Contribution : Characteristic_Expressions_Index; + when others => + null; + end case; + end record; + + package Scalar_Quantities is new Tables + (Table_Index_Type => Quantity_Index_Type, + Table_Component_Type => Scalar_Quantity, + Table_Low_Bound => 1, + Table_Initial => 128); +end Elaboration.AMS; diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 46eecb5ee..14a915ec2 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -21,14 +21,14 @@ with Str_Table; with Errorout; use Errorout; with Evaluation; with Execution; use Execution; -with Simulation; use Simulation; +--with Simulation; use Simulation; with Iirs_Utils; use Iirs_Utils; with Libraries; with Name_Table; with File_Operation; with Iir_Chains; use Iir_Chains; with Grt.Types; use Grt.Types; -with Simulation.AMS; use Simulation.AMS; +with Elaboration.AMS; use Elaboration.AMS; with Areapools; use Areapools; with Grt.Errors; with Grt.Options; @@ -2817,6 +2817,8 @@ package body Elaboration is -- Use a 'fake' process to execute code during elaboration. Current_Process := No_Process; + Instance_Pool := Global_Pool'Access; + pragma Assert (Is_Empty (Expr_Pool)); -- Find architecture and configuration for the top unit @@ -2866,6 +2868,8 @@ package body Elaboration is Current_Process := null; + Instance_Pool := null; + -- Stop now in case of errors. if Nbr_Errors /= 0 then Grt.Errors.Fatal_Error; diff --git a/src/vhdl/simulate/execution.ads b/src/vhdl/simulate/execution.ads index 533b592f8..40be27391 100644 --- a/src/vhdl/simulate/execution.ads +++ b/src/vhdl/simulate/execution.ads @@ -45,6 +45,13 @@ package Execution is end record; type Process_State_Acc is access all Process_State_Type; + type Process_State_Array is + array (Process_Index_Type range <>) of aliased Process_State_Type; + type Process_State_Array_Acc is access Process_State_Array; + + -- Array containing all processes. + Processes_State: Process_State_Array_Acc; + Simulation_Finished : exception; -- Current process being executed. This is only for the debugger. diff --git a/src/vhdl/simulate/simulation-ams-debugger.adb b/src/vhdl/simulate/simulation-ams-debugger.adb deleted file mode 100644 index 9cdbc75b2..000000000 --- a/src/vhdl/simulate/simulation-ams-debugger.adb +++ /dev/null @@ -1,87 +0,0 @@ --- Interpreter AMS 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 Debugger; use Debugger; -with Iirs_Utils; use Iirs_Utils; -with Ada.Text_IO; use Ada.Text_IO; -with Disp_Vhdl; - -package body Simulation.AMS.Debugger is - procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type) - is - Obj : Scalar_Quantity renames Scalar_Quantities.Table (Quantity); - begin - Disp_Instance_Name (Obj.Instance, True); - Put ('.'); - Put (Image_Identifier (Obj.Decl)); - if Obj.Kind = Quantity_Reference then - Put ("'Ref"); - end if; - end Disp_Quantity_Name; - - procedure Disp_Term (Term : Ams_Term_Acc) is - begin - case Term.Sign is - when Op_Plus => - Put (" + "); - when Op_Minus => - Put (" - "); - end case; - - case Term.Op is - when Op_Quantity => - Disp_Quantity_Name (Term.Quantity); - when Op_Vhdl_Expr => - Disp_Vhdl.Disp_Expression (Term.Vhdl_Expr); - end case; - end Disp_Term; - - procedure Disp_Characteristic_Expression - (Ce : Characteristic_Expressions_Index) - is - Obj : Characteristic_Expr renames - Characteristic_Expressions.Table (Ce); - Expr : Ams_Term_Acc := Obj.Expr; - begin - case Obj.Kind is - when Explicit => - Put ("Explic:"); - when Contribution => - Put ("Contri:"); - when Structural => - Put ("Struct:"); - end case; - - while Expr /= null loop - Disp_Term (Expr); - Expr := Expr.Next; - end loop; - New_Line; - end Disp_Characteristic_Expression; - - procedure Disp_Characteristic_Expressions is - begin - Put_Line ("Characteristic expressions:"); - for I in Characteristic_Expressions.First - .. Characteristic_Expressions.Last - loop - Disp_Characteristic_Expression (I); - end loop; - end Disp_Characteristic_Expressions; -end Simulation.AMS.Debugger; - diff --git a/src/vhdl/simulate/simulation-ams-debugger.ads b/src/vhdl/simulate/simulation-ams-debugger.ads deleted file mode 100644 index 0cfcdedc7..000000000 --- a/src/vhdl/simulate/simulation-ams-debugger.ads +++ /dev/null @@ -1,27 +0,0 @@ --- Interpreter AMS 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. - -package Simulation.AMS.Debugger is - procedure Disp_Quantity_Name (Quantity : Quantity_Index_Type); - - procedure Disp_Characteristic_Expression - (Ce : Characteristic_Expressions_Index); - - procedure Disp_Characteristic_Expressions; -end Simulation.AMS.Debugger; - diff --git a/src/vhdl/simulate/simulation-ams.adb b/src/vhdl/simulate/simulation-ams.adb deleted file mode 100644 index 89e8b8ed2..000000000 --- a/src/vhdl/simulate/simulation-ams.adb +++ /dev/null @@ -1,199 +0,0 @@ --- Interpreter AMS 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 Errorout; use Errorout; - -package body Simulation.AMS is - function Create_Characteristic_Expression - (Kind : Characteristic_Expr_Kind) - return Characteristic_Expressions_Index - is - begin - case Kind is - when Contribution => - Characteristic_Expressions.Append - ((Kind => Contribution, - Expr => null, - Tolerance => 0, - Dependencies => null)); - when others => - raise Program_Error; - end case; - return Characteristic_Expressions.Last; - end Create_Characteristic_Expression; - - function Create_Scalar_Quantity (Kind : Quantity_Kind; - Decl : Iir; - Instance : Block_Instance_Acc) - return Quantity_Index_Type - is - begin - case Kind is - when Quantity_Reference => - Scalar_Quantities.Append - ((Kind => Quantity_Reference, - Value => 0.0, - Decl => Decl, - Instance => Instance, - Contribution => - Create_Characteristic_Expression (Contribution))); - when Quantity_Across => - Scalar_Quantities.Append - ((Kind => Quantity_Across, - Value => 0.0, - Decl => Decl, - Instance => Instance)); - when Quantity_Through => - Scalar_Quantities.Append - ((Kind => Quantity_Through, - Value => 0.0, - Decl => Decl, - Instance => Instance)); - when others => - raise Program_Error; - end case; - return Scalar_Quantities.Last; - end Create_Scalar_Quantity; - - function Create_Scalar_Terminal (Decl : Iir; - Instance : Block_Instance_Acc) - return Terminal_Index_Type - is - begin - -- Simply create the reference quantity for a terminal - return Terminal_Index_Type - (Create_Scalar_Quantity (Quantity_Reference, Decl, Instance)); - end Create_Scalar_Terminal; - - function Get_Terminal_Reference (Terminal : Terminal_Index_Type) - return Quantity_Index_Type is - begin - return Quantity_Index_Type (Terminal); - end Get_Terminal_Reference; - - procedure Add_Characteristic_Expression - (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc) - is - begin - Characteristic_Expressions.Append - ((Kind => Kind, - Expr => Expr, - Tolerance => Default_Tolerance_Index, - Dependencies => null)); - end Add_Characteristic_Expression; - - procedure Compute_Dependencies (Idx : Characteristic_Expressions_Index) - is - package Quantity_Table is new Tables - (Table_Component_Type => Quantity_Index_Type, - Table_Index_Type => Natural, - Table_Low_Bound => 1, - Table_Initial => 16); - - El : Characteristic_Expr renames Characteristic_Expressions.Table (Idx); - Res : Quantity_Dependency_Acc := null; - - procedure Add_Dependency (Block : Block_Instance_Acc; N : Iir) - is - Q : Iir_Value_Literal_Acc; - begin - case Get_Kind (N) is - when Iir_Kinds_Branch_Quantity_Declaration => - Q := Execute_Name (Block, N, True); - Quantity_Table.Append (Q.Quantity); - when Iir_Kind_Simple_Name => - Add_Dependency (Block, Get_Named_Entity (N)); - when Iir_Kinds_Dyadic_Operator => - Add_Dependency (Block, Get_Left (N)); - Add_Dependency (Block, Get_Right (N)); - when Iir_Kinds_Literal => - null; - when others => - Error_Kind ("compute_dependencies", N); - end case; - end Add_Dependency; - - Term : Ams_Term_Acc := El.Expr; - begin - pragma Assert (El.Dependencies = null); - - while Term /= null loop - case Term.Op is - when Op_Quantity => - Quantity_Table.Append (Term.Quantity); - when Op_Vhdl_Expr => - Add_Dependency (Term.Vhdl_Instance, Term.Vhdl_Expr); - end case; - Term := Term.Next; - end loop; - Res := new Quantity_Dependency_Type (Nbr => Quantity_Table.Last); - for I in Quantity_Table.First .. Quantity_Table.Last loop - Res.Quantities (I) := Quantity_Table.Table (I); - end loop; - Quantity_Table.Free; - El.Dependencies := Res; - end Compute_Dependencies; - - function Build (Op : Ams_Sign; - Val : Quantity_Index_Type; - Right : Ams_Term_Acc := null) - return Ams_Term_Acc - is - begin - return new Ams_Term'(Op => Op_Quantity, - Sign => Op, - Next => Right, - Quantity => Val); - end Build; - - function Build (Op : Ams_Sign; - Instance : Block_Instance_Acc; - Expr : Iir; - Right : Ams_Term_Acc := null) - return Ams_Term_Acc - is - begin - return new Ams_Term' - (Op => Op_Vhdl_Expr, - Sign => Op, - Vhdl_Expr => Expr, - Vhdl_Instance => Instance, - Next => Right); - end Build; - - procedure Append_Characteristic_Expression - (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc) - is - Ref : constant Quantity_Index_Type := Get_Terminal_Reference (Terminal); - Ce : constant Characteristic_Expressions_Index := - Scalar_Quantities.Table (Ref).Contribution; - begin - pragma Assert (Expr.Next = null); - Expr.Next := Characteristic_Expressions.Table (Ce).Expr; - Characteristic_Expressions.Table (Ce).Expr := Expr; - end Append_Characteristic_Expression; - - procedure Create_Tables is - begin - for I in Characteristic_Expressions.First - .. Characteristic_Expressions.Last - loop - Compute_Dependencies (I); - end loop; - end Create_Tables; -end Simulation.AMS; diff --git a/src/vhdl/simulate/simulation-ams.ads b/src/vhdl/simulate/simulation-ams.ads deleted file mode 100644 index 8909cf1cc..000000000 --- a/src/vhdl/simulate/simulation-ams.ads +++ /dev/null @@ -1,163 +0,0 @@ --- Interpreter AMS 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 Tables; - -package Simulation.AMS is - -- AMS expressions - -- - -- At many places during elaboration, the LRM defines characteristic - -- expressions that aren't present in source code: - -- * contribution expression (12.3.1.4) - -- * characteristic expression for an across quantity declaration - -- (12.3.1.4) - -- * characteristic expression for simple simultaneous statement (the - -- expression is in the source in that case) (15.1) - -- - -- They are represented using a list of Ams_Expression elements. The value - -- is the sum of each element, using the + or - sign. - - type Ams_Sign is (Op_Plus, Op_Minus); - -- Sign for the operand - - type Ams_Operand is (Op_Quantity, Op_Vhdl_Expr); - -- The operand is one of: - -- Op_Quantity: a quantity - -- Op_Vhdl_Expr: an expression from the design. This expression may contain - -- quantities - - type Ams_Term (<>) is private; - type Ams_Term_Acc is access Ams_Term; - -- A term of a characteristic expression - - type Characteristic_Expr_Kind is - (Explicit, - Contribution, - Structural); - - type Tolerance_Index_Type is new Natural; - Default_Tolerance_Index : constant Tolerance_Index_Type := 0; - -- Tolerance - - type Characteristic_Expressions_Index is new Natural; - - type Quantity_Kind is - (Quantity_Reference, - -- The potential of a terminal. This is an across quantity between the - -- terminal and the reference terminal of the nature. - - Quantity_Across, - Quantity_Through, - Quantity_Free - -- Explicitly declared quantities - ); - - function Create_Scalar_Quantity (Kind : Quantity_Kind; - Decl : Iir; - Instance : Block_Instance_Acc) - return Quantity_Index_Type; - -- Create a new scalar quantity - - function Create_Scalar_Terminal (Decl : Iir; - Instance : Block_Instance_Acc) - return Terminal_Index_Type; - -- Create a new scalar terminal - - function Get_Terminal_Reference (Terminal : Terminal_Index_Type) - return Quantity_Index_Type; - -- Get the reference quantity of a terminal - - procedure Add_Characteristic_Expression - (Kind : Characteristic_Expr_Kind; Expr : Ams_Term_Acc); - -- Add a new characteristic expression - - function Build (Op : Ams_Sign; - Val : Quantity_Index_Type; - Right : Ams_Term_Acc := null) - return Ams_Term_Acc; - function Build (Op : Ams_Sign; - Instance : Block_Instance_Acc; - Expr : Iir; - Right : Ams_Term_Acc := null) - return Ams_Term_Acc; - -- Build a term of a characteristic expression - - procedure Append_Characteristic_Expression - (Terminal : Terminal_Index_Type; Expr : Ams_Term_Acc); - -- Append an expression to the contribution of a terminal - - procedure Create_Tables; -private - type Quantity_Index_Array is array (Positive range <>) - of Quantity_Index_Type; - - type Quantity_Dependency_Type (Nbr : Natural); - type Quantity_Dependency_Acc is access Quantity_Dependency_Type; - - type Quantity_Dependency_Type (Nbr : Natural) is record - Quantities : Quantity_Index_Array (1 .. Nbr); - end record; - - type Ams_Term (Op : Ams_Operand) is record - Sign : Ams_Sign; - Next : Ams_Term_Acc; - - case Op is - when Op_Quantity => - Quantity : Quantity_Index_Type; - when Op_Vhdl_Expr => - Vhdl_Expr : Iir; - Vhdl_Instance : Block_Instance_Acc; - end case; - end record; - - type Characteristic_Expr is record - Kind : Characteristic_Expr_Kind; - Expr : Ams_Term_Acc; - Tolerance : Tolerance_Index_Type; - Dependencies : Quantity_Dependency_Acc; - end record; - - package Characteristic_Expressions is new Tables - (Table_Index_Type => Characteristic_Expressions_Index, - Table_Component_Type => Characteristic_Expr, - Table_Low_Bound => 1, - Table_Initial => 128); - - type Scalar_Quantity (Kind : Quantity_Kind := Quantity_Reference) is record - Value : Ghdl_F64; - -- The value of the quantity - - Decl : Iir; - Instance : Block_Instance_Acc; - -- Declaration for the quantity - - case Kind is - when Quantity_Reference => - Contribution : Characteristic_Expressions_Index; - when others => - null; - end case; - end record; - - package Scalar_Quantities is new Tables - (Table_Index_Type => Quantity_Index_Type, - Table_Component_Type => Scalar_Quantity, - Table_Low_Bound => 1, - Table_Initial => 128); -end Simulation.AMS; diff --git a/src/vhdl/simulate/simulation-main.adb b/src/vhdl/simulate/simulation-main.adb new file mode 100644 index 000000000..d4b26320f --- /dev/null +++ b/src/vhdl/simulate/simulation-main.adb @@ -0,0 +1,1141 @@ +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 Execution; use Execution; +with Ieee.Std_Logic_1164; +with Grt.Main; +with Debugger; use Debugger; +with Debugger.AMS; +with Grt.Errors; +with Grt.Rtis; +with Grt.Processes; +with Grt.Signals; +with Areapools; use Areapools; + +package body 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; + 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 Register_Sensitivity + (Instance : Block_Instance_Acc; List : Iir_List) + is + Sig : Iir; + Marker : Mark_Type; + begin + for J in Natural loop + Sig := Get_Nth_Element (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 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; + 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 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 : 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); + 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; + Val : 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 + (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time)); + when Implicit_Quiet => + Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal + (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time)); + when Implicit_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; + 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 + El : Iir_Element_Declaration; + List : Iir_List; + begin + List := Get_Elements_Declaration_List + (Get_Base_Type (Sig_Type)); + 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); + 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_Register_Kind => Kind_Signal_Register, + Iir_Bus_Kind => Kind_Signal_Bus); + begin + case Get_Kind (Signal) is + when Iir_Kind_Interface_Signal_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; + + 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 Guard_Signal => + Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl); + when Implicit_Stable | Implicit_Quiet | Implicit_Transaction => + Create_Implicit_Signal + (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); + when Implicit_Delayed => + Create_Delayed_Signal (E.Sig, E.Val, + E.Prefix, Std_Time (E.Time)); + when User_Signal => + Create_User_Signal (E.Instance, E.Decl, E.Sig, E.Val); + 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 Simulation.Main; diff --git a/src/vhdl/simulate/simulation-main.ads b/src/vhdl/simulate/simulation-main.ads new file mode 100644 index 000000000..ed8fe5d69 --- /dev/null +++ b/src/vhdl/simulate/simulation-main.ads @@ -0,0 +1,4 @@ +package Simulation.Main is + -- The entry point of the simulator. + procedure Simulation_Entity (Top_Conf : Iir_Design_Unit); +end Simulation.Main; diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb index a3d58bcd7..26c5e9508 100644 --- a/src/vhdl/simulate/simulation.adb +++ b/src/vhdl/simulate/simulation.adb @@ -16,24 +16,13 @@ -- 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 PSL.Nodes; -with PSL.NFAs; -with Trans_Analyzes; with Types; use Types; -with Std_Package; -with Ieee.Std_Logic_1164; -with Debugger; use Debugger; -with Simulation.AMS.Debugger; +with Execution; use Execution; with Areapools; use Areapools; with Grt.Signals; with Grt.Processes; -with Grt.Main; -with Grt.Errors; -with Grt.Rtis; +with Grtlink; +pragma Unreferenced (Grtlink); package body Simulation is @@ -136,18 +125,8 @@ package body Simulation is 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) + 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; @@ -205,10 +184,6 @@ package body Simulation is 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 @@ -608,59 +583,6 @@ package body Simulation is end if; end Execute_Wait_Statement; - 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 Resolver_Read_Mode is (Read_Port, Read_Driver); function Resolver_Read_Value (Sig : Iir_Value_Literal_Acc; @@ -766,57 +688,6 @@ package body Simulation is 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; @@ -841,1051 +712,4 @@ package body Simulation is 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 Register_Sensitivity - (Instance : Block_Instance_Acc; List : Iir_List) - is - Sig : Iir; - Marker : Mark_Type; - begin - for J in Natural loop - Sig := Get_Nth_Element (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 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; - - -- 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 => - 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; - - 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 - 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; - - 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; - 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 : 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); - 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; - Val : 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 - (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time)); - when Implicit_Quiet => - Sig.Sig := Grt.Signals.Ghdl_Create_Quiet_Signal - (To_Ghdl_Value_Ptr (Val.B1'Address), Std_Time (Time)); - when Implicit_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; - 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 - El : Iir_Element_Declaration; - List : Iir_List; - begin - List := Get_Elements_Declaration_List - (Get_Base_Type (Sig_Type)); - 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); - 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_Register_Kind => Kind_Signal_Register, - Iir_Bus_Kind => Kind_Signal_Bus); - begin - case Get_Kind (Signal) is - when Iir_Kind_Interface_Signal_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; - - 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 Guard_Signal => - Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl); - when Implicit_Stable | Implicit_Quiet | Implicit_Transaction => - Create_Implicit_Signal - (E.Sig, E.Val, E.Time, E.Prefix, E.Kind); - when Implicit_Delayed => - Create_Delayed_Signal (E.Sig, E.Val, - E.Prefix, Std_Time (E.Time)); - when User_Signal => - Create_User_Signal (E.Instance, E.Decl, E.Sig, E.Val); - 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 - Warning_Msg_Elab - ("top entity should not have inputs signals", Entity); - 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; - 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 Simulation; diff --git a/src/vhdl/simulate/simulation.ads b/src/vhdl/simulate/simulation.ads index b910b4306..55af11a2e 100644 --- a/src/vhdl/simulate/simulation.ads +++ b/src/vhdl/simulate/simulation.ads @@ -21,15 +21,12 @@ with Grt.Types; use Grt.Types; with Iirs; use Iirs; with Iir_Values; use Iir_Values; with Elaboration; use Elaboration; -with Execution; use Execution; package Simulation is Trace_Simulation : Boolean := False; Disp_Tree : Boolean := False; Disp_Stats : Boolean := False; Disp_Ams : Boolean := False; - Flag_Debugger : Boolean := False; - Flag_Interractive : Boolean := False; type Resolv_Instance_Type is record Func : Iir; @@ -57,16 +54,6 @@ package Simulation is function Guard_Func (Data : System.Address) return Ghdl_B1; pragma Convention (C, Guard_Func); - -- The entry point of the simulator. - procedure Simulation_Entity (Top_Conf : Iir_Design_Unit); - - type Process_State_Array is - array (Process_Index_Type range <>) of aliased Process_State_Type; - type Process_State_Array_Acc is access Process_State_Array; - - -- Array containing all processes. - Processes_State: Process_State_Array_Acc; - function Execute_Signal_Value (Indirect: Iir_Value_Literal_Acc) return Iir_Value_Literal_Acc; @@ -125,4 +112,26 @@ package Simulation is function Execute_Wait_Statement (Instance : Block_Instance_Acc; Stmt: Iir_Wait_Statement) return Boolean; +private + 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; + + 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); end Simulation; diff --git a/src/vhdl/translate/trans-preelab.adb b/src/vhdl/translate/trans-preelab.adb new file mode 100644 index 000000000..944fa8e9b --- /dev/null +++ b/src/vhdl/translate/trans-preelab.adb @@ -0,0 +1,58 @@ +-- Build ortho structures from iir_values +-- Copyright (C) 2016 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Configuration; use Configuration; +with Iirs_Utils; use Iirs_Utils; +with Errorout; use Errorout; +with Elaboration; + +package body Trans.Preelab is + -- Primary unit + secondary unit (architecture name which may be null) + -- to elaborate. + procedure Pre_Elaborate (Primary : String; + Secondary : String; + Filelist : String; + Whole : Boolean) + is + pragma Unreferenced (Filelist, Whole); + Config : Iir_Design_Unit; + Config_Lib : Iir_Configuration_Declaration; + Entity : Iir_Entity_Declaration; + -- Arch : Iir_Architecture_Body; + begin + Config := Configure (Primary, Secondary); + if Config = Null_Iir then + return; + end if; + + Config_Lib := Get_Library_Unit (Config); + Entity := Get_Entity (Config_Lib); + -- Arch := Strip_Denoting_Name + -- (Get_Block_Specification (Get_Block_Configuration (Config_Lib))); + + -- Be sure the entity can be at the top of a design. + Check_Entity_Declaration_Top (Entity); + + -- Return now in case of errors. + if Nbr_Errors /= 0 then + return; + end if; + + Elaboration.Elaborate_Design (Config); + end Pre_Elaborate; +end Trans.Preelab; diff --git a/src/vhdl/translate/trans-preelab.ads b/src/vhdl/translate/trans-preelab.ads new file mode 100644 index 000000000..a54a56864 --- /dev/null +++ b/src/vhdl/translate/trans-preelab.ads @@ -0,0 +1,26 @@ +-- Build ortho structures from iir_values +-- Copyright (C) 2016 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 GCC; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package Trans.Preelab is + -- Primary unit + secondary unit (architecture name which may be null) + -- to elaborate. + procedure Pre_Elaborate (Primary : String; + Secondary : String; + Filelist : String; + Whole : Boolean); +end Trans.Preelab; -- cgit v1.2.3