===================================================================
@@ -4068,10 +4068,13 @@
-------------
-- Transforms 'Machine into a call to the floating-point attribute
- -- function Machine in Fat_xxx (where xxx is the root type)
+ -- function Machine in Fat_xxx (where xxx is the root type).
+ -- Expansion is avoided for cases the back end can handle directly.
when Attribute_Machine =>
- Expand_Fpt_Attribute_R (N);
+ if not Is_Inline_Floating_Point_Attribute (N) then
+ Expand_Fpt_Attribute_R (N);
+ end if;
----------------------
-- Machine_Rounding --
@@ -4335,10 +4338,13 @@
-----------
-- Transforms 'Model into a call to the floating-point attribute
- -- function Model in Fat_xxx (where xxx is the root type)
+ -- function Model in Fat_xxx (where xxx is the root type).
+ -- Expansion is avoided for cases the back end can handle directly.
when Attribute_Model =>
- Expand_Fpt_Attribute_R (N);
+ if not Is_Inline_Floating_Point_Attribute (N) then
+ Expand_Fpt_Attribute_R (N);
+ end if;
-----------------
-- Object_Size --
@@ -5411,9 +5417,12 @@
-- Transforms 'Rounding into a call to the floating-point attribute
-- function Rounding in Fat_xxx (where xxx is the root type)
+ -- Expansion is avoided for cases the back end can handle directly.
when Attribute_Rounding =>
- Expand_Fpt_Attribute_R (N);
+ if not Is_Inline_Floating_Point_Attribute (N) then
+ Expand_Fpt_Attribute_R (N);
+ end if;
-------------
-- Scaling --
@@ -7946,7 +7955,10 @@
Id : constant Attribute_Id := Get_Attribute_Id (Attribute_Name (N));
begin
- if Nkind (Parent (N)) /= N_Type_Conversion
+ if Id = Attribute_Machine or else Id = Attribute_Model then
+ return True;
+
+ elsif Nkind (Parent (N)) /= N_Type_Conversion
or else not Is_Integer_Type (Etype (Parent (N)))
then
return False;
@@ -7955,7 +7967,7 @@
-- Should also support 'Machine_Rounding and 'Unbiased_Rounding, but
-- required back end support has not been implemented yet ???
- return Id = Attribute_Truncation;
+ return Id = Attribute_Rounding or else Id = Attribute_Truncation;
end Is_Inline_Floating_Point_Attribute;
end Exp_Attr;
===================================================================
@@ -259,7 +259,7 @@
procedure Simplify_Type_Conversion (N : Node_Id);
-- Called after N has been resolved and evaluated, but before range checks
-- have been applied. Currently simplifies a combination of floating-point
- -- to integer conversion and Truncation attribute.
+ -- to integer conversion and Rounding or Truncation attribute.
function Unique_Fixed_Point_Type (N : Node_Id) return Entity_Id;
-- A universal_fixed expression in an universal context is unambiguous if
@@ -11082,29 +11082,36 @@
Opnd_Typ : constant Entity_Id := Etype (Operand);
begin
- if Is_Floating_Point_Type (Opnd_Typ)
- and then
- (Is_Integer_Type (Target_Typ)
- or else (Is_Fixed_Point_Type (Target_Typ)
- and then Conversion_OK (N)))
- and then Nkind (Operand) = N_Attribute_Reference
- and then Attribute_Name (Operand) = Name_Truncation
+ -- Special processing if the conversion is the expression of a
+ -- Rounding or Truncation attribute reference. In this case we
+ -- replace:
- -- Special processing required if the conversion is the expression
- -- of a Truncation attribute reference. In this case we replace:
+ -- ityp (ftyp'Rounding (x)) or ityp (ftyp'Truncation (x))
- -- ityp (ftyp'Truncation (x))
-
-- by
-- ityp (x)
- -- with the Float_Truncate flag set, which is more efficient.
+ -- with the Float_Truncate flag set to False or True respectively,
+ -- which is more efficient.
+ if Is_Floating_Point_Type (Opnd_Typ)
+ and then
+ (Is_Integer_Type (Target_Typ)
+ or else (Is_Fixed_Point_Type (Target_Typ)
+ and then Conversion_OK (N)))
+ and then Nkind (Operand) = N_Attribute_Reference
+ and then (Attribute_Name (Operand) = Name_Rounding
+ or else Attribute_Name (Operand) = Name_Truncation)
then
- Rewrite (Operand,
- Relocate_Node (First (Expressions (Operand))));
- Set_Float_Truncate (N, True);
+ declare
+ Truncate : constant Boolean :=
+ Attribute_Name (Operand) = Name_Truncation;
+ begin
+ Rewrite (Operand,
+ Relocate_Node (First (Expressions (Operand))));
+ Set_Float_Truncate (N, Truncate);
+ end;
end if;
end;
end if;
===================================================================
@@ -335,6 +335,9 @@
types whose size is greater or equal to 64 bits, or 0 if this alignment
is not specifically capped. */
extern int double_scalar_alignment;
+
+/* True if floating-point arithmetics may use wider intermediate results. */
+extern bool fp_arith_may_widen;
/* Data structures used to represent attributes. */
===================================================================
@@ -76,6 +76,9 @@
is not specifically capped. */
int double_scalar_alignment;
+/* True if floating-point arithmetics may use wider intermediate results. */
+bool fp_arith_may_widen = true;
+
/* Tree nodes for the various types and decls we create. */
tree gnat_std_decls[(int) ADT_LAST];
===================================================================
@@ -717,6 +717,9 @@
= { "float", "double", "long double" };
int iloop;
+ /* We are going to compute it below. */
+ fp_arith_may_widen = false;
+
for (iloop = 0; iloop < NUM_MACHINE_MODES; iloop++)
{
enum machine_mode i = (enum machine_mode) iloop;
@@ -766,6 +769,15 @@
if (!fmt)
continue;
+ /* Be conservative and consider that floating-point arithmetics may
+ use wider intermediate results as soon as there is an extended
+ Motorola or Intel mode supported by the machine. */
+ if (fmt == &ieee_extended_motorola_format
+ || fmt == &ieee_extended_intel_96_format
+ || fmt == &ieee_extended_intel_96_round_53_format
+ || fmt == &ieee_extended_intel_128_format)
+ fp_arith_may_widen = true;
+
if (fmt->b == 2)
digs = (fmt->p - 1) * 1233 / 4096; /* scale by log (2) */
===================================================================
@@ -76,18 +76,6 @@
#define BLOCK_SOURCE_END_LOCATION(BLOCK) block_end_locus_sink
#endif
-/* For efficient float-to-int rounding, it is necessary to know whether
- floating-point arithmetic may use wider intermediate results. When
- FP_ARITH_MAY_WIDEN is not defined, be conservative and only assume
- that arithmetic does not widen if double precision is emulated. */
-#ifndef FP_ARITH_MAY_WIDEN
-#if defined(HAVE_extendsfdf2)
-#define FP_ARITH_MAY_WIDEN HAVE_extendsfdf2
-#else
-#define FP_ARITH_MAY_WIDEN 0
-#endif
-#endif
-
/* Pointers to front-end tables accessed through macros. */
struct Node *Nodes_Ptr;
struct Flags *Flags_Ptr;
@@ -804,12 +792,15 @@
case Attr_Object_Size:
case Attr_Value_Size:
case Attr_Component_Size:
+ case Attr_Descriptor_Size:
case Attr_Max_Size_In_Storage_Elements:
case Attr_Min:
case Attr_Max:
case Attr_Null_Parameter:
case Attr_Passed_By_Reference:
case Attr_Mechanism_Code:
+ case Attr_Machine:
+ case Attr_Model:
return 0;
case Attr_Address:
@@ -2334,6 +2325,54 @@
}
break;
+ case Attr_Model:
+ /* We treat Model as identical to Machine. This is true for at least
+ IEEE and some other nice floating-point systems. */
+
+ /* ... fall through ... */
+
+ case Attr_Machine:
+ /* The trick is to force the compiler to store the result in memory so
+ that we do not have extra precision used. But do this only when this
+ is necessary, i.e. for a type that is not the longest floating-point
+ type and if FP_ARITH_MAY_WIDEN is true. */
+ prefix_unused = true;
+ gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ gnu_result = convert (gnu_result_type, gnu_expr);
+
+ if (gnu_result_type != longest_float_type_node && fp_arith_may_widen)
+ {
+ tree rec_type = make_node (RECORD_TYPE);
+ tree field
+ = create_field_decl (get_identifier ("OBJ"), gnu_result_type,
+ rec_type, NULL_TREE, NULL_TREE, 0, 0);
+ tree rec_val, asm_expr;
+
+ finish_record_type (rec_type, field, 0, false);
+
+ rec_val = build_constructor_single (rec_type, field, gnu_result);
+ rec_val = save_expr (rec_val);
+
+ asm_expr
+ = build5 (ASM_EXPR, void_type_node,
+ build_string (0, ""),
+ tree_cons (build_tree_list (NULL_TREE,
+ build_string (2, "=m")),
+ rec_val, NULL_TREE),
+ tree_cons (build_tree_list (NULL_TREE,
+ build_string (1, "m")),
+ rec_val, NULL_TREE),
+ NULL_TREE, NULL_TREE);
+ ASM_VOLATILE_P (asm_expr) = 1;
+
+ gnu_result
+ = build_compound_expr (gnu_result_type, asm_expr,
+ build_component_ref (rec_val, NULL_TREE,
+ field, false));
+ }
+ break;
+
default:
/* This abort means that we have an unimplemented attribute. */
gcc_unreachable ();
@@ -2347,7 +2386,7 @@
&& TREE_SIDE_EFFECTS (gnu_prefix)
&& !Is_Entity_Name (gnat_prefix))
gnu_result
- = build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix, gnu_result);
+ = build_compound_expr (TREE_TYPE (gnu_result), gnu_prefix, gnu_result);
*gnu_result_type_p = gnu_result_type;
return gnu_result;
@@ -8675,7 +8714,8 @@
/* Now convert to the result base type. If this is a non-truncating
float-to-integer conversion, round. */
- if (INTEGRAL_TYPE_P (gnu_base_type) && FLOAT_TYPE_P (gnu_in_basetype)
+ if (INTEGRAL_TYPE_P (gnu_base_type)
+ && FLOAT_TYPE_P (gnu_in_basetype)
&& !truncatep)
{
REAL_VALUE_TYPE half_minus_pred_half, pred_half;
@@ -8684,11 +8724,11 @@
const struct real_format *fmt;
/* The following calculations depend on proper rounding to even
- of each arithmetic operation. In order to prevent excess
+ of each arithmetic operation. In order to prevent excess
precision from spoiling this property, use the widest hardware
floating-point type if FP_ARITH_MAY_WIDEN is true. */
calc_type
- = FP_ARITH_MAY_WIDEN ? longest_float_type_node : gnu_in_basetype;
+ = fp_arith_may_widen ? longest_float_type_node : gnu_in_basetype;
/* FIXME: Should not have padding in the first place. */
if (TYPE_IS_PADDING_P (calc_type))