Add assember CFI directives to millicode division and remainder routines.
[official-gcc.git] / gcc / ada / exp_fixd.adb
blob61c2f923f0825fe31e1169ffc296a5d53b1f6480
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- E X P _ F I X D --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2023, Free Software Foundation, Inc. --
10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING3. If not, go to --
19 -- http://www.gnu.org/licenses for a complete copy of the license. --
20 -- --
21 -- GNAT was originally developed by the GNAT team at New York University. --
22 -- Extensive contributions were provided by Ada Core Technologies Inc. --
23 -- --
24 ------------------------------------------------------------------------------
26 with Atree; use Atree;
27 with Checks; use Checks;
28 with Einfo; use Einfo;
29 with 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;
37 with Sem; use Sem;
38 with Sem_Eval; use Sem_Eval;
39 with Sem_Res; use Sem_Res;
40 with Sem_Util; use Sem_Util;
41 with Sinfo; use Sinfo;
42 with 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
66 (N : Node_Id;
67 Typ : Entity_Id;
68 Expr : Node_Id;
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
94 (N : Node_Id;
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
102 (N : Node_Id;
103 X, Y, Z : Node_Id;
104 Qnn, Rnn : out Entity_Id;
105 Code : out List_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
134 (N : Node_Id;
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
142 (N : Node_Id;
143 X, Y, Z : Node_Id;
144 Qnn, Rnn : out Entity_Id;
145 Code : out List_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 Get_Size_For_Value (V : Uint) return Pos;
194 -- Given a non-negative universal integer value, return the size of a small
195 -- signed integer type covering -V .. V, or Pos'Max if no such type exists.
197 function Get_Type_For_Size (Siz : Pos; Force : Boolean) return Entity_Id;
198 -- Return the smallest signed integer type containing at least Siz bits.
199 -- If no such type exists, return Empty if Force is False or the largest
200 -- signed integer type if Force is True.
202 function Integer_Literal
203 (N : Node_Id;
204 V : Uint;
205 Negative : Boolean := False) return Node_Id;
206 -- Given a non-negative universal integer value, build a typed integer
207 -- literal node, using the smallest applicable standard integer type.
208 -- If Negative is true, then a negative literal is built. If V exceeds
209 -- 2**(System_Max_Integer_Size - 1) - 1, the largest value allowed for
210 -- perfect result set scaling factors (see RM G.2.3(22)), then Empty is
211 -- returned. The node N provides the Sloc value for the constructed
212 -- literal. The Etype of the resulting literal is correctly set, and it
213 -- is marked as analyzed.
215 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id;
216 -- Build a real literal node from the given value, the Etype of the
217 -- returned node is set to Universal_Real, since all floating-point
218 -- arithmetic operations that we construct use Universal_Real
220 function Rounded_Result_Set (N : Node_Id) return Boolean;
221 -- Returns True if N is a node that contains the Rounded_Result flag
222 -- and if the flag is true or the target type is an integer type.
224 procedure Set_Result
225 (N : Node_Id;
226 Expr : Node_Id;
227 Rchk : Boolean := False;
228 Trunc : Boolean := False);
229 -- N is the node for the current conversion, division or multiplication
230 -- operation, and Expr is an expression representing the result. Expr may
231 -- be of floating-point or integer type. If the operation result is fixed-
232 -- point, then the value of Expr is in units of small of the result type
233 -- (i.e. small's have already been dealt with). The result of the call is
234 -- to replace N by an appropriate conversion to the result type, dealing
235 -- with rounding for the decimal types case. The node is then analyzed and
236 -- resolved using the result type. If Rchk or Trunc are True, then
237 -- respectively Do_Range_Check and Float_Truncate are set in the
238 -- resulting conversion.
240 ----------------------
241 -- Build_Conversion --
242 ----------------------
244 function Build_Conversion
245 (N : Node_Id;
246 Typ : Entity_Id;
247 Expr : Node_Id;
248 Rchk : Boolean := False;
249 Trunc : Boolean := False) return Node_Id
251 Loc : constant Source_Ptr := Sloc (N);
252 Result : Node_Id;
253 Rcheck : Boolean := Rchk;
255 begin
256 -- A special case, if the expression is an integer literal and the
257 -- target type is an integer type, then just retype the integer
258 -- literal to the desired target type. Don't do this if we need
259 -- a range check.
261 if Nkind (Expr) = N_Integer_Literal
262 and then Is_Integer_Type (Typ)
263 and then not Rchk
264 then
265 Result := Expr;
267 -- Cases where we end up with a conversion. Note that we do not use the
268 -- Convert_To abstraction here, since we may be decorating the resulting
269 -- conversion with Rounded_Result and/or Conversion_OK, so we want the
270 -- conversion node present, even if it appears to be redundant.
272 else
273 -- Remove inner conversion if both inner and outer conversions are
274 -- to integer types, since the inner one serves no purpose (except
275 -- perhaps to set rounding, so we preserve the Rounded_Result flag)
276 -- and also preserve the Conversion_OK and Do_Range_Check flags of
277 -- the inner conversion.
279 if Is_Integer_Type (Typ)
280 and then Is_Integer_Type (Etype (Expr))
281 and then Nkind (Expr) = N_Type_Conversion
282 then
283 Result :=
284 Make_Type_Conversion (Loc,
285 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
286 Expression => Expression (Expr));
287 Set_Rounded_Result (Result, Rounded_Result_Set (Expr));
288 Set_Conversion_OK (Result, Conversion_OK (Expr));
289 Rcheck := Rcheck or Do_Range_Check (Expr);
291 -- For all other cases, a simple type conversion will work
293 else
294 Result :=
295 Make_Type_Conversion (Loc,
296 Subtype_Mark => New_Occurrence_Of (Typ, Loc),
297 Expression => Expr);
299 Set_Float_Truncate (Result, Trunc);
300 end if;
302 -- Set Conversion_OK if either result or expression type is a
303 -- fixed-point type, since from a semantic point of view, we are
304 -- treating fixed-point values as integers at this stage.
306 if Is_Fixed_Point_Type (Typ)
307 or else Is_Fixed_Point_Type (Etype (Expression (Result)))
308 then
309 Set_Conversion_OK (Result);
310 end if;
312 -- Set Do_Range_Check if either it was requested by the caller,
313 -- or if an eliminated inner conversion had a range check.
315 if Rcheck then
316 Enable_Range_Check (Result);
317 else
318 Set_Do_Range_Check (Result, False);
319 end if;
320 end if;
322 Set_Etype (Result, Typ);
323 return Result;
324 end Build_Conversion;
326 ------------------
327 -- Build_Divide --
328 ------------------
330 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is
331 Loc : constant Source_Ptr := Sloc (N);
332 Left_Type : constant Entity_Id := Base_Type (Etype (L));
333 Right_Type : constant Entity_Id := Base_Type (Etype (R));
334 Left_Size : Int;
335 Right_Size : Int;
336 Result_Type : Entity_Id;
337 Rnode : Node_Id;
339 begin
340 -- Deal with floating-point case first
342 if Is_Floating_Point_Type (Left_Type) then
343 pragma Assert (Left_Type = Universal_Real);
344 pragma Assert (Right_Type = Universal_Real);
346 Rnode := Make_Op_Divide (Loc, L, R);
347 Result_Type := Universal_Real;
349 -- Integer and fixed-point cases
351 else
352 -- An optimization. If the right operand is the literal 1, then we
353 -- can just return the left hand operand. Putting the optimization
354 -- here allows us to omit the check at the call site.
356 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
357 return L;
358 end if;
360 -- Otherwise we need to figure out the correct result type size
361 -- First figure out the effective sizes of the operands. Normally
362 -- the effective size of an operand is the RM_Size of the operand.
363 -- But a special case arises with operands whose size is known at
364 -- compile time. In this case, we can use the actual value of the
365 -- operand to get a size if it would fit in a small signed integer.
367 Left_Size := UI_To_Int (RM_Size (Left_Type));
369 if Compile_Time_Known_Value (L) then
370 declare
371 Siz : constant Int :=
372 Get_Size_For_Value (UI_Abs (Expr_Value (L)));
373 begin
374 if Siz < Left_Size then
375 Left_Size := Siz;
376 end if;
377 end;
378 end if;
380 Right_Size := UI_To_Int (RM_Size (Right_Type));
382 if Compile_Time_Known_Value (R) then
383 declare
384 Siz : constant Int :=
385 Get_Size_For_Value (UI_Abs (Expr_Value (R)));
386 begin
387 if Siz < Right_Size then
388 Right_Size := Siz;
389 end if;
390 end;
391 end if;
393 -- Do the operation using the longer of the two sizes
395 Result_Type :=
396 Get_Type_For_Size (Int'Max (Left_Size, Right_Size), Force => True);
398 Rnode :=
399 Make_Op_Divide (Loc,
400 Left_Opnd => Build_Conversion (N, Result_Type, L),
401 Right_Opnd => Build_Conversion (N, Result_Type, R));
402 end if;
404 -- We now have a divide node built with Result_Type set. First
405 -- set Etype of result, as required for all Build_xxx routines
407 Set_Etype (Rnode, Base_Type (Result_Type));
409 -- The result is rounded if the target of the operation is decimal
410 -- and Rounded_Result is set, or if the target of the operation
411 -- is an integer type, as determined by Rounded_Result_Set.
413 Set_Rounded_Result (Rnode, Rounded_Result_Set (N));
415 -- One more check. We did the divide operation using the longer of
416 -- the two sizes, which is reasonable. However, in the case where the
417 -- two types have unequal sizes, it is impossible for the result of
418 -- a divide operation to be larger than the dividend, so we can put
419 -- a conversion round the result to keep the evolving operation size
420 -- as small as possible.
422 if not Is_Floating_Point_Type (Left_Type) then
423 Rnode := Build_Conversion (N, Left_Type, Rnode);
424 end if;
426 return Rnode;
427 end Build_Divide;
429 -------------------------
430 -- Build_Double_Divide --
431 -------------------------
433 function Build_Double_Divide
434 (N : Node_Id;
435 X, Y, Z : Node_Id) return Node_Id
437 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
438 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
439 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
440 D_Size : constant Nat := Y_Size + Z_Size;
441 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
442 Expr : Node_Id;
444 begin
445 -- If the denominator fits in Max_Integer_Size bits, we can build the
446 -- operations directly without causing any intermediate overflow. But
447 -- for backward compatibility reasons, we use a 128-bit divide only
448 -- if one of the operands is already larger than 64 bits.
450 if D_Size <= System_Max_Integer_Size
451 and then (D_Size <= 64 or else M_Size > 64)
452 then
453 return Build_Divide (N, X, Build_Multiply (N, Y, Z));
455 -- Otherwise we use the runtime routine
457 -- [Qnn : Interfaces.Integer_{64|128};
458 -- Rnn : Interfaces.Integer_{64|128};
459 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
460 -- Qnn]
462 else
463 declare
464 Loc : constant Source_Ptr := Sloc (N);
465 Qnn : Entity_Id;
466 Rnn : Entity_Id;
467 Code : List_Id;
469 pragma Warnings (Off, Rnn);
471 begin
472 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
473 Insert_Actions (N, Code);
474 Expr := New_Occurrence_Of (Qnn, Loc);
476 -- Set type of result in case used elsewhere (see note at start)
478 Set_Etype (Expr, Etype (Qnn));
480 -- Set result as analyzed (see note at start on build routines)
482 return Expr;
483 end;
484 end if;
485 end Build_Double_Divide;
487 ------------------------------
488 -- Build_Double_Divide_Code --
489 ------------------------------
491 -- If the denominator can be computed in Max_Integer_Size bits, we build
493 -- [Nnn : constant typ := typ (X);
494 -- Dnn : constant typ := typ (Y) * typ (Z)
495 -- Qnn : constant typ := Nnn / Dnn;
496 -- Rnn : constant typ := Nnn rem Dnn;
498 -- If the denominator cannot be computed in Max_Integer_Size bits, we build
500 -- [Qnn : Interfaces.Integer_{64|128};
501 -- Rnn : Interfaces.Integer_{64|128};
502 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);]
504 procedure Build_Double_Divide_Code
505 (N : Node_Id;
506 X, Y, Z : Node_Id;
507 Qnn, Rnn : out Entity_Id;
508 Code : out List_Id)
510 Loc : constant Source_Ptr := Sloc (N);
512 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
513 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
514 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
515 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
517 QR_Id : RE_Id;
518 QR_Siz : Nat;
519 QR_Typ : Entity_Id;
521 Nnn : Entity_Id;
522 Dnn : Entity_Id;
524 Quo : Node_Id;
525 Rnd : Entity_Id;
527 begin
528 -- Find type that will allow computation of denominator
530 QR_Siz := Nat'Max (X_Size, Y_Size + Z_Size);
532 if QR_Siz <= 16 then
533 QR_Typ := Standard_Integer_16;
534 QR_Id := RE_Null;
536 elsif QR_Siz <= 32 then
537 QR_Typ := Standard_Integer_32;
538 QR_Id := RE_Null;
540 elsif QR_Siz <= 64 then
541 QR_Typ := Standard_Integer_64;
542 QR_Id := RE_Null;
544 -- For backward compatibility reasons, we use a 128-bit divide only
545 -- if one of the operands is already larger than 64 bits.
547 elsif System_Max_Integer_Size < 128 or else M_Size <= 64 then
548 QR_Typ := RTE (RE_Integer_64);
549 QR_Id := RE_Double_Divide64;
551 elsif QR_Siz <= 128 then
552 QR_Typ := Standard_Integer_128;
553 QR_Id := RE_Null;
555 else
556 QR_Typ := RTE (RE_Integer_128);
557 QR_Id := RE_Double_Divide128;
558 end if;
560 -- Define quotient and remainder, and set their Etypes, so
561 -- that they can be picked up by Build_xxx routines.
563 Qnn := Make_Temporary (Loc, 'S');
564 Rnn := Make_Temporary (Loc, 'R');
566 Set_Etype (Qnn, QR_Typ);
567 Set_Etype (Rnn, QR_Typ);
569 -- Case where we can compute the denominator in Max_Integer_Size bits
571 if QR_Id = RE_Null then
573 -- Create temporaries for numerator and denominator and set Etypes,
574 -- so that New_Occurrence_Of picks them up for Build_xxx calls.
576 Nnn := Make_Temporary (Loc, 'N');
577 Dnn := Make_Temporary (Loc, 'D');
579 Set_Etype (Nnn, QR_Typ);
580 Set_Etype (Dnn, QR_Typ);
582 Code := New_List (
583 Make_Object_Declaration (Loc,
584 Defining_Identifier => Nnn,
585 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
586 Constant_Present => True,
587 Expression => Build_Conversion (N, QR_Typ, X)),
589 Make_Object_Declaration (Loc,
590 Defining_Identifier => Dnn,
591 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
592 Constant_Present => True,
593 Expression => Build_Multiply (N, Y, Z)));
595 Quo :=
596 Build_Divide (N,
597 New_Occurrence_Of (Nnn, Loc),
598 New_Occurrence_Of (Dnn, Loc));
600 Set_Rounded_Result (Quo, Rounded_Result_Set (N));
602 Append_To (Code,
603 Make_Object_Declaration (Loc,
604 Defining_Identifier => Qnn,
605 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
606 Constant_Present => True,
607 Expression => Quo));
609 Append_To (Code,
610 Make_Object_Declaration (Loc,
611 Defining_Identifier => Rnn,
612 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
613 Constant_Present => True,
614 Expression =>
615 Build_Rem (N,
616 New_Occurrence_Of (Nnn, Loc),
617 New_Occurrence_Of (Dnn, Loc))));
619 -- Case where denominator does not fit in Max_Integer_Size bits, we have
620 -- to call the runtime routine to compute the quotient and remainder.
622 else
623 Rnd := Boolean_Literals (Rounded_Result_Set (N));
625 Code := New_List (
626 Make_Object_Declaration (Loc,
627 Defining_Identifier => Qnn,
628 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
630 Make_Object_Declaration (Loc,
631 Defining_Identifier => Rnn,
632 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
634 Make_Procedure_Call_Statement (Loc,
635 Name => New_Occurrence_Of (RTE (QR_Id), Loc),
636 Parameter_Associations => New_List (
637 Build_Conversion (N, QR_Typ, X),
638 Build_Conversion (N, QR_Typ, Y),
639 Build_Conversion (N, QR_Typ, Z),
640 New_Occurrence_Of (Qnn, Loc),
641 New_Occurrence_Of (Rnn, Loc),
642 New_Occurrence_Of (Rnd, Loc))));
643 end if;
644 end Build_Double_Divide_Code;
646 --------------------
647 -- Build_Multiply --
648 --------------------
650 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is
651 Loc : constant Source_Ptr := Sloc (N);
652 Left_Type : constant Entity_Id := Etype (L);
653 Right_Type : constant Entity_Id := Etype (R);
654 Left_Size : Int;
655 Right_Size : Int;
656 Result_Type : Entity_Id;
657 Rnode : Node_Id;
659 begin
660 -- Deal with floating-point case first
662 if Is_Floating_Point_Type (Left_Type) then
663 pragma Assert (Left_Type = Universal_Real);
664 pragma Assert (Right_Type = Universal_Real);
666 Result_Type := Universal_Real;
667 Rnode := Make_Op_Multiply (Loc, L, R);
669 -- Integer and fixed-point cases
671 else
672 -- An optimization. If the right operand is the literal 1, then we
673 -- can just return the left hand operand. Putting the optimization
674 -- here allows us to omit the check at the call site. Similarly, if
675 -- the left operand is the integer 1 we can return the right operand.
677 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then
678 return L;
679 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then
680 return R;
681 end if;
683 -- Otherwise we need to figure out the correct result type size
684 -- First figure out the effective sizes of the operands. Normally
685 -- the effective size of an operand is the RM_Size of the operand.
686 -- But a special case arises with operands whose size is known at
687 -- compile time. In this case, we can use the actual value of the
688 -- operand to get a size if it would fit in a small signed integer.
690 Left_Size := UI_To_Int (RM_Size (Left_Type));
692 if Compile_Time_Known_Value (L) then
693 declare
694 Siz : constant Int :=
695 Get_Size_For_Value (UI_Abs (Expr_Value (L)));
696 begin
697 if Siz < Left_Size then
698 Left_Size := Siz;
699 end if;
700 end;
701 end if;
703 Right_Size := UI_To_Int (RM_Size (Right_Type));
705 if Compile_Time_Known_Value (R) then
706 declare
707 Siz : constant Int :=
708 Get_Size_For_Value (UI_Abs (Expr_Value (R)));
709 begin
710 if Siz < Right_Size then
711 Right_Size := Siz;
712 end if;
713 end;
714 end if;
716 -- Now the result size must be at least the sum of the two sizes,
717 -- to accommodate all possible results.
719 Result_Type :=
720 Get_Type_For_Size (Left_Size + Right_Size, Force => True);
722 Rnode :=
723 Make_Op_Multiply (Loc,
724 Left_Opnd => Build_Conversion (N, Result_Type, L),
725 Right_Opnd => Build_Conversion (N, Result_Type, R));
726 end if;
728 -- We now have a multiply node built with Result_Type set. First
729 -- set Etype of result, as required for all Build_xxx routines
731 Set_Etype (Rnode, Base_Type (Result_Type));
733 return Rnode;
734 end Build_Multiply;
736 ---------------
737 -- Build_Rem --
738 ---------------
740 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is
741 Loc : constant Source_Ptr := Sloc (N);
742 Left_Type : constant Entity_Id := Etype (L);
743 Right_Type : constant Entity_Id := Etype (R);
744 Result_Type : Entity_Id;
745 Rnode : Node_Id;
747 begin
748 if Left_Type = Right_Type then
749 Result_Type := Left_Type;
750 Rnode :=
751 Make_Op_Rem (Loc,
752 Left_Opnd => L,
753 Right_Opnd => R);
755 -- If left size is larger, we do the remainder operation using the
756 -- size of the left type (i.e. the larger of the two integer types).
758 elsif Esize (Left_Type) >= Esize (Right_Type) then
759 Result_Type := Left_Type;
760 Rnode :=
761 Make_Op_Rem (Loc,
762 Left_Opnd => L,
763 Right_Opnd => Build_Conversion (N, Left_Type, R));
765 -- Similarly, if the right size is larger, we do the remainder
766 -- operation using the right type.
768 else
769 Result_Type := Right_Type;
770 Rnode :=
771 Make_Op_Rem (Loc,
772 Left_Opnd => Build_Conversion (N, Right_Type, L),
773 Right_Opnd => R);
774 end if;
776 -- We now have an N_Op_Rem node built with Result_Type set. First
777 -- set Etype of result, as required for all Build_xxx routines
779 Set_Etype (Rnode, Base_Type (Result_Type));
781 -- One more check. We did the rem operation using the larger of the
782 -- two types, which is reasonable. However, in the case where the
783 -- two types have unequal sizes, it is impossible for the result of
784 -- a remainder operation to be larger than the smaller of the two
785 -- types, so we can put a conversion round the result to keep the
786 -- evolving operation size as small as possible.
788 if Esize (Left_Type) >= Esize (Right_Type) then
789 Rnode := Build_Conversion (N, Right_Type, Rnode);
790 elsif Esize (Right_Type) >= Esize (Left_Type) then
791 Rnode := Build_Conversion (N, Left_Type, Rnode);
792 end if;
794 return Rnode;
795 end Build_Rem;
797 -------------------------
798 -- Build_Scaled_Divide --
799 -------------------------
801 function Build_Scaled_Divide
802 (N : Node_Id;
803 X, Y, Z : Node_Id) return Node_Id
805 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
806 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
807 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
808 N_Size : constant Nat := X_Size + Y_Size;
809 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
810 Expr : Node_Id;
812 begin
813 -- If the numerator fits in Max_Integer_Size bits, we can build the
814 -- operations directly without causing any intermediate overflow. But
815 -- for backward compatibility reasons, we use a 128-bit divide only
816 -- if one of the operands is already larger than 64 bits.
818 if N_Size <= System_Max_Integer_Size
819 and then (N_Size <= 64 or else M_Size > 64)
820 then
821 return Build_Divide (N, Build_Multiply (N, X, Y), Z);
823 -- Otherwise we use the runtime routine
825 -- [Qnn : Integer_{64|128},
826 -- Rnn : Integer_{64|128};
827 -- Scaled_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);
828 -- Qnn]
830 else
831 declare
832 Loc : constant Source_Ptr := Sloc (N);
833 Qnn : Entity_Id;
834 Rnn : Entity_Id;
835 Code : List_Id;
837 pragma Warnings (Off, Rnn);
839 begin
840 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code);
841 Insert_Actions (N, Code);
842 Expr := New_Occurrence_Of (Qnn, Loc);
844 -- Set type of result in case used elsewhere (see note at start)
846 Set_Etype (Expr, Etype (Qnn));
847 return Expr;
848 end;
849 end if;
850 end Build_Scaled_Divide;
852 ------------------------------
853 -- Build_Scaled_Divide_Code --
854 ------------------------------
856 -- If the numerator can be computed in Max_Integer_Size bits, we build
858 -- [Nnn : constant typ := typ (X) * typ (Y);
859 -- Dnn : constant typ := typ (Z)
860 -- Qnn : constant typ := Nnn / Dnn;
861 -- Rnn : constant typ := Nnn rem Dnn;
863 -- If the numerator cannot be computed in Max_Integer_Size bits, we build
865 -- [Qnn : Interfaces.Integer_{64|128};
866 -- Rnn : Interfaces.Integer_{64|128};
867 -- Scaled_Divide_{64|128} (X, Y, Z, Qnn, Rnn, Round);]
869 procedure Build_Scaled_Divide_Code
870 (N : Node_Id;
871 X, Y, Z : Node_Id;
872 Qnn, Rnn : out Entity_Id;
873 Code : out List_Id)
875 Loc : constant Source_Ptr := Sloc (N);
877 X_Size : constant Nat := UI_To_Int (RM_Size (Etype (X)));
878 Y_Size : constant Nat := UI_To_Int (RM_Size (Etype (Y)));
879 Z_Size : constant Nat := UI_To_Int (RM_Size (Etype (Z)));
880 M_Size : constant Nat := Nat'Max (X_Size, Nat'Max (Y_Size, Z_Size));
882 QR_Id : RE_Id;
883 QR_Siz : Nat;
884 QR_Typ : Entity_Id;
886 Nnn : Entity_Id;
887 Dnn : Entity_Id;
889 Quo : Node_Id;
890 Rnd : Entity_Id;
892 begin
893 -- Find type that will allow computation of numerator
895 QR_Siz := Nat'Max (X_Size + Y_Size, Z_Size);
897 if QR_Siz <= 16 then
898 QR_Typ := Standard_Integer_16;
899 QR_Id := RE_Null;
901 elsif QR_Siz <= 32 then
902 QR_Typ := Standard_Integer_32;
903 QR_Id := RE_Null;
905 elsif QR_Siz <= 64 then
906 QR_Typ := Standard_Integer_64;
907 QR_Id := RE_Null;
909 -- For backward compatibility reasons, we use a 128-bit divide only
910 -- if one of the operands is already larger than 64 bits.
912 elsif System_Max_Integer_Size < 128 or else M_Size <= 64 then
913 QR_Typ := RTE (RE_Integer_64);
914 QR_Id := RE_Scaled_Divide64;
916 elsif QR_Siz <= 128 then
917 QR_Typ := Standard_Integer_128;
918 QR_Id := RE_Null;
920 else
921 QR_Typ := RTE (RE_Integer_128);
922 QR_Id := RE_Scaled_Divide128;
923 end if;
925 -- Define quotient and remainder, and set their Etypes, so
926 -- that they can be picked up by Build_xxx routines.
928 Qnn := Make_Temporary (Loc, 'S');
929 Rnn := Make_Temporary (Loc, 'R');
931 Set_Etype (Qnn, QR_Typ);
932 Set_Etype (Rnn, QR_Typ);
934 -- Case where we can compute the numerator in Max_Integer_Size bits
936 if QR_Id = RE_Null then
937 Nnn := Make_Temporary (Loc, 'N');
938 Dnn := Make_Temporary (Loc, 'D');
940 -- Set Etypes, so that they can be picked up by New_Occurrence_Of
942 Set_Etype (Nnn, QR_Typ);
943 Set_Etype (Dnn, QR_Typ);
945 Code := New_List (
946 Make_Object_Declaration (Loc,
947 Defining_Identifier => Nnn,
948 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
949 Constant_Present => True,
950 Expression => Build_Multiply (N, X, Y)),
952 Make_Object_Declaration (Loc,
953 Defining_Identifier => Dnn,
954 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
955 Constant_Present => True,
956 Expression => Build_Conversion (N, QR_Typ, Z)));
958 Quo :=
959 Build_Divide (N,
960 New_Occurrence_Of (Nnn, Loc),
961 New_Occurrence_Of (Dnn, Loc));
963 Append_To (Code,
964 Make_Object_Declaration (Loc,
965 Defining_Identifier => Qnn,
966 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
967 Constant_Present => True,
968 Expression => Quo));
970 Append_To (Code,
971 Make_Object_Declaration (Loc,
972 Defining_Identifier => Rnn,
973 Object_Definition => New_Occurrence_Of (QR_Typ, Loc),
974 Constant_Present => True,
975 Expression =>
976 Build_Rem (N,
977 New_Occurrence_Of (Nnn, Loc),
978 New_Occurrence_Of (Dnn, Loc))));
980 -- Case where numerator does not fit in Max_Integer_Size bits, we have
981 -- to call the runtime routine to compute the quotient and remainder.
983 else
984 Rnd := Boolean_Literals (Rounded_Result_Set (N));
986 Code := New_List (
987 Make_Object_Declaration (Loc,
988 Defining_Identifier => Qnn,
989 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
991 Make_Object_Declaration (Loc,
992 Defining_Identifier => Rnn,
993 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)),
995 Make_Procedure_Call_Statement (Loc,
996 Name => New_Occurrence_Of (RTE (QR_Id), Loc),
997 Parameter_Associations => New_List (
998 Build_Conversion (N, QR_Typ, X),
999 Build_Conversion (N, QR_Typ, Y),
1000 Build_Conversion (N, QR_Typ, Z),
1001 New_Occurrence_Of (Qnn, Loc),
1002 New_Occurrence_Of (Rnn, Loc),
1003 New_Occurrence_Of (Rnd, Loc))));
1004 end if;
1006 -- Set type of result, for use in caller
1008 Set_Etype (Qnn, QR_Typ);
1009 end Build_Scaled_Divide_Code;
1011 ---------------------------
1012 -- Do_Divide_Fixed_Fixed --
1013 ---------------------------
1015 -- We have:
1017 -- (Result_Value * Result_Small) =
1018 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
1020 -- Result_Value = (Left_Value / Right_Value) *
1021 -- (Left_Small / (Right_Small * Result_Small));
1023 -- we can do the operation in integer arithmetic if this fraction is an
1024 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1025 -- Otherwise the result is in the close result set and our approach is to
1026 -- use floating-point to compute this close result.
1028 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is
1029 Left : constant Node_Id := Left_Opnd (N);
1030 Right : constant Node_Id := Right_Opnd (N);
1031 Left_Type : constant Entity_Id := Etype (Left);
1032 Right_Type : constant Entity_Id := Etype (Right);
1033 Result_Type : constant Entity_Id := Etype (N);
1034 Right_Small : constant Ureal := Small_Value (Right_Type);
1035 Left_Small : constant Ureal := Small_Value (Left_Type);
1037 Result_Small : Ureal;
1038 Frac : Ureal;
1039 Frac_Num : Uint;
1040 Frac_Den : Uint;
1041 Lit_Int : Node_Id;
1043 begin
1044 -- Rounding is required if the result is integral
1046 if Is_Integer_Type (Result_Type) then
1047 Set_Rounded_Result (N);
1048 end if;
1050 -- Get result small. If the result is an integer, treat it as though
1051 -- it had a small of 1.0, all other processing is identical.
1053 if Is_Integer_Type (Result_Type) then
1054 Result_Small := Ureal_1;
1055 else
1056 Result_Small := Small_Value (Result_Type);
1057 end if;
1059 -- Get small ratio
1061 Frac := Left_Small / (Right_Small * Result_Small);
1062 Frac_Num := Norm_Num (Frac);
1063 Frac_Den := Norm_Den (Frac);
1065 -- If the fraction is an integer, then we get the result by multiplying
1066 -- the left operand by the integer, and then dividing by the right
1067 -- operand (the order is important, if we did the divide first, we
1068 -- would lose precision).
1070 if Frac_Den = 1 then
1071 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1073 if Present (Lit_Int) then
1074 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right));
1075 return;
1076 end if;
1078 -- If the fraction is the reciprocal of an integer, then we get the
1079 -- result by first multiplying the divisor by the integer, and then
1080 -- doing the division with the adjusted divisor.
1082 -- Note: this is much better than doing two divisions: multiplications
1083 -- are much faster than divisions (and certainly faster than rounded
1084 -- divisions), and we don't get inaccuracies from double rounding.
1086 elsif Frac_Num = 1 then
1087 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1089 if Present (Lit_Int) then
1090 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int));
1091 return;
1092 end if;
1093 end if;
1095 -- If we fall through, we use floating-point to compute the result
1097 Set_Result (N,
1098 Build_Multiply (N,
1099 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
1100 Real_Literal (N, Frac)));
1101 end Do_Divide_Fixed_Fixed;
1103 -------------------------------
1104 -- Do_Divide_Fixed_Universal --
1105 -------------------------------
1107 -- We have:
1109 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value;
1110 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small);
1112 -- The result is required to be in the perfect result set if the literal
1113 -- can be factored so that the resulting small ratio is an integer or the
1114 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1115 -- analysis of these RM requirements:
1117 -- We must factor the literal, finding an integer K:
1119 -- Lit_Value = K * Right_Small
1120 -- Right_Small = Lit_Value / K
1122 -- such that the small ratio:
1124 -- Left_Small
1125 -- ------------------------------
1126 -- (Lit_Value / K) * Result_Small
1128 -- Left_Small
1129 -- = ------------------------ * K
1130 -- Lit_Value * Result_Small
1132 -- is an integer or the reciprocal of an integer, and for
1133 -- implementation efficiency we need the smallest such K.
1135 -- First we reduce the left fraction to lowest terms
1137 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal
1138 -- of an integer, and this is clearly the minimum K case, so set K = 1,
1139 -- Right_Small = Lit_Value.
1141 -- If numerator > 1, then set K to the denominator of the fraction so
1142 -- that the resulting small ratio is an integer (the numerator value).
1144 procedure Do_Divide_Fixed_Universal (N : Node_Id) is
1145 Left : constant Node_Id := Left_Opnd (N);
1146 Right : constant Node_Id := Right_Opnd (N);
1147 Left_Type : constant Entity_Id := Etype (Left);
1148 Result_Type : constant Entity_Id := Etype (N);
1149 Left_Small : constant Ureal := Small_Value (Left_Type);
1150 Lit_Value : constant Ureal := Realval (Right);
1152 Result_Small : Ureal;
1153 Frac : Ureal;
1154 Frac_Num : Uint;
1155 Frac_Den : Uint;
1156 Lit_K : Node_Id;
1157 Lit_Int : Node_Id;
1159 begin
1160 -- Get result small. If the result is an integer, treat it as though
1161 -- it had a small of 1.0, all other processing is identical.
1163 if Is_Integer_Type (Result_Type) then
1164 Result_Small := Ureal_1;
1165 else
1166 Result_Small := Small_Value (Result_Type);
1167 end if;
1169 -- Determine if literal can be rewritten successfully
1171 Frac := Left_Small / (Lit_Value * Result_Small);
1172 Frac_Num := Norm_Num (Frac);
1173 Frac_Den := Norm_Den (Frac);
1175 -- Case where fraction is the reciprocal of an integer (K = 1, integer
1176 -- = denominator). If this integer is not too large, this is the case
1177 -- where the result can be obtained by dividing by this integer value.
1179 if Frac_Num = 1 then
1180 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1182 if Present (Lit_Int) then
1183 Set_Result (N, Build_Divide (N, Left, Lit_Int));
1184 return;
1185 end if;
1187 -- Case where we choose K to make fraction an integer (K = denominator
1188 -- of fraction, integer = numerator of fraction). If both K and the
1189 -- numerator are small enough, this is the case where the result can
1190 -- be obtained by first multiplying by the integer value and then
1191 -- dividing by K (the order is important, if we divided first, we
1192 -- would lose precision).
1194 else
1195 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1196 Lit_K := Integer_Literal (N, Frac_Den, False);
1198 if Present (Lit_Int) and then Present (Lit_K) then
1199 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K));
1200 return;
1201 end if;
1202 end if;
1204 -- Fall through if the literal cannot be successfully rewritten, or if
1205 -- the small ratio is out of range of integer arithmetic. In the former
1206 -- case it is fine to use floating-point to get the close result set,
1207 -- and in the latter case, it means that the result is zero or raises
1208 -- constraint error, and we can do that accurately in floating-point.
1210 -- If we end up using floating-point, then we take the right integer
1211 -- to be one, and its small to be the value of the original right real
1212 -- literal. That way, we need only one floating-point multiplication.
1214 Set_Result (N,
1215 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1216 end Do_Divide_Fixed_Universal;
1218 -------------------------------
1219 -- Do_Divide_Universal_Fixed --
1220 -------------------------------
1222 -- We have:
1224 -- (Result_Value * Result_Small) =
1225 -- Lit_Value / (Right_Value * Right_Small)
1226 -- Result_Value =
1227 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value
1229 -- The result is required to be in the perfect result set if the literal
1230 -- can be factored so that the resulting small ratio is an integer or the
1231 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1232 -- analysis of these RM requirements:
1234 -- We must factor the literal, finding an integer K:
1236 -- Lit_Value = K * Left_Small
1237 -- Left_Small = Lit_Value / K
1239 -- such that the small ratio:
1241 -- (Lit_Value / K)
1242 -- --------------------------
1243 -- Right_Small * Result_Small
1245 -- Lit_Value 1
1246 -- = -------------------------- * -
1247 -- Right_Small * Result_Small K
1249 -- is an integer or the reciprocal of an integer, and for
1250 -- implementation efficiency we need the smallest such K.
1252 -- First we reduce the left fraction to lowest terms
1254 -- If denominator = 1, then for K = 1, the small ratio is an integer
1255 -- (the numerator) and this is clearly the minimum K case, so set K = 1,
1256 -- and Left_Small = Lit_Value.
1258 -- If denominator > 1, then set K to the numerator of the fraction so
1259 -- that the resulting small ratio is the reciprocal of an integer (the
1260 -- numerator value).
1262 procedure Do_Divide_Universal_Fixed (N : Node_Id) is
1263 Left : constant Node_Id := Left_Opnd (N);
1264 Right : constant Node_Id := Right_Opnd (N);
1265 Right_Type : constant Entity_Id := Etype (Right);
1266 Result_Type : constant Entity_Id := Etype (N);
1267 Right_Small : constant Ureal := Small_Value (Right_Type);
1268 Lit_Value : constant Ureal := Realval (Left);
1270 Result_Small : Ureal;
1271 Frac : Ureal;
1272 Frac_Num : Uint;
1273 Frac_Den : Uint;
1274 Lit_K : Node_Id;
1275 Lit_Int : Node_Id;
1277 begin
1278 -- Get result small. If the result is an integer, treat it as though
1279 -- it had a small of 1.0, all other processing is identical.
1281 if Is_Integer_Type (Result_Type) then
1282 Result_Small := Ureal_1;
1283 else
1284 Result_Small := Small_Value (Result_Type);
1285 end if;
1287 -- Determine if literal can be rewritten successfully
1289 Frac := Lit_Value / (Right_Small * Result_Small);
1290 Frac_Num := Norm_Num (Frac);
1291 Frac_Den := Norm_Den (Frac);
1293 -- Case where fraction is an integer (K = 1, integer = numerator). If
1294 -- this integer is not too large, this is the case where the result
1295 -- can be obtained by dividing this integer by the right operand.
1297 if Frac_Den = 1 then
1298 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1300 if Present (Lit_Int) then
1301 Set_Result (N, Build_Divide (N, Lit_Int, Right));
1302 return;
1303 end if;
1305 -- Case where we choose K to make the fraction the reciprocal of an
1306 -- integer (K = numerator of fraction, integer = numerator of fraction).
1307 -- If both K and the integer are small enough, this is the case where
1308 -- the result can be obtained by multiplying the right operand by K
1309 -- and then dividing by the integer value. The order of the operations
1310 -- is important (if we divided first, we would lose precision).
1312 else
1313 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1314 Lit_K := Integer_Literal (N, Frac_Num, False);
1316 if Present (Lit_Int) and then Present (Lit_K) then
1317 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int));
1318 return;
1319 end if;
1320 end if;
1322 -- Fall through if the literal cannot be successfully rewritten, or if
1323 -- the small ratio is out of range of integer arithmetic. In the former
1324 -- case it is fine to use floating-point to get the close result set,
1325 -- and in the latter case, it means that the result is zero or raises
1326 -- constraint error, and we can do that accurately in floating-point.
1328 -- If we end up using floating-point, then we take the right integer
1329 -- to be one, and its small to be the value of the original right real
1330 -- literal. That way, we need only one floating-point division.
1332 Set_Result (N,
1333 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right)));
1334 end Do_Divide_Universal_Fixed;
1336 -----------------------------
1337 -- Do_Multiply_Fixed_Fixed --
1338 -----------------------------
1340 -- We have:
1342 -- (Result_Value * Result_Small) =
1343 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
1345 -- Result_Value = (Left_Value * Right_Value) *
1346 -- (Left_Small * Right_Small) / Result_Small;
1348 -- we can do the operation in integer arithmetic if this fraction is an
1349 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)).
1350 -- Otherwise the result is in the close result set and our approach is to
1351 -- use floating-point to compute this close result.
1353 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is
1354 Left : constant Node_Id := Left_Opnd (N);
1355 Right : constant Node_Id := Right_Opnd (N);
1357 Left_Type : constant Entity_Id := Etype (Left);
1358 Right_Type : constant Entity_Id := Etype (Right);
1359 Result_Type : constant Entity_Id := Etype (N);
1360 Right_Small : constant Ureal := Small_Value (Right_Type);
1361 Left_Small : constant Ureal := Small_Value (Left_Type);
1363 Result_Small : Ureal;
1364 Frac : Ureal;
1365 Frac_Num : Uint;
1366 Frac_Den : Uint;
1367 Lit_Int : Node_Id;
1369 begin
1370 -- Get result small. If the result is an integer, treat it as though
1371 -- it had a small of 1.0, all other processing is identical.
1373 if Is_Integer_Type (Result_Type) then
1374 Result_Small := Ureal_1;
1375 else
1376 Result_Small := Small_Value (Result_Type);
1377 end if;
1379 -- Get small ratio
1381 Frac := (Left_Small * Right_Small) / Result_Small;
1382 Frac_Num := Norm_Num (Frac);
1383 Frac_Den := Norm_Den (Frac);
1385 -- If the fraction is an integer, then we get the result by multiplying
1386 -- the operands, and then multiplying the result by the integer value.
1388 if Frac_Den = 1 then
1389 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive
1391 if Present (Lit_Int) then
1392 Set_Result (N,
1393 Build_Multiply (N, Build_Multiply (N, Left, Right), Lit_Int));
1394 return;
1395 end if;
1397 -- If the fraction is the reciprocal of an integer, then we get the
1398 -- result by multiplying the operands, and then dividing the result by
1399 -- the integer value. The order of the operations is important, if we
1400 -- divided first, we would lose precision.
1402 elsif Frac_Num = 1 then
1403 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive
1405 if Present (Lit_Int) then
1406 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int));
1407 return;
1408 end if;
1409 end if;
1411 -- If we fall through, we use floating-point to compute the result
1413 Set_Result (N,
1414 Build_Multiply (N,
1415 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
1416 Real_Literal (N, Frac)));
1417 end Do_Multiply_Fixed_Fixed;
1419 ---------------------------------
1420 -- Do_Multiply_Fixed_Universal --
1421 ---------------------------------
1423 -- We have:
1425 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value;
1426 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small;
1428 -- The result is required to be in the perfect result set if the literal
1429 -- can be factored so that the resulting small ratio is an integer or the
1430 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed
1431 -- analysis of these RM requirements:
1433 -- We must factor the literal, finding an integer K:
1435 -- Lit_Value = K * Right_Small
1436 -- Right_Small = Lit_Value / K
1438 -- such that the small ratio:
1440 -- Left_Small * (Lit_Value / K)
1441 -- ----------------------------
1442 -- Result_Small
1444 -- Left_Small * Lit_Value 1
1445 -- = ---------------------- * -
1446 -- Result_Small K
1448 -- is an integer or the reciprocal of an integer, and for
1449 -- implementation efficiency we need the smallest such K.
1451 -- First we reduce the left fraction to lowest terms
1453 -- If denominator = 1, then for K = 1, the small ratio is an integer, and
1454 -- this is clearly the minimum K case, so set
1456 -- K = 1, Right_Small = Lit_Value
1458 -- If denominator > 1, then set K to the numerator of the fraction, so
1459 -- that the resulting small ratio is the reciprocal of the integer (the
1460 -- denominator value).
1462 procedure Do_Multiply_Fixed_Universal
1463 (N : Node_Id;
1464 Left, Right : Node_Id)
1466 Left_Type : constant Entity_Id := Etype (Left);
1467 Result_Type : constant Entity_Id := Etype (N);
1468 Left_Small : constant Ureal := Small_Value (Left_Type);
1469 Lit_Value : constant Ureal := Realval (Right);
1471 Result_Small : Ureal;
1472 Frac : Ureal;
1473 Frac_Num : Uint;
1474 Frac_Den : Uint;
1475 Lit_K : Node_Id;
1476 Lit_Int : Node_Id;
1478 begin
1479 -- Get result small. If the result is an integer, treat it as though
1480 -- it had a small of 1.0, all other processing is identical.
1482 if Is_Integer_Type (Result_Type) then
1483 Result_Small := Ureal_1;
1484 else
1485 Result_Small := Small_Value (Result_Type);
1486 end if;
1488 -- Determine if literal can be rewritten successfully
1490 Frac := (Left_Small * Lit_Value) / Result_Small;
1491 Frac_Num := Norm_Num (Frac);
1492 Frac_Den := Norm_Den (Frac);
1494 -- Case where fraction is an integer (K = 1, integer = numerator). If
1495 -- this integer is not too large, this is the case where the result can
1496 -- be obtained by multiplying by this integer value.
1498 if Frac_Den = 1 then
1499 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac));
1501 if Present (Lit_Int) then
1502 Set_Result (N, Build_Multiply (N, Left, Lit_Int));
1503 return;
1504 end if;
1506 -- Case where we choose K to make fraction the reciprocal of an integer
1507 -- (K = numerator of fraction, integer = denominator of fraction). If
1508 -- both K and the denominator are small enough, this is the case where
1509 -- the result can be obtained by first multiplying by K, and then
1510 -- dividing by the integer value.
1512 else
1513 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac));
1514 Lit_K := Integer_Literal (N, Frac_Num, False);
1516 if Present (Lit_Int) and then Present (Lit_K) then
1517 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int));
1518 return;
1519 end if;
1520 end if;
1522 -- Fall through if the literal cannot be successfully rewritten, or if
1523 -- the small ratio is out of range of integer arithmetic. In the former
1524 -- case it is fine to use floating-point to get the close result set,
1525 -- and in the latter case, it means that the result is zero or raises
1526 -- constraint error, and we can do that accurately in floating-point.
1528 -- If we end up using floating-point, then we take the right integer
1529 -- to be one, and its small to be the value of the original right real
1530 -- literal. That way, we need only one floating-point multiplication.
1532 Set_Result (N,
1533 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac)));
1534 end Do_Multiply_Fixed_Universal;
1536 ---------------------------------
1537 -- Expand_Convert_Fixed_Static --
1538 ---------------------------------
1540 procedure Expand_Convert_Fixed_Static (N : Node_Id) is
1541 begin
1542 Rewrite (N,
1543 Convert_To (Etype (N),
1544 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N)))));
1545 Analyze_And_Resolve (N);
1546 end Expand_Convert_Fixed_Static;
1548 -----------------------------------
1549 -- Expand_Convert_Fixed_To_Fixed --
1550 -----------------------------------
1552 -- We have:
1554 -- Result_Value * Result_Small = Source_Value * Source_Small
1555 -- Result_Value = Source_Value * (Source_Small / Result_Small)
1557 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small
1558 -- integer, then the perfect result set is obtained by a single integer
1559 -- multiplication.
1561 -- If the small ratio is the reciprocal of a sufficiently small integer,
1562 -- then the perfect result set is obtained by a single integer division.
1564 -- If the numerator and denominator of the small ratio are sufficiently
1565 -- small integers, then the perfect result set is obtained by a scaled
1566 -- divide operation.
1568 -- In other cases, we obtain the close result set by calculating the
1569 -- result in floating-point.
1571 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is
1572 Rng_Check : constant Boolean := Do_Range_Check (N);
1573 Expr : constant Node_Id := Expression (N);
1574 Result_Type : constant Entity_Id := Etype (N);
1575 Source_Type : constant Entity_Id := Etype (Expr);
1576 Small_Ratio : Ureal;
1577 Ratio_Num : Uint;
1578 Ratio_Den : Uint;
1579 Lit_Num : Node_Id;
1580 Lit_Den : Node_Id;
1582 begin
1583 if Is_OK_Static_Expression (Expr) then
1584 Expand_Convert_Fixed_Static (N);
1585 return;
1586 end if;
1588 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type);
1589 Ratio_Num := Norm_Num (Small_Ratio);
1590 Ratio_Den := Norm_Den (Small_Ratio);
1592 if Ratio_Den = 1 then
1593 if Ratio_Num = 1 then
1594 Set_Result (N, Expr);
1595 return;
1597 else
1598 Lit_Num := Integer_Literal (N, Ratio_Num);
1600 if Present (Lit_Num) then
1601 Set_Result (N, Build_Multiply (N, Expr, Lit_Num));
1602 return;
1603 end if;
1604 end if;
1606 elsif Ratio_Num = 1 then
1607 Lit_Den := Integer_Literal (N, Ratio_Den);
1609 if Present (Lit_Den) then
1610 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check);
1611 return;
1612 end if;
1614 else
1615 Lit_Num := Integer_Literal (N, Ratio_Num);
1616 Lit_Den := Integer_Literal (N, Ratio_Den);
1618 if Present (Lit_Num) and then Present (Lit_Den) then
1619 Set_Result
1620 (N, Build_Scaled_Divide (N, Expr, Lit_Num, Lit_Den), Rng_Check);
1621 return;
1622 end if;
1623 end if;
1625 -- Fall through to use floating-point for the close result set case,
1626 -- as a result of the numerator or denominator of the small ratio not
1627 -- being a sufficiently small integer.
1629 Set_Result (N,
1630 Build_Multiply (N,
1631 Fpt_Value (Expr),
1632 Real_Literal (N, Small_Ratio)),
1633 Rng_Check);
1634 end Expand_Convert_Fixed_To_Fixed;
1636 -----------------------------------
1637 -- Expand_Convert_Fixed_To_Float --
1638 -----------------------------------
1640 -- If the small of the fixed type is 1.0, then we simply convert the
1641 -- integer value directly to the target floating-point type, otherwise
1642 -- we first have to multiply by the small, in Universal_Real, and then
1643 -- convert the result to the target floating-point type.
1645 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is
1646 Rng_Check : constant Boolean := Do_Range_Check (N);
1647 Expr : constant Node_Id := Expression (N);
1648 Source_Type : constant Entity_Id := Etype (Expr);
1649 Small : constant Ureal := Small_Value (Source_Type);
1651 begin
1652 if Is_OK_Static_Expression (Expr) then
1653 Expand_Convert_Fixed_Static (N);
1654 return;
1655 end if;
1657 if Small = Ureal_1 then
1658 Set_Result (N, Expr);
1660 else
1661 Set_Result (N,
1662 Build_Multiply (N,
1663 Fpt_Value (Expr),
1664 Real_Literal (N, Small)),
1665 Rng_Check);
1666 end if;
1667 end Expand_Convert_Fixed_To_Float;
1669 -------------------------------------
1670 -- Expand_Convert_Fixed_To_Integer --
1671 -------------------------------------
1673 -- We have:
1675 -- Result_Value = Source_Value * Source_Small
1677 -- If the small value is a sufficiently small integer, then the perfect
1678 -- result set is obtained by a single integer multiplication.
1680 -- If the small value is the reciprocal of a sufficiently small integer,
1681 -- then the perfect result set is obtained by a single integer division.
1683 -- If the numerator and denominator of the small value are sufficiently
1684 -- small integers, then the perfect result set is obtained by a scaled
1685 -- divide operation.
1687 -- In other cases, we obtain the close result set by calculating the
1688 -- result in floating-point.
1690 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is
1691 Rng_Check : constant Boolean := Do_Range_Check (N);
1692 Expr : constant Node_Id := Expression (N);
1693 Source_Type : constant Entity_Id := Etype (Expr);
1694 Small : constant Ureal := Small_Value (Source_Type);
1695 Small_Num : constant Uint := Norm_Num (Small);
1696 Small_Den : constant Uint := Norm_Den (Small);
1697 Lit_Num : Node_Id;
1698 Lit_Den : Node_Id;
1700 begin
1701 if Is_OK_Static_Expression (Expr) then
1702 Expand_Convert_Fixed_Static (N);
1703 return;
1704 end if;
1706 if Small_Den = 1 then
1707 Lit_Num := Integer_Literal (N, Small_Num);
1709 if Present (Lit_Num) then
1710 Set_Result (N, Build_Multiply (N, Expr, Lit_Num), Rng_Check);
1711 return;
1712 end if;
1714 elsif Small_Num = 1 then
1715 Lit_Den := Integer_Literal (N, Small_Den);
1717 if Present (Lit_Den) then
1718 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check);
1719 return;
1720 end if;
1722 else
1723 Lit_Num := Integer_Literal (N, Small_Num);
1724 Lit_Den := Integer_Literal (N, Small_Den);
1726 if Present (Lit_Num) and then Present (Lit_Den) then
1727 Set_Result
1728 (N, Build_Scaled_Divide (N, Expr, Lit_Num, Lit_Den), Rng_Check);
1729 return;
1730 end if;
1731 end if;
1733 -- Fall through to use floating-point for the close result set case,
1734 -- as a result of the numerator or denominator of the small value not
1735 -- being a sufficiently small integer.
1737 Set_Result (N,
1738 Build_Multiply (N,
1739 Fpt_Value (Expr),
1740 Real_Literal (N, Small)),
1741 Rng_Check);
1742 end Expand_Convert_Fixed_To_Integer;
1744 -----------------------------------
1745 -- Expand_Convert_Float_To_Fixed --
1746 -----------------------------------
1748 -- We have
1750 -- Result_Value * Result_Small = Operand_Value
1752 -- so compute:
1754 -- Result_Value = Operand_Value * (1.0 / Result_Small)
1756 -- We do the small scaling in floating-point, and we do a multiplication
1757 -- rather than a division, since it is accurate enough for the perfect
1758 -- result cases, and faster.
1760 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is
1761 Expr : constant Node_Id := Expression (N);
1762 Result_Type : constant Entity_Id := Etype (N);
1763 Rng_Check : constant Boolean := Do_Range_Check (N);
1764 Small : constant Ureal := Small_Value (Result_Type);
1766 begin
1767 -- Optimize small = 1, where we can avoid the multiply completely
1769 if Small = Ureal_1 then
1770 Set_Result (N, Expr, Rng_Check, Trunc => True);
1772 -- Normal case where multiply is required. Rounding is truncating
1773 -- for decimal fixed point types only, see RM 4.6(29), except if the
1774 -- conversion comes from an attribute reference 'Round (RM 3.5.10 (14)):
1775 -- The attribute is implemented by means of a conversion that must
1776 -- round.
1778 else
1779 Set_Result
1780 (N => N,
1781 Expr =>
1782 Build_Multiply
1783 (N => N,
1784 L => Fpt_Value (Expr),
1785 R => Real_Literal (N, Ureal_1 / Small)),
1786 Rchk => Rng_Check,
1787 Trunc => Is_Decimal_Fixed_Point_Type (Result_Type)
1788 and not Rounded_Result (N));
1789 end if;
1790 end Expand_Convert_Float_To_Fixed;
1792 -------------------------------------
1793 -- Expand_Convert_Integer_To_Fixed --
1794 -------------------------------------
1796 -- We have
1798 -- Result_Value * Result_Small = Operand_Value
1799 -- Result_Value = Operand_Value / Result_Small
1801 -- If the small value is a sufficiently small integer, then the perfect
1802 -- result set is obtained by a single integer division.
1804 -- If the small value is the reciprocal of a sufficiently small integer,
1805 -- the perfect result set is obtained by a single integer multiplication.
1807 -- If the numerator and denominator of the small value are sufficiently
1808 -- small integers, then the perfect result set is obtained by a scaled
1809 -- divide operation.
1811 -- In other cases, we obtain the close result set by calculating the
1812 -- result in floating-point using a multiplication by the reciprocal
1813 -- of the Result_Small.
1815 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is
1816 Rng_Check : constant Boolean := Do_Range_Check (N);
1817 Expr : constant Node_Id := Expression (N);
1818 Result_Type : constant Entity_Id := Etype (N);
1819 Small : constant Ureal := Small_Value (Result_Type);
1820 Small_Num : constant Uint := Norm_Num (Small);
1821 Small_Den : constant Uint := Norm_Den (Small);
1822 Lit_Num : Node_Id;
1823 Lit_Den : Node_Id;
1825 begin
1826 if Small_Den = 1 then
1827 Lit_Num := Integer_Literal (N, Small_Num);
1829 if Present (Lit_Num) then
1830 Set_Result (N, Build_Divide (N, Expr, Lit_Num), Rng_Check);
1831 return;
1832 end if;
1834 elsif Small_Num = 1 then
1835 Lit_Den := Integer_Literal (N, Small_Den);
1837 if Present (Lit_Den) then
1838 Set_Result (N, Build_Multiply (N, Expr, Lit_Den), Rng_Check);
1839 return;
1840 end if;
1842 else
1843 Lit_Num := Integer_Literal (N, Small_Num);
1844 Lit_Den := Integer_Literal (N, Small_Den);
1846 if Present (Lit_Num) and then Present (Lit_Den) then
1847 Set_Result
1848 (N, Build_Scaled_Divide (N, Expr, Lit_Den, Lit_Num), Rng_Check);
1849 return;
1850 end if;
1851 end if;
1853 -- Fall through to use floating-point for the close result set case,
1854 -- as a result of the numerator or denominator of the small value not
1855 -- being a sufficiently small integer.
1857 Set_Result (N,
1858 Build_Multiply (N,
1859 Fpt_Value (Expr),
1860 Real_Literal (N, Ureal_1 / Small)),
1861 Rng_Check);
1862 end Expand_Convert_Integer_To_Fixed;
1864 --------------------------------
1865 -- Expand_Decimal_Divide_Call --
1866 --------------------------------
1868 -- We have four operands
1870 -- Dividend
1871 -- Divisor
1872 -- Quotient
1873 -- Remainder
1875 -- All of which are decimal types, and which thus have associated
1876 -- decimal scales.
1878 -- Computing the quotient is a similar problem to that faced by the
1879 -- normal fixed-point division, except that it is simpler, because
1880 -- we always have compatible smalls.
1882 -- Quotient = (Dividend / Divisor) * 10**q
1884 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small)
1885 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale
1887 -- For q >= 0, we compute
1889 -- Numerator := Dividend * 10 ** q
1890 -- Denominator := Divisor
1891 -- Quotient := Numerator / Denominator
1893 -- For q < 0, we compute
1895 -- Numerator := Dividend
1896 -- Denominator := Divisor * 10 ** q
1897 -- Quotient := Numerator / Denominator
1899 -- Both these divisions are done in truncated mode, and the remainder
1900 -- from these divisions is used to compute the result Remainder. This
1901 -- remainder has the effective scale of the numerator of the division,
1903 -- For q >= 0, the remainder scale is Dividend'Scale + q
1904 -- For q < 0, the remainder scale is Dividend'Scale
1906 -- The result Remainder is then computed by a normal truncating decimal
1907 -- conversion from this scale to the scale of the remainder, i.e. by a
1908 -- division or multiplication by the appropriate power of 10.
1910 procedure Expand_Decimal_Divide_Call (N : Node_Id) is
1911 Loc : constant Source_Ptr := Sloc (N);
1913 Dividend : Node_Id := First_Actual (N);
1914 Divisor : Node_Id := Next_Actual (Dividend);
1915 Quotient : Node_Id := Next_Actual (Divisor);
1916 Remainder : Node_Id := Next_Actual (Quotient);
1918 Dividend_Type : constant Entity_Id := Etype (Dividend);
1919 Divisor_Type : constant Entity_Id := Etype (Divisor);
1920 Quotient_Type : constant Entity_Id := Etype (Quotient);
1921 Remainder_Type : constant Entity_Id := Etype (Remainder);
1923 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type);
1924 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type);
1925 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type);
1926 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type);
1928 Q : Uint;
1929 Numerator_Scale : Uint;
1930 Stmts : List_Id;
1931 Qnn : Entity_Id;
1932 Rnn : Entity_Id;
1933 Computed_Remainder : Node_Id;
1934 Adjusted_Remainder : Node_Id;
1935 Scale_Adjust : Uint;
1937 begin
1938 -- Relocate the operands, since they are now list elements, and we
1939 -- need to reference them separately as operands in the expanded code.
1941 Dividend := Relocate_Node (Dividend);
1942 Divisor := Relocate_Node (Divisor);
1943 Quotient := Relocate_Node (Quotient);
1944 Remainder := Relocate_Node (Remainder);
1946 -- Now compute Q, the adjustment scale
1948 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale;
1950 -- If Q is non-negative then we need a scaled divide
1952 if Q >= 0 then
1953 Build_Scaled_Divide_Code
1955 Dividend,
1956 Integer_Literal (N, Uint_10 ** Q),
1957 Divisor,
1958 Qnn, Rnn, Stmts);
1960 Numerator_Scale := Dividend_Scale + Q;
1962 -- If Q is negative, then we need a double divide
1964 else
1965 Build_Double_Divide_Code
1967 Dividend,
1968 Divisor,
1969 Integer_Literal (N, Uint_10 ** (-Q)),
1970 Qnn, Rnn, Stmts);
1972 Numerator_Scale := Dividend_Scale;
1973 end if;
1975 -- Add statement to set quotient value
1977 -- Quotient := quotient-type!(Qnn);
1979 Append_To (Stmts,
1980 Make_Assignment_Statement (Loc,
1981 Name => Quotient,
1982 Expression =>
1983 Unchecked_Convert_To (Quotient_Type,
1984 Build_Conversion (N, Quotient_Type,
1985 New_Occurrence_Of (Qnn, Loc)))));
1987 -- Now we need to deal with computing and setting the remainder. The
1988 -- scale of the remainder is in Numerator_Scale, and the desired
1989 -- scale is the scale of the given Remainder argument. There are
1990 -- three cases:
1992 -- Numerator_Scale > Remainder_Scale
1994 -- in this case, there are extra digits in the computed remainder
1995 -- which must be eliminated by an extra division:
1997 -- computed-remainder := Numerator rem Denominator
1998 -- scale_adjust = Numerator_Scale - Remainder_Scale
1999 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust
2001 -- Numerator_Scale = Remainder_Scale
2003 -- in this case, the we have the remainder we need
2005 -- computed-remainder := Numerator rem Denominator
2006 -- adjusted-remainder := computed-remainder
2008 -- Numerator_Scale < Remainder_Scale
2010 -- in this case, we have insufficient digits in the computed
2011 -- remainder, which must be eliminated by an extra multiply
2013 -- computed-remainder := Numerator rem Denominator
2014 -- scale_adjust = Remainder_Scale - Numerator_Scale
2015 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust
2017 -- Finally we assign the adjusted-remainder to the result Remainder
2018 -- with conversions to get the proper fixed-point type representation.
2020 Computed_Remainder := New_Occurrence_Of (Rnn, Loc);
2022 if Numerator_Scale > Remainder_Scale then
2023 Scale_Adjust := Numerator_Scale - Remainder_Scale;
2024 Adjusted_Remainder :=
2025 Build_Divide
2026 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
2028 elsif Numerator_Scale = Remainder_Scale then
2029 Adjusted_Remainder := Computed_Remainder;
2031 else -- Numerator_Scale < Remainder_Scale
2032 Scale_Adjust := Remainder_Scale - Numerator_Scale;
2033 Adjusted_Remainder :=
2034 Build_Multiply
2035 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust));
2036 end if;
2038 -- Assignment of remainder result
2040 Append_To (Stmts,
2041 Make_Assignment_Statement (Loc,
2042 Name => Remainder,
2043 Expression =>
2044 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder)));
2046 -- Final step is to rewrite the call with a block containing the
2047 -- above sequence of constructed statements for the divide operation.
2049 Rewrite (N,
2050 Make_Block_Statement (Loc,
2051 Handled_Statement_Sequence =>
2052 Make_Handled_Sequence_Of_Statements (Loc,
2053 Statements => Stmts)));
2055 Analyze (N);
2056 end Expand_Decimal_Divide_Call;
2058 -----------------------------------------------
2059 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed --
2060 -----------------------------------------------
2062 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2063 Left : constant Node_Id := Left_Opnd (N);
2064 Right : constant Node_Id := Right_Opnd (N);
2066 begin
2067 if Etype (Left) = Universal_Real then
2068 Do_Divide_Universal_Fixed (N);
2070 elsif Etype (Right) = Universal_Real then
2071 Do_Divide_Fixed_Universal (N);
2073 else
2074 Do_Divide_Fixed_Fixed (N);
2076 -- A focused optimization: if after constant folding the
2077 -- expression is of the form: T ((Exp * D) / D), where D is
2078 -- a static constant, return T (Exp). This form will show up
2079 -- when D is the denominator of the static expression for the
2080 -- 'small of fixed-point types involved. This transformation
2081 -- removes a division that may be expensive on some targets.
2083 if Nkind (N) = N_Type_Conversion
2084 and then Nkind (Expression (N)) = N_Op_Divide
2085 then
2086 declare
2087 Num : constant Node_Id := Left_Opnd (Expression (N));
2088 Den : constant Node_Id := Right_Opnd (Expression (N));
2090 begin
2091 if Nkind (Den) = N_Integer_Literal
2092 and then Nkind (Num) = N_Op_Multiply
2093 and then Nkind (Right_Opnd (Num)) = N_Integer_Literal
2094 and then Intval (Den) = Intval (Right_Opnd (Num))
2095 then
2096 Rewrite (Expression (N), Left_Opnd (Num));
2097 end if;
2098 end;
2099 end if;
2100 end if;
2101 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed;
2103 -----------------------------------------------
2104 -- Expand_Divide_Fixed_By_Fixed_Giving_Float --
2105 -----------------------------------------------
2107 -- The division is done in Universal_Real, and the result is multiplied
2108 -- by the small ratio, which is Small (Right) / Small (Left). Special
2109 -- treatment is required for universal operands, which represent their
2110 -- own value and do not require conversion.
2112 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2113 Left : constant Node_Id := Left_Opnd (N);
2114 Right : constant Node_Id := Right_Opnd (N);
2116 Left_Type : constant Entity_Id := Etype (Left);
2117 Right_Type : constant Entity_Id := Etype (Right);
2119 begin
2120 -- Case of left operand is universal real, the result we want is:
2122 -- Left_Value / (Right_Value * Right_Small)
2124 -- so we compute this as:
2126 -- (Left_Value / Right_Small) / Right_Value
2128 if Left_Type = Universal_Real then
2129 Set_Result (N,
2130 Build_Divide (N,
2131 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)),
2132 Fpt_Value (Right)));
2134 -- Case of right operand is universal real, the result we want is
2136 -- (Left_Value * Left_Small) / Right_Value
2138 -- so we compute this as:
2140 -- Left_Value * (Left_Small / Right_Value)
2142 -- Note we invert to a multiplication since usually floating-point
2143 -- multiplication is much faster than floating-point division.
2145 elsif Right_Type = Universal_Real then
2146 Set_Result (N,
2147 Build_Multiply (N,
2148 Fpt_Value (Left),
2149 Real_Literal (N, Small_Value (Left_Type) / Realval (Right))));
2151 -- Both operands are fixed, so the value we want is
2153 -- (Left_Value * Left_Small) / (Right_Value * Right_Small)
2155 -- which we compute as:
2157 -- (Left_Value / Right_Value) * (Left_Small / Right_Small)
2159 else
2160 Set_Result (N,
2161 Build_Multiply (N,
2162 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)),
2163 Real_Literal (N,
2164 Small_Value (Left_Type) / Small_Value (Right_Type))));
2165 end if;
2166 end Expand_Divide_Fixed_By_Fixed_Giving_Float;
2168 -------------------------------------------------
2169 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer --
2170 -------------------------------------------------
2172 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2173 Left : constant Node_Id := Left_Opnd (N);
2174 Right : constant Node_Id := Right_Opnd (N);
2175 begin
2176 if Etype (Left) = Universal_Real then
2177 Do_Divide_Universal_Fixed (N);
2178 elsif Etype (Right) = Universal_Real then
2179 Do_Divide_Fixed_Universal (N);
2180 else
2181 Do_Divide_Fixed_Fixed (N);
2182 end if;
2183 end Expand_Divide_Fixed_By_Fixed_Giving_Integer;
2185 -------------------------------------------------
2186 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed --
2187 -------------------------------------------------
2189 -- Since the operand and result fixed-point type is the same, this is
2190 -- a straight divide by the right operand, the small can be ignored.
2192 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2193 Left : constant Node_Id := Left_Opnd (N);
2194 Right : constant Node_Id := Right_Opnd (N);
2195 begin
2196 Set_Result (N, Build_Divide (N, Left, Right));
2197 end Expand_Divide_Fixed_By_Integer_Giving_Fixed;
2199 -------------------------------------------------
2200 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed --
2201 -------------------------------------------------
2203 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is
2204 Left : constant Node_Id := Left_Opnd (N);
2205 Right : constant Node_Id := Right_Opnd (N);
2207 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id);
2208 -- The operand may be a non-static universal value, such an
2209 -- exponentiation with a non-static exponent. In that case, treat
2210 -- as a fixed * fixed multiplication, and convert the argument to
2211 -- the target fixed type.
2213 ----------------------------------
2214 -- Rewrite_Non_Static_Universal --
2215 ----------------------------------
2217 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is
2218 Loc : constant Source_Ptr := Sloc (N);
2219 begin
2220 Rewrite (Opnd,
2221 Make_Type_Conversion (Loc,
2222 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc),
2223 Expression => Expression (Opnd)));
2224 Analyze_And_Resolve (Opnd, Etype (N));
2225 end Rewrite_Non_Static_Universal;
2227 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed
2229 begin
2230 if Etype (Left) = Universal_Real then
2231 if Nkind (Left) = N_Real_Literal then
2232 Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2234 elsif Nkind (Left) = N_Type_Conversion then
2235 Rewrite_Non_Static_Universal (Left);
2236 Do_Multiply_Fixed_Fixed (N);
2237 end if;
2239 elsif Etype (Right) = Universal_Real then
2240 if Nkind (Right) = N_Real_Literal then
2241 Do_Multiply_Fixed_Universal (N, Left, Right);
2243 elsif Nkind (Right) = N_Type_Conversion then
2244 Rewrite_Non_Static_Universal (Right);
2245 Do_Multiply_Fixed_Fixed (N);
2246 end if;
2248 else
2249 Do_Multiply_Fixed_Fixed (N);
2250 end if;
2251 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed;
2253 -------------------------------------------------
2254 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float --
2255 -------------------------------------------------
2257 -- The multiply is done in Universal_Real, and the result is multiplied
2258 -- by the adjustment for the smalls which is Small (Right) * Small (Left).
2259 -- Special treatment is required for universal operands.
2261 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is
2262 Left : constant Node_Id := Left_Opnd (N);
2263 Right : constant Node_Id := Right_Opnd (N);
2265 Left_Type : constant Entity_Id := Etype (Left);
2266 Right_Type : constant Entity_Id := Etype (Right);
2268 begin
2269 -- Case of left operand is universal real, the result we want is
2271 -- Left_Value * (Right_Value * Right_Small)
2273 -- so we compute this as:
2275 -- (Left_Value * Right_Small) * Right_Value;
2277 if Left_Type = Universal_Real then
2278 Set_Result (N,
2279 Build_Multiply (N,
2280 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)),
2281 Fpt_Value (Right)));
2283 -- Case of right operand is universal real, the result we want is
2285 -- (Left_Value * Left_Small) * Right_Value
2287 -- so we compute this as:
2289 -- Left_Value * (Left_Small * Right_Value)
2291 elsif Right_Type = Universal_Real then
2292 Set_Result (N,
2293 Build_Multiply (N,
2294 Fpt_Value (Left),
2295 Real_Literal (N, Small_Value (Left_Type) * Realval (Right))));
2297 -- Both operands are fixed, so the value we want is
2299 -- (Left_Value * Left_Small) * (Right_Value * Right_Small)
2301 -- which we compute as:
2303 -- (Left_Value * Right_Value) * (Right_Small * Left_Small)
2305 else
2306 Set_Result (N,
2307 Build_Multiply (N,
2308 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)),
2309 Real_Literal (N,
2310 Small_Value (Right_Type) * Small_Value (Left_Type))));
2311 end if;
2312 end Expand_Multiply_Fixed_By_Fixed_Giving_Float;
2314 ---------------------------------------------------
2315 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer --
2316 ---------------------------------------------------
2318 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is
2319 Loc : constant Source_Ptr := Sloc (N);
2320 Left : constant Node_Id := Left_Opnd (N);
2321 Right : constant Node_Id := Right_Opnd (N);
2323 begin
2324 if Etype (Left) = Universal_Real then
2325 Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left);
2327 elsif Etype (Right) = Universal_Real then
2328 Do_Multiply_Fixed_Universal (N, Left, Right);
2330 -- If both types are equal and we need to avoid floating point
2331 -- instructions, it's worth introducing a temporary with the
2332 -- common type, because it may be evaluated more simply without
2333 -- the need for run-time use of floating point.
2335 elsif Etype (Right) = Etype (Left)
2336 and then Restriction_Active (No_Floating_Point)
2337 then
2338 declare
2339 Temp : constant Entity_Id := Make_Temporary (Loc, 'F');
2340 Mult : constant Node_Id := Make_Op_Multiply (Loc, Left, Right);
2341 Decl : constant Node_Id :=
2342 Make_Object_Declaration (Loc,
2343 Defining_Identifier => Temp,
2344 Object_Definition => New_Occurrence_Of (Etype (Right), Loc),
2345 Expression => Mult);
2347 begin
2348 Insert_Action (N, Decl);
2349 Rewrite (N,
2350 OK_Convert_To (Etype (N), New_Occurrence_Of (Temp, Loc)));
2351 Analyze_And_Resolve (N, Standard_Integer);
2352 end;
2354 else
2355 Do_Multiply_Fixed_Fixed (N);
2356 end if;
2357 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer;
2359 ---------------------------------------------------
2360 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed --
2361 ---------------------------------------------------
2363 -- Since the operand and result fixed-point type is the same, this is
2364 -- a straight multiply by the right operand, the small can be ignored.
2366 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is
2367 begin
2368 Set_Result (N,
2369 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2370 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed;
2372 ---------------------------------------------------
2373 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed --
2374 ---------------------------------------------------
2376 -- Since the operand and result fixed-point type is the same, this is
2377 -- a straight multiply by the right operand, the small can be ignored.
2379 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is
2380 begin
2381 Set_Result (N,
2382 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N)));
2383 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed;
2385 ---------------
2386 -- Fpt_Value --
2387 ---------------
2389 function Fpt_Value (N : Node_Id) return Node_Id is
2390 begin
2391 return Build_Conversion (N, Universal_Real, N);
2392 end Fpt_Value;
2394 ------------------------
2395 -- Get_Size_For_Value --
2396 ------------------------
2398 function Get_Size_For_Value (V : Uint) return Pos is
2399 begin
2400 pragma Assert (V >= Uint_0);
2402 if V < Uint_2 ** 7 then
2403 return 8;
2405 elsif V < Uint_2 ** 15 then
2406 return 16;
2408 elsif V < Uint_2 ** 31 then
2409 return 32;
2411 elsif V < Uint_2 ** 63 then
2412 return 64;
2414 elsif V < Uint_2 ** 127 then
2415 return 128;
2417 else
2418 return Pos'Last;
2419 end if;
2420 end Get_Size_For_Value;
2422 -----------------------
2423 -- Get_Type_For_Size --
2424 -----------------------
2426 function Get_Type_For_Size (Siz : Pos; Force : Boolean) return Entity_Id is
2427 begin
2428 if Siz <= 8 then
2429 return Standard_Integer_8;
2431 elsif Siz <= 16 then
2432 return Standard_Integer_16;
2434 elsif Siz <= 32 then
2435 return Standard_Integer_32;
2437 elsif Siz <= 64
2438 or else (Force and then System_Max_Integer_Size < 128)
2439 then
2440 return Standard_Integer_64;
2442 elsif (Siz <= 128 and then System_Max_Integer_Size = 128)
2443 or else Force
2444 then
2445 return Standard_Integer_128;
2447 else
2448 return Empty;
2449 end if;
2450 end Get_Type_For_Size;
2452 ---------------------
2453 -- Integer_Literal --
2454 ---------------------
2456 function Integer_Literal
2457 (N : Node_Id;
2458 V : Uint;
2459 Negative : Boolean := False) return Node_Id
2461 T : Entity_Id;
2462 L : Node_Id;
2464 begin
2465 T := Get_Type_For_Size (Get_Size_For_Value (V), Force => False);
2466 if No (T) then
2467 return Empty;
2468 end if;
2470 if Negative then
2471 L := Make_Integer_Literal (Sloc (N), UI_Negate (V));
2472 else
2473 L := Make_Integer_Literal (Sloc (N), V);
2474 end if;
2476 -- Set type of result in case used elsewhere (see note at start)
2478 Set_Etype (L, T);
2479 Set_Is_Static_Expression (L);
2481 -- We really need to set Analyzed here because we may be creating a
2482 -- very strange beast, namely an integer literal typed as fixed-point
2483 -- and the analyzer won't like that.
2485 Set_Analyzed (L);
2486 return L;
2487 end Integer_Literal;
2489 ------------------
2490 -- Real_Literal --
2491 ------------------
2493 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is
2494 L : Node_Id;
2496 begin
2497 L := Make_Real_Literal (Sloc (N), V);
2499 -- Set type of result in case used elsewhere (see note at start)
2501 Set_Etype (L, Universal_Real);
2502 return L;
2503 end Real_Literal;
2505 ------------------------
2506 -- Rounded_Result_Set --
2507 ------------------------
2509 function Rounded_Result_Set (N : Node_Id) return Boolean is
2510 K : constant Node_Kind := Nkind (N);
2511 begin
2512 if (K = N_Type_Conversion or else
2513 K = N_Op_Divide or else
2514 K = N_Op_Multiply)
2515 and then
2516 (Rounded_Result (N) or else Is_Integer_Type (Etype (N)))
2517 then
2518 return True;
2519 else
2520 return False;
2521 end if;
2522 end Rounded_Result_Set;
2524 ----------------
2525 -- Set_Result --
2526 ----------------
2528 procedure Set_Result
2529 (N : Node_Id;
2530 Expr : Node_Id;
2531 Rchk : Boolean := False;
2532 Trunc : Boolean := False)
2534 Cnode : Node_Id;
2536 Expr_Type : constant Entity_Id := Etype (Expr);
2537 Result_Type : constant Entity_Id := Etype (N);
2539 begin
2540 -- No conversion required if types match and no range check or truncate
2542 if Result_Type = Expr_Type and then not (Rchk or Trunc) then
2543 Cnode := Expr;
2545 -- Else perform required conversion
2547 else
2548 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc);
2549 end if;
2551 Rewrite (N, Cnode);
2552 Analyze_And_Resolve (N, Result_Type);
2553 end Set_Result;
2555 end Exp_Fixd;