aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorRobert Dewar <dewar@adacore.com>2014-07-30 13:48:04 +0000
committerArnaud Charlet <charlet@gcc.gnu.org>2014-07-30 15:48:04 +0200
commit3aac5551307840a5063d13759922cf334db2caeb (patch)
treed4a81b782569bcedc25fe6e5ba6e07906d83a49c /gcc/ada
parent274d2584e534a5e63be48999c794e90a73d420cb (diff)
downloadgcc-3aac5551307840a5063d13759922cf334db2caeb.zip
gcc-3aac5551307840a5063d13759922cf334db2caeb.tar.gz
gcc-3aac5551307840a5063d13759922cf334db2caeb.tar.bz2
exp_ch7.adb, [...]: Minor reformatting.
2014-07-30 Robert Dewar <dewar@adacore.com> * exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads, inline.adb, s-parame-hpux.ads, exp_smem.adb, s-tasini.adb, s-tasini.ads, s-parame-vms-ia64.ads, s-parame.ads, s-taskin.ads, s-parame-vxworks.ads, a-tasatt.adb, a-tasatt.ads: Minor reformatting. * a-suenco.adb (Convert): Handle overlong encodings in UTF8-UTF8 conversion. From-SVN: r213268
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/ChangeLog9
-rw-r--r--gcc/ada/a-suenco.adb67
-rw-r--r--gcc/ada/a-tasatt.adb44
-rw-r--r--gcc/ada/a-tasatt.ads40
-rw-r--r--gcc/ada/exp_ch7.adb13
-rw-r--r--gcc/ada/exp_smem.adb18
-rw-r--r--gcc/ada/inline.adb2
-rw-r--r--gcc/ada/s-parame-hpux.ads2
-rw-r--r--gcc/ada/s-parame-vms-alpha.ads2
-rw-r--r--gcc/ada/s-parame-vms-ia64.ads2
-rw-r--r--gcc/ada/s-parame-vxworks.ads2
-rw-r--r--gcc/ada/s-parame.ads2
-rw-r--r--gcc/ada/s-tasini.adb1
-rw-r--r--gcc/ada/s-tasini.ads6
-rw-r--r--gcc/ada/s-taskin.ads6
-rw-r--r--gcc/ada/s-tataat.adb24
-rw-r--r--gcc/ada/s-tataat.ads17
17 files changed, 170 insertions, 87 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c7e1696..b13804b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,12 @@
+2014-07-30 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch7.adb, s-tataat.adb, s-tataat.ads, s-parame-vms-alpha.ads,
+ inline.adb, s-parame-hpux.ads, exp_smem.adb, s-tasini.adb,
+ s-tasini.ads, s-parame-vms-ia64.ads, s-parame.ads, s-taskin.ads,
+ s-parame-vxworks.ads, a-tasatt.adb, a-tasatt.ads: Minor reformatting.
+ * a-suenco.adb (Convert): Handle overlong encodings in UTF8-UTF8
+ conversion.
+
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* sem_ch5.adb: Improve error recovery.
diff --git a/gcc/ada/a-suenco.adb b/gcc/ada/a-suenco.adb
index ea83123..54d142d 100644
--- a/gcc/ada/a-suenco.adb
+++ b/gcc/ada/a-suenco.adb
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
--- Copyright (C) 2010-2013, Free Software Foundation, Inc. --
+-- Copyright (C) 2010-2014, 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- --
@@ -42,7 +42,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
is
begin
-- Nothing to do if identical schemes, but for UTF_8 we need to
- -- exclude overlong encodings, so need to do the full conversion.
+ -- handle overlong encodings, so need to do the full conversion.
if Input_Scheme = Output_Scheme
and then Input_Scheme /= UTF_8
@@ -50,7 +50,8 @@ package body Ada.Strings.UTF_Encoding.Conversions is
return Item;
-- For remaining cases, one or other of the operands is UTF-16BE/LE
- -- encoded, so go through UTF-16 intermediate.
+ -- encoded, or we have the UTF-8 to UTF-8 case where we must handle
+ -- overlong encodings. In all cases, go through UTF-16 intermediate.
else
return Convert (UTF_16_Wide_String'(Convert (Item, Input_Scheme)),
@@ -159,7 +160,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
C := To_Unsigned_8 (Item (Iptr));
Iptr := Iptr + 1;
- -- Codes in the range 16#00# - 16#7F#
+ -- Codes in the range 16#00# .. 16#7F#
-- UTF-8: 0xxxxxxx
-- UTF-16: 00000000_0xxxxxxx
@@ -173,7 +174,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
elsif C <= 2#10_111111# then
Raise_Encoding_Error (Iptr - 1);
- -- Codes in the range 16#80# - 16#7FF#
+ -- Codes in the range 16#80# .. 16#7FF#
-- UTF-8: 110yyyxx 10xxxxxx
-- UTF-16: 00000yyy_xxxxxxxx
@@ -183,7 +184,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
Len := Len + 1;
Result (Len) := Wide_Character'Val (R);
- -- Codes in the range 16#800# - 16#FFFF#
+ -- Codes in the range 16#800# .. 16#D7FF or 16#DF01# .. 16#FFFF#
-- UTF-8: 1110yyyy 10yyyyxx 10xxxxxx
-- UTF-16: yyyyyyyy_xxxxxxxx
@@ -201,7 +202,7 @@ package body Ada.Strings.UTF_Encoding.Conversions is
Raise_Encoding_Error (Iptr - 3);
end if;
- -- Codes in the range 16#10000# - 16#10FFFF#
+ -- Codes in the range 16#10000# .. 16#10FFFF#
-- UTF-8: 11110zzz 10zzyyyy 10yyyyxx 10xxxxxx
-- UTF-16: 110110zz_zzyyyyyy 110111yy_xxxxxxxx
-- Note: zzzz in the output is input zzzzz - 1
@@ -212,24 +213,50 @@ package body Ada.Strings.UTF_Encoding.Conversions is
-- R now has zzzzzyyyy
- R := R - 2#0000_1_0000#;
+ -- At this stage, we check for the case where we have an overlong
+ -- encoding, and the encoded value in fact lies in the single word
+ -- range (16#800# .. 16#D7FF or 16#DF01# .. 16#FFFF#). This means
+ -- that the result fits in a single result word.
- -- R now has zzzzyyyy (zzzz minus one for the output)
+ if R <= 2#1111# then
+ Get_Continuation;
+ Get_Continuation;
- Get_Continuation;
+ -- Make sure we are not in the forbidden surrogate range
- -- R now has zzzzyyyyyyyyxx
+ if R in 16#D800# .. 16#DF00# then
+ Raise_Encoding_Error (Iptr - 3);
+ end if;
- Len := Len + 1;
- Result (Len) :=
- Wide_Character'Val
- (2#110110_00_0000_0000# or Shift_Right (R, 4));
+ -- Otherwise output a single UTF-16 value
- R := R and 2#1111#;
- Get_Continuation;
- Len := Len + 1;
- Result (Len) :=
- Wide_Character'Val (2#110111_00_0000_0000# or R);
+ Len := Len + 1;
+ Result (Len) := Wide_Character'Val (R);
+
+ -- Here for normal case (code value > 16#FFFF and zzzzz non-zero)
+
+ else
+ -- Subtract 1 from input zzzzz value to get output zzzz value
+
+ R := R - 2#0000_1_0000#;
+
+ -- R now has zzzzyyyy (zzzz minus one for the output)
+
+ Get_Continuation;
+
+ -- R now has zzzzyy_yyyyyyxx
+
+ Len := Len + 1;
+ Result (Len) :=
+ Wide_Character'Val
+ (2#110110_00_0000_0000# or Shift_Right (R, 4));
+
+ R := R and 2#1111#;
+ Get_Continuation;
+ Len := Len + 1;
+ Result (Len) :=
+ Wide_Character'Val (2#110111_00_0000_0000# or R);
+ end if;
-- Any other code is an error
diff --git a/gcc/ada/a-tasatt.adb b/gcc/ada/a-tasatt.adb
index 015f625..c127fe0 100644
--- a/gcc/ada/a-tasatt.adb
+++ b/gcc/ada/a-tasatt.adb
@@ -70,13 +70,14 @@ package body Ada.Task_Attributes is
-- Each value in the task control block's Attributes array is either
-- mapped to the attribute value directly if Fast_Path is True, or
-- is in effect a Real_Attribute_Access.
+ --
-- Note: the Deallocator field must be first, for compatibility with
-- System.Tasking.Task_Attributes.Attribute_Record and to allow unchecked
-- conversions between Attribute_Access and Real_Attribute_Access.
function New_Attribute (Val : Attribute) return Atomic_Address;
- -- Create a new Real_Attribute using Val, and return its address.
- -- The returned value can be converted via To_Real_Attribute.
+ -- Create a new Real_Attribute using Val, and return its address. The
+ -- returned value can be converted via To_Real_Attribute.
procedure Deallocate (Ptr : Atomic_Address);
-- Free memory associated with Ptr, a Real_Attribute_Access in reality
@@ -84,21 +85,25 @@ package body Ada.Task_Attributes is
function To_Real_Attribute is new
Ada.Unchecked_Conversion (Atomic_Address, Real_Attribute_Access);
- -- Kill warning about possible size mismatch
pragma Warnings (Off);
+ -- Kill warning about possible size mismatch
+
function To_Address is new
Ada.Unchecked_Conversion (Attribute, Atomic_Address);
function To_Attribute is new
Ada.Unchecked_Conversion (Atomic_Address, Attribute);
+
pragma Warnings (On);
function To_Address is new
Ada.Unchecked_Conversion (Real_Attribute_Access, Atomic_Address);
- -- Kill warning about possible aliasing
pragma Warnings (Off);
+ -- Kill warning about possible aliasing
+
function To_Handle is new
Ada.Unchecked_Conversion (System.Address, Attribute_Handle);
+
pragma Warnings (On);
function To_Task_Id is new Ada.Unchecked_Conversion
@@ -109,15 +114,15 @@ package body Ada.Task_Attributes is
Ada.Unchecked_Deallocation (Real_Attribute, Real_Attribute_Access);
Fast_Path : constant Boolean :=
- Attribute'Size <= Atomic_Address'Size and then
- To_Address (Initial_Value) = 0;
+ Attribute'Size <= Atomic_Address'Size
+ and then To_Address (Initial_Value) = 0;
-- If the attribute fits in an Atomic_Address and Initial_Value is 0 (or
-- null), then we will map the attribute directly into
-- ATCB.Attributes (Index), otherwise we will create a level of indirection
-- and instead use Attributes (Index) as a Real_Attribute_Access.
Index : constant Integer :=
- Next_Index (Require_Finalization => not Fast_Path);
+ Next_Index (Require_Finalization => not Fast_Path);
-- Index in the task control block's Attributes array
--------------
@@ -126,11 +131,13 @@ package body Ada.Task_Attributes is
procedure Finalize (Cleanup : in out Attribute_Cleanup) is
pragma Unreferenced (Cleanup);
+
begin
STPO.Lock_RTS;
declare
C : System.Tasking.Task_Id := System.Tasking.All_Tasks_List;
+
begin
while C /= null loop
STPO.Write_Lock (C);
@@ -168,9 +175,8 @@ package body Ada.Task_Attributes is
function New_Attribute (Val : Attribute) return Atomic_Address is
Tmp : Real_Attribute_Access;
begin
- Tmp := new Real_Attribute'
- (Free => Deallocate'Unrestricted_Access,
- Value => Val);
+ Tmp := new Real_Attribute'(Free => Deallocate'Unrestricted_Access,
+ Value => Val);
return To_Address (Tmp);
end New_Attribute;
@@ -184,7 +190,7 @@ package body Ada.Task_Attributes is
is
Self_Id : Task_Id;
TT : constant Task_Id := To_Task_Id (T);
- Error_Message : constant String := "Trying to get the reference of a ";
+ Error_Message : constant String := "trying to get the reference of a ";
Result : Attribute_Handle;
begin
@@ -235,8 +241,11 @@ package body Ada.Task_Attributes is
end if;
if Fast_Path then
+
-- No finalization needed, simply reset to Initial_Value
+
TT.Attributes (Index) := To_Address (Initial_Value);
+
else
Self_Id := STPO.Self;
Task_Lock (Self_Id);
@@ -264,7 +273,7 @@ package body Ada.Task_Attributes is
is
Self_Id : Task_Id;
TT : constant Task_Id := To_Task_Id (T);
- Error_Message : constant String := "Trying to Set the Value of a ";
+ Error_Message : constant String := "trying to set the value of a ";
begin
if TT = null then
@@ -276,14 +285,18 @@ package body Ada.Task_Attributes is
end if;
if Fast_Path then
+
-- No finalization needed, simply set to Val
+
TT.Attributes (Index) := To_Address (Val);
+
else
Self_Id := STPO.Self;
Task_Lock (Self_Id);
declare
Attr : Atomic_Address renames TT.Attributes (Index);
+
begin
if Attr /= 0 then
Deallocate (Attr);
@@ -306,7 +319,7 @@ package body Ada.Task_Attributes is
is
Self_Id : Task_Id;
TT : constant Task_Id := To_Task_Id (T);
- Error_Message : constant String := "Trying to get the Value of a ";
+ Error_Message : constant String := "trying to get the value of a ";
begin
if TT = null then
@@ -319,20 +332,23 @@ package body Ada.Task_Attributes is
if Fast_Path then
return To_Attribute (TT.Attributes (Index));
+
else
Self_Id := STPO.Self;
Task_Lock (Self_Id);
declare
Attr : Atomic_Address renames TT.Attributes (Index);
+
begin
if Attr = 0 then
Task_Unlock (Self_Id);
return Initial_Value;
+
else
declare
Result : constant Attribute :=
- To_Real_Attribute (Attr).Value;
+ To_Real_Attribute (Attr).Value;
begin
Task_Unlock (Self_Id);
return Result;
diff --git a/gcc/ada/a-tasatt.ads b/gcc/ada/a-tasatt.ads
index ebcf253..a3e1f0e 100644
--- a/gcc/ada/a-tasatt.ads
+++ b/gcc/ada/a-tasatt.ads
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2014, Free Software Foundation, Inc. --
-- --
-- This specification is derived from the Ada Reference Manual for use with --
-- GNAT. The copyright notice above, and the license provisions that follow --
@@ -41,28 +41,52 @@ generic
package Ada.Task_Attributes is
+ -- Note that this package will use an efficient implementation with no
+ -- locks and no extra dynamic memory allocation if Attribute can fit in a
+ -- System.Address type, and Initial_Value is 0 (null for an access type).
+
+ -- Other types and initial values are supported, but will require
+ -- the use of locking and a level of indirection (meaning extra dynamic
+ -- memory allocation).
+
+ -- The maximum number of task attributes supported by this implementation
+ -- is determined by the constant System.Parameters.Max_Attribute_Count.
+ -- If you exceed this number, Storage_Error will be raised during the
+ -- elaboration of the instantiation of this package.
+
type Attribute_Handle is access all Attribute;
function Value
- (T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task) return Attribute;
+ (T : Ada.Task_Identification.Task_Id :=
+ Ada.Task_Identification.Current_Task) return Attribute;
+ -- Return the value of the corresponding attribute of T. Tasking_Error
+ -- is raised if T is terminated and Program_Error will be raised if T
+ -- is Null_Task_Id.
function Reference
- (T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task) return Attribute_Handle;
+ (T : Ada.Task_Identification.Task_Id :=
+ Ada.Task_Identification.Current_Task) return Attribute_Handle;
+ -- Return an access value that designates the corresponding attribute of
+ -- T. Tasking_Error is raised if T is terminated and Program_Error will be
+ -- raised if T is Null_Task_Id.
procedure Set_Value
(Val : Attribute;
T : Ada.Task_Identification.Task_Id :=
Ada.Task_Identification.Current_Task);
+ -- Finalize the old value of the attribute of T and assign Val to that
+ -- attribute. Tasking_Error is raised if T is terminated and Program_Error
+ -- will be raised if T is Null_Task_Id.
procedure Reinitialize
- (T : Ada.Task_Identification.Task_Id :=
- Ada.Task_Identification.Current_Task);
+ (T : Ada.Task_Identification.Task_Id :=
+ Ada.Task_Identification.Current_Task);
+ -- Same as Set_Value (Initial_Value, T). Tasking_Error is raised if T is
+ -- terminated and Program_Error will be raised if T is Null_Task_Id.
private
pragma Inline (Value);
+ pragma Inline (Reference);
pragma Inline (Set_Value);
pragma Inline (Reinitialize);
-
end Ada.Task_Attributes;
diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index 32b254f..2477347 100644
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -5022,13 +5022,14 @@ package body Exp_Ch7 is
-- Reset the action lists
- Scope_Stack.Table (Scope_Stack.Last).
- Actions_To_Be_Wrapped (Before) := No_List;
- Scope_Stack.Table (Scope_Stack.Last).
- Actions_To_Be_Wrapped (After) := No_List;
+ Scope_Stack.Table
+ (Scope_Stack.Last).Actions_To_Be_Wrapped (Before) := No_List;
+ Scope_Stack.Table
+ (Scope_Stack.Last).Actions_To_Be_Wrapped (After) := No_List;
+
if Clean then
- Scope_Stack.Table (Scope_Stack.Last).
- Actions_To_Be_Wrapped (Cleanup) := No_List;
+ Scope_Stack.Table
+ (Scope_Stack.Last).Actions_To_Be_Wrapped (Cleanup) := No_List;
end if;
end;
end Insert_Actions_In_Scope_Around;
diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb
index a870660..c264b50 100644
--- a/gcc/ada/exp_smem.adb
+++ b/gcc/ada/exp_smem.adb
@@ -189,25 +189,24 @@ package body Exp_Smem is
-- subtypes in transient scopes.
Vid := Make_Temporary (Loc, 'N', Obj);
- Vde := Make_Object_Declaration (Loc,
+ Vde :=
+ Make_Object_Declaration (Loc,
Defining_Identifier => Vid,
Constant_Present => True,
Object_Definition => New_Occurrence_Of (Standard_String, Loc),
Expression => Make_String_Literal (Loc, Vnm));
- if In_Transient then
-
- -- Already in a transient scope: make sure we insert Vde outside
- -- that scope.
+ -- Already in a transient scope. Make sure that we insert Vde outside
+ -- that scope.
+ if In_Transient then
Insert_Before_And_Analyze (Node_To_Be_Wrapped, Vde);
- else
- -- Not in a transient scope yet: insert Vde as an action on N prio
- -- to establishing one.
+ -- Not in a transient scope yet: insert Vde as an action on N prior to
+ -- establishing one.
+ else
Insert_Action (N, Vde);
-
Establish_Transient_Scope (N, Sec_Stack => False);
end if;
@@ -216,6 +215,7 @@ package body Exp_Smem is
declare
Locked_Shared_Objects : Elist_Id renames
Scope_Stack.Table (Scope_Stack.Last).Locked_Shared_Objects;
+
begin
if Locked_Shared_Objects = No_Elist then
Locked_Shared_Objects := New_Elmt_List;
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index b2ff243..4f09958 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -1698,7 +1698,7 @@ package body Inline is
elsif Present (Body_Id)
and then (No (SPARK_Pragma (Body_Id))
or else
- Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On)
+ Get_SPARK_Mode_From_Pragma (SPARK_Pragma (Body_Id)) /= On)
then
return False;
diff --git a/gcc/ada/s-parame-hpux.ads b/gcc/ada/s-parame-hpux.ads
index b5e5d32..8ee4b4f 100644
--- a/gcc/ada/s-parame-hpux.ads
+++ b/gcc/ada/s-parame-hpux.ads
@@ -181,7 +181,7 @@ package System.Parameters is
---------------------
Max_Attribute_Count : constant := 32;
- -- Number of task attributes stored in the task control block.
+ -- Number of task attributes stored in the task control block
--------------------
-- Runtime Traces --
diff --git a/gcc/ada/s-parame-vms-alpha.ads b/gcc/ada/s-parame-vms-alpha.ads
index a76048d..1e7161f 100644
--- a/gcc/ada/s-parame-vms-alpha.ads
+++ b/gcc/ada/s-parame-vms-alpha.ads
@@ -184,7 +184,7 @@ package System.Parameters is
---------------------
Max_Attribute_Count : constant := 32;
- -- Number of task attributes stored in the task control block.
+ -- Number of task attributes stored in the task control block
--------------------
-- Runtime Traces --
diff --git a/gcc/ada/s-parame-vms-ia64.ads b/gcc/ada/s-parame-vms-ia64.ads
index f64b0bb..0f18f3d 100644
--- a/gcc/ada/s-parame-vms-ia64.ads
+++ b/gcc/ada/s-parame-vms-ia64.ads
@@ -184,7 +184,7 @@ package System.Parameters is
---------------------
Max_Attribute_Count : constant := 32;
- -- Number of task attributes stored in the task control block.
+ -- Number of task attributes stored in the task control block
--------------------
-- Runtime Traces --
diff --git a/gcc/ada/s-parame-vxworks.ads b/gcc/ada/s-parame-vxworks.ads
index 73007b9..e2768e5 100644
--- a/gcc/ada/s-parame-vxworks.ads
+++ b/gcc/ada/s-parame-vxworks.ads
@@ -183,7 +183,7 @@ package System.Parameters is
---------------------
Max_Attribute_Count : constant := 16;
- -- Number of task attributes stored in the task control block.
+ -- Number of task attributes stored in the task control block
--------------------
-- Runtime Traces --
diff --git a/gcc/ada/s-parame.ads b/gcc/ada/s-parame.ads
index 4ba0880..abc3f4e 100644
--- a/gcc/ada/s-parame.ads
+++ b/gcc/ada/s-parame.ads
@@ -183,7 +183,7 @@ package System.Parameters is
---------------------
Max_Attribute_Count : constant := 32;
- -- Number of task attributes stored in the task control block.
+ -- Number of task attributes stored in the task control block
--------------------
-- Runtime Traces --
diff --git a/gcc/ada/s-tasini.adb b/gcc/ada/s-tasini.adb
index 66734b1..b8e0362 100644
--- a/gcc/ada/s-tasini.adb
+++ b/gcc/ada/s-tasini.adb
@@ -814,6 +814,7 @@ package body System.Tasking.Initialization is
procedure Finalize_Attributes (T : Task_Id) is
Attr : Atomic_Address;
+
begin
for J in T.Attributes'Range loop
Attr := T.Attributes (J);
diff --git a/gcc/ada/s-tasini.ads b/gcc/ada/s-tasini.ads
index 831961a..29f10e0 100644
--- a/gcc/ada/s-tasini.ads
+++ b/gcc/ada/s-tasini.ads
@@ -38,9 +38,9 @@ package System.Tasking.Initialization is
-- Remove T from All_Tasks_List. Call this function with RTS_Lock taken
procedure Finalize_Attributes (T : Task_Id);
- -- Finalize all attributes from T
- -- This is to be called just before the ATCB is deallocated.
- -- It relies on the caller holding T.L write-lock on entry.
+ -- Finalize all attributes from T. This is to be called just before the
+ -- ATCB is deallocated. It relies on the caller holding T.L write-lock
+ -- on entry.
---------------------------------
-- Tasking-Specific Soft Links --
diff --git a/gcc/ada/s-taskin.ads b/gcc/ada/s-taskin.ads
index 9a47c6a..761bd2b 100644
--- a/gcc/ada/s-taskin.ads
+++ b/gcc/ada/s-taskin.ads
@@ -942,9 +942,9 @@ package System.Tasking is
pragma Atomic (Atomic_Address);
type Attribute_Array is
array (1 .. Parameters.Max_Attribute_Count) of Atomic_Address;
- -- Array of task attributes.
- -- The value (Atomic_Address) will either be converted to a task
- -- attribute if it fits, or to a pointer to a record by Ada.Task_Attributes
+ -- Array of task attributes. The value (Atomic_Address) will either be
+ -- converted to a task attribute if it fits, or to a pointer to a record
+ -- by Ada.Task_Attributes.
type Task_Serial_Number is mod 2 ** 64;
-- Used to give each task a unique serial number
diff --git a/gcc/ada/s-tataat.adb b/gcc/ada/s-tataat.adb
index fbdb52a..3f002fa 100644
--- a/gcc/ada/s-tataat.adb
+++ b/gcc/ada/s-tataat.adb
@@ -34,19 +34,21 @@ with System.Tasking.Initialization; use System.Tasking.Initialization;
package body System.Tasking.Task_Attributes is
- ----------------
- -- Next_Index --
- ----------------
-
type Index_Info is record
- Used, Require_Finalization : Boolean;
+ Used : Boolean;
+ -- Used is True if a given index is used by an instantiation of
+ -- Ada.Task_Attributes, False otherwise.
+
+ Require_Finalization : Boolean;
+ -- Require_Finalization is True if the attribute requires finalization
end record;
- -- Used is True if a given index is used by an instantiation of
- -- Ada.Task_Attributes, False otherwise.
- -- Require_Finalization is True if the attribute requires finalization.
Index_Array : array (1 .. Max_Attribute_Count) of Index_Info :=
- (others => (False, False));
+ (others => (False, False));
+
+ -- Note that this package will use an efficient implementation with no
+ -- locks and no extra dynamic memory allocation if Attribute can fit in a
+ -- System.Address type and Initial_Value is 0 (or null for an access type).
function Next_Index (Require_Finalization : Boolean) return Integer is
Self_Id : constant Task_Id := Self;
@@ -79,6 +81,10 @@ package body System.Tasking.Task_Attributes is
Task_Unlock (Self_Id);
end Finalize;
+ --------------------------
+ -- Require_Finalization --
+ --------------------------
+
function Require_Finalization (Index : Integer) return Boolean is
begin
pragma Assert (Index in Index_Array'Range);
diff --git a/gcc/ada/s-tataat.ads b/gcc/ada/s-tataat.ads
index 16661ae..2dd5f5e 100644
--- a/gcc/ada/s-tataat.ads
+++ b/gcc/ada/s-tataat.ads
@@ -50,17 +50,16 @@ package System.Tasking.Task_Attributes is
Ada.Unchecked_Conversion (Atomic_Address, Attribute_Access);
function Next_Index (Require_Finalization : Boolean) return Integer;
- -- Return the next attribute index available.
- -- Require_Finalization is True if the attribute requires finalization
- -- and in particular its deallocator (Free field in Attribute_Record)
- -- should be called.
- -- Raise Storage_Error if no index is available.
+ -- Return the next attribute index available. Require_Finalization is True
+ -- if the attribute requires finalization and in particular its deallocator
+ -- (Free field in Attribute_Record) should be called. Raise Storage_Error
+ -- if no index is available.
function Require_Finalization (Index : Integer) return Boolean;
- -- Return True if a given attribute index requires call to Free.
- -- This call is not protected against concurrent access, should only
- -- be called during finalization of the corresponding instantiation of
- -- Ada.Task_Attributes, or during finalization of a task.
+ -- Return True if a given attribute index requires call to Free. This call
+ -- is not protected against concurrent access, should only be called during
+ -- finalization of the corresponding instantiation of Ada.Task_Attributes,
+ -- or during finalization of a task.
procedure Finalize (Index : Integer);
-- Finalize given Index, possibly allowing future reuse