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