s-osinte-tru64.ads, [...] (Get_Stack_Base): New function

2005-03-08  Eric Botcazou  <ebotcazou@adacore.com>

	* s-osinte-tru64.ads, s-osinte-tru64.adb (Get_Stack_Base): New function
	(Hide_Yellow_Zone): New procedure to hide the Yellow Zone of the
	calling thread.
	(Stack_Base_Available): New flag.
	(Get_Page_Size): New overloaded functions imported from C.
	(PROT_NONE, PROT_READ, PROT_WRITE, PROT_EXEC, PROT_ALL,
	PROT_ON, PROT_OFF): New constants.
	(mprotect): New function imported from C.
	(pthread_teb_t): New record type.

	* s-taprop-tru64.adb: (Enter_Task): Invoke Hide_Yellow_Zone.
	(Create_Task): Account for the Yellow Zone and the guard page.

From-SVN: r96479

3 files changed, 121 insertions, 16 deletions

diff --git a/gcc/ada/s-osinte-tru64.adb b/gcc/ada/s-osinte-tru64.adb
index e0b683e..0733d8a 100644
--- a/gcc/ada/s-osinte-tru64.adb
+++ b/gcc/ada/s-osinte-tru64.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1998-2002, Free Software Foundation, Inc.          --
+--         Copyright (C) 1998-2005, 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- --
@@ -31,7 +31,7 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  This is the DEC Unix version of this package.
+--  This is the DEC Unix version of this package
 
 --  This package encapsulates all direct interfaces to OS services
 --  that are needed by children of System.
@@ -45,6 +45,16 @@ with System.Machine_Code; use System.Machine_Code;
 
 package body System.OS_Interface is
 
+   --------------------
+   -- Get_Stack_Base --
+   --------------------
+
+   function Get_Stack_Base (thread : pthread_t) return Address is
+      pragma Unreferenced (thread);
+   begin
+      return Null_Address;
+   end Get_Stack_Base;
+
    ------------------
    -- pthread_init --
    ------------------
@@ -68,6 +78,31 @@ package body System.OS_Interface is
       return Self;
    end pthread_self;
 
+   ----------------------
+   -- Hide_Yellow_Zone --
+   ----------------------
+
+   procedure Hide_Yellow_Zone is
+      type Teb_Ptr is access all pthread_teb_t;
+      Teb : Teb_Ptr;
+      Res : Interfaces.C.int;
+      pragma Unreferenced (Res);
+
+   begin
+      --  Get the Thread Environment Block address
+
+      Asm ("call_pal 0x9e" & ASCII.LF & ASCII.HT &
+           "bis $31, $0, %0",
+           Outputs => Teb_Ptr'Asm_Output ("=r", Teb),
+           Clobber => "$0");
+
+      --  Stick a guard page right above the Yellow Zone if it exists
+
+      if Teb.all.stack_yellow /= Teb.all.stack_guard then
+         Res := mprotect (Teb.all.stack_yellow, Get_Page_Size, PROT_ON);
+      end if;
+   end Hide_Yellow_Zone;
+
    -----------------
    -- To_Duration --
    -----------------
diff --git a/gcc/ada/s-osinte-tru64.ads b/gcc/ada/s-osinte-tru64.ads
index 8723f2d..27d3eee 100644
--- a/gcc/ada/s-osinte-tru64.ads
+++ b/gcc/ada/s-osinte-tru64.ads
@@ -7,7 +7,7 @@
 --                                  S p e c                                 --
 --                                                                          --
 --             Copyright (C) 1991-1994, Florida State University            --
---             Copyright (C) 1995-2004, Free Software Foundation, Inc.      --
+--             Copyright (C) 1995-2005, 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- --
@@ -277,6 +277,42 @@ package System.OS_Interface is
 
    PTHREAD_EXPLICIT_SCHED : constant := 1;
 
+   -----------
+   -- 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.
+
+   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
+
+   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;
+
+   function mprotect (addr : Address; len : size_t; prot : int) return int;
+   pragma Import (C, mprotect);
+
+   procedure Hide_Yellow_Zone;
+   --  Every thread except the initial one features an overflow warning area
+   --  just above the overflow guard area on the stack. They are called
+   --  the Yellow Zone and the Red Zone respectively. This procedure hides
+   --  the former so that the latter could be exposed to stack probing.
+
    ---------------------------------------
    -- Nonstandard Thread Initialization --
    ---------------------------------------
@@ -490,6 +526,34 @@ private
 
    type pthread_t is new System.Address;
 
+   type pthread_teb_t is record
+      reserved1     : System.Address;
+      reserved2     : System.Address;
+      size          : unsigned_short;
+      version       : unsigned_char;
+      reserved3     : unsigned_char;
+      external      : unsigned_char;
+      reserved4     : char_array (0 .. 1);
+      creator       : unsigned_char;
+      sequence      : unsigned_long;
+      reserved5     : unsigned_long_array (0 .. 1);
+      per_kt_area   : System.Address;
+      stack_base    : System.Address;
+      stack_reserve : System.Address;
+      stack_yellow  : System.Address;
+      stack_guard   : System.Address;
+      stack_size    : unsigned_long;
+      tsd_values    : System.Address;
+      tsd_count     : unsigned_long;
+      reserved6     : unsigned;
+      reserved7     : unsigned;
+      thread_flags  : unsigned;
+      thd_errno     : int;
+      stack_hiwater : System.Address;
+      home_rad      : unsigned_long;
+   end record;
+   pragma Convention (C, pthread_teb_t);
+
    type pthread_cond_t is record
       state     : unsigned;
       valid     : unsigned;
