[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
This commit is contained in:
Arnaud Charlet
parent
7fc5387116
commit
04cbd48e9e
|
|
@ -1,3 +1,15 @@
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.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");
|
||||
|
||||
if Val.Den = 1 then
|
||||
UI_Write (Val.Num / Val.Rbase, Format);
|
||||
Write_Char ('.');
|
||||
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 = 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);
|
||||
elsif Val.Rbase = 16 then
|
||||
UI_Image (Val.Num, Hex);
|
||||
pragma Assert (Val.Rbase = 16);
|
||||
|
||||
elsif Val.Den = -1 then
|
||||
UI_Write (Val.Num, Format);
|
||||
Write_Str ("0.0");
|
||||
Write_Str ("16#0.");
|
||||
Write_Str (UI_Image_Buffer (4 .. UI_Image_Length));
|
||||
|
||||
elsif Val.Den = -2 then
|
||||
UI_Write (Val.Num, Format);
|
||||
Write_Str ("00.0");
|
||||
-- For exponent, exclude 16# # and underscores from length
|
||||
|
||||
-- Else use exponential format
|
||||
UI_Image_Length := UI_Image_Length - 4;
|
||||
UI_Image_Length := UI_Image_Length - UI_Image_Length / 5;
|
||||
|
||||
Write_Char ('E');
|
||||
UI_Write (Int (UI_Image_Length) - Val.Den, Decimal);
|
||||
|
||||
elsif Val.Den = 1 then
|
||||
UI_Write (Val.Num / 10, Decimal);
|
||||
Write_Char ('.');
|
||||
UI_Write (Val.Num mod 10, Decimal);
|
||||
|
||||
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);
|
||||
|
||||
-- Else use decimal exponential format
|
||||
|
||||
else
|
||||
-- Write decimal constants with a non-zero unit digit. This
|
||||
-- matches usual scientific notation.
|
||||
|
||||
UI_Image (Val.Num, Decimal);
|
||||
Write_Char (UI_Image_Buffer (1));
|
||||
Write_Char ('.');
|
||||
|
||||
if UI_Image_Length = 1 then
|
||||
Write_Char ('0');
|
||||
else
|
||||
UI_Image (Val.Num, Format);
|
||||
Scale := UI_From_Int (Int (UI_Image_Length));
|
||||
|
||||
if Format = Decimal then
|
||||
|
||||
-- Write decimal constants with a non-zero unit digit. This
|
||||
-- matches usual scientific notation.
|
||||
|
||||
Write_Char (UI_Image_Buffer (1));
|
||||
Write_Char ('.');
|
||||
|
||||
if UI_Image_Length = 1 then
|
||||
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
|
||||
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.
|
||||
|
||||
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;
|
||||
|
||||
Write_Char ('E');
|
||||
Format := Decimal;
|
||||
UI_Write (Scale - Val.Den, Decimal);
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -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, "");
|
||||
|
|
|
|||
Loading…
Reference in New Issue