diff --git a/gcc/ada/s-osinte-tru64.adb b/gcc/ada/s-osinte-tru64.adb index e0b683e52cd..0733d8abec5 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 8723f2db857..27d3eeea2bb 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 d569831f87e..6667899fed9 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);