[multiple changes]

2009-04-20  Arnaud Charlet  <charlet@adacore.com>

	* switch-c.adb (Scan_Front_End_Switches): Disable inspector mode in
	ASIS mode.

2009-04-20  Geert Bosch  <bosch@adacore.com>

	* a-tifiio.adb (Put): Avoid generating too many digits for certain
	fixed types with smalls that are neither integer or the reciprocal
	of an integer.

2009-04-20  Bob Duff  <duff@adacore.com>

	* uname.ads: Minor comment fix.

	* types.ads: Minor comment fix.

From-SVN: r146382

5 files changed, 126 insertions, 63 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 68478df..204592b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,20 @@
+2009-04-20  Arnaud Charlet  <charlet@adacore.com>
+
+	* switch-c.adb (Scan_Front_End_Switches): Disable inspector mode in
+	ASIS mode.
+
+2009-04-20  Geert Bosch  <bosch@adacore.com>
+
+	* a-tifiio.adb (Put): Avoid generating too many digits for certain
+	fixed types with smalls that are neither integer or the reciprocal
+	of an integer.
+
+2009-04-20  Bob Duff  <duff@adacore.com>
+
+	* uname.ads: Minor comment fix.
+
+	* types.ads: Minor comment fix.
+
 2009-04-20  Pascal Obry  <obry@adacore.com>
 
 	* adaint.c (__gnat_get_libraries_from_registry): Fix code to
diff --git a/gcc/ada/a-tifiio.adb b/gcc/ada/a-tifiio.adb
index 8d2dddd..22926f8 100644
--- a/gcc/ada/a-tifiio.adb
+++ b/gcc/ada/a-tifiio.adb
@@ -296,8 +296,6 @@ package body Ada.Text_IO.Fixed_IO is
    --  True iff a numerator and denominator can be calculated such that
    --  their ratio exactly represents the small of Num
 
-   --  Local Subprograms
-
    procedure Put
      (To   : out String;
       Last : out Natural;
@@ -423,14 +421,6 @@ package body Ada.Text_IO.Fixed_IO is
       Neg : constant Boolean := (Item < 0.0);
       Pos : Integer := 0;  -- Next digit X has value X * 10.0**Pos;
 
-      Y, Z : Int64;
-      E : constant Integer := Boolean'Pos (not Exact)
-                                *  (Max_Digits - 1 + Scale);
-      D : constant Integer := Boolean'Pos (Exact)
-                                * Integer'Min (A, Max_Digits - (Num'Fore - 1))
-                            + Boolean'Pos (not Exact)
-                                * (Scale - 1);
-
       procedure Put_Character (C : Character);
       pragma Inline (Put_Character);
       --  Add C to the output string To, updating Last
@@ -442,7 +432,7 @@ package body Ada.Text_IO.Fixed_IO is
       --  digit, Pos must not be changed outside Put_Digit anymore
 
       procedure Put_Int64 (X : Int64; Scale : Integer);
