[multiple changes]

2012-11-06  Tristan Gingold  <gingold@adacore.com>

	* fe.h (Get_Vax_Real_Literal_As_Signed): Declare.
	* eval_fat.adb, eval_fat.ads (Decompose_Int): Move spec in package spec.
	* exp_vfpt.adb, exp_vfpt.ads (Vax_Real_Literal_As_Signed): New function.
	(Expand_Vax_Real_Literal): Remove.
	* exp_ch2.adb (Expand_N_Real_Literal): Do nothing.
	* sem_eval.adb (Expr_Value_R): Remove special Vax float case,
	as this is not anymore a special case.

2012-11-06  Yannick Moy  <moy@adacore.com>

	* uintp.ads: Minor correction of typo in comment.

2012-11-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove
	requirement that discriminants of an unchecked_union must have
	defaults.

2012-11-06  Vasiliy Fofanov  <fofanov@adacore.com>

	* projects.texi: Minor wordsmithing.

From-SVN: r193224

11 files changed, 141 insertions, 129 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 9216213..a08aa14 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+2012-11-06  Tristan Gingold  <gingold@adacore.com>
+
+	* fe.h (Get_Vax_Real_Literal_As_Signed): Declare.
+	* eval_fat.adb, eval_fat.ads (Decompose_Int): Move spec in package spec.
+	* exp_vfpt.adb, exp_vfpt.ads (Vax_Real_Literal_As_Signed): New function.
+	(Expand_Vax_Real_Literal): Remove.
+	* exp_ch2.adb (Expand_N_Real_Literal): Do nothing.
+	* sem_eval.adb (Expr_Value_R): Remove special Vax float case,
+	as this is not anymore a special case.
+
+2012-11-06  Yannick Moy  <moy@adacore.com>
+
+	* uintp.ads: Minor correction of typo in comment.
+
+2012-11-06  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_prag.adb (Analyze_Pragnma, case Unchecked_Union): remove
+	requirement that discriminants of an unchecked_union must have
+	defaults.
+
+2012-11-06  Vasiliy Fofanov  <fofanov@adacore.com>
+
+	* projects.texi: Minor wordsmithing.
+
 2012-11-06  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch9.adb, exp_vfpt.adb, xoscons.adb: Minor reformatting.
diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb
index bbcb886..5ff748d 100644
--- a/gcc/ada/eval_fat.adb
+++ b/gcc/ada/eval_fat.adb
@@ -57,20 +57,6 @@ package body Eval_Fat is
    --  parts. The fraction is in the interval 1.0 / Radix .. T'Pred (1.0) and
    --  uses Rbase = Radix. The result is rounded to a nearest machine number.
 
-   procedure Decompose_Int
-     (RT       : R;
-      X        : T;
-      Fraction : out UI;
-      Exponent : out UI;
-      Mode     : Rounding_Mode);
-   --  This is similar to Decompose, except that the Fraction value returned
-   --  is an integer representing the value Fraction * Scale, where Scale is
-   --  the value (Machine_Radix_Value (RT) ** Machine_Mantissa_Value (RT)). The
-   --  value is obtained by using biased rounding (halfway cases round away
-   --  from zero), round to even, a floor operation or a ceiling operation
-   --  depending on the setting of Mode (see corresponding descriptions in
-   --  Urealp).
-
    --------------
    -- Adjacent --
    --------------
diff --git a/gcc/ada/eval_fat.ads b/gcc/ada/eval_fat.ads
index 964dd22..4ef153c 100644
--- a/gcc/ada/eval_fat.ads
+++ b/gcc/ada/eval_fat.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -99,4 +99,18 @@ package Eval_Fat is
       Mode  : Rounding_Mode;
       Enode : Node_Id) return T;
 
