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