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