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