From d7db3f4f65563632493aa82c1cf12c7ed3f89eff Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Wed, 30 May 2018 08:58:27 +0000 Subject: [PATCH] [Ada] Extend the applicability of Thread_Local_Storage to composite types This patch allows the GNAT-specific Thread_Local_Storage to be applied to variables of a composite type initiallized with an aggregate with static components that requires no elaboration code. 2018-05-30 Ed Schonberg gcc/ada/ * freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage is now legal on a variable of composite type initialized with an aggregate that is fully static and requires no elaboration code. * exp_aggr.adb (Convert_To_Positional): Recognize additional cases of nested aggregates that are compile-time static, so they can be used to initialize variables declared with Threqd_Local_Storage. * doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on Thread_Local_Storage. * gnat_rm.texi: Regenerate. gcc/testsuite/ * gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase. From-SVN: r260944 --- gcc/ada/ChangeLog | 12 +++++ .../doc/gnat_rm/implementation_defined_pragmas.rst | 12 +++-- gcc/ada/exp_aggr.adb | 18 ++++++++ gcc/ada/freeze.adb | 19 +++++--- gcc/ada/gnat_rm.texi | 14 +++--- gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gnat.dg/tls1.adb | 51 ++++++++++++++++++++++ gcc/testsuite/gnat.dg/tls1_pkg.ads | 23 ++++++++++ 8 files changed, 138 insertions(+), 15 deletions(-) create mode 100644 gcc/testsuite/gnat.dg/tls1.adb create mode 100644 gcc/testsuite/gnat.dg/tls1_pkg.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 258c4ac5cc3..f9a9ecac2d0 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2018-05-30 Ed Schonberg + + * freeze.adb (Freeze_Object_Declaration): A pragma Thread_Local_Storage + is now legal on a variable of composite type initialized with an + aggregate that is fully static and requires no elaboration code. + * exp_aggr.adb (Convert_To_Positional): Recognize additional cases of + nested aggregates that are compile-time static, so they can be used to + initialize variables declared with Threqd_Local_Storage. + * doc/gnat_rm/implementation_defined_pragmas.rst: Add documentation on + Thread_Local_Storage. + * gnat_rm.texi: Regenerate. + 2018-05-30 Yannick Moy * sem_util.adb (Policy_In_Effect): Take into account CodePeer and diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 353a9a5f346..aec0d8448d4 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -6613,13 +6613,17 @@ Syntax: This pragma specifies that the specified entity, which must be a variable declared in a library-level package, is to be marked as "Thread Local Storage" (``TLS``). On systems supporting this (which -include Windows, Solaris, GNU/Linux and VxWorks 6), this causes each +include Windows, Solaris, GNU/Linux, and VxWorks 6), this causes each thread (and hence each Ada task) to see a distinct copy of the variable. -The variable may not have default initialization, and if there is +The variable must not have default initialization, and if there is an explicit initialization, it must be either ``null`` for an -access variable, or a static expression for a scalar variable. -This provides a low level mechanism similar to that provided by +access variable, a static expression for a scalar variable, or a fully +static aggregate for a composite type, that is to say, an aggregate all +of whose components are static, and which does not include packed or +discriminated components. + +This provides a low-level mechanism similar to that provided by the ``Ada.Task_Attributes`` package, but much more efficient and is also useful in writing interface code that will interact with foreign threads. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index e01d374a075..e587c17f90e 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4727,7 +4727,25 @@ package body Exp_Aggr is return; end if; + -- A subaggregate may have been flattened but is not known to be + -- Compile_Time_Known. Set that flag in cases that cannot require + -- elaboration code, so that the aggregate can be used as the + -- initial value of a thread-local variable. + if Is_Flat (N, Number_Dimensions (Typ)) then + Check_Static_Components; + if Static_Components then + if Is_Packed (Etype (N)) + or else + (Is_Record_Type (Component_Type (Etype (N))) + and then Has_Discriminants (Component_Type (Etype (N)))) + then + null; + else + Set_Compile_Time_Known_Aggregate (N); + end if; + end if; + return; end if; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 598714980b6..4d7fe26c962 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3441,12 +3441,19 @@ package body Freeze is (Is_OK_Static_Expression (Expression (Decl)) or else Nkind (Expression (Decl)) = N_Null))) then - Error_Msg_NE - ("Thread_Local_Storage variable& is " - & "improperly initialized", Decl, E); - Error_Msg_NE - ("\only allowed initialization is explicit " - & "NULL or static expression", Decl, E); + if Nkind (Expression (Decl)) = N_Aggregate + and then Compile_Time_Known_Aggregate (Expression (Decl)) + then + null; + else + Error_Msg_NE + ("Thread_Local_Storage variable& is " + & "improperly initialized", Decl, E); + Error_Msg_NE + ("\only allowed initialization is explicit " + & "NULL, static expression or static aggregate", + Decl, E); + end if; end if; end; end if; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index b6cad4e4889..7647865ba02 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Apr 24, 2018 +GNAT Reference Manual , May 22, 2018 AdaCore @@ -8070,13 +8070,17 @@ pragma Thread_Local_Storage ([Entity =>] LOCAL_NAME); This pragma specifies that the specified entity, which must be a variable declared in a library-level package, is to be marked as "Thread Local Storage" (@code{TLS}). On systems supporting this (which -include Windows, Solaris, GNU/Linux and VxWorks 6), this causes each +include Windows, Solaris, GNU/Linux, and VxWorks 6), this causes each thread (and hence each Ada task) to see a distinct copy of the variable. -The variable may not have default initialization, and if there is +The variable must not have default initialization, and if there is an explicit initialization, it must be either @code{null} for an -access variable, or a static expression for a scalar variable. -This provides a low level mechanism similar to that provided by +access variable, a static expression for a scalar variable, or a fully +static aggregate for a composite type, that is to say, an aggregate all +of whose components are static, and which does not include packed or +discriminated components. + +This provides a low-level mechanism similar to that provided by the @code{Ada.Task_Attributes} package, but much more efficient and is also useful in writing interface code that will interact with foreign threads. diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 2e35d647f63..8b32534b7fa 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2018-05-30 Ed Schonberg + + * gnat.dg/tls1.adb, gnat.dg/tls1_pkg.ads: New testcase. + 2018-05-30 Hristian Kirtchev * gnat.dg/synchronized1.adb, gnat.dg/synchronized1.ads: New testcase. diff --git a/gcc/testsuite/gnat.dg/tls1.adb b/gcc/testsuite/gnat.dg/tls1.adb new file mode 100644 index 00000000000..d45105d719c --- /dev/null +++ b/gcc/testsuite/gnat.dg/tls1.adb @@ -0,0 +1,51 @@ +-- { dg-do run } + +with Text_IO; use Text_IO; +with TLS1_Pkg; use TLS1_Pkg; + +procedure TLS1 is + Result : Integer; + + task type T is + entry Change (Inc : Integer); + entry Sum (Result : out Integer); + end T; + + task body T is + begin + accept Change (Inc : Integer) do + for I in My_Array.data'range loop + My_Array.Data (I).Point := Inc; + end loop; + end; + + accept Sum (Result : out Integer) do + Result := 0; + for I in My_Array.data'range loop + Result := Result + My_Array.Data (I).Point; + end loop; + end; + end T; + + Gang : array (1..10) of T; + +begin + for J in Gang'range loop + Gang (J).Change (J); + end loop; + + -- Verify the contents of each local thread storage. + + for J in Gang'range loop + Gang (J).Sum (Result); + pragma Assert (Result = J * 500); + end loop; + + -- Verify that original data is unaffected. + + for J in My_Array.Data'range loop + Result := Result + My_Array.Data (J).Point; + end loop; + + pragma Assert (Result = 500); +end TLS1; diff --git a/gcc/testsuite/gnat.dg/tls1_pkg.ads b/gcc/testsuite/gnat.dg/tls1_pkg.ads new file mode 100644 index 00000000000..3153fafd174 --- /dev/null +++ b/gcc/testsuite/gnat.dg/tls1_pkg.ads @@ -0,0 +1,23 @@ +pragma Restrictions (No_Implicit_Loops); + +package TLS1_Pkg is + Type My_Record_Type is record + Date : long_float; + Point : Integer; + end record; + + type Nb_Type is range 0 .. 500; + subtype Index_Type is Nb_Type range 1 .. 500; + + type My_Array_Type is array (Index_Type) of My_Record_Type; + + type My_Pseudo_Box_Type is record + Nb : Nb_Type; + Data : My_Array_Type; + End record; + + My_Array : My_Pseudo_Box_Type := (Nb => 10, + Data => (others => (Date => 3.0, Point => 1))); + pragma Thread_Local_Storage (My_Array); + +end TLS1_Pkg; -- 2.11.4.GIT