diff options
author | Tristan Gingold <tgingold@free.fr> | 2016-02-12 05:53:22 +0100 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2016-02-14 13:52:33 +0100 |
commit | 2c88f7c0f5a9859eeb118147444afbd47c71c2a8 (patch) | |
tree | 57ac7d5a8585649939f6ccfbce0d1350e699ccf7 /src | |
parent | 48e27ae110b44f1feb73f906e322e8d59c7c2c98 (diff) | |
download | ghdl-2c88f7c0f5a9859eeb118147444afbd47c71c2a8.tar.gz ghdl-2c88f7c0f5a9859eeb118147444afbd47c71c2a8.tar.bz2 ghdl-2c88f7c0f5a9859eeb118147444afbd47c71c2a8.zip |
simul: preliminary work to support PSL.
Diffstat (limited to 'src')
-rw-r--r-- | src/vhdl/simulate/annotations.adb | 18 | ||||
-rw-r--r-- | src/vhdl/simulate/annotations.ads | 6 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.adb | 121 | ||||
-rw-r--r-- | src/vhdl/simulate/elaboration.ads | 19 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.adb | 65 | ||||
-rw-r--r-- | src/vhdl/simulate/execution.ads | 7 | ||||
-rw-r--r-- | src/vhdl/simulate/simulation.adb | 192 |
7 files changed, 323 insertions, 105 deletions
diff --git a/src/vhdl/simulate/annotations.adb b/src/vhdl/simulate/annotations.adb index e11bfed2d..ef85321ba 100644 --- a/src/vhdl/simulate/annotations.adb +++ b/src/vhdl/simulate/annotations.adb @@ -95,6 +95,10 @@ package body Annotations is Info := new Sim_Info_Type'(Kind => Kind_Quantity, Obj_Scope => Current_Scope, Slot => Block_Info.Nbr_Objects); + when Kind_PSL => + Info := new Sim_Info_Type'(Kind => Kind_PSL, + Obj_Scope => Current_Scope, + Slot => Block_Info.Nbr_Objects); when Kind_Environment => Info := new Sim_Info_Type'(Kind => Kind_Environment, Env_Slot => Block_Info.Nbr_Objects, @@ -954,6 +958,14 @@ package body Annotations is when Iir_Kind_For_Generate_Statement => Annotate_For_Generate_Statement (Block_Info, El); + when Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Declaration => + null; + + when Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Psl_Assert_Statement => + Create_Object_Info (Block_Info, El, Kind_PSL); + when Iir_Kind_Simple_Simultaneous_Statement => null; @@ -1253,7 +1265,8 @@ package body Annotations is when Kind_Object | Kind_Signal | Kind_File | Kind_Terminal | Kind_Quantity - | Kind_Environment => + | Kind_Environment + | Kind_PSL => Put_Line ("-- slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Image (Info.Obj_Scope)); when Kind_Scalar_Type @@ -1290,7 +1303,8 @@ package body Annotations is Put_Line ("nbr instance:" & Instance_Slot_Type'Image (Info.Nbr_Instances)); when Kind_Object | Kind_Signal | Kind_File - | Kind_Terminal | Kind_Quantity | Kind_Environment => + | Kind_Terminal | Kind_Quantity | Kind_Environment + | Kind_PSL => Put_Line ("slot:" & Object_Slot_Type'Image (Info.Slot) & ", scope:" & Image (Info.Obj_Scope)); when Kind_Range => diff --git a/src/vhdl/simulate/annotations.ads b/src/vhdl/simulate/annotations.ads index 3c605373a..1f95d15cf 100644 --- a/src/vhdl/simulate/annotations.ads +++ b/src/vhdl/simulate/annotations.ads @@ -46,7 +46,8 @@ package Annotations is Kind_Object, Kind_Signal, Kind_Range, Kind_File, Kind_Terminal, Kind_Quantity, - Kind_Environment); + Kind_Environment, + Kind_PSL); type Sim_Info_Type (Kind: Sim_Info_Kind); type Sim_Info_Acc is access all Sim_Info_Type; @@ -114,7 +115,8 @@ package Annotations is | Kind_Range | Kind_File | Kind_Terminal - | Kind_Quantity => + | Kind_Quantity + | Kind_PSL => -- Block in which this object is declared in. Obj_Scope : Scope_Type; diff --git a/src/vhdl/simulate/elaboration.adb b/src/vhdl/simulate/elaboration.adb index 1c3b66a80..963b17d8c 100644 --- a/src/vhdl/simulate/elaboration.adb +++ b/src/vhdl/simulate/elaboration.adb @@ -17,7 +17,6 @@ -- 02111-1307, USA. with Ada.Text_IO; -with Types; use Types; with Str_Table; with Errorout; use Errorout; with Evaluation; @@ -65,6 +64,54 @@ package body Elaboration is Port_Map : Iir) return Block_Instance_Acc; + procedure Create_Object + (Instance : Block_Instance_Acc; + Slot : Object_Slot_Type; + Num : Object_Slot_Type := 1) is + begin + -- Check elaboration order. + -- Note: this is not done for package since objects from package are + -- commons (same scope), and package annotation order can be different + -- from package elaboration order (eg: body). + if Slot /= Instance.Elab_Objects + 1 + or else Instance.Objects (Slot) /= null + then + Error_Msg_Elab ("bad elaboration order"); + raise Internal_Error; + end if; + Instance.Elab_Objects := Slot + Num - 1; + end Create_Object; + + procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) + is + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + begin + Create_Object (Instance, Slot, 1); + end Create_Object; + + procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir) + is + Info : constant Sim_Info_Acc := Get_Info (Decl); + Slot : constant Object_Slot_Type := Info.Slot; + begin + if Slot /= Instance.Elab_Objects + or else Info.Obj_Scope /= Instance.Block_Scope + then + Error_Msg_Elab ("bad destroy order"); + raise Internal_Error; + end if; + -- Clear the slot (this is necessary for ranges). + Instance.Objects (Slot) := null; + Instance.Elab_Objects := Slot - 1; + end Destroy_Object; + + procedure Create_Signal (Instance : Block_Instance_Acc; Decl : Iir) + is + Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; + begin + Create_Object (Instance, Slot, 2); + end Create_Signal; + -- Create a new signal, using DEFAULT as initial value. -- Set its number. procedure Elaborate_Signal (Block: Block_Instance_Acc; @@ -624,59 +671,6 @@ package body Elaboration is end case; end Init_To_Default; - procedure Create_Object - (Instance : Block_Instance_Acc; Slot : Object_Slot_Type) is - begin - -- Check elaboration order. - -- Note: this is not done for package since objects from package are - -- commons (same scope), and package annotation order can be different - -- from package elaboration order (eg: body). - if Slot /= Instance.Elab_Objects + 1 - or else Instance.Objects (Slot) /= null - then - Error_Msg_Elab ("bad elaboration order"); - raise Internal_Error; - end if; - Instance.Elab_Objects := Slot; - end Create_Object; - - procedure Create_Object (Instance : Block_Instance_Acc; Decl : Iir) - is - Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - begin - Create_Object (Instance, Slot); - end Create_Object; - - procedure Destroy_Object (Instance : Block_Instance_Acc; Decl : Iir) - is - Info : constant Sim_Info_Acc := Get_Info (Decl); - Slot : constant Object_Slot_Type := Info.Slot; - begin - if Slot /= Instance.Elab_Objects - or else Info.Obj_Scope /= Instance.Block_Scope - then - Error_Msg_Elab ("bad destroy order"); - raise Internal_Error; - end if; - -- Clear the slot (this is necessary for ranges). - Instance.Objects (Slot) := null; - Instance.Elab_Objects := Slot - 1; - end Destroy_Object; - - procedure Create_Signal (Instance : Block_Instance_Acc; Decl : Iir) - is - Slot : constant Object_Slot_Type := Get_Info (Decl).Slot; - begin - if Slot /= Instance.Elab_Objects + 1 - or else Instance.Objects (Slot) /= null - then - Error_Msg_Elab ("bad elaboration order", Decl); - raise Internal_Error; - end if; - -- One slot is reserved for default value - Instance.Elab_Objects := Slot + 1; - end Create_Signal; - function Create_Terminal_Object (Block: Block_Instance_Acc; Decl : Iir; Def: Iir) @@ -1718,6 +1712,17 @@ package body Elaboration is -- just before simulation. end Elaborate_Process_Statement; + procedure Elaborate_Psl_Directive + (Instance : Block_Instance_Acc; Stmt : Iir) + is + begin + -- Create the state vector (and initialize it). + -- Create the bool flag (for cover) + -- Create the process + -- Create the finalizer + PSL_Table.Append (PSL_Entry'(Instance, Stmt, null, False)); + end Elaborate_Psl_Directive; + -- LRM93 §12.4 Elaboration of a Statement Part. procedure Elaborate_Statement_Part (Instance : Block_Instance_Acc; Stmt_Chain: Iir) @@ -1755,6 +1760,14 @@ package body Elaboration is Build (Op_Minus, Instance, Get_Simultaneous_Left (Stmt)))); + when Iir_Kind_Psl_Default_Clock + | Iir_Kind_Psl_Declaration => + null; + + when Iir_Kind_Psl_Cover_Statement + | Iir_Kind_Psl_Assert_Statement => + Elaborate_Psl_Directive (Instance, Stmt); + when others => Error_Kind ("elaborate_statement_part", Stmt); end case; diff --git a/src/vhdl/simulate/elaboration.ads b/src/vhdl/simulate/elaboration.ads index dd2da32be..b7ff6b70c 100644 --- a/src/vhdl/simulate/elaboration.ads +++ b/src/vhdl/simulate/elaboration.ads @@ -18,6 +18,7 @@ with Ada.Unchecked_Deallocation; with Tables; +with Types; use Types; with Iirs; use Iirs; with Iir_Values; use Iir_Values; with Grt.Types; @@ -221,4 +222,22 @@ package Elaboration is Table_Index_Type => Environment_Index_Type, Table_Low_Bound => 1, Table_Initial => 2); + + type Boolean_Vector is array (Nat32 range <>) of Boolean; + type Boolean_Vector_Acc is access Boolean_Vector; + + type PSL_Entry is record + Instance : Block_Instance_Acc; + Stmt : Iir; + States : Boolean_Vector_Acc; + Done : Boolean; + end record; + + type PSL_Index_Type is new Natural; + + package PSL_Table is new Tables + (Table_Component_Type => PSL_Entry, + Table_Index_Type => PSL_Index_Type, + Table_Low_Bound => 1, + Table_Initial => 2); end Elaboration; diff --git a/src/vhdl/simulate/execution.adb b/src/vhdl/simulate/execution.adb index 692289a57..9c6da7731 100644 --- a/src/vhdl/simulate/execution.adb +++ b/src/vhdl/simulate/execution.adb @@ -58,7 +58,8 @@ package body Execution is procedure Update_Next_Statement (Proc : Process_State_Acc); -- Display a message when an assertion has failed. - procedure Execute_Failed_Assertion (Report : String; + procedure Execute_Failed_Assertion (Msg : String; + Report : String; Severity : Natural; Stmt: Iir); @@ -547,7 +548,8 @@ package body Execution is use Grt.Std_Logic_1164; begin Execute_Failed_Assertion - ("STD_LOGIC_1164: '-' operand for matching ordering operator", + ("assertion", + "STD_LOGIC_1164: '-' operand for matching ordering operator", 2, Loc); end Assert_Std_Ulogic_Dc; @@ -4102,7 +4104,8 @@ package body Execution is -- REPORT is the value (string) to display, or null to use default message. -- SEVERITY is the severity or null to use default (error). -- STMT is used to display location. - procedure Execute_Failed_Assertion (Report : String; + procedure Execute_Failed_Assertion (Msg : String; + Report : String; Severity : Natural; Stmt: Iir) is begin @@ -4113,7 +4116,9 @@ package body Execution is Put (Standard_Error, Disp_Location (Stmt)); -- 1: an indication that this message is from an assertion. - Put (Standard_Error, "(assertion "); + Put (Standard_Error, '('); + Put (Standard_Error, Msg); + Put (Standard_Error, ' '); -- 2: the value of the severity level. case Severity is @@ -4144,30 +4149,12 @@ package body Execution is end if; end Execute_Failed_Assertion; - procedure Execute_Failed_Assertion (Report : Iir_Value_Literal_Acc; - Severity : Natural; - Stmt: Iir) is - begin - if Report /= null then - declare - Msg : String (1 .. Natural (Report.Val_Array.Len)); - begin - for I in Report.Val_Array.V'Range loop - Msg (Positive (I)) := - Character'Val (Report.Val_Array.V (I).E8); - end loop; - Execute_Failed_Assertion (Msg, Severity, Stmt); - end; - else - -- The default value for the message string is: - -- "Assertion violation.". - -- Does the message string include quotes ? - Execute_Failed_Assertion ("Assertion violation.", Severity, Stmt); - end if; - end Execute_Failed_Assertion; - - procedure Execute_Report_Statement - (Instance: Block_Instance_Acc; Stmt: Iir; Default_Severity : Natural) + procedure Execute_Failed_Assertion + (Instance: Block_Instance_Acc; + Label : String; + Stmt : Iir; + Default_Msg : String; + Default_Severity : Natural) is Expr: Iir; Report, Severity_Lit: Iir_Value_Literal_Acc; @@ -4188,9 +4175,21 @@ package body Execution is else Severity := Default_Severity; end if; - Execute_Failed_Assertion (Report, Severity, Stmt); + if Report /= null then + declare + Msg : String (1 .. Natural (Report.Val_Array.Len)); + begin + for I in Report.Val_Array.V'Range loop + Msg (Positive (I)) := + Character'Val (Report.Val_Array.V (I).E8); + end loop; + Execute_Failed_Assertion (Label, Msg, Severity, Stmt); + end; + else + Execute_Failed_Assertion (Label, Default_Msg, Severity, Stmt); + end if; Release (Marker, Expr_Pool); - end Execute_Report_Statement; + end Execute_Failed_Assertion; function Is_In_Choice (Instance: Block_Instance_Acc; @@ -4783,13 +4782,15 @@ package body Execution is Res := Execute_Condition (Instance, Get_Assertion_Condition (Stmt)); if not Res then - Execute_Report_Statement (Instance, Stmt, 2); + Execute_Failed_Assertion (Instance, "assertion", Stmt, + "Assertion violation.", 2); end if; end; Update_Next_Statement (Proc); when Iir_Kind_Report_Statement => - Execute_Report_Statement (Instance, Stmt, 0); + Execute_Failed_Assertion (Instance, "report", Stmt, + "Assertion violation.", 0); Update_Next_Statement (Proc); when Iir_Kind_Variable_Assignment_Statement => diff --git a/src/vhdl/simulate/execution.ads b/src/vhdl/simulate/execution.ads index 17d05f4a0..080ee59ca 100644 --- a/src/vhdl/simulate/execution.ads +++ b/src/vhdl/simulate/execution.ads @@ -88,6 +88,13 @@ package Execution is Expr_Type : Iir) return Iir_Value_Literal_Acc; + procedure Execute_Failed_Assertion + (Instance: Block_Instance_Acc; + Label : String; + Stmt : Iir; + Default_Msg : String; + Default_Severity : Natural); + function Execute_Resolution_Function (Block: Block_Instance_Acc; Imp : Iir; Arr : Iir_Value_Literal_Acc) return Iir_Value_Literal_Acc; diff --git a/src/vhdl/simulate/simulation.adb b/src/vhdl/simulate/simulation.adb index 2d2b1007b..b02d47dd2 100644 --- a/src/vhdl/simulate/simulation.adb +++ b/src/vhdl/simulate/simulation.adb @@ -20,8 +20,12 @@ 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 Areapools; use Areapools; @@ -921,6 +925,21 @@ package body Simulation is 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; @@ -958,21 +977,7 @@ package body Simulation is end if; -- Register sensitivity. - declare - Sig_List : Iir_List; - Sig : Iir; - Marker : Mark_Type; - begin - Sig_List := Get_Sensitivity_List (El); - for J in Natural loop - Sig := Get_Nth_Element (Sig_List, J); - exit when Sig = Null_Iir; - Mark (Marker, Expr_Pool); - Process_Add_Sensitivity - (Execute_Name (Instance, Sig, True)); - Release (Marker, Expr_Pool); - end loop; - end; + Register_Sensitivity (Instance, Get_Sensitivity_List (El)); when Iir_Kind_Process_Statement => if Get_Postponed_Flag (El) then @@ -1031,6 +1036,162 @@ package body Simulation is 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); + + -- 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; @@ -1690,6 +1851,7 @@ package body Simulation is Create_Connects; Create_Disconnections; Create_Processes; + Create_PSL; if Disp_Tree then Debugger.Disp_Instances_Tree; |