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-2021, 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------------------------------------------------------------------------------ 25 26with Atree; use Atree; 27with Checks; use Checks; 28with Einfo; use Einfo; 29with Einfo.Entities; use Einfo.Entities; 30with Einfo.Utils; use Einfo.Utils; 31with Exp_Util; use Exp_Util; 32with Nlists; use Nlists; 33with Nmake; use Nmake; 34with Restrict; use Restrict; 35with Rident; use Rident; 36with Rtsfind; use Rtsfind; 37with Sem; use Sem; 38with Sem_Eval; use Sem_Eval; 39with Sem_Res; use Sem_Res; 40with Sem_Util; use Sem_Util; 41with Sinfo; use Sinfo; 42with Sinfo.Nodes; use Sinfo.Nodes; 43with Stand; use Stand; 44with Tbuild; use Tbuild; 45with Ttypes; use Ttypes; 46with Uintp; use Uintp; 47with Urealp; use Urealp; 48 49package body Exp_Fixd is 50 51 ----------------------- 52 -- Local Subprograms -- 53 ----------------------- 54 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). 64 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. 79 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. 92 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. 100 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. 112 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. 123 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. 132 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. 140 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. 152 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. 157 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. 162 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. 167 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. 172 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). 178 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. 185 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). 192 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. 196 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. 201 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. 214 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 219 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. 223 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. 239 240 ---------------------- 241 -- Build_Conversion -- 242 ---------------------- 243 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 250 is 251 Loc : constant Source_Ptr := Sloc (N); 252 Result : Node_Id; 253 Rcheck : Boolean := Rchk; 254 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. 260 261 if Nkind (Expr) = N_Integer_Literal 262 and then Is_Integer_Type (Typ) 263 and then not Rchk 264 then 265 Result := Expr; 266 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. 271 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. 278 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); 290 291 -- For all other cases, a simple type conversion will work 292 293 else 294 Result := 295 Make_Type_Conversion (Loc, 296 Subtype_Mark => New_Occurrence_Of (Typ, Loc), 297 Expression => Expr); 298 299 Set_Float_Truncate (Result, Trunc); 300 end if; 301 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. 305 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; 311 312 -- Set Do_Range_Check if either it was requested by the caller, 313 -- or if an eliminated inner conversion had a range check. 314 315 if Rcheck then 316 Enable_Range_Check (Result); 317 else 318 Set_Do_Range_Check (Result, False); 319 end if; 320 end if; 321 322 Set_Etype (Result, Typ); 323 return Result; 324 end Build_Conversion; 325 326 ------------------ 327 -- Build_Divide -- 328 ------------------ 329 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; 338 339 begin 340 -- Deal with floating-point case first 341 342 if Is_Floating_Point_Type (Left_Type) then 343 pragma Assert (Left_Type = Universal_Real); 344 pragma Assert (Right_Type = Universal_Real); 345 346 Rnode := Make_Op_Divide (Loc, L, R); 347 Result_Type := Universal_Real; 348 349 -- Integer and fixed-point cases 350 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. 355 356 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then 357 return L; 358 end if; 359 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. 366 367 Left_Size := UI_To_Int (RM_Size (Left_Type)); 368 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; 379 380 Right_Size := UI_To_Int (RM_Size (Right_Type)); 381 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; 392 393 -- Do the operation using the longer of the two sizes 394 395 Result_Type := 396 Get_Type_For_Size (Int'Max (Left_Size, Right_Size), Force => True); 397 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; 403 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 406 407 Set_Etype (Rnode, Base_Type (Result_Type)); 408 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. 412 413 Set_Rounded_Result (Rnode, Rounded_Result_Set (N)); 414 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. 421 422 if not Is_Floating_Point_Type (Left_Type) then 423 Rnode := Build_Conversion (N, Left_Type, Rnode); 424 end if; 425 426 return Rnode; 427 end Build_Divide; 428 429 ------------------------- 430 -- Build_Double_Divide -- 431 ------------------------- 432 433 function Build_Double_Divide 434 (N : Node_Id; 435 X, Y, Z : Node_Id) return Node_Id 436 is 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; 443 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. 449 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)); 454 455 -- Otherwise we use the runtime routine 456 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] 461 462 else 463 declare 464 Loc : constant Source_Ptr := Sloc (N); 465 Qnn : Entity_Id; 466 Rnn : Entity_Id; 467 Code : List_Id; 468 469 pragma Warnings (Off, Rnn); 470 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); 475 476 -- Set type of result in case used elsewhere (see note at start) 477 478 Set_Etype (Expr, Etype (Qnn)); 479 480 -- Set result as analyzed (see note at start on build routines) 481 482 return Expr; 483 end; 484 end if; 485 end Build_Double_Divide; 486 487 ------------------------------ 488 -- Build_Double_Divide_Code -- 489 ------------------------------ 490 491 -- If the denominator can be computed in Max_Integer_Size bits, we build 492 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; 497 498 -- If the denominator cannot be computed in Max_Integer_Size bits, we build 499 500 -- [Qnn : Interfaces.Integer_{64|128}; 501 -- Rnn : Interfaces.Integer_{64|128}; 502 -- Double_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round);] 503 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) 509 is 510 Loc : constant Source_Ptr := Sloc (N); 511 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)); 516 517 QR_Id : RE_Id; 518 QR_Siz : Nat; 519 QR_Typ : Entity_Id; 520 521 Nnn : Entity_Id; 522 Dnn : Entity_Id; 523 524 Quo : Node_Id; 525 Rnd : Entity_Id; 526 527 begin 528 -- Find type that will allow computation of denominator 529 530 QR_Siz := Nat'Max (X_Size, Y_Size + Z_Size); 531 532 if QR_Siz <= 16 then 533 QR_Typ := Standard_Integer_16; 534 QR_Id := RE_Null; 535 536 elsif QR_Siz <= 32 then 537 QR_Typ := Standard_Integer_32; 538 QR_Id := RE_Null; 539 540 elsif QR_Siz <= 64 then 541 QR_Typ := Standard_Integer_64; 542 QR_Id := RE_Null; 543 544 -- For backward compatibility reasons, we use a 128-bit divide only 545 -- if one of the operands is already larger than 64 bits. 546 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; 550 551 elsif QR_Siz <= 128 then 552 QR_Typ := Standard_Integer_128; 553 QR_Id := RE_Null; 554 555 else 556 QR_Typ := RTE (RE_Integer_128); 557 QR_Id := RE_Double_Divide128; 558 end if; 559 560 -- Define quotient and remainder, and set their Etypes, so 561 -- that they can be picked up by Build_xxx routines. 562 563 Qnn := Make_Temporary (Loc, 'S'); 564 Rnn := Make_Temporary (Loc, 'R'); 565 566 Set_Etype (Qnn, QR_Typ); 567 Set_Etype (Rnn, QR_Typ); 568 569 -- Case where we can compute the denominator in Max_Integer_Size bits 570 571 if QR_Id = RE_Null then 572 573 -- Create temporaries for numerator and denominator and set Etypes, 574 -- so that New_Occurrence_Of picks them up for Build_xxx calls. 575 576 Nnn := Make_Temporary (Loc, 'N'); 577 Dnn := Make_Temporary (Loc, 'D'); 578 579 Set_Etype (Nnn, QR_Typ); 580 Set_Etype (Dnn, QR_Typ); 581 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)), 588 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))); 594 595 Quo := 596 Build_Divide (N, 597 New_Occurrence_Of (Nnn, Loc), 598 New_Occurrence_Of (Dnn, Loc)); 599 600 Set_Rounded_Result (Quo, Rounded_Result_Set (N)); 601 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)); 608 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)))); 618 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. 621 622 else 623 Rnd := Boolean_Literals (Rounded_Result_Set (N)); 624 625 Code := New_List ( 626 Make_Object_Declaration (Loc, 627 Defining_Identifier => Qnn, 628 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 629 630 Make_Object_Declaration (Loc, 631 Defining_Identifier => Rnn, 632 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 633 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; 645 646 -------------------- 647 -- Build_Multiply -- 648 -------------------- 649 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; 658 659 begin 660 -- Deal with floating-point case first 661 662 if Is_Floating_Point_Type (Left_Type) then 663 pragma Assert (Left_Type = Universal_Real); 664 pragma Assert (Right_Type = Universal_Real); 665 666 Result_Type := Universal_Real; 667 Rnode := Make_Op_Multiply (Loc, L, R); 668 669 -- Integer and fixed-point cases 670 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. 676 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; 682 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. 689 690 Left_Size := UI_To_Int (RM_Size (Left_Type)); 691 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; 702 703 Right_Size := UI_To_Int (RM_Size (Right_Type)); 704 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; 715 716 -- Now the result size must be at least the sum of the two sizes, 717 -- to accommodate all possible results. 718 719 Result_Type := 720 Get_Type_For_Size (Left_Size + Right_Size, Force => True); 721 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; 727 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 730 731 Set_Etype (Rnode, Base_Type (Result_Type)); 732 733 return Rnode; 734 end Build_Multiply; 735 736 --------------- 737 -- Build_Rem -- 738 --------------- 739 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; 746 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); 754 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). 757 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)); 764 765 -- Similarly, if the right size is larger, we do the remainder 766 -- operation using the right type. 767 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; 775 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 778 779 Set_Etype (Rnode, Base_Type (Result_Type)); 780 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. 787 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; 793 794 return Rnode; 795 end Build_Rem; 796 797 ------------------------- 798 -- Build_Scaled_Divide -- 799 ------------------------- 800 801 function Build_Scaled_Divide 802 (N : Node_Id; 803 X, Y, Z : Node_Id) return Node_Id 804 is 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; 811 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. 817 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); 822 823 -- Otherwise we use the runtime routine 824 825 -- [Qnn : Integer_{64|128}, 826 -- Rnn : Integer_{64|128}; 827 -- Scaled_Divide{64|128} (X, Y, Z, Qnn, Rnn, Round); 828 -- Qnn] 829 830 else 831 declare 832 Loc : constant Source_Ptr := Sloc (N); 833 Qnn : Entity_Id; 834 Rnn : Entity_Id; 835 Code : List_Id; 836 837 pragma Warnings (Off, Rnn); 838 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); 843 844 -- Set type of result in case used elsewhere (see note at start) 845 846 Set_Etype (Expr, Etype (Qnn)); 847 return Expr; 848 end; 849 end if; 850 end Build_Scaled_Divide; 851 852 ------------------------------ 853 -- Build_Scaled_Divide_Code -- 854 ------------------------------ 855 856 -- If the numerator can be computed in Max_Integer_Size bits, we build 857 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; 862 863 -- If the numerator cannot be computed in Max_Integer_Size bits, we build 864 865 -- [Qnn : Interfaces.Integer_{64|128}; 866 -- Rnn : Interfaces.Integer_{64|128}; 867 -- Scaled_Divide_{64|128} (X, Y, Z, Qnn, Rnn, Round);] 868 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) 874 is 875 Loc : constant Source_Ptr := Sloc (N); 876 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)); 881 882 QR_Id : RE_Id; 883 QR_Siz : Nat; 884 QR_Typ : Entity_Id; 885 886 Nnn : Entity_Id; 887 Dnn : Entity_Id; 888 889 Quo : Node_Id; 890 Rnd : Entity_Id; 891 892 begin 893 -- Find type that will allow computation of numerator 894 895 QR_Siz := Nat'Max (X_Size + Y_Size, Z_Size); 896 897 if QR_Siz <= 16 then 898 QR_Typ := Standard_Integer_16; 899 QR_Id := RE_Null; 900 901 elsif QR_Siz <= 32 then 902 QR_Typ := Standard_Integer_32; 903 QR_Id := RE_Null; 904 905 elsif QR_Siz <= 64 then 906 QR_Typ := Standard_Integer_64; 907 QR_Id := RE_Null; 908 909 -- For backward compatibility reasons, we use a 128-bit divide only 910 -- if one of the operands is already larger than 64 bits. 911 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; 915 916 elsif QR_Siz <= 128 then 917 QR_Typ := Standard_Integer_128; 918 QR_Id := RE_Null; 919 920 else 921 QR_Typ := RTE (RE_Integer_128); 922 QR_Id := RE_Scaled_Divide128; 923 end if; 924 925 -- Define quotient and remainder, and set their Etypes, so 926 -- that they can be picked up by Build_xxx routines. 927 928 Qnn := Make_Temporary (Loc, 'S'); 929 Rnn := Make_Temporary (Loc, 'R'); 930 931 Set_Etype (Qnn, QR_Typ); 932 Set_Etype (Rnn, QR_Typ); 933 934 -- Case where we can compute the numerator in Max_Integer_Size bits 935 936 if QR_Id = RE_Null then 937 Nnn := Make_Temporary (Loc, 'N'); 938 Dnn := Make_Temporary (Loc, 'D'); 939 940 -- Set Etypes, so that they can be picked up by New_Occurrence_Of 941 942 Set_Etype (Nnn, QR_Typ); 943 Set_Etype (Dnn, QR_Typ); 944 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)), 951 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))); 957 958 Quo := 959 Build_Divide (N, 960 New_Occurrence_Of (Nnn, Loc), 961 New_Occurrence_Of (Dnn, Loc)); 962 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)); 969 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)))); 979 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. 982 983 else 984 Rnd := Boolean_Literals (Rounded_Result_Set (N)); 985 986 Code := New_List ( 987 Make_Object_Declaration (Loc, 988 Defining_Identifier => Qnn, 989 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 990 991 Make_Object_Declaration (Loc, 992 Defining_Identifier => Rnn, 993 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 994 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; 1005 1006 -- Set type of result, for use in caller 1007 1008 Set_Etype (Qnn, QR_Typ); 1009 end Build_Scaled_Divide_Code; 1010 1011 --------------------------- 1012 -- Do_Divide_Fixed_Fixed -- 1013 --------------------------- 1014 1015 -- We have: 1016 1017 -- (Result_Value * Result_Small) = 1018 -- (Left_Value * Left_Small) / (Right_Value * Right_Small) 1019 1020 -- Result_Value = (Left_Value / Right_Value) * 1021 -- (Left_Small / (Right_Small * Result_Small)); 1022 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. 1027 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); 1036 1037 Result_Small : Ureal; 1038 Frac : Ureal; 1039 Frac_Num : Uint; 1040 Frac_Den : Uint; 1041 Lit_Int : Node_Id; 1042 1043 begin 1044 -- Rounding is required if the result is integral 1045 1046 if Is_Integer_Type (Result_Type) then 1047 Set_Rounded_Result (N); 1048 end if; 1049 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. 1052 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; 1058 1059 -- Get small ratio 1060 1061 Frac := Left_Small / (Right_Small * Result_Small); 1062 Frac_Num := Norm_Num (Frac); 1063 Frac_Den := Norm_Den (Frac); 1064 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). 1069 1070 if Frac_Den = 1 then 1071 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive 1072 1073 if Present (Lit_Int) then 1074 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right)); 1075 return; 1076 end if; 1077 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. 1081 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. 1085 1086 elsif Frac_Num = 1 then 1087 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive 1088 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; 1094 1095 -- If we fall through, we use floating-point to compute the result 1096 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; 1102 1103 ------------------------------- 1104 -- Do_Divide_Fixed_Universal -- 1105 ------------------------------- 1106 1107 -- We have: 1108 1109 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value; 1110 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small); 1111 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: 1116 1117 -- We must factor the literal, finding an integer K: 1118 1119 -- Lit_Value = K * Right_Small 1120 -- Right_Small = Lit_Value / K 1121 1122 -- such that the small ratio: 1123 1124 -- Left_Small 1125 -- ------------------------------ 1126 -- (Lit_Value / K) * Result_Small 1127 1128 -- Left_Small 1129 -- = ------------------------ * K 1130 -- Lit_Value * Result_Small 1131 1132 -- is an integer or the reciprocal of an integer, and for 1133 -- implementation efficiency we need the smallest such K. 1134 1135 -- First we reduce the left fraction to lowest terms 1136 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. 1140 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). 1143 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); 1151 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; 1158 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. 1162 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; 1168 1169 -- Determine if literal can be rewritten successfully 1170 1171 Frac := Left_Small / (Lit_Value * Result_Small); 1172 Frac_Num := Norm_Num (Frac); 1173 Frac_Den := Norm_Den (Frac); 1174 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. 1178 1179 if Frac_Num = 1 then 1180 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac)); 1181 1182 if Present (Lit_Int) then 1183 Set_Result (N, Build_Divide (N, Left, Lit_Int)); 1184 return; 1185 end if; 1186 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). 1193 1194 else 1195 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac)); 1196 Lit_K := Integer_Literal (N, Frac_Den, False); 1197 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; 1203 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. 1209 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. 1213 1214 Set_Result (N, 1215 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); 1216 end Do_Divide_Fixed_Universal; 1217 1218 ------------------------------- 1219 -- Do_Divide_Universal_Fixed -- 1220 ------------------------------- 1221 1222 -- We have: 1223 1224 -- (Result_Value * Result_Small) = 1225 -- Lit_Value / (Right_Value * Right_Small) 1226 -- Result_Value = 1227 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value 1228 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: 1233 1234 -- We must factor the literal, finding an integer K: 1235 1236 -- Lit_Value = K * Left_Small 1237 -- Left_Small = Lit_Value / K 1238 1239 -- such that the small ratio: 1240 1241 -- (Lit_Value / K) 1242 -- -------------------------- 1243 -- Right_Small * Result_Small 1244 1245 -- Lit_Value 1 1246 -- = -------------------------- * - 1247 -- Right_Small * Result_Small K 1248 1249 -- is an integer or the reciprocal of an integer, and for 1250 -- implementation efficiency we need the smallest such K. 1251 1252 -- First we reduce the left fraction to lowest terms 1253 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. 1257 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). 1261 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); 1269 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; 1276 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. 1280 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; 1286 1287 -- Determine if literal can be rewritten successfully 1288 1289 Frac := Lit_Value / (Right_Small * Result_Small); 1290 Frac_Num := Norm_Num (Frac); 1291 Frac_Den := Norm_Den (Frac); 1292 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. 1296 1297 if Frac_Den = 1 then 1298 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac)); 1299 1300 if Present (Lit_Int) then 1301 Set_Result (N, Build_Divide (N, Lit_Int, Right)); 1302 return; 1303 end if; 1304 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). 1311 1312 else 1313 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac)); 1314 Lit_K := Integer_Literal (N, Frac_Num, False); 1315 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; 1321 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. 1327 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. 1331 1332 Set_Result (N, 1333 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right))); 1334 end Do_Divide_Universal_Fixed; 1335 1336 ----------------------------- 1337 -- Do_Multiply_Fixed_Fixed -- 1338 ----------------------------- 1339 1340 -- We have: 1341 1342 -- (Result_Value * Result_Small) = 1343 -- (Left_Value * Left_Small) * (Right_Value * Right_Small) 1344 1345 -- Result_Value = (Left_Value * Right_Value) * 1346 -- (Left_Small * Right_Small) / Result_Small; 1347 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. 1352 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); 1356 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); 1362 1363 Result_Small : Ureal; 1364 Frac : Ureal; 1365 Frac_Num : Uint; 1366 Frac_Den : Uint; 1367 Lit_Int : Node_Id; 1368 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. 1372 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; 1378 1379 -- Get small ratio 1380 1381 Frac := (Left_Small * Right_Small) / Result_Small; 1382 Frac_Num := Norm_Num (Frac); 1383 Frac_Den := Norm_Den (Frac); 1384 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. 1387 1388 if Frac_Den = 1 then 1389 Lit_Int := Integer_Literal (N, Frac_Num); -- always positive 1390 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; 1396 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. 1401 1402 elsif Frac_Num = 1 then 1403 Lit_Int := Integer_Literal (N, Frac_Den); -- always positive 1404 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; 1410 1411 -- If we fall through, we use floating-point to compute the result 1412 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; 1418 1419 --------------------------------- 1420 -- Do_Multiply_Fixed_Universal -- 1421 --------------------------------- 1422 1423 -- We have: 1424 1425 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value; 1426 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small; 1427 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: 1432 1433 -- We must factor the literal, finding an integer K: 1434 1435 -- Lit_Value = K * Right_Small 1436 -- Right_Small = Lit_Value / K 1437 1438 -- such that the small ratio: 1439 1440 -- Left_Small * (Lit_Value / K) 1441 -- ---------------------------- 1442 -- Result_Small 1443 1444 -- Left_Small * Lit_Value 1 1445 -- = ---------------------- * - 1446 -- Result_Small K 1447 1448 -- is an integer or the reciprocal of an integer, and for 1449 -- implementation efficiency we need the smallest such K. 1450 1451 -- First we reduce the left fraction to lowest terms 1452 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 1455 1456 -- K = 1, Right_Small = Lit_Value 1457 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). 1461 1462 procedure Do_Multiply_Fixed_Universal 1463 (N : Node_Id; 1464 Left, Right : Node_Id) 1465 is 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); 1470 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; 1477 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. 1481 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; 1487 1488 -- Determine if literal can be rewritten successfully 1489 1490 Frac := (Left_Small * Lit_Value) / Result_Small; 1491 Frac_Num := Norm_Num (Frac); 1492 Frac_Den := Norm_Den (Frac); 1493 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. 1497 1498 if Frac_Den = 1 then 1499 Lit_Int := Integer_Literal (N, Frac_Num, UR_Is_Negative (Frac)); 1500 1501 if Present (Lit_Int) then 1502 Set_Result (N, Build_Multiply (N, Left, Lit_Int)); 1503 return; 1504 end if; 1505 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. 1511 1512 else 1513 Lit_Int := Integer_Literal (N, Frac_Den, UR_Is_Negative (Frac)); 1514 Lit_K := Integer_Literal (N, Frac_Num, False); 1515 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; 1521 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. 1527 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. 1531 1532 Set_Result (N, 1533 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); 1534 end Do_Multiply_Fixed_Universal; 1535 1536 --------------------------------- 1537 -- Expand_Convert_Fixed_Static -- 1538 --------------------------------- 1539 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; 1547 1548 ----------------------------------- 1549 -- Expand_Convert_Fixed_To_Fixed -- 1550 ----------------------------------- 1551 1552 -- We have: 1553 1554 -- Result_Value * Result_Small = Source_Value * Source_Small 1555 -- Result_Value = Source_Value * (Source_Small / Result_Small) 1556 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. 1560 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. 1563 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. 1567 1568 -- In other cases, we obtain the close result set by calculating the 1569 -- result in floating-point. 1570 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; 1581 1582 begin 1583 if Is_OK_Static_Expression (Expr) then 1584 Expand_Convert_Fixed_Static (N); 1585 return; 1586 end if; 1587 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); 1591 1592 if Ratio_Den = 1 then 1593 if Ratio_Num = 1 then 1594 Set_Result (N, Expr); 1595 return; 1596 1597 else 1598 Lit_Num := Integer_Literal (N, Ratio_Num); 1599 1600 if Present (Lit_Num) then 1601 Set_Result (N, Build_Multiply (N, Expr, Lit_Num)); 1602 return; 1603 end if; 1604 end if; 1605 1606 elsif Ratio_Num = 1 then 1607 Lit_Den := Integer_Literal (N, Ratio_Den); 1608 1609 if Present (Lit_Den) then 1610 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check); 1611 return; 1612 end if; 1613 1614 else 1615 Lit_Num := Integer_Literal (N, Ratio_Num); 1616 Lit_Den := Integer_Literal (N, Ratio_Den); 1617 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; 1624 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. 1628 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; 1635 1636 ----------------------------------- 1637 -- Expand_Convert_Fixed_To_Float -- 1638 ----------------------------------- 1639 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. 1644 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); 1650 1651 begin 1652 if Is_OK_Static_Expression (Expr) then 1653 Expand_Convert_Fixed_Static (N); 1654 return; 1655 end if; 1656 1657 if Small = Ureal_1 then 1658 Set_Result (N, Expr); 1659 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; 1668 1669 ------------------------------------- 1670 -- Expand_Convert_Fixed_To_Integer -- 1671 ------------------------------------- 1672 1673 -- We have: 1674 1675 -- Result_Value = Source_Value * Source_Small 1676 1677 -- If the small value is a sufficiently small integer, then the perfect 1678 -- result set is obtained by a single integer multiplication. 1679 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. 1682 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. 1686 1687 -- In other cases, we obtain the close result set by calculating the 1688 -- result in floating-point. 1689 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; 1699 1700 begin 1701 if Is_OK_Static_Expression (Expr) then 1702 Expand_Convert_Fixed_Static (N); 1703 return; 1704 end if; 1705 1706 if Small_Den = 1 then 1707 Lit_Num := Integer_Literal (N, Small_Num); 1708 1709 if Present (Lit_Num) then 1710 Set_Result (N, Build_Multiply (N, Expr, Lit_Num), Rng_Check); 1711 return; 1712 end if; 1713 1714 elsif Small_Num = 1 then 1715 Lit_Den := Integer_Literal (N, Small_Den); 1716 1717 if Present (Lit_Den) then 1718 Set_Result (N, Build_Divide (N, Expr, Lit_Den), Rng_Check); 1719 return; 1720 end if; 1721 1722 else 1723 Lit_Num := Integer_Literal (N, Small_Num); 1724 Lit_Den := Integer_Literal (N, Small_Den); 1725 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; 1732 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. 1736 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; 1743 1744 ----------------------------------- 1745 -- Expand_Convert_Float_To_Fixed -- 1746 ----------------------------------- 1747 1748 -- We have 1749 1750 -- Result_Value * Result_Small = Operand_Value 1751 1752 -- so compute: 1753 1754 -- Result_Value = Operand_Value * (1.0 / Result_Small) 1755 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. 1759 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); 1765 1766 begin 1767 -- Optimize small = 1, where we can avoid the multiply completely 1768 1769 if Small = Ureal_1 then 1770 Set_Result (N, Expr, Rng_Check, Trunc => True); 1771 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. 1777 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; 1791 1792 ------------------------------------- 1793 -- Expand_Convert_Integer_To_Fixed -- 1794 ------------------------------------- 1795 1796 -- We have 1797 1798 -- Result_Value * Result_Small = Operand_Value 1799 -- Result_Value = Operand_Value / Result_Small 1800 1801 -- If the small value is a sufficiently small integer, then the perfect 1802 -- result set is obtained by a single integer division. 1803 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. 1806 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. 1810 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. 1814 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; 1824 1825 begin 1826 if Small_Den = 1 then 1827 Lit_Num := Integer_Literal (N, Small_Num); 1828 1829 if Present (Lit_Num) then 1830 Set_Result (N, Build_Divide (N, Expr, Lit_Num), Rng_Check); 1831 return; 1832 end if; 1833 1834 elsif Small_Num = 1 then 1835 Lit_Den := Integer_Literal (N, Small_Den); 1836 1837 if Present (Lit_Den) then 1838 Set_Result (N, Build_Multiply (N, Expr, Lit_Den), Rng_Check); 1839 return; 1840 end if; 1841 1842 else 1843 Lit_Num := Integer_Literal (N, Small_Num); 1844 Lit_Den := Integer_Literal (N, Small_Den); 1845 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; 1852 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. 1856 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; 1863 1864 -------------------------------- 1865 -- Expand_Decimal_Divide_Call -- 1866 -------------------------------- 1867 1868 -- We have four operands 1869 1870 -- Dividend 1871 -- Divisor 1872 -- Quotient 1873 -- Remainder 1874 1875 -- All of which are decimal types, and which thus have associated 1876 -- decimal scales. 1877 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. 1881 1882 -- Quotient = (Dividend / Divisor) * 10**q 1883 1884 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small) 1885 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale 1886 1887 -- For q >= 0, we compute 1888 1889 -- Numerator := Dividend * 10 ** q 1890 -- Denominator := Divisor 1891 -- Quotient := Numerator / Denominator 1892 1893 -- For q < 0, we compute 1894 1895 -- Numerator := Dividend 1896 -- Denominator := Divisor * 10 ** q 1897 -- Quotient := Numerator / Denominator 1898 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, 1902 1903 -- For q >= 0, the remainder scale is Dividend'Scale + q 1904 -- For q < 0, the remainder scale is Dividend'Scale 1905 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. 1909 1910 procedure Expand_Decimal_Divide_Call (N : Node_Id) is 1911 Loc : constant Source_Ptr := Sloc (N); 1912 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); 1917 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); 1922 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); 1927 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; 1936 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. 1940 1941 Dividend := Relocate_Node (Dividend); 1942 Divisor := Relocate_Node (Divisor); 1943 Quotient := Relocate_Node (Quotient); 1944 Remainder := Relocate_Node (Remainder); 1945 1946 -- Now compute Q, the adjustment scale 1947 1948 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale; 1949 1950 -- If Q is non-negative then we need a scaled divide 1951 1952 if Q >= 0 then 1953 Build_Scaled_Divide_Code 1954 (N, 1955 Dividend, 1956 Integer_Literal (N, Uint_10 ** Q), 1957 Divisor, 1958 Qnn, Rnn, Stmts); 1959 1960 Numerator_Scale := Dividend_Scale + Q; 1961 1962 -- If Q is negative, then we need a double divide 1963 1964 else 1965 Build_Double_Divide_Code 1966 (N, 1967 Dividend, 1968 Divisor, 1969 Integer_Literal (N, Uint_10 ** (-Q)), 1970 Qnn, Rnn, Stmts); 1971 1972 Numerator_Scale := Dividend_Scale; 1973 end if; 1974 1975 -- Add statement to set quotient value 1976 1977 -- Quotient := quotient-type!(Qnn); 1978 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))))); 1986 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: 1991 1992 -- Numerator_Scale > Remainder_Scale 1993 1994 -- in this case, there are extra digits in the computed remainder 1995 -- which must be eliminated by an extra division: 1996 1997 -- computed-remainder := Numerator rem Denominator 1998 -- scale_adjust = Numerator_Scale - Remainder_Scale 1999 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust 2000 2001 -- Numerator_Scale = Remainder_Scale 2002 2003 -- in this case, the we have the remainder we need 2004 2005 -- computed-remainder := Numerator rem Denominator 2006 -- adjusted-remainder := computed-remainder 2007 2008 -- Numerator_Scale < Remainder_Scale 2009 2010 -- in this case, we have insufficient digits in the computed 2011 -- remainder, which must be eliminated by an extra multiply 2012 2013 -- computed-remainder := Numerator rem Denominator 2014 -- scale_adjust = Remainder_Scale - Numerator_Scale 2015 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust 2016 2017 -- Finally we assign the adjusted-remainder to the result Remainder 2018 -- with conversions to get the proper fixed-point type representation. 2019 2020 Computed_Remainder := New_Occurrence_Of (Rnn, Loc); 2021 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)); 2027 2028 elsif Numerator_Scale = Remainder_Scale then 2029 Adjusted_Remainder := Computed_Remainder; 2030 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; 2037 2038 -- Assignment of remainder result 2039 2040 Append_To (Stmts, 2041 Make_Assignment_Statement (Loc, 2042 Name => Remainder, 2043 Expression => 2044 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder))); 2045 2046 -- Final step is to rewrite the call with a block containing the 2047 -- above sequence of constructed statements for the divide operation. 2048 2049 Rewrite (N, 2050 Make_Block_Statement (Loc, 2051 Handled_Statement_Sequence => 2052 Make_Handled_Sequence_Of_Statements (Loc, 2053 Statements => Stmts))); 2054 2055 Analyze (N); 2056 end Expand_Decimal_Divide_Call; 2057 2058 ----------------------------------------------- 2059 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed -- 2060 ----------------------------------------------- 2061 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); 2065 2066 begin 2067 if Etype (Left) = Universal_Real then 2068 Do_Divide_Universal_Fixed (N); 2069 2070 elsif Etype (Right) = Universal_Real then 2071 Do_Divide_Fixed_Universal (N); 2072 2073 else 2074 Do_Divide_Fixed_Fixed (N); 2075 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. 2082 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)); 2089 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; 2102 2103 ----------------------------------------------- 2104 -- Expand_Divide_Fixed_By_Fixed_Giving_Float -- 2105 ----------------------------------------------- 2106 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. 2111 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); 2115 2116 Left_Type : constant Entity_Id := Etype (Left); 2117 Right_Type : constant Entity_Id := Etype (Right); 2118 2119 begin 2120 -- Case of left operand is universal real, the result we want is: 2121 2122 -- Left_Value / (Right_Value * Right_Small) 2123 2124 -- so we compute this as: 2125 2126 -- (Left_Value / Right_Small) / Right_Value 2127 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))); 2133 2134 -- Case of right operand is universal real, the result we want is 2135 2136 -- (Left_Value * Left_Small) / Right_Value 2137 2138 -- so we compute this as: 2139 2140 -- Left_Value * (Left_Small / Right_Value) 2141 2142 -- Note we invert to a multiplication since usually floating-point 2143 -- multiplication is much faster than floating-point division. 2144 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)))); 2150 2151 -- Both operands are fixed, so the value we want is 2152 2153 -- (Left_Value * Left_Small) / (Right_Value * Right_Small) 2154 2155 -- which we compute as: 2156 2157 -- (Left_Value / Right_Value) * (Left_Small / Right_Small) 2158 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; 2167 2168 ------------------------------------------------- 2169 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer -- 2170 ------------------------------------------------- 2171 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; 2184 2185 ------------------------------------------------- 2186 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed -- 2187 ------------------------------------------------- 2188 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. 2191 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; 2198 2199 ------------------------------------------------- 2200 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed -- 2201 ------------------------------------------------- 2202 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); 2206 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. 2212 2213 ---------------------------------- 2214 -- Rewrite_Non_Static_Universal -- 2215 ---------------------------------- 2216 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; 2226 2227 -- Start of processing for Expand_Multiply_Fixed_By_Fixed_Giving_Fixed 2228 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); 2233 2234 elsif Nkind (Left) = N_Type_Conversion then 2235 Rewrite_Non_Static_Universal (Left); 2236 Do_Multiply_Fixed_Fixed (N); 2237 end if; 2238 2239 elsif Etype (Right) = Universal_Real then 2240 if Nkind (Right) = N_Real_Literal then 2241 Do_Multiply_Fixed_Universal (N, Left, Right); 2242 2243 elsif Nkind (Right) = N_Type_Conversion then 2244 Rewrite_Non_Static_Universal (Right); 2245 Do_Multiply_Fixed_Fixed (N); 2246 end if; 2247 2248 else 2249 Do_Multiply_Fixed_Fixed (N); 2250 end if; 2251 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed; 2252 2253 ------------------------------------------------- 2254 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float -- 2255 ------------------------------------------------- 2256 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. 2260 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); 2264 2265 Left_Type : constant Entity_Id := Etype (Left); 2266 Right_Type : constant Entity_Id := Etype (Right); 2267 2268 begin 2269 -- Case of left operand is universal real, the result we want is 2270 2271 -- Left_Value * (Right_Value * Right_Small) 2272 2273 -- so we compute this as: 2274 2275 -- (Left_Value * Right_Small) * Right_Value; 2276 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))); 2282 2283 -- Case of right operand is universal real, the result we want is 2284 2285 -- (Left_Value * Left_Small) * Right_Value 2286 2287 -- so we compute this as: 2288 2289 -- Left_Value * (Left_Small * Right_Value) 2290 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)))); 2296 2297 -- Both operands are fixed, so the value we want is 2298 2299 -- (Left_Value * Left_Small) * (Right_Value * Right_Small) 2300 2301 -- which we compute as: 2302 2303 -- (Left_Value * Right_Value) * (Right_Small * Left_Small) 2304 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; 2313 2314 --------------------------------------------------- 2315 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer -- 2316 --------------------------------------------------- 2317 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); 2322 2323 begin 2324 if Etype (Left) = Universal_Real then 2325 Do_Multiply_Fixed_Universal (N, Left => Right, Right => Left); 2326 2327 elsif Etype (Right) = Universal_Real then 2328 Do_Multiply_Fixed_Universal (N, Left, Right); 2329 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. 2334 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); 2346 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; 2353 2354 else 2355 Do_Multiply_Fixed_Fixed (N); 2356 end if; 2357 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer; 2358 2359 --------------------------------------------------- 2360 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed -- 2361 --------------------------------------------------- 2362 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. 2365 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; 2371 2372 --------------------------------------------------- 2373 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed -- 2374 --------------------------------------------------- 2375 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. 2378 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; 2384 2385 --------------- 2386 -- Fpt_Value -- 2387 --------------- 2388 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; 2393 2394 ------------------------ 2395 -- Get_Size_For_Value -- 2396 ------------------------ 2397 2398 function Get_Size_For_Value (V : Uint) return Pos is 2399 begin 2400 pragma Assert (V >= Uint_0); 2401 2402 if V < Uint_2 ** 7 then 2403 return 8; 2404 2405 elsif V < Uint_2 ** 15 then 2406 return 16; 2407 2408 elsif V < Uint_2 ** 31 then 2409 return 32; 2410 2411 elsif V < Uint_2 ** 63 then 2412 return 64; 2413 2414 elsif V < Uint_2 ** 127 then 2415 return 128; 2416 2417 else 2418 return Pos'Last; 2419 end if; 2420 end Get_Size_For_Value; 2421 2422 ----------------------- 2423 -- Get_Type_For_Size -- 2424 ----------------------- 2425 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; 2430 2431 elsif Siz <= 16 then 2432 return Standard_Integer_16; 2433 2434 elsif Siz <= 32 then 2435 return Standard_Integer_32; 2436 2437 elsif Siz <= 64 2438 or else (Force and then System_Max_Integer_Size < 128) 2439 then 2440 return Standard_Integer_64; 2441 2442 elsif (Siz <= 128 and then System_Max_Integer_Size = 128) 2443 or else Force 2444 then 2445 return Standard_Integer_128; 2446 2447 else 2448 return Empty; 2449 end if; 2450 end Get_Type_For_Size; 2451 2452 --------------------- 2453 -- Integer_Literal -- 2454 --------------------- 2455 2456 function Integer_Literal 2457 (N : Node_Id; 2458 V : Uint; 2459 Negative : Boolean := False) return Node_Id 2460 is 2461 T : Entity_Id; 2462 L : Node_Id; 2463 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; 2469 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; 2475 2476 -- Set type of result in case used elsewhere (see note at start) 2477 2478 Set_Etype (L, T); 2479 Set_Is_Static_Expression (L); 2480 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. 2484 2485 Set_Analyzed (L); 2486 return L; 2487 end Integer_Literal; 2488 2489 ------------------ 2490 -- Real_Literal -- 2491 ------------------ 2492 2493 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is 2494 L : Node_Id; 2495 2496 begin 2497 L := Make_Real_Literal (Sloc (N), V); 2498 2499 -- Set type of result in case used elsewhere (see note at start) 2500 2501 Set_Etype (L, Universal_Real); 2502 return L; 2503 end Real_Literal; 2504 2505 ------------------------ 2506 -- Rounded_Result_Set -- 2507 ------------------------ 2508 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; 2523 2524 ---------------- 2525 -- Set_Result -- 2526 ---------------- 2527 2528 procedure Set_Result 2529 (N : Node_Id; 2530 Expr : Node_Id; 2531 Rchk : Boolean := False; 2532 Trunc : Boolean := False) 2533 is 2534 Cnode : Node_Id; 2535 2536 Expr_Type : constant Entity_Id := Etype (Expr); 2537 Result_Type : constant Entity_Id := Etype (N); 2538 2539 begin 2540 -- No conversion required if types match and no range check or truncate 2541 2542 if Result_Type = Expr_Type and then not (Rchk or Trunc) then 2543 Cnode := Expr; 2544 2545 -- Else perform required conversion 2546 2547 else 2548 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk, Trunc); 2549 end if; 2550 2551 Rewrite (N, Cnode); 2552 Analyze_And_Resolve (N, Result_Type); 2553 end Set_Result; 2554 2555end Exp_Fixd; 2556