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