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