Skip to content

R
riscv-gcc-1
Commit 04cbd48e by Arnaud Charlet
Options

[multiple changes] 

2010-10-21  Geert Bosch  <bosch@adacore.com>

	* 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  <dewar@adacore.com>

	* einfo.ads, xeinfo.adb: Minor reformatting.
	* s-stalib.ads: Minor comment fixes.

From-SVN: r165762
parent 7fc53871
Showing with 260 additions and 269 deletions
gcc/ada/ChangeLog
2010-10-21 Geert Bosch <bosch@adacore.com>
* 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 <dewar@adacore.com>
* einfo.ads, xeinfo.adb: Minor reformatting.
* s-stalib.ads: Minor comment fixes.
2010-10-21 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb (Enter_Overloaded_Entity): Refine warning message about
......
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)
......
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
......
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);
......
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, "");
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment