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