+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,
-- 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;
end if;
Stringt.Release;
-
end if;
if (not Read_Only) or else Source.Table (Src).Source_Found then
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);
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);
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
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
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
-- 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
-- Is_Task_Allocation_Block (Flag6)
-- Is_Asynchronous_Call_Block (Flag7)
-- Exception_Junk (Flag8-Sem)
+ -- Is_Finalization_Wrapper (Flag9-Sem)
-------------------------
-- 5.7 Exit Statement --
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
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
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);
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);
-- 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
-- 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
projects / gcc.git / commitdiff