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