[multiple changes]

2004-05-24  Geert Bosch  <bosch@gnat.com>

	* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi
	with 192 bits of precision, sufficient to reduce a double-extended
	arguments X with a maximum relative error of T'Machine_Epsilon, for X
	in -2.0**32 .. 2.0**32.
	(Cos, Sin):  Always reduce arguments of 1/4 Pi or larger, to prevent
	reduction by the processor, which only uses a 68-bit approximation of
	Pi.
	(Tan): Always reduce arguments and compute function either using
	the processor's fptan instruction, or by dividing sin and cos as needed.

2004-05-24  Doug Rupp  <rupp@gnat.com>

	* adaint.c (__gnat_readdir): Cast CRTL function retun value to avoid
	gcc error on 32/64 bit VMS.

2004-05-24  Olivier Hainque  <hainque@act-europe.fr>

	* init.c (__gnat_error_handler): Handle EEXIST as EACCES for SIGSEGVs,
	since this is what we get for stack overflows although not documented
	as such.
	Document the issues which may require adjustments to our signal
	handlers.

2004-05-24  Ed Schonberg  <schonberg@gnat.com>

	* inline.adb (Add_Scope_To_Clean): Do not add cleanup actions to the
	enclosing dynamic scope if the instantiation is within a generic unit.

2004-05-24  Arnaud Charlet  <charlet@act-europe.fr>

	* exp_dbug.ads: Fix typo.

	* Makefile.in: s-osinte-linux-ia64.ads was misnamed.
	Rename it to its proper name: system-linux-ia64.ads
	(stamp-gnatlib1): Remove extra target specific run time files when
	setting up the rts directory.

2004-05-24  Javier Miranda  <miranda@gnat.com>

	* einfo.ads, einfo.adb (Limited_Views): Removed.
	(Limited_View): New attribute that replaces the previous one. It is
	now a bona fide package with the limited-view list through the
	first_entity and first_private attributes.

	* sem_ch10.adb (Install_Private_With_Clauses): Give support to
	limited-private-with clause.
	(Install_Limited_Withed_Unit): Install the private declarations of a
	limited-private-withed package. Update the installation of the shadow
	entities according to the new structure (see Build_Limited_Views)
	(Build_Limited_Views): Replace the previous implementation of the
	limited view by a package entity that references the first shadow
	entity plus the first shadow private entity (required for limited-
	private-with clause)
	(New_Internal_Shadow_Entity): Code cleanup.
	(Remove_Limited_With_Clause): Update the implementation to undo the
	new work carried out by Build_Limited_Views.
	(Build_Chain): Complete documentation.
	Replace Ada0Y by Ada 0Y in comments
	Minor reformating

	* sem_ch3.adb (Array_Type_Declaration): In case of anonymous access
	types the level of accessibility depends on the enclosing type
	declaration.

	* sem_ch8.adb (Find_Expanded_Name): Fix condition to detect shadow
	entities. Complete documentation of previous change.

2004-05-24  Robert Dewar  <dewar@gnat.com>

	* namet.adb: Minor reformatting
	Avoid use of name I (replace by J)
	Minor code restructuring

	* sem_ch6.adb: Minor reformatting

	* lib-writ.adb: Do not set restriction as active if this is a
	Restriction_Warning case.

	* sem_prag.adb: Reset restriction warning flag if real pragma
	restriction encountered.

	* s-htable.adb: Minor reformatting
	Change rotate count to 3 in Hash (improves hash for small strings)

	* 5qsystem.ads: Add comments for type Address (no literals allowed).

	* gnat_ugn.texi: Add new section of documentation "Code Generation
	Control", which describes the use of -m switches.

2004-05-24  Eric Botcazou  <ebotcazou@act-europe.fr>

	(tree_transform) <N_Identifier>: Do the dereference directly through
	the DECL_INITIAL for renamed variables.

From-SVN: r82205

20 files changed, 630 insertions, 329 deletions

diff --git a/gcc/ada/5qsystem.ads b/gcc/ada/5qsystem.ads
index c8b9493..9052e2b 100644
--- a/gcc/ada/5qsystem.ads
+++ b/gcc/ada/5qsystem.ads
@@ -64,6 +64,14 @@ pragma Pure (System);
 
    type Address is new Long_Integer;
    Null_Address : constant Address;
+   --  Although this is declared as an integer type, no arithmetic operations
+   --  are available (see abstract declarations below), and furthermore there
+   --  is special processing in the compiler that prevents the use of integer
+   --  literals with this type (use To_Address to convert integer literals).
+   --
+   --  Conversion to and from Short_Address is however freely permitted, and
+   --  is indeed the reason that Address is declared as an integer type. See
+   --
 
    Storage_Unit : constant := 8;
    Word_Size    : constant := 64;
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 126ecae..a8a95d1 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,99 @@
+2004-05-24  Geert Bosch  <bosch@gnat.com>
+
+	* a-numaux-x86.adb (Reduce): Reimplement using an approximation of Pi
+	with 192 bits of precision, sufficient to reduce a double-extended
+	arguments X with a maximum relative error of T'Machine_Epsilon, for X
+	in -2.0**32 .. 2.0**32.
+	(Cos, Sin):  Always reduce arguments of 1/4 Pi or larger, to prevent
+	reduction by the processor, which only uses a 68-bit approximation of
+	Pi.
+	(Tan): Always reduce arguments and compute function either using
+	the processor's fptan instruction, or by dividing sin and cos as needed.
+
+2004-05-24  Doug Rupp  <rupp@gnat.com>
+
+	* adaint.c (__gnat_readdir): Cast CRTL function retun value to avoid
+	gcc error on 32/64 bit VMS.
+
+2004-05-24  Olivier Hainque  <hainque@act-europe.fr>
+
+	* init.c (__gnat_error_handler): Handle EEXIST as EACCES for SIGSEGVs,
+	since this is what we get for stack overflows although not documented
+	as such.
+	Document the issues which may require adjustments to our signal
+	handlers.
+
+2004-05-24  Ed Schonberg  <schonberg@gnat.com>
+
+	* inline.adb (Add_Scope_To_Clean): Do not add cleanup actions to the
+	enclosing dynamic scope if the instantiation is within a generic unit.
+
+2004-05-24  Arnaud Charlet  <charlet@act-europe.fr>
+
+	* exp_dbug.ads: Fix typo.
+
+	* Makefile.in: s-osinte-linux-ia64.ads was misnamed.
+	Rename it to its proper name: system-linux-ia64.ads
+	(stamp-gnatlib1): Remove extra target specific run time files when
+	setting up the rts directory.
+
+2004-05-24  Javier Miranda  <miranda@gnat.com>
+
+	* einfo.ads, einfo.adb (Limited_Views): Removed.
+	(Limited_View): New attribute that replaces the previous one. It is
+	now a bona fide package with the limited-view list through the
+	first_entity and first_private attributes.
+
+	* sem_ch10.adb (Install_Private_With_Clauses): Give support to
+	limited-private-with clause.
+	(Install_Limited_Withed_Unit): Install the private declarations of a
+	limited-private-withed package. Update the installation of the shadow
+	entities according to the new structure (see Build_Limited_Views)
+	(Build_Limited_Views): Replace the previous implementation of the
+	limited view by a package entity that references the first shadow
+	entity plus the first shadow private entity (required for limited-
+	private-with clause)
+	(New_Internal_Shadow_Entity): Code cleanup.
+	(Remove_Limited_With_Clause): Update the implementation to undo the
+	new work carried out by Build_Limited_Views.
+	(Build_Chain): Complete documentation.
+	Replace Ada0Y by Ada 0Y in comments
+	Minor reformating
+
+	* sem_ch3.adb (Array_Type_Declaration): In case of anonymous access
+	types the level of accessibility depends on the enclosing type
+	declaration.
+
+	* sem_ch8.adb (Find_Expanded_Name): Fix condition to detect shadow
+	entities. Complete documentation of previous change.
+
+2004-05-24  Robert Dewar  <dewar@gnat.com>
+
+	* namet.adb: Minor reformatting
+	Avoid use of name I (replace by J)
+	Minor code restructuring
+
+	* sem_ch6.adb: Minor reformatting
+
+	* lib-writ.adb: Do not set restriction as active if this is a
+	Restriction_Warning case.
+
+	* sem_prag.adb: Reset restriction warning flag if real pragma
+	restriction encountered.
+
+	* s-htable.adb: Minor reformatting
+	Change rotate count to 3 in Hash (improves hash for small strings)
+
+	* 5qsystem.ads: Add comments for type Address (no literals allowed).
+
+	* gnat_ugn.texi: Add new section of documentation "Code Generation
+	Control", which describes the use of -m switches.
+
+2004-05-24  Eric Botcazou  <ebotcazou@act-europe.fr>
+
+	(tree_transform) <N_Identifier>: Do the dereference directly through
+	the DECL_INITIAL for renamed variables.
+
 2004-05-24  Arnaud Charlet  <charlet@act-europe.fr>
 
 	* s-osinte-linux-ia64.ads: Renamed system-linux-ia64.ads
