* c-decl.c (duplicate_decls): Conditionalize DECL_SAVED_TREE copy.
[official-gcc.git] / gcc / ada / exp_fixd.adb
blob0eba7e2673efe8f1eb2f0f810542f070734941e4
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ F I X D --
6 -- --
7 -- B o d y --
8 -- --
9 -- $Revision$
10 -- --
11 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
12 -- --
13 -- GNAT is free software; you can redistribute it and/or modify it under --
14 -- terms of the GNU General Public License as published by the Free Soft- --
15 -- ware Foundation; either version 2, or (at your option) any later ver- --
16 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19 -- for more details. You should have received a copy of the GNU General --
20 -- Public License distributed with GNAT; see file COPYING. If not, write --
21 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22 -- MA 02111-1307, USA. --
23 -- --
24 -- GNAT was originally developed by the GNAT team at New York University. --
25 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
26 -- --
27 ------------------------------------------------------------------------------
29 with Atree; use Atree;
30 with Checks; use Checks;
31 with Einfo; use Einfo;
32 with Exp_Util; use Exp_Util;
33 with Nlists; use Nlists;
34 with Nmake; use Nmake;
35 with Restrict; use Restrict;
36 with Rtsfind; use Rtsfind;
37 with Sem; use Sem;
38 with Sem_Eval; use Sem_Eval;
39 with Sem_Res; use Sem_Res;
40 with Sem_Util; use Sem_Util;
41 with Sinfo; use Sinfo;
42 with Stand; use Stand;
43 with Tbuild; use Tbuild;
44 with Ttypes; use Ttypes;
45 with Uintp; use Uintp;
46 with Urealp; use Urealp;
48 package body Exp_Fixd is
50 -----------------------
51 -- Local Subprograms --
52 -----------------------
54 -- General note; in this unit, a number of routines are driven by the
55 -- types (Etype) of their operands. Since we are dealing with unanalyzed
56 -- expressions as they are constructed, the Etypes would not normally be
57 -- set, but the construction routines that we use in this unit do in fact
58 -- set the Etype values correctly. In addition, setting the Etype ensures
59 -- that the analyzer does not try to redetermine the type when the node
60 -- is analyzed (which would be wrong, since in the case where we set the
61 -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
62 -- still dealing with a normal fixed-point operation and mess it up).
64 function Build_Conversion
65 (N : Node_Id;
66 Typ : Entity_Id;
67 Expr : Node_Id;
68 Rchk : Boolean := False)
69 return Node_Id;
70 -- Build an expression that converts the expression Expr to type Typ,
71 -- taking the source location from Sloc (N). If the conversions involve
72 -- fixed-point types, then the Conversion_OK flag will be set so that the
73 -- resulting conversions do not get re-expanded. On return the resulting
74 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
75 -- in the resulting conversion node.
77 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
78 -- Builds an N_Op_Divide node from the given left and right operand
79 -- expressions, using the source location from Sloc (N). The operands
80 -- are either both Long_Long_Float, in which case Build_Divide differs
81 -- from Make_Op_Divide only in that the Etype of the resulting node is
82 -- set (to Long_Long_Float), or they can be integer types. In this case
83 -- the integer types need not be the same, and Build_Divide converts
84 -- the operand with the smaller sized type to match the type of the
85 -- other operand and sets this as the result type. The Rounded_Result
86 -- flag of the result in this case is set from the Rounded_Result flag
87 -- of node N. On return, the resulting node is analyzed, and has its
88 -- Etype set.
90 function Build_Double_Divide
91 (N : Node_Id;
92 X, Y, Z : Node_Id)
93 return Node_Id;
94 -- Returns a node corresponding to the value X/(Y*Z) using the source
95 -- location from Sloc (N). The division is rounded if the Rounded_Result
96 -- flag of N is set. The integer types of X, Y, Z may be different. On
97 -- return the resulting node is analyzed, and has its Etype set.
99 procedure Build_Double_Divide_Code
100 (N : Node_Id;
101 X, Y, Z : Node_Id;
102 Qnn, Rnn : out Entity_Id;
103 Code : out List_Id);
104 -- Generates a sequence of code for determining the quotient and remainder
105 -- of the division X/(Y*Z), using the source location from Sloc (N).
106 -- Entities of appropriate types are allocated for the quotient and
107 -- remainder and returned in Qnn and Rnn. The result is rounded if
108 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
109 -- are appropriately set on return.
111 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
112 -- Builds an N_Op_Multiply node from the given left and right operand
113 -- expressions, using the source location from Sloc (N). The operands
114 -- are either both Long_Long_Float, in which case Build_Divide differs
115 -- from Make_Op_Multiply only in that the Etype of the resulting node is
116 -- set (to Long_Long_Float), or they can be integer types. In this case
117 -- the integer types need not be the same, and Build_Multiply chooses
118 -- a type long enough to hold the product (i.e. twice the size of the
119 -- longer of the two operand types), and both operands are converted
120 -- to this type. The Etype of the result is also set to this value.
121 -- However, the result can never overflow Integer_64, so this is the
122 -- largest type that is ever generated. On return, the resulting node
123 -- is analyzed and has its Etype set.
125 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
126 -- Builds an N_Op_Rem node from the given left and right operand
127 -- expressions, using the source location from Sloc (N). The operands
128 -- are both integer types, which need not be the same. Build_Rem
129 -- converts the operand with the smaller sized type to match the type
130 -- of the other operand and sets this as the result type. The result
131 -- is never rounded (rem operations cannot be rounded in any case!)
132 -- On return, the resulting node is analyzed and has its Etype set.
134 function Build_Scaled_Divide
135 (N : Node_Id;
136 X, Y, Z : Node_Id)
137 return Node_Id;
138 -- Returns a node corresponding to the value X*Y/Z using the source
139 -- location from Sloc (N). The division is rounded if the Rounded_Result
140 -- flag of N is set. The integer types of X, Y, Z may be different. On
141 -- return the resulting node is analyzed and has is Etype set.
143 procedure Build_Scaled_Divide_Code
144 (N : Node_Id;
145 X, Y, Z : Node_Id;
146 Qnn, Rnn : out Entity_Id;
147 Code : out List_Id);
148 -- Generates a sequence of code for determining the quotient and remainder
149 -- of the division X*Y/Z, using the source location from Sloc (N). Entities
150 -- of appropriate types are allocated for the quotient and remainder and
151 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
152 -- The division is rounded if the Rounded_Result flag of N is set. The
153 -- Etype fields of Qnn and Rnn are appropriately set on return.
155 procedure Do_Divide_Fixed_Fixed (N : Node_Id);
156 -- Handles expansion of divide for case of two fixed-point operands
157 -- (neither of them universal), with an integer or fixed-point result.
158 -- N is the N_Op_Divide node to be expanded.
160 procedure Do_Divide_Fixed_Universal (N : Node_Id);
161 -- Handles expansion of divide for case of a fixed-point operand divided
162 -- by a universal real operand, with an integer or fixed-point result. N
163 -- is the N_Op_Divide node to be expanded.
165 procedure Do_Divide_Universal_Fixed (N : Node_Id);
166 -- Handles expansion of divide for case of a universal real operand
167 -- divided by a fixed-point operand, with an integer or fixed-point
168 -- result. N is the N_Op_Divide node to be expanded.
170 procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
171 -- Handles expansion of multiply for case of two fixed-point operands
172 -- (neither of them universal), with an integer or fixed-point result.
173 -- N is the N_Op_Multiply node to be expanded.
175 procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
176 -- Handles expansion of multiply for case of a fixed-point operand
177 -- multiplied by a universal real operand, with an integer or fixed-
178 -- point result. N is the N_Op_Multiply node to be expanded, and
179 -- Left, Right are the operands (which may have been switched).
181 procedure Expand_Convert_Fixed_Static (N : Node_Id);
182 -- This routine is called where the node N is a conversion of a literal
183 -- or other static expression of a fixed-point type to some other type.
184 -- In such cases, we simply rewrite the operand as a real literal and
185 -- reanalyze. This avoids problems which would otherwise result from
186 -- attempting to build and fold expressions involving constants.
188 function Fpt_Value (N : Node_Id) return Node_Id;
189 -- Given an operand of fixed-point operation, return an expression that
190 -- represents the corresponding Long_Long_Float value. The expression
191 -- can be of integer type, floating-point type, or fixed-point type.
192 -- The expression returned is neither analyzed and resolved. The Etype
193 -- of the result is properly set (to Long_Long_Float).
195 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id;
196 -- Given a non-negative universal integer value, build a typed integer
197 -- literal node, using the smallest applicable standard integer type. If
198 -- the value exceeds 2**63-1, the largest value allowed for perfect result
199 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
200 -- node N provides the Sloc value for the constructed literal. The Etype
201 -- of the resulting literal is correctly set, and it is marked as analyzed.
203 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
204 -- Build a real literal node from the given value, the Etype of the
205 -- returned node is set to Long_Long_Float, since all floating-point
206 -- arithmetic operations that we construct use Long_Long_Float
208 function Rounded_Result_Set (N : Node_Id) return Boolean;
209 -- Returns True if N is a node that contains the Rounded_Result flag
210 -- and if the flag is true.
212 procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
213 -- N is the node for the current conversion, division or multiplication
214 -- operation, and Expr is an expression representing the result. Expr
215 -- may be of floating-point or integer type. If the operation result
216 -- is fixed-point, then the value of Expr is in units of small of the
217 -- result type (i.e. small's have already been dealt with). The result
218 -- of the call is to replace N by an appropriate conversion to the
219 -- result type, dealing with rounding for the decimal types case. The
220 -- node is then analyzed and resolved using the result type. If Rchk
221 -- is True, then Do_Range_Check is set in the resulting conversion.
223 ----------------------
224 -- Build_Conversion --
225 ----------------------
227 function Build_Conversion
228 (N : Node_Id;
229 Typ : Entity_Id;
230 Expr : Node_Id;
231 Rchk : Boolean := False)
232 return Node_Id
234 Loc : constant Source_Ptr := Sloc (N);
235 Result : Node_Id;
236 Rcheck : Boolean := Rchk;
238 begin
239 -- A special case, if the expression is an integer literal and the
240 -- target type is an integer type, then just retype the integer
241 -- literal to the desired target type. Don't do this if we need
242 -- a range check.
244 if Nkind (Expr) = N_Integer_Literal
245 and then Is_Integer_Type (Typ)
246 and then not Rchk
247 then
248 Result := Expr;
250 -- Cases where we end up with a conversion. Note that we do not use the
251 -- Convert_To abstraction here, since we may be decorating the resulting
252 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
253 -- conversion node present, even if it appears to be redundant.
255 else
256 -- Remove inner conversion if both inner and outer conversions are
257 -- to integer types, since the inner one serves no purpose (except
258 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
259 -- and also we preserve the range check flag on the inner operand
261 if Is_Integer_Type (Typ)
262 and then Is_Integer_Type (Etype (Expr))
263 and then Nkind (Expr) = N_Type_Conversion
264 then
265 Result :=
266 Make_Type_Conversion (Loc,
267 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
268 Expression => Expression (Expr));
269 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
270 Rcheck := Rcheck or Do_Range_Check (Expr);
272 -- For all other cases, a simple type conversion will work
274 else
275 Result :=
276 Make_Type_Conversion (Loc,
277 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
278 Expression => Expr);
279 end if;
281 -- Set Conversion_OK if either result or expression type is a
282 -- fixed-point type, since from a semantic point of view, we are
283 -- treating fixed-point values as integers at this stage.
285 if Is_Fixed_Point_Type (Typ)
286 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
287 then
288 Set_Conversion_OK (Result);
289 end if;
291 -- Set Do_Range_Check if either it was requested by the caller,
292 -- or if an eliminated inner conversion had a range check.
294 if Rcheck then
295 Enable_Range_Check (Result);
296 else
297 Set_Do_Range_Check (Result, False);
298 end if;
299 end if;
301 Set_Etype (Result, Typ);
302 return Result;
304 end Build_Conversion;
306 ------------------
307 -- Build_Divide --
308 ------------------
310 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
311 Loc : constant Source_Ptr := Sloc (N);
312 Left_Type : constant Entity_Id := Base_Type (Etype (L));
313 Right_Type : constant Entity_Id := Base_Type (Etype (R));
314 Result_Type : Entity_Id;
315 Rnode : Node_Id;
317 begin
318 -- Deal with floating-point case first
320 if Is_Floating_Point_Type (Left_Type) then
321 pragma Assert (Left_Type = Standard_Long_Long_Float);
322 pragma Assert (Right_Type = Standard_Long_Long_Float);
324 Rnode := Make_Op_Divide (Loc, L, R);
325 Result_Type := Standard_Long_Long_Float;
327 -- Integer and fixed-point cases
329 else
330 -- An optimization. If the right operand is the literal 1, then we
331 -- can just return the left hand operand. Putting the optimization
332 -- here allows us to omit the check at the call site.
334 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
335 return L;
336 end if;
338 -- If left and right types are the same, no conversion needed
340 if Left_Type = Right_Type then
341 Result_Type := Left_Type;
342 Rnode :=
343 Make_Op_Divide (Loc,
344 Left_Opnd => L,
345 Right_Opnd => R);
347 -- Use left type if it is the larger of the two
349 elsif Esize (Left_Type) >= Esize (Right_Type) then
350 Result_Type := Left_Type;
351 Rnode :=
352 Make_Op_Divide (Loc,
353 Left_Opnd => L,
354 Right_Opnd => Build_Conversion (N, Left_Type, R));
356 -- Otherwise right type is larger of the two, us it
358 else
359 Result_Type := Right_Type;
360 Rnode :=
361 Make_Op_Divide (Loc,
362 Left_Opnd => Build_Conversion (N, Right_Type, L),
363 Right_Opnd => R);
364 end if;
365 end if;
367 -- We now have a divide node built with Result_Type set. First
368 -- set Etype of result, as required for all Build_xxx routines
370 Set_Etype (Rnode, Base_Type (Result_Type));
372 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
373 -- since this is a literal arithmetic operation, to be performed
374 -- by Gigi without any consideration of small values.
376 if Is_Fixed_Point_Type (Result_Type) then
377 Set_Treat_Fixed_As_Integer (Rnode);
378 end if;
380 -- The result is rounded if the target of the operation is decimal
381 -- and Rounded_Result is set, or if the target of the operation
382 -- is an integer type.
384 if Is_Integer_Type (Etype (N))
385 or else Rounded_Result_Set (N)
386 then
387 Set_Rounded_Result (Rnode);
388 end if;
390 return Rnode;
392 end Build_Divide;
394 -------------------------
395 -- Build_Double_Divide --
396 -------------------------
398 function Build_Double_Divide
399 (N : Node_Id;
400 X, Y, Z : Node_Id)
401 return Node_Id
403 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
404 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
405 Expr : Node_Id;
407 begin
408 if Y_Size > System_Word_Size
409 or else
410 Z_Size > System_Word_Size
411 then
412 Disallow_In_No_Run_Time_Mode (N);
413 end if;
415 -- If denominator fits in 64 bits, we can build the operations directly
416 -- without causing any intermediate overflow, so that's what we do!
418 if Int'Max (Y_Size, Z_Size) <= 32 then
419 return
420 Build_Divide (N, X, Build_Multiply (N, Y, Z));
422 -- Otherwise we use the runtime routine
424 -- [Qnn : Interfaces.Integer_64,
425 -- Rnn : Interfaces.Integer_64;
426 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
427 -- Qnn]
429 else
430 declare
431 Loc : constant Source_Ptr := Sloc (N);
432 Qnn : Entity_Id;
433 Rnn : Entity_Id;
434 Code : List_Id;
436 begin
437 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
438 Insert_Actions (N, Code);
439 Expr := New_Occurrence_Of (Qnn, Loc);
441 -- Set type of result in case used elsewhere (see note at start)
443 Set_Etype (Expr, Etype (Qnn));
445 -- Set result as analyzed (see note at start on build routines)
447 return Expr;
448 end;
449 end if;
450 end Build_Double_Divide;
452 ------------------------------
453 -- Build_Double_Divide_Code --
454 ------------------------------
456 -- If the denominator can be computed in 64-bits, we build
458 -- [Nnn : constant typ := typ (X);
459 -- Dnn : constant typ := typ (Y) * typ (Z)
460 -- Qnn : constant typ := Nnn / Dnn;
461 -- Rnn : constant typ := Nnn / Dnn;
463 -- If the numerator cannot be computed in 64 bits, we build
465 -- [Qnn : typ;
466 -- Rnn : typ;
467 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
469 procedure Build_Double_Divide_Code
470 (N : Node_Id;
471 X, Y, Z : Node_Id;
472 Qnn, Rnn : out Entity_Id;
473 Code : out List_Id)
475 Loc : constant Source_Ptr := Sloc (N);
477 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
478 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
479 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
481 QR_Siz : Int;
482 QR_Typ : Entity_Id;
484 Nnn : Entity_Id;
485 Dnn : Entity_Id;
487 Quo : Node_Id;
488 Rnd : Entity_Id;
490 begin
491 -- Find type that will allow computation of numerator
493 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
495 if QR_Siz <= 16 then
496 QR_Typ := Standard_Integer_16;
497 elsif QR_Siz <= 32 then
498 QR_Typ := Standard_Integer_32;
499 elsif QR_Siz <= 64 then
500 QR_Typ := Standard_Integer_64;
502 -- For more than 64, bits, we use the 64-bit integer defined in
503 -- Interfaces, so that it can be handled by the runtime routine
505 else
506 QR_Typ := RTE (RE_Integer_64);
507 end if;
509 -- Define quotient and remainder, and set their Etypes, so
510 -- that they can be picked up by Build_xxx routines.
512 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
513 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
515 Set_Etype (Qnn, QR_Typ);
516 Set_Etype (Rnn, QR_Typ);
518 -- Case that we can compute the denominator in 64 bits
520 if QR_Siz <= 64 then
522 -- Create temporaries for numerator and denominator and set Etypes,
523 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
525 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
526 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
528 Set_Etype (Nnn, QR_Typ);
529 Set_Etype (Dnn, QR_Typ);
531 Code := New_List (
532 Make_Object_Declaration (Loc,
533 Defining_Identifier => Nnn,
534 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
535 Constant_Present => True,
536 Expression => Build_Conversion (N, QR_Typ, X)),
538 Make_Object_Declaration (Loc,
539 Defining_Identifier => Dnn,
540 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
541 Constant_Present => True,
542 Expression =>
543 Build_Multiply (N,
544 Build_Conversion (N, QR_Typ, Y),
545 Build_Conversion (N, QR_Typ, Z))));
547 Quo :=
548 Build_Divide (N,
549 New_Occurrence_Of (Nnn, Loc),
550 New_Occurrence_Of (Dnn, Loc));
552 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
554 Append_To (Code,
555 Make_Object_Declaration (Loc,
556 Defining_Identifier => Qnn,
557 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
558 Constant_Present => True,
559 Expression => Quo));
561 Append_To (Code,
562 Make_Object_Declaration (Loc,
563 Defining_Identifier => Rnn,
564 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
565 Constant_Present => True,
566 Expression =>
567 Build_Rem (N,
568 New_Occurrence_Of (Nnn, Loc),
569 New_Occurrence_Of (Dnn, Loc))));
571 -- Case where denominator does not fit in 64 bits, so we have to
572 -- call the runtime routine to compute the quotient and remainder
574 else
575 if Rounded_Result_Set (N) then
576 Rnd := Standard_True;
577 else
578 Rnd := Standard_False;
579 end if;
581 Code := New_List (
582 Make_Object_Declaration (Loc,
583 Defining_Identifier => Qnn,
584 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
586 Make_Object_Declaration (Loc,
587 Defining_Identifier => Rnn,
588 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
590 Make_Procedure_Call_Statement (Loc,
591 Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
592 Parameter_Associations => New_List (
593 Build_Conversion (N, QR_Typ, X),
594 Build_Conversion (N, QR_Typ, Y),
595 Build_Conversion (N, QR_Typ, Z),
596 New_Occurrence_Of (Qnn, Loc),
597 New_Occurrence_Of (Rnn, Loc),
598 New_Occurrence_Of (Rnd, Loc))));
599 end if;
601 end Build_Double_Divide_Code;
603 --------------------
604 -- Build_Multiply --
605 --------------------
607 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
608 Loc : constant Source_Ptr := Sloc (N);
609 Left_Type : constant Entity_Id := Etype (L);
610 Right_Type : constant Entity_Id := Etype (R);
611 Rsize : Int;
612 Result_Type : Entity_Id;
613 Rnode : Node_Id;
615 begin
616 -- Deal with floating-point case first
618 if Is_Floating_Point_Type (Left_Type) then
619 pragma Assert (Left_Type = Standard_Long_Long_Float);
620 pragma Assert (Right_Type = Standard_Long_Long_Float);
622 Result_Type := Standard_Long_Long_Float;
623 Rnode := Make_Op_Multiply (Loc, L, R);
625 -- Integer and fixed-point cases
627 else
628 -- An optimization. If the right operand is the literal 1, then we
629 -- can just return the left hand operand. Putting the optimization
630 -- here allows us to omit the check at the call site. Similarly, if
631 -- the left operand is the integer 1 we can return the right operand.
633 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
634 return L;
635 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
636 return R;
637 end if;
639 -- Otherwise we use a type that is at least twice the longer
640 -- of the two sizes.
642 Rsize := 2 * Int'Max (UI_To_Int (Esize (Left_Type)),
643 UI_To_Int (Esize (Right_Type)));
645 if Rsize <= 8 then
646 Result_Type := Standard_Integer_8;
648 elsif Rsize <= 16 then
649 Result_Type := Standard_Integer_16;
651 elsif Rsize <= 32 then
652 Result_Type := Standard_Integer_32;
654 else
655 if Rsize > System_Word_Size then
656 Disallow_In_No_Run_Time_Mode (N);
657 end if;
659 Result_Type := Standard_Integer_64;
660 end if;
662 Rnode :=
663 Make_Op_Multiply (Loc,
664 Left_Opnd => Build_Conversion (N, Result_Type, L),
665 Right_Opnd => Build_Conversion (N, Result_Type, R));
666 end if;
668 -- We now have a multiply node built with Result_Type set. First
669 -- set Etype of result, as required for all Build_xxx routines
671 Set_Etype (Rnode, Base_Type (Result_Type));
673 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
674 -- since this is a literal arithmetic operation, to be performed
675 -- by Gigi without any consideration of small values.
677 if Is_Fixed_Point_Type (Result_Type) then
678 Set_Treat_Fixed_As_Integer (Rnode);
679 end if;
681 return Rnode;
682 end Build_Multiply;
684 ---------------
685 -- Build_Rem --
686 ---------------
688 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
689 Loc : constant Source_Ptr := Sloc (N);
690 Left_Type : constant Entity_Id := Etype (L);
691 Right_Type : constant Entity_Id := Etype (R);
692 Result_Type : Entity_Id;
693 Rnode : Node_Id;
695 begin
696 if Left_Type = Right_Type then
697 Result_Type := Left_Type;
698 Rnode :=
699 Make_Op_Rem (Loc,
700 Left_Opnd => L,
701 Right_Opnd => R);
703 -- If left size is larger, we do the remainder operation using the
704 -- size of the left type (i.e. the larger of the two integer types).
706 elsif Esize (Left_Type) >= Esize (Right_Type) then
707 Result_Type := Left_Type;
708 Rnode :=
709 Make_Op_Rem (Loc,
710 Left_Opnd => L,
711 Right_Opnd => Build_Conversion (N, Left_Type, R));
713 -- Similarly, if the right size is larger, we do the remainder
714 -- operation using the right type.
716 else
717 Result_Type := Right_Type;
718 Rnode :=
719 Make_Op_Rem (Loc,
720 Left_Opnd => Build_Conversion (N, Right_Type, L),
721 Right_Opnd => R);
722 end if;
724 -- We now have an N_Op_Rem node built with Result_Type set. First
725 -- set Etype of result, as required for all Build_xxx routines
727 Set_Etype (Rnode, Base_Type (Result_Type));
729 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
730 -- since this is a literal arithmetic operation, to be performed
731 -- by Gigi without any consideration of small values.
733 if Is_Fixed_Point_Type (Result_Type) then
734 Set_Treat_Fixed_As_Integer (Rnode);
735 end if;
737 -- One more check. We did the rem operation using the larger of the
738 -- two types, which is reasonable. However, in the case where the
739 -- two types have unequal sizes, it is impossible for the result of
740 -- a remainder operation to be larger than the smaller of the two
741 -- types, so we can put a conversion round the result to keep the
742 -- evolving operation size as small as possible.
744 if Esize (Left_Type) >= Esize (Right_Type) then
745 Rnode := Build_Conversion (N, Right_Type, Rnode);
746 elsif Esize (Right_Type) >= Esize (Left_Type) then
747 Rnode := Build_Conversion (N, Left_Type, Rnode);
748 end if;
750 return Rnode;
751 end Build_Rem;
753 -------------------------
754 -- Build_Scaled_Divide --
755 -------------------------
757 function Build_Scaled_Divide
758 (N : Node_Id;
759 X, Y, Z : Node_Id)
760 return Node_Id
762 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
763 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
764 Expr : Node_Id;
766 begin
767 -- If numerator fits in 64 bits, we can build the operations directly
768 -- without causing any intermediate overflow, so that's what we do!
770 if Int'Max (X_Size, Y_Size) <= 32 then
771 return
772 Build_Divide (N, Build_Multiply (N, X, Y), Z);
774 -- Otherwise we use the runtime routine
776 -- [Qnn : Integer_64,
777 -- Rnn : Integer_64;
778 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
779 -- Qnn]
781 else
782 declare
783 Loc : constant Source_Ptr := Sloc (N);
784 Qnn : Entity_Id;
785 Rnn : Entity_Id;
786 Code : List_Id;
788 begin
789 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
790 Insert_Actions (N, Code);
791 Expr := New_Occurrence_Of (Qnn, Loc);
793 -- Set type of result in case used elsewhere (see note at start)
795 Set_Etype (Expr, Etype (Qnn));
796 return Expr;
797 end;
798 end if;
799 end Build_Scaled_Divide;
801 ------------------------------
802 -- Build_Scaled_Divide_Code --
803 ------------------------------
805 -- If the numerator can be computed in 64-bits, we build
807 -- [Nnn : constant typ := typ (X) * typ (Y);
808 -- Dnn : constant typ := typ (Z)
809 -- Qnn : constant typ := Nnn / Dnn;
810 -- Rnn : constant typ := Nnn / Dnn;
812 -- If the numerator cannot be computed in 64 bits, we build
814 -- [Qnn : Interfaces.Integer_64;
815 -- Rnn : Interfaces.Integer_64;
816 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
818 procedure Build_Scaled_Divide_Code
819 (N : Node_Id;
820 X, Y, Z : Node_Id;
821 Qnn, Rnn : out Entity_Id;
822 Code : out List_Id)
824 Loc : constant Source_Ptr := Sloc (N);
826 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
827 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
828 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
830 QR_Siz : Int;
831 QR_Typ : Entity_Id;
833 Nnn : Entity_Id;
834 Dnn : Entity_Id;
836 Quo : Node_Id;
837 Rnd : Entity_Id;
839 begin
840 -- Find type that will allow computation of numerator
842 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
844 if QR_Siz <= 16 then
845 QR_Typ := Standard_Integer_16;
846 elsif QR_Siz <= 32 then
847 QR_Typ := Standard_Integer_32;
848 elsif QR_Siz <= 64 then
849 QR_Typ := Standard_Integer_64;
851 -- For more than 64, bits, we use the 64-bit integer defined in
852 -- Interfaces, so that it can be handled by the runtime routine
854 else
855 QR_Typ := RTE (RE_Integer_64);
856 end if;
858 -- Define quotient and remainder, and set their Etypes, so
859 -- that they can be picked up by Build_xxx routines.
861 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
862 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
864 Set_Etype (Qnn, QR_Typ);
865 Set_Etype (Rnn, QR_Typ);
867 -- Case that we can compute the numerator in 64 bits
869 if QR_Siz <= 64 then
870 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
871 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
873 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
875 Set_Etype (Nnn, QR_Typ);
876 Set_Etype (Dnn, QR_Typ);
878 Code := New_List (
879 Make_Object_Declaration (Loc,
880 Defining_Identifier => Nnn,
881 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
882 Constant_Present => True,
883 Expression =>
884 Build_Multiply (N,
885 Build_Conversion (N, QR_Typ, X),
886 Build_Conversion (N, QR_Typ, Y))),
888 Make_Object_Declaration (Loc,
889 Defining_Identifier => Dnn,
890 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
891 Constant_Present => True,
892 Expression => Build_Conversion (N, QR_Typ, Z)));
894 Quo :=
895 Build_Divide (N,
896 New_Occurrence_Of (Nnn, Loc),
897 New_Occurrence_Of (Dnn, Loc));
899 Append_To (Code,
900 Make_Object_Declaration (Loc,
901 Defining_Identifier => Qnn,
902 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
903 Constant_Present => True,
904 Expression => Quo));
906 Append_To (Code,
907 Make_Object_Declaration (Loc,
908 Defining_Identifier => Rnn,
909 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
910 Constant_Present => True,
911 Expression =>
912 Build_Rem (N,
913 New_Occurrence_Of (Nnn, Loc),
914 New_Occurrence_Of (Dnn, Loc))));
916 -- Case where numerator does not fit in 64 bits, so we have to
917 -- call the runtime routine to compute the quotient and remainder
919 else
920 if Rounded_Result_Set (N) then
921 Rnd := Standard_True;
922 else
923 Rnd := Standard_False;
924 end if;
926 Code := New_List (
927 Make_Object_Declaration (Loc,
928 Defining_Identifier => Qnn,
929 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
931 Make_Object_Declaration (Loc,
932 Defining_Identifier => Rnn,
933 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
935 Make_Procedure_Call_Statement (Loc,
936 Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
937 Parameter_Associations => New_List (
938 Build_Conversion (N, QR_Typ, X),
939 Build_Conversion (N, QR_Typ, Y),
940 Build_Conversion (N, QR_Typ, Z),
941 New_Occurrence_Of (Qnn, Loc),
942 New_Occurrence_Of (Rnn, Loc),
943 New_Occurrence_Of (Rnd, Loc))));
944 end if;
946 -- Set type of result, for use in caller.
948 Set_Etype (Qnn, QR_Typ);
949 end Build_Scaled_Divide_Code;
951 ---------------------------
952 -- Do_Divide_Fixed_Fixed --
953 ---------------------------
955 -- We have:
957 -- (Result_Value * Result_Small) =
958 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
960 -- Result_Value = (Left_Value / Right_Value) *
961 -- (Left_Small / (Right_Small * Result_Small));
963 -- we can do the operation in integer arithmetic if this fraction is an
964 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
965 -- Otherwise the result is in the close result set and our approach is to
966 -- use floating-point to compute this close result.
968 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
969 Left : constant Node_Id := Left_Opnd (N);
970 Right : constant Node_Id := Right_Opnd (N);
971 Left_Type : constant Entity_Id := Etype (Left);
972 Right_Type : constant Entity_Id := Etype (Right);
973 Result_Type : constant Entity_Id := Etype (N);
974 Right_Small : constant Ureal := Small_Value (Right_Type);
975 Left_Small : constant Ureal := Small_Value (Left_Type);
977 Result_Small : Ureal;
978 Frac : Ureal;
979 Frac_Num : Uint;
980 Frac_Den : Uint;
981 Lit_Int : Node_Id;
983 begin
984 -- Rounding is required if the result is integral
986 if Is_Integer_Type (Result_Type) then
987 Set_Rounded_Result (N);
988 end if;
990 -- Get result small. If the result is an integer, treat it as though
991 -- it had a small of 1.0, all other processing is identical.
993 if Is_Integer_Type (Result_Type) then
994 Result_Small := Ureal_1;
995 else
996 Result_Small := Small_Value (Result_Type);
997 end if;
999 -- Get small ratio
1001 Frac := Left_Small / (Right_Small * Result_Small);
1002 Frac_Num := Norm_Num (Frac);
1003 Frac_Den := Norm_Den (Frac);
1005 -- If the fraction is an integer, then we get the result by multiplying
1006 -- the left operand by the integer, and then dividing by the right
1007 -- operand (the order is important, if we did the divide first, we
1008 -- would lose precision).
1010 if Frac_Den = 1 then
1011 Lit_Int := Integer_Literal (N, Frac_Num);
1013 if Present (Lit_Int) then
1014 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1015 return;
1016 end if;
1018 -- If the fraction is the reciprocal of an integer, then we get the
1019 -- result by first multiplying the divisor by the integer, and then
1020 -- doing the division with the adjusted divisor.
1022 -- Note: this is much better than doing two divisions: multiplications
1023 -- are much faster than divisions (and certainly faster than rounded
1024 -- divisions), and we don't get inaccuracies from double rounding.
1026 elsif Frac_Num = 1 then
1027 Lit_Int := Integer_Literal (N, Frac_Den);
1029 if Present (Lit_Int) then
1030 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1031 return;
1032 end if;
1033 end if;
1035 -- If we fall through, we use floating-point to compute the result
1037 Set_Result (N,
1038 Build_Multiply (N,
1039 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1040 Real_Literal (N, Frac)));
1042 end Do_Divide_Fixed_Fixed;
1044 -------------------------------
1045 -- Do_Divide_Fixed_Universal --
1046 -------------------------------
1048 -- We have:
1050 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1051 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1053 -- The result is required to be in the perfect result set if the literal
1054 -- can be factored so that the resulting small ratio is an integer or the
1055 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1056 -- analysis of these RM requirements:
1058 -- We must factor the literal, finding an integer K:
1060 -- Lit_Value = K * Right_Small
1061 -- Right_Small = Lit_Value / K
1063 -- such that the small ratio:
1065 -- Left_Small
1066 -- ------------------------------
1067 -- (Lit_Value / K) * Result_Small
1069 -- Left_Small
1070 -- = ------------------------ * K
1071 -- Lit_Value * Result_Small
1073 -- is an integer or the reciprocal of an integer, and for
1074 -- implementation efficiency we need the smallest such K.
1076 -- First we reduce the left fraction to lowest terms.
1078 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1079 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1080 -- Right_Small = Lit_Value.
1082 -- If numerator > 1, then set K to the denominator of the fraction so
1083 -- that the resulting small ratio is an integer (the numerator value).
1085 procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1086 Left : constant Node_Id := Left_Opnd (N);
1087 Right : constant Node_Id := Right_Opnd (N);
1088 Left_Type : constant Entity_Id := Etype (Left);
1089 Result_Type : constant Entity_Id := Etype (N);
1090 Left_Small : constant Ureal := Small_Value (Left_Type);
1091 Lit_Value : constant Ureal := Realval (Right);
1093 Result_Small : Ureal;
1094 Frac : Ureal;
1095 Frac_Num : Uint;
1096 Frac_Den : Uint;
1097 Lit_K : Node_Id;
1098 Lit_Int : Node_Id;
1100 begin
1101 -- Get result small. If the result is an integer, treat it as though
1102 -- it had a small of 1.0, all other processing is identical.
1104 if Is_Integer_Type (Result_Type) then
1105 Result_Small := Ureal_1;
1106 else
1107 Result_Small := Small_Value (Result_Type);
1108 end if;
1110 -- Determine if literal can be rewritten successfully
1112 Frac := Left_Small / (Lit_Value * Result_Small);
1113 Frac_Num := Norm_Num (Frac);
1114 Frac_Den := Norm_Den (Frac);
1116 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1117 -- = denominator). If this integer is not too large, this is the case
1118 -- where the result can be obtained by dividing by this integer value.
1120 if Frac_Num = 1 then
1121 Lit_Int := Integer_Literal (N, Frac_Den);
1123 if Present (Lit_Int) then
1124 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1125 return;
1126 end if;
1128 -- Case where we choose K to make fraction an integer (K = denominator
1129 -- of fraction, integer = numerator of fraction). If both K and the
1130 -- numerator are small enough, this is the case where the result can
1131 -- be obtained by first multiplying by the integer value and then
1132 -- dividing by K (the order is important, if we divided first, we
1133 -- would lose precision).
1135 else
1136 Lit_Int := Integer_Literal (N, Frac_Num);
1137 Lit_K := Integer_Literal (N, Frac_Den);
1139 if Present (Lit_Int) and then Present (Lit_K) then
1140 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1141 return;
1142 end if;
1143 end if;
1145 -- Fall through if the literal cannot be successfully rewritten, or if
1146 -- the small ratio is out of range of integer arithmetic. In the former
1147 -- case it is fine to use floating-point to get the close result set,
1148 -- and in the latter case, it means that the result is zero or raises
1149 -- constraint error, and we can do that accurately in floating-point.
1151 -- If we end up using floating-point, then we take the right integer
1152 -- to be one, and its small to be the value of the original right real
1153 -- literal. That way, we need only one floating-point multiplication.
1155 Set_Result (N,
1156 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1158 end Do_Divide_Fixed_Universal;
1160 -------------------------------
1161 -- Do_Divide_Universal_Fixed --
1162 -------------------------------
1164 -- We have:
1166 -- (Result_Value * Result_Small) =
1167 -- Lit_Value / (Right_Value * Right_Small)
1168 -- Result_Value =
1169 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1171 -- The result is required to be in the perfect result set if the literal
1172 -- can be factored so that the resulting small ratio is an integer or the
1173 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1174 -- analysis of these RM requirements:
1176 -- We must factor the literal, finding an integer K:
1178 -- Lit_Value = K * Left_Small
1179 -- Left_Small = Lit_Value / K
1181 -- such that the small ratio:
1183 -- (Lit_Value / K)
1184 -- --------------------------
1185 -- Right_Small * Result_Small
1187 -- Lit_Value 1
1188 -- = -------------------------- * -
1189 -- Right_Small * Result_Small K
1191 -- is an integer or the reciprocal of an integer, and for
1192 -- implementation efficiency we need the smallest such K.
1194 -- First we reduce the left fraction to lowest terms.
1196 -- If denominator = 1, then for K = 1, the small ratio is an integer
1197 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1198 -- and Left_Small = Lit_Value.
1200 -- If denominator > 1, then set K to the numerator of the fraction so
1201 -- that the resulting small ratio is the reciprocal of an integer (the
1202 -- numerator value).
1204 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1205 Left : constant Node_Id := Left_Opnd (N);
1206 Right : constant Node_Id := Right_Opnd (N);
1207 Right_Type : constant Entity_Id := Etype (Right);
1208 Result_Type : constant Entity_Id := Etype (N);
1209 Right_Small : constant Ureal := Small_Value (Right_Type);
1210 Lit_Value : constant Ureal := Realval (Left);
1212 Result_Small : Ureal;
1213 Frac : Ureal;
1214 Frac_Num : Uint;
1215 Frac_Den : Uint;
1216 Lit_K : Node_Id;
1217 Lit_Int : Node_Id;
1219 begin
1220 -- Get result small. If the result is an integer, treat it as though
1221 -- it had a small of 1.0, all other processing is identical.
1223 if Is_Integer_Type (Result_Type) then
1224 Result_Small := Ureal_1;
1225 else
1226 Result_Small := Small_Value (Result_Type);
1227 end if;
1229 -- Determine if literal can be rewritten successfully
1231 Frac := Lit_Value / (Right_Small * Result_Small);
1232 Frac_Num := Norm_Num (Frac);
1233 Frac_Den := Norm_Den (Frac);
1235 -- Case where fraction is an integer (K = 1, integer = numerator). If
1236 -- this integer is not too large, this is the case where the result
1237 -- can be obtained by dividing this integer by the right operand.
1239 if Frac_Den = 1 then
1240 Lit_Int := Integer_Literal (N, Frac_Num);
1242 if Present (Lit_Int) then
1243 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1244 return;
1245 end if;
1247 -- Case where we choose K to make the fraction the reciprocal of an
1248 -- integer (K = numerator of fraction, integer = numerator of fraction).
1249 -- If both K and the integer are small enough, this is the case where
1250 -- the result can be obtained by multiplying the right operand by K
1251 -- and then dividing by the integer value. The order of the operations
1252 -- is important (if we divided first, we would lose precision).
1254 else
1255 Lit_Int := Integer_Literal (N, Frac_Den);
1256 Lit_K := Integer_Literal (N, Frac_Num);
1258 if Present (Lit_Int) and then Present (Lit_K) then
1259 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1260 return;
1261 end if;
1262 end if;
1264 -- Fall through if the literal cannot be successfully rewritten, or if
1265 -- the small ratio is out of range of integer arithmetic. In the former
1266 -- case it is fine to use floating-point to get the close result set,
1267 -- and in the latter case, it means that the result is zero or raises
1268 -- constraint error, and we can do that accurately in floating-point.
1270 -- If we end up using floating-point, then we take the right integer
1271 -- to be one, and its small to be the value of the original right real
1272 -- literal. That way, we need only one floating-point division.
1274 Set_Result (N,
1275 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1277 end Do_Divide_Universal_Fixed;
1279 -----------------------------
1280 -- Do_Multiply_Fixed_Fixed --
1281 -----------------------------
1283 -- We have:
1285 -- (Result_Value * Result_Small) =
1286 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1288 -- Result_Value = (Left_Value * Right_Value) *
1289 -- (Left_Small * Right_Small) / Result_Small;
1291 -- we can do the operation in integer arithmetic if this fraction is an
1292 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1293 -- Otherwise the result is in the close result set and our approach is to
1294 -- use floating-point to compute this close result.
1296 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1297 Left : constant Node_Id := Left_Opnd (N);
1298 Right : constant Node_Id := Right_Opnd (N);
1300 Left_Type : constant Entity_Id := Etype (Left);
1301 Right_Type : constant Entity_Id := Etype (Right);
1302 Result_Type : constant Entity_Id := Etype (N);
1303 Right_Small : constant Ureal := Small_Value (Right_Type);
1304 Left_Small : constant Ureal := Small_Value (Left_Type);
1306 Result_Small : Ureal;
1307 Frac : Ureal;
1308 Frac_Num : Uint;
1309 Frac_Den : Uint;
1310 Lit_Int : Node_Id;
1312 begin
1313 -- Get result small. If the result is an integer, treat it as though
1314 -- it had a small of 1.0, all other processing is identical.
1316 if Is_Integer_Type (Result_Type) then
1317 Result_Small := Ureal_1;
1318 else
1319 Result_Small := Small_Value (Result_Type);
1320 end if;
1322 -- Get small ratio
1324 Frac := (Left_Small * Right_Small) / Result_Small;
1325 Frac_Num := Norm_Num (Frac);
1326 Frac_Den := Norm_Den (Frac);
1328 -- If the fraction is an integer, then we get the result by multiplying
1329 -- the operands, and then multiplying the result by the integer value.
1331 if Frac_Den = 1 then
1332 Lit_Int := Integer_Literal (N, Frac_Num);
1334 if Present (Lit_Int) then
1335 Set_Result (N,
1336 Build_Multiply (N, Build_Multiply (N, Left, Right),
1337 Lit_Int));
1338 return;
1339 end if;
1341 -- If the fraction is the reciprocal of an integer, then we get the
1342 -- result by multiplying the operands, and then dividing the result by
1343 -- the integer value. The order of the operations is important, if we
1344 -- divided first, we would lose precision.
1346 elsif Frac_Num = 1 then
1347 Lit_Int := Integer_Literal (N, Frac_Den);
1349 if Present (Lit_Int) then
1350 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1351 return;
1352 end if;
1353 end if;
1355 -- If we fall through, we use floating-point to compute the result
1357 Set_Result (N,
1358 Build_Multiply (N,
1359 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1360 Real_Literal (N, Frac)));
1362 end Do_Multiply_Fixed_Fixed;
1364 ---------------------------------
1365 -- Do_Multiply_Fixed_Universal --
1366 ---------------------------------
1368 -- We have:
1370 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1371 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1373 -- The result is required to be in the perfect result set if the literal
1374 -- can be factored so that the resulting small ratio is an integer or the
1375 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1376 -- analysis of these RM requirements:
1378 -- We must factor the literal, finding an integer K:
1380 -- Lit_Value = K * Right_Small
1381 -- Right_Small = Lit_Value / K
1383 -- such that the small ratio:
1385 -- Left_Small * (Lit_Value / K)
1386 -- ----------------------------
1387 -- Result_Small
1389 -- Left_Small * Lit_Value 1
1390 -- = ---------------------- * -
1391 -- Result_Small K
1393 -- is an integer or the reciprocal of an integer, and for
1394 -- implementation efficiency we need the smallest such K.
1396 -- First we reduce the left fraction to lowest terms.
1398 -- If denominator = 1, then for K = 1, the small ratio is an
1399 -- integer, and this is clearly the minimum K case, so set
1400 -- K = 1, Right_Small = Lit_Value.
1402 -- If denominator > 1, then set K to the numerator of the
1403 -- fraction, so that the resulting small ratio is the
1404 -- reciprocal of the integer (the denominator value).
1406 procedure Do_Multiply_Fixed_Universal
1407 (N : Node_Id;
1408 Left, Right : Node_Id)
1410 Left_Type : constant Entity_Id := Etype (Left);
1411 Result_Type : constant Entity_Id := Etype (N);
1412 Left_Small : constant Ureal := Small_Value (Left_Type);
1413 Lit_Value : constant Ureal := Realval (Right);
1415 Result_Small : Ureal;
1416 Frac : Ureal;
1417 Frac_Num : Uint;
1418 Frac_Den : Uint;
1419 Lit_K : Node_Id;
1420 Lit_Int : Node_Id;
1422 begin
1423 -- Get result small. If the result is an integer, treat it as though
1424 -- it had a small of 1.0, all other processing is identical.
1426 if Is_Integer_Type (Result_Type) then
1427 Result_Small := Ureal_1;
1428 else
1429 Result_Small := Small_Value (Result_Type);
1430 end if;
1432 -- Determine if literal can be rewritten successfully
1434 Frac := (Left_Small * Lit_Value) / Result_Small;
1435 Frac_Num := Norm_Num (Frac);
1436 Frac_Den := Norm_Den (Frac);
1438 -- Case where fraction is an integer (K = 1, integer = numerator). If
1439 -- this integer is not too large, this is the case where the result can
1440 -- be obtained by multiplying by this integer value.
1442 if Frac_Den = 1 then
1443 Lit_Int := Integer_Literal (N, Frac_Num);
1445 if Present (Lit_Int) then
1446 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1447 return;
1448 end if;
1450 -- Case where we choose K to make fraction the reciprocal of an integer
1451 -- (K = numerator of fraction, integer = denominator of fraction). If
1452 -- both K and the denominator are small enough, this is the case where
1453 -- the result can be obtained by first multiplying by K, and then
1454 -- dividing by the integer value.
1456 else
1457 Lit_Int := Integer_Literal (N, Frac_Den);
1458 Lit_K := Integer_Literal (N, Frac_Num);
1460 if Present (Lit_Int) and then Present (Lit_K) then
1461 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1462 return;
1463 end if;
1464 end if;
1466 -- Fall through if the literal cannot be successfully rewritten, or if
1467 -- the small ratio is out of range of integer arithmetic. In the former
1468 -- case it is fine to use floating-point to get the close result set,
1469 -- and in the latter case, it means that the result is zero or raises
1470 -- constraint error, and we can do that accurately in floating-point.
1472 -- If we end up using floating-point, then we take the right integer
1473 -- to be one, and its small to be the value of the original right real
1474 -- literal. That way, we need only one floating-point multiplication.
1476 Set_Result (N,
1477 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1479 end Do_Multiply_Fixed_Universal;
1481 ---------------------------------
1482 -- Expand_Convert_Fixed_Static --
1483 ---------------------------------
1485 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1486 begin
1487 Rewrite (N,
1488 Convert_To (Etype (N),
1489 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1490 Analyze_And_Resolve (N);
1491 end Expand_Convert_Fixed_Static;
1493 -----------------------------------
1494 -- Expand_Convert_Fixed_To_Fixed --
1495 -----------------------------------
1497 -- We have:
1499 -- Result_Value * Result_Small = Source_Value * Source_Small
1500 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1502 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1503 -- integer, then the perfect result set is obtained by a single integer
1504 -- multiplication.
1506 -- If the small ratio is the reciprocal of a sufficiently small integer,
1507 -- then the perfect result set is obtained by a single integer division.
1509 -- In other cases, we obtain the close result set by calculating the
1510 -- result in floating-point.
1512 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1513 Rng_Check : constant Boolean := Do_Range_Check (N);
1514 Expr : constant Node_Id := Expression (N);
1515 Result_Type : constant Entity_Id := Etype (N);
1516 Source_Type : constant Entity_Id := Etype (Expr);
1517 Small_Ratio : Ureal;
1518 Ratio_Num : Uint;
1519 Ratio_Den : Uint;
1520 Lit : Node_Id;
1522 begin
1523 if Is_OK_Static_Expression (Expr) then
1524 Expand_Convert_Fixed_Static (N);
1525 return;
1526 end if;
1528 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1529 Ratio_Num := Norm_Num (Small_Ratio);
1530 Ratio_Den := Norm_Den (Small_Ratio);
1532 if Ratio_Den = 1 then
1534 if Ratio_Num = 1 then
1535 Set_Result (N, Expr);
1536 return;
1538 else
1539 Lit := Integer_Literal (N, Ratio_Num);
1541 if Present (Lit) then
1542 Set_Result (N, Build_Multiply (N, Expr, Lit));
1543 return;
1544 end if;
1545 end if;
1547 elsif Ratio_Num = 1 then
1548 Lit := Integer_Literal (N, Ratio_Den);
1550 if Present (Lit) then
1551 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1552 return;
1553 end if;
1554 end if;
1556 -- Fall through to use floating-point for the close result set case
1557 -- either as a result of the small ratio not being an integer or the
1558 -- reciprocal of an integer, or if the integer is out of range.
1560 Set_Result (N,
1561 Build_Multiply (N,
1562 Fpt_Value (Expr),
1563 Real_Literal (N, Small_Ratio)),
1564 Rng_Check);
1566 end Expand_Convert_Fixed_To_Fixed;
1568 -----------------------------------
1569 -- Expand_Convert_Fixed_To_Float --
1570 -----------------------------------
1572 -- If the small of the fixed type is 1.0, then we simply convert the
1573 -- integer value directly to the target floating-point type, otherwise
1574 -- we first have to multiply by the small, in Long_Long_Float, and then
1575 -- convert the result to the target floating-point type.
1577 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1578 Rng_Check : constant Boolean := Do_Range_Check (N);
1579 Expr : constant Node_Id := Expression (N);
1580 Source_Type : constant Entity_Id := Etype (Expr);
1581 Small : constant Ureal := Small_Value (Source_Type);
1583 begin
1584 if Is_OK_Static_Expression (Expr) then
1585 Expand_Convert_Fixed_Static (N);
1586 return;
1587 end if;
1589 if Small = Ureal_1 then
1590 Set_Result (N, Expr);
1592 else
1593 Set_Result (N,
1594 Build_Multiply (N,
1595 Fpt_Value (Expr),
1596 Real_Literal (N, Small)),
1597 Rng_Check);
1598 end if;
1599 end Expand_Convert_Fixed_To_Float;
1601 -------------------------------------
1602 -- Expand_Convert_Fixed_To_Integer --
1603 -------------------------------------
1605 -- We have:
1607 -- Result_Value = Source_Value * Source_Small
1609 -- If the small value is a sufficiently small integer, then the perfect
1610 -- result set is obtained by a single integer multiplication.
1612 -- If the small value is the reciprocal of a sufficiently small integer,
1613 -- then the perfect result set is obtained by a single integer division.
1615 -- In other cases, we obtain the close result set by calculating the
1616 -- result in floating-point.
1618 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1619 Rng_Check : constant Boolean := Do_Range_Check (N);
1620 Expr : constant Node_Id := Expression (N);
1621 Source_Type : constant Entity_Id := Etype (Expr);
1622 Small : constant Ureal := Small_Value (Source_Type);
1623 Small_Num : constant Uint := Norm_Num (Small);
1624 Small_Den : constant Uint := Norm_Den (Small);
1625 Lit : Node_Id;
1627 begin
1628 if Is_OK_Static_Expression (Expr) then
1629 Expand_Convert_Fixed_Static (N);
1630 return;
1631 end if;
1633 if Small_Den = 1 then
1634 Lit := Integer_Literal (N, Small_Num);
1636 if Present (Lit) then
1637 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1638 return;
1639 end if;
1641 elsif Small_Num = 1 then
1642 Lit := Integer_Literal (N, Small_Den);
1644 if Present (Lit) then
1645 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1646 return;
1647 end if;
1648 end if;
1650 -- Fall through to use floating-point for the close result set case
1651 -- either as a result of the small value not being an integer or the
1652 -- reciprocal of an integer, or if the integer is out of range.
1654 Set_Result (N,
1655 Build_Multiply (N,
1656 Fpt_Value (Expr),
1657 Real_Literal (N, Small)),
1658 Rng_Check);
1660 end Expand_Convert_Fixed_To_Integer;
1662 -----------------------------------
1663 -- Expand_Convert_Float_To_Fixed --
1664 -----------------------------------
1666 -- We have
1668 -- Result_Value * Result_Small = Operand_Value
1670 -- so compute:
1672 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1674 -- We do the small scaling in floating-point, and we do a multiplication
1675 -- rather than a division, since it is accurate enough for the perfect
1676 -- result cases, and faster.
1678 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1679 Rng_Check : constant Boolean := Do_Range_Check (N);
1680 Expr : constant Node_Id := Expression (N);
1681 Result_Type : constant Entity_Id := Etype (N);
1682 Small : constant Ureal := Small_Value (Result_Type);
1684 begin
1685 -- Optimize small = 1, where we can avoid the multiply completely
1687 if Small = Ureal_1 then
1688 Set_Result (N, Expr, Rng_Check);
1690 -- Normal case where multiply is required
1692 else
1693 Set_Result (N,
1694 Build_Multiply (N,
1695 Fpt_Value (Expr),
1696 Real_Literal (N, Ureal_1 / Small)),
1697 Rng_Check);
1698 end if;
1699 end Expand_Convert_Float_To_Fixed;
1701 -------------------------------------
1702 -- Expand_Convert_Integer_To_Fixed --
1703 -------------------------------------
1705 -- We have
1707 -- Result_Value * Result_Small = Operand_Value
1708 -- Result_Value = Operand_Value / Result_Small
1710 -- If the small value is a sufficiently small integer, then the perfect
1711 -- result set is obtained by a single integer division.
1713 -- If the small value is the reciprocal of a sufficiently small integer,
1714 -- the perfect result set is obtained by a single integer multiplication.
1716 -- In other cases, we obtain the close result set by calculating the
1717 -- result in floating-point using a multiplication by the reciprocal
1718 -- of the Result_Small.
1720 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1721 Rng_Check : constant Boolean := Do_Range_Check (N);
1722 Expr : constant Node_Id := Expression (N);
1723 Result_Type : constant Entity_Id := Etype (N);
1724 Small : constant Ureal := Small_Value (Result_Type);
1725 Small_Num : constant Uint := Norm_Num (Small);
1726 Small_Den : constant Uint := Norm_Den (Small);
1727 Lit : Node_Id;
1729 begin
1730 if Small_Den = 1 then
1731 Lit := Integer_Literal (N, Small_Num);
1733 if Present (Lit) then
1734 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1735 return;
1736 end if;
1738 elsif Small_Num = 1 then
1739 Lit := Integer_Literal (N, Small_Den);
1741 if Present (Lit) then
1742 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1743 return;
1744 end if;
1745 end if;
1747 -- Fall through to use floating-point for the close result set case
1748 -- either as a result of the small value not being an integer or the
1749 -- reciprocal of an integer, or if the integer is out of range.
1751 Set_Result (N,
1752 Build_Multiply (N,
1753 Fpt_Value (Expr),
1754 Real_Literal (N, Ureal_1 / Small)),
1755 Rng_Check);
1757 end Expand_Convert_Integer_To_Fixed;
1759 --------------------------------
1760 -- Expand_Decimal_Divide_Call --
1761 --------------------------------
1763 -- We have four operands
1765 -- Dividend
1766 -- Divisor
1767 -- Quotient
1768 -- Remainder
1770 -- All of which are decimal types, and which thus have associated
1771 -- decimal scales.
1773 -- Computing the quotient is a similar problem to that faced by the
1774 -- normal fixed-point division, except that it is simpler, because
1775 -- we always have compatible smalls.
1777 -- Quotient = (Dividend / Divisor) * 10**q
1779 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1780 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1782 -- For q >= 0, we compute
1784 -- Numerator := Dividend * 10 ** q
1785 -- Denominator := Divisor
1786 -- Quotient := Numerator / Denominator
1788 -- For q < 0, we compute
1790 -- Numerator := Dividend
1791 -- Denominator := Divisor * 10 ** q
1792 -- Quotient := Numerator / Denominator
1794 -- Both these divisions are done in truncated mode, and the remainder
1795 -- from these divisions is used to compute the result Remainder. This
1796 -- remainder has the effective scale of the numerator of the division,
1798 -- For q >= 0, the remainder scale is Dividend'Scale + q
1799 -- For q < 0, the remainder scale is Dividend'Scale
1801 -- The result Remainder is then computed by a normal truncating decimal
1802 -- conversion from this scale to the scale of the remainder, i.e. by a
1803 -- division or multiplication by the appropriate power of 10.
1805 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1806 Loc : constant Source_Ptr := Sloc (N);
1808 Dividend : Node_Id := First_Actual (N);
1809 Divisor : Node_Id := Next_Actual (Dividend);
1810 Quotient : Node_Id := Next_Actual (Divisor);
1811 Remainder : Node_Id := Next_Actual (Quotient);
1813 Dividend_Type : constant Entity_Id := Etype (Dividend);
1814 Divisor_Type : constant Entity_Id := Etype (Divisor);
1815 Quotient_Type : constant Entity_Id := Etype (Quotient);
1816 Remainder_Type : constant Entity_Id := Etype (Remainder);
1818 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1819 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1820 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1821 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1823 Q : Uint;
1824 Numerator_Scale : Uint;
1825 Stmts : List_Id;
1826 Qnn : Entity_Id;
1827 Rnn : Entity_Id;
1828 Computed_Remainder : Node_Id;
1829 Adjusted_Remainder : Node_Id;
1830 Scale_Adjust : Uint;
1832 begin
1833 -- Relocate the operands, since they are now list elements, and we
1834 -- need to reference them separately as operands in the expanded code.
1836 Dividend := Relocate_Node (Dividend);
1837 Divisor := Relocate_Node (Divisor);
1838 Quotient := Relocate_Node (Quotient);
1839 Remainder := Relocate_Node (Remainder);
1841 -- Now compute Q, the adjustment scale
1843 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1845 -- If Q is non-negative then we need a scaled divide
1847 if Q >= 0 then
1848 Build_Scaled_Divide_Code
1850 Dividend,
1851 Integer_Literal (N, Uint_10 ** Q),
1852 Divisor,
1853 Qnn, Rnn, Stmts);
1855 Numerator_Scale := Dividend_Scale + Q;
1857 -- If Q is negative, then we need a double divide
1859 else
1860 Build_Double_Divide_Code
1862 Dividend,
1863 Divisor,
1864 Integer_Literal (N, Uint_10 ** (-Q)),
1865 Qnn, Rnn, Stmts);
1867 Numerator_Scale := Dividend_Scale;
1868 end if;
1870 -- Add statement to set quotient value
1872 -- Quotient := quotient-type!(Qnn);
1874 Append_To (Stmts,
1875 Make_Assignment_Statement (Loc,
1876 Name => Quotient,
1877 Expression =>
1878 Unchecked_Convert_To (Quotient_Type,
1879 Build_Conversion (N, Quotient_Type,
1880 New_Occurrence_Of (Qnn, Loc)))));
1882 -- Now we need to deal with computing and setting the remainder. The
1883 -- scale of the remainder is in Numerator_Scale, and the desired
1884 -- scale is the scale of the given Remainder argument. There are
1885 -- three cases:
1887 -- Numerator_Scale > Remainder_Scale
1889 -- in this case, there are extra digits in the computed remainder
1890 -- which must be eliminated by an extra division:
1892 -- computed-remainder := Numerator rem Denominator
1893 -- scale_adjust = Numerator_Scale - Remainder_Scale
1894 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1896 -- Numerator_Scale = Remainder_Scale
1898 -- in this case, the we have the remainder we need
1900 -- computed-remainder := Numerator rem Denominator
1901 -- adjusted-remainder := computed-remainder
1903 -- Numerator_Scale < Remainder_Scale
1905 -- in this case, we have insufficient digits in the computed
1906 -- remainder, which must be eliminated by an extra multiply
1908 -- computed-remainder := Numerator rem Denominator
1909 -- scale_adjust = Remainder_Scale - Numerator_Scale
1910 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1912 -- Finally we assign the adjusted-remainder to the result Remainder
1913 -- with conversions to get the proper fixed-point type representation.
1915 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
1917 if Numerator_Scale > Remainder_Scale then
1918 Scale_Adjust := Numerator_Scale - Remainder_Scale;
1919 Adjusted_Remainder :=
1920 Build_Divide
1921 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1923 elsif Numerator_Scale = Remainder_Scale then
1924 Adjusted_Remainder := Computed_Remainder;
1926 else -- Numerator_Scale < Remainder_Scale
1927 Scale_Adjust := Remainder_Scale - Numerator_Scale;
1928 Adjusted_Remainder :=
1929 Build_Multiply
1930 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1931 end if;
1933 -- Assignment of remainder result
1935 Append_To (Stmts,
1936 Make_Assignment_Statement (Loc,
1937 Name => Remainder,
1938 Expression =>
1939 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
1941 -- Final step is to rewrite the call with a block containing the
1942 -- above sequence of constructed statements for the divide operation.
1944 Rewrite (N,
1945 Make_Block_Statement (Loc,
1946 Handled_Statement_Sequence =>
1947 Make_Handled_Sequence_Of_Statements (Loc,
1948 Statements => Stmts)));
1950 Analyze (N);
1952 end Expand_Decimal_Divide_Call;
1954 -----------------------------------------------
1955 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1956 -----------------------------------------------
1958 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
1959 Left : constant Node_Id := Left_Opnd (N);
1960 Right : constant Node_Id := Right_Opnd (N);
1962 begin
1963 if Etype (Left) = Universal_Real then
1964 Do_Divide_Universal_Fixed (N);
1966 elsif Etype (Right) = Universal_Real then
1967 Do_Divide_Fixed_Universal (N);
1969 else
1970 Do_Divide_Fixed_Fixed (N);
1971 end if;
1973 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
1975 -----------------------------------------------
1976 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1977 -----------------------------------------------
1979 -- The division is done in long_long_float, and the result is multiplied
1980 -- by the small ratio, which is Small (Right) / Small (Left). Special
1981 -- treatment is required for universal operands, which represent their
1982 -- own value and do not require conversion.
1984 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
1985 Left : constant Node_Id := Left_Opnd (N);
1986 Right : constant Node_Id := Right_Opnd (N);
1988 Left_Type : constant Entity_Id := Etype (Left);
1989 Right_Type : constant Entity_Id := Etype (Right);
1991 begin
1992 -- Case of left operand is universal real, the result we want is:
1994 -- Left_Value / (Right_Value * Right_Small)
1996 -- so we compute this as:
1998 -- (Left_Value / Right_Small) / Right_Value
2000 if Left_Type = Universal_Real then
2001 Set_Result (N,
2002 Build_Divide (N,
2003 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2004 Fpt_Value (Right)));
2006 -- Case of right operand is universal real, the result we want is
2008 -- (Left_Value * Left_Small) / Right_Value
2010 -- so we compute this as:
2012 -- Left_Value * (Left_Small / Right_Value)
2014 -- Note we invert to a multiplication since usually floating-point
2015 -- multiplication is much faster than floating-point division.
2017 elsif Right_Type = Universal_Real then
2018 Set_Result (N,
2019 Build_Multiply (N,
2020 Fpt_Value (Left),
2021 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2023 -- Both operands are fixed, so the value we want is
2025 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2027 -- which we compute as:
2029 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2031 else
2032 Set_Result (N,
2033 Build_Multiply (N,
2034 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2035 Real_Literal (N,
2036 Small_Value (Left_Type) / Small_Value (Right_Type))));
2037 end if;
2039 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2041 -------------------------------------------------
2042 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2043 -------------------------------------------------
2045 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2046 Left : constant Node_Id := Left_Opnd (N);
2047 Right : constant Node_Id := Right_Opnd (N);
2049 begin
2050 if Etype (Left) = Universal_Real then
2051 Do_Divide_Universal_Fixed (N);
2053 elsif Etype (Right) = Universal_Real then
2054 Do_Divide_Fixed_Universal (N);
2056 else
2057 Do_Divide_Fixed_Fixed (N);
2058 end if;
2060 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2062 -------------------------------------------------
2063 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2064 -------------------------------------------------
2066 -- Since the operand and result fixed-point type is the same, this is
2067 -- a straight divide by the right operand, the small can be ignored.
2069 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2070 Left : constant Node_Id := Left_Opnd (N);
2071 Right : constant Node_Id := Right_Opnd (N);
2073 begin
2074 Set_Result (N, Build_Divide (N, Left, Right));
2075 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2077 -------------------------------------------------
2078 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2079 -------------------------------------------------
2081 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2082 Left : constant Node_Id := Left_Opnd (N);
2083 Right : constant Node_Id := Right_Opnd (N);
2085 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2086 -- The operand may be a non-static universal value, such an
2087 -- exponentiation with a non-static exponent. In that case, treat
2088 -- as a fixed * fixed multiplication, and convert the argument to
2089 -- the target fixed type.
2091 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2092 Loc : constant Source_Ptr := Sloc (N);
2094 begin
2095 Rewrite (Opnd,
2096 Make_Type_Conversion (Loc,
2097 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2098 Expression => Expression (Opnd)));
2099 Analyze_And_Resolve (Opnd, Etype (N));
2100 end Rewrite_Non_Static_Universal;
2102 begin
2103 if Etype (Left) = Universal_Real then
2104 if Nkind (Left) = N_Real_Literal then
2105 Do_Multiply_Fixed_Universal (N, Right, Left);
2107 elsif Nkind (Left) = N_Type_Conversion then
2108 Rewrite_Non_Static_Universal (Left);
2109 Do_Multiply_Fixed_Fixed (N);
2110 end if;
2112 elsif Etype (Right) = Universal_Real then
2113 if Nkind (Right) = N_Real_Literal then
2114 Do_Multiply_Fixed_Universal (N, Left, Right);
2116 elsif Nkind (Right) = N_Type_Conversion then
2117 Rewrite_Non_Static_Universal (Right);
2118 Do_Multiply_Fixed_Fixed (N);
2119 end if;
2121 else
2122 Do_Multiply_Fixed_Fixed (N);
2123 end if;
2125 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2127 -------------------------------------------------
2128 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2129 -------------------------------------------------
2131 -- The multiply is done in long_long_float, and the result is multiplied
2132 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2133 -- Special treatment is required for universal operands.
2135 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2136 Left : constant Node_Id := Left_Opnd (N);
2137 Right : constant Node_Id := Right_Opnd (N);
2139 Left_Type : constant Entity_Id := Etype (Left);
2140 Right_Type : constant Entity_Id := Etype (Right);
2142 begin
2143 -- Case of left operand is universal real, the result we want is
2145 -- Left_Value * (Right_Value * Right_Small)
2147 -- so we compute this as:
2149 -- (Left_Value * Right_Small) * Right_Value;
2151 if Left_Type = Universal_Real then
2152 Set_Result (N,
2153 Build_Multiply (N,
2154 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2155 Fpt_Value (Right)));
2157 -- Case of right operand is universal real, the result we want is
2159 -- (Left_Value * Left_Small) * Right_Value
2161 -- so we compute this as:
2163 -- Left_Value * (Left_Small * Right_Value)
2165 elsif Right_Type = Universal_Real then
2166 Set_Result (N,
2167 Build_Multiply (N,
2168 Fpt_Value (Left),
2169 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2171 -- Both operands are fixed, so the value we want is
2173 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2175 -- which we compute as:
2177 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2179 else
2180 Set_Result (N,
2181 Build_Multiply (N,
2182 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2183 Real_Literal (N,
2184 Small_Value (Right_Type) * Small_Value (Left_Type))));
2185 end if;
2187 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2189 ---------------------------------------------------
2190 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2191 ---------------------------------------------------
2193 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2194 Left : constant Node_Id := Left_Opnd (N);
2195 Right : constant Node_Id := Right_Opnd (N);
2197 begin
2198 if Etype (Left) = Universal_Real then
2199 Do_Multiply_Fixed_Universal (N, Right, Left);
2201 elsif Etype (Right) = Universal_Real then
2202 Do_Multiply_Fixed_Universal (N, Left, Right);
2204 else
2205 Do_Multiply_Fixed_Fixed (N);
2206 end if;
2208 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2210 ---------------------------------------------------
2211 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2212 ---------------------------------------------------
2214 -- Since the operand and result fixed-point type is the same, this is
2215 -- a straight multiply by the right operand, the small can be ignored.
2217 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2218 begin
2219 Set_Result (N,
2220 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2221 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2223 ---------------------------------------------------
2224 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2225 ---------------------------------------------------
2227 -- Since the operand and result fixed-point type is the same, this is
2228 -- a straight multiply by the right operand, the small can be ignored.
2230 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2231 begin
2232 Set_Result (N,
2233 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2234 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2236 ---------------
2237 -- Fpt_Value --
2238 ---------------
2240 function Fpt_Value (N : Node_Id) return Node_Id is
2241 Typ : constant Entity_Id := Etype (N);
2243 begin
2244 if Is_Integer_Type (Typ)
2245 or else Is_Floating_Point_Type (Typ)
2246 then
2247 return
2248 Build_Conversion
2249 (N, Standard_Long_Long_Float, N);
2251 -- Fixed-point case, must get integer value first
2253 else
2254 return
2255 Build_Conversion (N, Standard_Long_Long_Float, N);
2256 end if;
2258 end Fpt_Value;
2260 ---------------------
2261 -- Integer_Literal --
2262 ---------------------
2264 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is
2265 T : Entity_Id;
2266 L : Node_Id;
2268 begin
2269 if V < Uint_2 ** 7 then
2270 T := Standard_Integer_8;
2272 elsif V < Uint_2 ** 15 then
2273 T := Standard_Integer_16;
2275 elsif V < Uint_2 ** 31 then
2276 T := Standard_Integer_32;
2278 elsif V < Uint_2 ** 63 then
2279 T := Standard_Integer_64;
2281 else
2282 return Empty;
2283 end if;
2285 L := Make_Integer_Literal (Sloc (N), V);
2287 -- Set type of result in case used elsewhere (see note at start)
2289 Set_Etype (L, T);
2290 Set_Is_Static_Expression (L);
2292 -- We really need to set Analyzed here because we may be creating a
2293 -- very strange beast, namely an integer literal typed as fixed-point
2294 -- and the analyzer won't like that. Probably we should allow the
2295 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2296 -- and teach the analyzer how to handle them ???
2298 Set_Analyzed (L);
2299 return L;
2301 end Integer_Literal;
2303 ------------------
2304 -- Real_Literal --
2305 ------------------
2307 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2308 L : Node_Id;
2310 begin
2311 L := Make_Real_Literal (Sloc (N), V);
2313 -- Set type of result in case used elsewhere (see note at start)
2315 Set_Etype (L, Standard_Long_Long_Float);
2316 return L;
2317 end Real_Literal;
2319 ------------------------
2320 -- Rounded_Result_Set --
2321 ------------------------
2323 function Rounded_Result_Set (N : Node_Id) return Boolean is
2324 K : constant Node_Kind := Nkind (N);
2326 begin
2327 if (K = N_Type_Conversion or else
2328 K = N_Op_Divide or else
2329 K = N_Op_Multiply)
2330 and then Rounded_Result (N)
2331 then
2332 return True;
2333 else
2334 return False;
2335 end if;
2336 end Rounded_Result_Set;
2338 ----------------
2339 -- Set_Result --
2340 ----------------
2342 procedure Set_Result
2343 (N : Node_Id;
2344 Expr : Node_Id;
2345 Rchk : Boolean := False)
2347 Cnode : Node_Id;
2349 Expr_Type : constant Entity_Id := Etype (Expr);
2350 Result_Type : constant Entity_Id := Etype (N);
2352 begin
2353 -- No conversion required if types match and no range check
2355 if Result_Type = Expr_Type and then not Rchk then
2356 Cnode := Expr;
2358 -- Else perform required conversion
2360 else
2361 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
2362 end if;
2364 Rewrite (N, Cnode);
2365 Analyze_And_Resolve (N, Result_Type);
2367 end Set_Result;
2369 end Exp_Fixd;