From 68218f7cf3231acd218849e35fc2a481ea9d0bff Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 20 Apr 2009 11:27:50 +0200 Subject: [PATCH] [multiple changes] 2009-04-20 Arnaud Charlet * switch-c.adb (Scan_Front_End_Switches): Disable inspector mode in ASIS mode. 2009-04-20 Geert Bosch * 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 * uname.ads: Minor comment fix. * types.ads: Minor comment fix. From-SVN: r146382 --- gcc/ada/ChangeLog | 17 ++++++ gcc/ada/a-tifiio.adb | 147 +++++++++++++++++++++++++++++++-------------------- gcc/ada/switch-c.adb | 15 +++++- gcc/ada/types.ads | 4 +- gcc/ada/uname.ads | 6 +-- 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 + + * switch-c.adb (Scan_Front_End_Switches): Disable inspector mode in + ASIS mode. + +2009-04-20 Geert Bosch + + * 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 + + * uname.ads: Minor comment fix. + + * types.ads: Minor comment fix. + 2009-04-20 Pascal Obry * 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 -- 2.7.4