2007-04-20 Ed Schonberg <schonberg@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / s-stchop.adb

diff --git a/gcc/ada/s-stchop.adb b/gcc/ada/s-stchop.adb
index 3a1b1e9..c0577af 100644 (file)
--- a/gcc/ada/s-stchop.adb
+++ b/gcc/ada/s-stchop.adb
@@ -1,12 +1,12 @@
 ------------------------------------------------------------------------------
 --                                                                          --
---                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- --
@@ -16,8 +16,8 @@
 -- 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, --
@@ -32,7 +32,7 @@
 ------------------------------------------------------------------------------
 
 --  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);
@@ -50,7 +50,8 @@ package body System.Stack_Checking.Operations is
 
    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
@@ -90,7 +91,7 @@ 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
       type Frame_Mark is null record;
       Frame_Location : Frame_Mark;
@@ -166,28 +167,6 @@ package body System.Stack_Checking.Operations is
       return My_Stack; -- Never trust the cached value, but return local copy!
    end Set_Stack_Info;
 
-   --------------------
-   -- Set_Stack_Size --
-   --------------------
-
-   --  Specify the stack size for the current frame.
-
-   procedure Set_Stack_Size
-     (Stack_Size : System.Storage_Elements.Storage_Offset)
-   is
-      My_Stack      : Stack_Access;
-      Frame_Address : constant System.Address := My_Stack'Address;
-
-   begin
-      My_Stack := Stack_Check (Frame_Address);
-
-      if Stack_Grows_Down then
-         My_Stack.Limit := My_Stack.Base - Stack_Size;
-      else
-         My_Stack.Limit := My_Stack.Base + Stack_Size;
-      end if;
-   end Set_Stack_Size;
-
    -----------------
    -- Stack_Check --
    -----------------
@@ -201,6 +180,20 @@ package body System.Stack_Checking.Operations is
       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,