diff --git a/gcc/ada/Makefile.in b/gcc/ada/Makefile.in
index a094a82..79d4045 100644
--- a/gcc/ada/Makefile.in
+++ b/gcc/ada/Makefile.in
@@ -1268,7 +1268,7 @@ ifeq ($(strip $(filter-out %ia64 linux%,$(arch) $(osys))),)
   s-taprop.adb<s-taprop-linux.adb \
   s-tpopsp.adb<s-tpopsp-posix-foreign.adb \
   s-taspri.ads<s-taspri-linux.ads \
-  system.ads<s-osinte-linux-ia64.ads
+  system.ads<system-linux-ia64.ads
 
   TOOLS_TARGET_PAIRS=mlib-tgt.adb<mlib-tgt-linux.adb
   MISCLIB=
@@ -1663,6 +1663,7 @@ install-gnatlib: ../stamp-gnatlib
 # Remove files to be replaced by target dependent sources
 	$(RM) $(foreach PAIR,$(LIBGNAT_TARGET_PAIRS), \
 	                rts/$(word 1,$(subst <, ,$(PAIR))))
+	$(RM) rts/*-*-*.ads rts/*-*-*.adb
 # Copy new target dependent sources
 	$(foreach PAIR,$(LIBGNAT_TARGET_PAIRS), \
 	          $(LN_S) $(fsrcpfx)$(word 2,$(subst <, ,$(PAIR))) \
diff --git a/gcc/ada/a-numaux-x86.adb b/gcc/ada/a-numaux-x86.adb
index a137333..b118670 100644
--- a/gcc/ada/a-numaux-x86.adb
+++ b/gcc/ada/a-numaux-x86.adb
@@ -7,7 +7,7 @@
 --                                 B o d y                                  --
 --                        (Machine Version for x86)                         --
 --                                                                          --
---          Copyright (C) 1998-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- 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- --
@@ -41,61 +41,7 @@ with System.Machine_Code; use System.Machine_Code;
 
 package body Ada.Numerics.Aux is
 
-   NL           : constant String := ASCII.LF & ASCII.HT;
-
-   type FPU_Stack_Pointer is range 0 .. 7;
-   for FPU_Stack_Pointer'Size use 3;
-
-   type FPU_Status_Word is record
-      B   : Boolean; -- FPU Busy (for 8087 compatibility only)
-      ES  : Boolean; -- Error Summary Status
-      SF  : Boolean; -- Stack Fault
-
-      Top : FPU_Stack_Pointer;
-
-      --  Condition Code Flags
-
-      --  C2 is set by FPREM and FPREM1 to indicate incomplete reduction.
-      --  In case of successfull recorction, C0, C3 and C1 are set to the
-      --  three least significant bits of the result (resp. Q2, Q1 and Q0).
-
-      --  C2 is used by FPTAN, FSIN, FCOS, and FSINCOS to indicate that
-      --  that source operand is beyond the allowable range of
-      --  -2.0**63 .. 2.0**63.
-
-      C3  : Boolean;
-      C2  : Boolean;
-      C1  : Boolean;
-      C0  : Boolean;
-
-      --  Exception Flags
-
-      PE  : Boolean; -- Precision
-      UE  : Boolean; -- Underflow
-      OE  : Boolean; -- Overflow
-      ZE  : Boolean; -- Zero Divide
-      DE  : Boolean; -- Denormalized Operand
-      IE  : Boolean; -- Invalid Operation
-   end record;
-
-   for FPU_Status_Word use record
-      B   at 0 range 15 .. 15;
-      C3  at 0 range 14 .. 14;
-      Top at 0 range 11 .. 13;
-      C2  at 0 range 10 .. 10;
-      C1  at 0 range  9 ..  9;
-      C0  at 0 range  8 ..  8;
-      ES  at 0 range  7 ..  7;
-      SF  at 0 range  6 ..  6;
-      PE  at 0 range  5 ..  5;
-      UE  at 0 range  4 ..  4;
-      OE  at 0 range  3 ..  3;
-      ZE  at 0 range  2 ..  2;
-      DE  at 0 range  1 ..  1;
-      IE  at 0 range  0 ..  0;
-   end record;
-
-   for FPU_Status_Word'Size use 16;
+   NL : constant String := ASCII.LF & ASCII.HT;
 
    -----------------------
    -- Local subprograms --
@@ -109,12 +55,9 @@ package body Ada.Numerics.Aux is
    --  to calculate the exponentiation. This is used by Pow for values
    --  for values of Y in the open interval (-0.25, 0.25)
 
-   function Reduce (X : Double) return Double;
-   --  Implement partial reduction of X by Pi in the x86.
-
-   --  Note that for the Sin, Cos and Tan functions completely accurate
-   --  reduction of the argument is done for arguments in the range of
-   --  -2.0**63 .. 2.0**63, using a 66-bit approximation of Pi.
+   procedure Reduce (X : in out Double; Q : out Natural);
+   --  Implements reduction of X by Pi/2. Q is the quadrant of the final
+   --  result in the range 0 .. 3. The absolute value of X is at most Pi.
 
    pragma Inline (Is_Nan);
    pragma Inline (Reduce);
@@ -123,9 +66,8 @@ package body Ada.Numerics.Aux is
    --  Basic Elementary Functions --
    ---------------------------------
 
-   --  This section implements a few elementary functions that are
-   --  used to build the more complex ones. This ordering enables
-   --  better inlining.
+   --  This section implements a few elementary functions that are used to
+   --  build the more complex ones. This ordering enables better inlining.
 
    ----------
    -- Atan --
@@ -206,20 +148,45 @@ package body Ada.Numerics.Aux is
    -- Reduce --
    ------------
 
-   function Reduce (X : Double) return Double is
-      Result : Double;
+   procedure Reduce (X : in out Double; Q : out Natural) is
+      Half_Pi     : constant := Pi / 2.0;
+      Two_Over_Pi : constant := 2.0 / Pi;
+
+      HM : constant := Integer'Min (Double'Machine_Mantissa / 2, Natural'Size);
+      M  : constant Double := 0.5 + 2.0**(1 - HM); -- Splitting constant
+      P1 : constant Double := Double'Leading_Part (Half_Pi, HM);
+      P2 : constant Double := Double'Leading_Part (Half_Pi - P1, HM);
+      P3 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2, HM);
+      P4 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3, HM);
+      P5 : constant Double := Double'Leading_Part (Half_Pi - P1 - P2 - P3
+                                                                 - P4, HM);
+      P6 : constant Double := Double'Model (Half_Pi - P1 - P2 - P3 - P4 - P5);
+      K  : Double := X * Two_Over_Pi;
    begin
-      Asm
-        (Template =>
-         --  Partial argument reduction
-         "fldpi                " & NL
-       & "fadd    %%st(0), %%st" & NL
-       & "fxch    %%st(1)      " & NL
-       & "fprem1               " & NL
-       & "fstp    %%st(1)      ",
-         Outputs  => Double'Asm_Output ("=t", Result),
-         Inputs   => Double'Asm_Input  ("0", X));
-      return Result;
+      --  For X < 2.0**32, all products below are computed exactly.
+      --  Due to cancellation effects all subtractions are exact as well.
+      --  As no double extended floating-point number has more than 75
+      --  zeros after the binary point, the result will be the correctly
+      --  rounded result of X - K * (Pi / 2.0).
+
+      while abs K >= 2.0**HM loop
+         K := K * M - (K * M - K);
+         X := (((((X - K * P1) - K * P2) - K * P3)
+                     - K * P4) - K * P5) - K * P6;
+         K := X * Two_Over_Pi;
+      end loop;
+
+      if K /= K then
+
+         --  K is not a number, because X was not finite
+
+         raise Constraint_Error;
+      end if;
+
+      K := Double'Rounding (K);
+      Q := Integer (K) mod 4;
+      X := (((((X - K * P1) - K * P2) - K * P3)
+                  - K * P4) - K * P5) - K * P6;
    end Reduce;
 
    ----------
@@ -241,9 +208,9 @@ package body Ada.Numerics.Aux is
       return Result;
    end Sqrt;
 
-   ---------------------------------
-   --  Other Elementary Functions --
-   ---------------------------------
+   --------------------------------
+   -- Other Elementary Functions --
+   --------------------------------
 
    --  These are built using the previously implemented basic functions
 
@@ -253,6 +220,7 @@ package body Ada.Numerics.Aux is
 
    function Acos (X : Double) return Double is
       Result  : Double;
+
    begin
       Result := 2.0 * Atan (Sqrt ((1.0 - X) / (1.0 + X)));
 
@@ -271,8 +239,8 @@ package body Ada.Numerics.Aux is
 
    function Asin (X : Double) return Double is
       Result  : Double;
-   begin
 
+   begin
       Result := Atan (X / Sqrt ((1.0 - X) * (1.0 + X)));
 
       --  The result value is NaN iff input was invalid
@@ -289,29 +257,38 @@ package body Ada.Numerics.Aux is
    ---------
 
    function Cos (X : Double) return Double is
-      Reduced_X : Double := X;
+      Reduced_X : Double := abs X;
       Result    : Double;
-      Status    : FPU_Status_Word;
+      Quadrant  : Natural range 0 .. 3;
 
    begin
+      if Reduced_X > Pi / 4.0 then
+         Reduce (Reduced_X, Quadrant);
+
+         case Quadrant is
+            when 0 =>
+               Asm (Template  => "fcos",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+            when 1 =>
+               Asm (Template  => "fsin",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", -Reduced_X));
+            when 2 =>
+               Asm (Template  => "fcos ; fchs",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+            when 3 =>
+               Asm (Template  => "fsin",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+         end case;
 
-      loop
-         Asm
-           (Template =>
-            "fcos                 " & NL
-          & "xorl    %%eax, %%eax " & NL
-          & "fnstsw  %%ax         ",
-            Outputs  => (Double'Asm_Output         ("=t", Result),
-                        FPU_Status_Word'Asm_Output ("=a", Status)),
-            Inputs   => Double'Asm_Input           ("0", Reduced_X));
-
-         exit when not Status.C2;
-
-         --  Original argument was not in range and the result
-         --  is the unmodified argument.
-
-         Reduced_X := Reduce (Result);
-      end loop;
+      else
+         Asm (Template  => "fcos",
+              Outputs  => Double'Asm_Output ("=t", Result),
+              Inputs   => Double'Asm_Input  ("0", Reduced_X));
+      end if;
 
       return Result;
    end Cos;
@@ -322,7 +299,6 @@ package body Ada.Numerics.Aux is
 
    function Logarithmic_Pow (X, Y : Double) return Double is
       Result  : Double;
-
    begin
       Asm (Template => ""             --  X                  : Y
        & "fyl2x                " & NL --  Y * Log2 (X)
@@ -339,7 +315,6 @@ package body Ada.Numerics.Aux is
          Inputs   =>
            (Double'Asm_Input  ("0", X),
             Double'Asm_Input  ("u", Y)));
-
       return Result;
    end Logarithmic_Pow;
 
@@ -351,8 +326,7 @@ package body Ada.Numerics.Aux is
       type Mantissa_Type is mod 2**Double'Machine_Mantissa;
       --  Modular type that can hold all bits of the mantissa of Double
 
-      --  For negative exponents, a division is done
-      --  at the end of the processing.
+      --  For negative exponents, do divide at the end of the processing
 
       Negative_Y : constant Boolean := Y < 0.0;
       Abs_Y      : constant Double := abs Y;
@@ -370,8 +344,7 @@ package body Ada.Numerics.Aux is
       Factor : Double := 1.0;
 
    begin
-      --  Select algorithm for calculating Pow:
-      --  integer cases fall through
+      --  Select algorithm for calculating Pow (integer cases fall through)
 
       if Exp_High >= 2.0**Double'Machine_Mantissa then
 
@@ -395,7 +368,6 @@ package body Ada.Numerics.Aux is
 
       elsif Exp_High /= Abs_Y then
          Exp_Low := Abs_Y - Exp_High;
-
          Factor := 1.0;
 
          if Exp_Low /= 0.0 then
@@ -473,27 +445,36 @@ package body Ada.Numerics.Aux is
    function Sin (X : Double) return Double is
       Reduced_X : Double := X;
       Result    : Double;
-      Status    : FPU_Status_Word;
+      Quadrant  : Natural range 0 .. 3;
 
    begin
+      if abs X > Pi / 4.0 then
+         Reduce (Reduced_X, Quadrant);
+
+         case Quadrant is
+            when 0 =>
+               Asm (Template  => "fsin",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+            when 1 =>
+               Asm (Template  => "fcos",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+            when 2 =>
+               Asm (Template  => "fsin",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", -Reduced_X));
+            when 3 =>
+               Asm (Template  => "fcos ; fchs",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+         end case;
 
-      loop
-         Asm
-           (Template =>
-            "fsin                 " & NL
-          & "xorl    %%eax, %%eax " & NL
-          & "fnstsw  %%ax         ",
-            Outputs  => (Double'Asm_Output          ("=t", Result),
-                         FPU_Status_Word'Asm_Output ("=a", Status)),
-            Inputs   => Double'Asm_Input            ("0", Reduced_X));
-
-         exit when not Status.C2;
-
-         --  Original argument was not in range and the result
-         --  is the unmodified argument.
-
-         Reduced_X := Reduce (Result);
-      end loop;
+      else
+         Asm (Template  => "fsin",
+            Outputs  => Double'Asm_Output ("=t", Result),
+            Inputs   => Double'Asm_Input  ("0", Reduced_X));
+      end if;
 
       return Result;
    end Sin;
@@ -505,30 +486,34 @@ package body Ada.Numerics.Aux is
    function Tan (X : Double) return Double is
       Reduced_X : Double := X;
       Result    : Double;
-      Status    : FPU_Status_Word;
+      Quadrant  : Natural range 0 .. 3;
 
    begin
+      if abs X > Pi / 4.0 then
+         Reduce (Reduced_X, Quadrant);
+
+         if Quadrant mod 2 = 0 then
+            Asm (Template  => "fptan" & NL
+                            & "ffree   %%st(0)"  & NL
+                            & "fincstp",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+         else
+            Asm (Template  => "fsincos" & NL
+                            & "fdivp   %%st(1)" & NL
+                            & "fchs",
+                  Outputs  => Double'Asm_Output ("=t", Result),
+                  Inputs   => Double'Asm_Input  ("0", Reduced_X));
+         end if;
 
-      loop
-         Asm
-           (Template =>
-            "fptan                " & NL
-          & "xorl    %%eax, %%eax " & NL
-          & "fnstsw  %%ax         " & NL
-          & "ffree   %%st(0)      " & NL
-          & "fincstp              ",
-
-            Outputs  => (Double'Asm_Output         ("=t", Result),
-                        FPU_Status_Word'Asm_Output ("=a", Status)),
-            Inputs   => Double'Asm_Input           ("0", Reduced_X));
-
-         exit when not Status.C2;
-
-         --  Original argument was not in range and the result
-         --  is the unmodified argument.
-
-         Reduced_X := Reduce (Result);
-      end loop;
+      else
+         Asm (Template  =>
+               "fptan                 " & NL
+             & "ffree   %%st(0)      " & NL
+             & "fincstp              ",
+               Outputs  => Double'Asm_Output ("=t", Result),
+               Inputs   => Double'Asm_Input  ("0", Reduced_X));
+      end if;
 
       return Result;
    end Tan;
@@ -543,11 +528,9 @@ package body Ada.Numerics.Aux is
 
       if abs X < 25.0 then
          return (Exp (X) - Exp (-X)) / 2.0;
-
       else
          return Exp (X) / 2.0;
       end if;
-
    end Sinh;
 
    ----------
@@ -560,11 +543,9 @@ package body Ada.Numerics.Aux is
 
       if abs X < 22.0 then
          return (Exp (X) + Exp (-X)) / 2.0;
-
       else
          return Exp (X) / 2.0;
       end if;
-
    end Cosh;
 
    ----------
@@ -574,7 +555,7 @@ package body Ada.Numerics.Aux is
    function Tanh (X : Double) return Double is
    begin
       --  Return the Hyperbolic Tangent of x
-      --
+
       --                                    x    -x
       --                                   e  - e        Sinh (X)
       --       Tanh (X) is defined to be -----------   = --------
@@ -586,7 +567,6 @@ package body Ada.Numerics.Aux is
       end if;
 
       return 1.0 / (1.0 + Exp (-2.0 * X)) - 1.0 / (1.0 + Exp (2.0 * X));
-
    end Tanh;
 
 end Ada.Numerics.Aux;
diff --git a/gcc/ada/adaint.c b/gcc/ada/adaint.c
index 7b8813a..92573fd 100644
--- a/gcc/ada/adaint.c
+++ b/gcc/ada/adaint.c
@@ -806,7 +806,7 @@ __gnat_readdir (DIR *dirp, char *buffer)
     return NULL;
 
 #else
-  struct dirent *dirent = readdir (dirp);
+  struct dirent *dirent = (struct dirent *) readdir (dirp);
 
   if (dirent != NULL)
     {
diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb
index b2ad23f..df32596 100644
--- a/gcc/ada/einfo.adb
+++ b/gcc/ada/einfo.adb
@@ -205,7 +205,7 @@ package body Einfo is
    --    Inner_Instances                 Elist23
    --    Enum_Pos_To_Rep                 Node23
    --    Packed_Array_Type               Node23
-   --    Limited_Views                   Elist23
+   --    Limited_View                    Node23
    --    Privals_Chain                   Elist23
    --    Protected_Operation             Node23
 
@@ -1708,11 +1708,11 @@ package body Einfo is
       return Node20 (Id);
    end Last_Entity;
 
-   function Limited_Views (Id : E) return L is
+   function Limited_View (Id : E) return E is
    begin
       pragma Assert (Ekind (Id) = E_Package);
-      return Elist23 (Id);
-   end Limited_Views;
+      return Node23 (Id);
+   end Limited_View;
 
    function Lit_Indexes (Id : E) return E is
    begin
@@ -3666,11 +3666,11 @@ package body Einfo is
       Set_Node20 (Id, V);
    end Set_Last_Entity;
 
-   procedure Set_Limited_Views (Id : E; V : L) is
+   procedure Set_Limited_View (Id : E; V : E) is
    begin
       pragma Assert (Ekind (Id) = E_Package);
-      Set_Elist23 (Id, V);
-   end Set_Limited_Views;
+      Set_Node23 (Id, V);
+   end Set_Limited_View;
 
    procedure Set_Lit_Indexes (Id : E; V : E) is
    begin
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 6487a22..3b5c5bc 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -2391,11 +2391,12 @@ package Einfo is
 --       Points to a the last entry in the list of associated entities chained
 --       through the Next_Entity field. Empty if no entities are chained.
 
---    Limited_Views (Elist23)
---       Present in non-generic package entities that are not instances.
---       The elements of this list are the shadow entities created for the
---       types and local packages that are declared in a package that appears
---       in a limited_with clause (Ada0Y: AI-50217)
+--    Limited_View (Node23)
+--       Present in non-generic package entities that are not instances. Bona
+--       fide package with the limited-view list through the first_entity and
+--       first_private attributes. The elements of this list are the shadow
+--       entities created for the types and local packages that are declared
+--       in a package that appears in a limited_with clause (Ada0Y: AI-50217)
 
 --    Lit_Indexes (Node15)
 --       Present in enumeration types and subtypes. Non-empty only for the
@@ -4454,7 +4455,7 @@ package Einfo is
    --    Scope_Depth_Value             (Uint22)
    --    Generic_Renamings             (Elist23)  (for an instance)
    --    Inner_Instances               (Elist23)  (generic case only)
-   --    Limited_Views                 (Elist23)  (non-generic, not instance)
+   --    Limited_View                  (Node23)   (non-generic, not instance)
    --    Delay_Subprogram_Descriptors  (Flag50)
    --    Body_Needed_For_SAL           (Flag40)
    --    Discard_Names                 (Flag88)
@@ -5187,7 +5188,7 @@ package Einfo is
    function Kill_Range_Checks                  (Id : E) return B;
    function Kill_Tag_Checks                    (Id : E) return B;
    function Last_Entity                        (Id : E) return E;
-   function Limited_Views                      (Id : E) return L;
+   function Limited_View                       (Id : E) return E;
    function Lit_Indexes                        (Id : E) return E;
    function Lit_Strings                        (Id : E) return E;
    function Machine_Radix_10                   (Id : E) return B;
@@ -5661,7 +5662,7 @@ package Einfo is
    procedure Set_Kill_Range_Checks             (Id : E; V : B := True);
    procedure Set_Kill_Tag_Checks               (Id : E; V : B := True);
    procedure Set_Last_Entity                   (Id : E; V : E);
-   procedure Set_Limited_Views                 (Id : E; V : L);
+   procedure Set_Limited_View                  (Id : E; V : E);
    procedure Set_Lit_Indexes                   (Id : E; V : E);
    procedure Set_Lit_Strings                   (Id : E; V : E);
    procedure Set_Machine_Radix_10              (Id : E; V : B := True);
@@ -6187,7 +6188,7 @@ package Einfo is
    pragma Inline (Kill_Range_Checks);
    pragma Inline (Kill_Tag_Checks);
    pragma Inline (Last_Entity);
-   pragma Inline (Limited_Views);
+   pragma Inline (Limited_View);
    pragma Inline (Lit_Indexes);
    pragma Inline (Lit_Strings);
    pragma Inline (Machine_Radix_10);
@@ -6496,7 +6497,7 @@ package Einfo is
    pragma Inline (Set_Kill_Range_Checks);
    pragma Inline (Set_Kill_Tag_Checks);
    pragma Inline (Set_Last_Entity);
-   pragma Inline (Set_Limited_Views);
+   pragma Inline (Set_Limited_View);
    pragma Inline (Set_Lit_Indexes);
    pragma Inline (Set_Lit_Strings);
    pragma Inline (Set_Machine_Radix_10);
diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads
index 080e866..0abca30 100644
--- a/gcc/ada/exp_dbug.ads
+++ b/gcc/ada/exp_dbug.ads
@@ -104,7 +104,7 @@ package Exp_Dbug is
       --    __nn  (two underscores)
 
       --  where nn is a serial number (2 for the second overloaded function,
-      --  2 for the third, etc.). A suffix of __1 is always omitted (i.e. no
+      --  3 for the third, etc.). A suffix of __1 is always omitted (i.e. no
       --  suffix implies the first instance).
 
       --  These names are prefixed by the normal full qualification. So
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 1a30c46..c75882b 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -3646,6 +3646,7 @@ describe the switches in more detail in functionally grouped sections.
 * Exception Handling Control::
 * Units to Sources Mapping Files::
 * Integrated Preprocessing::
+* Code Generation Control::
 @ifset vms
 * Return Codes::
 @end ifset
@@ -6534,6 +6535,35 @@ This switch is similar to switch @option{^-D^/ASSOCIATE^} of @code{gnatprep}.
 
 @end table
 
+@node Code Generation Control
+@subsection Code Generation Control
+
+@noindent
+
+The GCC technology provides a wide range of target dependent
+@option{-m} switches for controlling
+details of code generation with respect to different versions of
+architectures. This includes variations in instruction sets (e.g.
+different members of the power pc family), and different requirements
+for optimal arrangement of instructions (e.g. different members of
+the x86 family). The list of available @option{-m} switches may be
+found in the GCC documentation.
+
+Use of the these @option{-m} switches may in some cases result in improved
+code performance.
+
+The GNAT Pro technology is tested and qualified without any
+@option{-m} switches,
+so generally the most reliable approach is to avoid the use of these
+switches. However, we generally expect most of these switches to work
+successfully with GNAT Pro, and many customers have reported successful
+use of these options.
+
+Our general advice is to avoid the use of @option{-m} switches unless
+special needs lead to requirements in this area. In particular,
+there is no point in using @option{-m} switches to improve performance
+unless you actually see a performance improvement.
+
 @ifset vms
 @node Return Codes
 @subsection Return Codes
diff --git a/gcc/ada/init.c b/gcc/ada/init.c
index b27e059..9d79b6c 100644
--- a/gcc/ada/init.c
+++ b/gcc/ada/init.c
@@ -262,6 +262,51 @@ __gnat_set_globals (int main_priority,
    at all; the intention is that this be replaced by system specific
    code where initialization is required. */
 
