1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2007, 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 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. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
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
;
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
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
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
94 Qnn
, Rnn
: out Entity_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
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
136 Qnn
, Rnn
: out Entity_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
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
225 Rchk
: Boolean := False) return Node_Id
227 Loc
: constant Source_Ptr
:= Sloc
(N
);
229 Rcheck
: Boolean := Rchk
;
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
237 if Nkind
(Expr
) = N_Integer_Literal
238 and then Is_Integer_Type
(Typ
)
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.
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
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
269 Make_Type_Conversion
(Loc
,
270 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
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
)))
281 Set_Conversion_OK
(Result
);
284 -- Set Do_Range_Check if either it was requested by the caller,
285 -- or if an eliminated inner conversion had a range check.
288 Enable_Range_Check
(Result
);
290 Set_Do_Range_Check
(Result
, False);
294 Set_Etype
(Result
, Typ
);
296 end Build_Conversion
;
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
;
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
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
330 -- If left and right types are the same, no conversion needed
332 if Left_Type
= Right_Type
then
333 Result_Type
:= Left_Type
;
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
;
346 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
348 -- Otherwise right type is larger of the two, us it
351 Result_Type
:= Right_Type
;
354 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
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
);
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
)
379 Set_Rounded_Result
(Rnode
);
385 -------------------------
386 -- Build_Double_Divide --
387 -------------------------
389 function Build_Double_Divide
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
)));
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
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);
414 Loc
: constant Source_Ptr
:= Sloc
(N
);
420 Build_Double_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
421 Insert_Actions
(N
, Code
);
422 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
424 -- Set type of result in case used elsewhere (see note at start)
426 Set_Etype
(Expr
, Etype
(Qnn
));
428 -- Set result as analyzed (see note at start on build routines)
433 end Build_Double_Divide
;
435 ------------------------------
436 -- Build_Double_Divide_Code --
437 ------------------------------
439 -- If the denominator can be computed in 64-bits, we build
441 -- [Nnn : constant typ := typ (X);
442 -- Dnn : constant typ := typ (Y) * typ (Z)
443 -- Qnn : constant typ := Nnn / Dnn;
444 -- Rnn : constant typ := Nnn / Dnn;
446 -- If the numerator cannot be computed in 64 bits, we build
450 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
452 procedure Build_Double_Divide_Code
455 Qnn
, Rnn
: out Entity_Id
;
458 Loc
: constant Source_Ptr
:= Sloc
(N
);
460 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
461 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
462 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
474 -- Find type that will allow computation of numerator
476 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
479 QR_Typ
:= Standard_Integer_16
;
480 elsif QR_Siz
<= 32 then
481 QR_Typ
:= Standard_Integer_32
;
482 elsif QR_Siz
<= 64 then
483 QR_Typ
:= Standard_Integer_64
;
485 -- For more than 64, bits, we use the 64-bit integer defined in
486 -- Interfaces, so that it can be handled by the runtime routine
489 QR_Typ
:= RTE
(RE_Integer_64
);
492 -- Define quotient and remainder, and set their Etypes, so
493 -- that they can be picked up by Build_xxx routines.
495 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
496 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
498 Set_Etype
(Qnn
, QR_Typ
);
499 Set_Etype
(Rnn
, QR_Typ
);
501 -- Case that we can compute the denominator in 64 bits
505 -- Create temporaries for numerator and denominator and set Etypes,
506 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
508 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
509 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
511 Set_Etype
(Nnn
, QR_Typ
);
512 Set_Etype
(Dnn
, QR_Typ
);
515 Make_Object_Declaration
(Loc
,
516 Defining_Identifier
=> Nnn
,
517 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
518 Constant_Present
=> True,
519 Expression
=> Build_Conversion
(N
, QR_Typ
, X
)),
521 Make_Object_Declaration
(Loc
,
522 Defining_Identifier
=> Dnn
,
523 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
524 Constant_Present
=> True,
527 Build_Conversion
(N
, QR_Typ
, Y
),
528 Build_Conversion
(N
, QR_Typ
, Z
))));
532 New_Occurrence_Of
(Nnn
, Loc
),
533 New_Occurrence_Of
(Dnn
, Loc
));
535 Set_Rounded_Result
(Quo
, Rounded_Result_Set
(N
));
538 Make_Object_Declaration
(Loc
,
539 Defining_Identifier
=> Qnn
,
540 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
541 Constant_Present
=> True,
545 Make_Object_Declaration
(Loc
,
546 Defining_Identifier
=> Rnn
,
547 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
548 Constant_Present
=> True,
551 New_Occurrence_Of
(Nnn
, Loc
),
552 New_Occurrence_Of
(Dnn
, Loc
))));
554 -- Case where denominator does not fit in 64 bits, so we have to
555 -- call the runtime routine to compute the quotient and remainder
558 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
561 Make_Object_Declaration
(Loc
,
562 Defining_Identifier
=> Qnn
,
563 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
565 Make_Object_Declaration
(Loc
,
566 Defining_Identifier
=> Rnn
,
567 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
569 Make_Procedure_Call_Statement
(Loc
,
570 Name
=> New_Occurrence_Of
(RTE
(RE_Double_Divide
), Loc
),
571 Parameter_Associations
=> New_List
(
572 Build_Conversion
(N
, QR_Typ
, X
),
573 Build_Conversion
(N
, QR_Typ
, Y
),
574 Build_Conversion
(N
, QR_Typ
, Z
),
575 New_Occurrence_Of
(Qnn
, Loc
),
576 New_Occurrence_Of
(Rnn
, Loc
),
577 New_Occurrence_Of
(Rnd
, Loc
))));
579 end Build_Double_Divide_Code
;
585 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
586 Loc
: constant Source_Ptr
:= Sloc
(N
);
587 Left_Type
: constant Entity_Id
:= Etype
(L
);
588 Right_Type
: constant Entity_Id
:= Etype
(R
);
592 Result_Type
: Entity_Id
;
596 -- Deal with floating-point case first
598 if Is_Floating_Point_Type
(Left_Type
) then
599 pragma Assert
(Left_Type
= Universal_Real
);
600 pragma Assert
(Right_Type
= Universal_Real
);
602 Result_Type
:= Universal_Real
;
603 Rnode
:= Make_Op_Multiply
(Loc
, L
, R
);
605 -- Integer and fixed-point cases
608 -- An optimization. If the right operand is the literal 1, then we
609 -- can just return the left hand operand. Putting the optimization
610 -- here allows us to omit the check at the call site. Similarly, if
611 -- the left operand is the integer 1 we can return the right operand.
613 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
615 elsif Nkind
(L
) = N_Integer_Literal
and then Intval
(L
) = 1 then
619 -- Otherwise we need to figure out the correct result type size
620 -- First figure out the effective sizes of the operands. Normally
621 -- the effective size of an operand is the RM_Size of the operand.
622 -- But a special case arises with operands whose size is known at
623 -- compile time. In this case, we can use the actual value of the
624 -- operand to get its size if it would fit in 8 or 16 bits.
626 -- Note: if both operands are known at compile time (can that
627 -- happen?) and both were equal to the power of 2, then we would
628 -- be one bit off in this test, so for the left operand, we only
629 -- go up to the power of 2 - 1. This ensures that we do not get
630 -- this anomolous case, and in practice the right operand is by
631 -- far the more likely one to be the constant.
633 Left_Size
:= UI_To_Int
(RM_Size
(Left_Type
));
635 if Compile_Time_Known_Value
(L
) then
637 Val
: constant Uint
:= Expr_Value
(L
);
640 if Val
< Int
'(2 ** 8) then
642 elsif Val < Int'(2 ** 16) then
648 Right_Size
:= UI_To_Int
(RM_Size
(Right_Type
));
650 if Compile_Time_Known_Value
(R
) then
652 Val
: constant Uint
:= Expr_Value
(R
);
655 if Val
<= Int
'(2 ** 8) then
657 elsif Val <= Int'(2 ** 16) then
663 -- Now the result size must be at least twice the longer of
664 -- the two sizes, to accomodate all possible results.
666 Rsize
:= 2 * Int
'Max (Left_Size
, Right_Size
);
669 Result_Type
:= Standard_Integer_8
;
671 elsif Rsize
<= 16 then
672 Result_Type
:= Standard_Integer_16
;
674 elsif Rsize
<= 32 then
675 Result_Type
:= Standard_Integer_32
;
678 Result_Type
:= Standard_Integer_64
;
682 Make_Op_Multiply
(Loc
,
683 Left_Opnd
=> Build_Conversion
(N
, Result_Type
, L
),
684 Right_Opnd
=> Build_Conversion
(N
, Result_Type
, R
));
687 -- We now have a multiply node built with Result_Type set. First
688 -- set Etype of result, as required for all Build_xxx routines
690 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
692 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
693 -- since this is a literal arithmetic operation, to be performed
694 -- by Gigi without any consideration of small values.
696 if Is_Fixed_Point_Type
(Result_Type
) then
697 Set_Treat_Fixed_As_Integer
(Rnode
);
707 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
708 Loc
: constant Source_Ptr
:= Sloc
(N
);
709 Left_Type
: constant Entity_Id
:= Etype
(L
);
710 Right_Type
: constant Entity_Id
:= Etype
(R
);
711 Result_Type
: Entity_Id
;
715 if Left_Type
= Right_Type
then
716 Result_Type
:= Left_Type
;
722 -- If left size is larger, we do the remainder operation using the
723 -- size of the left type (i.e. the larger of the two integer types).
725 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
726 Result_Type
:= Left_Type
;
730 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
732 -- Similarly, if the right size is larger, we do the remainder
733 -- operation using the right type.
736 Result_Type
:= Right_Type
;
739 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
743 -- We now have an N_Op_Rem node built with Result_Type set. First
744 -- set Etype of result, as required for all Build_xxx routines
746 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
748 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
749 -- since this is a literal arithmetic operation, to be performed
750 -- by Gigi without any consideration of small values.
752 if Is_Fixed_Point_Type
(Result_Type
) then
753 Set_Treat_Fixed_As_Integer
(Rnode
);
756 -- One more check. We did the rem operation using the larger of the
757 -- two types, which is reasonable. However, in the case where the
758 -- two types have unequal sizes, it is impossible for the result of
759 -- a remainder operation to be larger than the smaller of the two
760 -- types, so we can put a conversion round the result to keep the
761 -- evolving operation size as small as possible.
763 if Esize
(Left_Type
) >= Esize
(Right_Type
) then
764 Rnode
:= Build_Conversion
(N
, Right_Type
, Rnode
);
765 elsif Esize
(Right_Type
) >= Esize
(Left_Type
) then
766 Rnode
:= Build_Conversion
(N
, Left_Type
, Rnode
);
772 -------------------------
773 -- Build_Scaled_Divide --
774 -------------------------
776 function Build_Scaled_Divide
778 X
, Y
, Z
: Node_Id
) return Node_Id
780 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
781 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
785 -- If numerator fits in 64 bits, we can build the operations directly
786 -- without causing any intermediate overflow, so that's what we do!
788 if Int
'Max (X_Size
, Y_Size
) <= 32 then
790 Build_Divide
(N
, Build_Multiply
(N
, X
, Y
), Z
);
792 -- Otherwise we use the runtime routine
794 -- [Qnn : Integer_64,
796 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
801 Loc
: constant Source_Ptr
:= Sloc
(N
);
807 Build_Scaled_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
808 Insert_Actions
(N
, Code
);
809 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
811 -- Set type of result in case used elsewhere (see note at start)
813 Set_Etype
(Expr
, Etype
(Qnn
));
817 end Build_Scaled_Divide
;
819 ------------------------------
820 -- Build_Scaled_Divide_Code --
821 ------------------------------
823 -- If the numerator can be computed in 64-bits, we build
825 -- [Nnn : constant typ := typ (X) * typ (Y);
826 -- Dnn : constant typ := typ (Z)
827 -- Qnn : constant typ := Nnn / Dnn;
828 -- Rnn : constant typ := Nnn / Dnn;
830 -- If the numerator cannot be computed in 64 bits, we build
832 -- [Qnn : Interfaces.Integer_64;
833 -- Rnn : Interfaces.Integer_64;
834 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
836 procedure Build_Scaled_Divide_Code
839 Qnn
, Rnn
: out Entity_Id
;
842 Loc
: constant Source_Ptr
:= Sloc
(N
);
844 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
845 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
846 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
858 -- Find type that will allow computation of numerator
860 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
863 QR_Typ
:= Standard_Integer_16
;
864 elsif QR_Siz
<= 32 then
865 QR_Typ
:= Standard_Integer_32
;
866 elsif QR_Siz
<= 64 then
867 QR_Typ
:= Standard_Integer_64
;
869 -- For more than 64, bits, we use the 64-bit integer defined in
870 -- Interfaces, so that it can be handled by the runtime routine
873 QR_Typ
:= RTE
(RE_Integer_64
);
876 -- Define quotient and remainder, and set their Etypes, so
877 -- that they can be picked up by Build_xxx routines.
879 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
880 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
882 Set_Etype
(Qnn
, QR_Typ
);
883 Set_Etype
(Rnn
, QR_Typ
);
885 -- Case that we can compute the numerator in 64 bits
888 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
889 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
891 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
893 Set_Etype
(Nnn
, QR_Typ
);
894 Set_Etype
(Dnn
, QR_Typ
);
897 Make_Object_Declaration
(Loc
,
898 Defining_Identifier
=> Nnn
,
899 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
900 Constant_Present
=> True,
903 Build_Conversion
(N
, QR_Typ
, X
),
904 Build_Conversion
(N
, QR_Typ
, Y
))),
906 Make_Object_Declaration
(Loc
,
907 Defining_Identifier
=> Dnn
,
908 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
909 Constant_Present
=> True,
910 Expression
=> Build_Conversion
(N
, QR_Typ
, Z
)));
914 New_Occurrence_Of
(Nnn
, Loc
),
915 New_Occurrence_Of
(Dnn
, Loc
));
918 Make_Object_Declaration
(Loc
,
919 Defining_Identifier
=> Qnn
,
920 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
921 Constant_Present
=> True,
925 Make_Object_Declaration
(Loc
,
926 Defining_Identifier
=> Rnn
,
927 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
928 Constant_Present
=> True,
931 New_Occurrence_Of
(Nnn
, Loc
),
932 New_Occurrence_Of
(Dnn
, Loc
))));
934 -- Case where numerator does not fit in 64 bits, so we have to
935 -- call the runtime routine to compute the quotient and remainder
938 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
941 Make_Object_Declaration
(Loc
,
942 Defining_Identifier
=> Qnn
,
943 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
945 Make_Object_Declaration
(Loc
,
946 Defining_Identifier
=> Rnn
,
947 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
949 Make_Procedure_Call_Statement
(Loc
,
950 Name
=> New_Occurrence_Of
(RTE
(RE_Scaled_Divide
), Loc
),
951 Parameter_Associations
=> New_List
(
952 Build_Conversion
(N
, QR_Typ
, X
),
953 Build_Conversion
(N
, QR_Typ
, Y
),
954 Build_Conversion
(N
, QR_Typ
, Z
),
955 New_Occurrence_Of
(Qnn
, Loc
),
956 New_Occurrence_Of
(Rnn
, Loc
),
957 New_Occurrence_Of
(Rnd
, Loc
))));
960 -- Set type of result, for use in caller
962 Set_Etype
(Qnn
, QR_Typ
);
963 end Build_Scaled_Divide_Code
;
965 ---------------------------
966 -- Do_Divide_Fixed_Fixed --
967 ---------------------------
971 -- (Result_Value * Result_Small) =
972 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
974 -- Result_Value = (Left_Value / Right_Value) *
975 -- (Left_Small / (Right_Small * Result_Small));
977 -- we can do the operation in integer arithmetic if this fraction is an
978 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
979 -- Otherwise the result is in the close result set and our approach is to
980 -- use floating-point to compute this close result.
982 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
) is
983 Left
: constant Node_Id
:= Left_Opnd
(N
);
984 Right
: constant Node_Id
:= Right_Opnd
(N
);
985 Left_Type
: constant Entity_Id
:= Etype
(Left
);
986 Right_Type
: constant Entity_Id
:= Etype
(Right
);
987 Result_Type
: constant Entity_Id
:= Etype
(N
);
988 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
989 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
991 Result_Small
: Ureal
;
998 -- Rounding is required if the result is integral
1000 if Is_Integer_Type
(Result_Type
) then
1001 Set_Rounded_Result
(N
);
1004 -- Get result small. If the result is an integer, treat it as though
1005 -- it had a small of 1.0, all other processing is identical.
1007 if Is_Integer_Type
(Result_Type
) then
1008 Result_Small
:= Ureal_1
;
1010 Result_Small
:= Small_Value
(Result_Type
);
1015 Frac
:= Left_Small
/ (Right_Small
* Result_Small
);
1016 Frac_Num
:= Norm_Num
(Frac
);
1017 Frac_Den
:= Norm_Den
(Frac
);
1019 -- If the fraction is an integer, then we get the result by multiplying
1020 -- the left operand by the integer, and then dividing by the right
1021 -- operand (the order is important, if we did the divide first, we
1022 -- would lose precision).
1024 if Frac_Den
= 1 then
1025 Lit_Int
:= Integer_Literal
(N
, Frac_Num
); -- always positive
1027 if Present
(Lit_Int
) then
1028 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Right
));
1032 -- If the fraction is the reciprocal of an integer, then we get the
1033 -- result by first multiplying the divisor by the integer, and then
1034 -- doing the division with the adjusted divisor.
1036 -- Note: this is much better than doing two divisions: multiplications
1037 -- are much faster than divisions (and certainly faster than rounded
1038 -- divisions), and we don't get inaccuracies from double rounding.
1040 elsif Frac_Num
= 1 then
1041 Lit_Int
:= Integer_Literal
(N
, Frac_Den
); -- always positive
1043 if Present
(Lit_Int
) then
1044 Set_Result
(N
, Build_Double_Divide
(N
, Left
, Right
, Lit_Int
));
1049 -- If we fall through, we use floating-point to compute the result
1053 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1054 Real_Literal
(N
, Frac
)));
1055 end Do_Divide_Fixed_Fixed
;
1057 -------------------------------
1058 -- Do_Divide_Fixed_Universal --
1059 -------------------------------
1063 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1064 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1066 -- The result is required to be in the perfect result set if the literal
1067 -- can be factored so that the resulting small ratio is an integer or the
1068 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1069 -- analysis of these RM requirements:
1071 -- We must factor the literal, finding an integer K:
1073 -- Lit_Value = K * Right_Small
1074 -- Right_Small = Lit_Value / K
1076 -- such that the small ratio:
1079 -- ------------------------------
1080 -- (Lit_Value / K) * Result_Small
1083 -- = ------------------------ * K
1084 -- Lit_Value * Result_Small
1086 -- is an integer or the reciprocal of an integer, and for
1087 -- implementation efficiency we need the smallest such K.
1089 -- First we reduce the left fraction to lowest terms
1091 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1092 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1093 -- Right_Small = Lit_Value.
1095 -- If numerator > 1, then set K to the denominator of the fraction so
1096 -- that the resulting small ratio is an integer (the numerator value).
1098 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
) is
1099 Left
: constant Node_Id
:= Left_Opnd
(N
);
1100 Right
: constant Node_Id
:= Right_Opnd
(N
);
1101 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1102 Result_Type
: constant Entity_Id
:= Etype
(N
);
1103 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1104 Lit_Value
: constant Ureal
:= Realval
(Right
);
1106 Result_Small
: Ureal
;
1114 -- Get result small. If the result is an integer, treat it as though
1115 -- it had a small of 1.0, all other processing is identical.
1117 if Is_Integer_Type
(Result_Type
) then
1118 Result_Small
:= Ureal_1
;
1120 Result_Small
:= Small_Value
(Result_Type
);
1123 -- Determine if literal can be rewritten successfully
1125 Frac
:= Left_Small
/ (Lit_Value
* Result_Small
);
1126 Frac_Num
:= Norm_Num
(Frac
);
1127 Frac_Den
:= Norm_Den
(Frac
);
1129 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1130 -- = denominator). If this integer is not too large, this is the case
1131 -- where the result can be obtained by dividing by this integer value.
1133 if Frac_Num
= 1 then
1134 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1136 if Present
(Lit_Int
) then
1137 Set_Result
(N
, Build_Divide
(N
, Left
, Lit_Int
));
1141 -- Case where we choose K to make fraction an integer (K = denominator
1142 -- of fraction, integer = numerator of fraction). If both K and the
1143 -- numerator are small enough, this is the case where the result can
1144 -- be obtained by first multiplying by the integer value and then
1145 -- dividing by K (the order is important, if we divided first, we
1146 -- would lose precision).
1149 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1150 Lit_K
:= Integer_Literal
(N
, Frac_Den
, False);
1152 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1153 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Lit_K
));
1158 -- Fall through if the literal cannot be successfully rewritten, or if
1159 -- the small ratio is out of range of integer arithmetic. In the former
1160 -- case it is fine to use floating-point to get the close result set,
1161 -- and in the latter case, it means that the result is zero or raises
1162 -- constraint error, and we can do that accurately in floating-point.
1164 -- If we end up using floating-point, then we take the right integer
1165 -- to be one, and its small to be the value of the original right real
1166 -- literal. That way, we need only one floating-point multiplication.
1169 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1170 end Do_Divide_Fixed_Universal
;
1172 -------------------------------
1173 -- Do_Divide_Universal_Fixed --
1174 -------------------------------
1178 -- (Result_Value * Result_Small) =
1179 -- Lit_Value / (Right_Value * Right_Small)
1181 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1183 -- The result is required to be in the perfect result set if the literal
1184 -- can be factored so that the resulting small ratio is an integer or the
1185 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1186 -- analysis of these RM requirements:
1188 -- We must factor the literal, finding an integer K:
1190 -- Lit_Value = K * Left_Small
1191 -- Left_Small = Lit_Value / K
1193 -- such that the small ratio:
1196 -- --------------------------
1197 -- Right_Small * Result_Small
1200 -- = -------------------------- * -
1201 -- Right_Small * Result_Small K
1203 -- is an integer or the reciprocal of an integer, and for
1204 -- implementation efficiency we need the smallest such K.
1206 -- First we reduce the left fraction to lowest terms
1208 -- If denominator = 1, then for K = 1, the small ratio is an integer
1209 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1210 -- and Left_Small = Lit_Value.
1212 -- If denominator > 1, then set K to the numerator of the fraction so
1213 -- that the resulting small ratio is the reciprocal of an integer (the
1214 -- numerator value).
1216 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
) is
1217 Left
: constant Node_Id
:= Left_Opnd
(N
);
1218 Right
: constant Node_Id
:= Right_Opnd
(N
);
1219 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1220 Result_Type
: constant Entity_Id
:= Etype
(N
);
1221 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1222 Lit_Value
: constant Ureal
:= Realval
(Left
);
1224 Result_Small
: Ureal
;
1232 -- Get result small. If the result is an integer, treat it as though
1233 -- it had a small of 1.0, all other processing is identical.
1235 if Is_Integer_Type
(Result_Type
) then
1236 Result_Small
:= Ureal_1
;
1238 Result_Small
:= Small_Value
(Result_Type
);
1241 -- Determine if literal can be rewritten successfully
1243 Frac
:= Lit_Value
/ (Right_Small
* Result_Small
);
1244 Frac_Num
:= Norm_Num
(Frac
);
1245 Frac_Den
:= Norm_Den
(Frac
);
1247 -- Case where fraction is an integer (K = 1, integer = numerator). If
1248 -- this integer is not too large, this is the case where the result
1249 -- can be obtained by dividing this integer by the right operand.
1251 if Frac_Den
= 1 then
1252 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1254 if Present
(Lit_Int
) then
1255 Set_Result
(N
, Build_Divide
(N
, Lit_Int
, Right
));
1259 -- Case where we choose K to make the fraction the reciprocal of an
1260 -- integer (K = numerator of fraction, integer = numerator of fraction).
1261 -- If both K and the integer are small enough, this is the case where
1262 -- the result can be obtained by multiplying the right operand by K
1263 -- and then dividing by the integer value. The order of the operations
1264 -- is important (if we divided first, we would lose precision).
1267 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1268 Lit_K
:= Integer_Literal
(N
, Frac_Num
, False);
1270 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1271 Set_Result
(N
, Build_Double_Divide
(N
, Lit_K
, Right
, Lit_Int
));
1276 -- Fall through if the literal cannot be successfully rewritten, or if
1277 -- the small ratio is out of range of integer arithmetic. In the former
1278 -- case it is fine to use floating-point to get the close result set,
1279 -- and in the latter case, it means that the result is zero or raises
1280 -- constraint error, and we can do that accurately in floating-point.
1282 -- If we end up using floating-point, then we take the right integer
1283 -- to be one, and its small to be the value of the original right real
1284 -- literal. That way, we need only one floating-point division.
1287 Build_Divide
(N
, Real_Literal
(N
, Frac
), Fpt_Value
(Right
)));
1288 end Do_Divide_Universal_Fixed
;
1290 -----------------------------
1291 -- Do_Multiply_Fixed_Fixed --
1292 -----------------------------
1296 -- (Result_Value * Result_Small) =
1297 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1299 -- Result_Value = (Left_Value * Right_Value) *
1300 -- (Left_Small * Right_Small) / Result_Small;
1302 -- we can do the operation in integer arithmetic if this fraction is an
1303 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1304 -- Otherwise the result is in the close result set and our approach is to
1305 -- use floating-point to compute this close result.
1307 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
) is
1308 Left
: constant Node_Id
:= Left_Opnd
(N
);
1309 Right
: constant Node_Id
:= Right_Opnd
(N
);
1311 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1312 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1313 Result_Type
: constant Entity_Id
:= Etype
(N
);
1314 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1315 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1317 Result_Small
: Ureal
;
1324 -- Get result small. If the result is an integer, treat it as though
1325 -- it had a small of 1.0, all other processing is identical.
1327 if Is_Integer_Type
(Result_Type
) then
1328 Result_Small
:= Ureal_1
;
1330 Result_Small
:= Small_Value
(Result_Type
);
1335 Frac
:= (Left_Small
* Right_Small
) / Result_Small
;
1336 Frac_Num
:= Norm_Num
(Frac
);
1337 Frac_Den
:= Norm_Den
(Frac
);
1339 -- If the fraction is an integer, then we get the result by multiplying
1340 -- the operands, and then multiplying the result by the integer value.
1342 if Frac_Den
= 1 then
1343 Lit_Int
:= Integer_Literal
(N
, Frac_Num
); -- always positive
1345 if Present
(Lit_Int
) then
1347 Build_Multiply
(N
, Build_Multiply
(N
, Left
, Right
),
1352 -- If the fraction is the reciprocal of an integer, then we get the
1353 -- result by multiplying the operands, and then dividing the result by
1354 -- the integer value. The order of the operations is important, if we
1355 -- divided first, we would lose precision.
1357 elsif Frac_Num
= 1 then
1358 Lit_Int
:= Integer_Literal
(N
, Frac_Den
); -- always positive
1360 if Present
(Lit_Int
) then
1361 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Right
, Lit_Int
));
1366 -- If we fall through, we use floating-point to compute the result
1370 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1371 Real_Literal
(N
, Frac
)));
1372 end Do_Multiply_Fixed_Fixed
;
1374 ---------------------------------
1375 -- Do_Multiply_Fixed_Universal --
1376 ---------------------------------
1380 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1381 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1383 -- The result is required to be in the perfect result set if the literal
1384 -- can be factored so that the resulting small ratio is an integer or the
1385 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1386 -- analysis of these RM requirements:
1388 -- We must factor the literal, finding an integer K:
1390 -- Lit_Value = K * Right_Small
1391 -- Right_Small = Lit_Value / K
1393 -- such that the small ratio:
1395 -- Left_Small * (Lit_Value / K)
1396 -- ----------------------------
1399 -- Left_Small * Lit_Value 1
1400 -- = ---------------------- * -
1403 -- is an integer or the reciprocal of an integer, and for
1404 -- implementation efficiency we need the smallest such K.
1406 -- First we reduce the left fraction to lowest terms
1408 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1409 -- this is clearly the minimum K case, so set
1411 -- K = 1, Right_Small = Lit_Value
1413 -- If denominator > 1, then set K to the numerator of the fraction, so
1414 -- that the resulting small ratio is the reciprocal of the integer (the
1415 -- denominator value).
1417 procedure Do_Multiply_Fixed_Universal
1419 Left
, Right
: Node_Id
)
1421 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1422 Result_Type
: constant Entity_Id
:= Etype
(N
);
1423 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1424 Lit_Value
: constant Ureal
:= Realval
(Right
);
1426 Result_Small
: Ureal
;
1434 -- Get result small. If the result is an integer, treat it as though
1435 -- it had a small of 1.0, all other processing is identical.
1437 if Is_Integer_Type
(Result_Type
) then
1438 Result_Small
:= Ureal_1
;
1440 Result_Small
:= Small_Value
(Result_Type
);
1443 -- Determine if literal can be rewritten successfully
1445 Frac
:= (Left_Small
* Lit_Value
) / Result_Small
;
1446 Frac_Num
:= Norm_Num
(Frac
);
1447 Frac_Den
:= Norm_Den
(Frac
);
1449 -- Case where fraction is an integer (K = 1, integer = numerator). If
1450 -- this integer is not too large, this is the case where the result can
1451 -- be obtained by multiplying by this integer value.
1453 if Frac_Den
= 1 then
1454 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1456 if Present
(Lit_Int
) then
1457 Set_Result
(N
, Build_Multiply
(N
, Left
, Lit_Int
));
1461 -- Case where we choose K to make fraction the reciprocal of an integer
1462 -- (K = numerator of fraction, integer = denominator of fraction). If
1463 -- both K and the denominator are small enough, this is the case where
1464 -- the result can be obtained by first multiplying by K, and then
1465 -- dividing by the integer value.
1468 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1469 Lit_K
:= Integer_Literal
(N
, Frac_Num
);
1471 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1472 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_K
, Lit_Int
));
1477 -- Fall through if the literal cannot be successfully rewritten, or if
1478 -- the small ratio is out of range of integer arithmetic. In the former
1479 -- case it is fine to use floating-point to get the close result set,
1480 -- and in the latter case, it means that the result is zero or raises
1481 -- constraint error, and we can do that accurately in floating-point.
1483 -- If we end up using floating-point, then we take the right integer
1484 -- to be one, and its small to be the value of the original right real
1485 -- literal. That way, we need only one floating-point multiplication.
1488 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1489 end Do_Multiply_Fixed_Universal
;
1491 ---------------------------------
1492 -- Expand_Convert_Fixed_Static --
1493 ---------------------------------
1495 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
) is
1498 Convert_To
(Etype
(N
),
1499 Make_Real_Literal
(Sloc
(N
), Expr_Value_R
(Expression
(N
)))));
1500 Analyze_And_Resolve
(N
);
1501 end Expand_Convert_Fixed_Static
;
1503 -----------------------------------
1504 -- Expand_Convert_Fixed_To_Fixed --
1505 -----------------------------------
1509 -- Result_Value * Result_Small = Source_Value * Source_Small
1510 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1512 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1513 -- integer, then the perfect result set is obtained by a single integer
1516 -- If the small ratio is the reciprocal of a sufficiently small integer,
1517 -- then the perfect result set is obtained by a single integer division.
1519 -- In other cases, we obtain the close result set by calculating the
1520 -- result in floating-point.
1522 procedure Expand_Convert_Fixed_To_Fixed
(N
: Node_Id
) is
1523 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1524 Expr
: constant Node_Id
:= Expression
(N
);
1525 Result_Type
: constant Entity_Id
:= Etype
(N
);
1526 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1527 Small_Ratio
: Ureal
;
1533 if Is_OK_Static_Expression
(Expr
) then
1534 Expand_Convert_Fixed_Static
(N
);
1538 Small_Ratio
:= Small_Value
(Source_Type
) / Small_Value
(Result_Type
);
1539 Ratio_Num
:= Norm_Num
(Small_Ratio
);
1540 Ratio_Den
:= Norm_Den
(Small_Ratio
);
1542 if Ratio_Den
= 1 then
1543 if Ratio_Num
= 1 then
1544 Set_Result
(N
, Expr
);
1548 Lit
:= Integer_Literal
(N
, Ratio_Num
);
1550 if Present
(Lit
) then
1551 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
));
1556 elsif Ratio_Num
= 1 then
1557 Lit
:= Integer_Literal
(N
, Ratio_Den
);
1559 if Present
(Lit
) then
1560 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1565 -- Fall through to use floating-point for the close result set case
1566 -- either as a result of the small ratio not being an integer or the
1567 -- reciprocal of an integer, or if the integer is out of range.
1572 Real_Literal
(N
, Small_Ratio
)),
1574 end Expand_Convert_Fixed_To_Fixed
;
1576 -----------------------------------
1577 -- Expand_Convert_Fixed_To_Float --
1578 -----------------------------------
1580 -- If the small of the fixed type is 1.0, then we simply convert the
1581 -- integer value directly to the target floating-point type, otherwise
1582 -- we first have to multiply by the small, in Universal_Real, and then
1583 -- convert the result to the target floating-point type.
1585 procedure Expand_Convert_Fixed_To_Float
(N
: Node_Id
) is
1586 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1587 Expr
: constant Node_Id
:= Expression
(N
);
1588 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1589 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1592 if Is_OK_Static_Expression
(Expr
) then
1593 Expand_Convert_Fixed_Static
(N
);
1597 if Small
= Ureal_1
then
1598 Set_Result
(N
, Expr
);
1604 Real_Literal
(N
, Small
)),
1607 end Expand_Convert_Fixed_To_Float
;
1609 -------------------------------------
1610 -- Expand_Convert_Fixed_To_Integer --
1611 -------------------------------------
1615 -- Result_Value = Source_Value * Source_Small
1617 -- If the small value is a sufficiently small integer, then the perfect
1618 -- result set is obtained by a single integer multiplication.
1620 -- If the small value is the reciprocal of a sufficiently small integer,
1621 -- then the perfect result set is obtained by a single integer division.
1623 -- In other cases, we obtain the close result set by calculating the
1624 -- result in floating-point.
1626 procedure Expand_Convert_Fixed_To_Integer
(N
: Node_Id
) is
1627 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1628 Expr
: constant Node_Id
:= Expression
(N
);
1629 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1630 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1631 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1632 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1636 if Is_OK_Static_Expression
(Expr
) then
1637 Expand_Convert_Fixed_Static
(N
);
1641 if Small_Den
= 1 then
1642 Lit
:= Integer_Literal
(N
, Small_Num
);
1644 if Present
(Lit
) then
1645 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1649 elsif Small_Num
= 1 then
1650 Lit
:= Integer_Literal
(N
, Small_Den
);
1652 if Present
(Lit
) then
1653 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1658 -- Fall through to use floating-point for the close result set case
1659 -- either as a result of the small value not being an integer or the
1660 -- reciprocal of an integer, or if the integer is out of range.
1665 Real_Literal
(N
, Small
)),
1667 end Expand_Convert_Fixed_To_Integer
;
1669 -----------------------------------
1670 -- Expand_Convert_Float_To_Fixed --
1671 -----------------------------------
1675 -- Result_Value * Result_Small = Operand_Value
1679 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1681 -- We do the small scaling in floating-point, and we do a multiplication
1682 -- rather than a division, since it is accurate enough for the perfect
1683 -- result cases, and faster.
1685 procedure Expand_Convert_Float_To_Fixed
(N
: Node_Id
) is
1686 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1687 Expr
: constant Node_Id
:= Expression
(N
);
1688 Result_Type
: constant Entity_Id
:= Etype
(N
);
1689 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1692 -- Optimize small = 1, where we can avoid the multiply completely
1694 if Small
= Ureal_1
then
1695 Set_Result
(N
, Expr
, Rng_Check
);
1697 -- Normal case where multiply is required
1703 Real_Literal
(N
, Ureal_1
/ Small
)),
1706 end Expand_Convert_Float_To_Fixed
;
1708 -------------------------------------
1709 -- Expand_Convert_Integer_To_Fixed --
1710 -------------------------------------
1714 -- Result_Value * Result_Small = Operand_Value
1715 -- Result_Value = Operand_Value / Result_Small
1717 -- If the small value is a sufficiently small integer, then the perfect
1718 -- result set is obtained by a single integer division.
1720 -- If the small value is the reciprocal of a sufficiently small integer,
1721 -- the perfect result set is obtained by a single integer multiplication.
1723 -- In other cases, we obtain the close result set by calculating the
1724 -- result in floating-point using a multiplication by the reciprocal
1725 -- of the Result_Small.
1727 procedure Expand_Convert_Integer_To_Fixed
(N
: Node_Id
) is
1728 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1729 Expr
: constant Node_Id
:= Expression
(N
);
1730 Result_Type
: constant Entity_Id
:= Etype
(N
);
1731 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1732 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1733 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1737 if Small_Den
= 1 then
1738 Lit
:= Integer_Literal
(N
, Small_Num
);
1740 if Present
(Lit
) then
1741 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1745 elsif Small_Num
= 1 then
1746 Lit
:= Integer_Literal
(N
, Small_Den
);
1748 if Present
(Lit
) then
1749 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1754 -- Fall through to use floating-point for the close result set case
1755 -- either as a result of the small value not being an integer or the
1756 -- reciprocal of an integer, or if the integer is out of range.
1761 Real_Literal
(N
, Ureal_1
/ Small
)),
1763 end Expand_Convert_Integer_To_Fixed
;
1765 --------------------------------
1766 -- Expand_Decimal_Divide_Call --
1767 --------------------------------
1769 -- We have four operands
1776 -- All of which are decimal types, and which thus have associated
1779 -- Computing the quotient is a similar problem to that faced by the
1780 -- normal fixed-point division, except that it is simpler, because
1781 -- we always have compatible smalls.
1783 -- Quotient = (Dividend / Divisor) * 10**q
1785 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1786 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1788 -- For q >= 0, we compute
1790 -- Numerator := Dividend * 10 ** q
1791 -- Denominator := Divisor
1792 -- Quotient := Numerator / Denominator
1794 -- For q < 0, we compute
1796 -- Numerator := Dividend
1797 -- Denominator := Divisor * 10 ** q
1798 -- Quotient := Numerator / Denominator
1800 -- Both these divisions are done in truncated mode, and the remainder
1801 -- from these divisions is used to compute the result Remainder. This
1802 -- remainder has the effective scale of the numerator of the division,
1804 -- For q >= 0, the remainder scale is Dividend'Scale + q
1805 -- For q < 0, the remainder scale is Dividend'Scale
1807 -- The result Remainder is then computed by a normal truncating decimal
1808 -- conversion from this scale to the scale of the remainder, i.e. by a
1809 -- division or multiplication by the appropriate power of 10.
1811 procedure Expand_Decimal_Divide_Call
(N
: Node_Id
) is
1812 Loc
: constant Source_Ptr
:= Sloc
(N
);
1814 Dividend
: Node_Id
:= First_Actual
(N
);
1815 Divisor
: Node_Id
:= Next_Actual
(Dividend
);
1816 Quotient
: Node_Id
:= Next_Actual
(Divisor
);
1817 Remainder
: Node_Id
:= Next_Actual
(Quotient
);
1819 Dividend_Type
: constant Entity_Id
:= Etype
(Dividend
);
1820 Divisor_Type
: constant Entity_Id
:= Etype
(Divisor
);
1821 Quotient_Type
: constant Entity_Id
:= Etype
(Quotient
);
1822 Remainder_Type
: constant Entity_Id
:= Etype
(Remainder
);
1824 Dividend_Scale
: constant Uint
:= Scale_Value
(Dividend_Type
);
1825 Divisor_Scale
: constant Uint
:= Scale_Value
(Divisor_Type
);
1826 Quotient_Scale
: constant Uint
:= Scale_Value
(Quotient_Type
);
1827 Remainder_Scale
: constant Uint
:= Scale_Value
(Remainder_Type
);
1830 Numerator_Scale
: Uint
;
1834 Computed_Remainder
: Node_Id
;
1835 Adjusted_Remainder
: Node_Id
;
1836 Scale_Adjust
: Uint
;
1839 -- Relocate the operands, since they are now list elements, and we
1840 -- need to reference them separately as operands in the expanded code.
1842 Dividend
:= Relocate_Node
(Dividend
);
1843 Divisor
:= Relocate_Node
(Divisor
);
1844 Quotient
:= Relocate_Node
(Quotient
);
1845 Remainder
:= Relocate_Node
(Remainder
);
1847 -- Now compute Q, the adjustment scale
1849 Q
:= Divisor_Scale
+ Quotient_Scale
- Dividend_Scale
;
1851 -- If Q is non-negative then we need a scaled divide
1854 Build_Scaled_Divide_Code
1857 Integer_Literal
(N
, Uint_10
** Q
),
1861 Numerator_Scale
:= Dividend_Scale
+ Q
;
1863 -- If Q is negative, then we need a double divide
1866 Build_Double_Divide_Code
1870 Integer_Literal
(N
, Uint_10
** (-Q
)),
1873 Numerator_Scale
:= Dividend_Scale
;
1876 -- Add statement to set quotient value
1878 -- Quotient := quotient-type!(Qnn);
1881 Make_Assignment_Statement
(Loc
,
1884 Unchecked_Convert_To
(Quotient_Type
,
1885 Build_Conversion
(N
, Quotient_Type
,
1886 New_Occurrence_Of
(Qnn
, Loc
)))));
1888 -- Now we need to deal with computing and setting the remainder. The
1889 -- scale of the remainder is in Numerator_Scale, and the desired
1890 -- scale is the scale of the given Remainder argument. There are
1893 -- Numerator_Scale > Remainder_Scale
1895 -- in this case, there are extra digits in the computed remainder
1896 -- which must be eliminated by an extra division:
1898 -- computed-remainder := Numerator rem Denominator
1899 -- scale_adjust = Numerator_Scale - Remainder_Scale
1900 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1902 -- Numerator_Scale = Remainder_Scale
1904 -- in this case, the we have the remainder we need
1906 -- computed-remainder := Numerator rem Denominator
1907 -- adjusted-remainder := computed-remainder
1909 -- Numerator_Scale < Remainder_Scale
1911 -- in this case, we have insufficient digits in the computed
1912 -- remainder, which must be eliminated by an extra multiply
1914 -- computed-remainder := Numerator rem Denominator
1915 -- scale_adjust = Remainder_Scale - Numerator_Scale
1916 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1918 -- Finally we assign the adjusted-remainder to the result Remainder
1919 -- with conversions to get the proper fixed-point type representation.
1921 Computed_Remainder
:= New_Occurrence_Of
(Rnn
, Loc
);
1923 if Numerator_Scale
> Remainder_Scale
then
1924 Scale_Adjust
:= Numerator_Scale
- Remainder_Scale
;
1925 Adjusted_Remainder
:=
1927 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1929 elsif Numerator_Scale
= Remainder_Scale
then
1930 Adjusted_Remainder
:= Computed_Remainder
;
1932 else -- Numerator_Scale < Remainder_Scale
1933 Scale_Adjust
:= Remainder_Scale
- Numerator_Scale
;
1934 Adjusted_Remainder
:=
1936 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1939 -- Assignment of remainder result
1942 Make_Assignment_Statement
(Loc
,
1945 Unchecked_Convert_To
(Remainder_Type
, Adjusted_Remainder
)));
1947 -- Final step is to rewrite the call with a block containing the
1948 -- above sequence of constructed statements for the divide operation.
1951 Make_Block_Statement
(Loc
,
1952 Handled_Statement_Sequence
=>
1953 Make_Handled_Sequence_Of_Statements
(Loc
,
1954 Statements
=> Stmts
)));
1957 end Expand_Decimal_Divide_Call
;
1959 -----------------------------------------------
1960 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1961 -----------------------------------------------
1963 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
1964 Left
: constant Node_Id
:= Left_Opnd
(N
);
1965 Right
: constant Node_Id
:= Right_Opnd
(N
);
1968 -- Suppress expansion of a fixed-by-fixed division if the
1969 -- operation is supported directly by the target.
1971 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
1975 if Etype
(Left
) = Universal_Real
then
1976 Do_Divide_Universal_Fixed
(N
);
1978 elsif Etype
(Right
) = Universal_Real
then
1979 Do_Divide_Fixed_Universal
(N
);
1982 Do_Divide_Fixed_Fixed
(N
);
1984 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed
;
1986 -----------------------------------------------
1987 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1988 -----------------------------------------------
1990 -- The division is done in Universal_Real, and the result is multiplied
1991 -- by the small ratio, which is Small (Right) / Small (Left). Special
1992 -- treatment is required for universal operands, which represent their
1993 -- own value and do not require conversion.
1995 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
1996 Left
: constant Node_Id
:= Left_Opnd
(N
);
1997 Right
: constant Node_Id
:= Right_Opnd
(N
);
1999 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2000 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2003 -- Case of left operand is universal real, the result we want is:
2005 -- Left_Value / (Right_Value * Right_Small)
2007 -- so we compute this as:
2009 -- (Left_Value / Right_Small) / Right_Value
2011 if Left_Type
= Universal_Real
then
2014 Real_Literal
(N
, Realval
(Left
) / Small_Value
(Right_Type
)),
2015 Fpt_Value
(Right
)));
2017 -- Case of right operand is universal real, the result we want is
2019 -- (Left_Value * Left_Small) / Right_Value
2021 -- so we compute this as:
2023 -- Left_Value * (Left_Small / Right_Value)
2025 -- Note we invert to a multiplication since usually floating-point
2026 -- multiplication is much faster than floating-point division.
2028 elsif Right_Type
= Universal_Real
then
2032 Real_Literal
(N
, Small_Value
(Left_Type
) / Realval
(Right
))));
2034 -- Both operands are fixed, so the value we want is
2036 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2038 -- which we compute as:
2040 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2045 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2047 Small_Value
(Left_Type
) / Small_Value
(Right_Type
))));
2049 end Expand_Divide_Fixed_By_Fixed_Giving_Float
;
2051 -------------------------------------------------
2052 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2053 -------------------------------------------------
2055 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2056 Left
: constant Node_Id
:= Left_Opnd
(N
);
2057 Right
: constant Node_Id
:= Right_Opnd
(N
);
2059 if Etype
(Left
) = Universal_Real
then
2060 Do_Divide_Universal_Fixed
(N
);
2061 elsif Etype
(Right
) = Universal_Real
then
2062 Do_Divide_Fixed_Universal
(N
);
2064 Do_Divide_Fixed_Fixed
(N
);
2066 end Expand_Divide_Fixed_By_Fixed_Giving_Integer
;
2068 -------------------------------------------------
2069 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2070 -------------------------------------------------
2072 -- Since the operand and result fixed-point type is the same, this is
2073 -- a straight divide by the right operand, the small can be ignored.
2075 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2076 Left
: constant Node_Id
:= Left_Opnd
(N
);
2077 Right
: constant Node_Id
:= Right_Opnd
(N
);
2079 Set_Result
(N
, Build_Divide
(N
, Left
, Right
));
2080 end Expand_Divide_Fixed_By_Integer_Giving_Fixed
;
2082 -------------------------------------------------
2083 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2084 -------------------------------------------------
2086 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2087 Left
: constant Node_Id
:= Left_Opnd
(N
);
2088 Right
: constant Node_Id
:= Right_Opnd
(N
);
2090 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
);
2091 -- The operand may be a non-static universal value, such an
2092 -- exponentiation with a non-static exponent. In that case, treat
2093 -- as a fixed * fixed multiplication, and convert the argument to
2094 -- the target fixed type.
2096 ----------------------------------
2097 -- Rewrite_Non_Static_Universal --
2098 ----------------------------------
2100 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
) is
2101 Loc
: constant Source_Ptr
:= Sloc
(N
);
2104 Make_Type_Conversion
(Loc
,
2105 Subtype_Mark
=> New_Occurrence_Of
(Etype
(N
), Loc
),
2106 Expression
=> Expression
(Opnd
)));
2107 Analyze_And_Resolve
(Opnd
, Etype
(N
));
2108 end Rewrite_Non_Static_Universal
;
2110 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2113 -- Suppress expansion of a fixed-by-fixed multiplication if the
2114 -- operation is supported directly by the target.
2116 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
2120 if Etype
(Left
) = Universal_Real
then
2121 if Nkind
(Left
) = N_Real_Literal
then
2122 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2124 elsif Nkind
(Left
) = N_Type_Conversion
then
2125 Rewrite_Non_Static_Universal
(Left
);
2126 Do_Multiply_Fixed_Fixed
(N
);
2129 elsif Etype
(Right
) = Universal_Real
then
2130 if Nkind
(Right
) = N_Real_Literal
then
2131 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2133 elsif Nkind
(Right
) = N_Type_Conversion
then
2134 Rewrite_Non_Static_Universal
(Right
);
2135 Do_Multiply_Fixed_Fixed
(N
);
2139 Do_Multiply_Fixed_Fixed
(N
);
2141 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
;
2143 -------------------------------------------------
2144 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2145 -------------------------------------------------
2147 -- The multiply is done in Universal_Real, and the result is multiplied
2148 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2149 -- Special treatment is required for universal operands.
2151 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2152 Left
: constant Node_Id
:= Left_Opnd
(N
);
2153 Right
: constant Node_Id
:= Right_Opnd
(N
);
2155 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2156 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2159 -- Case of left operand is universal real, the result we want is
2161 -- Left_Value * (Right_Value * Right_Small)
2163 -- so we compute this as:
2165 -- (Left_Value * Right_Small) * Right_Value;
2167 if Left_Type
= Universal_Real
then
2170 Real_Literal
(N
, Realval
(Left
) * Small_Value
(Right_Type
)),
2171 Fpt_Value
(Right
)));
2173 -- Case of right operand is universal real, the result we want is
2175 -- (Left_Value * Left_Small) * Right_Value
2177 -- so we compute this as:
2179 -- Left_Value * (Left_Small * Right_Value)
2181 elsif Right_Type
= Universal_Real
then
2185 Real_Literal
(N
, Small_Value
(Left_Type
) * Realval
(Right
))));
2187 -- Both operands are fixed, so the value we want is
2189 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2191 -- which we compute as:
2193 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2198 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2200 Small_Value
(Right_Type
) * Small_Value
(Left_Type
))));
2202 end Expand_Multiply_Fixed_By_Fixed_Giving_Float
;
2204 ---------------------------------------------------
2205 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2206 ---------------------------------------------------
2208 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2209 Left
: constant Node_Id
:= Left_Opnd
(N
);
2210 Right
: constant Node_Id
:= Right_Opnd
(N
);
2212 if Etype
(Left
) = Universal_Real
then
2213 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2214 elsif Etype
(Right
) = Universal_Real
then
2215 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2217 Do_Multiply_Fixed_Fixed
(N
);
2219 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer
;
2221 ---------------------------------------------------
2222 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2223 ---------------------------------------------------
2225 -- Since the operand and result fixed-point type is the same, this is
2226 -- a straight multiply by the right operand, the small can be ignored.
2228 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2231 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2232 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed
;
2234 ---------------------------------------------------
2235 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2236 ---------------------------------------------------
2238 -- Since the operand and result fixed-point type is the same, this is
2239 -- a straight multiply by the right operand, the small can be ignored.
2241 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2244 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2245 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed
;
2251 function Fpt_Value
(N
: Node_Id
) return Node_Id
is
2252 Typ
: constant Entity_Id
:= Etype
(N
);
2255 if Is_Integer_Type
(Typ
)
2256 or else Is_Floating_Point_Type
(Typ
)
2258 return Build_Conversion
(N
, Universal_Real
, N
);
2260 -- Fixed-point case, must get integer value first
2263 return Build_Conversion
(N
, Universal_Real
, N
);
2267 ---------------------
2268 -- Integer_Literal --
2269 ---------------------
2271 function Integer_Literal
2274 Negative
: Boolean := False) return Node_Id
2280 if V
< Uint_2
** 7 then
2281 T
:= Standard_Integer_8
;
2283 elsif V
< Uint_2
** 15 then
2284 T
:= Standard_Integer_16
;
2286 elsif V
< Uint_2
** 31 then
2287 T
:= Standard_Integer_32
;
2289 elsif V
< Uint_2
** 63 then
2290 T
:= Standard_Integer_64
;
2297 L
:= Make_Integer_Literal
(Sloc
(N
), UI_Negate
(V
));
2299 L
:= Make_Integer_Literal
(Sloc
(N
), V
);
2302 -- Set type of result in case used elsewhere (see note at start)
2305 Set_Is_Static_Expression
(L
);
2307 -- We really need to set Analyzed here because we may be creating a
2308 -- very strange beast, namely an integer literal typed as fixed-point
2309 -- and the analyzer won't like that. Probably we should allow the
2310 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2311 -- and teach the analyzer how to handle them ???
2315 end Integer_Literal
;
2321 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
is
2325 L
:= Make_Real_Literal
(Sloc
(N
), V
);
2327 -- Set type of result in case used elsewhere (see note at start)
2329 Set_Etype
(L
, Universal_Real
);
2333 ------------------------
2334 -- Rounded_Result_Set --
2335 ------------------------
2337 function Rounded_Result_Set
(N
: Node_Id
) return Boolean is
2338 K
: constant Node_Kind
:= Nkind
(N
);
2340 if (K
= N_Type_Conversion
or else
2341 K
= N_Op_Divide
or else
2344 (Rounded_Result
(N
) or else Is_Integer_Type
(Etype
(N
)))
2350 end Rounded_Result_Set
;
2356 procedure Set_Result
2359 Rchk
: Boolean := False)
2363 Expr_Type
: constant Entity_Id
:= Etype
(Expr
);
2364 Result_Type
: constant Entity_Id
:= Etype
(N
);
2367 -- No conversion required if types match and no range check
2369 if Result_Type
= Expr_Type
and then not Rchk
then
2372 -- Else perform required conversion
2375 Cnode
:= Build_Conversion
(N
, Result_Type
, Expr
, Rchk
);
2379 Analyze_And_Resolve
(N
, Result_Type
);