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