[multiple changes]

2009-04-16  Tristan Gingold  <gingold@adacore.com>

	* init.c: Detect real stack overflow on Darwin.

	* system-darwin-x86.ads: Use stack probing on darwin x86.

2009-04-16  Ed Schonberg  <schonberg@adacore.com>

	* sem_attr.adb (Analyze_Attribute, case 'Address): It is illegal to
	take the address of an intrinsic subprogram.

2009-04-16  Vincent Celier  <celier@adacore.com>

	* g-trasym-unimplemented.ads, g-trasym-unimplemented.adb: New file.

	* g-trasym.ads: Update comments.

2009-04-16  Vasiliy Fofanov  <fofanov@adacore.com>

	* tracebak.c (STOP_FRAME): Verify validity of the current address
	before dereferencing.

From-SVN: r146182

8 files changed, 221 insertions, 8 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5daa65f..0d0e450 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,8 +1,30 @@
+2009-04-16  Tristan Gingold  <gingold@adacore.com>
+
+	* init.c: Detect real stack overflow on Darwin.
+
+	* system-darwin-x86.ads: Use stack probing on darwin x86.
+
+2009-04-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_attr.adb (Analyze_Attribute, case 'Address): It is illegal to
+	take the address of an intrinsic subprogram.
+
 2009-04-16  Arnaud Charlet  <charlet@adacore.com>
 
 	* gcc-interface/Makefile.in: Change g-trasym to g-trasym-unimplemented
 	for the targets where GNAT.Traceback.Symbolic is not supported.
 
+2009-04-16  Vincent Celier  <celier@adacore.com>
+
+	* g-trasym-unimplemented.ads, g-trasym-unimplemented.adb: New file.
+
+	* g-trasym.ads: Update comments.
+
+2009-04-16  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* tracebak.c (STOP_FRAME): Verify validity of the current address
+	before dereferencing.
+
 2009-04-16  Ed Schonberg  <schonberg@adacore.com>
 
 	* sprint.adb (Write_Itype): If the itype is an array subtype, preserve
diff --git a/gcc/ada/g-trasym-unimplemented.adb b/gcc/ada/g-trasym-unimplemented.adb
new file mode 100644
index 0000000..5432eaf
--- /dev/null
+++ b/gcc/ada/g-trasym-unimplemented.adb
@@ -0,0 +1,72 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             G N A T . T R A C E B A C K . S Y M B O L I C                --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                     Copyright (C) 1999-2008, AdaCore                     --
+--                                                                          --
+-- GNAT 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 2,  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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- 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  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Version used on unimplemented targets
+
+--  Run-time symbolic traceback is currently supported on the following
+--  targets:
+
+--     HP-UX
+--     IRIX
+--     GNU/Linux x86
+--     AIX
+--     Solaris sparc
+--     Tru64
+--     OpenVMS/Alpha
+--     Windows NT/XP/Vista
+
+--  This version is used on all other targets, it generates a warning at
+--  compile time if it is with'ed, and the bodies generate messages saying
+--  that the functions are not implemented.
+
+package body GNAT.Traceback.Symbolic is
+
+   ------------------------
+   -- Symbolic_Traceback --
+   ------------------------
+
+   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String
+   is
+      pragma Unreferenced (Traceback);
+   begin
+      return "Symbolic_Traceback not implemented on this target";
+   end Symbolic_Traceback;
+
+   function Symbolic_Traceback (E : Exception_Occurrence) return String
+   is
+      pragma Unreferenced (E);
+   begin
+      return "Symbolic_Traceback not implemented on this target";
+   end Symbolic_Traceback;
+
+end GNAT.Traceback.Symbolic;
diff --git a/gcc/ada/g-trasym-unimplemented.ads b/gcc/ada/g-trasym-unimplemented.ads
new file mode 100644
index 0000000..d03db88
--- /dev/null
+++ b/gcc/ada/g-trasym-unimplemented.ads
@@ -0,0 +1,66 @@
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--             G N A T . T R A C E B A C K . S Y M B O L I C                --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                     Copyright (C) 1999-2008, AdaCore                     --
+--                                                                          --
+-- GNAT 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 2,  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.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- 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  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+--  Version used on unimplemented targets
+
+--  Run-time symbolic traceback is currently supported on the following
+--  targets:
+
+--     HP-UX hppa and ia64
+--     IRIX
+--     GNU/Linux x86, x86_64, ia64
+--     AIX
+--     Solaris sparc and x86
+--     Tru64
+--     OpenVMS/Alpha
+--     Windows NT/XP/Vista
+
+--  This version is used on all other targets, it generates a warning at
+--  compile time if it is with'ed, and the bodies generate messages saying
+--  that the functions are not implemented.
+
+with Ada.Exceptions; use Ada.Exceptions;
+
+package GNAT.Traceback.Symbolic is
+   pragma Elaborate_Body;
+
+--     pragma Compile_Time_Warning
+--       (True, "symbolic traceback not implemented on this target");
+
+   function Symbolic_Traceback (Traceback : Tracebacks_Array) return String;
+   --  Build a string containing a symbolic traceback of the given call chain
+
+   function Symbolic_Traceback (E : Exception_Occurrence) return String;
+   --  Build string containing symbolic traceback of given exception occurrence
+
+end GNAT.Traceback.Symbolic;
diff --git a/gcc/ada/g-trasym.ads b/gcc/ada/g-trasym.ads
index fbcf9ca..8936231 100644
--- a/gcc/ada/g-trasym.ads
+++ b/gcc/ada/g-trasym.ads
@@ -35,11 +35,11 @@
 
 --  This capability is currently supported on the following targets:
 
---     HP-UX
+--     HP-UX hppa and ia64
 --     IRIX
---     GNU/Linux x86
+--     GNU/Linux x86, x86_64, ia64
 --     AIX
---     Solaris sparc
+--     Solaris sparc and x86
 --     Tru64
 --     OpenVMS/Alpha
 --     Windows NT/XP/Vista
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index e86a975..fab0942 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -2098,6 +2098,8 @@ __gnat_install_handler(void)
 #elif defined(__APPLE__)
 
 #include <signal.h>
+#include <mach/mach_vm.h>
+#include <mach/vm_statistics.h>
 
 /* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
 char __gnat_alternate_stack[64 * 1024]; /* 2 * MINSIGSTKSZ */
@@ -2108,6 +2110,31 @@ static void __gnat_error_handler (int sig, siginfo_t * si, void * uc);
 #define	UC_RESET_ALT_STACK	0x80000000
 extern int sigreturn (void *uc, int flavour);
 
+/* Return true if ADDR is within a stack guard area.  */
+static int
+__gnat_is_stack_guard (mach_vm_address_t addr)
+{
+  kern_return_t kret;
+  vm_region_submap_info_data_64_t info;
+  mach_vm_address_t start;
+  mach_vm_size_t size;
+  natural_t depth;
+  mach_msg_type_number_t count;
+
+  count = VM_REGION_SUBMAP_INFO_COUNT_64;
+  start = addr;
+  size = -1;
+  depth = 9999;
+  kret = mach_vm_region_recurse (mach_task_self (), &start, &size, &depth,
+				 (vm_region_recurse_info_t) &info, &count);
+  if (kret == KERN_SUCCESS
+      && addr >= start && addr < (start + size)
+      && info.protection == VM_PROT_NONE
+      && info.user_tag == VM_MEMORY_STACK)
+    return 1;
+  return 0;
+}
+
 static void
 __gnat_error_handler (int sig, siginfo_t * si, void * uc)
 {
@@ -2118,9 +2145,16 @@ __gnat_error_handler (int sig, siginfo_t * si, void * uc)
     {
     case SIGSEGV:
     case SIGBUS:
-      /* FIXME: we need to detect the case of a *real* SIGSEGV.  */
-      exception = &storage_error;
-      msg = "stack overflow or erroneous memory access";
+      if (__gnat_is_stack_guard ((mach_vm_address_t)si->si_addr))
+	{
+	  exception = &storage_error;
+	  msg = "stack overflow";
+	}
+      else
+	{
+	  exception = &constraint_error;
+	  msg = "erroneous memory access";
+	}
       /* Reset the use of alt stack, so that the alt stack will be used
 	 for the next signal delivery.  */
       sigreturn (NULL, UC_RESET_ALT_STACK);
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 2bf6143..e2fe5c3 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -2049,6 +2049,24 @@ package body Sem_Attr is
                      Error_Attr_P
                        ("prefix of % attribute cannot be Inline_Always" &
                         " subprogram");
+
+                  --  It is illegal to apply 'Address to an intrinsic
+                  --  subprogram. This is now formalized in AI05-0095.
+                  --  In an instance, an attempt to obtain 'Address of an
+                  --  intrinsic subprogram (e.g the renaming of a predefined
+                  --  operator that is an actual) raises Program_Error.
+
+                  elsif Convention (Ent) = Convention_Intrinsic then
+                     if In_Instance then
+                        Rewrite (N,
+                          Make_Raise_Program_Error (Loc,
+                            Reason => PE_Misaligned_Address_Value));
+                        --   ??? why Misaligned_Address_Value, seems wrong
+
+                     else
+                        Error_Msg_N
+                         ("cannot take Address of intrinsic subprogram", N);
+                     end if;
                   end if;
 
                elsif Is_Object (Ent)
diff --git a/gcc/ada/system-darwin-x86.ads b/gcc/ada/system-darwin-x86.ads
index d7f6d0e..a4d5fbf 100644
--- a/gcc/ada/system-darwin-x86.ads
+++ b/gcc/ada/system-darwin-x86.ads
@@ -155,7 +155,7 @@ private
    Preallocated_Stacks       : constant Boolean := False;
    Signed_Zeros              : constant Boolean := True;
    Stack_Check_Default       : constant Boolean := False;
-   Stack_Check_Probes        : constant Boolean := False;
+   Stack_Check_Probes        : constant Boolean := True;
    Stack_Check_Limits        : constant Boolean := False;
    Support_64_Bit_Divides    : constant Boolean := True;
    Support_Aggregates        : constant Boolean := True;
diff --git a/gcc/ada/tracebak.c b/gcc/ada/tracebak.c
index 8a69057..8f3c4cc 100644
--- a/gcc/ada/tracebak.c
+++ b/gcc/ada/tracebak.c
@@ -317,7 +317,8 @@ struct layout
 #define FRAME_OFFSET(FP) 0
 #define PC_ADJUST -2
 #define STOP_FRAME(CURRENT, TOP_STACK) \
-  (IS_BAD_PTR((long)(CURRENT)->return_address) \
+  (IS_BAD_PTR((long)(CURRENT)) \
+   || IS_BAD_PTR((long)(CURRENT)->return_address) \
    || (CURRENT)->return_address == 0|| (CURRENT)->next == 0  \
    || (void *) (CURRENT) < (TOP_STACK))