diff options
| author | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2008-09-06 03:24:23 +0000 |
|---|---|---|
| committer | gingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7> | 2008-09-06 03:24:23 +0000 |
| commit | db0dacf3b4a07f26c317d7cda0c6f8882e511f88 (patch) | |
| tree | 5a4e45f543f458deba660baed7d0aacfe2751322 | |
| parent | b42e36e23f23a0d27e7b08d6cb4461237720de3b (diff) | |
| download | ghdl-db0dacf3b4a07f26c317d7cda0c6f8882e511f88.tar.gz ghdl-db0dacf3b4a07f26c317d7cda0c6f8882e511f88.tar.bz2 ghdl-db0dacf3b4a07f26c317d7cda0c6f8882e511f88.zip | |
New feature: all-sensitized processes (for vhdl 2008)
85 files changed, 665 insertions, 156 deletions
diff --git a/back_end.adb b/back_end.adb index 7efb15e79..81bc20732 100644 --- a/back_end.adb +++ b/back_end.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Flags; use Flags; @@ -31,6 +31,8 @@ package body Back_End is return Image_Identifier (Library) & "-obj87.cf"; when Vhdl_93c | Vhdl_93 | Vhdl_00 | Vhdl_02 => return Image_Identifier (Library) & "-obj93.cf"; + when Vhdl_08 => + return Image_Identifier (Library) & "-obj08.cf"; end case; end Default_Library_To_File_Name; end Back_End; diff --git a/back_end.ads b/back_end.ads index 43ec34893..e3804def8 100644 --- a/back_end.ads +++ b/back_end.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Exceptions; use Ada.Exceptions; @@ -1,5 +1,5 @@ -- Canonicalization pass --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- Copyright (C) 2002, 2003, 2004, 2005, 2008 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 @@ -12,7 +12,7 @@ -- 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 +-- 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; @@ -273,6 +273,226 @@ package body Canon is end case; end Canon_Extract_Sensitivity; + procedure Canon_Extract_Sensitivity_If_Not_Null + (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False) is + begin + if Expr /= Null_Iir then + Canon_Extract_Sensitivity (Expr, Sensitivity_List, Is_Target); + end if; + end Canon_Extract_Sensitivity_If_Not_Null; + + procedure Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Chain : Iir; List : Iir_List) + is + Stmt : Iir; + begin + Stmt := Chain; + while Stmt /= Null_Iir loop + case Get_Kind (Stmt) is + when Iir_Kind_Assertion_Statement => + -- LRM08 11.3 + -- * For each assertion, report, next, exit or return + -- statement, apply the rule of 10.2 to each expression + -- in the statement, and construct the union of the + -- resulting sets. + Canon_Extract_Sensitivity + (Get_Assertion_Condition (Stmt), List); + Canon_Extract_Sensitivity + (Get_Severity_Expression (Stmt), List); + Canon_Extract_Sensitivity + (Get_Report_Expression (Stmt), List); + when Iir_Kind_Report_Statement => + -- LRM08 11.3 + -- See assertion_statement case. + Canon_Extract_Sensitivity + (Get_Severity_Expression (Stmt), List); + Canon_Extract_Sensitivity + (Get_Report_Expression (Stmt), List); + when Iir_Kind_Next_Statement + | Iir_Kind_Exit_Statement => + -- LRM08 11.3 + -- See assertion_statement case. + Canon_Extract_Sensitivity + (Get_Condition (Stmt), List); + when Iir_Kind_Return_Statement => + -- LRM08 11.3 + -- See assertion_statement case. + Canon_Extract_Sensitivity_If_Not_Null + (Get_Expression (Stmt), List); + when Iir_Kind_Variable_Assignment_Statement => + -- LRM08 11.3 + -- * For each assignment statement, apply the rule of 10.2 to + -- each expression occuring in the assignment, including any + -- expressions occuring in the index names or slice names in + -- the target, and construct the union of the resulting sets. + Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); + Canon_Extract_Sensitivity (Get_Expression (Stmt), List, False); + when Iir_Kind_Signal_Assignment_Statement => + -- LRM08 11.3 + -- See variable assignment statement case. + Canon_Extract_Sensitivity (Get_Target (Stmt), List, True); + Canon_Extract_Sensitivity_If_Not_Null + (Get_Reject_Time_Expression (Stmt), List); + declare + We: Iir_Waveform_Element; + begin + We := Get_Waveform_Chain (Stmt); + while We /= Null_Iir loop + Canon_Extract_Sensitivity (Get_We_Value (We), List); + We := Get_Chain (We); + end loop; + end; + when Iir_Kind_If_Statement => + -- LRM08 11.3 + -- * For each if statement, apply the rule of 10.2 to the + -- condition and apply this rule recursively to each + -- sequence of statements within the if statement, and + -- construct the union of the resuling sets. + declare + El1 : Iir := Stmt; + Cond : Iir; + begin + loop + Cond := Get_Condition (El1); + if Cond /= Null_Iir then + Canon_Extract_Sensitivity (Cond, List); + end if; + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Sequential_Statement_Chain (El1), List); + El1 := Get_Else_Clause (El1); + exit when El1 = Null_Iir; + end loop; + end; + when Iir_Kind_Case_Statement => + -- LRM08 11.3 + -- * For each case statement, apply the rule of 10.2 to the + -- expression and apply this rule recursively to each + -- sequence of statements within the case statement, and + -- construct the union of the resulting sets. + Canon_Extract_Sensitivity (Get_Expression (Stmt), List); + declare + Choice: Iir; + begin + Choice := Get_Case_Statement_Alternative_Chain (Stmt); + while Choice /= Null_Iir loop + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Associated (Choice), List); + Choice := Get_Chain (Choice); + end loop; + end; + when Iir_Kind_While_Loop_Statement => + -- LRM08 11.3 + -- * For each loop statement, apply the rule of 10.2 to each + -- expression in the iteration scheme, if present, and apply + -- this rule recursively to the sequence of statements within + -- the loop statement, and construct the union of the + -- resulting sets. + Canon_Extract_Sensitivity_If_Not_Null + (Get_Condition (Stmt), List); + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Sequential_Statement_Chain (Stmt), List); + when Iir_Kind_For_Loop_Statement => + -- LRM08 11.3 + -- See loop statement case. + declare + It : constant Iir := Get_Iterator_Scheme (Stmt); + It_Type : constant Iir := Get_Type (It); + Rng : constant Iir := Get_Range_Constraint (It_Type); + begin + if Get_Kind (Rng) = Iir_Kind_Range_Expression then + Canon_Extract_Sensitivity (Rng, List); + end if; + end; + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Sequential_Statement_Chain (Stmt), List); + when Iir_Kind_Null_Statement => + -- LRM08 11.3 + -- ? + null; + when Iir_Kind_Procedure_Call_Statement => + -- LRM08 11.3 + -- * For each procedure call statement, apply the rule of 10.2 + -- to each actual designator (other than OPEN) associated + -- with each formal parameter of mode IN or INOUT, and + -- construct the union of the resulting sets. + declare + Param : Iir; + begin + Param := Get_Parameter_Association_Chain + (Get_Procedure_Call (Stmt)); + while Param /= Null_Iir loop + if (Get_Kind (Param) + = Iir_Kind_Association_Element_By_Expression) + and then (Get_Mode (Get_Base_Name (Get_Formal (Param))) + /= Iir_Out_Mode) + then + Canon_Extract_Sensitivity (Get_Actual (Param), List); + end if; + Param := Get_Chain (Param); + end loop; + end; + when others => + Error_Kind + ("canon_extract_sequential_statement_chain_sensitivity", + Stmt); + end case; + Stmt := Get_Chain (Stmt); + end loop; + end Canon_Extract_Sequential_Statement_Chain_Sensitivity; + + procedure Canon_Extract_Sensitivity_From_Callees + (Callees_List : Iir_List; Sensitivity_List : Iir_List) + is + Callee : Iir; + begin + -- LRM08 11.3 + -- Moreover, for each subprogram for which the process is a parent + -- (see 4.3), the sensitivity list includes members of the set + -- constructed by apply the preceding rule to the statements of the + -- subprogram, but excluding the members that denote formal signal + -- parameters or members of formal signal parameters of the subprogram + -- or any of its parents. + if Callees_List = Null_Iir_List then + return; + end if; + for I in Natural loop + Callee := Get_Nth_Element (Callees_List, I); + exit when Callee = Null_Iir; + if not Get_Seen_Flag (Callee) then + Set_Seen_Flag (Callee, True); + case Get_All_Sensitized_State (Callee) is + when Read_Signal => + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Sequential_Statement_Chain + (Get_Subprogram_Body (Callee)), + Sensitivity_List); + Canon_Extract_Sensitivity_From_Callees + (Get_Callees_List (Callee), Sensitivity_List); + when No_Signal => + null; + when Unknown | Invalid_Signal => + raise Internal_Error; + end case; + end if; + end loop; + end Canon_Extract_Sensitivity_From_Callees; + + function Canon_Extract_Process_Sensitivity + (Proc : Iir_Sensitized_Process_Statement) + return Iir_List + is + Res : Iir_List; + begin + Res := Create_Iir_List; + Canon_Extract_Sequential_Statement_Chain_Sensitivity + (Get_Sequential_Statement_Chain (Proc), Res); + Canon_Extract_Sensitivity_From_Callees + (Get_Callees_List (Proc), Res); + Set_Seen_Flag (Proc, True); + Clear_Seen_Flag (Proc); + return Res; + end Canon_Extract_Process_Sensitivity; + -- function Make_Aggregate (Array_Type : Iir_Array_Type_Definition; El : Iir) -- return Iir_Aggregate -- is @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; @@ -58,4 +58,10 @@ package Canon is -- as indexes of an indexed name) are added. procedure Canon_Extract_Sensitivity (Expr: Iir; Sensitivity_List: Iir_List; Is_Target: Boolean := False); + + -- Compute the sensitivity list of all-sensitized process PROC. + -- Used for vhdl 08. + function Canon_Extract_Process_Sensitivity + (Proc : Iir_Sensitized_Process_Statement) + return Iir_List; end Canon; diff --git a/configuration.adb b/configuration.adb index aabce5026..0aa3ad2ab 100644 --- a/configuration.adb +++ b/configuration.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Libraries; diff --git a/configuration.ads b/configuration.ads index 081099876..9b5ea9b3e 100644 --- a/configuration.ads +++ b/configuration.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/disp_tree.adb b/disp_tree.adb index 4fc44166d..7e72a125c 100644 --- a/disp_tree.adb +++ b/disp_tree.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; @@ -1018,7 +1018,8 @@ package body Disp_Tree is end if; Header ("wait_state:", False); Disp_State (Get_Wait_State (Tree)); - + Header ("all_sensitized_state: " & Iir_All_Sensitized'Image + (Get_All_Sensitized_State (Tree))); Header ("subprogram_depth:", False); Disp_Depth (Get_Subprogram_Depth (Tree)); Header ("subprogram_body:"); diff --git a/disp_tree.ads b/disp_tree.ads index 6e3e3d714..f1bdf9bea 100644 --- a/disp_tree.ads +++ b/disp_tree.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/disp_vhdl.adb b/disp_vhdl.adb index 9b09cd49e..57b2d4da6 100644 --- a/disp_vhdl.adb +++ b/disp_vhdl.adb @@ -12,7 +12,7 @@ -- 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 +-- 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. diff --git a/disp_vhdl.ads b/disp_vhdl.ads index 592c786a9..6bac04e70 100644 --- a/disp_vhdl.ads +++ b/disp_vhdl.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/errorout.adb b/errorout.adb index 8128dd117..32b124960 100644 --- a/errorout.adb +++ b/errorout.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; diff --git a/errorout.ads b/errorout.ads index 8707d2d7f..f75374b69 100644 --- a/errorout.ads +++ b/errorout.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/evaluation.adb b/evaluation.adb index 2323691b7..c54300304 100644 --- a/evaluation.adb +++ b/evaluation.adb @@ -12,7 +12,7 @@ -- 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 +-- 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; diff --git a/evaluation.ads b/evaluation.ads index a9ae748f0..a54ead36c 100644 --- a/evaluation.ads +++ b/evaluation.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/files_map.adb b/files_map.adb index e92cbc788..c73ffbe6c 100644 --- a/files_map.adb +++ b/files_map.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Interfaces.C; diff --git a/files_map.ads b/files_map.ads index 4bcf8772d..a8bd64616 100644 --- a/files_map.ads +++ b/files_map.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; @@ -12,7 +12,7 @@ -- 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 +-- 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. @@ -27,6 +27,8 @@ package body Flags is | Vhdl_00 | Vhdl_02 => Flag_String (1 .. 2) := "93"; + when Vhdl_08 => + Flag_String (1 .. 2) := "08"; end case; if Flag_Integer_64 then Flag_String (3) := 'I'; @@ -12,7 +12,7 @@ -- 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 +-- 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. @@ -25,7 +25,8 @@ package Flags is -- List of vhdl standards. -- VHDL_93c is vhdl_93 with backward compatibility with 87 (file). - type Vhdl_Std_Type is (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02); + type Vhdl_Std_Type is + (Vhdl_87, Vhdl_93c, Vhdl_93, Vhdl_00, Vhdl_02, Vhdl_08); -- Standard accepted. Vhdl_Std: Vhdl_Std_Type := Vhdl_93c; diff --git a/ieee-std_logic_1164.adb b/ieee-std_logic_1164.adb index e7150964d..561ed6535 100644 --- a/ieee-std_logic_1164.adb +++ b/ieee-std_logic_1164.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/ieee-std_logic_1164.ads b/ieee-std_logic_1164.ads index e1325c378..b1f14f272 100644 --- a/ieee-std_logic_1164.ads +++ b/ieee-std_logic_1164.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb index bf9ab8221..d489d99cb 100644 --- a/ieee-vital_timing.adb +++ b/ieee-vital_timing.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/ieee-vital_timing.ads b/ieee-vital_timing.ads index b67271c19..7abda2eba 100644 --- a/ieee-vital_timing.ads +++ b/ieee-vital_timing.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/iir_chain_handling.adb b/iir_chain_handling.adb index b660d5d2d..1e70a366a 100644 --- a/iir_chain_handling.adb +++ b/iir_chain_handling.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 body Iir_Chain_Handling is diff --git a/iir_chain_handling.ads b/iir_chain_handling.ads index 0ba70ae66..3865e9b65 100644 --- a/iir_chain_handling.ads +++ b/iir_chain_handling.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/iir_chains.adb b/iir_chains.adb index 984ab9909..ef47b6485 100644 --- a/iir_chains.adb +++ b/iir_chains.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 body Iir_Chains is diff --git a/iir_chains.ads b/iir_chains.ads index 45da27fa6..95b2f755b 100644 --- a/iir_chains.ads +++ b/iir_chains.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Conversion; @@ -4156,6 +4156,30 @@ package body Iirs is Set_State1 (Proc, Tri_State_Type'Pos (State)); end Set_Wait_State; + procedure Check_Kind_For_All_Sensitized_State (Target : Iir) is + begin + case Get_Kind (Target) is + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + null; + when others => + Failed ("All_Sensitized_State", Target); + end case; + end Check_Kind_For_All_Sensitized_State; + + function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized is + begin + Check_Kind_For_All_Sensitized_State (Proc); + return Iir_All_Sensitized'Val (Get_State3 (Proc)); + end Get_All_Sensitized_State; + + procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized) + is + begin + Check_Kind_For_All_Sensitized_State (Proc); + Set_State3 (Proc, Iir_All_Sensitized'Pos (State)); + end Set_All_Sensitized_State; + procedure Check_Kind_For_Seen_Flag (Target : Iir) is begin case Get_Kind (Target) is diff --git a/iirs.adb.in b/iirs.adb.in index 2bde117c8..06a0e58cc 100644 --- a/iirs.adb.in +++ b/iirs.adb.in @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Conversion; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Deallocation; @@ -865,7 +865,7 @@ package Iirs is -- -- Subprogram declaration. -- - -- The declaration containing this type declaration. + -- The declaration containing this subrogram declaration. -- Get/Set_Parent (Field0) -- -- Only for Iir_Kind_Function_Declaration: @@ -913,10 +913,12 @@ package Iirs is -- Only for Iir_Kind_Function_Declaration: -- Get/Set_Resolution_Function_Flag (Flag7) -- + -- Get/Set_Wait_State (State1) + -- -- Only for Iir_Kind_Procedure_Declaration: -- Get/Set_Purity_State (State2) -- - -- Get/Set_Wait_State (State1) + -- Get/Set_All_Sensitized_State (State3) -- Iir_Kind_Function_Body (Short) -- Iir_Kind_Procedure_Body (Short) @@ -2973,6 +2975,23 @@ package Iirs is -- PURE. type Iir_Pure_State is (Unknown, Pure, Maybe_Impure, Impure); + -- State of subprograms for validity of use in all-sensitized process. + -- INVALID_SIGNAL means that the subprogram is in a package and + -- reads a signal or that the subprogram calls (indirectly) such + -- a subprogram. In this case, the subprogram cannot be called from + -- an all-sensitized process. + -- READ_SIGNAL means that the subprogram reads a signal and is defined + -- in an entity or an architecture or that the subprogram calls + -- (indirectly) such a subprogram. In this case, the subprogram can + -- be called from an all-sensitized process and the reference will be + -- part of the sensitivity list. + -- NO_SIGNAL means that the subprogram doesn't read any signal and don't + -- call such a subprogram. The subprogram can be called from an + -- all-sensitized process but there is no need to track this call. + -- UNKNOWN means that the state is not yet defined. + type Iir_All_Sensitized is + (Unknown, No_Signal, Read_Signal, Invalid_Signal); + --------------- -- subranges -- --------------- @@ -4498,6 +4517,18 @@ package Iirs is function Get_Wait_State (Proc : Iir) return Tri_State_Type; procedure Set_Wait_State (Proc : Iir; State : Tri_State_Type); + -- Get/Set wether the subprogram may be called by a sensitized process + -- whose sensitivity list is ALL. + -- FALSE if declared in a package unit and reads a signal that is not + -- one of its interface, or if it calls such a subprogram. + -- TRUE if it doesn't call a subprogram whose state is False and + -- either doesn't read a signal or declared within an entity or + -- architecture. + -- UNKNOWN if the status is not yet known. + -- Field: State3 (pos) + function Get_All_Sensitized_State (Proc : Iir) return Iir_All_Sensitized; + procedure Set_All_Sensitized_State (Proc : Iir; State : Iir_All_Sensitized); + -- Get/Set the seen flag. -- Used when the graph of callees is walked, to avoid infinite loops, since -- the graph is not a DAG (there may be cycles). diff --git a/iirs_utils.adb b/iirs_utils.adb index 01c98d22f..9b441f75a 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Scan; use Scan; @@ -837,6 +837,4 @@ package body Iirs_Utils is end case; end loop; end Is_Signal_Object; - - end Iirs_Utils; diff --git a/iirs_utils.ads b/iirs_utils.ads index bd0eb67a9..67baa832f 100644 --- a/iirs_utils.ads +++ b/iirs_utils.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/libraries.adb b/libraries.adb index 734cccbc9..e70a88a1a 100644 --- a/libraries.adb +++ b/libraries.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; diff --git a/libraries.ads b/libraries.ads index e28f412ce..18b1c5d57 100644 --- a/libraries.ads +++ b/libraries.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/libraries/Makefile.inc b/libraries/Makefile.inc index 2830b2317..4b8920e1d 100644 --- a/libraries/Makefile.inc +++ b/libraries/Makefile.inc @@ -48,35 +48,44 @@ MENTOR_BSRCS := mentor/std_logic_arith.vhdl mentor/std_logic_arith_body.vhdl STD87_BSRCS := $(STD_SRCS:.vhdl=.v87) STD93_BSRCS := $(STD_SRCS:.vhdl=.v93) +STD08_BSRCS := $(STD_SRCS:.vhdl=.v08) IEEE87_BSRCS := $(IEEE_SRCS:.vhdl=.v87) IEEE93_BSRCS := $(IEEE_SRCS:.vhdl=.v93) $(MATH_SRCS) SYNOPSYS87_BSRCS := $(SYNOPSYS_BSRCS) SYNOPSYS93_BSRCS := $(SYNOPSYS_BSRCS) MENTOR93_BSRCS := $(MENTOR_BSRCS) -.PREFIXES: .vhdl .v93 .v87 +.PREFIXES: .vhdl .v93 .v87 .v08 %.v93: %.vhdl sed -e '/--V87/s/^/ --/' < $< > $@ +%.v08: %.vhdl + sed -e '/--V87/s/^/ --/' < $< > $@ + %.v87: %.vhdl sed -e '/--V93/s/^/ --/' -e '/--START-V93/,/--END-V93/s/^/--/' \ < $< > $@ +STD87_DIR:=$(LIB87_DIR)/std +IEEE87_DIR:=$(LIB87_DIR)/ieee +SYN87_DIR:=$(LIB87_DIR)/synopsys + STD93_DIR:=$(LIB93_DIR)/std IEEE93_DIR:=$(LIB93_DIR)/ieee SYN93_DIR:=$(LIB93_DIR)/synopsys MENTOR93_DIR:=$(LIB93_DIR)/mentor -STD87_DIR:=$(LIB87_DIR)/std -IEEE87_DIR:=$(LIB87_DIR)/ieee -SYN87_DIR:=$(LIB87_DIR)/synopsys +STD08_DIR:=$(LIB08_DIR)/std -ANALYZE93:=$(ANALYZE) --std=93 ANALYZE87:=$(ANALYZE) --std=87 +ANALYZE93:=$(ANALYZE) --std=93 +ANALYZE08:=$(ANALYZE) --std=08 STD87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD87_BSRCS)) STD93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD93_BSRCS)) +STD08_SRCS=$(addprefix $(LIBSRC_DIR)/,$(STD08_BSRCS)) + IEEE93_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE93_BSRCS)) IEEE87_SRCS=$(addprefix $(LIBSRC_DIR)/,$(IEEE87_BSRCS)) SYNOPSYS_SRCS=$(addprefix $(LIBSRC_DIR)/,$(SYNOPSYS_BSRCS)) @@ -171,3 +180,13 @@ synopsys.v87: $(LIB87_DIR) $(SYNOPSYS_SRCS) force echo $$cmd; eval $$cmd || exit 1; \ done; \ cd $$prev + +std.v08: $(LIB08_DIR) $(STD08_SRCS) force + $(RM) -rf $(STD08_DIR) + mkdir $(STD08_DIR) + prev=`pwd`; cd $(STD08_DIR); \ + for i in $(STD08_SRCS); do \ + echo $$i; \ + $(ANALYZE08) --bootstrap --work=std $(REL_DIR)/$$i || exit 1; \ + done; \ + cd $$prev @@ -12,7 +12,7 @@ -- 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 +-- 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 System; @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/name_table.adb b/name_table.adb index dd1f78f2c..85f65191f 100644 --- a/name_table.adb +++ b/name_table.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; diff --git a/name_table.ads b/name_table.ads index 5659a89a4..c3d3e72f1 100644 --- a/name_table.ads +++ b/name_table.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 System; @@ -12,7 +12,7 @@ -- 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 +-- 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 GNAT.Table; @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/options.adb b/options.adb index 36aeb2105..80eeadb2d 100644 --- a/options.adb +++ b/options.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; use Ada.Text_IO; @@ -53,7 +53,8 @@ package body Options is return True; end Option_Warning; - function Parse_Option (Opt: String) return Boolean is + function Parse_Option (Opt: String) return Boolean + is Beg: constant Integer := Opt'First; begin if Opt'Length > 5 and then Opt (Beg .. Beg + 5) = "--std=" then @@ -66,6 +67,8 @@ package body Options is Vhdl_Std := Vhdl_00; elsif Opt (Beg + 6 .. Beg + 7) = "02" then Vhdl_Std := Vhdl_02; + elsif Opt (Beg + 6 .. Beg + 7) = "08" then + Vhdl_Std := Vhdl_08; else return False; end if; @@ -173,8 +176,7 @@ package body Options is P (" --work=LIB use LIB as work library"); P (" --workdir=DIR use DIR for the file library"); P (" -PPATH add PATH in the library path list"); - P (" --std=87 select vhdl 87 standard"); - P (" --std=93 select vhdl 93 standard"); + P (" --std=87/93/00/02/08 select vhdl 87/93/00/02/08 standard"); P (" --std=93c select vhdl 93 standard and allow 87 syntax"); P (" --[no-]vital-checks do [not] check VITAL restrictions"); P ("Warnings:"); diff --git a/options.ads b/options.ads index c5fa09c14..d9dc890cd 100644 --- a/options.ads +++ b/options.ads @@ -12,7 +12,7 @@ -- 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 +-- 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. @@ -12,7 +12,7 @@ -- 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 +-- 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_Chains; use Iir_Chains; @@ -4342,16 +4342,16 @@ package body Parse is -- precond: PROCESS -- postcond: null -- - -- [ §9.2 ] + -- [ LRM87 9.2 / LRM08 11.3 ] -- process_statement ::= -- [ PROCESS_label : ] - -- [ POSTPONED ] PROCESS [ ( sensitivity_list ) ] [ IS ] + -- [ POSTPONED ] PROCESS [ ( process_sensitivity_list ) ] [ IS ] -- process_declarative_part -- BEGIN -- process_statement_part -- END [ POSTPONED ] PROCESS [ PROCESS_label ] ; -- - -- FIXME: POSTPONED + -- process_sensitivity_list ::= ALL | sensitivity_list function Parse_Process_Statement (Label: Name_Id; Loc : Location_Type; Is_Postponed : Boolean) return Iir @@ -4365,9 +4365,18 @@ package body Parse is if Current_Token = Tok_Left_Paren then Res := Create_Iir (Iir_Kind_Sensitized_Process_Statement); Scan.Scan; - Sensitivity_List := Create_Iir_List; + if Current_Token = Tok_All then + if Vhdl_Std < Vhdl_08 then + Error_Msg_Parse + ("all sensitized process allowed only in vhdl 08"); + end if; + Sensitivity_List := Iir_List_All; + Scan.Scan; + else + Sensitivity_List := Create_Iir_List; + Parse_Sensitivity_List (Sensitivity_List); + end if; Set_Sensitivity_List (Res, Sensitivity_List); - Parse_Sensitivity_List (Sensitivity_List); Expect (Tok_Right_Paren); Scan.Scan; else @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/post_sems.adb b/post_sems.adb index 2eee5c0a0..27fafd5df 100644 --- a/post_sems.adb +++ b/post_sems.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/post_sems.ads b/post_sems.ads index 15fcb4449..ed042264e 100644 --- a/post_sems.ads +++ b/post_sems.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/scan-scan_literal.adb b/scan-scan_literal.adb index 6b2e7a615..1f3fcecb7 100644 --- a/scan-scan_literal.adb +++ b/scan-scan_literal.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Conversion; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Unchecked_Conversion; @@ -1541,12 +1541,14 @@ package body Sem is Sem_Interface_Chain (Interface_Chain, Interface_Function); Set_Return_Type (Subprg, Sem_Subtype_Indication (Get_Return_Type (Subprg))); + Set_All_Sensitized_State (Subprg, Unknown); when Iir_Kind_Procedure_Declaration => Sem_Interface_Chain (Interface_Chain, Interface_Procedure); -- Unless the body is analyzed, the procedure purity is unknown. Set_Purity_State (Subprg, Unknown); -- Check if the procedure is passive. Set_Passive_Flag (Subprg, True); + Set_All_Sensitized_State (Subprg, Unknown); declare Inter : Iir; begin @@ -1624,7 +1626,7 @@ package body Sem is Set_Impure_Depth (Subprg, Iir_Depth_Pure); -- LRM 10.1 Declarative regions - -- 3. A subprogram declaration, together with thr corresponding + -- 3. A subprogram declaration, together with the corresponding -- subprogram body. Open_Declarative_Region; Set_Is_Within_Flag (Spec, True); @@ -1646,7 +1648,7 @@ package body Sem is case Get_Kind (Spec) is when Iir_Kind_Procedure_Declaration => - -- Update purity state of procedure. + -- Update purity state of procedure if there are no callees. case Get_Purity_State (Spec) is when Pure | Maybe_Impure => @@ -1665,7 +1667,8 @@ package body Sem is end if; end if; end case; - -- Update wait state if necessary. + + -- Update wait state if the state of all callees is known. if Get_Wait_State (Spec) = Unknown then declare Callees : Iir_List; @@ -1705,6 +1708,17 @@ package body Sem is end if; end; end if; + + -- Set All_Sensitized_State in trivial cases. + if Get_All_Sensitized_State (Spec) = Unknown + and then Get_Callees_List (Spec) = Null_Iir_List + then + Set_All_Sensitized_State (Spec, No_Signal); + end if; + + -- Do not add to Analysis_Check_List as procedures can't + -- generate purity/wait/all-sensitized errors by themselves. + when Iir_Kind_Function_Declaration => if Get_Callees_List (Spec) /= Null_Iir_List then -- Purity calls to be checked later. @@ -1719,11 +1733,11 @@ package body Sem is -- Status of Update_And_Check_Pure_Wait. type Update_Pure_Status is ( - -- The purity is computed and known. + -- The purity/wait/all-sensitized are computed and known. Update_Pure_Done, - -- A missing body prevents from computing the purity. + -- A missing body prevents from computing the purity/wait/all-sensitized Update_Pure_Missing, - -- Purity is unknown (recursion). + -- Purity/wait/all-sensitized is unknown (recursion). Update_Pure_Unknown ); function Update_And_Check_Pure_Wait (Subprg : Iir) @@ -1765,24 +1779,32 @@ package body Sem is else Depth := Iir_Depth_Impure; end if; + when Iir_Kind_Procedure_Declaration => Kind := K_Procedure; if Get_Purity_State (Subprg) = Impure and then Get_Wait_State (Subprg) /= Unknown + and then Get_All_Sensitized_State (Subprg) /= Unknown then -- No need to go further. - Destroy_Iir_List (Callees_List); - Set_Callees_List (Subprg, Null_Iir_List); + if Get_All_Sensitized_State (Subprg) = No_Signal + or else Vhdl_Std < Vhdl_08 + then + Destroy_Iir_List (Callees_List); + Set_Callees_List (Subprg, Null_Iir_List); + end if; return Update_Pure_Done; end if; Subprg_Bod := Get_Subprogram_Body (Subprg); Subprg_Depth := Get_Subprogram_Depth (Subprg); Depth := Get_Impure_Depth (Subprg_Bod); + when Iir_Kind_Sensitized_Process_Statement => Kind := K_Process; Subprg_Bod := Null_Iir; Subprg_Depth := Iir_Depth_Top; Depth := Iir_Depth_Impure; + when others => Error_Kind ("update_and_check_pure_wait(1)", Subprg); end case; @@ -1813,12 +1835,9 @@ package body Sem is Callee := Get_Nth_Element (Callees_List, I); exit when Callee = Null_Iir; - -- Only procedures should appear in the list: + -- Note: -- Pure functions should not be in the list. -- Impure functions must have directly set Purity_State. - if Get_Kind (Callee) /= Iir_Kind_Procedure_Declaration then - Error_Kind ("update_and_check_pure_wait(3)", Callee); - end if; -- Check pure. Callee_Bod := Get_Subprogram_Body (Callee); @@ -1829,8 +1848,11 @@ package body Sem is Res := Update_Pure_Missing; else -- Second loop: recurse if a state is not known. - if J = 1 and then (Get_Purity_State (Callee) = Unknown - or else Get_Wait_State (Callee) = Unknown) + if J = 1 + and then + (Get_Purity_State (Callee) = Unknown + or else Get_Wait_State (Callee) = Unknown + or else Get_All_Sensitized_State (Callee) = Unknown) then Res1 := Update_And_Check_Pure_Wait (Callee); if Res1 = Update_Pure_Missing then @@ -1879,19 +1901,55 @@ package body Sem is end if; end if; + if Get_All_Sensitized_State (Callee) = Invalid_Signal then + case Kind is + when K_Function | K_Procedure => + Set_All_Sensitized_State (Subprg, Invalid_Signal); + when K_Process => + -- LRM08 11.3 + -- + -- It is an error if a process statement with the + -- reserved word ALL as its process sensitivity list + -- is the parent of a subprogram declared in a design + -- unit other than that containing the process statement + -- and the subprogram reads an explicitly declared + -- signal that is not a formal signal parameter or + -- member of a formal signal parameter of the + -- subprogram or of any of its parents. Similarly, + -- it is an error if such subprogram reads an implicit + -- signal whose explicit ancestor is not a formal signal + -- parameter or member of a formal parameter of + -- the subprogram or of any of its parents. + Error_Msg_Sem + ("all-sensitized " & Disp_Node (Subprg) + & " can't call " & Disp_Node (Callee), Subprg); + Error_Msg_Sem + (" (as this subprogram reads (indirectly) a signal)", + Subprg); + end case; + end if; + -- Keep in list. if Callee_Bod = Null_Iir - or else (Get_Purity_State (Callee) = Unknown - and then Depth /= Iir_Depth_Impure) - or else (Get_Wait_State (Callee) = Unknown - and then (Kind /= K_Procedure - or else Get_Wait_State (Subprg) = Unknown)) + or else + (Get_Purity_State (Callee) = Unknown + and then Depth /= Iir_Depth_Impure) + or else + (Get_Wait_State (Callee) = Unknown + and then (Kind /= K_Procedure + or else Get_Wait_State (Subprg) = Unknown)) + or else + (Vhdl_Std >= Vhdl_08 + and then + (Get_All_Sensitized_State (Callee) = Unknown + or else Get_All_Sensitized_State (Callee) = Read_Signal)) then Replace_Nth_Element (Callees_List, Npos, Callee); Npos := Npos + 1; end if; end loop; + -- End of callee loop. if Npos = 0 then Destroy_Iir_List (Callees_List); Callees_List := Null_Iir_List; @@ -1903,6 +1961,11 @@ package body Sem is Set_Wait_State (Subprg, False); end if; end if; + if Kind = K_Procedure or Kind = K_Function then + if Get_All_Sensitized_State (Subprg) = Unknown then + Set_All_Sensitized_State (Subprg, No_Signal); + end if; + end if; Res := Update_Pure_Done; exit; else @@ -1915,6 +1978,9 @@ package body Sem is return Res; end Update_And_Check_Pure_Wait; + -- Check pure/wait/all-sensitized issues for SUBPRG (subprogram or + -- process). Return False if the analysis is incomplete (and must + -- be deferred). function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean is Res : Update_Pure_Status; @@ -1936,6 +2002,11 @@ package body Sem is Set_Wait_State (Subprg, False); end if; end if; + if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then + if Get_All_Sensitized_State (Subprg) = Unknown then + Set_All_Sensitized_State (Subprg, No_Signal); + end if; + end if; return True; end case; end Root_Update_And_Check_Pure_Wait; @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_assocs.adb b/sem_assocs.adb index 23b315a23..1b5f4807d 100644 --- a/sem_assocs.adb +++ b/sem_assocs.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Evaluation; use Evaluation; diff --git a/sem_assocs.ads b/sem_assocs.ads index 524223601..3b5a8841a 100644 --- a/sem_assocs.ads +++ b/sem_assocs.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_decls.adb b/sem_decls.adb index 1ab069831..f5556495d 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -12,7 +12,7 @@ -- 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 +-- 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; diff --git a/sem_decls.ads b/sem_decls.ads index dfd389ff1..da4020b6c 100644 --- a/sem_decls.ads +++ b/sem_decls.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_expr.adb b/sem_expr.adb index ad1138a42..b26decdeb 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Std_Package; use Std_Package; @@ -730,8 +730,8 @@ package body Sem_Expr is Set_Expr_Staticness (Expr, Staticness); end Set_Function_Call_Staticness; - -- Add CALLEE in the calle list of SUBPRG (which must be a subprg decl). - procedure Add_In_Callee_List (Subprg : Iir; Callee : Iir) + -- Add CALLEE in the callees list of SUBPRG (which must be a subprg decl). + procedure Add_In_Callees_List (Subprg : Iir; Callee : Iir) is List : Iir_List; begin @@ -743,7 +743,7 @@ package body Sem_Expr is -- FIXME: May use a flag in IMP to speed up the -- add operation. Add_Element (List, Callee); - end Add_In_Callee_List; + end Add_In_Callees_List; -- Check purity rules when SUBPRG calls CALLEE. -- Both SUBPRG and CALLEE are subprogram declarations. @@ -808,7 +808,7 @@ package body Sem_Expr is Depth := Get_Impure_Depth (Callee_Body); when Unknown => -- Add in list. - Add_In_Callee_List (Subprg, Callee); + Add_In_Callees_List (Subprg, Callee); if Callee_Body /= Null_Iir then Depth := Get_Impure_Depth (Callee_Body); @@ -867,7 +867,7 @@ package body Sem_Expr is when True => null; when Unknown => - Add_In_Callee_List (Subprg, Callee); + Add_In_Callees_List (Subprg, Callee); return; end case; @@ -897,6 +897,81 @@ package body Sem_Expr is end case; end Sem_Call_Wait_Check; + procedure Sem_Call_All_Sensitized_Check + (Subprg : Iir; Callee : Iir; Loc : Iir) + is + begin + -- No need to deal with 'process (all)' if standard predates it. + if Vhdl_Std < Vhdl_08 then + return; + end if; + + -- If subprogram called is pure, then there is no signals reference. + case Get_Kind (Callee) is + when Iir_Kind_Function_Declaration => + if Get_Pure_Flag (Callee) then + return; + end if; + when Iir_Kind_Procedure_Declaration => + if Get_Purity_State (Callee) = Pure then + return; + end if; + when others => + Error_Kind ("sem_call_all_sensitized_check", Callee); + end case; + + case Get_All_Sensitized_State (Callee) is + when Invalid_Signal => + case Get_Kind (Subprg) is + when Iir_Kind_Sensitized_Process_Statement => + if Get_Sensitivity_List (Subprg) = Iir_List_All then + -- LRM08 11.3 + -- + -- It is an error if a process statement with the + -- reserved word ALL as its process sensitivity list + -- is the parent of a subprogram declared in a design + -- unit other than that containing the process statement + -- and the subprogram reads an explicitly declared + -- signal that is not a formal signal parameter or + -- member of a formal signal parameter of the + -- subprogram or of any of its parents. Similarly, + -- it is an error if such subprogram reads an implicit + -- signal whose explicit ancestor is not a formal signal + -- parameter or member of a formal parameter of + -- the subprogram or of any of its parents. + Error_Msg_Sem + ("all-sensitized " & Disp_Node (Subprg) + & " can't call " & Disp_Node (Callee), Loc); + Error_Msg_Sem + (" (as this subprogram reads (indirectly) a signal)", + Loc); + end if; + when Iir_Kind_Process_Statement => + return; + when Iir_Kind_Function_Declaration + | Iir_Kind_Procedure_Declaration => + Set_All_Sensitized_State (Subprg, Invalid_Signal); + when others => + Error_Kind ("sem_call_all_sensitized_check", Subprg); + end case; + when Read_Signal => + -- Put this subprogram in callees list as it may read a signal. + -- Used by canon to build the sensitivity list. + Add_In_Callees_List (Subprg, Callee); + if Get_Kind (Subprg) in Iir_Kinds_Subprogram_Declaration then + if Get_All_Sensitized_State (Subprg) < Read_Signal then + Set_All_Sensitized_State (Subprg, Read_Signal); + end if; + end if; + when Unknown => + -- Put this subprogram in callees list as it may read a signal. + -- Used by canon to build the sensitivity list. + Add_In_Callees_List (Subprg, Callee); + when No_Signal => + null; + end case; + end Sem_Call_All_Sensitized_Check; + -- Set IMP as the implementation to being called by EXPR. -- If the context is a subprogram or a process (ie, if current_subprogram -- is not NULL), then mark IMP as callee of current_subprogram, and @@ -929,9 +1004,11 @@ package body Sem_Expr is end if; when Iir_Kind_Function_Declaration => Sem_Call_Purity_Check (Subprg, Imp, Expr); + Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr); when Iir_Kind_Procedure_Declaration => Sem_Call_Purity_Check (Subprg, Imp, Expr); Sem_Call_Wait_Check (Subprg, Imp, Expr); + Sem_Call_All_Sensitized_Check (Subprg, Imp, Expr); -- Check passive. if Get_Passive_Flag (Imp) = False then case Get_Kind (Subprg) is diff --git a/sem_expr.ads b/sem_expr.ads index 428e8b683..441e3e069 100644 --- a/sem_expr.ads +++ b/sem_expr.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/sem_names.adb b/sem_names.adb index 69ffa1000..234926be0 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Evaluation; use Evaluation; @@ -1179,6 +1179,32 @@ package body Sem_Names is end case; end Sem_Check_Pure; + -- Set All_Sensitized_State to False iff OBJ is a signal declaration + -- and the current subprogram is in a package body. + procedure Sem_Check_All_Sensitized (Obj : Iir) + is + Subprg : Iir; + begin + -- We cares only of signals. + if Get_Kind (Obj) /= Iir_Kind_Signal_Declaration then + return; + end if; + -- We cares only of subprograms. Give up if we are in a process. + Subprg := Sem_Stmts.Get_Current_Subprogram; + if Subprg = Null_Iir + or else Get_Kind (Subprg) not in Iir_Kinds_Subprogram_Declaration + then + return; + end if; + if Get_Kind (Get_Library_Unit (Sem.Get_Current_Design_Unit)) + = Iir_Kind_Package_Body + then + Set_All_Sensitized_State (Subprg, Invalid_Signal); + else + Set_All_Sensitized_State (Subprg, Read_Signal); + end if; + end Sem_Check_All_Sensitized; + procedure Finish_Sem_Name (Name : Iir; Res : Iir) is Pfx : Iir; @@ -2463,7 +2489,13 @@ package body Sem_Names is -- Set_Parameter (Res, Param); -- end if; -- end if; + if Get_Kind (Prefix) = Iir_Kind_Signal_Interface_Declaration then + -- LRM93 2.1.1.2 / LRM08 4.2.2.3 + -- + -- It is an error if signal-valued attributes 'STABLE , 'QUIET, + -- 'TRANSACTION, and 'DELAYED of formal signal paramaters of any + -- mode are read within a subprogram. case Get_Kind (Get_Parent (Prefix)) is when Iir_Kind_Function_Declaration | Iir_Kind_Procedure_Declaration => @@ -2915,6 +2947,7 @@ package body Sem_Names is when Iir_Kinds_Object_Declaration => Set_Base_Name (Name, Expr); Sem_Check_Pure (Name, Expr); + Sem_Check_All_Sensitized (Expr); when Iir_Kind_Indexed_Name | Iir_Kind_Slice_Name | Iir_Kind_Selected_Element @@ -2933,6 +2966,7 @@ package body Sem_Names is end if; end loop; Sem_Check_Pure (Name, E); + Sem_Check_All_Sensitized (E); end; when Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration => diff --git a/sem_names.ads b/sem_names.ads index b01920f46..5fc57fb04 100644 --- a/sem_names.ads +++ b/sem_names.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_scopes.adb b/sem_scopes.adb index 88e676075..b3d345ce2 100644 --- a/sem_scopes.adb +++ b/sem_scopes.adb @@ -12,7 +12,7 @@ -- 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 +-- along with GHDL; see the file COPYING. If not, write to the Free -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Ada.Text_IO; diff --git a/sem_scopes.ads b/sem_scopes.ads index d4792046f..c686ff2bd 100644 --- a/sem_scopes.ads +++ b/sem_scopes.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_specs.adb b/sem_specs.adb index 7d1274984..3117481ed 100644 --- a/sem_specs.adb +++ b/sem_specs.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/sem_specs.ads b/sem_specs.ads index ab02fb2c4..22e5d4ed9 100644 --- a/sem_specs.ads +++ b/sem_specs.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_stmts.adb b/sem_stmts.adb index ab0979afe..c5ec80bb9 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -12,7 +12,7 @@ -- 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 +-- 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; @@ -819,7 +819,7 @@ package body Sem_Stmts is if not Check_Odcat_Expression (Get_Prefix (Expr)) then return False; end if; - -- GHDL: I don't understand why the indexsing expressions + -- GHDL: I don't understand why the indexing expressions -- must be locally static. So I don't check this in 93c. if Flags.Vhdl_Std /= Vhdl_93c and then @@ -954,6 +954,10 @@ package body Sem_Stmts is Res: Iir; Prefix : Iir; begin + if List = Iir_List_All then + return; + end if; + for I in Natural loop -- El is an iir_identifier. El := Get_Nth_Element (List, I); @@ -1511,6 +1515,9 @@ package body Sem_Stmts is if Get_Kind (Proc) = Iir_Kind_Sensitized_Process_Statement and then Get_Callees_List (Proc) /= Null_Iir_List then + -- Check there is no wait statement in subprograms called. + -- Also in the case of all-sensitized process, check that package + -- subprograms don't read signals. Sem.Add_Analysis_Checks_List (Proc); end if; end Sem_Process_Statement; diff --git a/sem_stmts.ads b/sem_stmts.ads index 57f51fd10..a420ce0d9 100644 --- a/sem_stmts.ads +++ b/sem_stmts.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/sem_types.adb b/sem_types.adb index bd3cc55fc..fc8b932ed 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Libraries; diff --git a/sem_types.ads b/sem_types.ads index a51379477..c71ebbc9d 100644 --- a/sem_types.ads +++ b/sem_types.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/std_names.adb b/std_names.adb index 51aa22472..97b613aa3 100644 --- a/std_names.adb +++ b/std_names.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Name_Table; diff --git a/std_names.ads b/std_names.ads index d1f6bd2db..90c948fee 100644 --- a/std_names.ads +++ b/std_names.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/std_package.adb b/std_package.adb index f18582eea..cc69d3344 100644 --- a/std_package.adb +++ b/std_package.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/std_package.ads b/std_package.ads index 1429f8044..0182ff8c1 100644 --- a/std_package.ads +++ b/std_package.ads @@ -12,7 +12,7 @@ -- 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 +-- 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; use Iirs; diff --git a/str_table.adb b/str_table.adb index 1a1cde4af..b064898d6 100644 --- a/str_table.adb +++ b/str_table.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 System; diff --git a/str_table.ads b/str_table.ads index 5044f8308..de65070e3 100644 --- a/str_table.ads +++ b/str_table.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/tokens.adb b/tokens.adb index c426200c0..ad56810a0 100644 --- a/tokens.adb +++ b/tokens.adb @@ -12,7 +12,7 @@ -- 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 +-- 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 body Tokens is diff --git a/tokens.ads b/tokens.ads index 2e7b2d640..c6e198707 100644 --- a/tokens.ads +++ b/tokens.ads @@ -12,7 +12,7 @@ -- 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 +-- 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 Tokens is diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 0d76bc502..66e0abde7 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -81,39 +81,38 @@ bootstrap.old: force $(MAKE) -C ../../libraries EXT=obj \ ANALYSE="$(PWD)/ghdl -a -g" std-obj93.cf -LIB93_DIR:=../lib/v93 LIB87_DIR:=../lib/v87 +LIB93_DIR:=../lib/v93 +LIB08_DIR:=../lib/v08 + LIBSRC_DIR:=../../libraries REL_DIR:=../.. ANALYZE:=../../../ghdldrv/ghdl -a $(LIB_CFLAGS) LN=ln -s CP=cp -$(LIB87_DIR): +$(LIB87_DIR) $(LIB93_DIR) $(LIB08_DIR): [ -d ../lib ] || mkdir ../lib - [ -d $(LIB87_DIR) ] || mkdir $(LIB87_DIR) - -$(LIB93_DIR): - [ -d ../lib ] || mkdir ../lib - [ -d $(LIB93_DIR) ] || mkdir $(LIB93_DIR) + [ -d $@ ] || mkdir $@ include ../../libraries/Makefile.inc GHDL1=../ghdl1-gcc -$(LIB87_DIR)/std/std_standard.o: $(GHDL1) - $(GHDL1) --std=87 -quiet $(LIB_CFLAGS) -o std_standard.s \ +$(LIB93_DIR)/std/std_standard.o: $(GHDL1) + $(GHDL1) --std=93 -quiet $(LIB_CFLAGS) -o std_standard.s \ --compile-standard $(CC) -c -o $@ std_standard.s $(RM) std_standard.s -$(LIB93_DIR)/std/std_standard.o: $(GHDL1) - $(GHDL1) --std=93 -quiet $(LIB_CFLAGS) -o std_standard.s \ +$(LIB87_DIR)/std/std_standard.o: $(GHDL1) + $(GHDL1) --std=87 -quiet $(LIB_CFLAGS) -o std_standard.s \ --compile-standard $(CC) -c -o $@ std_standard.s $(RM) std_standard.s install.v93: std.v93 ieee.v93 synopsys.v93 mentor.v93 install.v87: std.v87 ieee.v87 synopsys.v87 +install.v08: std.v08 install.standard: $(LIB93_DIR)/std/std_standard.o \ $(LIB87_DIR)/std/std_standard.o @@ -122,7 +121,7 @@ grt.links: cd ../lib; ln -sf $(GRTSRCDIR)/grt.lst .; ln -sf $(GRTSRCDIR)/libgrt.a .; ln -sf $(GRTSRCDIR)/grt.ver . install.all: install.v87 install.v93 install.standard -install.mcode: install.v87 install.v93 +install.mcode: install.v87 install.v93 install.v08 clean: force $(RM) -f *.o *.ali ghdl_gcc ghdl_mcode diff --git a/translate/ghdldrv/ghdllocal.adb b/translate/ghdldrv/ghdllocal.adb index 310dabbfb..5cd97b47d 100644 --- a/translate/ghdldrv/ghdllocal.adb +++ b/translate/ghdldrv/ghdllocal.adb @@ -174,6 +174,8 @@ package body Ghdllocal is | Vhdl_00 | Vhdl_02 => return "v93"; + when Vhdl_08 => + return "v08"; end case; end Get_Version_Path; diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads index c71abacda..3057fc8e3 100644 --- a/translate/grt/grt-options.ads +++ b/translate/grt/grt-options.ads @@ -41,7 +41,7 @@ package Grt.Options is -- Consistent flags used for analysis. -- Format is "VVitr", where: - -- 'VV' is the version (87 or 93). + -- 'VV' is the version (87, 93 or 08). -- 'i' is the integer size ('i' for 32 bits, 'I' for 64 bits). -- 't' is the time size ('t' for 32 bits, 'T' for 64 bits). -- 'r' is the resolution ('?' for to be set by the user, '-' for any). diff --git a/translate/translation.adb b/translate/translation.adb index 24fdc7696..1e5658109 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -21370,6 +21370,7 @@ package body Translation is Constr : O_Assoc_List; Info : Proc_Info_Acc; List : Iir_List; + List_Orig : Iir_List; Final : Boolean; begin New_Debug_Line_Stmt (Get_Line_Number (Proc)); @@ -21407,16 +21408,11 @@ package body Translation is New_Lit (New_Subprogram_Address (Info.Process_Subprg, Ghdl_Ptr_Type))); Rtis.Associate_Rti_Context (Constr, Proc); --- New_Association --- (Constr, --- New_Address (New_Selected_Element --- (Get_Instance_Ref (Info.Process_Decls_Type), --- Info.Process_Name), --- Ghdl_Instance_Name_Acc)); New_Procedure_Call (Constr); -- First elaborate declarations since a driver may depend on -- an alias declaration. + -- Also, with vhdl 08 a sensitivity element may depend on an alias. Chap4.Elab_Declaration_Chain (Proc, Final); -- Register drivers. @@ -21462,9 +21458,17 @@ package body Translation is end if; if Is_Sensitized then - List := Get_Sensitivity_List (Proc); + List_Orig := Get_Sensitivity_List (Proc); + if List_Orig = Iir_List_All then + List := Canon.Canon_Extract_Process_Sensitivity (Proc); + else + List := List_Orig; + end if; Destroy_Types_In_List (List); Register_Signal_List (List, Ghdl_Process_Add_Sensitivity); + if List_Orig = Iir_List_All then + Destroy_Iir_List (List); + end if; end if; Pop_Scope (Info.Process_Decls_Type); @@ -12,7 +12,7 @@ -- 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 +-- 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 Interfaces; @@ -12,7 +12,7 @@ -- 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 +-- 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 GNAT.Table; @@ -12,7 +12,7 @@ -- 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 +-- 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 Types; use Types; diff --git a/xtools/check_iirs_pkg.adb b/xtools/check_iirs_pkg.adb index 6f705f701..fc4595116 100644 --- a/xtools/check_iirs_pkg.adb +++ b/xtools/check_iirs_pkg.adb @@ -232,7 +232,7 @@ package body Check_Iirs_Pkg is type Func_Info is record -- Name of the function. - Name : Vstring; + Name : String_Access; -- Field get/set by the function. Field : Field_Type; -- If true, the iir use this function. @@ -583,7 +583,7 @@ package body Check_Iirs_Pkg is Set (Function2pos, Ident, Integer (Function_Pos)); Func_Table.Set_Last (Function_Pos); Func_Table.Table (Function_Pos) := - (Name => Ident, + (Name => new String'(To_String (Ident)), Field => Field_Type (Field_Pos), Uses => (others => False), Target_Name => new String'(To_String (Ident_2)), @@ -1032,10 +1032,10 @@ package body Check_Iirs_Pkg is begin -- Avoid bug get_parent. if Is_Used (I) then - Same_Name := F.Name = Field_Table.Table (F.Field).Name.all; + Same_Name := F.Name.all = Field_Table.Table (F.Field).Name.all; if Flag_Checks then Put (" procedure Check_Kind_For_"); - Put (F.Name); + Put (F.Name.all); Put (" (Target : Iir) is"); New_Line; Put_Line (" begin"); @@ -1057,17 +1057,17 @@ package body Check_Iirs_Pkg is Put_Line (" null;"); Put_Line (" when others =>"); Put (" Failed ("""); - Put (F.Name); + Put (F.Name.all); Put_Line (""", Target);"); Put_Line (" end case;"); Put (" end Check_Kind_For_"); - Put (F.Name); + Put (F.Name.all); Put_Line (";"); New_Line; end if; Put (" function Get_"); - Put (F.Name); + Put (F.Name.all); Put (" ("); Put (F.Target_Name.all); Put (" : "); @@ -1083,7 +1083,7 @@ package body Check_Iirs_Pkg is Put_Line (" begin"); if Flag_Checks then Put (" Check_Kind_For_"); - Put (F.Name); + Put (F.Name.all); Put (" ("); Put (F.Target_Name.all); Put (");"); @@ -1120,14 +1120,14 @@ package body Check_Iirs_Pkg is Put (";"); New_Line; Put (" end Get_"); - Put (F.Name); + Put (F.Name.all); Put (";"); New_Line; New_Line; if F.Value_Name /= null then Put (" procedure Set_"); - Put (F.Name); + Put (F.Name.all); Put (" ("); Put (F.Target_Name.all); Put (" : "); @@ -1146,7 +1146,7 @@ package body Check_Iirs_Pkg is Put_Line (" begin"); if Flag_Checks then Put (" Check_Kind_For_"); - Put (F.Name); + Put (F.Name.all); Put (" ("); Put (F.Target_Name.all); Put (");"); @@ -1184,7 +1184,7 @@ package body Check_Iirs_Pkg is Put (");"); New_Line; Put (" end Set_"); - Put (F.Name); + Put (F.Name.all); Put (";"); New_Line; New_Line; |