s-stchop-vxworks.adb:
2007-04-06 Eric Botcazou <botcazou@adacore.com> * s-stchop-vxworks.adb: (Stack_Check): Raise Storage_Error if the argument has wrapped around. From-SVN: r123605
This commit is contained in:
parent
fc879b8f3f
commit
7a56c3bc62
|
@ -6,7 +6,7 @@
|
||||||
-- --
|
-- --
|
||||||
-- B o d y --
|
-- B o d y --
|
||||||
-- --
|
-- --
|
||||||
-- Copyright (C) 1999-2006 Free Software Foundation, Inc. --
|
-- Copyright (C) 1999-2006, Free Software Foundation, Inc. --
|
||||||
-- --
|
-- --
|
||||||
-- GNARL is free software; you can redistribute it and/or modify it under --
|
-- 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- --
|
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||||
|
@ -49,38 +49,40 @@ with System.OS_Interface;
|
||||||
|
|
||||||
package body System.Stack_Checking.Operations is
|
package body System.Stack_Checking.Operations is
|
||||||
|
|
||||||
-- In order to have stack checking working appropriately on
|
-- In order to have stack checking working appropriately on VxWorks we need
|
||||||
-- VxWorks we need to extract the stack size information from the
|
-- to extract the stack size information from the VxWorks kernel itself. It
|
||||||
-- VxWorks kernel itself. It means that the library for showing
|
-- means that the library for showing task-related information needs to be
|
||||||
-- task-related information needs to be linked into the VxWorks
|
-- linked into the VxWorks system, when using stack checking. The TaskShow
|
||||||
-- system, when using stack checking. The TaskShow library can be
|
-- library can be linked into the VxWorks system by either:
|
||||||
-- linked into the VxWorks system by either:
|
|
||||||
-- * defining INCLUDE_SHOW_ROUTINES in config.h when using
|
-- * defining INCLUDE_SHOW_ROUTINES in config.h when using
|
||||||
-- configuration header files, or
|
-- configuration header files, or
|
||||||
|
|
||||||
-- * selecting INCLUDE_TASK_SHOW when using the Tornado project
|
-- * selecting INCLUDE_TASK_SHOW when using the Tornado project
|
||||||
-- facility.
|
-- facility.
|
||||||
|
|
||||||
function Set_Stack_Info (Stack : access Stack_Access) return Stack_Access;
|
function Set_Stack_Info
|
||||||
|
(Stack : not null access Stack_Access) return Stack_Access;
|
||||||
|
|
||||||
-- The function Set_Stack_Info is the actual function that updates
|
-- The function Set_Stack_Info is the actual function that updates the
|
||||||
-- the cache containing a pointer to the Stack_Info. It may also
|
-- cache containing a pointer to the Stack_Info. It may also be used for
|
||||||
-- be used for detecting asynchronous abort in combination with
|
-- detecting asynchronous abort in combination with Invalidate_Self_Cache.
|
||||||
-- Invalidate_Self_Cache.
|
|
||||||
|
|
||||||
-- Set_Stack_Info should do the following things in order:
|
-- Set_Stack_Info should do the following things in order:
|
||||||
-- 1) Get the Stack_Access value for the current task
|
-- 1) Get the Stack_Access value for the current task
|
||||||
-- 2) Set Stack.all to the value obtained in 1)
|
-- 2) Set Stack.all to the value obtained in 1)
|
||||||
-- 3) Optionally Poll to check for asynchronous abort
|
-- 3) Optionally Poll to check for asynchronous abort
|
||||||
|
|
||||||
-- This order is important because if at any time a write to
|
-- This order is important because if at any time a write to the stack
|
||||||
-- the stack cache is pending, that write should be followed
|
-- cache is pending, that write should be followed by a Poll to prevent
|
||||||
-- by a Poll to prevent loosing signals.
|
-- loosing signals.
|
||||||
|
|
||||||
-- Note: This function must be compiled with Polling turned off
|
-- Note: This function must be compiled with Polling turned off
|
||||||
|
|
||||||
-- Note: on systems like VxWorks and OS/2 with real thread-local storage,
|
-- Note: on systems like VxWorks and OS/2 with real thread-local storage,
|
||||||
-- Set_Stack_Info should return an access value for such local
|
-- Set_Stack_Info should return an access value for such local
|
||||||
-- storage. In those cases the cache will always be up-to-date.
|
-- storage. In those cases the cache will always be up-to-date.
|
||||||
|
-- Fix examples??? Linux???
|
||||||
|
|
||||||
-- The following constants should be imported from some system-specific
|
-- The following constants should be imported from some system-specific
|
||||||
-- constants package. The constants must be static for performance reasons.
|
-- constants package. The constants must be static for performance reasons.
|
||||||
|
@ -100,9 +102,8 @@ package body System.Stack_Checking.Operations is
|
||||||
--------------------
|
--------------------
|
||||||
|
|
||||||
function Set_Stack_Info
|
function Set_Stack_Info
|
||||||
(Stack : access Stack_Access) return Stack_Access
|
(Stack : not null access Stack_Access) return Stack_Access
|
||||||
is
|
is
|
||||||
|
|
||||||
-- Task descriptor that is handled internally by the VxWorks kernel
|
-- Task descriptor that is handled internally by the VxWorks kernel
|
||||||
|
|
||||||
type Td_Events_Storage is array (1 .. 4) of Interfaces.C.int;
|
type Td_Events_Storage is array (1 .. 4) of Interfaces.C.int;
|
||||||
|
@ -131,8 +132,9 @@ package body System.Stack_Checking.Operations is
|
||||||
|
|
||||||
-- This VxWorks procedure fills in a specified task descriptor
|
-- This VxWorks procedure fills in a specified task descriptor
|
||||||
-- for a specified task.
|
-- for a specified task.
|
||||||
procedure TaskInfoGet (T_Id : System.OS_Interface.t_id;
|
procedure TaskInfoGet
|
||||||
Task_Desc : access Task_Descriptor);
|
(T_Id : System.OS_Interface.t_id;
|
||||||
|
Task_Desc : not null access Task_Descriptor);
|
||||||
pragma Import (C, TaskInfoGet, "taskInfoGet");
|
pragma Import (C, TaskInfoGet, "taskInfoGet");
|
||||||
|
|
||||||
My_Stack : Stack_Access;
|
My_Stack : Stack_Access;
|
||||||
|
@ -147,12 +149,12 @@ package body System.Stack_Checking.Operations is
|
||||||
|
|
||||||
if My_Stack.Base = Null_Address then
|
if My_Stack.Base = Null_Address then
|
||||||
|
|
||||||
-- First invocation. Ask the VxWorks kernel about stack
|
-- First invocation. Ask the VxWorks kernel about stack values
|
||||||
-- values.
|
|
||||||
TaskInfoGet (System.OS_Interface.taskIdSelf, Task_Desc'Access);
|
TaskInfoGet (System.OS_Interface.taskIdSelf, Task_Desc'Access);
|
||||||
|
|
||||||
My_Stack.Size := System.Storage_Elements.Storage_Offset
|
My_Stack.Size :=
|
||||||
(Task_Desc.Td_StackSize);
|
System.Storage_Elements.Storage_Offset (Task_Desc.Td_StackSize);
|
||||||
My_Stack.Base := Task_Desc.Td_PStackBase;
|
My_Stack.Base := Task_Desc.Td_PStackBase;
|
||||||
My_Stack.Limit := Task_Desc.Td_PStackLimit;
|
My_Stack.Limit := Task_Desc.Td_PStackLimit;
|
||||||
|
|
||||||
|
@ -168,7 +170,9 @@ package body System.Stack_Checking.Operations is
|
||||||
raise Standard'Abort_Signal;
|
raise Standard'Abort_Signal;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
return My_Stack; -- Never trust the cached value, but return local copy!
|
-- Never trust the cached value, return local copy!
|
||||||
|
|
||||||
|
return My_Stack;
|
||||||
end Set_Stack_Info;
|
end Set_Stack_Info;
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
@ -179,42 +183,50 @@ package body System.Stack_Checking.Operations is
|
||||||
(Stack_Address : System.Address) return Stack_Access
|
(Stack_Address : System.Address) return Stack_Access
|
||||||
is
|
is
|
||||||
type Frame_Marker is null record;
|
type Frame_Marker is null record;
|
||||||
|
|
||||||
Marker : Frame_Marker;
|
Marker : Frame_Marker;
|
||||||
Cached_Stack : constant Stack_Access := Cache;
|
Cached_Stack : constant Stack_Access := Cache;
|
||||||
Frame_Address : constant System.Address := Marker'Address;
|
Frame_Address : constant System.Address := Marker'Address;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
-- This function first does a "cheap" check which is correct
|
-- The parameter may have wrapped around in System.Address arithmetics.
|
||||||
-- if it succeeds. In case of failure, the full check is done.
|
-- In that case, we have no other choices than raising the exception.
|
||||||
-- Ideally the cheap check should be done in an optimized manner,
|
|
||||||
-- or be inlined.
|
|
||||||
|
|
||||||
if (Stack_Grows_Down and then
|
if (Stack_Grows_Down and then Stack_Address > Frame_Address)
|
||||||
(Frame_Address <= Cached_Stack.Base
|
or else (not Stack_Grows_Down and then Stack_Address < Frame_Address)
|
||||||
and
|
then
|
||||||
Stack_Address > Cached_Stack.Limit))
|
Ada.Exceptions.Raise_Exception
|
||||||
or else
|
(E => Storage_Error'Identity,
|
||||||
(not Stack_Grows_Down and then
|
Message => "stack overflow detected");
|
||||||
(Frame_Address >= Cached_Stack.Base
|
end if;
|
||||||
and
|
|
||||||
Stack_Address < Cached_Stack.Limit))
|
-- 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 then Stack_Address > Cached_Stack.Limit)
|
||||||
|
or else (not Stack_Grows_Down
|
||||||
|
and then Frame_Address >= Cached_Stack.Base
|
||||||
|
and then Stack_Address < Cached_Stack.Limit)
|
||||||
then
|
then
|
||||||
-- Cached_Stack is valid as it passed the stack check
|
-- Cached_Stack is valid as it passed the stack check
|
||||||
|
|
||||||
return Cached_Stack;
|
return Cached_Stack;
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
Full_Check :
|
Full_Check :
|
||||||
declare
|
declare
|
||||||
My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
|
My_Stack : constant Stack_Access := Set_Stack_Info (Cache'Access);
|
||||||
-- At this point Stack.all might already be invalid, so
|
-- At this point Stack.all might already be invalid, so it is
|
||||||
-- it is essential to use our local copy of Stack!
|
-- essential to use our local copy of Stack!
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if (Stack_Grows_Down and then
|
if (Stack_Grows_Down
|
||||||
Stack_Address < My_Stack.Limit)
|
and then Stack_Address < My_Stack.Limit)
|
||||||
or else
|
or else (not Stack_Grows_Down
|
||||||
(not Stack_Grows_Down and then
|
and then Stack_Address > My_Stack.Limit)
|
||||||
Stack_Address > My_Stack.Limit)
|
|
||||||
then
|
then
|
||||||
Ada.Exceptions.Raise_Exception
|
Ada.Exceptions.Raise_Exception
|
||||||
(E => Storage_Error'Identity,
|
(E => Storage_Error'Identity,
|
||||||
|
|
Loading…
Reference in New Issue