OpenCores
URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [ada/] [exp_fixd.adb] - Blame information for rev 715

Go to most recent revision | Details | Compare with Previous | View Log

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

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.