1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2006, Free Software Foundation, Inc. --
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. --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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;
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
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
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
95 Qnn, Rnn : out Entity_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
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
137 Qnn, Rnn : out Entity_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
189 Negative : Boolean := False) return Node_Id;
190 -- Given a non-negative universal integer value, build a typed integer
191 -- literal node, using the smallest applicable standard integer type. If
192 -- and only if Negative is true a negative literal is built. If V exceeds
193 -- 2**63-1, the largest value allowed for perfect result set scaling
194 -- factors (see RM G.2.3(22)), then Empty is returned. The node N provides
195 -- the Sloc value for the constructed literal. The Etype of the resulting
196 -- literal is correctly set, and it is marked as analyzed.
198 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
199 -- Build a real literal node from the given value, the Etype of the
200 -- returned node is set to Universal_Real, since all floating-point
201 -- arithmetic operations that we construct use Universal_Real
203 function Rounded_Result_Set (N : Node_Id) return Boolean;
204 -- Returns True if N is a node that contains the Rounded_Result flag
205 -- and if the flag is true or the target type is an integer type.
207 procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
208 -- N is the node for the current conversion, division or multiplication
209 -- operation, and Expr is an expression representing the result. Expr may
210 -- be of floating-point or integer type. If the operation result is fixed-
211 -- point, then the value of Expr is in units of small of the result type
212 -- (i.e. small's have already been dealt with). The result of the call is
213 -- to replace N by an appropriate conversion to the result type, dealing
214 -- with rounding for the decimal types case. The node is then analyzed and
215 -- resolved using the result type. If Rchk is True, then Do_Range_Check is
216 -- set in the resulting conversion.
218 ----------------------
219 -- Build_Conversion --
220 ----------------------
222 function Build_Conversion
226 Rchk : Boolean := False) return Node_Id
228 Loc : constant Source_Ptr := Sloc (N);
230 Rcheck : Boolean := Rchk;
233 -- A special case, if the expression is an integer literal and the
234 -- target type is an integer type, then just retype the integer
235 -- literal to the desired target type. Don't do this if we need
238 if Nkind (Expr) = N_Integer_Literal
239 and then Is_Integer_Type (Typ)
244 -- Cases where we end up with a conversion. Note that we do not use the
245 -- Convert_To abstraction here, since we may be decorating the resulting
246 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
247 -- conversion node present, even if it appears to be redundant.
250 -- Remove inner conversion if both inner and outer conversions are
251 -- to integer types, since the inner one serves no purpose (except
252 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
253 -- and also we preserve the range check flag on the inner operand
255 if Is_Integer_Type (Typ)
256 and then Is_Integer_Type (Etype (Expr))
257 and then Nkind (Expr) = N_Type_Conversion
260 Make_Type_Conversion (Loc,
261 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
262 Expression => Expression (Expr));
263 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
264 Rcheck := Rcheck or Do_Range_Check (Expr);
266 -- For all other cases, a simple type conversion will work
270 Make_Type_Conversion (Loc,
271 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
275 -- Set Conversion_OK if either result or expression type is a
276 -- fixed-point type, since from a semantic point of view, we are
277 -- treating fixed-point values as integers at this stage.
279 if Is_Fixed_Point_Type (Typ)
280 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
282 Set_Conversion_OK (Result);
285 -- Set Do_Range_Check if either it was requested by the caller,
286 -- or if an eliminated inner conversion had a range check.
289 Enable_Range_Check (Result);
291 Set_Do_Range_Check (Result, False);
295 Set_Etype (Result, Typ);
297 end Build_Conversion;
303 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
304 Loc : constant Source_Ptr := Sloc (N);
305 Left_Type : constant Entity_Id := Base_Type (Etype (L));
306 Right_Type : constant Entity_Id := Base_Type (Etype (R));
307 Result_Type : Entity_Id;
311 -- Deal with floating-point case first
313 if Is_Floating_Point_Type (Left_Type) then
314 pragma Assert (Left_Type = Universal_Real);
315 pragma Assert (Right_Type = Universal_Real);
317 Rnode := Make_Op_Divide (Loc, L, R);
318 Result_Type := Universal_Real;
320 -- Integer and fixed-point cases
323 -- An optimization. If the right operand is the literal 1, then we
324 -- can just return the left hand operand. Putting the optimization
325 -- here allows us to omit the check at the call site.
327 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
331 -- If left and right types are the same, no conversion needed
333 if Left_Type = Right_Type then
334 Result_Type := Left_Type;
340 -- Use left type if it is the larger of the two
342 elsif Esize (Left_Type) >= Esize (Right_Type) then
343 Result_Type := Left_Type;
347 Right_Opnd => Build_Conversion (N, Left_Type, R));
349 -- Otherwise right type is larger of the two, us it
352 Result_Type := Right_Type;
355 Left_Opnd => Build_Conversion (N, Right_Type, L),
360 -- We now have a divide node built with Result_Type set. First
361 -- set Etype of result, as required for all Build_xxx routines
363 Set_Etype (Rnode, Base_Type (Result_Type));
365 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
366 -- since this is a literal arithmetic operation, to be performed
367 -- by Gigi without any consideration of small values.
369 if Is_Fixed_Point_Type (Result_Type) then
370 Set_Treat_Fixed_As_Integer (Rnode);
373 -- The result is rounded if the target of the operation is decimal
374 -- and Rounded_Result is set, or if the target of the operation
375 -- is an integer type.
377 if Is_Integer_Type (Etype (N))
378 or else Rounded_Result_Set (N)
380 Set_Rounded_Result (Rnode);
386 -------------------------
387 -- Build_Double_Divide --
388 -------------------------
390 function Build_Double_Divide
392 X, Y, Z : Node_Id) return Node_Id
394 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
395 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
399 -- If denominator fits in 64 bits, we can build the operations directly
400 -- without causing any intermediate overflow, so that's what we do!
402 if Int'Max (Y_Size, Z_Size) <= 32 then
404 Build_Divide (N, X, Build_Multiply (N, Y, Z));
406 -- Otherwise we use the runtime routine
408 -- [Qnn : Interfaces.Integer_64,
409 -- Rnn : Interfaces.Integer_64;
410 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
415 Loc : constant Source_Ptr := Sloc (N);
421 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
422 Insert_Actions (N, Code);
423 Expr := New_Occurrence_Of (Qnn, Loc);
425 -- Set type of result in case used elsewhere (see note at start)
427 Set_Etype (Expr, Etype (Qnn));
429 -- Set result as analyzed (see note at start on build routines)
434 end Build_Double_Divide;
436 ------------------------------
437 -- Build_Double_Divide_Code --
438 ------------------------------
440 -- If the denominator can be computed in 64-bits, we build
442 -- [Nnn : constant typ := typ (X);
443 -- Dnn : constant typ := typ (Y) * typ (Z)
444 -- Qnn : constant typ := Nnn / Dnn;
445 -- Rnn : constant typ := Nnn / Dnn;
447 -- If the numerator cannot be computed in 64 bits, we build
451 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
453 procedure Build_Double_Divide_Code
456 Qnn, Rnn : out Entity_Id;
459 Loc : constant Source_Ptr := Sloc (N);
461 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
462 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
463 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
475 -- Find type that will allow computation of numerator
477 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
480 QR_Typ := Standard_Integer_16;
481 elsif QR_Siz <= 32 then
482 QR_Typ := Standard_Integer_32;
483 elsif QR_Siz <= 64 then
484 QR_Typ := Standard_Integer_64;
486 -- For more than 64, bits, we use the 64-bit integer defined in
487 -- Interfaces, so that it can be handled by the runtime routine
490 QR_Typ := RTE (RE_Integer_64);
493 -- Define quotient and remainder, and set their Etypes, so
494 -- that they can be picked up by Build_xxx routines.
496 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
497 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
499 Set_Etype (Qnn, QR_Typ);
500 Set_Etype (Rnn, QR_Typ);
502 -- Case that we can compute the denominator in 64 bits
506 -- Create temporaries for numerator and denominator and set Etypes,
507 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
509 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
510 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
512 Set_Etype (Nnn, QR_Typ);
513 Set_Etype (Dnn, QR_Typ);
516 Make_Object_Declaration (Loc,
517 Defining_Identifier => Nnn,
518 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
519 Constant_Present => True,
520 Expression => Build_Conversion (N, QR_Typ, X)),
522 Make_Object_Declaration (Loc,
523 Defining_Identifier => Dnn,
524 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
525 Constant_Present => True,
528 Build_Conversion (N, QR_Typ, Y),
529 Build_Conversion (N, QR_Typ, Z))));
533 New_Occurrence_Of (Nnn, Loc),
534 New_Occurrence_Of (Dnn, Loc));
536 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
539 Make_Object_Declaration (Loc,
540 Defining_Identifier => Qnn,
541 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
542 Constant_Present => True,
546 Make_Object_Declaration (Loc,
547 Defining_Identifier => Rnn,
548 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
549 Constant_Present => True,
552 New_Occurrence_Of (Nnn, Loc),
553 New_Occurrence_Of (Dnn, Loc))));
555 -- Case where denominator does not fit in 64 bits, so we have to
556 -- call the runtime routine to compute the quotient and remainder
559 Rnd := Boolean_Literals (Rounded_Result_Set (N));
562 Make_Object_Declaration (Loc,
563 Defining_Identifier => Qnn,
564 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
566 Make_Object_Declaration (Loc,
567 Defining_Identifier => Rnn,
568 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
570 Make_Procedure_Call_Statement (Loc,
571 Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
572 Parameter_Associations => New_List (
573 Build_Conversion (N, QR_Typ, X),
574 Build_Conversion (N, QR_Typ, Y),
575 Build_Conversion (N, QR_Typ, Z),
576 New_Occurrence_Of (Qnn, Loc),
577 New_Occurrence_Of (Rnn, Loc),
578 New_Occurrence_Of (Rnd, Loc))));
580 end Build_Double_Divide_Code;
586 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
587 Loc : constant Source_Ptr := Sloc (N);
588 Left_Type : constant Entity_Id := Etype (L);
589 Right_Type : constant Entity_Id := Etype (R);
593 Result_Type : Entity_Id;
597 -- Deal with floating-point case first
599 if Is_Floating_Point_Type (Left_Type) then
600 pragma Assert (Left_Type = Universal_Real);
601 pragma Assert (Right_Type = Universal_Real);
603 Result_Type := Universal_Real;
604 Rnode := Make_Op_Multiply (Loc, L, R);
606 -- Integer and fixed-point cases
609 -- An optimization. If the right operand is the literal 1, then we
610 -- can just return the left hand operand. Putting the optimization
611 -- here allows us to omit the check at the call site. Similarly, if
612 -- the left operand is the integer 1 we can return the right operand.
614 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
616 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
620 -- Otherwise we need to figure out the correct result type size
621 -- First figure out the effective sizes of the operands. Normally
622 -- the effective size of an operand is the RM_Size of the operand.
623 -- But a special case arises with operands whose size is known at
624 -- compile time. In this case, we can use the actual value of the
625 -- operand to get its size if it would fit in 8 or 16 bits.
627 -- Note: if both operands are known at compile time (can that
628 -- happen?) and both were equal to the power of 2, then we would
629 -- be one bit off in this test, so for the left operand, we only
630 -- go up to the power of 2 - 1. This ensures that we do not get
631 -- this anomolous case, and in practice the right operand is by
632 -- far the more likely one to be the constant.
634 Left_Size := UI_To_Int (RM_Size (Left_Type));
636 if Compile_Time_Known_Value (L) then
638 Val : constant Uint := Expr_Value (L);
641 if Val < Int'(2 ** 8) then
643 elsif Val < Int'(2 ** 16) then
649 Right_Size := UI_To_Int (RM_Size (Right_Type));
651 if Compile_Time_Known_Value (R) then
653 Val : constant Uint := Expr_Value (R);
656 if Val <= Int'(2 ** 8) then
658 elsif Val <= Int'(2 ** 16) then
664 -- Now the result size must be at least twice the longer of
665 -- the two sizes, to accomodate all possible results.
667 Rsize := 2 * Int'Max (Left_Size, Right_Size);
670 Result_Type := Standard_Integer_8;
672 elsif Rsize <= 16 then
673 Result_Type := Standard_Integer_16;
675 elsif Rsize <= 32 then
676 Result_Type := Standard_Integer_32;
679 Result_Type := Standard_Integer_64;
683 Make_Op_Multiply (Loc,
684 Left_Opnd => Build_Conversion (N, Result_Type, L),
685 Right_Opnd => Build_Conversion (N, Result_Type, R));
688 -- We now have a multiply node built with Result_Type set. First
689 -- set Etype of result, as required for all Build_xxx routines
691 Set_Etype (Rnode, Base_Type (Result_Type));
693 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
694 -- since this is a literal arithmetic operation, to be performed
695 -- by Gigi without any consideration of small values.
697 if Is_Fixed_Point_Type (Result_Type) then
698 Set_Treat_Fixed_As_Integer (Rnode);
708 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
709 Loc : constant Source_Ptr := Sloc (N);
710 Left_Type : constant Entity_Id := Etype (L);
711 Right_Type : constant Entity_Id := Etype (R);
712 Result_Type : Entity_Id;
716 if Left_Type = Right_Type then
717 Result_Type := Left_Type;
723 -- If left size is larger, we do the remainder operation using the
724 -- size of the left type (i.e. the larger of the two integer types).
726 elsif Esize (Left_Type) >= Esize (Right_Type) then
727 Result_Type := Left_Type;
731 Right_Opnd => Build_Conversion (N, Left_Type, R));
733 -- Similarly, if the right size is larger, we do the remainder
734 -- operation using the right type.
737 Result_Type := Right_Type;
740 Left_Opnd => Build_Conversion (N, Right_Type, L),
744 -- We now have an N_Op_Rem node built with Result_Type set. First
745 -- set Etype of result, as required for all Build_xxx routines
747 Set_Etype (Rnode, Base_Type (Result_Type));
749 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
750 -- since this is a literal arithmetic operation, to be performed
751 -- by Gigi without any consideration of small values.
753 if Is_Fixed_Point_Type (Result_Type) then
754 Set_Treat_Fixed_As_Integer (Rnode);
757 -- One more check. We did the rem operation using the larger of the
758 -- two types, which is reasonable. However, in the case where the
759 -- two types have unequal sizes, it is impossible for the result of
760 -- a remainder operation to be larger than the smaller of the two
761 -- types, so we can put a conversion round the result to keep the
762 -- evolving operation size as small as possible.
764 if Esize (Left_Type) >= Esize (Right_Type) then
765 Rnode := Build_Conversion (N, Right_Type, Rnode);
766 elsif Esize (Right_Type) >= Esize (Left_Type) then
767 Rnode := Build_Conversion (N, Left_Type, Rnode);
773 -------------------------
774 -- Build_Scaled_Divide --
775 -------------------------
777 function Build_Scaled_Divide
779 X, Y, Z : Node_Id) return Node_Id
781 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
782 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
786 -- If numerator fits in 64 bits, we can build the operations directly
787 -- without causing any intermediate overflow, so that's what we do!
789 if Int'Max (X_Size, Y_Size) <= 32 then
791 Build_Divide (N, Build_Multiply (N, X, Y), Z);
793 -- Otherwise we use the runtime routine
795 -- [Qnn : Integer_64,
797 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
802 Loc : constant Source_Ptr := Sloc (N);
808 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
809 Insert_Actions (N, Code);
810 Expr := New_Occurrence_Of (Qnn, Loc);
812 -- Set type of result in case used elsewhere (see note at start)
814 Set_Etype (Expr, Etype (Qnn));
818 end Build_Scaled_Divide;
820 ------------------------------
821 -- Build_Scaled_Divide_Code --
822 ------------------------------
824 -- If the numerator can be computed in 64-bits, we build
826 -- [Nnn : constant typ := typ (X) * typ (Y);
827 -- Dnn : constant typ := typ (Z)
828 -- Qnn : constant typ := Nnn / Dnn;
829 -- Rnn : constant typ := Nnn / Dnn;
831 -- If the numerator cannot be computed in 64 bits, we build
833 -- [Qnn : Interfaces.Integer_64;
834 -- Rnn : Interfaces.Integer_64;
835 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
837 procedure Build_Scaled_Divide_Code
840 Qnn, Rnn : out Entity_Id;
843 Loc : constant Source_Ptr := Sloc (N);
845 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
846 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
847 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
859 -- Find type that will allow computation of numerator
861 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
864 QR_Typ := Standard_Integer_16;
865 elsif QR_Siz <= 32 then
866 QR_Typ := Standard_Integer_32;
867 elsif QR_Siz <= 64 then
868 QR_Typ := Standard_Integer_64;
870 -- For more than 64, bits, we use the 64-bit integer defined in
871 -- Interfaces, so that it can be handled by the runtime routine
874 QR_Typ := RTE (RE_Integer_64);
877 -- Define quotient and remainder, and set their Etypes, so
878 -- that they can be picked up by Build_xxx routines.
880 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
881 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
883 Set_Etype (Qnn, QR_Typ);
884 Set_Etype (Rnn, QR_Typ);
886 -- Case that we can compute the numerator in 64 bits
889 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
890 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
892 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
894 Set_Etype (Nnn, QR_Typ);
895 Set_Etype (Dnn, QR_Typ);
898 Make_Object_Declaration (Loc,
899 Defining_Identifier => Nnn,
900 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
901 Constant_Present => True,
904 Build_Conversion (N, QR_Typ, X),
905 Build_Conversion (N, QR_Typ, Y))),
907 Make_Object_Declaration (Loc,
908 Defining_Identifier => Dnn,
909 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
910 Constant_Present => True,
911 Expression => Build_Conversion (N, QR_Typ, Z)));
915 New_Occurrence_Of (Nnn, Loc),
916 New_Occurrence_Of (Dnn, Loc));
919 Make_Object_Declaration (Loc,
920 Defining_Identifier => Qnn,
921 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
922 Constant_Present => True,
926 Make_Object_Declaration (Loc,
927 Defining_Identifier => Rnn,
928 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
929 Constant_Present => True,
932 New_Occurrence_Of (Nnn, Loc),
933 New_Occurrence_Of (Dnn, Loc))));
935 -- Case where numerator does not fit in 64 bits, so we have to
936 -- call the runtime routine to compute the quotient and remainder
939 Rnd := Boolean_Literals (Rounded_Result_Set (N));
942 Make_Object_Declaration (Loc,
943 Defining_Identifier => Qnn,
944 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
946 Make_Object_Declaration (Loc,
947 Defining_Identifier => Rnn,
948 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
950 Make_Procedure_Call_Statement (Loc,
951 Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
952 Parameter_Associations => New_List (
953 Build_Conversion (N, QR_Typ, X),
954 Build_Conversion (N, QR_Typ, Y),
955 Build_Conversion (N, QR_Typ, Z),
956 New_Occurrence_Of (Qnn, Loc),
957 New_Occurrence_Of (Rnn, Loc),
958 New_Occurrence_Of (Rnd, Loc))));
961 -- Set type of result, for use in caller
963 Set_Etype (Qnn, QR_Typ);
964 end Build_Scaled_Divide_Code;
966 ---------------------------
967 -- Do_Divide_Fixed_Fixed --
968 ---------------------------
972 -- (Result_Value * Result_Small) =
973 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
975 -- Result_Value = (Left_Value / Right_Value) *
976 -- (Left_Small / (Right_Small * Result_Small));
978 -- we can do the operation in integer arithmetic if this fraction is an
979 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
980 -- Otherwise the result is in the close result set and our approach is to
981 -- use floating-point to compute this close result.
983 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
984 Left : constant Node_Id := Left_Opnd (N);
985 Right : constant Node_Id := Right_Opnd (N);
986 Left_Type : constant Entity_Id := Etype (Left);
987 Right_Type : constant Entity_Id := Etype (Right);
988 Result_Type : constant Entity_Id := Etype (N);
989 Right_Small : constant Ureal := Small_Value (Right_Type);
990 Left_Small : constant Ureal := Small_Value (Left_Type);
992 Result_Small : Ureal;
999 -- Rounding is required if the result is integral
1001 if Is_Integer_Type (Result_Type) then
1002 Set_Rounded_Result (N);
1005 -- Get result small. If the result is an integer, treat it as though
1006 -- it had a small of 1.0, all other processing is identical.
1008 if Is_Integer_Type (Result_Type) then
1009 Result_Small := Ureal_1;
1011 Result_Small := Small_Value (Result_Type);
1016 Frac := Left_Small / (Right_Small * Result_Small);
1017 Frac_Num := Norm_Num (Frac);
1018 Frac_Den := Norm_Den (Frac);
1020 -- If the fraction is an integer, then we get the result by multiplying
1021 -- the left operand by the integer, and then dividing by the right
1022 -- operand (the order is important, if we did the divide first, we
1023 -- would lose precision).
1025 if Frac_Den = 1 then
1026 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1028 if Present (Lit_Int) then
1029 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1033 -- If the fraction is the reciprocal of an integer, then we get the
1034 -- result by first multiplying the divisor by the integer, and then
1035 -- doing the division with the adjusted divisor.
1037 -- Note: this is much better than doing two divisions: multiplications
1038 -- are much faster than divisions (and certainly faster than rounded
1039 -- divisions), and we don't get inaccuracies from double rounding.
1041 elsif Frac_Num = 1 then
1042 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1044 if Present (Lit_Int) then
1045 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1050 -- If we fall through, we use floating-point to compute the result
1054 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1055 Real_Literal (N, Frac)));
1056 end Do_Divide_Fixed_Fixed;
1058 -------------------------------
1059 -- Do_Divide_Fixed_Universal --
1060 -------------------------------
1064 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1065 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1067 -- The result is required to be in the perfect result set if the literal
1068 -- can be factored so that the resulting small ratio is an integer or the
1069 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1070 -- analysis of these RM requirements:
1072 -- We must factor the literal, finding an integer K:
1074 -- Lit_Value = K * Right_Small
1075 -- Right_Small = Lit_Value / K
1077 -- such that the small ratio:
1080 -- ------------------------------
1081 -- (Lit_Value / K) * Result_Small
1084 -- = ------------------------ * K
1085 -- Lit_Value * Result_Small
1087 -- is an integer or the reciprocal of an integer, and for
1088 -- implementation efficiency we need the smallest such K.
1090 -- First we reduce the left fraction to lowest terms
1092 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1093 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1094 -- Right_Small = Lit_Value.
1096 -- If numerator > 1, then set K to the denominator of the fraction so
1097 -- that the resulting small ratio is an integer (the numerator value).
1099 procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1100 Left : constant Node_Id := Left_Opnd (N);
1101 Right : constant Node_Id := Right_Opnd (N);
1102 Left_Type : constant Entity_Id := Etype (Left);
1103 Result_Type : constant Entity_Id := Etype (N);
1104 Left_Small : constant Ureal := Small_Value (Left_Type);
1105 Lit_Value : constant Ureal := Realval (Right);
1107 Result_Small : Ureal;
1115 -- Get result small. If the result is an integer, treat it as though
1116 -- it had a small of 1.0, all other processing is identical.
1118 if Is_Integer_Type (Result_Type) then
1119 Result_Small := Ureal_1;
1121 Result_Small := Small_Value (Result_Type);
1124 -- Determine if literal can be rewritten successfully
1126 Frac := Left_Small / (Lit_Value * Result_Small);
1127 Frac_Num := Norm_Num (Frac);
1128 Frac_Den := Norm_Den (Frac);
1130 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1131 -- = denominator). If this integer is not too large, this is the case
1132 -- where the result can be obtained by dividing by this integer value.
1134 if Frac_Num = 1 then
1135 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1137 if Present (Lit_Int) then
1138 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1142 -- Case where we choose K to make fraction an integer (K = denominator
1143 -- of fraction, integer = numerator of fraction). If both K and the
1144 -- numerator are small enough, this is the case where the result can
1145 -- be obtained by first multiplying by the integer value and then
1146 -- dividing by K (the order is important, if we divided first, we
1147 -- would lose precision).
1150 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1151 Lit_K := Integer_Literal (N, Frac_Den, False);
1153 if Present (Lit_Int) and then Present (Lit_K) then
1154 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1159 -- Fall through if the literal cannot be successfully rewritten, or if
1160 -- the small ratio is out of range of integer arithmetic. In the former
1161 -- case it is fine to use floating-point to get the close result set,
1162 -- and in the latter case, it means that the result is zero or raises
1163 -- constraint error, and we can do that accurately in floating-point.
1165 -- If we end up using floating-point, then we take the right integer
1166 -- to be one, and its small to be the value of the original right real
1167 -- literal. That way, we need only one floating-point multiplication.
1170 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1171 end Do_Divide_Fixed_Universal;
1173 -------------------------------
1174 -- Do_Divide_Universal_Fixed --
1175 -------------------------------
1179 -- (Result_Value * Result_Small) =
1180 -- Lit_Value / (Right_Value * Right_Small)
1182 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1184 -- The result is required to be in the perfect result set if the literal
1185 -- can be factored so that the resulting small ratio is an integer or the
1186 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1187 -- analysis of these RM requirements:
1189 -- We must factor the literal, finding an integer K:
1191 -- Lit_Value = K * Left_Small
1192 -- Left_Small = Lit_Value / K
1194 -- such that the small ratio:
1197 -- --------------------------
1198 -- Right_Small * Result_Small
1201 -- = -------------------------- * -
1202 -- Right_Small * Result_Small K
1204 -- is an integer or the reciprocal of an integer, and for
1205 -- implementation efficiency we need the smallest such K.
1207 -- First we reduce the left fraction to lowest terms
1209 -- If denominator = 1, then for K = 1, the small ratio is an integer
1210 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1211 -- and Left_Small = Lit_Value.
1213 -- If denominator > 1, then set K to the numerator of the fraction so
1214 -- that the resulting small ratio is the reciprocal of an integer (the
1215 -- numerator value).
1217 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1218 Left : constant Node_Id := Left_Opnd (N);
1219 Right : constant Node_Id := Right_Opnd (N);
1220 Right_Type : constant Entity_Id := Etype (Right);
1221 Result_Type : constant Entity_Id := Etype (N);
1222 Right_Small : constant Ureal := Small_Value (Right_Type);
1223 Lit_Value : constant Ureal := Realval (Left);
1225 Result_Small : Ureal;
1233 -- Get result small. If the result is an integer, treat it as though
1234 -- it had a small of 1.0, all other processing is identical.
1236 if Is_Integer_Type (Result_Type) then
1237 Result_Small := Ureal_1;
1239 Result_Small := Small_Value (Result_Type);
1242 -- Determine if literal can be rewritten successfully
1244 Frac := Lit_Value / (Right_Small * Result_Small);
1245 Frac_Num := Norm_Num (Frac);
1246 Frac_Den := Norm_Den (Frac);
1248 -- Case where fraction is an integer (K = 1, integer = numerator). If
1249 -- this integer is not too large, this is the case where the result
1250 -- can be obtained by dividing this integer by the right operand.
1252 if Frac_Den = 1 then
1253 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1255 if Present (Lit_Int) then
1256 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1260 -- Case where we choose K to make the fraction the reciprocal of an
1261 -- integer (K = numerator of fraction, integer = numerator of fraction).
1262 -- If both K and the integer are small enough, this is the case where
1263 -- the result can be obtained by multiplying the right operand by K
1264 -- and then dividing by the integer value. The order of the operations
1265 -- is important (if we divided first, we would lose precision).
1268 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1269 Lit_K := Integer_Literal (N, Frac_Num, False);
1271 if Present (Lit_Int) and then Present (Lit_K) then
1272 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1277 -- Fall through if the literal cannot be successfully rewritten, or if
1278 -- the small ratio is out of range of integer arithmetic. In the former
1279 -- case it is fine to use floating-point to get the close result set,
1280 -- and in the latter case, it means that the result is zero or raises
1281 -- constraint error, and we can do that accurately in floating-point.
1283 -- If we end up using floating-point, then we take the right integer
1284 -- to be one, and its small to be the value of the original right real
1285 -- literal. That way, we need only one floating-point division.
1288 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1289 end Do_Divide_Universal_Fixed;
1291 -----------------------------
1292 -- Do_Multiply_Fixed_Fixed --
1293 -----------------------------
1297 -- (Result_Value * Result_Small) =
1298 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1300 -- Result_Value = (Left_Value * Right_Value) *
1301 -- (Left_Small * Right_Small) / Result_Small;
1303 -- we can do the operation in integer arithmetic if this fraction is an
1304 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1305 -- Otherwise the result is in the close result set and our approach is to
1306 -- use floating-point to compute this close result.
1308 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1309 Left : constant Node_Id := Left_Opnd (N);
1310 Right : constant Node_Id := Right_Opnd (N);
1312 Left_Type : constant Entity_Id := Etype (Left);
1313 Right_Type : constant Entity_Id := Etype (Right);
1314 Result_Type : constant Entity_Id := Etype (N);
1315 Right_Small : constant Ureal := Small_Value (Right_Type);
1316 Left_Small : constant Ureal := Small_Value (Left_Type);
1318 Result_Small : Ureal;
1325 -- Get result small. If the result is an integer, treat it as though
1326 -- it had a small of 1.0, all other processing is identical.
1328 if Is_Integer_Type (Result_Type) then
1329 Result_Small := Ureal_1;
1331 Result_Small := Small_Value (Result_Type);
1336 Frac := (Left_Small * Right_Small) / Result_Small;
1337 Frac_Num := Norm_Num (Frac);
1338 Frac_Den := Norm_Den (Frac);
1340 -- If the fraction is an integer, then we get the result by multiplying
1341 -- the operands, and then multiplying the result by the integer value.
1343 if Frac_Den = 1 then
1344 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1346 if Present (Lit_Int) then
1348 Build_Multiply (N, Build_Multiply (N, Left, Right),
1353 -- If the fraction is the reciprocal of an integer, then we get the
1354 -- result by multiplying the operands, and then dividing the result by
1355 -- the integer value. The order of the operations is important, if we
1356 -- divided first, we would lose precision.
1358 elsif Frac_Num = 1 then
1359 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1361 if Present (Lit_Int) then
1362 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1367 -- If we fall through, we use floating-point to compute the result
1371 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1372 Real_Literal (N, Frac)));
1373 end Do_Multiply_Fixed_Fixed;
1375 ---------------------------------
1376 -- Do_Multiply_Fixed_Universal --
1377 ---------------------------------
1381 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1382 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1384 -- The result is required to be in the perfect result set if the literal
1385 -- can be factored so that the resulting small ratio is an integer or the
1386 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1387 -- analysis of these RM requirements:
1389 -- We must factor the literal, finding an integer K:
1391 -- Lit_Value = K * Right_Small
1392 -- Right_Small = Lit_Value / K
1394 -- such that the small ratio:
1396 -- Left_Small * (Lit_Value / K)
1397 -- ----------------------------
1400 -- Left_Small * Lit_Value 1
1401 -- = ---------------------- * -
1404 -- is an integer or the reciprocal of an integer, and for
1405 -- implementation efficiency we need the smallest such K.
1407 -- First we reduce the left fraction to lowest terms
1409 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1410 -- this is clearly the minimum K case, so set
1412 -- K = 1, Right_Small = Lit_Value
1414 -- If denominator > 1, then set K to the numerator of the fraction, so
1415 -- that the resulting small ratio is the reciprocal of the integer (the
1416 -- denominator value).
1418 procedure Do_Multiply_Fixed_Universal
1420 Left, Right : Node_Id)
1422 Left_Type : constant Entity_Id := Etype (Left);
1423 Result_Type : constant Entity_Id := Etype (N);
1424 Left_Small : constant Ureal := Small_Value (Left_Type);
1425 Lit_Value : constant Ureal := Realval (Right);
1427 Result_Small : Ureal;
1435 -- Get result small. If the result is an integer, treat it as though
1436 -- it had a small of 1.0, all other processing is identical.
1438 if Is_Integer_Type (Result_Type) then
1439 Result_Small := Ureal_1;
1441 Result_Small := Small_Value (Result_Type);
1444 -- Determine if literal can be rewritten successfully
1446 Frac := (Left_Small * Lit_Value) / Result_Small;
1447 Frac_Num := Norm_Num (Frac);
1448 Frac_Den := Norm_Den (Frac);
1450 -- Case where fraction is an integer (K = 1, integer = numerator). If
1451 -- this integer is not too large, this is the case where the result can
1452 -- be obtained by multiplying by this integer value.
1454 if Frac_Den = 1 then
1455 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1457 if Present (Lit_Int) then
1458 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1462 -- Case where we choose K to make fraction the reciprocal of an integer
1463 -- (K = numerator of fraction, integer = denominator of fraction). If
1464 -- both K and the denominator are small enough, this is the case where
1465 -- the result can be obtained by first multiplying by K, and then
1466 -- dividing by the integer value.
1469 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1470 Lit_K := Integer_Literal (N, Frac_Num);
1472 if Present (Lit_Int) and then Present (Lit_K) then
1473 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1478 -- Fall through if the literal cannot be successfully rewritten, or if
1479 -- the small ratio is out of range of integer arithmetic. In the former
1480 -- case it is fine to use floating-point to get the close result set,
1481 -- and in the latter case, it means that the result is zero or raises
1482 -- constraint error, and we can do that accurately in floating-point.
1484 -- If we end up using floating-point, then we take the right integer
1485 -- to be one, and its small to be the value of the original right real
1486 -- literal. That way, we need only one floating-point multiplication.
1489 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1490 end Do_Multiply_Fixed_Universal;
1492 ---------------------------------
1493 -- Expand_Convert_Fixed_Static --
1494 ---------------------------------
1496 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1499 Convert_To (Etype (N),
1500 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1501 Analyze_And_Resolve (N);
1502 end Expand_Convert_Fixed_Static;
1504 -----------------------------------
1505 -- Expand_Convert_Fixed_To_Fixed --
1506 -----------------------------------
1510 -- Result_Value * Result_Small = Source_Value * Source_Small
1511 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1513 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1514 -- integer, then the perfect result set is obtained by a single integer
1517 -- If the small ratio is the reciprocal of a sufficiently small integer,
1518 -- then the perfect result set is obtained by a single integer division.
1520 -- In other cases, we obtain the close result set by calculating the
1521 -- result in floating-point.
1523 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1524 Rng_Check : constant Boolean := Do_Range_Check (N);
1525 Expr : constant Node_Id := Expression (N);
1526 Result_Type : constant Entity_Id := Etype (N);
1527 Source_Type : constant Entity_Id := Etype (Expr);
1528 Small_Ratio : Ureal;
1534 if Is_OK_Static_Expression (Expr) then
1535 Expand_Convert_Fixed_Static (N);
1539 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1540 Ratio_Num := Norm_Num (Small_Ratio);
1541 Ratio_Den := Norm_Den (Small_Ratio);
1543 if Ratio_Den = 1 then
1544 if Ratio_Num = 1 then
1545 Set_Result (N, Expr);
1549 Lit := Integer_Literal (N, Ratio_Num);
1551 if Present (Lit) then
1552 Set_Result (N, Build_Multiply (N, Expr, Lit));
1557 elsif Ratio_Num = 1 then
1558 Lit := Integer_Literal (N, Ratio_Den);
1560 if Present (Lit) then
1561 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1566 -- Fall through to use floating-point for the close result set case
1567 -- either as a result of the small ratio not being an integer or the
1568 -- reciprocal of an integer, or if the integer is out of range.
1573 Real_Literal (N, Small_Ratio)),
1575 end Expand_Convert_Fixed_To_Fixed;
1577 -----------------------------------
1578 -- Expand_Convert_Fixed_To_Float --
1579 -----------------------------------
1581 -- If the small of the fixed type is 1.0, then we simply convert the
1582 -- integer value directly to the target floating-point type, otherwise
1583 -- we first have to multiply by the small, in Universal_Real, and then
1584 -- convert the result to the target floating-point type.
1586 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1587 Rng_Check : constant Boolean := Do_Range_Check (N);
1588 Expr : constant Node_Id := Expression (N);
1589 Source_Type : constant Entity_Id := Etype (Expr);
1590 Small : constant Ureal := Small_Value (Source_Type);
1593 if Is_OK_Static_Expression (Expr) then
1594 Expand_Convert_Fixed_Static (N);
1598 if Small = Ureal_1 then
1599 Set_Result (N, Expr);
1605 Real_Literal (N, Small)),
1608 end Expand_Convert_Fixed_To_Float;
1610 -------------------------------------
1611 -- Expand_Convert_Fixed_To_Integer --
1612 -------------------------------------
1616 -- Result_Value = Source_Value * Source_Small
1618 -- If the small value is a sufficiently small integer, then the perfect
1619 -- result set is obtained by a single integer multiplication.
1621 -- If the small value is the reciprocal of a sufficiently small integer,
1622 -- then the perfect result set is obtained by a single integer division.
1624 -- In other cases, we obtain the close result set by calculating the
1625 -- result in floating-point.
1627 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1628 Rng_Check : constant Boolean := Do_Range_Check (N);
1629 Expr : constant Node_Id := Expression (N);
1630 Source_Type : constant Entity_Id := Etype (Expr);
1631 Small : constant Ureal := Small_Value (Source_Type);
1632 Small_Num : constant Uint := Norm_Num (Small);
1633 Small_Den : constant Uint := Norm_Den (Small);
1637 if Is_OK_Static_Expression (Expr) then
1638 Expand_Convert_Fixed_Static (N);
1642 if Small_Den = 1 then
1643 Lit := Integer_Literal (N, Small_Num);
1645 if Present (Lit) then
1646 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1650 elsif Small_Num = 1 then
1651 Lit := Integer_Literal (N, Small_Den);
1653 if Present (Lit) then
1654 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1659 -- Fall through to use floating-point for the close result set case
1660 -- either as a result of the small value not being an integer or the
1661 -- reciprocal of an integer, or if the integer is out of range.
1666 Real_Literal (N, Small)),
1668 end Expand_Convert_Fixed_To_Integer;
1670 -----------------------------------
1671 -- Expand_Convert_Float_To_Fixed --
1672 -----------------------------------
1676 -- Result_Value * Result_Small = Operand_Value
1680 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1682 -- We do the small scaling in floating-point, and we do a multiplication
1683 -- rather than a division, since it is accurate enough for the perfect
1684 -- result cases, and faster.
1686 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1687 Rng_Check : constant Boolean := Do_Range_Check (N);
1688 Expr : constant Node_Id := Expression (N);
1689 Result_Type : constant Entity_Id := Etype (N);
1690 Small : constant Ureal := Small_Value (Result_Type);
1693 -- Optimize small = 1, where we can avoid the multiply completely
1695 if Small = Ureal_1 then
1696 Set_Result (N, Expr, Rng_Check);
1698 -- Normal case where multiply is required
1704 Real_Literal (N, Ureal_1 / Small)),
1707 end Expand_Convert_Float_To_Fixed;
1709 -------------------------------------
1710 -- Expand_Convert_Integer_To_Fixed --
1711 -------------------------------------
1715 -- Result_Value * Result_Small = Operand_Value
1716 -- Result_Value = Operand_Value / Result_Small
1718 -- If the small value is a sufficiently small integer, then the perfect
1719 -- result set is obtained by a single integer division.
1721 -- If the small value is the reciprocal of a sufficiently small integer,
1722 -- the perfect result set is obtained by a single integer multiplication.
1724 -- In other cases, we obtain the close result set by calculating the
1725 -- result in floating-point using a multiplication by the reciprocal
1726 -- of the Result_Small.
1728 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1729 Rng_Check : constant Boolean := Do_Range_Check (N);
1730 Expr : constant Node_Id := Expression (N);
1731 Result_Type : constant Entity_Id := Etype (N);
1732 Small : constant Ureal := Small_Value (Result_Type);
1733 Small_Num : constant Uint := Norm_Num (Small);
1734 Small_Den : constant Uint := Norm_Den (Small);
1738 if Small_Den = 1 then
1739 Lit := Integer_Literal (N, Small_Num);
1741 if Present (Lit) then
1742 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1746 elsif Small_Num = 1 then
1747 Lit := Integer_Literal (N, Small_Den);
1749 if Present (Lit) then
1750 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1755 -- Fall through to use floating-point for the close result set case
1756 -- either as a result of the small value not being an integer or the
1757 -- reciprocal of an integer, or if the integer is out of range.
1762 Real_Literal (N, Ureal_1 / Small)),
1764 end Expand_Convert_Integer_To_Fixed;
1766 --------------------------------
1767 -- Expand_Decimal_Divide_Call --
1768 --------------------------------
1770 -- We have four operands
1777 -- All of which are decimal types, and which thus have associated
1780 -- Computing the quotient is a similar problem to that faced by the
1781 -- normal fixed-point division, except that it is simpler, because
1782 -- we always have compatible smalls.
1784 -- Quotient = (Dividend / Divisor) * 10**q
1786 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1787 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1789 -- For q >= 0, we compute
1791 -- Numerator := Dividend * 10 ** q
1792 -- Denominator := Divisor
1793 -- Quotient := Numerator / Denominator
1795 -- For q < 0, we compute
1797 -- Numerator := Dividend
1798 -- Denominator := Divisor * 10 ** q
1799 -- Quotient := Numerator / Denominator
1801 -- Both these divisions are done in truncated mode, and the remainder
1802 -- from these divisions is used to compute the result Remainder. This
1803 -- remainder has the effective scale of the numerator of the division,
1805 -- For q >= 0, the remainder scale is Dividend'Scale + q
1806 -- For q < 0, the remainder scale is Dividend'Scale
1808 -- The result Remainder is then computed by a normal truncating decimal
1809 -- conversion from this scale to the scale of the remainder, i.e. by a
1810 -- division or multiplication by the appropriate power of 10.
1812 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1813 Loc : constant Source_Ptr := Sloc (N);
1815 Dividend : Node_Id := First_Actual (N);
1816 Divisor : Node_Id := Next_Actual (Dividend);
1817 Quotient : Node_Id := Next_Actual (Divisor);
1818 Remainder : Node_Id := Next_Actual (Quotient);
1820 Dividend_Type : constant Entity_Id := Etype (Dividend);
1821 Divisor_Type : constant Entity_Id := Etype (Divisor);
1822 Quotient_Type : constant Entity_Id := Etype (Quotient);
1823 Remainder_Type : constant Entity_Id := Etype (Remainder);
1825 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1826 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1827 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1828 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1831 Numerator_Scale : Uint;
1835 Computed_Remainder : Node_Id;
1836 Adjusted_Remainder : Node_Id;
1837 Scale_Adjust : Uint;
1840 -- Relocate the operands, since they are now list elements, and we
1841 -- need to reference them separately as operands in the expanded code.
1843 Dividend := Relocate_Node (Dividend);
1844 Divisor := Relocate_Node (Divisor);
1845 Quotient := Relocate_Node (Quotient);
1846 Remainder := Relocate_Node (Remainder);
1848 -- Now compute Q, the adjustment scale
1850 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1852 -- If Q is non-negative then we need a scaled divide
1855 Build_Scaled_Divide_Code
1858 Integer_Literal (N, Uint_10 ** Q),
1862 Numerator_Scale := Dividend_Scale + Q;
1864 -- If Q is negative, then we need a double divide
1867 Build_Double_Divide_Code
1871 Integer_Literal (N, Uint_10 ** (-Q)),
1874 Numerator_Scale := Dividend_Scale;
1877 -- Add statement to set quotient value
1879 -- Quotient := quotient-type!(Qnn);
1882 Make_Assignment_Statement (Loc,
1885 Unchecked_Convert_To (Quotient_Type,
1886 Build_Conversion (N, Quotient_Type,
1887 New_Occurrence_Of (Qnn, Loc)))));
1889 -- Now we need to deal with computing and setting the remainder. The
1890 -- scale of the remainder is in Numerator_Scale, and the desired
1891 -- scale is the scale of the given Remainder argument. There are
1894 -- Numerator_Scale > Remainder_Scale
1896 -- in this case, there are extra digits in the computed remainder
1897 -- which must be eliminated by an extra division:
1899 -- computed-remainder := Numerator rem Denominator
1900 -- scale_adjust = Numerator_Scale - Remainder_Scale
1901 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1903 -- Numerator_Scale = Remainder_Scale
1905 -- in this case, the we have the remainder we need
1907 -- computed-remainder := Numerator rem Denominator
1908 -- adjusted-remainder := computed-remainder
1910 -- Numerator_Scale < Remainder_Scale
1912 -- in this case, we have insufficient digits in the computed
1913 -- remainder, which must be eliminated by an extra multiply
1915 -- computed-remainder := Numerator rem Denominator
1916 -- scale_adjust = Remainder_Scale - Numerator_Scale
1917 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1919 -- Finally we assign the adjusted-remainder to the result Remainder
1920 -- with conversions to get the proper fixed-point type representation.
1922 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
1924 if Numerator_Scale > Remainder_Scale then
1925 Scale_Adjust := Numerator_Scale - Remainder_Scale;
1926 Adjusted_Remainder :=
1928 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1930 elsif Numerator_Scale = Remainder_Scale then
1931 Adjusted_Remainder := Computed_Remainder;
1933 else -- Numerator_Scale < Remainder_Scale
1934 Scale_Adjust := Remainder_Scale - Numerator_Scale;
1935 Adjusted_Remainder :=
1937 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1940 -- Assignment of remainder result
1943 Make_Assignment_Statement (Loc,
1946 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
1948 -- Final step is to rewrite the call with a block containing the
1949 -- above sequence of constructed statements for the divide operation.
1952 Make_Block_Statement (Loc,
1953 Handled_Statement_Sequence =>
1954 Make_Handled_Sequence_Of_Statements (Loc,
1955 Statements => Stmts)));
1958 end Expand_Decimal_Divide_Call;
1960 -----------------------------------------------
1961 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1962 -----------------------------------------------
1964 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
1965 Left : constant Node_Id := Left_Opnd (N);
1966 Right : constant Node_Id := Right_Opnd (N);
1969 -- Suppress expansion of a fixed-by-fixed division if the
1970 -- operation is supported directly by the target.
1972 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
1976 if Etype (Left) = Universal_Real then
1977 Do_Divide_Universal_Fixed (N);
1979 elsif Etype (Right) = Universal_Real then
1980 Do_Divide_Fixed_Universal (N);
1983 Do_Divide_Fixed_Fixed (N);
1985 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
1987 -----------------------------------------------
1988 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1989 -----------------------------------------------
1991 -- The division is done in Universal_Real, and the result is multiplied
1992 -- by the small ratio, which is Small (Right) / Small (Left). Special
1993 -- treatment is required for universal operands, which represent their
1994 -- own value and do not require conversion.
1996 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
1997 Left : constant Node_Id := Left_Opnd (N);
1998 Right : constant Node_Id := Right_Opnd (N);
2000 Left_Type : constant Entity_Id := Etype (Left);
2001 Right_Type : constant Entity_Id := Etype (Right);
2004 -- Case of left operand is universal real, the result we want is:
2006 -- Left_Value / (Right_Value * Right_Small)
2008 -- so we compute this as:
2010 -- (Left_Value / Right_Small) / Right_Value
2012 if Left_Type = Universal_Real then
2015 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2016 Fpt_Value (Right)));
2018 -- Case of right operand is universal real, the result we want is
2020 -- (Left_Value * Left_Small) / Right_Value
2022 -- so we compute this as:
2024 -- Left_Value * (Left_Small / Right_Value)
2026 -- Note we invert to a multiplication since usually floating-point
2027 -- multiplication is much faster than floating-point division.
2029 elsif Right_Type = Universal_Real then
2033 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2035 -- Both operands are fixed, so the value we want is
2037 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2039 -- which we compute as:
2041 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2046 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2048 Small_Value (Left_Type) / Small_Value (Right_Type))));
2050 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2052 -------------------------------------------------
2053 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2054 -------------------------------------------------
2056 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2057 Left : constant Node_Id := Left_Opnd (N);
2058 Right : constant Node_Id := Right_Opnd (N);
2060 if Etype (Left) = Universal_Real then
2061 Do_Divide_Universal_Fixed (N);
2062 elsif Etype (Right) = Universal_Real then
2063 Do_Divide_Fixed_Universal (N);
2065 Do_Divide_Fixed_Fixed (N);
2067 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2069 -------------------------------------------------
2070 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2071 -------------------------------------------------
2073 -- Since the operand and result fixed-point type is the same, this is
2074 -- a straight divide by the right operand, the small can be ignored.
2076 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2077 Left : constant Node_Id := Left_Opnd (N);
2078 Right : constant Node_Id := Right_Opnd (N);
2080 Set_Result (N, Build_Divide (N, Left, Right));
2081 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2083 -------------------------------------------------
2084 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2085 -------------------------------------------------
2087 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2088 Left : constant Node_Id := Left_Opnd (N);
2089 Right : constant Node_Id := Right_Opnd (N);
2091 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2092 -- The operand may be a non-static universal value, such an
2093 -- exponentiation with a non-static exponent. In that case, treat
2094 -- as a fixed * fixed multiplication, and convert the argument to
2095 -- the target fixed type.
2097 ----------------------------------
2098 -- Rewrite_Non_Static_Universal --
2099 ----------------------------------
2101 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2102 Loc : constant Source_Ptr := Sloc (N);
2105 Make_Type_Conversion (Loc,
2106 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2107 Expression => Expression (Opnd)));
2108 Analyze_And_Resolve (Opnd, Etype (N));
2109 end Rewrite_Non_Static_Universal;
2111 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2114 -- Suppress expansion of a fixed-by-fixed multiplication if the
2115 -- operation is supported directly by the target.
2117 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
2121 if Etype (Left) = Universal_Real then
2122 if Nkind (Left) = N_Real_Literal then
2123 Do_Multiply_Fixed_Universal (N, Right, Left);
2125 elsif Nkind (Left) = N_Type_Conversion then
2126 Rewrite_Non_Static_Universal (Left);
2127 Do_Multiply_Fixed_Fixed (N);
2130 elsif Etype (Right) = Universal_Real then
2131 if Nkind (Right) = N_Real_Literal then
2132 Do_Multiply_Fixed_Universal (N, Left, Right);
2134 elsif Nkind (Right) = N_Type_Conversion then
2135 Rewrite_Non_Static_Universal (Right);
2136 Do_Multiply_Fixed_Fixed (N);
2140 Do_Multiply_Fixed_Fixed (N);
2142 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2144 -------------------------------------------------
2145 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2146 -------------------------------------------------
2148 -- The multiply is done in Universal_Real, and the result is multiplied
2149 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2150 -- Special treatment is required for universal operands.
2152 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2153 Left : constant Node_Id := Left_Opnd (N);
2154 Right : constant Node_Id := Right_Opnd (N);
2156 Left_Type : constant Entity_Id := Etype (Left);
2157 Right_Type : constant Entity_Id := Etype (Right);
2160 -- Case of left operand is universal real, the result we want is
2162 -- Left_Value * (Right_Value * Right_Small)
2164 -- so we compute this as:
2166 -- (Left_Value * Right_Small) * Right_Value;
2168 if Left_Type = Universal_Real then
2171 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2172 Fpt_Value (Right)));
2174 -- Case of right operand is universal real, the result we want is
2176 -- (Left_Value * Left_Small) * Right_Value
2178 -- so we compute this as:
2180 -- Left_Value * (Left_Small * Right_Value)
2182 elsif Right_Type = Universal_Real then
2186 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2188 -- Both operands are fixed, so the value we want is
2190 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2192 -- which we compute as:
2194 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2199 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2201 Small_Value (Right_Type) * Small_Value (Left_Type))));
2203 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2205 ---------------------------------------------------
2206 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2207 ---------------------------------------------------
2209 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2210 Left : constant Node_Id := Left_Opnd (N);
2211 Right : constant Node_Id := Right_Opnd (N);
2213 if Etype (Left) = Universal_Real then
2214 Do_Multiply_Fixed_Universal (N, Right, Left);
2215 elsif Etype (Right) = Universal_Real then
2216 Do_Multiply_Fixed_Universal (N, Left, Right);
2218 Do_Multiply_Fixed_Fixed (N);
2220 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2222 ---------------------------------------------------
2223 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2224 ---------------------------------------------------
2226 -- Since the operand and result fixed-point type is the same, this is
2227 -- a straight multiply by the right operand, the small can be ignored.
2229 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2232 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2233 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2235 ---------------------------------------------------
2236 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2237 ---------------------------------------------------
2239 -- Since the operand and result fixed-point type is the same, this is
2240 -- a straight multiply by the right operand, the small can be ignored.
2242 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2245 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2246 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2252 function Fpt_Value (N : Node_Id) return Node_Id is
2253 Typ : constant Entity_Id := Etype (N);
2256 if Is_Integer_Type (Typ)
2257 or else Is_Floating_Point_Type (Typ)
2259 return Build_Conversion (N, Universal_Real, N);
2261 -- Fixed-point case, must get integer value first
2264 return Build_Conversion (N, Universal_Real, N);
2268 ---------------------
2269 -- Integer_Literal --
2270 ---------------------
2272 function Integer_Literal
2275 Negative : Boolean := False) return Node_Id
2281 if V < Uint_2 ** 7 then
2282 T := Standard_Integer_8;
2284 elsif V < Uint_2 ** 15 then
2285 T := Standard_Integer_16;
2287 elsif V < Uint_2 ** 31 then
2288 T := Standard_Integer_32;
2290 elsif V < Uint_2 ** 63 then
2291 T := Standard_Integer_64;
2298 L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
2300 L := Make_Integer_Literal (Sloc (N), V);
2303 -- Set type of result in case used elsewhere (see note at start)
2306 Set_Is_Static_Expression (L);
2308 -- We really need to set Analyzed here because we may be creating a
2309 -- very strange beast, namely an integer literal typed as fixed-point
2310 -- and the analyzer won't like that. Probably we should allow the
2311 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2312 -- and teach the analyzer how to handle them ???
2316 end Integer_Literal;
2322 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2326 L := Make_Real_Literal (Sloc (N), V);
2328 -- Set type of result in case used elsewhere (see note at start)
2330 Set_Etype (L, Universal_Real);
2334 ------------------------
2335 -- Rounded_Result_Set --
2336 ------------------------
2338 function Rounded_Result_Set (N : Node_Id) return Boolean is
2339 K : constant Node_Kind := Nkind (N);
2341 if (K = N_Type_Conversion or else
2342 K = N_Op_Divide or else
2345 (Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
2351 end Rounded_Result_Set;
2357 procedure Set_Result
2360 Rchk : Boolean := False)
2364 Expr_Type : constant Entity_Id := Etype (Expr);
2365 Result_Type : constant Entity_Id := Etype (N);
2368 -- No conversion required if types match and no range check
2370 if Result_Type = Expr_Type and then not Rchk then
2373 -- Else perform required conversion
2376 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
2380 Analyze_And_Resolve (N, Result_Type);