gcc/ada/exp_fixd.adb

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