diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 30 | ||||
| -rw-r--r-- | gcc/ada/checks.adb | 134 | ||||
| -rw-r--r-- | gcc/ada/checks.ads | 16 | ||||
| -rw-r--r-- | gcc/ada/exp_ch4.adb | 26 | ||||
| -rw-r--r-- | gcc/ada/osint.adb | 2 | ||||
| -rw-r--r-- | gcc/ada/s-spsufi.adb | 20 | ||||
| -rw-r--r-- | gcc/ada/s-spsufi.ads | 3 | ||||
| -rw-r--r-- | gcc/ada/s-stposu.adb | 37 | ||||
| -rw-r--r-- | gcc/ada/s-stposu.ads | 8 | ||||
| -rw-r--r-- | gcc/ada/s-tassta.adb | 15 | ||||
| -rw-r--r-- | gcc/ada/sem_prag.adb | 10 | ||||
| -rw-r--r-- | gcc/ada/switch-c.adb | 8 |
12 files changed, 168 insertions, 141 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8196e94e8ad..7936d18be8f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,33 @@ +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. diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 075eb14caeb..8ec1b2ec588 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -765,9 +765,9 @@ package body Checks is 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) @@ -775,9 +775,9 @@ package body Checks is 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); @@ -797,7 +797,7 @@ package body Checks is -- 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. @@ -805,9 +805,9 @@ package body Checks is -- 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 @@ -1117,10 +1117,11 @@ package body Checks is 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); @@ -1164,8 +1165,8 @@ package body Checks is -- 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); @@ -1206,9 +1207,10 @@ package body Checks is 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 @@ -3813,8 +3815,8 @@ package body Checks is 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))); @@ -4442,13 +4444,14 @@ package body Checks is 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 @@ -6691,9 +6694,9 @@ package body Checks is -- 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 @@ -6710,12 +6713,12 @@ package body Checks is -- 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; @@ -6755,33 +6758,33 @@ package body Checks is -- 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 -- @@ -6858,7 +6861,7 @@ package body Checks is 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 @@ -6901,8 +6904,8 @@ package body Checks is 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! @@ -6952,8 +6955,6 @@ package body Checks is 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; @@ -6986,7 +6987,7 @@ package body Checks is -- 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); @@ -7057,7 +7058,7 @@ package body Checks is -- 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; @@ -7069,10 +7070,6 @@ package body Checks is 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 @@ -7297,13 +7294,13 @@ package body Checks is -- 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; @@ -7412,13 +7409,13 @@ package body Checks is 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 @@ -7428,11 +7425,12 @@ package body Checks is 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) @@ -7455,8 +7453,8 @@ package body Checks is 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 diff --git a/gcc/ada/checks.ads b/gcc/ada/checks.ads index 8efaecef780..a989cfac05f 100644 --- a/gcc/ada/checks.ads +++ b/gcc/ada/checks.ads @@ -223,7 +223,7 @@ package Checks is -- 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; @@ -273,7 +273,7 @@ package Checks is 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 @@ -289,13 +289,13 @@ package Checks is -- -- 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. @@ -310,8 +310,8 @@ package Checks is -- 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 @@ -320,7 +320,7 @@ package Checks 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 @@ -328,7 +328,7 @@ package Checks is -- 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 diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index f47bae4b918..9e28fc6d01c 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -141,8 +141,8 @@ package body Exp_Ch4 is -- 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; @@ -165,10 +165,10 @@ package body Exp_Ch4 is -- 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 @@ -5524,7 +5524,7 @@ package body Exp_Ch4 is 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. @@ -7084,7 +7084,7 @@ package body Exp_Ch4 is 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); @@ -7678,7 +7678,7 @@ package body Exp_Ch4 is 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); @@ -7728,7 +7728,7 @@ package body Exp_Ch4 is 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); @@ -7778,7 +7778,7 @@ package body Exp_Ch4 is 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); @@ -7828,7 +7828,7 @@ package body Exp_Ch4 is 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); @@ -8263,7 +8263,7 @@ package body Exp_Ch4 is 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); diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index af355a16a26..8765b4cb60e 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -1658,7 +1658,7 @@ package body Osint is -- 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); diff --git a/gcc/ada/s-spsufi.adb b/gcc/ada/s-spsufi.adb index 86b18aad7df..9ed8e3ee5ec 100644 --- a/gcc/ada/s-spsufi.adb +++ b/gcc/ada/s-spsufi.adb @@ -7,7 +7,7 @@ -- -- -- 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- -- @@ -30,6 +30,9 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Unchecked_Deallocation; +with System.Finalization_Masters; use System.Finalization_Masters; + package body System.Storage_Pools.Subpools.Finalization is ----------------------------- @@ -37,6 +40,8 @@ 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. @@ -48,9 +53,18 @@ package body System.Storage_Pools.Subpools.Finalization is 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 diff --git a/gcc/ada/s-spsufi.ads b/gcc/ada/s-spsufi.ads index 66aac4b07a9..c1f4d641eaa 100644 --- a/gcc/ada/s-spsufi.ads +++ b/gcc/ada/s-spsufi.ads @@ -7,7 +7,7 @@ -- -- -- 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- -- @@ -33,6 +33,7 @@ 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: diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb index 7838e48d8e8..99a61174e0f 100644 --- a/gcc/ada/s-stposu.adb +++ b/gcc/ada/s-stposu.adb @@ -31,12 +31,13 @@ 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 @@ -51,11 +52,6 @@ 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 -- ----------------------------------- @@ -544,9 +540,10 @@ package body System.Storage_Pools.Subpools is -- 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 => @@ -565,32 +562,6 @@ package body System.Storage_Pools.Subpools is 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 -- ------------------------------ diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads index 40fe676bdaf..c80dd9e3446 100644 --- a/gcc/ada/s-stposu.ads +++ b/gcc/ada/s-stposu.ads @@ -325,6 +325,9 @@ private -- 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 @@ -333,11 +336,6 @@ private -- 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; diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index 57c28be4ee5..0b4a742ec1f 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -1905,7 +1905,16 @@ package body System.Tasking.Stages is 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 @@ -2088,9 +2097,7 @@ package body System.Tasking.Stages is -- 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 diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 258ec5b1685..c791c3344a7 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -11798,8 +11798,16 @@ package body Sem_Prag is 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; diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb index 7dbbd8a86b6..2a96c06d11a 100644 --- a/gcc/ada/switch-c.adb +++ b/gcc/ada/switch-c.adb @@ -53,7 +53,7 @@ package body Switch.C is 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; @@ -867,11 +867,11 @@ package body Switch.C is 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; |