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