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