config/sparc/sol2-bi.h: Revert previous delta.
[official-gcc.git] / gcc / ada / exp_fixd.adb
blob862180aec3bbc529f6c216686154b2d54cb345e1
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ F I X D --
6 -- --
7 -- B o d y --
8 -- --
9 -- --
10 -- Copyright (C) 1992-2001 Free Software Foundation, Inc. --
11 -- --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
22 -- --
23 -- GNAT was originally developed by the GNAT team at New York University. --
24 -- Extensive contributions were provided by Ada Core Technologies Inc. --
25 -- --
26 ------------------------------------------------------------------------------
28 with Atree; use Atree;
29 with Checks; use Checks;
30 with Einfo; use Einfo;
31 with Exp_Util; use Exp_Util;
32 with Nlists; use Nlists;
33 with Nmake; use Nmake;
34 with Restrict; use Restrict;
35 with Rtsfind; use Rtsfind;
36 with Sem; use Sem;
37 with Sem_Eval; use Sem_Eval;
38 with Sem_Res; use Sem_Res;
39 with Sem_Util; use Sem_Util;
40 with Sinfo; use Sinfo;
41 with Stand; use Stand;
42 with Tbuild; use Tbuild;
43 with Ttypes; use Ttypes;
44 with Uintp; use Uintp;
45 with Urealp; use Urealp;
47 package body Exp_Fixd is
49 -----------------------
50 -- Local Subprograms --
51 -----------------------
53 -- General note; in this unit, a number of routines are driven by the
54 -- types (Etype) of their operands. Since we are dealing with unanalyzed
55 -- expressions as they are constructed, the Etypes would not normally be
56 -- set, but the construction routines that we use in this unit do in fact
57 -- set the Etype values correctly. In addition, setting the Etype ensures
58 -- that the analyzer does not try to redetermine the type when the node
59 -- is analyzed (which would be wrong, since in the case where we set the
60 -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was
61 -- still dealing with a normal fixed-point operation and mess it up).
63 function Build_Conversion
64 (N : Node_Id;
65 Typ : Entity_Id;
66 Expr : Node_Id;
67 Rchk : Boolean := False)
68 return Node_Id;
69 -- Build an expression that converts the expression Expr to type Typ,
70 -- taking the source location from Sloc (N). If the conversions involve
71 -- fixed-point types, then the Conversion_OK flag will be set so that the
72 -- resulting conversions do not get re-expanded. On return the resulting
73 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
74 -- in the resulting conversion node.
76 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
77 -- Builds an N_Op_Divide node from the given left and right operand
78 -- expressions, using the source location from Sloc (N). The operands
79 -- are either both Long_Long_Float, in which case Build_Divide differs
80 -- from Make_Op_Divide only in that the Etype of the resulting node is
81 -- set (to Long_Long_Float), or they can be integer types. In this case
82 -- the integer types need not be the same, and Build_Divide converts
83 -- the operand with the smaller sized type to match the type of the
84 -- other operand and sets this as the result type. The Rounded_Result
85 -- flag of the result in this case is set from the Rounded_Result flag
86 -- of node N. On return, the resulting node is analyzed, and has its
87 -- Etype set.
89 function Build_Double_Divide
90 (N : Node_Id;
91 X, Y, Z : Node_Id)
92 return Node_Id;
93 -- Returns a node corresponding to the value X/(Y*Z) using the source
94 -- location from Sloc (N). The division is rounded if the Rounded_Result
95 -- flag of N is set. The integer types of X, Y, Z may be different. On
96 -- return the resulting node is analyzed, and has its Etype set.
98 procedure Build_Double_Divide_Code
99 (N : Node_Id;
100 X, Y, Z : Node_Id;
101 Qnn, Rnn : out Entity_Id;
102 Code : out List_Id);
103 -- Generates a sequence of code for determining the quotient and remainder
104 -- of the division X/(Y*Z), using the source location from Sloc (N).
105 -- Entities of appropriate types are allocated for the quotient and
106 -- remainder and returned in Qnn and Rnn. The result is rounded if
107 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn
108 -- are appropriately set on return.
110 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
111 -- Builds an N_Op_Multiply node from the given left and right operand
112 -- expressions, using the source location from Sloc (N). The operands
113 -- are either both Long_Long_Float, in which case Build_Divide differs
114 -- from Make_Op_Multiply only in that the Etype of the resulting node is
115 -- set (to Long_Long_Float), or they can be integer types. In this case
116 -- the integer types need not be the same, and Build_Multiply chooses
117 -- a type long enough to hold the product (i.e. twice the size of the
118 -- longer of the two operand types), and both operands are converted
119 -- to this type. The Etype of the result is also set to this value.
120 -- However, the result can never overflow Integer_64, so this is the
121 -- largest type that is ever generated. On return, the resulting node
122 -- is analyzed and has its Etype set.
124 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id;
125 -- Builds an N_Op_Rem node from the given left and right operand
126 -- expressions, using the source location from Sloc (N). The operands
127 -- are both integer types, which need not be the same. Build_Rem
128 -- converts the operand with the smaller sized type to match the type
129 -- of the other operand and sets this as the result type. The result
130 -- is never rounded (rem operations cannot be rounded in any case!)
131 -- On return, the resulting node is analyzed and has its Etype set.
133 function Build_Scaled_Divide
134 (N : Node_Id;
135 X, Y, Z : Node_Id)
136 return Node_Id;
137 -- Returns a node corresponding to the value X*Y/Z using the source
138 -- location from Sloc (N). The division is rounded if the Rounded_Result
139 -- flag of N is set. The integer types of X, Y, Z may be different. On
140 -- return the resulting node is analyzed and has is Etype set.
142 procedure Build_Scaled_Divide_Code
143 (N : Node_Id;
144 X, Y, Z : Node_Id;
145 Qnn, Rnn : out Entity_Id;
146 Code : out List_Id);
147 -- Generates a sequence of code for determining the quotient and remainder
148 -- of the division X*Y/Z, using the source location from Sloc (N). Entities
149 -- of appropriate types are allocated for the quotient and remainder and
150 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
151 -- The division is rounded if the Rounded_Result flag of N is set. The
152 -- Etype fields of Qnn and Rnn are appropriately set on return.
154 procedure Do_Divide_Fixed_Fixed (N : Node_Id);
155 -- Handles expansion of divide for case of two fixed-point operands
156 -- (neither of them universal), with an integer or fixed-point result.
157 -- N is the N_Op_Divide node to be expanded.
159 procedure Do_Divide_Fixed_Universal (N : Node_Id);
160 -- Handles expansion of divide for case of a fixed-point operand divided
161 -- by a universal real operand, with an integer or fixed-point result. N
162 -- is the N_Op_Divide node to be expanded.
164 procedure Do_Divide_Universal_Fixed (N : Node_Id);
165 -- Handles expansion of divide for case of a universal real operand
166 -- divided by a fixed-point operand, with an integer or fixed-point
167 -- result. N is the N_Op_Divide node to be expanded.
169 procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
170 -- Handles expansion of multiply for case of two fixed-point operands
171 -- (neither of them universal), with an integer or fixed-point result.
172 -- N is the N_Op_Multiply node to be expanded.
174 procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
175 -- Handles expansion of multiply for case of a fixed-point operand
176 -- multiplied by a universal real operand, with an integer or fixed-
177 -- point result. N is the N_Op_Multiply node to be expanded, and
178 -- Left, Right are the operands (which may have been switched).
180 procedure Expand_Convert_Fixed_Static (N : Node_Id);
181 -- This routine is called where the node N is a conversion of a literal
182 -- or other static expression of a fixed-point type to some other type.
183 -- In such cases, we simply rewrite the operand as a real literal and
184 -- reanalyze. This avoids problems which would otherwise result from
185 -- attempting to build and fold expressions involving constants.
187 function Fpt_Value (N : Node_Id) return Node_Id;
188 -- Given an operand of fixed-point operation, return an expression that
189 -- represents the corresponding Long_Long_Float value. The expression
190 -- can be of integer type, floating-point type, or fixed-point type.
191 -- The expression returned is neither analyzed and resolved. The Etype
192 -- of the result is properly set (to Long_Long_Float).
194 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id;
195 -- Given a non-negative universal integer value, build a typed integer
196 -- literal node, using the smallest applicable standard integer type. If
197 -- the value exceeds 2**63-1, the largest value allowed for perfect result
198 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The
199 -- node N provides the Sloc value for the constructed literal. The Etype
200 -- of the resulting literal is correctly set, and it is marked as analyzed.
202 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
203 -- Build a real literal node from the given value, the Etype of the
204 -- returned node is set to Long_Long_Float, since all floating-point
205 -- arithmetic operations that we construct use Long_Long_Float
207 function Rounded_Result_Set (N : Node_Id) return Boolean;
208 -- Returns True if N is a node that contains the Rounded_Result flag
209 -- and if the flag is true.
211 procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False);
212 -- N is the node for the current conversion, division or multiplication
213 -- operation, and Expr is an expression representing the result. Expr
214 -- may be of floating-point or integer type. If the operation result
215 -- is fixed-point, then the value of Expr is in units of small of the
216 -- result type (i.e. small's have already been dealt with). The result
217 -- of the call is to replace N by an appropriate conversion to the
218 -- result type, dealing with rounding for the decimal types case. The
219 -- node is then analyzed and resolved using the result type. If Rchk
220 -- is True, then Do_Range_Check is set in the resulting conversion.
222 ----------------------
223 -- Build_Conversion --
224 ----------------------
226 function Build_Conversion
227 (N : Node_Id;
228 Typ : Entity_Id;
229 Expr : Node_Id;
230 Rchk : Boolean := False)
231 return Node_Id
233 Loc : constant Source_Ptr := Sloc (N);
234 Result : Node_Id;
235 Rcheck : Boolean := Rchk;
237 begin
238 -- A special case, if the expression is an integer literal and the
239 -- target type is an integer type, then just retype the integer
240 -- literal to the desired target type. Don't do this if we need
241 -- a range check.
243 if Nkind (Expr) = N_Integer_Literal
244 and then Is_Integer_Type (Typ)
245 and then not Rchk
246 then
247 Result := Expr;
249 -- Cases where we end up with a conversion. Note that we do not use the
250 -- Convert_To abstraction here, since we may be decorating the resulting
251 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
252 -- conversion node present, even if it appears to be redundant.
254 else
255 -- Remove inner conversion if both inner and outer conversions are
256 -- to integer types, since the inner one serves no purpose (except
257 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
258 -- and also we preserve the range check flag on the inner operand
260 if Is_Integer_Type (Typ)
261 and then Is_Integer_Type (Etype (Expr))
262 and then Nkind (Expr) = N_Type_Conversion
263 then
264 Result :=
265 Make_Type_Conversion (Loc,
266 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
267 Expression => Expression (Expr));
268 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
269 Rcheck := Rcheck or Do_Range_Check (Expr);
271 -- For all other cases, a simple type conversion will work
273 else
274 Result :=
275 Make_Type_Conversion (Loc,
276 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
277 Expression => Expr);
278 end if;
280 -- Set Conversion_OK if either result or expression type is a
281 -- fixed-point type, since from a semantic point of view, we are
282 -- treating fixed-point values as integers at this stage.
284 if Is_Fixed_Point_Type (Typ)
285 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
286 then
287 Set_Conversion_OK (Result);
288 end if;
290 -- Set Do_Range_Check if either it was requested by the caller,
291 -- or if an eliminated inner conversion had a range check.
293 if Rcheck then
294 Enable_Range_Check (Result);
295 else
296 Set_Do_Range_Check (Result, False);
297 end if;
298 end if;
300 Set_Etype (Result, Typ);
301 return Result;
303 end Build_Conversion;
305 ------------------
306 -- Build_Divide --
307 ------------------
309 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
310 Loc : constant Source_Ptr := Sloc (N);
311 Left_Type : constant Entity_Id := Base_Type (Etype (L));
312 Right_Type : constant Entity_Id := Base_Type (Etype (R));
313 Result_Type : Entity_Id;
314 Rnode : Node_Id;
316 begin
317 -- Deal with floating-point case first
319 if Is_Floating_Point_Type (Left_Type) then
320 pragma Assert (Left_Type = Standard_Long_Long_Float);
321 pragma Assert (Right_Type = Standard_Long_Long_Float);
323 Rnode := Make_Op_Divide (Loc, L, R);
324 Result_Type := Standard_Long_Long_Float;
326 -- Integer and fixed-point cases
328 else
329 -- An optimization. If the right operand is the literal 1, then we
330 -- can just return the left hand operand. Putting the optimization
331 -- here allows us to omit the check at the call site.
333 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
334 return L;
335 end if;
337 -- If left and right types are the same, no conversion needed
339 if Left_Type = Right_Type then
340 Result_Type := Left_Type;
341 Rnode :=
342 Make_Op_Divide (Loc,
343 Left_Opnd => L,
344 Right_Opnd => R);
346 -- Use left type if it is the larger of the two
348 elsif Esize (Left_Type) >= Esize (Right_Type) then
349 Result_Type := Left_Type;
350 Rnode :=
351 Make_Op_Divide (Loc,
352 Left_Opnd => L,
353 Right_Opnd => Build_Conversion (N, Left_Type, R));
355 -- Otherwise right type is larger of the two, us it
357 else
358 Result_Type := Right_Type;
359 Rnode :=
360 Make_Op_Divide (Loc,
361 Left_Opnd => Build_Conversion (N, Right_Type, L),
362 Right_Opnd => R);
363 end if;
364 end if;
366 -- We now have a divide node built with Result_Type set. First
367 -- set Etype of result, as required for all Build_xxx routines
369 Set_Etype (Rnode, Base_Type (Result_Type));
371 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
372 -- since this is a literal arithmetic operation, to be performed
373 -- by Gigi without any consideration of small values.
375 if Is_Fixed_Point_Type (Result_Type) then
376 Set_Treat_Fixed_As_Integer (Rnode);
377 end if;
379 -- The result is rounded if the target of the operation is decimal
380 -- and Rounded_Result is set, or if the target of the operation
381 -- is an integer type.
383 if Is_Integer_Type (Etype (N))
384 or else Rounded_Result_Set (N)
385 then
386 Set_Rounded_Result (Rnode);
387 end if;
389 return Rnode;
391 end Build_Divide;
393 -------------------------
394 -- Build_Double_Divide --
395 -------------------------
397 function Build_Double_Divide
398 (N : Node_Id;
399 X, Y, Z : Node_Id)
400 return Node_Id
402 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
403 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
404 Expr : Node_Id;
406 begin
407 if Y_Size > System_Word_Size
408 or else
409 Z_Size > System_Word_Size
410 then
411 Disallow_In_No_Run_Time_Mode (N);
412 end if;
414 -- If denominator fits in 64 bits, we can build the operations directly
415 -- without causing any intermediate overflow, so that's what we do!
417 if Int'Max (Y_Size, Z_Size) <= 32 then
418 return
419 Build_Divide (N, X, Build_Multiply (N, Y, Z));
421 -- Otherwise we use the runtime routine
423 -- [Qnn : Interfaces.Integer_64,
424 -- Rnn : Interfaces.Integer_64;
425 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);
426 -- Qnn]
428 else
429 declare
430 Loc : constant Source_Ptr := Sloc (N);
431 Qnn : Entity_Id;
432 Rnn : Entity_Id;
433 Code : List_Id;
435 begin
436 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
437 Insert_Actions (N, Code);
438 Expr := New_Occurrence_Of (Qnn, Loc);
440 -- Set type of result in case used elsewhere (see note at start)
442 Set_Etype (Expr, Etype (Qnn));
444 -- Set result as analyzed (see note at start on build routines)
446 return Expr;
447 end;
448 end if;
449 end Build_Double_Divide;
451 ------------------------------
452 -- Build_Double_Divide_Code --
453 ------------------------------
455 -- If the denominator can be computed in 64-bits, we build
457 -- [Nnn : constant typ := typ (X);
458 -- Dnn : constant typ := typ (Y) * typ (Z)
459 -- Qnn : constant typ := Nnn / Dnn;
460 -- Rnn : constant typ := Nnn / Dnn;
462 -- If the numerator cannot be computed in 64 bits, we build
464 -- [Qnn : typ;
465 -- Rnn : typ;
466 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);]
468 procedure Build_Double_Divide_Code
469 (N : Node_Id;
470 X, Y, Z : Node_Id;
471 Qnn, Rnn : out Entity_Id;
472 Code : out List_Id)
474 Loc : constant Source_Ptr := Sloc (N);
476 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
477 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
478 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
480 QR_Siz : Int;
481 QR_Typ : Entity_Id;
483 Nnn : Entity_Id;
484 Dnn : Entity_Id;
486 Quo : Node_Id;
487 Rnd : Entity_Id;
489 begin
490 -- Find type that will allow computation of numerator
492 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
494 if QR_Siz <= 16 then
495 QR_Typ := Standard_Integer_16;
496 elsif QR_Siz <= 32 then
497 QR_Typ := Standard_Integer_32;
498 elsif QR_Siz <= 64 then
499 QR_Typ := Standard_Integer_64;
501 -- For more than 64, bits, we use the 64-bit integer defined in
502 -- Interfaces, so that it can be handled by the runtime routine
504 else
505 QR_Typ := RTE (RE_Integer_64);
506 end if;
508 -- Define quotient and remainder, and set their Etypes, so
509 -- that they can be picked up by Build_xxx routines.
511 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
512 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
514 Set_Etype (Qnn, QR_Typ);
515 Set_Etype (Rnn, QR_Typ);
517 -- Case that we can compute the denominator in 64 bits
519 if QR_Siz <= 64 then
521 -- Create temporaries for numerator and denominator and set Etypes,
522 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
524 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
525 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
527 Set_Etype (Nnn, QR_Typ);
528 Set_Etype (Dnn, QR_Typ);
530 Code := New_List (
531 Make_Object_Declaration (Loc,
532 Defining_Identifier => Nnn,
533 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
534 Constant_Present => True,
535 Expression => Build_Conversion (N, QR_Typ, X)),
537 Make_Object_Declaration (Loc,
538 Defining_Identifier => Dnn,
539 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
540 Constant_Present => True,
541 Expression =>
542 Build_Multiply (N,
543 Build_Conversion (N, QR_Typ, Y),
544 Build_Conversion (N, QR_Typ, Z))));
546 Quo :=
547 Build_Divide (N,
548 New_Occurrence_Of (Nnn, Loc),
549 New_Occurrence_Of (Dnn, Loc));
551 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
553 Append_To (Code,
554 Make_Object_Declaration (Loc,
555 Defining_Identifier => Qnn,
556 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
557 Constant_Present => True,
558 Expression => Quo));
560 Append_To (Code,
561 Make_Object_Declaration (Loc,
562 Defining_Identifier => Rnn,
563 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
564 Constant_Present => True,
565 Expression =>
566 Build_Rem (N,
567 New_Occurrence_Of (Nnn, Loc),
568 New_Occurrence_Of (Dnn, Loc))));
570 -- Case where denominator does not fit in 64 bits, so we have to
571 -- call the runtime routine to compute the quotient and remainder
573 else
574 if Rounded_Result_Set (N) then
575 Rnd := Standard_True;
576 else
577 Rnd := Standard_False;
578 end if;
580 Code := New_List (
581 Make_Object_Declaration (Loc,
582 Defining_Identifier => Qnn,
583 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
585 Make_Object_Declaration (Loc,
586 Defining_Identifier => Rnn,
587 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
589 Make_Procedure_Call_Statement (Loc,
590 Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc),
591 Parameter_Associations => New_List (
592 Build_Conversion (N, QR_Typ, X),
593 Build_Conversion (N, QR_Typ, Y),
594 Build_Conversion (N, QR_Typ, Z),
595 New_Occurrence_Of (Qnn, Loc),
596 New_Occurrence_Of (Rnn, Loc),
597 New_Occurrence_Of (Rnd, Loc))));
598 end if;
600 end Build_Double_Divide_Code;
602 --------------------
603 -- Build_Multiply --
604 --------------------
606 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
607 Loc : constant Source_Ptr := Sloc (N);
608 Left_Type : constant Entity_Id := Etype (L);
609 Right_Type : constant Entity_Id := Etype (R);
610 Rsize : Int;
611 Result_Type : Entity_Id;
612 Rnode : Node_Id;
614 begin
615 -- Deal with floating-point case first
617 if Is_Floating_Point_Type (Left_Type) then
618 pragma Assert (Left_Type = Standard_Long_Long_Float);
619 pragma Assert (Right_Type = Standard_Long_Long_Float);
621 Result_Type := Standard_Long_Long_Float;
622 Rnode := Make_Op_Multiply (Loc, L, R);
624 -- Integer and fixed-point cases
626 else
627 -- An optimization. If the right operand is the literal 1, then we
628 -- can just return the left hand operand. Putting the optimization
629 -- here allows us to omit the check at the call site. Similarly, if
630 -- the left operand is the integer 1 we can return the right operand.
632 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
633 return L;
634 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
635 return R;
636 end if;
638 -- Otherwise we use a type that is at least twice the longer
639 -- of the two sizes.
641 Rsize := 2 * Int'Max (UI_To_Int (Esize (Left_Type)),
642 UI_To_Int (Esize (Right_Type)));
644 if Rsize <= 8 then
645 Result_Type := Standard_Integer_8;
647 elsif Rsize <= 16 then
648 Result_Type := Standard_Integer_16;
650 elsif Rsize <= 32 then
651 Result_Type := Standard_Integer_32;
653 else
654 if Rsize > System_Word_Size then
655 Disallow_In_No_Run_Time_Mode (N);
656 end if;
658 Result_Type := Standard_Integer_64;
659 end if;
661 Rnode :=
662 Make_Op_Multiply (Loc,
663 Left_Opnd => Build_Conversion (N, Result_Type, L),
664 Right_Opnd => Build_Conversion (N, Result_Type, R));
665 end if;
667 -- We now have a multiply node built with Result_Type set. First
668 -- set Etype of result, as required for all Build_xxx routines
670 Set_Etype (Rnode, Base_Type (Result_Type));
672 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
673 -- since this is a literal arithmetic operation, to be performed
674 -- by Gigi without any consideration of small values.
676 if Is_Fixed_Point_Type (Result_Type) then
677 Set_Treat_Fixed_As_Integer (Rnode);
678 end if;
680 return Rnode;
681 end Build_Multiply;
683 ---------------
684 -- Build_Rem --
685 ---------------
687 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
688 Loc : constant Source_Ptr := Sloc (N);
689 Left_Type : constant Entity_Id := Etype (L);
690 Right_Type : constant Entity_Id := Etype (R);
691 Result_Type : Entity_Id;
692 Rnode : Node_Id;
694 begin
695 if Left_Type = Right_Type then
696 Result_Type := Left_Type;
697 Rnode :=
698 Make_Op_Rem (Loc,
699 Left_Opnd => L,
700 Right_Opnd => R);
702 -- If left size is larger, we do the remainder operation using the
703 -- size of the left type (i.e. the larger of the two integer types).
705 elsif Esize (Left_Type) >= Esize (Right_Type) then
706 Result_Type := Left_Type;
707 Rnode :=
708 Make_Op_Rem (Loc,
709 Left_Opnd => L,
710 Right_Opnd => Build_Conversion (N, Left_Type, R));
712 -- Similarly, if the right size is larger, we do the remainder
713 -- operation using the right type.
715 else
716 Result_Type := Right_Type;
717 Rnode :=
718 Make_Op_Rem (Loc,
719 Left_Opnd => Build_Conversion (N, Right_Type, L),
720 Right_Opnd => R);
721 end if;
723 -- We now have an N_Op_Rem node built with Result_Type set. First
724 -- set Etype of result, as required for all Build_xxx routines
726 Set_Etype (Rnode, Base_Type (Result_Type));
728 -- Set Treat_Fixed_As_Integer if operation on fixed-point type
729 -- since this is a literal arithmetic operation, to be performed
730 -- by Gigi without any consideration of small values.
732 if Is_Fixed_Point_Type (Result_Type) then
733 Set_Treat_Fixed_As_Integer (Rnode);
734 end if;
736 -- One more check. We did the rem operation using the larger of the
737 -- two types, which is reasonable. However, in the case where the
738 -- two types have unequal sizes, it is impossible for the result of
739 -- a remainder operation to be larger than the smaller of the two
740 -- types, so we can put a conversion round the result to keep the
741 -- evolving operation size as small as possible.
743 if Esize (Left_Type) >= Esize (Right_Type) then
744 Rnode := Build_Conversion (N, Right_Type, Rnode);
745 elsif Esize (Right_Type) >= Esize (Left_Type) then
746 Rnode := Build_Conversion (N, Left_Type, Rnode);
747 end if;
749 return Rnode;
750 end Build_Rem;
752 -------------------------
753 -- Build_Scaled_Divide --
754 -------------------------
756 function Build_Scaled_Divide
757 (N : Node_Id;
758 X, Y, Z : Node_Id)
759 return Node_Id
761 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
762 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
763 Expr : Node_Id;
765 begin
766 -- If numerator fits in 64 bits, we can build the operations directly
767 -- without causing any intermediate overflow, so that's what we do!
769 if Int'Max (X_Size, Y_Size) <= 32 then
770 return
771 Build_Divide (N, Build_Multiply (N, X, Y), Z);
773 -- Otherwise we use the runtime routine
775 -- [Qnn : Integer_64,
776 -- Rnn : Integer_64;
777 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);
778 -- Qnn]
780 else
781 declare
782 Loc : constant Source_Ptr := Sloc (N);
783 Qnn : Entity_Id;
784 Rnn : Entity_Id;
785 Code : List_Id;
787 begin
788 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
789 Insert_Actions (N, Code);
790 Expr := New_Occurrence_Of (Qnn, Loc);
792 -- Set type of result in case used elsewhere (see note at start)
794 Set_Etype (Expr, Etype (Qnn));
795 return Expr;
796 end;
797 end if;
798 end Build_Scaled_Divide;
800 ------------------------------
801 -- Build_Scaled_Divide_Code --
802 ------------------------------
804 -- If the numerator can be computed in 64-bits, we build
806 -- [Nnn : constant typ := typ (X) * typ (Y);
807 -- Dnn : constant typ := typ (Z)
808 -- Qnn : constant typ := Nnn / Dnn;
809 -- Rnn : constant typ := Nnn / Dnn;
811 -- If the numerator cannot be computed in 64 bits, we build
813 -- [Qnn : Interfaces.Integer_64;
814 -- Rnn : Interfaces.Integer_64;
815 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);]
817 procedure Build_Scaled_Divide_Code
818 (N : Node_Id;
819 X, Y, Z : Node_Id;
820 Qnn, Rnn : out Entity_Id;
821 Code : out List_Id)
823 Loc : constant Source_Ptr := Sloc (N);
825 X_Size : constant Int := UI_To_Int (Esize (Etype (X)));
826 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y)));
827 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z)));
829 QR_Siz : Int;
830 QR_Typ : Entity_Id;
832 Nnn : Entity_Id;
833 Dnn : Entity_Id;
835 Quo : Node_Id;
836 Rnd : Entity_Id;
838 begin
839 -- Find type that will allow computation of numerator
841 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size));
843 if QR_Siz <= 16 then
844 QR_Typ := Standard_Integer_16;
845 elsif QR_Siz <= 32 then
846 QR_Typ := Standard_Integer_32;
847 elsif QR_Siz <= 64 then
848 QR_Typ := Standard_Integer_64;
850 -- For more than 64, bits, we use the 64-bit integer defined in
851 -- Interfaces, so that it can be handled by the runtime routine
853 else
854 QR_Typ := RTE (RE_Integer_64);
855 end if;
857 -- Define quotient and remainder, and set their Etypes, so
858 -- that they can be picked up by Build_xxx routines.
860 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S'));
861 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R'));
863 Set_Etype (Qnn, QR_Typ);
864 Set_Etype (Rnn, QR_Typ);
866 -- Case that we can compute the numerator in 64 bits
868 if QR_Siz <= 64 then
869 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N'));
870 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D'));
872 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
874 Set_Etype (Nnn, QR_Typ);
875 Set_Etype (Dnn, QR_Typ);
877 Code := New_List (
878 Make_Object_Declaration (Loc,
879 Defining_Identifier => Nnn,
880 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
881 Constant_Present => True,
882 Expression =>
883 Build_Multiply (N,
884 Build_Conversion (N, QR_Typ, X),
885 Build_Conversion (N, QR_Typ, Y))),
887 Make_Object_Declaration (Loc,
888 Defining_Identifier => Dnn,
889 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
890 Constant_Present => True,
891 Expression => Build_Conversion (N, QR_Typ, Z)));
893 Quo :=
894 Build_Divide (N,
895 New_Occurrence_Of (Nnn, Loc),
896 New_Occurrence_Of (Dnn, Loc));
898 Append_To (Code,
899 Make_Object_Declaration (Loc,
900 Defining_Identifier => Qnn,
901 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
902 Constant_Present => True,
903 Expression => Quo));
905 Append_To (Code,
906 Make_Object_Declaration (Loc,
907 Defining_Identifier => Rnn,
908 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
909 Constant_Present => True,
910 Expression =>
911 Build_Rem (N,
912 New_Occurrence_Of (Nnn, Loc),
913 New_Occurrence_Of (Dnn, Loc))));
915 -- Case where numerator does not fit in 64 bits, so we have to
916 -- call the runtime routine to compute the quotient and remainder
918 else
919 if Rounded_Result_Set (N) then
920 Rnd := Standard_True;
921 else
922 Rnd := Standard_False;
923 end if;
925 Code := New_List (
926 Make_Object_Declaration (Loc,
927 Defining_Identifier => Qnn,
928 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
930 Make_Object_Declaration (Loc,
931 Defining_Identifier => Rnn,
932 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
934 Make_Procedure_Call_Statement (Loc,
935 Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc),
936 Parameter_Associations => New_List (
937 Build_Conversion (N, QR_Typ, X),
938 Build_Conversion (N, QR_Typ, Y),
939 Build_Conversion (N, QR_Typ, Z),
940 New_Occurrence_Of (Qnn, Loc),
941 New_Occurrence_Of (Rnn, Loc),
942 New_Occurrence_Of (Rnd, Loc))));
943 end if;
945 -- Set type of result, for use in caller.
947 Set_Etype (Qnn, QR_Typ);
948 end Build_Scaled_Divide_Code;
950 ---------------------------
951 -- Do_Divide_Fixed_Fixed --
952 ---------------------------
954 -- We have:
956 -- (Result_Value * Result_Small) =
957 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
959 -- Result_Value = (Left_Value / Right_Value) *
960 -- (Left_Small / (Right_Small * Result_Small));
962 -- we can do the operation in integer arithmetic if this fraction is an
963 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
964 -- Otherwise the result is in the close result set and our approach is to
965 -- use floating-point to compute this close result.
967 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
968 Left : constant Node_Id := Left_Opnd (N);
969 Right : constant Node_Id := Right_Opnd (N);
970 Left_Type : constant Entity_Id := Etype (Left);
971 Right_Type : constant Entity_Id := Etype (Right);
972 Result_Type : constant Entity_Id := Etype (N);
973 Right_Small : constant Ureal := Small_Value (Right_Type);
974 Left_Small : constant Ureal := Small_Value (Left_Type);
976 Result_Small : Ureal;
977 Frac : Ureal;
978 Frac_Num : Uint;
979 Frac_Den : Uint;
980 Lit_Int : Node_Id;
982 begin
983 -- Rounding is required if the result is integral
985 if Is_Integer_Type (Result_Type) then
986 Set_Rounded_Result (N);
987 end if;
989 -- Get result small. If the result is an integer, treat it as though
990 -- it had a small of 1.0, all other processing is identical.
992 if Is_Integer_Type (Result_Type) then
993 Result_Small := Ureal_1;
994 else
995 Result_Small := Small_Value (Result_Type);
996 end if;
998 -- Get small ratio
1000 Frac := Left_Small / (Right_Small * Result_Small);
1001 Frac_Num := Norm_Num (Frac);
1002 Frac_Den := Norm_Den (Frac);
1004 -- If the fraction is an integer, then we get the result by multiplying
1005 -- the left operand by the integer, and then dividing by the right
1006 -- operand (the order is important, if we did the divide first, we
1007 -- would lose precision).
1009 if Frac_Den = 1 then
1010 Lit_Int := Integer_Literal (N, Frac_Num);
1012 if Present (Lit_Int) then
1013 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1014 return;
1015 end if;
1017 -- If the fraction is the reciprocal of an integer, then we get the
1018 -- result by first multiplying the divisor by the integer, and then
1019 -- doing the division with the adjusted divisor.
1021 -- Note: this is much better than doing two divisions: multiplications
1022 -- are much faster than divisions (and certainly faster than rounded
1023 -- divisions), and we don't get inaccuracies from double rounding.
1025 elsif Frac_Num = 1 then
1026 Lit_Int := Integer_Literal (N, Frac_Den);
1028 if Present (Lit_Int) then
1029 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1030 return;
1031 end if;
1032 end if;
1034 -- If we fall through, we use floating-point to compute the result
1036 Set_Result (N,
1037 Build_Multiply (N,
1038 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1039 Real_Literal (N, Frac)));
1041 end Do_Divide_Fixed_Fixed;
1043 -------------------------------
1044 -- Do_Divide_Fixed_Universal --
1045 -------------------------------
1047 -- We have:
1049 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1050 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1052 -- The result is required to be in the perfect result set if the literal
1053 -- can be factored so that the resulting small ratio is an integer or the
1054 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1055 -- analysis of these RM requirements:
1057 -- We must factor the literal, finding an integer K:
1059 -- Lit_Value = K * Right_Small
1060 -- Right_Small = Lit_Value / K
1062 -- such that the small ratio:
1064 -- Left_Small
1065 -- ------------------------------
1066 -- (Lit_Value / K) * Result_Small
1068 -- Left_Small
1069 -- = ------------------------ * K
1070 -- Lit_Value * Result_Small
1072 -- is an integer or the reciprocal of an integer, and for
1073 -- implementation efficiency we need the smallest such K.
1075 -- First we reduce the left fraction to lowest terms.
1077 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1078 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1079 -- Right_Small = Lit_Value.
1081 -- If numerator > 1, then set K to the denominator of the fraction so
1082 -- that the resulting small ratio is an integer (the numerator value).
1084 procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1085 Left : constant Node_Id := Left_Opnd (N);
1086 Right : constant Node_Id := Right_Opnd (N);
1087 Left_Type : constant Entity_Id := Etype (Left);
1088 Result_Type : constant Entity_Id := Etype (N);
1089 Left_Small : constant Ureal := Small_Value (Left_Type);
1090 Lit_Value : constant Ureal := Realval (Right);
1092 Result_Small : Ureal;
1093 Frac : Ureal;
1094 Frac_Num : Uint;
1095 Frac_Den : Uint;
1096 Lit_K : Node_Id;
1097 Lit_Int : Node_Id;
1099 begin
1100 -- Get result small. If the result is an integer, treat it as though
1101 -- it had a small of 1.0, all other processing is identical.
1103 if Is_Integer_Type (Result_Type) then
1104 Result_Small := Ureal_1;
1105 else
1106 Result_Small := Small_Value (Result_Type);
1107 end if;
1109 -- Determine if literal can be rewritten successfully
1111 Frac := Left_Small / (Lit_Value * Result_Small);
1112 Frac_Num := Norm_Num (Frac);
1113 Frac_Den := Norm_Den (Frac);
1115 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1116 -- = denominator). If this integer is not too large, this is the case
1117 -- where the result can be obtained by dividing by this integer value.
1119 if Frac_Num = 1 then
1120 Lit_Int := Integer_Literal (N, Frac_Den);
1122 if Present (Lit_Int) then
1123 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1124 return;
1125 end if;
1127 -- Case where we choose K to make fraction an integer (K = denominator
1128 -- of fraction, integer = numerator of fraction). If both K and the
1129 -- numerator are small enough, this is the case where the result can
1130 -- be obtained by first multiplying by the integer value and then
1131 -- dividing by K (the order is important, if we divided first, we
1132 -- would lose precision).
1134 else
1135 Lit_Int := Integer_Literal (N, Frac_Num);
1136 Lit_K := Integer_Literal (N, Frac_Den);
1138 if Present (Lit_Int) and then Present (Lit_K) then
1139 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1140 return;
1141 end if;
1142 end if;
1144 -- Fall through if the literal cannot be successfully rewritten, or if
1145 -- the small ratio is out of range of integer arithmetic. In the former
1146 -- case it is fine to use floating-point to get the close result set,
1147 -- and in the latter case, it means that the result is zero or raises
1148 -- constraint error, and we can do that accurately in floating-point.
1150 -- If we end up using floating-point, then we take the right integer
1151 -- to be one, and its small to be the value of the original right real
1152 -- literal. That way, we need only one floating-point multiplication.
1154 Set_Result (N,
1155 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1157 end Do_Divide_Fixed_Universal;
1159 -------------------------------
1160 -- Do_Divide_Universal_Fixed --
1161 -------------------------------
1163 -- We have:
1165 -- (Result_Value * Result_Small) =
1166 -- Lit_Value / (Right_Value * Right_Small)
1167 -- Result_Value =
1168 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1170 -- The result is required to be in the perfect result set if the literal
1171 -- can be factored so that the resulting small ratio is an integer or the
1172 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1173 -- analysis of these RM requirements:
1175 -- We must factor the literal, finding an integer K:
1177 -- Lit_Value = K * Left_Small
1178 -- Left_Small = Lit_Value / K
1180 -- such that the small ratio:
1182 -- (Lit_Value / K)
1183 -- --------------------------
1184 -- Right_Small * Result_Small
1186 -- Lit_Value 1
1187 -- = -------------------------- * -
1188 -- Right_Small * Result_Small K
1190 -- is an integer or the reciprocal of an integer, and for
1191 -- implementation efficiency we need the smallest such K.
1193 -- First we reduce the left fraction to lowest terms.
1195 -- If denominator = 1, then for K = 1, the small ratio is an integer
1196 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1197 -- and Left_Small = Lit_Value.
1199 -- If denominator > 1, then set K to the numerator of the fraction so
1200 -- that the resulting small ratio is the reciprocal of an integer (the
1201 -- numerator value).
1203 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1204 Left : constant Node_Id := Left_Opnd (N);
1205 Right : constant Node_Id := Right_Opnd (N);
1206 Right_Type : constant Entity_Id := Etype (Right);
1207 Result_Type : constant Entity_Id := Etype (N);
1208 Right_Small : constant Ureal := Small_Value (Right_Type);
1209 Lit_Value : constant Ureal := Realval (Left);
1211 Result_Small : Ureal;
1212 Frac : Ureal;
1213 Frac_Num : Uint;
1214 Frac_Den : Uint;
1215 Lit_K : Node_Id;
1216 Lit_Int : Node_Id;
1218 begin
1219 -- Get result small. If the result is an integer, treat it as though
1220 -- it had a small of 1.0, all other processing is identical.
1222 if Is_Integer_Type (Result_Type) then
1223 Result_Small := Ureal_1;
1224 else
1225 Result_Small := Small_Value (Result_Type);
1226 end if;
1228 -- Determine if literal can be rewritten successfully
1230 Frac := Lit_Value / (Right_Small * Result_Small);
1231 Frac_Num := Norm_Num (Frac);
1232 Frac_Den := Norm_Den (Frac);
1234 -- Case where fraction is an integer (K = 1, integer = numerator). If
1235 -- this integer is not too large, this is the case where the result
1236 -- can be obtained by dividing this integer by the right operand.
1238 if Frac_Den = 1 then
1239 Lit_Int := Integer_Literal (N, Frac_Num);
1241 if Present (Lit_Int) then
1242 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1243 return;
1244 end if;
1246 -- Case where we choose K to make the fraction the reciprocal of an
1247 -- integer (K = numerator of fraction, integer = numerator of fraction).
1248 -- If both K and the integer are small enough, this is the case where
1249 -- the result can be obtained by multiplying the right operand by K
1250 -- and then dividing by the integer value. The order of the operations
1251 -- is important (if we divided first, we would lose precision).
1253 else
1254 Lit_Int := Integer_Literal (N, Frac_Den);
1255 Lit_K := Integer_Literal (N, Frac_Num);
1257 if Present (Lit_Int) and then Present (Lit_K) then
1258 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1259 return;
1260 end if;
1261 end if;
1263 -- Fall through if the literal cannot be successfully rewritten, or if
1264 -- the small ratio is out of range of integer arithmetic. In the former
1265 -- case it is fine to use floating-point to get the close result set,
1266 -- and in the latter case, it means that the result is zero or raises
1267 -- constraint error, and we can do that accurately in floating-point.
1269 -- If we end up using floating-point, then we take the right integer
1270 -- to be one, and its small to be the value of the original right real
1271 -- literal. That way, we need only one floating-point division.
1273 Set_Result (N,
1274 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1276 end Do_Divide_Universal_Fixed;
1278 -----------------------------
1279 -- Do_Multiply_Fixed_Fixed --
1280 -----------------------------
1282 -- We have:
1284 -- (Result_Value * Result_Small) =
1285 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1287 -- Result_Value = (Left_Value * Right_Value) *
1288 -- (Left_Small * Right_Small) / Result_Small;
1290 -- we can do the operation in integer arithmetic if this fraction is an
1291 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1292 -- Otherwise the result is in the close result set and our approach is to
1293 -- use floating-point to compute this close result.
1295 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1296 Left : constant Node_Id := Left_Opnd (N);
1297 Right : constant Node_Id := Right_Opnd (N);
1299 Left_Type : constant Entity_Id := Etype (Left);
1300 Right_Type : constant Entity_Id := Etype (Right);
1301 Result_Type : constant Entity_Id := Etype (N);
1302 Right_Small : constant Ureal := Small_Value (Right_Type);
1303 Left_Small : constant Ureal := Small_Value (Left_Type);
1305 Result_Small : Ureal;
1306 Frac : Ureal;
1307 Frac_Num : Uint;
1308 Frac_Den : Uint;
1309 Lit_Int : Node_Id;
1311 begin
1312 -- Get result small. If the result is an integer, treat it as though
1313 -- it had a small of 1.0, all other processing is identical.
1315 if Is_Integer_Type (Result_Type) then
1316 Result_Small := Ureal_1;
1317 else
1318 Result_Small := Small_Value (Result_Type);
1319 end if;
1321 -- Get small ratio
1323 Frac := (Left_Small * Right_Small) / Result_Small;
1324 Frac_Num := Norm_Num (Frac);
1325 Frac_Den := Norm_Den (Frac);
1327 -- If the fraction is an integer, then we get the result by multiplying
1328 -- the operands, and then multiplying the result by the integer value.
1330 if Frac_Den = 1 then
1331 Lit_Int := Integer_Literal (N, Frac_Num);
1333 if Present (Lit_Int) then
1334 Set_Result (N,
1335 Build_Multiply (N, Build_Multiply (N, Left, Right),
1336 Lit_Int));
1337 return;
1338 end if;
1340 -- If the fraction is the reciprocal of an integer, then we get the
1341 -- result by multiplying the operands, and then dividing the result by
1342 -- the integer value. The order of the operations is important, if we
1343 -- divided first, we would lose precision.
1345 elsif Frac_Num = 1 then
1346 Lit_Int := Integer_Literal (N, Frac_Den);
1348 if Present (Lit_Int) then
1349 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1350 return;
1351 end if;
1352 end if;
1354 -- If we fall through, we use floating-point to compute the result
1356 Set_Result (N,
1357 Build_Multiply (N,
1358 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1359 Real_Literal (N, Frac)));
1361 end Do_Multiply_Fixed_Fixed;
1363 ---------------------------------
1364 -- Do_Multiply_Fixed_Universal --
1365 ---------------------------------
1367 -- We have:
1369 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1370 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1372 -- The result is required to be in the perfect result set if the literal
1373 -- can be factored so that the resulting small ratio is an integer or the
1374 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1375 -- analysis of these RM requirements:
1377 -- We must factor the literal, finding an integer K:
1379 -- Lit_Value = K * Right_Small
1380 -- Right_Small = Lit_Value / K
1382 -- such that the small ratio:
1384 -- Left_Small * (Lit_Value / K)
1385 -- ----------------------------
1386 -- Result_Small
1388 -- Left_Small * Lit_Value 1
1389 -- = ---------------------- * -
1390 -- Result_Small K
1392 -- is an integer or the reciprocal of an integer, and for
1393 -- implementation efficiency we need the smallest such K.
1395 -- First we reduce the left fraction to lowest terms.
1397 -- If denominator = 1, then for K = 1, the small ratio is an
1398 -- integer, and this is clearly the minimum K case, so set
1399 -- K = 1, Right_Small = Lit_Value.
1401 -- If denominator > 1, then set K to the numerator of the
1402 -- fraction, so that the resulting small ratio is the
1403 -- reciprocal of the integer (the denominator value).
1405 procedure Do_Multiply_Fixed_Universal
1406 (N : Node_Id;
1407 Left, Right : Node_Id)
1409 Left_Type : constant Entity_Id := Etype (Left);
1410 Result_Type : constant Entity_Id := Etype (N);
1411 Left_Small : constant Ureal := Small_Value (Left_Type);
1412 Lit_Value : constant Ureal := Realval (Right);
1414 Result_Small : Ureal;
1415 Frac : Ureal;
1416 Frac_Num : Uint;
1417 Frac_Den : Uint;
1418 Lit_K : Node_Id;
1419 Lit_Int : Node_Id;
1421 begin
1422 -- Get result small. If the result is an integer, treat it as though
1423 -- it had a small of 1.0, all other processing is identical.
1425 if Is_Integer_Type (Result_Type) then
1426 Result_Small := Ureal_1;
1427 else
1428 Result_Small := Small_Value (Result_Type);
1429 end if;
1431 -- Determine if literal can be rewritten successfully
1433 Frac := (Left_Small * Lit_Value) / Result_Small;
1434 Frac_Num := Norm_Num (Frac);
1435 Frac_Den := Norm_Den (Frac);
1437 -- Case where fraction is an integer (K = 1, integer = numerator). If
1438 -- this integer is not too large, this is the case where the result can
1439 -- be obtained by multiplying by this integer value.
1441 if Frac_Den = 1 then
1442 Lit_Int := Integer_Literal (N, Frac_Num);
1444 if Present (Lit_Int) then
1445 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1446 return;
1447 end if;
1449 -- Case where we choose K to make fraction the reciprocal of an integer
1450 -- (K = numerator of fraction, integer = denominator of fraction). If
1451 -- both K and the denominator are small enough, this is the case where
1452 -- the result can be obtained by first multiplying by K, and then
1453 -- dividing by the integer value.
1455 else
1456 Lit_Int := Integer_Literal (N, Frac_Den);
1457 Lit_K := Integer_Literal (N, Frac_Num);
1459 if Present (Lit_Int) and then Present (Lit_K) then
1460 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1461 return;
1462 end if;
1463 end if;
1465 -- Fall through if the literal cannot be successfully rewritten, or if
1466 -- the small ratio is out of range of integer arithmetic. In the former
1467 -- case it is fine to use floating-point to get the close result set,
1468 -- and in the latter case, it means that the result is zero or raises
1469 -- constraint error, and we can do that accurately in floating-point.
1471 -- If we end up using floating-point, then we take the right integer
1472 -- to be one, and its small to be the value of the original right real
1473 -- literal. That way, we need only one floating-point multiplication.
1475 Set_Result (N,
1476 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1478 end Do_Multiply_Fixed_Universal;
1480 ---------------------------------
1481 -- Expand_Convert_Fixed_Static --
1482 ---------------------------------
1484 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1485 begin
1486 Rewrite (N,
1487 Convert_To (Etype (N),
1488 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1489 Analyze_And_Resolve (N);
1490 end Expand_Convert_Fixed_Static;
1492 -----------------------------------
1493 -- Expand_Convert_Fixed_To_Fixed --
1494 -----------------------------------
1496 -- We have:
1498 -- Result_Value * Result_Small = Source_Value * Source_Small
1499 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1501 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1502 -- integer, then the perfect result set is obtained by a single integer
1503 -- multiplication.
1505 -- If the small ratio is the reciprocal of a sufficiently small integer,
1506 -- then the perfect result set is obtained by a single integer division.
1508 -- In other cases, we obtain the close result set by calculating the
1509 -- result in floating-point.
1511 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1512 Rng_Check : constant Boolean := Do_Range_Check (N);
1513 Expr : constant Node_Id := Expression (N);
1514 Result_Type : constant Entity_Id := Etype (N);
1515 Source_Type : constant Entity_Id := Etype (Expr);
1516 Small_Ratio : Ureal;
1517 Ratio_Num : Uint;
1518 Ratio_Den : Uint;
1519 Lit : Node_Id;
1521 begin
1522 if Is_OK_Static_Expression (Expr) then
1523 Expand_Convert_Fixed_Static (N);
1524 return;
1525 end if;
1527 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1528 Ratio_Num := Norm_Num (Small_Ratio);
1529 Ratio_Den := Norm_Den (Small_Ratio);
1531 if Ratio_Den = 1 then
1533 if Ratio_Num = 1 then
1534 Set_Result (N, Expr);
1535 return;
1537 else
1538 Lit := Integer_Literal (N, Ratio_Num);
1540 if Present (Lit) then
1541 Set_Result (N, Build_Multiply (N, Expr, Lit));
1542 return;
1543 end if;
1544 end if;
1546 elsif Ratio_Num = 1 then
1547 Lit := Integer_Literal (N, Ratio_Den);
1549 if Present (Lit) then
1550 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1551 return;
1552 end if;
1553 end if;
1555 -- Fall through to use floating-point for the close result set case
1556 -- either as a result of the small ratio not being an integer or the
1557 -- reciprocal of an integer, or if the integer is out of range.
1559 Set_Result (N,
1560 Build_Multiply (N,
1561 Fpt_Value (Expr),
1562 Real_Literal (N, Small_Ratio)),
1563 Rng_Check);
1565 end Expand_Convert_Fixed_To_Fixed;
1567 -----------------------------------
1568 -- Expand_Convert_Fixed_To_Float --
1569 -----------------------------------
1571 -- If the small of the fixed type is 1.0, then we simply convert the
1572 -- integer value directly to the target floating-point type, otherwise
1573 -- we first have to multiply by the small, in Long_Long_Float, and then
1574 -- convert the result to the target floating-point type.
1576 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1577 Rng_Check : constant Boolean := Do_Range_Check (N);
1578 Expr : constant Node_Id := Expression (N);
1579 Source_Type : constant Entity_Id := Etype (Expr);
1580 Small : constant Ureal := Small_Value (Source_Type);
1582 begin
1583 if Is_OK_Static_Expression (Expr) then
1584 Expand_Convert_Fixed_Static (N);
1585 return;
1586 end if;
1588 if Small = Ureal_1 then
1589 Set_Result (N, Expr);
1591 else
1592 Set_Result (N,
1593 Build_Multiply (N,
1594 Fpt_Value (Expr),
1595 Real_Literal (N, Small)),
1596 Rng_Check);
1597 end if;
1598 end Expand_Convert_Fixed_To_Float;
1600 -------------------------------------
1601 -- Expand_Convert_Fixed_To_Integer --
1602 -------------------------------------
1604 -- We have:
1606 -- Result_Value = Source_Value * Source_Small
1608 -- If the small value is a sufficiently small integer, then the perfect
1609 -- result set is obtained by a single integer multiplication.
1611 -- If the small value is the reciprocal of a sufficiently small integer,
1612 -- then the perfect result set is obtained by a single integer division.
1614 -- In other cases, we obtain the close result set by calculating the
1615 -- result in floating-point.
1617 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1618 Rng_Check : constant Boolean := Do_Range_Check (N);
1619 Expr : constant Node_Id := Expression (N);
1620 Source_Type : constant Entity_Id := Etype (Expr);
1621 Small : constant Ureal := Small_Value (Source_Type);
1622 Small_Num : constant Uint := Norm_Num (Small);
1623 Small_Den : constant Uint := Norm_Den (Small);
1624 Lit : Node_Id;
1626 begin
1627 if Is_OK_Static_Expression (Expr) then
1628 Expand_Convert_Fixed_Static (N);
1629 return;
1630 end if;
1632 if Small_Den = 1 then
1633 Lit := Integer_Literal (N, Small_Num);
1635 if Present (Lit) then
1636 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1637 return;
1638 end if;
1640 elsif Small_Num = 1 then
1641 Lit := Integer_Literal (N, Small_Den);
1643 if Present (Lit) then
1644 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1645 return;
1646 end if;
1647 end if;
1649 -- Fall through to use floating-point for the close result set case
1650 -- either as a result of the small value not being an integer or the
1651 -- reciprocal of an integer, or if the integer is out of range.
1653 Set_Result (N,
1654 Build_Multiply (N,
1655 Fpt_Value (Expr),
1656 Real_Literal (N, Small)),
1657 Rng_Check);
1659 end Expand_Convert_Fixed_To_Integer;
1661 -----------------------------------
1662 -- Expand_Convert_Float_To_Fixed --
1663 -----------------------------------
1665 -- We have
1667 -- Result_Value * Result_Small = Operand_Value
1669 -- so compute:
1671 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1673 -- We do the small scaling in floating-point, and we do a multiplication
1674 -- rather than a division, since it is accurate enough for the perfect
1675 -- result cases, and faster.
1677 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1678 Rng_Check : constant Boolean := Do_Range_Check (N);
1679 Expr : constant Node_Id := Expression (N);
1680 Result_Type : constant Entity_Id := Etype (N);
1681 Small : constant Ureal := Small_Value (Result_Type);
1683 begin
1684 -- Optimize small = 1, where we can avoid the multiply completely
1686 if Small = Ureal_1 then
1687 Set_Result (N, Expr, Rng_Check);
1689 -- Normal case where multiply is required
1691 else
1692 Set_Result (N,
1693 Build_Multiply (N,
1694 Fpt_Value (Expr),
1695 Real_Literal (N, Ureal_1 / Small)),
1696 Rng_Check);
1697 end if;
1698 end Expand_Convert_Float_To_Fixed;
1700 -------------------------------------
1701 -- Expand_Convert_Integer_To_Fixed --
1702 -------------------------------------
1704 -- We have
1706 -- Result_Value * Result_Small = Operand_Value
1707 -- Result_Value = Operand_Value / Result_Small
1709 -- If the small value is a sufficiently small integer, then the perfect
1710 -- result set is obtained by a single integer division.
1712 -- If the small value is the reciprocal of a sufficiently small integer,
1713 -- the perfect result set is obtained by a single integer multiplication.
1715 -- In other cases, we obtain the close result set by calculating the
1716 -- result in floating-point using a multiplication by the reciprocal
1717 -- of the Result_Small.
1719 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1720 Rng_Check : constant Boolean := Do_Range_Check (N);
1721 Expr : constant Node_Id := Expression (N);
1722 Result_Type : constant Entity_Id := Etype (N);
1723 Small : constant Ureal := Small_Value (Result_Type);
1724 Small_Num : constant Uint := Norm_Num (Small);
1725 Small_Den : constant Uint := Norm_Den (Small);
1726 Lit : Node_Id;
1728 begin
1729 if Small_Den = 1 then
1730 Lit := Integer_Literal (N, Small_Num);
1732 if Present (Lit) then
1733 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check);
1734 return;
1735 end if;
1737 elsif Small_Num = 1 then
1738 Lit := Integer_Literal (N, Small_Den);
1740 if Present (Lit) then
1741 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check);
1742 return;
1743 end if;
1744 end if;
1746 -- Fall through to use floating-point for the close result set case
1747 -- either as a result of the small value not being an integer or the
1748 -- reciprocal of an integer, or if the integer is out of range.
1750 Set_Result (N,
1751 Build_Multiply (N,
1752 Fpt_Value (Expr),
1753 Real_Literal (N, Ureal_1 / Small)),
1754 Rng_Check);
1756 end Expand_Convert_Integer_To_Fixed;
1758 --------------------------------
1759 -- Expand_Decimal_Divide_Call --
1760 --------------------------------
1762 -- We have four operands
1764 -- Dividend
1765 -- Divisor
1766 -- Quotient
1767 -- Remainder
1769 -- All of which are decimal types, and which thus have associated
1770 -- decimal scales.
1772 -- Computing the quotient is a similar problem to that faced by the
1773 -- normal fixed-point division, except that it is simpler, because
1774 -- we always have compatible smalls.
1776 -- Quotient = (Dividend / Divisor) * 10**q
1778 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1779 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1781 -- For q >= 0, we compute
1783 -- Numerator := Dividend * 10 ** q
1784 -- Denominator := Divisor
1785 -- Quotient := Numerator / Denominator
1787 -- For q < 0, we compute
1789 -- Numerator := Dividend
1790 -- Denominator := Divisor * 10 ** q
1791 -- Quotient := Numerator / Denominator
1793 -- Both these divisions are done in truncated mode, and the remainder
1794 -- from these divisions is used to compute the result Remainder. This
1795 -- remainder has the effective scale of the numerator of the division,
1797 -- For q >= 0, the remainder scale is Dividend'Scale + q
1798 -- For q < 0, the remainder scale is Dividend'Scale
1800 -- The result Remainder is then computed by a normal truncating decimal
1801 -- conversion from this scale to the scale of the remainder, i.e. by a
1802 -- division or multiplication by the appropriate power of 10.
1804 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1805 Loc : constant Source_Ptr := Sloc (N);
1807 Dividend : Node_Id := First_Actual (N);
1808 Divisor : Node_Id := Next_Actual (Dividend);
1809 Quotient : Node_Id := Next_Actual (Divisor);
1810 Remainder : Node_Id := Next_Actual (Quotient);
1812 Dividend_Type : constant Entity_Id := Etype (Dividend);
1813 Divisor_Type : constant Entity_Id := Etype (Divisor);
1814 Quotient_Type : constant Entity_Id := Etype (Quotient);
1815 Remainder_Type : constant Entity_Id := Etype (Remainder);
1817 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1818 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1819 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1820 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1822 Q : Uint;
1823 Numerator_Scale : Uint;
1824 Stmts : List_Id;
1825 Qnn : Entity_Id;
1826 Rnn : Entity_Id;
1827 Computed_Remainder : Node_Id;
1828 Adjusted_Remainder : Node_Id;
1829 Scale_Adjust : Uint;
1831 begin
1832 -- Relocate the operands, since they are now list elements, and we
1833 -- need to reference them separately as operands in the expanded code.
1835 Dividend := Relocate_Node (Dividend);
1836 Divisor := Relocate_Node (Divisor);
1837 Quotient := Relocate_Node (Quotient);
1838 Remainder := Relocate_Node (Remainder);
1840 -- Now compute Q, the adjustment scale
1842 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1844 -- If Q is non-negative then we need a scaled divide
1846 if Q >= 0 then
1847 Build_Scaled_Divide_Code
1849 Dividend,
1850 Integer_Literal (N, Uint_10 ** Q),
1851 Divisor,
1852 Qnn, Rnn, Stmts);
1854 Numerator_Scale := Dividend_Scale + Q;
1856 -- If Q is negative, then we need a double divide
1858 else
1859 Build_Double_Divide_Code
1861 Dividend,
1862 Divisor,
1863 Integer_Literal (N, Uint_10 ** (-Q)),
1864 Qnn, Rnn, Stmts);
1866 Numerator_Scale := Dividend_Scale;
1867 end if;
1869 -- Add statement to set quotient value
1871 -- Quotient := quotient-type!(Qnn);
1873 Append_To (Stmts,
1874 Make_Assignment_Statement (Loc,
1875 Name => Quotient,
1876 Expression =>
1877 Unchecked_Convert_To (Quotient_Type,
1878 Build_Conversion (N, Quotient_Type,
1879 New_Occurrence_Of (Qnn, Loc)))));
1881 -- Now we need to deal with computing and setting the remainder. The
1882 -- scale of the remainder is in Numerator_Scale, and the desired
1883 -- scale is the scale of the given Remainder argument. There are
1884 -- three cases:
1886 -- Numerator_Scale > Remainder_Scale
1888 -- in this case, there are extra digits in the computed remainder
1889 -- which must be eliminated by an extra division:
1891 -- computed-remainder := Numerator rem Denominator
1892 -- scale_adjust = Numerator_Scale - Remainder_Scale
1893 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
1895 -- Numerator_Scale = Remainder_Scale
1897 -- in this case, the we have the remainder we need
1899 -- computed-remainder := Numerator rem Denominator
1900 -- adjusted-remainder := computed-remainder
1902 -- Numerator_Scale < Remainder_Scale
1904 -- in this case, we have insufficient digits in the computed
1905 -- remainder, which must be eliminated by an extra multiply
1907 -- computed-remainder := Numerator rem Denominator
1908 -- scale_adjust = Remainder_Scale - Numerator_Scale
1909 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
1911 -- Finally we assign the adjusted-remainder to the result Remainder
1912 -- with conversions to get the proper fixed-point type representation.
1914 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
1916 if Numerator_Scale > Remainder_Scale then
1917 Scale_Adjust := Numerator_Scale - Remainder_Scale;
1918 Adjusted_Remainder :=
1919 Build_Divide
1920 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1922 elsif Numerator_Scale = Remainder_Scale then
1923 Adjusted_Remainder := Computed_Remainder;
1925 else -- Numerator_Scale < Remainder_Scale
1926 Scale_Adjust := Remainder_Scale - Numerator_Scale;
1927 Adjusted_Remainder :=
1928 Build_Multiply
1929 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
1930 end if;
1932 -- Assignment of remainder result
1934 Append_To (Stmts,
1935 Make_Assignment_Statement (Loc,
1936 Name => Remainder,
1937 Expression =>
1938 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
1940 -- Final step is to rewrite the call with a block containing the
1941 -- above sequence of constructed statements for the divide operation.
1943 Rewrite (N,
1944 Make_Block_Statement (Loc,
1945 Handled_Statement_Sequence =>
1946 Make_Handled_Sequence_Of_Statements (Loc,
1947 Statements => Stmts)));
1949 Analyze (N);
1951 end Expand_Decimal_Divide_Call;
1953 -----------------------------------------------
1954 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
1955 -----------------------------------------------
1957 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
1958 Left : constant Node_Id := Left_Opnd (N);
1959 Right : constant Node_Id := Right_Opnd (N);
1961 begin
1962 -- Suppress expansion of a fixed-by-fixed division if the
1963 -- operation is supported directly by the target.
1965 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
1966 return;
1967 end if;
1969 if Etype (Left) = Universal_Real then
1970 Do_Divide_Universal_Fixed (N);
1972 elsif Etype (Right) = Universal_Real then
1973 Do_Divide_Fixed_Universal (N);
1975 else
1976 Do_Divide_Fixed_Fixed (N);
1977 end if;
1979 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
1981 -----------------------------------------------
1982 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
1983 -----------------------------------------------
1985 -- The division is done in long_long_float, and the result is multiplied
1986 -- by the small ratio, which is Small (Right) / Small (Left). Special
1987 -- treatment is required for universal operands, which represent their
1988 -- own value and do not require conversion.
1990 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
1991 Left : constant Node_Id := Left_Opnd (N);
1992 Right : constant Node_Id := Right_Opnd (N);
1994 Left_Type : constant Entity_Id := Etype (Left);
1995 Right_Type : constant Entity_Id := Etype (Right);
1997 begin
1998 -- Case of left operand is universal real, the result we want is:
2000 -- Left_Value / (Right_Value * Right_Small)
2002 -- so we compute this as:
2004 -- (Left_Value / Right_Small) / Right_Value
2006 if Left_Type = Universal_Real then
2007 Set_Result (N,
2008 Build_Divide (N,
2009 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2010 Fpt_Value (Right)));
2012 -- Case of right operand is universal real, the result we want is
2014 -- (Left_Value * Left_Small) / Right_Value
2016 -- so we compute this as:
2018 -- Left_Value * (Left_Small / Right_Value)
2020 -- Note we invert to a multiplication since usually floating-point
2021 -- multiplication is much faster than floating-point division.
2023 elsif Right_Type = Universal_Real then
2024 Set_Result (N,
2025 Build_Multiply (N,
2026 Fpt_Value (Left),
2027 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2029 -- Both operands are fixed, so the value we want is
2031 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2033 -- which we compute as:
2035 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2037 else
2038 Set_Result (N,
2039 Build_Multiply (N,
2040 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2041 Real_Literal (N,
2042 Small_Value (Left_Type) / Small_Value (Right_Type))));
2043 end if;
2045 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2047 -------------------------------------------------
2048 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2049 -------------------------------------------------
2051 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2052 Left : constant Node_Id := Left_Opnd (N);
2053 Right : constant Node_Id := Right_Opnd (N);
2055 begin
2056 if Etype (Left) = Universal_Real then
2057 Do_Divide_Universal_Fixed (N);
2059 elsif Etype (Right) = Universal_Real then
2060 Do_Divide_Fixed_Universal (N);
2062 else
2063 Do_Divide_Fixed_Fixed (N);
2064 end if;
2066 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2068 -------------------------------------------------
2069 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2070 -------------------------------------------------
2072 -- Since the operand and result fixed-point type is the same, this is
2073 -- a straight divide by the right operand, the small can be ignored.
2075 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2076 Left : constant Node_Id := Left_Opnd (N);
2077 Right : constant Node_Id := Right_Opnd (N);
2079 begin
2080 Set_Result (N, Build_Divide (N, Left, Right));
2081 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2083 -------------------------------------------------
2084 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2085 -------------------------------------------------
2087 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2088 Left : constant Node_Id := Left_Opnd (N);
2089 Right : constant Node_Id := Right_Opnd (N);
2091 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2092 -- The operand may be a non-static universal value, such an
2093 -- exponentiation with a non-static exponent. In that case, treat
2094 -- as a fixed * fixed multiplication, and convert the argument to
2095 -- the target fixed type.
2097 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2098 Loc : constant Source_Ptr := Sloc (N);
2100 begin
2101 Rewrite (Opnd,
2102 Make_Type_Conversion (Loc,
2103 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2104 Expression => Expression (Opnd)));
2105 Analyze_And_Resolve (Opnd, Etype (N));
2106 end Rewrite_Non_Static_Universal;
2108 begin
2109 -- Suppress expansion of a fixed-by-fixed multiplication if the
2110 -- operation is supported directly by the target.
2112 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then
2113 return;
2114 end if;
2116 if Etype (Left) = Universal_Real then
2117 if Nkind (Left) = N_Real_Literal then
2118 Do_Multiply_Fixed_Universal (N, Right, Left);
2120 elsif Nkind (Left) = N_Type_Conversion then
2121 Rewrite_Non_Static_Universal (Left);
2122 Do_Multiply_Fixed_Fixed (N);
2123 end if;
2125 elsif Etype (Right) = Universal_Real then
2126 if Nkind (Right) = N_Real_Literal then
2127 Do_Multiply_Fixed_Universal (N, Left, Right);
2129 elsif Nkind (Right) = N_Type_Conversion then
2130 Rewrite_Non_Static_Universal (Right);
2131 Do_Multiply_Fixed_Fixed (N);
2132 end if;
2134 else
2135 Do_Multiply_Fixed_Fixed (N);
2136 end if;
2138 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2140 -------------------------------------------------
2141 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2142 -------------------------------------------------
2144 -- The multiply is done in long_long_float, and the result is multiplied
2145 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2146 -- Special treatment is required for universal operands.
2148 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2149 Left : constant Node_Id := Left_Opnd (N);
2150 Right : constant Node_Id := Right_Opnd (N);
2152 Left_Type : constant Entity_Id := Etype (Left);
2153 Right_Type : constant Entity_Id := Etype (Right);
2155 begin
2156 -- Case of left operand is universal real, the result we want is
2158 -- Left_Value * (Right_Value * Right_Small)
2160 -- so we compute this as:
2162 -- (Left_Value * Right_Small) * Right_Value;
2164 if Left_Type = Universal_Real then
2165 Set_Result (N,
2166 Build_Multiply (N,
2167 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2168 Fpt_Value (Right)));
2170 -- Case of right operand is universal real, the result we want is
2172 -- (Left_Value * Left_Small) * Right_Value
2174 -- so we compute this as:
2176 -- Left_Value * (Left_Small * Right_Value)
2178 elsif Right_Type = Universal_Real then
2179 Set_Result (N,
2180 Build_Multiply (N,
2181 Fpt_Value (Left),
2182 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2184 -- Both operands are fixed, so the value we want is
2186 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2188 -- which we compute as:
2190 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2192 else
2193 Set_Result (N,
2194 Build_Multiply (N,
2195 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2196 Real_Literal (N,
2197 Small_Value (Right_Type) * Small_Value (Left_Type))));
2198 end if;
2200 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2202 ---------------------------------------------------
2203 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2204 ---------------------------------------------------
2206 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2207 Left : constant Node_Id := Left_Opnd (N);
2208 Right : constant Node_Id := Right_Opnd (N);
2210 begin
2211 if Etype (Left) = Universal_Real then
2212 Do_Multiply_Fixed_Universal (N, Right, Left);
2214 elsif Etype (Right) = Universal_Real then
2215 Do_Multiply_Fixed_Universal (N, Left, Right);
2217 else
2218 Do_Multiply_Fixed_Fixed (N);
2219 end if;
2221 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2223 ---------------------------------------------------
2224 -- Expand_Multiply_Fixed_By_Integer_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_Fixed_By_Integer_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_Fixed_By_Integer_Giving_Fixed;
2236 ---------------------------------------------------
2237 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2238 ---------------------------------------------------
2240 -- Since the operand and result fixed-point type is the same, this is
2241 -- a straight multiply by the right operand, the small can be ignored.
2243 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2244 begin
2245 Set_Result (N,
2246 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2247 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2249 ---------------
2250 -- Fpt_Value --
2251 ---------------
2253 function Fpt_Value (N : Node_Id) return Node_Id is
2254 Typ : constant Entity_Id := Etype (N);
2256 begin
2257 if Is_Integer_Type (Typ)
2258 or else Is_Floating_Point_Type (Typ)
2259 then
2260 return
2261 Build_Conversion
2262 (N, Standard_Long_Long_Float, N);
2264 -- Fixed-point case, must get integer value first
2266 else
2267 return
2268 Build_Conversion (N, Standard_Long_Long_Float, N);
2269 end if;
2271 end Fpt_Value;
2273 ---------------------
2274 -- Integer_Literal --
2275 ---------------------
2277 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is
2278 T : Entity_Id;
2279 L : Node_Id;
2281 begin
2282 if V < Uint_2 ** 7 then
2283 T := Standard_Integer_8;
2285 elsif V < Uint_2 ** 15 then
2286 T := Standard_Integer_16;
2288 elsif V < Uint_2 ** 31 then
2289 T := Standard_Integer_32;
2291 elsif V < Uint_2 ** 63 then
2292 T := Standard_Integer_64;
2294 else
2295 return Empty;
2296 end if;
2298 L := Make_Integer_Literal (Sloc (N), V);
2300 -- Set type of result in case used elsewhere (see note at start)
2302 Set_Etype (L, T);
2303 Set_Is_Static_Expression (L);
2305 -- We really need to set Analyzed here because we may be creating a
2306 -- very strange beast, namely an integer literal typed as fixed-point
2307 -- and the analyzer won't like that. Probably we should allow the
2308 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes
2309 -- and teach the analyzer how to handle them ???
2311 Set_Analyzed (L);
2312 return L;
2314 end Integer_Literal;
2316 ------------------
2317 -- Real_Literal --
2318 ------------------
2320 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2321 L : Node_Id;
2323 begin
2324 L := Make_Real_Literal (Sloc (N), V);
2326 -- Set type of result in case used elsewhere (see note at start)
2328 Set_Etype (L, Standard_Long_Long_Float);
2329 return L;
2330 end Real_Literal;
2332 ------------------------
2333 -- Rounded_Result_Set --
2334 ------------------------
2336 function Rounded_Result_Set (N : Node_Id) return Boolean is
2337 K : constant Node_Kind := Nkind (N);
2339 begin
2340 if (K = N_Type_Conversion or else
2341 K = N_Op_Divide or else
2342 K = N_Op_Multiply)
2343 and then Rounded_Result (N)
2344 then
2345 return True;
2346 else
2347 return False;
2348 end if;
2349 end Rounded_Result_Set;
2351 ----------------
2352 -- Set_Result --
2353 ----------------
2355 procedure Set_Result
2356 (N : Node_Id;
2357 Expr : Node_Id;
2358 Rchk : Boolean := False)
2360 Cnode : Node_Id;
2362 Expr_Type : constant Entity_Id := Etype (Expr);
2363 Result_Type : constant Entity_Id := Etype (N);
2365 begin
2366 -- No conversion required if types match and no range check
2368 if Result_Type = Expr_Type and then not Rchk then
2369 Cnode := Expr;
2371 -- Else perform required conversion
2373 else
2374 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk);
2375 end if;
2377 Rewrite (N, Cnode);
2378 Analyze_And_Resolve (N, Result_Type);
2380 end Set_Result;
2382 end Exp_Fixd;