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