+   procedure Decompose_Int
+     (RT       : R;
+      X        : T;
+      Fraction : out UI;
+      Exponent : out UI;
+      Mode     : Rounding_Mode);
+   --  Decomposes a floating-point number into fraction and exponent parts.
+   --  The Fraction value returned is an integer representing the value
+   --  Fraction * Scale, where Scale is the value (Machine_Radix_Value (RT) **
+   --  Machine_Mantissa_Value (RT)). The value is obtained by using biased
+   --  rounding (halfway cases round away from zero), round to even, a floor
+   --  operation or a ceiling operation depending on the setting of Mode (see
+   --  corresponding descriptions in Urealp).
+
 end Eval_Fat;
diff --git a/gcc/ada/exp_ch2.adb b/gcc/ada/exp_ch2.adb
index 37a5bda..bbd23ba 100644
--- a/gcc/ada/exp_ch2.adb
+++ b/gcc/ada/exp_ch2.adb
@@ -32,7 +32,6 @@ with Errout;   use Errout;
 with Exp_Smem; use Exp_Smem;
 with Exp_Tss;  use Exp_Tss;
 with Exp_Util; use Exp_Util;
-with Exp_VFpt; use Exp_VFpt;
 with Namet;    use Namet;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -637,9 +636,8 @@ package body Exp_Ch2 is
 
    procedure Expand_N_Real_Literal (N : Node_Id) is
    begin
-      if Vax_Float (Etype (N)) then
-         Expand_Vax_Real_Literal (N);
-      end if;
+      --  Vax real literal are now allowed by gigi
+      null;
    end Expand_N_Real_Literal;
 
    --------------------------------
diff --git a/gcc/ada/exp_vfpt.adb b/gcc/ada/exp_vfpt.adb
index 1539ea9..af4c3ef 100644
--- a/gcc/ada/exp_vfpt.adb
+++ b/gcc/ada/exp_vfpt.adb
@@ -32,8 +32,8 @@ with Sem_Res;  use Sem_Res;
 with Sinfo;    use Sinfo;
 with Stand;    use Stand;
 with Tbuild;   use Tbuild;
-with Uintp;    use Uintp;
 with Urealp;   use Urealp;
+with Eval_Fat; use Eval_Fat;
 
 package body Exp_VFpt is
 
@@ -76,9 +76,13 @@ package body Exp_VFpt is
    --  +--------------------------------+
    --  |             fraction           |  A + 4
    --  +--------------------------------+
-   --  |             fraction           |  A + 6
+   --  |             fraction (low)     |  A + 6
    --  +--------------------------------+
 
+   --  Note that the fraction bits are not continuous in memory. Bytes in a
+   --  words are stored using little endianness, but words are stored using
+   --  big endianness (PDP endian)
+
    --  Like Float F but with 55 bits for the fraction.
 
    --  Float G:
@@ -93,10 +97,10 @@ package body Exp_VFpt is
    --  +--------------------------------+
    --  |             fraction           |  A + 4
    --  +--------------------------------+
-   --  |             fraction           |  A + 6
+   --  |             fraction (low)     |  A + 6
    --  +--------------------------------+
 
-   --  Exponent values of 1 through 2047 indicate trye binary exponents of
+   --  Exponent values of 1 through 2047 indicate true binary exponents of
    --  -1023 to +1023.
 
    --  Main differences compared to IEEE 754:
@@ -553,93 +557,101 @@ package body Exp_VFpt is
       Analyze_And_Resolve (N, Typ, Suppress => All_Checks);
    end Expand_Vax_Foreign_Return;
 
-   -----------------------------
-   -- Expand_Vax_Real_Literal --
-   -----------------------------
+   --------------------------------
+   -- Vax_Real_Literal_As_Signed --
+   --------------------------------
 
-   procedure Expand_Vax_Real_Literal (N : Node_Id) is
-      Loc  : constant Source_Ptr := Sloc (N);
-      Typ  : constant Entity_Id  := Etype (N);
-      Btyp : constant Entity_Id  := Base_Type (Typ);
-      Stat : constant Boolean    := Is_Static_Expression (N);
-      Nod  : Node_Id;
+   function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint is
+      Btyp     : constant Entity_Id :=
+                   Base_Type (Underlying_Type (Etype (N)));
+
+      Value    : constant Ureal := Realval (N);
+      Negative : Boolean;
+      Fraction : UI;
+      Exponent : UI;
+      Res      : UI;
+
+      Exponent_Size : Uint;
+      --  Number of bits for the exponent
 
