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