[multiple changes]

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

	* sprint.adb (Write_Itype): If the itype is an array subtype, preserve
	the original location of the index expressions and the index subtypes,
	to prevent spurious out-of-scope references in gigi.

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

	* init.c, s-osinte-darwin.ads, system-darwin-x86_64.ads:
	Add support for stack checking on darwin.

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

	* prj-attr.adb: New attribute Runtime_Source_Dir

	* prj-nmsc.adb (Process_Project_Level_Array_Attributes): Process
	attribute Runtime_Source_Dir.
	(Check_Naming_Schemes): Give default values to out parameters to avoid
	invalid data.

	* prj.ads (Language_Config): New component Runtime_Source_Dir

	* snames.ads-tmpl: New standard name Runtime_Source_Dir

From-SVN: r146177

gcc/ada/ChangeLog

+2009-04-16  Ed Schonberg  <schonberg@adacore.com>
+
+	* sprint.adb (Write_Itype): If the itype is an array subtype, preserve
+	the original location of the index expressions and the index subtypes,
+	to prevent spurious out-of-scope references in gigi.
+
+2009-04-16  Tristan Gingold  <gingold@adacore.com>
+
+	* init.c, s-osinte-darwin.ads, system-darwin-x86_64.ads:
+	Add support for stack checking on darwin.
+
+2009-04-16  Vincent Celier  <celier@adacore.com>
+
+	* prj-attr.adb: New attribute Runtime_Source_Dir
+
+	* prj-nmsc.adb (Process_Project_Level_Array_Attributes): Process
+	attribute Runtime_Source_Dir.
+	(Check_Naming_Schemes): Give default values to out parameters to avoid
+	invalid data.
+
+	* prj.ads (Language_Config): New component Runtime_Source_Dir
+
+	* snames.ads-tmpl: New standard name Runtime_Source_Dir
+
 2009-04-16  Pascal Obry  <obry@adacore.com>
 
 	* adaint.h, adaint.c (__gnat_rmdir): New routine.

gcc/ada/init.c

@@ -2099,8 +2099,15 @@ __gnat_install_handler(void)
 
 #include <signal.h>
 
+/* This must be in keeping with System.OS_Interface.Alternate_Stack_Size.  */
+char __gnat_alternate_stack[64 * 1024]; /* 2 * MINSIGSTKSZ */
+
 static void __gnat_error_handler (int sig, siginfo_t * si, void * uc);
 
+/* Defined in xnu unix_signal.c  */
+#define	UC_RESET_ALT_STACK	0x80000000
+extern int sigreturn (void *uc, int flavour);
+
 static void
 __gnat_error_handler (int sig, siginfo_t * si, void * uc)
 {
@@ -2113,6 +2120,9 @@ __gnat_error_handler (int sig, siginfo_t * si, void * uc)
       /* FIXME: we need to detect the case of a *real* SIGSEGV.  */
       exception = &storage_error;
       msg = "stack overflow or 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);
       break;
 
     case SIGBUS:
@@ -2140,7 +2150,16 @@ __gnat_install_handler (void)
 
   /* Set up signal handler to map synchronous signals to appropriate
      exceptions.  Make sure that the handler isn't interrupted by another
-     signal that might cause a scheduling event!  */
+     signal that might cause a scheduling event!  Also setup an alternate
+     stack region for the handler execution so that stack overflows can be
+     handled properly, avoiding a SEGV generation from stack usage by the
+     handler itself (and it is required by Darwin).  */
+
+  stack_t stack;
+  stack.ss_sp = __gnat_alternate_stack;
+  stack.ss_size = sizeof (__gnat_alternate_stack);
+  stack.ss_flags = 0;
+  sigaltstack (&stack, NULL);
 
   act.sa_flags = SA_NODEFER | SA_RESTART | SA_SIGINFO;
   act.sa_sigaction = __gnat_error_handler;
@@ -2153,11 +2172,13 @@ __gnat_install_handler (void)
     sigaction (SIGFPE,  &act, NULL);
   if (__gnat_get_interrupt_state (SIGILL) != 's')
     sigaction (SIGILL,  &act, NULL);
-  if (__gnat_get_interrupt_state (SIGSEGV) != 's')
-    sigaction (SIGSEGV, &act, NULL);
   if (__gnat_get_interrupt_state (SIGBUS) != 's')
     sigaction (SIGBUS,  &act, NULL);
 
+  act.sa_flags |= SA_ONSTACK;
+  if (__gnat_get_interrupt_state (SIGSEGV) != 's')
+    sigaction (SIGSEGV, &act, NULL);
+
   __gnat_handler_installed = 1;
 }
 

gcc/ada/prj-attr.adb

@@ -140,6 +140,7 @@ package body Prj.Attr is
    "LVshared_library_minimum_switches#" &
    "LVlibrary_version_switches#" &
    "Saruntime_library_dir#" &
+   "Saruntime_source_dir#" &
 
    --  package Naming
 

gcc/ada/prj-nmsc.adb

@@ -2290,6 +2290,14 @@ package body Prj.Nmsc is
                           (Lang_Index).Config.Runtime_Library_Dir :=
                           Element.Value.Value;
 
+                     when Name_Runtime_Source_Dir =>
+
+                        --  Attribute Runtime_Library_Dir (<language>)
+
+                        In_Tree.Languages_Data.Table
+                          (Lang_Index).Config.Runtime_Source_Dir :=
+                          Element.Value.Value;
+
                      when Name_Object_Generated =>
                         declare
                            pragma Unsuppress (All_Checks);
@@ -7724,7 +7732,7 @@ package body Prj.Nmsc is
       Config         : Language_Config;
       Lang           : Name_List_Index := Data.Languages;
       Header_File    : Boolean := False;
-      First_Language : Language_Index;
+      First_Language : Language_Index := No_Language_Index;
       OK             : Boolean;
 
       Last_Spec : Natural;
@@ -7732,8 +7740,15 @@ package body Prj.Nmsc is
       Last_Sep  : Natural;
 
    begin
-      Unit := No_Name;
-      Alternate_Languages := No_Alternate_Language;
+      --  Default values
+
+      Alternate_Languages   := No_Alternate_Language;
+      Language              := No_Language_Index;
+      Language_Name         := No_Name;
+      Display_Language_Name := No_Name;
+      Unit                  := No_Name;
+      Lang_Kind             := File_Based;
+      Kind                  := Spec;
 
       while Lang /= No_Name_List loop
          Language_Name := In_Tree.Name_Lists.Table (Lang).Name;

gcc/ada/prj.ads

@@ -456,6 +456,9 @@ package Prj is
       Runtime_Library_Dir        : Name_Id := No_Name;
       --  Path name of the runtime library directory, if any
 
+      Runtime_Source_Dir        : Name_Id := No_Name;
+      --  Path name of the runtime source directory, if any
+
       Mapping_File_Switches  : Name_List_Index := No_Name_List;
       --  The option(s) to provide a mapping file to the compiler. Specified in
       --  the configuration. When value is No_Name_List, there is no mapping
@@ -558,6 +561,7 @@ package Prj is
                            Object_Generated             => True,
                            Objects_Linked               => True,
                            Runtime_Library_Dir          => No_Name,
+                           Runtime_Source_Dir           => No_Name,
                            Mapping_File_Switches        => No_Name_List,
                            Mapping_Spec_Suffix          => No_File,
                            Mapping_Body_Suffix          => No_File,

gcc/ada/s-osinte-darwin.ads

@@ -279,10 +279,11 @@ package System.OS_Interface is
    pragma Import (C, sigaltstack, "sigaltstack");
 
    Alternate_Stack : aliased System.Address;
-   --  This is a dummy definition, never used (Alternate_Stack_Size is null)
+   pragma Import (C, Alternate_Stack, "__gnat_alternate_stack");
+   --  The alternate signal stack for stack overflows
 
-   Alternate_Stack_Size : constant := 0;
-   --  No alternate signal stack is used on this platform
+   Alternate_Stack_Size : constant := 64 * 1024;
+   --  This must be in keeping with init.c:__gnat_alternate_stack
 
    Stack_Base_Available : constant Boolean := False;
    --  Indicates whether the stack base is available on this target. This

gcc/ada/snames.ads-tmpl

@@ -1134,6 +1134,7 @@ package Snames is
    Name_Toolchain_Description            : constant Name_Id := N + $;
    Name_Toolchain_Version                : constant Name_Id := N + $;
    Name_Runtime_Library_Dir              : constant Name_Id := N + $;
+   Name_Runtime_Source_Dir               : constant Name_Id := N + $;
 
    --  Other miscellaneous names used in front end
 

gcc/ada/sprint.adb

@@ -3719,7 +3719,7 @@ package body Sprint is
 
                      Write_Id (Directly_Designated_Type (Typ));
 
-                     --  Array types and string types
+                  --  Array types and string types
 
                   when E_Array_Type | E_String_Type =>
                      Write_Header;
@@ -3748,7 +3748,8 @@ package body Sprint is
                      Sprint_Node (X);
                      Set_Sloc (X, Old_Sloc);
 
-                     --  Array subtypes and string subtypes
+                     --  Array subtypes and string subtypes.
+                     --  Preserve Sloc of index subtypes, as above.
 
                   when E_Array_Subtype | E_String_Subtype =>
                      Write_Header (False);
@@ -3757,7 +3758,9 @@ package body Sprint is
 
                      X := First_Index (Typ);
                      loop
+                        Old_Sloc := Sloc (X);
                         Sprint_Node (X);
+                        Set_Sloc (X, Old_Sloc);
                         Next_Index (X);
                         exit when No (X);
                         Write_Str (", ");
@@ -3765,7 +3768,7 @@ package body Sprint is
 
                      Write_Char (')');
 
-                     --  Signed integer types, and modular integer subtypes
+                  --  Signed integer types, and modular integer subtypes
 
                   when E_Signed_Integer_Type     |
                        E_Signed_Integer_Subtype  |
@@ -3821,14 +3824,14 @@ package body Sprint is
                         end if;
                      end;
 
-                     --  Modular integer types
+                  --  Modular integer types
 
                   when E_Modular_Integer_Type =>
                      Write_Header;
                      Write_Str (" mod ");
                      Write_Uint_With_Col_Check (Modulus (Typ), Auto);
 
-                     --  Floating point types and subtypes
+                  --  Floating point types and subtypes
 
                   when E_Floating_Point_Type    |
                        E_Floating_Point_Subtype =>
@@ -4104,8 +4107,8 @@ package body Sprint is
             exit when Spec = Empty;
 
             --  Add semicolon, unless we are printing original tree and the
-            --  next specification is part of a list (but not the first
-            --  element of that list)
+            --  next specification is part of a list (but not the first element
+            --  of that list).
 
             if not Dump_Original_Only or else not Prev_Ids (Spec) then
                Write_Str ("; ");

gcc/ada/system-darwin-x86_64.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;