From e98668b178c080f9e264011a3af160d02a796a4f Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 12 Jun 2012 13:59:32 +0200 Subject: [PATCH] [multiple changes] 2012-06-12 Robert Dewar * stringt.adb: Minor reformatting. 2012-06-12 Robert Dewar * ali-util.adb, stringt.ads: Minor reformatting. 2012-06-12 Hristian Kirtchev * exp_ch7.adb (Process_Declarations): Handle the case where the original context has been wrapped in a block to avoid interference between exception handlers and At_End handlers. (Wrap_HSS_In_Block): Mark the block which contains the original statements of the context as being a finalization wrapper. * sinfo.adb (Is_Finalization_Wrapper): New routine. (Set_Is_Finalization_Wrapper): New routine. * sinfo.ads: Add new attribute Is_Finalization_Wrapper applicable to block statemnts. (Is_Finalization_Wrapper): New routine with corresponding pragma Inline. (Set_Is_Finalization_Wrapper): New routine with corresponding pragma Inline. 2012-06-12 Steve Baird * gnat1drv.adb (Adjust_Global_Switches): No longer need to set Exception_Extra_Info in CodePeer_Mode. From-SVN: r188449 --- gcc/ada/ChangeLog | 29 +++++++++++++++++++++++++++++ gcc/ada/ali-util.adb | 5 +++-- gcc/ada/exp_ch7.adb | 21 +++++++++++++++++++++ gcc/ada/gnat1drv.adb | 6 ------ gcc/ada/sinfo.adb | 16 ++++++++++++++++ gcc/ada/sinfo.ads | 15 +++++++++++++++ gcc/ada/stringt.adb | 2 +- gcc/ada/stringt.ads | 7 ++++--- 8 files changed, 89 insertions(+), 12 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 90bb9bb851c..5944186d0d2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,32 @@ +2012-06-12 Robert Dewar + + * stringt.adb: Minor reformatting. + +2012-06-12 Robert Dewar + + * ali-util.adb, stringt.ads: Minor reformatting. + +2012-06-12 Hristian Kirtchev + + * exp_ch7.adb (Process_Declarations): Handle the case where + the original context has been wrapped in a block to avoid + interference between exception handlers and At_End handlers. + (Wrap_HSS_In_Block): Mark the block which contains the original + statements of the context as being a finalization wrapper. + * sinfo.adb (Is_Finalization_Wrapper): New routine. + (Set_Is_Finalization_Wrapper): New routine. + + * sinfo.ads: Add new attribute Is_Finalization_Wrapper applicable + to block statemnts. + (Is_Finalization_Wrapper): New routine with corresponding pragma Inline. + (Set_Is_Finalization_Wrapper): New routine with corresponding pragma + Inline. + +2012-06-12 Steve Baird + + * gnat1drv.adb (Adjust_Global_Switches): No longer need to set + Exception_Extra_Info in CodePeer_Mode. + 2012-06-12 Robert Dewar * sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb, diff --git a/gcc/ada/ali-util.adb b/gcc/ada/ali-util.adb index 40cb1d9f765..0c2e87d5111 100644 --- a/gcc/ada/ali-util.adb +++ b/gcc/ada/ali-util.adb @@ -475,7 +475,9 @@ package body ALI.Util is -- of the source file in the table if checksums match. -- ??? It is probably worth updating the ALI file with a new - -- field to avoid recomputing it each time. + -- field to avoid recomputing it each time. In any case we ensure + -- that we don't gobble up string table space by doing a mark + -- release around this computation. Stringt.Mark; @@ -495,7 +497,6 @@ package body ALI.Util is end if; Stringt.Release; - end if; if (not Read_Only) or else Source.Table (Src).Source_Found then diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 1ffc8ca730e..0352fe25767 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2094,6 +2094,22 @@ package body Exp_Ch7 is then Last_Top_Level_Ctrl_Construct := Decl; end if; + + -- Handle the case where the original context has been wrapped in + -- a block to avoid interference between exception handlers and + -- At_End handlers. Treat the block as transparent and process its + -- contents. + + elsif Nkind (Decl) = N_Block_Statement + and then Is_Finalization_Wrapper (Decl) + then + if Present (Handled_Statement_Sequence (Decl)) then + Process_Declarations + (Statements (Handled_Statement_Sequence (Decl)), + Preprocess); + end if; + + Process_Declarations (Declarations (Decl), Preprocess); end if; Prev_Non_Pragma (Decl); @@ -3696,6 +3712,11 @@ package body Exp_Ch7 is Make_Block_Statement (Loc, Handled_Statement_Sequence => HSS); + -- Signal the finalization machinery that this particular block + -- contains the original context. + + Set_Is_Finalization_Wrapper (Block); + Set_Handled_Statement_Sequence (N, Make_Handled_Sequence_Of_Statements (Loc, New_List (Block))); HSS := Handled_Statement_Sequence (N); diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb index a3ed807e4e2..57aacca5b45 100644 --- a/gcc/ada/gnat1drv.adb +++ b/gcc/ada/gnat1drv.adb @@ -265,12 +265,6 @@ procedure Gnat1drv is Force_ALI_Tree_File := True; Try_Semantics := True; - - -- Enable Exception_Extra_Info for now, to avoid extra messages - -- on controlled operations. - -- ??? To be revised. - - Exception_Extra_Info := True; end if; -- Set Configurable_Run_Time mode if system.ads flag set diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index e7ad52e6daf..9c6b6888b21 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -1806,6 +1806,14 @@ package body Sinfo is return Flag11 (N); end Is_Expanded_Build_In_Place_Call; + function Is_Finalization_Wrapper + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Block_Statement); + return Flag9 (N); + end Is_Finalization_Wrapper; + function Is_Folded_In_Parser (N : Node_Id) return Boolean is begin @@ -4902,6 +4910,14 @@ package body Sinfo is Set_Flag11 (N, Val); end Set_Is_Expanded_Build_In_Place_Call; + procedure Set_Is_Finalization_Wrapper + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Block_Statement); + Set_Flag9 (N, Val); + end Set_Is_Finalization_Wrapper; + procedure Set_Is_Folded_In_Parser (N : Node_Id; Val : Boolean := True) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 22aea5b8ffe..76204498da0 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1310,6 +1310,12 @@ package Sinfo is -- actuals to support a build-in-place style of call have been added to -- the call. + -- Is_Finalization_Wrapper (Flag9-Sem); + -- This flag is present in N_Block_Statement nodes. It is set when the + -- block acts as a wrapper of a handled construct which has controlled + -- objects. The wrapper prevents interference between exception handlers + -- and At_End handlers. + -- Is_In_Discriminant_Check (Flag11-Sem) -- This flag is present in a selected component, and is used to indicate -- that the reference occurs within a discriminant check. The @@ -4331,6 +4337,7 @@ package Sinfo is -- Is_Task_Allocation_Block (Flag6) -- Is_Asynchronous_Call_Block (Flag7) -- Exception_Junk (Flag8-Sem) + -- Is_Finalization_Wrapper (Flag9-Sem) ------------------------- -- 5.7 Exit Statement -- @@ -8670,6 +8677,9 @@ package Sinfo is function Is_Expanded_Build_In_Place_Call (N : Node_Id) return Boolean; -- Flag11 + function Is_Finalization_Wrapper + (N : Node_Id) return Boolean; -- Flag9 + function Is_Folded_In_Parser (N : Node_Id) return Boolean; -- Flag4 @@ -9657,6 +9667,9 @@ package Sinfo is procedure Set_Is_Expanded_Build_In_Place_Call (N : Node_Id; Val : Boolean := True); -- Flag11 + procedure Set_Is_Finalization_Wrapper + (N : Node_Id; Val : Boolean := True); -- Flag9 + procedure Set_Is_Folded_In_Parser (N : Node_Id; Val : Boolean := True); -- Flag4 @@ -12014,6 +12027,7 @@ package Sinfo is pragma Inline (Is_Elsif); pragma Inline (Is_Entry_Barrier_Function); pragma Inline (Is_Expanded_Build_In_Place_Call); + pragma Inline (Is_Finalization_Wrapper); pragma Inline (Is_Folded_In_Parser); pragma Inline (Is_In_Discriminant_Check); pragma Inline (Is_Machine_Number); @@ -12338,6 +12352,7 @@ package Sinfo is pragma Inline (Set_Is_Elsif); pragma Inline (Set_Is_Entry_Barrier_Function); pragma Inline (Set_Is_Expanded_Build_In_Place_Call); + pragma Inline (Set_Is_Finalization_Wrapper); pragma Inline (Set_Is_Folded_In_Parser); pragma Inline (Set_Is_In_Discriminant_Check); pragma Inline (Set_Is_Machine_Number); diff --git a/gcc/ada/stringt.adb b/gcc/ada/stringt.adb index 8d3b2da3176..c0ec2f10fdf 100644 --- a/gcc/ada/stringt.adb +++ b/gcc/ada/stringt.adb @@ -70,7 +70,7 @@ package body Stringt is -- when Start_String is called with a parameter that is the last string -- currently allocated in the table. - Strings_Last : String_Id := First_String_Id; + Strings_Last : String_Id := First_String_Id; String_Chars_Last : Int := 0; -- Strings_Last and String_Chars_Last are used by procedure Mark and -- Release to get a snapshot of the tables and to restore them to their diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 7fb472554a3..7f96df03e47 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -63,12 +63,13 @@ package Stringt is -- Unlock internal tables, in case back end needs to modify them procedure Mark; - -- Take a snapshot of the internal tables + -- Take a snapshot of the internal tables. Used in conjunction with Release + -- when computing temporary string values that need not be preserved. procedure Release; -- Restore the internal tables to the situation when Mark was last called. - -- Mark and Release are used when getting checksums of sources in minimal - -- recompilation mode, to reduce memory usage. + -- If Release is called with no prior call to Mark, the entire string table + -- is cleared to its initial (empty) setting. procedure Start_String; -- Sets up for storing a new string in the table. To store a string, a -- 2.30.2