------------------------------------------------------------------------------
-- --
--- 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-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- --
-- 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. --
+-- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
+-- Boston, MA 02110-1301, USA. --
-- --
-- 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 is the general implementation of this package. There is a VxWorks
--- specific version of this package (5zstchop.adb). This file should
+-- specific version of this package (s-stchop-vxworks.adb). This file should
-- be kept synchronized with it.
pragma Restrictions (No_Elaboration_Code);
Kilobyte : constant := 1024;
- 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
--------------------
function Set_Stack_Info
- (Stack : access Stack_Access) return Stack_Access
+ (Stack : not null access Stack_Access) return Stack_Access
is
type Frame_Mark is null record;
Frame_Location : Frame_Mark;
Frame_Address : constant System.Address := Marker'Address;
begin
+ -- 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
+ 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,