diff --git a/gcc/ada/s-taprop-tru64.adb b/gcc/ada/s-taprop-tru64.adb
index d569831..6667899f 100644
--- a/gcc/ada/s-taprop-tru64.adb
+++ b/gcc/ada/s-taprop-tru64.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2004, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2005, 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- --
@@ -111,7 +111,7 @@ package body System.Task_Primitives.Operations is
    --  Key used to find the Ada Task_Id associated with a thread
 
    Environment_Task_Id : Task_Id;
-   --  A variable to hold Task_Id for the environment task.
+   --  A variable to hold Task_Id for the environment task
 
    Unblocked_Signal_Mask : aliased sigset_t;
    --  The set of signals that should unblocked in all tasks
@@ -126,12 +126,12 @@ package body System.Task_Primitives.Operations is
    pragma Import (C, Dispatching_Policy, "__gl_task_dispatching_policy");
 
    FIFO_Within_Priorities : constant Boolean := Dispatching_Policy = 'F';
-   --  Indicates whether FIFO_Within_Priorities is set.
+   --  Indicates whether FIFO_Within_Priorities is set
 
    Curpid : pid_t;
 
    Foreign_Task_Elaborated : aliased Boolean := True;
-   --  Used to identified fake tasks (i.e., non-Ada Threads).
+   --  Used to identified fake tasks (i.e., non-Ada Threads)
 
    --------------------
    -- Local Packages --
@@ -141,7 +141,7 @@ package body System.Task_Primitives.Operations is
 
       procedure Initialize (Environment_Task : Task_Id);
       pragma Inline (Initialize);
-      --  Initialize various data needed by this package.
+      --  Initialize various data needed by this package
 
       function Is_Valid_Task return Boolean;
       pragma Inline (Is_Valid_Task);
@@ -149,23 +149,23 @@ package body System.Task_Primitives.Operations is
 
       procedure Set (Self_Id : Task_Id);
       pragma Inline (Set);
-      --  Set the self id for the current task.
+      --  Set the self id for the current task
 
       function Self return Task_Id;
       pragma Inline (Self);
-      --  Return a pointer to the Ada Task Control Block of the calling task.
+      --  Return a pointer to the Ada Task Control Block of the calling task
 
    end Specific;
 
    package body Specific is separate;
-   --  The body of this package is target specific.
+   --  The body of this package is target specific
 
    ---------------------------------
    -- Support for foreign threads --
    ---------------------------------
 
    function Register_Foreign_Thread (Thread : Thread_Id) return Task_Id;
-   --  Allocate and Initialize a new ATCB for the current Thread.
+   --  Allocate and initialize a new ATCB for the current Thread
 
    function Register_Foreign_Thread
      (Thread : Thread_Id) return Task_Id is separate;
@@ -175,7 +175,7 @@ package body System.Task_Primitives.Operations is
    -----------------------
 
    procedure Abort_Handler (Sig : Signal);
-   --  Signal handler used to implement asynchronous abortion.
+   --  Signal handler used to implement asynchronous abort
 
    -------------------
    -- Abort_Handler --
@@ -338,7 +338,7 @@ package body System.Task_Primitives.Operations is
       Current_Prio   : System.Any_Priority;
 
    begin
-      --  Perform ceiling checks only when this is the locking policy in use.
+      --  Perform ceiling checks only when this is the locking policy in use
 
       if Locking_Policy = 'C' then
          Self_ID := Self;
@@ -440,7 +440,7 @@ package body System.Task_Primitives.Operations is
                      (Self_ID.Common.LL.CV'Access, Self_ID.Common.LL.L'Access);
       end if;
 
-      --  EINTR is not considered a failure.
+      --  EINTR is not considered a failure
 
       pragma Assert (Result = 0 or else Result = EINTR);
    end Sleep;
@@ -689,6 +689,7 @@ package body System.Task_Primitives.Operations is
 
    procedure Enter_Task (Self_ID : Task_Id) is
    begin
+      Hide_Yellow_Zone;
       Self_ID.Common.LL.Thread := pthread_self;
       Specific.Set (Self_ID);
 
@@ -815,6 +816,11 @@ package body System.Task_Primitives.Operations is
          Adjusted_Stack_Size := Interfaces.C.size_t (Stack_Size);
       end if;
 
+      --  Account for the Yellow Zone (2 pages) and the guard page
+      --  right above. See Hide_Yellow_Zone for the rationale.
+
+      Adjusted_Stack_Size := Adjusted_Stack_Size + 3 * Get_Page_Size;
+
       Result := pthread_attr_init (Attributes'Access);
       pragma Assert (Result = 0 or else Result = ENOMEM);
 
@@ -1072,7 +1078,7 @@ package body System.Task_Primitives.Operations is
    begin
       Environment_Task_Id := Environment_Task;
 
-      --  Initialize the lock used to synchronize chain of all ATCBs.
+      --  Initialize the lock used to synchronize chain of all ATCBs
 
       Initialize_Lock (Single_RTS_Lock'Access, RTS_Lock_Level);