+2010-06-22 Thomas Quinot <quinot@adacore.com>
+
+ * exp_aggr.adb (Rewrite_Discriminant): Fix predicate used to identify
+ reference to discriminant (can be an expanded name as well as an
+ identifier).
+
+2010-06-22 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_ch6.adb: Clarify comment.
+
+2010-06-22 Geert Bosch <bosch@adacore.com>
+
+ * exp_imgv.adb (Expand_Image_Attribute): Treat ordinary fixed point
+ with decimal small as decimal types, avoiding floating-point arithmetic.
+ (Has_Decimal_Small): New function.
+ * einfo.ads, einfo.adb (Aft_Value): New synthesized attributed for
+ fixed point types.
+ * sem_attr.adb (Eval_Attribute): Remove Aft_Value function and update
+ callers to call the new function in Einfo that takes the entity as
+ parameter.
+
2010-06-22 Robert Dewar <dewar@adacore.com>
* sem_ch3.adb, sem_ch8.adb: Minor reformatting.
return Flag104 (Id);
end Address_Taken;
+ function Aft_Value (Id : E) return U is
+ Result : Nat := 1;
+ Delta_Val : Ureal := Delta_Value (Id);
+ begin
+ while Delta_Val < Ureal_Tenth loop
+ Delta_Val := Delta_Val * Ureal_10;
+ Result := Result + 1;
+ end loop;
+
+ return UI_From_Int (Result);
+ end Aft_Value;
+
function Alias (Id : E) return E is
begin
pragma Assert
-- make sure that the address can be meaningfully taken, and also in
-- the case of subprograms to control output of certain warnings.
+-- Aft_Value (synthesized)
+-- Applies to fixed and decimal types. Computes a universal integer
+-- that holds value of the Aft attribute for the type.
+
-- Alias (Node18)
-- Present in overloaded entities (literals, subprograms, entries) and
-- subprograms that cover a primitive operation of an abstract interface
-- Small_Value (Ureal21)
-- Has_Machine_Radix_Clause (Flag83)
-- Machine_Radix_10 (Flag84)
+ -- Aft_Value (synth)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- Scalar_Range (Node20)
-- Small_Value (Ureal21)
-- Has_Small_Clause (Flag67)
+ -- Aft_Value (synth)
-- Type_Low_Bound (synth)
-- Type_High_Bound (synth)
-- (plus type attributes)
-- so they do not correspond to defined fields in the entity itself.
function Address_Clause (Id : E) return N;
+ function Aft_Value (Id : E) return U;
function Alignment_Clause (Id : E) return N;
function Base_Type (Id : E) return E;
function Declaration_Node (Id : E) return N;
function Rewrite_Discriminant (Expr : Node_Id) return Traverse_Result is
begin
- if Nkind (Expr) = N_Identifier
+ if Is_Entity_Name (Expr)
and then Present (Entity (Expr))
and then Ekind (Entity (Expr)) = E_In_Parameter
and then Present (Discriminal_Link (Entity (Expr)))
function Is_Build_In_Place_Function (E : Entity_Id) return Boolean is
begin
- -- This function is called in some rare cases when expansion is off.
- -- In those cases the build_in_place expansion will not take place.
+ -- This function is called from Expand_Subtype_From_Expr during
+ -- semantic analysis, even when expansion is off. In those cases
+ -- the build_in_place expansion will not take place.
if not Expander_Active then
return False;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-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- --
with Tbuild; use Tbuild;
with Ttypes; use Ttypes;
with Uintp; use Uintp;
+with Urealp; use Urealp;
package body Exp_Imgv is
+ function Has_Decimal_Small (E : Entity_Id) return Boolean;
+ -- Applies to all entities. True for a Decimal_Fixed_Point_Type, or an
+ -- Ordinary_Fixed_Point_Type with a small that is a negative power of ten.
+ -- Shouldn't this be in einfo.adb or sem_aux.adb???
+
------------------------------------
-- Build_Enumeration_Image_Tables --
------------------------------------
Tent := RTE (RE_Long_Long_Unsigned);
end if;
- elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
+ elsif Is_Fixed_Point_Type (Rtyp) and then Has_Decimal_Small (Rtyp) then
if UI_To_Int (Esize (Rtyp)) <= Standard_Integer_Size then
Imid := RE_Image_Decimal;
Tent := Standard_Integer;
Prefix => New_Reference_To (Ptyp, Loc),
Attribute_Name => Name_Aft));
+ if Has_Decimal_Small (Rtyp) then
+ Set_Conversion_OK (First (Arg_List));
+ Set_Etype (First (Arg_List), Tent);
+ end if;
+
-- For decimal, append Scale and also set to do literal conversion
elsif Is_Decimal_Fixed_Point_Type (Rtyp) then
Analyze_And_Resolve (N, Typ);
end Expand_Width_Attribute;
+ -----------------------
+ -- Has_Decimal_Small --
+ -----------------------
+
+ function Has_Decimal_Small (E : Entity_Id) return Boolean is
+ begin
+ return Is_Decimal_Fixed_Point_Type (E)
+ or else
+ (Is_Ordinary_Fixed_Point_Type (E)
+ and then Ureal_10**Aft_Value (E) * Small_Value (E) = Ureal_1);
+ end Has_Decimal_Small;
+
end Exp_Imgv;
-- processing, since otherwise gigi might see an attribute which it is
-- unprepared to deal with.
- function Aft_Value return Nat;
- -- Computes Aft value for current attribute prefix (used by Aft itself
- -- and also by Width for computing the Width of a fixed point type).
-
procedure Check_Concurrent_Discriminant (Bound : Node_Id);
-- If Bound is a reference to a discriminant of a task or protected type
-- occurring within the object's body, rewrite attribute reference into
-- Verify that the prefix of a potentially static array attribute
-- satisfies the conditions of 4.9 (14).
- ---------------
- -- Aft_Value --
- ---------------
-
- function Aft_Value return Nat is
- Result : Nat;
- Delta_Val : Ureal;
-
- begin
- Result := 1;
- Delta_Val := Delta_Value (P_Type);
- while Delta_Val < Ureal_Tenth loop
- Delta_Val := Delta_Val * Ureal_10;
- Result := Result + 1;
- end loop;
-
- return Result;
- end Aft_Value;
-
-----------------------------------
-- Check_Concurrent_Discriminant --
-----------------------------------
---------
when Attribute_Aft =>
- Fold_Uint (N, UI_From_Int (Aft_Value), True);
+ Fold_Uint (N, Aft_Value (P_Type), True);
---------------
-- Alignment --
-- For fixed-point type width is Fore + 1 + Aft (RM 3.5(34))
Fold_Uint
- (N, UI_From_Int (Fore_Value + 1 + Aft_Value), True);
+ (N, UI_From_Int (Fore_Value + 1) + Aft_Value (P_Type),
+ True);
end if;
-- Discrete types
projects / platform / upstream / gcc.git / commitdiff