Skip to content

R
riscv-gcc-1
Commit 09c239f6 by Eric Botcazou Committed by Arnaud Charlet
Options

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
parent 0b6eb8e1
Showing with 121 additions and 16 deletions
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 --
-----------------
......
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;
......
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);
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment