-- --
-- B o d y --
-- --
--- --
--- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2008, 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- --
--- ware Foundation; either version 2, or (at your option) any later ver- --
+-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
-- for more details. You should have received a copy of the GNU General --
--- Public License distributed with GNAT; see file COPYING. If not, write --
--- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
--- MA 02111-1307, USA. --
+-- Public License distributed with GNAT; see file COPYING3. If not, go to --
+-- http://www.gnu.org/licenses for a complete copy of the license. --
-- --
-- GNAT was originally developed by the GNAT team at New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc. --
-- --
------------------------------------------------------------------------------
with Exp_Util; use Exp_Util;
with Nlists; use Nlists;
with Nmake; use Nmake;
-with Restrict; use Restrict;
with Rtsfind; use Rtsfind;
with Sem; use Sem;
with Sem_Eval; use Sem_Eval;
with Sinfo; use Sinfo;
with Stand; use Stand;
with Tbuild; use Tbuild;
-with Ttypes; use Ttypes;
with Uintp; use Uintp;
with Urealp; use Urealp;
-- still dealing with a normal fixed-point operation and mess it up).
function Build_Conversion
- (N : Node_Id;
- Typ : Entity_Id;
- Expr : Node_Id;
- Rchk : Boolean := False)
- return Node_Id;
+ (N : Node_Id;
+ Typ : Entity_Id;
+ Expr : Node_Id;
+ Rchk : Boolean := False;
+ Trunc : 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
-- resulting conversions do not get re-expanded. On return the resulting
-- node has its Etype set. If Rchk is set, then Do_Range_Check is set
- -- in the resulting conversion node.
+ -- in the resulting conversion node. If Trunc is set, then the
+ -- Float_Truncate flag is set on the conversion, which must be from
+ -- a floating-point type to an integer type.
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
-- 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_Multiply 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
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;
+ function Integer_Literal
+ (N : Node_Id;
+ V : Uint;
+ Negative : Boolean := False) return Node_Id;
-- Given a non-negative universal integer value, build a typed integer
-- literal node, using the smallest applicable standard integer type. If
- -- the value exceeds 2**63-1, the largest value allowed for perfect result
- -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
- -- node N provides the Sloc value for the constructed literal. The Etype
- -- of the resulting literal is correctly set, and it is marked as analyzed.
+ -- and only if Negative is true a negative literal is built. If V exceeds
+ -- 2**63-1, the largest value allowed for perfect result set scaling
+ -- factors (see RM G.2.3(22)), then Empty is returned. The node N provides
+ -- the Sloc value for the constructed literal. The Etype of the resulting
+ -- literal is correctly set, and it is marked as analyzed.
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
- -- and if the flag is true.
+ -- and if the flag is true or the target type is an integer type.
- procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
+ procedure Set_Result
+ (N : Node_Id;
+ Expr : Node_Id;
+ Rchk : Boolean := False;
+ Trunc : Boolean := False);
-- N is the node for the current conversion, division or multiplication
- -- operation, and Expr is an expression representing the result. Expr
- -- may be of floating-point or integer type. If the operation result
- -- is fixed-point, then the value of Expr is in units of small of the
- -- result type (i.e. small's have already been dealt with). The result
- -- of the call is to replace N by an appropriate conversion to the
- -- result type, dealing with rounding for the decimal types case. The
- -- node is then analyzed and resolved using the result type. If Rchk
- -- is True, then Do_Range_Check is set in the resulting conversion.
+ -- operation, and Expr is an expression representing the result. Expr may
+ -- be of floating-point or integer type. If the operation result is fixed-
+ -- point, then the value of Expr is in units of small of the result type
+ -- (i.e. small's have already been dealt with). The result of the call is
+ -- to replace N by an appropriate conversion to the result type, dealing
+ -- with rounding for the decimal types case. The node is then analyzed and
+ -- resolved using the result type. If Rchk or Trunc are True, then
+ -- respectively Do_Range_Check and Float_Truncate are set in the
+ -- resulting conversion.
----------------------
-- Build_Conversion --
----------------------
function Build_Conversion
- (N : Node_Id;
- Typ : Entity_Id;
- Expr : Node_Id;
- Rchk : Boolean := False)
- return Node_Id
+ (N : Node_Id;
+ Typ : Entity_Id;
+ Expr : Node_Id;
+ Rchk : Boolean := False;
+ Trunc : Boolean := False) return Node_Id
is
Loc : constant Source_Ptr := Sloc (N);
Result : Node_Id;
Make_Type_Conversion (Loc,
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
Expression => Expr);
+
+ Set_Float_Truncate (Result, Trunc);
end if;
-- Set Conversion_OK if either result or expression type is a
Set_Etype (Result, Typ);
return Result;
-
end Build_Conversion;
------------------
-- 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
end if;
return Rnode;
-
end Build_Divide;
-------------------------
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)));
Expr : Node_Id;
begin
- if Y_Size > System_Word_Size
- or else
- Z_Size > System_Word_Size
- then
- Disallow_In_No_Run_Time_Mode (N);
- end if;
-
-- If denominator fits in 64 bits, we can build the operations directly
-- without causing any intermediate overflow, so that's what we do!
Rnn : Entity_Id;
Code : List_Id;
+ pragma Warnings (Off, Rnn);
+
begin
Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
Insert_Actions (N, Code);
-- call the runtime routine to compute the quotient and remainder
else
- if Rounded_Result_Set (N) then
- Rnd := Standard_True;
- else
- Rnd := Standard_False;
- end if;
+ Rnd := Boolean_Literals (Rounded_Result_Set (N));
Code := New_List (
Make_Object_Declaration (Loc,
New_Occurrence_Of (Rnn, Loc),
New_Occurrence_Of (Rnd, Loc))));
end if;
-
end Build_Double_Divide_Code;
--------------------
Loc : constant Source_Ptr := Sloc (N);
Left_Type : constant Entity_Id := Etype (L);
Right_Type : constant Entity_Id := Etype (R);
+ Left_Size : Int;
+ Right_Size : Int;
Rsize : Int;
Result_Type : Entity_Id;
Rnode : Node_Id;
-- 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
return R;
end if;
- -- Otherwise we use a type that is at least twice the longer
- -- of the two sizes.
+ -- Otherwise we need to figure out the correct result type size
+ -- First figure out the effective sizes of the operands. Normally
+ -- the effective size of an operand is the RM_Size of the operand.
+ -- But a special case arises with operands whose size is known at
+ -- compile time. In this case, we can use the actual value of the
+ -- operand to get its size if it would fit signed in 8 or 16 bits.
+
+ Left_Size := UI_To_Int (RM_Size (Left_Type));
+
+ if Compile_Time_Known_Value (L) then
+ declare
+ Val : constant Uint := Expr_Value (L);
+ begin
+ if Val < Int'(2 ** 7) then
+ Left_Size := 8;
+ elsif Val < Int'(2 ** 15) then
+ Left_Size := 16;
+ end if;
+ end;
+ end if;
+
+ Right_Size := UI_To_Int (RM_Size (Right_Type));
+
+ if Compile_Time_Known_Value (R) then
+ declare
+ Val : constant Uint := Expr_Value (R);
+ begin
+ if Val <= Int'(2 ** 7) then
+ Right_Size := 8;
+ elsif Val <= Int'(2 ** 15) then
+ Right_Size := 16;
+ end if;
+ end;
+ end if;
+
+ -- Now the result size must be at least twice the longer of
+ -- the two sizes, to accommodate all possible results.
- Rsize := 2 * Int'Max (UI_To_Int (Esize (Left_Type)),
- UI_To_Int (Esize (Right_Type)));
+ Rsize := 2 * Int'Max (Left_Size, Right_Size);
if Rsize <= 8 then
Result_Type := Standard_Integer_8;
Result_Type := Standard_Integer_32;
else
- if Rsize > System_Word_Size then
- Disallow_In_No_Run_Time_Mode (N);
- end if;
-
Result_Type := Standard_Integer_64;
end if;
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)));
Rnn : Entity_Id;
Code : List_Id;
+ pragma Warnings (Off, Rnn);
+
begin
Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
Insert_Actions (N, Code);
-- call the runtime routine to compute the quotient and remainder
else
- if Rounded_Result_Set (N) then
- Rnd := Standard_True;
- else
- Rnd := Standard_False;
- end if;
+ Rnd := Boolean_Literals (Rounded_Result_Set (N));
Code := New_List (
Make_Object_Declaration (Loc,
New_Occurrence_Of (Rnd, Loc))));
end if;
- -- Set type of result, for use in caller.
+ -- Set type of result, for use in caller
Set_Etype (Qnn, QR_Typ);
end Build_Scaled_Divide_Code;
-- would lose precision).
if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
+ Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
if Present (Lit_Int) then
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
-- divisions), and we don't get inaccuracies from double rounding.
elsif Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
+ Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
if Present (Lit_Int) then
Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
Build_Multiply (N,
Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
Real_Literal (N, Frac)));
-
end Do_Divide_Fixed_Fixed;
-------------------------------
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
- -- First we reduce the left fraction to lowest terms.
+ -- First we reduce the left fraction to lowest terms
-- If numerator = 1, then for K = 1, the small ratio is the reciprocal
-- of an integer, and this is clearly the minimum K case, so set K = 1,
-- where the result can be obtained by dividing by this integer value.
if Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
+ Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
if Present (Lit_Int) then
Set_Result (N, Build_Divide (N, Left, Lit_Int));
-- would lose precision).
else
- Lit_Int := Integer_Literal (N, Frac_Num);
- Lit_K := Integer_Literal (N, Frac_Den);
+ Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
+ Lit_K := Integer_Literal (N, Frac_Den, False);
if Present (Lit_Int) and then Present (Lit_K) then
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
Set_Result (N,
Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
-
end Do_Divide_Fixed_Universal;
-------------------------------
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
- -- First we reduce the left fraction to lowest terms.
+ -- First we reduce the left fraction to lowest terms
-- If denominator = 1, then for K = 1, the small ratio is an integer
-- (the numerator) and this is clearly the minimum K case, so set K = 1,
-- can be obtained by dividing this integer by the right operand.
if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
+ Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
if Present (Lit_Int) then
Set_Result (N, Build_Divide (N, Lit_Int, Right));
-- is important (if we divided first, we would lose precision).
else
- Lit_Int := Integer_Literal (N, Frac_Den);
- Lit_K := Integer_Literal (N, Frac_Num);
+ Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
+ Lit_K := Integer_Literal (N, Frac_Num, False);
if Present (Lit_Int) and then Present (Lit_K) then
Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
Set_Result (N,
Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
-
end Do_Divide_Universal_Fixed;
-----------------------------
-- the operands, and then multiplying the result by the integer value.
if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
+ Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
if Present (Lit_Int) then
Set_Result (N,
-- divided first, we would lose precision.
elsif Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
+ Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
if Present (Lit_Int) then
Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
Build_Multiply (N,
Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
Real_Literal (N, Frac)));
-
end Do_Multiply_Fixed_Fixed;
---------------------------------
-- is an integer or the reciprocal of an integer, and for
-- implementation efficiency we need the smallest such K.
- -- First we reduce the left fraction to lowest terms.
+ -- First we reduce the left fraction to lowest terms
+
+ -- If denominator = 1, then for K = 1, the small ratio is an integer, and
+ -- this is clearly the minimum K case, so set
- -- 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 denominator 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
+ -- denominator value).
procedure Do_Multiply_Fixed_Universal
(N : Node_Id;
-- be obtained by multiplying by this integer value.
if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
+ Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
if Present (Lit_Int) then
Set_Result (N, Build_Multiply (N, Left, Lit_Int));
-- dividing by the integer value.
else
- Lit_Int := Integer_Literal (N, Frac_Den);
+ Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
Lit_K := Integer_Literal (N, Frac_Num);
if Present (Lit_Int) and then Present (Lit_K) then
Set_Result (N,
Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
-
end Do_Multiply_Fixed_Universal;
---------------------------------
Ratio_Den := Norm_Den (Small_Ratio);
if Ratio_Den = 1 then
-
if Ratio_Num = 1 then
Set_Result (N, Expr);
return;
Fpt_Value (Expr),
Real_Literal (N, Small_Ratio)),
Rng_Check);
-
end Expand_Convert_Fixed_To_Fixed;
-----------------------------------
-- 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
Fpt_Value (Expr),
Real_Literal (N, Small)),
Rng_Check);
-
end Expand_Convert_Fixed_To_Integer;
-----------------------------------
-- Optimize small = 1, where we can avoid the multiply completely
if Small = Ureal_1 then
- Set_Result (N, Expr, Rng_Check);
+ Set_Result (N, Expr, Rng_Check, Trunc => True);
-- Normal case where multiply is required
+ -- Rounding is truncating for decimal fixed point types only,
+ -- see RM 4.6(29).
else
Set_Result (N,
Build_Multiply (N,
Fpt_Value (Expr),
Real_Literal (N, Ureal_1 / Small)),
- Rng_Check);
+ Rng_Check, Trunc => Is_Decimal_Fixed_Point_Type (Result_Type));
end if;
end Expand_Convert_Float_To_Fixed;
Fpt_Value (Expr),
Real_Literal (N, Ureal_1 / Small)),
Rng_Check);
-
end Expand_Convert_Integer_To_Fixed;
--------------------------------
-- 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);
Statements => Stmts)));
Analyze (N);
-
end Expand_Decimal_Divide_Call;
-----------------------------------------------
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.
Real_Literal (N,
Small_Value (Left_Type) / Small_Value (Right_Type))));
end if;
-
end Expand_Divide_Fixed_By_Fixed_Giving_Float;
-------------------------------------------------
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;
-------------------------------------------------
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;
-- 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,
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.
if Etype (Left) = Universal_Real then
if Nkind (Left) = N_Real_Literal then
- Do_Multiply_Fixed_Universal (N, Right, Left);
+ Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
elsif Nkind (Left) = N_Type_Conversion then
Rewrite_Non_Static_Universal (Left);
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.
Real_Literal (N,
Small_Value (Right_Type) * Small_Value (Left_Type))));
end if;
-
end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
---------------------------------------------------
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);
-
+ Do_Multiply_Fixed_Universal (N, Left => Right, 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;
---------------------------------------------------
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;
---------------------
-- Integer_Literal --
---------------------
- function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is
+ function Integer_Literal
+ (N : Node_Id;
+ V : Uint;
+ Negative : Boolean := False) return Node_Id
+ is
T : Entity_Id;
L : Node_Id;
return Empty;
end if;
- L := Make_Integer_Literal (Sloc (N), V);
+ if Negative then
+ L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
+ else
+ L := Make_Integer_Literal (Sloc (N), V);
+ end if;
-- Set type of result in case used elsewhere (see note at start)
Set_Analyzed (L);
return L;
-
end Integer_Literal;
------------------
-- 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;
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
K = N_Op_Multiply)
- and then Rounded_Result (N)
+ and then
+ (Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
then
return True;
else
----------------
procedure Set_Result
- (N : Node_Id;
- Expr : Node_Id;
- Rchk : Boolean := False)
+ (N : Node_Id;
+ Expr : Node_Id;
+ Rchk : Boolean := False;
+ Trunc : Boolean := False)
is
Cnode : Node_Id;
Result_Type : constant Entity_Id := Etype (N);
begin
- -- No conversion required if types match and no range check
+ -- No conversion required if types match and no range check or truncate
- if Result_Type = Expr_Type and then not Rchk then
+ if Result_Type = Expr_Type and then not (Rchk or Trunc) then
Cnode := Expr;
-- Else perform required conversion
else
- Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
+ Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
end if;
Rewrite (N, Cnode);
Analyze_And_Resolve (N, Result_Type);
-
end Set_Result;
end Exp_Fixd;
OSDN Git Service
