gcc/ada/exp_fixd.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             E X P _ F I X D                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2008, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;    use Atree;
  27 with Checks;   use Checks;
  28 with Einfo;    use Einfo;
  29 with Exp_Util; use Exp_Util;
  30 with Nlists;   use Nlists;
  31 with Nmake;    use Nmake;
  32 with Rtsfind;  use Rtsfind;
  33 with Sem;      use Sem;
  34 with Sem_Eval; use Sem_Eval;
  35 with Sem_Res;  use Sem_Res;
  36 with Sem_Util; use Sem_Util;
  37 with Sinfo;    use Sinfo;
  38 with Stand;    use Stand;
  39 with Tbuild;   use Tbuild;
  40 with Uintp;    use Uintp;
  41 with Urealp;   use Urealp;
  42
  43 package body Exp_Fixd is
  44
  45    -----------------------
  46    -- Local Subprograms --
  47    -----------------------
  48
  49    --  General note; in this unit, a number of routines are driven by the
  50    --  types (Etype) of their operands. Since we are dealing with unanalyzed
  51    --  expressions as they are constructed, the Etypes would not normally be
  52    --  set, but the construction routines that we use in this unit do in fact
  53    --  set the Etype values correctly. In addition, setting the Etype ensures
  54    --  that the analyzer does not try to redetermine the type when the node
  55    --  is analyzed (which would be wrong, since in the case where we set the
  56    --  Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
  57    --  still dealing with a normal fixed-point operation and mess it up).
  58
  59    function Build_Conversion
  60      (N     : Node_Id;
  61       Typ   : Entity_Id;
  62       Expr  : Node_Id;
  63       Rchk  : Boolean := False;
  64       Trunc : Boolean := False) return Node_Id;
  65    --  Build an expression that converts the expression Expr to type Typ,
  66    --  taking the source location from Sloc (N). If the conversions involve
  67    --  fixed-point types, then the Conversion_OK flag will be set so that the
  68    --  resulting conversions do not get re-expanded. On return the resulting
  69    --  node has its Etype set. If Rchk is set, then Do_Range_Check is set
  70    --  in the resulting conversion node. If Trunc is set, then the
  71    --  Float_Truncate flag is set on the conversion, which must be from
  72    --  a floating-point type to an integer type.
  73
  74    function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
  75    --  Builds an N_Op_Divide node from the given left and right operand
  76    --  expressions, using the source location from Sloc (N). The operands are
  77    --  either both Universal_Real, in which case Build_Divide differs from
  78    --  Make_Op_Divide only in that the Etype of the resulting node is set (to
  79    --  Universal_Real), or they can be integer types. In this case the integer
  80    --  types need not be the same, and Build_Divide converts the operand with
  81    --  the smaller sized type to match the type of the other operand and sets
  82    --  this as the result type. The Rounded_Result flag of the result in this
  83    --  case is set from the Rounded_Result flag of node N. On return, the
  84    --  resulting node is analyzed, and has its Etype set.
  85
  86    function Build_Double_Divide
  87      (N       : Node_Id;
  88       X, Y, Z : Node_Id) return Node_Id;
  89    --  Returns a node corresponding to the value X/(Y*Z) using the source
  90    --  location from Sloc (N). The division is rounded if the Rounded_Result
  91    --  flag of N is set. The integer types of X, Y, Z may be different. On
  92    --  return the resulting node is analyzed, and has its Etype set.
  93
  94    procedure Build_Double_Divide_Code
  95      (N        : Node_Id;
  96       X, Y, Z  : Node_Id;
  97       Qnn, Rnn : out Entity_Id;
  98       Code     : out List_Id);
  99    --  Generates a sequence of code for determining the quotient and remainder
 100    --  of the division X/(Y*Z), using the source location from Sloc (N).
 101    --  Entities of appropriate types are allocated for the quotient and
 102    --  remainder and returned in Qnn and Rnn. The result is rounded if the
 103    --  Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are
 104    --  appropriately set on return.
 105
 106    function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
 107    --  Builds an N_Op_Multiply node from the given left and right operand
 108    --  expressions, using the source location from Sloc (N). The operands are
 109    --  either both Universal_Real, in which case Build_Multiply differs from
 110    --  Make_Op_Multiply only in that the Etype of the resulting node is set (to
 111    --  Universal_Real), or they can be integer types. In this case the integer
 112    --  types need not be the same, and Build_Multiply chooses a type long
 113    --  enough to hold the product (i.e. twice the size of the longer of the two
 114    --  operand types), and both operands are converted to this type. The Etype
 115    --  of the result is also set to this value. However, the result can never
 116    --  overflow Integer_64, so this is the largest type that is ever generated.
 117    --  On return, the resulting node is analyzed and has its Etype set.
 118
 119    function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
 120    --  Builds an N_Op_Rem node from the given left and right operand
 121    --  expressions, using the source location from Sloc (N). The operands are
 122    --  both integer types, which need not be the same. Build_Rem converts the
 123    --  operand with the smaller sized type to match the type of the other
 124    --  operand and sets this as the result type. The result is never rounded
 125    --  (rem operations cannot be rounded in any case!) On return, the resulting
 126    --  node is analyzed and has its Etype set.
 127
 128    function Build_Scaled_Divide
 129      (N       : Node_Id;
 130       X, Y, Z : Node_Id) return Node_Id;
 131    --  Returns a node corresponding to the value X*Y/Z using the source
 132    --  location from Sloc (N). The division is rounded if the Rounded_Result
 133    --  flag of N is set. The integer types of X, Y, Z may be different. On
 134    --  return the resulting node is analyzed and has is Etype set.
 135
 136    procedure Build_Scaled_Divide_Code
 137      (N        : Node_Id;
 138       X, Y, Z  : Node_Id;
 139       Qnn, Rnn : out Entity_Id;
 140       Code     : out List_Id);
 141    --  Generates a sequence of code for determining the quotient and remainder
 142    --  of the division X*Y/Z, using the source location from Sloc (N). Entities
 143    --  of appropriate types are allocated for the quotient and remainder and
 144    --  returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
 145    --  The division is rounded if the Rounded_Result flag of N is set. The
 146    --  Etype fields of Qnn and Rnn are appropriately set on return.
 147
 148    procedure Do_Divide_Fixed_Fixed (N : Node_Id);
 149    --  Handles expansion of divide for case of two fixed-point operands
 150    --  (neither of them universal), with an integer or fixed-point result.
 151    --  N is the N_Op_Divide node to be expanded.
 152
 153    procedure Do_Divide_Fixed_Universal (N : Node_Id);
 154    --  Handles expansion of divide for case of a fixed-point operand divided
 155    --  by a universal real operand, with an integer or fixed-point result. N
 156    --  is the N_Op_Divide node to be expanded.
 157
 158    procedure Do_Divide_Universal_Fixed (N : Node_Id);
 159    --  Handles expansion of divide for case of a universal real operand
 160    --  divided by a fixed-point operand, with an integer or fixed-point
 161    --  result. N is the N_Op_Divide node to be expanded.
 162
 163    procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
 164    --  Handles expansion of multiply for case of two fixed-point operands
 165    --  (neither of them universal), with an integer or fixed-point result.
 166    --  N is the N_Op_Multiply node to be expanded.
 167
 168    procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
 169    --  Handles expansion of multiply for case of a fixed-point operand
 170    --  multiplied by a universal real operand, with an integer or fixed-
 171    --  point result. N is the N_Op_Multiply node to be expanded, and
 172    --  Left, Right are the operands (which may have been switched).
 173
 174    procedure Expand_Convert_Fixed_Static (N : Node_Id);
 175    --  This routine is called where the node N is a conversion of a literal
 176    --  or other static expression of a fixed-point type to some other type.
 177    --  In such cases, we simply rewrite the operand as a real literal and
 178    --  reanalyze. This avoids problems which would otherwise result from
 179    --  attempting to build and fold expressions involving constants.
 180
 181    function Fpt_Value (N : Node_Id) return Node_Id;
 182    --  Given an operand of fixed-point operation, return an expression that
 183    --  represents the corresponding Universal_Real value. The expression
 184    --  can be of integer type, floating-point type, or fixed-point type.
 185    --  The expression returned is neither analyzed and resolved. The Etype
 186    --  of the result is properly set (to Universal_Real).
 187
 188    function Integer_Literal
 189      (N        : Node_Id;
 190       V        : Uint;
 191       Negative : Boolean := False) return Node_Id;
 192    --  Given a non-negative universal integer value, build a typed integer
 193    --  literal node, using the smallest applicable standard integer type. If
 194    --  and only if Negative is true a negative literal is built. If V exceeds
 195    --  2**63-1, the largest value allowed for perfect result set scaling
 196    --  factors (see RM G.2.3(22)), then Empty is returned. The node N provides
 197    --  the Sloc value for the constructed literal. The Etype of the resulting
 198    --  literal is correctly set, and it is marked as analyzed.
 199
 200    function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
 201    --  Build a real literal node from the given value, the Etype of the
 202    --  returned node is set to Universal_Real, since all floating-point
 203    --  arithmetic operations that we construct use Universal_Real
 204
 205    function Rounded_Result_Set (N : Node_Id) return Boolean;
 206    --  Returns True if N is a node that contains the Rounded_Result flag
 207    --  and if the flag is true or the target type is an integer type.
 208
 209    procedure Set_Result
 210      (N     : Node_Id;
 211       Expr  : Node_Id;
 212       Rchk  : Boolean := False;
 213       Trunc : Boolean := False);
 214    --  N is the node for the current conversion, division or multiplication
 215    --  operation, and Expr is an expression representing the result. Expr may
 216    --  be of floating-point or integer type. If the operation result is fixed-
 217    --  point, then the value of Expr is in units of small of the result type
 218    --  (i.e. small's have already been dealt with). The result of the call is
 219    --  to replace N by an appropriate conversion to the result type, dealing
 220    --  with rounding for the decimal types case. The node is then analyzed and
 221    --  resolved using the result type. If Rchk or Trunc are True, then
 222    --  respectively Do_Range_Check and Float_Truncate are set in the
 223    --  resulting conversion.
 224
 225    ----------------------
 226    -- Build_Conversion --
 227    ----------------------
 228
 229    function Build_Conversion
 230      (N     : Node_Id;
 231       Typ   : Entity_Id;
 232       Expr  : Node_Id;
 233       Rchk  : Boolean := False;
 234       Trunc : Boolean := False) return Node_Id
 235    is
 236       Loc    : constant Source_Ptr := Sloc (N);
 237       Result : Node_Id;
 238       Rcheck : Boolean := Rchk;
 239
 240    begin
 241       --  A special case, if the expression is an integer literal and the
 242       --  target type is an integer type, then just retype the integer
 243       --  literal to the desired target type. Don't do this if we need
 244       --  a range check.
 245
 246       if Nkind (Expr) = N_Integer_Literal
 247         and then Is_Integer_Type (Typ)
 248         and then not Rchk
 249       then
 250          Result := Expr;
 251
 252       --  Cases where we end up with a conversion. Note that we do not use the
 253       --  Convert_To abstraction here, since we may be decorating the resulting
 254       --  conversion with Rounded_Result and/or Conversion_OK, so we want the
 255       --  conversion node present, even if it appears to be redundant.
 256
 257       else
 258          --  Remove inner conversion if both inner and outer conversions are
 259          --  to integer types, since the inner one serves no purpose (except
 260          --  perhaps to set rounding, so we preserve the Rounded_Result flag)
 261          --  and also we preserve the range check flag on the inner operand
 262
 263          if Is_Integer_Type (Typ)
 264            and then Is_Integer_Type (Etype (Expr))
 265            and then Nkind (Expr) = N_Type_Conversion
 266          then
 267             Result :=
 268               Make_Type_Conversion (Loc,
 269                 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
 270                 Expression   => Expression (Expr));
 271             Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
 272             Rcheck := Rcheck or Do_Range_Check (Expr);
 273
 274          --  For all other cases, a simple type conversion will work
 275
 276          else
 277             Result :=
 278               Make_Type_Conversion (Loc,
 279                 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
 280                 Expression   => Expr);
 281
 282             Set_Float_Truncate (Result, Trunc);
 283          end if;
 284
 285          --  Set Conversion_OK if either result or expression type is a
 286          --  fixed-point type, since from a semantic point of view, we are
 287          --  treating fixed-point values as integers at this stage.
 288
 289          if Is_Fixed_Point_Type (Typ)
 290            or else Is_Fixed_Point_Type (Etype (Expression (Result)))
 291          then
 292             Set_Conversion_OK (Result);
 293          end if;
 294
 295          --  Set Do_Range_Check if either it was requested by the caller,
 296          --  or if an eliminated inner conversion had a range check.
 297
 298          if Rcheck then
 299             Enable_Range_Check (Result);
 300          else
 301             Set_Do_Range_Check (Result, False);
 302          end if;
 303       end if;
 304
 305       Set_Etype (Result, Typ);
 306       return Result;
 307    end Build_Conversion;
 308
 309    ------------------
 310    -- Build_Divide --
 311    ------------------
 312
 313    function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
 314       Loc         : constant Source_Ptr := Sloc (N);
 315       Left_Type   : constant Entity_Id  := Base_Type (Etype (L));
 316       Right_Type  : constant Entity_Id  := Base_Type (Etype (R));
 317       Result_Type : Entity_Id;
 318       Rnode       : Node_Id;
 319
 320    begin
 321       --  Deal with floating-point case first
 322
 323       if Is_Floating_Point_Type (Left_Type) then
 324          pragma Assert (Left_Type = Universal_Real);
 325          pragma Assert (Right_Type = Universal_Real);
 326
 327          Rnode := Make_Op_Divide (Loc, L, R);
 328          Result_Type := Universal_Real;
 329
 330       --  Integer and fixed-point cases
 331
 332       else
 333          --  An optimization. If the right operand is the literal 1, then we
 334          --  can just return the left hand operand. Putting the optimization
 335          --  here allows us to omit the check at the call site.
 336
 337          if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
 338             return L;
 339          end if;
 340
 341          --  If left and right types are the same, no conversion needed
 342
 343          if Left_Type = Right_Type then
 344             Result_Type := Left_Type;
 345             Rnode :=
 346               Make_Op_Divide (Loc,
 347                 Left_Opnd  => L,
 348                 Right_Opnd => R);
 349
 350          --  Use left type if it is the larger of the two
 351
 352          elsif Esize (Left_Type) >= Esize (Right_Type) then
 353             Result_Type := Left_Type;
 354             Rnode :=
 355               Make_Op_Divide (Loc,
 356                 Left_Opnd  => L,
 357                 Right_Opnd => Build_Conversion (N, Left_Type, R));
 358
 359          --  Otherwise right type is larger of the two, us it
 360
 361          else
 362             Result_Type := Right_Type;
 363             Rnode :=
 364               Make_Op_Divide (Loc,
 365                 Left_Opnd => Build_Conversion (N, Right_Type, L),
 366                 Right_Opnd => R);
 367          end if;
 368       end if;
 369
 370       --  We now have a divide node built with Result_Type set. First
 371       --  set Etype of result, as required for all Build_xxx routines
 372
 373       Set_Etype (Rnode, Base_Type (Result_Type));
 374
 375       --  Set Treat_Fixed_As_Integer if operation on fixed-point type
 376       --  since this is a literal arithmetic operation, to be performed
 377       --  by Gigi without any consideration of small values.
 378
 379       if Is_Fixed_Point_Type (Result_Type) then
 380          Set_Treat_Fixed_As_Integer (Rnode);
 381       end if;
 382
 383       --  The result is rounded if the target of the operation is decimal
 384       --  and Rounded_Result is set, or if the target of the operation
 385       --  is an integer type.
 386
 387       if Is_Integer_Type (Etype (N))
 388         or else Rounded_Result_Set (N)
 389       then
 390          Set_Rounded_Result (Rnode);
 391       end if;
 392
 393       return Rnode;
 394    end Build_Divide;
 395
 396    -------------------------
 397    -- Build_Double_Divide --
 398    -------------------------
 399
 400    function Build_Double_Divide
 401      (N       : Node_Id;
 402       X, Y, Z : Node_Id) return Node_Id
 403    is
 404       Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
 405       Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
 406       Expr   : Node_Id;
 407
 408    begin
 409       --  If denominator fits in 64 bits, we can build the operations directly
 410       --  without causing any intermediate overflow, so that's what we do!
 411
 412       if Int'Max (Y_Size, Z_Size) <= 32 then
 413          return
 414            Build_Divide (N, X, Build_Multiply (N, Y, Z));
 415
 416       --  Otherwise we use the runtime routine
 417
 418       --    [Qnn : Interfaces.Integer_64,
 419       --     Rnn : Interfaces.Integer_64;
 420       --     Double_Divide (X, Y, Z, Qnn, Rnn, Round);
 421       --     Qnn]
 422
 423       else
 424          declare
 425             Loc  : constant Source_Ptr := Sloc (N);
 426             Qnn  : Entity_Id;
 427             Rnn  : Entity_Id;
 428             Code : List_Id;
 429
 430             pragma Warnings (Off, Rnn);
 431
 432          begin
 433             Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
 434             Insert_Actions (N, Code);
 435             Expr := New_Occurrence_Of (Qnn, Loc);
 436
 437             --  Set type of result in case used elsewhere (see note at start)
 438
 439             Set_Etype (Expr, Etype (Qnn));
 440
 441             --  Set result as analyzed (see note at start on build routines)
 442
 443             return Expr;
 444          end;
 445       end if;
 446    end Build_Double_Divide;
 447
 448    ------------------------------
 449    -- Build_Double_Divide_Code --
 450    ------------------------------
 451
 452    --  If the denominator can be computed in 64-bits, we build
 453
 454    --    [Nnn : constant typ := typ (X);
 455    --     Dnn : constant typ := typ (Y) * typ (Z)
 456    --     Qnn : constant typ := Nnn / Dnn;
 457    --     Rnn : constant typ := Nnn / Dnn;
 458
 459    --  If the numerator cannot be computed in 64 bits, we build
 460
 461    --    [Qnn : typ;
 462    --     Rnn : typ;
 463    --     Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
 464
 465    procedure Build_Double_Divide_Code
 466      (N        : Node_Id;
 467       X, Y, Z  : Node_Id;
 468       Qnn, Rnn : out Entity_Id;
 469       Code     : out List_Id)
 470    is
 471       Loc    : constant Source_Ptr := Sloc (N);
 472
 473       X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
 474       Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
 475       Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
 476
 477       QR_Siz : Int;
 478       QR_Typ : Entity_Id;
 479
 480       Nnn : Entity_Id;
 481       Dnn : Entity_Id;
 482
 483       Quo : Node_Id;
 484       Rnd : Entity_Id;
 485
 486    begin
 487       --  Find type that will allow computation of numerator
 488
 489       QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
 490
 491       if QR_Siz <= 16 then
 492          QR_Typ := Standard_Integer_16;
 493       elsif QR_Siz <= 32 then
 494          QR_Typ := Standard_Integer_32;
 495       elsif QR_Siz <= 64 then
 496          QR_Typ := Standard_Integer_64;
 497
 498       --  For more than 64, bits, we use the 64-bit integer defined in
 499       --  Interfaces, so that it can be handled by the runtime routine
 500
 501       else
 502          QR_Typ := RTE (RE_Integer_64);
 503       end if;
 504
 505       --  Define quotient and remainder, and set their Etypes, so
 506       --  that they can be picked up by Build_xxx routines.
 507
 508       Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
 509       Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
 510
 511       Set_Etype (Qnn, QR_Typ);
 512       Set_Etype (Rnn, QR_Typ);
 513
 514       --  Case that we can compute the denominator in 64 bits
 515
 516       if QR_Siz <= 64 then
 517
 518          --  Create temporaries for numerator and denominator and set Etypes,
 519          --  so that New_Occurrence_Of picks them up for Build_xxx calls.
 520
 521          Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
 522          Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
 523
 524          Set_Etype (Nnn, QR_Typ);
 525          Set_Etype (Dnn, QR_Typ);
 526
 527          Code := New_List (
 528            Make_Object_Declaration (Loc,
 529              Defining_Identifier => Nnn,
 530              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 531              Constant_Present    => True,
 532              Expression => Build_Conversion (N, QR_Typ, X)),
 533
 534            Make_Object_Declaration (Loc,
 535              Defining_Identifier => Dnn,
 536              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 537              Constant_Present    => True,
 538              Expression =>
 539                Build_Multiply (N,
 540                  Build_Conversion (N, QR_Typ, Y),
 541                  Build_Conversion (N, QR_Typ, Z))));
 542
 543          Quo :=
 544            Build_Divide (N,
 545              New_Occurrence_Of (Nnn, Loc),
 546              New_Occurrence_Of (Dnn, Loc));
 547
 548          Set_Rounded_Result (Quo, Rounded_Result_Set (N));
 549
 550          Append_To (Code,
 551            Make_Object_Declaration (Loc,
 552              Defining_Identifier => Qnn,
 553              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 554              Constant_Present    => True,
 555              Expression          => Quo));
 556
 557          Append_To (Code,
 558            Make_Object_Declaration (Loc,
 559              Defining_Identifier => Rnn,
 560              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 561              Constant_Present    => True,
 562              Expression =>
 563                Build_Rem (N,
 564                  New_Occurrence_Of (Nnn, Loc),
 565                  New_Occurrence_Of (Dnn, Loc))));
 566
 567       --  Case where denominator does not fit in 64 bits, so we have to
 568       --  call the runtime routine to compute the quotient and remainder
 569
 570       else
 571          Rnd := Boolean_Literals (Rounded_Result_Set (N));
 572
 573          Code := New_List (
 574            Make_Object_Declaration (Loc,
 575              Defining_Identifier => Qnn,
 576              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc)),
 577
 578            Make_Object_Declaration (Loc,
 579              Defining_Identifier => Rnn,
 580              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc)),
 581
 582            Make_Procedure_Call_Statement (Loc,
 583              Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
 584              Parameter_Associations => New_List (
 585                Build_Conversion (N, QR_Typ, X),
 586                Build_Conversion (N, QR_Typ, Y),
 587                Build_Conversion (N, QR_Typ, Z),
 588                New_Occurrence_Of (Qnn, Loc),
 589                New_Occurrence_Of (Rnn, Loc),
 590                New_Occurrence_Of (Rnd, Loc))));
 591       end if;
 592    end Build_Double_Divide_Code;
 593
 594    --------------------
 595    -- Build_Multiply --
 596    --------------------
 597
 598    function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
 599       Loc         : constant Source_Ptr := Sloc (N);
 600       Left_Type   : constant Entity_Id  := Etype (L);
 601       Right_Type  : constant Entity_Id  := Etype (R);
 602       Left_Size   : Int;
 603       Right_Size  : Int;
 604       Rsize       : Int;
 605       Result_Type : Entity_Id;
 606       Rnode       : Node_Id;
 607
 608    begin
 609       --  Deal with floating-point case first
 610
 611       if Is_Floating_Point_Type (Left_Type) then
 612          pragma Assert (Left_Type = Universal_Real);
 613          pragma Assert (Right_Type = Universal_Real);
 614
 615          Result_Type := Universal_Real;
 616          Rnode := Make_Op_Multiply (Loc, L, R);
 617
 618       --  Integer and fixed-point cases
 619
 620       else
 621          --  An optimization. If the right operand is the literal 1, then we
 622          --  can just return the left hand operand. Putting the optimization
 623          --  here allows us to omit the check at the call site. Similarly, if
 624          --  the left operand is the integer 1 we can return the right operand.
 625
 626          if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
 627             return L;
 628          elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
 629             return R;
 630          end if;
 631
 632          --  Otherwise we need to figure out the correct result type size
 633          --  First figure out the effective sizes of the operands. Normally
 634          --  the effective size of an operand is the RM_Size of the operand.
 635          --  But a special case arises with operands whose size is known at
 636          --  compile time. In this case, we can use the actual value of the
 637          --  operand to get its size if it would fit signed in 8 or 16 bits.
 638
 639          Left_Size := UI_To_Int (RM_Size (Left_Type));
 640
 641          if Compile_Time_Known_Value (L) then
 642             declare
 643                Val : constant Uint := Expr_Value (L);
 644             begin
 645                if Val < Int'(2 ** 7) then
 646                   Left_Size := 8;
 647                elsif Val < Int'(2 ** 15) then
 648                   Left_Size := 16;
 649                end if;
 650             end;
 651          end if;
 652
 653          Right_Size := UI_To_Int (RM_Size (Right_Type));
 654
 655          if Compile_Time_Known_Value (R) then
 656             declare
 657                Val : constant Uint := Expr_Value (R);
 658             begin
 659                if Val <= Int'(2 ** 7) then
 660                   Right_Size := 8;
 661                elsif Val <= Int'(2 ** 15) then
 662                   Right_Size := 16;
 663                end if;
 664             end;
 665          end if;
 666
 667          --  Now the result size must be at least twice the longer of
 668          --  the two sizes, to accommodate all possible results.
 669
 670          Rsize := 2 * Int'Max (Left_Size, Right_Size);
 671
 672          if Rsize <= 8 then
 673             Result_Type := Standard_Integer_8;
 674
 675          elsif Rsize <= 16 then
 676             Result_Type := Standard_Integer_16;
 677
 678          elsif Rsize <= 32 then
 679             Result_Type := Standard_Integer_32;
 680
 681          else
 682             Result_Type := Standard_Integer_64;
 683          end if;
 684
 685          Rnode :=
 686             Make_Op_Multiply (Loc,
 687               Left_Opnd  => Build_Conversion (N, Result_Type, L),
 688               Right_Opnd => Build_Conversion (N, Result_Type, R));
 689       end if;
 690
 691       --  We now have a multiply node built with Result_Type set. First
 692       --  set Etype of result, as required for all Build_xxx routines
 693
 694       Set_Etype (Rnode, Base_Type (Result_Type));
 695
 696       --  Set Treat_Fixed_As_Integer if operation on fixed-point type
 697       --  since this is a literal arithmetic operation, to be performed
 698       --  by Gigi without any consideration of small values.
 699
 700       if Is_Fixed_Point_Type (Result_Type) then
 701          Set_Treat_Fixed_As_Integer (Rnode);
 702       end if;
 703
 704       return Rnode;
 705    end Build_Multiply;
 706
 707    ---------------
 708    -- Build_Rem --
 709    ---------------
 710
 711    function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
 712       Loc         : constant Source_Ptr := Sloc (N);
 713       Left_Type   : constant Entity_Id  := Etype (L);
 714       Right_Type  : constant Entity_Id  := Etype (R);
 715       Result_Type : Entity_Id;
 716       Rnode       : Node_Id;
 717
 718    begin
 719       if Left_Type = Right_Type then
 720          Result_Type := Left_Type;
 721          Rnode :=
 722            Make_Op_Rem (Loc,
 723              Left_Opnd  => L,
 724              Right_Opnd => R);
 725
 726       --  If left size is larger, we do the remainder operation using the
 727       --  size of the left type (i.e. the larger of the two integer types).
 728
 729       elsif Esize (Left_Type) >= Esize (Right_Type) then
 730          Result_Type := Left_Type;
 731          Rnode :=
 732            Make_Op_Rem (Loc,
 733              Left_Opnd  => L,
 734              Right_Opnd => Build_Conversion (N, Left_Type, R));
 735
 736       --  Similarly, if the right size is larger, we do the remainder
 737       --  operation using the right type.
 738
 739       else
 740          Result_Type := Right_Type;
 741          Rnode :=
 742            Make_Op_Rem (Loc,
 743              Left_Opnd => Build_Conversion (N, Right_Type, L),
 744              Right_Opnd => R);
 745       end if;
 746
 747       --  We now have an N_Op_Rem node built with Result_Type set. First
 748       --  set Etype of result, as required for all Build_xxx routines
 749
 750       Set_Etype (Rnode, Base_Type (Result_Type));
 751
 752       --  Set Treat_Fixed_As_Integer if operation on fixed-point type
 753       --  since this is a literal arithmetic operation, to be performed
 754       --  by Gigi without any consideration of small values.
 755
 756       if Is_Fixed_Point_Type (Result_Type) then
 757          Set_Treat_Fixed_As_Integer (Rnode);
 758       end if;
 759
 760       --  One more check. We did the rem operation using the larger of the
 761       --  two types, which is reasonable. However, in the case where the
 762       --  two types have unequal sizes, it is impossible for the result of
 763       --  a remainder operation to be larger than the smaller of the two
 764       --  types, so we can put a conversion round the result to keep the
 765       --  evolving operation size as small as possible.
 766
 767       if Esize (Left_Type) >= Esize (Right_Type) then
 768          Rnode := Build_Conversion (N, Right_Type, Rnode);
 769       elsif Esize (Right_Type) >= Esize (Left_Type) then
 770          Rnode := Build_Conversion (N, Left_Type, Rnode);
 771       end if;
 772
 773       return Rnode;
 774    end Build_Rem;
 775
 776    -------------------------
 777    -- Build_Scaled_Divide --
 778    -------------------------
 779
 780    function Build_Scaled_Divide
 781      (N       : Node_Id;
 782       X, Y, Z : Node_Id) return Node_Id
 783    is
 784       X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
 785       Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
 786       Expr   : Node_Id;
 787
 788    begin
 789       --  If numerator fits in 64 bits, we can build the operations directly
 790       --  without causing any intermediate overflow, so that's what we do!
 791
 792       if Int'Max (X_Size, Y_Size) <= 32 then
 793          return
 794            Build_Divide (N, Build_Multiply (N, X, Y), Z);
 795
 796       --  Otherwise we use the runtime routine
 797
 798       --    [Qnn : Integer_64,
 799       --     Rnn : Integer_64;
 800       --     Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
 801       --     Qnn]
 802
 803       else
 804          declare
 805             Loc  : constant Source_Ptr := Sloc (N);
 806             Qnn  : Entity_Id;
 807             Rnn  : Entity_Id;
 808             Code : List_Id;
 809
 810             pragma Warnings (Off, Rnn);
 811
 812          begin
 813             Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
 814             Insert_Actions (N, Code);
 815             Expr := New_Occurrence_Of (Qnn, Loc);
 816
 817             --  Set type of result in case used elsewhere (see note at start)
 818
 819             Set_Etype (Expr, Etype (Qnn));
 820             return Expr;
 821          end;
 822       end if;
 823    end Build_Scaled_Divide;
 824
 825    ------------------------------
 826    -- Build_Scaled_Divide_Code --
 827    ------------------------------
 828
 829    --  If the numerator can be computed in 64-bits, we build
 830
 831    --    [Nnn : constant typ := typ (X) * typ (Y);
 832    --     Dnn : constant typ := typ (Z)
 833    --     Qnn : constant typ := Nnn / Dnn;
 834    --     Rnn : constant typ := Nnn / Dnn;
 835
 836    --  If the numerator cannot be computed in 64 bits, we build
 837
 838    --    [Qnn : Interfaces.Integer_64;
 839    --     Rnn : Interfaces.Integer_64;
 840    --     Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
 841
 842    procedure Build_Scaled_Divide_Code
 843      (N        : Node_Id;
 844       X, Y, Z  : Node_Id;
 845       Qnn, Rnn : out Entity_Id;
 846       Code     : out List_Id)
 847    is
 848       Loc    : constant Source_Ptr := Sloc (N);
 849
 850       X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
 851       Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
 852       Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
 853
 854       QR_Siz : Int;
 855       QR_Typ : Entity_Id;
 856
 857       Nnn : Entity_Id;
 858       Dnn : Entity_Id;
 859
 860       Quo : Node_Id;
 861       Rnd : Entity_Id;
 862
 863    begin
 864       --  Find type that will allow computation of numerator
 865
 866       QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
 867
 868       if QR_Siz <= 16 then
 869          QR_Typ := Standard_Integer_16;
 870       elsif QR_Siz <= 32 then
 871          QR_Typ := Standard_Integer_32;
 872       elsif QR_Siz <= 64 then
 873          QR_Typ := Standard_Integer_64;
 874
 875       --  For more than 64, bits, we use the 64-bit integer defined in
 876       --  Interfaces, so that it can be handled by the runtime routine
 877
 878       else
 879          QR_Typ := RTE (RE_Integer_64);
 880       end if;
 881
 882       --  Define quotient and remainder, and set their Etypes, so
 883       --  that they can be picked up by Build_xxx routines.
 884
 885       Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
 886       Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
 887
 888       Set_Etype (Qnn, QR_Typ);
 889       Set_Etype (Rnn, QR_Typ);
 890
 891       --  Case that we can compute the numerator in 64 bits
 892
 893       if QR_Siz <= 64 then
 894          Nnn := Make_Defining_Identifier (Loc, New_Internal_Name  ('N'));
 895          Dnn := Make_Defining_Identifier (Loc, New_Internal_Name  ('D'));
 896
 897          --  Set Etypes, so that they can be picked up by New_Occurrence_Of
 898
 899          Set_Etype (Nnn, QR_Typ);
 900          Set_Etype (Dnn, QR_Typ);
 901
 902          Code := New_List (
 903            Make_Object_Declaration (Loc,
 904              Defining_Identifier => Nnn,
 905              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 906              Constant_Present    => True,
 907              Expression =>
 908                Build_Multiply (N,
 909                  Build_Conversion (N, QR_Typ, X),
 910                  Build_Conversion (N, QR_Typ, Y))),
 911
 912            Make_Object_Declaration (Loc,
 913              Defining_Identifier => Dnn,
 914              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 915              Constant_Present    => True,
 916              Expression => Build_Conversion (N, QR_Typ, Z)));
 917
 918          Quo :=
 919            Build_Divide (N,
 920              New_Occurrence_Of (Nnn, Loc),
 921              New_Occurrence_Of (Dnn, Loc));
 922
 923          Append_To (Code,
 924            Make_Object_Declaration (Loc,
 925              Defining_Identifier => Qnn,
 926              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 927              Constant_Present    => True,
 928              Expression          => Quo));
 929
 930          Append_To (Code,
 931            Make_Object_Declaration (Loc,
 932              Defining_Identifier => Rnn,
 933              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc),
 934              Constant_Present    => True,
 935              Expression =>
 936                Build_Rem (N,
 937                  New_Occurrence_Of (Nnn, Loc),
 938                  New_Occurrence_Of (Dnn, Loc))));
 939
 940       --  Case where numerator does not fit in 64 bits, so we have to
 941       --  call the runtime routine to compute the quotient and remainder
 942
 943       else
 944          Rnd := Boolean_Literals (Rounded_Result_Set (N));
 945
 946          Code := New_List (
 947            Make_Object_Declaration (Loc,
 948              Defining_Identifier => Qnn,
 949              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc)),
 950
 951            Make_Object_Declaration (Loc,
 952              Defining_Identifier => Rnn,
 953              Object_Definition   => New_Occurrence_Of (QR_Typ, Loc)),
 954
 955            Make_Procedure_Call_Statement (Loc,
 956              Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
 957              Parameter_Associations => New_List (
 958                Build_Conversion (N, QR_Typ, X),
 959                Build_Conversion (N, QR_Typ, Y),
 960                Build_Conversion (N, QR_Typ, Z),
 961                New_Occurrence_Of (Qnn, Loc),
 962                New_Occurrence_Of (Rnn, Loc),
 963                New_Occurrence_Of (Rnd, Loc))));
 964       end if;
 965
 966       --  Set type of result, for use in caller
 967
 968       Set_Etype (Qnn, QR_Typ);
 969    end Build_Scaled_Divide_Code;
 970
 971    ---------------------------
 972    -- Do_Divide_Fixed_Fixed --
 973    ---------------------------
 974
 975    --  We have:
 976
 977    --    (Result_Value * Result_Small) =
 978    --        (Left_Value * Left_Small) / (Right_Value * Right_Small)
 979
 980    --    Result_Value = (Left_Value / Right_Value) *
 981    --                   (Left_Small / (Right_Small * Result_Small));
 982
 983    --  we can do the operation in integer arithmetic if this fraction is an
 984    --  integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
 985    --  Otherwise the result is in the close result set and our approach is to
 986    --  use floating-point to compute this close result.
 987
 988    procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
 989       Left        : constant Node_Id   := Left_Opnd (N);
 990       Right       : constant Node_Id   := Right_Opnd (N);
 991       Left_Type   : constant Entity_Id := Etype (Left);
 992       Right_Type  : constant Entity_Id := Etype (Right);
 993       Result_Type : constant Entity_Id := Etype (N);
 994       Right_Small : constant Ureal     := Small_Value (Right_Type);
 995       Left_Small  : constant Ureal     := Small_Value (Left_Type);
 996
 997       Result_Small : Ureal;
 998       Frac         : Ureal;
 999       Frac_Num     : Uint;
1000       Frac_Den     : Uint;
1001       Lit_Int      : Node_Id;
1002
1003    begin
1004       --  Rounding is required if the result is integral
1005
1006       if Is_Integer_Type (Result_Type) then
1007          Set_Rounded_Result (N);
1008       end if;
1009
1010       --  Get result small. If the result is an integer, treat it as though
1011       --  it had a small of 1.0, all other processing is identical.
1012
1013       if Is_Integer_Type (Result_Type) then
1014          Result_Small := Ureal_1;
1015       else
1016          Result_Small := Small_Value (Result_Type);
1017       end if;
1018
1019       --  Get small ratio
1020
1021       Frac     := Left_Small / (Right_Small * Result_Small);
1022       Frac_Num := Norm_Num (Frac);
1023       Frac_Den := Norm_Den (Frac);
1024
1025       --  If the fraction is an integer, then we get the result by multiplying
1026       --  the left operand by the integer, and then dividing by the right
1027       --  operand (the order is important, if we did the divide first, we
1028       --  would lose precision).
1029
1030       if Frac_Den = 1 then
1031          Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1032
1033          if Present (Lit_Int) then
1034             Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1035             return;
1036          end if;
1037
1038       --  If the fraction is the reciprocal of an integer, then we get the
1039       --  result by first multiplying the divisor by the integer, and then
1040       --  doing the division with the adjusted divisor.
1041
1042       --  Note: this is much better than doing two divisions: multiplications
1043       --  are much faster than divisions (and certainly faster than rounded
1044       --  divisions), and we don't get inaccuracies from double rounding.
1045
1046       elsif Frac_Num = 1 then
1047          Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1048
1049          if Present (Lit_Int) then
1050             Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1051             return;
1052          end if;
1053       end if;
1054
1055       --  If we fall through, we use floating-point to compute the result
1056
1057       Set_Result (N,
1058         Build_Multiply (N,
1059           Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1060           Real_Literal (N, Frac)));
1061    end Do_Divide_Fixed_Fixed;
1062
1063    -------------------------------
1064    -- Do_Divide_Fixed_Universal --
1065    -------------------------------
1066
1067    --  We have:
1068
1069    --    (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1070    --    Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1071
1072    --  The result is required to be in the perfect result set if the literal
1073    --  can be factored so that the resulting small ratio is an integer or the
1074    --  reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1075    --  analysis of these RM requirements:
1076
1077    --  We must factor the literal, finding an integer K:
1078
1079    --     Lit_Value = K * Right_Small
1080    --     Right_Small = Lit_Value / K
1081
1082    --  such that the small ratio:
1083
1084    --              Left_Small
1085    --     ------------------------------
1086    --     (Lit_Value / K) * Result_Small
1087
1088    --            Left_Small
1089    --  =  ------------------------  *  K
1090    --     Lit_Value * Result_Small
1091
1092    --  is an integer or the reciprocal of an integer, and for
1093    --  implementation efficiency we need the smallest such K.
1094
1095    --  First we reduce the left fraction to lowest terms
1096
1097    --    If numerator = 1, then for K = 1, the small ratio is the reciprocal
1098    --    of an integer, and this is clearly the minimum K case, so set K = 1,
1099    --    Right_Small = Lit_Value.
1100
1101    --    If numerator > 1, then set K to the denominator of the fraction so
1102    --    that the resulting small ratio is an integer (the numerator value).
1103
1104    procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1105       Left        : constant Node_Id   := Left_Opnd (N);
1106       Right       : constant Node_Id   := Right_Opnd (N);
1107       Left_Type   : constant Entity_Id := Etype (Left);
1108       Result_Type : constant Entity_Id := Etype (N);
1109       Left_Small  : constant Ureal     := Small_Value (Left_Type);
1110       Lit_Value   : constant Ureal     := Realval (Right);
1111
1112       Result_Small : Ureal;
1113       Frac         : Ureal;
1114       Frac_Num     : Uint;
1115       Frac_Den     : Uint;
1116       Lit_K        : Node_Id;
1117       Lit_Int      : Node_Id;
1118
1119    begin
1120       --  Get result small. If the result is an integer, treat it as though
1121       --  it had a small of 1.0, all other processing is identical.
1122
1123       if Is_Integer_Type (Result_Type) then
1124          Result_Small := Ureal_1;
1125       else
1126          Result_Small := Small_Value (Result_Type);
1127       end if;
1128
1129       --  Determine if literal can be rewritten successfully
1130
1131       Frac     := Left_Small / (Lit_Value * Result_Small);
1132       Frac_Num := Norm_Num (Frac);
1133       Frac_Den := Norm_Den (Frac);
1134
1135       --  Case where fraction is the reciprocal of an integer (K = 1, integer
1136       --  = denominator). If this integer is not too large, this is the case
1137       --  where the result can be obtained by dividing by this integer value.
1138
1139       if Frac_Num = 1 then
1140          Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1141
1142          if Present (Lit_Int) then
1143             Set_Result (N, Build_Divide (N, Left, Lit_Int));
1144             return;
1145          end if;
1146
1147       --  Case where we choose K to make fraction an integer (K = denominator
1148       --  of fraction, integer = numerator of fraction). If both K and the
1149       --  numerator are small enough, this is the case where the result can
1150       --  be obtained by first multiplying by the integer value and then
1151       --  dividing by K (the order is important, if we divided first, we
1152       --  would lose precision).
1153
1154       else
1155          Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1156          Lit_K   := Integer_Literal (N, Frac_Den, False);
1157
1158          if Present (Lit_Int) and then Present (Lit_K) then
1159             Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1160             return;
1161          end if;
1162       end if;
1163
1164       --  Fall through if the literal cannot be successfully rewritten, or if
1165       --  the small ratio is out of range of integer arithmetic. In the former
1166       --  case it is fine to use floating-point to get the close result set,
1167       --  and in the latter case, it means that the result is zero or raises
1168       --  constraint error, and we can do that accurately in floating-point.
1169
1170       --  If we end up using floating-point, then we take the right integer
1171       --  to be one, and its small to be the value of the original right real
1172       --  literal. That way, we need only one floating-point multiplication.
1173
1174       Set_Result (N,
1175         Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1176    end Do_Divide_Fixed_Universal;
1177
1178    -------------------------------
1179    -- Do_Divide_Universal_Fixed --
1180    -------------------------------
1181
1182    --  We have:
1183
1184    --    (Result_Value * Result_Small) =
1185    --          Lit_Value / (Right_Value * Right_Small)
1186    --    Result_Value =
1187    --          (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1188
1189    --  The result is required to be in the perfect result set if the literal
1190    --  can be factored so that the resulting small ratio is an integer or the
1191    --  reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1192    --  analysis of these RM requirements:
1193
1194    --  We must factor the literal, finding an integer K:
1195
1196    --     Lit_Value = K * Left_Small
1197    --     Left_Small = Lit_Value / K
1198
1199    --  such that the small ratio:
1200
1201    --           (Lit_Value / K)
1202    --     --------------------------
1203    --     Right_Small * Result_Small
1204
1205    --              Lit_Value             1
1206    --  =  --------------------------  *  -
1207    --     Right_Small * Result_Small     K
1208
1209    --  is an integer or the reciprocal of an integer, and for
1210    --  implementation efficiency we need the smallest such K.
1211
1212    --  First we reduce the left fraction to lowest terms
1213
1214    --    If denominator = 1, then for K = 1, the small ratio is an integer
1215    --    (the numerator) and this is clearly the minimum K case, so set K = 1,
1216    --    and Left_Small = Lit_Value.
1217
1218    --    If denominator > 1, then set K to the numerator of the fraction so
1219    --    that the resulting small ratio is the reciprocal of an integer (the
1220    --    numerator value).
1221
1222    procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1223       Left        : constant Node_Id   := Left_Opnd (N);
1224       Right       : constant Node_Id   := Right_Opnd (N);
1225       Right_Type  : constant Entity_Id := Etype (Right);
1226       Result_Type : constant Entity_Id := Etype (N);
1227       Right_Small : constant Ureal     := Small_Value (Right_Type);
1228       Lit_Value   : constant Ureal     := Realval (Left);
1229
1230       Result_Small : Ureal;
1231       Frac         : Ureal;
1232       Frac_Num     : Uint;
1233       Frac_Den     : Uint;
1234       Lit_K        : Node_Id;
1235       Lit_Int      : Node_Id;
1236
1237    begin
1238       --  Get result small. If the result is an integer, treat it as though
1239       --  it had a small of 1.0, all other processing is identical.
1240
1241       if Is_Integer_Type (Result_Type) then
1242          Result_Small := Ureal_1;
1243       else
1244          Result_Small := Small_Value (Result_Type);
1245       end if;
1246
1247       --  Determine if literal can be rewritten successfully
1248
1249       Frac     := Lit_Value / (Right_Small * Result_Small);
1250       Frac_Num := Norm_Num (Frac);
1251       Frac_Den := Norm_Den (Frac);
1252
1253       --  Case where fraction is an integer (K = 1, integer = numerator). If
1254       --  this integer is not too large, this is the case where the result
1255       --  can be obtained by dividing this integer by the right operand.
1256
1257       if Frac_Den = 1 then
1258          Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1259
1260          if Present (Lit_Int) then
1261             Set_Result (N, Build_Divide (N, Lit_Int, Right));
1262             return;
1263          end if;
1264
1265       --  Case where we choose K to make the fraction the reciprocal of an
1266       --  integer (K = numerator of fraction, integer = numerator of fraction).
1267       --  If both K and the integer are small enough, this is the case where
1268       --  the result can be obtained by multiplying the right operand by K
1269       --  and then dividing by the integer value. The order of the operations
1270       --  is important (if we divided first, we would lose precision).
1271
1272       else
1273          Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1274          Lit_K   := Integer_Literal (N, Frac_Num, False);
1275
1276          if Present (Lit_Int) and then Present (Lit_K) then
1277             Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1278             return;
1279          end if;
1280       end if;
1281
1282       --  Fall through if the literal cannot be successfully rewritten, or if
1283       --  the small ratio is out of range of integer arithmetic. In the former
1284       --  case it is fine to use floating-point to get the close result set,
1285       --  and in the latter case, it means that the result is zero or raises
1286       --  constraint error, and we can do that accurately in floating-point.
1287
1288       --  If we end up using floating-point, then we take the right integer
1289       --  to be one, and its small to be the value of the original right real
1290       --  literal. That way, we need only one floating-point division.
1291
1292       Set_Result (N,
1293         Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1294    end Do_Divide_Universal_Fixed;
1295
1296    -----------------------------
1297    -- Do_Multiply_Fixed_Fixed --
1298    -----------------------------
1299
1300    --  We have:
1301
1302    --    (Result_Value * Result_Small) =
1303    --        (Left_Value * Left_Small) * (Right_Value * Right_Small)
1304
1305    --    Result_Value = (Left_Value * Right_Value) *
1306    --                   (Left_Small * Right_Small) / Result_Small;
1307
1308    --  we can do the operation in integer arithmetic if this fraction is an
1309    --  integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1310    --  Otherwise the result is in the close result set and our approach is to
1311    --  use floating-point to compute this close result.
1312
1313    procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1314       Left  : constant Node_Id := Left_Opnd (N);
1315       Right : constant Node_Id := Right_Opnd (N);
1316
1317       Left_Type   : constant Entity_Id := Etype (Left);
1318       Right_Type  : constant Entity_Id := Etype (Right);
1319       Result_Type : constant Entity_Id := Etype (N);
1320       Right_Small : constant Ureal     := Small_Value (Right_Type);
1321       Left_Small  : constant Ureal     := Small_Value (Left_Type);
1322
1323       Result_Small : Ureal;
1324       Frac         : Ureal;
1325       Frac_Num     : Uint;
1326       Frac_Den     : Uint;
1327       Lit_Int      : Node_Id;
1328
1329    begin
1330       --  Get result small. If the result is an integer, treat it as though
1331       --  it had a small of 1.0, all other processing is identical.
1332
1333       if Is_Integer_Type (Result_Type) then
1334          Result_Small := Ureal_1;
1335       else
1336          Result_Small := Small_Value (Result_Type);
1337       end if;
1338
1339       --  Get small ratio
1340
1341       Frac     := (Left_Small * Right_Small) / Result_Small;
1342       Frac_Num := Norm_Num (Frac);
1343       Frac_Den := Norm_Den (Frac);
1344
1345       --  If the fraction is an integer, then we get the result by multiplying
1346       --  the operands, and then multiplying the result by the integer value.
1347
1348       if Frac_Den = 1 then
1349          Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1350
1351          if Present (Lit_Int) then
1352             Set_Result (N,
1353               Build_Multiply (N, Build_Multiply (N, Left, Right),
1354                 Lit_Int));
1355             return;
1356          end if;
1357
1358       --  If the fraction is the reciprocal of an integer, then we get the
1359       --  result by multiplying the operands, and then dividing the result by
1360       --  the integer value. The order of the operations is important, if we
1361       --  divided first, we would lose precision.
1362
1363       elsif Frac_Num = 1 then
1364          Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1365
1366          if Present (Lit_Int) then
1367             Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1368             return;
1369          end if;
1370       end if;
1371
1372       --  If we fall through, we use floating-point to compute the result
1373
1374       Set_Result (N,
1375         Build_Multiply (N,
1376           Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1377           Real_Literal (N, Frac)));
1378    end Do_Multiply_Fixed_Fixed;
1379
1380    ---------------------------------
1381    -- Do_Multiply_Fixed_Universal --
1382    ---------------------------------
1383
1384    --  We have:
1385
1386    --    (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1387    --    Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1388
1389    --  The result is required to be in the perfect result set if the literal
1390    --  can be factored so that the resulting small ratio is an integer or the
1391    --  reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1392    --  analysis of these RM requirements:
1393
1394    --  We must factor the literal, finding an integer K:
1395
1396    --     Lit_Value = K * Right_Small
1397    --     Right_Small = Lit_Value / K
1398
1399    --  such that the small ratio:
1400
1401    --     Left_Small * (Lit_Value / K)
1402    --     ----------------------------
1403    --             Result_Small
1404
1405    --     Left_Small * Lit_Value     1
1406    --  =  ----------------------  *  -
1407    --          Result_Small          K
1408
1409    --  is an integer or the reciprocal of an integer, and for
1410    --  implementation efficiency we need the smallest such K.
1411
1412    --  First we reduce the left fraction to lowest terms
1413
1414    --    If denominator = 1, then for K = 1, the small ratio is an integer, and
1415    --    this is clearly the minimum K case, so set
1416
1417    --      K = 1, Right_Small = Lit_Value
1418
1419    --    If denominator > 1, then set K to the numerator of the fraction, so
1420    --    that the resulting small ratio is the reciprocal of the integer (the
1421    --    denominator value).
1422
1423    procedure Do_Multiply_Fixed_Universal
1424      (N           : Node_Id;
1425       Left, Right : Node_Id)
1426    is
1427       Left_Type   : constant Entity_Id := Etype (Left);
1428       Result_Type : constant Entity_Id := Etype (N);
1429       Left_Small  : constant Ureal     := Small_Value (Left_Type);
1430       Lit_Value   : constant Ureal     := Realval (Right);
1431
1432       Result_Small : Ureal;
1433       Frac         : Ureal;
1434       Frac_Num     : Uint;
1435       Frac_Den     : Uint;
1436       Lit_K        : Node_Id;
1437       Lit_Int      : Node_Id;
1438
1439    begin
1440       --  Get result small. If the result is an integer, treat it as though
1441       --  it had a small of 1.0, all other processing is identical.
1442
1443       if Is_Integer_Type (Result_Type) then
1444          Result_Small := Ureal_1;
1445       else
1446          Result_Small := Small_Value (Result_Type);
1447       end if;
1448
1449       --  Determine if literal can be rewritten successfully
1450
1451       Frac     := (Left_Small * Lit_Value) / Result_Small;
1452       Frac_Num := Norm_Num (Frac);
1453       Frac_Den := Norm_Den (Frac);
1454
1455       --  Case where fraction is an integer (K = 1, integer = numerator). If
1456       --  this integer is not too large, this is the case where the result can
1457       --  be obtained by multiplying by this integer value.
1458
1459       if Frac_Den = 1 then
1460          Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1461
1462          if Present (Lit_Int) then
1463             Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1464             return;
1465          end if;
1466
1467       --  Case where we choose K to make fraction the reciprocal of an integer
1468       --  (K = numerator of fraction, integer = denominator of fraction). If
1469       --  both K and the denominator are small enough, this is the case where
1470       --  the result can be obtained by first multiplying by K, and then
1471       --  dividing by the integer value.
1472
1473       else
1474          Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1475          Lit_K   := Integer_Literal (N, Frac_Num);
1476
1477          if Present (Lit_Int) and then Present (Lit_K) then
1478             Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1479             return;
1480          end if;
1481       end if;
1482
1483       --  Fall through if the literal cannot be successfully rewritten, or if
1484       --  the small ratio is out of range of integer arithmetic. In the former
1485       --  case it is fine to use floating-point to get the close result set,
1486       --  and in the latter case, it means that the result is zero or raises
1487       --  constraint error, and we can do that accurately in floating-point.
1488
1489       --  If we end up using floating-point, then we take the right integer
1490       --  to be one, and its small to be the value of the original right real
1491       --  literal. That way, we need only one floating-point multiplication.
1492
1493       Set_Result (N,
1494         Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1495    end Do_Multiply_Fixed_Universal;
1496
1497    ---------------------------------
1498    -- Expand_Convert_Fixed_Static --
1499    ---------------------------------
1500
1501    procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1502    begin
1503       Rewrite (N,
1504         Convert_To (Etype (N),
1505           Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1506       Analyze_And_Resolve (N);
1507    end Expand_Convert_Fixed_Static;
1508
1509    -----------------------------------
1510    -- Expand_Convert_Fixed_To_Fixed --
1511    -----------------------------------
1512
1513    --  We have:
1514
1515    --    Result_Value * Result_Small = Source_Value * Source_Small
1516    --    Result_Value = Source_Value * (Source_Small / Result_Small)
1517
1518    --  If the small ratio (Source_Small / Result_Small) is a sufficiently small
1519    --  integer, then the perfect result set is obtained by a single integer
1520    --  multiplication.
1521
1522    --  If the small ratio is the reciprocal of a sufficiently small integer,
1523    --  then the perfect result set is obtained by a single integer division.
1524
1525    --  In other cases, we obtain the close result set by calculating the
1526    --  result in floating-point.
1527
1528    procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1529       Rng_Check   : constant Boolean   := Do_Range_Check (N);
1530       Expr        : constant Node_Id   := Expression (N);
1531       Result_Type : constant Entity_Id := Etype (N);
1532       Source_Type : constant Entity_Id := Etype (Expr);
1533       Small_Ratio : Ureal;
1534       Ratio_Num   : Uint;
1535       Ratio_Den   : Uint;
1536       Lit         : Node_Id;
1537
1538    begin
1539       if Is_OK_Static_Expression (Expr) then
1540          Expand_Convert_Fixed_Static (N);
1541          return;
1542       end if;
1543
1544       Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1545       Ratio_Num   := Norm_Num (Small_Ratio);
1546       Ratio_Den   := Norm_Den (Small_Ratio);
1547
1548       if Ratio_Den = 1 then
1549          if Ratio_Num = 1 then
1550             Set_Result (N, Expr);
1551             return;
1552
1553          else
1554             Lit := Integer_Literal (N, Ratio_Num);
1555
1556             if Present (Lit) then
1557                Set_Result (N, Build_Multiply (N, Expr, Lit));
1558                return;
1559             end if;
1560          end if;
1561
1562       elsif Ratio_Num = 1 then
1563          Lit := Integer_Literal (N, Ratio_Den);
1564
1565          if Present (Lit) then
1566             Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1567             return;
1568          end if;
1569       end if;
1570
1571       --  Fall through to use floating-point for the close result set case
1572       --  either as a result of the small ratio not being an integer or the
1573       --  reciprocal of an integer, or if the integer is out of range.
1574
1575       Set_Result (N,
1576         Build_Multiply (N,
1577           Fpt_Value (Expr),
1578           Real_Literal (N, Small_Ratio)),
1579         Rng_Check);
1580    end Expand_Convert_Fixed_To_Fixed;
1581
1582    -----------------------------------
1583    -- Expand_Convert_Fixed_To_Float --
1584    -----------------------------------
1585
1586    --  If the small of the fixed type is 1.0, then we simply convert the
1587    --  integer value directly to the target floating-point type, otherwise
1588    --  we first have to multiply by the small, in Universal_Real, and then
1589    --  convert the result to the target floating-point type.
1590
1591    procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1592       Rng_Check   : constant Boolean    := Do_Range_Check (N);
1593       Expr        : constant Node_Id    := Expression (N);
1594       Source_Type : constant Entity_Id  := Etype (Expr);
1595       Small       : constant Ureal      := Small_Value (Source_Type);
1596
1597    begin
1598       if Is_OK_Static_Expression (Expr) then
1599          Expand_Convert_Fixed_Static (N);
1600          return;
1601       end if;
1602
1603       if Small = Ureal_1 then
1604          Set_Result (N, Expr);
1605
1606       else
1607          Set_Result (N,
1608            Build_Multiply (N,
1609              Fpt_Value (Expr),
1610              Real_Literal (N, Small)),
1611            Rng_Check);
1612       end if;
1613    end Expand_Convert_Fixed_To_Float;
1614
1615    -------------------------------------
1616    -- Expand_Convert_Fixed_To_Integer --
1617    -------------------------------------
1618
1619    --  We have:
1620
1621    --    Result_Value = Source_Value * Source_Small
1622
1623    --  If the small value is a sufficiently small integer, then the perfect
1624    --  result set is obtained by a single integer multiplication.
1625
1626    --  If the small value is the reciprocal of a sufficiently small integer,
1627    --  then the perfect result set is obtained by a single integer division.
1628
1629    --  In other cases, we obtain the close result set by calculating the
1630    --  result in floating-point.
1631
1632    procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1633       Rng_Check   : constant Boolean   := Do_Range_Check (N);
1634       Expr        : constant Node_Id   := Expression (N);
1635       Source_Type : constant Entity_Id := Etype (Expr);
1636       Small       : constant Ureal     := Small_Value (Source_Type);
1637       Small_Num   : constant Uint      := Norm_Num (Small);
1638       Small_Den   : constant Uint      := Norm_Den (Small);
1639       Lit         : Node_Id;
1640
1641    begin
1642       if Is_OK_Static_Expression (Expr) then
1643          Expand_Convert_Fixed_Static (N);
1644          return;
1645       end if;
1646
1647       if Small_Den = 1 then
1648          Lit := Integer_Literal (N, Small_Num);
1649
1650          if Present (Lit) then
1651             Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1652             return;
1653          end if;
1654
1655       elsif Small_Num = 1 then
1656          Lit := Integer_Literal (N, Small_Den);
1657
1658          if Present (Lit) then
1659             Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1660             return;
1661          end if;
1662       end if;
1663
1664       --  Fall through to use floating-point for the close result set case
1665       --  either as a result of the small value not being an integer or the
1666       --  reciprocal of an integer, or if the integer is out of range.
1667
1668       Set_Result (N,
1669         Build_Multiply (N,
1670           Fpt_Value (Expr),
1671           Real_Literal (N, Small)),
1672         Rng_Check);
1673    end Expand_Convert_Fixed_To_Integer;
1674
1675    -----------------------------------
1676    -- Expand_Convert_Float_To_Fixed --
1677    -----------------------------------
1678
1679    --  We have
1680
1681    --    Result_Value * Result_Small = Operand_Value
1682
1683    --  so compute:
1684
1685    --    Result_Value = Operand_Value * (1.0 / Result_Small)
1686
1687    --  We do the small scaling in floating-point, and we do a multiplication
1688    --  rather than a division, since it is accurate enough for the perfect
1689    --  result cases, and faster.
1690
1691    procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1692       Rng_Check   : constant Boolean   := Do_Range_Check (N);
1693       Expr        : constant Node_Id   := Expression (N);
1694       Result_Type : constant Entity_Id := Etype (N);
1695       Small       : constant Ureal     := Small_Value (Result_Type);
1696
1697    begin
1698       --  Optimize small = 1, where we can avoid the multiply completely
1699
1700       if Small = Ureal_1 then
1701          Set_Result (N, Expr, Rng_Check, Trunc => True);
1702
1703       --  Normal case where multiply is required
1704       --  Rounding is truncating for decimal fixed point types only,
1705       --  see RM 4.6(29).
1706
1707       else
1708          Set_Result (N,
1709            Build_Multiply (N,
1710              Fpt_Value (Expr),
1711              Real_Literal (N, Ureal_1 / Small)),
1712            Rng_Check, Trunc => Is_Decimal_Fixed_Point_Type (Result_Type));
1713       end if;
1714    end Expand_Convert_Float_To_Fixed;
1715
1716    -------------------------------------
1717    -- Expand_Convert_Integer_To_Fixed --
1718    -------------------------------------
1719
1720    --  We have
1721
1722    --    Result_Value * Result_Small = Operand_Value
1723    --    Result_Value = Operand_Value / Result_Small
1724
1725    --  If the small value is a sufficiently small integer, then the perfect
1726    --  result set is obtained by a single integer division.
1727
1728    --  If the small value is the reciprocal of a sufficiently small integer,
1729    --  the perfect result set is obtained by a single integer multiplication.
1730
1731    --  In other cases, we obtain the close result set by calculating the
1732    --  result in floating-point using a multiplication by the reciprocal
1733    --  of the Result_Small.
1734
1735    procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1736       Rng_Check   : constant Boolean   := Do_Range_Check (N);
1737       Expr        : constant Node_Id   := Expression (N);
1738       Result_Type : constant Entity_Id := Etype (N);
1739       Small       : constant Ureal     := Small_Value (Result_Type);
1740       Small_Num   : constant Uint      := Norm_Num (Small);
1741       Small_Den   : constant Uint      := Norm_Den (Small);
1742       Lit         : Node_Id;
1743
1744    begin
1745       if Small_Den = 1 then
1746          Lit := Integer_Literal (N, Small_Num);
1747
1748          if Present (Lit) then
1749             Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1750             return;
1751          end if;
1752
1753       elsif Small_Num = 1 then
1754          Lit := Integer_Literal (N, Small_Den);
1755
1756          if Present (Lit) then
1757             Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1758             return;
1759          end if;
1760       end if;
1761
1762       --  Fall through to use floating-point for the close result set case
1763       --  either as a result of the small value not being an integer or the
1764       --  reciprocal of an integer, or if the integer is out of range.
1765
1766       Set_Result (N,
1767         Build_Multiply (N,
1768           Fpt_Value (Expr),
1769           Real_Literal (N, Ureal_1 / Small)),
1770         Rng_Check);
1771    end Expand_Convert_Integer_To_Fixed;
1772
1773    --------------------------------
1774    -- Expand_Decimal_Divide_Call --
1775    --------------------------------
1776
1777    --  We have four operands
1778
1779    --    Dividend
1780    --    Divisor
1781    --    Quotient
1782    --    Remainder
1783
1784    --  All of which are decimal types, and which thus have associated
1785    --  decimal scales.
1786
1787    --  Computing the quotient is a similar problem to that faced by the
1788    --  normal fixed-point division, except that it is simpler, because
1789    --  we always have compatible smalls.
1790
1791    --    Quotient = (Dividend / Divisor) * 10**q
1792
1793    --      where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1794    --      so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1795
1796    --    For q >= 0, we compute
1797
1798    --      Numerator   := Dividend * 10 ** q
1799    --      Denominator := Divisor
1800    --      Quotient    := Numerator / Denominator
1801
1802    --    For q < 0, we compute
1803
1804    --      Numerator   := Dividend
1805    --      Denominator := Divisor * 10 ** q
1806    --      Quotient    := Numerator / Denominator
1807
1808    --  Both these divisions are done in truncated mode, and the remainder
1809    --  from these divisions is used to compute the result Remainder. This
1810    --  remainder has the effective scale of the numerator of the division,
1811
1812    --    For q >= 0, the remainder scale is Dividend'Scale + q
1813    --    For q <  0, the remainder scale is Dividend'Scale
1814
1815    --  The result Remainder is then computed by a normal truncating decimal
1816    --  conversion from this scale to the scale of the remainder, i.e. by a
1817    --  division or multiplication by the appropriate power of 10.
1818
1819    procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1820       Loc : constant Source_Ptr := Sloc (N);
1821
1822       Dividend  : Node_Id := First_Actual (N);
1823       Divisor   : Node_Id := Next_Actual (Dividend);
1824       Quotient  : Node_Id := Next_Actual (Divisor);
1825       Remainder : Node_Id := Next_Actual (Quotient);
1826
1827       Dividend_Type   : constant Entity_Id := Etype (Dividend);
1828       Divisor_Type    : constant Entity_Id := Etype (Divisor);
1829       Quotient_Type   : constant Entity_Id := Etype (Quotient);
1830       Remainder_Type  : constant Entity_Id := Etype (Remainder);
1831
1832       Dividend_Scale  : constant Uint := Scale_Value (Dividend_Type);
1833       Divisor_Scale   : constant Uint := Scale_Value (Divisor_Type);
1834       Quotient_Scale  : constant Uint := Scale_Value (Quotient_Type);
1835       Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1836
1837       Q                  : Uint;
1838       Numerator_Scale    : Uint;
1839       Stmts              : List_Id;
1840       Qnn                : Entity_Id;
1841       Rnn                : Entity_Id;
1842       Computed_Remainder : Node_Id;
1843       Adjusted_Remainder : Node_Id;
1844       Scale_Adjust       : Uint;
1845
1846    begin
1847       --  Relocate the operands, since they are now list elements, and we
1848       --  need to reference them separately as operands in the expanded code.
1849
1850       Dividend  := Relocate_Node (Dividend);
1851       Divisor   := Relocate_Node (Divisor);
1852       Quotient  := Relocate_Node (Quotient);
1853       Remainder := Relocate_Node (Remainder);
1854
1855       --  Now compute Q, the adjustment scale
1856
1857       Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1858
1859       --  If Q is non-negative then we need a scaled divide
1860
1861       if Q >= 0 then
1862          Build_Scaled_Divide_Code
1863            (N,
1864             Dividend,
1865             Integer_Literal (N, Uint_10 ** Q),
1866             Divisor,
1867             Qnn, Rnn, Stmts);
1868
1869          Numerator_Scale := Dividend_Scale + Q;
1870
1871       --  If Q is negative, then we need a double divide
1872
1873       else
1874          Build_Double_Divide_Code
1875            (N,
1876             Dividend,
1877             Divisor,
1878             Integer_Literal (N, Uint_10 ** (-Q)),
1879             Qnn, Rnn, Stmts);
1880
1881          Numerator_Scale := Dividend_Scale;
1882       end if;
1883
1884       --  Add statement to set quotient value
1885
1886       --    Quotient := quotient-type!(Qnn);
1887
1888       Append_To (Stmts,
1889         Make_Assignment_Statement (Loc,
1890           Name => Quotient,
1891           Expression =>
1892             Unchecked_Convert_To (Quotient_Type,
1893               Build_Conversion (N, Quotient_Type,
1894                 New_Occurrence_Of (Qnn, Loc)))));
1895
1896       --  Now we need to deal with computing and setting the remainder. The
1897       --  scale of the remainder is in Numerator_Scale, and the desired
1898       --  scale is the scale of the given Remainder argument. There are
1899       --  three cases:
1900
1901       --    Numerator_Scale > Remainder_Scale
1902
1903       --      in this case, there are extra digits in the computed remainder
1904       --      which must be eliminated by an extra division:
1905
1906       --        computed-remainder := Numerator rem Denominator
1907       --        scale_adjust = Numerator_Scale - Remainder_Scale
1908       --        adjusted-remainder := computed-remainder / 10 ** scale_adjust
1909
1910       --    Numerator_Scale = Remainder_Scale
1911
1912       --      in this case, the we have the remainder we need
1913
1914       --        computed-remainder := Numerator rem Denominator
1915       --        adjusted-remainder := computed-remainder
1916
1917       --    Numerator_Scale < Remainder_Scale
1918
1919       --      in this case, we have insufficient digits in the computed
1920       --      remainder, which must be eliminated by an extra multiply
1921
1922       --        computed-remainder := Numerator rem Denominator
1923       --        scale_adjust = Remainder_Scale - Numerator_Scale
1924       --        adjusted-remainder := computed-remainder * 10 ** scale_adjust
1925
1926       --  Finally we assign the adjusted-remainder to the result Remainder
1927       --  with conversions to get the proper fixed-point type representation.
1928
1929       Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
1930
1931       if Numerator_Scale > Remainder_Scale then
1932          Scale_Adjust := Numerator_Scale - Remainder_Scale;
1933          Adjusted_Remainder :=
1934            Build_Divide
1935              (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1936
1937       elsif Numerator_Scale = Remainder_Scale then
1938          Adjusted_Remainder := Computed_Remainder;
1939
1940       else -- Numerator_Scale < Remainder_Scale
1941          Scale_Adjust := Remainder_Scale - Numerator_Scale;
1942          Adjusted_Remainder :=
1943            Build_Multiply
1944              (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1945       end if;
1946
1947       --  Assignment of remainder result
1948
1949       Append_To (Stmts,
1950         Make_Assignment_Statement (Loc,
1951           Name => Remainder,
1952           Expression =>
1953             Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
1954
1955       --  Final step is to rewrite the call with a block containing the
1956       --  above sequence of constructed statements for the divide operation.
1957
1958       Rewrite (N,
1959         Make_Block_Statement (Loc,
1960           Handled_Statement_Sequence =>
1961             Make_Handled_Sequence_Of_Statements (Loc,
1962               Statements => Stmts)));
1963
1964       Analyze (N);
1965    end Expand_Decimal_Divide_Call;
1966
1967    -----------------------------------------------
1968    -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1969    -----------------------------------------------
1970
1971    procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
1972       Left  : constant Node_Id := Left_Opnd (N);
1973       Right : constant Node_Id := Right_Opnd (N);
1974
1975    begin
1976       --  Suppress expansion of a fixed-by-fixed division if the
1977       --  operation is supported directly by the target.
1978
1979       if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
1980          return;
1981       end if;
1982
1983       if Etype (Left) = Universal_Real then
1984          Do_Divide_Universal_Fixed (N);
1985
1986       elsif Etype (Right) = Universal_Real then
1987          Do_Divide_Fixed_Universal (N);
1988
1989       else
1990          Do_Divide_Fixed_Fixed (N);
1991       end if;
1992    end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
1993
1994    -----------------------------------------------
1995    -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1996    -----------------------------------------------
1997
1998    --  The division is done in Universal_Real, and the result is multiplied
1999    --  by the small ratio, which is Small (Right) / Small (Left). Special
2000    --  treatment is required for universal operands, which represent their
2001    --  own value and do not require conversion.
2002
2003    procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2004       Left  : constant Node_Id := Left_Opnd (N);
2005       Right : constant Node_Id := Right_Opnd (N);
2006
2007       Left_Type  : constant Entity_Id := Etype (Left);
2008       Right_Type : constant Entity_Id := Etype (Right);
2009
2010    begin
2011       --  Case of left operand is universal real, the result we want is:
2012
2013       --    Left_Value / (Right_Value * Right_Small)
2014
2015       --  so we compute this as:
2016
2017       --    (Left_Value / Right_Small) / Right_Value
2018
2019       if Left_Type = Universal_Real then
2020          Set_Result (N,
2021            Build_Divide (N,
2022              Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2023              Fpt_Value (Right)));
2024
2025       --  Case of right operand is universal real, the result we want is
2026
2027       --    (Left_Value * Left_Small) / Right_Value
2028
2029       --  so we compute this as:
2030
2031       --    Left_Value * (Left_Small / Right_Value)
2032
2033       --  Note we invert to a multiplication since usually floating-point
2034       --  multiplication is much faster than floating-point division.
2035
2036       elsif Right_Type = Universal_Real then
2037          Set_Result (N,
2038            Build_Multiply (N,
2039              Fpt_Value (Left),
2040              Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2041
2042       --  Both operands are fixed, so the value we want is
2043
2044       --    (Left_Value * Left_Small) / (Right_Value * Right_Small)
2045
2046       --  which we compute as:
2047
2048       --    (Left_Value / Right_Value) * (Left_Small / Right_Small)
2049
2050       else
2051          Set_Result (N,
2052            Build_Multiply (N,
2053              Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2054              Real_Literal (N,
2055                Small_Value (Left_Type) / Small_Value (Right_Type))));
2056       end if;
2057    end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2058
2059    -------------------------------------------------
2060    -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2061    -------------------------------------------------
2062
2063    procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2064       Left  : constant Node_Id := Left_Opnd (N);
2065       Right : constant Node_Id := Right_Opnd (N);
2066    begin
2067       if Etype (Left) = Universal_Real then
2068          Do_Divide_Universal_Fixed (N);
2069       elsif Etype (Right) = Universal_Real then
2070          Do_Divide_Fixed_Universal (N);
2071       else
2072          Do_Divide_Fixed_Fixed (N);
2073       end if;
2074    end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2075
2076    -------------------------------------------------
2077    -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2078    -------------------------------------------------
2079
2080    --  Since the operand and result fixed-point type is the same, this is
2081    --  a straight divide by the right operand, the small can be ignored.
2082
2083    procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2084       Left  : constant Node_Id := Left_Opnd (N);
2085       Right : constant Node_Id := Right_Opnd (N);
2086    begin
2087       Set_Result (N, Build_Divide (N, Left, Right));
2088    end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2089
2090    -------------------------------------------------
2091    -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2092    -------------------------------------------------
2093
2094    procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2095       Left  : constant Node_Id := Left_Opnd (N);
2096       Right : constant Node_Id := Right_Opnd (N);
2097
2098       procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2099       --  The operand may be a non-static universal value, such an
2100       --  exponentiation with a non-static exponent. In that case, treat
2101       --  as a fixed * fixed multiplication, and convert the argument to
2102       --  the target fixed type.
2103
2104       ----------------------------------
2105       -- Rewrite_Non_Static_Universal --
2106       ----------------------------------
2107
2108       procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2109          Loc : constant Source_Ptr := Sloc (N);
2110       begin
2111          Rewrite (Opnd,
2112            Make_Type_Conversion (Loc,
2113              Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2114              Expression   => Expression (Opnd)));
2115          Analyze_And_Resolve (Opnd, Etype (N));
2116       end Rewrite_Non_Static_Universal;
2117
2118    --  Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2119
2120    begin
2121       --  Suppress expansion of a fixed-by-fixed multiplication if the
2122       --  operation is supported directly by the target.
2123
2124       if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
2125          return;
2126       end if;
2127
2128       if Etype (Left) = Universal_Real then
2129          if Nkind (Left) = N_Real_Literal then
2130             Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2131
2132          elsif Nkind (Left) = N_Type_Conversion then
2133             Rewrite_Non_Static_Universal (Left);
2134             Do_Multiply_Fixed_Fixed (N);
2135          end if;
2136
2137       elsif Etype (Right) = Universal_Real then
2138          if Nkind (Right) = N_Real_Literal then
2139             Do_Multiply_Fixed_Universal (N, Left, Right);
2140
2141          elsif Nkind (Right) = N_Type_Conversion then
2142             Rewrite_Non_Static_Universal (Right);
2143             Do_Multiply_Fixed_Fixed (N);
2144          end if;
2145
2146       else
2147          Do_Multiply_Fixed_Fixed (N);
2148       end if;
2149    end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2150
2151    -------------------------------------------------
2152    -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2153    -------------------------------------------------
2154
2155    --  The multiply is done in Universal_Real, and the result is multiplied
2156    --  by the adjustment for the smalls which is Small (Right) * Small (Left).
2157    --  Special treatment is required for universal operands.
2158
2159    procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2160       Left  : constant Node_Id := Left_Opnd (N);
2161       Right : constant Node_Id := Right_Opnd (N);
2162
2163       Left_Type  : constant Entity_Id := Etype (Left);
2164       Right_Type : constant Entity_Id := Etype (Right);
2165
2166    begin
2167       --  Case of left operand is universal real, the result we want is
2168
2169       --    Left_Value * (Right_Value * Right_Small)
2170
2171       --  so we compute this as:
2172
2173       --    (Left_Value * Right_Small) * Right_Value;
2174
2175       if Left_Type = Universal_Real then
2176          Set_Result (N,
2177            Build_Multiply (N,
2178              Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2179              Fpt_Value (Right)));
2180
2181       --  Case of right operand is universal real, the result we want is
2182
2183       --    (Left_Value * Left_Small) * Right_Value
2184
2185       --  so we compute this as:
2186
2187       --    Left_Value * (Left_Small * Right_Value)
2188
2189       elsif Right_Type = Universal_Real then
2190          Set_Result (N,
2191            Build_Multiply (N,
2192              Fpt_Value (Left),
2193              Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2194
2195       --  Both operands are fixed, so the value we want is
2196
2197       --    (Left_Value * Left_Small) * (Right_Value * Right_Small)
2198
2199       --  which we compute as:
2200
2201       --    (Left_Value * Right_Value) * (Right_Small * Left_Small)
2202
2203       else
2204          Set_Result (N,
2205            Build_Multiply (N,
2206              Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2207              Real_Literal (N,
2208                Small_Value (Right_Type) * Small_Value (Left_Type))));
2209       end if;
2210    end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2211
2212    ---------------------------------------------------
2213    -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2214    ---------------------------------------------------
2215
2216    procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2217       Left  : constant Node_Id := Left_Opnd (N);
2218       Right : constant Node_Id := Right_Opnd (N);
2219    begin
2220       if Etype (Left) = Universal_Real then
2221          Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2222       elsif Etype (Right) = Universal_Real then
2223          Do_Multiply_Fixed_Universal (N, Left, Right);
2224       else
2225          Do_Multiply_Fixed_Fixed (N);
2226       end if;
2227    end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2228
2229    ---------------------------------------------------
2230    -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2231    ---------------------------------------------------
2232
2233    --  Since the operand and result fixed-point type is the same, this is
2234    --  a straight multiply by the right operand, the small can be ignored.
2235
2236    procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2237    begin
2238       Set_Result (N,
2239         Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2240    end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2241
2242    ---------------------------------------------------
2243    -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2244    ---------------------------------------------------
2245
2246    --  Since the operand and result fixed-point type is the same, this is
2247    --  a straight multiply by the right operand, the small can be ignored.
2248
2249    procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2250    begin
2251       Set_Result (N,
2252         Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2253    end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2254
2255    ---------------
2256    -- Fpt_Value --
2257    ---------------
2258
2259    function Fpt_Value (N : Node_Id) return Node_Id is
2260       Typ   : constant Entity_Id  := Etype (N);
2261
2262    begin
2263       if Is_Integer_Type (Typ)
2264         or else Is_Floating_Point_Type (Typ)
2265       then
2266          return Build_Conversion (N, Universal_Real, N);
2267
2268       --  Fixed-point case, must get integer value first
2269
2270       else
2271          return Build_Conversion (N, Universal_Real, N);
2272       end if;
2273    end Fpt_Value;
2274
2275    ---------------------
2276    -- Integer_Literal --
2277    ---------------------
2278
2279    function Integer_Literal
2280      (N        : Node_Id;
2281       V        : Uint;
2282       Negative : Boolean := False) return Node_Id
2283    is
2284       T : Entity_Id;
2285       L : Node_Id;
2286
2287    begin
2288       if V < Uint_2 ** 7 then
2289          T := Standard_Integer_8;
2290
2291       elsif V < Uint_2 ** 15 then
2292          T := Standard_Integer_16;
2293
2294       elsif V < Uint_2 ** 31 then
2295          T := Standard_Integer_32;
2296
2297       elsif V < Uint_2 ** 63 then
2298          T := Standard_Integer_64;
2299
2300       else
2301          return Empty;
2302       end if;
2303
2304       if Negative then
2305          L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
2306       else
2307          L := Make_Integer_Literal (Sloc (N), V);
2308       end if;
2309
2310       --  Set type of result in case used elsewhere (see note at start)
2311
2312       Set_Etype (L, T);
2313       Set_Is_Static_Expression (L);
2314
2315       --  We really need to set Analyzed here because we may be creating a
2316       --  very strange beast, namely an integer literal typed as fixed-point
2317       --  and the analyzer won't like that. Probably we should allow the
2318       --  Treat_Fixed_As_Integer flag to appear on integer literal nodes
2319       --  and teach the analyzer how to handle them ???
2320
2321       Set_Analyzed (L);
2322       return L;
2323    end Integer_Literal;
2324
2325    ------------------
2326    -- Real_Literal --
2327    ------------------
2328
2329    function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2330       L : Node_Id;
2331
2332    begin
2333       L := Make_Real_Literal (Sloc (N), V);
2334
2335       --  Set type of result in case used elsewhere (see note at start)
2336
2337       Set_Etype (L, Universal_Real);
2338       return L;
2339    end Real_Literal;
2340
2341    ------------------------
2342    -- Rounded_Result_Set --
2343    ------------------------
2344
2345    function Rounded_Result_Set (N : Node_Id) return Boolean is
2346       K : constant Node_Kind := Nkind (N);
2347    begin
2348       if (K = N_Type_Conversion or else
2349           K = N_Op_Divide       or else
2350           K = N_Op_Multiply)
2351         and then
2352           (Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
2353       then
2354          return True;
2355       else
2356          return False;
2357       end if;
2358    end Rounded_Result_Set;
2359
2360    ----------------
2361    -- Set_Result --
2362    ----------------
2363
2364    procedure Set_Result
2365      (N     : Node_Id;
2366       Expr  : Node_Id;
2367       Rchk  : Boolean := False;
2368       Trunc : Boolean := False)
2369    is
2370       Cnode : Node_Id;
2371
2372       Expr_Type   : constant Entity_Id := Etype (Expr);
2373       Result_Type : constant Entity_Id := Etype (N);
2374
2375    begin
2376       --  No conversion required if types match and no range check or truncate
2377
2378       if Result_Type = Expr_Type and then not (Rchk or Trunc) then
2379          Cnode := Expr;
2380
2381       --  Else perform required conversion
2382
2383       else
2384          Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
2385       end if;
2386
2387       Rewrite (N, Cnode);
2388       Analyze_And_Resolve (N, Result_Type);
2389    end Set_Result;
2390
2391 end Exp_Fixd;