+2012-10-05 Yannick Moy <moy@adacore.com>
+
+ * switch-c.adb, checks.adb, checks.ads, sem_prag.adb, exp_ch4.adb,
+ osint.adb: Minor correction of typos, and special case for Alfa mode.
+
+2012-10-05 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * s-spsufi.adb: Add with clause for Ada.Unchecked_Deallocation.
+ Add with and use clauses for System.Finalization_Masters.
+ (Finalize_And_Deallocate): Add an instance of
+ Ada.Unchecked_Deallocation. Merge the code from the now obsolete
+ Finalize_Subpool into this routine.
+ * s-spsufi.ads: Add pragma Preelaborate.
+ * s-stposu.adb: Remove with clause for
+ Ada.Unchecked_Deallocation; Add with and use clauses for
+ System.Storage_Pools.Subpools.Finalization; (Finalize_Pool):
+ Update the comment on all actions takes with respect to a subpool
+ finalization. Finalize and deallocate each individual subpool.
+ (Finalize_Subpool): Removed.
+ (Free): Removed;
+ (Detach): Move from package body to spec.
+ * s-stposu.ads (Detach): Move from package body to spec.
+ (Finalize_Subpool): Removed.
+
+2012-10-05 Arnaud Charlet <charlet@adacore.com>
+
+ * s-tassta.adb: Update comments.
+ (Vulnerable_Complete_Master): If Free_On_Termination is set, do
+ nothing, and let the task free itself if not already done.
+
2012-10-04 Robert Dewar <dewar@adacore.com>
* sem_res.adb (Resolve_Set_Membership): Warn on duplicates.
procedure Apply_Arithmetic_Overflow_Check (N : Node_Id) is
begin
-- Use old routine in almost all cases (the only case we are treating
- -- specially is the case of an signed integer arithmetic op with the
+ -- specially is the case of a signed integer arithmetic op with the
-- Do_Overflow_Check flag set on the node, and the overflow checking
- -- mode is either Minimized_Or_Eliminated.
+ -- mode is MINIMIZED or ELIMINATED).
if Overflow_Check_Mode (Etype (N)) not in Minimized_Or_Eliminated
or else not Do_Overflow_Check (N)
then
Apply_Arithmetic_Overflow_Checked_Suppressed (N);
- -- Otherwise use the new routine for MINIMIZED/ELIMINATED modes for
- -- the case of a signed integer arithmetic op, with Do_Overflow_Check
- -- set True, and the checking mode is Minimized_Or_Eliminated.
+ -- Otherwise use the new routine for the case of a signed integer
+ -- arithmetic op, with Do_Overflow_Check set to True, and the checking
+ -- mode is MINIMIZED or ELIMINATED.
else
Apply_Arithmetic_Overflow_Minimized_Eliminated (N);
-- This is used in SUPPRESSED/CHECKED modes. It is identical to the
-- code for these cases before the big overflow earthquake, thus ensuring
- -- that in these modes we have compatible behavior (and realibility) to
+ -- that in these modes we have compatible behavior (and reliability) to
-- what was there before. It is also called for types other than signed
-- integers, and if the Do_Overflow_Check flag is off.
-- to give up and just generate an overflow check without any fuss.
procedure Apply_Arithmetic_Overflow_Checked_Suppressed (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Rtyp : constant Entity_Id := Root_Type (Typ);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
+ Rtyp : constant Entity_Id := Root_Type (Typ);
begin
-- An interesting special case. If the arithmetic operation appears as
end if;
-- Otherwise, we have a top level arithmetic operation node, and this
- -- is where we commence the special processing for minimize/eliminate.
- -- This is the case where we tell the machinery not to move into Bignum
- -- mode at this top level (of course the top level operation will still
- -- be in Bignum mode if either of its operands are of type Bignum).
+ -- is where we commence the special processing for MINIMIZED/ELIMINATED
+ -- modes. This is the case where we tell the machinery not to move into
+ -- Bignum mode at this top level (of course the top level operation
+ -- will still be in Bignum mode if either of its operands are of type
+ -- Bignum).
Minimize_Eliminate_Overflow_Checks (Op, Lo, Hi, Top_Level => True);
-- X := Long_Long_Integer'Base (A * (B ** C));
-- Now the product may fit in Long_Long_Integer but not in Integer.
- -- In Minimize/Eliminate mode, we don't want to introduce an overflow
- -- exception for this intermediate value.
+ -- In MINIMIZED/ELIMINATED mode, we don't want to introduce an
+ -- overflow exception for this intermediate value.
declare
Blk : constant Node_Id := Make_Bignum_Block (Loc);
Analyze_And_Resolve (Op);
end;
- -- Here we know the result is Long_Long_Integer'Base, or that it
- -- has been rewritten because the parent is a conversion (see
- -- Apply_Arithmetic_Overflow_Check.Conversion_Optimization).
+ -- Here we know the result is Long_Long_Integer'Base,
+ -- or that it has been rewritten because the parent
+ -- is a conversion (see Conversion_Optimization in
+ -- Apply_Arithmetic_Overflow_Checked_Suppressed).
else
pragma Assert
if Is_RTE (Etype (N), RE_Bignum) then
return Relocate_Node (N);
- -- Otherwise construct call to To_Bignum, converting the operand to
- -- the required Long_Long_Integer form.
+ -- Otherwise construct call to To_Bignum, converting the operand to the
+ -- required Long_Long_Integer form.
else
pragma Assert (Is_Signed_Integer_Type (Etype (N)));
return;
end if;
- -- This is the point at which processing for CHECKED mode diverges from
- -- processing for MINIMIZED/ELIMINATED mode. This divergence is probably
- -- more extreme that it needs to be, but what is going on here is that
- -- when we introduced MINIMIZED/ELININATED modes, we wanted to leave the
- -- processing for CHECKED mode untouched. There were two reasons for
- -- this. First it avoided any incomptible change of behavior. Second,
- -- it guaranteed that CHECKED mode continued to be legacy reliable.
+ -- This is the point at which processing for CHECKED mode diverges
+ -- from processing for MINIMIZED/ELIMINATED modes. This divergence is
+ -- probably more extreme that it needs to be, but what is going on here
+ -- is that when we introduced MINIMIZED/ELIMINATED modes, we wanted
+ -- to leave the processing for CHECKED mode untouched. There were
+ -- two reasons for this. First it avoided any incompatible change of
+ -- behavior. Second, it guaranteed that CHECKED mode continued to be
+ -- legacy reliable.
-- The big difference is that in CHECKED mode there is a fair amount of
-- circuitry to try to avoid setting the Do_Overflow_Check flag if we
-- recursive calls to process operands. This processing may involve the use
-- of bignum or long long integer arithmetic, which will change the types
-- of operands and results. That's why we can't do this bottom up (since
- -- it would intefere with semantic analysis).
+ -- it would interfere with semantic analysis).
- -- What happens is that if Minimized/Eliminated mode is in effect then
+ -- What happens is that if MINIMIZED/ELIMINATED mode is in effect then
-- the operator expansion routines, as well as the expansion routines
-- for if/case expression test the Do_Overflow_Check flag and if it is
-- set they (for the moment) do nothing except call the routine to apply
-- After possible rewriting of a constituent subexpression node, a call is
-- made to either reexpand the node (if nothing has changed) or reanalyze
- -- the node (if it has been modified by the overflow check processing).
- -- The Analyzed_flag is set False before the reexpand/reanalyze. To avoid
- -- a recursive call into the whole overflow apparatus, and important rule
+ -- the node (if it has been modified by the overflow check processing). The
+ -- Analyzed_Flag is set to False before the reexpand/reanalyze. To avoid
+ -- a recursive call into the whole overflow apparatus, an important rule
-- for this call is that either Do_Overflow_Check must be False, or if
-- it is set, then the overflow checking mode must be temporarily set
- -- to Checked/Suppressed. Either step will avoid the unwanted recursion.
+ -- to CHECKED/SUPPRESSED. Either step will avoid the unwanted recursion.
procedure Minimize_Eliminate_Overflow_Checks
(N : Node_Id;
-- Set True if one or more operands is already of type Bignum, meaning
-- that for sure (regardless of Top_Level setting) we are committed to
-- doing the operation in Bignum mode (or in the case of a case or if
- -- expression, converting all the dependent expressions to bignum).
+ -- expression, converting all the dependent expressions to Bignum).
Long_Long_Integer_Operands : Boolean;
- -- Set True if one r more operands is already of type Long_Loong_Integer
+ -- Set True if one or more operands is already of type Long_Long_Integer
-- which means that if the result is known to be in the result type
-- range, then we must convert such operands back to the result type.
-- This switch is properly set only when Bignum_Operands is False.
procedure Reexpand (C : Suppressed_Or_Checked);
- -- This is called when we have not modifed the node, so we do not need
- -- to reanalyze it. But we do want to reexpand it in either CHECKED
- -- or SUPPRESSED mode (as indicated by the argument C) to get proper
+ -- This is called when we have not modified the node, so we do not need
+ -- to reanalyze it. But we do want to reexpand it in either SUPPRESSED
+ -- or CHECKED mode (as indicated by the argument C) to get proper
-- expansion. It is important that we reset the mode to SUPPRESSED or
-- CHECKED, since if we leave it in MINIMIZED or ELIMINATED mode we
-- would reenter this routine recursively which would not be good!
-- Note that this is not just an optimization, testing has showed up
- -- several complex cases in which renalyzing an already analyzed node
+ -- several complex cases in which reanalyzing an already analyzed node
-- causes incorrect behavior.
function In_Result_Range return Boolean;
-- Returns True iff Lo .. Hi are within range of the result type
procedure Max (A : in out Uint; B : Uint);
- -- If A is No_Uint, sets A to B, else to UI_Max (A, B);
+ -- If A is No_Uint, sets A to B, else to UI_Max (A, B)
procedure Min (A : in out Uint; B : Uint);
- -- If A is No_Uint, sets A to B, else to UI_Min (A, B);
+ -- If A is No_Uint, sets A to B, else to UI_Min (A, B)
---------------------
-- In_Result_Range --
Determine_Range (N, OK, Lo, Hi, Assume_Valid => False);
- -- If Deterine_Range did not work (can this in fact happen? Not
+ -- If Determine_Range did not work (can this in fact happen? Not
-- clear but might as well protect), use type bounds.
if not OK then
Max (Hi, Rhi);
end if;
- -- If at least one of our operands is now bignum, we must rebuild
- -- the if expression to use bignum operands. We will analyze the
+ -- If at least one of our operands is now Bignum, we must rebuild
+ -- the if expression to use Bignum operands. We will analyze the
-- rebuilt if expression with overflow checks off, since once we
-- are in bignum mode, we are all done with overflow checks!
elsif Nkind (N) = N_Case_Expression then
Bignum_Operands := False;
Long_Long_Integer_Operands := False;
- Lo := No_Uint;
- Hi := No_Uint;
declare
Alt : Node_Id;
-- resetting the overflow flag, since we are done with overflow
-- checks for this node. We will reexpand to get the needed
-- expansion for the case expression, but we do not need to
- -- renalyze, since nothing has changed.
+ -- reanalyze, since nothing has changed.
if not (Bignum_Operands or Long_Long_Integer_Operands) then
Set_Do_Overflow_Check (N, False);
-- don't need to do any range analysis. As previously discussed we could
-- do range analysis in such cases, but it could mean working with giant
-- numbers at compile time for very little gain (the number of cases
- -- in which we could slip back from bignum mode are small).
+ -- in which we could slip back from bignum mode is small).
if Rlo = No_Uint or else (Binary and then Llo = No_Uint) then
Lo := No_Uint;
else
Bignum_Operands := False;
- Long_Long_Integer_Operands :=
- Etype (Right_Opnd (N)) = LLIB
- or else (Binary and then Etype (Left_Opnd (N)) = LLIB);
-
case Nkind (N) is
-- Absolute value
-- Result can only be negative if base can be negative
if Llo < 0 then
- if UI_Mod (Rhi, 2) = 0 then
+ if Rhi mod 2 = 0 then
Lo := Llo ** (Rhi - 1);
else
Lo := Llo ** Rhi;
end if;
- -- Otherwise low bound is minimium ** minimum
+ -- Otherwise low bound is minimum ** minimum
else
Lo := Llo ** Rlo;
end if;
-- Here for the case where we have not rewritten anything (no bignum
- -- operands or long long integer operands), and we know the result If we
- -- know we are in the result range, and we do not have Bignum operands
- -- or Long_Long_Integer operands, we can just reexpand with overflow
- -- checks turned off (since we know we cannot have overflow). As always
- -- the reexpansion is required to complete expansion of the operator,
- -- but we do not need to reanalyze, and we prevent recursion by
- -- suppressing the check,
+ -- operands or long long integer operands), and we know the result.
+ -- If we know we are in the result range, and we do not have Bignum
+ -- operands or Long_Long_Integer operands, we can just reexpand with
+ -- overflow checks turned off (since we know we cannot have overflow).
+ -- As always the reexpansion is required to complete expansion of the
+ -- operator, but we do not need to reanalyze, and we prevent recursion
+ -- by suppressing the check.
if not (Bignum_Operands or Long_Long_Integer_Operands)
and then In_Result_Range
return;
-- Here we know that we are not in the result range, and in the general
- -- we will move into either the Bignum or Long_Long_Integer domain to
- -- compute the result. However, there is one exception. If we are at the
- -- top level, and we do not have Bignum or Long_Long_Integer operands,
- -- we will have to immediately convert the result back to the result
- -- type, so there is no point in Bignum/Long_Long_Integer fiddling.
+ -- case we will move into either the Bignum or Long_Long_Integer domain
+ -- to compute the result. However, there is one exception. If we are
+ -- at the top level, and we do not have Bignum or Long_Long_Integer
+ -- operands, we will have to immediately convert the result back to
+ -- the result type, so there is no point in Bignum/Long_Long_Integer
+ -- fiddling.
elsif Top_Level
and then not (Bignum_Operands or Long_Long_Integer_Operands)
Set_Analyzed (N, False);
-- One subtlety. We can't just go ahead and do an analyze operation
- -- here because it will cause recursion into the whole minimized/
- -- eliminated overflow processing which is not what we want. Here
+ -- here because it will cause recursion into the whole MINIMIZED/
+ -- ELIMINATED overflow processing which is not what we want. Here
-- we are at the top level, and we need a check against the result
-- mode (i.e. we want to use Checked mode). So do exactly that!
-- Also, we have not modified the node, so this is a case where
-- Returns result of converting node N to Bignum. The returned value is not
-- analyzed, the caller takes responsibility for this. Node N must be a
-- subexpression node of a signed integer type or Bignum type (if it is
- -- already a Bignnum, the returned value is Relocate_Node (N).
+ -- already a Bignum, the returned value is Relocate_Node (N)).
procedure Determine_Range
(N : Node_Id;
Top_Level : Boolean);
-- This is the main routine for handling MINIMIZED and ELIMINATED overflow
-- checks. On entry N is a node whose result is a signed integer subtype.
- -- If the node is an artihmetic operation, then a range analysis is carried
+ -- If the node is an arithmetic operation, then a range analysis is carried
-- out, and there are three possibilities:
--
-- The node is left unchanged (apart from expansion of an exponentiation
--
-- In the first two cases, Lo and Hi are set to the bounds of the possible
-- range of results, computed as accurately as possible. In the third case
- -- Lo and Hi are set to No_Uint (there are some cases where we cold get an
+ -- Lo and Hi are set to No_Uint (there are some cases where we could get an
-- advantage from keeping result ranges for Bignum values, but it could use
-- a lot of space and is very unlikely to be valuable).
--
-- If the node is not an arithmetic operation, then it is unchanged but
-- Lo and Hi are still set (to the bounds of the result subtype if nothing
- -- better can be determined.
+ -- better can be determined).
--
-- Note: this function is recursive, if called with an arithmetic operator,
-- recursive calls are made to process the operands using this procedure.
-- with a Long_Long_Integer left operand and an Integer right operand, and
-- we would get a semantic error.
--
- -- The routine is called in three situations if we are operating in
- -- either MINIMIZED or ELIMINATED modes.
+ -- The routine is called in three situations if we are operating in either
+ -- MINIMIZED or ELIMINATED modes.
--
-- Overflow checks applied to the top node of an expression tree when
-- that node is an arithmetic operator. In this case the result is
--
-- Overflow checks are applied to the operands of a comparison operation.
-- In this case, the comparison is done on the result Long_Long_Integer
- -- or Bignum values, without raising any exceptions.
+ -- or Bignum values, without raising any exception.
--
-- Overflow checks are applied to the left operand of a membership test.
-- In this case no exception is raised if a Long_Long_Integer or Bignum
-- just that the result of IN is false in that case).
--
-- Note that if Bignum values appear, the caller must take care of doing
- -- the appropriate mark/release operation on the secondary stack.
+ -- the appropriate mark/release operations on the secondary stack.
--
-- Top_Level is used to avoid inefficient unnecessary transitions into the
-- Bignum domain. If Top_Level is True, it means that the caller will have
-- Common expansion processing for short-circuit boolean operators
procedure Expand_Compare_Minimize_Eliminate_Overflow (N : Node_Id);
- -- Deal with comparison in Minimize/Eliminate overflow mode. This is where
- -- we allow comparison of "out of range" values.
+ -- Deal with comparison in MINIMIZED/ELIMINATED overflow mode. This is
+ -- where we allow comparison of "out of range" values.
function Expand_Composite_Equality
(Nod : Node_Id;
-- include both arrays and singleton elements.
procedure Expand_Membership_Minimize_Eliminate_Overflow (N : Node_Id);
- -- N is an N_In membership test mode, with the overflow check mode
- -- set to Minimized or Eliminated, and the type of the left operand
- -- is a signed integer type. This is a case where top level processing
- -- is required to handle overflow checks in subtrees.
+ -- N is an N_In membership test mode, with the overflow check mode set to
+ -- MINIMIZED or ELIMINATED, and the type of the left operand is a signed
+ -- integer type. This is a case where top level processing is required to
+ -- handle overflow checks in subtrees.
procedure Fixup_Universal_Fixed_Operation (N : Node_Id);
-- N is a N_Op_Divide or N_Op_Multiply node whose result is universal
Ltyp := Etype (Left_Opnd (N));
Rtyp := Etype (Right_Opnd (N));
- -- If Minimize/Eliminate overflow mode and type is a signed integer
+ -- If MINIMIZED/ELIMINATED overflow mode and type is a signed integer
-- type, then expand with a separate procedure. Note the use of the
-- flag No_Minimize_Eliminate to prevent infinite recursion.
Typl := Base_Type (Typl);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
- -- results in not having a comparison operation any more, we are done.
+ -- results in not having a comparison operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
Binary_Op_Validity_Checks (N);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
- -- results in not having a comparison operation any more, we are done.
+ -- results in not having a comparison operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
Binary_Op_Validity_Checks (N);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
- -- results in not having a comparison operation any more, we are done.
+ -- results in not having a comparison operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
Binary_Op_Validity_Checks (N);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
- -- results in not having a comparison operation any more, we are done.
+ -- results in not having a comparison operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
Binary_Op_Validity_Checks (N);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if that
- -- results in not having a comparison operation any more, we are done.
+ -- results in not having a comparison operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
Binary_Op_Validity_Checks (N);
-- Deal with overflow checks in MINIMIZED/ELIMINATED mode and if
- -- that results in not having a /= opertion any more, we are done.
+ -- that results in not having a /= operation anymore, we are done.
Expand_Compare_Minimize_Eliminate_Overflow (N);
-- Start off by setting all suppress options, to False. The special
-- overflow fields are set to Not_Set (they will be set by -gnatp, or
-- by -gnato, or, if neither of these appear, in Adjust_Global_Switches
- -- in Gnat1drv.
+ -- in Gnat1drv).
Suppress_Options := ((others => False), Not_Set, Not_Set);
-- --
-- B o d y --
-- --
--- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- --
------------------------------------------------------------------------------
+with Ada.Unchecked_Deallocation;
+with System.Finalization_Masters; use System.Finalization_Masters;
+
package body System.Storage_Pools.Subpools.Finalization is
-----------------------------
-----------------------------
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle) is
+ procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr);
+
begin
-- Do nothing if the subpool was never created or never used. The latter
-- case may arise with an array of subpool implementations.
return;
end if;
- -- Clean up all controlled objects allocated through the subpool
+ -- Clean up all controlled objects chained on the subpool's master
+
+ Finalize (Subpool.Master);
+
+ -- Remove the subpool from its owner's list of subpools
+
+ Detach (Subpool.Node);
+
+ -- Destroy the associated doubly linked list node which was created in
+ -- Set_Pool_Of_Subpools.
- Finalize_Subpool (Subpool);
+ Free (Subpool.Node);
-- Dispatch to the user-defined implementation of Deallocate_Subpool
-- --
-- S p e c --
-- --
--- Copyright (C) 2011, Free Software Foundation, Inc. --
+-- Copyright (C) 2011-2012, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
pragma Compiler_Unit;
package System.Storage_Pools.Subpools.Finalization is
+ pragma Preelaborate;
procedure Finalize_And_Deallocate (Subpool : in out Subpool_Handle);
-- This routine performs the following actions:
with Ada.Exceptions; use Ada.Exceptions;
with Ada.Unchecked_Conversion;
-with Ada.Unchecked_Deallocation;
with System.Address_Image;
with System.Finalization_Masters; use System.Finalization_Masters;
with System.IO; use System.IO;
with System.Soft_Links; use System.Soft_Links;
with System.Storage_Elements; use System.Storage_Elements;
+with System.Storage_Pools.Subpools.Finalization;
+use System.Storage_Pools.Subpools.Finalization;
package body System.Storage_Pools.Subpools is
procedure Attach (N : not null SP_Node_Ptr; L : not null SP_Node_Ptr);
-- Attach a subpool node to a pool
- procedure Free is new Ada.Unchecked_Deallocation (SP_Node, SP_Node_Ptr);
-
- procedure Detach (N : not null SP_Node_Ptr);
- -- Unhook a subpool node from an arbitrary subpool list
-
-----------------------------------
-- Adjust_Controlled_Dereference --
-----------------------------------
-- 2) Remove the the subpool from the owner's list of subpools
-- 3) Deallocate the doubly linked list node associated with the
-- subpool.
+ -- 4) Call Deallocate_Subpool
begin
- Finalize_Subpool (Curr_Ptr.Subpool);
+ Finalize_And_Deallocate (Curr_Ptr.Subpool);
exception
when Fin_Occur : others =>
end if;
end Finalize_Pool;
- ----------------------
- -- Finalize_Subpool --
- ----------------------
-
- procedure Finalize_Subpool (Subpool : not null Subpool_Handle) is
- begin
- -- Do nothing if the subpool was never used
-
- if Subpool.Owner = null or else Subpool.Node = null then
- return;
- end if;
-
- -- Clean up all controlled objects chained on the subpool's master
-
- Finalize (Subpool.Master);
-
- -- Remove the subpool from its owner's list of subpools
-
- Detach (Subpool.Node);
-
- -- Destroy the associated doubly linked list node which was created in
- -- Set_Pool_Of_Subpool.
-
- Free (Subpool.Node);
- end Finalize_Subpool;
-
------------------------------
-- Header_Size_With_Padding --
------------------------------
-- is controlled. When set to True, the machinery generates additional
-- data.
+ procedure Detach (N : not null SP_Node_Ptr);
+ -- Unhook a subpool node from an arbitrary subpool list
+
overriding procedure Finalize (Controller : in out Pool_Controller);
-- Buffer routine, calls Finalize_Pool
-- their masters. This action first detaches a controlled object from a
-- particular master, then invokes its Finalize_Address primitive.
- procedure Finalize_Subpool (Subpool : not null Subpool_Handle);
- -- Finalize all controlled objects chained on Subpool's master. Remove the
- -- subpool from its owner's list. Deallocate the associated doubly linked
- -- list node.
-
function Header_Size_With_Padding
(Alignment : System.Storage_Elements.Storage_Count)
return System.Storage_Elements.Storage_Count;
C := All_Tasks_List;
P := null;
while C /= null loop
- if C.Common.Parent = Self_ID and then C.Master_of_Task >= CM then
+ -- If Free_On_Termination is set, do nothing here, and let
+ -- the task free itself if not already done, otherwise we
+ -- risk a race condition where Vulnerable_Free_Task is called
+ -- in the loop below, while the task calls Free_Task itself,
+ -- in Terminate_Task.
+
+ if C.Common.Parent = Self_ID
+ and then C.Master_of_Task >= CM
+ and then not C.Free_On_Termination
+ then
if P /= null then
P.Common.All_Tasks_Link := C.Common.All_Tasks_Link;
else
-- is called from Expunge_Unactivated_Tasks.
-- For tasks created by elaboration of task object declarations it is
- -- called from the finalization code of the Task_Wrapper procedure. It is
- -- also called from Ada.Unchecked_Deallocation, for objects that are or
- -- contain tasks.
+ -- called from the finalization code of the Task_Wrapper procedure.
procedure Vulnerable_Free_Task (T : Task_Id) is
begin
Check_Optional_Identifier (Arg, Name);
Check_Arg_Is_Identifier (Argx);
+ -- Do not suppress overflow checks for formal verification.
+ -- Instead, require that a check is inserted so that formal
+ -- verification can detect wraparound errors.
+
if Chars (Argx) = Name_Suppressed then
- return Suppressed;
+ if Alfa_Mode then
+ return Checked;
+ else
+ return Suppressed;
+ end if;
elsif Chars (Argx) = Name_Checked then
return Checked;
function Get_Overflow_Mode (C : Character) return Overflow_Check_Type;
-- Given a digit in the range 0 .. 3, returns the corresponding value of
- -- Overflow_Check_Type. Raises program error if C is outside this range.
+ -- Overflow_Check_Type. Raises Program_Error if C is outside this range.
function Switch_Subsequently_Cancelled
(C : String;
then
Suppress_Options.Suppress (J) := True;
end if;
-
- Suppress_Options.Overflow_Checks_General := Suppressed;
- Suppress_Options.Overflow_Checks_Assertions := Suppressed;
end loop;
+ Suppress_Options.Overflow_Checks_General := Suppressed;
+ Suppress_Options.Overflow_Checks_Assertions := Suppressed;
+
Validity_Checks_On := False;
Opt.Suppress_Checks := True;
end if;
projects / platform / upstream / gcc.git / commitdiff