diff --git a/gcc/ada/s-stchop-vxworks.adb b/gcc/ada/s-stchop-vxworks.adb index d3171a89717..bc045ca0397 100644 --- a/gcc/ada/s-stchop-vxworks.adb +++ b/gcc/ada/s-stchop-vxworks.adb @@ -6,7 +6,7 @@ -- -- -- 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 -- -- 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 - -- 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; + 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 cache containing a pointer to the Stack_Info. It may also - -- be used for detecting asynchronous abort in combination with - -- Invalidate_Self_Cache. + -- 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. + -- 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. + -- Fix examples??? Linux??? -- The following constants should be imported from some system-specific -- 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 - (Stack : access Stack_Access) return Stack_Access + (Stack : not null access Stack_Access) return Stack_Access is - -- Task descriptor that is handled internally by the VxWorks kernel 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 -- for a specified task. - procedure TaskInfoGet (T_Id : System.OS_Interface.t_id; - Task_Desc : access Task_Descriptor); + procedure TaskInfoGet + (T_Id : System.OS_Interface.t_id; + Task_Desc : not null access Task_Descriptor); pragma Import (C, TaskInfoGet, "taskInfoGet"); My_Stack : Stack_Access; @@ -147,12 +149,12 @@ package body System.Stack_Checking.Operations is if My_Stack.Base = Null_Address then - -- First invocation. Ask the VxWorks kernel about stack - -- values. + -- First invocation. Ask the VxWorks kernel about stack values + TaskInfoGet (System.OS_Interface.taskIdSelf, Task_Desc'Access); - My_Stack.Size := System.Storage_Elements.Storage_Offset - (Task_Desc.Td_StackSize); + 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; @@ -168,7 +170,9 @@ package body System.Stack_Checking.Operations is raise Standard'Abort_Signal; 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; ----------------- @@ -179,42 +183,50 @@ package body System.Stack_Checking.Operations is (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. + -- The parameter may have wrapped around in System.Address arithmetics. + -- In that case, we have no other choices than raising the exception. - 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)) + if (Stack_Grows_Down and then Stack_Address > Frame_Address) + or else (not Stack_Grows_Down and then Stack_Address < Frame_Address) + then + Ada.Exceptions.Raise_Exception + (E => Storage_Error'Identity, + Message => "stack overflow detected"); + end if; + + -- 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 -- 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! + -- 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) + 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,