CbC/CbC_gcc: gcc/ada/exp_fixd.adb comparison

comparison gcc/ada/exp_fixd.adb @ 111:04ced10e8804

gcc 7

author	kono
date	Fri, 27 Oct 2017 22:46:09 +0900
parents
children	84e7813d76e9

comparison

equal deleted inserted replaced

-:561a7518be6b
+:04ced10e8804
+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT COMPILER COMPONENTS                         --
+--                                                                          --
+--                             E X P _ F I X D                              --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--          Copyright (C) 1992-2017, 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 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 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. --
+-- 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 Rident;   use Rident;
+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 Snames;   use Snames;
+with Stand;    use Stand;
+with Tbuild;   use Tbuild;
+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;
+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. 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 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;
+--  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 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.
+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 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 Universal_Real).
+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
+--  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 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 or the target type is an integer type.
+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 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;
+Trunc : 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);
+Set_Float_Truncate (Result, Trunc);
+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 = Universal_Real);
+pragma Assert (Right_Type = Universal_Real);
+Rnode := Make_Op_Divide (Loc, L, R);
+Result_Type := Universal_Real;
+--  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 Nat := UI_To_Int (Esize (Etype (Y)));
+Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
+Expr   : Node_Id;
+begin
+--  If denominator fits in 64 bits, we can build the operations directly
+--  without causing any intermediate overflow, so that's what we do.
+if Nat'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;
+pragma Warnings (Off, Rnn);
+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 Nat := UI_To_Int (Esize (Etype (X)));
+Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
+Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
+QR_Siz : Nat;
+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 := Nat'Max (X_Size, 2 * Nat'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_Temporary (Loc, 'S');
+Rnn := Make_Temporary (Loc, '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_Temporary (Loc, 'N');
+Dnn := Make_Temporary (Loc, '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
+Rnd := Boolean_Literals (Rounded_Result_Set (N));
+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);
+Left_Size   : Int;
+Right_Size  : Int;
+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 = Universal_Real);
+pragma Assert (Right_Type = Universal_Real);
+Result_Type := Universal_Real;
+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 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 (Left_Size, Right_Size);
+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
+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 Nat := UI_To_Int (Esize (Etype (X)));
+Y_Size : constant Nat := 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 Nat'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;
+pragma Warnings (Off, Rnn);
+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 Nat := UI_To_Int (Esize (Etype (X)));
+Y_Size : constant Nat := UI_To_Int (Esize (Etype (Y)));
+Z_Size : constant Nat := UI_To_Int (Esize (Etype (Z)));
+QR_Siz : Nat;
+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 := Nat'Max (X_Size, 2 * Nat'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_Temporary (Loc, 'S');
+Rnn := Make_Temporary (Loc, '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_Temporary (Loc, 'N');
+Dnn := Make_Temporary (Loc, '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
+Rnd := Boolean_Literals (Rounded_Result_Set (N));
+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); -- always positive
+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); -- always positive
+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, UR_Is_Negative (Frac));
+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, 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));
+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, UR_Is_Negative (Frac));
+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, 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));
+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); -- always positive
+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); -- always positive
+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, UR_Is_Negative (Frac));
+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, 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_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 Universal_Real, 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
+Expr        : constant Node_Id   := Expression (N);
+Orig_N      : constant Node_Id   := Original_Node (N);
+Result_Type : constant Entity_Id := Etype (N);
+Rng_Check   : constant Boolean   := Do_Range_Check (N);
+Small       : constant Ureal     := Small_Value (Result_Type);
+Truncate    : Boolean;
+begin
+--  Optimize small = 1, where we can avoid the multiply completely
+if Small = Ureal_1 then
+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), except if the
+--  conversion comes from an attribute reference 'Round (RM 3.5.10 (14)):
+--  The attribute is implemented by means of a conversion that must
+--  round.
+else
+if Is_Decimal_Fixed_Point_Type (Result_Type) then
+Truncate :=
+Nkind (Orig_N) /= N_Attribute_Reference
+or else Get_Attribute_Id
+(Attribute_Name (Orig_N)) /= Attribute_Round;
+else
+Truncate := False;
+end if;
+Set_Result
+(N     => N,
+Expr  =>
+Build_Multiply
+(N => N,
+L => Fpt_Value (Expr),
+R => Real_Literal (N, Ureal_1 / Small)),
+Rchk  => Rng_Check,
+Trunc => Truncate);
+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
+--  Suppress expansion of a fixed-by-fixed division if the
+--  operation is supported directly by the target.
+if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
+return;
+end if;
+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);
+--  A focused optimization: if after constant folding the
+--  expression is of the form:  T ((Exp * D) / D), where D is
+--  a static constant, return  T (Exp). This form will show up
+--  when D is the denominator of the static expression for the
+--  'small of fixed-point types involved. This transformation
+--  removes a division that may be expensive on some targets.
+if Nkind (N) = N_Type_Conversion
+and then Nkind (Expression (N)) = N_Op_Divide
+then
+declare
+Num : constant Node_Id := Left_Opnd  (Expression (N));
+Den : constant Node_Id := Right_Opnd (Expression (N));
+begin
+if Nkind (Den) = N_Integer_Literal
+and then Nkind (Num) = N_Op_Multiply
+and then Nkind (Right_Opnd (Num)) = N_Integer_Literal
+and then Intval (Den) = Intval (Right_Opnd (Num))
+then
+Rewrite (Expression (N), Left_Opnd (Num));
+end if;
+end;
+end if;
+end if;
+end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
+-----------------------------------------------
+-- Expand_Divide_Fixed_By_Fixed_Giving_Float --
+-----------------------------------------------
+--  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.
+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.
+----------------------------------
+-- 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,
+Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
+Expression   => Expression (Opnd)));
+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 Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
+return;
+end if;
+if Etype (Left) = Universal_Real then
+if Nkind (Left) = N_Real_Literal then
+Do_Multiply_Fixed_Universal (N, Left => Right, 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 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.
+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
+Loc   : constant Source_Ptr := Sloc (N);
+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, Left => Right, Right => Left);
+elsif Etype (Right) = Universal_Real then
+Do_Multiply_Fixed_Universal (N, Left, Right);
+--  If both types are equal and we need to avoid floating point
+--  instructions, it's worth introducing a temporary with the
+--  common type, because it may be evaluated more simply without
+--  the need for run-time use of floating point.
+elsif Etype (Right) = Etype (Left)
+and then Restriction_Active (No_Floating_Point)
+then
+declare
+Temp : constant Entity_Id := Make_Temporary (Loc, 'F');
+Mult : constant Node_Id   := Make_Op_Multiply (Loc, Left, Right);
+Decl : constant Node_Id   :=
+Make_Object_Declaration (Loc,
+Defining_Identifier => Temp,
+Object_Definition   => New_Occurrence_Of (Etype (Right), Loc),
+Expression          => Mult);
+begin
+Insert_Action (N, Decl);
+Rewrite (N,
+OK_Convert_To (Etype (N), New_Occurrence_Of (Temp, Loc)));
+Analyze_And_Resolve (N, Standard_Integer);
+end;
+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, Universal_Real, N);
+--  Fixed-point case, must get integer value first
+else
+return Build_Conversion (N, Universal_Real, N);
+end if;
+end Fpt_Value;
+---------------------
+-- Integer_Literal --
+---------------------
+function Integer_Literal
+(N        : Node_Id;
+V        : Uint;
+Negative : Boolean := False) 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;
+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_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, Universal_Real);
+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) or else Is_Integer_Type (Etype (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;
+Trunc : 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 or truncate
+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, Trunc);
+end if;
+Rewrite (N, Cnode);
+Analyze_And_Resolve (N, Result_Type);
+end Set_Result;
+end Exp_Fixd;

Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/exp_fixd.adb @ 111:04ced10e8804