[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:
parent
175a7536b1
commit
e98668b178
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue