Commit 69ba91ed by Arnaud Charlet

[multiple changes]

2009-10-28  Robert Dewar  <dewar@adacore.com>

	* exp_attr.adb, exp_ch9.adb, prj-nmsc.adb, tbuild.adb, ali.adb,
	types.ads: Minor reformatting

2009-10-28  Tristan Gingold  <gingold@adacore.com>

	* init.c: Fix __gnat_error_handler for Darwin10 (Snow Leopard)

From-SVN: r153658
parent 5f3f175d
2009-10-28 Robert Dewar <dewar@adacore.com>
* exp_attr.adb, exp_ch9.adb, prj-nmsc.adb, tbuild.adb, ali.adb,
types.ads: Minor reformatting
2009-10-28 Tristan Gingold <gingold@adacore.com>
* init.c: Fix __gnat_error_handler for Darwin10 (Snow Leopard)
2009-10-28 Thomas Quinot <quinot@adacore.com> 2009-10-28 Thomas Quinot <quinot@adacore.com>
* exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for * exp_ch4.adb (Expand_N_Type_Conversion): Perform Integer promotion for
......
...@@ -190,7 +190,7 @@ package body ALI is ...@@ -190,7 +190,7 @@ package body ALI is
function Get_Name function Get_Name
(Ignore_Spaces : Boolean := False; (Ignore_Spaces : Boolean := False;
Ignore_Special : Boolean := False)return Name_Id; Ignore_Special : Boolean := False) return Name_Id;
-- Skip blanks, then scan out a name (name is left in Name_Buffer with -- Skip blanks, then scan out a name (name is left in Name_Buffer with
-- length in Name_Len, as well as being returned in Name_Id form). -- length in Name_Len, as well as being returned in Name_Id form).
-- If Lower is set to True then the Name_Buffer will be converted to -- If Lower is set to True then the Name_Buffer will be converted to
......
...@@ -661,12 +661,10 @@ package body Exp_Attr is ...@@ -661,12 +661,10 @@ package body Exp_Attr is
if Is_Protected_Self_Reference (Pref) if Is_Protected_Self_Reference (Pref)
and then not and then not
(Nkind_In (Parent (N), (Nkind_In (Parent (N), N_Index_Or_Discriminant_Constraint,
N_Index_Or_Discriminant_Constraint,
N_Discriminant_Association) N_Discriminant_Association)
and then and then Nkind (Parent (Parent (Parent (Parent (N))))) =
Nkind (Parent (Parent (Parent (Parent (N))))) N_Component_Definition)
= N_Component_Definition)
then then
Rewrite (Pref, Concurrent_Ref (Pref)); Rewrite (Pref, Concurrent_Ref (Pref));
Analyze (Pref); Analyze (Pref);
...@@ -690,9 +688,9 @@ package body Exp_Attr is ...@@ -690,9 +688,9 @@ package body Exp_Attr is
function Enclosing_Object (N : Node_Id) return Node_Id; function Enclosing_Object (N : Node_Id) return Node_Id;
-- If N denotes a compound name (selected component, indexed -- If N denotes a compound name (selected component, indexed
-- component, or slice), returns the name of the outermost -- component, or slice), returns the name of the outermost such
-- such enclosing object. Otherwise returns N. If the object -- enclosing object. Otherwise returns N. If the object is a
-- is a renaming, then the renamed object is returned. -- renaming, then the renamed object is returned.
---------------------- ----------------------
-- Enclosing_Object -- -- Enclosing_Object --
......
...@@ -7824,8 +7824,8 @@ package body Exp_Ch9 is ...@@ -7824,8 +7824,8 @@ package body Exp_Ch9 is
Oent : constant Entity_Id := Defining_Identifier (Priv); Oent : constant Entity_Id := Defining_Identifier (Priv);
New_Comp : Node_Id; New_Comp : Node_Id;
Nent : constant Entity_Id := Nent : constant Entity_Id :=
Make_Defining_Identifier Make_Defining_Identifier (Sloc (Oent),
(Sloc (Oent), Chars (Oent)); Chars => Chars (Oent));
begin begin
if Present (Subtype_Indication (Old_Comp)) then if Present (Subtype_Indication (Old_Comp)) then
......
...@@ -2114,6 +2114,7 @@ __gnat_install_handler(void) ...@@ -2114,6 +2114,7 @@ __gnat_install_handler(void)
#elif defined(__APPLE__) #elif defined(__APPLE__)
#include <signal.h> #include <signal.h>
#include <sys/syscall.h>
#include <mach/mach_vm.h> #include <mach/mach_vm.h>
#include <mach/mach_init.h> #include <mach/mach_init.h>
#include <mach/vm_statistics.h> #include <mach/vm_statistics.h>
...@@ -2123,9 +2124,9 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */ ...@@ -2123,9 +2124,9 @@ char __gnat_alternate_stack[32 * 1024]; /* 1 * MINSIGSTKSZ */
static void __gnat_error_handler (int sig, siginfo_t * si, void * uc); static void __gnat_error_handler (int sig, siginfo_t * si, void * uc);
/* Defined in xnu unix_signal.c */ /* Defined in xnu unix_signal.c.
Tell the kernel to re-use alt stack when delivering a signal. */
#define UC_RESET_ALT_STACK 0x80000000 #define UC_RESET_ALT_STACK 0x80000000
extern int sigreturn (void *uc, int flavour);
/* Return true if ADDR is within a stack guard area. */ /* Return true if ADDR is within a stack guard area. */
static int static int
...@@ -2173,8 +2174,9 @@ __gnat_error_handler (int sig, siginfo_t * si, void * uc ATTRIBUTE_UNUSED) ...@@ -2173,8 +2174,9 @@ __gnat_error_handler (int sig, siginfo_t * si, void * uc ATTRIBUTE_UNUSED)
msg = "erroneous memory access"; msg = "erroneous memory access";
} }
/* Reset the use of alt stack, so that the alt stack will be used /* Reset the use of alt stack, so that the alt stack will be used
for the next signal delivery. */ for the next signal delivery.
sigreturn (NULL, UC_RESET_ALT_STACK); The stack can't be used in case of stack checking. */
syscall (SYS_sigreturn, NULL, UC_RESET_ALT_STACK);
break; break;
case SIGFPE: case SIGFPE:
......
...@@ -4712,7 +4712,7 @@ package body Prj.Nmsc is ...@@ -4712,7 +4712,7 @@ package body Prj.Nmsc is
(Path_Id : Name_Id; (Path_Id : Name_Id;
Display_Path_Id : Name_Id); Display_Path_Id : Name_Id);
-- Add the directory Path_Id to the list of source_dirs if not -- Add the directory Path_Id to the list of source_dirs if not
-- already in the list -- already in the list.
procedure Recursive_Find_Dirs (Path : Name_Id); procedure Recursive_Find_Dirs (Path : Name_Id);
-- Find all the subdirectories (recursively) of Path and add them -- Find all the subdirectories (recursively) of Path and add them
...@@ -4731,12 +4731,12 @@ package body Prj.Nmsc is ...@@ -4731,12 +4731,12 @@ package body Prj.Nmsc is
Rank_List : Number_List_Index; Rank_List : Number_List_Index;
Prev_Rank : Number_List_Index; Prev_Rank : Number_List_Index;
Element : String_Element; Element : String_Element;
begin begin
Prev := Nil_String; Prev := Nil_String;
Prev_Rank := No_Number_List; Prev_Rank := No_Number_List;
List := Project.Source_Dirs; List := Project.Source_Dirs;
Rank_List := Project.Source_Dir_Ranks; Rank_List := Project.Source_Dir_Ranks;
while List /= Nil_String loop while List /= Nil_String loop
Element := Data.Tree.String_Elements.Table (List); Element := Data.Tree.String_Elements.Table (List);
exit when Element.Value = Path_Id; exit when Element.Value = Path_Id;
...@@ -4782,7 +4782,6 @@ package body Prj.Nmsc is ...@@ -4782,7 +4782,6 @@ package body Prj.Nmsc is
String_Element_Table.Last (Data.Tree.String_Elements); String_Element_Table.Last (Data.Tree.String_Elements);
Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next := Data.Tree.Number_Lists.Table (Last_Src_Dir_Rank).Next :=
Number_List_Table.Last (Data.Tree.Number_Lists); Number_List_Table.Last (Data.Tree.Number_Lists);
end if; end if;
-- And register this source directory as the new last -- And register this source directory as the new last
...@@ -4796,6 +4795,7 @@ package body Prj.Nmsc is ...@@ -4796,6 +4795,7 @@ package body Prj.Nmsc is
(Number => Rank, Next => No_Number_List); (Number => Rank, Next => No_Number_List);
elsif List /= Nil_String then elsif List /= Nil_String then
-- Remove source dir, if present -- Remove source dir, if present
if Prev = Nil_String then if Prev = Nil_String then
...@@ -4821,6 +4821,7 @@ package body Prj.Nmsc is ...@@ -4821,6 +4821,7 @@ package body Prj.Nmsc is
Dir : Dir_Type; Dir : Dir_Type;
Name : String (1 .. 250); Name : String (1 .. 250);
Last : Natural; Last : Natural;
Non_Canonical_Path : Name_Id := No_Name; Non_Canonical_Path : Name_Id := No_Name;
Canonical_Path : Name_Id := No_Name; Canonical_Path : Name_Id := No_Name;
...@@ -4860,9 +4861,9 @@ package body Prj.Nmsc is ...@@ -4860,9 +4861,9 @@ package body Prj.Nmsc is
(Path_Id => Canonical_Path, (Path_Id => Canonical_Path,
Display_Path_Id => Non_Canonical_Path); Display_Path_Id => Non_Canonical_Path);
-- Now look for subdirectories. We do that even when this -- Now look for subdirectories. Do that even when this directory
-- directory is already in the list, because some of its -- is already in the list, because some of its subdirectories may
-- subdirectories may not be in the list yet. -- not be in the list yet.
Open (Dir, The_Path (The_Path'First .. The_Path_Last)); Open (Dir, The_Path (The_Path'First .. The_Path_Last));
...@@ -4885,8 +4886,10 @@ package body Prj.Nmsc is ...@@ -4885,8 +4886,10 @@ package body Prj.Nmsc is
Normalize_Pathname Normalize_Pathname
(Name => Name (1 .. Last), (Name => Name (1 .. Last),
Directory => Directory =>
The_Path (The_Path'First .. The_Path_Last), The_Path
Resolve_Links => Opt.Follow_Links_For_Dirs, (The_Path'First .. The_Path_Last),
Resolve_Links =>
Opt.Follow_Links_For_Dirs,
Case_Sensitive => True); Case_Sensitive => True);
begin begin
...@@ -5030,7 +5033,8 @@ package body Prj.Nmsc is ...@@ -5030,7 +5033,8 @@ package body Prj.Nmsc is
declare declare
Path : constant String := Path : constant String :=
Normalize_Pathname Normalize_Pathname
(Name => Get_Name_String (Path_Name.Name), (Name =>
Get_Name_String (Path_Name.Name),
Directory => Directory =>
Get_Name_String (Project.Directory.Name), Get_Name_String (Project.Directory.Name),
Resolve_Links => Opt.Follow_Links_For_Dirs, Resolve_Links => Opt.Follow_Links_For_Dirs,
......
...@@ -668,10 +668,12 @@ package body Tbuild is ...@@ -668,10 +668,12 @@ package body Tbuild is
N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic); N_Op_Shift_Right_Arithmetic => Name_Shift_Right_Arithmetic);
Nod : constant Node_Id := New_Node (New_Node_Kind, New_Sloc); Nod : constant Node_Id := New_Node (New_Node_Kind, New_Sloc);
begin begin
if New_Node_Kind in Name_Of'Range then if New_Node_Kind in Name_Of'Range then
Set_Chars (Nod, Name_Of (New_Node_Kind)); Set_Chars (Nod, Name_Of (New_Node_Kind));
end if; end if;
return Nod; return Nod;
end New_Op_Node; end New_Op_Node;
......
...@@ -31,7 +31,7 @@ ...@@ -31,7 +31,7 @@
-- This package contains host independent type definitions which are used -- This package contains host independent type definitions which are used
-- in more than one unit in the compiler. They are gathered here for easy -- in more than one unit in the compiler. They are gathered here for easy
-- reference, though in some cases the full description is found in the -- reference, although in some cases the full description is found in the
-- relevant module which implements the definition. The main reason that they -- relevant module which implements the definition. The main reason that they
-- are not in their "natural" specs is that this would cause a lot of inter- -- are not in their "natural" specs is that this would cause a lot of inter-
-- spec dependencies, and in particular some awkward circular dependencies -- spec dependencies, and in particular some awkward circular dependencies
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment