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