-      RE_Source : RE_Id;
-      RE_Target : RE_Id;
-      RE_Fncall : RE_Id;
-      --  Entities for source, target and function call in conversion
+      Fraction_Size : Uint;
+      --  Number of bits for the fraction
 
+      Uintp_Mark : constant Uintp.Save_Mark := Mark;
+      --  Use the mark & release feature to delete temporaries
    begin
-      --  We do not know how to convert Vax format real literals, so what
-      --  we do is to convert these to be IEEE literals, and introduce the
-      --  necessary conversion operation.
+      --  Extract the sign now
 
-      if Vax_Float (Btyp) then
-         --  What we want to construct here is
+      Negative := UR_Is_Negative (Value);
 
-         --    x!(y_to_z (1.0E0))
+      --  Decompose the number
 
-         --  where
+      Decompose_Int (Btyp, abs Value, Fraction, Exponent, Round_Even);
 
-         --    x is the base type of the literal (Btyp)
+      --  Number of bits for the fraction, leading fraction bit is implicit
 
-         --    y_to_z is
+      Fraction_Size := Machine_Mantissa_Value (Btyp) - Int'(1);
 
-         --      s_to_f for F_Float
-         --      t_to_g for G_Float
-         --      t_to_d for D_Float
+      --  Number of bits for the exponent (one bit for the sign)
 
-         --  The literal is typed as S (for F_Float) or T otherwise
+      Exponent_Size := RM_Size (Btyp) - Fraction_Size - Int'(1);
 
-         --  We do all our own construction, analysis, and expansion here,
-         --  since things are at too low a level to use Analyze or Expand
-         --  to get this built (we get circularities and other strange
-         --  problems if we try!)
+      if Fraction = Uint_0 then
+         --  Handle zero
 
-         if Digits_Value (Btyp) = VAXFF_Digits then
-            RE_Source := RE_S;
-            RE_Target := RE_F;
-            RE_Fncall := RE_S_To_F;
+         Res := Uint_0;
 
-         elsif Digits_Value (Btyp) = VAXDF_Digits then
-            RE_Source := RE_T;
-            RE_Target := RE_D;
-            RE_Fncall := RE_T_To_D;
+      elsif Exponent <= -(Uint_2 ** (Exponent_Size - 1)) then
+         --  Underflow
 
-         else pragma Assert (Digits_Value (Btyp) = VAXGF_Digits);
-            RE_Source := RE_T;
-            RE_Target := RE_G;
-            RE_Fncall := RE_T_To_G;
-         end if;
+         Res := Uint_0;
+      else
+         --  Check for overflow
 
-         Nod := Relocate_Node (N);
+         pragma Assert (Exponent < Uint_2 ** (Exponent_Size - 1));
 
-         Set_Etype (Nod, RTE (RE_Source));
-         Set_Analyzed (Nod, True);
+         --  MSB of the fraction must be 1
 
-         Nod :=
-           Make_Function_Call (Loc,
-             Name => New_Occurrence_Of (RTE (RE_Fncall), Loc),
-             Parameter_Associations => New_List (Nod));
+         pragma Assert (Fraction / Uint_2 ** Fraction_Size = Uint_1);
 
-         Set_Etype (Nod, RTE (RE_Target));
-         Set_Analyzed (Nod, True);
+         --  Remove the redudant most significant fraction bit
 
-         Nod :=
-           Make_Unchecked_Type_Conversion (Loc,
-             Subtype_Mark => New_Occurrence_Of (Typ, Loc),
-             Expression   => Nod);
+         Fraction := Fraction - Uint_2 ** Fraction_Size;
 
