154 lines
6.8 KiB
Ada
154 lines
6.8 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- 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-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 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. --
|
|
-- --
|
|
-- 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. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
-- This is the verson for VxWorks 5 and VxWorks MILS
|
|
|
|
-- This file should be kept synchronized with the general implementation
|
|
-- provided by s-stchop.adb.
|
|
|
|
pragma Restrictions (No_Elaboration_Code);
|
|
-- We want to guarantee the absence of elaboration code because the
|
|
-- binder does not handle references to this package.
|
|
|
|
with System.Storage_Elements; use System.Storage_Elements;
|
|
with System.Parameters; use System.Parameters;
|
|
with Interfaces.C;
|
|
|
|
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.
|
|
|
|
-- For VxWorks 5 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.
|
|
|
|
-- VxWorks MILS includes the necessary routine in taskLib, so nothing
|
|
-- special needs to be done there.
|
|
|
|
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
|
|
-- For the environment task
|
|
|
|
Set_Stack_Limit_For_Current_Task;
|
|
|
|
-- Will be called by every created task
|
|
|
|
Set_Stack_Limit_Hook := Set_Stack_Limit_For_Current_Task'Access;
|
|
end Initialize_Stack_Limit;
|
|
|
|
--------------------------------------
|
|
-- Set_Stack_Limit_For_Current_Task --
|
|
--------------------------------------
|
|
|
|
procedure Set_Stack_Limit_For_Current_Task is
|
|
use Interfaces.C;
|
|
|
|
function Task_Var_Add (Tid : Interfaces.C.int; Var : Address)
|
|
return Interfaces.C.int;
|
|
pragma Import (C, Task_Var_Add, "taskVarAdd");
|
|
-- Import from VxWorks
|
|
|
|
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.
|
|
|
|
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.
|
|
|
|
Stack_Info : aliased OS_Stack_Info;
|
|
|
|
Limit : System.Address;
|
|
|
|
begin
|
|
-- Get stack bounds from VxWorks
|
|
|
|
Get_Stack_Info (Stack_Info'Access);
|
|
|
|
-- In s-stchop.adb, we check for overflow in the following operations,
|
|
-- but we have no such check in this vxworks version. Why not ???
|
|
|
|
if Stack_Grows_Down then
|
|
Limit := Stack_Info.Base - Storage_Offset (Stack_Info.Size);
|
|
else
|
|
Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size);
|
|
end if;
|
|
|
|
-- Note: taskVarAdd implicitly calls taskVarInit if required
|
|
|
|
if Task_Var_Add (0, Stack_Limit'Address) = 0 then
|
|
Stack_Limit := Limit;
|
|
end if;
|
|
end Set_Stack_Limit_For_Current_Task;
|
|
|
|
end System.Stack_Checking.Operations;
|