* gimplify.c (find_single_pointer_decl_1): New static function.
[official-gcc.git] / gcc / ada / exp_fixd.adb
blob511392d5f78eb43143d31209e488b094446133b7
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-2005 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 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 51 Franklin Street, Fifth Floor, --
20 -- Boston, MA 02110-1301, USA. --
21 -- --
22 -- GNAT was originally developed by the GNAT team at New York University. --
23 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 -- --
25 ------------------------------------------------------------------------------
27 with Atree; use Atree;
28 with Checks; use Checks;
29 with Einfo; use Einfo;
30 with Exp_Util; use Exp_Util;
31 with Nlists; use Nlists;
32 with Nmake; use Nmake;
33 with Rtsfind; use Rtsfind;
34 with Sem; use Sem;
35 with Sem_Eval; use Sem_Eval;
36 with Sem_Res; use Sem_Res;
37 with Sem_Util; use Sem_Util;
38 with Sinfo; use Sinfo;
39 with Stand; use Stand;
40 with Tbuild; use Tbuild;
41 with Uintp; use Uintp;
42 with Urealp; use Urealp;
44 package body Exp_Fixd is
46 -----------------------
47 -- Local Subprograms --
48 -----------------------
50 -- General note; in this unit, a number of routines are driven by the
51 -- types (Etype) of their operands. Since we are dealing with unanalyzed
52 -- expressions as they are constructed, the Etypes would not normally be
53 -- set, but the construction routines that we use in this unit do in fact
54 -- set the Etype values correctly. In addition, setting the Etype ensures
55 -- that the analyzer does not try to redetermine the type when the node
56 -- is analyzed (which would be wrong, since in the case where we set the
57 -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
58 -- still dealing with a normal fixed-point operation and mess it up).
60 function Build_Conversion
61 (N : Node_Id;
62 Typ : Entity_Id;
63 Expr : Node_Id;
64 Rchk : Boolean := False)
65 return Node_Id;
66 -- Build an expression that converts the expression Expr to type Typ,
67 -- taking the source location from Sloc (N). If the conversions involve
68 -- fixed-point types, then the Conversion_OK flag will be set so that the
69 -- resulting conversions do not get re-expanded. On return the resulting
70 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
71 -- in the resulting conversion node.
73 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
74 -- Builds an N_Op_Divide node from the given left and right operand
75 -- expressions, using the source location from Sloc (N). The operands
76 -- are either both Long_Long_Float, in which case Build_Divide differs
77 -- from Make_Op_Divide only in that the Etype of the resulting node is
78 -- set (to Long_Long_Float), or they can be integer types. In this case
79 -- the integer types need not be the same, and Build_Divide converts
80 -- the operand with the smaller sized type to match the type of the
81 -- other operand and sets this as the result type. The Rounded_Result
82 -- flag of the result in this case is set from the Rounded_Result flag
83 -- of node N. On return, the resulting node is analyzed, and has its
84 -- Etype set.
86 function Build_Double_Divide
87 (N : Node_Id;
88 X, Y, Z : Node_Id)
89 return Node_Id;
90 -- Returns a node corresponding to the value X/(Y*Z) using the source
91 -- location from Sloc (N). The division is rounded if the Rounded_Result
92 -- flag of N is set. The integer types of X, Y, Z may be different. On
93 -- return the resulting node is analyzed, and has its Etype set.
95 procedure Build_Double_Divide_Code
96 (N : Node_Id;
97 X, Y, Z : Node_Id;
98 Qnn, Rnn : out Entity_Id;
99 Code : out List_Id);
100 -- Generates a sequence of code for determining the quotient and remainder
101 -- of the division X/(Y*Z), using the source location from Sloc (N).
102 -- Entities of appropriate types are allocated for the quotient and
103 -- remainder and returned in Qnn and Rnn. The result is rounded if
104 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
105 -- are appropriately set on return.
107 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
108 -- Builds an N_Op_Multiply node from the given left and right operand
109 -- expressions, using the source location from Sloc (N). The operands
110 -- are either both Long_Long_Float, in which case Build_Divide differs
111 -- from Make_Op_Multiply only in that the Etype of the resulting node is
112 -- set (to Long_Long_Float), or they can be integer types. In this case
113 -- the integer types need not be the same, and Build_Multiply chooses
114 -- a type long enough to hold the product (i.e. twice the size of the
115 -- longer of the two operand types), and both operands are converted
116 -- to this type. The Etype of the result is also set to this value.
117 -- However, the result can never overflow Integer_64, so this is the
118 -- largest type that is ever generated. On return, the resulting node
119 -- is analyzed and has its Etype set.
121 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
122 -- Builds an N_Op_Rem node from the given left and right operand
123 -- expressions, using the source location from Sloc (N). The operands
124 -- are both integer types, which need not be the same. Build_Rem
125 -- converts the operand with the smaller sized type to match the type
126 -- of the other operand and sets this as the result type. The result
127 -- is never rounded (rem operations cannot be rounded in any case!)
128 -- On return, the resulting node is analyzed and has its Etype set.
130 function Build_Scaled_Divide
131 (N : Node_Id;
132 X, Y, Z : Node_Id)
133 return Node_Id;
134 -- Returns a node corresponding to the value X*Y/Z using the source
135 -- location from Sloc (N). The division is rounded if the Rounded_Result
136 -- flag of N is set. The integer types of X, Y, Z may be different. On
137 -- return the resulting node is analyzed and has is Etype set.
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.
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.
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.
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.
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.
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).
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.
184 function Fpt_Value (N : Node_Id) return Node_Id;
185 -- Given an operand of fixed-point operation, return an expression that
186 -- represents the corresponding Long_Long_Float value. The expression
187 -- can be of integer type, floating-point type, or fixed-point type.
188 -- The expression returned is neither analyzed and resolved. The Etype
189 -- of the result is properly set (to Long_Long_Float).
191 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id;
192 -- Given a non-negative universal integer value, build a typed integer
193 -- literal node, using the smallest applicable standard integer type. If
194 -- the value exceeds 2**63-1, the largest value allowed for perfect result
195 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
196 -- node N provides the Sloc value for the constructed literal. The Etype
197 -- of the resulting literal is correctly set, and it is marked as analyzed.
199 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
200 -- Build a real literal node from the given value, the Etype of the
201 -- returned node is set to Long_Long_Float, since all floating-point
202 -- arithmetic operations that we construct use Long_Long_Float
204 function Rounded_Result_Set (N : Node_Id) return Boolean;
205 -- Returns True if N is a node that contains the Rounded_Result flag
206 -- and if the flag is true.
208 procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
209 -- N is the node for the current conversion, division or multiplication
210 -- operation, and Expr is an expression representing the result. Expr
211 -- may be of floating-point or integer type. If the operation result
212 -- is fixed-point, then the value of Expr is in units of small of the
213 -- result type (i.e. small's have already been dealt with). The result
214 -- of the call is to replace N by an appropriate conversion to the
215 -- result type, dealing with rounding for the decimal types case. The
216 -- node is then analyzed and resolved using the result type. If Rchk
217 -- is True, then Do_Range_Check is set in the resulting conversion.
219 ----------------------
220 -- Build_Conversion --
221 ----------------------
223 function Build_Conversion
224 (N : Node_Id;
225 Typ : Entity_Id;
226 Expr : Node_Id;
227 Rchk : Boolean := False)
228 return Node_Id
230 Loc : constant Source_Ptr := Sloc (N);
231 Result : Node_Id;
232 Rcheck : Boolean := Rchk;
234 begin
235 -- A special case, if the expression is an integer literal and the
236 -- target type is an integer type, then just retype the integer
237 -- literal to the desired target type. Don't do this if we need
238 -- a range check.
240 if Nkind (Expr) = N_Integer_Literal
241 and then Is_Integer_Type (Typ)
242 and then not Rchk
243 then
244 Result := Expr;
246 -- Cases where we end up with a conversion. Note that we do not use the
247 -- Convert_To abstraction here, since we may be decorating the resulting
248 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
249 -- conversion node present, even if it appears to be redundant.
251 else
252 -- Remove inner conversion if both inner and outer conversions are
253 -- to integer types, since the inner one serves no purpose (except
254 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
255 -- and also we preserve the range check flag on the inner operand
257 if Is_Integer_Type (Typ)
258 and then Is_Integer_Type (Etype (Expr))
259 and then Nkind (Expr) = N_Type_Conversion
260 then
261 Result :=
262 Make_Type_Conversion (Loc,
263 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
264 Expression => Expression (Expr));
265 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
266 Rcheck := Rcheck or Do_Range_Check (Expr);
268 -- For all other cases, a simple type conversion will work
270 else
271 Result :=
272 Make_Type_Conversion (Loc,
273 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
274 Expression => Expr);
275 end if;
277 -- Set Conversion_OK if either result or expression type is a
278 -- fixed-point type, since from a semantic point of view, we are
279 -- treating fixed-point values as integers at this stage.
281 if Is_Fixed_Point_Type (Typ)
282 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
283 then
284 Set_Conversion_OK (Result);
285 end if;
287 -- Set Do_Range_Check if either it was requested by the caller,
288 -- or if an eliminated inner conversion had a range check.
290 if Rcheck then
291 Enable_Range_Check (Result);
292 else
293 Set_Do_Range_Check (Result, False);
294 end if;
295 end if;
297 Set_Etype (Result, Typ);
298 return Result;
300 end Build_Conversion;
302 ------------------
303 -- Build_Divide --
304 ------------------
306 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
307 Loc : constant Source_Ptr := Sloc (N);
308 Left_Type : constant Entity_Id := Base_Type (Etype (L));
309 Right_Type : constant Entity_Id := Base_Type (Etype (R));
310 Result_Type : Entity_Id;
311 Rnode : Node_Id;
313 begin
314 -- Deal with floating-point case first
316 if Is_Floating_Point_Type (Left_Type) then
317 pragma Assert (Left_Type = Standard_Long_Long_Float);
318 pragma Assert (Right_Type = Standard_Long_Long_Float);
320 Rnode := Make_Op_Divide (Loc, L, R);
321 Result_Type := Standard_Long_Long_Float;
323 -- Integer and fixed-point cases
325 else
326 -- An optimization. If the right operand is the literal 1, then we
327 -- can just return the left hand operand. Putting the optimization
328 -- here allows us to omit the check at the call site.
330 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
331 return L;
332 end if;
334 -- If left and right types are the same, no conversion needed
336 if Left_Type = Right_Type then
337 Result_Type := Left_Type;
338 Rnode :=
339 Make_Op_Divide (Loc,
340 Left_Opnd => L,
341 Right_Opnd => R);
343 -- Use left type if it is the larger of the two
345 elsif Esize (Left_Type) >= Esize (Right_Type) then
346 Result_Type := Left_Type;
347 Rnode :=
348 Make_Op_Divide (Loc,
349 Left_Opnd => L,
350 Right_Opnd => Build_Conversion (N, Left_Type, R));
352 -- Otherwise right type is larger of the two, us it
354 else
355 Result_Type := Right_Type;
356 Rnode :=
357 Make_Op_Divide (Loc,
358 Left_Opnd => Build_Conversion (N, Right_Type, L),
359 Right_Opnd => R);
360 end if;
361 end if;
363 -- We now have a divide node built with Result_Type set. First
364 -- set Etype of result, as required for all Build_xxx routines
366 Set_Etype (Rnode, Base_Type (Result_Type));
368 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
369 -- since this is a literal arithmetic operation, to be performed
370 -- by Gigi without any consideration of small values.
372 if Is_Fixed_Point_Type (Result_Type) then
373 Set_Treat_Fixed_As_Integer (Rnode);
374 end if;
376 -- The result is rounded if the target of the operation is decimal
377 -- and Rounded_Result is set, or if the target of the operation
378 -- is an integer type.
380 if Is_Integer_Type (Etype (N))
381 or else Rounded_Result_Set (N)
382 then
383 Set_Rounded_Result (Rnode);
384 end if;
386 return Rnode;
388 end Build_Divide;
390 -------------------------
391 -- Build_Double_Divide --
392 -------------------------
394 function Build_Double_Divide
395 (N : Node_Id;
396 X, Y, Z : Node_Id)
397 return Node_Id
399 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
400 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
401 Expr : Node_Id;
403 begin
404 -- If denominator fits in 64 bits, we can build the operations directly
405 -- without causing any intermediate overflow, so that's what we do!
407 if Int'Max (Y_Size, Z_Size) <= 32 then
408 return
409 Build_Divide (N, X, Build_Multiply (N, Y, Z));
411 -- Otherwise we use the runtime routine
413 -- [Qnn : Interfaces.Integer_64,
414 -- Rnn : Interfaces.Integer_64;
415 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
416 -- Qnn]
418 else
419 declare
420 Loc : constant Source_Ptr := Sloc (N);
421 Qnn : Entity_Id;
422 Rnn : Entity_Id;
423 Code : List_Id;
425 begin
426 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
427 Insert_Actions (N, Code);
428 Expr := New_Occurrence_Of (Qnn, Loc);
430 -- Set type of result in case used elsewhere (see note at start)
432 Set_Etype (Expr, Etype (Qnn));
434 -- Set result as analyzed (see note at start on build routines)
436 return Expr;
437 end;
438 end if;
439 end Build_Double_Divide;
441 ------------------------------
442 -- Build_Double_Divide_Code --
443 ------------------------------
445 -- If the denominator can be computed in 64-bits, we build
447 -- [Nnn : constant typ := typ (X);
448 -- Dnn : constant typ := typ (Y) * typ (Z)
449 -- Qnn : constant typ := Nnn / Dnn;
450 -- Rnn : constant typ := Nnn / Dnn;
452 -- If the numerator cannot be computed in 64 bits, we build
454 -- [Qnn : typ;
455 -- Rnn : typ;
456 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
458 procedure Build_Double_Divide_Code
459 (N : Node_Id;
460 X, Y, Z : Node_Id;
461 Qnn, Rnn : out Entity_Id;
462 Code : out List_Id)
464 Loc : constant Source_Ptr := Sloc (N);
466 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
467 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
468 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
470 QR_Siz : Int;
471 QR_Typ : Entity_Id;
473 Nnn : Entity_Id;
474 Dnn : Entity_Id;
476 Quo : Node_Id;
477 Rnd : Entity_Id;
479 begin
480 -- Find type that will allow computation of numerator
482 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
484 if QR_Siz <= 16 then
485 QR_Typ := Standard_Integer_16;
486 elsif QR_Siz <= 32 then
487 QR_Typ := Standard_Integer_32;
488 elsif QR_Siz <= 64 then
489 QR_Typ := Standard_Integer_64;
491 -- For more than 64, bits, we use the 64-bit integer defined in
492 -- Interfaces, so that it can be handled by the runtime routine
494 else
495 QR_Typ := RTE (RE_Integer_64);
496 end if;
498 -- Define quotient and remainder, and set their Etypes, so
499 -- that they can be picked up by Build_xxx routines.
501 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
502 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
504 Set_Etype (Qnn, QR_Typ);
505 Set_Etype (Rnn, QR_Typ);
507 -- Case that we can compute the denominator in 64 bits
509 if QR_Siz <= 64 then
511 -- Create temporaries for numerator and denominator and set Etypes,
512 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
514 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
515 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
517 Set_Etype (Nnn, QR_Typ);
518 Set_Etype (Dnn, QR_Typ);
520 Code := New_List (
521 Make_Object_Declaration (Loc,
522 Defining_Identifier => Nnn,
523 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
524 Constant_Present => True,
525 Expression => Build_Conversion (N, QR_Typ, X)),
527 Make_Object_Declaration (Loc,
528 Defining_Identifier => Dnn,
529 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
530 Constant_Present => True,
531 Expression =>
532 Build_Multiply (N,
533 Build_Conversion (N, QR_Typ, Y),
534 Build_Conversion (N, QR_Typ, Z))));
536 Quo :=
537 Build_Divide (N,
538 New_Occurrence_Of (Nnn, Loc),
539 New_Occurrence_Of (Dnn, Loc));
541 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
543 Append_To (Code,
544 Make_Object_Declaration (Loc,
545 Defining_Identifier => Qnn,
546 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
547 Constant_Present => True,
548 Expression => Quo));
550 Append_To (Code,
551 Make_Object_Declaration (Loc,
552 Defining_Identifier => Rnn,
553 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
554 Constant_Present => True,
555 Expression =>
556 Build_Rem (N,
557 New_Occurrence_Of (Nnn, Loc),
558 New_Occurrence_Of (Dnn, Loc))));
560 -- Case where denominator does not fit in 64 bits, so we have to
561 -- call the runtime routine to compute the quotient and remainder
563 else
564 Rnd := Boolean_Literals (Rounded_Result_Set (N));
566 Code := New_List (
567 Make_Object_Declaration (Loc,
568 Defining_Identifier => Qnn,
569 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
571 Make_Object_Declaration (Loc,
572 Defining_Identifier => Rnn,
573 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
575 Make_Procedure_Call_Statement (Loc,
576 Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
577 Parameter_Associations => New_List (
578 Build_Conversion (N, QR_Typ, X),
579 Build_Conversion (N, QR_Typ, Y),
580 Build_Conversion (N, QR_Typ, Z),
581 New_Occurrence_Of (Qnn, Loc),
582 New_Occurrence_Of (Rnn, Loc),
583 New_Occurrence_Of (Rnd, Loc))));
584 end if;
586 end Build_Double_Divide_Code;
588 --------------------
589 -- Build_Multiply --
590 --------------------
592 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
593 Loc : constant Source_Ptr := Sloc (N);
594 Left_Type : constant Entity_Id := Etype (L);
595 Right_Type : constant Entity_Id := Etype (R);
596 Left_Size : Int;
597 Right_Size : Int;
598 Rsize : Int;
599 Result_Type : Entity_Id;
600 Rnode : Node_Id;
602 begin
603 -- Deal with floating-point case first
605 if Is_Floating_Point_Type (Left_Type) then
606 pragma Assert (Left_Type = Standard_Long_Long_Float);
607 pragma Assert (Right_Type = Standard_Long_Long_Float);
609 Result_Type := Standard_Long_Long_Float;
610 Rnode := Make_Op_Multiply (Loc, L, R);
612 -- Integer and fixed-point cases
614 else
615 -- An optimization. If the right operand is the literal 1, then we
616 -- can just return the left hand operand. Putting the optimization
617 -- here allows us to omit the check at the call site. Similarly, if
618 -- the left operand is the integer 1 we can return the right operand.
620 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
621 return L;
622 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
623 return R;
624 end if;
626 -- Otherwise we need to figure out the correct result type size
627 -- First figure out the effective sizes of the operands. Normally
628 -- the effective size of an operand is the RM_Size of the operand.
629 -- But a special case arises with operands whose size is known at
630 -- compile time. In this case, we can use the actual value of the
631 -- operand to get its size if it would fit in 8 or 16 bits.
633 -- Note: if both operands are known at compile time (can that
634 -- happen?) and both were equal to the power of 2, then we would
635 -- be one bit off in this test, so for the left operand, we only
636 -- go up to the power of 2 - 1. This ensures that we do not get
637 -- this anomolous case, and in practice the right operand is by
638 -- far the more likely one to be the constant.
640 Left_Size := UI_To_Int (RM_Size (Left_Type));
642 if Compile_Time_Known_Value (L) then
643 declare
644 Val : constant Uint := Expr_Value (L);
646 begin
647 if Val < Int'(2 ** 8) then
648 Left_Size := 8;
649 elsif Val < Int'(2 ** 16) then
650 Left_Size := 16;
651 end if;
652 end;
653 end if;
655 Right_Size := UI_To_Int (RM_Size (Right_Type));
657 if Compile_Time_Known_Value (R) then
658 declare
659 Val : constant Uint := Expr_Value (R);
661 begin
662 if Val <= Int'(2 ** 8) then
663 Right_Size := 8;
664 elsif Val <= Int'(2 ** 16) then
665 Right_Size := 16;
666 end if;
667 end;
668 end if;
670 -- Now the result size must be at least twice the longer of
671 -- the two sizes, to accomodate all possible results.
673 Rsize := 2 * Int'Max (Left_Size, Right_Size);
675 if Rsize <= 8 then
676 Result_Type := Standard_Integer_8;
678 elsif Rsize <= 16 then
679 Result_Type := Standard_Integer_16;
681 elsif Rsize <= 32 then
682 Result_Type := Standard_Integer_32;
684 else
685 Result_Type := Standard_Integer_64;
686 end if;
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;
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
697 Set_Etype (Rnode, Base_Type (Result_Type));
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.
703 if Is_Fixed_Point_Type (Result_Type) then
704 Set_Treat_Fixed_As_Integer (Rnode);
705 end if;
707 return Rnode;
708 end Build_Multiply;
710 ---------------
711 -- Build_Rem --
712 ---------------
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;
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);
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).
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));
739 -- Similarly, if the right size is larger, we do the remainder
740 -- operation using the right type.
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;
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
753 Set_Etype (Rnode, Base_Type (Result_Type));
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.
759 if Is_Fixed_Point_Type (Result_Type) then
760 Set_Treat_Fixed_As_Integer (Rnode);
761 end if;
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.
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;
776 return Rnode;
777 end Build_Rem;
779 -------------------------
780 -- Build_Scaled_Divide --
781 -------------------------
783 function Build_Scaled_Divide
784 (N : Node_Id;
785 X, Y, Z : Node_Id)
786 return Node_Id
788 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
789 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
790 Expr : Node_Id;
792 begin
793 -- If numerator fits in 64 bits, we can build the operations directly
794 -- without causing any intermediate overflow, so that's what we do!
796 if Int'Max (X_Size, Y_Size) <= 32 then
797 return
798 Build_Divide (N, Build_Multiply (N, X, Y), Z);
800 -- Otherwise we use the runtime routine
802 -- [Qnn : Integer_64,
803 -- Rnn : Integer_64;
804 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
805 -- Qnn]
807 else
808 declare
809 Loc : constant Source_Ptr := Sloc (N);
810 Qnn : Entity_Id;
811 Rnn : Entity_Id;
812 Code : List_Id;
814 begin
815 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
816 Insert_Actions (N, Code);
817 Expr := New_Occurrence_Of (Qnn, Loc);
819 -- Set type of result in case used elsewhere (see note at start)
821 Set_Etype (Expr, Etype (Qnn));
822 return Expr;
823 end;
824 end if;
825 end Build_Scaled_Divide;
827 ------------------------------
828 -- Build_Scaled_Divide_Code --
829 ------------------------------
831 -- If the numerator can be computed in 64-bits, we build
833 -- [Nnn : constant typ := typ (X) * typ (Y);
834 -- Dnn : constant typ := typ (Z)
835 -- Qnn : constant typ := Nnn / Dnn;
836 -- Rnn : constant typ := Nnn / Dnn;
838 -- If the numerator cannot be computed in 64 bits, we build
840 -- [Qnn : Interfaces.Integer_64;
841 -- Rnn : Interfaces.Integer_64;
842 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
844 procedure Build_Scaled_Divide_Code
845 (N : Node_Id;
846 X, Y, Z : Node_Id;
847 Qnn, Rnn : out Entity_Id;
848 Code : out List_Id)
850 Loc : constant Source_Ptr := Sloc (N);
852 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
853 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
854 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
856 QR_Siz : Int;
857 QR_Typ : Entity_Id;
859 Nnn : Entity_Id;
860 Dnn : Entity_Id;
862 Quo : Node_Id;
863 Rnd : Entity_Id;
865 begin
866 -- Find type that will allow computation of numerator
868 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
870 if QR_Siz <= 16 then
871 QR_Typ := Standard_Integer_16;
872 elsif QR_Siz <= 32 then
873 QR_Typ := Standard_Integer_32;
874 elsif QR_Siz <= 64 then
875 QR_Typ := Standard_Integer_64;
877 -- For more than 64, bits, we use the 64-bit integer defined in
878 -- Interfaces, so that it can be handled by the runtime routine
880 else
881 QR_Typ := RTE (RE_Integer_64);
882 end if;
884 -- Define quotient and remainder, and set their Etypes, so
885 -- that they can be picked up by Build_xxx routines.
887 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
888 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
890 Set_Etype (Qnn, QR_Typ);
891 Set_Etype (Rnn, QR_Typ);
893 -- Case that we can compute the numerator in 64 bits
895 if QR_Siz <= 64 then
896 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
897 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
899 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
901 Set_Etype (Nnn, QR_Typ);
902 Set_Etype (Dnn, QR_Typ);
904 Code := New_List (
905 Make_Object_Declaration (Loc,
906 Defining_Identifier => Nnn,
907 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
908 Constant_Present => True,
909 Expression =>
910 Build_Multiply (N,
911 Build_Conversion (N, QR_Typ, X),
912 Build_Conversion (N, QR_Typ, Y))),
914 Make_Object_Declaration (Loc,
915 Defining_Identifier => Dnn,
916 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
917 Constant_Present => True,
918 Expression => Build_Conversion (N, QR_Typ, Z)));
920 Quo :=
921 Build_Divide (N,
922 New_Occurrence_Of (Nnn, Loc),
923 New_Occurrence_Of (Dnn, Loc));
925 Append_To (Code,
926 Make_Object_Declaration (Loc,
927 Defining_Identifier => Qnn,
928 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
929 Constant_Present => True,
930 Expression => Quo));
932 Append_To (Code,
933 Make_Object_Declaration (Loc,
934 Defining_Identifier => Rnn,
935 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
936 Constant_Present => True,
937 Expression =>
938 Build_Rem (N,
939 New_Occurrence_Of (Nnn, Loc),
940 New_Occurrence_Of (Dnn, Loc))));
942 -- Case where numerator does not fit in 64 bits, so we have to
943 -- call the runtime routine to compute the quotient and remainder
945 else
946 Rnd := Boolean_Literals (Rounded_Result_Set (N));
948 Code := New_List (
949 Make_Object_Declaration (Loc,
950 Defining_Identifier => Qnn,
951 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
953 Make_Object_Declaration (Loc,
954 Defining_Identifier => Rnn,
955 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
957 Make_Procedure_Call_Statement (Loc,
958 Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
959 Parameter_Associations => New_List (
960 Build_Conversion (N, QR_Typ, X),
961 Build_Conversion (N, QR_Typ, Y),
962 Build_Conversion (N, QR_Typ, Z),
963 New_Occurrence_Of (Qnn, Loc),
964 New_Occurrence_Of (Rnn, Loc),
965 New_Occurrence_Of (Rnd, Loc))));
966 end if;
968 -- Set type of result, for use in caller
970 Set_Etype (Qnn, QR_Typ);
971 end Build_Scaled_Divide_Code;
973 ---------------------------
974 -- Do_Divide_Fixed_Fixed --
975 ---------------------------
977 -- We have:
979 -- (Result_Value * Result_Small) =
980 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
982 -- Result_Value = (Left_Value / Right_Value) *
983 -- (Left_Small / (Right_Small * Result_Small));
985 -- we can do the operation in integer arithmetic if this fraction is an
986 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
987 -- Otherwise the result is in the close result set and our approach is to
988 -- use floating-point to compute this close result.
990 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
991 Left : constant Node_Id := Left_Opnd (N);
992 Right : constant Node_Id := Right_Opnd (N);
993 Left_Type : constant Entity_Id := Etype (Left);
994 Right_Type : constant Entity_Id := Etype (Right);
995 Result_Type : constant Entity_Id := Etype (N);
996 Right_Small : constant Ureal := Small_Value (Right_Type);
997 Left_Small : constant Ureal := Small_Value (Left_Type);
999 Result_Small : Ureal;
1000 Frac : Ureal;
1001 Frac_Num : Uint;
1002 Frac_Den : Uint;
1003 Lit_Int : Node_Id;
1005 begin
1006 -- Rounding is required if the result is integral
1008 if Is_Integer_Type (Result_Type) then
1009 Set_Rounded_Result (N);
1010 end if;
1012 -- Get result small. If the result is an integer, treat it as though
1013 -- it had a small of 1.0, all other processing is identical.
1015 if Is_Integer_Type (Result_Type) then
1016 Result_Small := Ureal_1;
1017 else
1018 Result_Small := Small_Value (Result_Type);
1019 end if;
1021 -- Get small ratio
1023 Frac := Left_Small / (Right_Small * Result_Small);
1024 Frac_Num := Norm_Num (Frac);
1025 Frac_Den := Norm_Den (Frac);
1027 -- If the fraction is an integer, then we get the result by multiplying
1028 -- the left operand by the integer, and then dividing by the right
1029 -- operand (the order is important, if we did the divide first, we
1030 -- would lose precision).
1032 if Frac_Den = 1 then
1033 Lit_Int := Integer_Literal (N, Frac_Num);
1035 if Present (Lit_Int) then
1036 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1037 return;
1038 end if;
1040 -- If the fraction is the reciprocal of an integer, then we get the
1041 -- result by first multiplying the divisor by the integer, and then
1042 -- doing the division with the adjusted divisor.
1044 -- Note: this is much better than doing two divisions: multiplications
1045 -- are much faster than divisions (and certainly faster than rounded
1046 -- divisions), and we don't get inaccuracies from double rounding.
1048 elsif Frac_Num = 1 then
1049 Lit_Int := Integer_Literal (N, Frac_Den);
1051 if Present (Lit_Int) then
1052 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1053 return;
1054 end if;
1055 end if;
1057 -- If we fall through, we use floating-point to compute the result
1059 Set_Result (N,
1060 Build_Multiply (N,
1061 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1062 Real_Literal (N, Frac)));
1064 end Do_Divide_Fixed_Fixed;
1066 -------------------------------
1067 -- Do_Divide_Fixed_Universal --
1068 -------------------------------
1070 -- We have:
1072 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1073 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
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:
1080 -- We must factor the literal, finding an integer K:
1082 -- Lit_Value = K * Right_Small
1083 -- Right_Small = Lit_Value / K
1085 -- such that the small ratio:
1087 -- Left_Small
1088 -- ------------------------------
1089 -- (Lit_Value / K) * Result_Small
1091 -- Left_Small
1092 -- = ------------------------ * K
1093 -- Lit_Value * Result_Small
1095 -- is an integer or the reciprocal of an integer, and for
1096 -- implementation efficiency we need the smallest such K.
1098 -- First we reduce the left fraction to lowest terms
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.
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).
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);
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;
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.
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;
1132 -- Determine if literal can be rewritten successfully
1134 Frac := Left_Small / (Lit_Value * Result_Small);
1135 Frac_Num := Norm_Num (Frac);
1136 Frac_Den := Norm_Den (Frac);
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.
1142 if Frac_Num = 1 then
1143 Lit_Int := Integer_Literal (N, Frac_Den);
1145 if Present (Lit_Int) then
1146 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1147 return;
1148 end if;
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).
1157 else
1158 Lit_Int := Integer_Literal (N, Frac_Num);
1159 Lit_K := Integer_Literal (N, Frac_Den);
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;
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.
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.
1177 Set_Result (N,
1178 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1180 end Do_Divide_Fixed_Universal;
1182 -------------------------------
1183 -- Do_Divide_Universal_Fixed --
1184 -------------------------------
1186 -- We have:
1188 -- (Result_Value * Result_Small) =
1189 -- Lit_Value / (Right_Value * Right_Small)
1190 -- Result_Value =
1191 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1193 -- The result is required to be in the perfect result set if the literal
1194 -- can be factored so that the resulting small ratio is an integer or the
1195 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1196 -- analysis of these RM requirements:
1198 -- We must factor the literal, finding an integer K:
1200 -- Lit_Value = K * Left_Small
1201 -- Left_Small = Lit_Value / K
1203 -- such that the small ratio:
1205 -- (Lit_Value / K)
1206 -- --------------------------
1207 -- Right_Small * Result_Small
1209 -- Lit_Value 1
1210 -- = -------------------------- * -
1211 -- Right_Small * Result_Small K
1213 -- is an integer or the reciprocal of an integer, and for
1214 -- implementation efficiency we need the smallest such K.
1216 -- First we reduce the left fraction to lowest terms
1218 -- If denominator = 1, then for K = 1, the small ratio is an integer
1219 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1220 -- and Left_Small = Lit_Value.
1222 -- If denominator > 1, then set K to the numerator of the fraction so
1223 -- that the resulting small ratio is the reciprocal of an integer (the
1224 -- numerator value).
1226 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1227 Left : constant Node_Id := Left_Opnd (N);
1228 Right : constant Node_Id := Right_Opnd (N);
1229 Right_Type : constant Entity_Id := Etype (Right);
1230 Result_Type : constant Entity_Id := Etype (N);
1231 Right_Small : constant Ureal := Small_Value (Right_Type);
1232 Lit_Value : constant Ureal := Realval (Left);
1234 Result_Small : Ureal;
1235 Frac : Ureal;
1236 Frac_Num : Uint;
1237 Frac_Den : Uint;
1238 Lit_K : Node_Id;
1239 Lit_Int : Node_Id;
1241 begin
1242 -- Get result small. If the result is an integer, treat it as though
1243 -- it had a small of 1.0, all other processing is identical.
1245 if Is_Integer_Type (Result_Type) then
1246 Result_Small := Ureal_1;
1247 else
1248 Result_Small := Small_Value (Result_Type);
1249 end if;
1251 -- Determine if literal can be rewritten successfully
1253 Frac := Lit_Value / (Right_Small * Result_Small);
1254 Frac_Num := Norm_Num (Frac);
1255 Frac_Den := Norm_Den (Frac);
1257 -- Case where fraction is an integer (K = 1, integer = numerator). If
1258 -- this integer is not too large, this is the case where the result
1259 -- can be obtained by dividing this integer by the right operand.
1261 if Frac_Den = 1 then
1262 Lit_Int := Integer_Literal (N, Frac_Num);
1264 if Present (Lit_Int) then
1265 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1266 return;
1267 end if;
1269 -- Case where we choose K to make the fraction the reciprocal of an
1270 -- integer (K = numerator of fraction, integer = numerator of fraction).
1271 -- If both K and the integer are small enough, this is the case where
1272 -- the result can be obtained by multiplying the right operand by K
1273 -- and then dividing by the integer value. The order of the operations
1274 -- is important (if we divided first, we would lose precision).
1276 else
1277 Lit_Int := Integer_Literal (N, Frac_Den);
1278 Lit_K := Integer_Literal (N, Frac_Num);
1280 if Present (Lit_Int) and then Present (Lit_K) then
1281 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1282 return;
1283 end if;
1284 end if;
1286 -- Fall through if the literal cannot be successfully rewritten, or if
1287 -- the small ratio is out of range of integer arithmetic. In the former
1288 -- case it is fine to use floating-point to get the close result set,
1289 -- and in the latter case, it means that the result is zero or raises
1290 -- constraint error, and we can do that accurately in floating-point.
1292 -- If we end up using floating-point, then we take the right integer
1293 -- to be one, and its small to be the value of the original right real
1294 -- literal. That way, we need only one floating-point division.
1296 Set_Result (N,
1297 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1299 end Do_Divide_Universal_Fixed;
1301 -----------------------------
1302 -- Do_Multiply_Fixed_Fixed --
1303 -----------------------------
1305 -- We have:
1307 -- (Result_Value * Result_Small) =
1308 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1310 -- Result_Value = (Left_Value * Right_Value) *
1311 -- (Left_Small * Right_Small) / Result_Small;
1313 -- we can do the operation in integer arithmetic if this fraction is an
1314 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1315 -- Otherwise the result is in the close result set and our approach is to
1316 -- use floating-point to compute this close result.
1318 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1319 Left : constant Node_Id := Left_Opnd (N);
1320 Right : constant Node_Id := Right_Opnd (N);
1322 Left_Type : constant Entity_Id := Etype (Left);
1323 Right_Type : constant Entity_Id := Etype (Right);
1324 Result_Type : constant Entity_Id := Etype (N);
1325 Right_Small : constant Ureal := Small_Value (Right_Type);
1326 Left_Small : constant Ureal := Small_Value (Left_Type);
1328 Result_Small : Ureal;
1329 Frac : Ureal;
1330 Frac_Num : Uint;
1331 Frac_Den : Uint;
1332 Lit_Int : Node_Id;
1334 begin
1335 -- Get result small. If the result is an integer, treat it as though
1336 -- it had a small of 1.0, all other processing is identical.
1338 if Is_Integer_Type (Result_Type) then
1339 Result_Small := Ureal_1;
1340 else
1341 Result_Small := Small_Value (Result_Type);
1342 end if;
1344 -- Get small ratio
1346 Frac := (Left_Small * Right_Small) / Result_Small;
1347 Frac_Num := Norm_Num (Frac);
1348 Frac_Den := Norm_Den (Frac);
1350 -- If the fraction is an integer, then we get the result by multiplying
1351 -- the operands, and then multiplying the result by the integer value.
1353 if Frac_Den = 1 then
1354 Lit_Int := Integer_Literal (N, Frac_Num);
1356 if Present (Lit_Int) then
1357 Set_Result (N,
1358 Build_Multiply (N, Build_Multiply (N, Left, Right),
1359 Lit_Int));
1360 return;
1361 end if;
1363 -- If the fraction is the reciprocal of an integer, then we get the
1364 -- result by multiplying the operands, and then dividing the result by
1365 -- the integer value. The order of the operations is important, if we
1366 -- divided first, we would lose precision.
1368 elsif Frac_Num = 1 then
1369 Lit_Int := Integer_Literal (N, Frac_Den);
1371 if Present (Lit_Int) then
1372 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1373 return;
1374 end if;
1375 end if;
1377 -- If we fall through, we use floating-point to compute the result
1379 Set_Result (N,
1380 Build_Multiply (N,
1381 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1382 Real_Literal (N, Frac)));
1384 end Do_Multiply_Fixed_Fixed;
1386 ---------------------------------
1387 -- Do_Multiply_Fixed_Universal --
1388 ---------------------------------
1390 -- We have:
1392 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1393 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1395 -- The result is required to be in the perfect result set if the literal
1396 -- can be factored so that the resulting small ratio is an integer or the
1397 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1398 -- analysis of these RM requirements:
1400 -- We must factor the literal, finding an integer K:
1402 -- Lit_Value = K * Right_Small
1403 -- Right_Small = Lit_Value / K
1405 -- such that the small ratio:
1407 -- Left_Small * (Lit_Value / K)
1408 -- ----------------------------
1409 -- Result_Small
1411 -- Left_Small * Lit_Value 1
1412 -- = ---------------------- * -
1413 -- Result_Small K
1415 -- is an integer or the reciprocal of an integer, and for
1416 -- implementation efficiency we need the smallest such K.
1418 -- First we reduce the left fraction to lowest terms
1420 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1421 -- this is clearly the minimum K case, so set
1423 -- K = 1, Right_Small = Lit_Value.
1425 -- If denominator > 1, then set K to the numerator of the fraction, so
1426 -- that the resulting small ratio is the reciprocal of the integer (the
1427 -- denominator value).
1429 procedure Do_Multiply_Fixed_Universal
1430 (N : Node_Id;
1431 Left, Right : Node_Id)
1433 Left_Type : constant Entity_Id := Etype (Left);
1434 Result_Type : constant Entity_Id := Etype (N);
1435 Left_Small : constant Ureal := Small_Value (Left_Type);
1436 Lit_Value : constant Ureal := Realval (Right);
1438 Result_Small : Ureal;
1439 Frac : Ureal;
1440 Frac_Num : Uint;
1441 Frac_Den : Uint;
1442 Lit_K : Node_Id;
1443 Lit_Int : Node_Id;
1445 begin
1446 -- Get result small. If the result is an integer, treat it as though
1447 -- it had a small of 1.0, all other processing is identical.
1449 if Is_Integer_Type (Result_Type) then
1450 Result_Small := Ureal_1;
1451 else
1452 Result_Small := Small_Value (Result_Type);
1453 end if;
1455 -- Determine if literal can be rewritten successfully
1457 Frac := (Left_Small * Lit_Value) / Result_Small;
1458 Frac_Num := Norm_Num (Frac);
1459 Frac_Den := Norm_Den (Frac);
1461 -- Case where fraction is an integer (K = 1, integer = numerator). If
1462 -- this integer is not too large, this is the case where the result can
1463 -- be obtained by multiplying by this integer value.
1465 if Frac_Den = 1 then
1466 Lit_Int := Integer_Literal (N, Frac_Num);
1468 if Present (Lit_Int) then
1469 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1470 return;
1471 end if;
1473 -- Case where we choose K to make fraction the reciprocal of an integer
1474 -- (K = numerator of fraction, integer = denominator of fraction). If
1475 -- both K and the denominator are small enough, this is the case where
1476 -- the result can be obtained by first multiplying by K, and then
1477 -- dividing by the integer value.
1479 else
1480 Lit_Int := Integer_Literal (N, Frac_Den);
1481 Lit_K := Integer_Literal (N, Frac_Num);
1483 if Present (Lit_Int) and then Present (Lit_K) then
1484 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1485 return;
1486 end if;
1487 end if;
1489 -- Fall through if the literal cannot be successfully rewritten, or if
1490 -- the small ratio is out of range of integer arithmetic. In the former
1491 -- case it is fine to use floating-point to get the close result set,
1492 -- and in the latter case, it means that the result is zero or raises
1493 -- constraint error, and we can do that accurately in floating-point.
1495 -- If we end up using floating-point, then we take the right integer
1496 -- to be one, and its small to be the value of the original right real
1497 -- literal. That way, we need only one floating-point multiplication.
1499 Set_Result (N,
1500 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1502 end Do_Multiply_Fixed_Universal;
1504 ---------------------------------
1505 -- Expand_Convert_Fixed_Static --
1506 ---------------------------------
1508 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1509 begin
1510 Rewrite (N,
1511 Convert_To (Etype (N),
1512 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1513 Analyze_And_Resolve (N);
1514 end Expand_Convert_Fixed_Static;
1516 -----------------------------------
1517 -- Expand_Convert_Fixed_To_Fixed --
1518 -----------------------------------
1520 -- We have:
1522 -- Result_Value * Result_Small = Source_Value * Source_Small
1523 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1525 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1526 -- integer, then the perfect result set is obtained by a single integer
1527 -- multiplication.
1529 -- If the small ratio is the reciprocal of a sufficiently small integer,
1530 -- then the perfect result set is obtained by a single integer division.
1532 -- In other cases, we obtain the close result set by calculating the
1533 -- result in floating-point.
1535 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1536 Rng_Check : constant Boolean := Do_Range_Check (N);
1537 Expr : constant Node_Id := Expression (N);
1538 Result_Type : constant Entity_Id := Etype (N);
1539 Source_Type : constant Entity_Id := Etype (Expr);
1540 Small_Ratio : Ureal;
1541 Ratio_Num : Uint;
1542 Ratio_Den : Uint;
1543 Lit : Node_Id;
1545 begin
1546 if Is_OK_Static_Expression (Expr) then
1547 Expand_Convert_Fixed_Static (N);
1548 return;
1549 end if;
1551 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1552 Ratio_Num := Norm_Num (Small_Ratio);
1553 Ratio_Den := Norm_Den (Small_Ratio);
1555 if Ratio_Den = 1 then
1557 if Ratio_Num = 1 then
1558 Set_Result (N, Expr);
1559 return;
1561 else
1562 Lit := Integer_Literal (N, Ratio_Num);
1564 if Present (Lit) then
1565 Set_Result (N, Build_Multiply (N, Expr, Lit));
1566 return;
1567 end if;
1568 end if;
1570 elsif Ratio_Num = 1 then
1571 Lit := Integer_Literal (N, Ratio_Den);
1573 if Present (Lit) then
1574 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1575 return;
1576 end if;
1577 end if;
1579 -- Fall through to use floating-point for the close result set case
1580 -- either as a result of the small ratio not being an integer or the
1581 -- reciprocal of an integer, or if the integer is out of range.
1583 Set_Result (N,
1584 Build_Multiply (N,
1585 Fpt_Value (Expr),
1586 Real_Literal (N, Small_Ratio)),
1587 Rng_Check);
1589 end Expand_Convert_Fixed_To_Fixed;
1591 -----------------------------------
1592 -- Expand_Convert_Fixed_To_Float --
1593 -----------------------------------
1595 -- If the small of the fixed type is 1.0, then we simply convert the
1596 -- integer value directly to the target floating-point type, otherwise
1597 -- we first have to multiply by the small, in Long_Long_Float, and then
1598 -- convert the result to the target floating-point type.
1600 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1601 Rng_Check : constant Boolean := Do_Range_Check (N);
1602 Expr : constant Node_Id := Expression (N);
1603 Source_Type : constant Entity_Id := Etype (Expr);
1604 Small : constant Ureal := Small_Value (Source_Type);
1606 begin
1607 if Is_OK_Static_Expression (Expr) then
1608 Expand_Convert_Fixed_Static (N);
1609 return;
1610 end if;
1612 if Small = Ureal_1 then
1613 Set_Result (N, Expr);
1615 else
1616 Set_Result (N,
1617 Build_Multiply (N,
1618 Fpt_Value (Expr),
1619 Real_Literal (N, Small)),
1620 Rng_Check);
1621 end if;
1622 end Expand_Convert_Fixed_To_Float;
1624 -------------------------------------
1625 -- Expand_Convert_Fixed_To_Integer --
1626 -------------------------------------
1628 -- We have:
1630 -- Result_Value = Source_Value * Source_Small
1632 -- If the small value is a sufficiently small integer, then the perfect
1633 -- result set is obtained by a single integer multiplication.
1635 -- If the small value is the reciprocal of a sufficiently small integer,
1636 -- then the perfect result set is obtained by a single integer division.
1638 -- In other cases, we obtain the close result set by calculating the
1639 -- result in floating-point.
1641 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1642 Rng_Check : constant Boolean := Do_Range_Check (N);
1643 Expr : constant Node_Id := Expression (N);
1644 Source_Type : constant Entity_Id := Etype (Expr);
1645 Small : constant Ureal := Small_Value (Source_Type);
1646 Small_Num : constant Uint := Norm_Num (Small);
1647 Small_Den : constant Uint := Norm_Den (Small);
1648 Lit : Node_Id;
1650 begin
1651 if Is_OK_Static_Expression (Expr) then
1652 Expand_Convert_Fixed_Static (N);
1653 return;
1654 end if;
1656 if Small_Den = 1 then
1657 Lit := Integer_Literal (N, Small_Num);
1659 if Present (Lit) then
1660 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1661 return;
1662 end if;
1664 elsif Small_Num = 1 then
1665 Lit := Integer_Literal (N, Small_Den);
1667 if Present (Lit) then
1668 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1669 return;
1670 end if;
1671 end if;
1673 -- Fall through to use floating-point for the close result set case
1674 -- either as a result of the small value not being an integer or the
1675 -- reciprocal of an integer, or if the integer is out of range.
1677 Set_Result (N,
1678 Build_Multiply (N,
1679 Fpt_Value (Expr),
1680 Real_Literal (N, Small)),
1681 Rng_Check);
1683 end Expand_Convert_Fixed_To_Integer;
1685 -----------------------------------
1686 -- Expand_Convert_Float_To_Fixed --
1687 -----------------------------------
1689 -- We have
1691 -- Result_Value * Result_Small = Operand_Value
1693 -- so compute:
1695 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1697 -- We do the small scaling in floating-point, and we do a multiplication
1698 -- rather than a division, since it is accurate enough for the perfect
1699 -- result cases, and faster.
1701 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1702 Rng_Check : constant Boolean := Do_Range_Check (N);
1703 Expr : constant Node_Id := Expression (N);
1704 Result_Type : constant Entity_Id := Etype (N);
1705 Small : constant Ureal := Small_Value (Result_Type);
1707 begin
1708 -- Optimize small = 1, where we can avoid the multiply completely
1710 if Small = Ureal_1 then
1711 Set_Result (N, Expr, Rng_Check);
1713 -- Normal case where multiply is required
1715 else
1716 Set_Result (N,
1717 Build_Multiply (N,
1718 Fpt_Value (Expr),
1719 Real_Literal (N, Ureal_1 / Small)),
1720 Rng_Check);
1721 end if;
1722 end Expand_Convert_Float_To_Fixed;
1724 -------------------------------------
1725 -- Expand_Convert_Integer_To_Fixed --
1726 -------------------------------------
1728 -- We have
1730 -- Result_Value * Result_Small = Operand_Value
1731 -- Result_Value = Operand_Value / Result_Small
1733 -- If the small value is a sufficiently small integer, then the perfect
1734 -- result set is obtained by a single integer division.
1736 -- If the small value is the reciprocal of a sufficiently small integer,
1737 -- the perfect result set is obtained by a single integer multiplication.
1739 -- In other cases, we obtain the close result set by calculating the
1740 -- result in floating-point using a multiplication by the reciprocal
1741 -- of the Result_Small.
1743 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1744 Rng_Check : constant Boolean := Do_Range_Check (N);
1745 Expr : constant Node_Id := Expression (N);
1746 Result_Type : constant Entity_Id := Etype (N);
1747 Small : constant Ureal := Small_Value (Result_Type);
1748 Small_Num : constant Uint := Norm_Num (Small);
1749 Small_Den : constant Uint := Norm_Den (Small);
1750 Lit : Node_Id;
1752 begin
1753 if Small_Den = 1 then
1754 Lit := Integer_Literal (N, Small_Num);
1756 if Present (Lit) then
1757 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1758 return;
1759 end if;
1761 elsif Small_Num = 1 then
1762 Lit := Integer_Literal (N, Small_Den);
1764 if Present (Lit) then
1765 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1766 return;
1767 end if;
1768 end if;
1770 -- Fall through to use floating-point for the close result set case
1771 -- either as a result of the small value not being an integer or the
1772 -- reciprocal of an integer, or if the integer is out of range.
1774 Set_Result (N,
1775 Build_Multiply (N,
1776 Fpt_Value (Expr),
1777 Real_Literal (N, Ureal_1 / Small)),
1778 Rng_Check);
1780 end Expand_Convert_Integer_To_Fixed;
1782 --------------------------------
1783 -- Expand_Decimal_Divide_Call --
1784 --------------------------------
1786 -- We have four operands
1788 -- Dividend
1789 -- Divisor
1790 -- Quotient
1791 -- Remainder
1793 -- All of which are decimal types, and which thus have associated
1794 -- decimal scales.
1796 -- Computing the quotient is a similar problem to that faced by the
1797 -- normal fixed-point division, except that it is simpler, because
1798 -- we always have compatible smalls.
1800 -- Quotient = (Dividend / Divisor) * 10**q
1802 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1803 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1805 -- For q >= 0, we compute
1807 -- Numerator := Dividend * 10 ** q
1808 -- Denominator := Divisor
1809 -- Quotient := Numerator / Denominator
1811 -- For q < 0, we compute
1813 -- Numerator := Dividend
1814 -- Denominator := Divisor * 10 ** q
1815 -- Quotient := Numerator / Denominator
1817 -- Both these divisions are done in truncated mode, and the remainder
1818 -- from these divisions is used to compute the result Remainder. This
1819 -- remainder has the effective scale of the numerator of the division,
1821 -- For q >= 0, the remainder scale is Dividend'Scale + q
1822 -- For q < 0, the remainder scale is Dividend'Scale
1824 -- The result Remainder is then computed by a normal truncating decimal
1825 -- conversion from this scale to the scale of the remainder, i.e. by a
1826 -- division or multiplication by the appropriate power of 10.
1828 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1829 Loc : constant Source_Ptr := Sloc (N);
1831 Dividend : Node_Id := First_Actual (N);
1832 Divisor : Node_Id := Next_Actual (Dividend);
1833 Quotient : Node_Id := Next_Actual (Divisor);
1834 Remainder : Node_Id := Next_Actual (Quotient);
1836 Dividend_Type : constant Entity_Id := Etype (Dividend);
1837 Divisor_Type : constant Entity_Id := Etype (Divisor);
1838 Quotient_Type : constant Entity_Id := Etype (Quotient);
1839 Remainder_Type : constant Entity_Id := Etype (Remainder);
1841 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1842 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1843 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1844 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1846 Q : Uint;
1847 Numerator_Scale : Uint;
1848 Stmts : List_Id;
1849 Qnn : Entity_Id;
1850 Rnn : Entity_Id;
1851 Computed_Remainder : Node_Id;
1852 Adjusted_Remainder : Node_Id;
1853 Scale_Adjust : Uint;
1855 begin
1856 -- Relocate the operands, since they are now list elements, and we
1857 -- need to reference them separately as operands in the expanded code.
1859 Dividend := Relocate_Node (Dividend);
1860 Divisor := Relocate_Node (Divisor);
1861 Quotient := Relocate_Node (Quotient);
1862 Remainder := Relocate_Node (Remainder);
1864 -- Now compute Q, the adjustment scale
1866 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1868 -- If Q is non-negative then we need a scaled divide
1870 if Q >= 0 then
1871 Build_Scaled_Divide_Code
1873 Dividend,
1874 Integer_Literal (N, Uint_10 ** Q),
1875 Divisor,
1876 Qnn, Rnn, Stmts);
1878 Numerator_Scale := Dividend_Scale + Q;
1880 -- If Q is negative, then we need a double divide
1882 else
1883 Build_Double_Divide_Code
1885 Dividend,
1886 Divisor,
1887 Integer_Literal (N, Uint_10 ** (-Q)),
1888 Qnn, Rnn, Stmts);
1890 Numerator_Scale := Dividend_Scale;
1891 end if;
1893 -- Add statement to set quotient value
1895 -- Quotient := quotient-type!(Qnn);
1897 Append_To (Stmts,
1898 Make_Assignment_Statement (Loc,
1899 Name => Quotient,
1900 Expression =>
1901 Unchecked_Convert_To (Quotient_Type,
1902 Build_Conversion (N, Quotient_Type,
1903 New_Occurrence_Of (Qnn, Loc)))));
1905 -- Now we need to deal with computing and setting the remainder. The
1906 -- scale of the remainder is in Numerator_Scale, and the desired
1907 -- scale is the scale of the given Remainder argument. There are
1908 -- three cases:
1910 -- Numerator_Scale > Remainder_Scale
1912 -- in this case, there are extra digits in the computed remainder
1913 -- which must be eliminated by an extra division:
1915 -- computed-remainder := Numerator rem Denominator
1916 -- scale_adjust = Numerator_Scale - Remainder_Scale
1917 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1919 -- Numerator_Scale = Remainder_Scale
1921 -- in this case, the we have the remainder we need
1923 -- computed-remainder := Numerator rem Denominator
1924 -- adjusted-remainder := computed-remainder
1926 -- Numerator_Scale < Remainder_Scale
1928 -- in this case, we have insufficient digits in the computed
1929 -- remainder, which must be eliminated by an extra multiply
1931 -- computed-remainder := Numerator rem Denominator
1932 -- scale_adjust = Remainder_Scale - Numerator_Scale
1933 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1935 -- Finally we assign the adjusted-remainder to the result Remainder
1936 -- with conversions to get the proper fixed-point type representation.
1938 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
1940 if Numerator_Scale > Remainder_Scale then
1941 Scale_Adjust := Numerator_Scale - Remainder_Scale;
1942 Adjusted_Remainder :=
1943 Build_Divide
1944 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1946 elsif Numerator_Scale = Remainder_Scale then
1947 Adjusted_Remainder := Computed_Remainder;
1949 else -- Numerator_Scale < Remainder_Scale
1950 Scale_Adjust := Remainder_Scale - Numerator_Scale;
1951 Adjusted_Remainder :=
1952 Build_Multiply
1953 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1954 end if;
1956 -- Assignment of remainder result
1958 Append_To (Stmts,
1959 Make_Assignment_Statement (Loc,
1960 Name => Remainder,
1961 Expression =>
1962 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
1964 -- Final step is to rewrite the call with a block containing the
1965 -- above sequence of constructed statements for the divide operation.
1967 Rewrite (N,
1968 Make_Block_Statement (Loc,
1969 Handled_Statement_Sequence =>
1970 Make_Handled_Sequence_Of_Statements (Loc,
1971 Statements => Stmts)));
1973 Analyze (N);
1975 end Expand_Decimal_Divide_Call;
1977 -----------------------------------------------
1978 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1979 -----------------------------------------------
1981 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
1982 Left : constant Node_Id := Left_Opnd (N);
1983 Right : constant Node_Id := Right_Opnd (N);
1985 begin
1986 -- Suppress expansion of a fixed-by-fixed division if the
1987 -- operation is supported directly by the target.
1989 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
1990 return;
1991 end if;
1993 if Etype (Left) = Universal_Real then
1994 Do_Divide_Universal_Fixed (N);
1996 elsif Etype (Right) = Universal_Real then
1997 Do_Divide_Fixed_Universal (N);
1999 else
2000 Do_Divide_Fixed_Fixed (N);
2001 end if;
2003 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
2005 -----------------------------------------------
2006 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
2007 -----------------------------------------------
2009 -- The division is done in long_long_float, and the result is multiplied
2010 -- by the small ratio, which is Small (Right) / Small (Left). Special
2011 -- treatment is required for universal operands, which represent their
2012 -- own value and do not require conversion.
2014 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2015 Left : constant Node_Id := Left_Opnd (N);
2016 Right : constant Node_Id := Right_Opnd (N);
2018 Left_Type : constant Entity_Id := Etype (Left);
2019 Right_Type : constant Entity_Id := Etype (Right);
2021 begin
2022 -- Case of left operand is universal real, the result we want is:
2024 -- Left_Value / (Right_Value * Right_Small)
2026 -- so we compute this as:
2028 -- (Left_Value / Right_Small) / Right_Value
2030 if Left_Type = Universal_Real then
2031 Set_Result (N,
2032 Build_Divide (N,
2033 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2034 Fpt_Value (Right)));
2036 -- Case of right operand is universal real, the result we want is
2038 -- (Left_Value * Left_Small) / Right_Value
2040 -- so we compute this as:
2042 -- Left_Value * (Left_Small / Right_Value)
2044 -- Note we invert to a multiplication since usually floating-point
2045 -- multiplication is much faster than floating-point division.
2047 elsif Right_Type = Universal_Real then
2048 Set_Result (N,
2049 Build_Multiply (N,
2050 Fpt_Value (Left),
2051 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2053 -- Both operands are fixed, so the value we want is
2055 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2057 -- which we compute as:
2059 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2061 else
2062 Set_Result (N,
2063 Build_Multiply (N,
2064 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2065 Real_Literal (N,
2066 Small_Value (Left_Type) / Small_Value (Right_Type))));
2067 end if;
2069 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2071 -------------------------------------------------
2072 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2073 -------------------------------------------------
2075 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2076 Left : constant Node_Id := Left_Opnd (N);
2077 Right : constant Node_Id := Right_Opnd (N);
2079 begin
2080 if Etype (Left) = Universal_Real then
2081 Do_Divide_Universal_Fixed (N);
2083 elsif Etype (Right) = Universal_Real then
2084 Do_Divide_Fixed_Universal (N);
2086 else
2087 Do_Divide_Fixed_Fixed (N);
2088 end if;
2090 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2092 -------------------------------------------------
2093 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2094 -------------------------------------------------
2096 -- Since the operand and result fixed-point type is the same, this is
2097 -- a straight divide by the right operand, the small can be ignored.
2099 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2100 Left : constant Node_Id := Left_Opnd (N);
2101 Right : constant Node_Id := Right_Opnd (N);
2103 begin
2104 Set_Result (N, Build_Divide (N, Left, Right));
2105 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2107 -------------------------------------------------
2108 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2109 -------------------------------------------------
2111 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2112 Left : constant Node_Id := Left_Opnd (N);
2113 Right : constant Node_Id := Right_Opnd (N);
2115 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2116 -- The operand may be a non-static universal value, such an
2117 -- exponentiation with a non-static exponent. In that case, treat
2118 -- as a fixed * fixed multiplication, and convert the argument to
2119 -- the target fixed type.
2121 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2122 Loc : constant Source_Ptr := Sloc (N);
2124 begin
2125 Rewrite (Opnd,
2126 Make_Type_Conversion (Loc,
2127 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2128 Expression => Expression (Opnd)));
2129 Analyze_And_Resolve (Opnd, Etype (N));
2130 end Rewrite_Non_Static_Universal;
2132 begin
2133 -- Suppress expansion of a fixed-by-fixed multiplication if the
2134 -- operation is supported directly by the target.
2136 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
2137 return;
2138 end if;
2140 if Etype (Left) = Universal_Real then
2141 if Nkind (Left) = N_Real_Literal then
2142 Do_Multiply_Fixed_Universal (N, Right, Left);
2144 elsif Nkind (Left) = N_Type_Conversion then
2145 Rewrite_Non_Static_Universal (Left);
2146 Do_Multiply_Fixed_Fixed (N);
2147 end if;
2149 elsif Etype (Right) = Universal_Real then
2150 if Nkind (Right) = N_Real_Literal then
2151 Do_Multiply_Fixed_Universal (N, Left, Right);
2153 elsif Nkind (Right) = N_Type_Conversion then
2154 Rewrite_Non_Static_Universal (Right);
2155 Do_Multiply_Fixed_Fixed (N);
2156 end if;
2158 else
2159 Do_Multiply_Fixed_Fixed (N);
2160 end if;
2162 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2164 -------------------------------------------------
2165 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2166 -------------------------------------------------
2168 -- The multiply is done in long_long_float, and the result is multiplied
2169 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2170 -- Special treatment is required for universal operands.
2172 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2173 Left : constant Node_Id := Left_Opnd (N);
2174 Right : constant Node_Id := Right_Opnd (N);
2176 Left_Type : constant Entity_Id := Etype (Left);
2177 Right_Type : constant Entity_Id := Etype (Right);
2179 begin
2180 -- Case of left operand is universal real, the result we want is
2182 -- Left_Value * (Right_Value * Right_Small)
2184 -- so we compute this as:
2186 -- (Left_Value * Right_Small) * Right_Value;
2188 if Left_Type = Universal_Real then
2189 Set_Result (N,
2190 Build_Multiply (N,
2191 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2192 Fpt_Value (Right)));
2194 -- Case of right operand is universal real, the result we want is
2196 -- (Left_Value * Left_Small) * Right_Value
2198 -- so we compute this as:
2200 -- Left_Value * (Left_Small * Right_Value)
2202 elsif Right_Type = Universal_Real then
2203 Set_Result (N,
2204 Build_Multiply (N,
2205 Fpt_Value (Left),
2206 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2208 -- Both operands are fixed, so the value we want is
2210 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2212 -- which we compute as:
2214 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2216 else
2217 Set_Result (N,
2218 Build_Multiply (N,
2219 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2220 Real_Literal (N,
2221 Small_Value (Right_Type) * Small_Value (Left_Type))));
2222 end if;
2224 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2226 ---------------------------------------------------
2227 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2228 ---------------------------------------------------
2230 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2231 Left : constant Node_Id := Left_Opnd (N);
2232 Right : constant Node_Id := Right_Opnd (N);
2234 begin
2235 if Etype (Left) = Universal_Real then
2236 Do_Multiply_Fixed_Universal (N, Right, Left);
2238 elsif Etype (Right) = Universal_Real then
2239 Do_Multiply_Fixed_Universal (N, Left, Right);
2241 else
2242 Do_Multiply_Fixed_Fixed (N);
2243 end if;
2245 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2247 ---------------------------------------------------
2248 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2249 ---------------------------------------------------
2251 -- Since the operand and result fixed-point type is the same, this is
2252 -- a straight multiply by the right operand, the small can be ignored.
2254 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2255 begin
2256 Set_Result (N,
2257 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2258 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2260 ---------------------------------------------------
2261 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2262 ---------------------------------------------------
2264 -- Since the operand and result fixed-point type is the same, this is
2265 -- a straight multiply by the right operand, the small can be ignored.
2267 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2268 begin
2269 Set_Result (N,
2270 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2271 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2273 ---------------
2274 -- Fpt_Value --
2275 ---------------
2277 function Fpt_Value (N : Node_Id) return Node_Id is
2278 Typ : constant Entity_Id := Etype (N);
2280 begin
2281 if Is_Integer_Type (Typ)
2282 or else Is_Floating_Point_Type (Typ)
2283 then
2284 return
2285 Build_Conversion
2286 (N, Standard_Long_Long_Float, N);
2288 -- Fixed-point case, must get integer value first
2290 else
2291 return
2292 Build_Conversion (N, Standard_Long_Long_Float, N);
2293 end if;
2295 end Fpt_Value;
2297 ---------------------
2298 -- Integer_Literal --
2299 ---------------------
2301 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is
2302 T : Entity_Id;
2303 L : Node_Id;
2305 begin
2306 if V < Uint_2 ** 7 then
2307 T := Standard_Integer_8;
2309 elsif V < Uint_2 ** 15 then
2310 T := Standard_Integer_16;
2312 elsif V < Uint_2 ** 31 then
2313 T := Standard_Integer_32;
2315 elsif V < Uint_2 ** 63 then
2316 T := Standard_Integer_64;
2318 else
2319 return Empty;
2320 end if;
2322 L := Make_Integer_Literal (Sloc (N), V);
2324 -- Set type of result in case used elsewhere (see note at start)
2326 Set_Etype (L, T);
2327 Set_Is_Static_Expression (L);
2329 -- We really need to set Analyzed here because we may be creating a
2330 -- very strange beast, namely an integer literal typed as fixed-point
2331 -- and the analyzer won't like that. Probably we should allow the
2332 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2333 -- and teach the analyzer how to handle them ???
2335 Set_Analyzed (L);
2336 return L;
2337 end Integer_Literal;
2339 ------------------
2340 -- Real_Literal --
2341 ------------------
2343 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2344 L : Node_Id;
2346 begin
2347 L := Make_Real_Literal (Sloc (N), V);
2349 -- Set type of result in case used elsewhere (see note at start)
2351 Set_Etype (L, Standard_Long_Long_Float);
2352 return L;
2353 end Real_Literal;
2355 ------------------------
2356 -- Rounded_Result_Set --
2357 ------------------------
2359 function Rounded_Result_Set (N : Node_Id) return Boolean is
2360 K : constant Node_Kind := Nkind (N);
2362 begin
2363 if (K = N_Type_Conversion or else
2364 K = N_Op_Divide or else
2365 K = N_Op_Multiply)
2366 and then Rounded_Result (N)
2367 then
2368 return True;
2369 else
2370 return False;
2371 end if;
2372 end Rounded_Result_Set;
2374 ----------------
2375 -- Set_Result --
2376 ----------------
2378 procedure Set_Result
2379 (N : Node_Id;
2380 Expr : Node_Id;
2381 Rchk : Boolean := False)
2383 Cnode : Node_Id;
2385 Expr_Type : constant Entity_Id := Etype (Expr);
2386 Result_Type : constant Entity_Id := Etype (N);
2388 begin
2389 -- No conversion required if types match and no range check
2391 if Result_Type = Expr_Type and then not Rchk then
2392 Cnode := Expr;
2394 -- Else perform required conversion
2396 else
2397 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
2398 end if;
2400 Rewrite (N, Cnode);
2401 Analyze_And_Resolve (N, Result_Type);
2403 end Set_Result;
2405 end Exp_Fixd;