+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
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
--- /dev/null
+------------------------------------------------------------------------------
+-- --
+-- 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;
-- 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
#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 */
#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)
{
{
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);
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)
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;
#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))
OSDN Git Service