-      --  Output the decimal number X * 10**Scale
+      --  Output the decimal number abs X * 10**Scale.
 
       procedure Put_Scaled
         (X, Y, Z : Int64;
@@ -548,7 +538,10 @@ package body Ada.Text_IO.Fixed_IO is
             Put_Digit (0);
          end loop;
 
-         --  If Pos is less than Scale now, reset to equal Scale
+         --  If and only if more than one digit is output before the decimal
+         --  point, pos will be unequal to scale when outputting the first
+         --  digit.
+         pragma Assert (Pos = Scale or else Last = To'First - 1);
 
          Pos := Scale;
 
@@ -564,60 +557,87 @@ package body Ada.Text_IO.Fixed_IO is
          A       : Field;
          E       : Integer)
       is
-         N  : constant Natural := (A + Max_Digits - 1) / Max_Digits + 1;
-         Q  : array (1 .. N) of Int64 := (others => 0);
-
-         XX : Int64 := X;
-         YY : Int64 := Y;
-         AA : Field := A;
+         pragma Assert (E >= -Max_Digits);
+         AA : constant Field := E + A;
+         N  : constant Natural := (AA + Max_Digits - 1) / Max_Digits + 1;
+         Q  : array (0 .. N - 1) of Int64 := (others => 0);
+         --  Each element of Q has Max_Digits decimal digits, except
+         --  the last, which has eAA rem Max_Digits. Only Q (Q'First)
+         --  may have an absolute value equal to or larger than 10**Max_Digits.
+         --  Only the absolute value of the elements is not significant, not
+         --  the sign.
+
+         XX    : Int64 := X;
+         YY    : Int64 := Y;
 
       begin
          for J in Q'Range loop
             exit when XX = 0;
 
-            Scaled_Divide (XX, YY, Z, Q (J), XX, Round => AA = 0);
+            if J > 0 then
+               YY := 10**(Integer'Min (Max_Digits, AA - (J - 1) * Max_Digits));
+            end if;
 
-            --  As the last block of digits is rounded, a carry may have to
-            --  be propagated to the more significant digits. Since the last
-            --  block may have less than Max_Digits, the test for this block
-            --  is specialized.
+            Scaled_Divide (XX, YY, Z, Q (J), R => XX, Round => False);
+         end loop;
 
-            --  The absolute value of the left-most digit block may equal
-            --  10*Max_Digits, as no carry can be propagated from there.
-            --  The final output routines need to be prepared to handle
-            --  this specific case.
+         if -E > A then
+            pragma Assert (N = 1);
 
-            if (Q (J) = YY or -Q (J) = YY) and then J > Q'First then
-               if Q (J) < 0 then
-                  Q (J - 1) := Q (J - 1) + 1;
+            Discard_Extra_Digits :
+            declare
+               Factor : constant Int64 := 10**(-E - A);
+            begin
+               --  The scaling factors were such that the first division
+               --  produced more digits than requested. So divide away extra
+               --  digits and compute new remainder for later rounding.
+
+               if abs (Q (0) rem Factor) >= Factor / 2 then
+                  Q (0) := abs (Q (0) / Factor) + 1;
                else
-                  Q (J - 1) := Q (J - 1) - 1;
+                  Q (0) := Q (0) / Factor;
                end if;
 
-               Q (J) := 0;
+               XX := 0;
+            end Discard_Extra_Digits;
+         end if;
 
-               Propagate_Carry :
-               for J in reverse Q'First + 1 .. Q'Last loop
-                  if Q (J) >= 10**Max_Digits then
-                     Q (J - 1) := Q (J - 1) + 1;
-                     Q (J) := Q (J) - 10**Max_Digits;
+         --  At this point XX is a remainder and we need to determine if
+         --  the quotient in Q must be rounded away from zero.
+         --  As XX is less than the divisor, it is safe to take its absolute
+         --  without chance of overflow. The check to see if XX is at least
+         --  half the absolute value of the divisor must be done carefully to
+         --  avoid overflow or lose precision.
 
-                  elsif Q (J) <= -10**Max_Digits then
-                     Q (J - 1) := Q (J - 1) - 1;
-                     Q (J) := Q (J) + 10**Max_Digits;
-                  end if;
-               end loop Propagate_Carry;
-            end if;
+         XX := abs XX;
 
-            YY := -10**Integer'Min (Max_Digits, AA);
-            AA := AA - Integer'Min (Max_Digits, AA);
-         end loop;
+         if XX >= 2**62
+            or else (Z < 0 and then (-XX) * 2 <= Z)
+            or else (Z >= 0 and then XX * 2 >= Z)
+         then
+            --  OK, rounding is necessary. As the sign is not significant,
+            --  take advantage of the fact that an extra negative value will
+            --  always be available when propagating the carry.
+
+            Q (Q'Last) := -abs Q (Q'Last) - 1;
+
+            Propagate_Carry :
+            for J in reverse 1 .. Q'Last loop
+               if Q (J) = YY or else Q (J) = -YY then
+                  Q (J) := 0;
+                  Q (J - 1) := -abs Q (J - 1) - 1;
+
+               else
+                  exit Propagate_Carry;
+               end if;
+            end loop Propagate_Carry;
+         end if;
 
          for J in Q'First .. Q'Last - 1 loop
-            Put_Int64 (Q (J), E - (J - Q'First) * Max_Digits);
+            Put_Int64 (Q (J), E - J * Max_Digits);
          end loop;
 
-         Put_Int64 (Q (Q'Last), E - A);
+         Put_Int64 (Q (Q'Last), -A);
       end Put_Scaled;
 
    --  Start of processing for Put
@@ -652,20 +672,35 @@ package body Ada.Text_IO.Fixed_IO is
       end if;
 
       if Exact then
-         Y := Int64'Min (Int64 (-Num'Small), -1) * 10**Integer'Max (0, D);
-         Z := Int64'Min (Int64 (-(1.0 / Num'Small)), -1)
-                                                 * 10**Integer'Max (0, -D);
-      else
-         Y := Int64 (-(Num'Small * 10.0**E));
-         Z := -10**Max_Digits;
+         declare
+            D : constant Integer := Integer'Min (A, Max_Digits
+                                                            - (Num'Fore - 1));
+            Y : constant Int64   := Int64'Min (Int64 (-Num'Small), -1)
+                                     * 10**Integer'Max (0, D);
+            Z : constant Int64   := Int64'Min (Int64 (-(1.0 / Num'Small)), -1)
+                                     * 10**Integer'Max (0, -D);
+         begin
+            Put_Scaled (X, Y, Z, A, -D);
+         end;
+
+      else -- not Exact
+         declare
+            E : constant Integer := Max_Digits - 1 + Scale;
+            D : constant Integer := Scale - 1;
+            Y : constant Int64   := Int64 (-Num'Small * 10.0**E);
+            Z : constant Int64   := -10**Max_Digits;
+         begin
+            Put_Scaled (X, Y, Z, A, -D);
+         end;
       end if;
 
-      Put_Scaled (X, Y, Z, A - D, -D);
-
       --  If only zero digits encountered, unit digit has not been output yet
 
       if Last < To'First then
          Pos := 0;
+
+      elsif Last > To'Last then
+         raise Layout_Error; -- Not enough room in the output variable
       end if;
 
       --  Always output digits up to the first one after the decimal point
diff --git a/gcc/ada/switch-c.adb b/gcc/ada/switch-c.adb
index 6c79b94..dc85383 100644
--- a/gcc/ada/switch-c.adb
+++ b/gcc/ada/switch-c.adb
@@ -257,12 +257,23 @@ package body Switch.C is
                         Set_Dotted_Debug_Flag (C);
                         Store_Compilation_Switch ("-gnatd." & C);
 
-                        --  Disable front-end inlining in inspector mode
                         --  ??? Change this when we use a non debug flag to
                         --  enable inspector mode.
 
                         if C = 'I' then
-                           Front_End_Inlining := False;
+                           if ASIS_Mode then
+                              --  Do not enable inspector mode in ASIS mode,
+                              --  since the two switches are incompatible.
+
+                              Inspector_Mode := False;
+
+                           else
+                              --  In inspector mode, we need back-end rep info
+                              --  annotations and disable front-end inlining.
+
+                              Back_Annotate_Rep_Info := True;
+                              Front_End_Inlining := False;
+                           end if;
                         end if;
                      else
                         Set_Debug_Flag (C);
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 96b60b5..98bcbdb 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -450,8 +450,8 @@ package Types is
    ------------------------------
 
    --  Element list Id values are used to identify element lists stored in the
-   --  tree (see package Tree for further details). They are formed by adding a
-   --  bias (Element_List_Bias) to subscript values in the same array that is
+   --  tree (see package Atree for further details). They are formed by adding
+   --  a bias (Element_List_Bias) to subscript values in the same array that is
    --  used for node list headers.
 
    type Elist_Id is range Elist_Low_Bound .. Elist_High_Bound;
diff --git a/gcc/ada/uname.ads b/gcc/ada/uname.ads
index 587ac9b..d522040 100644
--- a/gcc/ada/uname.ads
+++ b/gcc/ada/uname.ads
@@ -48,9 +48,9 @@ package Uname is
    --    %b  for package/subprogram/generic bodies and subunits
 
    --  Unit names are stored in the names table, and referred to by the
-   --  corresponding Name_Id values. The subtype Unit_Name, which is a
-   --  synonym for Name_Id, is used to indicate that a Name_Id value that
-   --  holds a unit name (as defined above) is expected.
+   --  corresponding Name_Id values. The type Unit_Name_Type, derived from
+   --  Name_Id, is used to indicate that a Name_Id value that holds a unit name
+   --  (as defined above) is expected.
 
    --  Note: as far as possible the conventions for unit names are encapsulated
    --  in this package. The one exception is that package Fname, which provides