From e74d643a35af630dde8a5fd9582b1c391fd022c4 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 14 Oct 2013 15:39:16 +0200 Subject: [PATCH] [multiple changes] 2013-10-14 Hristian Kirtchev * sem_prag.adb (Analyze_Dependency_Clause): Add new local variable Non_Null_Output_Seen. Update the call to Analyze_Input_Output. (Analyze_Input_Item): Streamline the detection mechanism of null and non-null items. (Analyze_Input_List): Add new local variable Non_Null_Input_Seen. Update all calls to Analyze_Input_Output. (Analyze_Input_Output): Add new formal parameter Non_Null_Seen and update the related comment on usage. Update the recursive call to itself. Attribute 'Result is now treated as a non-null item. Detect mixes of null and non-null items. (Analyze_Initialization_Item): Streamline the detection mechanism of null and non-null items. 2013-10-14 Vincent Celier * projects.texi: Add documentation for the new project level attribute Library_Rpath_Options. 2013-10-14 Tristan Gingold * a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure. (Set_Foreign_Occurrence): New procedure, extracted from Setup_Current_Excep. * exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice parameter in case of zcx. * sem_ch11.adb (Analyze_Exception_Handlers): Need debug info for the choice parameter. * raise-gcc.c: Add comments. From-SVN: r203552 --- gcc/ada/ChangeLog | 31 +++++++++ gcc/ada/a-exexpr-gcc.adb | 65 ++++++++++++++--- gcc/ada/exp_ch11.adb | 7 +- gcc/ada/projects.texi | 8 +++ gcc/ada/raise-gcc.c | 4 +- gcc/ada/sem_ch11.adb | 1 + gcc/ada/sem_prag.adb | 176 ++++++++++++++++++++++++++++------------------- 7 files changed, 211 insertions(+), 81 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index acb4f58..a102f90 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,36 @@ 2013-10-14 Hristian Kirtchev + * sem_prag.adb (Analyze_Dependency_Clause): Add new local variable + Non_Null_Output_Seen. Update the call to Analyze_Input_Output. + (Analyze_Input_Item): Streamline the detection mechanism of null and + non-null items. + (Analyze_Input_List): Add new local variable + Non_Null_Input_Seen. Update all calls to Analyze_Input_Output. + (Analyze_Input_Output): Add new formal parameter Non_Null_Seen + and update the related comment on usage. Update the + recursive call to itself. Attribute 'Result is now treated + as a non-null item. Detect mixes of null and non-null items. + (Analyze_Initialization_Item): Streamline the detection mechanism + of null and non-null items. + +2013-10-14 Vincent Celier + + * projects.texi: Add documentation for the new project level + attribute Library_Rpath_Options. + +2013-10-14 Tristan Gingold + + * a-exexpr-gcc.adb (Set_Exception_Parameter): New procedure. + (Set_Foreign_Occurrence): New procedure, extracted from + Setup_Current_Excep. + * exp_ch11.adb (Expand_Exception_Handlers): Do not expand choice + parameter in case of zcx. + * sem_ch11.adb (Analyze_Exception_Handlers): Need debug info + for the choice parameter. + * raise-gcc.c: Add comments. + +2013-10-14 Hristian Kirtchev + * aspects.adb: Add an entry in table Canonical_Aspect for Initial_Condition. * aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument, diff --git a/gcc/ada/a-exexpr-gcc.adb b/gcc/ada/a-exexpr-gcc.adb index 0bf3198..77abaa5 100644 --- a/gcc/ada/a-exexpr-gcc.adb +++ b/gcc/ada/a-exexpr-gcc.adb @@ -199,13 +199,14 @@ package body Exception_Propagation is (GCC_Exception : not null GCC_Exception_Access); pragma No_Return (Reraise_GCC_Exception); pragma Export (C, Reraise_GCC_Exception, "__gnat_reraise_zcx"); - -- Called to implement raise without exception, ie reraise. Called + -- Called to implement raise without exception, ie reraise. Called -- directly from gigi. function Setup_Current_Excep (GCC_Exception : not null GCC_Exception_Access) return EOA; pragma Export (C, Setup_Current_Excep, "__gnat_setup_current_excep"); - -- Write Get_Current_Excep.all from GCC_Exception + -- Write Get_Current_Excep.all from GCC_Exception. Called by the + -- personnality routine. procedure Unhandled_Except_Handler (GCC_Exception : not null GCC_Exception_Access); @@ -243,6 +244,17 @@ package body Exception_Propagation is UW_Argument : System.Address); pragma Import (C, Unwind_ForcedUnwind, "__gnat_Unwind_ForcedUnwind"); + procedure Set_Exception_Parameter + (Excep : EOA; + GCC_Exception : not null GCC_Exception_Access); + pragma Export (C, Set_Exception_Parameter, + "__gnat_set_exception_parameter"); + -- Called inserted by gigi to initialize the exception parameter + + procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address); + -- Utility routine to initialize occurrence Excep for a foreign exception + -- whose machine occurrence is Mo. + -- Hooks called when entering/leaving an exception handler for a given -- occurrence, aimed at handling the stack of active occurrences. The -- calls are generated by gigi in tree_transform/N_Exception_Handler. @@ -338,6 +350,20 @@ package body Exception_Propagation is Free (Copy); end GNAT_GCC_Exception_Cleanup; + ---------------------------- + -- Set_Foreign_Occurrence -- + ---------------------------- + + procedure Set_Foreign_Occurrence (Excep : EOA; Mo : System.Address) is + begin + Excep.Id := Foreign_Exception'Access; + Excep.Machine_Occurrence := Mo; + Excep.Msg_Length := 0; + Excep.Exception_Raised := True; + Excep.Pid := Local_Partition_ID; + Excep.Num_Tracebacks := 0; + end Set_Foreign_Occurrence; + ------------------------- -- Setup_Current_Excep -- ------------------------- @@ -366,12 +392,7 @@ package body Exception_Propagation is -- A default one - Excep.Id := Foreign_Exception'Access; - Excep.Machine_Occurrence := GCC_Exception.all'Address; - Excep.Msg_Length := 0; - Excep.Exception_Raised := True; - Excep.Pid := Local_Partition_ID; - Excep.Num_Tracebacks := 0; + Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); return Excep; end if; @@ -465,6 +486,34 @@ package body Exception_Propagation is Propagate_GCC_Exception (To_GCC_Exception (Excep.Machine_Occurrence)); end Propagate_Exception; + ----------------------------- + -- Set_Exception_Parameter -- + ----------------------------- + + procedure Set_Exception_Parameter + (Excep : EOA; + GCC_Exception : not null GCC_Exception_Access) is + begin + -- Setup the exception occurrence + + if GCC_Exception.Class = GNAT_Exception_Class then + + -- From the GCC exception + + declare + GNAT_Occurrence : constant GNAT_GCC_Exception_Access := + To_GNAT_GCC_Exception (GCC_Exception); + begin + Save_Occurrence (Excep.all, GNAT_Occurrence.Occurrence); + end; + else + + -- A default one + + Set_Foreign_Occurrence (Excep, GCC_Exception.all'Address); + end if; + end Set_Exception_Parameter; + ------------------------------ -- Unhandled_Except_Handler -- ------------------------------ diff --git a/gcc/ada/exp_ch11.adb b/gcc/ada/exp_ch11.adb index 1f5ebe8..476b69c 100644 --- a/gcc/ada/exp_ch11.adb +++ b/gcc/ada/exp_ch11.adb @@ -1025,7 +1025,12 @@ package body Exp_Ch11 is -- ... -- end; - if Present (Choice_Parameter (Handler)) then + -- This expansion is not performed when using GCC ZCX. Gigi + -- will insert a call to intialize the choice parameter. + + if Present (Choice_Parameter (Handler)) + and then Exception_Mechanism /= Back_End_Exceptions + then declare Cparm : constant Entity_Id := Choice_Parameter (Handler); Cloc : constant Source_Ptr := Sloc (Cparm); diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index c027904..819c1e9 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -3962,6 +3962,14 @@ the command line when linking a shared library. Value is a list of options that are to be used when linking a shared library. +@item @b{Library_Rpath_Options}: list, indexed, case-insensitive index + +Index is a language name. Value is a list of options for an invocation of the +compiler of the language. This invocation is done for a shared library project +with sources of the language. The output of the invocation is the path name +of a shared library file. The directory name is to be put in the run path +option switch when linking the shared library for the project. + @item @b{Library_Src_Dir}: single Value is the name of the directory where copies of the sources of the diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index 5d32167..a207e52 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -1217,7 +1217,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, setup_to_install (uw_context, uw_exception, action.landing_pad, action.ttype_filter); - /* Write current exception, so that it can be retrieved from Ada. */ + /* Write current exception, so that it can be retrieved from Ada. It was + already done during phase 1 (just above), but in between, one or several + exceptions may have been raised (in cleanup handlers). */ __gnat_setup_current_excep (uw_exception); return _URC_INSTALL_CONTEXT; diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index c5b92e2..a397edf 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -199,6 +199,7 @@ package body Sem_Ch11 is if Comes_From_Source (Choice) then Check_Restriction (No_Exception_Propagation, Choice); + Set_Debug_Info_Needed (Choice); end if; if No (H_Scope) then diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 4734581..bd00a3c 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -555,12 +555,13 @@ package body Sem_Prag is -- Verify the legality of a single input list procedure Analyze_Input_Output - (Item : Node_Id; - Is_Input : Boolean; - Self_Ref : Boolean; - Top_Level : Boolean; - Seen : in out Elist_Id; - Null_Seen : in out Boolean); + (Item : Node_Id; + Is_Input : Boolean; + Self_Ref : Boolean; + Top_Level : Boolean; + Seen : in out Elist_Id; + Null_Seen : in out Boolean; + Non_Null_Seen : in out Boolean); -- Verify the legality of a single input or output item. Flag -- Is_Input should be set whenever Item is an input, False when it -- denotes an output. Flag Self_Ref should be set when the item is an @@ -568,7 +569,8 @@ package body Sem_Prag is -- be set whenever Item appears immediately within an input or output -- list. Seen is a collection of all abstract states, variables and -- formals processed so far. Flag Null_Seen denotes whether a null - -- input or output has been encountered. + -- input or output has been encountered. Flag Non_Null_Seen denotes + -- whether a non-null input or output has been encountered. ------------------------ -- Analyze_Input_List -- @@ -579,8 +581,9 @@ package body Sem_Prag is -- A list containing the entities of all inputs that appear in the -- current input list. - Null_Input_Seen : Boolean := False; - -- A flag used to track the legality of a null input + Non_Null_Input_Seen : Boolean := False; + Null_Input_Seen : Boolean := False; + -- Flags used to check the legality of an input list Input : Node_Id; @@ -596,12 +599,13 @@ package body Sem_Prag is Input := First (Expressions (Inputs)); while Present (Input) loop Analyze_Input_Output - (Item => Input, - Is_Input => True, - Self_Ref => False, - Top_Level => False, - Seen => Inputs_Seen, - Null_Seen => Null_Input_Seen); + (Item => Input, + Is_Input => True, + Self_Ref => False, + Top_Level => False, + Seen => Inputs_Seen, + Null_Seen => Null_Input_Seen, + Non_Null_Seen => Non_Null_Input_Seen); Next (Input); end loop; @@ -614,12 +618,13 @@ package body Sem_Prag is else Analyze_Input_Output - (Item => Inputs, - Is_Input => True, - Self_Ref => False, - Top_Level => False, - Seen => Inputs_Seen, - Null_Seen => Null_Input_Seen); + (Item => Inputs, + Is_Input => True, + Self_Ref => False, + Top_Level => False, + Seen => Inputs_Seen, + Null_Seen => Null_Input_Seen, + Non_Null_Seen => Non_Null_Input_Seen); end if; -- Detect an illegal dependency clause of the form @@ -638,12 +643,13 @@ package body Sem_Prag is -------------------------- procedure Analyze_Input_Output - (Item : Node_Id; - Is_Input : Boolean; - Self_Ref : Boolean; - Top_Level : Boolean; - Seen : in out Elist_Id; - Null_Seen : in out Boolean) + (Item : Node_Id; + Is_Input : Boolean; + Self_Ref : Boolean; + Top_Level : Boolean; + Seen : in out Elist_Id; + Null_Seen : in out Boolean; + Non_Null_Seen : in out Boolean) is Is_Output : constant Boolean := not Is_Input; Grouped : Node_Id; @@ -666,12 +672,13 @@ package body Sem_Prag is Grouped := First (Expressions (Item)); while Present (Grouped) loop Analyze_Input_Output - (Item => Grouped, - Is_Input => Is_Input, - Self_Ref => Self_Ref, - Top_Level => False, - Seen => Seen, - Null_Seen => Null_Seen); + (Item => Grouped, + Is_Input => Is_Input, + Self_Ref => Self_Ref, + Top_Level => False, + Seen => Seen, + Null_Seen => Null_Seen, + Non_Null_Seen => Non_Null_Seen); Next (Grouped); end loop; @@ -683,6 +690,7 @@ package body Sem_Prag is -- Process Function'Result in the context of a dependency clause elsif Is_Attribute_Result (Item) then + Non_Null_Seen := True; -- It is sufficent to analyze the prefix of 'Result in order to -- establish legality of the attribute. @@ -707,6 +715,10 @@ package body Sem_Prag is elsif Is_Input then Error_Msg_N ("function result cannot act as input", Item); + elsif Null_Seen then + Error_Msg_N + ("cannot mix null and non-null dependency items", Item); + else Result_Seen := True; end if; @@ -719,19 +731,39 @@ package body Sem_Prag is if Null_Seen then Error_Msg_N ("multiple null dependency relations not allowed", Item); + + elsif Non_Null_Seen then + Error_Msg_N + ("cannot mix null and non-null dependency items", Item); + else Null_Seen := True; - if Is_Output and then not Is_Last then - Error_Msg_N - ("null output list must be the last clause in a " - & "dependency relation", Item); + if Is_Output then + if not Is_Last then + Error_Msg_N + ("null output list must be the last clause in a " + & "dependency relation", Item); + + -- Catch a useless dependence of the form: + -- null =>+ ... + + elsif Self_Ref then + Error_Msg_N + ("useless dependence, null depends on itself", Item); + end if; end if; end if; -- Default case else + Non_Null_Seen := True; + + if Null_Seen then + Error_Msg_N ("cannot mix null and non-null items", Item); + end if; + Analyze (Item); -- Find the entity of the item. If this is a renaming, climb @@ -845,6 +877,9 @@ package body Sem_Prag is Output : Node_Id; Self_Ref : Boolean; + Non_Null_Output_Seen : Boolean := False; + -- Flag used to check the legality of an output list + -- Start of processing for Analyze_Dependency_Clause begin @@ -864,12 +899,13 @@ package body Sem_Prag is Output := First (Choices (Clause)); while Present (Output) loop Analyze_Input_Output - (Item => Output, - Is_Input => False, - Self_Ref => Self_Ref, - Top_Level => True, - Seen => All_Outputs_Seen, - Null_Seen => Null_Output_Seen); + (Item => Output, + Is_Input => False, + Self_Ref => Self_Ref, + Top_Level => True, + Seen => All_Outputs_Seen, + Null_Seen => Null_Output_Seen, + Non_Null_Seen => Non_Null_Output_Seen); Next (Output); end loop; @@ -2192,22 +2228,15 @@ package body Sem_Prag is Item_Id : Entity_Id; begin - -- A package with null initialization list is not allowed to have - -- additional initializations. - - if Null_Seen then - Error_Msg_NE ("package & has null initialization", Item, Pack_Id); - -- Null initialization list - elsif Nkind (Item) = N_Null then - - -- Catch a case where a null initialization item appears in a list - -- of non-null items. + if Nkind (Item) = N_Null then + if Null_Seen then + Error_Msg_N ("multiple null initializations not allowed", Item); - if Non_Null_Seen then - Error_Msg_NE - ("package & has non-null initialization", Item, Pack_Id); + elsif Non_Null_Seen then + Error_Msg_N + ("cannot mix null and non-null initialization items", Item); else Null_Seen := True; end if; @@ -2217,6 +2246,11 @@ package body Sem_Prag is else Non_Null_Seen := True; + if Null_Seen then + Error_Msg_N + ("cannot mix null and non-null initialization items", Item); + end if; + Analyze (Item); if Is_Entity_Name (Item) then @@ -2287,21 +2321,16 @@ package body Sem_Prag is Input_Id : Entity_Id; begin - -- An initialization item with null inputs is not allowed to have - -- assitional inputs. - - if Null_Seen then - Error_Msg_N ("item has null input list", Item); - -- Null input list - elsif Nkind (Input) = N_Null then - - -- Catch a case where a null input appears in a list of non- - -- null inpits. + if Nkind (Input) = N_Null then + if Null_Seen then + Error_Msg_N + ("multiple null initializations not allowed", Item); - if Non_Null_Seen then - Error_Msg_N ("item has non-null input list", Item); + elsif Non_Null_Seen then + Error_Msg_N + ("cannot mix null and non-null initialization item", Item); else Null_Seen := True; end if; @@ -2311,6 +2340,11 @@ package body Sem_Prag is else Non_Null_Seen := True; + if Null_Seen then + Error_Msg_N + ("cannot mix null and non-null initialization item", Item); + end if; + Analyze (Input); if Is_Entity_Name (Input) then @@ -9299,7 +9333,7 @@ package body Sem_Prag is elsif Nkind (State) = N_Null then Name := New_Internal_Name ('S'); - Is_Null := True; + Is_Null := True; Null_Seen := True; -- Catch a case where a null state appears in a list of @@ -19946,7 +19980,7 @@ package body Sem_Prag is Dep_Id := Entity_Of (Dep_Input); -- Inspect all inputs of the refinement clause and attempt - -- to match against the inputs of the dependance clause. + -- to match against the inputs of the dependence clause. Ref_Input := First (Ref_Inputs); while Present (Ref_Input) loop @@ -20256,7 +20290,7 @@ package body Sem_Prag is begin -- The analysis of pragma Depends should produce normalized clauses -- with exactly one output. This is important because output items - -- are unique in the whole dependance relation and can be used as + -- are unique in the whole dependence relation and can be used as -- keys. pragma Assert (No (Next (Dep_Output))); -- 2.7.4