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