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