From: Robert Dewar Date: Tue, 15 Nov 2005 13:58:08 +0000 (+0100) Subject: exp_fixd.adb: Use Universal_Real instead of Long_Long_Float when... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=65b1b4317c419981d35e0f2c7e71236fd105bc96;p=gcc.git exp_fixd.adb: Use Universal_Real instead of Long_Long_Float when... 2005-11-14 Robert Dewar * exp_fixd.adb: Use Universal_Real instead of Long_Long_Float when we need a high precision float type for the generated code (prevents gratuitous Vax_Float stuff when pragma Float_Representation (Vax_Float) used). * exp_imgv.adb: Use Universal_Real instead of Long_Long_Float when we need a high precision float type for the generated code (prevents gratuitous Vax_Float stuff when pragma Float_Representation (Vax_Float) used). (Expand_Width_Attribute): In configurable run-time, the attribute is not allowed on non-static enumeration subtypes. Force a load error to emit the correct diagnostic. From-SVN: r106975 --- diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 511392d5f78..fa1f8403ac8 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2005, 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- -- @@ -61,8 +61,7 @@ package body Exp_Fixd is (N : Node_Id; Typ : Entity_Id; Expr : Node_Id; - Rchk : Boolean := False) - return Node_Id; + Rchk : Boolean := False) return Node_Id; -- Build an expression that converts the expression Expr to type Typ, -- taking the source location from Sloc (N). If the conversions involve -- fixed-point types, then the Conversion_OK flag will be set so that the @@ -72,21 +71,19 @@ package body Exp_Fixd is function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id; -- Builds an N_Op_Divide node from the given left and right operand - -- expressions, using the source location from Sloc (N). The operands - -- are either both Long_Long_Float, in which case Build_Divide differs - -- from Make_Op_Divide only in that the Etype of the resulting node is - -- set (to Long_Long_Float), or they can be integer types. In this case - -- the integer types need not be the same, and Build_Divide converts - -- the operand with the smaller sized type to match the type of the - -- other operand and sets this as the result type. The Rounded_Result - -- flag of the result in this case is set from the Rounded_Result flag - -- of node N. On return, the resulting node is analyzed, and has its - -- Etype set. + -- expressions, using the source location from Sloc (N). The operands are + -- either both Universal_Real, in which case Build_Divide differs from + -- Make_Op_Divide only in that the Etype of the resulting node is set (to + -- Universal_Real), or they can be integer types. In this case the integer + -- types need not be the same, and Build_Divide converts the operand with + -- the smaller sized type to match the type of the other operand and sets + -- this as the result type. The Rounded_Result flag of the result in this + -- case is set from the Rounded_Result flag of node N. On return, the + -- resulting node is analyzed, and has its Etype set. function Build_Double_Divide (N : Node_Id; - X, Y, Z : Node_Id) - return Node_Id; + X, Y, Z : Node_Id) return Node_Id; -- Returns a node corresponding to the value X/(Y*Z) using the source -- location from Sloc (N). The division is rounded if the Rounded_Result -- flag of N is set. The integer types of X, Y, Z may be different. On @@ -100,37 +97,35 @@ package body Exp_Fixd is -- Generates a sequence of code for determining the quotient and remainder -- of the division X/(Y*Z), using the source location from Sloc (N). -- Entities of appropriate types are allocated for the quotient and - -- remainder and returned in Qnn and Rnn. The result is rounded if - -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn - -- are appropriately set on return. + -- remainder and returned in Qnn and Rnn. The result is rounded if the + -- Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are + -- appropriately set on return. function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id; -- Builds an N_Op_Multiply node from the given left and right operand - -- expressions, using the source location from Sloc (N). The operands - -- are either both Long_Long_Float, in which case Build_Divide differs - -- from Make_Op_Multiply only in that the Etype of the resulting node is - -- set (to Long_Long_Float), or they can be integer types. In this case - -- the integer types need not be the same, and Build_Multiply chooses - -- a type long enough to hold the product (i.e. twice the size of the - -- longer of the two operand types), and both operands are converted - -- to this type. The Etype of the result is also set to this value. - -- However, the result can never overflow Integer_64, so this is the - -- largest type that is ever generated. On return, the resulting node - -- is analyzed and has its Etype set. + -- expressions, using the source location from Sloc (N). The operands are + -- either both Universal_Real, in which case Build_Divide differs from + -- Make_Op_Multiply only in that the Etype of the resulting node is set (to + -- Universal_Real), or they can be integer types. In this case the integer + -- types need not be the same, and Build_Multiply chooses a type long + -- enough to hold the product (i.e. twice the size of the longer of the two + -- operand types), and both operands are converted to this type. The Etype + -- of the result is also set to this value. However, the result can never + -- overflow Integer_64, so this is the largest type that is ever generated. + -- On return, the resulting node is analyzed and has its Etype set. function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id; -- Builds an N_Op_Rem node from the given left and right operand - -- expressions, using the source location from Sloc (N). The operands - -- are both integer types, which need not be the same. Build_Rem - -- converts the operand with the smaller sized type to match the type - -- of the other operand and sets this as the result type. The result - -- is never rounded (rem operations cannot be rounded in any case!) - -- On return, the resulting node is analyzed and has its Etype set. + -- expressions, using the source location from Sloc (N). The operands are + -- both integer types, which need not be the same. Build_Rem converts the + -- operand with the smaller sized type to match the type of the other + -- operand and sets this as the result type. The result is never rounded + -- (rem operations cannot be rounded in any case!) On return, the resulting + -- node is analyzed and has its Etype set. function Build_Scaled_Divide (N : Node_Id; - X, Y, Z : Node_Id) - return Node_Id; + X, Y, Z : Node_Id) return Node_Id; -- Returns a node corresponding to the value X*Y/Z using the source -- location from Sloc (N). The division is rounded if the Rounded_Result -- flag of N is set. The integer types of X, Y, Z may be different. On @@ -183,10 +178,10 @@ package body Exp_Fixd is function Fpt_Value (N : Node_Id) return Node_Id; -- Given an operand of fixed-point operation, return an expression that - -- represents the corresponding Long_Long_Float value. The expression + -- represents the corresponding Universal_Real value. The expression -- can be of integer type, floating-point type, or fixed-point type. -- The expression returned is neither analyzed and resolved. The Etype - -- of the result is properly set (to Long_Long_Float). + -- of the result is properly set (to Universal_Real). function Integer_Literal (N : Node_Id; V : Uint) return Node_Id; -- Given a non-negative universal integer value, build a typed integer @@ -198,8 +193,8 @@ package body Exp_Fixd is function Real_Literal (N : Node_Id; V : Ureal) return Node_Id; -- Build a real literal node from the given value, the Etype of the - -- returned node is set to Long_Long_Float, since all floating-point - -- arithmetic operations that we construct use Long_Long_Float + -- returned node is set to Universal_Real, since all floating-point + -- arithmetic operations that we construct use Universal_Real function Rounded_Result_Set (N : Node_Id) return Boolean; -- Returns True if N is a node that contains the Rounded_Result flag @@ -224,8 +219,7 @@ package body Exp_Fixd is (N : Node_Id; Typ : Entity_Id; Expr : Node_Id; - Rchk : Boolean := False) - return Node_Id + Rchk : Boolean := False) return Node_Id is Loc : constant Source_Ptr := Sloc (N); Result : Node_Id; @@ -296,7 +290,6 @@ package body Exp_Fixd is Set_Etype (Result, Typ); return Result; - end Build_Conversion; ------------------ @@ -314,11 +307,11 @@ package body Exp_Fixd is -- Deal with floating-point case first if Is_Floating_Point_Type (Left_Type) then - pragma Assert (Left_Type = Standard_Long_Long_Float); - pragma Assert (Right_Type = Standard_Long_Long_Float); + pragma Assert (Left_Type = Universal_Real); + pragma Assert (Right_Type = Universal_Real); Rnode := Make_Op_Divide (Loc, L, R); - Result_Type := Standard_Long_Long_Float; + Result_Type := Universal_Real; -- Integer and fixed-point cases @@ -384,7 +377,6 @@ package body Exp_Fixd is end if; return Rnode; - end Build_Divide; ------------------------- @@ -393,8 +385,7 @@ package body Exp_Fixd is function Build_Double_Divide (N : Node_Id; - X, Y, Z : Node_Id) - return Node_Id + X, Y, Z : Node_Id) return Node_Id is Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); Z_Size : constant Int := UI_To_Int (Esize (Etype (Z))); @@ -582,7 +573,6 @@ package body Exp_Fixd is New_Occurrence_Of (Rnn, Loc), New_Occurrence_Of (Rnd, Loc)))); end if; - end Build_Double_Divide_Code; -------------------- @@ -603,10 +593,10 @@ package body Exp_Fixd is -- Deal with floating-point case first if Is_Floating_Point_Type (Left_Type) then - pragma Assert (Left_Type = Standard_Long_Long_Float); - pragma Assert (Right_Type = Standard_Long_Long_Float); + pragma Assert (Left_Type = Universal_Real); + pragma Assert (Right_Type = Universal_Real); - Result_Type := Standard_Long_Long_Float; + Result_Type := Universal_Real; Rnode := Make_Op_Multiply (Loc, L, R); -- Integer and fixed-point cases @@ -782,8 +772,7 @@ package body Exp_Fixd is function Build_Scaled_Divide (N : Node_Id; - X, Y, Z : Node_Id) - return Node_Id + X, Y, Z : Node_Id) return Node_Id is X_Size : constant Int := UI_To_Int (Esize (Etype (X))); Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); @@ -1060,7 +1049,6 @@ package body Exp_Fixd is Build_Multiply (N, Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)), Real_Literal (N, Frac))); - end Do_Divide_Fixed_Fixed; ------------------------------- @@ -1176,7 +1164,6 @@ package body Exp_Fixd is Set_Result (N, Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); - end Do_Divide_Fixed_Universal; ------------------------------- @@ -1295,7 +1282,6 @@ package body Exp_Fixd is Set_Result (N, Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right))); - end Do_Divide_Universal_Fixed; ----------------------------- @@ -1380,7 +1366,6 @@ package body Exp_Fixd is Build_Multiply (N, Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)), Real_Literal (N, Frac))); - end Do_Multiply_Fixed_Fixed; --------------------------------- @@ -1420,7 +1405,7 @@ package body Exp_Fixd is -- If denominator = 1, then for K = 1, the small ratio is an integer, and -- this is clearly the minimum K case, so set - -- K = 1, Right_Small = Lit_Value. + -- K = 1, Right_Small = Lit_Value -- If denominator > 1, then set K to the numerator of the fraction, so -- that the resulting small ratio is the reciprocal of the integer (the @@ -1498,7 +1483,6 @@ package body Exp_Fixd is Set_Result (N, Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); - end Do_Multiply_Fixed_Universal; --------------------------------- @@ -1553,7 +1537,6 @@ package body Exp_Fixd is Ratio_Den := Norm_Den (Small_Ratio); if Ratio_Den = 1 then - if Ratio_Num = 1 then Set_Result (N, Expr); return; @@ -1585,7 +1568,6 @@ package body Exp_Fixd is Fpt_Value (Expr), Real_Literal (N, Small_Ratio)), Rng_Check); - end Expand_Convert_Fixed_To_Fixed; ----------------------------------- @@ -1594,7 +1576,7 @@ package body Exp_Fixd is -- If the small of the fixed type is 1.0, then we simply convert the -- integer value directly to the target floating-point type, otherwise - -- we first have to multiply by the small, in Long_Long_Float, and then + -- we first have to multiply by the small, in Universal_Real, and then -- convert the result to the target floating-point type. procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is @@ -1679,7 +1661,6 @@ package body Exp_Fixd is Fpt_Value (Expr), Real_Literal (N, Small)), Rng_Check); - end Expand_Convert_Fixed_To_Integer; ----------------------------------- @@ -1776,7 +1757,6 @@ package body Exp_Fixd is Fpt_Value (Expr), Real_Literal (N, Ureal_1 / Small)), Rng_Check); - end Expand_Convert_Integer_To_Fixed; -------------------------------- @@ -1826,7 +1806,7 @@ package body Exp_Fixd is -- division or multiplication by the appropriate power of 10. procedure Expand_Decimal_Divide_Call (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); + Loc : constant Source_Ptr := Sloc (N); Dividend : Node_Id := First_Actual (N); Divisor : Node_Id := Next_Actual (Dividend); @@ -1971,7 +1951,6 @@ package body Exp_Fixd is Statements => Stmts))); Analyze (N); - end Expand_Decimal_Divide_Call; ----------------------------------------------- @@ -1999,14 +1978,13 @@ package body Exp_Fixd is else Do_Divide_Fixed_Fixed (N); end if; - end Expand_Divide_Fixed_By_Fixed_Giving_Fixed; ----------------------------------------------- -- Expand_Divide_Fixed_By_Fixed_Giving_Float -- ----------------------------------------------- - -- The division is done in long_long_float, and the result is multiplied + -- The division is done in Universal_Real, and the result is multiplied -- by the small ratio, which is Small (Right) / Small (Left). Special -- treatment is required for universal operands, which represent their -- own value and do not require conversion. @@ -2065,7 +2043,6 @@ package body Exp_Fixd is Real_Literal (N, Small_Value (Left_Type) / Small_Value (Right_Type)))); end if; - end Expand_Divide_Fixed_By_Fixed_Giving_Float; ------------------------------------------------- @@ -2075,18 +2052,14 @@ package body Exp_Fixd is procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); - begin if Etype (Left) = Universal_Real then Do_Divide_Universal_Fixed (N); - elsif Etype (Right) = Universal_Real then Do_Divide_Fixed_Universal (N); - else Do_Divide_Fixed_Fixed (N); end if; - end Expand_Divide_Fixed_By_Fixed_Giving_Integer; ------------------------------------------------- @@ -2099,7 +2072,6 @@ package body Exp_Fixd is procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); - begin Set_Result (N, Build_Divide (N, Left, Right)); end Expand_Divide_Fixed_By_Integer_Giving_Fixed; @@ -2118,9 +2090,12 @@ package body Exp_Fixd is -- as a fixed * fixed multiplication, and convert the argument to -- the target fixed type. - procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); + ---------------------------------- + -- Rewrite_Non_Static_Universal -- + ---------------------------------- + procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is + Loc : constant Source_Ptr := Sloc (N); begin Rewrite (Opnd, Make_Type_Conversion (Loc, @@ -2129,6 +2104,8 @@ package body Exp_Fixd is Analyze_And_Resolve (Opnd, Etype (N)); end Rewrite_Non_Static_Universal; + -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed + begin -- Suppress expansion of a fixed-by-fixed multiplication if the -- operation is supported directly by the target. @@ -2158,14 +2135,13 @@ package body Exp_Fixd is else Do_Multiply_Fixed_Fixed (N); end if; - end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed; ------------------------------------------------- -- Expand_Multiply_Fixed_By_Fixed_Giving_Float -- ------------------------------------------------- - -- The multiply is done in long_long_float, and the result is multiplied + -- The multiply is done in Universal_Real, and the result is multiplied -- by the adjustment for the smalls which is Small (Right) * Small (Left). -- Special treatment is required for universal operands. @@ -2220,7 +2196,6 @@ package body Exp_Fixd is Real_Literal (N, Small_Value (Right_Type) * Small_Value (Left_Type)))); end if; - end Expand_Multiply_Fixed_By_Fixed_Giving_Float; --------------------------------------------------- @@ -2230,18 +2205,14 @@ package body Exp_Fixd is procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is Left : constant Node_Id := Left_Opnd (N); Right : constant Node_Id := Right_Opnd (N); - begin if Etype (Left) = Universal_Real then Do_Multiply_Fixed_Universal (N, Right, Left); - elsif Etype (Right) = Universal_Real then Do_Multiply_Fixed_Universal (N, Left, Right); - else Do_Multiply_Fixed_Fixed (N); end if; - end Expand_Multiply_Fixed_By_Fixed_Giving_Integer; --------------------------------------------------- @@ -2281,17 +2252,13 @@ package body Exp_Fixd is if Is_Integer_Type (Typ) or else Is_Floating_Point_Type (Typ) then - return - Build_Conversion - (N, Standard_Long_Long_Float, N); + return Build_Conversion (N, Universal_Real, N); -- Fixed-point case, must get integer value first else - return - Build_Conversion (N, Standard_Long_Long_Float, N); + return Build_Conversion (N, Universal_Real, N); end if; - end Fpt_Value; --------------------- @@ -2348,7 +2315,7 @@ package body Exp_Fixd is -- Set type of result in case used elsewhere (see note at start) - Set_Etype (L, Standard_Long_Long_Float); + Set_Etype (L, Universal_Real); return L; end Real_Literal; @@ -2358,7 +2325,6 @@ package body Exp_Fixd is function Rounded_Result_Set (N : Node_Id) return Boolean is K : constant Node_Kind := Nkind (N); - begin if (K = N_Type_Conversion or else K = N_Op_Divide or else @@ -2399,7 +2365,6 @@ package body Exp_Fixd is Rewrite (N, Cnode); Analyze_And_Resolve (N, Result_Type); - end Set_Result; end Exp_Fixd; diff --git a/gcc/ada/exp_imgv.adb b/gcc/ada/exp_imgv.adb index 6e25788cfd5..1fdbced6814 100644 --- a/gcc/ada/exp_imgv.adb +++ b/gcc/ada/exp_imgv.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005 Free Software Foundation, Inc. -- +-- Copyright (C) 2001-2005, 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- -- @@ -831,6 +831,22 @@ package body Exp_Imgv is else pragma Assert (Is_Enumeration_Type (Rtyp)); + if Discard_Names (Rtyp) then + + -- This is a configurable run-time, or else a restriction is in + -- effect. In either case the attribute cannot be supported. Force + -- a load error from Rtsfind to generate an appropriate message, + -- as is done with other ZFP violations. + + declare + pragma Warnings (Off); -- since Discard is unreferenced + Discard : constant Entity_Id := RTE (RE_Null); + pragma Warnings (On); + begin + return; + end; + end if; + Ttyp := Component_Type (Etype (Lit_Indexes (Rtyp))); case Attr is