1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
26 ------------------------------------------------------------------------------
28 with Atree
; use Atree
;
29 with Checks
; use Checks
;
30 with Einfo
; use Einfo
;
31 with Exp_Util
; use Exp_Util
;
32 with Nlists
; use Nlists
;
33 with Nmake
; use Nmake
;
34 with Restrict
; use Restrict
;
35 with Rtsfind
; use Rtsfind
;
37 with Sem_Eval
; use Sem_Eval
;
38 with Sem_Res
; use Sem_Res
;
39 with Sem_Util
; use Sem_Util
;
40 with Sinfo
; use Sinfo
;
41 with Stand
; use Stand
;
42 with Tbuild
; use Tbuild
;
43 with Ttypes
; use Ttypes
;
44 with Uintp
; use Uintp
;
45 with Urealp
; use Urealp
;
47 package body Exp_Fixd
is
49 -----------------------
50 -- Local Subprograms --
51 -----------------------
53 -- General note; in this unit, a number of routines are driven by the
54 -- types (Etype) of their operands. Since we are dealing with unanalyzed
55 -- expressions as they are constructed, the Etypes would not normally be
56 -- set, but the construction routines that we use in this unit do in fact
57 -- set the Etype values correctly. In addition, setting the Etype ensures
58 -- that the analyzer does not try to redetermine the type when the node
59 -- is analyzed (which would be wrong, since in the case where we set the
60 -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
61 -- still dealing with a normal fixed-point operation and mess it up).
63 function Build_Conversion
67 Rchk
: Boolean := False)
69 -- Build an expression that converts the expression Expr to type Typ,
70 -- taking the source location from Sloc (N). If the conversions involve
71 -- fixed-point types, then the Conversion_OK flag will be set so that the
72 -- resulting conversions do not get re-expanded. On return the resulting
73 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
74 -- in the resulting conversion node.
76 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
77 -- Builds an N_Op_Divide node from the given left and right operand
78 -- expressions, using the source location from Sloc (N). The operands
79 -- are either both Long_Long_Float, in which case Build_Divide differs
80 -- from Make_Op_Divide only in that the Etype of the resulting node is
81 -- set (to Long_Long_Float), or they can be integer types. In this case
82 -- the integer types need not be the same, and Build_Divide converts
83 -- the operand with the smaller sized type to match the type of the
84 -- other operand and sets this as the result type. The Rounded_Result
85 -- flag of the result in this case is set from the Rounded_Result flag
86 -- of node N. On return, the resulting node is analyzed, and has its
89 function Build_Double_Divide
93 -- Returns a node corresponding to the value X/(Y*Z) using the source
94 -- location from Sloc (N). The division is rounded if the Rounded_Result
95 -- flag of N is set. The integer types of X, Y, Z may be different. On
96 -- return the resulting node is analyzed, and has its Etype set.
98 procedure Build_Double_Divide_Code
101 Qnn
, Rnn
: out Entity_Id
;
103 -- Generates a sequence of code for determining the quotient and remainder
104 -- of the division X/(Y*Z), using the source location from Sloc (N).
105 -- Entities of appropriate types are allocated for the quotient and
106 -- remainder and returned in Qnn and Rnn. The result is rounded if
107 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
108 -- are appropriately set on return.
110 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
111 -- Builds an N_Op_Multiply node from the given left and right operand
112 -- expressions, using the source location from Sloc (N). The operands
113 -- are either both Long_Long_Float, in which case Build_Divide differs
114 -- from Make_Op_Multiply only in that the Etype of the resulting node is
115 -- set (to Long_Long_Float), or they can be integer types. In this case
116 -- the integer types need not be the same, and Build_Multiply chooses
117 -- a type long enough to hold the product (i.e. twice the size of the
118 -- longer of the two operand types), and both operands are converted
119 -- to this type. The Etype of the result is also set to this value.
120 -- However, the result can never overflow Integer_64, so this is the
121 -- largest type that is ever generated. On return, the resulting node
122 -- is analyzed and has its Etype set.
124 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
125 -- Builds an N_Op_Rem node from the given left and right operand
126 -- expressions, using the source location from Sloc (N). The operands
127 -- are both integer types, which need not be the same. Build_Rem
128 -- converts the operand with the smaller sized type to match the type
129 -- of the other operand and sets this as the result type. The result
130 -- is never rounded (rem operations cannot be rounded in any case!)
131 -- On return, the resulting node is analyzed and has its Etype set.
133 function Build_Scaled_Divide
137 -- Returns a node corresponding to the value X*Y/Z using the source
138 -- location from Sloc (N). The division is rounded if the Rounded_Result
139 -- flag of N is set. The integer types of X, Y, Z may be different. On
140 -- return the resulting node is analyzed and has is Etype set.
142 procedure Build_Scaled_Divide_Code
145 Qnn
, Rnn
: out Entity_Id
;
147 -- Generates a sequence of code for determining the quotient and remainder
148 -- of the division X*Y/Z, using the source location from Sloc (N). Entities
149 -- of appropriate types are allocated for the quotient and remainder and
150 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
151 -- The division is rounded if the Rounded_Result flag of N is set. The
152 -- Etype fields of Qnn and Rnn are appropriately set on return.
154 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
);
155 -- Handles expansion of divide for case of two fixed-point operands
156 -- (neither of them universal), with an integer or fixed-point result.
157 -- N is the N_Op_Divide node to be expanded.
159 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
);
160 -- Handles expansion of divide for case of a fixed-point operand divided
161 -- by a universal real operand, with an integer or fixed-point result. N
162 -- is the N_Op_Divide node to be expanded.
164 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
);
165 -- Handles expansion of divide for case of a universal real operand
166 -- divided by a fixed-point operand, with an integer or fixed-point
167 -- result. N is the N_Op_Divide node to be expanded.
169 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
);
170 -- Handles expansion of multiply for case of two fixed-point operands
171 -- (neither of them universal), with an integer or fixed-point result.
172 -- N is the N_Op_Multiply node to be expanded.
174 procedure Do_Multiply_Fixed_Universal
(N
: Node_Id
; Left
, Right
: Node_Id
);
175 -- Handles expansion of multiply for case of a fixed-point operand
176 -- multiplied by a universal real operand, with an integer or fixed-
177 -- point result. N is the N_Op_Multiply node to be expanded, and
178 -- Left, Right are the operands (which may have been switched).
180 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
);
181 -- This routine is called where the node N is a conversion of a literal
182 -- or other static expression of a fixed-point type to some other type.
183 -- In such cases, we simply rewrite the operand as a real literal and
184 -- reanalyze. This avoids problems which would otherwise result from
185 -- attempting to build and fold expressions involving constants.
187 function Fpt_Value
(N
: Node_Id
) return Node_Id
;
188 -- Given an operand of fixed-point operation, return an expression that
189 -- represents the corresponding Long_Long_Float value. The expression
190 -- can be of integer type, floating-point type, or fixed-point type.
191 -- The expression returned is neither analyzed and resolved. The Etype
192 -- of the result is properly set (to Long_Long_Float).
194 function Integer_Literal
(N
: Node_Id
; V
: Uint
) return Node_Id
;
195 -- Given a non-negative universal integer value, build a typed integer
196 -- literal node, using the smallest applicable standard integer type. If
197 -- the value exceeds 2**63-1, the largest value allowed for perfect result
198 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
199 -- node N provides the Sloc value for the constructed literal. The Etype
200 -- of the resulting literal is correctly set, and it is marked as analyzed.
202 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
;
203 -- Build a real literal node from the given value, the Etype of the
204 -- returned node is set to Long_Long_Float, since all floating-point
205 -- arithmetic operations that we construct use Long_Long_Float
207 function Rounded_Result_Set
(N
: Node_Id
) return Boolean;
208 -- Returns True if N is a node that contains the Rounded_Result flag
209 -- and if the flag is true.
211 procedure Set_Result
(N
: Node_Id
; Expr
: Node_Id
; Rchk
: Boolean := False);
212 -- N is the node for the current conversion, division or multiplication
213 -- operation, and Expr is an expression representing the result. Expr
214 -- may be of floating-point or integer type. If the operation result
215 -- is fixed-point, then the value of Expr is in units of small of the
216 -- result type (i.e. small's have already been dealt with). The result
217 -- of the call is to replace N by an appropriate conversion to the
218 -- result type, dealing with rounding for the decimal types case. The
219 -- node is then analyzed and resolved using the result type. If Rchk
220 -- is True, then Do_Range_Check is set in the resulting conversion.
222 ----------------------
223 -- Build_Conversion --
224 ----------------------
226 function Build_Conversion
230 Rchk
: Boolean := False)
233 Loc
: constant Source_Ptr
:= Sloc
(N
);
235 Rcheck
: Boolean := Rchk
;
238 -- A special case, if the expression is an integer literal and the
239 -- target type is an integer type, then just retype the integer
240 -- literal to the desired target type. Don't do this if we need
243 if Nkind
(Expr
) = N_Integer_Literal
244 and then Is_Integer_Type
(Typ
)
249 -- Cases where we end up with a conversion. Note that we do not use the
250 -- Convert_To abstraction here, since we may be decorating the resulting
251 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
252 -- conversion node present, even if it appears to be redundant.
255 -- Remove inner conversion if both inner and outer conversions are
256 -- to integer types, since the inner one serves no purpose (except
257 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
258 -- and also we preserve the range check flag on the inner operand
260 if Is_Integer_Type
(Typ
)
261 and then Is_Integer_Type
(Etype
(Expr
))
262 and then Nkind
(Expr
) = N_Type_Conversion
265 Make_Type_Conversion
(Loc
,
266 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
267 Expression
=> Expression
(Expr
));
268 Set_Rounded_Result
(Result
, Rounded_Result_Set
(Expr
));
269 Rcheck
:= Rcheck
or Do_Range_Check
(Expr
);
271 -- For all other cases, a simple type conversion will work
275 Make_Type_Conversion
(Loc
,
276 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
280 -- Set Conversion_OK if either result or expression type is a
281 -- fixed-point type, since from a semantic point of view, we are
282 -- treating fixed-point values as integers at this stage.
284 if Is_Fixed_Point_Type
(Typ
)
285 or else Is_Fixed_Point_Type
(Etype
(Expression
(Result
)))
287 Set_Conversion_OK
(Result
);
290 -- Set Do_Range_Check if either it was requested by the caller,
291 -- or if an eliminated inner conversion had a range check.
294 Enable_Range_Check
(Result
);
296 Set_Do_Range_Check
(Result
, False);
300 Set_Etype
(Result
, Typ
);
303 end Build_Conversion
;
309 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
310 Loc
: constant Source_Ptr
:= Sloc
(N
);
311 Left_Type
: constant Entity_Id
:= Base_Type
(Etype
(L
));
312 Right_Type
: constant Entity_Id
:= Base_Type
(Etype
(R
));
313 Result_Type
: Entity_Id
;
317 -- Deal with floating-point case first
319 if Is_Floating_Point_Type
(Left_Type
) then
320 pragma Assert
(Left_Type
= Standard_Long_Long_Float
);
321 pragma Assert
(Right_Type
= Standard_Long_Long_Float
);
323 Rnode
:= Make_Op_Divide
(Loc
, L
, R
);
324 Result_Type
:= Standard_Long_Long_Float
;
326 -- Integer and fixed-point cases
329 -- An optimization. If the right operand is the literal 1, then we
330 -- can just return the left hand operand. Putting the optimization
331 -- here allows us to omit the check at the call site.
333 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
337 -- If left and right types are the same, no conversion needed
339 if Left_Type
= Right_Type
then
340 Result_Type
:= Left_Type
;
346 -- Use left type if it is the larger of the two
348 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
349 Result_Type
:= Left_Type
;
353 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
355 -- Otherwise right type is larger of the two, us it
358 Result_Type
:= Right_Type
;
361 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
366 -- We now have a divide node built with Result_Type set. First
367 -- set Etype of result, as required for all Build_xxx routines
369 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
371 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
372 -- since this is a literal arithmetic operation, to be performed
373 -- by Gigi without any consideration of small values.
375 if Is_Fixed_Point_Type
(Result_Type
) then
376 Set_Treat_Fixed_As_Integer
(Rnode
);
379 -- The result is rounded if the target of the operation is decimal
380 -- and Rounded_Result is set, or if the target of the operation
381 -- is an integer type.
383 if Is_Integer_Type
(Etype
(N
))
384 or else Rounded_Result_Set
(N
)
386 Set_Rounded_Result
(Rnode
);
393 -------------------------
394 -- Build_Double_Divide --
395 -------------------------
397 function Build_Double_Divide
402 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
403 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
407 if Y_Size
> System_Word_Size
409 Z_Size
> System_Word_Size
411 Disallow_In_No_Run_Time_Mode
(N
);
414 -- If denominator fits in 64 bits, we can build the operations directly
415 -- without causing any intermediate overflow, so that's what we do!
417 if Int
'Max (Y_Size
, Z_Size
) <= 32 then
419 Build_Divide
(N
, X
, Build_Multiply
(N
, Y
, Z
));
421 -- Otherwise we use the runtime routine
423 -- [Qnn : Interfaces.Integer_64,
424 -- Rnn : Interfaces.Integer_64;
425 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
430 Loc
: constant Source_Ptr
:= Sloc
(N
);
436 Build_Double_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
437 Insert_Actions
(N
, Code
);
438 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
440 -- Set type of result in case used elsewhere (see note at start)
442 Set_Etype
(Expr
, Etype
(Qnn
));
444 -- Set result as analyzed (see note at start on build routines)
449 end Build_Double_Divide
;
451 ------------------------------
452 -- Build_Double_Divide_Code --
453 ------------------------------
455 -- If the denominator can be computed in 64-bits, we build
457 -- [Nnn : constant typ := typ (X);
458 -- Dnn : constant typ := typ (Y) * typ (Z)
459 -- Qnn : constant typ := Nnn / Dnn;
460 -- Rnn : constant typ := Nnn / Dnn;
462 -- If the numerator cannot be computed in 64 bits, we build
466 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
468 procedure Build_Double_Divide_Code
471 Qnn
, Rnn
: out Entity_Id
;
474 Loc
: constant Source_Ptr
:= Sloc
(N
);
476 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
477 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
478 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
490 -- Find type that will allow computation of numerator
492 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
495 QR_Typ
:= Standard_Integer_16
;
496 elsif QR_Siz
<= 32 then
497 QR_Typ
:= Standard_Integer_32
;
498 elsif QR_Siz
<= 64 then
499 QR_Typ
:= Standard_Integer_64
;
501 -- For more than 64, bits, we use the 64-bit integer defined in
502 -- Interfaces, so that it can be handled by the runtime routine
505 QR_Typ
:= RTE
(RE_Integer_64
);
508 -- Define quotient and remainder, and set their Etypes, so
509 -- that they can be picked up by Build_xxx routines.
511 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
512 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
514 Set_Etype
(Qnn
, QR_Typ
);
515 Set_Etype
(Rnn
, QR_Typ
);
517 -- Case that we can compute the denominator in 64 bits
521 -- Create temporaries for numerator and denominator and set Etypes,
522 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
524 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
525 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
527 Set_Etype
(Nnn
, QR_Typ
);
528 Set_Etype
(Dnn
, QR_Typ
);
531 Make_Object_Declaration
(Loc
,
532 Defining_Identifier
=> Nnn
,
533 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
534 Constant_Present
=> True,
535 Expression
=> Build_Conversion
(N
, QR_Typ
, X
)),
537 Make_Object_Declaration
(Loc
,
538 Defining_Identifier
=> Dnn
,
539 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
540 Constant_Present
=> True,
543 Build_Conversion
(N
, QR_Typ
, Y
),
544 Build_Conversion
(N
, QR_Typ
, Z
))));
548 New_Occurrence_Of
(Nnn
, Loc
),
549 New_Occurrence_Of
(Dnn
, Loc
));
551 Set_Rounded_Result
(Quo
, Rounded_Result_Set
(N
));
554 Make_Object_Declaration
(Loc
,
555 Defining_Identifier
=> Qnn
,
556 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
557 Constant_Present
=> True,
561 Make_Object_Declaration
(Loc
,
562 Defining_Identifier
=> Rnn
,
563 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
564 Constant_Present
=> True,
567 New_Occurrence_Of
(Nnn
, Loc
),
568 New_Occurrence_Of
(Dnn
, Loc
))));
570 -- Case where denominator does not fit in 64 bits, so we have to
571 -- call the runtime routine to compute the quotient and remainder
574 if Rounded_Result_Set
(N
) then
575 Rnd
:= Standard_True
;
577 Rnd
:= Standard_False
;
581 Make_Object_Declaration
(Loc
,
582 Defining_Identifier
=> Qnn
,
583 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
585 Make_Object_Declaration
(Loc
,
586 Defining_Identifier
=> Rnn
,
587 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
589 Make_Procedure_Call_Statement
(Loc
,
590 Name
=> New_Occurrence_Of
(RTE
(RE_Double_Divide
), Loc
),
591 Parameter_Associations
=> New_List
(
592 Build_Conversion
(N
, QR_Typ
, X
),
593 Build_Conversion
(N
, QR_Typ
, Y
),
594 Build_Conversion
(N
, QR_Typ
, Z
),
595 New_Occurrence_Of
(Qnn
, Loc
),
596 New_Occurrence_Of
(Rnn
, Loc
),
597 New_Occurrence_Of
(Rnd
, Loc
))));
600 end Build_Double_Divide_Code
;
606 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
607 Loc
: constant Source_Ptr
:= Sloc
(N
);
608 Left_Type
: constant Entity_Id
:= Etype
(L
);
609 Right_Type
: constant Entity_Id
:= Etype
(R
);
611 Result_Type
: Entity_Id
;
615 -- Deal with floating-point case first
617 if Is_Floating_Point_Type
(Left_Type
) then
618 pragma Assert
(Left_Type
= Standard_Long_Long_Float
);
619 pragma Assert
(Right_Type
= Standard_Long_Long_Float
);
621 Result_Type
:= Standard_Long_Long_Float
;
622 Rnode
:= Make_Op_Multiply
(Loc
, L
, R
);
624 -- Integer and fixed-point cases
627 -- An optimization. If the right operand is the literal 1, then we
628 -- can just return the left hand operand. Putting the optimization
629 -- here allows us to omit the check at the call site. Similarly, if
630 -- the left operand is the integer 1 we can return the right operand.
632 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
634 elsif Nkind
(L
) = N_Integer_Literal
and then Intval
(L
) = 1 then
638 -- Otherwise we use a type that is at least twice the longer
641 Rsize
:= 2 * Int
'Max (UI_To_Int
(Esize
(Left_Type
)),
642 UI_To_Int
(Esize
(Right_Type
)));
645 Result_Type
:= Standard_Integer_8
;
647 elsif Rsize
<= 16 then
648 Result_Type
:= Standard_Integer_16
;
650 elsif Rsize
<= 32 then
651 Result_Type
:= Standard_Integer_32
;
654 if Rsize
> System_Word_Size
then
655 Disallow_In_No_Run_Time_Mode
(N
);
658 Result_Type
:= Standard_Integer_64
;
662 Make_Op_Multiply
(Loc
,
663 Left_Opnd
=> Build_Conversion
(N
, Result_Type
, L
),
664 Right_Opnd
=> Build_Conversion
(N
, Result_Type
, R
));
667 -- We now have a multiply node built with Result_Type set. First
668 -- set Etype of result, as required for all Build_xxx routines
670 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
672 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
673 -- since this is a literal arithmetic operation, to be performed
674 -- by Gigi without any consideration of small values.
676 if Is_Fixed_Point_Type
(Result_Type
) then
677 Set_Treat_Fixed_As_Integer
(Rnode
);
687 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
688 Loc
: constant Source_Ptr
:= Sloc
(N
);
689 Left_Type
: constant Entity_Id
:= Etype
(L
);
690 Right_Type
: constant Entity_Id
:= Etype
(R
);
691 Result_Type
: Entity_Id
;
695 if Left_Type
= Right_Type
then
696 Result_Type
:= Left_Type
;
702 -- If left size is larger, we do the remainder operation using the
703 -- size of the left type (i.e. the larger of the two integer types).
705 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
706 Result_Type
:= Left_Type
;
710 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
712 -- Similarly, if the right size is larger, we do the remainder
713 -- operation using the right type.
716 Result_Type
:= Right_Type
;
719 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
723 -- We now have an N_Op_Rem node built with Result_Type set. First
724 -- set Etype of result, as required for all Build_xxx routines
726 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
728 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
729 -- since this is a literal arithmetic operation, to be performed
730 -- by Gigi without any consideration of small values.
732 if Is_Fixed_Point_Type
(Result_Type
) then
733 Set_Treat_Fixed_As_Integer
(Rnode
);
736 -- One more check. We did the rem operation using the larger of the
737 -- two types, which is reasonable. However, in the case where the
738 -- two types have unequal sizes, it is impossible for the result of
739 -- a remainder operation to be larger than the smaller of the two
740 -- types, so we can put a conversion round the result to keep the
741 -- evolving operation size as small as possible.
743 if Esize
(Left_Type
) >= Esize
(Right_Type
) then
744 Rnode
:= Build_Conversion
(N
, Right_Type
, Rnode
);
745 elsif Esize
(Right_Type
) >= Esize
(Left_Type
) then
746 Rnode
:= Build_Conversion
(N
, Left_Type
, Rnode
);
752 -------------------------
753 -- Build_Scaled_Divide --
754 -------------------------
756 function Build_Scaled_Divide
761 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
762 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
766 -- If numerator fits in 64 bits, we can build the operations directly
767 -- without causing any intermediate overflow, so that's what we do!
769 if Int
'Max (X_Size
, Y_Size
) <= 32 then
771 Build_Divide
(N
, Build_Multiply
(N
, X
, Y
), Z
);
773 -- Otherwise we use the runtime routine
775 -- [Qnn : Integer_64,
777 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
782 Loc
: constant Source_Ptr
:= Sloc
(N
);
788 Build_Scaled_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
789 Insert_Actions
(N
, Code
);
790 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
792 -- Set type of result in case used elsewhere (see note at start)
794 Set_Etype
(Expr
, Etype
(Qnn
));
798 end Build_Scaled_Divide
;
800 ------------------------------
801 -- Build_Scaled_Divide_Code --
802 ------------------------------
804 -- If the numerator can be computed in 64-bits, we build
806 -- [Nnn : constant typ := typ (X) * typ (Y);
807 -- Dnn : constant typ := typ (Z)
808 -- Qnn : constant typ := Nnn / Dnn;
809 -- Rnn : constant typ := Nnn / Dnn;
811 -- If the numerator cannot be computed in 64 bits, we build
813 -- [Qnn : Interfaces.Integer_64;
814 -- Rnn : Interfaces.Integer_64;
815 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
817 procedure Build_Scaled_Divide_Code
820 Qnn
, Rnn
: out Entity_Id
;
823 Loc
: constant Source_Ptr
:= Sloc
(N
);
825 X_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(X
)));
826 Y_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Y
)));
827 Z_Size
: constant Int
:= UI_To_Int
(Esize
(Etype
(Z
)));
839 -- Find type that will allow computation of numerator
841 QR_Siz
:= Int
'Max (X_Size
, 2 * Int
'Max (Y_Size
, Z_Size
));
844 QR_Typ
:= Standard_Integer_16
;
845 elsif QR_Siz
<= 32 then
846 QR_Typ
:= Standard_Integer_32
;
847 elsif QR_Siz
<= 64 then
848 QR_Typ
:= Standard_Integer_64
;
850 -- For more than 64, bits, we use the 64-bit integer defined in
851 -- Interfaces, so that it can be handled by the runtime routine
854 QR_Typ
:= RTE
(RE_Integer_64
);
857 -- Define quotient and remainder, and set their Etypes, so
858 -- that they can be picked up by Build_xxx routines.
860 Qnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('S'));
861 Rnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('R'));
863 Set_Etype
(Qnn
, QR_Typ
);
864 Set_Etype
(Rnn
, QR_Typ
);
866 -- Case that we can compute the numerator in 64 bits
869 Nnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('N'));
870 Dnn
:= Make_Defining_Identifier
(Loc
, New_Internal_Name
('D'));
872 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
874 Set_Etype
(Nnn
, QR_Typ
);
875 Set_Etype
(Dnn
, QR_Typ
);
878 Make_Object_Declaration
(Loc
,
879 Defining_Identifier
=> Nnn
,
880 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
881 Constant_Present
=> True,
884 Build_Conversion
(N
, QR_Typ
, X
),
885 Build_Conversion
(N
, QR_Typ
, Y
))),
887 Make_Object_Declaration
(Loc
,
888 Defining_Identifier
=> Dnn
,
889 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
890 Constant_Present
=> True,
891 Expression
=> Build_Conversion
(N
, QR_Typ
, Z
)));
895 New_Occurrence_Of
(Nnn
, Loc
),
896 New_Occurrence_Of
(Dnn
, Loc
));
899 Make_Object_Declaration
(Loc
,
900 Defining_Identifier
=> Qnn
,
901 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
902 Constant_Present
=> True,
906 Make_Object_Declaration
(Loc
,
907 Defining_Identifier
=> Rnn
,
908 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
909 Constant_Present
=> True,
912 New_Occurrence_Of
(Nnn
, Loc
),
913 New_Occurrence_Of
(Dnn
, Loc
))));
915 -- Case where numerator does not fit in 64 bits, so we have to
916 -- call the runtime routine to compute the quotient and remainder
919 if Rounded_Result_Set
(N
) then
920 Rnd
:= Standard_True
;
922 Rnd
:= Standard_False
;
926 Make_Object_Declaration
(Loc
,
927 Defining_Identifier
=> Qnn
,
928 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
930 Make_Object_Declaration
(Loc
,
931 Defining_Identifier
=> Rnn
,
932 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
934 Make_Procedure_Call_Statement
(Loc
,
935 Name
=> New_Occurrence_Of
(RTE
(RE_Scaled_Divide
), Loc
),
936 Parameter_Associations
=> New_List
(
937 Build_Conversion
(N
, QR_Typ
, X
),
938 Build_Conversion
(N
, QR_Typ
, Y
),
939 Build_Conversion
(N
, QR_Typ
, Z
),
940 New_Occurrence_Of
(Qnn
, Loc
),
941 New_Occurrence_Of
(Rnn
, Loc
),
942 New_Occurrence_Of
(Rnd
, Loc
))));
945 -- Set type of result, for use in caller.
947 Set_Etype
(Qnn
, QR_Typ
);
948 end Build_Scaled_Divide_Code
;
950 ---------------------------
951 -- Do_Divide_Fixed_Fixed --
952 ---------------------------
956 -- (Result_Value * Result_Small) =
957 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
959 -- Result_Value = (Left_Value / Right_Value) *
960 -- (Left_Small / (Right_Small * Result_Small));
962 -- we can do the operation in integer arithmetic if this fraction is an
963 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
964 -- Otherwise the result is in the close result set and our approach is to
965 -- use floating-point to compute this close result.
967 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
) is
968 Left
: constant Node_Id
:= Left_Opnd
(N
);
969 Right
: constant Node_Id
:= Right_Opnd
(N
);
970 Left_Type
: constant Entity_Id
:= Etype
(Left
);
971 Right_Type
: constant Entity_Id
:= Etype
(Right
);
972 Result_Type
: constant Entity_Id
:= Etype
(N
);
973 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
974 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
976 Result_Small
: Ureal
;
983 -- Rounding is required if the result is integral
985 if Is_Integer_Type
(Result_Type
) then
986 Set_Rounded_Result
(N
);
989 -- Get result small. If the result is an integer, treat it as though
990 -- it had a small of 1.0, all other processing is identical.
992 if Is_Integer_Type
(Result_Type
) then
993 Result_Small
:= Ureal_1
;
995 Result_Small
:= Small_Value
(Result_Type
);
1000 Frac
:= Left_Small
/ (Right_Small
* Result_Small
);
1001 Frac_Num
:= Norm_Num
(Frac
);
1002 Frac_Den
:= Norm_Den
(Frac
);
1004 -- If the fraction is an integer, then we get the result by multiplying
1005 -- the left operand by the integer, and then dividing by the right
1006 -- operand (the order is important, if we did the divide first, we
1007 -- would lose precision).
1009 if Frac_Den
= 1 then
1010 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1012 if Present
(Lit_Int
) then
1013 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Right
));
1017 -- If the fraction is the reciprocal of an integer, then we get the
1018 -- result by first multiplying the divisor by the integer, and then
1019 -- doing the division with the adjusted divisor.
1021 -- Note: this is much better than doing two divisions: multiplications
1022 -- are much faster than divisions (and certainly faster than rounded
1023 -- divisions), and we don't get inaccuracies from double rounding.
1025 elsif Frac_Num
= 1 then
1026 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1028 if Present
(Lit_Int
) then
1029 Set_Result
(N
, Build_Double_Divide
(N
, Left
, Right
, Lit_Int
));
1034 -- If we fall through, we use floating-point to compute the result
1038 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1039 Real_Literal
(N
, Frac
)));
1041 end Do_Divide_Fixed_Fixed
;
1043 -------------------------------
1044 -- Do_Divide_Fixed_Universal --
1045 -------------------------------
1049 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1050 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1052 -- The result is required to be in the perfect result set if the literal
1053 -- can be factored so that the resulting small ratio is an integer or the
1054 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1055 -- analysis of these RM requirements:
1057 -- We must factor the literal, finding an integer K:
1059 -- Lit_Value = K * Right_Small
1060 -- Right_Small = Lit_Value / K
1062 -- such that the small ratio:
1065 -- ------------------------------
1066 -- (Lit_Value / K) * Result_Small
1069 -- = ------------------------ * K
1070 -- Lit_Value * Result_Small
1072 -- is an integer or the reciprocal of an integer, and for
1073 -- implementation efficiency we need the smallest such K.
1075 -- First we reduce the left fraction to lowest terms.
1077 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1078 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1079 -- Right_Small = Lit_Value.
1081 -- If numerator > 1, then set K to the denominator of the fraction so
1082 -- that the resulting small ratio is an integer (the numerator value).
1084 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
) is
1085 Left
: constant Node_Id
:= Left_Opnd
(N
);
1086 Right
: constant Node_Id
:= Right_Opnd
(N
);
1087 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1088 Result_Type
: constant Entity_Id
:= Etype
(N
);
1089 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1090 Lit_Value
: constant Ureal
:= Realval
(Right
);
1092 Result_Small
: Ureal
;
1100 -- Get result small. If the result is an integer, treat it as though
1101 -- it had a small of 1.0, all other processing is identical.
1103 if Is_Integer_Type
(Result_Type
) then
1104 Result_Small
:= Ureal_1
;
1106 Result_Small
:= Small_Value
(Result_Type
);
1109 -- Determine if literal can be rewritten successfully
1111 Frac
:= Left_Small
/ (Lit_Value
* Result_Small
);
1112 Frac_Num
:= Norm_Num
(Frac
);
1113 Frac_Den
:= Norm_Den
(Frac
);
1115 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1116 -- = denominator). If this integer is not too large, this is the case
1117 -- where the result can be obtained by dividing by this integer value.
1119 if Frac_Num
= 1 then
1120 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1122 if Present
(Lit_Int
) then
1123 Set_Result
(N
, Build_Divide
(N
, Left
, Lit_Int
));
1127 -- Case where we choose K to make fraction an integer (K = denominator
1128 -- of fraction, integer = numerator of fraction). If both K and the
1129 -- numerator are small enough, this is the case where the result can
1130 -- be obtained by first multiplying by the integer value and then
1131 -- dividing by K (the order is important, if we divided first, we
1132 -- would lose precision).
1135 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1136 Lit_K
:= Integer_Literal
(N
, Frac_Den
);
1138 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1139 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Lit_K
));
1144 -- Fall through if the literal cannot be successfully rewritten, or if
1145 -- the small ratio is out of range of integer arithmetic. In the former
1146 -- case it is fine to use floating-point to get the close result set,
1147 -- and in the latter case, it means that the result is zero or raises
1148 -- constraint error, and we can do that accurately in floating-point.
1150 -- If we end up using floating-point, then we take the right integer
1151 -- to be one, and its small to be the value of the original right real
1152 -- literal. That way, we need only one floating-point multiplication.
1155 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1157 end Do_Divide_Fixed_Universal
;
1159 -------------------------------
1160 -- Do_Divide_Universal_Fixed --
1161 -------------------------------
1165 -- (Result_Value * Result_Small) =
1166 -- Lit_Value / (Right_Value * Right_Small)
1168 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1170 -- The result is required to be in the perfect result set if the literal
1171 -- can be factored so that the resulting small ratio is an integer or the
1172 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1173 -- analysis of these RM requirements:
1175 -- We must factor the literal, finding an integer K:
1177 -- Lit_Value = K * Left_Small
1178 -- Left_Small = Lit_Value / K
1180 -- such that the small ratio:
1183 -- --------------------------
1184 -- Right_Small * Result_Small
1187 -- = -------------------------- * -
1188 -- Right_Small * Result_Small K
1190 -- is an integer or the reciprocal of an integer, and for
1191 -- implementation efficiency we need the smallest such K.
1193 -- First we reduce the left fraction to lowest terms.
1195 -- If denominator = 1, then for K = 1, the small ratio is an integer
1196 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1197 -- and Left_Small = Lit_Value.
1199 -- If denominator > 1, then set K to the numerator of the fraction so
1200 -- that the resulting small ratio is the reciprocal of an integer (the
1201 -- numerator value).
1203 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
) is
1204 Left
: constant Node_Id
:= Left_Opnd
(N
);
1205 Right
: constant Node_Id
:= Right_Opnd
(N
);
1206 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1207 Result_Type
: constant Entity_Id
:= Etype
(N
);
1208 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1209 Lit_Value
: constant Ureal
:= Realval
(Left
);
1211 Result_Small
: Ureal
;
1219 -- Get result small. If the result is an integer, treat it as though
1220 -- it had a small of 1.0, all other processing is identical.
1222 if Is_Integer_Type
(Result_Type
) then
1223 Result_Small
:= Ureal_1
;
1225 Result_Small
:= Small_Value
(Result_Type
);
1228 -- Determine if literal can be rewritten successfully
1230 Frac
:= Lit_Value
/ (Right_Small
* Result_Small
);
1231 Frac_Num
:= Norm_Num
(Frac
);
1232 Frac_Den
:= Norm_Den
(Frac
);
1234 -- Case where fraction is an integer (K = 1, integer = numerator). If
1235 -- this integer is not too large, this is the case where the result
1236 -- can be obtained by dividing this integer by the right operand.
1238 if Frac_Den
= 1 then
1239 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1241 if Present
(Lit_Int
) then
1242 Set_Result
(N
, Build_Divide
(N
, Lit_Int
, Right
));
1246 -- Case where we choose K to make the fraction the reciprocal of an
1247 -- integer (K = numerator of fraction, integer = numerator of fraction).
1248 -- If both K and the integer are small enough, this is the case where
1249 -- the result can be obtained by multiplying the right operand by K
1250 -- and then dividing by the integer value. The order of the operations
1251 -- is important (if we divided first, we would lose precision).
1254 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1255 Lit_K
:= Integer_Literal
(N
, Frac_Num
);
1257 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1258 Set_Result
(N
, Build_Double_Divide
(N
, Lit_K
, Right
, Lit_Int
));
1263 -- Fall through if the literal cannot be successfully rewritten, or if
1264 -- the small ratio is out of range of integer arithmetic. In the former
1265 -- case it is fine to use floating-point to get the close result set,
1266 -- and in the latter case, it means that the result is zero or raises
1267 -- constraint error, and we can do that accurately in floating-point.
1269 -- If we end up using floating-point, then we take the right integer
1270 -- to be one, and its small to be the value of the original right real
1271 -- literal. That way, we need only one floating-point division.
1274 Build_Divide
(N
, Real_Literal
(N
, Frac
), Fpt_Value
(Right
)));
1276 end Do_Divide_Universal_Fixed
;
1278 -----------------------------
1279 -- Do_Multiply_Fixed_Fixed --
1280 -----------------------------
1284 -- (Result_Value * Result_Small) =
1285 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1287 -- Result_Value = (Left_Value * Right_Value) *
1288 -- (Left_Small * Right_Small) / Result_Small;
1290 -- we can do the operation in integer arithmetic if this fraction is an
1291 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1292 -- Otherwise the result is in the close result set and our approach is to
1293 -- use floating-point to compute this close result.
1295 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
) is
1296 Left
: constant Node_Id
:= Left_Opnd
(N
);
1297 Right
: constant Node_Id
:= Right_Opnd
(N
);
1299 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1300 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1301 Result_Type
: constant Entity_Id
:= Etype
(N
);
1302 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1303 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1305 Result_Small
: Ureal
;
1312 -- Get result small. If the result is an integer, treat it as though
1313 -- it had a small of 1.0, all other processing is identical.
1315 if Is_Integer_Type
(Result_Type
) then
1316 Result_Small
:= Ureal_1
;
1318 Result_Small
:= Small_Value
(Result_Type
);
1323 Frac
:= (Left_Small
* Right_Small
) / Result_Small
;
1324 Frac_Num
:= Norm_Num
(Frac
);
1325 Frac_Den
:= Norm_Den
(Frac
);
1327 -- If the fraction is an integer, then we get the result by multiplying
1328 -- the operands, and then multiplying the result by the integer value.
1330 if Frac_Den
= 1 then
1331 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1333 if Present
(Lit_Int
) then
1335 Build_Multiply
(N
, Build_Multiply
(N
, Left
, Right
),
1340 -- If the fraction is the reciprocal of an integer, then we get the
1341 -- result by multiplying the operands, and then dividing the result by
1342 -- the integer value. The order of the operations is important, if we
1343 -- divided first, we would lose precision.
1345 elsif Frac_Num
= 1 then
1346 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1348 if Present
(Lit_Int
) then
1349 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Right
, Lit_Int
));
1354 -- If we fall through, we use floating-point to compute the result
1358 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1359 Real_Literal
(N
, Frac
)));
1361 end Do_Multiply_Fixed_Fixed
;
1363 ---------------------------------
1364 -- Do_Multiply_Fixed_Universal --
1365 ---------------------------------
1369 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1370 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1372 -- The result is required to be in the perfect result set if the literal
1373 -- can be factored so that the resulting small ratio is an integer or the
1374 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1375 -- analysis of these RM requirements:
1377 -- We must factor the literal, finding an integer K:
1379 -- Lit_Value = K * Right_Small
1380 -- Right_Small = Lit_Value / K
1382 -- such that the small ratio:
1384 -- Left_Small * (Lit_Value / K)
1385 -- ----------------------------
1388 -- Left_Small * Lit_Value 1
1389 -- = ---------------------- * -
1392 -- is an integer or the reciprocal of an integer, and for
1393 -- implementation efficiency we need the smallest such K.
1395 -- First we reduce the left fraction to lowest terms.
1397 -- If denominator = 1, then for K = 1, the small ratio is an
1398 -- integer, and this is clearly the minimum K case, so set
1399 -- K = 1, Right_Small = Lit_Value.
1401 -- If denominator > 1, then set K to the numerator of the
1402 -- fraction, so that the resulting small ratio is the
1403 -- reciprocal of the integer (the denominator value).
1405 procedure Do_Multiply_Fixed_Universal
1407 Left
, Right
: Node_Id
)
1409 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1410 Result_Type
: constant Entity_Id
:= Etype
(N
);
1411 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1412 Lit_Value
: constant Ureal
:= Realval
(Right
);
1414 Result_Small
: Ureal
;
1422 -- Get result small. If the result is an integer, treat it as though
1423 -- it had a small of 1.0, all other processing is identical.
1425 if Is_Integer_Type
(Result_Type
) then
1426 Result_Small
:= Ureal_1
;
1428 Result_Small
:= Small_Value
(Result_Type
);
1431 -- Determine if literal can be rewritten successfully
1433 Frac
:= (Left_Small
* Lit_Value
) / Result_Small
;
1434 Frac_Num
:= Norm_Num
(Frac
);
1435 Frac_Den
:= Norm_Den
(Frac
);
1437 -- Case where fraction is an integer (K = 1, integer = numerator). If
1438 -- this integer is not too large, this is the case where the result can
1439 -- be obtained by multiplying by this integer value.
1441 if Frac_Den
= 1 then
1442 Lit_Int
:= Integer_Literal
(N
, Frac_Num
);
1444 if Present
(Lit_Int
) then
1445 Set_Result
(N
, Build_Multiply
(N
, Left
, Lit_Int
));
1449 -- Case where we choose K to make fraction the reciprocal of an integer
1450 -- (K = numerator of fraction, integer = denominator of fraction). If
1451 -- both K and the denominator are small enough, this is the case where
1452 -- the result can be obtained by first multiplying by K, and then
1453 -- dividing by the integer value.
1456 Lit_Int
:= Integer_Literal
(N
, Frac_Den
);
1457 Lit_K
:= Integer_Literal
(N
, Frac_Num
);
1459 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1460 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_K
, Lit_Int
));
1465 -- Fall through if the literal cannot be successfully rewritten, or if
1466 -- the small ratio is out of range of integer arithmetic. In the former
1467 -- case it is fine to use floating-point to get the close result set,
1468 -- and in the latter case, it means that the result is zero or raises
1469 -- constraint error, and we can do that accurately in floating-point.
1471 -- If we end up using floating-point, then we take the right integer
1472 -- to be one, and its small to be the value of the original right real
1473 -- literal. That way, we need only one floating-point multiplication.
1476 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1478 end Do_Multiply_Fixed_Universal
;
1480 ---------------------------------
1481 -- Expand_Convert_Fixed_Static --
1482 ---------------------------------
1484 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
) is
1487 Convert_To
(Etype
(N
),
1488 Make_Real_Literal
(Sloc
(N
), Expr_Value_R
(Expression
(N
)))));
1489 Analyze_And_Resolve
(N
);
1490 end Expand_Convert_Fixed_Static
;
1492 -----------------------------------
1493 -- Expand_Convert_Fixed_To_Fixed --
1494 -----------------------------------
1498 -- Result_Value * Result_Small = Source_Value * Source_Small
1499 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1501 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1502 -- integer, then the perfect result set is obtained by a single integer
1505 -- If the small ratio is the reciprocal of a sufficiently small integer,
1506 -- then the perfect result set is obtained by a single integer division.
1508 -- In other cases, we obtain the close result set by calculating the
1509 -- result in floating-point.
1511 procedure Expand_Convert_Fixed_To_Fixed
(N
: Node_Id
) is
1512 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1513 Expr
: constant Node_Id
:= Expression
(N
);
1514 Result_Type
: constant Entity_Id
:= Etype
(N
);
1515 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1516 Small_Ratio
: Ureal
;
1522 if Is_OK_Static_Expression
(Expr
) then
1523 Expand_Convert_Fixed_Static
(N
);
1527 Small_Ratio
:= Small_Value
(Source_Type
) / Small_Value
(Result_Type
);
1528 Ratio_Num
:= Norm_Num
(Small_Ratio
);
1529 Ratio_Den
:= Norm_Den
(Small_Ratio
);
1531 if Ratio_Den
= 1 then
1533 if Ratio_Num
= 1 then
1534 Set_Result
(N
, Expr
);
1538 Lit
:= Integer_Literal
(N
, Ratio_Num
);
1540 if Present
(Lit
) then
1541 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
));
1546 elsif Ratio_Num
= 1 then
1547 Lit
:= Integer_Literal
(N
, Ratio_Den
);
1549 if Present
(Lit
) then
1550 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1555 -- Fall through to use floating-point for the close result set case
1556 -- either as a result of the small ratio not being an integer or the
1557 -- reciprocal of an integer, or if the integer is out of range.
1562 Real_Literal
(N
, Small_Ratio
)),
1565 end Expand_Convert_Fixed_To_Fixed
;
1567 -----------------------------------
1568 -- Expand_Convert_Fixed_To_Float --
1569 -----------------------------------
1571 -- If the small of the fixed type is 1.0, then we simply convert the
1572 -- integer value directly to the target floating-point type, otherwise
1573 -- we first have to multiply by the small, in Long_Long_Float, and then
1574 -- convert the result to the target floating-point type.
1576 procedure Expand_Convert_Fixed_To_Float
(N
: Node_Id
) is
1577 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1578 Expr
: constant Node_Id
:= Expression
(N
);
1579 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1580 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1583 if Is_OK_Static_Expression
(Expr
) then
1584 Expand_Convert_Fixed_Static
(N
);
1588 if Small
= Ureal_1
then
1589 Set_Result
(N
, Expr
);
1595 Real_Literal
(N
, Small
)),
1598 end Expand_Convert_Fixed_To_Float
;
1600 -------------------------------------
1601 -- Expand_Convert_Fixed_To_Integer --
1602 -------------------------------------
1606 -- Result_Value = Source_Value * Source_Small
1608 -- If the small value is a sufficiently small integer, then the perfect
1609 -- result set is obtained by a single integer multiplication.
1611 -- If the small value is the reciprocal of a sufficiently small integer,
1612 -- then the perfect result set is obtained by a single integer division.
1614 -- In other cases, we obtain the close result set by calculating the
1615 -- result in floating-point.
1617 procedure Expand_Convert_Fixed_To_Integer
(N
: Node_Id
) is
1618 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1619 Expr
: constant Node_Id
:= Expression
(N
);
1620 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1621 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1622 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1623 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1627 if Is_OK_Static_Expression
(Expr
) then
1628 Expand_Convert_Fixed_Static
(N
);
1632 if Small_Den
= 1 then
1633 Lit
:= Integer_Literal
(N
, Small_Num
);
1635 if Present
(Lit
) then
1636 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1640 elsif Small_Num
= 1 then
1641 Lit
:= Integer_Literal
(N
, Small_Den
);
1643 if Present
(Lit
) then
1644 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1649 -- Fall through to use floating-point for the close result set case
1650 -- either as a result of the small value not being an integer or the
1651 -- reciprocal of an integer, or if the integer is out of range.
1656 Real_Literal
(N
, Small
)),
1659 end Expand_Convert_Fixed_To_Integer
;
1661 -----------------------------------
1662 -- Expand_Convert_Float_To_Fixed --
1663 -----------------------------------
1667 -- Result_Value * Result_Small = Operand_Value
1671 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1673 -- We do the small scaling in floating-point, and we do a multiplication
1674 -- rather than a division, since it is accurate enough for the perfect
1675 -- result cases, and faster.
1677 procedure Expand_Convert_Float_To_Fixed
(N
: Node_Id
) is
1678 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1679 Expr
: constant Node_Id
:= Expression
(N
);
1680 Result_Type
: constant Entity_Id
:= Etype
(N
);
1681 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1684 -- Optimize small = 1, where we can avoid the multiply completely
1686 if Small
= Ureal_1
then
1687 Set_Result
(N
, Expr
, Rng_Check
);
1689 -- Normal case where multiply is required
1695 Real_Literal
(N
, Ureal_1
/ Small
)),
1698 end Expand_Convert_Float_To_Fixed
;
1700 -------------------------------------
1701 -- Expand_Convert_Integer_To_Fixed --
1702 -------------------------------------
1706 -- Result_Value * Result_Small = Operand_Value
1707 -- Result_Value = Operand_Value / Result_Small
1709 -- If the small value is a sufficiently small integer, then the perfect
1710 -- result set is obtained by a single integer division.
1712 -- If the small value is the reciprocal of a sufficiently small integer,
1713 -- the perfect result set is obtained by a single integer multiplication.
1715 -- In other cases, we obtain the close result set by calculating the
1716 -- result in floating-point using a multiplication by the reciprocal
1717 -- of the Result_Small.
1719 procedure Expand_Convert_Integer_To_Fixed
(N
: Node_Id
) is
1720 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1721 Expr
: constant Node_Id
:= Expression
(N
);
1722 Result_Type
: constant Entity_Id
:= Etype
(N
);
1723 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1724 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1725 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1729 if Small_Den
= 1 then
1730 Lit
:= Integer_Literal
(N
, Small_Num
);
1732 if Present
(Lit
) then
1733 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit
), Rng_Check
);
1737 elsif Small_Num
= 1 then
1738 Lit
:= Integer_Literal
(N
, Small_Den
);
1740 if Present
(Lit
) then
1741 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit
), Rng_Check
);
1746 -- Fall through to use floating-point for the close result set case
1747 -- either as a result of the small value not being an integer or the
1748 -- reciprocal of an integer, or if the integer is out of range.
1753 Real_Literal
(N
, Ureal_1
/ Small
)),
1756 end Expand_Convert_Integer_To_Fixed
;
1758 --------------------------------
1759 -- Expand_Decimal_Divide_Call --
1760 --------------------------------
1762 -- We have four operands
1769 -- All of which are decimal types, and which thus have associated
1772 -- Computing the quotient is a similar problem to that faced by the
1773 -- normal fixed-point division, except that it is simpler, because
1774 -- we always have compatible smalls.
1776 -- Quotient = (Dividend / Divisor) * 10**q
1778 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1779 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1781 -- For q >= 0, we compute
1783 -- Numerator := Dividend * 10 ** q
1784 -- Denominator := Divisor
1785 -- Quotient := Numerator / Denominator
1787 -- For q < 0, we compute
1789 -- Numerator := Dividend
1790 -- Denominator := Divisor * 10 ** q
1791 -- Quotient := Numerator / Denominator
1793 -- Both these divisions are done in truncated mode, and the remainder
1794 -- from these divisions is used to compute the result Remainder. This
1795 -- remainder has the effective scale of the numerator of the division,
1797 -- For q >= 0, the remainder scale is Dividend'Scale + q
1798 -- For q < 0, the remainder scale is Dividend'Scale
1800 -- The result Remainder is then computed by a normal truncating decimal
1801 -- conversion from this scale to the scale of the remainder, i.e. by a
1802 -- division or multiplication by the appropriate power of 10.
1804 procedure Expand_Decimal_Divide_Call
(N
: Node_Id
) is
1805 Loc
: constant Source_Ptr
:= Sloc
(N
);
1807 Dividend
: Node_Id
:= First_Actual
(N
);
1808 Divisor
: Node_Id
:= Next_Actual
(Dividend
);
1809 Quotient
: Node_Id
:= Next_Actual
(Divisor
);
1810 Remainder
: Node_Id
:= Next_Actual
(Quotient
);
1812 Dividend_Type
: constant Entity_Id
:= Etype
(Dividend
);
1813 Divisor_Type
: constant Entity_Id
:= Etype
(Divisor
);
1814 Quotient_Type
: constant Entity_Id
:= Etype
(Quotient
);
1815 Remainder_Type
: constant Entity_Id
:= Etype
(Remainder
);
1817 Dividend_Scale
: constant Uint
:= Scale_Value
(Dividend_Type
);
1818 Divisor_Scale
: constant Uint
:= Scale_Value
(Divisor_Type
);
1819 Quotient_Scale
: constant Uint
:= Scale_Value
(Quotient_Type
);
1820 Remainder_Scale
: constant Uint
:= Scale_Value
(Remainder_Type
);
1823 Numerator_Scale
: Uint
;
1827 Computed_Remainder
: Node_Id
;
1828 Adjusted_Remainder
: Node_Id
;
1829 Scale_Adjust
: Uint
;
1832 -- Relocate the operands, since they are now list elements, and we
1833 -- need to reference them separately as operands in the expanded code.
1835 Dividend
:= Relocate_Node
(Dividend
);
1836 Divisor
:= Relocate_Node
(Divisor
);
1837 Quotient
:= Relocate_Node
(Quotient
);
1838 Remainder
:= Relocate_Node
(Remainder
);
1840 -- Now compute Q, the adjustment scale
1842 Q
:= Divisor_Scale
+ Quotient_Scale
- Dividend_Scale
;
1844 -- If Q is non-negative then we need a scaled divide
1847 Build_Scaled_Divide_Code
1850 Integer_Literal
(N
, Uint_10
** Q
),
1854 Numerator_Scale
:= Dividend_Scale
+ Q
;
1856 -- If Q is negative, then we need a double divide
1859 Build_Double_Divide_Code
1863 Integer_Literal
(N
, Uint_10
** (-Q
)),
1866 Numerator_Scale
:= Dividend_Scale
;
1869 -- Add statement to set quotient value
1871 -- Quotient := quotient-type!(Qnn);
1874 Make_Assignment_Statement
(Loc
,
1877 Unchecked_Convert_To
(Quotient_Type
,
1878 Build_Conversion
(N
, Quotient_Type
,
1879 New_Occurrence_Of
(Qnn
, Loc
)))));
1881 -- Now we need to deal with computing and setting the remainder. The
1882 -- scale of the remainder is in Numerator_Scale, and the desired
1883 -- scale is the scale of the given Remainder argument. There are
1886 -- Numerator_Scale > Remainder_Scale
1888 -- in this case, there are extra digits in the computed remainder
1889 -- which must be eliminated by an extra division:
1891 -- computed-remainder := Numerator rem Denominator
1892 -- scale_adjust = Numerator_Scale - Remainder_Scale
1893 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1895 -- Numerator_Scale = Remainder_Scale
1897 -- in this case, the we have the remainder we need
1899 -- computed-remainder := Numerator rem Denominator
1900 -- adjusted-remainder := computed-remainder
1902 -- Numerator_Scale < Remainder_Scale
1904 -- in this case, we have insufficient digits in the computed
1905 -- remainder, which must be eliminated by an extra multiply
1907 -- computed-remainder := Numerator rem Denominator
1908 -- scale_adjust = Remainder_Scale - Numerator_Scale
1909 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1911 -- Finally we assign the adjusted-remainder to the result Remainder
1912 -- with conversions to get the proper fixed-point type representation.
1914 Computed_Remainder
:= New_Occurrence_Of
(Rnn
, Loc
);
1916 if Numerator_Scale
> Remainder_Scale
then
1917 Scale_Adjust
:= Numerator_Scale
- Remainder_Scale
;
1918 Adjusted_Remainder
:=
1920 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1922 elsif Numerator_Scale
= Remainder_Scale
then
1923 Adjusted_Remainder
:= Computed_Remainder
;
1925 else -- Numerator_Scale < Remainder_Scale
1926 Scale_Adjust
:= Remainder_Scale
- Numerator_Scale
;
1927 Adjusted_Remainder
:=
1929 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
1932 -- Assignment of remainder result
1935 Make_Assignment_Statement
(Loc
,
1938 Unchecked_Convert_To
(Remainder_Type
, Adjusted_Remainder
)));
1940 -- Final step is to rewrite the call with a block containing the
1941 -- above sequence of constructed statements for the divide operation.
1944 Make_Block_Statement
(Loc
,
1945 Handled_Statement_Sequence
=>
1946 Make_Handled_Sequence_Of_Statements
(Loc
,
1947 Statements
=> Stmts
)));
1951 end Expand_Decimal_Divide_Call
;
1953 -----------------------------------------------
1954 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1955 -----------------------------------------------
1957 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
1958 Left
: constant Node_Id
:= Left_Opnd
(N
);
1959 Right
: constant Node_Id
:= Right_Opnd
(N
);
1962 -- Suppress expansion of a fixed-by-fixed division if the
1963 -- operation is supported directly by the target.
1965 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
1969 if Etype
(Left
) = Universal_Real
then
1970 Do_Divide_Universal_Fixed
(N
);
1972 elsif Etype
(Right
) = Universal_Real
then
1973 Do_Divide_Fixed_Universal
(N
);
1976 Do_Divide_Fixed_Fixed
(N
);
1979 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed
;
1981 -----------------------------------------------
1982 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1983 -----------------------------------------------
1985 -- The division is done in long_long_float, and the result is multiplied
1986 -- by the small ratio, which is Small (Right) / Small (Left). Special
1987 -- treatment is required for universal operands, which represent their
1988 -- own value and do not require conversion.
1990 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
1991 Left
: constant Node_Id
:= Left_Opnd
(N
);
1992 Right
: constant Node_Id
:= Right_Opnd
(N
);
1994 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1995 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1998 -- Case of left operand is universal real, the result we want is:
2000 -- Left_Value / (Right_Value * Right_Small)
2002 -- so we compute this as:
2004 -- (Left_Value / Right_Small) / Right_Value
2006 if Left_Type
= Universal_Real
then
2009 Real_Literal
(N
, Realval
(Left
) / Small_Value
(Right_Type
)),
2010 Fpt_Value
(Right
)));
2012 -- Case of right operand is universal real, the result we want is
2014 -- (Left_Value * Left_Small) / Right_Value
2016 -- so we compute this as:
2018 -- Left_Value * (Left_Small / Right_Value)
2020 -- Note we invert to a multiplication since usually floating-point
2021 -- multiplication is much faster than floating-point division.
2023 elsif Right_Type
= Universal_Real
then
2027 Real_Literal
(N
, Small_Value
(Left_Type
) / Realval
(Right
))));
2029 -- Both operands are fixed, so the value we want is
2031 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2033 -- which we compute as:
2035 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2040 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2042 Small_Value
(Left_Type
) / Small_Value
(Right_Type
))));
2045 end Expand_Divide_Fixed_By_Fixed_Giving_Float
;
2047 -------------------------------------------------
2048 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2049 -------------------------------------------------
2051 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2052 Left
: constant Node_Id
:= Left_Opnd
(N
);
2053 Right
: constant Node_Id
:= Right_Opnd
(N
);
2056 if Etype
(Left
) = Universal_Real
then
2057 Do_Divide_Universal_Fixed
(N
);
2059 elsif Etype
(Right
) = Universal_Real
then
2060 Do_Divide_Fixed_Universal
(N
);
2063 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
);
2080 Set_Result
(N
, Build_Divide
(N
, Left
, Right
));
2081 end Expand_Divide_Fixed_By_Integer_Giving_Fixed
;
2083 -------------------------------------------------
2084 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2085 -------------------------------------------------
2087 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2088 Left
: constant Node_Id
:= Left_Opnd
(N
);
2089 Right
: constant Node_Id
:= Right_Opnd
(N
);
2091 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
);
2092 -- The operand may be a non-static universal value, such an
2093 -- exponentiation with a non-static exponent. In that case, treat
2094 -- as a fixed * fixed multiplication, and convert the argument to
2095 -- the target fixed type.
2097 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
) is
2098 Loc
: constant Source_Ptr
:= Sloc
(N
);
2102 Make_Type_Conversion
(Loc
,
2103 Subtype_Mark
=> New_Occurrence_Of
(Etype
(N
), Loc
),
2104 Expression
=> Expression
(Opnd
)));
2105 Analyze_And_Resolve
(Opnd
, Etype
(N
));
2106 end Rewrite_Non_Static_Universal
;
2109 -- Suppress expansion of a fixed-by-fixed multiplication if the
2110 -- operation is supported directly by the target.
2112 if Target_Has_Fixed_Ops
(Etype
(Left
), Etype
(Right
), Etype
(N
)) then
2116 if Etype
(Left
) = Universal_Real
then
2117 if Nkind
(Left
) = N_Real_Literal
then
2118 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2120 elsif Nkind
(Left
) = N_Type_Conversion
then
2121 Rewrite_Non_Static_Universal
(Left
);
2122 Do_Multiply_Fixed_Fixed
(N
);
2125 elsif Etype
(Right
) = Universal_Real
then
2126 if Nkind
(Right
) = N_Real_Literal
then
2127 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2129 elsif Nkind
(Right
) = N_Type_Conversion
then
2130 Rewrite_Non_Static_Universal
(Right
);
2131 Do_Multiply_Fixed_Fixed
(N
);
2135 Do_Multiply_Fixed_Fixed
(N
);
2138 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
;
2140 -------------------------------------------------
2141 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2142 -------------------------------------------------
2144 -- The multiply is done in long_long_float, and the result is multiplied
2145 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2146 -- Special treatment is required for universal operands.
2148 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2149 Left
: constant Node_Id
:= Left_Opnd
(N
);
2150 Right
: constant Node_Id
:= Right_Opnd
(N
);
2152 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2153 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2156 -- Case of left operand is universal real, the result we want is
2158 -- Left_Value * (Right_Value * Right_Small)
2160 -- so we compute this as:
2162 -- (Left_Value * Right_Small) * Right_Value;
2164 if Left_Type
= Universal_Real
then
2167 Real_Literal
(N
, Realval
(Left
) * Small_Value
(Right_Type
)),
2168 Fpt_Value
(Right
)));
2170 -- Case of right operand is universal real, the result we want is
2172 -- (Left_Value * Left_Small) * Right_Value
2174 -- so we compute this as:
2176 -- Left_Value * (Left_Small * Right_Value)
2178 elsif Right_Type
= Universal_Real
then
2182 Real_Literal
(N
, Small_Value
(Left_Type
) * Realval
(Right
))));
2184 -- Both operands are fixed, so the value we want is
2186 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2188 -- which we compute as:
2190 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2195 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2197 Small_Value
(Right_Type
) * Small_Value
(Left_Type
))));
2200 end Expand_Multiply_Fixed_By_Fixed_Giving_Float
;
2202 ---------------------------------------------------
2203 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2204 ---------------------------------------------------
2206 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2207 Left
: constant Node_Id
:= Left_Opnd
(N
);
2208 Right
: constant Node_Id
:= Right_Opnd
(N
);
2211 if Etype
(Left
) = Universal_Real
then
2212 Do_Multiply_Fixed_Universal
(N
, Right
, Left
);
2214 elsif Etype
(Right
) = Universal_Real
then
2215 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2218 Do_Multiply_Fixed_Fixed
(N
);
2221 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer
;
2223 ---------------------------------------------------
2224 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2225 ---------------------------------------------------
2227 -- Since the operand and result fixed-point type is the same, this is
2228 -- a straight multiply by the right operand, the small can be ignored.
2230 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2233 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2234 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed
;
2236 ---------------------------------------------------
2237 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2238 ---------------------------------------------------
2240 -- Since the operand and result fixed-point type is the same, this is
2241 -- a straight multiply by the right operand, the small can be ignored.
2243 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2246 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2247 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed
;
2253 function Fpt_Value
(N
: Node_Id
) return Node_Id
is
2254 Typ
: constant Entity_Id
:= Etype
(N
);
2257 if Is_Integer_Type
(Typ
)
2258 or else Is_Floating_Point_Type
(Typ
)
2262 (N
, Standard_Long_Long_Float
, N
);
2264 -- Fixed-point case, must get integer value first
2268 Build_Conversion
(N
, Standard_Long_Long_Float
, N
);
2273 ---------------------
2274 -- Integer_Literal --
2275 ---------------------
2277 function Integer_Literal
(N
: Node_Id
; V
: Uint
) return Node_Id
is
2282 if V
< Uint_2
** 7 then
2283 T
:= Standard_Integer_8
;
2285 elsif V
< Uint_2
** 15 then
2286 T
:= Standard_Integer_16
;
2288 elsif V
< Uint_2
** 31 then
2289 T
:= Standard_Integer_32
;
2291 elsif V
< Uint_2
** 63 then
2292 T
:= Standard_Integer_64
;
2298 L
:= Make_Integer_Literal
(Sloc
(N
), V
);
2300 -- Set type of result in case used elsewhere (see note at start)
2303 Set_Is_Static_Expression
(L
);
2305 -- We really need to set Analyzed here because we may be creating a
2306 -- very strange beast, namely an integer literal typed as fixed-point
2307 -- and the analyzer won't like that. Probably we should allow the
2308 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2309 -- and teach the analyzer how to handle them ???
2314 end Integer_Literal
;
2320 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
is
2324 L
:= Make_Real_Literal
(Sloc
(N
), V
);
2326 -- Set type of result in case used elsewhere (see note at start)
2328 Set_Etype
(L
, Standard_Long_Long_Float
);
2332 ------------------------
2333 -- Rounded_Result_Set --
2334 ------------------------
2336 function Rounded_Result_Set
(N
: Node_Id
) return Boolean is
2337 K
: constant Node_Kind
:= Nkind
(N
);
2340 if (K
= N_Type_Conversion
or else
2341 K
= N_Op_Divide
or else
2343 and then Rounded_Result
(N
)
2349 end Rounded_Result_Set
;
2355 procedure Set_Result
2358 Rchk
: Boolean := False)
2362 Expr_Type
: constant Entity_Id
:= Etype
(Expr
);
2363 Result_Type
: constant Entity_Id
:= Etype
(N
);
2366 -- No conversion required if types match and no range check
2368 if Result_Type
= Expr_Type
and then not Rchk
then
2371 -- Else perform required conversion
2374 Cnode
:= Build_Conversion
(N
, Result_Type
, Expr
, Rchk
);
2378 Analyze_And_Resolve
(N
, Result_Type
);