1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2004 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, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, 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)
66 -- Build an expression that converts the expression Expr to type Typ,
67 -- taking the source location from Sloc (N). If the conversions involve
68 -- fixed-point types, then the Conversion_OK flag will be set so that the
69 -- resulting conversions do not get re-expanded. On return the resulting
70 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
71 -- in the resulting conversion node.
73 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
74 -- Builds an N_Op_Divide node from the given left and right operand
75 -- expressions, using the source location from Sloc (N). The operands
76 -- are either both Long_Long_Float, in which case Build_Divide differs
77 -- from Make_Op_Divide only in that the Etype of the resulting node is
78 -- set (to Long_Long_Float), or they can be integer types. In this case
79 -- the integer types need not be the same, and Build_Divide converts
80 -- the operand with the smaller sized type to match the type of the
81 -- other operand and sets this as the result type. The Rounded_Result
82 -- flag of the result in this case is set from the Rounded_Result flag
83 -- of node N. On return, the resulting node is analyzed, and has its
86 function Build_Double_Divide
90 -- Returns a node corresponding to the value X/(Y*Z) using the source
91 -- location from Sloc (N). The division is rounded if the Rounded_Result
92 -- flag of N is set. The integer types of X, Y, Z may be different. On
93 -- return the resulting node is analyzed, and has its Etype set.
95 procedure Build_Double_Divide_Code
98 Qnn
, Rnn
: out Entity_Id
;
100 -- Generates a sequence of code for determining the quotient and remainder
101 -- of the division X/(Y*Z), using the source location from Sloc (N).
102 -- Entities of appropriate types are allocated for the quotient and
103 -- remainder and returned in Qnn and Rnn. The result is rounded if
104 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
105 -- are appropriately set on return.
107 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
108 -- Builds an N_Op_Multiply node from the given left and right operand
109 -- expressions, using the source location from Sloc (N). The operands
110 -- are either both Long_Long_Float, in which case Build_Divide differs
111 -- from Make_Op_Multiply only in that the Etype of the resulting node is
112 -- set (to Long_Long_Float), or they can be integer types. In this case
113 -- the integer types need not be the same, and Build_Multiply chooses
114 -- a type long enough to hold the product (i.e. twice the size of the
115 -- longer of the two operand types), and both operands are converted
116 -- to this type. The Etype of the result is also set to this value.
117 -- However, the result can never overflow Integer_64, so this is the
118 -- largest type that is ever generated. On return, the resulting node
119 -- is analyzed and has its Etype set.
121 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
122 -- Builds an N_Op_Rem node from the given left and right operand
123 -- expressions, using the source location from Sloc (N). The operands
124 -- are both integer types, which need not be the same. Build_Rem
125 -- converts the operand with the smaller sized type to match the type
126 -- of the other operand and sets this as the result type. The result
127 -- is never rounded (rem operations cannot be rounded in any case!)
128 -- On return, the resulting node is analyzed and has its Etype set.
130 function Build_Scaled_Divide
134 -- Returns a node corresponding to the value X*Y/Z using the source
135 -- location from Sloc (N). The division is rounded if the Rounded_Result
136 -- flag of N is set. The integer types of X, Y, Z may be different. On
137 -- return the resulting node is analyzed and has is Etype set.
139 procedure Build_Scaled_Divide_Code
142 Qnn
, Rnn
: out Entity_Id
;
144 -- Generates a sequence of code for determining the quotient and remainder
145 -- of the division X*Y/Z, using the source location from Sloc (N). Entities
146 -- of appropriate types are allocated for the quotient and remainder and
147 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
148 -- The division is rounded if the Rounded_Result flag of N is set. The
149 -- Etype fields of Qnn and Rnn are appropriately set on return.
151 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
);
152 -- Handles expansion of divide for case of two fixed-point operands
153 -- (neither of them universal), with an integer or fixed-point result.
154 -- N is the N_Op_Divide node to be expanded.
156 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
);
157 -- Handles expansion of divide for case of a fixed-point operand divided
158 -- by a universal real operand, with an integer or fixed-point result. N
159 -- is the N_Op_Divide node to be expanded.
161 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
);
162 -- Handles expansion of divide for case of a universal real operand
163 -- divided by a fixed-point operand, with an integer or fixed-point
164 -- result. N is the N_Op_Divide node to be expanded.
166 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
);
167 -- Handles expansion of multiply for case of two fixed-point operands
168 -- (neither of them universal), with an integer or fixed-point result.
169 -- N is the N_Op_Multiply node to be expanded.
171 procedure Do_Multiply_Fixed_Universal
(N
: Node_Id
; Left
, Right
: Node_Id
);
172 -- Handles expansion of multiply for case of a fixed-point operand
173 -- multiplied by a universal real operand, with an integer or fixed-
174 -- point result. N is the N_Op_Multiply node to be expanded, and
175 -- Left, Right are the operands (which may have been switched).
177 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
);
178 -- This routine is called where the node N is a conversion of a literal
179 -- or other static expression of a fixed-point type to some other type.
180 -- In such cases, we simply rewrite the operand as a real literal and
181 -- reanalyze. This avoids problems which would otherwise result from
182 -- attempting to build and fold expressions involving constants.
184 function Fpt_Value
(N
: Node_Id
) return Node_Id
;
185 -- Given an operand of fixed-point operation, return an expression that
186 -- represents the corresponding Long_Long_Float value. The expression
187 -- can be of integer type, floating-point type, or fixed-point type.
188 -- The expression returned is neither analyzed and resolved. The Etype
189 -- of the result is properly set (to Long_Long_Float).
191 function Integer_Literal
(N
: Node_Id
; V
: Uint
) return Node_Id
;
192 -- Given a non-negative universal integer value, build a typed integer
193 -- literal node, using the smallest applicable standard integer type. If
194 -- the value exceeds 2**63-1, the largest value allowed for perfect result
195 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
196 -- node N provides the Sloc value for the constructed literal. The Etype
197 -- of the resulting literal is correctly set, and it is marked as analyzed.
199 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
;
200 -- Build a real literal node from the given value, the Etype of the
201 -- returned node is set to Long_Long_Float, since all floating-point
202 -- arithmetic operations that we construct use Long_Long_Float
204 function Rounded_Result_Set
(N
: Node_Id
) return Boolean;
205 -- Returns True if N is a node that contains the Rounded_Result flag
206 -- and if the flag is true.
208 procedure Set_Result
(N
: Node_Id
; Expr
: Node_Id
; Rchk
: Boolean := False);
209 -- N is the node for the current conversion, division or multiplication
210 -- operation, and Expr is an expression representing the result. Expr
211 -- may be of floating-point or integer type. If the operation result
212 -- is fixed-point, then the value of Expr is in units of small of the
213 -- result type (i.e. small's have already been dealt with). The result
214 -- of the call is to replace N by an appropriate conversion to the
215 -- result type, dealing with rounding for the decimal types case. The
216 -- node is then analyzed and resolved using the result type. If Rchk
217 -- is True, then Do_Range_Check is set in the resulting conversion.
219 ----------------------
220 -- Build_Conversion --
221 ----------------------
223 function Build_Conversion
227 Rchk
: Boolean := False)
230 Loc
: constant Source_Ptr
:= Sloc
(N
);
232 Rcheck
: Boolean := Rchk
;
235 -- A special case, if the expression is an integer literal and the
236 -- target type is an integer type, then just retype the integer
237 -- literal to the desired target type. Don't do this if we need
240 if Nkind
(Expr
) = N_Integer_Literal
241 and then Is_Integer_Type
(Typ
)
246 -- Cases where we end up with a conversion. Note that we do not use the
247 -- Convert_To abstraction here, since we may be decorating the resulting
248 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
249 -- conversion node present, even if it appears to be redundant.
252 -- Remove inner conversion if both inner and outer conversions are
253 -- to integer types, since the inner one serves no purpose (except
254 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
255 -- and also we preserve the range check flag on the inner operand
257 if Is_Integer_Type
(Typ
)
258 and then Is_Integer_Type
(Etype
(Expr
))
259 and then Nkind
(Expr
) = N_Type_Conversion
262 Make_Type_Conversion
(Loc
,
263 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
264 Expression
=> Expression
(Expr
));
265 Set_Rounded_Result
(Result
, Rounded_Result_Set
(Expr
));
266 Rcheck
:= Rcheck
or Do_Range_Check
(Expr
);
268 -- For all other cases, a simple type conversion will work
272 Make_Type_Conversion
(Loc
,
273 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
277 -- Set Conversion_OK if either result or expression type is a
278 -- fixed-point type, since from a semantic point of view, we are
279 -- treating fixed-point values as integers at this stage.
281 if Is_Fixed_Point_Type
(Typ
)
282 or else Is_Fixed_Point_Type
(Etype
(Expression
(Result
)))
284 Set_Conversion_OK
(Result
);
287 -- Set Do_Range_Check if either it was requested by the caller,
288 -- or if an eliminated inner conversion had a range check.
291 Enable_Range_Check
(Result
);
293 Set_Do_Range_Check
(Result
, False);
297 Set_Etype
(Result
, Typ
);
300 end Build_Conversion
;
306 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
307 Loc
: constant Source_Ptr
:= Sloc
(N
);
308 Left_Type
: constant Entity_Id
:= Base_Type
(Etype
(L
));
309 Right_Type
: constant Entity_Id
:= Base_Type
(Etype
(R
));
310 Result_Type
: Entity_Id
;
314 -- Deal with floating-point case first
316 if Is_Floating_Point_Type
(Left_Type
) then
317 pragma Assert
(Left_Type
= Standard_Long_Long_Float
);
318 pragma Assert
(Right_Type
= Standard_Long_Long_Float
);
320 Rnode
:= Make_Op_Divide
(Loc
, L
, R
);
321 Result_Type
:= Standard_Long_Long_Float
;
323 -- Integer and fixed-point cases
326 -- An optimization. If the right operand is the literal 1, then we
327 -- can just return the left hand operand. Putting the optimization
328 -- here allows us to omit the check at the call site.
330 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
334 -- If left and right types are the same, no conversion needed
336 if Left_Type
= Right_Type
then
337 Result_Type
:= Left_Type
;
343 -- Use left type if it is the larger of the two
345 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
346 Result_Type
:= Left_Type
;
350 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
352 -- Otherwise right type is larger of the two, us it
355 Result_Type
:= Right_Type
;
358 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
363 -- We now have a divide node built with Result_Type set. First
364 -- set Etype of result, as required for all Build_xxx routines
366 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
368 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
369 -- since this is a literal arithmetic operation, to be performed
370 -- by Gigi without any consideration of small values.
372 if Is_Fixed_Point_Type
(Result_Type
) then
373 Set_Treat_Fixed_As_Integer
(Rnode
);
376 -- The result is rounded if the target of the operation is decimal
377 -- and Rounded_Result is set, or if the target of the operation
378 -- is an integer type.
380 if Is_Integer_Type
(Etype
(N
))
381 or else Rounded_Result_Set
(N
)
383 Set_Rounded_Result
(Rnode
);
390 -------------------------
391 -- Build_Double_Divide --
392 -------------------------
394 function Build_Double_Divide
399 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
400 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
404 -- If denominator fits in 64 bits, we can build the operations directly
405 -- without causing any intermediate overflow, so that's what we do!
407 if Int
'Max (Y_Size
, Z_Size
) <= 32 then
409 Build_Divide
(N
, X
, Build_Multiply
(N
, Y
, Z
));
411 -- Otherwise we use the runtime routine
413 -- [Qnn : Interfaces.Integer_64,
414 -- Rnn : Interfaces.Integer_64;
415 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
420 Loc
: constant Source_Ptr
:= Sloc
(N
);
426 Build_Double_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
427 Insert_Actions
(N
, Code
);
428 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
430 -- Set type of result in case used elsewhere (see note at start)
432 Set_Etype
(Expr
, Etype
(Qnn
));
434 -- Set result as analyzed (see note at start on build routines)
439 end Build_Double_Divide
;
441 ------------------------------
442 -- Build_Double_Divide_Code --
443 ------------------------------
445 -- If the denominator can be computed in 64-bits, we build
447 -- [Nnn : constant typ := typ (X);
448 -- Dnn : constant typ := typ (Y) * typ (Z)
449 -- Qnn : constant typ := Nnn / Dnn;
450 -- Rnn : constant typ := Nnn / Dnn;
452 -- If the numerator cannot be computed in 64 bits, we build
456 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
458 procedure Build_Double_Divide_Code
461 Qnn
, Rnn
: out Entity_Id
;
464 Loc
: constant Source_Ptr
:= Sloc
(N
);
466 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
467 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
468 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
480 -- Find type that will allow computation of numerator
482 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
485 QR_Typ
:= Standard_Integer_16
;
486 elsif QR_Siz
<= 32 then
487 QR_Typ
:= Standard_Integer_32
;
488 elsif QR_Siz
<= 64 then
489 QR_Typ
:= Standard_Integer_64
;
491 -- For more than 64, bits, we use the 64-bit integer defined in
492 -- Interfaces, so that it can be handled by the runtime routine
495 QR_Typ
:= RTE
(RE_Integer_64
);
498 -- Define quotient and remainder, and set their Etypes, so
499 -- that they can be picked up by Build_xxx routines.
501 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
502 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
504 Set_Etype
(Qnn
, QR_Typ
);
505 Set_Etype
(Rnn
, QR_Typ
);
507 -- Case that we can compute the denominator in 64 bits
511 -- Create temporaries for numerator and denominator and set Etypes,
512 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
514 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
515 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
517 Set_Etype
(Nnn
, QR_Typ
);
518 Set_Etype
(Dnn
, QR_Typ
);
521 Make_Object_Declaration
(Loc
,
522 Defining_Identifier
=> Nnn
,
523 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
524 Constant_Present
=> True,
525 Expression
=> Build_Conversion
(N
, QR_Typ
, X
)),
527 Make_Object_Declaration
(Loc
,
528 Defining_Identifier
=> Dnn
,
529 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
530 Constant_Present
=> True,
533 Build_Conversion
(N
, QR_Typ
, Y
),
534 Build_Conversion
(N
, QR_Typ
, Z
))));
538 New_Occurrence_Of
(Nnn
, Loc
),
539 New_Occurrence_Of
(Dnn
, Loc
));
541 Set_Rounded_Result
(Quo
, Rounded_Result_Set
(N
));
544 Make_Object_Declaration
(Loc
,
545 Defining_Identifier
=> Qnn
,
546 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
547 Constant_Present
=> True,
551 Make_Object_Declaration
(Loc
,
552 Defining_Identifier
=> Rnn
,
553 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
554 Constant_Present
=> True,
557 New_Occurrence_Of
(Nnn
, Loc
),
558 New_Occurrence_Of
(Dnn
, Loc
))));
560 -- Case where denominator does not fit in 64 bits, so we have to
561 -- call the runtime routine to compute the quotient and remainder
564 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
567 Make_Object_Declaration
(Loc
,
568 Defining_Identifier
=> Qnn
,
569 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
571 Make_Object_Declaration
(Loc
,
572 Defining_Identifier
=> Rnn
,
573 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
575 Make_Procedure_Call_Statement
(Loc
,
576 Name
=> New_Occurrence_Of
(RTE
(RE_Double_Divide
), Loc
),
577 Parameter_Associations
=> New_List
(
578 Build_Conversion
(N
, QR_Typ
, X
),
579 Build_Conversion
(N
, QR_Typ
, Y
),
580 Build_Conversion
(N
, QR_Typ
, Z
),
581 New_Occurrence_Of
(Qnn
, Loc
),
582 New_Occurrence_Of
(Rnn
, Loc
),
583 New_Occurrence_Of
(Rnd
, Loc
))));
586 end Build_Double_Divide_Code
;
592 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
593 Loc
: constant Source_Ptr
:= Sloc
(N
);
594 Left_Type
: constant Entity_Id
:= Etype
(L
);
595 Right_Type
: constant Entity_Id
:= Etype
(R
);
599 Result_Type
: Entity_Id
;
603 -- Deal with floating-point case first
605 if Is_Floating_Point_Type
(Left_Type
) then
606 pragma Assert
(Left_Type
= Standard_Long_Long_Float
);
607 pragma Assert
(Right_Type
= Standard_Long_Long_Float
);
609 Result_Type
:= Standard_Long_Long_Float
;
610 Rnode
:= Make_Op_Multiply
(Loc
, L
, R
);
612 -- Integer and fixed-point cases
615 -- An optimization. If the right operand is the literal 1, then we
616 -- can just return the left hand operand. Putting the optimization
617 -- here allows us to omit the check at the call site. Similarly, if
618 -- the left operand is the integer 1 we can return the right operand.
620 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
622 elsif Nkind
(L
) = N_Integer_Literal
and then Intval
(L
) = 1 then
626 -- Otherwise we need to figure out the correct result type size
627 -- First figure out the effective sizes of the operands. Normally
628 -- the effective size of an operand is the RM_Size of the operand.
629 -- But a special case arises with operands whose size is known at
630 -- compile time. In this case, we can use the actual value of the
631 -- operand to get its size if it would fit in 8 or 16 bits.
633 -- Note: if both operands are known at compile time (can that
634 -- happen?) and both were equal to the power of 2, then we would
635 -- be one bit off in this test, so for the left operand, we only
636 -- go up to the power of 2 - 1. This ensures that we do not get
637 -- this anomolous case, and in practice the right operand is by
638 -- far the more likely one to be the constant.
640 Left_Size
:= UI_To_Int
(RM_Size
(Left_Type
));
642 if Compile_Time_Known_Value
(L
) then
644 Val
: constant Uint
:= Expr_Value
(L
);
647 if Val
< Int
'(2 ** 8) then
649 elsif Val < Int'(2 ** 16) then
655 Right_Size
:= UI_To_Int
(RM_Size
(Right_Type
));
657 if Compile_Time_Known_Value
(R
) then
659 Val
: constant Uint
:= Expr_Value
(R
);
662 if Val
<= Int
'(2 ** 8) then
664 elsif Val <= Int'(2 ** 16) then
670 -- Now the result size must be at least twice the longer of
671 -- the two sizes, to accomodate all possible results.
673 Rsize
:= 2 * Int
'Max (Left_Size
, Right_Size
);
676 Result_Type
:= Standard_Integer_8
;
678 elsif Rsize
<= 16 then
679 Result_Type
:= Standard_Integer_16
;
681 elsif Rsize
<= 32 then
682 Result_Type
:= Standard_Integer_32
;
685 Result_Type
:= Standard_Integer_64
;
689 Make_Op_Multiply
(Loc
,
690 Left_Opnd
=> Build_Conversion
(N
, Result_Type
, L
),
691 Right_Opnd
=> Build_Conversion
(N
, Result_Type
, R
));
694 -- We now have a multiply node built with Result_Type set. First
695 -- set Etype of result, as required for all Build_xxx routines
697 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
699 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
700 -- since this is a literal arithmetic operation, to be performed
701 -- by Gigi without any consideration of small values.
703 if Is_Fixed_Point_Type
(Result_Type
) then
704 Set_Treat_Fixed_As_Integer
(Rnode
);
714 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
715 Loc
: constant Source_Ptr
:= Sloc
(N
);
716 Left_Type
: constant Entity_Id
:= Etype
(L
);
717 Right_Type
: constant Entity_Id
:= Etype
(R
);
718 Result_Type
: Entity_Id
;
722 if Left_Type
= Right_Type
then
723 Result_Type
:= Left_Type
;
729 -- If left size is larger, we do the remainder operation using the
730 -- size of the left type (i.e. the larger of the two integer types).
732 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
733 Result_Type
:= Left_Type
;
737 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
739 -- Similarly, if the right size is larger, we do the remainder
740 -- operation using the right type.
743 Result_Type
:= Right_Type
;
746 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
750 -- We now have an N_Op_Rem node built with Result_Type set. First
751 -- set Etype of result, as required for all Build_xxx routines
753 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
755 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
756 -- since this is a literal arithmetic operation, to be performed
757 -- by Gigi without any consideration of small values.
759 if Is_Fixed_Point_Type
(Result_Type
) then
760 Set_Treat_Fixed_As_Integer
(Rnode
);
763 -- One more check. We did the rem operation using the larger of the
764 -- two types, which is reasonable. However, in the case where the
765 -- two types have unequal sizes, it is impossible for the result of
766 -- a remainder operation to be larger than the smaller of the two
767 -- types, so we can put a conversion round the result to keep the
768 -- evolving operation size as small as possible.
770 if Esize
(Left_Type
) >= Esize
(Right_Type
) then
771 Rnode
:= Build_Conversion
(N
, Right_Type
, Rnode
);
772 elsif Esize
(Right_Type
) >= Esize
(Left_Type
) then
773 Rnode
:= Build_Conversion
(N
, Left_Type
, Rnode
);
779 -------------------------
780 -- Build_Scaled_Divide --
781 -------------------------
783 function Build_Scaled_Divide
788 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
789 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
793 -- If numerator fits in 64 bits, we can build the operations directly
794 -- without causing any intermediate overflow, so that's what we do!
796 if Int
'Max (X_Size
, Y_Size
) <= 32 then
798 Build_Divide
(N
, Build_Multiply
(N
, X
, Y
), Z
);
800 -- Otherwise we use the runtime routine
802 -- [Qnn : Integer_64,
804 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
809 Loc
: constant Source_Ptr
:= Sloc
(N
);
815 Build_Scaled_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
816 Insert_Actions
(N
, Code
);
817 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
819 -- Set type of result in case used elsewhere (see note at start)
821 Set_Etype
(Expr
, Etype
(Qnn
));
825 end Build_Scaled_Divide
;
827 ------------------------------
828 -- Build_Scaled_Divide_Code --
829 ------------------------------
831 -- If the numerator can be computed in 64-bits, we build
833 -- [Nnn : constant typ := typ (X) * typ (Y);
834 -- Dnn : constant typ := typ (Z)
835 -- Qnn : constant typ := Nnn / Dnn;
836 -- Rnn : constant typ := Nnn / Dnn;
838 -- If the numerator cannot be computed in 64 bits, we build
840 -- [Qnn : Interfaces.Integer_64;
841 -- Rnn : Interfaces.Integer_64;
842 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
844 procedure Build_Scaled_Divide_Code
847 Qnn
, Rnn
: out Entity_Id
;
850 Loc
: constant Source_Ptr
:= Sloc
(N
);
852 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
853 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
854 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
866 -- Find type that will allow computation of numerator
868 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
871 QR_Typ
:= Standard_Integer_16
;
872 elsif QR_Siz
<= 32 then
873 QR_Typ
:= Standard_Integer_32
;
874 elsif QR_Siz
<= 64 then
875 QR_Typ
:= Standard_Integer_64
;
877 -- For more than 64, bits, we use the 64-bit integer defined in
878 -- Interfaces, so that it can be handled by the runtime routine
881 QR_Typ
:= RTE
(RE_Integer_64
);
884 -- Define quotient and remainder, and set their Etypes, so
885 -- that they can be picked up by Build_xxx routines.
887 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
888 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
890 Set_Etype
(Qnn
, QR_Typ
);
891 Set_Etype
(Rnn
, QR_Typ
);
893 -- Case that we can compute the numerator in 64 bits
896 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
897 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
899 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
901 Set_Etype
(Nnn
, QR_Typ
);
902 Set_Etype
(Dnn
, QR_Typ
);
905 Make_Object_Declaration
(Loc
,
906 Defining_Identifier
=> Nnn
,
907 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
908 Constant_Present
=> True,
911 Build_Conversion
(N
, QR_Typ
, X
),
912 Build_Conversion
(N
, QR_Typ
, Y
))),
914 Make_Object_Declaration
(Loc
,
915 Defining_Identifier
=> Dnn
,
916 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
917 Constant_Present
=> True,
918 Expression
=> Build_Conversion
(N
, QR_Typ
, Z
)));
922 New_Occurrence_Of
(Nnn
, Loc
),
923 New_Occurrence_Of
(Dnn
, Loc
));
926 Make_Object_Declaration
(Loc
,
927 Defining_Identifier
=> Qnn
,
928 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
929 Constant_Present
=> True,
933 Make_Object_Declaration
(Loc
,
934 Defining_Identifier
=> Rnn
,
935 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
936 Constant_Present
=> True,
939 New_Occurrence_Of
(Nnn
, Loc
),
940 New_Occurrence_Of
(Dnn
, Loc
))));
942 -- Case where numerator does not fit in 64 bits, so we have to
943 -- call the runtime routine to compute the quotient and remainder
946 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
949 Make_Object_Declaration
(Loc
,
950 Defining_Identifier
=> Qnn
,
951 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
953 Make_Object_Declaration
(Loc
,
954 Defining_Identifier
=> Rnn
,
955 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
957 Make_Procedure_Call_Statement
(Loc
,
958 Name
=> New_Occurrence_Of
(RTE
(RE_Scaled_Divide
), Loc
),
959 Parameter_Associations
=> New_List
(
960 Build_Conversion
(N
, QR_Typ
, X
),
961 Build_Conversion
(N
, QR_Typ
, Y
),
962 Build_Conversion
(N
, QR_Typ
, Z
),
963 New_Occurrence_Of
(Qnn
, Loc
),
964 New_Occurrence_Of
(Rnn
, Loc
),
965 New_Occurrence_Of
(Rnd
, Loc
))));
968 -- Set type of result, for use in caller.
970 Set_Etype
(Qnn
, QR_Typ
);
971 end Build_Scaled_Divide_Code
;
973 ---------------------------
974 -- Do_Divide_Fixed_Fixed --
975 ---------------------------
979 -- (Result_Value * Result_Small) =
980 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
982 -- Result_Value = (Left_Value / Right_Value) *
983 -- (Left_Small / (Right_Small * Result_Small));
985 -- we can do the operation in integer arithmetic if this fraction is an
986 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
987 -- Otherwise the result is in the close result set and our approach is to
988 -- use floating-point to compute this close result.
990 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
) is
991 Left
: constant Node_Id
:= Left_Opnd
(N
);
992 Right
: constant Node_Id
:= Right_Opnd
(N
);
993 Left_Type
: constant Entity_Id
:= Etype
(Left
);
994 Right_Type
: constant Entity_Id
:= Etype
(Right
);
995 Result_Type
: constant Entity_Id
:= Etype
(N
);
996 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
997 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
999 Result_Small
: Ureal
;
1006 -- Rounding is required if the result is integral
1008 if Is_Integer_Type
(Result_Type
) then
1009 Set_Rounded_Result
(N
);
1012 -- Get result small. If the result is an integer, treat it as though
1013 -- it had a small of 1.0, all other processing is identical.
1015 if Is_Integer_Type
(Result_Type
) then
1016 Result_Small
:= Ureal_1
;
1018 Result_Small
:= Small_Value
(Result_Type
);
1023 Frac
:= Left_Small
/ (Right_Small
* Result_Small
);
1024 Frac_Num
:= Norm_Num
(Frac
);
1025 Frac_Den
:= Norm_Den
(Frac
);
1027 -- If the fraction is an integer, then we get the result by multiplying
1028 -- the left operand by the integer, and then dividing by the right
1029 -- operand (the order is important, if we did the divide first, we
1030 -- would lose precision).
1032 if Frac_Den
= 1 then
1033 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1035 if Present
(Lit_Int
) then
1036 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Right
));
1040 -- If the fraction is the reciprocal of an integer, then we get the
1041 -- result by first multiplying the divisor by the integer, and then
1042 -- doing the division with the adjusted divisor.
1044 -- Note: this is much better than doing two divisions: multiplications
1045 -- are much faster than divisions (and certainly faster than rounded
1046 -- divisions), and we don't get inaccuracies from double rounding.
1048 elsif Frac_Num
= 1 then
1049 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1051 if Present
(Lit_Int
) then
1052 Set_Result
(N
, Build_Double_Divide
(N
, Left
, Right
, Lit_Int
));
1057 -- If we fall through, we use floating-point to compute the result
1061 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1062 Real_Literal
(N
, Frac
)));
1064 end Do_Divide_Fixed_Fixed
;
1066 -------------------------------
1067 -- Do_Divide_Fixed_Universal --
1068 -------------------------------
1072 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1073 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1075 -- The result is required to be in the perfect result set if the literal
1076 -- can be factored so that the resulting small ratio is an integer or the
1077 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1078 -- analysis of these RM requirements:
1080 -- We must factor the literal, finding an integer K:
1082 -- Lit_Value = K * Right_Small
1083 -- Right_Small = Lit_Value / K
1085 -- such that the small ratio:
1088 -- ------------------------------
1089 -- (Lit_Value / K) * Result_Small
1092 -- = ------------------------ * K
1093 -- Lit_Value * Result_Small
1095 -- is an integer or the reciprocal of an integer, and for
1096 -- implementation efficiency we need the smallest such K.
1098 -- First we reduce the left fraction to lowest terms.
1100 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1101 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1102 -- Right_Small = Lit_Value.
1104 -- If numerator > 1, then set K to the denominator of the fraction so
1105 -- that the resulting small ratio is an integer (the numerator value).
1107 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
) is
1108 Left
: constant Node_Id
:= Left_Opnd
(N
);
1109 Right
: constant Node_Id
:= Right_Opnd
(N
);
1110 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1111 Result_Type
: constant Entity_Id
:= Etype
(N
);
1112 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1113 Lit_Value
: constant Ureal
:= Realval
(Right
);
1115 Result_Small
: Ureal
;
1123 -- Get result small. If the result is an integer, treat it as though
1124 -- it had a small of 1.0, all other processing is identical.
1126 if Is_Integer_Type
(Result_Type
) then
1127 Result_Small
:= Ureal_1
;
1129 Result_Small
:= Small_Value
(Result_Type
);
1132 -- Determine if literal can be rewritten successfully
1134 Frac
:= Left_Small
/ (Lit_Value
* Result_Small
);
1135 Frac_Num
:= Norm_Num
(Frac
);
1136 Frac_Den
:= Norm_Den
(Frac
);
1138 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1139 -- = denominator). If this integer is not too large, this is the case
1140 -- where the result can be obtained by dividing by this integer value.
1142 if Frac_Num
= 1 then
1143 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1145 if Present
(Lit_Int
) then
1146 Set_Result
(N
, Build_Divide
(N
, Left
, Lit_Int
));
1150 -- Case where we choose K to make fraction an integer (K = denominator
1151 -- of fraction, integer = numerator of fraction). If both K and the
1152 -- numerator are small enough, this is the case where the result can
1153 -- be obtained by first multiplying by the integer value and then
1154 -- dividing by K (the order is important, if we divided first, we
1155 -- would lose precision).
1158 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1159 Lit_K
:= Integer_Literal
(N
, Frac_Den
);
1161 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1162 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Lit_K
));
1167 -- Fall through if the literal cannot be successfully rewritten, or if
1168 -- the small ratio is out of range of integer arithmetic. In the former
1169 -- case it is fine to use floating-point to get the close result set,
1170 -- and in the latter case, it means that the result is zero or raises
1171 -- constraint error, and we can do that accurately in floating-point.
1173 -- If we end up using floating-point, then we take the right integer
1174 -- to be one, and its small to be the value of the original right real
1175 -- literal. That way, we need only one floating-point multiplication.
1178 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1180 end Do_Divide_Fixed_Universal
;
1182 -------------------------------
1183 -- Do_Divide_Universal_Fixed --
1184 -------------------------------
1188 -- (Result_Value * Result_Small) =
1189 -- Lit_Value / (Right_Value * Right_Small)
1191 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1193 -- The result is required to be in the perfect result set if the literal
1194 -- can be factored so that the resulting small ratio is an integer or the
1195 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1196 -- analysis of these RM requirements:
1198 -- We must factor the literal, finding an integer K:
1200 -- Lit_Value = K * Left_Small
1201 -- Left_Small = Lit_Value / K
1203 -- such that the small ratio:
1206 -- --------------------------
1207 -- Right_Small * Result_Small
1210 -- = -------------------------- * -
1211 -- Right_Small * Result_Small K
1213 -- is an integer or the reciprocal of an integer, and for
1214 -- implementation efficiency we need the smallest such K.
1216 -- First we reduce the left fraction to lowest terms.
1218 -- If denominator = 1, then for K = 1, the small ratio is an integer
1219 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1220 -- and Left_Small = Lit_Value.
1222 -- If denominator > 1, then set K to the numerator of the fraction so
1223 -- that the resulting small ratio is the reciprocal of an integer (the
1224 -- numerator value).
1226 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
) is
1227 Left
: constant Node_Id
:= Left_Opnd
(N
);
1228 Right
: constant Node_Id
:= Right_Opnd
(N
);
1229 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1230 Result_Type
: constant Entity_Id
:= Etype
(N
);
1231 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1232 Lit_Value
: constant Ureal
:= Realval
(Left
);
1234 Result_Small
: Ureal
;
1242 -- Get result small. If the result is an integer, treat it as though
1243 -- it had a small of 1.0, all other processing is identical.
1245 if Is_Integer_Type
(Result_Type
) then
1246 Result_Small
:= Ureal_1
;
1248 Result_Small
:= Small_Value
(Result_Type
);
1251 -- Determine if literal can be rewritten successfully
1253 Frac
:= Lit_Value
/ (Right_Small
* Result_Small
);
1254 Frac_Num
:= Norm_Num
(Frac
);
1255 Frac_Den
:= Norm_Den
(Frac
);
1257 -- Case where fraction is an integer (K = 1, integer = numerator). If
1258 -- this integer is not too large, this is the case where the result
1259 -- can be obtained by dividing this integer by the right operand.
1261 if Frac_Den
= 1 then
1262 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1264 if Present
(Lit_Int
) then
1265 Set_Result
(N
, Build_Divide
(N
, Lit_Int
, Right
));
1269 -- Case where we choose K to make the fraction the reciprocal of an
1270 -- integer (K = numerator of fraction, integer = numerator of fraction).
1271 -- If both K and the integer are small enough, this is the case where
1272 -- the result can be obtained by multiplying the right operand by K
1273 -- and then dividing by the integer value. The order of the operations
1274 -- is important (if we divided first, we would lose precision).
1277 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1278 Lit_K
:= Integer_Literal
(N
, Frac_Num
);
1280 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1281 Set_Result
(N
, Build_Double_Divide
(N
, Lit_K
, Right
, Lit_Int
));
1286 -- Fall through if the literal cannot be successfully rewritten, or if
1287 -- the small ratio is out of range of integer arithmetic. In the former
1288 -- case it is fine to use floating-point to get the close result set,
1289 -- and in the latter case, it means that the result is zero or raises
1290 -- constraint error, and we can do that accurately in floating-point.
1292 -- If we end up using floating-point, then we take the right integer
1293 -- to be one, and its small to be the value of the original right real
1294 -- literal. That way, we need only one floating-point division.
1297 Build_Divide
(N
, Real_Literal
(N
, Frac
), Fpt_Value
(Right
)));
1299 end Do_Divide_Universal_Fixed
;
1301 -----------------------------
1302 -- Do_Multiply_Fixed_Fixed --
1303 -----------------------------
1307 -- (Result_Value * Result_Small) =
1308 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1310 -- Result_Value = (Left_Value * Right_Value) *
1311 -- (Left_Small * Right_Small) / Result_Small;
1313 -- we can do the operation in integer arithmetic if this fraction is an
1314 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1315 -- Otherwise the result is in the close result set and our approach is to
1316 -- use floating-point to compute this close result.
1318 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
) is
1319 Left
: constant Node_Id
:= Left_Opnd
(N
);
1320 Right
: constant Node_Id
:= Right_Opnd
(N
);
1322 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1323 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1324 Result_Type
: constant Entity_Id
:= Etype
(N
);
1325 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1326 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1328 Result_Small
: Ureal
;
1335 -- Get result small. If the result is an integer, treat it as though
1336 -- it had a small of 1.0, all other processing is identical.
1338 if Is_Integer_Type
(Result_Type
) then
1339 Result_Small
:= Ureal_1
;
1341 Result_Small
:= Small_Value
(Result_Type
);
1346 Frac
:= (Left_Small
* Right_Small
) / Result_Small
;
1347 Frac_Num
:= Norm_Num
(Frac
);
1348 Frac_Den
:= Norm_Den
(Frac
);
1350 -- If the fraction is an integer, then we get the result by multiplying
1351 -- the operands, and then multiplying the result by the integer value.
1353 if Frac_Den
= 1 then
1354 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1356 if Present
(Lit_Int
) then
1358 Build_Multiply
(N
, Build_Multiply
(N
, Left
, Right
),
1363 -- If the fraction is the reciprocal of an integer, then we get the
1364 -- result by multiplying the operands, and then dividing the result by
1365 -- the integer value. The order of the operations is important, if we
1366 -- divided first, we would lose precision.
1368 elsif Frac_Num
= 1 then
1369 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1371 if Present
(Lit_Int
) then
1372 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Right
, Lit_Int
));
1377 -- If we fall through, we use floating-point to compute the result
1381 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1382 Real_Literal
(N
, Frac
)));
1384 end Do_Multiply_Fixed_Fixed
;
1386 ---------------------------------
1387 -- Do_Multiply_Fixed_Universal --
1388 ---------------------------------
1392 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1393 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1395 -- The result is required to be in the perfect result set if the literal
1396 -- can be factored so that the resulting small ratio is an integer or the
1397 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1398 -- analysis of these RM requirements:
1400 -- We must factor the literal, finding an integer K:
1402 -- Lit_Value = K * Right_Small
1403 -- Right_Small = Lit_Value / K
1405 -- such that the small ratio:
1407 -- Left_Small * (Lit_Value / K)
1408 -- ----------------------------
1411 -- Left_Small * Lit_Value 1
1412 -- = ---------------------- * -
1415 -- is an integer or the reciprocal of an integer, and for
1416 -- implementation efficiency we need the smallest such K.
1418 -- First we reduce the left fraction to lowest terms.
1420 -- If denominator = 1, then for K = 1, the small ratio is an
1421 -- integer, and this is clearly the minimum K case, so set
1422 -- K = 1, Right_Small = Lit_Value.
1424 -- If denominator > 1, then set K to the numerator of the
1425 -- fraction, so that the resulting small ratio is the
1426 -- reciprocal of the integer (the denominator value).
1428 procedure Do_Multiply_Fixed_Universal
1430 Left
, Right
: Node_Id
)
1432 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1433 Result_Type
: constant Entity_Id
:= Etype
(N
);
1434 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1435 Lit_Value
: constant Ureal
:= Realval
(Right
);
1437 Result_Small
: Ureal
;
1445 -- Get result small. If the result is an integer, treat it as though
1446 -- it had a small of 1.0, all other processing is identical.
1448 if Is_Integer_Type
(Result_Type
) then
1449 Result_Small
:= Ureal_1
;
1451 Result_Small
:= Small_Value
(Result_Type
);
1454 -- Determine if literal can be rewritten successfully
1456 Frac
:= (Left_Small
* Lit_Value
) / Result_Small
;
1457 Frac_Num
:= Norm_Num
(Frac
);
1458 Frac_Den
:= Norm_Den
(Frac
);
1460 -- Case where fraction is an integer (K = 1, integer = numerator). If
1461 -- this integer is not too large, this is the case where the result can
1462 -- be obtained by multiplying by this integer value.
1464 if Frac_Den
= 1 then
1465 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1467 if Present
(Lit_Int
) then
1468 Set_Result
(N
, Build_Multiply
(N
, Left
, Lit_Int
));
1472 -- Case where we choose K to make fraction the reciprocal of an integer
1473 -- (K = numerator of fraction, integer = denominator of fraction). If
1474 -- both K and the denominator are small enough, this is the case where
1475 -- the result can be obtained by first multiplying by K, and then
1476 -- dividing by the integer value.
1479 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1480 Lit_K
:= Integer_Literal
(N
, Frac_Num
);
1482 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1483 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_K
, Lit_Int
));
1488 -- Fall through if the literal cannot be successfully rewritten, or if
1489 -- the small ratio is out of range of integer arithmetic. In the former
1490 -- case it is fine to use floating-point to get the close result set,
1491 -- and in the latter case, it means that the result is zero or raises
1492 -- constraint error, and we can do that accurately in floating-point.
1494 -- If we end up using floating-point, then we take the right integer
1495 -- to be one, and its small to be the value of the original right real
1496 -- literal. That way, we need only one floating-point multiplication.
1499 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1501 end Do_Multiply_Fixed_Universal
;
1503 ---------------------------------
1504 -- Expand_Convert_Fixed_Static --
1505 ---------------------------------
1507 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
) is
1510 Convert_To
(Etype
(N
),
1511 Make_Real_Literal
(Sloc
(N
), Expr_Value_R
(Expression
(N
)))));
1512 Analyze_And_Resolve
(N
);
1513 end Expand_Convert_Fixed_Static
;
1515 -----------------------------------
1516 -- Expand_Convert_Fixed_To_Fixed --
1517 -----------------------------------
1521 -- Result_Value * Result_Small = Source_Value * Source_Small
1522 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1524 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1525 -- integer, then the perfect result set is obtained by a single integer
1528 -- If the small ratio is the reciprocal of a sufficiently small integer,
1529 -- then the perfect result set is obtained by a single integer division.
1531 -- In other cases, we obtain the close result set by calculating the
1532 -- result in floating-point.
1534 procedure Expand_Convert_Fixed_To_Fixed
(N
: Node_Id
) is
1535 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1536 Expr
: constant Node_Id
:= Expression
(N
);
1537 Result_Type
: constant Entity_Id
:= Etype
(N
);
1538 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1539 Small_Ratio
: Ureal
;
1545 if Is_OK_Static_Expression
(Expr
) then
1546 Expand_Convert_Fixed_Static
(N
);
1550 Small_Ratio
:= Small_Value
(Source_Type
) / Small_Value
(Result_Type
);
1551 Ratio_Num
:= Norm_Num
(Small_Ratio
);
1552 Ratio_Den
:= Norm_Den
(Small_Ratio
);
1554 if Ratio_Den
= 1 then
1556 if Ratio_Num
= 1 then
1557 Set_Result
(N
, Expr
);
1561 Lit
:= Integer_Literal
(N
, Ratio_Num
);
1563 if Present
(Lit
) then
1564 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
));
1569 elsif Ratio_Num
= 1 then
1570 Lit
:= Integer_Literal
(N
, Ratio_Den
);
1572 if Present
(Lit
) then
1573 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1578 -- Fall through to use floating-point for the close result set case
1579 -- either as a result of the small ratio not being an integer or the
1580 -- reciprocal of an integer, or if the integer is out of range.
1585 Real_Literal
(N
, Small_Ratio
)),
1588 end Expand_Convert_Fixed_To_Fixed
;
1590 -----------------------------------
1591 -- Expand_Convert_Fixed_To_Float --
1592 -----------------------------------
1594 -- If the small of the fixed type is 1.0, then we simply convert the
1595 -- integer value directly to the target floating-point type, otherwise
1596 -- we first have to multiply by the small, in Long_Long_Float, and then
1597 -- convert the result to the target floating-point type.
1599 procedure Expand_Convert_Fixed_To_Float
(N
: Node_Id
) is
1600 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1601 Expr
: constant Node_Id
:= Expression
(N
);
1602 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1603 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1606 if Is_OK_Static_Expression
(Expr
) then
1607 Expand_Convert_Fixed_Static
(N
);
1611 if Small
= Ureal_1
then
1612 Set_Result
(N
, Expr
);
1618 Real_Literal
(N
, Small
)),
1621 end Expand_Convert_Fixed_To_Float
;
1623 -------------------------------------
1624 -- Expand_Convert_Fixed_To_Integer --
1625 -------------------------------------
1629 -- Result_Value = Source_Value * Source_Small
1631 -- If the small value is a sufficiently small integer, then the perfect
1632 -- result set is obtained by a single integer multiplication.
1634 -- If the small value is the reciprocal of a sufficiently small integer,
1635 -- then the perfect result set is obtained by a single integer division.
1637 -- In other cases, we obtain the close result set by calculating the
1638 -- result in floating-point.
1640 procedure Expand_Convert_Fixed_To_Integer
(N
: Node_Id
) is
1641 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1642 Expr
: constant Node_Id
:= Expression
(N
);
1643 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1644 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1645 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1646 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1650 if Is_OK_Static_Expression
(Expr
) then
1651 Expand_Convert_Fixed_Static
(N
);
1655 if Small_Den
= 1 then
1656 Lit
:= Integer_Literal
(N
, Small_Num
);
1658 if Present
(Lit
) then
1659 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1663 elsif Small_Num
= 1 then
1664 Lit
:= Integer_Literal
(N
, Small_Den
);
1666 if Present
(Lit
) then
1667 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1672 -- Fall through to use floating-point for the close result set case
1673 -- either as a result of the small value not being an integer or the
1674 -- reciprocal of an integer, or if the integer is out of range.
1679 Real_Literal
(N
, Small
)),
1682 end Expand_Convert_Fixed_To_Integer
;
1684 -----------------------------------
1685 -- Expand_Convert_Float_To_Fixed --
1686 -----------------------------------
1690 -- Result_Value * Result_Small = Operand_Value
1694 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1696 -- We do the small scaling in floating-point, and we do a multiplication
1697 -- rather than a division, since it is accurate enough for the perfect
1698 -- result cases, and faster.
1700 procedure Expand_Convert_Float_To_Fixed
(N
: Node_Id
) is
1701 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1702 Expr
: constant Node_Id
:= Expression
(N
);
1703 Result_Type
: constant Entity_Id
:= Etype
(N
);
1704 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1707 -- Optimize small = 1, where we can avoid the multiply completely
1709 if Small
= Ureal_1
then
1710 Set_Result
(N
, Expr
, Rng_Check
);
1712 -- Normal case where multiply is required
1718 Real_Literal
(N
, Ureal_1
/ Small
)),
1721 end Expand_Convert_Float_To_Fixed
;
1723 -------------------------------------
1724 -- Expand_Convert_Integer_To_Fixed --
1725 -------------------------------------
1729 -- Result_Value * Result_Small = Operand_Value
1730 -- Result_Value = Operand_Value / Result_Small
1732 -- If the small value is a sufficiently small integer, then the perfect
1733 -- result set is obtained by a single integer division.
1735 -- If the small value is the reciprocal of a sufficiently small integer,
1736 -- the perfect result set is obtained by a single integer multiplication.
1738 -- In other cases, we obtain the close result set by calculating the
1739 -- result in floating-point using a multiplication by the reciprocal
1740 -- of the Result_Small.
1742 procedure Expand_Convert_Integer_To_Fixed
(N
: Node_Id
) is
1743 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1744 Expr
: constant Node_Id
:= Expression
(N
);
1745 Result_Type
: constant Entity_Id
:= Etype
(N
);
1746 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1747 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1748 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1752 if Small_Den
= 1 then
1753 Lit
:= Integer_Literal
(N
, Small_Num
);
1755 if Present
(Lit
) then
1756 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1760 elsif Small_Num
= 1 then
1761 Lit
:= Integer_Literal
(N
, Small_Den
);
1763 if Present
(Lit
) then
1764 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1769 -- Fall through to use floating-point for the close result set case
1770 -- either as a result of the small value not being an integer or the
1771 -- reciprocal of an integer, or if the integer is out of range.
1776 Real_Literal
(N
, Ureal_1
/ Small
)),
1779 end Expand_Convert_Integer_To_Fixed
;
1781 --------------------------------
1782 -- Expand_Decimal_Divide_Call --
1783 --------------------------------
1785 -- We have four operands
1792 -- All of which are decimal types, and which thus have associated
1795 -- Computing the quotient is a similar problem to that faced by the
1796 -- normal fixed-point division, except that it is simpler, because
1797 -- we always have compatible smalls.
1799 -- Quotient = (Dividend / Divisor) * 10**q
1801 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1802 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1804 -- For q >= 0, we compute
1806 -- Numerator := Dividend * 10 ** q
1807 -- Denominator := Divisor
1808 -- Quotient := Numerator / Denominator
1810 -- For q < 0, we compute
1812 -- Numerator := Dividend
1813 -- Denominator := Divisor * 10 ** q
1814 -- Quotient := Numerator / Denominator
1816 -- Both these divisions are done in truncated mode, and the remainder
1817 -- from these divisions is used to compute the result Remainder. This
1818 -- remainder has the effective scale of the numerator of the division,
1820 -- For q >= 0, the remainder scale is Dividend'Scale + q
1821 -- For q < 0, the remainder scale is Dividend'Scale
1823 -- The result Remainder is then computed by a normal truncating decimal
1824 -- conversion from this scale to the scale of the remainder, i.e. by a
1825 -- division or multiplication by the appropriate power of 10.
1827 procedure Expand_Decimal_Divide_Call
(N
: Node_Id
) is
1828 Loc
: constant Source_Ptr
:= Sloc
(N
);
1830 Dividend
: Node_Id
:= First_Actual
(N
);
1831 Divisor
: Node_Id
:= Next_Actual
(Dividend
);
1832 Quotient
: Node_Id
:= Next_Actual
(Divisor
);
1833 Remainder
: Node_Id
:= Next_Actual
(Quotient
);
1835 Dividend_Type
: constant Entity_Id
:= Etype
(Dividend
);
1836 Divisor_Type
: constant Entity_Id
:= Etype
(Divisor
);
1837 Quotient_Type
: constant Entity_Id
:= Etype
(Quotient
);
1838 Remainder_Type
: constant Entity_Id
:= Etype
(Remainder
);
1840 Dividend_Scale
: constant Uint
:= Scale_Value
(Dividend_Type
);
1841 Divisor_Scale
: constant Uint
:= Scale_Value
(Divisor_Type
);
1842 Quotient_Scale
: constant Uint
:= Scale_Value
(Quotient_Type
);
1843 Remainder_Scale
: constant Uint
:= Scale_Value
(Remainder_Type
);
1846 Numerator_Scale
: Uint
;
1850 Computed_Remainder
: Node_Id
;
1851 Adjusted_Remainder
: Node_Id
;
1852 Scale_Adjust
: Uint
;
1855 -- Relocate the operands, since they are now list elements, and we
1856 -- need to reference them separately as operands in the expanded code.
1858 Dividend
:= Relocate_Node
(Dividend
);
1859 Divisor
:= Relocate_Node
(Divisor
);
1860 Quotient
:= Relocate_Node
(Quotient
);
1861 Remainder
:= Relocate_Node
(Remainder
);
1863 -- Now compute Q, the adjustment scale
1865 Q
:= Divisor_Scale
+ Quotient_Scale
- Dividend_Scale
;
1867 -- If Q is non-negative then we need a scaled divide
1870 Build_Scaled_Divide_Code
1873 Integer_Literal
(N
, Uint_10
** Q
),
1877 Numerator_Scale
:= Dividend_Scale
+ Q
;
1879 -- If Q is negative, then we need a double divide
1882 Build_Double_Divide_Code
1886 Integer_Literal
(N
, Uint_10
** (-Q
)),
1889 Numerator_Scale
:= Dividend_Scale
;
1892 -- Add statement to set quotient value
1894 -- Quotient := quotient-type!(Qnn);
1897 Make_Assignment_Statement
(Loc
,
1900 Unchecked_Convert_To
(Quotient_Type
,
1901 Build_Conversion
(N
, Quotient_Type
,
1902 New_Occurrence_Of
(Qnn
, Loc
)))));
1904 -- Now we need to deal with computing and setting the remainder. The
1905 -- scale of the remainder is in Numerator_Scale, and the desired
1906 -- scale is the scale of the given Remainder argument. There are
1909 -- Numerator_Scale > Remainder_Scale
1911 -- in this case, there are extra digits in the computed remainder
1912 -- which must be eliminated by an extra division:
1914 -- computed-remainder := Numerator rem Denominator
1915 -- scale_adjust = Numerator_Scale - Remainder_Scale
1916 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1918 -- Numerator_Scale = Remainder_Scale
1920 -- in this case, the we have the remainder we need
1922 -- computed-remainder := Numerator rem Denominator
1923 -- adjusted-remainder := computed-remainder
1925 -- Numerator_Scale < Remainder_Scale
1927 -- in this case, we have insufficient digits in the computed
1928 -- remainder, which must be eliminated by an extra multiply
1930 -- computed-remainder := Numerator rem Denominator
1931 -- scale_adjust = Remainder_Scale - Numerator_Scale
1932 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1934 -- Finally we assign the adjusted-remainder to the result Remainder
1935 -- with conversions to get the proper fixed-point type representation.
1937 Computed_Remainder
:= New_Occurrence_Of
(Rnn
, Loc
);
1939 if Numerator_Scale
> Remainder_Scale
then
1940 Scale_Adjust
:= Numerator_Scale
- Remainder_Scale
;
1941 Adjusted_Remainder
:=
1943 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1945 elsif Numerator_Scale
= Remainder_Scale
then
1946 Adjusted_Remainder
:= Computed_Remainder
;
1948 else -- Numerator_Scale < Remainder_Scale
1949 Scale_Adjust
:= Remainder_Scale
- Numerator_Scale
;
1950 Adjusted_Remainder
:=
1952 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1955 -- Assignment of remainder result
1958 Make_Assignment_Statement
(Loc
,
1961 Unchecked_Convert_To
(Remainder_Type
, Adjusted_Remainder
)));
1963 -- Final step is to rewrite the call with a block containing the
1964 -- above sequence of constructed statements for the divide operation.
1967 Make_Block_Statement
(Loc
,
1968 Handled_Statement_Sequence
=>
1969 Make_Handled_Sequence_Of_Statements
(Loc
,
1970 Statements
=> Stmts
)));
1974 end Expand_Decimal_Divide_Call
;
1976 -----------------------------------------------
1977 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1978 -----------------------------------------------
1980 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
1981 Left
: constant Node_Id
:= Left_Opnd
(N
);
1982 Right
: constant Node_Id
:= Right_Opnd
(N
);
1985 -- Suppress expansion of a fixed-by-fixed division if the
1986 -- operation is supported directly by the target.
1988 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
1992 if Etype
(Left
) = Universal_Real
then
1993 Do_Divide_Universal_Fixed
(N
);
1995 elsif Etype
(Right
) = Universal_Real
then
1996 Do_Divide_Fixed_Universal
(N
);
1999 Do_Divide_Fixed_Fixed
(N
);
2002 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed
;
2004 -----------------------------------------------
2005 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
2006 -----------------------------------------------
2008 -- The division is done in long_long_float, and the result is multiplied
2009 -- by the small ratio, which is Small (Right) / Small (Left). Special
2010 -- treatment is required for universal operands, which represent their
2011 -- own value and do not require conversion.
2013 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2014 Left
: constant Node_Id
:= Left_Opnd
(N
);
2015 Right
: constant Node_Id
:= Right_Opnd
(N
);
2017 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2018 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2021 -- Case of left operand is universal real, the result we want is:
2023 -- Left_Value / (Right_Value * Right_Small)
2025 -- so we compute this as:
2027 -- (Left_Value / Right_Small) / Right_Value
2029 if Left_Type
= Universal_Real
then
2032 Real_Literal
(N
, Realval
(Left
) / Small_Value
(Right_Type
)),
2033 Fpt_Value
(Right
)));
2035 -- Case of right operand is universal real, the result we want is
2037 -- (Left_Value * Left_Small) / Right_Value
2039 -- so we compute this as:
2041 -- Left_Value * (Left_Small / Right_Value)
2043 -- Note we invert to a multiplication since usually floating-point
2044 -- multiplication is much faster than floating-point division.
2046 elsif Right_Type
= Universal_Real
then
2050 Real_Literal
(N
, Small_Value
(Left_Type
) / Realval
(Right
))));
2052 -- Both operands are fixed, so the value we want is
2054 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2056 -- which we compute as:
2058 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2063 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2065 Small_Value
(Left_Type
) / Small_Value
(Right_Type
))));
2068 end Expand_Divide_Fixed_By_Fixed_Giving_Float
;
2070 -------------------------------------------------
2071 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2072 -------------------------------------------------
2074 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2075 Left
: constant Node_Id
:= Left_Opnd
(N
);
2076 Right
: constant Node_Id
:= Right_Opnd
(N
);
2079 if Etype
(Left
) = Universal_Real
then
2080 Do_Divide_Universal_Fixed
(N
);
2082 elsif Etype
(Right
) = Universal_Real
then
2083 Do_Divide_Fixed_Universal
(N
);
2086 Do_Divide_Fixed_Fixed
(N
);
2089 end Expand_Divide_Fixed_By_Fixed_Giving_Integer
;
2091 -------------------------------------------------
2092 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2093 -------------------------------------------------
2095 -- Since the operand and result fixed-point type is the same, this is
2096 -- a straight divide by the right operand, the small can be ignored.
2098 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2099 Left
: constant Node_Id
:= Left_Opnd
(N
);
2100 Right
: constant Node_Id
:= Right_Opnd
(N
);
2103 Set_Result
(N
, Build_Divide
(N
, Left
, Right
));
2104 end Expand_Divide_Fixed_By_Integer_Giving_Fixed
;
2106 -------------------------------------------------
2107 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2108 -------------------------------------------------
2110 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2111 Left
: constant Node_Id
:= Left_Opnd
(N
);
2112 Right
: constant Node_Id
:= Right_Opnd
(N
);
2114 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
);
2115 -- The operand may be a non-static universal value, such an
2116 -- exponentiation with a non-static exponent. In that case, treat
2117 -- as a fixed * fixed multiplication, and convert the argument to
2118 -- the target fixed type.
2120 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
) is
2121 Loc
: constant Source_Ptr
:= Sloc
(N
);
2125 Make_Type_Conversion
(Loc
,
2126 Subtype_Mark
=> New_Occurrence_Of
(Etype
(N
), Loc
),
2127 Expression
=> Expression
(Opnd
)));
2128 Analyze_And_Resolve
(Opnd
, Etype
(N
));
2129 end Rewrite_Non_Static_Universal
;
2132 -- Suppress expansion of a fixed-by-fixed multiplication if the
2133 -- operation is supported directly by the target.
2135 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
2139 if Etype
(Left
) = Universal_Real
then
2140 if Nkind
(Left
) = N_Real_Literal
then
2141 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2143 elsif Nkind
(Left
) = N_Type_Conversion
then
2144 Rewrite_Non_Static_Universal
(Left
);
2145 Do_Multiply_Fixed_Fixed
(N
);
2148 elsif Etype
(Right
) = Universal_Real
then
2149 if Nkind
(Right
) = N_Real_Literal
then
2150 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2152 elsif Nkind
(Right
) = N_Type_Conversion
then
2153 Rewrite_Non_Static_Universal
(Right
);
2154 Do_Multiply_Fixed_Fixed
(N
);
2158 Do_Multiply_Fixed_Fixed
(N
);
2161 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
;
2163 -------------------------------------------------
2164 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2165 -------------------------------------------------
2167 -- The multiply is done in long_long_float, and the result is multiplied
2168 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2169 -- Special treatment is required for universal operands.
2171 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2172 Left
: constant Node_Id
:= Left_Opnd
(N
);
2173 Right
: constant Node_Id
:= Right_Opnd
(N
);
2175 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2176 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2179 -- Case of left operand is universal real, the result we want is
2181 -- Left_Value * (Right_Value * Right_Small)
2183 -- so we compute this as:
2185 -- (Left_Value * Right_Small) * Right_Value;
2187 if Left_Type
= Universal_Real
then
2190 Real_Literal
(N
, Realval
(Left
) * Small_Value
(Right_Type
)),
2191 Fpt_Value
(Right
)));
2193 -- Case of right operand is universal real, the result we want is
2195 -- (Left_Value * Left_Small) * Right_Value
2197 -- so we compute this as:
2199 -- Left_Value * (Left_Small * Right_Value)
2201 elsif Right_Type
= Universal_Real
then
2205 Real_Literal
(N
, Small_Value
(Left_Type
) * Realval
(Right
))));
2207 -- Both operands are fixed, so the value we want is
2209 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2211 -- which we compute as:
2213 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2218 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2220 Small_Value
(Right_Type
) * Small_Value
(Left_Type
))));
2223 end Expand_Multiply_Fixed_By_Fixed_Giving_Float
;
2225 ---------------------------------------------------
2226 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2227 ---------------------------------------------------
2229 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2230 Left
: constant Node_Id
:= Left_Opnd
(N
);
2231 Right
: constant Node_Id
:= Right_Opnd
(N
);
2234 if Etype
(Left
) = Universal_Real
then
2235 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2237 elsif Etype
(Right
) = Universal_Real
then
2238 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2241 Do_Multiply_Fixed_Fixed
(N
);
2244 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer
;
2246 ---------------------------------------------------
2247 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2248 ---------------------------------------------------
2250 -- Since the operand and result fixed-point type is the same, this is
2251 -- a straight multiply by the right operand, the small can be ignored.
2253 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2256 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2257 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed
;
2259 ---------------------------------------------------
2260 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2261 ---------------------------------------------------
2263 -- Since the operand and result fixed-point type is the same, this is
2264 -- a straight multiply by the right operand, the small can be ignored.
2266 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2269 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2270 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed
;
2276 function Fpt_Value
(N
: Node_Id
) return Node_Id
is
2277 Typ
: constant Entity_Id
:= Etype
(N
);
2280 if Is_Integer_Type
(Typ
)
2281 or else Is_Floating_Point_Type
(Typ
)
2285 (N
, Standard_Long_Long_Float
, N
);
2287 -- Fixed-point case, must get integer value first
2291 Build_Conversion
(N
, Standard_Long_Long_Float
, N
);
2296 ---------------------
2297 -- Integer_Literal --
2298 ---------------------
2300 function Integer_Literal
(N
: Node_Id
; V
: Uint
) return Node_Id
is
2305 if V
< Uint_2
** 7 then
2306 T
:= Standard_Integer_8
;
2308 elsif V
< Uint_2
** 15 then
2309 T
:= Standard_Integer_16
;
2311 elsif V
< Uint_2
** 31 then
2312 T
:= Standard_Integer_32
;
2314 elsif V
< Uint_2
** 63 then
2315 T
:= Standard_Integer_64
;
2321 L
:= Make_Integer_Literal
(Sloc
(N
), V
);
2323 -- Set type of result in case used elsewhere (see note at start)
2326 Set_Is_Static_Expression
(L
);
2328 -- We really need to set Analyzed here because we may be creating a
2329 -- very strange beast, namely an integer literal typed as fixed-point
2330 -- and the analyzer won't like that. Probably we should allow the
2331 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2332 -- and teach the analyzer how to handle them ???
2336 end Integer_Literal
;
2342 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
is
2346 L
:= Make_Real_Literal
(Sloc
(N
), V
);
2348 -- Set type of result in case used elsewhere (see note at start)
2350 Set_Etype
(L
, Standard_Long_Long_Float
);
2354 ------------------------
2355 -- Rounded_Result_Set --
2356 ------------------------
2358 function Rounded_Result_Set
(N
: Node_Id
) return Boolean is
2359 K
: constant Node_Kind
:= Nkind
(N
);
2362 if (K
= N_Type_Conversion
or else
2363 K
= N_Op_Divide
or else
2365 and then Rounded_Result
(N
)
2371 end Rounded_Result_Set
;
2377 procedure Set_Result
2380 Rchk
: Boolean := False)
2384 Expr_Type
: constant Entity_Id
:= Etype
(Expr
);
2385 Result_Type
: constant Entity_Id
:= Etype
(N
);
2388 -- No conversion required if types match and no range check
2390 if Result_Type
= Expr_Type
and then not Rchk
then
2393 -- Else perform required conversion
2396 Cnode
:= Build_Conversion
(N
, Result_Type
, Expr
, Rchk
);
2400 Analyze_And_Resolve
(N
, Result_Type
);