+2010-09-10 Robert Dewar <dewar@adacore.com>
+
+ * repinfo.adb (List_Type_Info): List Small and Range for fixed-point
+ types.
+ * sprint.adb (Write_Ureal_With_Col_Check_Sloc): Use square brackets
+ rather than parens for fixed constants.
+ * sprint.ads: Use square brackets rather than parens for fixed constants
+ * urealp.adb (UR_Write): Use square brackets rather than parens
+ (UR_Write): Add Brackets argument
+ (UR_Write): Add many more special cases to output literals
+ * urealp.ads (UR_Write): Use square brackets rather than parens
+ (UR_Write): Add Brackets argument
+
+2010-09-10 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch4.adb: Minor reformatting.
+
2010-09-10 Richard Guenther <rguenther@suse.de>
* gcc-interface/utils.c (create_index_type): Use build_range_type.
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;
----------------------
-- 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
-- the call may be overloaded with both interpretations.
function Try_Object_Operation (N : Node_Id) return Boolean;
- -- Ada 2005 (AI-252): Support the object.operation notation
+ -- Ada 2005 (AI-252): Support the object.operation notation. If node N
+ -- is a call in this notation, it is transformed into a normal subprogram
+ -- call where the prefix is a parameter, and True is returned. If node
+ -- N is not of this form, it is unchanged, and False is returned.
procedure wpo (T : Entity_Id);
pragma Warnings (Off, wpo);
if Is_Access_Type (Prefix_Type) then
- -- A RACW object can never be used as prefix of a selected
- -- component since that means it is dereferenced without
- -- being a controlling operand of a dispatching operation
- -- (RM E.2.2(16/1)). Before reporting an error, we must check
- -- whether this is actually a dispatching call in prefix form.
+ -- A RACW object can never be used as prefix of a selected component
+ -- since that means it is dereferenced without being a controlling
+ -- operand of a dispatching operation (RM E.2.2(16/1)). Before
+ -- reporting an error, we must check whether this is actually a
+ -- dispatching call in prefix form.
if Is_Remote_Access_To_Class_Wide_Type (Prefix_Type)
and then Comes_From_Source (N)
-- this case gigi generates all the checks and can find the
-- necessary bounds information.
- -- We also do not need an actual subtype for the case of
- -- a first, last, length, or range attribute applied to a
+ -- We also do not need an actual subtype for the case of a
+ -- first, last, length, or range attribute applied to a
-- non-packed array, since gigi can again get the bounds in
-- these cases (gigi cannot handle the packed case, since it
-- has the bounds of the packed array type, not the original
N_Function_Call);
Loc : constant Source_Ptr := Sloc (N);
Obj : constant Node_Id := Prefix (N);
- Subprog : constant Node_Id :=
- Make_Identifier (Sloc (Selector_Name (N)),
- Chars => Chars (Selector_Name (N)));
+
+ Subprog : constant Node_Id :=
+ Make_Identifier (Sloc (Selector_Name (N)),
+ Chars => Chars (Selector_Name (N)));
-- Identifier on which possible interpretations will be collected
Report_Error : Boolean := False;
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;
-- 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)
-- --
-- B o d y --
-- --
--- 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- --
-- 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
-- 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;
-- --
-- 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- --
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);
OSDN Git Service
