diff options
author | Robert Dewar <dewar@adacore.com> | 2014-07-30 13:48:04 +0000 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2014-07-30 15:48:04 +0200 |
commit | 3aac5551307840a5063d13759922cf334db2caeb (patch) | |
tree | d4a81b782569bcedc25fe6e5ba6e07906d83a49c /gcc/ada | |
parent | 274d2584e534a5e63be48999c794e90a73d420cb (diff) | |
download | gcc-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/ChangeLog | 9 | ||||
-rw-r--r-- | gcc/ada/a-suenco.adb | 67 | ||||
-rw-r--r-- | gcc/ada/a-tasatt.adb | 44 | ||||
-rw-r--r-- | gcc/ada/a-tasatt.ads | 40 | ||||
-rw-r--r-- | gcc/ada/exp_ch7.adb | 13 | ||||
-rw-r--r-- | gcc/ada/exp_smem.adb | 18 | ||||
-rw-r--r-- | gcc/ada/inline.adb | 2 | ||||
-rw-r--r-- | gcc/ada/s-parame-hpux.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-parame-vms-alpha.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-parame-vms-ia64.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-parame-vxworks.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-parame.ads | 2 | ||||
-rw-r--r-- | gcc/ada/s-tasini.adb | 1 | ||||
-rw-r--r-- | gcc/ada/s-tasini.ads | 6 | ||||
-rw-r--r-- | gcc/ada/s-taskin.ads | 6 | ||||
-rw-r--r-- | gcc/ada/s-tataat.adb | 24 | ||||
-rw-r--r-- | gcc/ada/s-tataat.ads | 17 |
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 |