From 718f39dcc150d25458c3f49e08c5114dbfec64e8 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 29 Aug 2011 12:58:32 +0200 Subject: [PATCH] [multiple changes] 2011-08-29 Tristan Gingold * s-interr-hwint.adb: Revert previous patch (defer aborts in ZCX case). 2011-08-29 Geert Bosch * a-ngelfu.adb (Tan): Do not raise Constraint_Error if the argument is the closest machine number to Pi / 2.0. 2011-08-29 Jose Ruiz * impunit.adb (Non_Imp_File_Names_12): Add a-synbar for new Ada 2012 package Ada.Synchronous_Barriers. * a-synbar.ads, a-synbar.adb, a-synbar-posix.ads, a-synbar-posix.adb: Add new specs and bodies for Ada.Synchronous_Barriers. There is a default implementation using protected objects and another one a-synbar-posix using POSIX barriers as the underlying support. * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for Linux (x86, x86_64, ia64) and MIPS IRIX): Use the a-synbar-posix implementation of Ada.Synchronous_Barriers which uses POSIX barriers (more efficient). * Makefile.rtl (GNATRTL_TASKING_OBJS): Add a-synbar.o From-SVN: r178200 --- gcc/ada/ChangeLog | 20 +++++- gcc/ada/Makefile.rtl | 5 +- gcc/ada/a-ngelfu.adb | 5 +- gcc/ada/a-synbar-posix.adb | 112 +++++++++++++++++++++++++++++ gcc/ada/a-synbar-posix.ads | 83 ++++++++++++++++++++++ gcc/ada/a-synbar.adb | 71 +++++++++++++++++++ gcc/ada/a-synbar.ads | 53 ++++++++++++++ gcc/ada/gcc-interface/Makefile.in | 113 ++++++++++++++++++------------ gcc/ada/impunit.adb | 3 +- gcc/ada/s-interr-hwint.adb | 3 - 10 files changed, 412 insertions(+), 56 deletions(-) create mode 100644 gcc/ada/a-synbar-posix.adb create mode 100644 gcc/ada/a-synbar-posix.ads create mode 100644 gcc/ada/a-synbar.adb create mode 100644 gcc/ada/a-synbar.ads diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e906a4b9486..9aa78a2ace9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2011-08-29 Geert Bosch + + * a-ngelfu.adb (Tan): Do not raise Constraint_Error if the argument is + the closest machine number to Pi / 2.0. + +2011-08-29 Jose Ruiz + + * impunit.adb (Non_Imp_File_Names_12): Add a-synbar for new Ada 2012 + package Ada.Synchronous_Barriers. + * a-synbar.ads, a-synbar.adb, a-synbar-posix.ads, a-synbar-posix.adb: + Add new specs and bodies for Ada.Synchronous_Barriers. There is a + default implementation using protected objects and another one + a-synbar-posix using POSIX barriers as the underlying support. + * gcc-interface/Makefile.in (LIBGNAT_TARGET_PAIRS for Linux (x86, + x86_64, ia64) and MIPS IRIX): Use the a-synbar-posix implementation of + Ada.Synchronous_Barriers which uses POSIX barriers (more efficient). + Clean up dependencies. + * Makefile.rtl (GNATRTL_TASKING_OBJS): Add a-synbar.o + 2011-08-29 Robert Dewar * sem_ch7.adb, make.adb, sem_res.adb, exp_intr.adb, @@ -93,7 +112,6 @@ (Reraise_Occurrence_Always): Ditto. * s-tasren.adb (Exceptional_Complete_Rendezvous): Defer aborts if ZCX. * s-tpobop.adb: (Exceptional_Complete_Body): Undefer abort if ZCX. - * s-interr-hwint.adb (Interrupt_Manager): Defer abort if ZCX. 2011-08-29 Thomas Quinot diff --git a/gcc/ada/Makefile.rtl b/gcc/ada/Makefile.rtl index 16255b862b3..86eb6a5cb6f 100644 --- a/gcc/ada/Makefile.rtl +++ b/gcc/ada/Makefile.rtl @@ -33,6 +33,7 @@ GNATRTL_TASKING_OBJS= \ a-reatim$(objext) \ a-retide$(objext) \ a-rttiev$(objext) \ + a-synbar$(objext) \ a-sytaco$(objext) \ a-tasatt$(objext) \ a-taside$(objext) \ @@ -154,6 +155,7 @@ GNATRTL_NONTASKING_OBJS= \ a-envvar$(objext) \ a-except$(objext) \ a-exctra$(objext) \ + a-fihema$(objext) \ a-finali$(objext) \ a-flteio$(objext) \ a-fwteio$(objext) \ @@ -289,7 +291,6 @@ GNATRTL_NONTASKING_OBJS= \ a-tiunio$(objext) \ a-unccon$(objext) \ a-uncdea$(objext) \ - a-undesu$(objext) \ a-wichha$(objext) \ a-wichun$(objext) \ a-widcha$(objext) \ @@ -495,7 +496,6 @@ GNATRTL_NONTASKING_OBJS= \ s-ficobl$(objext) \ s-fileio$(objext) \ s-filofl$(objext) \ - s-finmas$(objext) \ s-finroo$(objext) \ s-fishfl$(objext) \ s-flocon$(objext) \ @@ -612,7 +612,6 @@ GNATRTL_NONTASKING_OBJS= \ s-stchop$(objext) \ s-stoele$(objext) \ s-stopoo$(objext) \ - s-stposu$(objext) \ s-stratt$(objext) \ s-strhas$(objext) \ s-string$(objext) \ diff --git a/gcc/ada/a-ngelfu.adb b/gcc/ada/a-ngelfu.adb index b615f9da957..7091054d62c 100644 --- a/gcc/ada/a-ngelfu.adb +++ b/gcc/ada/a-ngelfu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2011, 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- -- @@ -914,9 +914,6 @@ package body Ada.Numerics.Generic_Elementary_Functions is begin if abs X < Sqrt_Epsilon then return X; - - elsif abs X = Pi / 2.0 then - raise Constraint_Error; end if; return Float_Type'Base (Aux.Tan (Double (X))); diff --git a/gcc/ada/a-synbar-posix.adb b/gcc/ada/a-synbar-posix.adb new file mode 100644 index 00000000000..c31228e0eaa --- /dev/null +++ b/gcc/ada/a-synbar-posix.adb @@ -0,0 +1,112 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ B A R R I E R S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2011, 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 -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the body of this package using POSIX barriers + +with Interfaces.C; use Interfaces.C; + +package body Ada.Synchronous_Barriers is + + -------------------- + -- POSIX barriers -- + -------------------- + + function pthread_barrier_init + (barrier : not null access pthread_barrier_t; + attr : System.Address := System.Null_Address; + count : unsigned) + return int; + pragma Import (C, pthread_barrier_init, "pthread_barrier_init"); + -- Initialize barrier with the attributes in attr. The barrier is opened + -- when count waiters arrived. If attr is null the default barrier + -- attributes shall be used. + + -- Destroy a previously dynamically initialized barrier + function pthread_barrier_destroy + (barrier : not null access pthread_barrier_t) return int; + pragma Import (C, pthread_barrier_destroy, "pthread_barrier_destroy"); + -- Destroy a previously dynamically initialized barrier + + function pthread_barrier_wait + (barrier : not null access pthread_barrier_t) return int; + pragma Import (C, pthread_barrier_wait, "pthread_barrier_wait"); + -- Wait on barrier + + -------------- + -- Finalize -- + -------------- + + overriding procedure Finalize (Barrier : in out Synchronous_Barrier) is + Result : int; + + begin + Result := pthread_barrier_destroy (Barrier.POSIX_Barrier'Access); + pragma Assert (Result = 0); + end Finalize; + + overriding procedure Initialize (Barrier : in out Synchronous_Barrier) is + Result : int; + + begin + Result := pthread_barrier_init + (barrier => Barrier.POSIX_Barrier'Access, + attr => System.Null_Address, + count => unsigned (Barrier.Release_Threshold)); + pragma Assert (Result = 0); + end Initialize; + + ---------------------- + -- Wait_For_Release -- + ---------------------- + + procedure Wait_For_Release + (The_Barrier : in out Synchronous_Barrier; + Notified : out Boolean) + is + Result : int; + + PTHREAD_BARRIER_SERIAL_THREAD : constant := -1; + -- Value used to indicate the task which receives the notification for + -- the barrier open. + + begin + Result := pthread_barrier_wait + (barrier => The_Barrier.POSIX_Barrier'Access); + pragma Assert + (Result = 0 or else Result = PTHREAD_BARRIER_SERIAL_THREAD); + + Notified := (Result = PTHREAD_BARRIER_SERIAL_THREAD); + end Wait_For_Release; +end Ada.Synchronous_Barriers; diff --git a/gcc/ada/a-synbar-posix.ads b/gcc/ada/a-synbar-posix.ads new file mode 100644 index 00000000000..80d9b201e56 --- /dev/null +++ b/gcc/ada/a-synbar-posix.ads @@ -0,0 +1,83 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ B A R R I E R S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2011, 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 -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the spec of this package using POSIX barriers + +with System; +private with Ada.Finalization; +private with Interfaces.C; + +package Ada.Synchronous_Barriers is + pragma Preelaborate (Synchronous_Barriers); + + subtype Barrier_Limit is Positive range 1 .. Positive'Last; + + type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is + limited private; + + procedure Wait_For_Release (The_Barrier : in out Synchronous_Barrier; + Notified : out Boolean); + +private + -- POSIX barrier data type + + SIZEOF_PTHREAD_BARRIER_T : constant := + (if System.Word_Size = 64 then 32 else 20); + -- Value defined according to the linux definition in pthreadtypes.h. On + -- other system, MIPS IRIX, the object is smaller, so it works correctly + -- although we are wasting some space. + + type pthread_barrier_t_view is (size_based, align_based); + + type pthread_barrier_t (Kind : pthread_barrier_t_view := size_based) is + record + case Kind is + when size_based => + size : Interfaces.C.char_array (1 .. SIZEOF_PTHREAD_BARRIER_T); + when align_based => + align : Interfaces.C.long; + end case; + end record; + pragma Unchecked_Union (pthread_barrier_t); + + type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is + new Ada.Finalization.Limited_Controlled with + record + POSIX_Barrier : aliased pthread_barrier_t; + end record; + + overriding procedure Initialize (Barrier : in out Synchronous_Barrier); + overriding procedure Finalize (Barrier : in out Synchronous_Barrier); +end Ada.Synchronous_Barriers; diff --git a/gcc/ada/a-synbar.adb b/gcc/ada/a-synbar.adb new file mode 100644 index 00000000000..8efaef6d036 --- /dev/null +++ b/gcc/ada/a-synbar.adb @@ -0,0 +1,71 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ B A R R I E R S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 1992-2011, 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 -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body Ada.Synchronous_Barriers is + + protected body Synchronous_Barrier is + -- The condition "Wait'Count = Release_Threshold" opens the barrier when + -- the required number of tasks is reached. The condition "Keep_Open" + -- leaves the barrier open while there are queued tasks. While there are + -- tasks in the queue no new task will be queued, guaranteeing that the + -- barrier will remain open only for those tasks already inside. + + entry Wait (Notified : out Boolean) + when Wait'Count = Release_Threshold or else Keep_Open is + begin + -- If we are executing the entry it means that the required number + -- of tasks have been queued in the entry. Keep_Open barrier will + -- remain true until all queued tasks are out. + + Keep_Open := Wait'Count > 0; + + -- The last released task will close the barrier and get the + -- Notified token. + + Notified := Wait'Count = 0; + end Wait; + end Synchronous_Barrier; + + ---------------------- + -- Wait_For_Release -- + ---------------------- + + procedure Wait_For_Release + (The_Barrier : in out Synchronous_Barrier; + Notified : out Boolean) is + begin + The_Barrier.Wait (Notified); + end Wait_For_Release; +end Ada.Synchronous_Barriers; diff --git a/gcc/ada/a-synbar.ads b/gcc/ada/a-synbar.ads new file mode 100644 index 00000000000..c4506246702 --- /dev/null +++ b/gcc/ada/a-synbar.ads @@ -0,0 +1,53 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . S Y N C H R O N O U S _ B A R R I E R S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2011, 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 -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- 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- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- . -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package Ada.Synchronous_Barriers is + pragma Preelaborate (Synchronous_Barriers); + + subtype Barrier_Limit is Positive range 1 .. Positive'Last; + + type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is + limited private; + + procedure Wait_For_Release (The_Barrier : in out Synchronous_Barrier; + Notified : out Boolean); + +private + protected type Synchronous_Barrier (Release_Threshold : Barrier_Limit) is + entry Wait (Notified : out Boolean); + private + Keep_Open : Boolean := False; + end Synchronous_Barrier; +end Ada.Synchronous_Barriers; diff --git a/gcc/ada/gcc-interface/Makefile.in b/gcc/ada/gcc-interface/Makefile.in index c80480e7b8a..a8b911ed935 100644 --- a/gcc/ada/gcc-interface/Makefile.in +++ b/gcc/ada/gcc-interface/Makefile.in @@ -420,7 +420,26 @@ ATOMICS_TARGET_PAIRS += \ a-stzunb.adb - if ZCX_By_Default then - Initialization.Defer_Abort_Nestable (STPO.Self); - end if; -- Flush interrupt server semaphores, so they can terminate