-         Set_Etype (Nod, Typ);
-         Set_Analyzed (Nod, True);
-         Rewrite (N, Nod);
+         --  Build the fraction part. Note that this field is in mixed
+         --  endianness: words are stored using little endianness, while bytes
+         --  in words are stored using big endianness.
 
-         --  This odd expression is still a static expression. Note that
-         --  the routine Sem_Eval.Expr_Value_R understands this.
+         Res := Uint_0;
+         for I in 1 .. UI_To_Int (RM_Size (Btyp)) / 16 loop
+            Res := (Res * (Uint_2 ** 16)) + (Fraction mod (Uint_2 ** 16));
+            Fraction := Fraction / (Uint_2 ** 16);
+         end loop;
 
-         Set_Is_Static_Expression (N, Stat);
+         --  The sign bit
+
+         if Negative then
+            Res := Res + Int (2**15);
+         end if;
+
+         --  The exponent
+
+         Res := Res + (Exponent + Uint_2 ** (Exponent_Size - 1))
+           * Uint_2 ** (15 - Exponent_Size);
+
+         --  Until now, we have created an unsigned number, but an underlying
+         --  type is a signed type. Convert to a signed number to avoid
+         --  overflow in gigi.
+
+         if Res >= Uint_2 ** (Exponent_Size + Fraction_Size) then
+            Res := Res - Uint_2 ** (Exponent_Size + Fraction_Size + 1);
+         end if;
       end if;
-   end Expand_Vax_Real_Literal;
+
+      Release_And_Save (Uintp_Mark, Res);
+
+      return Res;
+   end Get_Vax_Real_Literal_As_Signed;
 
    ----------------------
    -- Expand_Vax_Valid --
diff --git a/gcc/ada/exp_vfpt.ads b/gcc/ada/exp_vfpt.ads
index fdca701..52aaf7d 100644
--- a/gcc/ada/exp_vfpt.ads
+++ b/gcc/ada/exp_vfpt.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -28,6 +28,7 @@
 --  point formats as used on the Vax and the Alpha and the ia64.
 
 with Types; use Types;
+with Uintp; use Uintp;
 
 package Exp_VFpt is
 
@@ -51,10 +52,12 @@ package Exp_VFpt is
    --  that moves the return value to an integer location on Alpha/VMS,
    --  noop everywhere else.
 
-   procedure Expand_Vax_Real_Literal (N : Node_Id);
-   --  The node N is a real literal node where the type is a Vax floating-point
-   --  type. This procedure rewrites the node to eliminate the occurrence of
-   --  such constants.
+   function Get_Vax_Real_Literal_As_Signed (N : Node_Id) return Uint;
+   --  Get the Vax binary representation of a real literal whose type is a Vax
+   --  floating-point type. This is used by gigi. Previously we expanded
+   --  real literal to a call to a LIB$OTS routine that performed the
+   --  conversion. This worked well, but was not efficient and generated huge
+   --  functions for aggregate initialization.
 
    procedure Expand_Vax_Valid (N : Node_Id);
    --  The node N is an attribute reference node for the Valid attribute where
diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h
index 9f5d64f..f8d399c 100644
--- a/gcc/ada/fe.h
+++ b/gcc/ada/fe.h
@@ -156,6 +156,11 @@ extern void Get_External_Name_With_Suffix	(Entity_Id, Fat_Pointer);
 
 extern Boolean Is_Fully_Repped_Tagged_Type      (Entity_Id);
 
+/* exp_vfpt: */
+
+#define Get_Vax_Real_Literal_As_Signed exp_vfpt__get_vax_real_literal_as_signed
+extern Ureal Get_Vax_Real_Literal_As_Signed (Node_Id);
+
 /* lib: */
 
 #define Cunit 				lib__cunit
diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi
index ed42094..79ac662 100644
--- a/gcc/ada/projects.texi
+++ b/gcc/ada/projects.texi
@@ -1036,10 +1036,10 @@ names in lower case)
 
 @noindent
 After building an application or a library it is often required to
