------------------------------------------------------------------------------
-- --
--- GNU ADA RUN-TIME LIBRARY (GNARL) COMPONENTS --
+-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . S T A C K _ C H E C K I N G . O P E R A T I O N S --
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2004 Free Software Foundation, Inc. --
+-- Copyright (C) 1999-2009, 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- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
+-- sion. GNAT 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, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- or FITNESS FOR A PARTICULAR PURPOSE. --
-- --
--- 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. --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception, --
+-- version 3.1, as published by the Free Software Foundation. --
+-- --
+-- You should have received a copy of the GNU General Public License and --
+-- a copy of the GCC Runtime Library Exception along with this program; --
+-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
+-- <http://www.gnu.org/licenses/>. --
-- --
-- GNARL was developed by the GNARL team at Florida State University. --
-- Extensive contributions were provided by Ada Core Technologies, Inc. --
-- We want to guarantee the absence of elaboration code because the
-- binder does not handle references to this package.
-with Ada.Exceptions;
-
with System.Storage_Elements; use System.Storage_Elements;
with System.Parameters; use System.Parameters;
-with System.Soft_Links;
with Interfaces.C;
-with System.OS_Interface;
package body System.Stack_Checking.Operations is
- -- In order to have stack checking working appropriately on
- -- VxWorks we need to extract the stack size information from the
- -- VxWorks kernel itself. It means that the library for showing
- -- task-related information needs to be linked into the VxWorks
- -- system, when using stack checking. The TaskShow library can be
- -- linked into the VxWorks system by either:
+ -- In order to have stack checking working appropriately on VxWorks we need
+ -- to extract the stack size information from the VxWorks kernel itself. It
+ -- means that the library for showing task-related information needs to be
+ -- linked into the VxWorks system, when using stack checking. The TaskShow
+ -- library can be linked into the VxWorks system by either:
+
-- * defining INCLUDE_SHOW_ROUTINES in config.h when using
-- configuration header files, or
+
-- * selecting INCLUDE_TASK_SHOW when using the Tornado project
-- facility.
- function Set_Stack_Info (Stack : access Stack_Access) return Stack_Access;
-
- -- The function Set_Stack_Info is the actual function that updates
- -- the cache containing a pointer to the Stack_Info. It may also
- -- be used for detecting asynchronous abort in combination with
- -- Invalidate_Self_Cache.
-
- -- Set_Stack_Info should do the following things in order:
- -- 1) Get the Stack_Access value for the current task
- -- 2) Set Stack.all to the value obtained in 1)
- -- 3) Optionally Poll to check for asynchronous abort
-
- -- This order is important because if at any time a write to
- -- the stack cache is pending, that write should be followed
- -- by a Poll to prevent loosing signals.
-
- -- Note: This function must be compiled with Polling turned off
-
- -- Note: on systems like VxWorks and OS/2 with real thread-local storage,
- -- Set_Stack_Info should return an access value for such local
- -- storage. In those cases the cache will always be up-to-date.
-
- -- The following constants should be imported from some system-specific
- -- constants package. The constants must be static for performance reasons.
-
- ----------------------------
- -- Invalidate_Stack_Cache --
- ----------------------------
-
- procedure Invalidate_Stack_Cache (Any_Stack : Stack_Access) is
- pragma Warnings (Off, Any_Stack);
- begin
- Cache := Null_Stack;
- end Invalidate_Stack_Cache;
-
- --------------------
- -- Set_Stack_Info --
- --------------------
-
- function Set_Stack_Info
- (Stack : access Stack_Access) return Stack_Access
- is
-
- -- Task descriptor that is handled internally by the VxWorks kernel
- type Task_Descriptor is record
- T_Id : Interfaces.C.int; -- task identifier
- Td_Name : System.Address; -- task name
- Td_Priority : Interfaces.C.int; -- task priority
- Td_Status : Interfaces.C.int; -- task status
- Td_Options : Interfaces.C.int; -- task option bits (see below)
- Td_Entry : System.Address; -- original entry point of task
- Td_Sp : System.Address; -- saved stack pointer
- Td_PStackBase : System.Address; -- the bottom of the stack
- Td_PStackLimit : System.Address; -- the effective end of the stack
- Td_PStackEnd : System.Address; -- the actual end of the stack
- Td_StackSize : Interfaces.C.int; -- size of stack in bytes
- Td_StackCurrent : Interfaces.C.int; -- current stack usage in bytes
- Td_StackHigh : Interfaces.C.int; -- maximum stack usage in bytes
- Td_StackMargin : Interfaces.C.int; -- current stack margin in bytes
- Td_ErrorStatus : Interfaces.C.int; -- most recent task error status
- Td_Delay : Interfaces.C.int; -- delay/timeout ticks
- end record;
-
- -- This VxWorks procedure fills in a specified task descriptor
- -- for a specified task.
- procedure TaskInfoGet (T_Id : System.OS_Interface.t_id;
- Task_Desc : access Task_Descriptor);
- pragma Import (C, TaskInfoGet, "taskInfoGet");
-
- My_Stack : Stack_Access;
- Task_Desc : aliased Task_Descriptor;
-
+ Stack_Limit : Address :=
+ Boolean'Pos (Stack_Grows_Down) * Address'First
+ + Boolean'Pos (not Stack_Grows_Down) * Address'Last;
+ pragma Export (C, Stack_Limit, "__gnat_stack_limit");
+ -- Stack_Limit contains the limit of the stack. This variable is later made
+ -- a task variable (by calling taskVarAdd) and then correctly set to the
+ -- stack limit of the task. Before being so initialized its value must be
+ -- valid so that any subprogram with stack checking enabled will run. We
+ -- use extreme values according to the direction of the stack.
+
+ type Set_Stack_Limit_Proc_Acc is access procedure;
+ pragma Convention (C, Set_Stack_Limit_Proc_Acc);
+
+ Set_Stack_Limit_Hook : Set_Stack_Limit_Proc_Acc;
+ pragma Import (C, Set_Stack_Limit_Hook, "__gnat_set_stack_limit_hook");
+ -- Procedure to be called when a task is created to set stack
+ -- limit.
+
+ procedure Set_Stack_Limit_For_Current_Task;
+ pragma Convention (C, Set_Stack_Limit_For_Current_Task);
+ -- Register Initial_SP as the initial stack pointer value for the current
+ -- task when it starts and Size as the associated stack area size. This
+ -- should be called once, after the soft-links have been initialized?
+
+ -----------------------------
+ -- Initialize_Stack_Limit --
+ -----------------------------
+
+ procedure Initialize_Stack_Limit is
begin
- -- The order of steps 1 .. 3 is important, see specification.
-
- -- 1) Get the Stack_Access value for the current task
-
- My_Stack := Soft_Links.Get_Stack_Info.all;
+ -- For the environment task
- if My_Stack.Base = Null_Address then
+ Set_Stack_Limit_For_Current_Task;
- -- First invocation. Ask the VxWorks kernel about stack
- -- values.
- TaskInfoGet (System.OS_Interface.taskIdSelf, Task_Desc'Access);
+ -- Will be called by every created task
- My_Stack.Size := System.Storage_Elements.Storage_Offset
- (Task_Desc.Td_StackSize);
- My_Stack.Base := Task_Desc.Td_PStackBase;
- My_Stack.Limit := Task_Desc.Td_PStackLimit;
+ Set_Stack_Limit_Hook := Set_Stack_Limit_For_Current_Task'Access;
+ end Initialize_Stack_Limit;
- end if;
-
- -- 2) Set Stack.all to the value obtained in 1)
+ --------------------------------------
+ -- Set_Stack_Limit_For_Current_Task --
+ --------------------------------------
- Stack.all := My_Stack;
+ procedure Set_Stack_Limit_For_Current_Task is
+ use Interfaces.C;
- -- 3) Optionally Poll to check for asynchronous abort
-
- if Soft_Links.Check_Abort_Status.all /= 0 then
- raise Standard'Abort_Signal;
- end if;
+ function Task_Var_Add (Tid : Interfaces.C.int; Var : Address)
+ return Interfaces.C.int;
+ pragma Import (C, Task_Var_Add, "taskVarAdd");
+ -- Import from VxWorks
- return My_Stack; -- Never trust the cached value, but return local copy!
- end Set_Stack_Info;
+ type OS_Stack_Info is record
+ Size : Interfaces.C.int;
+ Base : System.Address;
+ Limit : System.Address;
+ end record;
+ pragma Convention (C, OS_Stack_Info);
+ -- Type representing the information that we want to extract from the
+ -- underlying kernel.
- --------------------
- -- Set_Stack_Size --
- --------------------
+ procedure Get_Stack_Info (Stack : not null access OS_Stack_Info);
+ pragma Import (C, Get_Stack_Info, "__gnat_get_stack_info");
+ -- Procedure that fills the stack information associated to the
+ -- currently executing task.
- -- Specify the stack size for the current frame.
+ Stack_Info : aliased OS_Stack_Info;
- procedure Set_Stack_Size
- (Stack_Size : System.Storage_Elements.Storage_Offset)
- is
- My_Stack : Stack_Access;
- Frame_Address : constant System.Address := My_Stack'Address;
+ Limit : System.Address;
begin
- My_Stack := Stack_Check (Frame_Address);
+ -- Get stack bounds from VxWorks
+
+ Get_Stack_Info (Stack_Info'Access);
if Stack_Grows_Down then
- My_Stack.Limit := My_Stack.Base - Stack_Size;
+ Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size);
else
- My_Stack.Limit := My_Stack.Base + Stack_Size;
+ Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size);
end if;
- end Set_Stack_Size;
- -----------------
- -- Stack_Check --
- -----------------
+ -- Note: taskVarAdd implicitly calls taskVarInit if required
- function Stack_Check
- (Stack_Address : System.Address) return Stack_Access
- is
- type Frame_Marker is null record;
- Marker : Frame_Marker;
- Cached_Stack : constant Stack_Access := Cache;
- Frame_Address : constant System.Address := Marker'Address;
-
- begin
- -- This function first does a "cheap" check which is correct
- -- if it succeeds. In case of failure, the full check is done.
- -- Ideally the cheap check should be done in an optimized manner,
- -- or be inlined.
-
- if (Stack_Grows_Down and then
- (Frame_Address <= Cached_Stack.Base
- and
- Stack_Address > Cached_Stack.Limit))
- or else
- (not Stack_Grows_Down and then
- (Frame_Address >= Cached_Stack.Base
- and
- Stack_Address < Cached_Stack.Limit))
- then
- -- Cached_Stack is valid as it passed the stack check
- return Cached_Stack;
- end if;
-
- Full_Check :
- declare
- My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
- -- At this point Stack.all might already be invalid, so
- -- it is essential to use our local copy of Stack!
-
- begin
- if (Stack_Grows_Down and then
- Stack_Address < My_Stack.Limit)
- or else
- (not Stack_Grows_Down and then
- Stack_Address > My_Stack.Limit)
- then
- Ada.Exceptions.Raise_Exception
- (E => Storage_Error'Identity,
- Message => "stack overflow detected");
- end if;
-
- return My_Stack;
- end Full_Check;
- end Stack_Check;
-
- ------------------------
- -- Update_Stack_Cache --
- ------------------------
-
- procedure Update_Stack_Cache (Stack : Stack_Access) is
- begin
- if not Multi_Processor then
- Cache := Stack;
+ if Task_Var_Add (0, Stack_Limit'Address) = 0 then
+ Stack_Limit := Limit;
end if;
- end Update_Stack_Cache;
+ end Set_Stack_Limit_For_Current_Task;
end System.Stack_Checking.Operations;
OSDN Git Service
