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