+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT COMPILER COMPONENTS --
--- --
--- E X P _ F I X D --
--- --
--- B o d y --
--- --
--- $Revision: 1.2.12.1 $
--- --
--- Copyright (C) 1992-2001 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- --
--- 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. --
--- --
--- GNAT was originally developed by the GNAT team at New York University. --
--- Extensive contributions were provided by Ada Core Technologies Inc. --
--- --
-------------------------------------------------------------------------------
-
-with Atree; use Atree;
-with Checks; use Checks;
-with Einfo; use Einfo;
-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 Sem_Res; use Sem_Res;
-with Sem_Util; use Sem_Util;
-with Sinfo; use Sinfo;
-with Stand; use Stand;
-with Tbuild; use Tbuild;
-with Ttypes; use Ttypes;
-with Uintp; use Uintp;
-with Urealp; use Urealp;
-
-package body Exp_Fixd is
-
- -----------------------
- -- Local Subprograms --
- -----------------------
-
- -- General note; in this unit, a number of routines are driven by the
- -- types (Etype) of their operands. Since we are dealing with unanalyzed
- -- expressions as they are constructed, the Etypes would not normally be
- -- set, but the construction routines that we use in this unit do in fact
- -- set the Etype values correctly. In addition, setting the Etype ensures
- -- that the analyzer does not try to redetermine the type when the node
- -- is analyzed (which would be wrong, since in the case where we set the
- -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
- -- 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;
- -- 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.
-
- 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.
-
- function Build_Double_Divide
- (N : 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
- -- return the resulting node is analyzed, and has its Etype set.
-
- procedure Build_Double_Divide_Code
- (N : Node_Id;
- X, Y, Z : Node_Id;
- Qnn, Rnn : out Entity_Id;
- Code : out List_Id);
- -- 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.
-
- 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.
-
- 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.
-
- function Build_Scaled_Divide
- (N : 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
- -- return the resulting node is analyzed and has is Etype set.
-
- procedure Build_Scaled_Divide_Code
- (N : Node_Id;
- X, Y, Z : Node_Id;
- Qnn, Rnn : out Entity_Id;
- Code : out List_Id);
- -- 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 Rrr. The integer types for X, Y, Z may be different.
- -- The division is rounded if the Rounded_Result flag of N is set. The
- -- Etype fields of Qnn and Rnn are appropriately set on return.
-
- procedure Do_Divide_Fixed_Fixed (N : Node_Id);
- -- Handles expansion of divide for case of two fixed-point operands
- -- (neither of them universal), with an integer or fixed-point result.
- -- N is the N_Op_Divide node to be expanded.
-
- procedure Do_Divide_Fixed_Universal (N : Node_Id);
- -- Handles expansion of divide for case of a fixed-point operand divided
- -- by a universal real operand, with an integer or fixed-point result. N
- -- is the N_Op_Divide node to be expanded.
-
- procedure Do_Divide_Universal_Fixed (N : Node_Id);
- -- Handles expansion of divide for case of a universal real operand
- -- divided by a fixed-point operand, with an integer or fixed-point
- -- result. N is the N_Op_Divide node to be expanded.
-
- procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
- -- Handles expansion of multiply for case of two fixed-point operands
- -- (neither of them universal), with an integer or fixed-point result.
- -- N is the N_Op_Multiply node to be expanded.
-
- procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
- -- Handles expansion of multiply for case of a fixed-point operand
- -- multiplied by a universal real operand, with an integer or fixed-
- -- point result. N is the N_Op_Multiply node to be expanded, and
- -- Left, Right are the operands (which may have been switched).
-
- procedure Expand_Convert_Fixed_Static (N : Node_Id);
- -- This routine is called where the node N is a conversion of a literal
- -- or other static expression of a fixed-point type to some other type.
- -- In such cases, we simply rewrite the operand as a real literal and
- -- reanalyze. This avoids problems which would otherwise result from
- -- attempting to build and fold expressions involving constants.
-
- 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
- -- 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).
-
- function Integer_Literal (N : Node_Id; V : Uint) 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.
-
- 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
-
- 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.
-
- procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : 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.
-
- ----------------------
- -- Build_Conversion --
- ----------------------
-
- function Build_Conversion
- (N : Node_Id;
- Typ : Entity_Id;
- Expr : Node_Id;
- Rchk : Boolean := False)
- return Node_Id
- is
- Loc : constant Source_Ptr := Sloc (N);
- Result : Node_Id;
- Rcheck : Boolean := Rchk;
-
- begin
- -- A special case, if the expression is an integer literal and the
- -- target type is an integer type, then just retype the integer
- -- literal to the desired target type. Don't do this if we need
- -- a range check.
-
- if Nkind (Expr) = N_Integer_Literal
- and then Is_Integer_Type (Typ)
- and then not Rchk
- then
- Result := Expr;
-
- -- Cases where we end up with a conversion. Note that we do not use the
- -- Convert_To abstraction here, since we may be decorating the resulting
- -- conversion with Rounded_Result and/or Conversion_OK, so we want the
- -- conversion node present, even if it appears to be redundant.
-
- else
- -- Remove inner conversion if both inner and outer conversions are
- -- to integer types, since the inner one serves no purpose (except
- -- perhaps to set rounding, so we preserve the Rounded_Result flag)
- -- and also we preserve the range check flag on the inner operand
-
- if Is_Integer_Type (Typ)
- and then Is_Integer_Type (Etype (Expr))
- and then Nkind (Expr) = N_Type_Conversion
- then
- Result :=
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Typ, Loc),
- Expression => Expression (Expr));
- Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
- Rcheck := Rcheck or Do_Range_Check (Expr);
-
- -- For all other cases, a simple type conversion will work
-
- else
- Result :=
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Typ, Loc),
- Expression => Expr);
- end if;
-
- -- Set Conversion_OK if either result or expression type is a
- -- fixed-point type, since from a semantic point of view, we are
- -- treating fixed-point values as integers at this stage.
-
- if Is_Fixed_Point_Type (Typ)
- or else Is_Fixed_Point_Type (Etype (Expression (Result)))
- then
- Set_Conversion_OK (Result);
- end if;
-
- -- Set Do_Range_Check if either it was requested by the caller,
- -- or if an eliminated inner conversion had a range check.
-
- if Rcheck then
- Enable_Range_Check (Result);
- else
- Set_Do_Range_Check (Result, False);
- end if;
- end if;
-
- Set_Etype (Result, Typ);
- return Result;
-
- end Build_Conversion;
-
- ------------------
- -- Build_Divide --
- ------------------
-
- function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
- Loc : constant Source_Ptr := Sloc (N);
- Left_Type : constant Entity_Id := Base_Type (Etype (L));
- Right_Type : constant Entity_Id := Base_Type (Etype (R));
- Result_Type : Entity_Id;
- Rnode : Node_Id;
-
- begin
- -- 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);
-
- Rnode := Make_Op_Divide (Loc, L, R);
- Result_Type := Standard_Long_Long_Float;
-
- -- Integer and fixed-point cases
-
- else
- -- An optimization. If the right operand is the literal 1, then we
- -- can just return the left hand operand. Putting the optimization
- -- here allows us to omit the check at the call site.
-
- if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
- return L;
- end if;
-
- -- If left and right types are the same, no conversion needed
-
- if Left_Type = Right_Type then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => L,
- Right_Opnd => R);
-
- -- Use left type if it is the larger of the two
-
- elsif Esize (Left_Type) >= Esize (Right_Type) then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => L,
- Right_Opnd => Build_Conversion (N, Left_Type, R));
-
- -- Otherwise right type is larger of the two, us it
-
- else
- Result_Type := Right_Type;
- Rnode :=
- Make_Op_Divide (Loc,
- Left_Opnd => Build_Conversion (N, Right_Type, L),
- Right_Opnd => R);
- end if;
- end if;
-
- -- We now have a divide node built with Result_Type set. First
- -- set Etype of result, as required for all Build_xxx routines
-
- Set_Etype (Rnode, Base_Type (Result_Type));
-
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
- -- The result is rounded if the target of the operation is decimal
- -- and Rounded_Result is set, or if the target of the operation
- -- is an integer type.
-
- if Is_Integer_Type (Etype (N))
- or else Rounded_Result_Set (N)
- then
- Set_Rounded_Result (Rnode);
- end if;
-
- return Rnode;
-
- end Build_Divide;
-
- -------------------------
- -- Build_Double_Divide --
- -------------------------
-
- function Build_Double_Divide
- (N : 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!
-
- if Int'Max (Y_Size, Z_Size) <= 32 then
- return
- Build_Divide (N, X, Build_Multiply (N, Y, Z));
-
- -- Otherwise we use the runtime routine
-
- -- [Qnn : Interfaces.Integer_64,
- -- Rnn : Interfaces.Integer_64;
- -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
- -- Qnn]
-
- else
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Qnn : Entity_Id;
- Rnn : Entity_Id;
- Code : List_Id;
-
- begin
- Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
- Insert_Actions (N, Code);
- Expr := New_Occurrence_Of (Qnn, Loc);
-
- -- Set type of result in case used elsewhere (see note at start)
-
- Set_Etype (Expr, Etype (Qnn));
-
- -- Set result as analyzed (see note at start on build routines)
-
- return Expr;
- end;
- end if;
- end Build_Double_Divide;
-
- ------------------------------
- -- Build_Double_Divide_Code --
- ------------------------------
-
- -- If the denominator can be computed in 64-bits, we build
-
- -- [Nnn : constant typ := typ (X);
- -- Dnn : constant typ := typ (Y) * typ (Z)
- -- Qnn : constant typ := Nnn / Dnn;
- -- Rnn : constant typ := Nnn / Dnn;
-
- -- If the numerator cannot be computed in 64 bits, we build
-
- -- [Qnn : typ;
- -- Rnn : typ;
- -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
-
- procedure Build_Double_Divide_Code
- (N : Node_Id;
- X, Y, Z : Node_Id;
- Qnn, Rnn : out Entity_Id;
- Code : out List_Id)
- is
- Loc : constant Source_Ptr := Sloc (N);
-
- X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
- Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
-
- QR_Siz : Int;
- QR_Typ : Entity_Id;
-
- Nnn : Entity_Id;
- Dnn : Entity_Id;
-
- Quo : Node_Id;
- Rnd : Entity_Id;
-
- begin
- -- Find type that will allow computation of numerator
-
- QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
-
- if QR_Siz <= 16 then
- QR_Typ := Standard_Integer_16;
- elsif QR_Siz <= 32 then
- QR_Typ := Standard_Integer_32;
- elsif QR_Siz <= 64 then
- QR_Typ := Standard_Integer_64;
-
- -- For more than 64, bits, we use the 64-bit integer defined in
- -- Interfaces, so that it can be handled by the runtime routine
-
- else
- QR_Typ := RTE (RE_Integer_64);
- end if;
-
- -- Define quotient and remainder, and set their Etypes, so
- -- that they can be picked up by Build_xxx routines.
-
- Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
- Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-
- Set_Etype (Qnn, QR_Typ);
- Set_Etype (Rnn, QR_Typ);
-
- -- Case that we can compute the denominator in 64 bits
-
- if QR_Siz <= 64 then
-
- -- Create temporaries for numerator and denominator and set Etypes,
- -- so that New_Occurrence_Of picks them up for Build_xxx calls.
-
- Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
- Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
-
- Set_Etype (Nnn, QR_Typ);
- Set_Etype (Dnn, QR_Typ);
-
- Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Nnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression => Build_Conversion (N, QR_Typ, X)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Dnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression =>
- Build_Multiply (N,
- Build_Conversion (N, QR_Typ, Y),
- Build_Conversion (N, QR_Typ, Z))));
-
- Quo :=
- Build_Divide (N,
- New_Occurrence_Of (Nnn, Loc),
- New_Occurrence_Of (Dnn, Loc));
-
- Set_Rounded_Result (Quo, Rounded_Result_Set (N));
-
- Append_To (Code,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Qnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression => Quo));
-
- Append_To (Code,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Rnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression =>
- Build_Rem (N,
- New_Occurrence_Of (Nnn, Loc),
- New_Occurrence_Of (Dnn, Loc))));
-
- -- Case where denominator does not fit in 64 bits, so we have to
- -- 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;
-
- Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Qnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Rnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
-
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
- Parameter_Associations => New_List (
- Build_Conversion (N, QR_Typ, X),
- Build_Conversion (N, QR_Typ, Y),
- Build_Conversion (N, QR_Typ, Z),
- New_Occurrence_Of (Qnn, Loc),
- New_Occurrence_Of (Rnn, Loc),
- New_Occurrence_Of (Rnd, Loc))));
- end if;
-
- end Build_Double_Divide_Code;
-
- --------------------
- -- Build_Multiply --
- --------------------
-
- function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
- Loc : constant Source_Ptr := Sloc (N);
- Left_Type : constant Entity_Id := Etype (L);
- Right_Type : constant Entity_Id := Etype (R);
- Rsize : Int;
- Result_Type : Entity_Id;
- Rnode : Node_Id;
-
- begin
- -- 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);
-
- Result_Type := Standard_Long_Long_Float;
- Rnode := Make_Op_Multiply (Loc, L, R);
-
- -- Integer and fixed-point cases
-
- else
- -- An optimization. If the right operand is the literal 1, then we
- -- can just return the left hand operand. Putting the optimization
- -- here allows us to omit the check at the call site. Similarly, if
- -- the left operand is the integer 1 we can return the right operand.
-
- if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
- return L;
- elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
- return R;
- end if;
-
- -- Otherwise we use a type that is at least twice the longer
- -- of the two sizes.
-
- Rsize := 2 * Int'Max (UI_To_Int (Esize (Left_Type)),
- UI_To_Int (Esize (Right_Type)));
-
- if Rsize <= 8 then
- Result_Type := Standard_Integer_8;
-
- elsif Rsize <= 16 then
- Result_Type := Standard_Integer_16;
-
- elsif Rsize <= 32 then
- 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;
-
- Rnode :=
- Make_Op_Multiply (Loc,
- Left_Opnd => Build_Conversion (N, Result_Type, L),
- Right_Opnd => Build_Conversion (N, Result_Type, R));
- end if;
-
- -- We now have a multiply node built with Result_Type set. First
- -- set Etype of result, as required for all Build_xxx routines
-
- Set_Etype (Rnode, Base_Type (Result_Type));
-
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
- return Rnode;
- end Build_Multiply;
-
- ---------------
- -- Build_Rem --
- ---------------
-
- function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
- Loc : constant Source_Ptr := Sloc (N);
- Left_Type : constant Entity_Id := Etype (L);
- Right_Type : constant Entity_Id := Etype (R);
- Result_Type : Entity_Id;
- Rnode : Node_Id;
-
- begin
- if Left_Type = Right_Type then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Rem (Loc,
- Left_Opnd => L,
- Right_Opnd => R);
-
- -- If left size is larger, we do the remainder operation using the
- -- size of the left type (i.e. the larger of the two integer types).
-
- elsif Esize (Left_Type) >= Esize (Right_Type) then
- Result_Type := Left_Type;
- Rnode :=
- Make_Op_Rem (Loc,
- Left_Opnd => L,
- Right_Opnd => Build_Conversion (N, Left_Type, R));
-
- -- Similarly, if the right size is larger, we do the remainder
- -- operation using the right type.
-
- else
- Result_Type := Right_Type;
- Rnode :=
- Make_Op_Rem (Loc,
- Left_Opnd => Build_Conversion (N, Right_Type, L),
- Right_Opnd => R);
- end if;
-
- -- We now have an N_Op_Rem node built with Result_Type set. First
- -- set Etype of result, as required for all Build_xxx routines
-
- Set_Etype (Rnode, Base_Type (Result_Type));
-
- -- Set Treat_Fixed_As_Integer if operation on fixed-point type
- -- since this is a literal arithmetic operation, to be performed
- -- by Gigi without any consideration of small values.
-
- if Is_Fixed_Point_Type (Result_Type) then
- Set_Treat_Fixed_As_Integer (Rnode);
- end if;
-
- -- One more check. We did the rem operation using the larger of the
- -- two types, which is reasonable. However, in the case where the
- -- two types have unequal sizes, it is impossible for the result of
- -- a remainder operation to be larger than the smaller of the two
- -- types, so we can put a conversion round the result to keep the
- -- evolving operation size as small as possible.
-
- if Esize (Left_Type) >= Esize (Right_Type) then
- Rnode := Build_Conversion (N, Right_Type, Rnode);
- elsif Esize (Right_Type) >= Esize (Left_Type) then
- Rnode := Build_Conversion (N, Left_Type, Rnode);
- end if;
-
- return Rnode;
- end Build_Rem;
-
- -------------------------
- -- Build_Scaled_Divide --
- -------------------------
-
- function Build_Scaled_Divide
- (N : 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)));
- Expr : Node_Id;
-
- begin
- -- If numerator fits in 64 bits, we can build the operations directly
- -- without causing any intermediate overflow, so that's what we do!
-
- if Int'Max (X_Size, Y_Size) <= 32 then
- return
- Build_Divide (N, Build_Multiply (N, X, Y), Z);
-
- -- Otherwise we use the runtime routine
-
- -- [Qnn : Integer_64,
- -- Rnn : Integer_64;
- -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
- -- Qnn]
-
- else
- declare
- Loc : constant Source_Ptr := Sloc (N);
- Qnn : Entity_Id;
- Rnn : Entity_Id;
- Code : List_Id;
-
- begin
- Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
- Insert_Actions (N, Code);
- Expr := New_Occurrence_Of (Qnn, Loc);
-
- -- Set type of result in case used elsewhere (see note at start)
-
- Set_Etype (Expr, Etype (Qnn));
- return Expr;
- end;
- end if;
- end Build_Scaled_Divide;
-
- ------------------------------
- -- Build_Scaled_Divide_Code --
- ------------------------------
-
- -- If the numerator can be computed in 64-bits, we build
-
- -- [Nnn : constant typ := typ (X) * typ (Y);
- -- Dnn : constant typ := typ (Z)
- -- Qnn : constant typ := Nnn / Dnn;
- -- Rnn : constant typ := Nnn / Dnn;
-
- -- If the numerator cannot be computed in 64 bits, we build
-
- -- [Qnn : Interfaces.Integer_64;
- -- Rnn : Interfaces.Integer_64;
- -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
-
- procedure Build_Scaled_Divide_Code
- (N : Node_Id;
- X, Y, Z : Node_Id;
- Qnn, Rnn : out Entity_Id;
- Code : out List_Id)
- is
- Loc : constant Source_Ptr := Sloc (N);
-
- X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
- Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
- Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
-
- QR_Siz : Int;
- QR_Typ : Entity_Id;
-
- Nnn : Entity_Id;
- Dnn : Entity_Id;
-
- Quo : Node_Id;
- Rnd : Entity_Id;
-
- begin
- -- Find type that will allow computation of numerator
-
- QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
-
- if QR_Siz <= 16 then
- QR_Typ := Standard_Integer_16;
- elsif QR_Siz <= 32 then
- QR_Typ := Standard_Integer_32;
- elsif QR_Siz <= 64 then
- QR_Typ := Standard_Integer_64;
-
- -- For more than 64, bits, we use the 64-bit integer defined in
- -- Interfaces, so that it can be handled by the runtime routine
-
- else
- QR_Typ := RTE (RE_Integer_64);
- end if;
-
- -- Define quotient and remainder, and set their Etypes, so
- -- that they can be picked up by Build_xxx routines.
-
- Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
- Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
-
- Set_Etype (Qnn, QR_Typ);
- Set_Etype (Rnn, QR_Typ);
-
- -- Case that we can compute the numerator in 64 bits
-
- if QR_Siz <= 64 then
- Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
- Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
-
- -- Set Etypes, so that they can be picked up by New_Occurrence_Of
-
- Set_Etype (Nnn, QR_Typ);
- Set_Etype (Dnn, QR_Typ);
-
- Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Nnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression =>
- Build_Multiply (N,
- Build_Conversion (N, QR_Typ, X),
- Build_Conversion (N, QR_Typ, Y))),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Dnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression => Build_Conversion (N, QR_Typ, Z)));
-
- Quo :=
- Build_Divide (N,
- New_Occurrence_Of (Nnn, Loc),
- New_Occurrence_Of (Dnn, Loc));
-
- Append_To (Code,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Qnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression => Quo));
-
- Append_To (Code,
- Make_Object_Declaration (Loc,
- Defining_Identifier => Rnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
- Constant_Present => True,
- Expression =>
- Build_Rem (N,
- New_Occurrence_Of (Nnn, Loc),
- New_Occurrence_Of (Dnn, Loc))));
-
- -- Case where numerator does not fit in 64 bits, so we have to
- -- 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;
-
- Code := New_List (
- Make_Object_Declaration (Loc,
- Defining_Identifier => Qnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
-
- Make_Object_Declaration (Loc,
- Defining_Identifier => Rnn,
- Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
-
- Make_Procedure_Call_Statement (Loc,
- Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
- Parameter_Associations => New_List (
- Build_Conversion (N, QR_Typ, X),
- Build_Conversion (N, QR_Typ, Y),
- Build_Conversion (N, QR_Typ, Z),
- New_Occurrence_Of (Qnn, Loc),
- New_Occurrence_Of (Rnn, Loc),
- New_Occurrence_Of (Rnd, Loc))));
- end if;
-
- -- Set type of result, for use in caller.
-
- Set_Etype (Qnn, QR_Typ);
- end Build_Scaled_Divide_Code;
-
- ---------------------------
- -- Do_Divide_Fixed_Fixed --
- ---------------------------
-
- -- We have:
-
- -- (Result_Value * Result_Small) =
- -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
-
- -- Result_Value = (Left_Value / Right_Value) *
- -- (Left_Small / (Right_Small * Result_Small));
-
- -- we can do the operation in integer arithmetic if this fraction is an
- -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
- -- Otherwise the result is in the close result set and our approach is to
- -- use floating-point to compute this close result.
-
- procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
- Left_Type : constant Entity_Id := Etype (Left);
- Right_Type : constant Entity_Id := Etype (Right);
- Result_Type : constant Entity_Id := Etype (N);
- Right_Small : constant Ureal := Small_Value (Right_Type);
- Left_Small : constant Ureal := Small_Value (Left_Type);
-
- Result_Small : Ureal;
- Frac : Ureal;
- Frac_Num : Uint;
- Frac_Den : Uint;
- Lit_Int : Node_Id;
-
- begin
- -- Rounding is required if the result is integral
-
- if Is_Integer_Type (Result_Type) then
- Set_Rounded_Result (N);
- end if;
-
- -- Get result small. If the result is an integer, treat it as though
- -- it had a small of 1.0, all other processing is identical.
-
- if Is_Integer_Type (Result_Type) then
- Result_Small := Ureal_1;
- else
- Result_Small := Small_Value (Result_Type);
- end if;
-
- -- Get small ratio
-
- Frac := Left_Small / (Right_Small * Result_Small);
- Frac_Num := Norm_Num (Frac);
- Frac_Den := Norm_Den (Frac);
-
- -- If the fraction is an integer, then we get the result by multiplying
- -- the left operand by the integer, and then dividing by the right
- -- operand (the order is important, if we did the divide first, we
- -- would lose precision).
-
- if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
- return;
- end if;
-
- -- If the fraction is the reciprocal of an integer, then we get the
- -- result by first multiplying the divisor by the integer, and then
- -- doing the division with the adjusted divisor.
-
- -- Note: this is much better than doing two divisions: multiplications
- -- are much faster than divisions (and certainly faster than rounded
- -- divisions), and we don't get inaccuracies from double rounding.
-
- elsif Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
- return;
- end if;
- end if;
-
- -- If we fall through, we use floating-point to compute the result
-
- Set_Result (N,
- Build_Multiply (N,
- Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
- Real_Literal (N, Frac)));
-
- end Do_Divide_Fixed_Fixed;
-
- -------------------------------
- -- Do_Divide_Fixed_Universal --
- -------------------------------
-
- -- We have:
-
- -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
- -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
-
- -- The result is required to be in the perfect result set if the literal
- -- can be factored so that the resulting small ratio is an integer or the
- -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
- -- analysis of these RM requirements:
-
- -- We must factor the literal, finding an integer K:
-
- -- Lit_Value = K * Right_Small
- -- Right_Small = Lit_Value / K
-
- -- such that the small ratio:
-
- -- Left_Small
- -- ------------------------------
- -- (Lit_Value / K) * Result_Small
-
- -- Left_Small
- -- = ------------------------ * K
- -- Lit_Value * Result_Small
-
- -- 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.
-
- -- 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,
- -- Right_Small = Lit_Value.
-
- -- If numerator > 1, then set K to the denominator of the fraction so
- -- that the resulting small ratio is an integer (the numerator value).
-
- procedure Do_Divide_Fixed_Universal (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
- Left_Type : constant Entity_Id := Etype (Left);
- Result_Type : constant Entity_Id := Etype (N);
- Left_Small : constant Ureal := Small_Value (Left_Type);
- Lit_Value : constant Ureal := Realval (Right);
-
- Result_Small : Ureal;
- Frac : Ureal;
- Frac_Num : Uint;
- Frac_Den : Uint;
- Lit_K : Node_Id;
- Lit_Int : Node_Id;
-
- begin
- -- Get result small. If the result is an integer, treat it as though
- -- it had a small of 1.0, all other processing is identical.
-
- if Is_Integer_Type (Result_Type) then
- Result_Small := Ureal_1;
- else
- Result_Small := Small_Value (Result_Type);
- end if;
-
- -- Determine if literal can be rewritten successfully
-
- Frac := Left_Small / (Lit_Value * Result_Small);
- Frac_Num := Norm_Num (Frac);
- Frac_Den := Norm_Den (Frac);
-
- -- Case where fraction is the reciprocal of an integer (K = 1, integer
- -- = denominator). If this integer is not too large, this is the case
- -- where the result can be obtained by dividing by this integer value.
-
- if Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Divide (N, Left, Lit_Int));
- return;
- end if;
-
- -- Case where we choose K to make fraction an integer (K = denominator
- -- of fraction, integer = numerator of fraction). If both K and the
- -- numerator are small enough, this is the case where the result can
- -- be obtained by first multiplying by the integer value and then
- -- dividing by K (the order is important, if we divided first, we
- -- would lose precision).
-
- else
- Lit_Int := Integer_Literal (N, Frac_Num);
- Lit_K := Integer_Literal (N, Frac_Den);
-
- if Present (Lit_Int) and then Present (Lit_K) then
- Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
- return;
- end if;
- end if;
-
- -- Fall through if the literal cannot be successfully rewritten, or if
- -- the small ratio is out of range of integer arithmetic. In the former
- -- case it is fine to use floating-point to get the close result set,
- -- and in the latter case, it means that the result is zero or raises
- -- constraint error, and we can do that accurately in floating-point.
-
- -- If we end up using floating-point, then we take the right integer
- -- to be one, and its small to be the value of the original right real
- -- literal. That way, we need only one floating-point multiplication.
-
- Set_Result (N,
- Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
-
- end Do_Divide_Fixed_Universal;
-
- -------------------------------
- -- Do_Divide_Universal_Fixed --
- -------------------------------
-
- -- We have:
-
- -- (Result_Value * Result_Small) =
- -- Lit_Value / (Right_Value * Right_Small)
- -- Result_Value =
- -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
-
- -- The result is required to be in the perfect result set if the literal
- -- can be factored so that the resulting small ratio is an integer or the
- -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
- -- analysis of these RM requirements:
-
- -- We must factor the literal, finding an integer K:
-
- -- Lit_Value = K * Left_Small
- -- Left_Small = Lit_Value / K
-
- -- such that the small ratio:
-
- -- (Lit_Value / K)
- -- --------------------------
- -- Right_Small * Result_Small
-
- -- Lit_Value 1
- -- = -------------------------- * -
- -- Right_Small * Result_Small K
-
- -- 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.
-
- -- 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,
- -- and Left_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 an integer (the
- -- numerator value).
-
- procedure Do_Divide_Universal_Fixed (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
- Right_Type : constant Entity_Id := Etype (Right);
- Result_Type : constant Entity_Id := Etype (N);
- Right_Small : constant Ureal := Small_Value (Right_Type);
- Lit_Value : constant Ureal := Realval (Left);
-
- Result_Small : Ureal;
- Frac : Ureal;
- Frac_Num : Uint;
- Frac_Den : Uint;
- Lit_K : Node_Id;
- Lit_Int : Node_Id;
-
- begin
- -- Get result small. If the result is an integer, treat it as though
- -- it had a small of 1.0, all other processing is identical.
-
- if Is_Integer_Type (Result_Type) then
- Result_Small := Ureal_1;
- else
- Result_Small := Small_Value (Result_Type);
- end if;
-
- -- Determine if literal can be rewritten successfully
-
- Frac := Lit_Value / (Right_Small * Result_Small);
- Frac_Num := Norm_Num (Frac);
- Frac_Den := Norm_Den (Frac);
-
- -- Case where fraction is an integer (K = 1, integer = numerator). If
- -- this integer is not too large, this is the case where the result
- -- can be obtained by dividing this integer by the right operand.
-
- if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Divide (N, Lit_Int, Right));
- return;
- end if;
-
- -- Case where we choose K to make the fraction the reciprocal of an
- -- integer (K = numerator of fraction, integer = numerator of fraction).
- -- If both K and the integer are small enough, this is the case where
- -- the result can be obtained by multiplying the right operand by K
- -- and then dividing by the integer value. The order of the operations
- -- 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);
-
- if Present (Lit_Int) and then Present (Lit_K) then
- Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
- return;
- end if;
- end if;
-
- -- Fall through if the literal cannot be successfully rewritten, or if
- -- the small ratio is out of range of integer arithmetic. In the former
- -- case it is fine to use floating-point to get the close result set,
- -- and in the latter case, it means that the result is zero or raises
- -- constraint error, and we can do that accurately in floating-point.
-
- -- If we end up using floating-point, then we take the right integer
- -- to be one, and its small to be the value of the original right real
- -- literal. That way, we need only one floating-point division.
-
- Set_Result (N,
- Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
-
- end Do_Divide_Universal_Fixed;
-
- -----------------------------
- -- Do_Multiply_Fixed_Fixed --
- -----------------------------
-
- -- We have:
-
- -- (Result_Value * Result_Small) =
- -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
-
- -- Result_Value = (Left_Value * Right_Value) *
- -- (Left_Small * Right_Small) / Result_Small;
-
- -- we can do the operation in integer arithmetic if this fraction is an
- -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
- -- Otherwise the result is in the close result set and our approach is to
- -- use floating-point to compute this close result.
-
- procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
-
- Left_Type : constant Entity_Id := Etype (Left);
- Right_Type : constant Entity_Id := Etype (Right);
- Result_Type : constant Entity_Id := Etype (N);
- Right_Small : constant Ureal := Small_Value (Right_Type);
- Left_Small : constant Ureal := Small_Value (Left_Type);
-
- Result_Small : Ureal;
- Frac : Ureal;
- Frac_Num : Uint;
- Frac_Den : Uint;
- Lit_Int : Node_Id;
-
- begin
- -- Get result small. If the result is an integer, treat it as though
- -- it had a small of 1.0, all other processing is identical.
-
- if Is_Integer_Type (Result_Type) then
- Result_Small := Ureal_1;
- else
- Result_Small := Small_Value (Result_Type);
- end if;
-
- -- Get small ratio
-
- Frac := (Left_Small * Right_Small) / Result_Small;
- Frac_Num := Norm_Num (Frac);
- Frac_Den := Norm_Den (Frac);
-
- -- If the fraction is an integer, then we get the result by multiplying
- -- the operands, and then multiplying the result by the integer value.
-
- if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
-
- if Present (Lit_Int) then
- Set_Result (N,
- Build_Multiply (N, Build_Multiply (N, Left, Right),
- Lit_Int));
- return;
- end if;
-
- -- If the fraction is the reciprocal of an integer, then we get the
- -- result by multiplying the operands, and then dividing the result by
- -- the integer value. The order of the operations is important, if we
- -- divided first, we would lose precision.
-
- elsif Frac_Num = 1 then
- Lit_Int := Integer_Literal (N, Frac_Den);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
- return;
- end if;
- end if;
-
- -- If we fall through, we use floating-point to compute the result
-
- Set_Result (N,
- Build_Multiply (N,
- Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
- Real_Literal (N, Frac)));
-
- end Do_Multiply_Fixed_Fixed;
-
- ---------------------------------
- -- Do_Multiply_Fixed_Universal --
- ---------------------------------
-
- -- We have:
-
- -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
- -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
-
- -- The result is required to be in the perfect result set if the literal
- -- can be factored so that the resulting small ratio is an integer or the
- -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
- -- analysis of these RM requirements:
-
- -- We must factor the literal, finding an integer K:
-
- -- Lit_Value = K * Right_Small
- -- Right_Small = Lit_Value / K
-
- -- such that the small ratio:
-
- -- Left_Small * (Lit_Value / K)
- -- ----------------------------
- -- Result_Small
-
- -- Left_Small * Lit_Value 1
- -- = ---------------------- * -
- -- Result_Small K
-
- -- 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.
-
- -- 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.
-
- -- 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;
- Left, Right : Node_Id)
- is
- Left_Type : constant Entity_Id := Etype (Left);
- Result_Type : constant Entity_Id := Etype (N);
- Left_Small : constant Ureal := Small_Value (Left_Type);
- Lit_Value : constant Ureal := Realval (Right);
-
- Result_Small : Ureal;
- Frac : Ureal;
- Frac_Num : Uint;
- Frac_Den : Uint;
- Lit_K : Node_Id;
- Lit_Int : Node_Id;
-
- begin
- -- Get result small. If the result is an integer, treat it as though
- -- it had a small of 1.0, all other processing is identical.
-
- if Is_Integer_Type (Result_Type) then
- Result_Small := Ureal_1;
- else
- Result_Small := Small_Value (Result_Type);
- end if;
-
- -- Determine if literal can be rewritten successfully
-
- Frac := (Left_Small * Lit_Value) / Result_Small;
- Frac_Num := Norm_Num (Frac);
- Frac_Den := Norm_Den (Frac);
-
- -- Case where fraction is an integer (K = 1, integer = numerator). If
- -- this integer is not too large, this is the case where the result can
- -- be obtained by multiplying by this integer value.
-
- if Frac_Den = 1 then
- Lit_Int := Integer_Literal (N, Frac_Num);
-
- if Present (Lit_Int) then
- Set_Result (N, Build_Multiply (N, Left, Lit_Int));
- return;
- end if;
-
- -- Case where we choose K to make fraction the reciprocal of an integer
- -- (K = numerator of fraction, integer = denominator of fraction). If
- -- both K and the denominator are small enough, this is the case where
- -- the result can be obtained by first multiplying by K, and then
- -- dividing by the integer value.
-
- else
- Lit_Int := Integer_Literal (N, Frac_Den);
- Lit_K := Integer_Literal (N, Frac_Num);
-
- if Present (Lit_Int) and then Present (Lit_K) then
- Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
- return;
- end if;
- end if;
-
- -- Fall through if the literal cannot be successfully rewritten, or if
- -- the small ratio is out of range of integer arithmetic. In the former
- -- case it is fine to use floating-point to get the close result set,
- -- and in the latter case, it means that the result is zero or raises
- -- constraint error, and we can do that accurately in floating-point.
-
- -- If we end up using floating-point, then we take the right integer
- -- to be one, and its small to be the value of the original right real
- -- literal. That way, we need only one floating-point multiplication.
-
- Set_Result (N,
- Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
-
- end Do_Multiply_Fixed_Universal;
-
- ---------------------------------
- -- Expand_Convert_Fixed_Static --
- ---------------------------------
-
- procedure Expand_Convert_Fixed_Static (N : Node_Id) is
- begin
- Rewrite (N,
- Convert_To (Etype (N),
- Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
- Analyze_And_Resolve (N);
- end Expand_Convert_Fixed_Static;
-
- -----------------------------------
- -- Expand_Convert_Fixed_To_Fixed --
- -----------------------------------
-
- -- We have:
-
- -- Result_Value * Result_Small = Source_Value * Source_Small
- -- Result_Value = Source_Value * (Source_Small / Result_Small)
-
- -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
- -- integer, then the perfect result set is obtained by a single integer
- -- multiplication.
-
- -- If the small ratio is the reciprocal of a sufficiently small integer,
- -- then the perfect result set is obtained by a single integer division.
-
- -- In other cases, we obtain the close result set by calculating the
- -- result in floating-point.
-
- procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
- Rng_Check : constant Boolean := Do_Range_Check (N);
- Expr : constant Node_Id := Expression (N);
- Result_Type : constant Entity_Id := Etype (N);
- Source_Type : constant Entity_Id := Etype (Expr);
- Small_Ratio : Ureal;
- Ratio_Num : Uint;
- Ratio_Den : Uint;
- Lit : Node_Id;
-
- begin
- if Is_OK_Static_Expression (Expr) then
- Expand_Convert_Fixed_Static (N);
- return;
- end if;
-
- Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
- Ratio_Num := Norm_Num (Small_Ratio);
- Ratio_Den := Norm_Den (Small_Ratio);
-
- if Ratio_Den = 1 then
-
- if Ratio_Num = 1 then
- Set_Result (N, Expr);
- return;
-
- else
- Lit := Integer_Literal (N, Ratio_Num);
-
- if Present (Lit) then
- Set_Result (N, Build_Multiply (N, Expr, Lit));
- return;
- end if;
- end if;
-
- elsif Ratio_Num = 1 then
- Lit := Integer_Literal (N, Ratio_Den);
-
- if Present (Lit) then
- Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
- return;
- end if;
- end if;
-
- -- Fall through to use floating-point for the close result set case
- -- either as a result of the small ratio not being an integer or the
- -- reciprocal of an integer, or if the integer is out of range.
-
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Expr),
- Real_Literal (N, Small_Ratio)),
- Rng_Check);
-
- end Expand_Convert_Fixed_To_Fixed;
-
- -----------------------------------
- -- Expand_Convert_Fixed_To_Float --
- -----------------------------------
-
- -- 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
- -- convert the result to the target floating-point type.
-
- procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
- Rng_Check : constant Boolean := Do_Range_Check (N);
- Expr : constant Node_Id := Expression (N);
- Source_Type : constant Entity_Id := Etype (Expr);
- Small : constant Ureal := Small_Value (Source_Type);
-
- begin
- if Is_OK_Static_Expression (Expr) then
- Expand_Convert_Fixed_Static (N);
- return;
- end if;
-
- if Small = Ureal_1 then
- Set_Result (N, Expr);
-
- else
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Expr),
- Real_Literal (N, Small)),
- Rng_Check);
- end if;
- end Expand_Convert_Fixed_To_Float;
-
- -------------------------------------
- -- Expand_Convert_Fixed_To_Integer --
- -------------------------------------
-
- -- We have:
-
- -- Result_Value = Source_Value * Source_Small
-
- -- If the small value is a sufficiently small integer, then the perfect
- -- result set is obtained by a single integer multiplication.
-
- -- If the small value is the reciprocal of a sufficiently small integer,
- -- then the perfect result set is obtained by a single integer division.
-
- -- In other cases, we obtain the close result set by calculating the
- -- result in floating-point.
-
- procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
- Rng_Check : constant Boolean := Do_Range_Check (N);
- Expr : constant Node_Id := Expression (N);
- Source_Type : constant Entity_Id := Etype (Expr);
- Small : constant Ureal := Small_Value (Source_Type);
- Small_Num : constant Uint := Norm_Num (Small);
- Small_Den : constant Uint := Norm_Den (Small);
- Lit : Node_Id;
-
- begin
- if Is_OK_Static_Expression (Expr) then
- Expand_Convert_Fixed_Static (N);
- return;
- end if;
-
- if Small_Den = 1 then
- Lit := Integer_Literal (N, Small_Num);
-
- if Present (Lit) then
- Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
- return;
- end if;
-
- elsif Small_Num = 1 then
- Lit := Integer_Literal (N, Small_Den);
-
- if Present (Lit) then
- Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
- return;
- end if;
- end if;
-
- -- Fall through to use floating-point for the close result set case
- -- either as a result of the small value not being an integer or the
- -- reciprocal of an integer, or if the integer is out of range.
-
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Expr),
- Real_Literal (N, Small)),
- Rng_Check);
-
- end Expand_Convert_Fixed_To_Integer;
-
- -----------------------------------
- -- Expand_Convert_Float_To_Fixed --
- -----------------------------------
-
- -- We have
-
- -- Result_Value * Result_Small = Operand_Value
-
- -- so compute:
-
- -- Result_Value = Operand_Value * (1.0 / Result_Small)
-
- -- We do the small scaling in floating-point, and we do a multiplication
- -- rather than a division, since it is accurate enough for the perfect
- -- result cases, and faster.
-
- procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
- Rng_Check : constant Boolean := Do_Range_Check (N);
- Expr : constant Node_Id := Expression (N);
- Result_Type : constant Entity_Id := Etype (N);
- Small : constant Ureal := Small_Value (Result_Type);
-
- begin
- -- Optimize small = 1, where we can avoid the multiply completely
-
- if Small = Ureal_1 then
- Set_Result (N, Expr, Rng_Check);
-
- -- Normal case where multiply is required
-
- else
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Expr),
- Real_Literal (N, Ureal_1 / Small)),
- Rng_Check);
- end if;
- end Expand_Convert_Float_To_Fixed;
-
- -------------------------------------
- -- Expand_Convert_Integer_To_Fixed --
- -------------------------------------
-
- -- We have
-
- -- Result_Value * Result_Small = Operand_Value
- -- Result_Value = Operand_Value / Result_Small
-
- -- If the small value is a sufficiently small integer, then the perfect
- -- result set is obtained by a single integer division.
-
- -- If the small value is the reciprocal of a sufficiently small integer,
- -- the perfect result set is obtained by a single integer multiplication.
-
- -- In other cases, we obtain the close result set by calculating the
- -- result in floating-point using a multiplication by the reciprocal
- -- of the Result_Small.
-
- procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
- Rng_Check : constant Boolean := Do_Range_Check (N);
- Expr : constant Node_Id := Expression (N);
- Result_Type : constant Entity_Id := Etype (N);
- Small : constant Ureal := Small_Value (Result_Type);
- Small_Num : constant Uint := Norm_Num (Small);
- Small_Den : constant Uint := Norm_Den (Small);
- Lit : Node_Id;
-
- begin
- if Small_Den = 1 then
- Lit := Integer_Literal (N, Small_Num);
-
- if Present (Lit) then
- Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
- return;
- end if;
-
- elsif Small_Num = 1 then
- Lit := Integer_Literal (N, Small_Den);
-
- if Present (Lit) then
- Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
- return;
- end if;
- end if;
-
- -- Fall through to use floating-point for the close result set case
- -- either as a result of the small value not being an integer or the
- -- reciprocal of an integer, or if the integer is out of range.
-
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Expr),
- Real_Literal (N, Ureal_1 / Small)),
- Rng_Check);
-
- end Expand_Convert_Integer_To_Fixed;
-
- --------------------------------
- -- Expand_Decimal_Divide_Call --
- --------------------------------
-
- -- We have four operands
-
- -- Dividend
- -- Divisor
- -- Quotient
- -- Remainder
-
- -- All of which are decimal types, and which thus have associated
- -- decimal scales.
-
- -- Computing the quotient is a similar problem to that faced by the
- -- normal fixed-point division, except that it is simpler, because
- -- we always have compatible smalls.
-
- -- Quotient = (Dividend / Divisor) * 10**q
-
- -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
- -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
-
- -- For q >= 0, we compute
-
- -- Numerator := Dividend * 10 ** q
- -- Denominator := Divisor
- -- Quotient := Numerator / Denominator
-
- -- For q < 0, we compute
-
- -- Numerator := Dividend
- -- Denominator := Divisor * 10 ** q
- -- Quotient := Numerator / Denominator
-
- -- Both these divisions are done in truncated mode, and the remainder
- -- from these divisions is used to compute the result Remainder. This
- -- remainder has the effective scale of the numerator of the division,
-
- -- For q >= 0, the remainder scale is Dividend'Scale + q
- -- For q < 0, the remainder scale is Dividend'Scale
-
- -- The result Remainder is then computed by a normal truncating decimal
- -- conversion from this scale to the scale of the remainder, i.e. by a
- -- division or multiplication by the appropriate power of 10.
-
- procedure Expand_Decimal_Divide_Call (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
-
- Dividend : Node_Id := First_Actual (N);
- Divisor : Node_Id := Next_Actual (Dividend);
- Quotient : Node_Id := Next_Actual (Divisor);
- Remainder : Node_Id := Next_Actual (Quotient);
-
- Dividend_Type : constant Entity_Id := Etype (Dividend);
- Divisor_Type : constant Entity_Id := Etype (Divisor);
- Quotient_Type : constant Entity_Id := Etype (Quotient);
- Remainder_Type : constant Entity_Id := Etype (Remainder);
-
- Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
- Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
- Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
- Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
-
- Q : Uint;
- Numerator_Scale : Uint;
- Stmts : List_Id;
- Qnn : Entity_Id;
- Rnn : Entity_Id;
- Computed_Remainder : Node_Id;
- Adjusted_Remainder : Node_Id;
- Scale_Adjust : Uint;
-
- begin
- -- Relocate the operands, since they are now list elements, and we
- -- need to reference them separately as operands in the expanded code.
-
- Dividend := Relocate_Node (Dividend);
- Divisor := Relocate_Node (Divisor);
- Quotient := Relocate_Node (Quotient);
- Remainder := Relocate_Node (Remainder);
-
- -- Now compute Q, the adjustment scale
-
- Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
-
- -- If Q is non-negative then we need a scaled divide
-
- if Q >= 0 then
- Build_Scaled_Divide_Code
- (N,
- Dividend,
- Integer_Literal (N, Uint_10 ** Q),
- Divisor,
- Qnn, Rnn, Stmts);
-
- Numerator_Scale := Dividend_Scale + Q;
-
- -- If Q is negative, then we need a double divide
-
- else
- Build_Double_Divide_Code
- (N,
- Dividend,
- Divisor,
- Integer_Literal (N, Uint_10 ** (-Q)),
- Qnn, Rnn, Stmts);
-
- Numerator_Scale := Dividend_Scale;
- end if;
-
- -- Add statement to set quotient value
-
- -- Quotient := quotient-type!(Qnn);
-
- Append_To (Stmts,
- Make_Assignment_Statement (Loc,
- Name => Quotient,
- Expression =>
- Unchecked_Convert_To (Quotient_Type,
- Build_Conversion (N, Quotient_Type,
- New_Occurrence_Of (Qnn, Loc)))));
-
- -- Now we need to deal with computing and setting the remainder. The
- -- scale of the remainder is in Numerator_Scale, and the desired
- -- scale is the scale of the given Remainder argument. There are
- -- three cases:
-
- -- Numerator_Scale > Remainder_Scale
-
- -- in this case, there are extra digits in the computed remainder
- -- which must be eliminated by an extra division:
-
- -- computed-remainder := Numerator rem Denominator
- -- scale_adjust = Numerator_Scale - Remainder_Scale
- -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
-
- -- Numerator_Scale = Remainder_Scale
-
- -- in this case, the we have the remainder we need
-
- -- computed-remainder := Numerator rem Denominator
- -- adjusted-remainder := computed-remainder
-
- -- Numerator_Scale < Remainder_Scale
-
- -- in this case, we have insufficient digits in the computed
- -- remainder, which must be eliminated by an extra multiply
-
- -- computed-remainder := Numerator rem Denominator
- -- scale_adjust = Remainder_Scale - Numerator_Scale
- -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
-
- -- Finally we assign the adjusted-remainder to the result Remainder
- -- with conversions to get the proper fixed-point type representation.
-
- Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
-
- if Numerator_Scale > Remainder_Scale then
- Scale_Adjust := Numerator_Scale - Remainder_Scale;
- Adjusted_Remainder :=
- Build_Divide
- (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
-
- elsif Numerator_Scale = Remainder_Scale then
- Adjusted_Remainder := Computed_Remainder;
-
- else -- Numerator_Scale < Remainder_Scale
- Scale_Adjust := Remainder_Scale - Numerator_Scale;
- Adjusted_Remainder :=
- Build_Multiply
- (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
- end if;
-
- -- Assignment of remainder result
-
- Append_To (Stmts,
- Make_Assignment_Statement (Loc,
- Name => Remainder,
- Expression =>
- Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
-
- -- Final step is to rewrite the call with a block containing the
- -- above sequence of constructed statements for the divide operation.
-
- Rewrite (N,
- Make_Block_Statement (Loc,
- Handled_Statement_Sequence =>
- Make_Handled_Sequence_Of_Statements (Loc,
- Statements => Stmts)));
-
- Analyze (N);
-
- end Expand_Decimal_Divide_Call;
-
- -----------------------------------------------
- -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
- -----------------------------------------------
-
- procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (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_Fixed;
-
- -----------------------------------------------
- -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
- -----------------------------------------------
-
- -- The division is done in long_long_float, 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.
-
- procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
-
- Left_Type : constant Entity_Id := Etype (Left);
- Right_Type : constant Entity_Id := Etype (Right);
-
- begin
- -- Case of left operand is universal real, the result we want is:
-
- -- Left_Value / (Right_Value * Right_Small)
-
- -- so we compute this as:
-
- -- (Left_Value / Right_Small) / Right_Value
-
- if Left_Type = Universal_Real then
- Set_Result (N,
- Build_Divide (N,
- Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
- Fpt_Value (Right)));
-
- -- Case of right operand is universal real, the result we want is
-
- -- (Left_Value * Left_Small) / Right_Value
-
- -- so we compute this as:
-
- -- Left_Value * (Left_Small / Right_Value)
-
- -- Note we invert to a multiplication since usually floating-point
- -- multiplication is much faster than floating-point division.
-
- elsif Right_Type = Universal_Real then
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Left),
- Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
-
- -- Both operands are fixed, so the value we want is
-
- -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
-
- -- which we compute as:
-
- -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
-
- else
- Set_Result (N,
- Build_Multiply (N,
- Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
- Real_Literal (N,
- Small_Value (Left_Type) / Small_Value (Right_Type))));
- end if;
-
- end Expand_Divide_Fixed_By_Fixed_Giving_Float;
-
- -------------------------------------------------
- -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
- -------------------------------------------------
-
- 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;
-
- -------------------------------------------------
- -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
- -------------------------------------------------
-
- -- Since the operand and result fixed-point type is the same, this is
- -- a straight divide by the right operand, the small can be ignored.
-
- 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;
-
- -------------------------------------------------
- -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
- -------------------------------------------------
-
- procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
-
- procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
- -- The operand may be a non-static universal value, such an
- -- exponentiation with a non-static exponent. In that case, treat
- -- 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);
-
- begin
- Rewrite (Opnd,
- Make_Type_Conversion (Loc,
- Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
- Expression => Expression (Opnd)));
- Analyze_And_Resolve (Opnd, Etype (N));
- end Rewrite_Non_Static_Universal;
-
- begin
- if Etype (Left) = Universal_Real then
- if Nkind (Left) = N_Real_Literal then
- Do_Multiply_Fixed_Universal (N, Right, Left);
-
- elsif Nkind (Left) = N_Type_Conversion then
- Rewrite_Non_Static_Universal (Left);
- Do_Multiply_Fixed_Fixed (N);
- end if;
-
- elsif Etype (Right) = Universal_Real then
- if Nkind (Right) = N_Real_Literal then
- Do_Multiply_Fixed_Universal (N, Left, Right);
-
- elsif Nkind (Right) = N_Type_Conversion then
- Rewrite_Non_Static_Universal (Right);
- Do_Multiply_Fixed_Fixed (N);
- end if;
-
- 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
- -- by the adjustment for the smalls which is Small (Right) * Small (Left).
- -- Special treatment is required for universal operands.
-
- procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
- Left : constant Node_Id := Left_Opnd (N);
- Right : constant Node_Id := Right_Opnd (N);
-
- Left_Type : constant Entity_Id := Etype (Left);
- Right_Type : constant Entity_Id := Etype (Right);
-
- begin
- -- Case of left operand is universal real, the result we want is
-
- -- Left_Value * (Right_Value * Right_Small)
-
- -- so we compute this as:
-
- -- (Left_Value * Right_Small) * Right_Value;
-
- if Left_Type = Universal_Real then
- Set_Result (N,
- Build_Multiply (N,
- Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
- Fpt_Value (Right)));
-
- -- Case of right operand is universal real, the result we want is
-
- -- (Left_Value * Left_Small) * Right_Value
-
- -- so we compute this as:
-
- -- Left_Value * (Left_Small * Right_Value)
-
- elsif Right_Type = Universal_Real then
- Set_Result (N,
- Build_Multiply (N,
- Fpt_Value (Left),
- Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
-
- -- Both operands are fixed, so the value we want is
-
- -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
-
- -- which we compute as:
-
- -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
-
- else
- Set_Result (N,
- Build_Multiply (N,
- Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
- Real_Literal (N,
- Small_Value (Right_Type) * Small_Value (Left_Type))));
- end if;
-
- end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
-
- ---------------------------------------------------
- -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
- ---------------------------------------------------
-
- 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;
-
- ---------------------------------------------------
- -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
- ---------------------------------------------------
-
- -- Since the operand and result fixed-point type is the same, this is
- -- a straight multiply by the right operand, the small can be ignored.
-
- procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
- begin
- Set_Result (N,
- Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
- end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
-
- ---------------------------------------------------
- -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
- ---------------------------------------------------
-
- -- Since the operand and result fixed-point type is the same, this is
- -- a straight multiply by the right operand, the small can be ignored.
-
- procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
- begin
- Set_Result (N,
- Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
- end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
-
- ---------------
- -- Fpt_Value --
- ---------------
-
- function Fpt_Value (N : Node_Id) return Node_Id is
- Typ : constant Entity_Id := Etype (N);
-
- begin
- if Is_Integer_Type (Typ)
- or else Is_Floating_Point_Type (Typ)
- then
- return
- Build_Conversion
- (N, Standard_Long_Long_Float, N);
-
- -- Fixed-point case, must get integer value first
-
- else
- return
- Build_Conversion (N, Standard_Long_Long_Float, N);
- end if;
-
- end Fpt_Value;
-
- ---------------------
- -- Integer_Literal --
- ---------------------
-
- function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is
- T : Entity_Id;
- L : Node_Id;
-
- begin
- if V < Uint_2 ** 7 then
- T := Standard_Integer_8;
-
- elsif V < Uint_2 ** 15 then
- T := Standard_Integer_16;
-
- elsif V < Uint_2 ** 31 then
- T := Standard_Integer_32;
-
- elsif V < Uint_2 ** 63 then
- T := Standard_Integer_64;
-
- else
- return Empty;
- end if;
-
- L := Make_Integer_Literal (Sloc (N), V);
-
- -- Set type of result in case used elsewhere (see note at start)
-
- Set_Etype (L, T);
- Set_Is_Static_Expression (L);
-
- -- We really need to set Analyzed here because we may be creating a
- -- very strange beast, namely an integer literal typed as fixed-point
- -- and the analyzer won't like that. Probably we should allow the
- -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
- -- and teach the analyzer how to handle them ???
-
- Set_Analyzed (L);
- return L;
-
- end Integer_Literal;
-
- ------------------
- -- Real_Literal --
- ------------------
-
- function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
- L : Node_Id;
-
- begin
- L := Make_Real_Literal (Sloc (N), V);
-
- -- Set type of result in case used elsewhere (see note at start)
-
- Set_Etype (L, Standard_Long_Long_Float);
- return L;
- end Real_Literal;
-
- ------------------------
- -- Rounded_Result_Set --
- ------------------------
-
- 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)
- then
- return True;
- else
- return False;
- end if;
- end Rounded_Result_Set;
-
- ----------------
- -- Set_Result --
- ----------------
-
- procedure Set_Result
- (N : Node_Id;
- Expr : Node_Id;
- Rchk : Boolean := False)
- is
- Cnode : Node_Id;
-
- Expr_Type : constant Entity_Id := Etype (Expr);
- Result_Type : constant Entity_Id := Etype (N);
-
- begin
- -- No conversion required if types match and no range check
-
- if Result_Type = Expr_Type and then not Rchk then
- Cnode := Expr;
-
- -- Else perform required conversion
-
- else
- Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
- end if;
-
- Rewrite (N, Cnode);
- Analyze_And_Resolve (N, Result_Type);
-
- end Set_Result;
-
-end Exp_Fixd;
projects / msp430-gcc.git / blobdiff