[multiple changes]

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.

From-SVN: r188449
This commit is contained in:
Arnaud Charlet 2012-06-12 13:59:32 +02:00
parent 175a7536b1
commit e98668b178
8 changed files with 89 additions and 12 deletions

View File

@ -1,3 +1,32 @@
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,

View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -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

View File

@ -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);

View File

@ -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

View File

@ -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