1 ------------------------------------------------------------------------------
3 -- GNAT COMPILER COMPONENTS --
9 -- Copyright (C) 1992-2021, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
24 ------------------------------------------------------------------------------
26 with Atree; use Atree;
27 with Checks; use Checks;
28 with Einfo; use Einfo;
29 with Einfo.Entities; use Einfo.Entities;
30 with Einfo.Utils; use Einfo.Utils;
31 with Exp_Util; use Exp_Util;
32 with Nlists; use Nlists;
33 with Nmake; use Nmake;
34 with Restrict; use Restrict;
35 with Rident; use Rident;
36 with Rtsfind; use Rtsfind;
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 Sinfo.Nodes; use Sinfo.Nodes;
43 with Stand; use Stand;
44 with Tbuild; use Tbuild;
45 with Ttypes; use Ttypes;
46 with Uintp; use Uintp;
47 with Urealp; use Urealp;
49 package body Exp_Fixd is
51 -----------------------
52 -- Local Subprograms --
53 -----------------------
55 -- General note; in this unit, a number of routines are driven by the
56 -- types (Etype) of their operands. Since we are dealing with unanalyzed
57 -- expressions as they are constructed, the Etypes would not normally be
58 -- set, but the construction routines that we use in this unit do in fact
59 -- set the Etype values correctly. In addition, setting the Etype ensures
60 -- that the analyzer does not try to redetermine the type when the node
61 -- is analyzed (which would be wrong, since in the case where we set the
62 -- Conversion_OK flag, it would think it was still dealing with a normal
63 -- fixed-point operation and mess it up).
65 function Build_Conversion
69 Rchk : Boolean := False;
70 Trunc : Boolean := False) return Node_Id;
71 -- Build an expression that converts the expression Expr to type Typ,
72 -- taking the source location from Sloc (N). If the conversions involve
73 -- fixed-point types, then the Conversion_OK flag will be set so that the
74 -- resulting conversions do not get re-expanded. On return, the resulting
75 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set
76 -- in the resulting conversion node. If Trunc is set, then the
77 -- Float_Truncate flag is set on the conversion, which must be from
78 -- a floating-point type to an integer type.
80 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id;
81 -- Builds an N_Op_Divide node from the given left and right operand
82 -- expressions, using the source location from Sloc (N). The operands are
83 -- either both Universal_Real, in which case Build_Divide differs from
84 -- Make_Op_Divide only in that the Etype of the resulting node is set (to
85 -- Universal_Real), or they can be integer or fixed-point types. In this
86 -- case the types need not be the same, and Build_Divide chooses a type
87 -- long enough to hold both operands (i.e. the size of the longer of the
88 -- two operand types), and both operands are converted to this type. The
89 -- Etype of the result is also set to this value. The Rounded_Result flag
90 -- of the result in this case is set from the Rounded_Result flag of node
91 -- N. On return, the resulting node has its Etype set.
93 function Build_Double_Divide
95 X, Y, Z : Node_Id) return Node_Id;
96 -- Returns a node corresponding to the value X/(Y*Z) using the source
97 -- location from Sloc (N). The division is rounded if the Rounded_Result
98 -- flag of N is set. The integer types of X, Y, Z may be different. On
99 -- return, the resulting node has its Etype set.
101 procedure Build_Double_Divide_Code
104 Qnn, Rnn : out Entity_Id;
106 -- Generates a sequence of code for determining the quotient and remainder
107 -- of the division X/(Y*Z), using the source location from Sloc (N).
108 -- Entities of appropriate types are allocated for the quotient and
109 -- remainder and returned in Qnn and Rnn. The result is rounded if the
110 -- Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn are
111 -- appropriately set on return.
113 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id;
114 -- Builds an N_Op_Multiply node from the given left and right operand
115 -- expressions, using the source location from Sloc (N). The operands are
116 -- either both Universal_Real, in which case Build_Multiply differs from
117 -- Make_Op_Multiply only in that the Etype of the resulting node is set (to
118 -- Universal_Real), or they can be integer or fixed-point types. In this
119 -- case the types need not be the same, and Build_Multiply chooses a type
120 -- long enough to hold the product and both operands are converted to this
121 -- type. The type of the result is also set to this value. On return, the
122 -- resulting node 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 are
127 -- both integer types, which need not be the same. Build_Rem converts the
128 -- operand with the smaller sized type to match the type of the other
129 -- operand and sets this as the result type. The result is never rounded
130 -- (rem operations cannot be rounded in any case). On return, the resulting
131 -- node has its Etype set.
133 function Build_Scaled_Divide
135 X, Y, Z : Node_Id) return Node_Id;
136 -- Returns a node corresponding to the value X*Y/Z using the source
137 -- location from Sloc (N). The division is rounded if the Rounded_Result
138 -- flag of N is set. The integer types of X, Y, Z may be different. On
139 -- return the resulting node has its Etype set.
141 procedure Build_Scaled_Divide_Code
144 Qnn, Rnn : out Entity_Id;
146 -- Generates a sequence of code for determining the quotient and remainder
147 -- of the division X*Y/Z, using the source location from Sloc (N). Entities
148 -- of appropriate types are allocated for the quotient and remainder and
149 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different.
150 -- The division is rounded if the Rounded_Result flag of N is set. The
151 -- Etype fields of Qnn and Rnn are appropriately set on return.
153 procedure Do_Divide_Fixed_Fixed (N : Node_Id);
154 -- Handles expansion of divide for case of two fixed-point operands
155 -- (neither of them universal), with an integer or fixed-point result.
156 -- N is the N_Op_Divide node to be expanded.
158 procedure Do_Divide_Fixed_Universal (N : Node_Id);
159 -- Handles expansion of divide for case of a fixed-point operand divided
160 -- by a universal real operand, with an integer or fixed-point result. N
161 -- is the N_Op_Divide node to be expanded.
163 procedure Do_Divide_Universal_Fixed (N : Node_Id);
164 -- Handles expansion of divide for case of a universal real operand
165 -- divided by a fixed-point operand, with an integer or fixed-point
166 -- result. N is the N_Op_Divide node to be expanded.
168 procedure Do_Multiply_Fixed_Fixed (N : Node_Id);
169 -- Handles expansion of multiply for case of two fixed-point operands
170 -- (neither of them universal), with an integer or fixed-point result.
171 -- N is the N_Op_Multiply node to be expanded.
173 procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id);
174 -- Handles expansion of multiply for case of a fixed-point operand
175 -- multiplied by a universal real operand, with an integer or fixed-
176 -- point result. N is the N_Op_Multiply node to be expanded, and
177 -- Left, Right are the operands (which may have been switched).
179 procedure Expand_Convert_Fixed_Static (N : Node_Id);
180 -- This routine is called where the node N is a conversion of a literal
181 -- or other static expression of a fixed-point type to some other type.
182 -- In such cases, we simply rewrite the operand as a real literal and
183 -- reanalyze. This avoids problems which would otherwise result from
184 -- attempting to build and fold expressions involving constants.
186 function Fpt_Value (N : Node_Id) return Node_Id;
187 -- Given an operand of fixed-point operation, return an expression that
188 -- represents the corresponding Universal_Real value. The expression
189 -- can be of integer type, floating-point type, or fixed-point type.
190 -- The expression returned is neither analyzed nor resolved. The Etype
191 -- of the result is properly set (to Universal_Real).
193 function Integer_Literal
196 Negative : Boolean := False) return Node_Id;
197 -- Given a non-negative universal integer value, build a typed integer
198 -- literal node, using the smallest applicable standard integer type.
199 -- If Negative is true, then a negative literal is built. If V exceeds
200 -- 2**(System_Max_Integer_Size - 1) - 1, the largest value allowed for
201 -- perfect result set scaling factors (see RM G.2.3(22)), then Empty is
202 -- returned. The node N provides the Sloc value for the constructed
203 -- literal. The Etype of the resulting literal is correctly set, and it
204 -- is marked as analyzed.
206 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
207 -- Build a real literal node from the given value, the Etype of the
208 -- returned node is set to Universal_Real, since all floating-point
209 -- arithmetic operations that we construct use Universal_Real
211 function Rounded_Result_Set (N : Node_Id) return Boolean;
212 -- Returns True if N is a node that contains the Rounded_Result flag
213 -- and if the flag is true or the target type is an integer type.
218 Rchk : Boolean := False;
219 Trunc : Boolean := False);
220 -- N is the node for the current conversion, division or multiplication
221 -- operation, and Expr is an expression representing the result. Expr may
222 -- be of floating-point or integer type. If the operation result is fixed-
223 -- point, then the value of Expr is in units of small of the result type
224 -- (i.e. small's have already been dealt with). The result of the call is
225 -- to replace N by an appropriate conversion to the result type, dealing
226 -- with rounding for the decimal types case. The node is then analyzed and
227 -- resolved using the result type. If Rchk or Trunc are True, then
228 -- respectively Do_Range_Check and Float_Truncate are set in the
229 -- resulting conversion.
231 ----------------------
232 -- Build_Conversion --
233 ----------------------
235 function Build_Conversion
239 Rchk : Boolean := False;
240 Trunc : Boolean := False) return Node_Id
242 Loc : constant Source_Ptr := Sloc (N);
244 Rcheck : Boolean := Rchk;
247 -- A special case, if the expression is an integer literal and the
248 -- target type is an integer type, then just retype the integer
249 -- literal to the desired target type. Don't do this if we need
252 if Nkind (Expr) = N_Integer_Literal
253 and then Is_Integer_Type (Typ)
258 -- Cases where we end up with a conversion. Note that we do not use the
259 -- Convert_To abstraction here, since we may be decorating the resulting
260 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
261 -- conversion node present, even if it appears to be redundant.
264 -- Remove inner conversion if both inner and outer conversions are
265 -- to integer types, since the inner one serves no purpose (except
266 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
267 -- and also preserve the Conversion_OK and Do_Range_Check flags of
268 -- the inner conversion.
270 if Is_Integer_Type (Typ)
271 and then Is_Integer_Type (Etype (Expr))
272 and then Nkind (Expr) = N_Type_Conversion
275 Make_Type_Conversion (Loc,
276 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
277 Expression => Expression (Expr));
278 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
279 Set_Conversion_OK (Result, Conversion_OK (Expr));
280 Rcheck := Rcheck or Do_Range_Check (Expr);
282 -- For all other cases, a simple type conversion will work
286 Make_Type_Conversion (Loc,
287 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
290 Set_Float_Truncate (Result, Trunc);
293 -- Set Conversion_OK if either result or expression type is a
294 -- fixed-point type, since from a semantic point of view, we are
295 -- treating fixed-point values as integers at this stage.
297 if Is_Fixed_Point_Type (Typ)
298 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
300 Set_Conversion_OK (Result);
303 -- Set Do_Range_Check if either it was requested by the caller,
304 -- or if an eliminated inner conversion had a range check.
307 Enable_Range_Check (Result);
309 Set_Do_Range_Check (Result, False);
313 Set_Etype (Result, Typ);
315 end Build_Conversion;
321 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
322 Loc : constant Source_Ptr := Sloc (N);
323 Left_Type : constant Entity_Id := Base_Type (Etype (L));
324 Right_Type : constant Entity_Id := Base_Type (Etype (R));
328 Result_Type : Entity_Id;
332 -- Deal with floating-point case first
334 if Is_Floating_Point_Type (Left_Type) then
335 pragma Assert (Left_Type = Universal_Real);
336 pragma Assert (Right_Type = Universal_Real);
338 Rnode := Make_Op_Divide (Loc, L, R);
339 Result_Type := Universal_Real;
341 -- Integer and fixed-point cases
344 -- An optimization. If the right operand is the literal 1, then we
345 -- can just return the left hand operand. Putting the optimization
346 -- here allows us to omit the check at the call site.
348 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
352 -- Otherwise we need to figure out the correct result type size
353 -- First figure out the effective sizes of the operands. Normally
354 -- the effective size of an operand is the RM_Size of the operand.
355 -- But a special case arises with operands whose size is known at
356 -- compile time. In this case, we can use the actual value of the
357 -- operand to get its size if it would fit in signed 8/16/32 bits.
359 Left_Size := UI_To_Int (RM_Size (Left_Type));
361 if Compile_Time_Known_Value (L) then
363 Val : constant Uint := Expr_Value (L);
365 if Val < Uint_2 ** 7 then
367 elsif Val < Uint_2 ** 15 then
369 elsif Val < Uint_2 ** 31 then
375 Right_Size := UI_To_Int (RM_Size (Right_Type));
377 if Compile_Time_Known_Value (R) then
379 Val : constant Uint := Expr_Value (R);
381 if Val <= Int'(2 ** 7) then
383 elsif Val <= Int'(2 ** 15) then
389 -- Do the operation using the longer of the two sizes
391 Rsize := Int'Max (Left_Size, Right_Size);
394 Result_Type := Standard_Integer_8;
396 elsif Rsize <= 16 then
397 Result_Type := Standard_Integer_16;
399 elsif Rsize <= 32 then
400 Result_Type := Standard_Integer_32;
402 elsif Rsize <= 64 or else System_Max_Integer_Size < 128 then
403 Result_Type := Standard_Integer_64;
406 Result_Type := Standard_Integer_128;
411 Left_Opnd => Build_Conversion (N, Result_Type, L),
412 Right_Opnd => Build_Conversion (N, Result_Type, R));
415 -- We now have a divide node built with Result_Type set. First
416 -- set Etype of result, as required for all Build_xxx routines
418 Set_Etype (Rnode, Base_Type (Result_Type));
420 -- The result is rounded if the target of the operation is decimal
421 -- and Rounded_Result is set, or if the target of the operation
422 -- is an integer type, as determined by Rounded_Result_Set.
424 Set_Rounded_Result (Rnode, Rounded_Result_Set (N));
426 -- One more check. We did the divide operation using the longer of
427 -- the two sizes, which is reasonable. However, in the case where the
428 -- two types have unequal sizes, it is impossible for the result of
429 -- a divide operation to be larger than the dividend, so we can put
430 -- a conversion round the result to keep the evolving operation size
431 -- as small as possible.
433 if not Is_Floating_Point_Type (Left_Type) then
434 Rnode := Build_Conversion (N, Left_Type, Rnode);
440 -------------------------
441 -- Build_Double_Divide --
442 -------------------------
444 function Build_Double_Divide
446 X, Y, Z : Node_Id) return Node_Id
448 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
449 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
450 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
451 D_Size : constant Nat := Y_Size + Z_Size;
452 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
456 -- If the denominator fits in Max_Integer_Size bits, we can build the
457 -- operations directly without causing any intermediate overflow. But
458 -- for backward compatibility reasons, we use a 128-bit divide only
459 -- if one of the operands is already larger than 64 bits.
461 if D_Size <= System_Max_Integer_Size
462 and then (D_Size <= 64 or else M_Size > 64)
464 return Build_Divide (N, X, Build_Multiply (N, Y, Z));
466 -- Otherwise we use the runtime routine
468 -- [Qnn : Interfaces.Integer_{64|128};
469 -- Rnn : Interfaces.Integer_{64|128};
470 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
475 Loc : constant Source_Ptr := Sloc (N);
480 pragma Warnings (Off, Rnn);
483 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
484 Insert_Actions (N, Code);
485 Expr := New_Occurrence_Of (Qnn, Loc);
487 -- Set type of result in case used elsewhere (see note at start)
489 Set_Etype (Expr, Etype (Qnn));
491 -- Set result as analyzed (see note at start on build routines)
496 end Build_Double_Divide;
498 ------------------------------
499 -- Build_Double_Divide_Code --
500 ------------------------------
502 -- If the denominator can be computed in Max_Integer_Size bits, we build
504 -- [Nnn : constant typ := typ (X);
505 -- Dnn : constant typ := typ (Y) * typ (Z)
506 -- Qnn : constant typ := Nnn / Dnn;
507 -- Rnn : constant typ := Nnn rem Dnn;
509 -- If the denominator cannot be computed in Max_Integer_Size bits, we build
511 -- [Qnn : Interfaces.Integer_{64|128};
512 -- Rnn : Interfaces.Integer_{64|128};
513 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);]
515 procedure Build_Double_Divide_Code
518 Qnn, Rnn : out Entity_Id;
521 Loc : constant Source_Ptr := Sloc (N);
523 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
524 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
525 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
526 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
539 -- Find type that will allow computation of denominator
541 QR_Siz := Nat'Max (X_Size, Y_Size + Z_Size);
544 QR_Typ := Standard_Integer_16;
547 elsif QR_Siz <= 32 then
548 QR_Typ := Standard_Integer_32;
551 elsif QR_Siz <= 64 then
552 QR_Typ := Standard_Integer_64;
555 -- For backward compatibility reasons, we use a 128-bit divide only
556 -- if one of the operands is already larger than 64 bits.
558 elsif System_Max_Integer_Size < 128 or else M_Size <= 64 then
559 QR_Typ := RTE (RE_Integer_64);
560 QR_Id := RE_Double_Divide64;
562 elsif QR_Siz <= 128 then
563 QR_Typ := Standard_Integer_128;
567 QR_Typ := RTE (RE_Integer_128);
568 QR_Id := RE_Double_Divide128;
571 -- Define quotient and remainder, and set their Etypes, so
572 -- that they can be picked up by Build_xxx routines.
574 Qnn := Make_Temporary (Loc, 'S');
575 Rnn := Make_Temporary (Loc, 'R');
577 Set_Etype (Qnn, QR_Typ);
578 Set_Etype (Rnn, QR_Typ);
580 -- Case where we can compute the denominator in Max_Integer_Size bits
582 if QR_Id = RE_Null then
584 -- Create temporaries for numerator and denominator and set Etypes,
585 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
587 Nnn := Make_Temporary (Loc, 'N');
588 Dnn := Make_Temporary (Loc, 'D');
590 Set_Etype (Nnn, QR_Typ);
591 Set_Etype (Dnn, QR_Typ);
594 Make_Object_Declaration (Loc,
595 Defining_Identifier => Nnn,
596 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
597 Constant_Present => True,
598 Expression => Build_Conversion (N, QR_Typ, X)),
600 Make_Object_Declaration (Loc,
601 Defining_Identifier => Dnn,
602 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
603 Constant_Present => True,
604 Expression => Build_Multiply (N, Y, Z)));
608 New_Occurrence_Of (Nnn, Loc),
609 New_Occurrence_Of (Dnn, Loc));
611 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
614 Make_Object_Declaration (Loc,
615 Defining_Identifier => Qnn,
616 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
617 Constant_Present => True,
621 Make_Object_Declaration (Loc,
622 Defining_Identifier => Rnn,
623 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
624 Constant_Present => True,
627 New_Occurrence_Of (Nnn, Loc),
628 New_Occurrence_Of (Dnn, Loc))));
630 -- Case where denominator does not fit in Max_Integer_Size bits, we have
631 -- to call the runtime routine to compute the quotient and remainder.
634 Rnd := Boolean_Literals (Rounded_Result_Set (N));
637 Make_Object_Declaration (Loc,
638 Defining_Identifier => Qnn,
639 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
641 Make_Object_Declaration (Loc,
642 Defining_Identifier => Rnn,
643 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
645 Make_Procedure_Call_Statement (Loc,
646 Name => New_Occurrence_Of (RTE (QR_Id), Loc),
647 Parameter_Associations => New_List (
648 Build_Conversion (N, QR_Typ, X),
649 Build_Conversion (N, QR_Typ, Y),
650 Build_Conversion (N, QR_Typ, Z),
651 New_Occurrence_Of (Qnn, Loc),
652 New_Occurrence_Of (Rnn, Loc),
653 New_Occurrence_Of (Rnd, Loc))));
655 end Build_Double_Divide_Code;
661 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
662 Loc : constant Source_Ptr := Sloc (N);
663 Left_Type : constant Entity_Id := Etype (L);
664 Right_Type : constant Entity_Id := Etype (R);
668 Result_Type : Entity_Id;
672 -- Deal with floating-point case first
674 if Is_Floating_Point_Type (Left_Type) then
675 pragma Assert (Left_Type = Universal_Real);
676 pragma Assert (Right_Type = Universal_Real);
678 Result_Type := Universal_Real;
679 Rnode := Make_Op_Multiply (Loc, L, R);
681 -- Integer and fixed-point cases
684 -- An optimization. If the right operand is the literal 1, then we
685 -- can just return the left hand operand. Putting the optimization
686 -- here allows us to omit the check at the call site. Similarly, if
687 -- the left operand is the integer 1 we can return the right operand.
689 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
691 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
695 -- Otherwise we need to figure out the correct result type size
696 -- First figure out the effective sizes of the operands. Normally
697 -- the effective size of an operand is the RM_Size of the operand.
698 -- But a special case arises with operands whose size is known at
699 -- compile time. In this case, we can use the actual value of the
700 -- operand to get its size if it would fit in signed 8/16/32 bits.
702 Left_Size := UI_To_Int (RM_Size (Left_Type));
704 if Compile_Time_Known_Value (L) then
706 Val : constant Uint := Expr_Value (L);
708 if Val < Uint_2 ** 7 then
710 elsif Val < Uint_2 ** 15 then
712 elsif Val < Uint_2 ** 31 then
718 Right_Size := UI_To_Int (RM_Size (Right_Type));
720 if Compile_Time_Known_Value (R) then
722 Val : constant Uint := Expr_Value (R);
724 if Val <= Int'(2 ** 7) then
726 elsif Val <= Int'(2 ** 15) then
732 -- Now the result size must be at least the sum of the two sizes,
733 -- to accommodate all possible results.
735 Rsize := Left_Size + Right_Size;
738 Result_Type := Standard_Integer_8;
740 elsif Rsize <= 16 then
741 Result_Type := Standard_Integer_16;
743 elsif Rsize <= 32 then
744 Result_Type := Standard_Integer_32;
746 elsif Rsize <= 64 or else System_Max_Integer_Size < 128 then
747 Result_Type := Standard_Integer_64;
750 Result_Type := Standard_Integer_128;
754 Make_Op_Multiply (Loc,
755 Left_Opnd => Build_Conversion (N, Result_Type, L),
756 Right_Opnd => Build_Conversion (N, Result_Type, R));
759 -- We now have a multiply node built with Result_Type set. First
760 -- set Etype of result, as required for all Build_xxx routines
762 Set_Etype (Rnode, Base_Type (Result_Type));
771 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
772 Loc : constant Source_Ptr := Sloc (N);
773 Left_Type : constant Entity_Id := Etype (L);
774 Right_Type : constant Entity_Id := Etype (R);
775 Result_Type : Entity_Id;
779 if Left_Type = Right_Type then
780 Result_Type := Left_Type;
786 -- If left size is larger, we do the remainder operation using the
787 -- size of the left type (i.e. the larger of the two integer types).
789 elsif Esize (Left_Type) >= Esize (Right_Type) then
790 Result_Type := Left_Type;
794 Right_Opnd => Build_Conversion (N, Left_Type, R));
796 -- Similarly, if the right size is larger, we do the remainder
797 -- operation using the right type.
800 Result_Type := Right_Type;
803 Left_Opnd => Build_Conversion (N, Right_Type, L),
807 -- We now have an N_Op_Rem node built with Result_Type set. First
808 -- set Etype of result, as required for all Build_xxx routines
810 Set_Etype (Rnode, Base_Type (Result_Type));
812 -- One more check. We did the rem operation using the larger of the
813 -- two types, which is reasonable. However, in the case where the
814 -- two types have unequal sizes, it is impossible for the result of
815 -- a remainder operation to be larger than the smaller of the two
816 -- types, so we can put a conversion round the result to keep the
817 -- evolving operation size as small as possible.
819 if Esize (Left_Type) >= Esize (Right_Type) then
820 Rnode := Build_Conversion (N, Right_Type, Rnode);
821 elsif Esize (Right_Type) >= Esize (Left_Type) then
822 Rnode := Build_Conversion (N, Left_Type, Rnode);
828 -------------------------
829 -- Build_Scaled_Divide --
830 -------------------------
832 function Build_Scaled_Divide
834 X, Y, Z : Node_Id) return Node_Id
836 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
837 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
838 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
839 N_Size : constant Nat := X_Size + Y_Size;
840 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
844 -- If the numerator fits in Max_Integer_Size bits, we can build the
845 -- operations directly without causing any intermediate overflow. But
846 -- for backward compatibility reasons, we use a 128-bit divide only
847 -- if one of the operands is already larger than 64 bits.
849 if N_Size <= System_Max_Integer_Size
850 and then (N_Size <= 64 or else M_Size > 64)
852 return Build_Divide (N, Build_Multiply (N, X, Y), Z);
854 -- Otherwise we use the runtime routine
856 -- [Qnn : Integer_{64|128},
857 -- Rnn : Integer_{64|128};
858 -- Scaled_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
863 Loc : constant Source_Ptr := Sloc (N);
868 pragma Warnings (Off, Rnn);
871 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
872 Insert_Actions (N, Code);
873 Expr := New_Occurrence_Of (Qnn, Loc);
875 -- Set type of result in case used elsewhere (see note at start)
877 Set_Etype (Expr, Etype (Qnn));
881 end Build_Scaled_Divide;
883 ------------------------------
884 -- Build_Scaled_Divide_Code --
885 ------------------------------
887 -- If the numerator can be computed in Max_Integer_Size bits, we build
889 -- [Nnn : constant typ := typ (X) * typ (Y);
890 -- Dnn : constant typ := typ (Z)
891 -- Qnn : constant typ := Nnn / Dnn;
892 -- Rnn : constant typ := Nnn rem Dnn;
894 -- If the numerator cannot be computed in Max_Integer_Size bits, we build
896 -- [Qnn : Interfaces.Integer_{64|128};
897 -- Rnn : Interfaces.Integer_{64|128};
898 -- Scaled_Divide_{64|128} (X, Y, Z, Qnn, Rnn, Round);]
900 procedure Build_Scaled_Divide_Code
903 Qnn, Rnn : out Entity_Id;
906 Loc : constant Source_Ptr := Sloc (N);
908 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
909 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
910 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
911 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
924 -- Find type that will allow computation of numerator
926 QR_Siz := Nat'Max (X_Size + Y_Size, Z_Size);
929 QR_Typ := Standard_Integer_16;
932 elsif QR_Siz <= 32 then
933 QR_Typ := Standard_Integer_32;
936 elsif QR_Siz <= 64 then
937 QR_Typ := Standard_Integer_64;
940 -- For backward compatibility reasons, we use a 128-bit divide only
941 -- if one of the operands is already larger than 64 bits.
943 elsif System_Max_Integer_Size < 128 or else M_Size <= 64 then
944 QR_Typ := RTE (RE_Integer_64);
945 QR_Id := RE_Scaled_Divide64;
947 elsif QR_Siz <= 128 then
948 QR_Typ := Standard_Integer_128;
952 QR_Typ := RTE (RE_Integer_128);
953 QR_Id := RE_Scaled_Divide128;
956 -- Define quotient and remainder, and set their Etypes, so
957 -- that they can be picked up by Build_xxx routines.
959 Qnn := Make_Temporary (Loc, 'S');
960 Rnn := Make_Temporary (Loc, 'R');
962 Set_Etype (Qnn, QR_Typ);
963 Set_Etype (Rnn, QR_Typ);
965 -- Case where we can compute the numerator in Max_Integer_Size bits
967 if QR_Id = RE_Null then
968 Nnn := Make_Temporary (Loc, 'N');
969 Dnn := Make_Temporary (Loc, 'D');
971 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
973 Set_Etype (Nnn, QR_Typ);
974 Set_Etype (Dnn, QR_Typ);
977 Make_Object_Declaration (Loc,
978 Defining_Identifier => Nnn,
979 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
980 Constant_Present => True,
981 Expression => Build_Multiply (N, X, Y)),
983 Make_Object_Declaration (Loc,
984 Defining_Identifier => Dnn,
985 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
986 Constant_Present => True,
987 Expression => Build_Conversion (N, QR_Typ, Z)));
991 New_Occurrence_Of (Nnn, Loc),
992 New_Occurrence_Of (Dnn, Loc));
995 Make_Object_Declaration (Loc,
996 Defining_Identifier => Qnn,
997 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
998 Constant_Present => True,
1002 Make_Object_Declaration (Loc,
1003 Defining_Identifier => Rnn,
1004 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
1005 Constant_Present => True,
1008 New_Occurrence_Of (Nnn, Loc),
1009 New_Occurrence_Of (Dnn, Loc))));
1011 -- Case where numerator does not fit in Max_Integer_Size bits, we have
1012 -- to call the runtime routine to compute the quotient and remainder.
1015 Rnd := Boolean_Literals (Rounded_Result_Set (N));
1018 Make_Object_Declaration (Loc,
1019 Defining_Identifier => Qnn,
1020 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
1022 Make_Object_Declaration (Loc,
1023 Defining_Identifier => Rnn,
1024 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
1026 Make_Procedure_Call_Statement (Loc,
1027 Name => New_Occurrence_Of (RTE (QR_Id), Loc),
1028 Parameter_Associations => New_List (
1029 Build_Conversion (N, QR_Typ, X),
1030 Build_Conversion (N, QR_Typ, Y),
1031 Build_Conversion (N, QR_Typ, Z),
1032 New_Occurrence_Of (Qnn, Loc),
1033 New_Occurrence_Of (Rnn, Loc),
1034 New_Occurrence_Of (Rnd, Loc))));
1037 -- Set type of result, for use in caller
1039 Set_Etype (Qnn, QR_Typ);
1040 end Build_Scaled_Divide_Code;
1042 ---------------------------
1043 -- Do_Divide_Fixed_Fixed --
1044 ---------------------------
1048 -- (Result_Value * Result_Small) =
1049 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
1051 -- Result_Value = (Left_Value / Right_Value) *
1052 -- (Left_Small / (Right_Small * Result_Small));
1054 -- we can do the operation in integer arithmetic if this fraction is an
1055 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1056 -- Otherwise the result is in the close result set and our approach is to
1057 -- use floating-point to compute this close result.
1059 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
1060 Left : constant Node_Id := Left_Opnd (N);
1061 Right : constant Node_Id := Right_Opnd (N);
1062 Left_Type : constant Entity_Id := Etype (Left);
1063 Right_Type : constant Entity_Id := Etype (Right);
1064 Result_Type : constant Entity_Id := Etype (N);
1065 Right_Small : constant Ureal := Small_Value (Right_Type);
1066 Left_Small : constant Ureal := Small_Value (Left_Type);
1068 Result_Small : Ureal;
1075 -- Rounding is required if the result is integral
1077 if Is_Integer_Type (Result_Type) then
1078 Set_Rounded_Result (N);
1081 -- Get result small. If the result is an integer, treat it as though
1082 -- it had a small of 1.0, all other processing is identical.
1084 if Is_Integer_Type (Result_Type) then
1085 Result_Small := Ureal_1;
1087 Result_Small := Small_Value (Result_Type);
1092 Frac := Left_Small / (Right_Small * Result_Small);
1093 Frac_Num := Norm_Num (Frac);
1094 Frac_Den := Norm_Den (Frac);
1096 -- If the fraction is an integer, then we get the result by multiplying
1097 -- the left operand by the integer, and then dividing by the right
1098 -- operand (the order is important, if we did the divide first, we
1099 -- would lose precision).
1101 if Frac_Den = 1 then
1102 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1104 if Present (Lit_Int) then
1105 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1109 -- If the fraction is the reciprocal of an integer, then we get the
1110 -- result by first multiplying the divisor by the integer, and then
1111 -- doing the division with the adjusted divisor.
1113 -- Note: this is much better than doing two divisions: multiplications
1114 -- are much faster than divisions (and certainly faster than rounded
1115 -- divisions), and we don't get inaccuracies from double rounding.
1117 elsif Frac_Num = 1 then
1118 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1120 if Present (Lit_Int) then
1121 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1126 -- If we fall through, we use floating-point to compute the result
1130 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1131 Real_Literal (N, Frac)));
1132 end Do_Divide_Fixed_Fixed;
1134 -------------------------------
1135 -- Do_Divide_Fixed_Universal --
1136 -------------------------------
1140 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1141 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1143 -- The result is required to be in the perfect result set if the literal
1144 -- can be factored so that the resulting small ratio is an integer or the
1145 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1146 -- analysis of these RM requirements:
1148 -- We must factor the literal, finding an integer K:
1150 -- Lit_Value = K * Right_Small
1151 -- Right_Small = Lit_Value / K
1153 -- such that the small ratio:
1156 -- ------------------------------
1157 -- (Lit_Value / K) * Result_Small
1160 -- = ------------------------ * K
1161 -- Lit_Value * Result_Small
1163 -- is an integer or the reciprocal of an integer, and for
1164 -- implementation efficiency we need the smallest such K.
1166 -- First we reduce the left fraction to lowest terms
1168 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1169 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1170 -- Right_Small = Lit_Value.
1172 -- If numerator > 1, then set K to the denominator of the fraction so
1173 -- that the resulting small ratio is an integer (the numerator value).
1175 procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1176 Left : constant Node_Id := Left_Opnd (N);
1177 Right : constant Node_Id := Right_Opnd (N);
1178 Left_Type : constant Entity_Id := Etype (Left);
1179 Result_Type : constant Entity_Id := Etype (N);
1180 Left_Small : constant Ureal := Small_Value (Left_Type);
1181 Lit_Value : constant Ureal := Realval (Right);
1183 Result_Small : Ureal;
1191 -- Get result small. If the result is an integer, treat it as though
1192 -- it had a small of 1.0, all other processing is identical.
1194 if Is_Integer_Type (Result_Type) then
1195 Result_Small := Ureal_1;
1197 Result_Small := Small_Value (Result_Type);
1200 -- Determine if literal can be rewritten successfully
1202 Frac := Left_Small / (Lit_Value * Result_Small);
1203 Frac_Num := Norm_Num (Frac);
1204 Frac_Den := Norm_Den (Frac);
1206 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1207 -- = denominator). If this integer is not too large, this is the case
1208 -- where the result can be obtained by dividing by this integer value.
1210 if Frac_Num = 1 then
1211 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1213 if Present (Lit_Int) then
1214 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1218 -- Case where we choose K to make fraction an integer (K = denominator
1219 -- of fraction, integer = numerator of fraction). If both K and the
1220 -- numerator are small enough, this is the case where the result can
1221 -- be obtained by first multiplying by the integer value and then
1222 -- dividing by K (the order is important, if we divided first, we
1223 -- would lose precision).
1226 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1227 Lit_K := Integer_Literal (N, Frac_Den, False);
1229 if Present (Lit_Int) and then Present (Lit_K) then
1230 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1235 -- Fall through if the literal cannot be successfully rewritten, or if
1236 -- the small ratio is out of range of integer arithmetic. In the former
1237 -- case it is fine to use floating-point to get the close result set,
1238 -- and in the latter case, it means that the result is zero or raises
1239 -- constraint error, and we can do that accurately in floating-point.
1241 -- If we end up using floating-point, then we take the right integer
1242 -- to be one, and its small to be the value of the original right real
1243 -- literal. That way, we need only one floating-point multiplication.
1246 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1247 end Do_Divide_Fixed_Universal;
1249 -------------------------------
1250 -- Do_Divide_Universal_Fixed --
1251 -------------------------------
1255 -- (Result_Value * Result_Small) =
1256 -- Lit_Value / (Right_Value * Right_Small)
1258 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1260 -- The result is required to be in the perfect result set if the literal
1261 -- can be factored so that the resulting small ratio is an integer or the
1262 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1263 -- analysis of these RM requirements:
1265 -- We must factor the literal, finding an integer K:
1267 -- Lit_Value = K * Left_Small
1268 -- Left_Small = Lit_Value / K
1270 -- such that the small ratio:
1273 -- --------------------------
1274 -- Right_Small * Result_Small
1277 -- = -------------------------- * -
1278 -- Right_Small * Result_Small K
1280 -- is an integer or the reciprocal of an integer, and for
1281 -- implementation efficiency we need the smallest such K.
1283 -- First we reduce the left fraction to lowest terms
1285 -- If denominator = 1, then for K = 1, the small ratio is an integer
1286 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1287 -- and Left_Small = Lit_Value.
1289 -- If denominator > 1, then set K to the numerator of the fraction so
1290 -- that the resulting small ratio is the reciprocal of an integer (the
1291 -- numerator value).
1293 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1294 Left : constant Node_Id := Left_Opnd (N);
1295 Right : constant Node_Id := Right_Opnd (N);
1296 Right_Type : constant Entity_Id := Etype (Right);
1297 Result_Type : constant Entity_Id := Etype (N);
1298 Right_Small : constant Ureal := Small_Value (Right_Type);
1299 Lit_Value : constant Ureal := Realval (Left);
1301 Result_Small : Ureal;
1309 -- Get result small. If the result is an integer, treat it as though
1310 -- it had a small of 1.0, all other processing is identical.
1312 if Is_Integer_Type (Result_Type) then
1313 Result_Small := Ureal_1;
1315 Result_Small := Small_Value (Result_Type);
1318 -- Determine if literal can be rewritten successfully
1320 Frac := Lit_Value / (Right_Small * Result_Small);
1321 Frac_Num := Norm_Num (Frac);
1322 Frac_Den := Norm_Den (Frac);
1324 -- Case where fraction is an integer (K = 1, integer = numerator). If
1325 -- this integer is not too large, this is the case where the result
1326 -- can be obtained by dividing this integer by the right operand.
1328 if Frac_Den = 1 then
1329 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1331 if Present (Lit_Int) then
1332 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1336 -- Case where we choose K to make the fraction the reciprocal of an
1337 -- integer (K = numerator of fraction, integer = numerator of fraction).
1338 -- If both K and the integer are small enough, this is the case where
1339 -- the result can be obtained by multiplying the right operand by K
1340 -- and then dividing by the integer value. The order of the operations
1341 -- is important (if we divided first, we would lose precision).
1344 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1345 Lit_K := Integer_Literal (N, Frac_Num, False);
1347 if Present (Lit_Int) and then Present (Lit_K) then
1348 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1353 -- Fall through if the literal cannot be successfully rewritten, or if
1354 -- the small ratio is out of range of integer arithmetic. In the former
1355 -- case it is fine to use floating-point to get the close result set,
1356 -- and in the latter case, it means that the result is zero or raises
1357 -- constraint error, and we can do that accurately in floating-point.
1359 -- If we end up using floating-point, then we take the right integer
1360 -- to be one, and its small to be the value of the original right real
1361 -- literal. That way, we need only one floating-point division.
1364 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1365 end Do_Divide_Universal_Fixed;
1367 -----------------------------
1368 -- Do_Multiply_Fixed_Fixed --
1369 -----------------------------
1373 -- (Result_Value * Result_Small) =
1374 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1376 -- Result_Value = (Left_Value * Right_Value) *
1377 -- (Left_Small * Right_Small) / Result_Small;
1379 -- we can do the operation in integer arithmetic if this fraction is an
1380 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1381 -- Otherwise the result is in the close result set and our approach is to
1382 -- use floating-point to compute this close result.
1384 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1385 Left : constant Node_Id := Left_Opnd (N);
1386 Right : constant Node_Id := Right_Opnd (N);
1388 Left_Type : constant Entity_Id := Etype (Left);
1389 Right_Type : constant Entity_Id := Etype (Right);
1390 Result_Type : constant Entity_Id := Etype (N);
1391 Right_Small : constant Ureal := Small_Value (Right_Type);
1392 Left_Small : constant Ureal := Small_Value (Left_Type);
1394 Result_Small : Ureal;
1401 -- Get result small. If the result is an integer, treat it as though
1402 -- it had a small of 1.0, all other processing is identical.
1404 if Is_Integer_Type (Result_Type) then
1405 Result_Small := Ureal_1;
1407 Result_Small := Small_Value (Result_Type);
1412 Frac := (Left_Small * Right_Small) / Result_Small;
1413 Frac_Num := Norm_Num (Frac);
1414 Frac_Den := Norm_Den (Frac);
1416 -- If the fraction is an integer, then we get the result by multiplying
1417 -- the operands, and then multiplying the result by the integer value.
1419 if Frac_Den = 1 then
1420 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1422 if Present (Lit_Int) then
1424 Build_Multiply (N, Build_Multiply (N, Left, Right), Lit_Int));
1428 -- If the fraction is the reciprocal of an integer, then we get the
1429 -- result by multiplying the operands, and then dividing the result by
1430 -- the integer value. The order of the operations is important, if we
1431 -- divided first, we would lose precision.
1433 elsif Frac_Num = 1 then
1434 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1436 if Present (Lit_Int) then
1437 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1442 -- If we fall through, we use floating-point to compute the result
1446 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1447 Real_Literal (N, Frac)));
1448 end Do_Multiply_Fixed_Fixed;
1450 ---------------------------------
1451 -- Do_Multiply_Fixed_Universal --
1452 ---------------------------------
1456 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1457 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1459 -- The result is required to be in the perfect result set if the literal
1460 -- can be factored so that the resulting small ratio is an integer or the
1461 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1462 -- analysis of these RM requirements:
1464 -- We must factor the literal, finding an integer K:
1466 -- Lit_Value = K * Right_Small
1467 -- Right_Small = Lit_Value / K
1469 -- such that the small ratio:
1471 -- Left_Small * (Lit_Value / K)
1472 -- ----------------------------
1475 -- Left_Small * Lit_Value 1
1476 -- = ---------------------- * -
1479 -- is an integer or the reciprocal of an integer, and for
1480 -- implementation efficiency we need the smallest such K.
1482 -- First we reduce the left fraction to lowest terms
1484 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1485 -- this is clearly the minimum K case, so set
1487 -- K = 1, Right_Small = Lit_Value
1489 -- If denominator > 1, then set K to the numerator of the fraction, so
1490 -- that the resulting small ratio is the reciprocal of the integer (the
1491 -- denominator value).
1493 procedure Do_Multiply_Fixed_Universal
1495 Left, Right : Node_Id)
1497 Left_Type : constant Entity_Id := Etype (Left);
1498 Result_Type : constant Entity_Id := Etype (N);
1499 Left_Small : constant Ureal := Small_Value (Left_Type);
1500 Lit_Value : constant Ureal := Realval (Right);
1502 Result_Small : Ureal;
1510 -- Get result small. If the result is an integer, treat it as though
1511 -- it had a small of 1.0, all other processing is identical.
1513 if Is_Integer_Type (Result_Type) then
1514 Result_Small := Ureal_1;
1516 Result_Small := Small_Value (Result_Type);
1519 -- Determine if literal can be rewritten successfully
1521 Frac := (Left_Small * Lit_Value) / Result_Small;
1522 Frac_Num := Norm_Num (Frac);
1523 Frac_Den := Norm_Den (Frac);
1525 -- Case where fraction is an integer (K = 1, integer = numerator). If
1526 -- this integer is not too large, this is the case where the result can
1527 -- be obtained by multiplying by this integer value.
1529 if Frac_Den = 1 then
1530 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1532 if Present (Lit_Int) then
1533 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1537 -- Case where we choose K to make fraction the reciprocal of an integer
1538 -- (K = numerator of fraction, integer = denominator of fraction). If
1539 -- both K and the denominator are small enough, this is the case where
1540 -- the result can be obtained by first multiplying by K, and then
1541 -- dividing by the integer value.
1544 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1545 Lit_K := Integer_Literal (N, Frac_Num);
1547 if Present (Lit_Int) and then Present (Lit_K) then
1548 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1553 -- Fall through if the literal cannot be successfully rewritten, or if
1554 -- the small ratio is out of range of integer arithmetic. In the former
1555 -- case it is fine to use floating-point to get the close result set,
1556 -- and in the latter case, it means that the result is zero or raises
1557 -- constraint error, and we can do that accurately in floating-point.
1559 -- If we end up using floating-point, then we take the right integer
1560 -- to be one, and its small to be the value of the original right real
1561 -- literal. That way, we need only one floating-point multiplication.
1564 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1565 end Do_Multiply_Fixed_Universal;
1567 ---------------------------------
1568 -- Expand_Convert_Fixed_Static --
1569 ---------------------------------
1571 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1574 Convert_To (Etype (N),
1575 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1576 Analyze_And_Resolve (N);
1577 end Expand_Convert_Fixed_Static;
1579 -----------------------------------
1580 -- Expand_Convert_Fixed_To_Fixed --
1581 -----------------------------------
1585 -- Result_Value * Result_Small = Source_Value * Source_Small
1586 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1588 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1589 -- integer, then the perfect result set is obtained by a single integer
1592 -- If the small ratio is the reciprocal of a sufficiently small integer,
1593 -- then the perfect result set is obtained by a single integer division.
1595 -- If the numerator and denominator of the small ratio are sufficiently
1596 -- small integers, then the perfect result set is obtained by a scaled
1597 -- divide operation.
1599 -- In other cases, we obtain the close result set by calculating the
1600 -- result in floating-point.
1602 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1603 Rng_Check : constant Boolean := Do_Range_Check (N);
1604 Expr : constant Node_Id := Expression (N);
1605 Result_Type : constant Entity_Id := Etype (N);
1606 Source_Type : constant Entity_Id := Etype (Expr);
1607 Small_Ratio : Ureal;
1614 if Is_OK_Static_Expression (Expr) then
1615 Expand_Convert_Fixed_Static (N);
1619 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1620 Ratio_Num := Norm_Num (Small_Ratio);
1621 Ratio_Den := Norm_Den (Small_Ratio);
1623 if Ratio_Den = 1 then
1624 if Ratio_Num = 1 then
1625 Set_Result (N, Expr);
1629 Lit_Num := Integer_Literal (N, Ratio_Num);
1631 if Present (Lit_Num) then
1632 Set_Result (N, Build_Multiply (N, Expr, Lit_Num));
1637 elsif Ratio_Num = 1 then
1638 Lit_Den := Integer_Literal (N, Ratio_Den);
1640 if Present (Lit_Den) then
1641 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check);
1646 Lit_Num := Integer_Literal (N, Ratio_Num);
1647 Lit_Den := Integer_Literal (N, Ratio_Den);
1649 if Present (Lit_Num) and then Present (Lit_Den) then
1651 (N, Build_Scaled_Divide (N, Expr, Lit_Num, Lit_Den), Rng_Check);
1656 -- Fall through to use floating-point for the close result set case,
1657 -- as a result of the numerator or denominator of the small ratio not
1658 -- being a sufficiently small integer.
1663 Real_Literal (N, Small_Ratio)),
1665 end Expand_Convert_Fixed_To_Fixed;
1667 -----------------------------------
1668 -- Expand_Convert_Fixed_To_Float --
1669 -----------------------------------
1671 -- If the small of the fixed type is 1.0, then we simply convert the
1672 -- integer value directly to the target floating-point type, otherwise
1673 -- we first have to multiply by the small, in Universal_Real, and then
1674 -- convert the result to the target floating-point type.
1676 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1677 Rng_Check : constant Boolean := Do_Range_Check (N);
1678 Expr : constant Node_Id := Expression (N);
1679 Source_Type : constant Entity_Id := Etype (Expr);
1680 Small : constant Ureal := Small_Value (Source_Type);
1683 if Is_OK_Static_Expression (Expr) then
1684 Expand_Convert_Fixed_Static (N);
1688 if Small = Ureal_1 then
1689 Set_Result (N, Expr);
1695 Real_Literal (N, Small)),
1698 end Expand_Convert_Fixed_To_Float;
1700 -------------------------------------
1701 -- Expand_Convert_Fixed_To_Integer --
1702 -------------------------------------
1706 -- Result_Value = Source_Value * Source_Small
1708 -- If the small value is a sufficiently small integer, then the perfect
1709 -- result set is obtained by a single integer multiplication.
1711 -- If the small value is the reciprocal of a sufficiently small integer,
1712 -- then the perfect result set is obtained by a single integer division.
1714 -- If the numerator and denominator of the small value are sufficiently
1715 -- small integers, then the perfect result set is obtained by a scaled
1716 -- divide operation.
1718 -- In other cases, we obtain the close result set by calculating the
1719 -- result in floating-point.
1721 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1722 Rng_Check : constant Boolean := Do_Range_Check (N);
1723 Expr : constant Node_Id := Expression (N);
1724 Source_Type : constant Entity_Id := Etype (Expr);
1725 Small : constant Ureal := Small_Value (Source_Type);
1726 Small_Num : constant Uint := Norm_Num (Small);
1727 Small_Den : constant Uint := Norm_Den (Small);
1732 if Is_OK_Static_Expression (Expr) then
1733 Expand_Convert_Fixed_Static (N);
1737 if Small_Den = 1 then
1738 Lit_Num := Integer_Literal (N, Small_Num);
1740 if Present (Lit_Num) then
1741 Set_Result (N, Build_Multiply (N, Expr, Lit_Num), Rng_Check);
1745 elsif Small_Num = 1 then
1746 Lit_Den := Integer_Literal (N, Small_Den);
1748 if Present (Lit_Den) then
1749 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check);
1754 Lit_Num := Integer_Literal (N, Small_Num);
1755 Lit_Den := Integer_Literal (N, Small_Den);
1757 if Present (Lit_Num) and then Present (Lit_Den) then
1759 (N, Build_Scaled_Divide (N, Expr, Lit_Num, Lit_Den), Rng_Check);
1764 -- Fall through to use floating-point for the close result set case,
1765 -- as a result of the numerator or denominator of the small value not
1766 -- being a sufficiently small integer.
1771 Real_Literal (N, Small)),
1773 end Expand_Convert_Fixed_To_Integer;
1775 -----------------------------------
1776 -- Expand_Convert_Float_To_Fixed --
1777 -----------------------------------
1781 -- Result_Value * Result_Small = Operand_Value
1785 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1787 -- We do the small scaling in floating-point, and we do a multiplication
1788 -- rather than a division, since it is accurate enough for the perfect
1789 -- result cases, and faster.
1791 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1792 Expr : constant Node_Id := Expression (N);
1793 Result_Type : constant Entity_Id := Etype (N);
1794 Rng_Check : constant Boolean := Do_Range_Check (N);
1795 Small : constant Ureal := Small_Value (Result_Type);
1798 -- Optimize small = 1, where we can avoid the multiply completely
1800 if Small = Ureal_1 then
1801 Set_Result (N, Expr, Rng_Check, Trunc => True);
1803 -- Normal case where multiply is required. Rounding is truncating
1804 -- for decimal fixed point types only, see RM 4.6(29), except if the
1805 -- conversion comes from an attribute reference 'Round (RM 3.5.10 (14)):
1806 -- The attribute is implemented by means of a conversion that must
1815 L => Fpt_Value (Expr),
1816 R => Real_Literal (N, Ureal_1 / Small)),
1818 Trunc => Is_Decimal_Fixed_Point_Type (Result_Type)
1819 and not Rounded_Result (N));
1821 end Expand_Convert_Float_To_Fixed;
1823 -------------------------------------
1824 -- Expand_Convert_Integer_To_Fixed --
1825 -------------------------------------
1829 -- Result_Value * Result_Small = Operand_Value
1830 -- Result_Value = Operand_Value / Result_Small
1832 -- If the small value is a sufficiently small integer, then the perfect
1833 -- result set is obtained by a single integer division.
1835 -- If the small value is the reciprocal of a sufficiently small integer,
1836 -- the perfect result set is obtained by a single integer multiplication.
1838 -- If the numerator and denominator of the small value are sufficiently
1839 -- small integers, then the perfect result set is obtained by a scaled
1840 -- divide operation.
1842 -- In other cases, we obtain the close result set by calculating the
1843 -- result in floating-point using a multiplication by the reciprocal
1844 -- of the Result_Small.
1846 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1847 Rng_Check : constant Boolean := Do_Range_Check (N);
1848 Expr : constant Node_Id := Expression (N);
1849 Result_Type : constant Entity_Id := Etype (N);
1850 Small : constant Ureal := Small_Value (Result_Type);
1851 Small_Num : constant Uint := Norm_Num (Small);
1852 Small_Den : constant Uint := Norm_Den (Small);
1857 if Small_Den = 1 then
1858 Lit_Num := Integer_Literal (N, Small_Num);
1860 if Present (Lit_Num) then
1861 Set_Result (N, Build_Divide (N, Expr, Lit_Num), Rng_Check);
1865 elsif Small_Num = 1 then
1866 Lit_Den := Integer_Literal (N, Small_Den);
1868 if Present (Lit_Den) then
1869 Set_Result (N, Build_Multiply (N, Expr, Lit_Den), Rng_Check);
1874 Lit_Num := Integer_Literal (N, Small_Num);
1875 Lit_Den := Integer_Literal (N, Small_Den);
1877 if Present (Lit_Num) and then Present (Lit_Den) then
1879 (N, Build_Scaled_Divide (N, Expr, Lit_Den, Lit_Num), Rng_Check);
1884 -- Fall through to use floating-point for the close result set case,
1885 -- as a result of the numerator or denominator of the small value not
1886 -- being a sufficiently small integer.
1891 Real_Literal (N, Ureal_1 / Small)),
1893 end Expand_Convert_Integer_To_Fixed;
1895 --------------------------------
1896 -- Expand_Decimal_Divide_Call --
1897 --------------------------------
1899 -- We have four operands
1906 -- All of which are decimal types, and which thus have associated
1909 -- Computing the quotient is a similar problem to that faced by the
1910 -- normal fixed-point division, except that it is simpler, because
1911 -- we always have compatible smalls.
1913 -- Quotient = (Dividend / Divisor) * 10**q
1915 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1916 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1918 -- For q >= 0, we compute
1920 -- Numerator := Dividend * 10 ** q
1921 -- Denominator := Divisor
1922 -- Quotient := Numerator / Denominator
1924 -- For q < 0, we compute
1926 -- Numerator := Dividend
1927 -- Denominator := Divisor * 10 ** q
1928 -- Quotient := Numerator / Denominator
1930 -- Both these divisions are done in truncated mode, and the remainder
1931 -- from these divisions is used to compute the result Remainder. This
1932 -- remainder has the effective scale of the numerator of the division,
1934 -- For q >= 0, the remainder scale is Dividend'Scale + q
1935 -- For q < 0, the remainder scale is Dividend'Scale
1937 -- The result Remainder is then computed by a normal truncating decimal
1938 -- conversion from this scale to the scale of the remainder, i.e. by a
1939 -- division or multiplication by the appropriate power of 10.
1941 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1942 Loc : constant Source_Ptr := Sloc (N);
1944 Dividend : Node_Id := First_Actual (N);
1945 Divisor : Node_Id := Next_Actual (Dividend);
1946 Quotient : Node_Id := Next_Actual (Divisor);
1947 Remainder : Node_Id := Next_Actual (Quotient);
1949 Dividend_Type : constant Entity_Id := Etype (Dividend);
1950 Divisor_Type : constant Entity_Id := Etype (Divisor);
1951 Quotient_Type : constant Entity_Id := Etype (Quotient);
1952 Remainder_Type : constant Entity_Id := Etype (Remainder);
1954 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1955 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1956 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1957 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1960 Numerator_Scale : Uint;
1964 Computed_Remainder : Node_Id;
1965 Adjusted_Remainder : Node_Id;
1966 Scale_Adjust : Uint;
1969 -- Relocate the operands, since they are now list elements, and we
1970 -- need to reference them separately as operands in the expanded code.
1972 Dividend := Relocate_Node (Dividend);
1973 Divisor := Relocate_Node (Divisor);
1974 Quotient := Relocate_Node (Quotient);
1975 Remainder := Relocate_Node (Remainder);
1977 -- Now compute Q, the adjustment scale
1979 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1981 -- If Q is non-negative then we need a scaled divide
1984 Build_Scaled_Divide_Code
1987 Integer_Literal (N, Uint_10 ** Q),
1991 Numerator_Scale := Dividend_Scale + Q;
1993 -- If Q is negative, then we need a double divide
1996 Build_Double_Divide_Code
2000 Integer_Literal (N, Uint_10 ** (-Q)),
2003 Numerator_Scale := Dividend_Scale;
2006 -- Add statement to set quotient value
2008 -- Quotient := quotient-type!(Qnn);
2011 Make_Assignment_Statement (Loc,
2014 Unchecked_Convert_To (Quotient_Type,
2015 Build_Conversion (N, Quotient_Type,
2016 New_Occurrence_Of (Qnn, Loc)))));
2018 -- Now we need to deal with computing and setting the remainder. The
2019 -- scale of the remainder is in Numerator_Scale, and the desired
2020 -- scale is the scale of the given Remainder argument. There are
2023 -- Numerator_Scale > Remainder_Scale
2025 -- in this case, there are extra digits in the computed remainder
2026 -- which must be eliminated by an extra division:
2028 -- computed-remainder := Numerator rem Denominator
2029 -- scale_adjust = Numerator_Scale - Remainder_Scale
2030 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
2032 -- Numerator_Scale = Remainder_Scale
2034 -- in this case, the we have the remainder we need
2036 -- computed-remainder := Numerator rem Denominator
2037 -- adjusted-remainder := computed-remainder
2039 -- Numerator_Scale < Remainder_Scale
2041 -- in this case, we have insufficient digits in the computed
2042 -- remainder, which must be eliminated by an extra multiply
2044 -- computed-remainder := Numerator rem Denominator
2045 -- scale_adjust = Remainder_Scale - Numerator_Scale
2046 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
2048 -- Finally we assign the adjusted-remainder to the result Remainder
2049 -- with conversions to get the proper fixed-point type representation.
2051 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
2053 if Numerator_Scale > Remainder_Scale then
2054 Scale_Adjust := Numerator_Scale - Remainder_Scale;
2055 Adjusted_Remainder :=
2057 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
2059 elsif Numerator_Scale = Remainder_Scale then
2060 Adjusted_Remainder := Computed_Remainder;
2062 else -- Numerator_Scale < Remainder_Scale
2063 Scale_Adjust := Remainder_Scale - Numerator_Scale;
2064 Adjusted_Remainder :=
2066 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
2069 -- Assignment of remainder result
2072 Make_Assignment_Statement (Loc,
2075 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
2077 -- Final step is to rewrite the call with a block containing the
2078 -- above sequence of constructed statements for the divide operation.
2081 Make_Block_Statement (Loc,
2082 Handled_Statement_Sequence =>
2083 Make_Handled_Sequence_Of_Statements (Loc,
2084 Statements => Stmts)));
2087 end Expand_Decimal_Divide_Call;
2089 -----------------------------------------------
2090 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
2091 -----------------------------------------------
2093 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2094 Left : constant Node_Id := Left_Opnd (N);
2095 Right : constant Node_Id := Right_Opnd (N);
2098 if Etype (Left) = Universal_Real then
2099 Do_Divide_Universal_Fixed (N);
2101 elsif Etype (Right) = Universal_Real then
2102 Do_Divide_Fixed_Universal (N);
2105 Do_Divide_Fixed_Fixed (N);
2107 -- A focused optimization: if after constant folding the
2108 -- expression is of the form: T ((Exp * D) / D), where D is
2109 -- a static constant, return T (Exp). This form will show up
2110 -- when D is the denominator of the static expression for the
2111 -- 'small of fixed-point types involved. This transformation
2112 -- removes a division that may be expensive on some targets.
2114 if Nkind (N) = N_Type_Conversion
2115 and then Nkind (Expression (N)) = N_Op_Divide
2118 Num : constant Node_Id := Left_Opnd (Expression (N));
2119 Den : constant Node_Id := Right_Opnd (Expression (N));
2122 if Nkind (Den) = N_Integer_Literal
2123 and then Nkind (Num) = N_Op_Multiply
2124 and then Nkind (Right_Opnd (Num)) = N_Integer_Literal
2125 and then Intval (Den) = Intval (Right_Opnd (Num))
2127 Rewrite (Expression (N), Left_Opnd (Num));
2132 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
2134 -----------------------------------------------
2135 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
2136 -----------------------------------------------
2138 -- The division is done in Universal_Real, and the result is multiplied
2139 -- by the small ratio, which is Small (Right) / Small (Left). Special
2140 -- treatment is required for universal operands, which represent their
2141 -- own value and do not require conversion.
2143 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2144 Left : constant Node_Id := Left_Opnd (N);
2145 Right : constant Node_Id := Right_Opnd (N);
2147 Left_Type : constant Entity_Id := Etype (Left);
2148 Right_Type : constant Entity_Id := Etype (Right);
2151 -- Case of left operand is universal real, the result we want is:
2153 -- Left_Value / (Right_Value * Right_Small)
2155 -- so we compute this as:
2157 -- (Left_Value / Right_Small) / Right_Value
2159 if Left_Type = Universal_Real then
2162 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2163 Fpt_Value (Right)));
2165 -- Case of right operand is universal real, the result we want is
2167 -- (Left_Value * Left_Small) / Right_Value
2169 -- so we compute this as:
2171 -- Left_Value * (Left_Small / Right_Value)
2173 -- Note we invert to a multiplication since usually floating-point
2174 -- multiplication is much faster than floating-point division.
2176 elsif Right_Type = Universal_Real then
2180 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2182 -- Both operands are fixed, so the value we want is
2184 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2186 -- which we compute as:
2188 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2193 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2195 Small_Value (Left_Type) / Small_Value (Right_Type))));
2197 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2199 -------------------------------------------------
2200 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2201 -------------------------------------------------
2203 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2204 Left : constant Node_Id := Left_Opnd (N);
2205 Right : constant Node_Id := Right_Opnd (N);
2207 if Etype (Left) = Universal_Real then
2208 Do_Divide_Universal_Fixed (N);
2209 elsif Etype (Right) = Universal_Real then
2210 Do_Divide_Fixed_Universal (N);
2212 Do_Divide_Fixed_Fixed (N);
2214 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2216 -------------------------------------------------
2217 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2218 -------------------------------------------------
2220 -- Since the operand and result fixed-point type is the same, this is
2221 -- a straight divide by the right operand, the small can be ignored.
2223 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2224 Left : constant Node_Id := Left_Opnd (N);
2225 Right : constant Node_Id := Right_Opnd (N);
2227 Set_Result (N, Build_Divide (N, Left, Right));
2228 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2230 -------------------------------------------------
2231 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2232 -------------------------------------------------
2234 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2235 Left : constant Node_Id := Left_Opnd (N);
2236 Right : constant Node_Id := Right_Opnd (N);
2238 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2239 -- The operand may be a non-static universal value, such an
2240 -- exponentiation with a non-static exponent. In that case, treat
2241 -- as a fixed * fixed multiplication, and convert the argument to
2242 -- the target fixed type.
2244 ----------------------------------
2245 -- Rewrite_Non_Static_Universal --
2246 ----------------------------------
2248 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2249 Loc : constant Source_Ptr := Sloc (N);
2252 Make_Type_Conversion (Loc,
2253 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2254 Expression => Expression (Opnd)));
2255 Analyze_And_Resolve (Opnd, Etype (N));
2256 end Rewrite_Non_Static_Universal;
2258 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2261 if Etype (Left) = Universal_Real then
2262 if Nkind (Left) = N_Real_Literal then
2263 Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2265 elsif Nkind (Left) = N_Type_Conversion then
2266 Rewrite_Non_Static_Universal (Left);
2267 Do_Multiply_Fixed_Fixed (N);
2270 elsif Etype (Right) = Universal_Real then
2271 if Nkind (Right) = N_Real_Literal then
2272 Do_Multiply_Fixed_Universal (N, Left, Right);
2274 elsif Nkind (Right) = N_Type_Conversion then
2275 Rewrite_Non_Static_Universal (Right);
2276 Do_Multiply_Fixed_Fixed (N);
2280 Do_Multiply_Fixed_Fixed (N);
2282 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2284 -------------------------------------------------
2285 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2286 -------------------------------------------------
2288 -- The multiply is done in Universal_Real, and the result is multiplied
2289 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2290 -- Special treatment is required for universal operands.
2292 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2293 Left : constant Node_Id := Left_Opnd (N);
2294 Right : constant Node_Id := Right_Opnd (N);
2296 Left_Type : constant Entity_Id := Etype (Left);
2297 Right_Type : constant Entity_Id := Etype (Right);
2300 -- Case of left operand is universal real, the result we want is
2302 -- Left_Value * (Right_Value * Right_Small)
2304 -- so we compute this as:
2306 -- (Left_Value * Right_Small) * Right_Value;
2308 if Left_Type = Universal_Real then
2311 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2312 Fpt_Value (Right)));
2314 -- Case of right operand is universal real, the result we want is
2316 -- (Left_Value * Left_Small) * Right_Value
2318 -- so we compute this as:
2320 -- Left_Value * (Left_Small * Right_Value)
2322 elsif Right_Type = Universal_Real then
2326 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2328 -- Both operands are fixed, so the value we want is
2330 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2332 -- which we compute as:
2334 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2339 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2341 Small_Value (Right_Type) * Small_Value (Left_Type))));
2343 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2345 ---------------------------------------------------
2346 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2347 ---------------------------------------------------
2349 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2350 Loc : constant Source_Ptr := Sloc (N);
2351 Left : constant Node_Id := Left_Opnd (N);
2352 Right : constant Node_Id := Right_Opnd (N);
2355 if Etype (Left) = Universal_Real then
2356 Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2358 elsif Etype (Right) = Universal_Real then
2359 Do_Multiply_Fixed_Universal (N, Left, Right);
2361 -- If both types are equal and we need to avoid floating point
2362 -- instructions, it's worth introducing a temporary with the
2363 -- common type, because it may be evaluated more simply without
2364 -- the need for run-time use of floating point.
2366 elsif Etype (Right) = Etype (Left)
2367 and then Restriction_Active (No_Floating_Point)
2370 Temp : constant Entity_Id := Make_Temporary (Loc, 'F');
2371 Mult : constant Node_Id := Make_Op_Multiply (Loc, Left, Right);
2372 Decl : constant Node_Id :=
2373 Make_Object_Declaration (Loc,
2374 Defining_Identifier => Temp,
2375 Object_Definition => New_Occurrence_Of (Etype (Right), Loc),
2376 Expression => Mult);
2379 Insert_Action (N, Decl);
2381 OK_Convert_To (Etype (N), New_Occurrence_Of (Temp, Loc)));
2382 Analyze_And_Resolve (N, Standard_Integer);
2386 Do_Multiply_Fixed_Fixed (N);
2388 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2390 ---------------------------------------------------
2391 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2392 ---------------------------------------------------
2394 -- Since the operand and result fixed-point type is the same, this is
2395 -- a straight multiply by the right operand, the small can be ignored.
2397 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2400 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2401 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2403 ---------------------------------------------------
2404 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2405 ---------------------------------------------------
2407 -- Since the operand and result fixed-point type is the same, this is
2408 -- a straight multiply by the right operand, the small can be ignored.
2410 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2413 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2414 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2420 function Fpt_Value (N : Node_Id) return Node_Id is
2422 return Build_Conversion (N, Universal_Real, N);
2425 ---------------------
2426 -- Integer_Literal --
2427 ---------------------
2429 function Integer_Literal
2432 Negative : Boolean := False) return Node_Id
2438 if V < Uint_2 ** 7 then
2439 T := Standard_Integer_8;
2441 elsif V < Uint_2 ** 15 then
2442 T := Standard_Integer_16;
2444 elsif V < Uint_2 ** 31 then
2445 T := Standard_Integer_32;
2447 elsif V < Uint_2 ** 63 then
2448 T := Standard_Integer_64;
2450 elsif V < Uint_2 ** 127 and then System_Max_Integer_Size = 128 then
2451 T := Standard_Integer_128;
2458 L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
2460 L := Make_Integer_Literal (Sloc (N), V);
2463 -- Set type of result in case used elsewhere (see note at start)
2466 Set_Is_Static_Expression (L);
2468 -- We really need to set Analyzed here because we may be creating a
2469 -- very strange beast, namely an integer literal typed as fixed-point
2470 -- and the analyzer won't like that.
2474 end Integer_Literal;
2480 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2484 L := Make_Real_Literal (Sloc (N), V);
2486 -- Set type of result in case used elsewhere (see note at start)
2488 Set_Etype (L, Universal_Real);
2492 ------------------------
2493 -- Rounded_Result_Set --
2494 ------------------------
2496 function Rounded_Result_Set (N : Node_Id) return Boolean is
2497 K : constant Node_Kind := Nkind (N);
2499 if (K = N_Type_Conversion or else
2500 K = N_Op_Divide or else
2503 (Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
2509 end Rounded_Result_Set;
2515 procedure Set_Result
2518 Rchk : Boolean := False;
2519 Trunc : Boolean := False)
2523 Expr_Type : constant Entity_Id := Etype (Expr);
2524 Result_Type : constant Entity_Id := Etype (N);
2527 -- No conversion required if types match and no range check or truncate
2529 if Result_Type = Expr_Type and then not (Rchk or Trunc) then
2532 -- Else perform required conversion
2535 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
2539 Analyze_And_Resolve (N, Result_Type);