+/* Notes on the Zero Cost Exceptions scheme and its impact on the signal
+   handlers implemented below :
+
+   What we call Zero Cost Exceptions is implemented using the GCC eh
+   circuitry, even if the underlying implementation is setjmp/longjmp
+   based. In any case ...
+
+   The GCC unwinder expects to be dealing with call return addresses, since
+   this is the "nominal" case of what we retrieve while unwinding a regular
+   call chain. To evaluate if a handler applies at some point in this chain,
+   the propagation engine needs to determine what region the corresponding
+   call instruction pertains to. The return address may not be attached to the
+   same region as the call, so the unwinder unconditionally substracts "some"
+   amount to the return addresses it gets to search the region tables. The
+   exact amount is computed to ensure that the resulting address is inside the
+   call instruction, and is thus target dependant (think about delay slots for
+   instance).
+
+   When we raise an exception from a signal handler, e.g. to transform a
+   SIGSEGV into Storage_Error, things need to appear as if the signal handler
+   had been "called" by the instruction which triggered the signal, so that
+   exception handlers that apply there are considered. What the unwinder will
+   retrieve as the return address from the signal handler is what it will find
+   as the faulting instruction address in the corresponding signal context
+   pushed by the kernel. Leaving this address untouched may loose, because if
+   the triggering instruction happens to be the very first of a region, the
+   later adjustements performed by the unwinder would yield an address outside
+   that region. We need to compensate for those adjustments at some point,
+   which we currently do in the GCC unwinding fallback macro.
+
+   The thread at http://gcc.gnu.org/ml/gcc-patches/2004-05/msg00343.html
+   describes a couple of issues with our current approach. Basically: on some
+   targets the adjustment to apply depends on the triggering signal, which is
+   not easily accessible from the macro, and we actually do not tackle this as
+   of today. Besides, other languages, e.g. Java, deal with this by performing
+   the adjustment in the signal handler before the raise, so our adjustments
+   may break those front-ends.
+
+   To have it all right, we should either find a way to deal with the signal
+   variants from the macro and convert Java on all targets (ugh), or remove
+   our macro adjustments and update our signal handlers a-la-java way.  The
+   latter option appears the simplest, although some targets have their share
+   of subtleties to account for.  See for instance the syscall(SYS_sigaction)
+   story in libjava/include/i386-signal.h.  */
+
 /***********************************/
 /* __gnat_initialize (AIX Version) */
 /***********************************/