-install it into the development environment. This installation is
-required if the library is to be used by another application for
-example. The @command{gprinstall} tool provide an easy way to install
-libraries, executable or object code generated durting the build. The
+install it into the development environment. For instance this step is
+required if the library is to be used by another application.
+The @command{gprinstall} tool provides an easy way to install
+libraries, executable or object code generated during the build. The
 @b{Install} package can be used to change the default locations.
 
 The following attributes can be defined in package @code{Install}:
@@ -1073,7 +1073,7 @@ installed. Default is @b{include}.
 
 @item @b{Project_Subdir}
 
-Subdirectory of @b{Prefix} where the installed project is to be
+Subdirectory of @b{Prefix} where the generated project file is to be
 installed. Default is @b{share/gpr}.
 @end table
 
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 4217463..3434854 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -3862,7 +3862,6 @@ package body Sem_Eval is
    function Expr_Value_R (N : Node_Id) return Ureal is
       Kind : constant Node_Kind := Nkind (N);
       Ent  : Entity_Id;
-      Expr : Node_Id;
 
    begin
       if Kind = N_Real_Literal then
@@ -3876,25 +3875,6 @@ package body Sem_Eval is
       elsif Kind = N_Integer_Literal then
          return UR_From_Uint (Expr_Value (N));
 
-      --  Strange case of VAX literals, which are at this stage transformed
-      --  into Vax_Type!x_To_y(IEEE_Literal). See Expand_N_Real_Literal in
-      --  Exp_Vfpt for further details.
-
-      elsif Vax_Float (Etype (N))
-        and then Nkind (N) = N_Unchecked_Type_Conversion
-      then
-         Expr := Expression (N);
-
-         if Nkind (Expr) = N_Function_Call
-           and then Present (Parameter_Associations (Expr))
-         then
-            Expr := First (Parameter_Associations (Expr));
-
-            if Nkind (Expr) = N_Real_Literal then
-               return Realval (Expr);
-            end if;
-         end if;
-
       --  Peculiar VMS case, if we have xxx'Null_Parameter, return 0.0
 
       elsif Kind = N_Attribute_Reference
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index c3f27e1..f7f56f0 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -14495,7 +14495,6 @@ package body Sem_Prag is
             Assoc   : constant Node_Id := Arg1;
             Type_Id : constant Node_Id := Get_Pragma_Arg (Assoc);
             Typ     : Entity_Id;
-            Discr   : Entity_Id;
             Tdef    : Node_Id;
             Clist   : Node_Id;
             Vpart   : Node_Id;
@@ -14546,21 +14545,12 @@ package body Sem_Prag is
             --  Note: in previous versions of GNAT we used to check for limited
             --  types and give an error, but in fact the standard does allow
             --  Unchecked_Union on limited types, so this check was removed.
+            --  Similarly, GNAT used to require that all discriminants have
+            --  default values, but this is not mandated by the RM.
 
             --  Proceed with basic error checks completed
 
             else
-               Discr := First_Discriminant (Typ);
-               while Present (Discr) loop
-                  if No (Discriminant_Default_Value (Discr)) then
-                     Error_Msg_N
-                       ("unchecked union discriminant must have default value",
-                        Discr);
-                  end if;
-
-                  Next_Discriminant (Discr);
-               end loop;
-
                Tdef  := Type_Definition (Declaration_Node (Typ));
                Clist := Component_List (Tdef);
 
diff --git a/gcc/ada/uintp.ads b/gcc/ada/uintp.ads
index b730f44..dcf85a0 100644
--- a/gcc/ada/uintp.ads
+++ b/gcc/ada/uintp.ads
@@ -407,7 +407,7 @@ private
 
    Base : constant Int := 2 ** Base_Bits;
 
-   --  Values in the range -(Base+1) .. Max_Direct are encoded directly as
+   --  Values in the range -(Base-1) .. Max_Direct are encoded directly as
    --  Uint values by adding a bias value. The value of Max_Direct is chosen
    --  so that a directly represented number always fits in two digits when
    --  represented in base format.