-- --
-- 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- --
-- --
------------------------------------------------------------------------------
--- 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.
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 --
------------------
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 --
-----------------
-- 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- --
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 --
---------------------------------------
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;
-- --
-- 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- --
-- 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
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 --
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);
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;
-----------------------
procedure Abort_Handler (Sig : Signal);
- -- Signal handler used to implement asynchronous abortion.
+ -- Signal handler used to implement asynchronous abort
-------------------
-- Abort_Handler --
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;
(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;
procedure Enter_Task (Self_ID : Task_Id) is
begin
+ Hide_Yellow_Zone;
Self_ID.Common.LL.Thread := pthread_self;
Specific.Set (Self_ID);
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);
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);
projects / gcc.git / commitdiff