From 04cbd48e9ed3fbd4c66f7ebc829276b5b83932a5 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 21 Oct 2010 12:25:12 +0200 Subject: [PATCH] [multiple changes] 2010-10-21 Geert Bosch * urealp.adb (UR_Write): Write hexadecimal constants with exponent 1 as decimal constants, and write any others using the exponent notation. Minor reformatting throughout (Store_Ureal_Normalized): New function (minor code reorganization) 2010-10-21 Robert Dewar * einfo.ads, xeinfo.adb: Minor reformatting. * s-stalib.ads: Minor comment fixes. From-SVN: r165762 --- gcc/ada/ChangeLog | 12 ++ gcc/ada/einfo.ads | 13 +- gcc/ada/s-stalib.ads | 6 +- gcc/ada/urealp.adb | 494 ++++++++++++++++++++----------------------- gcc/ada/xeinfo.adb | 4 +- 5 files changed, 260 insertions(+), 269 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5d4d7b88f24..90fd375b6f1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,15 @@ +2010-10-21 Geert Bosch + + * urealp.adb (UR_Write): Write hexadecimal constants with exponent 1 as + decimal constants, and write any others using the exponent notation. + Minor reformatting throughout + (Store_Ureal_Normalized): New function (minor code reorganization) + +2010-10-21 Robert Dewar + + * einfo.ads, xeinfo.adb: Minor reformatting. + * s-stalib.ads: Minor comment fixes. + 2010-10-21 Ed Schonberg * sem_ch6.adb (Enter_Overloaded_Entity): Refine warning message about diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index bbfa09bbe34..b79fa2935e3 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -850,10 +850,11 @@ package Einfo is -- index starting at 1 and ranging up to number of discriminants. -- Dispatch_Table_Wrappers (Elist26) [implementation base type only] --- Present in library level record type entities if we are generating --- statically allocated dispatch tables. For a tagged type, points to --- the list of dispatch table wrappers associated with the tagged type. --- For a non-tagged record, contains No_Elist. +-- Present in record type [with private] entities. Set in library level +-- record type entities if we are generating statically allocated +-- dispatch tables. For a tagged type, points to the list of dispatch +-- table wrappers associated with the tagged type. For a non-tagged +-- record, contains No_Elist. -- DTC_Entity (Node16) -- Present in function and procedure entities. Set to Empty unless @@ -5424,7 +5425,6 @@ package Einfo is -- E_Record_Subtype -- Direct_Primitive_Operations (Elist10) -- Access_Disp_Table (Elist16) (base type only) - -- Dispatch_Table_Wrappers (Elist26) (base type only) -- Cloned_Subtype (Node16) (subtype case only) -- First_Entity (Node17) -- Corresponding_Concurrent_Type (Node18) @@ -5434,6 +5434,7 @@ package Einfo is -- Corresponding_Remote_Type (Node22) -- Stored_Constraint (Elist23) -- Interfaces (Elist25) + -- Dispatch_Table_Wrappers (Elist26) (base type only) -- Underlying_Record_View (Node28) (base type only) -- Component_Alignment (special) (base type only) -- C_Pass_By_Copy (Flag125) (base type only) @@ -5457,7 +5458,6 @@ package Einfo is -- E_Record_Subtype_With_Private -- Direct_Primitive_Operations (Elist10) -- Access_Disp_Table (Elist16) (base type only) - -- Dispatch_Table_Wrappers (Elist26) (base type only) -- First_Entity (Node17) -- Private_Dependents (Elist18) -- Underlying_Full_View (Node19) @@ -5466,6 +5466,7 @@ package Einfo is -- Private_View (Node22) -- Stored_Constraint (Elist23) -- Interfaces (Elist25) + -- Dispatch_Table_Wrappers (Elist26) (base type only) -- Has_Completion (Flag26) -- Has_Record_Rep_Clause (Flag65) (base type only) -- Has_External_Tag_Rep_Clause (Flag110) diff --git a/gcc/ada/s-stalib.ads b/gcc/ada/s-stalib.ads index d77da263f16..6b3d8645c63 100644 --- a/gcc/ada/s-stalib.ads +++ b/gcc/ada/s-stalib.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -33,11 +33,11 @@ -- are required to be part of every Ada program. A special mechanism is -- required to ensure that these are loaded, since it may be the case in -- some programs that the only references to these required packages are --- from C code or from code generated directly by Gigi, an in both cases +-- from C code or from code generated directly by Gigi, and in both cases -- the binder is not aware of such references. -- System.Standard_Library also includes data that must be present in every --- program, in particular the definitions of all the standard and also some +-- program, in particular data for all the standard exceptions, and also some -- subprograms that must be present in every program. -- The binder unconditionally includes s-stalib.ali, which ensures that this diff --git a/gcc/ada/urealp.adb b/gcc/ada/urealp.adb index 1c95ee6117b..e28ee59f106 100644 --- a/gcc/ada/urealp.adb +++ b/gcc/ada/urealp.adb @@ -44,7 +44,7 @@ package body Urealp is Num : Uint; -- Numerator (always non-negative) - Den : Uint; + Den : Uint; -- Denominator (always non-zero, always positive if base is zero) Rbase : Nat; @@ -80,20 +80,20 @@ package body Urealp is -- The following universal reals are the values returned by the constant -- functions. They are initialized by the initialization procedure. - UR_0 : Ureal; - UR_M_0 : Ureal; - UR_Tenth : Ureal; - UR_Half : Ureal; - UR_1 : Ureal; - UR_2 : Ureal; - UR_10 : Ureal; - UR_10_36 : Ureal; - UR_M_10_36 : Ureal; - UR_100 : Ureal; - UR_2_128 : Ureal; - UR_2_80 : Ureal; - UR_2_M_128 : Ureal; - UR_2_M_80 : Ureal; + UR_0 : Ureal; + UR_M_0 : Ureal; + UR_Tenth : Ureal; + UR_Half : Ureal; + UR_1 : Ureal; + UR_2 : Ureal; + UR_10 : Ureal; + UR_10_36 : Ureal; + UR_M_10_36 : Ureal; + UR_100 : Ureal; + UR_2_128 : Ureal; + UR_2_80 : Ureal; + UR_2_M_128 : Ureal; + UR_2_M_80 : Ureal; Num_Ureal_Constants : constant := 10; -- This is used for an assertion check in Tree_Read and Tree_Write to @@ -134,18 +134,22 @@ package body Urealp is -- Return true if the real quotient of Num / Den is an integer value function Normalize (Val : Ureal_Entry) return Ureal_Entry; - -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a - -- base value of 0). + -- Normalizes the Ureal_Entry by reducing it to lowest terms (with a base + -- value of 0). function Same (U1, U2 : Ureal) return Boolean; pragma Inline (Same); -- Determines if U1 and U2 are the same Ureal. Note that we cannot use - -- the equals operator for this test, since that tests for equality, - -- not identity. + -- the equals operator for this test, since that tests for equality, not + -- identity. function Store_Ureal (Val : Ureal_Entry) return Ureal; - -- This store a new entry in the universal reals table and return - -- its index in the table. + -- This store a new entry in the universal reals table and return its index + -- in the table. + + function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal; + pragma Inline (Store_Ureal_Normalized); + -- Like Store_Ureal, but normalizes its operand first. ------------------------- -- Decimal_Exponent_Hi -- @@ -451,6 +455,15 @@ package body Urealp is return Ureals.Last; end Store_Ureal; + ---------------------------- + -- Store_Ureal_Normalized -- + ---------------------------- + + function Store_Ureal_Normalized (Val : Ureal_Entry) return Ureal is + begin + return Store_Ureal (Normalize (Val)); + end Store_Ureal_Normalized; + --------------- -- Tree_Read -- --------------- @@ -505,11 +518,11 @@ package body Urealp is Val : constant Ureal_Entry := Ureals.Table (Real); begin - return Store_Ureal ( - (Num => Val.Num, - Den => Val.Den, - Rbase => Val.Rbase, - Negative => False)); + return Store_Ureal + ((Num => Val.Num, + Den => Val.Den, + Rbase => Val.Rbase, + Negative => False)); end UR_Abs; ------------ @@ -529,7 +542,6 @@ package body Urealp is function UR_Add (Left : Ureal; Right : Ureal) return Ureal is Lval : Ureal_Entry := Ureals.Table (Left); Rval : Ureal_Entry := Ureals.Table (Right); - Num : Uint; begin @@ -538,7 +550,6 @@ package body Urealp is -- be negative, even though in stored entries this can never be so) if Lval.Rbase /= 0 and then Lval.Rbase = Rval.Rbase then - declare Opd_Min, Opd_Max : Ureal_Entry; Exp_Min, Exp_Max : Uint; @@ -568,18 +579,18 @@ package body Urealp is Opd_Min.Num * Lval.Rbase ** (Exp_Max - Exp_Min) + Opd_Max.Num; if Num = 0 then - return Store_Ureal ( - (Num => Uint_0, - Den => Uint_1, - Rbase => 0, - Negative => Lval.Negative)); + return Store_Ureal + ((Num => Uint_0, + Den => Uint_1, + Rbase => 0, + Negative => Lval.Negative)); else - return Store_Ureal ( - (Num => abs Num, - Den => Exp_Max, - Rbase => Lval.Rbase, - Negative => (Num < 0))); + return Store_Ureal + ((Num => abs Num, + Den => Exp_Max, + Rbase => Lval.Rbase, + Negative => (Num < 0))); end if; end; @@ -600,19 +611,18 @@ package body Urealp is Num := (Ln.Num * Rn.Den) + (Rn.Num * Ln.Den); if Num = 0 then - return Store_Ureal ( - (Num => Uint_0, - Den => Uint_1, - Rbase => 0, - Negative => Lval.Negative)); + return Store_Ureal + ((Num => Uint_0, + Den => Uint_1, + Rbase => 0, + Negative => Lval.Negative)); else - return Store_Ureal ( - Normalize ( - (Num => abs Num, - Den => Ln.Den * Rn.Den, - Rbase => 0, - Negative => (Num < 0)))); + return Store_Ureal_Normalized + ((Num => abs Num, + Den => Ln.Den * Rn.Den, + Rbase => 0, + Negative => (Num < 0))); end if; end; end if; @@ -624,7 +634,6 @@ package body Urealp is function UR_Ceiling (Real : Ureal) return Uint is Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); - begin if Val.Negative then return UI_Negate (Val.Num / Val.Den); @@ -656,56 +665,51 @@ package body Urealp is pragma Assert (Rval.Num /= Uint_0); if Lval.Rbase = 0 then - if Rval.Rbase = 0 then - return Store_Ureal ( - Normalize ( - (Num => Lval.Num * Rval.Den, - Den => Lval.Den * Rval.Num, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Lval.Num * Rval.Den, + Den => Lval.Den * Rval.Num, + Rbase => 0, + Negative => Rneg)); elsif Is_Integer (Lval.Num, Rval.Num * Lval.Den) then - return Store_Ureal ( - (Num => Lval.Num / (Rval.Num * Lval.Den), - Den => (-Rval.Den), - Rbase => Rval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => Lval.Num / (Rval.Num * Lval.Den), + Den => (-Rval.Den), + Rbase => Rval.Rbase, + Negative => Rneg)); elsif Rval.Den < 0 then - return Store_Ureal ( - Normalize ( - (Num => Lval.Num, - Den => Rval.Rbase ** (-Rval.Den) * - Rval.Num * - Lval.Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Lval.Num, + Den => Rval.Rbase ** (-Rval.Den) * + Rval.Num * + Lval.Den, + Rbase => 0, + Negative => Rneg)); else - return Store_Ureal ( - Normalize ( - (Num => Lval.Num * Rval.Rbase ** Rval.Den, - Den => Rval.Num * Lval.Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Lval.Num * Rval.Rbase ** Rval.Den, + Den => Rval.Num * Lval.Den, + Rbase => 0, + Negative => Rneg)); end if; elsif Is_Integer (Lval.Num, Rval.Num) then - if Rval.Rbase = Lval.Rbase then - return Store_Ureal ( - (Num => Lval.Num / Rval.Num, - Den => Lval.Den - Rval.Den, - Rbase => Lval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => Lval.Num / Rval.Num, + Den => Lval.Den - Rval.Den, + Rbase => Lval.Rbase, + Negative => Rneg)); elsif Rval.Rbase = 0 then - return Store_Ureal ( - (Num => (Lval.Num / Rval.Num) * Rval.Den, - Den => Lval.Den, - Rbase => Lval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => (Lval.Num / Rval.Num) * Rval.Den, + Den => Lval.Den, + Rbase => Lval.Rbase, + Negative => Rneg)); elsif Rval.Den < 0 then declare @@ -721,20 +725,20 @@ package body Urealp is (Rval.Rbase ** (-Rval.Den)); end if; - return Store_Ureal ( - (Num => Num, - Den => Den, - Rbase => 0, - Negative => Rneg)); + return Store_Ureal + ((Num => Num, + Den => Den, + Rbase => 0, + Negative => Rneg)); end; else - return Store_Ureal ( - (Num => (Lval.Num / Rval.Num) * - (Rval.Rbase ** Rval.Den), - Den => Lval.Den, - Rbase => Lval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => (Lval.Num / Rval.Num) * + (Rval.Rbase ** Rval.Den), + Den => Lval.Den, + Rbase => Lval.Rbase, + Negative => Rneg)); end if; else @@ -745,7 +749,6 @@ package body Urealp is if Lval.Den < 0 then Num := Lval.Num * (Lval.Rbase ** (-Lval.Den)); Den := Rval.Num; - else Num := Lval.Num; Den := Rval.Num * (Lval.Rbase ** Lval.Den); @@ -762,12 +765,11 @@ package body Urealp is Num := Num * Rval.Den; end if; - return Store_Ureal ( - Normalize ( - (Num => Num, - Den => Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num, + Den => Den, + Rbase => 0, + Negative => Rneg)); end; end if; end UR_Div; @@ -814,11 +816,11 @@ package body Urealp is if IBas <= 16 and then UR_From_Uint (IBas) = Bas then - return Store_Ureal ( - (Num => Uint_1, - Den => -N, - Rbase => UI_To_Int (UR_Trunc (Bas)), - Negative => Neg)); + return Store_Ureal + ((Num => Uint_1, + Den => -N, + Rbase => UI_To_Int (UR_Trunc (Bas)), + Negative => Neg)); -- If the exponent is negative then we raise the numerator and the -- denominator (after normalization) to the absolute value of the @@ -829,11 +831,11 @@ package body Urealp is pragma Assert (Val.Num /= 0); Val := Normalize (Val); - return Store_Ureal ( - (Num => Val.Den ** X, - Den => Val.Num ** X, - Rbase => 0, - Negative => Neg)); + return Store_Ureal + ((Num => Val.Den ** X, + Den => Val.Num ** X, + Rbase => 0, + Negative => Neg)); -- If positive, we distinguish the case when the base is not zero, in -- which case the new denominator is just the product of the old one @@ -842,21 +844,21 @@ package body Urealp is else if Val.Rbase /= 0 then - return Store_Ureal ( - (Num => Val.Num ** X, - Den => Val.Den * X, - Rbase => Val.Rbase, - Negative => Neg)); + return Store_Ureal + ((Num => Val.Num ** X, + Den => Val.Den * X, + Rbase => Val.Rbase, + Negative => Neg)); -- And when the base is zero, in which case we exponentiate -- the old denominator. else - return Store_Ureal ( - (Num => Val.Num ** X, - Den => Val.Den ** X, - Rbase => 0, - Negative => Neg)); + return Store_Ureal + ((Num => Val.Num ** X, + Den => Val.Den ** X, + Rbase => 0, + Negative => Neg)); end if; end if; end UR_Exponentiate; @@ -867,7 +869,6 @@ package body Urealp is function UR_Floor (Real : Ureal) return Uint is Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); - begin if Val.Negative then return UI_Negate ((Val.Num + Val.Den - 1) / Val.Den); @@ -888,11 +889,11 @@ package body Urealp is return Ureal is begin - return Store_Ureal ( - (Num => Num, - Den => Den, - Rbase => Rbase, - Negative => Negative)); + return Store_Ureal + ((Num => Num, + Den => Den, + Rbase => Rbase, + Negative => Negative)); end UR_From_Components; ------------------ @@ -902,7 +903,7 @@ package body Urealp is function UR_From_Uint (UI : Uint) return Ureal is begin return UR_From_Components - (abs UI, Uint_1, Negative => (UI < 0)); + (abs UI, Uint_1, Negative => (UI < 0)); end UR_From_Uint; ----------- @@ -1095,67 +1096,62 @@ package body Urealp is begin if Lval.Rbase = 0 then if Rval.Rbase = 0 then - return Store_Ureal ( - Normalize ( - (Num => Num, - Den => Lval.Den * Rval.Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num, + Den => Lval.Den * Rval.Den, + Rbase => 0, + Negative => Rneg)); elsif Is_Integer (Num, Lval.Den) then - return Store_Ureal ( - (Num => Num / Lval.Den, - Den => Rval.Den, - Rbase => Rval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => Num / Lval.Den, + Den => Rval.Den, + Rbase => Rval.Rbase, + Negative => Rneg)); elsif Rval.Den < 0 then - return Store_Ureal ( - Normalize ( - (Num => Num * (Rval.Rbase ** (-Rval.Den)), - Den => Lval.Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num * (Rval.Rbase ** (-Rval.Den)), + Den => Lval.Den, + Rbase => 0, + Negative => Rneg)); else - return Store_Ureal ( - Normalize ( - (Num => Num, - Den => Lval.Den * (Rval.Rbase ** Rval.Den), - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num, + Den => Lval.Den * (Rval.Rbase ** Rval.Den), + Rbase => 0, + Negative => Rneg)); end if; elsif Lval.Rbase = Rval.Rbase then - return Store_Ureal ( - (Num => Num, - Den => Lval.Den + Rval.Den, - Rbase => Lval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => Num, + Den => Lval.Den + Rval.Den, + Rbase => Lval.Rbase, + Negative => Rneg)); elsif Rval.Rbase = 0 then if Is_Integer (Num, Rval.Den) then - return Store_Ureal ( - (Num => Num / Rval.Den, - Den => Lval.Den, - Rbase => Lval.Rbase, - Negative => Rneg)); + return Store_Ureal + ((Num => Num / Rval.Den, + Den => Lval.Den, + Rbase => Lval.Rbase, + Negative => Rneg)); elsif Lval.Den < 0 then - return Store_Ureal ( - Normalize ( - (Num => Num * (Lval.Rbase ** (-Lval.Den)), - Den => Rval.Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num * (Lval.Rbase ** (-Lval.Den)), + Den => Rval.Den, + Rbase => 0, + Negative => Rneg)); else - return Store_Ureal ( - Normalize ( - (Num => Num, - Den => Rval.Den * (Lval.Rbase ** Lval.Den), - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num, + Den => Rval.Den * (Lval.Rbase ** Lval.Den), + Rbase => 0, + Negative => Rneg)); end if; else @@ -1173,12 +1169,11 @@ package body Urealp is Den := Den * (Rval.Rbase ** Rval.Den); end if; - return Store_Ureal ( - Normalize ( - (Num => Num, - Den => Den, - Rbase => 0, - Negative => Rneg))); + return Store_Ureal_Normalized + ((Num => Num, + Den => Den, + Rbase => 0, + Negative => Rneg)); end if; end UR_Mul; @@ -1228,8 +1223,8 @@ package body Urealp is else Result := Rval.Negative /= Lval.Negative - or else Rval.Num /= Lval.Num - or else Rval.Den /= Lval.Den; + or else Rval.Num /= Lval.Num + or else Rval.Den /= Lval.Den; Release (Imrk); Release (Rmrk); return Result; @@ -1244,11 +1239,11 @@ package body Urealp is function UR_Negate (Real : Ureal) return Ureal is begin - return Store_Ureal ( - (Num => Ureals.Table (Real).Num, - Den => Ureals.Table (Real).Den, - Rbase => Ureals.Table (Real).Rbase, - Negative => not Ureals.Table (Real).Negative)); + return Store_Ureal + ((Num => Ureals.Table (Real).Num, + Den => Ureals.Table (Real).Den, + Rbase => Ureals.Table (Real).Rbase, + Negative => not Ureals.Table (Real).Negative)); end UR_Negate; ------------ @@ -1294,7 +1289,6 @@ package body Urealp is function UR_Trunc (Real : Ureal) return Uint is Val : constant Ureal_Entry := Normalize (Ureals.Table (Real)); - begin if Val.Negative then return -(Val.Num / Val.Den); @@ -1371,98 +1365,80 @@ package body Urealp is Write_Str (".0"); end if; - -- Constants in base 2, 10 or 16 can be written in normal Ada literal + -- Constants in base 10 or 16 can be written in normal Ada literal -- style, as long as they fit in the UI_Image_Buffer. Using hexadecimal -- notation, 4 bytes are required for the 16# # part, and every fifth -- character is an underscore. So, a buffer of size N has room for - - -- ((N - 4) - (N - 4) / 5) * 4 bits - - -- or at least - - -- N * 16 / 5 - 12 bits + -- ((N - 4) - (N - 4) / 5) * 4 bits, + -- or at least + -- N * 16 / 5 - 12 bits. elsif (Val.Rbase = 10 or else Val.Rbase = 16) and then Num_Bits (Val.Num) < UI_Image_Buffer'Length * 16 / 5 - 12 then - declare - Format : UI_Format := Decimal; - Scale : Uint; + pragma Assert (Val.Den /= 0); - begin - if Val.Rbase = 16 then - Write_Str ("16#"); - Format := Hex; - end if; - - -- Use fixed-point format for small scaling values + -- Use fixed-point format for small scaling values - if Val.Den = 1 then - UI_Write (Val.Num / Val.Rbase, Format); - Write_Char ('.'); - UI_Write (Val.Num mod Val.Rbase, Format); + if (Val.Rbase = 10 and then Val.Den < 0 and then Val.Den > -3) + or else (Val.Rbase = 16 and then Val.Den = -1) + then + UI_Write (Val.Num * Val.Rbase**(-Val.Den), Decimal); + Write_Str (".0"); - elsif Val.Den = 2 then - UI_Write (Val.Num / Val.Rbase**Uint_2, Format); - Write_Char ('.'); - UI_Write (Val.Num mod Val.Rbase**Uint_2 / Val.Rbase, Format); - UI_Write (Val.Num mod Val.Rbase, Format); + -- Write hexadecimal constants in exponential notation with a zero + -- unit digit. This matches the Ada canonical form for floating point + -- numbers, and also ensures that the underscores end up in the + -- correct place. - elsif Val.Den = -1 then - UI_Write (Val.Num, Format); - Write_Str ("0.0"); + elsif Val.Rbase = 16 then + UI_Image (Val.Num, Hex); + pragma Assert (Val.Rbase = 16); - elsif Val.Den = -2 then - UI_Write (Val.Num, Format); - Write_Str ("00.0"); + Write_Str ("16#0."); + Write_Str (UI_Image_Buffer (4 .. UI_Image_Length)); - -- Else use exponential format + -- For exponent, exclude 16# # and underscores from length - else - UI_Image (Val.Num, Format); - Scale := UI_From_Int (Int (UI_Image_Length)); + UI_Image_Length := UI_Image_Length - 4; + UI_Image_Length := UI_Image_Length - UI_Image_Length / 5; - if Format = Decimal then + Write_Char ('E'); + UI_Write (Int (UI_Image_Length) - Val.Den, Decimal); - -- Write decimal constants with a non-zero unit digit. This - -- matches usual scientific notation. + elsif Val.Den = 1 then + UI_Write (Val.Num / 10, Decimal); + Write_Char ('.'); + UI_Write (Val.Num mod 10, Decimal); - Write_Char (UI_Image_Buffer (1)); - Write_Char ('.'); + elsif Val.Den = 2 then + UI_Write (Val.Num / 100, Decimal); + Write_Char ('.'); + UI_Write (Val.Num / 10 mod 10, Decimal); + UI_Write (Val.Num mod 10, Decimal); - if UI_Image_Length = 1 then - Write_Char ('0'); - else - Write_Str (UI_Image_Buffer (2 .. UI_Image_Length)); - end if; + -- Else use decimal exponential format - Scale := Scale - 1; -- First digit is at unit position - else - pragma Assert (Format = Hex); - - -- Write hexadecimal constants with a zero unit digit. This - -- matches the Ada canonical form for binary floating point - -- numbers, and also ensures that the underscores end up in - -- the correct place. + else + -- Write decimal constants with a non-zero unit digit. This + -- matches usual scientific notation. - Write_Str ("0."); - Write_Str (UI_Image_Buffer (4 .. UI_Image_Length)); - Scale := Scale - 4; -- Subtract 16# # - Scale := Scale - Scale / 5; -- Subtract underscores; - end if; + UI_Image (Val.Num, Decimal); + Write_Char (UI_Image_Buffer (1)); + Write_Char ('.'); - Write_Char ('E'); - Format := Decimal; - UI_Write (Scale - Val.Den, Decimal); + if UI_Image_Length = 1 then + Write_Char ('0'); + else + Write_Str (UI_Image_Buffer (2 .. UI_Image_Length)); end if; - if Format = Hex then - Write_Char ('#'); - end if; - end; + Write_Char ('E'); + UI_Write (Int (UI_Image_Length - 1) - Val.Den, Decimal); + end if; - -- Constants in a base other than 10 can still be easily written - -- in normal Ada literal style if the numerator is one. + -- Constants in a base other than 10 can still be easily written in + -- normal Ada literal style if the numerator is one. elsif Val.Rbase /= 0 and then Val.Num = 1 then Write_Int (Val.Rbase); diff --git a/gcc/ada/xeinfo.adb b/gcc/ada/xeinfo.adb index feb542988c4..1c76c316ed0 100644 --- a/gcc/ada/xeinfo.adb +++ b/gcc/ada/xeinfo.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2008, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2010, 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- -- @@ -348,6 +348,7 @@ begin -- Case of type declaration elsif Match (Line, F_Typ) then + -- Process type declaration (must be enumeration type) Ctr := 0; @@ -371,6 +372,7 @@ begin end loop; -- Process function declarations + -- Note: Lastinlined used to control blank lines Put_Line (Ofile, ""); -- 2.30.2