@@ -1051,6 +1096,18 @@ struct Machine_State
 
 static void __gnat_error_handler (int, int, sigcontext_t *);
 
+/* We are not setting the SA_SIGINFO bit in the sigaction flags when
+   connecting that handler, with the effects described in the sigaction
+   man page:
+
+          SA_SIGINFO [...]
+          If cleared and the signal is caught, the first argument is
+          also the signal number but the second argument is the signal
+          code identifying the cause of the signal. The third argument
+          points to a sigcontext_t structure containing the receiving
+	  process's context when the signal was delivered.
+*/
+
 static void
 __gnat_error_handler (int sig, int code, sigcontext_t *sc)
 {
@@ -1076,8 +1133,13 @@ __gnat_error_handler (int sig, int code, sigcontext_t *sc)
 	  exception = &program_error; /* ??? storage_error ??? */
 	  msg = "SIGSEGV: (Autogrow for file failed)";
 	}
-      else if (code == EACCES)
+      else if (code == EACCES || code == EEXIST)
 	{
+	  /* ??? We handle stack overflows here, some of which do trigger
+	         SIGSEGV + EEXIST on Irix 6.5 although EEXIST is not part of
+	         the documented valid codes for SEGV in the signal(5) man
+	         page.  */
+
 	  /* ??? Re-add smarts to further verify that we launched
 		 the stack into a guard page, not an attempt to
 		 write to .text or something */
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index b96da45..7ca0e31 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2004 Free Software Foundation, Inc.          --
 --                                                                          --
 -- 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- --
@@ -467,6 +467,22 @@ package body Inline is
          return;
       end if;
 
+      --  If the instance appears within a generic subprogram there is nothing
+      --  to finalize either.
+
+      declare
+         S : Entity_Id;
+      begin
+         S := Scope (Inst);
+         while Present (S) and then S /= Standard_Standard loop
+            if Is_Generic_Subprogram (S) then
+               return;
+            end if;
+
+            S := Scope (S);
+         end loop;
+      end;
+
       Elmt := First_Elmt (To_Clean);
 
       while Present (Elmt) loop
diff --git a/gcc/ada/lib-writ.adb b/gcc/ada/lib-writ.adb
index 7168e69..c4dd766 100644
--- a/gcc/ada/lib-writ.adb
+++ b/gcc/ada/lib-writ.adb
@@ -944,7 +944,9 @@ package body Lib.Writ is
       --  First the information for the boolean restrictions
 
       for R in All_Boolean_Restrictions loop
-         if Main_Restrictions.Set (R) then
+         if Main_Restrictions.Set (R)
+           and then not Restriction_Warnings (R)
+         then
             Write_Info_Char ('r');
          elsif Main_Restrictions.Violated (R) then
             Write_Info_Char ('v');
diff --git a/gcc/ada/namet.adb b/gcc/ada/namet.adb
index 1b1af12..78c0df4 100644
--- a/gcc/ada/namet.adb
+++ b/gcc/ada/namet.adb
@@ -139,18 +139,17 @@ package body Namet is
 
    begin
       if Debug_Flag_H then
-
          for J in F'Range loop
             F (J) := 0;
          end loop;
 
-         for I in Hash_Index_Type loop
-            if Hash_Table (I) = No_Name then
+         for J in Hash_Index_Type loop
+            if Hash_Table (J) = No_Name then
                F (0) := F (0) + 1;
 
             else
                Write_Str ("Hash_Table (");
-               Write_Int (Int (I));
+               Write_Int (Int (J));
                Write_Str (") has ");
 
                declare
@@ -160,7 +159,7 @@ package body Namet is
 
                begin
                   C := 0;
-                  N := Hash_Table (I);
+                  N := Hash_Table (J);
 
                   while N /= No_Name loop
                      N := Name_Entries.Table (N).Hash_Link;
@@ -177,7 +176,7 @@ package body Namet is
                      F (Max_Chain_Length) := F (Max_Chain_Length) + 1;
                   end if;
 
-                  N := Hash_Table (I);
+                  N := Hash_Table (J);
 
                   while N /= No_Name loop
                      S := Name_Entries.Table (N).Name_Chars_Index;
@@ -196,27 +195,27 @@ package body Namet is
 
          Write_Eol;
 
-         for I in Int range 0 .. Max_Chain_Length loop
-            if F (I) /= 0 then
+         for J in Int range 0 .. Max_Chain_Length loop
+            if F (J) /= 0 then
                Write_Str ("Number of hash chains of length ");
 
-               if I < 10 then
+               if J < 10 then
                   Write_Char (' ');
                end if;
 
-               Write_Int (I);
+               Write_Int (J);
 
-               if I = Max_Chain_Length then
+               if J = Max_Chain_Length then
                   Write_Str (" or greater");
                end if;
 
                Write_Str (" = ");
-               Write_Int (F (I));
+               Write_Int (F (J));
                Write_Eol;
 
-               if I /= 0 then
-                  Nsyms := Nsyms + F (I);
-                  Probes := Probes + F (I) * (1 + I) * 100;
+               if J /= 0 then
+                  Nsyms := Nsyms + F (J);
+                  Probes := Probes + F (J) * (1 + J) * 100;
                end if;
             end if;
          end loop;
@@ -560,6 +559,8 @@ package body Namet is
    -- Get_Name_String --
    ---------------------
 
+   --  Procedure version leaving result in Name_Buffer, length in Name_Len
+
    procedure Get_Name_String (Id : Name_Id) is
       S : Int;
 
@@ -574,6 +575,12 @@ package body Namet is
       end loop;
    end Get_Name_String;
 
+   ---------------------
+   -- Get_Name_String --
+   ---------------------
+
+   --  Function version returning a string
+
    function Get_Name_String (Id : Name_Id) return String is
       S : Int;
 
@@ -656,45 +663,12 @@ package body Namet is
    ----------
 
    function Hash return Hash_Index_Type is
-      subtype Int_0_12 is Int range 0 .. 12;
-      --  Used to avoid when others on case jump below
-
-      Even_Name_Len : Integer;
-      --  Last even numbered position (used for >12 case)
-
    begin
-
-      --  Special test for 12 (rather than counting on a when others for the
-      --  case statement below) avoids some Ada compilers converting the case
-      --  statement into successive jumps.
-
-      --  The case of a name longer than 12 characters is handled by taking
-      --  the first 6 odd numbered characters and the last 6 even numbered
-      --  characters
-
-      if Name_Len > 12 then
-         Even_Name_Len := (Name_Len) / 2 * 2;
-
-         return ((((((((((((
-           Character'Pos (Name_Buffer (01))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
-           Character'Pos (Name_Buffer (03))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
-           Character'Pos (Name_Buffer (05))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
-           Character'Pos (Name_Buffer (07))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
-           Character'Pos (Name_Buffer (09))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
-           Character'Pos (Name_Buffer (11))) * 2 +
-           Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
-      end if;
-
       --  For the cases of 1-12 characters, all characters participate in the
       --  hash. The positioning is randomized, with the bias that characters
       --  later on participate fully (i.e. are added towards the right side).
 
-      case Int_0_12 (Name_Len) is
+      case Name_Len is
 
          when 0 =>
             return 0;
@@ -813,6 +787,26 @@ package body Namet is
               Character'Pos (Name_Buffer (10))) * 2 +
               Character'Pos (Name_Buffer (12))) mod Hash_Num;
 
+         --  Names longer than 12 characters are handled by taking the first
+         --  6 odd numbered characters and the last 6 even numbered characters.
+
+         when others => declare
+               Even_Name_Len : constant Integer := (Name_Len) / 2 * 2;
+         begin
+            return ((((((((((((
+              Character'Pos (Name_Buffer (01))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len - 10))) * 2 +
+              Character'Pos (Name_Buffer (03))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len - 08))) * 2 +
+              Character'Pos (Name_Buffer (05))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len - 06))) * 2 +
+              Character'Pos (Name_Buffer (07))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len - 04))) * 2 +
+              Character'Pos (Name_Buffer (09))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len - 02))) * 2 +
+              Character'Pos (Name_Buffer (11))) * 2 +
+              Character'Pos (Name_Buffer (Even_Name_Len))) mod Hash_Num;
+         end;
       end case;
    end Hash;
 
@@ -821,7 +815,6 @@ package body Namet is
    ----------------
 
    procedure Initialize is
-
    begin
       Name_Chars.Init;
       Name_Entries.Init;
@@ -853,12 +846,20 @@ package body Namet is
    -- Is_Internal_Name --
    ----------------------
 
+   --  Version taking an argument
+
    function Is_Internal_Name (Id : Name_Id) return Boolean is
    begin
       Get_Name_String (Id);
       return Is_Internal_Name;
    end Is_Internal_Name;
 
+   ----------------------
+   -- Is_Internal_Name --
+   ----------------------
+
+   --  Version taking its input from Name_Buffer
+
    function Is_Internal_Name return Boolean is
    begin
       if Name_Buffer (1) = '_'
@@ -1033,8 +1034,8 @@ package body Namet is
 
                S := Name_Entries.Table (New_Id).Name_Chars_Index;
 
-               for I in 1 .. Name_Len loop
-                  if Name_Chars.Table (S + Int (I)) /= Name_Buffer (I) then
+               for J in 1 .. Name_Len loop
+                  if Name_Chars.Table (S + Int (J)) /= Name_Buffer (J) then
                      goto No_Match;
                   end if;
                end loop;
@@ -1069,9 +1070,9 @@ package body Namet is
 
          --  Set corresponding string entry in the Name_Chars table
 
-         for I in 1 .. Name_Len loop
+         for J in 1 .. Name_Len loop
             Name_Chars.Increment_Last;
-            Name_Chars.Table (Name_Chars.Last) := Name_Buffer (I);
+            Name_Chars.Table (Name_Chars.Last) := Name_Buffer (J);
          end loop;
 
          Name_Chars.Increment_Last;
@@ -1149,11 +1150,9 @@ package body Namet is
       if In_Character_Range (C) then
          declare
             CC : constant Character := Get_Character (C);
-
          begin
             if CC in 'a' .. 'z' or else CC in '0' .. '9' then
                Name_Buffer (Name_Len) := CC;
-
             else
                Name_Buffer (Name_Len) := 'U';
                Set_Hex_Chars (Natural (C));
diff --git a/gcc/ada/s-htable.adb b/gcc/ada/s-htable.adb
index 2d2b422..5e3675a 100644
--- a/gcc/ada/s-htable.adb
+++ b/gcc/ada/s-htable.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---           Copyright (C) 1995-2002 Ada Core Technologies, Inc.            --
+--           Copyright (C) 1995-2004 Ada Core Technologies, Inc.            --
 --                                                                          --
 -- 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- --
@@ -182,9 +182,9 @@ package body System.HTable is
 
    end Static_HTable;
 
-   --------------------
-   --  Simple_HTable --
-   --------------------
+   -------------------
+   -- Simple_HTable --
+   -------------------
 
    package body Simple_HTable is
 
@@ -221,7 +221,6 @@ package body System.HTable is
 
       function  Get (K : Key) return Element is
          Tmp : constant Elmt_Ptr := Tab.Get (K);
-
       begin
          if Tmp = null then
             return No_Element;
@@ -236,7 +235,6 @@ package body System.HTable is
 
       function Get_First return Element is
          Tmp : constant Elmt_Ptr := Tab.Get_First;
-
       begin
          if Tmp = null then
             return No_Element;
@@ -260,7 +258,6 @@ package body System.HTable is
 
       function Get_Next return Element is
          Tmp : constant Elmt_Ptr := Tab.Get_Next;
-
       begin
          if Tmp = null then
             return No_Element;
@@ -318,7 +315,6 @@ package body System.HTable is
 
       procedure Set (K : Key; E : Element) is
          Tmp : constant Elmt_Ptr := Tab.Get (K);
-
       begin
          if Tmp = null then
             Tab.Set (new Element_Wrapper'(K, E, null));
@@ -348,15 +344,16 @@ package body System.HTable is
       function Rotate_Left (Value : Uns; Amount : Natural) return Uns;
       pragma Import (Intrinsic, Rotate_Left);
 
-      Tmp : Uns := 0;
+      Hash_Value : Uns;
 
    begin
+      Hash_Value := 0;
       for J in Key'Range loop
-         Tmp := Rotate_Left (Tmp, 1) + Character'Pos (Key (J));
+         Hash_Value := Rotate_Left (Hash_Value, 3) + Character'Pos (Key (J));
       end loop;
 
       return Header_Num'First +
-               Header_Num'Base (Tmp mod Header_Num'Range_Length);
+               Header_Num'Base (Hash_Value mod Header_Num'Range_Length);
    end Hash;
 
 end System.HTable;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 9eaee3e..333bae3 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -28,7 +28,6 @@ with Atree;    use Atree;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
-with Elists;   use Elists;
 with Exp_Util; use Exp_Util;
 with Fname;    use Fname;
 with Fname.UF; use Fname.UF;
@@ -77,7 +76,7 @@ package body Sem_Ch10 is
    --  in a limited_with clause. If the package was not previously analyzed
    --  then it also performs a basic decoration of the real entities; this
    --  is required to do not pass non-decorated entities to the back-end.
-   --  Implements Ada0Y (AI-50217).
+   --  Implements Ada 0Y (AI-50217).
 
    procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id);
    --  Check whether the source for the body of a compilation unit must
@@ -101,7 +100,7 @@ package body Sem_Ch10 is
    --  through a regular with clause. This procedure creates the implicit
    --  limited with_clauses for the parents and loads the corresponding units.
    --  The shadow entities are created when the inserted clause is analyzed.
-   --  Implements Ada0Y (AI-50217).
+   --  Implements Ada 0Y (AI-50217).
 
    procedure Expand_With_Clause (Nam : Node_Id; N : Node_Id);
    --  When a child unit appears in a context clause, the implicit withs on
@@ -129,11 +128,11 @@ package body Sem_Ch10 is
 
    procedure Install_Limited_Context_Clauses (N : Node_Id);
    --  Subsidiary to Install_Context. Process only limited with_clauses
-   --  for current unit. Implements Ada0Y (AI-50217).
+   --  for current unit. Implements Ada 0Y (AI-50217).
 
    procedure Install_Limited_Withed_Unit (N : Node_Id);
    --  Place shadow entities for a limited_with package in the visibility
-   --  structures for the current compilation. Implements Ada0Y (AI-50217).
+   --  structures for the current compilation. Implements Ada 0Y (AI-50217).
 
    procedure Install_Withed_Unit
      (With_Clause     : Node_Id;
@@ -182,7 +181,7 @@ package body Sem_Ch10 is
 
    procedure Remove_Limited_With_Clause (N : Node_Id);
    --  Remove from visibility the shadow entities introduced for a package
-   --  mentioned in a limited_with clause. Implements Ada0Y (AI-50217).
+   --  mentioned in a limited_with clause. Implements Ada 0Y (AI-50217).
 
    procedure Remove_Parents (Lib_Unit : Node_Id);
    --  Remove_Parents checks if Lib_Unit is a child spec. If so then the parent
@@ -620,7 +619,7 @@ package body Sem_Ch10 is
             Item := First (Context_Items (N));
             while Present (Item) loop
 
-               --  Ada0Y (AI-50217): Do not consider limited-withed units
+               --  Ada 0Y (AI-50217): Do not consider limited-withed units
 
                if Nkind (Item) = N_With_Clause
                   and then not Implicit_With (Item)
@@ -799,8 +798,8 @@ package body Sem_Ch10 is
       --  Loop through context items. This is done is three passes:
       --  a) The first pass analyze non-limited with-clauses.
       --  b) The second pass add implicit limited_with clauses for
-      --     the parents of child units (Ada0Y: AI-50217)
-      --  c) The third pass analyzes limited_with clauses (Ada0Y: AI-50217)
+      --     the parents of child units (Ada 0Y: AI-50217)
+      --  c) The third pass analyzes limited_with clauses (Ada 0Y: AI-50217)
 
       Item := First (Context_Items (N));
       while Present (Item) loop
@@ -1617,7 +1616,7 @@ package body Sem_Ch10 is
 
    begin
       if Limited_Present (N) then
-         --  Ada0Y (AI-50217): Build visibility structures but do not
+         --  Ada 0Y (AI-50217): Build visibility structures but do not
          --  analyze unit
 
          Build_Limited_Views (N);
@@ -3033,7 +3032,6 @@ package body Sem_Ch10 is
          if Nkind (Item) = N_With_Clause
            and then Limited_Present (Item)
          then
-
             Check_Withed_Unit (Item);
 
             if Private_Present (Library_Unit (Item)) then
@@ -3165,7 +3163,7 @@ package body Sem_Ch10 is
 
    procedure Install_Private_With_Clauses (P : Entity_Id) is
       Decl   : constant Node_Id := Unit_Declaration_Node (P);
-      Clause : Node_Id;
+      Item   : Node_Id;
 
    begin
       if Debug_Flag_I then
@@ -3175,15 +3173,20 @@ package body Sem_Ch10 is
       end if;
 
       if Nkind (Parent (Decl)) = N_Compilation_Unit then
-         Clause := First (Context_Items (Parent (Decl)));
-         while Present (Clause) loop
-            if Nkind (Clause) = N_With_Clause
-              and then Private_Present (Clause)
+         Item := First (Context_Items (Parent (Decl)));
+
+         while Present (Item) loop
+            if Nkind (Item) = N_With_Clause
+              and then Private_Present (Item)
             then
-               Install_Withed_Unit (Clause, Private_With_OK => True);
+               if Limited_Present (Item) then
+                  Install_Limited_Withed_Unit (Item);
+               else
+                  Install_Withed_Unit (Item, Private_With_OK => True);
+               end if;
             end if;
 
-            Next (Clause);
+            Next (Item);
          end loop;
       end if;
    end Install_Private_With_Clauses;
@@ -3274,10 +3277,11 @@ package body Sem_Ch10 is
                            Get_Source_Unit (Library_Unit (N));
       P_Unit           : constant Entity_Id := Unit (Library_Unit (N));
       P                : Entity_Id;
-      Lim_Elmt         : Elmt_Id;
-      Lim_Typ          : Entity_Id;
       Is_Child_Package : Boolean := False;
 
+      Lim_Header       : Entity_Id;
+      Lim_Typ          : Entity_Id;
+
       function In_Chain (E : Entity_Id) return Boolean;
       --  Check that the shadow entity is not already in the homonym
       --  chain, for example through a limited_with clause in a parent unit.
@@ -3362,6 +3366,35 @@ package body Sem_Ch10 is
                    or else (Is_Child_Package
                              and then Is_Visible_Child_Unit (P)))
       then
+         --  Ada 0Y (AI-262): Install the private declarations of P
+
+         if Private_Present (N)
+           and then not In_Private_Part (P)
+         then
+            declare
+               Id : Entity_Id;
+            begin
+               Id := First_Private_Entity (P);
+
+               while Present (Id) loop
+                  if not Is_Internal (Id)
+                    and then not Is_Child_Unit (Id)
+                  then
+                     if not In_Chain (Id) then
+                        Set_Homonym (Id, Current_Entity (Id));
+                        Set_Current_Entity (Id);
+                     end if;
+
+                     Set_Is_Immediately_Visible (Id);
+                  end if;
+
+                  Next_Entity (Id);
+               end loop;
+
+               Set_In_Private_Part (P);
+            end;
+         end if;
+
          return;
       end if;
 
@@ -3430,12 +3463,17 @@ package body Sem_Ch10 is
 
       Set_Is_Immediately_Visible (P);
 
-      --  Install each incomplete view
+      --  Install each incomplete view. The first element of the limited view
+      --  is a header (an E_Package entity) that is used to reference the first
+      --  shadow entity in the private part of the package
+
+      Lim_Header := Limited_View (P);
+      Lim_Typ    := First_Entity (Lim_Header);
 
-      Lim_Elmt   := First_Elmt (Limited_Views (P));
+      while Present (Lim_Typ) loop
 
-      while Present (Lim_Elmt) loop
-         Lim_Typ  := Node (Lim_Elmt);
+         exit when not Private_Present (N)
+                        and then Lim_Typ = First_Private_Entity (Lim_Header);
 
          if not In_Chain (Lim_Typ) then
             Set_Homonym (Lim_Typ, Current_Entity (Lim_Typ));
@@ -3446,10 +3484,9 @@ package body Sem_Ch10 is
                Write_Name (Chars (Lim_Typ));
                Write_Eol;
             end if;
-
          end if;
 
-         Next_Elmt (Lim_Elmt);
+         Next_Entity (Lim_Typ);
       end loop;
 
       --  The context clause has installed a limited-view, mark it
@@ -3643,9 +3680,13 @@ package body Sem_Ch10 is
       Unum : constant Unit_Number_Type := Get_Source_Unit (Library_Unit (N));
       P    : constant Entity_Id        := Cunit_Entity (Unum);
 
-      Spec        : Node_Id;         --  To denote a package specification
-      Lim_Typ     : Entity_Id;       --  To denote shadow entities.
-      Comp_Typ    : Entity_Id;       --  To denote real entities.
+      Spec        : Node_Id;            --  To denote a package specification
+      Lim_Typ     : Entity_Id;          --  To denote shadow entities
+      Comp_Typ    : Entity_Id;          --  To denote real entities
+
+      Lim_Header  : Entity_Id;          --  Package entity
+      Last_Lim_E  : Entity_Id := Empty; --  Last limited entity built
+      Last_Pub_Lim_E : Entity_Id;       --  To set the first private entity
 
       procedure Decorate_Incomplete_Type
         (E    : Entity_Id;
@@ -3665,7 +3706,9 @@ package body Sem_Ch10 is
       --  Set basic attributes of tagged type T, including its class_wide type.
       --  The parameters Loc, Scope are used to decorate the class_wide type.
 
-      procedure Build_Chain (Spec : Node_Id; Scope : Entity_Id);
+      procedure Build_Chain
+        (Scope      : Entity_Id;
+         First_Decl : Node_Id);
       --  Construct list of shadow entities and attach it to entity of
       --  package that is mentioned in a limited_with clause.
 
@@ -3673,8 +3716,8 @@ package body Sem_Ch10 is
         (Kind       : Entity_Kind;
          Sloc_Value : Source_Ptr;
          Id_Char    : Character) return Entity_Id;
-      --  This function is similar to New_Internal_Entity, except that the
-      --  entity is not added to the scope's list of entities.
+      --  Build a new internal entity and append it to the list of shadow
+      --  entities available through the limited-header
 
       ------------------------------
       -- Decorate_Incomplete_Type --
@@ -3685,13 +3728,13 @@ package body Sem_Ch10 is
          Scop : Entity_Id)
       is
       begin
-         Set_Ekind                     (E, E_Incomplete_Type);
-         Set_Scope                     (E, Scop);
-         Set_Etype                     (E, E);
-         Set_Is_First_Subtype          (E, True);
-         Set_Stored_Constraint         (E, No_Elist);
-         Set_Full_View                 (E, Empty);
-         Init_Size_Align               (E);
+         Set_Ekind             (E, E_Incomplete_Type);
+         Set_Scope             (E, Scop);
+         Set_Etype             (E, E);
+         Set_Is_First_Subtype  (E, True);
+         Set_Stored_Constraint (E, No_Elist);
+         Set_Full_View         (E, Empty);
+         Init_Size_Align       (E);
       end Decorate_Incomplete_Type;
 
       --------------------------
@@ -3725,7 +3768,7 @@ package body Sem_Ch10 is
             Set_Equivalent_Type           (CW, Empty);
             Set_From_With_Type            (CW, From_With_Type (T));
 
-            Set_Class_Wide_Type (T, CW);
+            Set_Class_Wide_Type           (T, CW);
          end if;
       end Decorate_Tagged_Type;
 
@@ -3750,36 +3793,54 @@ package body Sem_Ch10 is
          Sloc_Value : Source_Ptr;
          Id_Char    : Character) return Entity_Id
       is
-         N : constant Entity_Id :=
+         E : constant Entity_Id :=
                Make_Defining_Identifier (Sloc_Value,
                  Chars => New_Internal_Name (Id_Char));
 
       begin
-         Set_Ekind          (N, Kind);
-         Set_Is_Internal    (N, True);
+         Set_Ekind       (E, Kind);
+         Set_Is_Internal (E, True);
 
          if Kind in Type_Kind then
-            Init_Size_Align (N);
+            Init_Size_Align (E);
          end if;
 
-         return N;
+         Append_Entity (E, Lim_Header);
+         Last_Lim_E := E;
+         return E;
       end New_Internal_Shadow_Entity;
 
       -----------------
       -- Build_Chain --
       -----------------
 
-      --  Could use more comments below ???
-
-      procedure Build_Chain (Spec : Node_Id; Scope : Entity_Id) is
+      procedure Build_Chain
+        (Scope         : Entity_Id;
+         First_Decl    : Node_Id)
+      is
          Analyzed_Unit : constant Boolean := Analyzed (Cunit (Unum));
          Is_Tagged     : Boolean;
          Decl          : Node_Id;
 
       begin
-         Decl := First (Visible_Declarations (Spec));
+         Decl := First_Decl;
 
          while Present (Decl) loop
+
+            --  For each library_package_declaration in the environment, there
+            --  is an implicit declaration of a *limited view* of that library
+            --  package. The limited view of a package contains:
+            --
+            --   * For each nested package_declaration, a declaration of the
+            --     limited view of that package, with the same defining-
+            --     program-unit name.
+            --
+            --   * For each type_declaration in the visible part, an incomplete
+            --     type-declaration with the same defining_identifier, whose
+            --     completion is the type_declaration. If the type_declaration
+            --     is tagged, then the incomplete_type_declaration is tagged
+            --     incomplete.
+
             if Nkind (Decl) = N_Full_Type_Declaration then
                Is_Tagged :=
                   Nkind (Type_Definition (Decl)) = N_Record_Definition
@@ -3797,7 +3858,7 @@ package body Sem_Ch10 is
 
                --  Create shadow entity for type
 
-               Lim_Typ  := New_Internal_Shadow_Entity
+               Lim_Typ := New_Internal_Shadow_Entity
                  (Kind       => Ekind (Comp_Typ),
                   Sloc_Value => Sloc (Comp_Typ),
                   Id_Char    => 'Z');
@@ -3813,7 +3874,6 @@ package body Sem_Ch10 is
                end if;
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
-               Append_Elmt (Lim_Typ,  To => Limited_Views (P));
 
             elsif Nkind (Decl) = N_Private_Type_Declaration
               and then Tagged_Present (Decl)
@@ -3836,7 +3896,6 @@ package body Sem_Ch10 is
                Decorate_Tagged_Type (Sloc (Decl), Lim_Typ, Scope);
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
-               Append_Elmt (Lim_Typ,  To => Limited_Views (P));
 
             elsif Nkind (Decl) = N_Package_Declaration then
 
@@ -3868,9 +3927,9 @@ package body Sem_Ch10 is
                   --  Note: The non_limited_view attribute is not used
                   --  for local packages.
 
-                  Append_Elmt (Lim_Typ,  To => Limited_Views (P));
-
-                  Build_Chain (Spec, Scope => Lim_Typ);
+                  Build_Chain
+                    (Scope      => Lim_Typ,
+                     First_Decl => First (Visible_Declarations (Spec)));
                end;
             end if;
 
@@ -3931,12 +3990,41 @@ package body Sem_Ch10 is
       end if;
 
       Set_Ekind (P, E_Package);
-      Set_Limited_Views     (P, New_Elmt_List);
-      --  Set_Entity (Name (N), P);
 
-      --  Create the auxiliary chain
+      --  Build the header of the limited_view
+
+      Lim_Header := Make_Defining_Identifier (Sloc (N),
+                      Chars => New_Internal_Name (Id_Char => 'Z'));
+      Set_Ekind (Lim_Header, E_Package);
+      Set_Is_Internal (Lim_Header);
+      Set_Limited_View (P, Lim_Header);
+
+      --  Create the auxiliary chain. All the shadow entities are appended
+      --  to the list of entities of the limited-view header
+
+      Build_Chain
+        (Scope      => P,
+         First_Decl => First (Visible_Declarations (Spec)));
+
+      --  Save the last built shadow entity. It is needed later to set the
+      --  reference to the first shadow entity in the private part
+
+      Last_Pub_Lim_E := Last_Lim_E;
+
+      --  Ada 0Y (AI-262): Add the limited view of the private declarations
+      --  Required to give support to limited-private-with clauses
+
+      Build_Chain (Scope      => P,
+                   First_Decl => First (Private_Declarations (Spec)));
+
+      if Last_Pub_Lim_E /= Empty then
+         Set_First_Private_Entity (Lim_Header,
+                                   Next_Entity (Last_Pub_Lim_E));
+      else
+         Set_First_Private_Entity (Lim_Header,
+                                   First_Entity (P));
+      end if;
 
-      Build_Chain (Spec, Scope => P);
       Set_Limited_View_Installed (Spec);
    end Build_Limited_Views;
 
@@ -4065,7 +4153,7 @@ package body Sem_Ch10 is
       Unit_Name : Entity_Id;
 
    begin
-      --  Ada0Y (AI-50217): We remove the context clauses in two phases:
+      --  Ada 0Y (AI-50217): We remove the context clauses in two phases:
       --  limited-views first and regular-views later (to maintain the
       --  stack model).
 
@@ -4082,7 +4170,6 @@ package body Sem_Ch10 is
            and then Limited_View_Installed (Item)
          then
             Remove_Limited_With_Clause (Item);
-
          end if;
 
          Next (Item);
@@ -4131,10 +4218,9 @@ package body Sem_Ch10 is
    --------------------------------
 
    procedure Remove_Limited_With_Clause (N : Node_Id) is
-      P_Unit    : constant Entity_Id := Unit (Library_Unit (N));
-      P         : Entity_Id := Defining_Unit_Name (Specification (P_Unit));
-      Lim_Elmt  : Elmt_Id;
-      Lim_Typ   : Entity_Id;
+      P_Unit     : constant Entity_Id := Unit (Library_Unit (N));
+      P          : Entity_Id := Defining_Unit_Name (Specification (P_Unit));
+      Lim_Typ    : Entity_Id;
 
    begin
       if Nkind (P) = N_Defining_Program_Unit_Name then
@@ -4151,15 +4237,15 @@ package body Sem_Ch10 is
          Write_Eol;
       end if;
 
-      --  Remove all shadow entities from visibility
-
-      Lim_Elmt  := First_Elmt (Limited_Views (P));
+      --  Remove all shadow entities from visibility. The first element of the
+      --  limited view is a header (an E_Package entity) that is used to
+      --  reference the first shadow entity in the private part of the package
 
-      while Present (Lim_Elmt) loop
-         Lim_Typ  := Node (Lim_Elmt);
+      Lim_Typ    := First_Entity (Limited_View (P));
 
+      while Present (Lim_Typ) loop
          Unchain (Lim_Typ);
-         Next_Elmt (Lim_Elmt);
+         Next_Entity (Lim_Typ);
       end loop;
 
       --  Indicate that the limited view of the package is not installed
@@ -4205,7 +4291,6 @@ package body Sem_Ch10 is
                      Write_Name (Chars (Ent));
                      Write_Eol;
                   end if;
-
                end if;
 
                Next_Entity (Ent);
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 88480d8..109c05b 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2980,7 +2980,7 @@ package body Sem_Ch3 is
          --  types the level of accessibility depends on the enclosing type
          --  declaration
 
-         Set_Scope (Element_Type, T); --  Ada 0Y (AI-230)
+         Set_Scope (Element_Type, Current_Scope); --  Ada 0Y (AI-230)
 
          --  Ada 0Y (AI-254)
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 41d2388..69cc4d0 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -796,6 +796,7 @@ package body Sem_Ch6 is
 
       procedure Check_Following_Pragma is
          Prag : Node_Id;
+
       begin
          if Front_End_Inlining
            and then Is_List_Member (N)
@@ -817,6 +818,8 @@ package body Sem_Ch6 is
          end if;
       end Check_Following_Pragma;
 
+   --  Start of processing for Analyze_Subprogram_Body
+
    begin
       if Debug_Flag_C then
          Write_Str ("====  Compiling subprogram body ");
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 518179d..2ec768d 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -696,8 +696,10 @@ package body Sem_Ch8 is
 
          Analyze_And_Resolve (Nam, T);
 
-         --  Ada 0Y (AI-230): Renaming of anonymous access-to-constant types
-         --  allowed if and only if the renamed object is access-to-constant
+         --  Ada 0Y (AI-231): "In the case where the type is defined by an
+         --  access_definition, the renamed entity shall be of an access-to-
+         --  constant type if and only if the access_definition defines an
+         --  access-to-constant type" ARM 8.5.1(4)
 
          if Constant_Present (Access_Definition (N))
            and then not Is_Access_Constant (Etype (Nam))
@@ -3525,7 +3527,8 @@ package body Sem_Ch8 is
         and then From_With_Type (P_Name)
       then
          if From_With_Type (Id)
-           or else (Ekind (Id) = E_Package and then From_With_Type (Id))
+           or else Is_Type (Id)
+           or else Ekind (Id) = E_Package
          then
             null;
          else
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index afbb680..d3ee90e 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -3257,7 +3257,8 @@ package body Sem_Prag is
          Val   : Uint;
 
          procedure Set_Warning (R : All_Restrictions);
-         --  If this is a Restriction_Warnings pragma, set warning flag
+         --  If this is a Restriction_Warnings pragma, set warning flag,
+         --  otherwise flag gets cleared.
 
          -----------------
          -- Set_Warning --
@@ -3265,9 +3266,8 @@ package body Sem_Prag is
 
          procedure Set_Warning (R : All_Restrictions) is
          begin
-            if Prag_Id = Pragma_Restriction_Warnings then
-               Restriction_Warnings (R) := True;
-            end if;
+            Restriction_Warnings (R) :=
+              Prag_Id = Pragma_Restriction_Warnings;
          end Set_Warning;
 
       --  Start of processing for Process_Restrictions_Or_Restriction_Warnings
diff --git a/gcc/ada/trans.c b/gcc/ada/trans.c
index c928612..b32d4a6 100644
--- a/gcc/ada/trans.c
+++ b/gcc/ada/trans.c
@@ -273,7 +273,7 @@ gnat_to_gnu (Node_Id gnat_node)
 {
   tree gnu_root;
   bool made_sequence = false;
-    
+
   /* We support the use of this on statements now as a transition
      to full function-at-a-time processing.  So we need to see if anything
      we do generates RTL and returns error_mark_node.  */
@@ -517,14 +517,32 @@ tree_transform (Node_Id gnat_node)
 		  && DECL_BY_COMPONENT_PTR_P (gnu_result))))
 	{
 	  int ro = DECL_POINTS_TO_READONLY_P (gnu_result);
+	  tree initial;
 
 	  if (TREE_CODE (gnu_result) == PARM_DECL
 	      && DECL_BY_COMPONENT_PTR_P (gnu_result))
 	    gnu_result = convert (build_pointer_type (gnu_result_type),
 				  gnu_result);
 
-	  gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
-				       fold (gnu_result));
+	  /* If the object is constant, we try to do the dereference directly
+	     through the DECL_INITIAL.  This is actually required in order to
+	     get correct aliasing information for renamed objects that are
+	     components of non-aliased aggregates, because the type of
+	     the renamed object and that of the aggregate don't alias.  */
+	  if (TREE_READONLY (gnu_result)
+	      && DECL_INITIAL (gnu_result)
+	      /* Strip possible conversion to reference type.  */
+	      && (initial = TREE_CODE (DECL_INITIAL (gnu_result)) == NOP_EXPR
+			    ? TREE_OPERAND (DECL_INITIAL (gnu_result), 0)
+			    : DECL_INITIAL (gnu_result), 1)
+	      && TREE_CODE (initial) == ADDR_EXPR
+	      && (TREE_CODE (TREE_OPERAND (initial, 0)) == ARRAY_REF
+		  || TREE_CODE (TREE_OPERAND (initial, 0)) == COMPONENT_REF))
+	    gnu_result = TREE_OPERAND (initial, 0);
+	  else
+	    gnu_result = build_unary_op (INDIRECT_REF, NULL_TREE,
+				 	 fold (gnu_result));
+
 	  TREE_READONLY (gnu_result) = TREE_STATIC (gnu_result) = ro;
 	}
 
@@ -4373,7 +4391,7 @@ end_block_stmt ()
 
   return gnu_retval;
 }
-   
+
 /* Build a BLOCK_STMT from GNAT_LIST, a possibly-empty list of statements.  */
 
 static tree
@@ -4394,7 +4412,7 @@ build_block_stmt (List_Id gnat_list)
 
   gnu_result = end_block_stmt ();
   return TREE_CODE (gnu_result) == NULL_STMT ? NULL_TREE : gnu_result;
-} 
+}
 
 /* Build an EXPR_STMT to evaluate INSNS.  Use Sloc from GNAT_NODE.   */
 
@@ -4523,7 +4541,7 @@ gnat_expand_stmt (tree gnu_stmt)
 	  }
       break;
 
-    default: 
+    default:
      abort ();
     }
 }