1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2024, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree
; use Atree
;
27 with Checks
; use Checks
;
28 with Debug
; use Debug
;
29 with Einfo
; use Einfo
;
30 with Einfo
.Entities
; use Einfo
.Entities
;
31 with Einfo
.Utils
; use Einfo
.Utils
;
32 with Exp_Util
; use Exp_Util
;
33 with Nlists
; use Nlists
;
34 with Nmake
; use Nmake
;
35 with Restrict
; use Restrict
;
36 with Rident
; use Rident
;
37 with Rtsfind
; use Rtsfind
;
39 with Sem_Eval
; use Sem_Eval
;
40 with Sem_Res
; use Sem_Res
;
41 with Sem_Util
; use Sem_Util
;
42 with Sinfo
; use Sinfo
;
43 with Sinfo
.Nodes
; use Sinfo
.Nodes
;
44 with Stand
; use Stand
;
45 with Tbuild
; use Tbuild
;
46 with Ttypes
; use Ttypes
;
47 with Uintp
; use Uintp
;
48 with Urealp
; use Urealp
;
50 package body Exp_Fixd
is
52 -----------------------
53 -- Local Subprograms --
54 -----------------------
56 -- General note; in this unit, a number of routines are driven by the
57 -- types (Etype) of their operands. Since we are dealing with unanalyzed
58 -- expressions as they are constructed, the Etypes would not normally be
59 -- set, but the construction routines that we use in this unit do in fact
60 -- set the Etype values correctly. In addition, setting the Etype ensures
61 -- that the analyzer does not try to redetermine the type when the node
62 -- is analyzed (which would be wrong, since in the case where we set the
63 -- Conversion_OK flag, it would think it was still dealing with a normal
64 -- fixed-point operation and mess it up).
66 function Build_Conversion
70 Rchk
: Boolean := False;
71 Trunc
: Boolean := False) return Node_Id
;
72 -- Build an expression that converts the expression Expr to type Typ,
73 -- taking the source location from Sloc (N). If the conversions involve
74 -- fixed-point types, then the Conversion_OK flag will be set so that the
75 -- resulting conversions do not get re-expanded. On return, the resulting
76 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
77 -- in the resulting conversion node. If Trunc is set, then the
78 -- Float_Truncate flag is set on the conversion, which must be from
79 -- a floating-point type to an integer type.
81 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
82 -- Builds an N_Op_Divide node from the given left and right operand
83 -- expressions, using the source location from Sloc (N). The operands are
84 -- either both Universal_Real, in which case Build_Divide differs from
85 -- Make_Op_Divide only in that the Etype of the resulting node is set (to
86 -- Universal_Real), or they can be integer or fixed-point types. In this
87 -- case the types need not be the same, and Build_Divide chooses a type
88 -- long enough to hold both operands (i.e. the size of the longer of the
89 -- two operand types), and both operands are converted to this type. The
90 -- Etype of the result is also set to this value. The Rounded_Result flag
91 -- of the result in this case is set from the Rounded_Result flag of node
92 -- N. On return, the resulting node has its Etype set.
94 function Build_Double_Divide
96 X
, Y
, Z
: Node_Id
) return Node_Id
;
97 -- Returns a node corresponding to the value X/(Y*Z) using the source
98 -- location from Sloc (N). The division is rounded if the Rounded_Result
99 -- flag of N is set. The integer types of X, Y, Z may be different. On
100 -- return, the resulting node has its Etype set.
102 procedure Build_Double_Divide_Code
105 Qnn
, Rnn
: out Entity_Id
;
107 -- Generates a sequence of code for determining the quotient and remainder
108 -- of the division X/(Y*Z), using the source location from Sloc (N).
109 -- Entities of appropriate types are allocated for the quotient and
110 -- remainder and returned in Qnn and Rnn. The result is rounded if the
111 -- Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are
112 -- appropriately set on return.
114 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
115 -- Builds an N_Op_Multiply node from the given left and right operand
116 -- expressions, using the source location from Sloc (N). The operands are
117 -- either both Universal_Real, in which case Build_Multiply differs from
118 -- Make_Op_Multiply only in that the Etype of the resulting node is set (to
119 -- Universal_Real), or they can be integer or fixed-point types. In this
120 -- case the types need not be the same, and Build_Multiply chooses a type
121 -- long enough to hold the product and both operands are converted to this
122 -- type. The type of the result is also set to this value. On return, the
123 -- resulting node has its Etype set.
125 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
;
126 -- Builds an N_Op_Rem node from the given left and right operand
127 -- expressions, using the source location from Sloc (N). The operands are
128 -- both integer types, which need not be the same. Build_Rem converts the
129 -- operand with the smaller sized type to match the type of the other
130 -- operand and sets this as the result type. The result is never rounded
131 -- (rem operations cannot be rounded in any case). On return, the resulting
132 -- node has its Etype set.
134 function Build_Scaled_Divide
136 X
, Y
, Z
: Node_Id
) return Node_Id
;
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 has its 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 Universal_Real value. The expression
190 -- can be of integer type, floating-point type, or fixed-point type.
191 -- The expression returned is neither analyzed nor resolved. The Etype
192 -- of the result is properly set (to Universal_Real).
194 function Get_Size_For_Value
(V
: Uint
) return Pos
;
195 -- Given a non-negative universal integer value, return the size of a small
196 -- signed integer type covering -V .. V, or Pos'Max if no such type exists.
198 function Get_Type_For_Size
(Siz
: Pos
; Force
: Boolean) return Entity_Id
;
199 -- Return the smallest signed integer type containing at least Siz bits.
200 -- If no such type exists, return Empty if Force is False or the largest
201 -- signed integer type if Force is True.
203 function Integer_Literal
206 Negative
: Boolean := False) return Node_Id
;
207 -- Given a non-negative universal integer value, build a typed integer
208 -- literal node, using the smallest applicable standard integer type.
209 -- If Negative is true, then a negative literal is built. If V exceeds
210 -- 2**(System_Max_Integer_Size - 1) - 1, the largest value allowed for
211 -- perfect result set scaling factors (see RM G.2.3(22)), then Empty is
212 -- returned. The node N provides the Sloc value for the constructed
213 -- literal. The Etype of the resulting literal is correctly set, and it
214 -- is marked as analyzed.
216 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
;
217 -- Build a real literal node from the given value, the Etype of the
218 -- returned node is set to Universal_Real, since all floating-point
219 -- arithmetic operations that we construct use Universal_Real
221 function Rounded_Result_Set
(N
: Node_Id
) return Boolean;
222 -- Returns True if N is a node that contains the Rounded_Result flag
223 -- and if the flag is true or the target type is an integer type.
228 Rchk
: Boolean := False;
229 Trunc
: Boolean := False);
230 -- N is the node for the current conversion, division or multiplication
231 -- operation, and Expr is an expression representing the result. Expr may
232 -- be of floating-point or integer type. If the operation result is fixed-
233 -- point, then the value of Expr is in units of small of the result type
234 -- (i.e. small's have already been dealt with). The result of the call is
235 -- to replace N by an appropriate conversion to the result type, dealing
236 -- with rounding for the decimal types case. The node is then analyzed and
237 -- resolved using the result type. If Rchk or Trunc are True, then
238 -- respectively Do_Range_Check and Float_Truncate are set in the
239 -- resulting conversion.
241 ----------------------
242 -- Build_Conversion --
243 ----------------------
245 function Build_Conversion
249 Rchk
: Boolean := False;
250 Trunc
: Boolean := False) return Node_Id
252 Loc
: constant Source_Ptr
:= Sloc
(N
);
254 Rcheck
: Boolean := Rchk
;
257 -- A special case, if the expression is an integer literal and the
258 -- target type is an integer type, then just retype the integer
259 -- literal to the desired target type. Don't do this if we need
262 if Nkind
(Expr
) = N_Integer_Literal
263 and then Is_Integer_Type
(Typ
)
268 -- Cases where we end up with a conversion. Note that we do not use the
269 -- Convert_To abstraction here, since we may be decorating the resulting
270 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
271 -- conversion node present, even if it appears to be redundant.
274 -- Remove inner conversion if both inner and outer conversions are
275 -- to integer types, since the inner one serves no purpose (except
276 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
277 -- and also preserve the Conversion_OK and Do_Range_Check flags of
278 -- the inner conversion.
280 if Is_Integer_Type
(Typ
)
281 and then Is_Integer_Type
(Etype
(Expr
))
282 and then Nkind
(Expr
) = N_Type_Conversion
285 Make_Type_Conversion
(Loc
,
286 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
287 Expression
=> Expression
(Expr
));
288 Set_Rounded_Result
(Result
, Rounded_Result_Set
(Expr
));
289 Set_Conversion_OK
(Result
, Conversion_OK
(Expr
));
290 Rcheck
:= Rcheck
or Do_Range_Check
(Expr
);
292 -- For all other cases, a simple type conversion will work
296 Make_Type_Conversion
(Loc
,
297 Subtype_Mark
=> New_Occurrence_Of
(Typ
, Loc
),
300 Set_Float_Truncate
(Result
, Trunc
);
303 -- Set Conversion_OK if either result or expression type is a
304 -- fixed-point type, since from a semantic point of view, we are
305 -- treating fixed-point values as integers at this stage.
307 if Is_Fixed_Point_Type
(Typ
)
308 or else Is_Fixed_Point_Type
(Etype
(Expression
(Result
)))
310 Set_Conversion_OK
(Result
);
313 -- Set Do_Range_Check if either it was requested by the caller,
314 -- or if an eliminated inner conversion had a range check.
317 Enable_Range_Check
(Result
);
319 Set_Do_Range_Check
(Result
, False);
323 Set_Etype
(Result
, Typ
);
325 end Build_Conversion
;
331 function Build_Divide
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
332 Loc
: constant Source_Ptr
:= Sloc
(N
);
333 Left_Type
: constant Entity_Id
:= Base_Type
(Etype
(L
));
334 Right_Type
: constant Entity_Id
:= Base_Type
(Etype
(R
));
337 Result_Type
: Entity_Id
;
341 -- Deal with floating-point case first
343 if Is_Floating_Point_Type
(Left_Type
) then
344 pragma Assert
(Left_Type
= Universal_Real
);
345 pragma Assert
(Right_Type
= Universal_Real
);
347 Rnode
:= Make_Op_Divide
(Loc
, L
, R
);
348 Result_Type
:= Universal_Real
;
350 -- Integer and fixed-point cases
353 -- An optimization. If the right operand is the literal 1, then we
354 -- can just return the left hand operand. Putting the optimization
355 -- here allows us to omit the check at the call site.
357 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
361 -- Otherwise we need to figure out the correct result type size
362 -- First figure out the effective sizes of the operands. Normally
363 -- the effective size of an operand is the RM_Size of the operand.
364 -- But a special case arises with operands whose size is known at
365 -- compile time. In this case, we can use the actual value of the
366 -- operand to get a size if it would fit in a small signed integer.
368 Left_Size
:= UI_To_Int
(RM_Size
(Left_Type
));
370 if Compile_Time_Known_Value
(L
) then
372 Siz
: constant Int
:=
373 Get_Size_For_Value
(UI_Abs
(Expr_Value
(L
)));
375 if Siz
< Left_Size
then
381 Right_Size
:= UI_To_Int
(RM_Size
(Right_Type
));
383 if Compile_Time_Known_Value
(R
) then
385 Siz
: constant Int
:=
386 Get_Size_For_Value
(UI_Abs
(Expr_Value
(R
)));
388 if Siz
< Right_Size
then
394 -- Do the operation using the longer of the two sizes
397 Get_Type_For_Size
(Int
'Max (Left_Size
, Right_Size
), Force
=> True);
401 Left_Opnd
=> Build_Conversion
(N
, Result_Type
, L
),
402 Right_Opnd
=> Build_Conversion
(N
, Result_Type
, R
));
405 -- We now have a divide node built with Result_Type set. First
406 -- set Etype of result, as required for all Build_xxx routines
408 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
410 -- The result is rounded if the target of the operation is decimal
411 -- and Rounded_Result is set, or if the target of the operation
412 -- is an integer type, as determined by Rounded_Result_Set.
414 Set_Rounded_Result
(Rnode
, Rounded_Result_Set
(N
));
416 -- One more check. We did the divide operation using the longer of
417 -- the two sizes, which is reasonable. However, in the case where the
418 -- two types have unequal sizes, it is impossible for the result of
419 -- a divide operation to be larger than the dividend, so we can put
420 -- a conversion round the result to keep the evolving operation size
421 -- as small as possible.
423 if not Is_Floating_Point_Type
(Left_Type
) then
424 Rnode
:= Build_Conversion
(N
, Left_Type
, Rnode
);
430 -------------------------
431 -- Build_Double_Divide --
432 -------------------------
434 function Build_Double_Divide
436 X
, Y
, Z
: Node_Id
) return Node_Id
438 X_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(X
)));
439 Y_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Y
)));
440 Z_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Z
)));
441 D_Size
: constant Nat
:= Y_Size
+ Z_Size
;
442 M_Size
: constant Nat
:= Nat
'Max (X_Size
, Nat
'Max (Y_Size
, Z_Size
));
446 -- If the denominator fits in Max_Integer_Size bits, we can build the
447 -- operations directly without causing any intermediate overflow. But
448 -- for backward compatibility reasons, we use a 128-bit divide only
449 -- if one of the operands is already larger than 64 bits.
451 if D_Size
<= System_Max_Integer_Size
452 and then (D_Size
<= 64 or else M_Size
> 64)
454 return Build_Divide
(N
, X
, Build_Multiply
(N
, Y
, Z
));
456 -- Otherwise we use the runtime routine
458 -- [Qnn : Interfaces.Integer_{64|128};
459 -- Rnn : Interfaces.Integer_{64|128};
460 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
465 Loc
: constant Source_Ptr
:= Sloc
(N
);
470 pragma Warnings
(Off
, Rnn
);
473 Build_Double_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
474 Insert_Actions
(N
, Code
);
475 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
477 -- Set type of result in case used elsewhere (see note at start)
479 Set_Etype
(Expr
, Etype
(Qnn
));
481 -- Set result as analyzed (see note at start on build routines)
486 end Build_Double_Divide
;
488 ------------------------------
489 -- Build_Double_Divide_Code --
490 ------------------------------
492 -- If the denominator can be computed in Max_Integer_Size bits, we build
494 -- [Nnn : constant typ := typ (X);
495 -- Dnn : constant typ := typ (Y) * typ (Z)
496 -- Qnn : constant typ := Nnn / Dnn;
497 -- Rnn : constant typ := Nnn rem Dnn;
499 -- If the denominator cannot be computed in Max_Integer_Size bits, we build
501 -- [Qnn : Interfaces.Integer_{64|128};
502 -- Rnn : Interfaces.Integer_{64|128};
503 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);]
505 procedure Build_Double_Divide_Code
508 Qnn
, Rnn
: out Entity_Id
;
511 Loc
: constant Source_Ptr
:= Sloc
(N
);
513 X_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(X
)));
514 Y_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Y
)));
515 Z_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Z
)));
516 M_Size
: constant Nat
:= Nat
'Max (X_Size
, Nat
'Max (Y_Size
, Z_Size
));
529 -- Find type that will allow computation of denominator
531 QR_Siz
:= Nat
'Max (X_Size
, Y_Size
+ Z_Size
);
534 QR_Typ
:= Standard_Integer_16
;
537 elsif QR_Siz
<= 32 then
538 QR_Typ
:= Standard_Integer_32
;
541 elsif QR_Siz
<= 64 then
542 QR_Typ
:= Standard_Integer_64
;
545 -- For backward compatibility reasons, we use a 128-bit divide only
546 -- if one of the operands is already larger than 64 bits.
548 elsif System_Max_Integer_Size
< 128 or else M_Size
<= 64 then
549 QR_Typ
:= RTE
(RE_Integer_64
);
550 QR_Id
:= RE_Double_Divide64
;
552 elsif QR_Siz
<= 128 then
553 QR_Typ
:= Standard_Integer_128
;
557 QR_Typ
:= RTE
(RE_Integer_128
);
558 QR_Id
:= RE_Double_Divide128
;
561 -- Define quotient and remainder, and set their Etypes, so
562 -- that they can be picked up by Build_xxx routines.
564 Qnn
:= Make_Temporary
(Loc
, 'S');
565 Rnn
:= Make_Temporary
(Loc
, 'R');
567 Set_Etype
(Qnn
, QR_Typ
);
568 Set_Etype
(Rnn
, QR_Typ
);
570 -- Case where we can compute the denominator in Max_Integer_Size bits
572 if QR_Id
= RE_Null
then
574 -- Create temporaries for numerator and denominator and set Etypes,
575 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
577 Nnn
:= Make_Temporary
(Loc
, 'N');
578 Dnn
:= Make_Temporary
(Loc
, 'D');
580 Set_Etype
(Nnn
, QR_Typ
);
581 Set_Etype
(Dnn
, QR_Typ
);
584 Make_Object_Declaration
(Loc
,
585 Defining_Identifier
=> Nnn
,
586 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
587 Constant_Present
=> True,
588 Expression
=> Build_Conversion
(N
, QR_Typ
, X
)),
590 Make_Object_Declaration
(Loc
,
591 Defining_Identifier
=> Dnn
,
592 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
593 Constant_Present
=> True,
594 Expression
=> Build_Multiply
(N
, Y
, Z
)));
598 New_Occurrence_Of
(Nnn
, Loc
),
599 New_Occurrence_Of
(Dnn
, Loc
));
601 Set_Rounded_Result
(Quo
, Rounded_Result_Set
(N
));
604 Make_Object_Declaration
(Loc
,
605 Defining_Identifier
=> Qnn
,
606 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
607 Constant_Present
=> True,
611 Make_Object_Declaration
(Loc
,
612 Defining_Identifier
=> Rnn
,
613 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
614 Constant_Present
=> True,
617 New_Occurrence_Of
(Nnn
, Loc
),
618 New_Occurrence_Of
(Dnn
, Loc
))));
620 -- Case where denominator does not fit in Max_Integer_Size bits, we have
621 -- to call the runtime routine to compute the quotient and remainder.
624 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
627 Make_Object_Declaration
(Loc
,
628 Defining_Identifier
=> Qnn
,
629 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
631 Make_Object_Declaration
(Loc
,
632 Defining_Identifier
=> Rnn
,
633 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
635 Make_Procedure_Call_Statement
(Loc
,
636 Name
=> New_Occurrence_Of
(RTE
(QR_Id
), Loc
),
637 Parameter_Associations
=> New_List
(
638 Build_Conversion
(N
, QR_Typ
, X
),
639 Build_Conversion
(N
, QR_Typ
, Y
),
640 Build_Conversion
(N
, QR_Typ
, Z
),
641 New_Occurrence_Of
(Qnn
, Loc
),
642 New_Occurrence_Of
(Rnn
, Loc
),
643 New_Occurrence_Of
(Rnd
, Loc
))));
645 end Build_Double_Divide_Code
;
651 function Build_Multiply
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
652 Loc
: constant Source_Ptr
:= Sloc
(N
);
653 Left_Type
: constant Entity_Id
:= Etype
(L
);
654 Right_Type
: constant Entity_Id
:= Etype
(R
);
657 Result_Type
: Entity_Id
;
661 -- Deal with floating-point case first
663 if Is_Floating_Point_Type
(Left_Type
) then
664 pragma Assert
(Left_Type
= Universal_Real
);
665 pragma Assert
(Right_Type
= Universal_Real
);
667 Result_Type
:= Universal_Real
;
668 Rnode
:= Make_Op_Multiply
(Loc
, L
, R
);
670 -- Integer and fixed-point cases
673 -- An optimization. If the right operand is the literal 1, then we
674 -- can just return the left hand operand. Putting the optimization
675 -- here allows us to omit the check at the call site. Similarly, if
676 -- the left operand is the integer 1 we can return the right operand.
678 if Nkind
(R
) = N_Integer_Literal
and then Intval
(R
) = 1 then
680 elsif Nkind
(L
) = N_Integer_Literal
and then Intval
(L
) = 1 then
684 -- Otherwise we need to figure out the correct result type size
685 -- First figure out the effective sizes of the operands. Normally
686 -- the effective size of an operand is the RM_Size of the operand.
687 -- But a special case arises with operands whose size is known at
688 -- compile time. In this case, we can use the actual value of the
689 -- operand to get a size if it would fit in a small signed integer.
691 Left_Size
:= UI_To_Int
(RM_Size
(Left_Type
));
693 if Compile_Time_Known_Value
(L
) then
695 Siz
: constant Int
:=
696 Get_Size_For_Value
(UI_Abs
(Expr_Value
(L
)));
698 if Siz
< Left_Size
then
704 Right_Size
:= UI_To_Int
(RM_Size
(Right_Type
));
706 if Compile_Time_Known_Value
(R
) then
708 Siz
: constant Int
:=
709 Get_Size_For_Value
(UI_Abs
(Expr_Value
(R
)));
711 if Siz
< Right_Size
then
717 -- Now the result size must be at least the sum of the two sizes,
718 -- to accommodate all possible results.
721 Get_Type_For_Size
(Left_Size
+ Right_Size
, Force
=> True);
724 Make_Op_Multiply
(Loc
,
725 Left_Opnd
=> Build_Conversion
(N
, Result_Type
, L
),
726 Right_Opnd
=> Build_Conversion
(N
, Result_Type
, R
));
729 -- We now have a multiply node built with Result_Type set. First
730 -- set Etype of result, as required for all Build_xxx routines
732 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
741 function Build_Rem
(N
: Node_Id
; L
, R
: Node_Id
) return Node_Id
is
742 Loc
: constant Source_Ptr
:= Sloc
(N
);
743 Left_Type
: constant Entity_Id
:= Etype
(L
);
744 Right_Type
: constant Entity_Id
:= Etype
(R
);
745 Result_Type
: Entity_Id
;
749 if Left_Type
= Right_Type
then
750 Result_Type
:= Left_Type
;
756 -- If left size is larger, we do the remainder operation using the
757 -- size of the left type (i.e. the larger of the two integer types).
759 elsif Esize
(Left_Type
) >= Esize
(Right_Type
) then
760 Result_Type
:= Left_Type
;
764 Right_Opnd
=> Build_Conversion
(N
, Left_Type
, R
));
766 -- Similarly, if the right size is larger, we do the remainder
767 -- operation using the right type.
770 Result_Type
:= Right_Type
;
773 Left_Opnd
=> Build_Conversion
(N
, Right_Type
, L
),
777 -- We now have an N_Op_Rem node built with Result_Type set. First
778 -- set Etype of result, as required for all Build_xxx routines
780 Set_Etype
(Rnode
, Base_Type
(Result_Type
));
782 -- One more check. We did the rem operation using the larger of the
783 -- two types, which is reasonable. However, in the case where the
784 -- two types have unequal sizes, it is impossible for the result of
785 -- a remainder operation to be larger than the smaller of the two
786 -- types, so we can put a conversion round the result to keep the
787 -- evolving operation size as small as possible.
789 if Esize
(Left_Type
) >= Esize
(Right_Type
) then
790 Rnode
:= Build_Conversion
(N
, Right_Type
, Rnode
);
791 elsif Esize
(Right_Type
) >= Esize
(Left_Type
) then
792 Rnode
:= Build_Conversion
(N
, Left_Type
, Rnode
);
798 -------------------------
799 -- Build_Scaled_Divide --
800 -------------------------
802 function Build_Scaled_Divide
804 X
, Y
, Z
: Node_Id
) return Node_Id
806 X_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(X
)));
807 Y_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Y
)));
808 Z_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Z
)));
809 N_Size
: constant Nat
:= X_Size
+ Y_Size
;
810 M_Size
: constant Nat
:= Nat
'Max (X_Size
, Nat
'Max (Y_Size
, Z_Size
));
814 -- If the numerator fits in Max_Integer_Size bits, we can build the
815 -- operations directly without causing any intermediate overflow. But
816 -- for backward compatibility reasons, we use a 128-bit divide only
817 -- if one of the operands is already larger than 64 bits.
819 if N_Size
<= System_Max_Integer_Size
820 and then (N_Size
<= 64 or else M_Size
> 64)
822 return Build_Divide
(N
, Build_Multiply
(N
, X
, Y
), Z
);
824 -- Otherwise we use the runtime routine
826 -- [Qnn : Integer_{64|128},
827 -- Rnn : Integer_{64|128};
828 -- Scaled_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
833 Loc
: constant Source_Ptr
:= Sloc
(N
);
838 pragma Warnings
(Off
, Rnn
);
841 Build_Scaled_Divide_Code
(N
, X
, Y
, Z
, Qnn
, Rnn
, Code
);
842 Insert_Actions
(N
, Code
);
843 Expr
:= New_Occurrence_Of
(Qnn
, Loc
);
845 -- Set type of result in case used elsewhere (see note at start)
847 Set_Etype
(Expr
, Etype
(Qnn
));
851 end Build_Scaled_Divide
;
853 ------------------------------
854 -- Build_Scaled_Divide_Code --
855 ------------------------------
857 -- If the numerator can be computed in Max_Integer_Size bits, we build
859 -- [Nnn : constant typ := typ (X) * typ (Y);
860 -- Dnn : constant typ := typ (Z)
861 -- Qnn : constant typ := Nnn / Dnn;
862 -- Rnn : constant typ := Nnn rem Dnn;
864 -- If the numerator cannot be computed in Max_Integer_Size bits, we build
866 -- [Qnn : Interfaces.Integer_{64|128};
867 -- Rnn : Interfaces.Integer_{64|128};
868 -- Scaled_Divide_{64|128} (X, Y, Z, Qnn, Rnn, Round);]
870 procedure Build_Scaled_Divide_Code
873 Qnn
, Rnn
: out Entity_Id
;
876 Loc
: constant Source_Ptr
:= Sloc
(N
);
878 X_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(X
)));
879 Y_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Y
)));
880 Z_Size
: constant Nat
:= UI_To_Int
(RM_Size
(Etype
(Z
)));
881 M_Size
: constant Nat
:= Nat
'Max (X_Size
, Nat
'Max (Y_Size
, Z_Size
));
894 -- Find type that will allow computation of numerator
896 QR_Siz
:= Nat
'Max (X_Size
+ Y_Size
, Z_Size
);
899 QR_Typ
:= Standard_Integer_16
;
902 elsif QR_Siz
<= 32 then
903 QR_Typ
:= Standard_Integer_32
;
906 elsif QR_Siz
<= 64 then
907 QR_Typ
:= Standard_Integer_64
;
910 -- For backward compatibility reasons, we use a 128-bit divide only
911 -- if one of the operands is already larger than 64 bits.
913 elsif System_Max_Integer_Size
< 128 or else M_Size
<= 64 then
914 QR_Typ
:= RTE
(RE_Integer_64
);
915 QR_Id
:= RE_Scaled_Divide64
;
917 elsif QR_Siz
<= 128 then
918 QR_Typ
:= Standard_Integer_128
;
922 QR_Typ
:= RTE
(RE_Integer_128
);
923 QR_Id
:= RE_Scaled_Divide128
;
926 -- Define quotient and remainder, and set their Etypes, so
927 -- that they can be picked up by Build_xxx routines.
929 Qnn
:= Make_Temporary
(Loc
, 'S');
930 Rnn
:= Make_Temporary
(Loc
, 'R');
932 Set_Etype
(Qnn
, QR_Typ
);
933 Set_Etype
(Rnn
, QR_Typ
);
935 -- Case where we can compute the numerator in Max_Integer_Size bits
937 if QR_Id
= RE_Null
then
938 Nnn
:= Make_Temporary
(Loc
, 'N');
939 Dnn
:= Make_Temporary
(Loc
, 'D');
941 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
943 Set_Etype
(Nnn
, QR_Typ
);
944 Set_Etype
(Dnn
, QR_Typ
);
947 Make_Object_Declaration
(Loc
,
948 Defining_Identifier
=> Nnn
,
949 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
950 Constant_Present
=> True,
951 Expression
=> Build_Multiply
(N
, X
, Y
)),
953 Make_Object_Declaration
(Loc
,
954 Defining_Identifier
=> Dnn
,
955 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
956 Constant_Present
=> True,
957 Expression
=> Build_Conversion
(N
, QR_Typ
, Z
)));
961 New_Occurrence_Of
(Nnn
, Loc
),
962 New_Occurrence_Of
(Dnn
, Loc
));
965 Make_Object_Declaration
(Loc
,
966 Defining_Identifier
=> Qnn
,
967 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
968 Constant_Present
=> True,
972 Make_Object_Declaration
(Loc
,
973 Defining_Identifier
=> Rnn
,
974 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
),
975 Constant_Present
=> True,
978 New_Occurrence_Of
(Nnn
, Loc
),
979 New_Occurrence_Of
(Dnn
, Loc
))));
981 -- Case where numerator does not fit in Max_Integer_Size bits, we have
982 -- to call the runtime routine to compute the quotient and remainder.
985 Rnd
:= Boolean_Literals
(Rounded_Result_Set
(N
));
988 Make_Object_Declaration
(Loc
,
989 Defining_Identifier
=> Qnn
,
990 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
992 Make_Object_Declaration
(Loc
,
993 Defining_Identifier
=> Rnn
,
994 Object_Definition
=> New_Occurrence_Of
(QR_Typ
, Loc
)),
996 Make_Procedure_Call_Statement
(Loc
,
997 Name
=> New_Occurrence_Of
(RTE
(QR_Id
), Loc
),
998 Parameter_Associations
=> New_List
(
999 Build_Conversion
(N
, QR_Typ
, X
),
1000 Build_Conversion
(N
, QR_Typ
, Y
),
1001 Build_Conversion
(N
, QR_Typ
, Z
),
1002 New_Occurrence_Of
(Qnn
, Loc
),
1003 New_Occurrence_Of
(Rnn
, Loc
),
1004 New_Occurrence_Of
(Rnd
, Loc
))));
1007 -- Set type of result, for use in caller
1009 Set_Etype
(Qnn
, QR_Typ
);
1010 end Build_Scaled_Divide_Code
;
1012 ---------------------------
1013 -- Do_Divide_Fixed_Fixed --
1014 ---------------------------
1018 -- (Result_Value * Result_Small) =
1019 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
1021 -- Result_Value = (Left_Value / Right_Value) *
1022 -- (Left_Small / (Right_Small * Result_Small));
1024 -- we can do the operation in integer arithmetic if this fraction is an
1025 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1026 -- Otherwise the result is in the close result set and our approach is to
1027 -- use floating-point to compute this close result.
1029 procedure Do_Divide_Fixed_Fixed
(N
: Node_Id
) is
1030 Left
: constant Node_Id
:= Left_Opnd
(N
);
1031 Right
: constant Node_Id
:= Right_Opnd
(N
);
1032 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1033 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1034 Result_Type
: constant Entity_Id
:= Etype
(N
);
1035 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1036 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1038 Result_Small
: Ureal
;
1045 -- Rounding is required if the result is integral
1047 if Is_Integer_Type
(Result_Type
) then
1048 Set_Rounded_Result
(N
);
1051 -- Get result small. If the result is an integer, treat it as though
1052 -- it had a small of 1.0, all other processing is identical.
1054 if Is_Integer_Type
(Result_Type
) then
1055 Result_Small
:= Ureal_1
;
1057 Result_Small
:= Small_Value
(Result_Type
);
1062 Frac
:= Left_Small
/ (Right_Small
* Result_Small
);
1063 Frac_Num
:= Norm_Num
(Frac
);
1064 Frac_Den
:= Norm_Den
(Frac
);
1066 -- If the fraction is an integer, then we get the result by multiplying
1067 -- the left operand by the integer, and then dividing by the right
1068 -- operand (the order is important, if we did the divide first, we
1069 -- would lose precision).
1071 if Frac_Den
= 1 then
1072 Lit_Int
:= Integer_Literal
(N
, Frac_Num
); -- always positive
1074 if Present
(Lit_Int
) then
1075 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Right
));
1079 -- If the fraction is the reciprocal of an integer, then we get the
1080 -- result by first multiplying the divisor by the integer, and then
1081 -- doing the division with the adjusted divisor.
1083 -- Note: this is much better than doing two divisions: multiplications
1084 -- are much faster than divisions (and certainly faster than rounded
1085 -- divisions), and we don't get inaccuracies from double rounding.
1087 elsif Frac_Num
= 1 then
1088 Lit_Int
:= Integer_Literal
(N
, Frac_Den
); -- always positive
1090 if Present
(Lit_Int
) then
1091 Set_Result
(N
, Build_Double_Divide
(N
, Left
, Right
, Lit_Int
));
1096 -- If we fall through, we use floating-point to compute the result
1100 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1101 Real_Literal
(N
, Frac
)));
1102 end Do_Divide_Fixed_Fixed
;
1104 -------------------------------
1105 -- Do_Divide_Fixed_Universal --
1106 -------------------------------
1110 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1111 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1113 -- The result is required to be in the perfect result set if the literal
1114 -- can be factored so that the resulting small ratio is an integer or the
1115 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1116 -- analysis of these RM requirements:
1118 -- We must factor the literal, finding an integer K:
1120 -- Lit_Value = K * Right_Small
1121 -- Right_Small = Lit_Value / K
1123 -- such that the small ratio:
1126 -- ------------------------------
1127 -- (Lit_Value / K) * Result_Small
1130 -- = ------------------------ * K
1131 -- Lit_Value * Result_Small
1133 -- is an integer or the reciprocal of an integer, and for
1134 -- implementation efficiency we need the smallest such K.
1136 -- First we reduce the left fraction to lowest terms
1138 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1139 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1140 -- Right_Small = Lit_Value.
1142 -- If numerator > 1, then set K to the denominator of the fraction so
1143 -- that the resulting small ratio is an integer (the numerator value).
1145 procedure Do_Divide_Fixed_Universal
(N
: Node_Id
) is
1146 Left
: constant Node_Id
:= Left_Opnd
(N
);
1147 Right
: constant Node_Id
:= Right_Opnd
(N
);
1148 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1149 Result_Type
: constant Entity_Id
:= Etype
(N
);
1150 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1151 Lit_Value
: constant Ureal
:= Realval
(Right
);
1153 Result_Small
: Ureal
;
1161 -- Get result small. If the result is an integer, treat it as though
1162 -- it had a small of 1.0, all other processing is identical.
1164 if Is_Integer_Type
(Result_Type
) then
1165 Result_Small
:= Ureal_1
;
1167 Result_Small
:= Small_Value
(Result_Type
);
1170 -- Determine if literal can be rewritten successfully
1172 Frac
:= Left_Small
/ (Lit_Value
* Result_Small
);
1173 Frac_Num
:= Norm_Num
(Frac
);
1174 Frac_Den
:= Norm_Den
(Frac
);
1176 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1177 -- = denominator). If this integer is not too large, this is the case
1178 -- where the result can be obtained by dividing by this integer value.
1180 if Frac_Num
= 1 then
1181 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1183 if Present
(Lit_Int
) then
1184 Set_Result
(N
, Build_Divide
(N
, Left
, Lit_Int
));
1188 -- Case where we choose K to make fraction an integer (K = denominator
1189 -- of fraction, integer = numerator of fraction). If both K and the
1190 -- numerator are small enough, this is the case where the result can
1191 -- be obtained by first multiplying by the integer value and then
1192 -- dividing by K (the order is important, if we divided first, we
1193 -- would lose precision).
1196 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1197 Lit_K
:= Integer_Literal
(N
, Frac_Den
, False);
1199 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1200 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_Int
, Lit_K
));
1205 -- Fall through if the literal cannot be successfully rewritten, or if
1206 -- the small ratio is out of range of integer arithmetic. In the former
1207 -- case it is fine to use floating-point to get the close result set,
1208 -- and in the latter case, it means that the result is zero or raises
1209 -- constraint error, and we can do that accurately in floating-point.
1211 -- If we end up using floating-point, then we take the right integer
1212 -- to be one, and its small to be the value of the original right real
1213 -- literal. That way, we need only one floating-point multiplication.
1216 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1217 end Do_Divide_Fixed_Universal
;
1219 -------------------------------
1220 -- Do_Divide_Universal_Fixed --
1221 -------------------------------
1225 -- (Result_Value * Result_Small) =
1226 -- Lit_Value / (Right_Value * Right_Small)
1228 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1230 -- The result is required to be in the perfect result set if the literal
1231 -- can be factored so that the resulting small ratio is an integer or the
1232 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1233 -- analysis of these RM requirements:
1235 -- We must factor the literal, finding an integer K:
1237 -- Lit_Value = K * Left_Small
1238 -- Left_Small = Lit_Value / K
1240 -- such that the small ratio:
1243 -- --------------------------
1244 -- Right_Small * Result_Small
1247 -- = -------------------------- * -
1248 -- Right_Small * Result_Small K
1250 -- is an integer or the reciprocal of an integer, and for
1251 -- implementation efficiency we need the smallest such K.
1253 -- First we reduce the left fraction to lowest terms
1255 -- If denominator = 1, then for K = 1, the small ratio is an integer
1256 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1257 -- and Left_Small = Lit_Value.
1259 -- If denominator > 1, then set K to the numerator of the fraction so
1260 -- that the resulting small ratio is the reciprocal of an integer (the
1261 -- numerator value).
1263 procedure Do_Divide_Universal_Fixed
(N
: Node_Id
) is
1264 Left
: constant Node_Id
:= Left_Opnd
(N
);
1265 Right
: constant Node_Id
:= Right_Opnd
(N
);
1266 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1267 Result_Type
: constant Entity_Id
:= Etype
(N
);
1268 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1269 Lit_Value
: constant Ureal
:= Realval
(Left
);
1271 Result_Small
: Ureal
;
1279 -- Get result small. If the result is an integer, treat it as though
1280 -- it had a small of 1.0, all other processing is identical.
1282 if Is_Integer_Type
(Result_Type
) then
1283 Result_Small
:= Ureal_1
;
1285 Result_Small
:= Small_Value
(Result_Type
);
1288 -- Determine if literal can be rewritten successfully
1290 Frac
:= Lit_Value
/ (Right_Small
* Result_Small
);
1291 Frac_Num
:= Norm_Num
(Frac
);
1292 Frac_Den
:= Norm_Den
(Frac
);
1294 -- Case where fraction is an integer (K = 1, integer = numerator). If
1295 -- this integer is not too large, this is the case where the result
1296 -- can be obtained by dividing this integer by the right operand.
1298 if Frac_Den
= 1 then
1299 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1301 if Present
(Lit_Int
) then
1302 Set_Result
(N
, Build_Divide
(N
, Lit_Int
, Right
));
1306 -- Case where we choose K to make the fraction the reciprocal of an
1307 -- integer (K = numerator of fraction, integer = numerator of fraction).
1308 -- If both K and the integer are small enough, this is the case where
1309 -- the result can be obtained by multiplying the right operand by K
1310 -- and then dividing by the integer value. The order of the operations
1311 -- is important (if we divided first, we would lose precision).
1314 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1315 Lit_K
:= Integer_Literal
(N
, Frac_Num
, False);
1317 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1318 Set_Result
(N
, Build_Double_Divide
(N
, Lit_K
, Right
, Lit_Int
));
1323 -- Fall through if the literal cannot be successfully rewritten, or if
1324 -- the small ratio is out of range of integer arithmetic. In the former
1325 -- case it is fine to use floating-point to get the close result set,
1326 -- and in the latter case, it means that the result is zero or raises
1327 -- constraint error, and we can do that accurately in floating-point.
1329 -- If we end up using floating-point, then we take the right integer
1330 -- to be one, and its small to be the value of the original right real
1331 -- literal. That way, we need only one floating-point division.
1334 Build_Divide
(N
, Real_Literal
(N
, Frac
), Fpt_Value
(Right
)));
1335 end Do_Divide_Universal_Fixed
;
1337 -----------------------------
1338 -- Do_Multiply_Fixed_Fixed --
1339 -----------------------------
1343 -- (Result_Value * Result_Small) =
1344 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1346 -- Result_Value = (Left_Value * Right_Value) *
1347 -- (Left_Small * Right_Small) / Result_Small;
1349 -- we can do the operation in integer arithmetic if this fraction is an
1350 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1351 -- Otherwise the result is in the close result set and our approach is to
1352 -- use floating-point to compute this close result.
1354 procedure Do_Multiply_Fixed_Fixed
(N
: Node_Id
) is
1355 Left
: constant Node_Id
:= Left_Opnd
(N
);
1356 Right
: constant Node_Id
:= Right_Opnd
(N
);
1358 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1359 Right_Type
: constant Entity_Id
:= Etype
(Right
);
1360 Result_Type
: constant Entity_Id
:= Etype
(N
);
1361 Right_Small
: constant Ureal
:= Small_Value
(Right_Type
);
1362 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1364 Result_Small
: Ureal
;
1371 -- Get result small. If the result is an integer, treat it as though
1372 -- it had a small of 1.0, all other processing is identical.
1374 if Is_Integer_Type
(Result_Type
) then
1375 Result_Small
:= Ureal_1
;
1377 Result_Small
:= Small_Value
(Result_Type
);
1382 Frac
:= (Left_Small
* Right_Small
) / Result_Small
;
1383 Frac_Num
:= Norm_Num
(Frac
);
1384 Frac_Den
:= Norm_Den
(Frac
);
1386 -- If the fraction is an integer, then we get the result by multiplying
1387 -- the operands, and then multiplying the result by the integer value.
1389 if Frac_Den
= 1 then
1390 Lit_Int
:= Integer_Literal
(N
, Frac_Num
); -- always positive
1392 if Present
(Lit_Int
) then
1394 Build_Multiply
(N
, Build_Multiply
(N
, Left
, Right
), Lit_Int
));
1398 -- If the fraction is the reciprocal of an integer, then we get the
1399 -- result by multiplying the operands, and then dividing the result by
1400 -- the integer value. The order of the operations is important, if we
1401 -- divided first, we would lose precision.
1403 elsif Frac_Num
= 1 then
1404 Lit_Int
:= Integer_Literal
(N
, Frac_Den
); -- always positive
1406 if Present
(Lit_Int
) then
1407 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Right
, Lit_Int
));
1412 -- If we fall through, we use floating-point to compute the result
1416 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
1417 Real_Literal
(N
, Frac
)));
1418 end Do_Multiply_Fixed_Fixed
;
1420 ---------------------------------
1421 -- Do_Multiply_Fixed_Universal --
1422 ---------------------------------
1426 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1427 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1429 -- The result is required to be in the perfect result set if the literal
1430 -- can be factored so that the resulting small ratio is an integer or the
1431 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1432 -- analysis of these RM requirements:
1434 -- We must factor the literal, finding an integer K:
1436 -- Lit_Value = K * Right_Small
1437 -- Right_Small = Lit_Value / K
1439 -- such that the small ratio:
1441 -- Left_Small * (Lit_Value / K)
1442 -- ----------------------------
1445 -- Left_Small * Lit_Value 1
1446 -- = ---------------------- * -
1449 -- is an integer or the reciprocal of an integer, and for
1450 -- implementation efficiency we need the smallest such K.
1452 -- First we reduce the left fraction to lowest terms
1454 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1455 -- this is clearly the minimum K case, so set
1457 -- K = 1, Right_Small = Lit_Value
1459 -- If denominator > 1, then set K to the numerator of the fraction, so
1460 -- that the resulting small ratio is the reciprocal of the integer (the
1461 -- denominator value).
1463 procedure Do_Multiply_Fixed_Universal
1465 Left
, Right
: Node_Id
)
1467 Left_Type
: constant Entity_Id
:= Etype
(Left
);
1468 Result_Type
: constant Entity_Id
:= Etype
(N
);
1469 Left_Small
: constant Ureal
:= Small_Value
(Left_Type
);
1470 Lit_Value
: constant Ureal
:= Realval
(Right
);
1472 Result_Small
: Ureal
;
1480 -- Get result small. If the result is an integer, treat it as though
1481 -- it had a small of 1.0, all other processing is identical.
1483 if Is_Integer_Type
(Result_Type
) then
1484 Result_Small
:= Ureal_1
;
1486 Result_Small
:= Small_Value
(Result_Type
);
1489 -- Determine if literal can be rewritten successfully
1491 Frac
:= (Left_Small
* Lit_Value
) / Result_Small
;
1492 Frac_Num
:= Norm_Num
(Frac
);
1493 Frac_Den
:= Norm_Den
(Frac
);
1495 -- Case where fraction is an integer (K = 1, integer = numerator). If
1496 -- this integer is not too large, this is the case where the result can
1497 -- be obtained by multiplying by this integer value.
1499 if Frac_Den
= 1 then
1500 Lit_Int
:= Integer_Literal
(N
, Frac_Num
, UR_Is_Negative
(Frac
));
1502 if Present
(Lit_Int
) then
1503 Set_Result
(N
, Build_Multiply
(N
, Left
, Lit_Int
));
1507 -- Case where we choose K to make fraction the reciprocal of an integer
1508 -- (K = numerator of fraction, integer = denominator of fraction). If
1509 -- both K and the denominator are small enough, this is the case where
1510 -- the result can be obtained by first multiplying by K, and then
1511 -- dividing by the integer value.
1514 Lit_Int
:= Integer_Literal
(N
, Frac_Den
, UR_Is_Negative
(Frac
));
1515 Lit_K
:= Integer_Literal
(N
, Frac_Num
, False);
1517 if Present
(Lit_Int
) and then Present
(Lit_K
) then
1518 Set_Result
(N
, Build_Scaled_Divide
(N
, Left
, Lit_K
, Lit_Int
));
1523 -- Fall through if the literal cannot be successfully rewritten, or if
1524 -- the small ratio is out of range of integer arithmetic. In the former
1525 -- case it is fine to use floating-point to get the close result set,
1526 -- and in the latter case, it means that the result is zero or raises
1527 -- constraint error, and we can do that accurately in floating-point.
1529 -- If we end up using floating-point, then we take the right integer
1530 -- to be one, and its small to be the value of the original right real
1531 -- literal. That way, we need only one floating-point multiplication.
1534 Build_Multiply
(N
, Fpt_Value
(Left
), Real_Literal
(N
, Frac
)));
1535 end Do_Multiply_Fixed_Universal
;
1537 ---------------------------------
1538 -- Expand_Convert_Fixed_Static --
1539 ---------------------------------
1541 procedure Expand_Convert_Fixed_Static
(N
: Node_Id
) is
1544 Convert_To
(Etype
(N
),
1545 Make_Real_Literal
(Sloc
(N
), Expr_Value_R
(Expression
(N
)))));
1546 Analyze_And_Resolve
(N
);
1547 end Expand_Convert_Fixed_Static
;
1549 -----------------------------------
1550 -- Expand_Convert_Fixed_To_Fixed --
1551 -----------------------------------
1555 -- Result_Value * Result_Small = Source_Value * Source_Small
1556 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1558 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1559 -- integer, then the perfect result set is obtained by a single integer
1562 -- If the small ratio is the reciprocal of a sufficiently small integer,
1563 -- then the perfect result set is obtained by a single integer division.
1565 -- If the numerator and denominator of the small ratio are sufficiently
1566 -- small integers, then the perfect result set is obtained by a scaled
1567 -- divide operation.
1569 -- In other cases, we obtain the close result set by calculating the
1570 -- result in floating-point.
1572 procedure Expand_Convert_Fixed_To_Fixed
(N
: Node_Id
) is
1573 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1574 Expr
: constant Node_Id
:= Expression
(N
);
1575 Result_Type
: constant Entity_Id
:= Etype
(N
);
1576 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1577 Small_Ratio
: Ureal
;
1584 if Is_OK_Static_Expression
(Expr
) then
1585 Expand_Convert_Fixed_Static
(N
);
1589 Small_Ratio
:= Small_Value
(Source_Type
) / Small_Value
(Result_Type
);
1590 Ratio_Num
:= Norm_Num
(Small_Ratio
);
1591 Ratio_Den
:= Norm_Den
(Small_Ratio
);
1593 if Ratio_Den
= 1 then
1594 if Ratio_Num
= 1 then
1595 Set_Result
(N
, Expr
);
1599 Lit_Num
:= Integer_Literal
(N
, Ratio_Num
);
1601 if Present
(Lit_Num
) then
1602 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit_Num
));
1607 elsif Ratio_Num
= 1 then
1608 Lit_Den
:= Integer_Literal
(N
, Ratio_Den
);
1610 if Present
(Lit_Den
) then
1611 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit_Den
), Rng_Check
);
1616 Lit_Num
:= Integer_Literal
(N
, Ratio_Num
);
1617 Lit_Den
:= Integer_Literal
(N
, Ratio_Den
);
1619 if Present
(Lit_Num
) and then Present
(Lit_Den
) then
1621 (N
, Build_Scaled_Divide
(N
, Expr
, Lit_Num
, Lit_Den
), Rng_Check
);
1626 -- Fall through to use floating-point for the close result set case,
1627 -- as a result of the numerator or denominator of the small ratio not
1628 -- being sufficiently small. See also Expand_Convert_Float_To_Fixed.
1633 Real_Literal
(N
, Small_Ratio
)),
1635 Trunc
=> not Rounded_Result
(N
));
1636 end Expand_Convert_Fixed_To_Fixed
;
1638 -----------------------------------
1639 -- Expand_Convert_Fixed_To_Float --
1640 -----------------------------------
1642 -- If the small of the fixed type is 1.0, then we simply convert the
1643 -- integer value directly to the target floating-point type, otherwise
1644 -- we first have to multiply by the small, in Universal_Real, and then
1645 -- convert the result to the target floating-point type.
1647 procedure Expand_Convert_Fixed_To_Float
(N
: Node_Id
) is
1648 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1649 Expr
: constant Node_Id
:= Expression
(N
);
1650 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1651 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1654 if Is_OK_Static_Expression
(Expr
) then
1655 Expand_Convert_Fixed_Static
(N
);
1659 if Small
= Ureal_1
then
1660 Set_Result
(N
, Expr
);
1666 Real_Literal
(N
, Small
)),
1669 end Expand_Convert_Fixed_To_Float
;
1671 -------------------------------------
1672 -- Expand_Convert_Fixed_To_Integer --
1673 -------------------------------------
1677 -- Result_Value = Source_Value * Source_Small
1679 -- If the small value is a sufficiently small integer, then the perfect
1680 -- result set is obtained by a single integer multiplication.
1682 -- If the small value is the reciprocal of a sufficiently small integer,
1683 -- then the perfect result set is obtained by a single integer division.
1685 -- If the numerator and denominator of the small value are sufficiently
1686 -- small integers, then the perfect result set is obtained by a scaled
1687 -- divide operation.
1689 -- In other cases, we obtain the close result set by calculating the
1690 -- result in floating-point.
1692 procedure Expand_Convert_Fixed_To_Integer
(N
: Node_Id
) is
1693 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1694 Expr
: constant Node_Id
:= Expression
(N
);
1695 Source_Type
: constant Entity_Id
:= Etype
(Expr
);
1696 Small
: constant Ureal
:= Small_Value
(Source_Type
);
1697 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1698 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1703 if Is_OK_Static_Expression
(Expr
) then
1704 Expand_Convert_Fixed_Static
(N
);
1708 if Small_Den
= 1 then
1709 Lit_Num
:= Integer_Literal
(N
, Small_Num
);
1711 if Present
(Lit_Num
) then
1712 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit_Num
), Rng_Check
);
1716 elsif Small_Num
= 1 then
1717 Lit_Den
:= Integer_Literal
(N
, Small_Den
);
1719 if Present
(Lit_Den
) then
1720 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit_Den
), Rng_Check
);
1725 Lit_Num
:= Integer_Literal
(N
, Small_Num
);
1726 Lit_Den
:= Integer_Literal
(N
, Small_Den
);
1728 if Present
(Lit_Num
) and then Present
(Lit_Den
) then
1730 (N
, Build_Scaled_Divide
(N
, Expr
, Lit_Num
, Lit_Den
), Rng_Check
);
1735 -- Fall through to use floating-point for the close result set case,
1736 -- as a result of the numerator or denominator of the small value not
1737 -- being a sufficiently small integer.
1742 Real_Literal
(N
, Small
)),
1744 end Expand_Convert_Fixed_To_Integer
;
1746 -----------------------------------
1747 -- Expand_Convert_Float_To_Fixed --
1748 -----------------------------------
1752 -- Result_Value * Result_Small = Operand_Value
1756 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1758 -- We do the small scaling in floating-point, and we do a multiplication
1759 -- rather than a division, since it is accurate enough for the perfect
1760 -- result cases, and faster.
1762 procedure Expand_Convert_Float_To_Fixed
(N
: Node_Id
) is
1763 Expr
: constant Node_Id
:= Expression
(N
);
1764 Result_Type
: constant Entity_Id
:= Etype
(N
);
1765 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1766 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1769 -- Optimize small = 1, where we can avoid the multiply completely
1771 if Small
= Ureal_1
then
1772 Set_Result
(N
, Expr
, Rng_Check
, Trunc
=> True);
1774 -- Normal case where multiply is required. The conversion is truncating
1775 -- for fixed-point types, see RM 4.6(29), except if the conversion comes
1776 -- from an attribute reference 'Round (RM 3.5.10 (14)): the attribute is
1777 -- implemented by means of a conversion that needs to round. However, if
1778 -- the switch -gnatd.N is specified, we use rounding for ordinary fixed-
1779 -- point types, for compatibility with earlier versions of the compiler.
1784 L
=> Fpt_Value
(Expr
),
1785 R
=> Real_Literal
(N
, Ureal_1
/ Small
)),
1787 Trunc
=> not Rounded_Result
(N
)
1790 and then Is_Ordinary_Fixed_Point_Type
(Result_Type
)));
1792 end Expand_Convert_Float_To_Fixed
;
1794 -------------------------------------
1795 -- Expand_Convert_Integer_To_Fixed --
1796 -------------------------------------
1800 -- Result_Value * Result_Small = Operand_Value
1801 -- Result_Value = Operand_Value / Result_Small
1803 -- If the small value is a sufficiently small integer, then the perfect
1804 -- result set is obtained by a single integer division.
1806 -- If the small value is the reciprocal of a sufficiently small integer,
1807 -- the perfect result set is obtained by a single integer multiplication.
1809 -- If the numerator and denominator of the small value are sufficiently
1810 -- small integers, then the perfect result set is obtained by a scaled
1811 -- divide operation.
1813 -- In other cases, we obtain the close result set by calculating the
1814 -- result in floating-point using a multiplication by the reciprocal
1815 -- of the Result_Small.
1817 procedure Expand_Convert_Integer_To_Fixed
(N
: Node_Id
) is
1818 Rng_Check
: constant Boolean := Do_Range_Check
(N
);
1819 Expr
: constant Node_Id
:= Expression
(N
);
1820 Result_Type
: constant Entity_Id
:= Etype
(N
);
1821 Small
: constant Ureal
:= Small_Value
(Result_Type
);
1822 Small_Num
: constant Uint
:= Norm_Num
(Small
);
1823 Small_Den
: constant Uint
:= Norm_Den
(Small
);
1828 if Small_Den
= 1 then
1829 Lit_Num
:= Integer_Literal
(N
, Small_Num
);
1831 if Present
(Lit_Num
) then
1832 Set_Result
(N
, Build_Divide
(N
, Expr
, Lit_Num
), Rng_Check
);
1836 elsif Small_Num
= 1 then
1837 Lit_Den
:= Integer_Literal
(N
, Small_Den
);
1839 if Present
(Lit_Den
) then
1840 Set_Result
(N
, Build_Multiply
(N
, Expr
, Lit_Den
), Rng_Check
);
1845 Lit_Num
:= Integer_Literal
(N
, Small_Num
);
1846 Lit_Den
:= Integer_Literal
(N
, Small_Den
);
1848 if Present
(Lit_Num
) and then Present
(Lit_Den
) then
1850 (N
, Build_Scaled_Divide
(N
, Expr
, Lit_Den
, Lit_Num
), Rng_Check
);
1855 -- Fall through to use floating-point for the close result set case,
1856 -- as a result of the numerator or denominator of the small value not
1857 -- being sufficiently small. See also Expand_Convert_Float_To_Fixed.
1862 Real_Literal
(N
, Ureal_1
/ Small
)),
1864 Trunc
=> not Rounded_Result
(N
));
1865 end Expand_Convert_Integer_To_Fixed
;
1867 --------------------------------
1868 -- Expand_Decimal_Divide_Call --
1869 --------------------------------
1871 -- We have four operands
1878 -- All of which are decimal types, and which thus have associated
1881 -- Computing the quotient is a similar problem to that faced by the
1882 -- normal fixed-point division, except that it is simpler, because
1883 -- we always have compatible smalls.
1885 -- Quotient = (Dividend / Divisor) * 10**q
1887 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1888 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1890 -- For q >= 0, we compute
1892 -- Numerator := Dividend * 10 ** q
1893 -- Denominator := Divisor
1894 -- Quotient := Numerator / Denominator
1896 -- For q < 0, we compute
1898 -- Numerator := Dividend
1899 -- Denominator := Divisor * 10 ** q
1900 -- Quotient := Numerator / Denominator
1902 -- Both these divisions are done in truncated mode, and the remainder
1903 -- from these divisions is used to compute the result Remainder. This
1904 -- remainder has the effective scale of the numerator of the division,
1906 -- For q >= 0, the remainder scale is Dividend'Scale + q
1907 -- For q < 0, the remainder scale is Dividend'Scale
1909 -- The result Remainder is then computed by a normal truncating decimal
1910 -- conversion from this scale to the scale of the remainder, i.e. by a
1911 -- division or multiplication by the appropriate power of 10.
1913 procedure Expand_Decimal_Divide_Call
(N
: Node_Id
) is
1914 Loc
: constant Source_Ptr
:= Sloc
(N
);
1916 Dividend
: Node_Id
:= First_Actual
(N
);
1917 Divisor
: Node_Id
:= Next_Actual
(Dividend
);
1918 Quotient
: Node_Id
:= Next_Actual
(Divisor
);
1919 Remainder
: Node_Id
:= Next_Actual
(Quotient
);
1921 Dividend_Type
: constant Entity_Id
:= Etype
(Dividend
);
1922 Divisor_Type
: constant Entity_Id
:= Etype
(Divisor
);
1923 Quotient_Type
: constant Entity_Id
:= Etype
(Quotient
);
1924 Remainder_Type
: constant Entity_Id
:= Etype
(Remainder
);
1926 Dividend_Scale
: constant Uint
:= Scale_Value
(Dividend_Type
);
1927 Divisor_Scale
: constant Uint
:= Scale_Value
(Divisor_Type
);
1928 Quotient_Scale
: constant Uint
:= Scale_Value
(Quotient_Type
);
1929 Remainder_Scale
: constant Uint
:= Scale_Value
(Remainder_Type
);
1932 Numerator_Scale
: Uint
;
1936 Computed_Remainder
: Node_Id
;
1937 Adjusted_Remainder
: Node_Id
;
1938 Scale_Adjust
: Uint
;
1941 -- Relocate the operands, since they are now list elements, and we
1942 -- need to reference them separately as operands in the expanded code.
1944 Dividend
:= Relocate_Node
(Dividend
);
1945 Divisor
:= Relocate_Node
(Divisor
);
1946 Quotient
:= Relocate_Node
(Quotient
);
1947 Remainder
:= Relocate_Node
(Remainder
);
1949 -- Now compute Q, the adjustment scale
1951 Q
:= Divisor_Scale
+ Quotient_Scale
- Dividend_Scale
;
1953 -- If Q is non-negative then we need a scaled divide
1956 Build_Scaled_Divide_Code
1959 Integer_Literal
(N
, Uint_10
** Q
),
1963 Numerator_Scale
:= Dividend_Scale
+ Q
;
1965 -- If Q is negative, then we need a double divide
1968 Build_Double_Divide_Code
1972 Integer_Literal
(N
, Uint_10
** (-Q
)),
1975 Numerator_Scale
:= Dividend_Scale
;
1978 -- Add statement to set quotient value
1980 -- Quotient := quotient-type!(Qnn);
1983 Make_Assignment_Statement
(Loc
,
1986 Unchecked_Convert_To
(Quotient_Type
,
1987 Build_Conversion
(N
, Quotient_Type
,
1988 New_Occurrence_Of
(Qnn
, Loc
)))));
1990 -- Now we need to deal with computing and setting the remainder. The
1991 -- scale of the remainder is in Numerator_Scale, and the desired
1992 -- scale is the scale of the given Remainder argument. There are
1995 -- Numerator_Scale > Remainder_Scale
1997 -- in this case, there are extra digits in the computed remainder
1998 -- which must be eliminated by an extra division:
2000 -- computed-remainder := Numerator rem Denominator
2001 -- scale_adjust = Numerator_Scale - Remainder_Scale
2002 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
2004 -- Numerator_Scale = Remainder_Scale
2006 -- in this case, the we have the remainder we need
2008 -- computed-remainder := Numerator rem Denominator
2009 -- adjusted-remainder := computed-remainder
2011 -- Numerator_Scale < Remainder_Scale
2013 -- in this case, we have insufficient digits in the computed
2014 -- remainder, which must be eliminated by an extra multiply
2016 -- computed-remainder := Numerator rem Denominator
2017 -- scale_adjust = Remainder_Scale - Numerator_Scale
2018 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
2020 -- Finally we assign the adjusted-remainder to the result Remainder
2021 -- with conversions to get the proper fixed-point type representation.
2023 Computed_Remainder
:= New_Occurrence_Of
(Rnn
, Loc
);
2025 if Numerator_Scale
> Remainder_Scale
then
2026 Scale_Adjust
:= Numerator_Scale
- Remainder_Scale
;
2027 Adjusted_Remainder
:=
2029 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
2031 elsif Numerator_Scale
= Remainder_Scale
then
2032 Adjusted_Remainder
:= Computed_Remainder
;
2034 else -- Numerator_Scale < Remainder_Scale
2035 Scale_Adjust
:= Remainder_Scale
- Numerator_Scale
;
2036 Adjusted_Remainder
:=
2038 (N
, Computed_Remainder
, Integer_Literal
(N
, 10 ** Scale_Adjust
));
2041 -- Assignment of remainder result
2044 Make_Assignment_Statement
(Loc
,
2047 Unchecked_Convert_To
(Remainder_Type
, Adjusted_Remainder
)));
2049 -- Final step is to rewrite the call with a block containing the
2050 -- above sequence of constructed statements for the divide operation.
2053 Make_Block_Statement
(Loc
,
2054 Handled_Statement_Sequence
=>
2055 Make_Handled_Sequence_Of_Statements
(Loc
,
2056 Statements
=> Stmts
)));
2059 end Expand_Decimal_Divide_Call
;
2061 -----------------------------------------------
2062 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
2063 -----------------------------------------------
2065 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2066 Left
: constant Node_Id
:= Left_Opnd
(N
);
2067 Right
: constant Node_Id
:= Right_Opnd
(N
);
2070 if Etype
(Left
) = Universal_Real
then
2071 Do_Divide_Universal_Fixed
(N
);
2073 elsif Etype
(Right
) = Universal_Real
then
2074 Do_Divide_Fixed_Universal
(N
);
2077 Do_Divide_Fixed_Fixed
(N
);
2079 -- A focused optimization: if after constant folding the
2080 -- expression is of the form: T ((Exp * D) / D), where D is
2081 -- a static constant, return T (Exp). This form will show up
2082 -- when D is the denominator of the static expression for the
2083 -- 'small of fixed-point types involved. This transformation
2084 -- removes a division that may be expensive on some targets.
2086 if Nkind
(N
) = N_Type_Conversion
2087 and then Nkind
(Expression
(N
)) = N_Op_Divide
2090 Num
: constant Node_Id
:= Left_Opnd
(Expression
(N
));
2091 Den
: constant Node_Id
:= Right_Opnd
(Expression
(N
));
2094 if Nkind
(Den
) = N_Integer_Literal
2095 and then Nkind
(Num
) = N_Op_Multiply
2096 and then Nkind
(Right_Opnd
(Num
)) = N_Integer_Literal
2097 and then Intval
(Den
) = Intval
(Right_Opnd
(Num
))
2099 Rewrite
(Expression
(N
), Left_Opnd
(Num
));
2104 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed
;
2106 -----------------------------------------------
2107 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
2108 -----------------------------------------------
2110 -- The division is done in Universal_Real, and the result is multiplied
2111 -- by the small ratio, which is Small (Right) / Small (Left). Special
2112 -- treatment is required for universal operands, which represent their
2113 -- own value and do not require conversion.
2115 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2116 Left
: constant Node_Id
:= Left_Opnd
(N
);
2117 Right
: constant Node_Id
:= Right_Opnd
(N
);
2119 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2120 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2123 -- Case of left operand is universal real, the result we want is:
2125 -- Left_Value / (Right_Value * Right_Small)
2127 -- so we compute this as:
2129 -- (Left_Value / Right_Small) / Right_Value
2131 if Left_Type
= Universal_Real
then
2134 Real_Literal
(N
, Realval
(Left
) / Small_Value
(Right_Type
)),
2135 Fpt_Value
(Right
)));
2137 -- Case of right operand is universal real, the result we want is
2139 -- (Left_Value * Left_Small) / Right_Value
2141 -- so we compute this as:
2143 -- Left_Value * (Left_Small / Right_Value)
2145 -- Note we invert to a multiplication since usually floating-point
2146 -- multiplication is much faster than floating-point division.
2148 elsif Right_Type
= Universal_Real
then
2152 Real_Literal
(N
, Small_Value
(Left_Type
) / Realval
(Right
))));
2154 -- Both operands are fixed, so the value we want is
2156 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2158 -- which we compute as:
2160 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2165 Build_Divide
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2167 Small_Value
(Left_Type
) / Small_Value
(Right_Type
))));
2169 end Expand_Divide_Fixed_By_Fixed_Giving_Float
;
2171 -------------------------------------------------
2172 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2173 -------------------------------------------------
2175 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2176 Left
: constant Node_Id
:= Left_Opnd
(N
);
2177 Right
: constant Node_Id
:= Right_Opnd
(N
);
2179 if Etype
(Left
) = Universal_Real
then
2180 Do_Divide_Universal_Fixed
(N
);
2181 elsif Etype
(Right
) = Universal_Real
then
2182 Do_Divide_Fixed_Universal
(N
);
2184 Do_Divide_Fixed_Fixed
(N
);
2186 end Expand_Divide_Fixed_By_Fixed_Giving_Integer
;
2188 -------------------------------------------------
2189 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2190 -------------------------------------------------
2192 -- Since the operand and result fixed-point type is the same, this is
2193 -- a straight divide by the right operand, the small can be ignored.
2195 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2196 Left
: constant Node_Id
:= Left_Opnd
(N
);
2197 Right
: constant Node_Id
:= Right_Opnd
(N
);
2199 Set_Result
(N
, Build_Divide
(N
, Left
, Right
));
2200 end Expand_Divide_Fixed_By_Integer_Giving_Fixed
;
2202 -------------------------------------------------
2203 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2204 -------------------------------------------------
2206 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2207 Left
: constant Node_Id
:= Left_Opnd
(N
);
2208 Right
: constant Node_Id
:= Right_Opnd
(N
);
2210 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
);
2211 -- The operand may be a non-static universal value, such an
2212 -- exponentiation with a non-static exponent. In that case, treat
2213 -- as a fixed * fixed multiplication, and convert the argument to
2214 -- the target fixed type.
2216 ----------------------------------
2217 -- Rewrite_Non_Static_Universal --
2218 ----------------------------------
2220 procedure Rewrite_Non_Static_Universal
(Opnd
: Node_Id
) is
2221 Loc
: constant Source_Ptr
:= Sloc
(N
);
2224 Make_Type_Conversion
(Loc
,
2225 Subtype_Mark
=> New_Occurrence_Of
(Etype
(N
), Loc
),
2226 Expression
=> Expression
(Opnd
)));
2227 Analyze_And_Resolve
(Opnd
, Etype
(N
));
2228 end Rewrite_Non_Static_Universal
;
2230 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2233 if Etype
(Left
) = Universal_Real
then
2234 if Nkind
(Left
) = N_Real_Literal
then
2235 Do_Multiply_Fixed_Universal
(N
, Left
=> Right
, Right
=> Left
);
2237 elsif Nkind
(Left
) = N_Type_Conversion
then
2238 Rewrite_Non_Static_Universal
(Left
);
2239 Do_Multiply_Fixed_Fixed
(N
);
2242 elsif Etype
(Right
) = Universal_Real
then
2243 if Nkind
(Right
) = N_Real_Literal
then
2244 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2246 elsif Nkind
(Right
) = N_Type_Conversion
then
2247 Rewrite_Non_Static_Universal
(Right
);
2248 Do_Multiply_Fixed_Fixed
(N
);
2252 Do_Multiply_Fixed_Fixed
(N
);
2254 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
;
2256 -------------------------------------------------
2257 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2258 -------------------------------------------------
2260 -- The multiply is done in Universal_Real, and the result is multiplied
2261 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2262 -- Special treatment is required for universal operands.
2264 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float
(N
: Node_Id
) is
2265 Left
: constant Node_Id
:= Left_Opnd
(N
);
2266 Right
: constant Node_Id
:= Right_Opnd
(N
);
2268 Left_Type
: constant Entity_Id
:= Etype
(Left
);
2269 Right_Type
: constant Entity_Id
:= Etype
(Right
);
2272 -- Case of left operand is universal real, the result we want is
2274 -- Left_Value * (Right_Value * Right_Small)
2276 -- so we compute this as:
2278 -- (Left_Value * Right_Small) * Right_Value;
2280 if Left_Type
= Universal_Real
then
2283 Real_Literal
(N
, Realval
(Left
) * Small_Value
(Right_Type
)),
2284 Fpt_Value
(Right
)));
2286 -- Case of right operand is universal real, the result we want is
2288 -- (Left_Value * Left_Small) * Right_Value
2290 -- so we compute this as:
2292 -- Left_Value * (Left_Small * Right_Value)
2294 elsif Right_Type
= Universal_Real
then
2298 Real_Literal
(N
, Small_Value
(Left_Type
) * Realval
(Right
))));
2300 -- Both operands are fixed, so the value we want is
2302 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2304 -- which we compute as:
2306 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2311 Build_Multiply
(N
, Fpt_Value
(Left
), Fpt_Value
(Right
)),
2313 Small_Value
(Right_Type
) * Small_Value
(Left_Type
))));
2315 end Expand_Multiply_Fixed_By_Fixed_Giving_Float
;
2317 ---------------------------------------------------
2318 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2319 ---------------------------------------------------
2321 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer
(N
: Node_Id
) is
2322 Loc
: constant Source_Ptr
:= Sloc
(N
);
2323 Left
: constant Node_Id
:= Left_Opnd
(N
);
2324 Right
: constant Node_Id
:= Right_Opnd
(N
);
2327 if Etype
(Left
) = Universal_Real
then
2328 Do_Multiply_Fixed_Universal
(N
, Left
=> Right
, Right
=> Left
);
2330 elsif Etype
(Right
) = Universal_Real
then
2331 Do_Multiply_Fixed_Universal
(N
, Left
, Right
);
2333 -- If both types are equal and we need to avoid floating point
2334 -- instructions, it's worth introducing a temporary with the
2335 -- common type, because it may be evaluated more simply without
2336 -- the need for run-time use of floating point.
2338 elsif Etype
(Right
) = Etype
(Left
)
2339 and then Restriction_Active
(No_Floating_Point
)
2342 Temp
: constant Entity_Id
:= Make_Temporary
(Loc
, 'F');
2343 Mult
: constant Node_Id
:= Make_Op_Multiply
(Loc
, Left
, Right
);
2344 Decl
: constant Node_Id
:=
2345 Make_Object_Declaration
(Loc
,
2346 Defining_Identifier
=> Temp
,
2347 Object_Definition
=> New_Occurrence_Of
(Etype
(Right
), Loc
),
2348 Expression
=> Mult
);
2351 Insert_Action
(N
, Decl
);
2353 OK_Convert_To
(Etype
(N
), New_Occurrence_Of
(Temp
, Loc
)));
2354 Analyze_And_Resolve
(N
, Standard_Integer
);
2358 Do_Multiply_Fixed_Fixed
(N
);
2360 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer
;
2362 ---------------------------------------------------
2363 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2364 ---------------------------------------------------
2366 -- Since the operand and result fixed-point type is the same, this is
2367 -- a straight multiply by the right operand, the small can be ignored.
2369 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed
(N
: Node_Id
) is
2372 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2373 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed
;
2375 ---------------------------------------------------
2376 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2377 ---------------------------------------------------
2379 -- Since the operand and result fixed-point type is the same, this is
2380 -- a straight multiply by the right operand, the small can be ignored.
2382 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed
(N
: Node_Id
) is
2385 Build_Multiply
(N
, Left_Opnd
(N
), Right_Opnd
(N
)));
2386 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed
;
2392 function Fpt_Value
(N
: Node_Id
) return Node_Id
is
2394 return Build_Conversion
(N
, Universal_Real
, N
);
2397 ------------------------
2398 -- Get_Size_For_Value --
2399 ------------------------
2401 function Get_Size_For_Value
(V
: Uint
) return Pos
is
2403 pragma Assert
(V
>= Uint_0
);
2405 if V
< Uint_2
** 7 then
2408 elsif V
< Uint_2
** 15 then
2411 elsif V
< Uint_2
** 31 then
2414 elsif V
< Uint_2
** 63 then
2417 elsif V
< Uint_2
** 127 then
2423 end Get_Size_For_Value
;
2425 -----------------------
2426 -- Get_Type_For_Size --
2427 -----------------------
2429 function Get_Type_For_Size
(Siz
: Pos
; Force
: Boolean) return Entity_Id
is
2432 return Standard_Integer_8
;
2434 elsif Siz
<= 16 then
2435 return Standard_Integer_16
;
2437 elsif Siz
<= 32 then
2438 return Standard_Integer_32
;
2441 or else (Force
and then System_Max_Integer_Size
< 128)
2443 return Standard_Integer_64
;
2445 elsif (Siz
<= 128 and then System_Max_Integer_Size
= 128)
2448 return Standard_Integer_128
;
2453 end Get_Type_For_Size
;
2455 ---------------------
2456 -- Integer_Literal --
2457 ---------------------
2459 function Integer_Literal
2462 Negative
: Boolean := False) return Node_Id
2468 T
:= Get_Type_For_Size
(Get_Size_For_Value
(V
), Force
=> False);
2474 L
:= Make_Integer_Literal
(Sloc
(N
), UI_Negate
(V
));
2476 L
:= Make_Integer_Literal
(Sloc
(N
), V
);
2479 -- Set type of result in case used elsewhere (see note at start)
2482 Set_Is_Static_Expression
(L
);
2484 -- We really need to set Analyzed here because we may be creating a
2485 -- very strange beast, namely an integer literal typed as fixed-point
2486 -- and the analyzer won't like that.
2490 end Integer_Literal
;
2496 function Real_Literal
(N
: Node_Id
; V
: Ureal
) return Node_Id
is
2500 L
:= Make_Real_Literal
(Sloc
(N
), V
);
2502 -- Set type of result in case used elsewhere (see note at start)
2504 Set_Etype
(L
, Universal_Real
);
2508 ------------------------
2509 -- Rounded_Result_Set --
2510 ------------------------
2512 function Rounded_Result_Set
(N
: Node_Id
) return Boolean is
2513 K
: constant Node_Kind
:= Nkind
(N
);
2515 if (K
= N_Type_Conversion
or else
2516 K
= N_Op_Divide
or else
2519 (Rounded_Result
(N
) or else Is_Integer_Type
(Etype
(N
)))
2525 end Rounded_Result_Set
;
2531 procedure Set_Result
2534 Rchk
: Boolean := False;
2535 Trunc
: Boolean := False)
2539 Expr_Type
: constant Entity_Id
:= Etype
(Expr
);
2540 Result_Type
: constant Entity_Id
:= Etype
(N
);
2543 -- No conversion required if types match and no range check or truncate
2545 if Result_Type
= Expr_Type
and then not (Rchk
or Trunc
) then
2548 -- Else perform required conversion
2551 Cnode
:= Build_Conversion
(N
, Result_Type
, Expr
, Rchk
, Trunc
);
2555 Analyze_And_Resolve
(N
, Result_Type
);