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