summaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorcharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-06-12 11:59:32 +0000
committercharlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4>2012-06-12 11:59:32 +0000
commita96d5239066f4cf3e728839ebc68e665d685501d (patch)
treee3355c65235add255b8c58fb03b9c7982870adc3 /gcc/ada
parent658f1736894ad7214eb9060fc31d83644b563d7d (diff)
downloadgcc-a96d5239066f4cf3e728839ebc68e665d685501d.tar.gz
2012-06-12 Robert Dewar <dewar@adacore.com>
* stringt.adb: Minor reformatting. 2012-06-12 Robert Dewar <dewar@adacore.com> * ali-util.adb, stringt.ads: Minor reformatting. 2012-06-12 Hristian Kirtchev <kirtchev@adacore.com> * 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 <baird@adacore.com> * gnat1drv.adb (Adjust_Global_Switches): No longer need to set Exception_Extra_Info in CodePeer_Mode. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@188449 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog29
-rw-r--r--gcc/ada/ali-util.adb5
-rw-r--r--gcc/ada/exp_ch7.adb21
-rw-r--r--gcc/ada/gnat1drv.adb6
-rw-r--r--gcc/ada/sinfo.adb16
-rw-r--r--gcc/ada/sinfo.ads15
-rw-r--r--gcc/ada/stringt.adb2
-rw-r--r--gcc/ada/stringt.ads7
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,5 +1,34 @@
2012-06-12 Robert Dewar <dewar@adacore.com>
+ * stringt.adb: Minor reformatting.
+
+2012-06-12 Robert Dewar <dewar@adacore.com>
+
+ * ali-util.adb, stringt.ads: Minor reformatting.
+
+2012-06-12 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * 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 <baird@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): No longer need to set
+ Exception_Extra_Info in CodePeer_Mode.
+
+2012-06-12 Robert Dewar <dewar@adacore.com>
+
* sem_dist.adb, exp_ch7.adb, sem_type.adb, exp_attr.adb,
sinfo.ads, sem_ch7.adb, exp_alfa.adb, sem_scil.adb, sem_ch12.adb,
sem_util.adb, sem_res.adb, sem_attr.adb, sem_elab.adb, exp_ch6.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
View Lorry Controller Status