===================================================================
@@ -1054,6 +1054,39 @@ package body Repinfo is
Write_Str ("'Alignment use ");
Write_Val (Alignment (Ent));
Write_Line (";");
+
+ -- Special stuff for fixed-point
+
+ if Is_Fixed_Point_Type (Ent) then
+
+ -- Write small (always a static constant)
+
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Small use ");
+ UR_Write (Small_Value (Ent));
+ Write_Line (";");
+
+ -- Write range if static
+
+ declare
+ R : constant Node_Id := Scalar_Range (Ent);
+
+ begin
+ if Nkind (Low_Bound (R)) = N_Real_Literal
+ and then
+ Nkind (High_Bound (R)) = N_Real_Literal
+ then
+ Write_Str ("for ");
+ List_Name (Ent);
+ Write_Str ("'Range use ");
+ UR_Write (Realval (Low_Bound (R)));
+ Write_Str (" .. ");
+ UR_Write (Realval (High_Bound (R)));
+ Write_Line (";");
+ end if;
+ end;
+ end if;
end List_Type_Info;
----------------------
@@ -1087,8 +1120,8 @@ package body Repinfo is
-- Internal recursive routine to evaluate tree
function W (Val : Uint) return Word;
- -- Convert Val to Word, assuming Val is always in the Int range. This is
- -- a helper function for the evaluation of bitwise expressions like
+ -- Convert Val to Word, assuming Val is always in the Int range. This
+ -- is a helper function for the evaluation of bitwise expressions like
-- Bit_And_Expr, for which there is no direct support in uintp. Uint
-- values out of the Int range are expected to be seen in such
-- expressions only with overflowing byte sizes around, introducing
===================================================================
@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
+-- 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- --
@@ -1307,28 +1307,108 @@ package body Urealp is
-- UR_Write --
--------------
- procedure UR_Write (Real : Ureal) is
+ procedure UR_Write (Real : Ureal; Brackets : Boolean := False) is
Val : constant Ureal_Entry := Ureals.Table (Real);
+ T : Uint;
begin
-- If value is negative, we precede the constant by a minus sign
- -- and add an extra layer of parentheses on the outside since the
- -- minus sign is part of the value, not a negation operator.
if Val.Negative then
- Write_Str ("(-");
+ Write_Char ('-');
end if;
+ -- Zero is zero
+
+ if Val.Num = 0 then
+ Write_Str ("0.0");
+
-- Constants in base 10 can be written in normal Ada literal style
- if Val.Rbase = 10 then
- UI_Write (Val.Num / 10);
- Write_Char ('.');
- UI_Write (Val.Num mod 10);
+ elsif Val.Rbase = 10 then
- if Val.Den /= 0 then
+ -- Use fixed-point format for small scaling values
+
+ if Val.Den = 0 then
+ UI_Write (Val.Num, Decimal);
+ Write_Str (".0");
+
+ 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 mod 100 / 10, Decimal);
+ UI_Write (Val.Num mod 10, Decimal);
+
+ elsif Val.Den = -1 then
+ UI_Write (Val.Num, Decimal);
+ Write_Str ("0.0");
+
+ elsif Val.Den = -2 then
+ UI_Write (Val.Num, Decimal);
+ Write_Str ("00.0");
+
+ -- Else use exponential format
+
+ else
+ UI_Write (Val.Num / 10, Decimal);
+ Write_Char ('.');
+ UI_Write (Val.Num mod 10, Decimal);
Write_Char ('E');
- UI_Write (1 - Val.Den);
+ UI_Write (1 - Val.Den, Decimal);
+ end if;
+
+ -- If we have a constant in a base other than 10, and the denominator
+ -- is zero, then the value is simply the numerator value, since we are
+ -- dividing by base**0, which is 1.
+
+ elsif Val.Den = 0 then
+ UI_Write (Val.Num, Decimal);
+ Write_Str (".0");
+
+ -- Small powers of 2 get written in decimal fixed-point format
+
+ elsif Val.Rbase = 2
+ and then Val.Den <= 3
+ and then Val.Den >= -16
+ then
+ if Val.Den = 1 then
+ T := Val.Num * (10/2);
+ UI_Write (T / 10, Decimal);
+ Write_Char ('.');
+ UI_Write (T mod 10, Decimal);
+
+ elsif Val.Den = 2 then
+ T := Val.Num * (100/4);
+ UI_Write (T / 100, Decimal);
+ Write_Char ('.');
+ UI_Write (T mod 100 / 10, Decimal);
+
+ if T mod 10 /= 0 then
+ UI_Write (T mod 10, Decimal);
+ end if;
+
+ elsif Val.Den = 3 then
+ T := Val.Num * (1000 / 8);
+ UI_Write (T / 1000, Decimal);
+ Write_Char ('.');
+ UI_Write (T mod 1000 / 100, Decimal);
+
+ if T mod 100 /= 0 then
+ UI_Write (T mod 100 / 10, Decimal);
+
+ if T mod 10 /= 0 then
+ UI_Write (T mod 10, Decimal);
+ end if;
+ end if;
+
+ else
+ UI_Write (Val.Num * (Uint_2 ** (-Val.Den)), Decimal);
+ Write_Str (".0");
end if;
-- Constants in a base other than 10 can still be easily written
@@ -1343,48 +1423,60 @@ package body Urealp is
-- of the following forms, depending on the sign of the number
-- and the sign of the exponent (= minus denominator value)
- -- (numerator.0*base**exponent)
- -- (numerator.0*base**(-exponent))
+ -- numerator.0*base**exponent
+ -- numerator.0*base**-exponent
+
+ -- And of course an exponent of 0 can be omitted
elsif Val.Rbase /= 0 then
- Write_Char ('(');
+ if Brackets then
+ Write_Char ('[');
+ end if;
+
UI_Write (Val.Num, Decimal);
- Write_Str (".0*");
- Write_Int (Val.Rbase);
- Write_Str ("**");
+ Write_Str (".0");
- if Val.Den <= 0 then
- UI_Write (-Val.Den, Decimal);
+ if Val.Den /= 0 then
+ Write_Char ('*');
+ Write_Int (Val.Rbase);
+ Write_Str ("**");
- else
- Write_Str ("(-");
- UI_Write (Val.Den, Decimal);
- Write_Char (')');
+ if Val.Den <= 0 then
+ UI_Write (-Val.Den, Decimal);
+ else
+ Write_Str ("(-");
+ UI_Write (Val.Den, Decimal);
+ Write_Char (')');
+ end if;
end if;
- Write_Char (')');
+ if Brackets then
+ Write_Char (']');
+ end if;
- -- Rational constants with a denominator of 1 can be written as
- -- a real literal for the numerator integer.
+ -- Rationals where numerator is divisible by denominator can be output
+ -- as literals after we do the division. This includes the common case
+ -- where the denominator is 1.
- elsif Val.Den = 1 then
- UI_Write (Val.Num, Decimal);
+ elsif Val.Num mod Val.Den = 0 then
+ UI_Write (Val.Num / Val.Den, Decimal);
Write_Str (".0");
- -- Non-based (rational) constants are written in (num/den) style
+ -- Other non-based (rational) constants are written in num/den style
else
- Write_Char ('(');
+ if Brackets then
+ Write_Char ('[');
+ end if;
+
UI_Write (Val.Num, Decimal);
Write_Str (".0/");
UI_Write (Val.Den, Decimal);
- Write_Str (".0)");
- end if;
-
- -- Add trailing paren for negative values
+ Write_Str (".0");
- if Val.Negative then
- Write_Char (')');
+ if Brackets then
+ Write_Char (']');
+ end if;
end if;
end UR_Write;
===================================================================
@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
+-- 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- --
@@ -264,14 +264,17 @@ package Urealp is
function UR_Is_Positive (Real : Ureal) return Boolean;
-- Test if real value is greater than zero
- procedure UR_Write (Real : Ureal);
- -- Writes value of Real to standard output. Used only for debugging and
- -- tree/source output. If the result is easily representable as a standard
- -- Ada literal, it will be given that way, but as a result of evaluation
- -- of static expressions, it is possible to generate constants (e.g. 1/13)
- -- which have no such representation. In such cases (and in cases where it
- -- is too much work to figure out the Ada literal), the string that is
- -- output is of the form [numerator/denominator].
+ procedure UR_Write (Real : Ureal; Brackets : Boolean := False);
+ -- Writes value of Real to standard output. Used for debugging and
+ -- tree/source output, and also for -gnatR representation output. If the
+ -- result is easily representable as a standard Ada literal, it will be
+ -- given that way, but as a result of evaluation of static expressions, it
+ -- is possible to generate constants (e.g. 1/13) which have no such
+ -- representation. In such cases (and in cases where it is too much work to
+ -- figure out the Ada literal), the string that is output is of the form
+ -- of some expression such as integer/integer, or integer*integer**integer.
+ -- In the case where an expression is output, if Brackets is set to True,
+ -- the expression is surrounded by square brackets.
procedure pr (Real : Ureal);
pragma Export (Ada, pr);
===================================================================
@@ -4364,12 +4364,10 @@ package body Sprint is
procedure Write_Ureal_With_Col_Check_Sloc (U : Ureal) is
D : constant Uint := Denominator (U);
N : constant Uint := Numerator (U);
-
begin
- Col_Check
- (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
+ Col_Check (UI_Decimal_Digits_Hi (D) + UI_Decimal_Digits_Hi (N) + 4);
Set_Debug_Sloc;
- UR_Write (U);
+ UR_Write (U, Brackets => True);
end Write_Ureal_With_Col_Check_Sloc;
end Sprint;
===================================================================
@@ -76,7 +76,7 @@ package Sprint is
-- Push exception label %push_xxx_exception_label (label)
-- Raise xxx error [xxx_error [when cond]]
-- Raise xxx error with msg [xxx_error [when cond], "msg"]
- -- Rational literal See UR_Write for details
+ -- Rational literal [expression]
-- Rem wi Treat_Fixed_As_Integer x #rem y
-- Reference expression'reference
-- Shift nodes shift_name!(expr, count)