s-osinte-linux-alpha.ads, [...]: Removed.

2008-04-08  Eric Botcazou  <ebotcazou@adacore.com>
	    Arnaud Charlet  <charlet@adacore.com>

	* s-osinte-linux-alpha.ads, s-osinte-linux-hppa.ads: Removed.

	s-taspri-posix-noaltstack.ads, s-linux.ads, s-linux-alpha.ads,
	s-linux-hppa.ads: New files. Disable alternate stack on ia64-hpux.

	* s-osinte-lynxos-3.ads,
	(Alternate_Stack): Remove when not needed. Simplify declaration
	otherwise.
	(Alternate_Stack_Size): New constant.

	s-osinte-mingw.ads, s-taprop-mingw.adb: Code clean up: avoid use of
	'Unrestricted_Access.

	* s-osinte-hpux.ads, s-osinte-solaris-posix.ads, s-osinte-aix.ads,
	s-osinte-lynxos.ads, s-osinte-freebsd.ads s-osinte-darwin.ads,
	s-osinte-tru64.ads, s-osinte-irix.ads, s-osinte-linux.ads,
	s-osinte-solaris.ads, s-osinte-vms.ads
	(SA_ONSTACK): New constant.
	(stack_t): New record type.
	(sigaltstack): New imported function.
	(Alternate_Stack): New imported variable.
	(Alternate_Stack_Size): New constant.

	* system-linux-x86_64.ads: (Stack_Check_Probes): Set to True.

	* s-taspri-lynxos.ads, s-taspri-solaris.ads, s-taspri-tru64.ads,
	s-taspri-hpux-dce.ads (Task_Address): New subtype of System.Address
	(Task_Address_Size): New constant size of System.Address
	(Alternate_Stack_Size): New constant.

	* s-taprop-posix.adb, s-taprop-linux.adb (Get_Stack_Attributes): Delete.
	(Enter_Task): Do not notify stack to System.Stack_Checking.Operations.
	Establish the alternate stack if the platform makes use of n alternate
	signal stack for stack overflows.
	(Create_Task): Take into account the alternate stack in the stack size.
	(Initialize): Save the address of the alternate stack into the ATCB for
	the environment task.
	(Create_Task): Fix assertions for NPTL library (vs old LinuxThreads).

	* s-parame.adb (Minimum_Stack_Size): Increase value to 16K to

	* system-linux-x86.ads: (Stack_Check_Probes): Set to True.

	* s-intman-posix.adb: 
	(Initialize): Set SA_ONSTACK for SIGSEGV if the platform makes use of an
	alternate signal stack for stack overflows.

	* init.c (__gnat_adjust_context_for_raise, Linux version): On i386 and
	x86-64, adjust the saved value of the stack pointer if the signal was
	raised by a stack checking probe.
	(HP-UX section): Use global __gnat_alternate_stack as signal handler
	stack and only for SIGSEGV.
	(Linux section): Likewise on x86 and x86-64.
	[VxWorks section]
	(__gnat_map_signal): Now static.
	(__gnat_error_handler): Not static any more.
	(__gnat_adjust_context_for_raise): New function. Signal context
	adjustment for PPC && !VTHREADS && !RTP, as required by the zcx
	propagation circuitry.
	(__gnat_error_handler): Second argument of a sigaction handler is a
	pointer, not an int, and is unused.
	Adjust signal context before mapping to exception.
	Install signal handlers for LynxOS case.

	* s-taskin.ads (Common_ATCB): New field Task_Alternate_Stack.
	(Task_Id): Set size to Task_Address_Size
	(To_Task_id): Unchecked convert from Task_Address vice System.Address
	(To_Address): Unchecked convert to Task_Address vice System.Address

	* s-tassta.adb (Task_Wrapper): Define the alternate stack and save its
	address into the ATCB if the platform makes use of an alternate signal
	stack for stack overflows.
	(Free_Task): Add call to Finalize_Attributes_Link.
	Add argument Relative_Deadline to pass the value specified for
	the task. This is not yet used for any target.

	* s-tassta.ads (Create_Task): Add argument Relative_Deadline to pass
	the value specified for the task.

From-SVN: r134004

gcc/ada/s-intman-posix.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNARL 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- --
@@ -59,6 +59,8 @@
 --                default
 --      Reserved: the OS specific set of signals that are reserved.
 
+with System.Task_Primitives;
+
 package body System.Interrupt_Management is
 
    use Interfaces.C;
@@ -117,7 +119,7 @@ package body System.Interrupt_Management is
 
    begin
       --  With the __builtin_longjmp, the signal mask is not restored, so we
