1 |
281 |
jeremybenn |
------------------------------------------------------------------------------
|
2 |
|
|
-- --
|
3 |
|
|
-- GNAT COMPILER COMPONENTS --
|
4 |
|
|
-- --
|
5 |
|
|
-- E X P _ F I X D --
|
6 |
|
|
-- --
|
7 |
|
|
-- B o d y --
|
8 |
|
|
-- --
|
9 |
|
|
-- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
|
10 |
|
|
-- --
|
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. --
|
20 |
|
|
-- --
|
21 |
|
|
-- GNAT was originally developed by the GNAT team at New York University. --
|
22 |
|
|
-- Extensive contributions were provided by Ada Core Technologies Inc. --
|
23 |
|
|
-- --
|
24 |
|
|
------------------------------------------------------------------------------
|
25 |
|
|
|
26 |
|
|
with Atree; use Atree;
|
27 |
|
|
with Checks; use Checks;
|
28 |
|
|
with Einfo; use Einfo;
|
29 |
|
|
with Exp_Util; use Exp_Util;
|
30 |
|
|
with Nlists; use Nlists;
|
31 |
|
|
with Nmake; use Nmake;
|
32 |
|
|
with Rtsfind; use Rtsfind;
|
33 |
|
|
with Sem; use Sem;
|
34 |
|
|
with Sem_Eval; use Sem_Eval;
|
35 |
|
|
with Sem_Res; use Sem_Res;
|
36 |
|
|
with Sem_Util; use Sem_Util;
|
37 |
|
|
with Sinfo; use Sinfo;
|
38 |
|
|
with Stand; use Stand;
|
39 |
|
|
with Tbuild; use Tbuild;
|
40 |
|
|
with Uintp; use Uintp;
|
41 |
|
|
with Urealp; use Urealp;
|
42 |
|
|
|
43 |
|
|
package body Exp_Fixd is
|
44 |
|
|
|
45 |
|
|
-----------------------
|
46 |
|
|
-- Local Subprograms --
|
47 |
|
|
-----------------------
|
48 |
|
|
|
49 |
|
|
-- General note; in this unit, a number of routines are driven by the
|
50 |
|
|
-- types (Etype) of their operands. Since we are dealing with unanalyzed
|
51 |
|
|
-- expressions as they are constructed, the Etypes would not normally be
|
52 |
|
|
-- set, but the construction routines that we use in this unit do in fact
|
53 |
|
|
-- set the Etype values correctly. In addition, setting the Etype ensures
|
54 |
|
|
-- that the analyzer does not try to redetermine the type when the node
|
55 |
|
|
-- is analyzed (which would be wrong, since in the case where we set the
|
56 |
|
|
-- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
|
57 |
|
|
-- still dealing with a normal fixed-point operation and mess it up).
|
58 |
|
|
|
59 |
|
|
function Build_Conversion
|
60 |
|
|
(N : Node_Id;
|
61 |
|
|
Typ : Entity_Id;
|
62 |
|
|
Expr : Node_Id;
|
63 |
|
|
Rchk : Boolean := False;
|
64 |
|
|
Trunc : Boolean := False) return Node_Id;
|
65 |
|
|
-- Build an expression that converts the expression Expr to type Typ,
|
66 |
|
|
-- taking the source location from Sloc (N). If the conversions involve
|
67 |
|
|
-- fixed-point types, then the Conversion_OK flag will be set so that the
|
68 |
|
|
-- resulting conversions do not get re-expanded. On return the resulting
|
69 |
|
|
-- node has its Etype set. If Rchk is set, then Do_Range_Check is set
|
70 |
|
|
-- in the resulting conversion node. If Trunc is set, then the
|
71 |
|
|
-- Float_Truncate flag is set on the conversion, which must be from
|
72 |
|
|
-- a floating-point type to an integer type.
|
73 |
|
|
|
74 |
|
|
function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
|
75 |
|
|
-- Builds an N_Op_Divide node from the given left and right operand
|
76 |
|
|
-- expressions, using the source location from Sloc (N). The operands are
|
77 |
|
|
-- either both Universal_Real, in which case Build_Divide differs from
|
78 |
|
|
-- Make_Op_Divide only in that the Etype of the resulting node is set (to
|
79 |
|
|
-- Universal_Real), or they can be integer types. In this case the integer
|
80 |
|
|
-- types need not be the same, and Build_Divide converts the operand with
|
81 |
|
|
-- the smaller sized type to match the type of the other operand and sets
|
82 |
|
|
-- this as the result type. The Rounded_Result flag of the result in this
|
83 |
|
|
-- case is set from the Rounded_Result flag of node N. On return, the
|
84 |
|
|
-- resulting node is analyzed, and has its Etype set.
|
85 |
|
|
|
86 |
|
|
function Build_Double_Divide
|
87 |
|
|
(N : Node_Id;
|
88 |
|
|
X, Y, Z : Node_Id) return Node_Id;
|
89 |
|
|
-- Returns a node corresponding to the value X/(Y*Z) using the source
|
90 |
|
|
-- location from Sloc (N). The division is rounded if the Rounded_Result
|
91 |
|
|
-- flag of N is set. The integer types of X, Y, Z may be different. On
|
92 |
|
|
-- return the resulting node is analyzed, and has its Etype set.
|
93 |
|
|
|
94 |
|
|
procedure Build_Double_Divide_Code
|
95 |
|
|
(N : Node_Id;
|
96 |
|
|
X, Y, Z : Node_Id;
|
97 |
|
|
Qnn, Rnn : out Entity_Id;
|
98 |
|
|
Code : out List_Id);
|
99 |
|
|
-- Generates a sequence of code for determining the quotient and remainder
|
100 |
|
|
-- of the division X/(Y*Z), using the source location from Sloc (N).
|
101 |
|
|
-- Entities of appropriate types are allocated for the quotient and
|
102 |
|
|
-- remainder and returned in Qnn and Rnn. The result is rounded if the
|
103 |
|
|
-- Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are
|
104 |
|
|
-- appropriately set on return.
|
105 |
|
|
|
106 |
|
|
function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
|
107 |
|
|
-- Builds an N_Op_Multiply node from the given left and right operand
|
108 |
|
|
-- expressions, using the source location from Sloc (N). The operands are
|
109 |
|
|
-- either both Universal_Real, in which case Build_Multiply differs from
|
110 |
|
|
-- Make_Op_Multiply only in that the Etype of the resulting node is set (to
|
111 |
|
|
-- Universal_Real), or they can be integer types. In this case the integer
|
112 |
|
|
-- types need not be the same, and Build_Multiply chooses a type long
|
113 |
|
|
-- enough to hold the product (i.e. twice the size of the longer of the two
|
114 |
|
|
-- operand types), and both operands are converted to this type. The Etype
|
115 |
|
|
-- of the result is also set to this value. However, the result can never
|
116 |
|
|
-- overflow Integer_64, so this is the largest type that is ever generated.
|
117 |
|
|
-- On return, the resulting node is analyzed and has its Etype set.
|
118 |
|
|
|
119 |
|
|
function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
|
120 |
|
|
-- Builds an N_Op_Rem node from the given left and right operand
|
121 |
|
|
-- expressions, using the source location from Sloc (N). The operands are
|
122 |
|
|
-- both integer types, which need not be the same. Build_Rem converts the
|
123 |
|
|
-- operand with the smaller sized type to match the type of the other
|
124 |
|
|
-- operand and sets this as the result type. The result is never rounded
|
125 |
|
|
-- (rem operations cannot be rounded in any case!) On return, the resulting
|
126 |
|
|
-- node is analyzed and has its Etype set.
|
127 |
|
|
|
128 |
|
|
function Build_Scaled_Divide
|
129 |
|
|
(N : Node_Id;
|
130 |
|
|
X, Y, Z : Node_Id) return Node_Id;
|
131 |
|
|
-- Returns a node corresponding to the value X*Y/Z using the source
|
132 |
|
|
-- location from Sloc (N). The division is rounded if the Rounded_Result
|
133 |
|
|
-- flag of N is set. The integer types of X, Y, Z may be different. On
|
134 |
|
|
-- return the resulting node is analyzed and has is Etype set.
|
135 |
|
|
|
136 |
|
|
procedure Build_Scaled_Divide_Code
|
137 |
|
|
(N : Node_Id;
|
138 |
|
|
X, Y, Z : Node_Id;
|
139 |
|
|
Qnn, Rnn : out Entity_Id;
|
140 |
|
|
Code : out List_Id);
|
141 |
|
|
-- Generates a sequence of code for determining the quotient and remainder
|
142 |
|
|
-- of the division X*Y/Z, using the source location from Sloc (N). Entities
|
143 |
|
|
-- of appropriate types are allocated for the quotient and remainder and
|
144 |
|
|
-- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
|
145 |
|
|
-- The division is rounded if the Rounded_Result flag of N is set. The
|
146 |
|
|
-- Etype fields of Qnn and Rnn are appropriately set on return.
|
147 |
|
|
|
148 |
|
|
procedure Do_Divide_Fixed_Fixed (N : Node_Id);
|
149 |
|
|
-- Handles expansion of divide for case of two fixed-point operands
|
150 |
|
|
-- (neither of them universal), with an integer or fixed-point result.
|
151 |
|
|
-- N is the N_Op_Divide node to be expanded.
|
152 |
|
|
|
153 |
|
|
procedure Do_Divide_Fixed_Universal (N : Node_Id);
|
154 |
|
|
-- Handles expansion of divide for case of a fixed-point operand divided
|
155 |
|
|
-- by a universal real operand, with an integer or fixed-point result. N
|
156 |
|
|
-- is the N_Op_Divide node to be expanded.
|
157 |
|
|
|
158 |
|
|
procedure Do_Divide_Universal_Fixed (N : Node_Id);
|
159 |
|
|
-- Handles expansion of divide for case of a universal real operand
|
160 |
|
|
-- divided by a fixed-point operand, with an integer or fixed-point
|
161 |
|
|
-- result. N is the N_Op_Divide node to be expanded.
|
162 |
|
|
|
163 |
|
|
procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
|
164 |
|
|
-- Handles expansion of multiply for case of two fixed-point operands
|
165 |
|
|
-- (neither of them universal), with an integer or fixed-point result.
|
166 |
|
|
-- N is the N_Op_Multiply node to be expanded.
|
167 |
|
|
|
168 |
|
|
procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
|
169 |
|
|
-- Handles expansion of multiply for case of a fixed-point operand
|
170 |
|
|
-- multiplied by a universal real operand, with an integer or fixed-
|
171 |
|
|
-- point result. N is the N_Op_Multiply node to be expanded, and
|
172 |
|
|
-- Left, Right are the operands (which may have been switched).
|
173 |
|
|
|
174 |
|
|
procedure Expand_Convert_Fixed_Static (N : Node_Id);
|
175 |
|
|
-- This routine is called where the node N is a conversion of a literal
|
176 |
|
|
-- or other static expression of a fixed-point type to some other type.
|
177 |
|
|
-- In such cases, we simply rewrite the operand as a real literal and
|
178 |
|
|
-- reanalyze. This avoids problems which would otherwise result from
|
179 |
|
|
-- attempting to build and fold expressions involving constants.
|
180 |
|
|
|
181 |
|
|
function Fpt_Value (N : Node_Id) return Node_Id;
|
182 |
|
|
-- Given an operand of fixed-point operation, return an expression that
|
183 |
|
|
-- represents the corresponding Universal_Real value. The expression
|
184 |
|
|
-- can be of integer type, floating-point type, or fixed-point type.
|
185 |
|
|
-- The expression returned is neither analyzed and resolved. The Etype
|
186 |
|
|
-- of the result is properly set (to Universal_Real).
|
187 |
|
|
|
188 |
|
|
function Integer_Literal
|
189 |
|
|
(N : Node_Id;
|
190 |
|
|
V : Uint;
|
191 |
|
|
Negative : Boolean := False) return Node_Id;
|
192 |
|
|
-- Given a non-negative universal integer value, build a typed integer
|
193 |
|
|
-- literal node, using the smallest applicable standard integer type. If
|
194 |
|
|
-- and only if Negative is true a negative literal is built. If V exceeds
|
195 |
|
|
-- 2**63-1, the largest value allowed for perfect result set scaling
|
196 |
|
|
-- factors (see RM G.2.3(22)), then Empty is returned. The node N provides
|
197 |
|
|
-- the Sloc value for the constructed literal. The Etype of the resulting
|
198 |
|
|
-- literal is correctly set, and it is marked as analyzed.
|
199 |
|
|
|
200 |
|
|
function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
|
201 |
|
|
-- Build a real literal node from the given value, the Etype of the
|
202 |
|
|
-- returned node is set to Universal_Real, since all floating-point
|
203 |
|
|
-- arithmetic operations that we construct use Universal_Real
|
204 |
|
|
|
205 |
|
|
function Rounded_Result_Set (N : Node_Id) return Boolean;
|
206 |
|
|
-- Returns True if N is a node that contains the Rounded_Result flag
|
207 |
|
|
-- and if the flag is true or the target type is an integer type.
|
208 |
|
|
|
209 |
|
|
procedure Set_Result
|
210 |
|
|
(N : Node_Id;
|
211 |
|
|
Expr : Node_Id;
|
212 |
|
|
Rchk : Boolean := False;
|
213 |
|
|
Trunc : Boolean := False);
|
214 |
|
|
-- N is the node for the current conversion, division or multiplication
|
215 |
|
|
-- operation, and Expr is an expression representing the result. Expr may
|
216 |
|
|
-- be of floating-point or integer type. If the operation result is fixed-
|
217 |
|
|
-- point, then the value of Expr is in units of small of the result type
|
218 |
|
|
-- (i.e. small's have already been dealt with). The result of the call is
|
219 |
|
|
-- to replace N by an appropriate conversion to the result type, dealing
|
220 |
|
|
-- with rounding for the decimal types case. The node is then analyzed and
|
221 |
|
|
-- resolved using the result type. If Rchk or Trunc are True, then
|
222 |
|
|
-- respectively Do_Range_Check and Float_Truncate are set in the
|
223 |
|
|
-- resulting conversion.
|
224 |
|
|
|
225 |
|
|
----------------------
|
226 |
|
|
-- Build_Conversion --
|
227 |
|
|
----------------------
|
228 |
|
|
|
229 |
|
|
function Build_Conversion
|
230 |
|
|
(N : Node_Id;
|
231 |
|
|
Typ : Entity_Id;
|
232 |
|
|
Expr : Node_Id;
|
233 |
|
|
Rchk : Boolean := False;
|
234 |
|
|
Trunc : Boolean := False) return Node_Id
|
235 |
|
|
is
|
236 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
237 |
|
|
Result : Node_Id;
|
238 |
|
|
Rcheck : Boolean := Rchk;
|
239 |
|
|
|
240 |
|
|
begin
|
241 |
|
|
-- A special case, if the expression is an integer literal and the
|
242 |
|
|
-- target type is an integer type, then just retype the integer
|
243 |
|
|
-- literal to the desired target type. Don't do this if we need
|
244 |
|
|
-- a range check.
|
245 |
|
|
|
246 |
|
|
if Nkind (Expr) = N_Integer_Literal
|
247 |
|
|
and then Is_Integer_Type (Typ)
|
248 |
|
|
and then not Rchk
|
249 |
|
|
then
|
250 |
|
|
Result := Expr;
|
251 |
|
|
|
252 |
|
|
-- Cases where we end up with a conversion. Note that we do not use the
|
253 |
|
|
-- Convert_To abstraction here, since we may be decorating the resulting
|
254 |
|
|
-- conversion with Rounded_Result and/or Conversion_OK, so we want the
|
255 |
|
|
-- conversion node present, even if it appears to be redundant.
|
256 |
|
|
|
257 |
|
|
else
|
258 |
|
|
-- Remove inner conversion if both inner and outer conversions are
|
259 |
|
|
-- to integer types, since the inner one serves no purpose (except
|
260 |
|
|
-- perhaps to set rounding, so we preserve the Rounded_Result flag)
|
261 |
|
|
-- and also we preserve the range check flag on the inner operand
|
262 |
|
|
|
263 |
|
|
if Is_Integer_Type (Typ)
|
264 |
|
|
and then Is_Integer_Type (Etype (Expr))
|
265 |
|
|
and then Nkind (Expr) = N_Type_Conversion
|
266 |
|
|
then
|
267 |
|
|
Result :=
|
268 |
|
|
Make_Type_Conversion (Loc,
|
269 |
|
|
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
|
270 |
|
|
Expression => Expression (Expr));
|
271 |
|
|
Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
|
272 |
|
|
Rcheck := Rcheck or Do_Range_Check (Expr);
|
273 |
|
|
|
274 |
|
|
-- For all other cases, a simple type conversion will work
|
275 |
|
|
|
276 |
|
|
else
|
277 |
|
|
Result :=
|
278 |
|
|
Make_Type_Conversion (Loc,
|
279 |
|
|
Subtype_Mark => New_Occurrence_Of (Typ, Loc),
|
280 |
|
|
Expression => Expr);
|
281 |
|
|
|
282 |
|
|
Set_Float_Truncate (Result, Trunc);
|
283 |
|
|
end if;
|
284 |
|
|
|
285 |
|
|
-- Set Conversion_OK if either result or expression type is a
|
286 |
|
|
-- fixed-point type, since from a semantic point of view, we are
|
287 |
|
|
-- treating fixed-point values as integers at this stage.
|
288 |
|
|
|
289 |
|
|
if Is_Fixed_Point_Type (Typ)
|
290 |
|
|
or else Is_Fixed_Point_Type (Etype (Expression (Result)))
|
291 |
|
|
then
|
292 |
|
|
Set_Conversion_OK (Result);
|
293 |
|
|
end if;
|
294 |
|
|
|
295 |
|
|
-- Set Do_Range_Check if either it was requested by the caller,
|
296 |
|
|
-- or if an eliminated inner conversion had a range check.
|
297 |
|
|
|
298 |
|
|
if Rcheck then
|
299 |
|
|
Enable_Range_Check (Result);
|
300 |
|
|
else
|
301 |
|
|
Set_Do_Range_Check (Result, False);
|
302 |
|
|
end if;
|
303 |
|
|
end if;
|
304 |
|
|
|
305 |
|
|
Set_Etype (Result, Typ);
|
306 |
|
|
return Result;
|
307 |
|
|
end Build_Conversion;
|
308 |
|
|
|
309 |
|
|
------------------
|
310 |
|
|
-- Build_Divide --
|
311 |
|
|
------------------
|
312 |
|
|
|
313 |
|
|
function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
|
314 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
315 |
|
|
Left_Type : constant Entity_Id := Base_Type (Etype (L));
|
316 |
|
|
Right_Type : constant Entity_Id := Base_Type (Etype (R));
|
317 |
|
|
Result_Type : Entity_Id;
|
318 |
|
|
Rnode : Node_Id;
|
319 |
|
|
|
320 |
|
|
begin
|
321 |
|
|
-- Deal with floating-point case first
|
322 |
|
|
|
323 |
|
|
if Is_Floating_Point_Type (Left_Type) then
|
324 |
|
|
pragma Assert (Left_Type = Universal_Real);
|
325 |
|
|
pragma Assert (Right_Type = Universal_Real);
|
326 |
|
|
|
327 |
|
|
Rnode := Make_Op_Divide (Loc, L, R);
|
328 |
|
|
Result_Type := Universal_Real;
|
329 |
|
|
|
330 |
|
|
-- Integer and fixed-point cases
|
331 |
|
|
|
332 |
|
|
else
|
333 |
|
|
-- An optimization. If the right operand is the literal 1, then we
|
334 |
|
|
-- can just return the left hand operand. Putting the optimization
|
335 |
|
|
-- here allows us to omit the check at the call site.
|
336 |
|
|
|
337 |
|
|
if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
|
338 |
|
|
return L;
|
339 |
|
|
end if;
|
340 |
|
|
|
341 |
|
|
-- If left and right types are the same, no conversion needed
|
342 |
|
|
|
343 |
|
|
if Left_Type = Right_Type then
|
344 |
|
|
Result_Type := Left_Type;
|
345 |
|
|
Rnode :=
|
346 |
|
|
Make_Op_Divide (Loc,
|
347 |
|
|
Left_Opnd => L,
|
348 |
|
|
Right_Opnd => R);
|
349 |
|
|
|
350 |
|
|
-- Use left type if it is the larger of the two
|
351 |
|
|
|
352 |
|
|
elsif Esize (Left_Type) >= Esize (Right_Type) then
|
353 |
|
|
Result_Type := Left_Type;
|
354 |
|
|
Rnode :=
|
355 |
|
|
Make_Op_Divide (Loc,
|
356 |
|
|
Left_Opnd => L,
|
357 |
|
|
Right_Opnd => Build_Conversion (N, Left_Type, R));
|
358 |
|
|
|
359 |
|
|
-- Otherwise right type is larger of the two, us it
|
360 |
|
|
|
361 |
|
|
else
|
362 |
|
|
Result_Type := Right_Type;
|
363 |
|
|
Rnode :=
|
364 |
|
|
Make_Op_Divide (Loc,
|
365 |
|
|
Left_Opnd => Build_Conversion (N, Right_Type, L),
|
366 |
|
|
Right_Opnd => R);
|
367 |
|
|
end if;
|
368 |
|
|
end if;
|
369 |
|
|
|
370 |
|
|
-- We now have a divide node built with Result_Type set. First
|
371 |
|
|
-- set Etype of result, as required for all Build_xxx routines
|
372 |
|
|
|
373 |
|
|
Set_Etype (Rnode, Base_Type (Result_Type));
|
374 |
|
|
|
375 |
|
|
-- Set Treat_Fixed_As_Integer if operation on fixed-point type
|
376 |
|
|
-- since this is a literal arithmetic operation, to be performed
|
377 |
|
|
-- by Gigi without any consideration of small values.
|
378 |
|
|
|
379 |
|
|
if Is_Fixed_Point_Type (Result_Type) then
|
380 |
|
|
Set_Treat_Fixed_As_Integer (Rnode);
|
381 |
|
|
end if;
|
382 |
|
|
|
383 |
|
|
-- The result is rounded if the target of the operation is decimal
|
384 |
|
|
-- and Rounded_Result is set, or if the target of the operation
|
385 |
|
|
-- is an integer type.
|
386 |
|
|
|
387 |
|
|
if Is_Integer_Type (Etype (N))
|
388 |
|
|
or else Rounded_Result_Set (N)
|
389 |
|
|
then
|
390 |
|
|
Set_Rounded_Result (Rnode);
|
391 |
|
|
end if;
|
392 |
|
|
|
393 |
|
|
return Rnode;
|
394 |
|
|
end Build_Divide;
|
395 |
|
|
|
396 |
|
|
-------------------------
|
397 |
|
|
-- Build_Double_Divide --
|
398 |
|
|
-------------------------
|
399 |
|
|
|
400 |
|
|
function Build_Double_Divide
|
401 |
|
|
(N : Node_Id;
|
402 |
|
|
X, Y, Z : Node_Id) return Node_Id
|
403 |
|
|
is
|
404 |
|
|
Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
|
405 |
|
|
Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
|
406 |
|
|
Expr : Node_Id;
|
407 |
|
|
|
408 |
|
|
begin
|
409 |
|
|
-- If denominator fits in 64 bits, we can build the operations directly
|
410 |
|
|
-- without causing any intermediate overflow, so that's what we do!
|
411 |
|
|
|
412 |
|
|
if Int'Max (Y_Size, Z_Size) <= 32 then
|
413 |
|
|
return
|
414 |
|
|
Build_Divide (N, X, Build_Multiply (N, Y, Z));
|
415 |
|
|
|
416 |
|
|
-- Otherwise we use the runtime routine
|
417 |
|
|
|
418 |
|
|
-- [Qnn : Interfaces.Integer_64,
|
419 |
|
|
-- Rnn : Interfaces.Integer_64;
|
420 |
|
|
-- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
|
421 |
|
|
-- Qnn]
|
422 |
|
|
|
423 |
|
|
else
|
424 |
|
|
declare
|
425 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
426 |
|
|
Qnn : Entity_Id;
|
427 |
|
|
Rnn : Entity_Id;
|
428 |
|
|
Code : List_Id;
|
429 |
|
|
|
430 |
|
|
pragma Warnings (Off, Rnn);
|
431 |
|
|
|
432 |
|
|
begin
|
433 |
|
|
Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
|
434 |
|
|
Insert_Actions (N, Code);
|
435 |
|
|
Expr := New_Occurrence_Of (Qnn, Loc);
|
436 |
|
|
|
437 |
|
|
-- Set type of result in case used elsewhere (see note at start)
|
438 |
|
|
|
439 |
|
|
Set_Etype (Expr, Etype (Qnn));
|
440 |
|
|
|
441 |
|
|
-- Set result as analyzed (see note at start on build routines)
|
442 |
|
|
|
443 |
|
|
return Expr;
|
444 |
|
|
end;
|
445 |
|
|
end if;
|
446 |
|
|
end Build_Double_Divide;
|
447 |
|
|
|
448 |
|
|
------------------------------
|
449 |
|
|
-- Build_Double_Divide_Code --
|
450 |
|
|
------------------------------
|
451 |
|
|
|
452 |
|
|
-- If the denominator can be computed in 64-bits, we build
|
453 |
|
|
|
454 |
|
|
-- [Nnn : constant typ := typ (X);
|
455 |
|
|
-- Dnn : constant typ := typ (Y) * typ (Z)
|
456 |
|
|
-- Qnn : constant typ := Nnn / Dnn;
|
457 |
|
|
-- Rnn : constant typ := Nnn / Dnn;
|
458 |
|
|
|
459 |
|
|
-- If the numerator cannot be computed in 64 bits, we build
|
460 |
|
|
|
461 |
|
|
-- [Qnn : typ;
|
462 |
|
|
-- Rnn : typ;
|
463 |
|
|
-- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
|
464 |
|
|
|
465 |
|
|
procedure Build_Double_Divide_Code
|
466 |
|
|
(N : Node_Id;
|
467 |
|
|
X, Y, Z : Node_Id;
|
468 |
|
|
Qnn, Rnn : out Entity_Id;
|
469 |
|
|
Code : out List_Id)
|
470 |
|
|
is
|
471 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
472 |
|
|
|
473 |
|
|
X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
|
474 |
|
|
Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
|
475 |
|
|
Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
|
476 |
|
|
|
477 |
|
|
QR_Siz : Int;
|
478 |
|
|
QR_Typ : Entity_Id;
|
479 |
|
|
|
480 |
|
|
Nnn : Entity_Id;
|
481 |
|
|
Dnn : Entity_Id;
|
482 |
|
|
|
483 |
|
|
Quo : Node_Id;
|
484 |
|
|
Rnd : Entity_Id;
|
485 |
|
|
|
486 |
|
|
begin
|
487 |
|
|
-- Find type that will allow computation of numerator
|
488 |
|
|
|
489 |
|
|
QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
|
490 |
|
|
|
491 |
|
|
if QR_Siz <= 16 then
|
492 |
|
|
QR_Typ := Standard_Integer_16;
|
493 |
|
|
elsif QR_Siz <= 32 then
|
494 |
|
|
QR_Typ := Standard_Integer_32;
|
495 |
|
|
elsif QR_Siz <= 64 then
|
496 |
|
|
QR_Typ := Standard_Integer_64;
|
497 |
|
|
|
498 |
|
|
-- For more than 64, bits, we use the 64-bit integer defined in
|
499 |
|
|
-- Interfaces, so that it can be handled by the runtime routine
|
500 |
|
|
|
501 |
|
|
else
|
502 |
|
|
QR_Typ := RTE (RE_Integer_64);
|
503 |
|
|
end if;
|
504 |
|
|
|
505 |
|
|
-- Define quotient and remainder, and set their Etypes, so
|
506 |
|
|
-- that they can be picked up by Build_xxx routines.
|
507 |
|
|
|
508 |
|
|
Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
|
509 |
|
|
Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
|
510 |
|
|
|
511 |
|
|
Set_Etype (Qnn, QR_Typ);
|
512 |
|
|
Set_Etype (Rnn, QR_Typ);
|
513 |
|
|
|
514 |
|
|
-- Case that we can compute the denominator in 64 bits
|
515 |
|
|
|
516 |
|
|
if QR_Siz <= 64 then
|
517 |
|
|
|
518 |
|
|
-- Create temporaries for numerator and denominator and set Etypes,
|
519 |
|
|
-- so that New_Occurrence_Of picks them up for Build_xxx calls.
|
520 |
|
|
|
521 |
|
|
Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
|
522 |
|
|
Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
|
523 |
|
|
|
524 |
|
|
Set_Etype (Nnn, QR_Typ);
|
525 |
|
|
Set_Etype (Dnn, QR_Typ);
|
526 |
|
|
|
527 |
|
|
Code := New_List (
|
528 |
|
|
Make_Object_Declaration (Loc,
|
529 |
|
|
Defining_Identifier => Nnn,
|
530 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
531 |
|
|
Constant_Present => True,
|
532 |
|
|
Expression => Build_Conversion (N, QR_Typ, X)),
|
533 |
|
|
|
534 |
|
|
Make_Object_Declaration (Loc,
|
535 |
|
|
Defining_Identifier => Dnn,
|
536 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
537 |
|
|
Constant_Present => True,
|
538 |
|
|
Expression =>
|
539 |
|
|
Build_Multiply (N,
|
540 |
|
|
Build_Conversion (N, QR_Typ, Y),
|
541 |
|
|
Build_Conversion (N, QR_Typ, Z))));
|
542 |
|
|
|
543 |
|
|
Quo :=
|
544 |
|
|
Build_Divide (N,
|
545 |
|
|
New_Occurrence_Of (Nnn, Loc),
|
546 |
|
|
New_Occurrence_Of (Dnn, Loc));
|
547 |
|
|
|
548 |
|
|
Set_Rounded_Result (Quo, Rounded_Result_Set (N));
|
549 |
|
|
|
550 |
|
|
Append_To (Code,
|
551 |
|
|
Make_Object_Declaration (Loc,
|
552 |
|
|
Defining_Identifier => Qnn,
|
553 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
554 |
|
|
Constant_Present => True,
|
555 |
|
|
Expression => Quo));
|
556 |
|
|
|
557 |
|
|
Append_To (Code,
|
558 |
|
|
Make_Object_Declaration (Loc,
|
559 |
|
|
Defining_Identifier => Rnn,
|
560 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
561 |
|
|
Constant_Present => True,
|
562 |
|
|
Expression =>
|
563 |
|
|
Build_Rem (N,
|
564 |
|
|
New_Occurrence_Of (Nnn, Loc),
|
565 |
|
|
New_Occurrence_Of (Dnn, Loc))));
|
566 |
|
|
|
567 |
|
|
-- Case where denominator does not fit in 64 bits, so we have to
|
568 |
|
|
-- call the runtime routine to compute the quotient and remainder
|
569 |
|
|
|
570 |
|
|
else
|
571 |
|
|
Rnd := Boolean_Literals (Rounded_Result_Set (N));
|
572 |
|
|
|
573 |
|
|
Code := New_List (
|
574 |
|
|
Make_Object_Declaration (Loc,
|
575 |
|
|
Defining_Identifier => Qnn,
|
576 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
|
577 |
|
|
|
578 |
|
|
Make_Object_Declaration (Loc,
|
579 |
|
|
Defining_Identifier => Rnn,
|
580 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
|
581 |
|
|
|
582 |
|
|
Make_Procedure_Call_Statement (Loc,
|
583 |
|
|
Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
|
584 |
|
|
Parameter_Associations => New_List (
|
585 |
|
|
Build_Conversion (N, QR_Typ, X),
|
586 |
|
|
Build_Conversion (N, QR_Typ, Y),
|
587 |
|
|
Build_Conversion (N, QR_Typ, Z),
|
588 |
|
|
New_Occurrence_Of (Qnn, Loc),
|
589 |
|
|
New_Occurrence_Of (Rnn, Loc),
|
590 |
|
|
New_Occurrence_Of (Rnd, Loc))));
|
591 |
|
|
end if;
|
592 |
|
|
end Build_Double_Divide_Code;
|
593 |
|
|
|
594 |
|
|
--------------------
|
595 |
|
|
-- Build_Multiply --
|
596 |
|
|
--------------------
|
597 |
|
|
|
598 |
|
|
function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
|
599 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
600 |
|
|
Left_Type : constant Entity_Id := Etype (L);
|
601 |
|
|
Right_Type : constant Entity_Id := Etype (R);
|
602 |
|
|
Left_Size : Int;
|
603 |
|
|
Right_Size : Int;
|
604 |
|
|
Rsize : Int;
|
605 |
|
|
Result_Type : Entity_Id;
|
606 |
|
|
Rnode : Node_Id;
|
607 |
|
|
|
608 |
|
|
begin
|
609 |
|
|
-- Deal with floating-point case first
|
610 |
|
|
|
611 |
|
|
if Is_Floating_Point_Type (Left_Type) then
|
612 |
|
|
pragma Assert (Left_Type = Universal_Real);
|
613 |
|
|
pragma Assert (Right_Type = Universal_Real);
|
614 |
|
|
|
615 |
|
|
Result_Type := Universal_Real;
|
616 |
|
|
Rnode := Make_Op_Multiply (Loc, L, R);
|
617 |
|
|
|
618 |
|
|
-- Integer and fixed-point cases
|
619 |
|
|
|
620 |
|
|
else
|
621 |
|
|
-- An optimization. If the right operand is the literal 1, then we
|
622 |
|
|
-- can just return the left hand operand. Putting the optimization
|
623 |
|
|
-- here allows us to omit the check at the call site. Similarly, if
|
624 |
|
|
-- the left operand is the integer 1 we can return the right operand.
|
625 |
|
|
|
626 |
|
|
if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
|
627 |
|
|
return L;
|
628 |
|
|
elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
|
629 |
|
|
return R;
|
630 |
|
|
end if;
|
631 |
|
|
|
632 |
|
|
-- Otherwise we need to figure out the correct result type size
|
633 |
|
|
-- First figure out the effective sizes of the operands. Normally
|
634 |
|
|
-- the effective size of an operand is the RM_Size of the operand.
|
635 |
|
|
-- But a special case arises with operands whose size is known at
|
636 |
|
|
-- compile time. In this case, we can use the actual value of the
|
637 |
|
|
-- operand to get its size if it would fit signed in 8 or 16 bits.
|
638 |
|
|
|
639 |
|
|
Left_Size := UI_To_Int (RM_Size (Left_Type));
|
640 |
|
|
|
641 |
|
|
if Compile_Time_Known_Value (L) then
|
642 |
|
|
declare
|
643 |
|
|
Val : constant Uint := Expr_Value (L);
|
644 |
|
|
begin
|
645 |
|
|
if Val < Int'(2 ** 7) then
|
646 |
|
|
Left_Size := 8;
|
647 |
|
|
elsif Val < Int'(2 ** 15) then
|
648 |
|
|
Left_Size := 16;
|
649 |
|
|
end if;
|
650 |
|
|
end;
|
651 |
|
|
end if;
|
652 |
|
|
|
653 |
|
|
Right_Size := UI_To_Int (RM_Size (Right_Type));
|
654 |
|
|
|
655 |
|
|
if Compile_Time_Known_Value (R) then
|
656 |
|
|
declare
|
657 |
|
|
Val : constant Uint := Expr_Value (R);
|
658 |
|
|
begin
|
659 |
|
|
if Val <= Int'(2 ** 7) then
|
660 |
|
|
Right_Size := 8;
|
661 |
|
|
elsif Val <= Int'(2 ** 15) then
|
662 |
|
|
Right_Size := 16;
|
663 |
|
|
end if;
|
664 |
|
|
end;
|
665 |
|
|
end if;
|
666 |
|
|
|
667 |
|
|
-- Now the result size must be at least twice the longer of
|
668 |
|
|
-- the two sizes, to accommodate all possible results.
|
669 |
|
|
|
670 |
|
|
Rsize := 2 * Int'Max (Left_Size, Right_Size);
|
671 |
|
|
|
672 |
|
|
if Rsize <= 8 then
|
673 |
|
|
Result_Type := Standard_Integer_8;
|
674 |
|
|
|
675 |
|
|
elsif Rsize <= 16 then
|
676 |
|
|
Result_Type := Standard_Integer_16;
|
677 |
|
|
|
678 |
|
|
elsif Rsize <= 32 then
|
679 |
|
|
Result_Type := Standard_Integer_32;
|
680 |
|
|
|
681 |
|
|
else
|
682 |
|
|
Result_Type := Standard_Integer_64;
|
683 |
|
|
end if;
|
684 |
|
|
|
685 |
|
|
Rnode :=
|
686 |
|
|
Make_Op_Multiply (Loc,
|
687 |
|
|
Left_Opnd => Build_Conversion (N, Result_Type, L),
|
688 |
|
|
Right_Opnd => Build_Conversion (N, Result_Type, R));
|
689 |
|
|
end if;
|
690 |
|
|
|
691 |
|
|
-- We now have a multiply node built with Result_Type set. First
|
692 |
|
|
-- set Etype of result, as required for all Build_xxx routines
|
693 |
|
|
|
694 |
|
|
Set_Etype (Rnode, Base_Type (Result_Type));
|
695 |
|
|
|
696 |
|
|
-- Set Treat_Fixed_As_Integer if operation on fixed-point type
|
697 |
|
|
-- since this is a literal arithmetic operation, to be performed
|
698 |
|
|
-- by Gigi without any consideration of small values.
|
699 |
|
|
|
700 |
|
|
if Is_Fixed_Point_Type (Result_Type) then
|
701 |
|
|
Set_Treat_Fixed_As_Integer (Rnode);
|
702 |
|
|
end if;
|
703 |
|
|
|
704 |
|
|
return Rnode;
|
705 |
|
|
end Build_Multiply;
|
706 |
|
|
|
707 |
|
|
---------------
|
708 |
|
|
-- Build_Rem --
|
709 |
|
|
---------------
|
710 |
|
|
|
711 |
|
|
function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
|
712 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
713 |
|
|
Left_Type : constant Entity_Id := Etype (L);
|
714 |
|
|
Right_Type : constant Entity_Id := Etype (R);
|
715 |
|
|
Result_Type : Entity_Id;
|
716 |
|
|
Rnode : Node_Id;
|
717 |
|
|
|
718 |
|
|
begin
|
719 |
|
|
if Left_Type = Right_Type then
|
720 |
|
|
Result_Type := Left_Type;
|
721 |
|
|
Rnode :=
|
722 |
|
|
Make_Op_Rem (Loc,
|
723 |
|
|
Left_Opnd => L,
|
724 |
|
|
Right_Opnd => R);
|
725 |
|
|
|
726 |
|
|
-- If left size is larger, we do the remainder operation using the
|
727 |
|
|
-- size of the left type (i.e. the larger of the two integer types).
|
728 |
|
|
|
729 |
|
|
elsif Esize (Left_Type) >= Esize (Right_Type) then
|
730 |
|
|
Result_Type := Left_Type;
|
731 |
|
|
Rnode :=
|
732 |
|
|
Make_Op_Rem (Loc,
|
733 |
|
|
Left_Opnd => L,
|
734 |
|
|
Right_Opnd => Build_Conversion (N, Left_Type, R));
|
735 |
|
|
|
736 |
|
|
-- Similarly, if the right size is larger, we do the remainder
|
737 |
|
|
-- operation using the right type.
|
738 |
|
|
|
739 |
|
|
else
|
740 |
|
|
Result_Type := Right_Type;
|
741 |
|
|
Rnode :=
|
742 |
|
|
Make_Op_Rem (Loc,
|
743 |
|
|
Left_Opnd => Build_Conversion (N, Right_Type, L),
|
744 |
|
|
Right_Opnd => R);
|
745 |
|
|
end if;
|
746 |
|
|
|
747 |
|
|
-- We now have an N_Op_Rem node built with Result_Type set. First
|
748 |
|
|
-- set Etype of result, as required for all Build_xxx routines
|
749 |
|
|
|
750 |
|
|
Set_Etype (Rnode, Base_Type (Result_Type));
|
751 |
|
|
|
752 |
|
|
-- Set Treat_Fixed_As_Integer if operation on fixed-point type
|
753 |
|
|
-- since this is a literal arithmetic operation, to be performed
|
754 |
|
|
-- by Gigi without any consideration of small values.
|
755 |
|
|
|
756 |
|
|
if Is_Fixed_Point_Type (Result_Type) then
|
757 |
|
|
Set_Treat_Fixed_As_Integer (Rnode);
|
758 |
|
|
end if;
|
759 |
|
|
|
760 |
|
|
-- One more check. We did the rem operation using the larger of the
|
761 |
|
|
-- two types, which is reasonable. However, in the case where the
|
762 |
|
|
-- two types have unequal sizes, it is impossible for the result of
|
763 |
|
|
-- a remainder operation to be larger than the smaller of the two
|
764 |
|
|
-- types, so we can put a conversion round the result to keep the
|
765 |
|
|
-- evolving operation size as small as possible.
|
766 |
|
|
|
767 |
|
|
if Esize (Left_Type) >= Esize (Right_Type) then
|
768 |
|
|
Rnode := Build_Conversion (N, Right_Type, Rnode);
|
769 |
|
|
elsif Esize (Right_Type) >= Esize (Left_Type) then
|
770 |
|
|
Rnode := Build_Conversion (N, Left_Type, Rnode);
|
771 |
|
|
end if;
|
772 |
|
|
|
773 |
|
|
return Rnode;
|
774 |
|
|
end Build_Rem;
|
775 |
|
|
|
776 |
|
|
-------------------------
|
777 |
|
|
-- Build_Scaled_Divide --
|
778 |
|
|
-------------------------
|
779 |
|
|
|
780 |
|
|
function Build_Scaled_Divide
|
781 |
|
|
(N : Node_Id;
|
782 |
|
|
X, Y, Z : Node_Id) return Node_Id
|
783 |
|
|
is
|
784 |
|
|
X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
|
785 |
|
|
Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
|
786 |
|
|
Expr : Node_Id;
|
787 |
|
|
|
788 |
|
|
begin
|
789 |
|
|
-- If numerator fits in 64 bits, we can build the operations directly
|
790 |
|
|
-- without causing any intermediate overflow, so that's what we do!
|
791 |
|
|
|
792 |
|
|
if Int'Max (X_Size, Y_Size) <= 32 then
|
793 |
|
|
return
|
794 |
|
|
Build_Divide (N, Build_Multiply (N, X, Y), Z);
|
795 |
|
|
|
796 |
|
|
-- Otherwise we use the runtime routine
|
797 |
|
|
|
798 |
|
|
-- [Qnn : Integer_64,
|
799 |
|
|
-- Rnn : Integer_64;
|
800 |
|
|
-- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
|
801 |
|
|
-- Qnn]
|
802 |
|
|
|
803 |
|
|
else
|
804 |
|
|
declare
|
805 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
806 |
|
|
Qnn : Entity_Id;
|
807 |
|
|
Rnn : Entity_Id;
|
808 |
|
|
Code : List_Id;
|
809 |
|
|
|
810 |
|
|
pragma Warnings (Off, Rnn);
|
811 |
|
|
|
812 |
|
|
begin
|
813 |
|
|
Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
|
814 |
|
|
Insert_Actions (N, Code);
|
815 |
|
|
Expr := New_Occurrence_Of (Qnn, Loc);
|
816 |
|
|
|
817 |
|
|
-- Set type of result in case used elsewhere (see note at start)
|
818 |
|
|
|
819 |
|
|
Set_Etype (Expr, Etype (Qnn));
|
820 |
|
|
return Expr;
|
821 |
|
|
end;
|
822 |
|
|
end if;
|
823 |
|
|
end Build_Scaled_Divide;
|
824 |
|
|
|
825 |
|
|
------------------------------
|
826 |
|
|
-- Build_Scaled_Divide_Code --
|
827 |
|
|
------------------------------
|
828 |
|
|
|
829 |
|
|
-- If the numerator can be computed in 64-bits, we build
|
830 |
|
|
|
831 |
|
|
-- [Nnn : constant typ := typ (X) * typ (Y);
|
832 |
|
|
-- Dnn : constant typ := typ (Z)
|
833 |
|
|
-- Qnn : constant typ := Nnn / Dnn;
|
834 |
|
|
-- Rnn : constant typ := Nnn / Dnn;
|
835 |
|
|
|
836 |
|
|
-- If the numerator cannot be computed in 64 bits, we build
|
837 |
|
|
|
838 |
|
|
-- [Qnn : Interfaces.Integer_64;
|
839 |
|
|
-- Rnn : Interfaces.Integer_64;
|
840 |
|
|
-- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
|
841 |
|
|
|
842 |
|
|
procedure Build_Scaled_Divide_Code
|
843 |
|
|
(N : Node_Id;
|
844 |
|
|
X, Y, Z : Node_Id;
|
845 |
|
|
Qnn, Rnn : out Entity_Id;
|
846 |
|
|
Code : out List_Id)
|
847 |
|
|
is
|
848 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
849 |
|
|
|
850 |
|
|
X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
|
851 |
|
|
Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
|
852 |
|
|
Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
|
853 |
|
|
|
854 |
|
|
QR_Siz : Int;
|
855 |
|
|
QR_Typ : Entity_Id;
|
856 |
|
|
|
857 |
|
|
Nnn : Entity_Id;
|
858 |
|
|
Dnn : Entity_Id;
|
859 |
|
|
|
860 |
|
|
Quo : Node_Id;
|
861 |
|
|
Rnd : Entity_Id;
|
862 |
|
|
|
863 |
|
|
begin
|
864 |
|
|
-- Find type that will allow computation of numerator
|
865 |
|
|
|
866 |
|
|
QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
|
867 |
|
|
|
868 |
|
|
if QR_Siz <= 16 then
|
869 |
|
|
QR_Typ := Standard_Integer_16;
|
870 |
|
|
elsif QR_Siz <= 32 then
|
871 |
|
|
QR_Typ := Standard_Integer_32;
|
872 |
|
|
elsif QR_Siz <= 64 then
|
873 |
|
|
QR_Typ := Standard_Integer_64;
|
874 |
|
|
|
875 |
|
|
-- For more than 64, bits, we use the 64-bit integer defined in
|
876 |
|
|
-- Interfaces, so that it can be handled by the runtime routine
|
877 |
|
|
|
878 |
|
|
else
|
879 |
|
|
QR_Typ := RTE (RE_Integer_64);
|
880 |
|
|
end if;
|
881 |
|
|
|
882 |
|
|
-- Define quotient and remainder, and set their Etypes, so
|
883 |
|
|
-- that they can be picked up by Build_xxx routines.
|
884 |
|
|
|
885 |
|
|
Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
|
886 |
|
|
Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
|
887 |
|
|
|
888 |
|
|
Set_Etype (Qnn, QR_Typ);
|
889 |
|
|
Set_Etype (Rnn, QR_Typ);
|
890 |
|
|
|
891 |
|
|
-- Case that we can compute the numerator in 64 bits
|
892 |
|
|
|
893 |
|
|
if QR_Siz <= 64 then
|
894 |
|
|
Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
|
895 |
|
|
Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
|
896 |
|
|
|
897 |
|
|
-- Set Etypes, so that they can be picked up by New_Occurrence_Of
|
898 |
|
|
|
899 |
|
|
Set_Etype (Nnn, QR_Typ);
|
900 |
|
|
Set_Etype (Dnn, QR_Typ);
|
901 |
|
|
|
902 |
|
|
Code := New_List (
|
903 |
|
|
Make_Object_Declaration (Loc,
|
904 |
|
|
Defining_Identifier => Nnn,
|
905 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
906 |
|
|
Constant_Present => True,
|
907 |
|
|
Expression =>
|
908 |
|
|
Build_Multiply (N,
|
909 |
|
|
Build_Conversion (N, QR_Typ, X),
|
910 |
|
|
Build_Conversion (N, QR_Typ, Y))),
|
911 |
|
|
|
912 |
|
|
Make_Object_Declaration (Loc,
|
913 |
|
|
Defining_Identifier => Dnn,
|
914 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
915 |
|
|
Constant_Present => True,
|
916 |
|
|
Expression => Build_Conversion (N, QR_Typ, Z)));
|
917 |
|
|
|
918 |
|
|
Quo :=
|
919 |
|
|
Build_Divide (N,
|
920 |
|
|
New_Occurrence_Of (Nnn, Loc),
|
921 |
|
|
New_Occurrence_Of (Dnn, Loc));
|
922 |
|
|
|
923 |
|
|
Append_To (Code,
|
924 |
|
|
Make_Object_Declaration (Loc,
|
925 |
|
|
Defining_Identifier => Qnn,
|
926 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
927 |
|
|
Constant_Present => True,
|
928 |
|
|
Expression => Quo));
|
929 |
|
|
|
930 |
|
|
Append_To (Code,
|
931 |
|
|
Make_Object_Declaration (Loc,
|
932 |
|
|
Defining_Identifier => Rnn,
|
933 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
|
934 |
|
|
Constant_Present => True,
|
935 |
|
|
Expression =>
|
936 |
|
|
Build_Rem (N,
|
937 |
|
|
New_Occurrence_Of (Nnn, Loc),
|
938 |
|
|
New_Occurrence_Of (Dnn, Loc))));
|
939 |
|
|
|
940 |
|
|
-- Case where numerator does not fit in 64 bits, so we have to
|
941 |
|
|
-- call the runtime routine to compute the quotient and remainder
|
942 |
|
|
|
943 |
|
|
else
|
944 |
|
|
Rnd := Boolean_Literals (Rounded_Result_Set (N));
|
945 |
|
|
|
946 |
|
|
Code := New_List (
|
947 |
|
|
Make_Object_Declaration (Loc,
|
948 |
|
|
Defining_Identifier => Qnn,
|
949 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
|
950 |
|
|
|
951 |
|
|
Make_Object_Declaration (Loc,
|
952 |
|
|
Defining_Identifier => Rnn,
|
953 |
|
|
Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
|
954 |
|
|
|
955 |
|
|
Make_Procedure_Call_Statement (Loc,
|
956 |
|
|
Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
|
957 |
|
|
Parameter_Associations => New_List (
|
958 |
|
|
Build_Conversion (N, QR_Typ, X),
|
959 |
|
|
Build_Conversion (N, QR_Typ, Y),
|
960 |
|
|
Build_Conversion (N, QR_Typ, Z),
|
961 |
|
|
New_Occurrence_Of (Qnn, Loc),
|
962 |
|
|
New_Occurrence_Of (Rnn, Loc),
|
963 |
|
|
New_Occurrence_Of (Rnd, Loc))));
|
964 |
|
|
end if;
|
965 |
|
|
|
966 |
|
|
-- Set type of result, for use in caller
|
967 |
|
|
|
968 |
|
|
Set_Etype (Qnn, QR_Typ);
|
969 |
|
|
end Build_Scaled_Divide_Code;
|
970 |
|
|
|
971 |
|
|
---------------------------
|
972 |
|
|
-- Do_Divide_Fixed_Fixed --
|
973 |
|
|
---------------------------
|
974 |
|
|
|
975 |
|
|
-- We have:
|
976 |
|
|
|
977 |
|
|
-- (Result_Value * Result_Small) =
|
978 |
|
|
-- (Left_Value * Left_Small) / (Right_Value * Right_Small)
|
979 |
|
|
|
980 |
|
|
-- Result_Value = (Left_Value / Right_Value) *
|
981 |
|
|
-- (Left_Small / (Right_Small * Result_Small));
|
982 |
|
|
|
983 |
|
|
-- we can do the operation in integer arithmetic if this fraction is an
|
984 |
|
|
-- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
|
985 |
|
|
-- Otherwise the result is in the close result set and our approach is to
|
986 |
|
|
-- use floating-point to compute this close result.
|
987 |
|
|
|
988 |
|
|
procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
|
989 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
990 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
991 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
992 |
|
|
Right_Type : constant Entity_Id := Etype (Right);
|
993 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
994 |
|
|
Right_Small : constant Ureal := Small_Value (Right_Type);
|
995 |
|
|
Left_Small : constant Ureal := Small_Value (Left_Type);
|
996 |
|
|
|
997 |
|
|
Result_Small : Ureal;
|
998 |
|
|
Frac : Ureal;
|
999 |
|
|
Frac_Num : Uint;
|
1000 |
|
|
Frac_Den : Uint;
|
1001 |
|
|
Lit_Int : Node_Id;
|
1002 |
|
|
|
1003 |
|
|
begin
|
1004 |
|
|
-- Rounding is required if the result is integral
|
1005 |
|
|
|
1006 |
|
|
if Is_Integer_Type (Result_Type) then
|
1007 |
|
|
Set_Rounded_Result (N);
|
1008 |
|
|
end if;
|
1009 |
|
|
|
1010 |
|
|
-- Get result small. If the result is an integer, treat it as though
|
1011 |
|
|
-- it had a small of 1.0, all other processing is identical.
|
1012 |
|
|
|
1013 |
|
|
if Is_Integer_Type (Result_Type) then
|
1014 |
|
|
Result_Small := Ureal_1;
|
1015 |
|
|
else
|
1016 |
|
|
Result_Small := Small_Value (Result_Type);
|
1017 |
|
|
end if;
|
1018 |
|
|
|
1019 |
|
|
-- Get small ratio
|
1020 |
|
|
|
1021 |
|
|
Frac := Left_Small / (Right_Small * Result_Small);
|
1022 |
|
|
Frac_Num := Norm_Num (Frac);
|
1023 |
|
|
Frac_Den := Norm_Den (Frac);
|
1024 |
|
|
|
1025 |
|
|
-- If the fraction is an integer, then we get the result by multiplying
|
1026 |
|
|
-- the left operand by the integer, and then dividing by the right
|
1027 |
|
|
-- operand (the order is important, if we did the divide first, we
|
1028 |
|
|
-- would lose precision).
|
1029 |
|
|
|
1030 |
|
|
if Frac_Den = 1 then
|
1031 |
|
|
Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
|
1032 |
|
|
|
1033 |
|
|
if Present (Lit_Int) then
|
1034 |
|
|
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
|
1035 |
|
|
return;
|
1036 |
|
|
end if;
|
1037 |
|
|
|
1038 |
|
|
-- If the fraction is the reciprocal of an integer, then we get the
|
1039 |
|
|
-- result by first multiplying the divisor by the integer, and then
|
1040 |
|
|
-- doing the division with the adjusted divisor.
|
1041 |
|
|
|
1042 |
|
|
-- Note: this is much better than doing two divisions: multiplications
|
1043 |
|
|
-- are much faster than divisions (and certainly faster than rounded
|
1044 |
|
|
-- divisions), and we don't get inaccuracies from double rounding.
|
1045 |
|
|
|
1046 |
|
|
elsif Frac_Num = 1 then
|
1047 |
|
|
Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
|
1048 |
|
|
|
1049 |
|
|
if Present (Lit_Int) then
|
1050 |
|
|
Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
|
1051 |
|
|
return;
|
1052 |
|
|
end if;
|
1053 |
|
|
end if;
|
1054 |
|
|
|
1055 |
|
|
-- If we fall through, we use floating-point to compute the result
|
1056 |
|
|
|
1057 |
|
|
Set_Result (N,
|
1058 |
|
|
Build_Multiply (N,
|
1059 |
|
|
Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
|
1060 |
|
|
Real_Literal (N, Frac)));
|
1061 |
|
|
end Do_Divide_Fixed_Fixed;
|
1062 |
|
|
|
1063 |
|
|
-------------------------------
|
1064 |
|
|
-- Do_Divide_Fixed_Universal --
|
1065 |
|
|
-------------------------------
|
1066 |
|
|
|
1067 |
|
|
-- We have:
|
1068 |
|
|
|
1069 |
|
|
-- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
|
1070 |
|
|
-- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
|
1071 |
|
|
|
1072 |
|
|
-- The result is required to be in the perfect result set if the literal
|
1073 |
|
|
-- can be factored so that the resulting small ratio is an integer or the
|
1074 |
|
|
-- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
|
1075 |
|
|
-- analysis of these RM requirements:
|
1076 |
|
|
|
1077 |
|
|
-- We must factor the literal, finding an integer K:
|
1078 |
|
|
|
1079 |
|
|
-- Lit_Value = K * Right_Small
|
1080 |
|
|
-- Right_Small = Lit_Value / K
|
1081 |
|
|
|
1082 |
|
|
-- such that the small ratio:
|
1083 |
|
|
|
1084 |
|
|
-- Left_Small
|
1085 |
|
|
-- ------------------------------
|
1086 |
|
|
-- (Lit_Value / K) * Result_Small
|
1087 |
|
|
|
1088 |
|
|
-- Left_Small
|
1089 |
|
|
-- = ------------------------ * K
|
1090 |
|
|
-- Lit_Value * Result_Small
|
1091 |
|
|
|
1092 |
|
|
-- is an integer or the reciprocal of an integer, and for
|
1093 |
|
|
-- implementation efficiency we need the smallest such K.
|
1094 |
|
|
|
1095 |
|
|
-- First we reduce the left fraction to lowest terms
|
1096 |
|
|
|
1097 |
|
|
-- If numerator = 1, then for K = 1, the small ratio is the reciprocal
|
1098 |
|
|
-- of an integer, and this is clearly the minimum K case, so set K = 1,
|
1099 |
|
|
-- Right_Small = Lit_Value.
|
1100 |
|
|
|
1101 |
|
|
-- If numerator > 1, then set K to the denominator of the fraction so
|
1102 |
|
|
-- that the resulting small ratio is an integer (the numerator value).
|
1103 |
|
|
|
1104 |
|
|
procedure Do_Divide_Fixed_Universal (N : Node_Id) is
|
1105 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
1106 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
1107 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
1108 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1109 |
|
|
Left_Small : constant Ureal := Small_Value (Left_Type);
|
1110 |
|
|
Lit_Value : constant Ureal := Realval (Right);
|
1111 |
|
|
|
1112 |
|
|
Result_Small : Ureal;
|
1113 |
|
|
Frac : Ureal;
|
1114 |
|
|
Frac_Num : Uint;
|
1115 |
|
|
Frac_Den : Uint;
|
1116 |
|
|
Lit_K : Node_Id;
|
1117 |
|
|
Lit_Int : Node_Id;
|
1118 |
|
|
|
1119 |
|
|
begin
|
1120 |
|
|
-- Get result small. If the result is an integer, treat it as though
|
1121 |
|
|
-- it had a small of 1.0, all other processing is identical.
|
1122 |
|
|
|
1123 |
|
|
if Is_Integer_Type (Result_Type) then
|
1124 |
|
|
Result_Small := Ureal_1;
|
1125 |
|
|
else
|
1126 |
|
|
Result_Small := Small_Value (Result_Type);
|
1127 |
|
|
end if;
|
1128 |
|
|
|
1129 |
|
|
-- Determine if literal can be rewritten successfully
|
1130 |
|
|
|
1131 |
|
|
Frac := Left_Small / (Lit_Value * Result_Small);
|
1132 |
|
|
Frac_Num := Norm_Num (Frac);
|
1133 |
|
|
Frac_Den := Norm_Den (Frac);
|
1134 |
|
|
|
1135 |
|
|
-- Case where fraction is the reciprocal of an integer (K = 1, integer
|
1136 |
|
|
-- = denominator). If this integer is not too large, this is the case
|
1137 |
|
|
-- where the result can be obtained by dividing by this integer value.
|
1138 |
|
|
|
1139 |
|
|
if Frac_Num = 1 then
|
1140 |
|
|
Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
|
1141 |
|
|
|
1142 |
|
|
if Present (Lit_Int) then
|
1143 |
|
|
Set_Result (N, Build_Divide (N, Left, Lit_Int));
|
1144 |
|
|
return;
|
1145 |
|
|
end if;
|
1146 |
|
|
|
1147 |
|
|
-- Case where we choose K to make fraction an integer (K = denominator
|
1148 |
|
|
-- of fraction, integer = numerator of fraction). If both K and the
|
1149 |
|
|
-- numerator are small enough, this is the case where the result can
|
1150 |
|
|
-- be obtained by first multiplying by the integer value and then
|
1151 |
|
|
-- dividing by K (the order is important, if we divided first, we
|
1152 |
|
|
-- would lose precision).
|
1153 |
|
|
|
1154 |
|
|
else
|
1155 |
|
|
Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
|
1156 |
|
|
Lit_K := Integer_Literal (N, Frac_Den, False);
|
1157 |
|
|
|
1158 |
|
|
if Present (Lit_Int) and then Present (Lit_K) then
|
1159 |
|
|
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
|
1160 |
|
|
return;
|
1161 |
|
|
end if;
|
1162 |
|
|
end if;
|
1163 |
|
|
|
1164 |
|
|
-- Fall through if the literal cannot be successfully rewritten, or if
|
1165 |
|
|
-- the small ratio is out of range of integer arithmetic. In the former
|
1166 |
|
|
-- case it is fine to use floating-point to get the close result set,
|
1167 |
|
|
-- and in the latter case, it means that the result is zero or raises
|
1168 |
|
|
-- constraint error, and we can do that accurately in floating-point.
|
1169 |
|
|
|
1170 |
|
|
-- If we end up using floating-point, then we take the right integer
|
1171 |
|
|
-- to be one, and its small to be the value of the original right real
|
1172 |
|
|
-- literal. That way, we need only one floating-point multiplication.
|
1173 |
|
|
|
1174 |
|
|
Set_Result (N,
|
1175 |
|
|
Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
|
1176 |
|
|
end Do_Divide_Fixed_Universal;
|
1177 |
|
|
|
1178 |
|
|
-------------------------------
|
1179 |
|
|
-- Do_Divide_Universal_Fixed --
|
1180 |
|
|
-------------------------------
|
1181 |
|
|
|
1182 |
|
|
-- We have:
|
1183 |
|
|
|
1184 |
|
|
-- (Result_Value * Result_Small) =
|
1185 |
|
|
-- Lit_Value / (Right_Value * Right_Small)
|
1186 |
|
|
-- Result_Value =
|
1187 |
|
|
-- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
|
1188 |
|
|
|
1189 |
|
|
-- The result is required to be in the perfect result set if the literal
|
1190 |
|
|
-- can be factored so that the resulting small ratio is an integer or the
|
1191 |
|
|
-- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
|
1192 |
|
|
-- analysis of these RM requirements:
|
1193 |
|
|
|
1194 |
|
|
-- We must factor the literal, finding an integer K:
|
1195 |
|
|
|
1196 |
|
|
-- Lit_Value = K * Left_Small
|
1197 |
|
|
-- Left_Small = Lit_Value / K
|
1198 |
|
|
|
1199 |
|
|
-- such that the small ratio:
|
1200 |
|
|
|
1201 |
|
|
-- (Lit_Value / K)
|
1202 |
|
|
-- --------------------------
|
1203 |
|
|
-- Right_Small * Result_Small
|
1204 |
|
|
|
1205 |
|
|
-- Lit_Value 1
|
1206 |
|
|
-- = -------------------------- * -
|
1207 |
|
|
-- Right_Small * Result_Small K
|
1208 |
|
|
|
1209 |
|
|
-- is an integer or the reciprocal of an integer, and for
|
1210 |
|
|
-- implementation efficiency we need the smallest such K.
|
1211 |
|
|
|
1212 |
|
|
-- First we reduce the left fraction to lowest terms
|
1213 |
|
|
|
1214 |
|
|
-- If denominator = 1, then for K = 1, the small ratio is an integer
|
1215 |
|
|
-- (the numerator) and this is clearly the minimum K case, so set K = 1,
|
1216 |
|
|
-- and Left_Small = Lit_Value.
|
1217 |
|
|
|
1218 |
|
|
-- If denominator > 1, then set K to the numerator of the fraction so
|
1219 |
|
|
-- that the resulting small ratio is the reciprocal of an integer (the
|
1220 |
|
|
-- numerator value).
|
1221 |
|
|
|
1222 |
|
|
procedure Do_Divide_Universal_Fixed (N : Node_Id) is
|
1223 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
1224 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
1225 |
|
|
Right_Type : constant Entity_Id := Etype (Right);
|
1226 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1227 |
|
|
Right_Small : constant Ureal := Small_Value (Right_Type);
|
1228 |
|
|
Lit_Value : constant Ureal := Realval (Left);
|
1229 |
|
|
|
1230 |
|
|
Result_Small : Ureal;
|
1231 |
|
|
Frac : Ureal;
|
1232 |
|
|
Frac_Num : Uint;
|
1233 |
|
|
Frac_Den : Uint;
|
1234 |
|
|
Lit_K : Node_Id;
|
1235 |
|
|
Lit_Int : Node_Id;
|
1236 |
|
|
|
1237 |
|
|
begin
|
1238 |
|
|
-- Get result small. If the result is an integer, treat it as though
|
1239 |
|
|
-- it had a small of 1.0, all other processing is identical.
|
1240 |
|
|
|
1241 |
|
|
if Is_Integer_Type (Result_Type) then
|
1242 |
|
|
Result_Small := Ureal_1;
|
1243 |
|
|
else
|
1244 |
|
|
Result_Small := Small_Value (Result_Type);
|
1245 |
|
|
end if;
|
1246 |
|
|
|
1247 |
|
|
-- Determine if literal can be rewritten successfully
|
1248 |
|
|
|
1249 |
|
|
Frac := Lit_Value / (Right_Small * Result_Small);
|
1250 |
|
|
Frac_Num := Norm_Num (Frac);
|
1251 |
|
|
Frac_Den := Norm_Den (Frac);
|
1252 |
|
|
|
1253 |
|
|
-- Case where fraction is an integer (K = 1, integer = numerator). If
|
1254 |
|
|
-- this integer is not too large, this is the case where the result
|
1255 |
|
|
-- can be obtained by dividing this integer by the right operand.
|
1256 |
|
|
|
1257 |
|
|
if Frac_Den = 1 then
|
1258 |
|
|
Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
|
1259 |
|
|
|
1260 |
|
|
if Present (Lit_Int) then
|
1261 |
|
|
Set_Result (N, Build_Divide (N, Lit_Int, Right));
|
1262 |
|
|
return;
|
1263 |
|
|
end if;
|
1264 |
|
|
|
1265 |
|
|
-- Case where we choose K to make the fraction the reciprocal of an
|
1266 |
|
|
-- integer (K = numerator of fraction, integer = numerator of fraction).
|
1267 |
|
|
-- If both K and the integer are small enough, this is the case where
|
1268 |
|
|
-- the result can be obtained by multiplying the right operand by K
|
1269 |
|
|
-- and then dividing by the integer value. The order of the operations
|
1270 |
|
|
-- is important (if we divided first, we would lose precision).
|
1271 |
|
|
|
1272 |
|
|
else
|
1273 |
|
|
Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
|
1274 |
|
|
Lit_K := Integer_Literal (N, Frac_Num, False);
|
1275 |
|
|
|
1276 |
|
|
if Present (Lit_Int) and then Present (Lit_K) then
|
1277 |
|
|
Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
|
1278 |
|
|
return;
|
1279 |
|
|
end if;
|
1280 |
|
|
end if;
|
1281 |
|
|
|
1282 |
|
|
-- Fall through if the literal cannot be successfully rewritten, or if
|
1283 |
|
|
-- the small ratio is out of range of integer arithmetic. In the former
|
1284 |
|
|
-- case it is fine to use floating-point to get the close result set,
|
1285 |
|
|
-- and in the latter case, it means that the result is zero or raises
|
1286 |
|
|
-- constraint error, and we can do that accurately in floating-point.
|
1287 |
|
|
|
1288 |
|
|
-- If we end up using floating-point, then we take the right integer
|
1289 |
|
|
-- to be one, and its small to be the value of the original right real
|
1290 |
|
|
-- literal. That way, we need only one floating-point division.
|
1291 |
|
|
|
1292 |
|
|
Set_Result (N,
|
1293 |
|
|
Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
|
1294 |
|
|
end Do_Divide_Universal_Fixed;
|
1295 |
|
|
|
1296 |
|
|
-----------------------------
|
1297 |
|
|
-- Do_Multiply_Fixed_Fixed --
|
1298 |
|
|
-----------------------------
|
1299 |
|
|
|
1300 |
|
|
-- We have:
|
1301 |
|
|
|
1302 |
|
|
-- (Result_Value * Result_Small) =
|
1303 |
|
|
-- (Left_Value * Left_Small) * (Right_Value * Right_Small)
|
1304 |
|
|
|
1305 |
|
|
-- Result_Value = (Left_Value * Right_Value) *
|
1306 |
|
|
-- (Left_Small * Right_Small) / Result_Small;
|
1307 |
|
|
|
1308 |
|
|
-- we can do the operation in integer arithmetic if this fraction is an
|
1309 |
|
|
-- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
|
1310 |
|
|
-- Otherwise the result is in the close result set and our approach is to
|
1311 |
|
|
-- use floating-point to compute this close result.
|
1312 |
|
|
|
1313 |
|
|
procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
|
1314 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
1315 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
1316 |
|
|
|
1317 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
1318 |
|
|
Right_Type : constant Entity_Id := Etype (Right);
|
1319 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1320 |
|
|
Right_Small : constant Ureal := Small_Value (Right_Type);
|
1321 |
|
|
Left_Small : constant Ureal := Small_Value (Left_Type);
|
1322 |
|
|
|
1323 |
|
|
Result_Small : Ureal;
|
1324 |
|
|
Frac : Ureal;
|
1325 |
|
|
Frac_Num : Uint;
|
1326 |
|
|
Frac_Den : Uint;
|
1327 |
|
|
Lit_Int : Node_Id;
|
1328 |
|
|
|
1329 |
|
|
begin
|
1330 |
|
|
-- Get result small. If the result is an integer, treat it as though
|
1331 |
|
|
-- it had a small of 1.0, all other processing is identical.
|
1332 |
|
|
|
1333 |
|
|
if Is_Integer_Type (Result_Type) then
|
1334 |
|
|
Result_Small := Ureal_1;
|
1335 |
|
|
else
|
1336 |
|
|
Result_Small := Small_Value (Result_Type);
|
1337 |
|
|
end if;
|
1338 |
|
|
|
1339 |
|
|
-- Get small ratio
|
1340 |
|
|
|
1341 |
|
|
Frac := (Left_Small * Right_Small) / Result_Small;
|
1342 |
|
|
Frac_Num := Norm_Num (Frac);
|
1343 |
|
|
Frac_Den := Norm_Den (Frac);
|
1344 |
|
|
|
1345 |
|
|
-- If the fraction is an integer, then we get the result by multiplying
|
1346 |
|
|
-- the operands, and then multiplying the result by the integer value.
|
1347 |
|
|
|
1348 |
|
|
if Frac_Den = 1 then
|
1349 |
|
|
Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
|
1350 |
|
|
|
1351 |
|
|
if Present (Lit_Int) then
|
1352 |
|
|
Set_Result (N,
|
1353 |
|
|
Build_Multiply (N, Build_Multiply (N, Left, Right),
|
1354 |
|
|
Lit_Int));
|
1355 |
|
|
return;
|
1356 |
|
|
end if;
|
1357 |
|
|
|
1358 |
|
|
-- If the fraction is the reciprocal of an integer, then we get the
|
1359 |
|
|
-- result by multiplying the operands, and then dividing the result by
|
1360 |
|
|
-- the integer value. The order of the operations is important, if we
|
1361 |
|
|
-- divided first, we would lose precision.
|
1362 |
|
|
|
1363 |
|
|
elsif Frac_Num = 1 then
|
1364 |
|
|
Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
|
1365 |
|
|
|
1366 |
|
|
if Present (Lit_Int) then
|
1367 |
|
|
Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
|
1368 |
|
|
return;
|
1369 |
|
|
end if;
|
1370 |
|
|
end if;
|
1371 |
|
|
|
1372 |
|
|
-- If we fall through, we use floating-point to compute the result
|
1373 |
|
|
|
1374 |
|
|
Set_Result (N,
|
1375 |
|
|
Build_Multiply (N,
|
1376 |
|
|
Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
|
1377 |
|
|
Real_Literal (N, Frac)));
|
1378 |
|
|
end Do_Multiply_Fixed_Fixed;
|
1379 |
|
|
|
1380 |
|
|
---------------------------------
|
1381 |
|
|
-- Do_Multiply_Fixed_Universal --
|
1382 |
|
|
---------------------------------
|
1383 |
|
|
|
1384 |
|
|
-- We have:
|
1385 |
|
|
|
1386 |
|
|
-- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
|
1387 |
|
|
-- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
|
1388 |
|
|
|
1389 |
|
|
-- The result is required to be in the perfect result set if the literal
|
1390 |
|
|
-- can be factored so that the resulting small ratio is an integer or the
|
1391 |
|
|
-- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
|
1392 |
|
|
-- analysis of these RM requirements:
|
1393 |
|
|
|
1394 |
|
|
-- We must factor the literal, finding an integer K:
|
1395 |
|
|
|
1396 |
|
|
-- Lit_Value = K * Right_Small
|
1397 |
|
|
-- Right_Small = Lit_Value / K
|
1398 |
|
|
|
1399 |
|
|
-- such that the small ratio:
|
1400 |
|
|
|
1401 |
|
|
-- Left_Small * (Lit_Value / K)
|
1402 |
|
|
-- ----------------------------
|
1403 |
|
|
-- Result_Small
|
1404 |
|
|
|
1405 |
|
|
-- Left_Small * Lit_Value 1
|
1406 |
|
|
-- = ---------------------- * -
|
1407 |
|
|
-- Result_Small K
|
1408 |
|
|
|
1409 |
|
|
-- is an integer or the reciprocal of an integer, and for
|
1410 |
|
|
-- implementation efficiency we need the smallest such K.
|
1411 |
|
|
|
1412 |
|
|
-- First we reduce the left fraction to lowest terms
|
1413 |
|
|
|
1414 |
|
|
-- If denominator = 1, then for K = 1, the small ratio is an integer, and
|
1415 |
|
|
-- this is clearly the minimum K case, so set
|
1416 |
|
|
|
1417 |
|
|
-- K = 1, Right_Small = Lit_Value
|
1418 |
|
|
|
1419 |
|
|
-- If denominator > 1, then set K to the numerator of the fraction, so
|
1420 |
|
|
-- that the resulting small ratio is the reciprocal of the integer (the
|
1421 |
|
|
-- denominator value).
|
1422 |
|
|
|
1423 |
|
|
procedure Do_Multiply_Fixed_Universal
|
1424 |
|
|
(N : Node_Id;
|
1425 |
|
|
Left, Right : Node_Id)
|
1426 |
|
|
is
|
1427 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
1428 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1429 |
|
|
Left_Small : constant Ureal := Small_Value (Left_Type);
|
1430 |
|
|
Lit_Value : constant Ureal := Realval (Right);
|
1431 |
|
|
|
1432 |
|
|
Result_Small : Ureal;
|
1433 |
|
|
Frac : Ureal;
|
1434 |
|
|
Frac_Num : Uint;
|
1435 |
|
|
Frac_Den : Uint;
|
1436 |
|
|
Lit_K : Node_Id;
|
1437 |
|
|
Lit_Int : Node_Id;
|
1438 |
|
|
|
1439 |
|
|
begin
|
1440 |
|
|
-- Get result small. If the result is an integer, treat it as though
|
1441 |
|
|
-- it had a small of 1.0, all other processing is identical.
|
1442 |
|
|
|
1443 |
|
|
if Is_Integer_Type (Result_Type) then
|
1444 |
|
|
Result_Small := Ureal_1;
|
1445 |
|
|
else
|
1446 |
|
|
Result_Small := Small_Value (Result_Type);
|
1447 |
|
|
end if;
|
1448 |
|
|
|
1449 |
|
|
-- Determine if literal can be rewritten successfully
|
1450 |
|
|
|
1451 |
|
|
Frac := (Left_Small * Lit_Value) / Result_Small;
|
1452 |
|
|
Frac_Num := Norm_Num (Frac);
|
1453 |
|
|
Frac_Den := Norm_Den (Frac);
|
1454 |
|
|
|
1455 |
|
|
-- Case where fraction is an integer (K = 1, integer = numerator). If
|
1456 |
|
|
-- this integer is not too large, this is the case where the result can
|
1457 |
|
|
-- be obtained by multiplying by this integer value.
|
1458 |
|
|
|
1459 |
|
|
if Frac_Den = 1 then
|
1460 |
|
|
Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
|
1461 |
|
|
|
1462 |
|
|
if Present (Lit_Int) then
|
1463 |
|
|
Set_Result (N, Build_Multiply (N, Left, Lit_Int));
|
1464 |
|
|
return;
|
1465 |
|
|
end if;
|
1466 |
|
|
|
1467 |
|
|
-- Case where we choose K to make fraction the reciprocal of an integer
|
1468 |
|
|
-- (K = numerator of fraction, integer = denominator of fraction). If
|
1469 |
|
|
-- both K and the denominator are small enough, this is the case where
|
1470 |
|
|
-- the result can be obtained by first multiplying by K, and then
|
1471 |
|
|
-- dividing by the integer value.
|
1472 |
|
|
|
1473 |
|
|
else
|
1474 |
|
|
Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
|
1475 |
|
|
Lit_K := Integer_Literal (N, Frac_Num);
|
1476 |
|
|
|
1477 |
|
|
if Present (Lit_Int) and then Present (Lit_K) then
|
1478 |
|
|
Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
|
1479 |
|
|
return;
|
1480 |
|
|
end if;
|
1481 |
|
|
end if;
|
1482 |
|
|
|
1483 |
|
|
-- Fall through if the literal cannot be successfully rewritten, or if
|
1484 |
|
|
-- the small ratio is out of range of integer arithmetic. In the former
|
1485 |
|
|
-- case it is fine to use floating-point to get the close result set,
|
1486 |
|
|
-- and in the latter case, it means that the result is zero or raises
|
1487 |
|
|
-- constraint error, and we can do that accurately in floating-point.
|
1488 |
|
|
|
1489 |
|
|
-- If we end up using floating-point, then we take the right integer
|
1490 |
|
|
-- to be one, and its small to be the value of the original right real
|
1491 |
|
|
-- literal. That way, we need only one floating-point multiplication.
|
1492 |
|
|
|
1493 |
|
|
Set_Result (N,
|
1494 |
|
|
Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
|
1495 |
|
|
end Do_Multiply_Fixed_Universal;
|
1496 |
|
|
|
1497 |
|
|
---------------------------------
|
1498 |
|
|
-- Expand_Convert_Fixed_Static --
|
1499 |
|
|
---------------------------------
|
1500 |
|
|
|
1501 |
|
|
procedure Expand_Convert_Fixed_Static (N : Node_Id) is
|
1502 |
|
|
begin
|
1503 |
|
|
Rewrite (N,
|
1504 |
|
|
Convert_To (Etype (N),
|
1505 |
|
|
Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
|
1506 |
|
|
Analyze_And_Resolve (N);
|
1507 |
|
|
end Expand_Convert_Fixed_Static;
|
1508 |
|
|
|
1509 |
|
|
-----------------------------------
|
1510 |
|
|
-- Expand_Convert_Fixed_To_Fixed --
|
1511 |
|
|
-----------------------------------
|
1512 |
|
|
|
1513 |
|
|
-- We have:
|
1514 |
|
|
|
1515 |
|
|
-- Result_Value * Result_Small = Source_Value * Source_Small
|
1516 |
|
|
-- Result_Value = Source_Value * (Source_Small / Result_Small)
|
1517 |
|
|
|
1518 |
|
|
-- If the small ratio (Source_Small / Result_Small) is a sufficiently small
|
1519 |
|
|
-- integer, then the perfect result set is obtained by a single integer
|
1520 |
|
|
-- multiplication.
|
1521 |
|
|
|
1522 |
|
|
-- If the small ratio is the reciprocal of a sufficiently small integer,
|
1523 |
|
|
-- then the perfect result set is obtained by a single integer division.
|
1524 |
|
|
|
1525 |
|
|
-- In other cases, we obtain the close result set by calculating the
|
1526 |
|
|
-- result in floating-point.
|
1527 |
|
|
|
1528 |
|
|
procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
|
1529 |
|
|
Rng_Check : constant Boolean := Do_Range_Check (N);
|
1530 |
|
|
Expr : constant Node_Id := Expression (N);
|
1531 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1532 |
|
|
Source_Type : constant Entity_Id := Etype (Expr);
|
1533 |
|
|
Small_Ratio : Ureal;
|
1534 |
|
|
Ratio_Num : Uint;
|
1535 |
|
|
Ratio_Den : Uint;
|
1536 |
|
|
Lit : Node_Id;
|
1537 |
|
|
|
1538 |
|
|
begin
|
1539 |
|
|
if Is_OK_Static_Expression (Expr) then
|
1540 |
|
|
Expand_Convert_Fixed_Static (N);
|
1541 |
|
|
return;
|
1542 |
|
|
end if;
|
1543 |
|
|
|
1544 |
|
|
Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
|
1545 |
|
|
Ratio_Num := Norm_Num (Small_Ratio);
|
1546 |
|
|
Ratio_Den := Norm_Den (Small_Ratio);
|
1547 |
|
|
|
1548 |
|
|
if Ratio_Den = 1 then
|
1549 |
|
|
if Ratio_Num = 1 then
|
1550 |
|
|
Set_Result (N, Expr);
|
1551 |
|
|
return;
|
1552 |
|
|
|
1553 |
|
|
else
|
1554 |
|
|
Lit := Integer_Literal (N, Ratio_Num);
|
1555 |
|
|
|
1556 |
|
|
if Present (Lit) then
|
1557 |
|
|
Set_Result (N, Build_Multiply (N, Expr, Lit));
|
1558 |
|
|
return;
|
1559 |
|
|
end if;
|
1560 |
|
|
end if;
|
1561 |
|
|
|
1562 |
|
|
elsif Ratio_Num = 1 then
|
1563 |
|
|
Lit := Integer_Literal (N, Ratio_Den);
|
1564 |
|
|
|
1565 |
|
|
if Present (Lit) then
|
1566 |
|
|
Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
|
1567 |
|
|
return;
|
1568 |
|
|
end if;
|
1569 |
|
|
end if;
|
1570 |
|
|
|
1571 |
|
|
-- Fall through to use floating-point for the close result set case
|
1572 |
|
|
-- either as a result of the small ratio not being an integer or the
|
1573 |
|
|
-- reciprocal of an integer, or if the integer is out of range.
|
1574 |
|
|
|
1575 |
|
|
Set_Result (N,
|
1576 |
|
|
Build_Multiply (N,
|
1577 |
|
|
Fpt_Value (Expr),
|
1578 |
|
|
Real_Literal (N, Small_Ratio)),
|
1579 |
|
|
Rng_Check);
|
1580 |
|
|
end Expand_Convert_Fixed_To_Fixed;
|
1581 |
|
|
|
1582 |
|
|
-----------------------------------
|
1583 |
|
|
-- Expand_Convert_Fixed_To_Float --
|
1584 |
|
|
-----------------------------------
|
1585 |
|
|
|
1586 |
|
|
-- If the small of the fixed type is 1.0, then we simply convert the
|
1587 |
|
|
-- integer value directly to the target floating-point type, otherwise
|
1588 |
|
|
-- we first have to multiply by the small, in Universal_Real, and then
|
1589 |
|
|
-- convert the result to the target floating-point type.
|
1590 |
|
|
|
1591 |
|
|
procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
|
1592 |
|
|
Rng_Check : constant Boolean := Do_Range_Check (N);
|
1593 |
|
|
Expr : constant Node_Id := Expression (N);
|
1594 |
|
|
Source_Type : constant Entity_Id := Etype (Expr);
|
1595 |
|
|
Small : constant Ureal := Small_Value (Source_Type);
|
1596 |
|
|
|
1597 |
|
|
begin
|
1598 |
|
|
if Is_OK_Static_Expression (Expr) then
|
1599 |
|
|
Expand_Convert_Fixed_Static (N);
|
1600 |
|
|
return;
|
1601 |
|
|
end if;
|
1602 |
|
|
|
1603 |
|
|
if Small = Ureal_1 then
|
1604 |
|
|
Set_Result (N, Expr);
|
1605 |
|
|
|
1606 |
|
|
else
|
1607 |
|
|
Set_Result (N,
|
1608 |
|
|
Build_Multiply (N,
|
1609 |
|
|
Fpt_Value (Expr),
|
1610 |
|
|
Real_Literal (N, Small)),
|
1611 |
|
|
Rng_Check);
|
1612 |
|
|
end if;
|
1613 |
|
|
end Expand_Convert_Fixed_To_Float;
|
1614 |
|
|
|
1615 |
|
|
-------------------------------------
|
1616 |
|
|
-- Expand_Convert_Fixed_To_Integer --
|
1617 |
|
|
-------------------------------------
|
1618 |
|
|
|
1619 |
|
|
-- We have:
|
1620 |
|
|
|
1621 |
|
|
-- Result_Value = Source_Value * Source_Small
|
1622 |
|
|
|
1623 |
|
|
-- If the small value is a sufficiently small integer, then the perfect
|
1624 |
|
|
-- result set is obtained by a single integer multiplication.
|
1625 |
|
|
|
1626 |
|
|
-- If the small value is the reciprocal of a sufficiently small integer,
|
1627 |
|
|
-- then the perfect result set is obtained by a single integer division.
|
1628 |
|
|
|
1629 |
|
|
-- In other cases, we obtain the close result set by calculating the
|
1630 |
|
|
-- result in floating-point.
|
1631 |
|
|
|
1632 |
|
|
procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
|
1633 |
|
|
Rng_Check : constant Boolean := Do_Range_Check (N);
|
1634 |
|
|
Expr : constant Node_Id := Expression (N);
|
1635 |
|
|
Source_Type : constant Entity_Id := Etype (Expr);
|
1636 |
|
|
Small : constant Ureal := Small_Value (Source_Type);
|
1637 |
|
|
Small_Num : constant Uint := Norm_Num (Small);
|
1638 |
|
|
Small_Den : constant Uint := Norm_Den (Small);
|
1639 |
|
|
Lit : Node_Id;
|
1640 |
|
|
|
1641 |
|
|
begin
|
1642 |
|
|
if Is_OK_Static_Expression (Expr) then
|
1643 |
|
|
Expand_Convert_Fixed_Static (N);
|
1644 |
|
|
return;
|
1645 |
|
|
end if;
|
1646 |
|
|
|
1647 |
|
|
if Small_Den = 1 then
|
1648 |
|
|
Lit := Integer_Literal (N, Small_Num);
|
1649 |
|
|
|
1650 |
|
|
if Present (Lit) then
|
1651 |
|
|
Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
|
1652 |
|
|
return;
|
1653 |
|
|
end if;
|
1654 |
|
|
|
1655 |
|
|
elsif Small_Num = 1 then
|
1656 |
|
|
Lit := Integer_Literal (N, Small_Den);
|
1657 |
|
|
|
1658 |
|
|
if Present (Lit) then
|
1659 |
|
|
Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
|
1660 |
|
|
return;
|
1661 |
|
|
end if;
|
1662 |
|
|
end if;
|
1663 |
|
|
|
1664 |
|
|
-- Fall through to use floating-point for the close result set case
|
1665 |
|
|
-- either as a result of the small value not being an integer or the
|
1666 |
|
|
-- reciprocal of an integer, or if the integer is out of range.
|
1667 |
|
|
|
1668 |
|
|
Set_Result (N,
|
1669 |
|
|
Build_Multiply (N,
|
1670 |
|
|
Fpt_Value (Expr),
|
1671 |
|
|
Real_Literal (N, Small)),
|
1672 |
|
|
Rng_Check);
|
1673 |
|
|
end Expand_Convert_Fixed_To_Integer;
|
1674 |
|
|
|
1675 |
|
|
-----------------------------------
|
1676 |
|
|
-- Expand_Convert_Float_To_Fixed --
|
1677 |
|
|
-----------------------------------
|
1678 |
|
|
|
1679 |
|
|
-- We have
|
1680 |
|
|
|
1681 |
|
|
-- Result_Value * Result_Small = Operand_Value
|
1682 |
|
|
|
1683 |
|
|
-- so compute:
|
1684 |
|
|
|
1685 |
|
|
-- Result_Value = Operand_Value * (1.0 / Result_Small)
|
1686 |
|
|
|
1687 |
|
|
-- We do the small scaling in floating-point, and we do a multiplication
|
1688 |
|
|
-- rather than a division, since it is accurate enough for the perfect
|
1689 |
|
|
-- result cases, and faster.
|
1690 |
|
|
|
1691 |
|
|
procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
|
1692 |
|
|
Rng_Check : constant Boolean := Do_Range_Check (N);
|
1693 |
|
|
Expr : constant Node_Id := Expression (N);
|
1694 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1695 |
|
|
Small : constant Ureal := Small_Value (Result_Type);
|
1696 |
|
|
|
1697 |
|
|
begin
|
1698 |
|
|
-- Optimize small = 1, where we can avoid the multiply completely
|
1699 |
|
|
|
1700 |
|
|
if Small = Ureal_1 then
|
1701 |
|
|
Set_Result (N, Expr, Rng_Check, Trunc => True);
|
1702 |
|
|
|
1703 |
|
|
-- Normal case where multiply is required
|
1704 |
|
|
-- Rounding is truncating for decimal fixed point types only,
|
1705 |
|
|
-- see RM 4.6(29).
|
1706 |
|
|
|
1707 |
|
|
else
|
1708 |
|
|
Set_Result (N,
|
1709 |
|
|
Build_Multiply (N,
|
1710 |
|
|
Fpt_Value (Expr),
|
1711 |
|
|
Real_Literal (N, Ureal_1 / Small)),
|
1712 |
|
|
Rng_Check, Trunc => Is_Decimal_Fixed_Point_Type (Result_Type));
|
1713 |
|
|
end if;
|
1714 |
|
|
end Expand_Convert_Float_To_Fixed;
|
1715 |
|
|
|
1716 |
|
|
-------------------------------------
|
1717 |
|
|
-- Expand_Convert_Integer_To_Fixed --
|
1718 |
|
|
-------------------------------------
|
1719 |
|
|
|
1720 |
|
|
-- We have
|
1721 |
|
|
|
1722 |
|
|
-- Result_Value * Result_Small = Operand_Value
|
1723 |
|
|
-- Result_Value = Operand_Value / Result_Small
|
1724 |
|
|
|
1725 |
|
|
-- If the small value is a sufficiently small integer, then the perfect
|
1726 |
|
|
-- result set is obtained by a single integer division.
|
1727 |
|
|
|
1728 |
|
|
-- If the small value is the reciprocal of a sufficiently small integer,
|
1729 |
|
|
-- the perfect result set is obtained by a single integer multiplication.
|
1730 |
|
|
|
1731 |
|
|
-- In other cases, we obtain the close result set by calculating the
|
1732 |
|
|
-- result in floating-point using a multiplication by the reciprocal
|
1733 |
|
|
-- of the Result_Small.
|
1734 |
|
|
|
1735 |
|
|
procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
|
1736 |
|
|
Rng_Check : constant Boolean := Do_Range_Check (N);
|
1737 |
|
|
Expr : constant Node_Id := Expression (N);
|
1738 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
1739 |
|
|
Small : constant Ureal := Small_Value (Result_Type);
|
1740 |
|
|
Small_Num : constant Uint := Norm_Num (Small);
|
1741 |
|
|
Small_Den : constant Uint := Norm_Den (Small);
|
1742 |
|
|
Lit : Node_Id;
|
1743 |
|
|
|
1744 |
|
|
begin
|
1745 |
|
|
if Small_Den = 1 then
|
1746 |
|
|
Lit := Integer_Literal (N, Small_Num);
|
1747 |
|
|
|
1748 |
|
|
if Present (Lit) then
|
1749 |
|
|
Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
|
1750 |
|
|
return;
|
1751 |
|
|
end if;
|
1752 |
|
|
|
1753 |
|
|
elsif Small_Num = 1 then
|
1754 |
|
|
Lit := Integer_Literal (N, Small_Den);
|
1755 |
|
|
|
1756 |
|
|
if Present (Lit) then
|
1757 |
|
|
Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
|
1758 |
|
|
return;
|
1759 |
|
|
end if;
|
1760 |
|
|
end if;
|
1761 |
|
|
|
1762 |
|
|
-- Fall through to use floating-point for the close result set case
|
1763 |
|
|
-- either as a result of the small value not being an integer or the
|
1764 |
|
|
-- reciprocal of an integer, or if the integer is out of range.
|
1765 |
|
|
|
1766 |
|
|
Set_Result (N,
|
1767 |
|
|
Build_Multiply (N,
|
1768 |
|
|
Fpt_Value (Expr),
|
1769 |
|
|
Real_Literal (N, Ureal_1 / Small)),
|
1770 |
|
|
Rng_Check);
|
1771 |
|
|
end Expand_Convert_Integer_To_Fixed;
|
1772 |
|
|
|
1773 |
|
|
--------------------------------
|
1774 |
|
|
-- Expand_Decimal_Divide_Call --
|
1775 |
|
|
--------------------------------
|
1776 |
|
|
|
1777 |
|
|
-- We have four operands
|
1778 |
|
|
|
1779 |
|
|
-- Dividend
|
1780 |
|
|
-- Divisor
|
1781 |
|
|
-- Quotient
|
1782 |
|
|
-- Remainder
|
1783 |
|
|
|
1784 |
|
|
-- All of which are decimal types, and which thus have associated
|
1785 |
|
|
-- decimal scales.
|
1786 |
|
|
|
1787 |
|
|
-- Computing the quotient is a similar problem to that faced by the
|
1788 |
|
|
-- normal fixed-point division, except that it is simpler, because
|
1789 |
|
|
-- we always have compatible smalls.
|
1790 |
|
|
|
1791 |
|
|
-- Quotient = (Dividend / Divisor) * 10**q
|
1792 |
|
|
|
1793 |
|
|
-- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
|
1794 |
|
|
-- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
|
1795 |
|
|
|
1796 |
|
|
-- For q >= 0, we compute
|
1797 |
|
|
|
1798 |
|
|
-- Numerator := Dividend * 10 ** q
|
1799 |
|
|
-- Denominator := Divisor
|
1800 |
|
|
-- Quotient := Numerator / Denominator
|
1801 |
|
|
|
1802 |
|
|
-- For q < 0, we compute
|
1803 |
|
|
|
1804 |
|
|
-- Numerator := Dividend
|
1805 |
|
|
-- Denominator := Divisor * 10 ** q
|
1806 |
|
|
-- Quotient := Numerator / Denominator
|
1807 |
|
|
|
1808 |
|
|
-- Both these divisions are done in truncated mode, and the remainder
|
1809 |
|
|
-- from these divisions is used to compute the result Remainder. This
|
1810 |
|
|
-- remainder has the effective scale of the numerator of the division,
|
1811 |
|
|
|
1812 |
|
|
-- For q >= 0, the remainder scale is Dividend'Scale + q
|
1813 |
|
|
-- For q < 0, the remainder scale is Dividend'Scale
|
1814 |
|
|
|
1815 |
|
|
-- The result Remainder is then computed by a normal truncating decimal
|
1816 |
|
|
-- conversion from this scale to the scale of the remainder, i.e. by a
|
1817 |
|
|
-- division or multiplication by the appropriate power of 10.
|
1818 |
|
|
|
1819 |
|
|
procedure Expand_Decimal_Divide_Call (N : Node_Id) is
|
1820 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
1821 |
|
|
|
1822 |
|
|
Dividend : Node_Id := First_Actual (N);
|
1823 |
|
|
Divisor : Node_Id := Next_Actual (Dividend);
|
1824 |
|
|
Quotient : Node_Id := Next_Actual (Divisor);
|
1825 |
|
|
Remainder : Node_Id := Next_Actual (Quotient);
|
1826 |
|
|
|
1827 |
|
|
Dividend_Type : constant Entity_Id := Etype (Dividend);
|
1828 |
|
|
Divisor_Type : constant Entity_Id := Etype (Divisor);
|
1829 |
|
|
Quotient_Type : constant Entity_Id := Etype (Quotient);
|
1830 |
|
|
Remainder_Type : constant Entity_Id := Etype (Remainder);
|
1831 |
|
|
|
1832 |
|
|
Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
|
1833 |
|
|
Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
|
1834 |
|
|
Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
|
1835 |
|
|
Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
|
1836 |
|
|
|
1837 |
|
|
Q : Uint;
|
1838 |
|
|
Numerator_Scale : Uint;
|
1839 |
|
|
Stmts : List_Id;
|
1840 |
|
|
Qnn : Entity_Id;
|
1841 |
|
|
Rnn : Entity_Id;
|
1842 |
|
|
Computed_Remainder : Node_Id;
|
1843 |
|
|
Adjusted_Remainder : Node_Id;
|
1844 |
|
|
Scale_Adjust : Uint;
|
1845 |
|
|
|
1846 |
|
|
begin
|
1847 |
|
|
-- Relocate the operands, since they are now list elements, and we
|
1848 |
|
|
-- need to reference them separately as operands in the expanded code.
|
1849 |
|
|
|
1850 |
|
|
Dividend := Relocate_Node (Dividend);
|
1851 |
|
|
Divisor := Relocate_Node (Divisor);
|
1852 |
|
|
Quotient := Relocate_Node (Quotient);
|
1853 |
|
|
Remainder := Relocate_Node (Remainder);
|
1854 |
|
|
|
1855 |
|
|
-- Now compute Q, the adjustment scale
|
1856 |
|
|
|
1857 |
|
|
Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
|
1858 |
|
|
|
1859 |
|
|
-- If Q is non-negative then we need a scaled divide
|
1860 |
|
|
|
1861 |
|
|
if Q >= 0 then
|
1862 |
|
|
Build_Scaled_Divide_Code
|
1863 |
|
|
(N,
|
1864 |
|
|
Dividend,
|
1865 |
|
|
Integer_Literal (N, Uint_10 ** Q),
|
1866 |
|
|
Divisor,
|
1867 |
|
|
Qnn, Rnn, Stmts);
|
1868 |
|
|
|
1869 |
|
|
Numerator_Scale := Dividend_Scale + Q;
|
1870 |
|
|
|
1871 |
|
|
-- If Q is negative, then we need a double divide
|
1872 |
|
|
|
1873 |
|
|
else
|
1874 |
|
|
Build_Double_Divide_Code
|
1875 |
|
|
(N,
|
1876 |
|
|
Dividend,
|
1877 |
|
|
Divisor,
|
1878 |
|
|
Integer_Literal (N, Uint_10 ** (-Q)),
|
1879 |
|
|
Qnn, Rnn, Stmts);
|
1880 |
|
|
|
1881 |
|
|
Numerator_Scale := Dividend_Scale;
|
1882 |
|
|
end if;
|
1883 |
|
|
|
1884 |
|
|
-- Add statement to set quotient value
|
1885 |
|
|
|
1886 |
|
|
-- Quotient := quotient-type!(Qnn);
|
1887 |
|
|
|
1888 |
|
|
Append_To (Stmts,
|
1889 |
|
|
Make_Assignment_Statement (Loc,
|
1890 |
|
|
Name => Quotient,
|
1891 |
|
|
Expression =>
|
1892 |
|
|
Unchecked_Convert_To (Quotient_Type,
|
1893 |
|
|
Build_Conversion (N, Quotient_Type,
|
1894 |
|
|
New_Occurrence_Of (Qnn, Loc)))));
|
1895 |
|
|
|
1896 |
|
|
-- Now we need to deal with computing and setting the remainder. The
|
1897 |
|
|
-- scale of the remainder is in Numerator_Scale, and the desired
|
1898 |
|
|
-- scale is the scale of the given Remainder argument. There are
|
1899 |
|
|
-- three cases:
|
1900 |
|
|
|
1901 |
|
|
-- Numerator_Scale > Remainder_Scale
|
1902 |
|
|
|
1903 |
|
|
-- in this case, there are extra digits in the computed remainder
|
1904 |
|
|
-- which must be eliminated by an extra division:
|
1905 |
|
|
|
1906 |
|
|
-- computed-remainder := Numerator rem Denominator
|
1907 |
|
|
-- scale_adjust = Numerator_Scale - Remainder_Scale
|
1908 |
|
|
-- adjusted-remainder := computed-remainder / 10 ** scale_adjust
|
1909 |
|
|
|
1910 |
|
|
-- Numerator_Scale = Remainder_Scale
|
1911 |
|
|
|
1912 |
|
|
-- in this case, the we have the remainder we need
|
1913 |
|
|
|
1914 |
|
|
-- computed-remainder := Numerator rem Denominator
|
1915 |
|
|
-- adjusted-remainder := computed-remainder
|
1916 |
|
|
|
1917 |
|
|
-- Numerator_Scale < Remainder_Scale
|
1918 |
|
|
|
1919 |
|
|
-- in this case, we have insufficient digits in the computed
|
1920 |
|
|
-- remainder, which must be eliminated by an extra multiply
|
1921 |
|
|
|
1922 |
|
|
-- computed-remainder := Numerator rem Denominator
|
1923 |
|
|
-- scale_adjust = Remainder_Scale - Numerator_Scale
|
1924 |
|
|
-- adjusted-remainder := computed-remainder * 10 ** scale_adjust
|
1925 |
|
|
|
1926 |
|
|
-- Finally we assign the adjusted-remainder to the result Remainder
|
1927 |
|
|
-- with conversions to get the proper fixed-point type representation.
|
1928 |
|
|
|
1929 |
|
|
Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
|
1930 |
|
|
|
1931 |
|
|
if Numerator_Scale > Remainder_Scale then
|
1932 |
|
|
Scale_Adjust := Numerator_Scale - Remainder_Scale;
|
1933 |
|
|
Adjusted_Remainder :=
|
1934 |
|
|
Build_Divide
|
1935 |
|
|
(N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
|
1936 |
|
|
|
1937 |
|
|
elsif Numerator_Scale = Remainder_Scale then
|
1938 |
|
|
Adjusted_Remainder := Computed_Remainder;
|
1939 |
|
|
|
1940 |
|
|
else -- Numerator_Scale < Remainder_Scale
|
1941 |
|
|
Scale_Adjust := Remainder_Scale - Numerator_Scale;
|
1942 |
|
|
Adjusted_Remainder :=
|
1943 |
|
|
Build_Multiply
|
1944 |
|
|
(N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
|
1945 |
|
|
end if;
|
1946 |
|
|
|
1947 |
|
|
-- Assignment of remainder result
|
1948 |
|
|
|
1949 |
|
|
Append_To (Stmts,
|
1950 |
|
|
Make_Assignment_Statement (Loc,
|
1951 |
|
|
Name => Remainder,
|
1952 |
|
|
Expression =>
|
1953 |
|
|
Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
|
1954 |
|
|
|
1955 |
|
|
-- Final step is to rewrite the call with a block containing the
|
1956 |
|
|
-- above sequence of constructed statements for the divide operation.
|
1957 |
|
|
|
1958 |
|
|
Rewrite (N,
|
1959 |
|
|
Make_Block_Statement (Loc,
|
1960 |
|
|
Handled_Statement_Sequence =>
|
1961 |
|
|
Make_Handled_Sequence_Of_Statements (Loc,
|
1962 |
|
|
Statements => Stmts)));
|
1963 |
|
|
|
1964 |
|
|
Analyze (N);
|
1965 |
|
|
end Expand_Decimal_Divide_Call;
|
1966 |
|
|
|
1967 |
|
|
-----------------------------------------------
|
1968 |
|
|
-- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
|
1969 |
|
|
-----------------------------------------------
|
1970 |
|
|
|
1971 |
|
|
procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
|
1972 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
1973 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
1974 |
|
|
|
1975 |
|
|
begin
|
1976 |
|
|
-- Suppress expansion of a fixed-by-fixed division if the
|
1977 |
|
|
-- operation is supported directly by the target.
|
1978 |
|
|
|
1979 |
|
|
if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
|
1980 |
|
|
return;
|
1981 |
|
|
end if;
|
1982 |
|
|
|
1983 |
|
|
if Etype (Left) = Universal_Real then
|
1984 |
|
|
Do_Divide_Universal_Fixed (N);
|
1985 |
|
|
|
1986 |
|
|
elsif Etype (Right) = Universal_Real then
|
1987 |
|
|
Do_Divide_Fixed_Universal (N);
|
1988 |
|
|
|
1989 |
|
|
else
|
1990 |
|
|
Do_Divide_Fixed_Fixed (N);
|
1991 |
|
|
end if;
|
1992 |
|
|
end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
|
1993 |
|
|
|
1994 |
|
|
-----------------------------------------------
|
1995 |
|
|
-- Expand_Divide_Fixed_By_Fixed_Giving_Float --
|
1996 |
|
|
-----------------------------------------------
|
1997 |
|
|
|
1998 |
|
|
-- The division is done in Universal_Real, and the result is multiplied
|
1999 |
|
|
-- by the small ratio, which is Small (Right) / Small (Left). Special
|
2000 |
|
|
-- treatment is required for universal operands, which represent their
|
2001 |
|
|
-- own value and do not require conversion.
|
2002 |
|
|
|
2003 |
|
|
procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
|
2004 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2005 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2006 |
|
|
|
2007 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
2008 |
|
|
Right_Type : constant Entity_Id := Etype (Right);
|
2009 |
|
|
|
2010 |
|
|
begin
|
2011 |
|
|
-- Case of left operand is universal real, the result we want is:
|
2012 |
|
|
|
2013 |
|
|
-- Left_Value / (Right_Value * Right_Small)
|
2014 |
|
|
|
2015 |
|
|
-- so we compute this as:
|
2016 |
|
|
|
2017 |
|
|
-- (Left_Value / Right_Small) / Right_Value
|
2018 |
|
|
|
2019 |
|
|
if Left_Type = Universal_Real then
|
2020 |
|
|
Set_Result (N,
|
2021 |
|
|
Build_Divide (N,
|
2022 |
|
|
Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
|
2023 |
|
|
Fpt_Value (Right)));
|
2024 |
|
|
|
2025 |
|
|
-- Case of right operand is universal real, the result we want is
|
2026 |
|
|
|
2027 |
|
|
-- (Left_Value * Left_Small) / Right_Value
|
2028 |
|
|
|
2029 |
|
|
-- so we compute this as:
|
2030 |
|
|
|
2031 |
|
|
-- Left_Value * (Left_Small / Right_Value)
|
2032 |
|
|
|
2033 |
|
|
-- Note we invert to a multiplication since usually floating-point
|
2034 |
|
|
-- multiplication is much faster than floating-point division.
|
2035 |
|
|
|
2036 |
|
|
elsif Right_Type = Universal_Real then
|
2037 |
|
|
Set_Result (N,
|
2038 |
|
|
Build_Multiply (N,
|
2039 |
|
|
Fpt_Value (Left),
|
2040 |
|
|
Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
|
2041 |
|
|
|
2042 |
|
|
-- Both operands are fixed, so the value we want is
|
2043 |
|
|
|
2044 |
|
|
-- (Left_Value * Left_Small) / (Right_Value * Right_Small)
|
2045 |
|
|
|
2046 |
|
|
-- which we compute as:
|
2047 |
|
|
|
2048 |
|
|
-- (Left_Value / Right_Value) * (Left_Small / Right_Small)
|
2049 |
|
|
|
2050 |
|
|
else
|
2051 |
|
|
Set_Result (N,
|
2052 |
|
|
Build_Multiply (N,
|
2053 |
|
|
Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
|
2054 |
|
|
Real_Literal (N,
|
2055 |
|
|
Small_Value (Left_Type) / Small_Value (Right_Type))));
|
2056 |
|
|
end if;
|
2057 |
|
|
end Expand_Divide_Fixed_By_Fixed_Giving_Float;
|
2058 |
|
|
|
2059 |
|
|
-------------------------------------------------
|
2060 |
|
|
-- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
|
2061 |
|
|
-------------------------------------------------
|
2062 |
|
|
|
2063 |
|
|
procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
|
2064 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2065 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2066 |
|
|
begin
|
2067 |
|
|
if Etype (Left) = Universal_Real then
|
2068 |
|
|
Do_Divide_Universal_Fixed (N);
|
2069 |
|
|
elsif Etype (Right) = Universal_Real then
|
2070 |
|
|
Do_Divide_Fixed_Universal (N);
|
2071 |
|
|
else
|
2072 |
|
|
Do_Divide_Fixed_Fixed (N);
|
2073 |
|
|
end if;
|
2074 |
|
|
end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
|
2075 |
|
|
|
2076 |
|
|
-------------------------------------------------
|
2077 |
|
|
-- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
|
2078 |
|
|
-------------------------------------------------
|
2079 |
|
|
|
2080 |
|
|
-- Since the operand and result fixed-point type is the same, this is
|
2081 |
|
|
-- a straight divide by the right operand, the small can be ignored.
|
2082 |
|
|
|
2083 |
|
|
procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
|
2084 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2085 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2086 |
|
|
begin
|
2087 |
|
|
Set_Result (N, Build_Divide (N, Left, Right));
|
2088 |
|
|
end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
|
2089 |
|
|
|
2090 |
|
|
-------------------------------------------------
|
2091 |
|
|
-- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
|
2092 |
|
|
-------------------------------------------------
|
2093 |
|
|
|
2094 |
|
|
procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
|
2095 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2096 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2097 |
|
|
|
2098 |
|
|
procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
|
2099 |
|
|
-- The operand may be a non-static universal value, such an
|
2100 |
|
|
-- exponentiation with a non-static exponent. In that case, treat
|
2101 |
|
|
-- as a fixed * fixed multiplication, and convert the argument to
|
2102 |
|
|
-- the target fixed type.
|
2103 |
|
|
|
2104 |
|
|
----------------------------------
|
2105 |
|
|
-- Rewrite_Non_Static_Universal --
|
2106 |
|
|
----------------------------------
|
2107 |
|
|
|
2108 |
|
|
procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
|
2109 |
|
|
Loc : constant Source_Ptr := Sloc (N);
|
2110 |
|
|
begin
|
2111 |
|
|
Rewrite (Opnd,
|
2112 |
|
|
Make_Type_Conversion (Loc,
|
2113 |
|
|
Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
|
2114 |
|
|
Expression => Expression (Opnd)));
|
2115 |
|
|
Analyze_And_Resolve (Opnd, Etype (N));
|
2116 |
|
|
end Rewrite_Non_Static_Universal;
|
2117 |
|
|
|
2118 |
|
|
-- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
|
2119 |
|
|
|
2120 |
|
|
begin
|
2121 |
|
|
-- Suppress expansion of a fixed-by-fixed multiplication if the
|
2122 |
|
|
-- operation is supported directly by the target.
|
2123 |
|
|
|
2124 |
|
|
if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
|
2125 |
|
|
return;
|
2126 |
|
|
end if;
|
2127 |
|
|
|
2128 |
|
|
if Etype (Left) = Universal_Real then
|
2129 |
|
|
if Nkind (Left) = N_Real_Literal then
|
2130 |
|
|
Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
|
2131 |
|
|
|
2132 |
|
|
elsif Nkind (Left) = N_Type_Conversion then
|
2133 |
|
|
Rewrite_Non_Static_Universal (Left);
|
2134 |
|
|
Do_Multiply_Fixed_Fixed (N);
|
2135 |
|
|
end if;
|
2136 |
|
|
|
2137 |
|
|
elsif Etype (Right) = Universal_Real then
|
2138 |
|
|
if Nkind (Right) = N_Real_Literal then
|
2139 |
|
|
Do_Multiply_Fixed_Universal (N, Left, Right);
|
2140 |
|
|
|
2141 |
|
|
elsif Nkind (Right) = N_Type_Conversion then
|
2142 |
|
|
Rewrite_Non_Static_Universal (Right);
|
2143 |
|
|
Do_Multiply_Fixed_Fixed (N);
|
2144 |
|
|
end if;
|
2145 |
|
|
|
2146 |
|
|
else
|
2147 |
|
|
Do_Multiply_Fixed_Fixed (N);
|
2148 |
|
|
end if;
|
2149 |
|
|
end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
|
2150 |
|
|
|
2151 |
|
|
-------------------------------------------------
|
2152 |
|
|
-- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
|
2153 |
|
|
-------------------------------------------------
|
2154 |
|
|
|
2155 |
|
|
-- The multiply is done in Universal_Real, and the result is multiplied
|
2156 |
|
|
-- by the adjustment for the smalls which is Small (Right) * Small (Left).
|
2157 |
|
|
-- Special treatment is required for universal operands.
|
2158 |
|
|
|
2159 |
|
|
procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
|
2160 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2161 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2162 |
|
|
|
2163 |
|
|
Left_Type : constant Entity_Id := Etype (Left);
|
2164 |
|
|
Right_Type : constant Entity_Id := Etype (Right);
|
2165 |
|
|
|
2166 |
|
|
begin
|
2167 |
|
|
-- Case of left operand is universal real, the result we want is
|
2168 |
|
|
|
2169 |
|
|
-- Left_Value * (Right_Value * Right_Small)
|
2170 |
|
|
|
2171 |
|
|
-- so we compute this as:
|
2172 |
|
|
|
2173 |
|
|
-- (Left_Value * Right_Small) * Right_Value;
|
2174 |
|
|
|
2175 |
|
|
if Left_Type = Universal_Real then
|
2176 |
|
|
Set_Result (N,
|
2177 |
|
|
Build_Multiply (N,
|
2178 |
|
|
Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
|
2179 |
|
|
Fpt_Value (Right)));
|
2180 |
|
|
|
2181 |
|
|
-- Case of right operand is universal real, the result we want is
|
2182 |
|
|
|
2183 |
|
|
-- (Left_Value * Left_Small) * Right_Value
|
2184 |
|
|
|
2185 |
|
|
-- so we compute this as:
|
2186 |
|
|
|
2187 |
|
|
-- Left_Value * (Left_Small * Right_Value)
|
2188 |
|
|
|
2189 |
|
|
elsif Right_Type = Universal_Real then
|
2190 |
|
|
Set_Result (N,
|
2191 |
|
|
Build_Multiply (N,
|
2192 |
|
|
Fpt_Value (Left),
|
2193 |
|
|
Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
|
2194 |
|
|
|
2195 |
|
|
-- Both operands are fixed, so the value we want is
|
2196 |
|
|
|
2197 |
|
|
-- (Left_Value * Left_Small) * (Right_Value * Right_Small)
|
2198 |
|
|
|
2199 |
|
|
-- which we compute as:
|
2200 |
|
|
|
2201 |
|
|
-- (Left_Value * Right_Value) * (Right_Small * Left_Small)
|
2202 |
|
|
|
2203 |
|
|
else
|
2204 |
|
|
Set_Result (N,
|
2205 |
|
|
Build_Multiply (N,
|
2206 |
|
|
Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
|
2207 |
|
|
Real_Literal (N,
|
2208 |
|
|
Small_Value (Right_Type) * Small_Value (Left_Type))));
|
2209 |
|
|
end if;
|
2210 |
|
|
end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
|
2211 |
|
|
|
2212 |
|
|
---------------------------------------------------
|
2213 |
|
|
-- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
|
2214 |
|
|
---------------------------------------------------
|
2215 |
|
|
|
2216 |
|
|
procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
|
2217 |
|
|
Left : constant Node_Id := Left_Opnd (N);
|
2218 |
|
|
Right : constant Node_Id := Right_Opnd (N);
|
2219 |
|
|
begin
|
2220 |
|
|
if Etype (Left) = Universal_Real then
|
2221 |
|
|
Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
|
2222 |
|
|
elsif Etype (Right) = Universal_Real then
|
2223 |
|
|
Do_Multiply_Fixed_Universal (N, Left, Right);
|
2224 |
|
|
else
|
2225 |
|
|
Do_Multiply_Fixed_Fixed (N);
|
2226 |
|
|
end if;
|
2227 |
|
|
end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
|
2228 |
|
|
|
2229 |
|
|
---------------------------------------------------
|
2230 |
|
|
-- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
|
2231 |
|
|
---------------------------------------------------
|
2232 |
|
|
|
2233 |
|
|
-- Since the operand and result fixed-point type is the same, this is
|
2234 |
|
|
-- a straight multiply by the right operand, the small can be ignored.
|
2235 |
|
|
|
2236 |
|
|
procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
|
2237 |
|
|
begin
|
2238 |
|
|
Set_Result (N,
|
2239 |
|
|
Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
|
2240 |
|
|
end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
|
2241 |
|
|
|
2242 |
|
|
---------------------------------------------------
|
2243 |
|
|
-- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
|
2244 |
|
|
---------------------------------------------------
|
2245 |
|
|
|
2246 |
|
|
-- Since the operand and result fixed-point type is the same, this is
|
2247 |
|
|
-- a straight multiply by the right operand, the small can be ignored.
|
2248 |
|
|
|
2249 |
|
|
procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
|
2250 |
|
|
begin
|
2251 |
|
|
Set_Result (N,
|
2252 |
|
|
Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
|
2253 |
|
|
end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
|
2254 |
|
|
|
2255 |
|
|
---------------
|
2256 |
|
|
-- Fpt_Value --
|
2257 |
|
|
---------------
|
2258 |
|
|
|
2259 |
|
|
function Fpt_Value (N : Node_Id) return Node_Id is
|
2260 |
|
|
Typ : constant Entity_Id := Etype (N);
|
2261 |
|
|
|
2262 |
|
|
begin
|
2263 |
|
|
if Is_Integer_Type (Typ)
|
2264 |
|
|
or else Is_Floating_Point_Type (Typ)
|
2265 |
|
|
then
|
2266 |
|
|
return Build_Conversion (N, Universal_Real, N);
|
2267 |
|
|
|
2268 |
|
|
-- Fixed-point case, must get integer value first
|
2269 |
|
|
|
2270 |
|
|
else
|
2271 |
|
|
return Build_Conversion (N, Universal_Real, N);
|
2272 |
|
|
end if;
|
2273 |
|
|
end Fpt_Value;
|
2274 |
|
|
|
2275 |
|
|
---------------------
|
2276 |
|
|
-- Integer_Literal --
|
2277 |
|
|
---------------------
|
2278 |
|
|
|
2279 |
|
|
function Integer_Literal
|
2280 |
|
|
(N : Node_Id;
|
2281 |
|
|
V : Uint;
|
2282 |
|
|
Negative : Boolean := False) return Node_Id
|
2283 |
|
|
is
|
2284 |
|
|
T : Entity_Id;
|
2285 |
|
|
L : Node_Id;
|
2286 |
|
|
|
2287 |
|
|
begin
|
2288 |
|
|
if V < Uint_2 ** 7 then
|
2289 |
|
|
T := Standard_Integer_8;
|
2290 |
|
|
|
2291 |
|
|
elsif V < Uint_2 ** 15 then
|
2292 |
|
|
T := Standard_Integer_16;
|
2293 |
|
|
|
2294 |
|
|
elsif V < Uint_2 ** 31 then
|
2295 |
|
|
T := Standard_Integer_32;
|
2296 |
|
|
|
2297 |
|
|
elsif V < Uint_2 ** 63 then
|
2298 |
|
|
T := Standard_Integer_64;
|
2299 |
|
|
|
2300 |
|
|
else
|
2301 |
|
|
return Empty;
|
2302 |
|
|
end if;
|
2303 |
|
|
|
2304 |
|
|
if Negative then
|
2305 |
|
|
L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
|
2306 |
|
|
else
|
2307 |
|
|
L := Make_Integer_Literal (Sloc (N), V);
|
2308 |
|
|
end if;
|
2309 |
|
|
|
2310 |
|
|
-- Set type of result in case used elsewhere (see note at start)
|
2311 |
|
|
|
2312 |
|
|
Set_Etype (L, T);
|
2313 |
|
|
Set_Is_Static_Expression (L);
|
2314 |
|
|
|
2315 |
|
|
-- We really need to set Analyzed here because we may be creating a
|
2316 |
|
|
-- very strange beast, namely an integer literal typed as fixed-point
|
2317 |
|
|
-- and the analyzer won't like that. Probably we should allow the
|
2318 |
|
|
-- Treat_Fixed_As_Integer flag to appear on integer literal nodes
|
2319 |
|
|
-- and teach the analyzer how to handle them ???
|
2320 |
|
|
|
2321 |
|
|
Set_Analyzed (L);
|
2322 |
|
|
return L;
|
2323 |
|
|
end Integer_Literal;
|
2324 |
|
|
|
2325 |
|
|
------------------
|
2326 |
|
|
-- Real_Literal --
|
2327 |
|
|
------------------
|
2328 |
|
|
|
2329 |
|
|
function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
|
2330 |
|
|
L : Node_Id;
|
2331 |
|
|
|
2332 |
|
|
begin
|
2333 |
|
|
L := Make_Real_Literal (Sloc (N), V);
|
2334 |
|
|
|
2335 |
|
|
-- Set type of result in case used elsewhere (see note at start)
|
2336 |
|
|
|
2337 |
|
|
Set_Etype (L, Universal_Real);
|
2338 |
|
|
return L;
|
2339 |
|
|
end Real_Literal;
|
2340 |
|
|
|
2341 |
|
|
------------------------
|
2342 |
|
|
-- Rounded_Result_Set --
|
2343 |
|
|
------------------------
|
2344 |
|
|
|
2345 |
|
|
function Rounded_Result_Set (N : Node_Id) return Boolean is
|
2346 |
|
|
K : constant Node_Kind := Nkind (N);
|
2347 |
|
|
begin
|
2348 |
|
|
if (K = N_Type_Conversion or else
|
2349 |
|
|
K = N_Op_Divide or else
|
2350 |
|
|
K = N_Op_Multiply)
|
2351 |
|
|
and then
|
2352 |
|
|
(Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
|
2353 |
|
|
then
|
2354 |
|
|
return True;
|
2355 |
|
|
else
|
2356 |
|
|
return False;
|
2357 |
|
|
end if;
|
2358 |
|
|
end Rounded_Result_Set;
|
2359 |
|
|
|
2360 |
|
|
----------------
|
2361 |
|
|
-- Set_Result --
|
2362 |
|
|
----------------
|
2363 |
|
|
|
2364 |
|
|
procedure Set_Result
|
2365 |
|
|
(N : Node_Id;
|
2366 |
|
|
Expr : Node_Id;
|
2367 |
|
|
Rchk : Boolean := False;
|
2368 |
|
|
Trunc : Boolean := False)
|
2369 |
|
|
is
|
2370 |
|
|
Cnode : Node_Id;
|
2371 |
|
|
|
2372 |
|
|
Expr_Type : constant Entity_Id := Etype (Expr);
|
2373 |
|
|
Result_Type : constant Entity_Id := Etype (N);
|
2374 |
|
|
|
2375 |
|
|
begin
|
2376 |
|
|
-- No conversion required if types match and no range check or truncate
|
2377 |
|
|
|
2378 |
|
|
if Result_Type = Expr_Type and then not (Rchk or Trunc) then
|
2379 |
|
|
Cnode := Expr;
|
2380 |
|
|
|
2381 |
|
|
-- Else perform required conversion
|
2382 |
|
|
|
2383 |
|
|
else
|
2384 |
|
|
Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
|
2385 |
|
|
end if;
|
2386 |
|
|
|
2387 |
|
|
Rewrite (N, Cnode);
|
2388 |
|
|
Analyze_And_Resolve (N, Result_Type);
|
2389 |
|
|
end Set_Result;
|
2390 |
|
|
|
2391 |
|
|
end Exp_Fixd;
|