-      --  need to restore it explicitely.
+      --  need to restore it explicitly.
 
       Result := pthread_sigmask (SIG_UNBLOCK, Signal_Mask'Access, null);
       pragma Assert (Result = 0);
@@ -155,6 +157,10 @@ package body System.Interrupt_Management is
       old_act : aliased struct_sigaction;
       Result  : System.OS_Interface.int;
 
+      Use_Alternate_Stack : constant Boolean :=
+                              System.Task_Primitives.Alternate_Stack_Size /= 0;
+      --  Whether to use an alternate signal stack for stack overflows
+
    begin
       if Initialized then
          return;
@@ -171,8 +177,6 @@ package body System.Interrupt_Management is
 
       act.sa_handler := Notify_Exception'Address;
 
-      act.sa_flags := SA_SIGINFO;
-
       --  Setting SA_SIGINFO asks the kernel to pass more than just the signal
       --  number argument to the handler when it is called. The set of extra
       --  parameters includes a pointer to the interrupted context, which the
@@ -191,7 +195,7 @@ package body System.Interrupt_Management is
       --  fix should be made in sigsetjmp so that we save the Signal_Set and
       --  restore it after a longjmp.
 
-      --  Since SA_NODEFER is obsolete, instead we reset explicitely the mask
+      --  Since SA_NODEFER is obsolete, instead we reset explicitly the mask
       --  in the exception handler.
 
       Result := sigemptyset (Signal_Mask'Access);
@@ -220,6 +224,14 @@ package body System.Interrupt_Management is
             Reserve (Exception_Interrupts (J)) := True;
 
             if State (Exception_Interrupts (J)) /= Default then
+               act.sa_flags := SA_SIGINFO;
+
+               if Use_Alternate_Stack
+                 and then Exception_Interrupts (J) = SIGSEGV
+               then
+                  act.sa_flags := act.sa_flags + SA_ONSTACK;
+               end if;
+
                Result :=
                  sigaction
                    (Signal (Exception_Interrupts (J)), act'Unchecked_Access,
@@ -235,7 +247,7 @@ package body System.Interrupt_Management is
       end if;
 
       --  Set SIGINT to unmasked state as long as it is not in "User" state.
-      --  Check for Unreserve_All_Interrupts last
+      --  Check for Unreserve_All_Interrupts last.
 
       if State (SIGINT) /= User then
          Keep_Unmasked (SIGINT) := True;
@@ -243,7 +255,7 @@ package body System.Interrupt_Management is
       end if;
 
       --  Check all signals for state that requires keeping them unmasked and
-      --  reserved
+      --  reserved.
 
       for J in Interrupt_ID'Range loop
          if State (J) = Default or else State (J) = Runtime then

gcc/ada/s-linux-alpha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                          S Y S T E M .  L I N U X                        --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 2008, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNARL 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 2,  or (at your option) any later ver- --
+-- sion. GNARL 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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the alpha version of this package
+
+--  This package encapsulates cpu specific differences between implementations
+--  of GNU/Linux, in order to share s-osinte-linux.ads.
+
+--  PLEASE DO NOT add any with-clauses to this package or remove the pragma
+--  Preelaborate. This package is designed to be a bottom-level (leaf) package.
+
+with Interfaces.C;
+
+package System.Linux is
+   pragma Preelaborate;
+
+   -----------
+   -- Errno --
+   -----------
+
+   EAGAIN    : constant := 35;
+   EINTR     : constant := 4;
+   EINVAL    : constant := 22;
+   ENOMEM    : constant := 12;
+   EPERM     : constant := 1;
+   ETIMEDOUT : constant := 60;
+
+   -------------
+   -- Signals --
+   -------------
+
+   SIGHUP     : constant := 1; --  hangup
+   SIGINT     : constant := 2; --  interrupt (rubout)
+   SIGQUIT    : constant := 3; --  quit (ASCD FS)
+   SIGILL     : constant := 4; --  illegal instruction (not reset)
+   SIGTRAP    : constant := 5; --  trace trap (not reset)
+   SIGIOT     : constant := 6; --  IOT instruction
+   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
+   SIGFPE     : constant := 8; --  floating point exception
+   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
+   SIGBUS     : constant := 10; --  bus error
+   SIGSEGV    : constant := 11; --  segmentation violation
+   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
+   SIGALRM    : constant := 14; --  alarm clock
+   SIGTERM    : constant := 15; --  software termination signal from kill
+   SIGURG     : constant := 16; --  urgent condition on IO channel
+   SIGSTOP    : constant := 17; --  stop (cannot be caught or ignored)
+   SIGTSTP    : constant := 18; --  user stop requested from tty
+   SIGCONT    : constant := 19; --  stopped process has been continued
+   SIGCLD     : constant := 20; --  alias for SIGCHLD
+   SIGCHLD    : constant := 20; --  child status change
+   SIGTTIN    : constant := 21; --  background tty read attempted
+   SIGTTOU    : constant := 22; --  background tty write attempted
+   SIGIO      : constant := 23; --  I/O now possible (4.2 BSD)
+   SIGPOLL    : constant := 23; --  pollable event occurred
+   SIGXCPU    : constant := 24; --  CPU time limit exceeded
+   SIGXFSZ    : constant := 25; --  filesize limit exceeded
+   SIGVTALRM  : constant := 26; --  virtual timer expired
+   SIGPROF    : constant := 27; --  profiling timer expired
+   SIGWINCH   : constant := 28; --  window size change
+   SIGPWR     : constant := 29; --  power-fail restart
+   SIGUSR1    : constant := 30; --  user defined signal 1
+   SIGUSR2    : constant := 31; --  user defined signal 2
+
+   SIGLTHRRES : constant := 32; --  GNU/LinuxThreads restart signal
+   SIGLTHRCAN : constant := 33; --  GNU/LinuxThreads cancel signal
+   SIGLTHRDBG : constant := 34; --  GNU/LinuxThreads debugger signal
+
+   SIGADAABORT : constant := SIGABRT;
+   --  Change this if you want to use another signal for task abort.
+   --  SIGTERM might be a good one.
+
+   SIGUNUSED  : constant := 0;
+   SIGSTKFLT  : constant := 0;
+   SIGLOST    : constant := 0;
+   --  These don't exist for Linux/Alpha.  The constants are present
+   --  so that we can continue to use a-intnam-linux.ads.
+
+   --  struct_sigaction offsets
+
+   sa_mask_pos  : constant := Standard'Address_Size / 8;
+   sa_flags_pos : constant := 128 + sa_mask_pos;
+
+   SA_SIGINFO  : constant := 16#40#;
+   SA_ONSTACK  : constant := 16#01#;
+
+   type pthread_mutex_t is record
+      dum0, dum1, dum2, dum3, dum4 : Interfaces.C.unsigned_long;
+   end record;
+   pragma Convention (C, pthread_mutex_t);
+
+end System.Linux;

gcc/ada/s-linux-hppa.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                          S Y S T E M .  L I N U X                        --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 2008, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNARL 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 2,  or (at your option) any later ver- --
+-- sion. GNARL 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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the hppa version of this package
+
+--  This package encapsulates cpu specific differences between implementations
+--  of GNU/Linux, in order to share s-osinte-linux.ads.
+
+--  PLEASE DO NOT add any with-clauses to this package or remove the pragma
+--  Preelaborate. This package is designed to be a bottom-level (leaf) package.
+
+package System.Linux is
+   pragma Preelaborate;
+
+   -----------
+   -- Errno --
+   -----------
+
+   EAGAIN    : constant := 11;
+   EINTR     : constant := 4;
+   EINVAL    : constant := 22;
+   ENOMEM    : constant := 12;
+   EPERM     : constant := 1;
+   ETIMEDOUT : constant := 238;
+
+   -------------
+   -- Signals --
+   -------------
+
+   SIGHUP     : constant := 1; --  hangup
+   SIGINT     : constant := 2; --  interrupt (rubout)
+   SIGQUIT    : constant := 3; --  quit (ASCD FS)
+   SIGILL     : constant := 4; --  illegal instruction (not reset)
+   SIGTRAP    : constant := 5; --  trace trap (not reset)
+   SIGIOT     : constant := 6; --  IOT instruction
+   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
+   SIGEMT     : constant := 7; --  EMT
+   SIGFPE     : constant := 8; --  floating point exception
+   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
+   SIGBUS     : constant := 10; --  bus error
+   SIGSEGV    : constant := 11; --  segmentation violation
+   SIGSYS     : constant := 12; --  bad system call
+   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
+   SIGALRM    : constant := 14; --  alarm clock
+   SIGTERM    : constant := 15; --  software termination signal from kill
+   SIGUSR1    : constant := 16; --  user defined signal 1
+   SIGUSR2    : constant := 17; --  user defined signal 2
+   SIGCLD     : constant := 18; --  alias for SIGCHLD
+   SIGCHLD    : constant := 18; --  child status change
+   SIGPWR     : constant := 19; --  power-fail restart
+   SIGVTALRM  : constant := 20; --  virtual timer expired
+   SIGPROF    : constant := 21; --  profiling timer expired
+   SIGPOLL    : constant := 22; --  pollable event occurred
+   SIGIO      : constant := 22; --  I/O now possible (4.2 BSD)
+   SIGWINCH   : constant := 23; --  window size change
+   SIGSTOP    : constant := 24; --  stop (cannot be caught or ignored)
+   SIGTSTP    : constant := 25; --  user stop requested from tty
+   SIGCONT    : constant := 26; --  stopped process has been continued
+   SIGTTIN    : constant := 27; --  background tty read attempted
+   SIGTTOU    : constant := 28; --  background tty write attempted
+   SIGURG     : constant := 29; --  urgent condition on IO channel
+   SIGLOST    : constant := 30; --  File lock lost
+   SIGUNUSED  : constant := 31; --  unused signal (GNU/Linux)
+   SIGXCPU    : constant := 33; --  CPU time limit exceeded
+   SIGXFSZ    : constant := 34; --  filesize limit exceeded
+   SIGSTKFLT  : constant := 36; --  coprocessor stack fault (Linux)
+   SIGLTHRRES : constant := 37; --  GNU/LinuxThreads restart signal
+   SIGLTHRCAN : constant := 38; --  GNU/LinuxThreads cancel signal
+   SIGLTHRDBG : constant := 39; --  GNU/LinuxThreads debugger signal
+
+   --  struct_sigaction offsets
+
+   sa_flags_pos  : constant := Standard'Address_Size / 8;
+   sa_mask_pos   : constant := sa_flags_pos * 2;
+
+   SA_SIGINFO  : constant := 16#10#;
+   SA_ONSTACK  : constant := 16#01#;
+
+   type lock_array is array (1 .. 4) of int;
+   type atomic_lock_t is record
+      lock : lock_array;
+   end record;
+   pragma Convention (C, atomic_lock_t);
+   --  ??? Alignment should be 16 but this is larger than BIGGEST_ALIGNMENT.
+   --  This causes an erroneous pointer value to sometimes be passed to free
+   --  during deallocation.  See PR ada/24533 for more details.
+   for atomic_lock_t'Alignment use 8;
+
+   type struct_pthread_fast_lock is record
+      spinlock : atomic_lock_t;
+      status   : Long_Integer;
+   end record;
+   pragma Convention (C, struct_pthread_fast_lock);
+
+   type pthread_mutex_t is record
+      m_reserved : Integer;
+      m_count    : Integer;
+      m_owner    : System.Address;
+      m_kind     : Integer;
+      m_lock     : struct_pthread_fast_lock;
+   end record;
+   pragma Convention (C, pthread_mutex_t);
+
+end System.Linux;

gcc/ada/s-linux.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS               --
+--                                                                          --
+--                          S Y S T E M .  L I N U X                        --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 2008, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNARL 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 2,  or (at your option) any later ver- --
+-- sion. GNARL 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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is the default version of this package
+
+--  This package encapsulates cpu specific differences between implementations
+--  of GNU/Linux, in order to share s-osinte-linux.ads.
+
+--  PLEASE DO NOT add any with-clauses to this package or remove the pragma
+--  Preelaborate. This package is designed to be a bottom-level (leaf) package
+
+package System.Linux is
+   pragma Preelaborate;
+
+   -----------
+   -- Errno --
+   -----------
+
+   EAGAIN    : constant := 11;
+   EINTR     : constant := 4;
+   EINVAL    : constant := 22;
+   ENOMEM    : constant := 12;
+   EPERM     : constant := 1;
+   ETIMEDOUT : constant := 110;
+
+   -------------
+   -- Signals --
+   -------------
+
+   SIGHUP     : constant := 1; --  hangup
+   SIGINT     : constant := 2; --  interrupt (rubout)
+   SIGQUIT    : constant := 3; --  quit (ASCD FS)
+   SIGILL     : constant := 4; --  illegal instruction (not reset)
+   SIGTRAP    : constant := 5; --  trace trap (not reset)
+   SIGIOT     : constant := 6; --  IOT instruction
+   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
+   SIGFPE     : constant := 8; --  floating point exception
+   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
+   SIGBUS     : constant := 7; --  bus error
+   SIGSEGV    : constant := 11; --  segmentation violation
+   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
+   SIGALRM    : constant := 14; --  alarm clock
+   SIGTERM    : constant := 15; --  software termination signal from kill
+   SIGUSR1    : constant := 10; --  user defined signal 1
+   SIGUSR2    : constant := 12; --  user defined signal 2
+   SIGCLD     : constant := 17; --  alias for SIGCHLD
+   SIGCHLD    : constant := 17; --  child status change
+   SIGPWR     : constant := 30; --  power-fail restart
+   SIGWINCH   : constant := 28; --  window size change
+   SIGURG     : constant := 23; --  urgent condition on IO channel
+   SIGPOLL    : constant := 29; --  pollable event occurred
+   SIGIO      : constant := 29; --  I/O now possible (4.2 BSD)
+   SIGLOST    : constant := 29; --  File lock lost
+   SIGSTOP    : constant := 19; --  stop (cannot be caught or ignored)
+   SIGTSTP    : constant := 20; --  user stop requested from tty
+   SIGCONT    : constant := 18; --  stopped process has been continued
+   SIGTTIN    : constant := 21; --  background tty read attempted
+   SIGTTOU    : constant := 22; --  background tty write attempted
+   SIGVTALRM  : constant := 26; --  virtual timer expired
+   SIGPROF    : constant := 27; --  profiling timer expired
+   SIGXCPU    : constant := 24; --  CPU time limit exceeded
+   SIGXFSZ    : constant := 25; --  filesize limit exceeded
+   SIGUNUSED  : constant := 31; --  unused signal (GNU/Linux)
+   SIGSTKFLT  : constant := 16; --  coprocessor stack fault (Linux)
+   SIGLTHRRES : constant := 32; --  GNU/LinuxThreads restart signal
+   SIGLTHRCAN : constant := 33; --  GNU/LinuxThreads cancel signal
+   SIGLTHRDBG : constant := 34; --  GNU/LinuxThreads debugger signal
+
+   --  struct_sigaction offsets
+
+   sa_mask_pos  : constant := Standard'Address_Size / 8;
+   sa_flags_pos : constant := 128 + sa_mask_pos;
+
+   SA_SIGINFO  : constant := 16#04#;
+   SA_ONSTACK  : constant := 16#08000000#;
+
+   type struct_pthread_fast_lock is record
+      status   : Long_Integer;
+      spinlock : Integer;
+   end record;
+   pragma Convention (C, struct_pthread_fast_lock);
+
+   type pthread_mutex_t is record
+      m_reserved : Integer;
+      m_count    : Integer;
+      m_owner    : System.Address;
+      m_kind     : Integer;
+      m_lock     : struct_pthread_fast_lock;
+   end record;
+   pragma Convention (C, pthread_mutex_t);
+
+end System.Linux;

gcc/ada/s-osinte-aix.ads

@@ -175,6 +175,7 @@ package System.OS_Interface is
    type struct_sigaction_ptr is access all struct_sigaction;
 
    SA_SIGINFO : constant := 16#0100#;
+   SA_ONSTACK : constant := 16#0001#;
 
    SIG_BLOCK   : constant := 0;
    SIG_UNBLOCK : constant := 1;
@@ -291,6 +292,24 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_size  : size_t;
+      ss_flags : int;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   --  This is a dummy definition, never used (Alternate_Stack_Size is null)
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
    --  Indicates wether the stack base is available on this target
 
@@ -309,7 +328,6 @@ package System.OS_Interface is
    PROT_WRITE : constant := 2;
    PROT_EXEC  : constant := 4;
    PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
-
    PROT_ON    : constant := PROT_READ;
    PROT_OFF   : constant := PROT_ALL;
 

gcc/ada/s-osinte-darwin.ads

@@ -162,6 +162,7 @@ package System.OS_Interface is
    SIG_IGN : constant := 1;
 
    SA_SIGINFO : constant := 16#0040#;
+   SA_ONSTACK : constant := 16#0001#;
 
    function sigaction
      (sig  : Signal;
@@ -229,10 +230,10 @@ package System.OS_Interface is
    ---------
 
    function lwp_self return System.Address;
+   pragma Import (C, lwp_self, "pthread_self");
    --  lwp_self does not exist on this thread library, revert to pthread_self
    --  which is the closest approximation (with getpid). This function is
    --  needed to share 7staprop.adb across POSIX-like targets.
-   pragma Import (C, lwp_self, "pthread_self");
 
    -------------
    -- Threads --
@@ -264,22 +265,39 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_size  : size_t;
+      ss_flags : int;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   --  This is a dummy definition, never used (Alternate_Stack_Size is null)
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
-   --  Indicates wether the stack base is available on this target.
-   --  This allows us to share s-osinte.adb between all the FSU run time.
-   --  Note that this value can only be true if pthread_t has a complete
-   --  definition that corresponds exactly to the C header files.
+   --  Indicates wether the stack base is available on this target. This allows
+   --  us to share s-osinte.adb between all the FSU run time. Note that this
+   --  value can only be true if pthread_t has a complete definition that
+   --  corresponds exactly to the C header files.
 
    function Get_Stack_Base (thread : pthread_t) return System.Address;
    pragma Inline (Get_Stack_Base);
-   --  returns the stack base of the specified thread.
-   --  Only call this function when Stack_Base_Available is True.
+   --  returns the stack base of the specified thread. Only call this function
+   --  when Stack_Base_Available is True.
 
    function Get_Page_Size return size_t;
    function Get_Page_Size return System.Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  returns the size of a page, or 0 if this is not relevant on this
-   --  target
+   --  Returns the size of a page, or 0 if this is not relevant on this target
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
@@ -290,7 +308,8 @@ package System.OS_Interface is
    PROT_ON    : constant := PROT_NONE;
    PROT_OFF   : constant := PROT_ALL;
 
-   function mprotect (addr : System.Address;
+   function mprotect
+     (addr : System.Address;
       len  : size_t;
       prot : int) return int;
    pragma Import (C, mprotect);
@@ -528,13 +547,6 @@ private
    end record;
    pragma Convention (C, siginfo_t);
 
-   type stack_t is record
-      ss_sp    : System.Address;
-      ss_size  : int;
-      ss_flags : int;
-   end record;
-   pragma Convention (C, stack_t);
-
    type mcontext_t is new System.Address;
 
    type ucontext_t is record

gcc/ada/s-osinte-freebsd.ads

@@ -182,6 +182,7 @@ package System.OS_Interface is
    SIG_IGN : constant := 1;
 
    SA_SIGINFO : constant := 16#0040#;
+   SA_ONSTACK : constant := 16#0001#;
 
    function sigaction
      (sig  : Signal;
@@ -293,42 +294,57 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_size  : size_t;
+      ss_flags : int;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   --  This is a dummy definition, never used (Alternate_Stack_Size is null)
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
-   --  Indicates wether the stack base is available on this target.
-   --  This allows us to share s-osinte.adb between all the FSU run time.
-   --  Note that this value can only be true if pthread_t has a complete
-   --  definition that corresponds exactly to the C header files.
+   --  Indicates wether the stack base is available on this target. This allows
+   --  us to share s-osinte.adb between all the FSU run time. Note that this
+   --  value can only be true if pthread_t has a complete definition that
+   --  corresponds exactly to the C header files.
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
-   --  returns the stack base of the specified thread.
-   --  Only call this function when Stack_Base_Available is True.
+   --  returns the stack base of the specified thread. Only call this function
+   --  when Stack_Base_Available is True.
 
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  returns the size of a page, or 0 if this is not relevant on this
-   --  target
+   --  returns the size of a page, or 0 if this is not relevant on this target
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
    PROT_WRITE : constant := 2;
    PROT_EXEC  : constant := 4;
    PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
-
    PROT_ON    : constant := PROT_NONE;
    PROT_OFF   : constant := PROT_ALL;
 
-   function mprotect
-     (addr : Address; len : size_t; prot : int) return int;
+   function mprotect (addr : Address; len : size_t; prot : int) return int;
    pragma Import (C, mprotect);
 
    ---------------------------------------
    -- Nonstandard Thread Initialization --
    ---------------------------------------
 
-   --  FSU_THREADS requires pthread_init, which is nonstandard and
-   --  this should be invoked during the elaboration of s-taprop.adb
+   --  FSU_THREADS requires pthread_init, which is nonstandard and this should
+   --  be invoked during the elaboration of s-taprop.adb.
 
    --  FreeBSD does not require this so we provide an empty Ada body
 

gcc/ada/s-osinte-hpux.ads

@@ -157,6 +157,7 @@ package System.OS_Interface is
    type struct_sigaction_ptr is access all struct_sigaction;
 
    SA_SIGINFO : constant := 16#10#;
+   SA_ONSTACK : constant := 16#01#;
 
    SIG_BLOCK   : constant := 0;
    SIG_UNBLOCK : constant := 1;
@@ -278,26 +279,43 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_flags : int;
+      ss_size  : size_t;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
+   --  The alternate signal stack for stack overflows
+
+   Alternate_Stack_Size : constant := 16 * 1024;
+   --  This must be in keeping with init.c:__gnat_alternate_stack
+
    Stack_Base_Available : constant Boolean := False;
    --  Indicates wether the stack base is available on this target
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
-   --  returns the stack base of the specified thread.
-   --  Only call this function when Stack_Base_Available is True.
+   --  Returns the stack base of the specified thread. Only call this function
+   --  when Stack_Base_Available is True.
 
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  returns the size of a page, or 0 if this is not relevant on this
-   --  target
+   --  Returns the size of a page, or 0 if this is not relevant on this target
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
    PROT_WRITE : constant := 2;
    PROT_EXEC  : constant := 4;
    PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
-
    PROT_ON    : constant := PROT_READ;
    PROT_OFF   : constant := PROT_ALL;
 

gcc/ada/s-osinte-linux.ads

@@ -41,8 +41,8 @@
 --  Preelaborate. This package is designed to be a bottom-level (leaf) package.
 
 with Ada.Unchecked_Conversion;
-
 with Interfaces.C;
+with System.Linux;
 
 package System.OS_Interface is
    pragma Preelaborate;
@@ -67,12 +67,12 @@ package System.OS_Interface is
    function errno return int;
    pragma Import (C, errno, "__get_errno");
 
-   EAGAIN    : constant := 11;
-   EINTR     : constant := 4;
-   EINVAL    : constant := 22;
-   ENOMEM    : constant := 12;
-   EPERM     : constant := 1;
-   ETIMEDOUT : constant := 110;
+   EAGAIN    : constant := System.Linux.EAGAIN;
+   EINTR     : constant := System.Linux.EINTR;
+   EINVAL    : constant := System.Linux.EINVAL;
+   ENOMEM    : constant := System.Linux.ENOMEM;
+   EPERM     : constant := System.Linux.EPERM;
+   ETIMEDOUT : constant := System.Linux.ETIMEDOUT;
 
    -------------
    -- Signals --
@@ -82,44 +82,44 @@ package System.OS_Interface is
    type Signal is new int range 0 .. Max_Interrupt;
    for Signal'Size use int'Size;
 
-   SIGHUP     : constant := 1; --  hangup
-   SIGINT     : constant := 2; --  interrupt (rubout)
-   SIGQUIT    : constant := 3; --  quit (ASCD FS)
-   SIGILL     : constant := 4; --  illegal instruction (not reset)
-   SIGTRAP    : constant := 5; --  trace trap (not reset)
-   SIGIOT     : constant := 6; --  IOT instruction
-   SIGABRT    : constant := 6; --  used by abort, replace SIGIOT in the  future
-   SIGFPE     : constant := 8; --  floating point exception
-   SIGKILL    : constant := 9; --  kill (cannot be caught or ignored)
-   SIGBUS     : constant := 7; --  bus error
-   SIGSEGV    : constant := 11; --  segmentation violation
-   SIGPIPE    : constant := 13; --  write on a pipe with no one to read it
-   SIGALRM    : constant := 14; --  alarm clock
-   SIGTERM    : constant := 15; --  software termination signal from kill
-   SIGUSR1    : constant := 10; --  user defined signal 1
-   SIGUSR2    : constant := 12; --  user defined signal 2
-   SIGCLD     : constant := 17; --  alias for SIGCHLD
-   SIGCHLD    : constant := 17; --  child status change
-   SIGPWR     : constant := 30; --  power-fail restart
-   SIGWINCH   : constant := 28; --  window size change
-   SIGURG     : constant := 23; --  urgent condition on IO channel
-   SIGPOLL    : constant := 29; --  pollable event occurred
-   SIGIO      : constant := 29; --  I/O now possible (4.2 BSD)
-   SIGLOST    : constant := 29; --  File lock lost
-   SIGSTOP    : constant := 19; --  stop (cannot be caught or ignored)
-   SIGTSTP    : constant := 20; --  user stop requested from tty
-   SIGCONT    : constant := 18; --  stopped process has been continued
-   SIGTTIN    : constant := 21; --  background tty read attempted
-   SIGTTOU    : constant := 22; --  background tty write attempted
-   SIGVTALRM  : constant := 26; --  virtual timer expired
-   SIGPROF    : constant := 27; --  profiling timer expired
-   SIGXCPU    : constant := 24; --  CPU time limit exceeded
-   SIGXFSZ    : constant := 25; --  filesize limit exceeded
-   SIGUNUSED  : constant := 31; --  unused signal (GNU/Linux)
-   SIGSTKFLT  : constant := 16; --  coprocessor stack fault (Linux)
-   SIGLTHRRES : constant := 32; --  GNU/LinuxThreads restart signal
-   SIGLTHRCAN : constant := 33; --  GNU/LinuxThreads cancel signal
-   SIGLTHRDBG : constant := 34; --  GNU/LinuxThreads debugger signal
+   SIGHUP     : constant := System.Linux.SIGHUP;
+   SIGINT     : constant := System.Linux.SIGINT;
+   SIGQUIT    : constant := System.Linux.SIGQUIT;
+   SIGILL     : constant := System.Linux.SIGILL;
+   SIGTRAP    : constant := System.Linux.SIGTRAP;
+   SIGIOT     : constant := System.Linux.SIGIOT;
+   SIGABRT    : constant := System.Linux.SIGABRT;
+   SIGFPE     : constant := System.Linux.SIGFPE;
+   SIGKILL    : constant := System.Linux.SIGKILL;
+   SIGBUS     : constant := System.Linux.SIGBUS;
+   SIGSEGV    : constant := System.Linux.SIGSEGV;
+   SIGPIPE    : constant := System.Linux.SIGPIPE;
+   SIGALRM    : constant := System.Linux.SIGALRM;
+   SIGTERM    : constant := System.Linux.SIGTERM;
+   SIGUSR1    : constant := System.Linux.SIGUSR1;
+   SIGUSR2    : constant := System.Linux.SIGUSR2;
+   SIGCLD     : constant := System.Linux.SIGCLD;
+   SIGCHLD    : constant := System.Linux.SIGCHLD;
+   SIGPWR     : constant := System.Linux.SIGPWR;
+   SIGWINCH   : constant := System.Linux.SIGWINCH;
+   SIGURG     : constant := System.Linux.SIGURG;
+   SIGPOLL    : constant := System.Linux.SIGPOLL;
+   SIGIO      : constant := System.Linux.SIGIO;
+   SIGLOST    : constant := System.Linux.SIGLOST;
+   SIGSTOP    : constant := System.Linux.SIGSTOP;
+   SIGTSTP    : constant := System.Linux.SIGTSTP;
+   SIGCONT    : constant := System.Linux.SIGCONT;
+   SIGTTIN    : constant := System.Linux.SIGTTIN;
+   SIGTTOU    : constant := System.Linux.SIGTTOU;
+   SIGVTALRM  : constant := System.Linux.SIGVTALRM;
+   SIGPROF    : constant := System.Linux.SIGPROF;
+   SIGXCPU    : constant := System.Linux.SIGXCPU;
+   SIGXFSZ    : constant := System.Linux.SIGXFSZ;
+   SIGUNUSED  : constant := System.Linux.SIGUNUSED;
+   SIGSTKFLT  : constant := System.Linux.SIGSTKFLT;
+   SIGLTHRRES : constant := System.Linux.SIGLTHRRES;
+   SIGLTHRCAN : constant := System.Linux.SIGLTHRCAN;
+   SIGLTHRDBG : constant := System.Linux.SIGLTHRDBG;
 
    SIGADAABORT : constant := SIGABRT;
    --  Change this if you want to use another signal for task abort.
@@ -183,10 +183,11 @@ package System.OS_Interface is
    type struct_sigaction is record
       sa_handler  : System.Address;
       sa_mask     : sigset_t;
-      sa_flags     : unsigned_long;
+      sa_flags    : Interfaces.C.unsigned_long;
       sa_restorer : System.Address;
    end record;
    pragma Convention (C, struct_sigaction);
+
    type struct_sigaction_ptr is access all struct_sigaction;
 
    type Machine_State is record
@@ -199,7 +200,8 @@ package System.OS_Interface is
    end record;
    type Machine_State_Ptr is access all Machine_State;
 
-   SA_SIGINFO  : constant := 16#04#;
+   SA_SIGINFO : constant := System.Linux.SA_SIGINFO;
+   SA_ONSTACK : constant := System.Linux.SA_ONSTACK;
 
    SIG_BLOCK   : constant := 0;
    SIG_UNBLOCK : constant := 1;
@@ -299,6 +301,25 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_flags : int;
+      ss_size  : size_t;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
+   --  The alternate signal stack for stack overflows
+
+   Alternate_Stack_Size : constant := 16 * 1024;
+   --  This must be in keeping with init.c:__gnat_alternate_stack
+
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
    --  This is a dummy procedure to share some GNULLI files
@@ -483,9 +504,19 @@ package System.OS_Interface is
 
 private
 
-   type sigset_t is array (0 .. 127) of unsigned_char;
+   type sigset_t is array (0 .. 127) of Interfaces.C.unsigned_char;
    pragma Convention (C, sigset_t);
-   for sigset_t'Alignment use unsigned_long'Alignment;
+   for sigset_t'Alignment use Interfaces.C.unsigned_long'Alignment;
+
+   pragma Warnings (Off);
+   for struct_sigaction use record
+      sa_handler at                  0 range 0 .. Standard'Address_Size - 1;
+      sa_mask    at Linux.sa_mask_pos  range 0 .. 1023;
+      sa_flags   at Linux.sa_flags_pos range 0 .. Standard'Address_Size - 1;
+   end record;
+   --  We intentionally leave sa_restorer unspecified and let the compiler
+   --  append it after the last field, so disable corresponding warning.
+   pragma Warnings (On);
 
    type pid_t is new int;
 
@@ -526,20 +557,7 @@ private
    end record;
    pragma Convention (C, pthread_mutexattr_t);
 
-   type struct_pthread_fast_lock is record
-      status   : long;
-      spinlock : int;
-   end record;
-   pragma Convention (C, struct_pthread_fast_lock);
-
-   type pthread_mutex_t is record
-      m_reserved : int;
-      m_count    : int;
-      m_owner    : System.Address;
-      m_kind     : int;
-      m_lock     : struct_pthread_fast_lock;
-   end record;
-   pragma Convention (C, pthread_mutex_t);
+   type pthread_mutex_t is new System.Linux.pthread_mutex_t;
 
    type pthread_cond_t is array (0 .. 47) of unsigned_char;
    pragma Convention (C, pthread_cond_t);

gcc/ada/s-osinte-lynxos-3.ads

@@ -267,6 +267,9 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
    --  Indicates wether the stack base is available on this target
 

gcc/ada/s-osinte-lynxos.ads

@@ -172,6 +172,11 @@ package System.OS_Interface is
 
    SA_SIGINFO : constant := 16#80#;
 
+   SA_ONSTACK : constant := 16#00#;
+   --  SA_ONSTACK is not defined on LynxOS, but it is refered to in the POSIX
+   --  implementation of System.Interrupt_Management. Therefore we define a
+   --  dummy value of zero here so that setting this flag is a nop.
+
    SIG_BLOCK   : constant := 0;
    SIG_UNBLOCK : constant := 1;
    SIG_SETMASK : constant := 2;
@@ -276,6 +281,9 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
    --  Indicates whether the stack base is available on this target
 

gcc/ada/s-osinte-solaris-posix.ads

@@ -165,6 +165,7 @@ package System.OS_Interface is
    type struct_sigaction_ptr is access all struct_sigaction;
 
    SA_SIGINFO : constant := 16#0008#;
+   SA_ONSTACK : constant := 16#0001#;
 
    SIG_BLOCK   : constant := 1;
    SIG_UNBLOCK : constant := 2;
@@ -272,26 +273,42 @@ package System.OS_Interface is
    -- Stack --
    -----------
 
+   type stack_t is record
+      ss_sp    : System.Address;
+      ss_size  : size_t;
+      ss_flags : int;
+   end record;
+   pragma Convention (C, stack_t);
+
+   function sigaltstack
+     (ss  : not null access stack_t;
+      oss : access stack_t) return int;
+   pragma Import (C, sigaltstack, "sigaltstack");
+
+   Alternate_Stack : aliased System.Address;
+   --  This is a dummy definition, never used (Alternate_Stack_Size is null)
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
    Stack_Base_Available : constant Boolean := False;
    --  Indicates whether the stack base is available on this target
 
    function Get_Stack_Base (thread : pthread_t) return Address;
    pragma Inline (Get_Stack_Base);
-   --  returns the stack base of the specified thread.
-   --  Only call this function when Stack_Base_Available is True.
+   --  Returns the stack base of the specified thread. Only call this function
+   --  when Stack_Base_Available is True.
 
    function Get_Page_Size return size_t;
    function Get_Page_Size return Address;
    pragma Import (C, Get_Page_Size, "getpagesize");
-   --  returns the size of a page, or 0 if this is not relevant on this
-   --  target
+   --  Returns the size of a page, or 0 if this is not relevant on this target
 
    PROT_NONE  : constant := 0;
    PROT_READ  : constant := 1;
    PROT_WRITE : constant := 2;
    PROT_EXEC  : constant := 4;
    PROT_ALL   : constant := PROT_READ + PROT_WRITE + PROT_EXEC;
-
    PROT_ON    : constant := PROT_READ;
    PROT_OFF   : constant := PROT_ALL;
 

gcc/ada/s-osinte-tru64.ads

@@ -176,6 +176,7 @@ package System.OS_Interface is
 
    SA_NODEFER : constant := 8;
    SA_SIGINFO : constant := 16#40#;
+   SA_ONSTACK : constant := 16#01#;
 
    function sigaction
      (sig  : Signal;

gcc/ada/s-taprop-linux.adb

@@ -49,7 +49,6 @@ with System.Task_Info;
 with System.Tasking.Debug;
 with System.Interrupt_Management;
 with System.OS_Primitives;
-with System.Storage_Elements;
 with System.Stack_Checking.Operations;
 
 with System.Soft_Links;
@@ -69,9 +68,11 @@ package body System.Task_Primitives.Operations is
    use System.OS_Interface;
    use System.Parameters;
    use System.OS_Primitives;
-   use System.Storage_Elements;
    use System.Task_Info;
 
+   Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
+   --  Whether to use an alternate signal stack for stack overflows
+
    ----------------
    -- Local Data --
    ----------------
@@ -161,13 +162,6 @@ package body System.Task_Primitives.Operations is
    function To_pthread_t is new Ada.Unchecked_Conversion
      (unsigned_long, System.OS_Interface.pthread_t);
 
-   procedure Get_Stack_Attributes
-     (T    : Task_Id;
-      ISP  : out System.Address;
-      Size : out Storage_Offset);
-   --  Fill ISP and Size with the Initial Stack Pointer value and the
-   --  thread stack size for task T.
-
    -------------------
    -- Abort_Handler --
    -------------------
@@ -696,50 +690,6 @@ package body System.Task_Primitives.Operations is
       return T.Common.Current_Priority;
    end Get_Priority;
 
-   --------------------------
-   -- Get_Stack_Attributes --
-   --------------------------
-
-   procedure Get_Stack_Attributes
-     (T    : Task_Id;
-      ISP  : out System.Address;
-      Size : out Storage_Offset)
-   is
-      function pthread_getattr_np
-        (thread : pthread_t;
-         attr   : System.Address) return Interfaces.C.int;
-      pragma Import (C, pthread_getattr_np, "pthread_getattr_np");
-
-      function pthread_attr_getstack
-        (attr : System.Address;
-         base : System.Address;
-         size : System.Address) return Interfaces.C.int;
-      pragma Import (C, pthread_attr_getstack, "pthread_attr_getstack");
-
-      Result : Interfaces.C.int;
-
-      Attributes : aliased pthread_attr_t;
-      Stack_Base : aliased System.Address;
-      Stack_Size : aliased Storage_Offset;
-
-   begin
-      Result :=
-        pthread_getattr_np
-          (T.Common.LL.Thread, Attributes'Address);
-      pragma Assert (Result = 0);
-
-      Result :=
-        pthread_attr_getstack
-          (Attributes'Address, Stack_Base'Address, Stack_Size'Address);
-      pragma Assert (Result = 0);
-
-      Result := pthread_attr_destroy (Attributes'Access);
-      pragma Assert (Result = 0);
-
-      ISP  := Stack_Base + Stack_Size;
-      Size := Stack_Size;
-   end Get_Stack_Attributes;
-
    ----------------
    -- Enter_Task --
    ----------------
@@ -747,8 +697,7 @@ package body System.Task_Primitives.Operations is
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
       if Self_ID.Common.Task_Info /= null
-        and then
-          Self_ID.Common.Task_Info.CPU_Affinity = No_CPU
+        and then Self_ID.Common.Task_Info.CPU_Affinity = No_CPU
       then
          raise Invalid_CPU_Number;
       end if;
@@ -769,17 +718,18 @@ package body System.Task_Primitives.Operations is
 
       Unlock_RTS;
 
-      --  Determine where the task stack starts, how large it is, and let the
-      --  stack checking engine know about it.
-
+      if Use_Alternate_Stack then
          declare
-         Initial_SP : System.Address;
-         Stack_Size : Storage_Offset;
+            Stack  : aliased stack_t;
+            Result : Interfaces.C.int;
          begin
-         Get_Stack_Attributes (Self_ID, Initial_SP, Stack_Size);
-         System.Stack_Checking.Operations.Notify_Stack_Attributes
-           (Initial_SP, Stack_Size);
+            Stack.ss_sp    := Self_ID.Common.Task_Alternate_Stack;
+            Stack.ss_size  := Alternate_Stack_Size;
+            Stack.ss_flags := 0;
+            Result := sigaltstack (Stack'Access, null);
+            pragma Assert (Result = 0);
          end;
+      end if;
    end Enter_Task;
 
    --------------
@@ -865,9 +815,13 @@ package body System.Task_Primitives.Operations is
       Succeeded  : out Boolean)
    is
       Attributes          : aliased pthread_attr_t;
+      Adjusted_Stack_Size : Interfaces.C.size_t;
       Result              : Interfaces.C.int;
 
    begin
+      Adjusted_Stack_Size :=
+         Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
+
       Result := pthread_attr_init (Attributes'Access);
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
@@ -878,7 +832,7 @@ package body System.Task_Primitives.Operations is
 
       Result :=
         pthread_attr_setstacksize
-          (Attributes'Access, Interfaces.C.size_t (Stack_Size));
+          (Attributes'Access, Adjusted_Stack_Size);
       pragma Assert (Result = 0);
 
       Result :=
@@ -896,7 +850,8 @@ package body System.Task_Primitives.Operations is
          Attributes'Access,
          Thread_Body_Access (Wrapper),
          To_Address (T));
-      pragma Assert (Result = 0 or else Result = EAGAIN);
+      pragma Assert
+        (Result = 0 or else Result = EAGAIN or else Result = ENOMEM);
 
       if Result /= 0 then
          Succeeded := False;
@@ -1148,8 +1103,7 @@ package body System.Task_Primitives.Operations is
          pragma Assert (Result = 0);
 
          SSL.Abort_Undefer.all;
-      end
-      if;
+      end if;
    end Suspend_Until_True;
 
    ----------------
@@ -1253,6 +1207,7 @@ package body System.Task_Primitives.Operations is
       old_act : aliased struct_sigaction;
       Tmp_Set : aliased sigset_t;
       Result  : Interfaces.C.int;
+      --  Whether to use an alternate signal stack for stack overflows
 
       function State
         (Int : System.Interrupt_Management.Interrupt_ID) return Character;
@@ -1297,6 +1252,11 @@ package body System.Task_Primitives.Operations is
 
       Specific.Initialize (Environment_Task);
 
+      if Use_Alternate_Stack then
+         Environment_Task.Common.Task_Alternate_Stack :=
+           Alternate_Stack'Address;
+      end if;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler

gcc/ada/s-taprop-mingw.adb

@@ -49,6 +49,7 @@ with System.Tasking.Debug;
 with System.OS_Primitives;
 with System.Task_Info;
 with System.Interrupt_Management;
+with System.Win32.Ext;
 
 with System.Soft_Links;
 --  We use System.Soft_Links instead of System.Tasking.Initialization because
@@ -68,6 +69,8 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
    use System.Task_Info;
+   use System.Win32;
+   use System.Win32.Ext;
 
    pragma Link_With ("-Xlinker --stack=0x200000,0x1000");
    --  Change the default stack size (2 MB) for tasking programs on Windows.
@@ -76,6 +79,30 @@ package body System.Task_Primitives.Operations is
    --  Also note that under Windows XP, we use a Windows XP extension to
    --  specify the stack size on a per task basis, as done under other OSes.
 
+   ---------------------
+   -- Local Functions --
+   ---------------------
+
+   procedure InitializeCriticalSection (pCriticalSection : access RTS_Lock);
+   procedure InitializeCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import
+     (Stdcall, InitializeCriticalSection, "InitializeCriticalSection");
+
+   procedure EnterCriticalSection (pCriticalSection : access RTS_Lock);
+   procedure EnterCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, EnterCriticalSection, "EnterCriticalSection");
+
+   procedure LeaveCriticalSection (pCriticalSection : access RTS_Lock);
+   procedure LeaveCriticalSection (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, LeaveCriticalSection, "LeaveCriticalSection");
+
+   procedure DeleteCriticalSection (pCriticalSection : access RTS_Lock);
+   procedure DeleteCriticalSection
+     (pCriticalSection : access CRITICAL_SECTION);
+   pragma Import (Stdcall, DeleteCriticalSection, "DeleteCriticalSection");
+
    ----------------
    -- Local Data --
    ----------------
@@ -140,7 +167,7 @@ package body System.Task_Primitives.Operations is
          Succeeded : BOOL;
       begin
          Succeeded := TlsSetValue (TlsIndex, To_Address (Self_Id));
-         pragma Assert (Succeeded = True);
+         pragma Assert (Succeeded = Win32.TRUE);
       end Set;
 
    end Specific;
@@ -192,7 +219,7 @@ package body System.Task_Primitives.Operations is
    procedure Initialize_Cond (Cond : not null access Condition_Variable) is
       hEvent : HANDLE;
    begin
-      hEvent := CreateEvent (null, True, False, Null_Ptr);
+      hEvent := CreateEvent (null, Win32.TRUE, Win32.FALSE, Null_Ptr);
       pragma Assert (hEvent /= 0);
       Cond.all := Condition_Variable (hEvent);
    end Initialize_Cond;
@@ -208,7 +235,7 @@ package body System.Task_Primitives.Operations is
       Result : BOOL;
    begin
       Result := CloseHandle (HANDLE (Cond.all));
-      pragma Assert (Result = True);
+      pragma Assert (Result = Win32.TRUE);
    end Finalize_Cond;
 
    -----------------
@@ -219,7 +246,7 @@ package body System.Task_Primitives.Operations is
       Result : BOOL;
    begin
       Result := SetEvent (HANDLE (Cond.all));
-      pragma Assert (Result = True);
+      pragma Assert (Result = Win32.TRUE);
    end Cond_Signal;
 
    ---------------
@@ -243,7 +270,7 @@ package body System.Task_Primitives.Operations is
       --  Must reset Cond BEFORE L is unlocked
 
       Result_Bool := ResetEvent (HANDLE (Cond.all));
-      pragma Assert (Result_Bool = True);
+      pragma Assert (Result_Bool = Win32.TRUE);
       Unlock (L, Global_Lock => True);
 
       --  No problem if we are interrupted here: if the condition is signaled,
@@ -283,7 +310,7 @@ package body System.Task_Primitives.Operations is
       --  Must reset Cond BEFORE L is unlocked
 
       Result := ResetEvent (HANDLE (Cond.all));
-      pragma Assert (Result = True);
+      pragma Assert (Result = Win32.TRUE);
       Unlock (L, Global_Lock => True);
 
       --  No problem if we are interrupted here: if the condition is signaled,
@@ -316,7 +343,7 @@ package body System.Task_Primitives.Operations is
 
       if Timed_Out then
          Result := SetEvent (HANDLE (Cond.all));
-         pragma Assert (Result = True);
+         pragma Assert (Result = Win32.TRUE);
       end if;
 
       Status := Integer (Wait_Result);
@@ -384,7 +411,7 @@ package body System.Task_Primitives.Operations is
    is
       pragma Unreferenced (Level);
    begin
-      InitializeCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
+      InitializeCriticalSection (L);
    end Initialize_Lock;
 
    -------------------
@@ -398,7 +425,7 @@ package body System.Task_Primitives.Operations is
 
    procedure Finalize_Lock (L : not null access RTS_Lock) is
    begin
-      DeleteCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
+      DeleteCriticalSection (L);
    end Finalize_Lock;
 
    ----------------
@@ -426,15 +453,14 @@ package body System.Task_Primitives.Operations is
    is
    begin
       if not Single_Lock or else Global_Lock then
-         EnterCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
+         EnterCriticalSection (L);
       end if;
    end Write_Lock;
 
    procedure Write_Lock (T : Task_Id) is
    begin
       if not Single_Lock then
-         EnterCriticalSection
-           (CRITICAL_SECTION (T.Common.LL.L)'Unrestricted_Access);
+         EnterCriticalSection (T.Common.LL.L'Access);
       end if;
    end Write_Lock;
 
@@ -461,15 +487,14 @@ package body System.Task_Primitives.Operations is
      (L : not null access RTS_Lock; Global_Lock : Boolean := False) is
    begin
       if not Single_Lock or else Global_Lock then
-         LeaveCriticalSection (CRITICAL_SECTION (L.all)'Unrestricted_Access);
+         LeaveCriticalSection (L);
       end if;
    end Unlock;
 
    procedure Unlock (T : Task_Id) is
    begin
       if not Single_Lock then
-         LeaveCriticalSection
-           (CRITICAL_SECTION (T.Common.LL.L)'Unrestricted_Access);
+         LeaveCriticalSection (T.Common.LL.L'Access);
       end if;
    end Unlock;
 
@@ -708,7 +733,7 @@ package body System.Task_Primitives.Operations is
    begin
       Res := SetThreadPriority
         (T.Common.LL.Thread, Interfaces.C.int (Underlying_Priorities (Prio)));
-      pragma Assert (Res = True);
+      pragma Assert (Res = Win32.TRUE);
 
       if Dispatching_Policy = 'F' or else Get_Policy (Prio) = 'F' then
 
@@ -869,7 +894,7 @@ package body System.Task_Primitives.Operations is
 
       hTask          : HANDLE;
       TaskId         : aliased DWORD;
-      pTaskParameter : System.OS_Interface.PVOID;
+      pTaskParameter : Win32.PVOID;
       Result         : DWORD;
       Entry_Point    : PTHREAD_START_ROUTINE;
 
@@ -920,7 +945,7 @@ package body System.Task_Primitives.Operations is
          --  boost. A priority boost is temporarily given by the system to a
          --  thread when it is taken out of a wait state.
 
-         SetThreadPriorityBoost (hTask, DisablePriorityBoost => True);
+         SetThreadPriorityBoost (hTask, DisablePriorityBoost => Win32.TRUE);
       end if;
 
       --  Step 4: Handle Task_Info
@@ -972,7 +997,7 @@ package body System.Task_Primitives.Operations is
          Result := WaitForSingleObject (T.Common.LL.Thread, Wait_Infinite);
          pragma Assert (Result /= WAIT_FAILED);
          Succeeded := CloseHandle (T.Common.LL.Thread);
-         pragma Assert (Succeeded = True);
+         pragma Assert (Succeeded = Win32.TRUE);
       end if;
 
       Free (Self_ID);
@@ -1095,7 +1120,7 @@ package body System.Task_Primitives.Operations is
 
       --  Initialize internal condition variable
 
-      S.CV := CreateEvent (null, True, False, Null_Ptr);
+      S.CV := CreateEvent (null, Win32.TRUE, Win32.FALSE, Null_Ptr);
       pragma Assert (S.CV /= 0);
    end Initialize;
 
@@ -1113,7 +1138,7 @@ package body System.Task_Primitives.Operations is
       --  Destroy internal condition variable
 
       Result := CloseHandle (S.CV);
-      pragma Assert (Result = True);
+      pragma Assert (Result = Win32.TRUE);
    end Finalize;
 
    -------------------
@@ -1166,7 +1191,7 @@ package body System.Task_Primitives.Operations is
          S.State := False;
 
          Result := SetEvent (S.CV);
-         pragma Assert (Result = True);
+         pragma Assert (Result = Win32.TRUE);
       else
          S.State := True;
       end if;
@@ -1215,7 +1240,7 @@ package body System.Task_Primitives.Operations is
             --  Must reset CV BEFORE L is unlocked
 
             Result_Bool := ResetEvent (S.CV);
-            pragma Assert (Result_Bool = True);
+            pragma Assert (Result_Bool = Win32.TRUE);
 
             LeaveCriticalSection (S.L'Access);
 

gcc/ada/s-taprop-posix.adb

@@ -73,6 +73,9 @@ package body System.Task_Primitives.Operations is
    use System.Parameters;
    use System.OS_Primitives;
 
+   Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
+   --  Whether to use an alternate signal stack for stack overflows
+
    ----------------
    -- Local Data --
    ----------------
@@ -798,6 +801,19 @@ package body System.Task_Primitives.Operations is
       end loop;
 
       Unlock_RTS;
+
+      if Use_Alternate_Stack then
+         declare
+            Stack  : aliased stack_t;
+            Result : Interfaces.C.int;
+         begin
+            Stack.ss_sp    := Self_ID.Common.Task_Alternate_Stack;
+            Stack.ss_size  := Alternate_Stack_Size;
+            Stack.ss_flags := 0;
+            Result := sigaltstack (Stack'Access, null);
+            pragma Assert (Result = 0);
+         end;
+      end if;
    end Enter_Task;
 
    --------------
@@ -932,7 +948,8 @@ package body System.Task_Primitives.Operations is
       use System.Task_Info;
 
    begin
-      Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
+      Adjusted_Stack_Size :=
+         Interfaces.C.size_t (Stack_Size + Alternate_Stack_Size);
 
       if Stack_Base_Available then
 
@@ -1415,6 +1432,11 @@ package body System.Task_Primitives.Operations is
 
       Specific.Initialize (Environment_Task);
 
+      if Use_Alternate_Stack then
+         Environment_Task.Common.Task_Alternate_Stack :=
+           Alternate_Stack'Address;
+      end if;
+
       Enter_Task (Environment_Task);
 
       --  Install the abort-signal handler

gcc/ada/s-taskin.ads

@@ -106,6 +106,7 @@ package System.Tasking is
    type Ada_Task_Control_Block;
 
    type Task_Id is access all Ada_Task_Control_Block;
+   for Task_Id'Size use System.Task_Primitives.Task_Address_Size;
 
    Null_Task : constant Task_Id;
 
@@ -117,9 +118,11 @@ package System.Tasking is
    --  from the run-time system.
 
    function To_Task_Id is
-     new Ada.Unchecked_Conversion (System.Address, Task_Id);
+     new Ada.Unchecked_Conversion
+       (System.Task_Primitives.Task_Address, Task_Id);
    function To_Address is
-     new Ada.Unchecked_Conversion (Task_Id, System.Address);
+     new Ada.Unchecked_Conversion
+       (Task_Id, System.Task_Primitives.Task_Address);
 
    -----------------------
    -- Enumeration types --
@@ -340,7 +343,7 @@ package System.Tasking is
    --    Abnormal means that the task terminates because it is being aborted
 
    --    handled_Exception means that the task terminates because of exception
-   --    raised by by the execution of its task_body.
+   --    raised by the execution of its task_body.
 
    type Termination_Handler is access protected procedure
      (Cause : Cause_Of_Termination;
@@ -492,6 +495,11 @@ package System.Tasking is
       --  Activator writes it, once, before Self starts executing. Thereafter,
       --  Self only reads it.
 
+      Task_Alternate_Stack : System.Address;
+      --  The address of the alternate signal stack for this task, if any
+      --
+      --  Protection: Only accessed by Self
+
       Task_Entry_Point : Task_Procedure_Access;
       --  Information needed to call the procedure containing the code for
       --  the body of this task.
@@ -801,7 +809,8 @@ package System.Tasking is
    ------------------------------------
 
    type Access_Address is access all System.Address;
-   --  Comment on what this is used for ???
+   --  Anonymous pointer used to implement task attributes (see s-tataat.adb
+   --  and a-tasatt.adb)
 
    pragma No_Strict_Aliasing (Access_Address);
    --  This type is used in contexts where aliasing may be an issue (see

gcc/ada/s-taspri-hpux-dce.ads

@@ -64,6 +64,18 @@ package System.Task_Primitives is
    --  A component of this type is guaranteed to be included in the
    --  Ada_Task_Control_Block.
 
+   subtype Task_Address is System.Address;
+   --  In some versions of Task_Primitives, notably for VMS, Task_Address is
+   --  the short version of address defined in System.Aux_DEC. To avoid
+   --  dragging Aux_DEC into tasking packages a tasking specific subtype is
+   --  defined here.
+
+   Task_Address_Size : constant := Standard'Address_Size;
+   --  The size of Task_Address
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
 private
    type Lock is record
       L              : aliased System.OS_Interface.pthread_mutex_t;

gcc/ada/s-taspri-lynxos.ads

@@ -63,6 +63,18 @@ package System.Task_Primitives is
    --  A component of this type is guaranteed to be included in the
    --  Ada_Task_Control_Block.
 
+   subtype Task_Address is System.Address;
+   --  In some versions of Task_Primitives, notably for VMS, Task_Address is
+   --  the short version of address defined in System.Aux_DEC. To avoid
+   --  dragging Aux_DEC into tasking packages a tasking specific subtype is
+   --  defined here.
+
+   Task_Address_Size : constant := Standard'Address_Size;
+   --  The size of Task_Address
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
 private
 
    type Lock is record

gcc/ada/s-taspri-posix-noaltstack.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                  GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS                --
+--                                                                          --
+--                 S Y S T E M . T A S K _ P R I M I T I V E S              --
+--                                                                          --
+--                                  S p e c                                 --
+--                                                                          --
+--             Copyright (C) 1991-1994, Florida State University            --
+--                     Copyright (C) 1995-2008, AdaCore                     --
+--                                                                          --
+-- GNARL 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 2,  or (at your option) any later ver- --
+-- sion. GNARL 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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNARL; see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNARL was developed by the GNARL team at Florida State University.       --
+-- Extensive contributions were provided by Ada Core Technologies, Inc.     --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  This is a POSIX-like version of this package where no alternate stack
+--  is needed for stack checking.
+
+--  Note: this file can only be used for POSIX compliant systems
+
+pragma Polling (Off);
+--  Turn off polling, we do not want ATC polling to take place during tasking
+--  operations. It causes infinite loops and other problems.
+
+with System.OS_Interface;
+
+package System.Task_Primitives is
+   pragma Preelaborate;
+
+   type Lock is limited private;
+   --  Should be used for implementation of protected objects
+
+   type RTS_Lock is limited private;
+   --  Should be used inside the runtime system. The difference between Lock
+   --  and the RTS_Lock is that the later one serves only as a semaphore so
+   --  that do not check for ceiling violations.
+
+   type Suspension_Object is limited private;
+   --  Should be used for the implementation of Ada.Synchronous_Task_Control
+
+   type Task_Body_Access is access procedure;
+   --  Pointer to the task body's entry point (or possibly a wrapper declared
+   --  local to the GNARL).
+
+   type Private_Data is limited private;
+   --  Any information that the GNULLI needs maintained on a per-task basis.
+   --  A component of this type is guaranteed to be included in the
+   --  Ada_Task_Control_Block.
+
+   subtype Task_Address is System.Address;
+   --  In some versions of Task_Primitives, notably for VMS, Task_Address is
+   --  the short version of address defined in System.Aux_DEC. To avoid
+   --  dragging Aux_DEC into tasking packages a tasking specific subtype is
+   --  defined here.
+
+   Task_Address_Size : constant := Standard'Address_Size;
+   --  The size of Task_Address
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
+private
+
+   type Lock is new System.OS_Interface.pthread_mutex_t;
+   type RTS_Lock is new System.OS_Interface.pthread_mutex_t;
+
+   type Suspension_Object is record
+      State : Boolean;
+      pragma Atomic (State);
+      --  Boolean that indicates whether the object is open. This field is
+      --  marked Atomic to ensure that we can read its value without locking
+      --  the access to the Suspension_Object.
+
+      Waiting : Boolean;
+      --  Flag showing if there is a task already suspended on this object
+
+      L : aliased System.OS_Interface.pthread_mutex_t;
+      --  Protection for ensuring mutual exclusion on the Suspension_Object
+
+      CV : aliased System.OS_Interface.pthread_cond_t;
+      --  Condition variable used to queue threads until condition is signaled
+   end record;
+
+   type Private_Data is record
+      Thread : aliased System.OS_Interface.pthread_t;
+      pragma Atomic (Thread);
+      --  Thread field may be updated by two different threads of control.
+      --  (See, Enter_Task and Create_Task in s-taprop.adb). They put the same
+      --  value (thr_self value). We do not want to use lock on those
+      --  operations and the only thing we have to make sure is that they are
+      --  updated in atomic fashion.
+
+      LWP : aliased System.Address;
+      --  The purpose of this field is to provide a better tasking support on
+      --  gdb. The order of the two first fields (Thread and LWP) is important.
+      --  On targets where lwp is not relevant, this is equivalent to Thread.
+
+      CV : aliased System.OS_Interface.pthread_cond_t;
+      --  Should be commented ??? (in all versions of taspri)
+
+      L : aliased RTS_Lock;
+      --  Protection for all components is lock L
+   end record;
+
+end System.Task_Primitives;

gcc/ada/s-taspri-solaris.ads

@@ -71,6 +71,18 @@ package System.Task_Primitives is
    --  A component of this type is guaranteed to be included in the
    --  Ada_Task_Control_Block.
 
+   subtype Task_Address is System.Address;
+   --  In some versions of Task_Primitives, notably for VMS, Task_Address is
+   --  the short version of address defined in System.Aux_DEC. To avoid
+   --  dragging Aux_DEC into tasking packages a tasking specific subtype is
+   --  defined here.
+
+   Task_Address_Size : constant := Standard'Address_Size;
+   --  The size of Task_Address
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
 private
 
    type Private_Task_Serial_Number is mod 2 ** 64;

gcc/ada/s-taspri-tru64.ads

@@ -65,6 +65,18 @@ package System.Task_Primitives is
    --  Any information that the GNULLI needs maintained on a per-task basis.
    --  A component of this type is guaranteed to be included
 
+   subtype Task_Address is System.Address;
+   --  In some versions of Task_Primitives, notably for VMS, Task_Address is
+   --  the short version of address defined in System.Aux_DEC. To avoid
+   --  dragging Aux_DEC into tasking packages a tasking specific subtype is
+   --  defined here.
+
+   Task_Address_Size : constant := Standard'Address_Size;
+   --  The size of Task_Address
+
+   Alternate_Stack_Size : constant := 0;
+   --  No alternate signal stack is used on this platform
+
 private
 
    type Lock is record

gcc/ada/s-tassta.adb

@@ -40,6 +40,7 @@ with Ada.Unchecked_Deallocation;
 
 with System.Tasking.Debug;
 with System.Address_Image;
+with System.Task_Primitives;
 with System.Task_Primitives.Operations;
 with System.Tasking.Utilities;
 with System.Tasking.Queuing;
@@ -135,9 +136,6 @@ package body System.Tasking.Stages is
    --  For tasks created by an allocator that fails, due to an exception, it is
    --  called from Expunge_Unactivated_Tasks.
    --
-   --  It is also called from Ada.Unchecked_Deallocation, for objects that are
-   --  or contain tasks.
-   --
    --  Different code is used at master completion, in Terminate_Dependents,
    --  due to a need for tighter synchronization with the master.
 
@@ -408,8 +406,7 @@ package body System.Tasking.Stages is
 
       Initialization.Undefer_Abort_Nestable (Self_ID);
 
-      --  ???
-      --  Why do we need to allow for nested deferral here?
+      --  ??? Why do we need to allow for nested deferral here?
 
       if Runtime_Traces then
          Send_Trace_Info (T_Activate);
@@ -460,6 +457,7 @@ package body System.Tasking.Stages is
      (Priority          : Integer;
       Size              : System.Parameters.Size_Type;
       Task_Info         : System.Task_Info.Task_Info_Type;
+      Relative_Deadline : Ada.Real_Time.Time_Span;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
       State             : Task_Procedure_Access;
@@ -475,6 +473,10 @@ package body System.Tasking.Stages is
       Base_Priority : System.Any_Priority;
       Len           : Natural;
 
+      pragma Unreferenced (Relative_Deadline);
+      --  EDF scheduling is not supported by any of the target platforms so
+      --  this parameter is not passed any further.
+
    begin
       --  If Master is greater than the current master, it means that Master
       --  has already awaited its dependent tasks. This raises Program_Error,
@@ -749,7 +751,7 @@ package body System.Tasking.Stages is
          Unlock_RTS;
       end if;
 
-      --  We need to explicitely wait for the task to be terminated here
+      --  We need to explicitly wait for the task to be terminated here
       --  because on true concurrent system, we may end this procedure before
       --  the tasks are really terminated.
 
@@ -829,6 +831,7 @@ package body System.Tasking.Stages is
          Initialization.Task_Lock (Self_Id);
 
          Lock_RTS;
+         Initialization.Finalize_Attributes_Link.all (T);
          Initialization.Remove_From_All_Tasks_List (T);
          Unlock_RTS;
 
@@ -896,12 +899,12 @@ package body System.Tasking.Stages is
    -- Task_Wrapper --
    ------------------
 
-   --  The task wrapper is a procedure that is called first for each task
-   --  task body, and which in turn calls the compiler-generated task body
-   --  procedure. The wrapper's main job is to do initialization for the task.
-   --  It also has some locally declared objects that server as per-task local
-   --  data. Task finalization is done by Complete_Task, which is called from
-   --  an at-end handler that the compiler generates.
+   --  The task wrapper is a procedure that is called first for each task body
+   --  and which in turn calls the compiler-generated task body procedure.
+   --  The wrapper's main job is to do initialization for the task. It also
+   --  has some locally declared objects that serve as per-task local data.
+   --  Task finalization is done by Complete_Task, which is called from an
+   --  at-end handler that the compiler generates.
 
    procedure Task_Wrapper (Self_ID : Task_Id) is
       use type SSE.Storage_Offset;
@@ -910,6 +913,13 @@ package body System.Tasking.Stages is
 
       Bottom_Of_Stack : aliased Integer;
 
+      Task_Alternate_Stack :
+        aliased SSE.Storage_Array (1 .. Alternate_Stack_Size);
+      --  The alternate signal stack for this task, if any
+
+      Use_Alternate_Stack : constant Boolean := Alternate_Stack_Size /= 0;
+      --  Whether to use above alternate signal stack for stack overflows
+
       Secondary_Stack_Size :
         constant SSE.Storage_Offset :=
           Self_ID.Common.Compiler_Data.Pri_Stack_Info.Size *
@@ -921,6 +931,9 @@ package body System.Tasking.Stages is
       --  Why are warnings being turned off here???
 
       Secondary_Stack_Address : System.Address := Secondary_Stack'Address;
+      --  Address of secondary stack. In the fixed secondary stack case, this
+      --  value is not modified, causing a warning, hence the bracketing with
+      --  Warnings (Off/On). But why is so much *more* bracketed???
 
       Small_Overflow_Guard : constant := 12 * 1024;
       --  Note: this used to be 4K, but was changed to 12K, since smaller
@@ -939,9 +952,6 @@ package body System.Tasking.Stages is
       --  Size of the overflow guard, used by dynamic stack usage analysis
 
       pragma Warnings (On);
-      --  Address of secondary stack. In the fixed secondary stack case, this
-      --  value is not modified, causing a warning, hence the bracketing with
-      --  Warnings (Off/On). But why is so much *more* bracketed ???
 
       SEH_Table : aliased SSE.Storage_Array (1 .. 8);
       --  Structured Exception Registration table (2 words)
@@ -1017,6 +1027,10 @@ package body System.Tasking.Stages is
          Size := Size - Natural (Secondary_Stack_Size);
       end if;
 
+      if Use_Alternate_Stack then
+         Self_ID.Common.Task_Alternate_Stack := Task_Alternate_Stack'Address;
+      end if;
+
       if System.Stack_Usage.Is_Enabled then
          STPO.Lock_RTS;
          Initialize_Analyzer (Self_ID.Common.Analyzer,
@@ -1309,7 +1323,8 @@ package body System.Tasking.Stages is
       use System.Standard_Library;
 
       function To_Address is new
-        Ada.Unchecked_Conversion (Task_Id, System.Address);
+        Ada.Unchecked_Conversion
+         (Task_Id, System.Task_Primitives.Task_Address);
 
       function Tailored_Exception_Information
         (E : Exception_Occurrence) return String;

gcc/ada/s-tassta.ads

@@ -44,6 +44,8 @@
 with System.Task_Info;
 with System.Parameters;
 
+with Ada.Real_Time;
+
 package System.Tasking.Stages is
    pragma Elaborate_Body;
 
@@ -81,8 +83,8 @@ package System.Tasking.Stages is
    --         _init.discr := discr;
    --         _init._task_id := null;
    --         create_task (unspecified_priority, tZ,
-   --           unspecified_task_info, 0, _master,
-   --           task_procedure_access!(tB'address),
+   --           unspecified_task_info, ada__real_time__time_span_zero, 0,
+   --           _master, task_procedure_access!(tB'address),
    --           _init'address, tE'unchecked_access, _chain, _task_id, _init.
    --           _task_id);
    --         return;
@@ -170,6 +172,7 @@ package System.Tasking.Stages is
      (Priority          : Integer;
       Size              : System.Parameters.Size_Type;
       Task_Info         : System.Task_Info.Task_Info_Type;
+      Relative_Deadline : Ada.Real_Time.Time_Span;
       Num_Entries       : Task_Entry_Index;
       Master            : Master_Level;
       State             : Task_Procedure_Access;
@@ -186,6 +189,8 @@ package System.Tasking.Stages is
    --  Size is the stack size of the task to create
    --  Task_Info is the task info associated with the created task, or
    --   Unspecified_Task_Info if none.
+   --  Relative_Deadline is the relative deadline associated with the created
+   --  task by means of a pragma Relative_Deadline, or 0.0 if none.
    --  State is the compiler generated task's procedure body
    --  Discriminants is a pointer to a limited record whose discriminants
    --   are those of the task to create. This parameter should be passed as

gcc/ada/system-linux-x86.ads

@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                         (GNU-Linux/x86 Version)                          --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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 --
@@ -139,7 +139,7 @@ private
    Preallocated_Stacks       : constant Boolean := False;
    Signed_Zeros              : constant Boolean := True;
    Stack_Check_Default       : constant Boolean := False;
-   Stack_Check_Probes        : constant Boolean := False;
+   Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
    Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;

gcc/ada/system-linux-x86_64.ads

@@ -7,7 +7,7 @@
 --                                 S p e c                                  --
 --                       (GNU-Linux/x86-64 Version)                         --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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 --
@@ -139,7 +139,7 @@ private
    Preallocated_Stacks       : constant Boolean := False;
    Signed_Zeros              : constant Boolean := True;
    Stack_Check_Default       : constant Boolean := False;
-   Stack_Check_Probes        : constant Boolean := False;
+   Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
    Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;