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-2002 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 2, 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 COPYING. If not, write -- 19-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, -- 20-- MA 02111-1307, USA. -- 21-- -- 22-- GNAT was originally developed by the GNAT team at New York University. -- 23-- Extensive contributions were provided by Ada Core Technologies Inc. -- 24-- -- 25------------------------------------------------------------------------------ 26 27with Atree; use Atree; 28with Checks; use Checks; 29with Einfo; use Einfo; 30with Exp_Util; use Exp_Util; 31with Nlists; use Nlists; 32with Nmake; use Nmake; 33with Rtsfind; use Rtsfind; 34with Sem; use Sem; 35with Sem_Eval; use Sem_Eval; 36with Sem_Res; use Sem_Res; 37with Sem_Util; use Sem_Util; 38with Sinfo; use Sinfo; 39with Stand; use Stand; 40with Tbuild; use Tbuild; 41with Uintp; use Uintp; 42with Urealp; use Urealp; 43 44package body Exp_Fixd is 45 46 ----------------------- 47 -- Local Subprograms -- 48 ----------------------- 49 50 -- General note; in this unit, a number of routines are driven by the 51 -- types (Etype) of their operands. Since we are dealing with unanalyzed 52 -- expressions as they are constructed, the Etypes would not normally be 53 -- set, but the construction routines that we use in this unit do in fact 54 -- set the Etype values correctly. In addition, setting the Etype ensures 55 -- that the analyzer does not try to redetermine the type when the node 56 -- is analyzed (which would be wrong, since in the case where we set the 57 -- Treat_Fixed_As_Integer or Conversion_OK flags, it would think it was 58 -- still dealing with a normal fixed-point operation and mess it up). 59 60 function Build_Conversion 61 (N : Node_Id; 62 Typ : Entity_Id; 63 Expr : Node_Id; 64 Rchk : Boolean := False) 65 return Node_Id; 66 -- Build an expression that converts the expression Expr to type Typ, 67 -- taking the source location from Sloc (N). If the conversions involve 68 -- fixed-point types, then the Conversion_OK flag will be set so that the 69 -- resulting conversions do not get re-expanded. On return the resulting 70 -- node has its Etype set. If Rchk is set, then Do_Range_Check is set 71 -- in the resulting conversion node. 72 73 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id; 74 -- Builds an N_Op_Divide node from the given left and right operand 75 -- expressions, using the source location from Sloc (N). The operands 76 -- are either both Long_Long_Float, in which case Build_Divide differs 77 -- from Make_Op_Divide only in that the Etype of the resulting node is 78 -- set (to Long_Long_Float), or they can be integer types. In this case 79 -- the integer types need not be the same, and Build_Divide converts 80 -- the operand with the smaller sized type to match the type of the 81 -- other operand and sets this as the result type. The Rounded_Result 82 -- flag of the result in this case is set from the Rounded_Result flag 83 -- of node N. On return, the resulting node is analyzed, and has its 84 -- Etype set. 85 86 function Build_Double_Divide 87 (N : Node_Id; 88 X, Y, Z : Node_Id) 89 return Node_Id; 90 -- Returns a node corresponding to the value X/(Y*Z) using the source 91 -- location from Sloc (N). The division is rounded if the Rounded_Result 92 -- flag of N is set. The integer types of X, Y, Z may be different. On 93 -- return the resulting node is analyzed, and has its Etype set. 94 95 procedure Build_Double_Divide_Code 96 (N : Node_Id; 97 X, Y, Z : Node_Id; 98 Qnn, Rnn : out Entity_Id; 99 Code : out List_Id); 100 -- Generates a sequence of code for determining the quotient and remainder 101 -- of the division X/(Y*Z), using the source location from Sloc (N). 102 -- Entities of appropriate types are allocated for the quotient and 103 -- remainder and returned in Qnn and Rnn. The result is rounded if 104 -- the Rounded_Result flag of N is set. The Etype fields of Qnn and Rnn 105 -- are appropriately set on return. 106 107 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id; 108 -- Builds an N_Op_Multiply node from the given left and right operand 109 -- expressions, using the source location from Sloc (N). The operands 110 -- are either both Long_Long_Float, in which case Build_Divide differs 111 -- from Make_Op_Multiply only in that the Etype of the resulting node is 112 -- set (to Long_Long_Float), or they can be integer types. In this case 113 -- the integer types need not be the same, and Build_Multiply chooses 114 -- a type long enough to hold the product (i.e. twice the size of the 115 -- longer of the two operand types), and both operands are converted 116 -- to this type. The Etype of the result is also set to this value. 117 -- However, the result can never overflow Integer_64, so this is the 118 -- largest type that is ever generated. On return, the resulting node 119 -- is analyzed and has its Etype set. 120 121 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id; 122 -- Builds an N_Op_Rem node from the given left and right operand 123 -- expressions, using the source location from Sloc (N). The operands 124 -- are both integer types, which need not be the same. Build_Rem 125 -- converts the operand with the smaller sized type to match the type 126 -- of the other operand and sets this as the result type. The result 127 -- is never rounded (rem operations cannot be rounded in any case!) 128 -- On return, the resulting node is analyzed and has its Etype set. 129 130 function Build_Scaled_Divide 131 (N : Node_Id; 132 X, Y, Z : Node_Id) 133 return Node_Id; 134 -- Returns a node corresponding to the value X*Y/Z using the source 135 -- location from Sloc (N). The division is rounded if the Rounded_Result 136 -- flag of N is set. The integer types of X, Y, Z may be different. On 137 -- return the resulting node is analyzed and has is Etype set. 138 139 procedure Build_Scaled_Divide_Code 140 (N : Node_Id; 141 X, Y, Z : Node_Id; 142 Qnn, Rnn : out Entity_Id; 143 Code : out List_Id); 144 -- Generates a sequence of code for determining the quotient and remainder 145 -- of the division X*Y/Z, using the source location from Sloc (N). Entities 146 -- of appropriate types are allocated for the quotient and remainder and 147 -- returned in Qnn and Rrr. The integer types for X, Y, Z may be different. 148 -- The division is rounded if the Rounded_Result flag of N is set. The 149 -- Etype fields of Qnn and Rnn are appropriately set on return. 150 151 procedure Do_Divide_Fixed_Fixed (N : Node_Id); 152 -- Handles expansion of divide for case of two fixed-point operands 153 -- (neither of them universal), with an integer or fixed-point result. 154 -- N is the N_Op_Divide node to be expanded. 155 156 procedure Do_Divide_Fixed_Universal (N : Node_Id); 157 -- Handles expansion of divide for case of a fixed-point operand divided 158 -- by a universal real operand, with an integer or fixed-point result. N 159 -- is the N_Op_Divide node to be expanded. 160 161 procedure Do_Divide_Universal_Fixed (N : Node_Id); 162 -- Handles expansion of divide for case of a universal real operand 163 -- divided by a fixed-point operand, with an integer or fixed-point 164 -- result. N is the N_Op_Divide node to be expanded. 165 166 procedure Do_Multiply_Fixed_Fixed (N : Node_Id); 167 -- Handles expansion of multiply for case of two fixed-point operands 168 -- (neither of them universal), with an integer or fixed-point result. 169 -- N is the N_Op_Multiply node to be expanded. 170 171 procedure Do_Multiply_Fixed_Universal (N : Node_Id; Left, Right : Node_Id); 172 -- Handles expansion of multiply for case of a fixed-point operand 173 -- multiplied by a universal real operand, with an integer or fixed- 174 -- point result. N is the N_Op_Multiply node to be expanded, and 175 -- Left, Right are the operands (which may have been switched). 176 177 procedure Expand_Convert_Fixed_Static (N : Node_Id); 178 -- This routine is called where the node N is a conversion of a literal 179 -- or other static expression of a fixed-point type to some other type. 180 -- In such cases, we simply rewrite the operand as a real literal and 181 -- reanalyze. This avoids problems which would otherwise result from 182 -- attempting to build and fold expressions involving constants. 183 184 function Fpt_Value (N : Node_Id) return Node_Id; 185 -- Given an operand of fixed-point operation, return an expression that 186 -- represents the corresponding Long_Long_Float value. The expression 187 -- can be of integer type, floating-point type, or fixed-point type. 188 -- The expression returned is neither analyzed and resolved. The Etype 189 -- of the result is properly set (to Long_Long_Float). 190 191 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id; 192 -- Given a non-negative universal integer value, build a typed integer 193 -- literal node, using the smallest applicable standard integer type. If 194 -- the value exceeds 2**63-1, the largest value allowed for perfect result 195 -- set scaling factors (see RM G.2.3(22)), then Empty is returned. The 196 -- node N provides the Sloc value for the constructed literal. The Etype 197 -- of the resulting literal is correctly set, and it is marked as analyzed. 198 199 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id; 200 -- Build a real literal node from the given value, the Etype of the 201 -- returned node is set to Long_Long_Float, since all floating-point 202 -- arithmetic operations that we construct use Long_Long_Float 203 204 function Rounded_Result_Set (N : Node_Id) return Boolean; 205 -- Returns True if N is a node that contains the Rounded_Result flag 206 -- and if the flag is true. 207 208 procedure Set_Result (N : Node_Id; Expr : Node_Id; Rchk : Boolean := False); 209 -- N is the node for the current conversion, division or multiplication 210 -- operation, and Expr is an expression representing the result. Expr 211 -- may be of floating-point or integer type. If the operation result 212 -- is fixed-point, then the value of Expr is in units of small of the 213 -- result type (i.e. small's have already been dealt with). The result 214 -- of the call is to replace N by an appropriate conversion to the 215 -- result type, dealing with rounding for the decimal types case. The 216 -- node is then analyzed and resolved using the result type. If Rchk 217 -- is True, then Do_Range_Check is set in the resulting conversion. 218 219 ---------------------- 220 -- Build_Conversion -- 221 ---------------------- 222 223 function Build_Conversion 224 (N : Node_Id; 225 Typ : Entity_Id; 226 Expr : Node_Id; 227 Rchk : Boolean := False) 228 return Node_Id 229 is 230 Loc : constant Source_Ptr := Sloc (N); 231 Result : Node_Id; 232 Rcheck : Boolean := Rchk; 233 234 begin 235 -- A special case, if the expression is an integer literal and the 236 -- target type is an integer type, then just retype the integer 237 -- literal to the desired target type. Don't do this if we need 238 -- a range check. 239 240 if Nkind (Expr) = N_Integer_Literal 241 and then Is_Integer_Type (Typ) 242 and then not Rchk 243 then 244 Result := Expr; 245 246 -- Cases where we end up with a conversion. Note that we do not use the 247 -- Convert_To abstraction here, since we may be decorating the resulting 248 -- conversion with Rounded_Result and/or Conversion_OK, so we want the 249 -- conversion node present, even if it appears to be redundant. 250 251 else 252 -- Remove inner conversion if both inner and outer conversions are 253 -- to integer types, since the inner one serves no purpose (except 254 -- perhaps to set rounding, so we preserve the Rounded_Result flag) 255 -- and also we preserve the range check flag on the inner operand 256 257 if Is_Integer_Type (Typ) 258 and then Is_Integer_Type (Etype (Expr)) 259 and then Nkind (Expr) = N_Type_Conversion 260 then 261 Result := 262 Make_Type_Conversion (Loc, 263 Subtype_Mark => New_Occurrence_Of (Typ, Loc), 264 Expression => Expression (Expr)); 265 Set_Rounded_Result (Result, Rounded_Result_Set (Expr)); 266 Rcheck := Rcheck or Do_Range_Check (Expr); 267 268 -- For all other cases, a simple type conversion will work 269 270 else 271 Result := 272 Make_Type_Conversion (Loc, 273 Subtype_Mark => New_Occurrence_Of (Typ, Loc), 274 Expression => Expr); 275 end if; 276 277 -- Set Conversion_OK if either result or expression type is a 278 -- fixed-point type, since from a semantic point of view, we are 279 -- treating fixed-point values as integers at this stage. 280 281 if Is_Fixed_Point_Type (Typ) 282 or else Is_Fixed_Point_Type (Etype (Expression (Result))) 283 then 284 Set_Conversion_OK (Result); 285 end if; 286 287 -- Set Do_Range_Check if either it was requested by the caller, 288 -- or if an eliminated inner conversion had a range check. 289 290 if Rcheck then 291 Enable_Range_Check (Result); 292 else 293 Set_Do_Range_Check (Result, False); 294 end if; 295 end if; 296 297 Set_Etype (Result, Typ); 298 return Result; 299 300 end Build_Conversion; 301 302 ------------------ 303 -- Build_Divide -- 304 ------------------ 305 306 function Build_Divide (N : Node_Id; L, R : Node_Id) return Node_Id is 307 Loc : constant Source_Ptr := Sloc (N); 308 Left_Type : constant Entity_Id := Base_Type (Etype (L)); 309 Right_Type : constant Entity_Id := Base_Type (Etype (R)); 310 Result_Type : Entity_Id; 311 Rnode : Node_Id; 312 313 begin 314 -- Deal with floating-point case first 315 316 if Is_Floating_Point_Type (Left_Type) then 317 pragma Assert (Left_Type = Standard_Long_Long_Float); 318 pragma Assert (Right_Type = Standard_Long_Long_Float); 319 320 Rnode := Make_Op_Divide (Loc, L, R); 321 Result_Type := Standard_Long_Long_Float; 322 323 -- Integer and fixed-point cases 324 325 else 326 -- An optimization. If the right operand is the literal 1, then we 327 -- can just return the left hand operand. Putting the optimization 328 -- here allows us to omit the check at the call site. 329 330 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then 331 return L; 332 end if; 333 334 -- If left and right types are the same, no conversion needed 335 336 if Left_Type = Right_Type then 337 Result_Type := Left_Type; 338 Rnode := 339 Make_Op_Divide (Loc, 340 Left_Opnd => L, 341 Right_Opnd => R); 342 343 -- Use left type if it is the larger of the two 344 345 elsif Esize (Left_Type) >= Esize (Right_Type) then 346 Result_Type := Left_Type; 347 Rnode := 348 Make_Op_Divide (Loc, 349 Left_Opnd => L, 350 Right_Opnd => Build_Conversion (N, Left_Type, R)); 351 352 -- Otherwise right type is larger of the two, us it 353 354 else 355 Result_Type := Right_Type; 356 Rnode := 357 Make_Op_Divide (Loc, 358 Left_Opnd => Build_Conversion (N, Right_Type, L), 359 Right_Opnd => R); 360 end if; 361 end if; 362 363 -- We now have a divide node built with Result_Type set. First 364 -- set Etype of result, as required for all Build_xxx routines 365 366 Set_Etype (Rnode, Base_Type (Result_Type)); 367 368 -- Set Treat_Fixed_As_Integer if operation on fixed-point type 369 -- since this is a literal arithmetic operation, to be performed 370 -- by Gigi without any consideration of small values. 371 372 if Is_Fixed_Point_Type (Result_Type) then 373 Set_Treat_Fixed_As_Integer (Rnode); 374 end if; 375 376 -- The result is rounded if the target of the operation is decimal 377 -- and Rounded_Result is set, or if the target of the operation 378 -- is an integer type. 379 380 if Is_Integer_Type (Etype (N)) 381 or else Rounded_Result_Set (N) 382 then 383 Set_Rounded_Result (Rnode); 384 end if; 385 386 return Rnode; 387 388 end Build_Divide; 389 390 ------------------------- 391 -- Build_Double_Divide -- 392 ------------------------- 393 394 function Build_Double_Divide 395 (N : Node_Id; 396 X, Y, Z : Node_Id) 397 return Node_Id 398 is 399 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); 400 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z))); 401 Expr : Node_Id; 402 403 begin 404 -- If denominator fits in 64 bits, we can build the operations directly 405 -- without causing any intermediate overflow, so that's what we do! 406 407 if Int'Max (Y_Size, Z_Size) <= 32 then 408 return 409 Build_Divide (N, X, Build_Multiply (N, Y, Z)); 410 411 -- Otherwise we use the runtime routine 412 413 -- [Qnn : Interfaces.Integer_64, 414 -- Rnn : Interfaces.Integer_64; 415 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round); 416 -- Qnn] 417 418 else 419 declare 420 Loc : constant Source_Ptr := Sloc (N); 421 Qnn : Entity_Id; 422 Rnn : Entity_Id; 423 Code : List_Id; 424 425 begin 426 Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code); 427 Insert_Actions (N, Code); 428 Expr := New_Occurrence_Of (Qnn, Loc); 429 430 -- Set type of result in case used elsewhere (see note at start) 431 432 Set_Etype (Expr, Etype (Qnn)); 433 434 -- Set result as analyzed (see note at start on build routines) 435 436 return Expr; 437 end; 438 end if; 439 end Build_Double_Divide; 440 441 ------------------------------ 442 -- Build_Double_Divide_Code -- 443 ------------------------------ 444 445 -- If the denominator can be computed in 64-bits, we build 446 447 -- [Nnn : constant typ := typ (X); 448 -- Dnn : constant typ := typ (Y) * typ (Z) 449 -- Qnn : constant typ := Nnn / Dnn; 450 -- Rnn : constant typ := Nnn / Dnn; 451 452 -- If the numerator cannot be computed in 64 bits, we build 453 454 -- [Qnn : typ; 455 -- Rnn : typ; 456 -- Double_Divide (X, Y, Z, Qnn, Rnn, Round);] 457 458 procedure Build_Double_Divide_Code 459 (N : Node_Id; 460 X, Y, Z : Node_Id; 461 Qnn, Rnn : out Entity_Id; 462 Code : out List_Id) 463 is 464 Loc : constant Source_Ptr := Sloc (N); 465 466 X_Size : constant Int := UI_To_Int (Esize (Etype (X))); 467 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); 468 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z))); 469 470 QR_Siz : Int; 471 QR_Typ : Entity_Id; 472 473 Nnn : Entity_Id; 474 Dnn : Entity_Id; 475 476 Quo : Node_Id; 477 Rnd : Entity_Id; 478 479 begin 480 -- Find type that will allow computation of numerator 481 482 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size)); 483 484 if QR_Siz <= 16 then 485 QR_Typ := Standard_Integer_16; 486 elsif QR_Siz <= 32 then 487 QR_Typ := Standard_Integer_32; 488 elsif QR_Siz <= 64 then 489 QR_Typ := Standard_Integer_64; 490 491 -- For more than 64, bits, we use the 64-bit integer defined in 492 -- Interfaces, so that it can be handled by the runtime routine 493 494 else 495 QR_Typ := RTE (RE_Integer_64); 496 end if; 497 498 -- Define quotient and remainder, and set their Etypes, so 499 -- that they can be picked up by Build_xxx routines. 500 501 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S')); 502 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); 503 504 Set_Etype (Qnn, QR_Typ); 505 Set_Etype (Rnn, QR_Typ); 506 507 -- Case that we can compute the denominator in 64 bits 508 509 if QR_Siz <= 64 then 510 511 -- Create temporaries for numerator and denominator and set Etypes, 512 -- so that New_Occurrence_Of picks them up for Build_xxx calls. 513 514 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N')); 515 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D')); 516 517 Set_Etype (Nnn, QR_Typ); 518 Set_Etype (Dnn, QR_Typ); 519 520 Code := New_List ( 521 Make_Object_Declaration (Loc, 522 Defining_Identifier => Nnn, 523 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 524 Constant_Present => True, 525 Expression => Build_Conversion (N, QR_Typ, X)), 526 527 Make_Object_Declaration (Loc, 528 Defining_Identifier => Dnn, 529 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 530 Constant_Present => True, 531 Expression => 532 Build_Multiply (N, 533 Build_Conversion (N, QR_Typ, Y), 534 Build_Conversion (N, QR_Typ, Z)))); 535 536 Quo := 537 Build_Divide (N, 538 New_Occurrence_Of (Nnn, Loc), 539 New_Occurrence_Of (Dnn, Loc)); 540 541 Set_Rounded_Result (Quo, Rounded_Result_Set (N)); 542 543 Append_To (Code, 544 Make_Object_Declaration (Loc, 545 Defining_Identifier => Qnn, 546 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 547 Constant_Present => True, 548 Expression => Quo)); 549 550 Append_To (Code, 551 Make_Object_Declaration (Loc, 552 Defining_Identifier => Rnn, 553 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 554 Constant_Present => True, 555 Expression => 556 Build_Rem (N, 557 New_Occurrence_Of (Nnn, Loc), 558 New_Occurrence_Of (Dnn, Loc)))); 559 560 -- Case where denominator does not fit in 64 bits, so we have to 561 -- call the runtime routine to compute the quotient and remainder 562 563 else 564 if Rounded_Result_Set (N) then 565 Rnd := Standard_True; 566 else 567 Rnd := Standard_False; 568 end if; 569 570 Code := New_List ( 571 Make_Object_Declaration (Loc, 572 Defining_Identifier => Qnn, 573 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 574 575 Make_Object_Declaration (Loc, 576 Defining_Identifier => Rnn, 577 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 578 579 Make_Procedure_Call_Statement (Loc, 580 Name => New_Occurrence_Of (RTE (RE_Double_Divide), Loc), 581 Parameter_Associations => New_List ( 582 Build_Conversion (N, QR_Typ, X), 583 Build_Conversion (N, QR_Typ, Y), 584 Build_Conversion (N, QR_Typ, Z), 585 New_Occurrence_Of (Qnn, Loc), 586 New_Occurrence_Of (Rnn, Loc), 587 New_Occurrence_Of (Rnd, Loc)))); 588 end if; 589 590 end Build_Double_Divide_Code; 591 592 -------------------- 593 -- Build_Multiply -- 594 -------------------- 595 596 function Build_Multiply (N : Node_Id; L, R : Node_Id) return Node_Id is 597 Loc : constant Source_Ptr := Sloc (N); 598 Left_Type : constant Entity_Id := Etype (L); 599 Right_Type : constant Entity_Id := Etype (R); 600 Left_Size : Int; 601 Right_Size : Int; 602 Rsize : Int; 603 Result_Type : Entity_Id; 604 Rnode : Node_Id; 605 606 begin 607 -- Deal with floating-point case first 608 609 if Is_Floating_Point_Type (Left_Type) then 610 pragma Assert (Left_Type = Standard_Long_Long_Float); 611 pragma Assert (Right_Type = Standard_Long_Long_Float); 612 613 Result_Type := Standard_Long_Long_Float; 614 Rnode := Make_Op_Multiply (Loc, L, R); 615 616 -- Integer and fixed-point cases 617 618 else 619 -- An optimization. If the right operand is the literal 1, then we 620 -- can just return the left hand operand. Putting the optimization 621 -- here allows us to omit the check at the call site. Similarly, if 622 -- the left operand is the integer 1 we can return the right operand. 623 624 if Nkind (R) = N_Integer_Literal and then Intval (R) = 1 then 625 return L; 626 elsif Nkind (L) = N_Integer_Literal and then Intval (L) = 1 then 627 return R; 628 end if; 629 630 -- Otherwise we need to figure out the correct result type size 631 -- First figure out the effective sizes of the operands. Normally 632 -- the effective size of an operand is the RM_Size of the operand. 633 -- But a special case arises with operands whose size is known at 634 -- compile time. In this case, we can use the actual value of the 635 -- operand to get its size if it would fit in 8 or 16 bits. 636 637 -- Note: if both operands are known at compile time (can that 638 -- happen?) and both were equal to the power of 2, then we would 639 -- be one bit off in this test, so for the left operand, we only 640 -- go up to the power of 2 - 1. This ensures that we do not get 641 -- this anomolous case, and in practice the right operand is by 642 -- far the more likely one to be the constant. 643 644 Left_Size := UI_To_Int (RM_Size (Left_Type)); 645 646 if Compile_Time_Known_Value (L) then 647 declare 648 Val : constant Uint := Expr_Value (L); 649 650 begin 651 if Val < Int'(2 ** 8) then 652 Left_Size := 8; 653 elsif Val < Int'(2 ** 16) then 654 Left_Size := 16; 655 end if; 656 end; 657 end if; 658 659 Right_Size := UI_To_Int (RM_Size (Right_Type)); 660 661 if Compile_Time_Known_Value (R) then 662 declare 663 Val : constant Uint := Expr_Value (R); 664 665 begin 666 if Val <= Int'(2 ** 8) then 667 Right_Size := 8; 668 elsif Val <= Int'(2 ** 16) then 669 Right_Size := 16; 670 end if; 671 end; 672 end if; 673 674 -- Now the result size must be at least twice the longer of 675 -- the two sizes, to accomodate all possible results. 676 677 Rsize := 2 * Int'Max (Left_Size, Right_Size); 678 679 if Rsize <= 8 then 680 Result_Type := Standard_Integer_8; 681 682 elsif Rsize <= 16 then 683 Result_Type := Standard_Integer_16; 684 685 elsif Rsize <= 32 then 686 Result_Type := Standard_Integer_32; 687 688 else 689 Result_Type := Standard_Integer_64; 690 end if; 691 692 Rnode := 693 Make_Op_Multiply (Loc, 694 Left_Opnd => Build_Conversion (N, Result_Type, L), 695 Right_Opnd => Build_Conversion (N, Result_Type, R)); 696 end if; 697 698 -- We now have a multiply node built with Result_Type set. First 699 -- set Etype of result, as required for all Build_xxx routines 700 701 Set_Etype (Rnode, Base_Type (Result_Type)); 702 703 -- Set Treat_Fixed_As_Integer if operation on fixed-point type 704 -- since this is a literal arithmetic operation, to be performed 705 -- by Gigi without any consideration of small values. 706 707 if Is_Fixed_Point_Type (Result_Type) then 708 Set_Treat_Fixed_As_Integer (Rnode); 709 end if; 710 711 return Rnode; 712 end Build_Multiply; 713 714 --------------- 715 -- Build_Rem -- 716 --------------- 717 718 function Build_Rem (N : Node_Id; L, R : Node_Id) return Node_Id is 719 Loc : constant Source_Ptr := Sloc (N); 720 Left_Type : constant Entity_Id := Etype (L); 721 Right_Type : constant Entity_Id := Etype (R); 722 Result_Type : Entity_Id; 723 Rnode : Node_Id; 724 725 begin 726 if Left_Type = Right_Type then 727 Result_Type := Left_Type; 728 Rnode := 729 Make_Op_Rem (Loc, 730 Left_Opnd => L, 731 Right_Opnd => R); 732 733 -- If left size is larger, we do the remainder operation using the 734 -- size of the left type (i.e. the larger of the two integer types). 735 736 elsif Esize (Left_Type) >= Esize (Right_Type) then 737 Result_Type := Left_Type; 738 Rnode := 739 Make_Op_Rem (Loc, 740 Left_Opnd => L, 741 Right_Opnd => Build_Conversion (N, Left_Type, R)); 742 743 -- Similarly, if the right size is larger, we do the remainder 744 -- operation using the right type. 745 746 else 747 Result_Type := Right_Type; 748 Rnode := 749 Make_Op_Rem (Loc, 750 Left_Opnd => Build_Conversion (N, Right_Type, L), 751 Right_Opnd => R); 752 end if; 753 754 -- We now have an N_Op_Rem node built with Result_Type set. First 755 -- set Etype of result, as required for all Build_xxx routines 756 757 Set_Etype (Rnode, Base_Type (Result_Type)); 758 759 -- Set Treat_Fixed_As_Integer if operation on fixed-point type 760 -- since this is a literal arithmetic operation, to be performed 761 -- by Gigi without any consideration of small values. 762 763 if Is_Fixed_Point_Type (Result_Type) then 764 Set_Treat_Fixed_As_Integer (Rnode); 765 end if; 766 767 -- One more check. We did the rem operation using the larger of the 768 -- two types, which is reasonable. However, in the case where the 769 -- two types have unequal sizes, it is impossible for the result of 770 -- a remainder operation to be larger than the smaller of the two 771 -- types, so we can put a conversion round the result to keep the 772 -- evolving operation size as small as possible. 773 774 if Esize (Left_Type) >= Esize (Right_Type) then 775 Rnode := Build_Conversion (N, Right_Type, Rnode); 776 elsif Esize (Right_Type) >= Esize (Left_Type) then 777 Rnode := Build_Conversion (N, Left_Type, Rnode); 778 end if; 779 780 return Rnode; 781 end Build_Rem; 782 783 ------------------------- 784 -- Build_Scaled_Divide -- 785 ------------------------- 786 787 function Build_Scaled_Divide 788 (N : Node_Id; 789 X, Y, Z : Node_Id) 790 return Node_Id 791 is 792 X_Size : constant Int := UI_To_Int (Esize (Etype (X))); 793 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); 794 Expr : Node_Id; 795 796 begin 797 -- If numerator fits in 64 bits, we can build the operations directly 798 -- without causing any intermediate overflow, so that's what we do! 799 800 if Int'Max (X_Size, Y_Size) <= 32 then 801 return 802 Build_Divide (N, Build_Multiply (N, X, Y), Z); 803 804 -- Otherwise we use the runtime routine 805 806 -- [Qnn : Integer_64, 807 -- Rnn : Integer_64; 808 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round); 809 -- Qnn] 810 811 else 812 declare 813 Loc : constant Source_Ptr := Sloc (N); 814 Qnn : Entity_Id; 815 Rnn : Entity_Id; 816 Code : List_Id; 817 818 begin 819 Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code); 820 Insert_Actions (N, Code); 821 Expr := New_Occurrence_Of (Qnn, Loc); 822 823 -- Set type of result in case used elsewhere (see note at start) 824 825 Set_Etype (Expr, Etype (Qnn)); 826 return Expr; 827 end; 828 end if; 829 end Build_Scaled_Divide; 830 831 ------------------------------ 832 -- Build_Scaled_Divide_Code -- 833 ------------------------------ 834 835 -- If the numerator can be computed in 64-bits, we build 836 837 -- [Nnn : constant typ := typ (X) * typ (Y); 838 -- Dnn : constant typ := typ (Z) 839 -- Qnn : constant typ := Nnn / Dnn; 840 -- Rnn : constant typ := Nnn / Dnn; 841 842 -- If the numerator cannot be computed in 64 bits, we build 843 844 -- [Qnn : Interfaces.Integer_64; 845 -- Rnn : Interfaces.Integer_64; 846 -- Scaled_Divide (X, Y, Z, Qnn, Rnn, Round);] 847 848 procedure Build_Scaled_Divide_Code 849 (N : Node_Id; 850 X, Y, Z : Node_Id; 851 Qnn, Rnn : out Entity_Id; 852 Code : out List_Id) 853 is 854 Loc : constant Source_Ptr := Sloc (N); 855 856 X_Size : constant Int := UI_To_Int (Esize (Etype (X))); 857 Y_Size : constant Int := UI_To_Int (Esize (Etype (Y))); 858 Z_Size : constant Int := UI_To_Int (Esize (Etype (Z))); 859 860 QR_Siz : Int; 861 QR_Typ : Entity_Id; 862 863 Nnn : Entity_Id; 864 Dnn : Entity_Id; 865 866 Quo : Node_Id; 867 Rnd : Entity_Id; 868 869 begin 870 -- Find type that will allow computation of numerator 871 872 QR_Siz := Int'Max (X_Size, 2 * Int'Max (Y_Size, Z_Size)); 873 874 if QR_Siz <= 16 then 875 QR_Typ := Standard_Integer_16; 876 elsif QR_Siz <= 32 then 877 QR_Typ := Standard_Integer_32; 878 elsif QR_Siz <= 64 then 879 QR_Typ := Standard_Integer_64; 880 881 -- For more than 64, bits, we use the 64-bit integer defined in 882 -- Interfaces, so that it can be handled by the runtime routine 883 884 else 885 QR_Typ := RTE (RE_Integer_64); 886 end if; 887 888 -- Define quotient and remainder, and set their Etypes, so 889 -- that they can be picked up by Build_xxx routines. 890 891 Qnn := Make_Defining_Identifier (Loc, New_Internal_Name ('S')); 892 Rnn := Make_Defining_Identifier (Loc, New_Internal_Name ('R')); 893 894 Set_Etype (Qnn, QR_Typ); 895 Set_Etype (Rnn, QR_Typ); 896 897 -- Case that we can compute the numerator in 64 bits 898 899 if QR_Siz <= 64 then 900 Nnn := Make_Defining_Identifier (Loc, New_Internal_Name ('N')); 901 Dnn := Make_Defining_Identifier (Loc, New_Internal_Name ('D')); 902 903 -- Set Etypes, so that they can be picked up by New_Occurrence_Of 904 905 Set_Etype (Nnn, QR_Typ); 906 Set_Etype (Dnn, QR_Typ); 907 908 Code := New_List ( 909 Make_Object_Declaration (Loc, 910 Defining_Identifier => Nnn, 911 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 912 Constant_Present => True, 913 Expression => 914 Build_Multiply (N, 915 Build_Conversion (N, QR_Typ, X), 916 Build_Conversion (N, QR_Typ, Y))), 917 918 Make_Object_Declaration (Loc, 919 Defining_Identifier => Dnn, 920 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 921 Constant_Present => True, 922 Expression => Build_Conversion (N, QR_Typ, Z))); 923 924 Quo := 925 Build_Divide (N, 926 New_Occurrence_Of (Nnn, Loc), 927 New_Occurrence_Of (Dnn, Loc)); 928 929 Append_To (Code, 930 Make_Object_Declaration (Loc, 931 Defining_Identifier => Qnn, 932 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 933 Constant_Present => True, 934 Expression => Quo)); 935 936 Append_To (Code, 937 Make_Object_Declaration (Loc, 938 Defining_Identifier => Rnn, 939 Object_Definition => New_Occurrence_Of (QR_Typ, Loc), 940 Constant_Present => True, 941 Expression => 942 Build_Rem (N, 943 New_Occurrence_Of (Nnn, Loc), 944 New_Occurrence_Of (Dnn, Loc)))); 945 946 -- Case where numerator does not fit in 64 bits, so we have to 947 -- call the runtime routine to compute the quotient and remainder 948 949 else 950 if Rounded_Result_Set (N) then 951 Rnd := Standard_True; 952 else 953 Rnd := Standard_False; 954 end if; 955 956 Code := New_List ( 957 Make_Object_Declaration (Loc, 958 Defining_Identifier => Qnn, 959 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 960 961 Make_Object_Declaration (Loc, 962 Defining_Identifier => Rnn, 963 Object_Definition => New_Occurrence_Of (QR_Typ, Loc)), 964 965 Make_Procedure_Call_Statement (Loc, 966 Name => New_Occurrence_Of (RTE (RE_Scaled_Divide), Loc), 967 Parameter_Associations => New_List ( 968 Build_Conversion (N, QR_Typ, X), 969 Build_Conversion (N, QR_Typ, Y), 970 Build_Conversion (N, QR_Typ, Z), 971 New_Occurrence_Of (Qnn, Loc), 972 New_Occurrence_Of (Rnn, Loc), 973 New_Occurrence_Of (Rnd, Loc)))); 974 end if; 975 976 -- Set type of result, for use in caller. 977 978 Set_Etype (Qnn, QR_Typ); 979 end Build_Scaled_Divide_Code; 980 981 --------------------------- 982 -- Do_Divide_Fixed_Fixed -- 983 --------------------------- 984 985 -- We have: 986 987 -- (Result_Value * Result_Small) = 988 -- (Left_Value * Left_Small) / (Right_Value * Right_Small) 989 990 -- Result_Value = (Left_Value / Right_Value) * 991 -- (Left_Small / (Right_Small * Result_Small)); 992 993 -- we can do the operation in integer arithmetic if this fraction is an 994 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)). 995 -- Otherwise the result is in the close result set and our approach is to 996 -- use floating-point to compute this close result. 997 998 procedure Do_Divide_Fixed_Fixed (N : Node_Id) is 999 Left : constant Node_Id := Left_Opnd (N); 1000 Right : constant Node_Id := Right_Opnd (N); 1001 Left_Type : constant Entity_Id := Etype (Left); 1002 Right_Type : constant Entity_Id := Etype (Right); 1003 Result_Type : constant Entity_Id := Etype (N); 1004 Right_Small : constant Ureal := Small_Value (Right_Type); 1005 Left_Small : constant Ureal := Small_Value (Left_Type); 1006 1007 Result_Small : Ureal; 1008 Frac : Ureal; 1009 Frac_Num : Uint; 1010 Frac_Den : Uint; 1011 Lit_Int : Node_Id; 1012 1013 begin 1014 -- Rounding is required if the result is integral 1015 1016 if Is_Integer_Type (Result_Type) then 1017 Set_Rounded_Result (N); 1018 end if; 1019 1020 -- Get result small. If the result is an integer, treat it as though 1021 -- it had a small of 1.0, all other processing is identical. 1022 1023 if Is_Integer_Type (Result_Type) then 1024 Result_Small := Ureal_1; 1025 else 1026 Result_Small := Small_Value (Result_Type); 1027 end if; 1028 1029 -- Get small ratio 1030 1031 Frac := Left_Small / (Right_Small * Result_Small); 1032 Frac_Num := Norm_Num (Frac); 1033 Frac_Den := Norm_Den (Frac); 1034 1035 -- If the fraction is an integer, then we get the result by multiplying 1036 -- the left operand by the integer, and then dividing by the right 1037 -- operand (the order is important, if we did the divide first, we 1038 -- would lose precision). 1039 1040 if Frac_Den = 1 then 1041 Lit_Int := Integer_Literal (N, Frac_Num); 1042 1043 if Present (Lit_Int) then 1044 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Right)); 1045 return; 1046 end if; 1047 1048 -- If the fraction is the reciprocal of an integer, then we get the 1049 -- result by first multiplying the divisor by the integer, and then 1050 -- doing the division with the adjusted divisor. 1051 1052 -- Note: this is much better than doing two divisions: multiplications 1053 -- are much faster than divisions (and certainly faster than rounded 1054 -- divisions), and we don't get inaccuracies from double rounding. 1055 1056 elsif Frac_Num = 1 then 1057 Lit_Int := Integer_Literal (N, Frac_Den); 1058 1059 if Present (Lit_Int) then 1060 Set_Result (N, Build_Double_Divide (N, Left, Right, Lit_Int)); 1061 return; 1062 end if; 1063 end if; 1064 1065 -- If we fall through, we use floating-point to compute the result 1066 1067 Set_Result (N, 1068 Build_Multiply (N, 1069 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)), 1070 Real_Literal (N, Frac))); 1071 1072 end Do_Divide_Fixed_Fixed; 1073 1074 ------------------------------- 1075 -- Do_Divide_Fixed_Universal -- 1076 ------------------------------- 1077 1078 -- We have: 1079 1080 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) / Lit_Value; 1081 -- Result_Value = Left_Value * Left_Small /(Lit_Value * Result_Small); 1082 1083 -- The result is required to be in the perfect result set if the literal 1084 -- can be factored so that the resulting small ratio is an integer or the 1085 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed 1086 -- analysis of these RM requirements: 1087 1088 -- We must factor the literal, finding an integer K: 1089 1090 -- Lit_Value = K * Right_Small 1091 -- Right_Small = Lit_Value / K 1092 1093 -- such that the small ratio: 1094 1095 -- Left_Small 1096 -- ------------------------------ 1097 -- (Lit_Value / K) * Result_Small 1098 1099 -- Left_Small 1100 -- = ------------------------ * K 1101 -- Lit_Value * Result_Small 1102 1103 -- is an integer or the reciprocal of an integer, and for 1104 -- implementation efficiency we need the smallest such K. 1105 1106 -- First we reduce the left fraction to lowest terms. 1107 1108 -- If numerator = 1, then for K = 1, the small ratio is the reciprocal 1109 -- of an integer, and this is clearly the minimum K case, so set K = 1, 1110 -- Right_Small = Lit_Value. 1111 1112 -- If numerator > 1, then set K to the denominator of the fraction so 1113 -- that the resulting small ratio is an integer (the numerator value). 1114 1115 procedure Do_Divide_Fixed_Universal (N : Node_Id) is 1116 Left : constant Node_Id := Left_Opnd (N); 1117 Right : constant Node_Id := Right_Opnd (N); 1118 Left_Type : constant Entity_Id := Etype (Left); 1119 Result_Type : constant Entity_Id := Etype (N); 1120 Left_Small : constant Ureal := Small_Value (Left_Type); 1121 Lit_Value : constant Ureal := Realval (Right); 1122 1123 Result_Small : Ureal; 1124 Frac : Ureal; 1125 Frac_Num : Uint; 1126 Frac_Den : Uint; 1127 Lit_K : Node_Id; 1128 Lit_Int : Node_Id; 1129 1130 begin 1131 -- Get result small. If the result is an integer, treat it as though 1132 -- it had a small of 1.0, all other processing is identical. 1133 1134 if Is_Integer_Type (Result_Type) then 1135 Result_Small := Ureal_1; 1136 else 1137 Result_Small := Small_Value (Result_Type); 1138 end if; 1139 1140 -- Determine if literal can be rewritten successfully 1141 1142 Frac := Left_Small / (Lit_Value * Result_Small); 1143 Frac_Num := Norm_Num (Frac); 1144 Frac_Den := Norm_Den (Frac); 1145 1146 -- Case where fraction is the reciprocal of an integer (K = 1, integer 1147 -- = denominator). If this integer is not too large, this is the case 1148 -- where the result can be obtained by dividing by this integer value. 1149 1150 if Frac_Num = 1 then 1151 Lit_Int := Integer_Literal (N, Frac_Den); 1152 1153 if Present (Lit_Int) then 1154 Set_Result (N, Build_Divide (N, Left, Lit_Int)); 1155 return; 1156 end if; 1157 1158 -- Case where we choose K to make fraction an integer (K = denominator 1159 -- of fraction, integer = numerator of fraction). If both K and the 1160 -- numerator are small enough, this is the case where the result can 1161 -- be obtained by first multiplying by the integer value and then 1162 -- dividing by K (the order is important, if we divided first, we 1163 -- would lose precision). 1164 1165 else 1166 Lit_Int := Integer_Literal (N, Frac_Num); 1167 Lit_K := Integer_Literal (N, Frac_Den); 1168 1169 if Present (Lit_Int) and then Present (Lit_K) then 1170 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_Int, Lit_K)); 1171 return; 1172 end if; 1173 end if; 1174 1175 -- Fall through if the literal cannot be successfully rewritten, or if 1176 -- the small ratio is out of range of integer arithmetic. In the former 1177 -- case it is fine to use floating-point to get the close result set, 1178 -- and in the latter case, it means that the result is zero or raises 1179 -- constraint error, and we can do that accurately in floating-point. 1180 1181 -- If we end up using floating-point, then we take the right integer 1182 -- to be one, and its small to be the value of the original right real 1183 -- literal. That way, we need only one floating-point multiplication. 1184 1185 Set_Result (N, 1186 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); 1187 1188 end Do_Divide_Fixed_Universal; 1189 1190 ------------------------------- 1191 -- Do_Divide_Universal_Fixed -- 1192 ------------------------------- 1193 1194 -- We have: 1195 1196 -- (Result_Value * Result_Small) = 1197 -- Lit_Value / (Right_Value * Right_Small) 1198 -- Result_Value = 1199 -- (Lit_Value / (Right_Small * Result_Small)) / Right_Value 1200 1201 -- The result is required to be in the perfect result set if the literal 1202 -- can be factored so that the resulting small ratio is an integer or the 1203 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed 1204 -- analysis of these RM requirements: 1205 1206 -- We must factor the literal, finding an integer K: 1207 1208 -- Lit_Value = K * Left_Small 1209 -- Left_Small = Lit_Value / K 1210 1211 -- such that the small ratio: 1212 1213 -- (Lit_Value / K) 1214 -- -------------------------- 1215 -- Right_Small * Result_Small 1216 1217 -- Lit_Value 1 1218 -- = -------------------------- * - 1219 -- Right_Small * Result_Small K 1220 1221 -- is an integer or the reciprocal of an integer, and for 1222 -- implementation efficiency we need the smallest such K. 1223 1224 -- First we reduce the left fraction to lowest terms. 1225 1226 -- If denominator = 1, then for K = 1, the small ratio is an integer 1227 -- (the numerator) and this is clearly the minimum K case, so set K = 1, 1228 -- and Left_Small = Lit_Value. 1229 1230 -- If denominator > 1, then set K to the numerator of the fraction so 1231 -- that the resulting small ratio is the reciprocal of an integer (the 1232 -- numerator value). 1233 1234 procedure Do_Divide_Universal_Fixed (N : Node_Id) is 1235 Left : constant Node_Id := Left_Opnd (N); 1236 Right : constant Node_Id := Right_Opnd (N); 1237 Right_Type : constant Entity_Id := Etype (Right); 1238 Result_Type : constant Entity_Id := Etype (N); 1239 Right_Small : constant Ureal := Small_Value (Right_Type); 1240 Lit_Value : constant Ureal := Realval (Left); 1241 1242 Result_Small : Ureal; 1243 Frac : Ureal; 1244 Frac_Num : Uint; 1245 Frac_Den : Uint; 1246 Lit_K : Node_Id; 1247 Lit_Int : Node_Id; 1248 1249 begin 1250 -- Get result small. If the result is an integer, treat it as though 1251 -- it had a small of 1.0, all other processing is identical. 1252 1253 if Is_Integer_Type (Result_Type) then 1254 Result_Small := Ureal_1; 1255 else 1256 Result_Small := Small_Value (Result_Type); 1257 end if; 1258 1259 -- Determine if literal can be rewritten successfully 1260 1261 Frac := Lit_Value / (Right_Small * Result_Small); 1262 Frac_Num := Norm_Num (Frac); 1263 Frac_Den := Norm_Den (Frac); 1264 1265 -- Case where fraction is an integer (K = 1, integer = numerator). If 1266 -- this integer is not too large, this is the case where the result 1267 -- can be obtained by dividing this integer by the right operand. 1268 1269 if Frac_Den = 1 then 1270 Lit_Int := Integer_Literal (N, Frac_Num); 1271 1272 if Present (Lit_Int) then 1273 Set_Result (N, Build_Divide (N, Lit_Int, Right)); 1274 return; 1275 end if; 1276 1277 -- Case where we choose K to make the fraction the reciprocal of an 1278 -- integer (K = numerator of fraction, integer = numerator of fraction). 1279 -- If both K and the integer are small enough, this is the case where 1280 -- the result can be obtained by multiplying the right operand by K 1281 -- and then dividing by the integer value. The order of the operations 1282 -- is important (if we divided first, we would lose precision). 1283 1284 else 1285 Lit_Int := Integer_Literal (N, Frac_Den); 1286 Lit_K := Integer_Literal (N, Frac_Num); 1287 1288 if Present (Lit_Int) and then Present (Lit_K) then 1289 Set_Result (N, Build_Double_Divide (N, Lit_K, Right, Lit_Int)); 1290 return; 1291 end if; 1292 end if; 1293 1294 -- Fall through if the literal cannot be successfully rewritten, or if 1295 -- the small ratio is out of range of integer arithmetic. In the former 1296 -- case it is fine to use floating-point to get the close result set, 1297 -- and in the latter case, it means that the result is zero or raises 1298 -- constraint error, and we can do that accurately in floating-point. 1299 1300 -- If we end up using floating-point, then we take the right integer 1301 -- to be one, and its small to be the value of the original right real 1302 -- literal. That way, we need only one floating-point division. 1303 1304 Set_Result (N, 1305 Build_Divide (N, Real_Literal (N, Frac), Fpt_Value (Right))); 1306 1307 end Do_Divide_Universal_Fixed; 1308 1309 ----------------------------- 1310 -- Do_Multiply_Fixed_Fixed -- 1311 ----------------------------- 1312 1313 -- We have: 1314 1315 -- (Result_Value * Result_Small) = 1316 -- (Left_Value * Left_Small) * (Right_Value * Right_Small) 1317 1318 -- Result_Value = (Left_Value * Right_Value) * 1319 -- (Left_Small * Right_Small) / Result_Small; 1320 1321 -- we can do the operation in integer arithmetic if this fraction is an 1322 -- integer or the reciprocal of an integer, as detailed in (RM G.2.3(21)). 1323 -- Otherwise the result is in the close result set and our approach is to 1324 -- use floating-point to compute this close result. 1325 1326 procedure Do_Multiply_Fixed_Fixed (N : Node_Id) is 1327 Left : constant Node_Id := Left_Opnd (N); 1328 Right : constant Node_Id := Right_Opnd (N); 1329 1330 Left_Type : constant Entity_Id := Etype (Left); 1331 Right_Type : constant Entity_Id := Etype (Right); 1332 Result_Type : constant Entity_Id := Etype (N); 1333 Right_Small : constant Ureal := Small_Value (Right_Type); 1334 Left_Small : constant Ureal := Small_Value (Left_Type); 1335 1336 Result_Small : Ureal; 1337 Frac : Ureal; 1338 Frac_Num : Uint; 1339 Frac_Den : Uint; 1340 Lit_Int : Node_Id; 1341 1342 begin 1343 -- Get result small. If the result is an integer, treat it as though 1344 -- it had a small of 1.0, all other processing is identical. 1345 1346 if Is_Integer_Type (Result_Type) then 1347 Result_Small := Ureal_1; 1348 else 1349 Result_Small := Small_Value (Result_Type); 1350 end if; 1351 1352 -- Get small ratio 1353 1354 Frac := (Left_Small * Right_Small) / Result_Small; 1355 Frac_Num := Norm_Num (Frac); 1356 Frac_Den := Norm_Den (Frac); 1357 1358 -- If the fraction is an integer, then we get the result by multiplying 1359 -- the operands, and then multiplying the result by the integer value. 1360 1361 if Frac_Den = 1 then 1362 Lit_Int := Integer_Literal (N, Frac_Num); 1363 1364 if Present (Lit_Int) then 1365 Set_Result (N, 1366 Build_Multiply (N, Build_Multiply (N, Left, Right), 1367 Lit_Int)); 1368 return; 1369 end if; 1370 1371 -- If the fraction is the reciprocal of an integer, then we get the 1372 -- result by multiplying the operands, and then dividing the result by 1373 -- the integer value. The order of the operations is important, if we 1374 -- divided first, we would lose precision. 1375 1376 elsif Frac_Num = 1 then 1377 Lit_Int := Integer_Literal (N, Frac_Den); 1378 1379 if Present (Lit_Int) then 1380 Set_Result (N, Build_Scaled_Divide (N, Left, Right, Lit_Int)); 1381 return; 1382 end if; 1383 end if; 1384 1385 -- If we fall through, we use floating-point to compute the result 1386 1387 Set_Result (N, 1388 Build_Multiply (N, 1389 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)), 1390 Real_Literal (N, Frac))); 1391 1392 end Do_Multiply_Fixed_Fixed; 1393 1394 --------------------------------- 1395 -- Do_Multiply_Fixed_Universal -- 1396 --------------------------------- 1397 1398 -- We have: 1399 1400 -- (Result_Value * Result_Small) = (Left_Value * Left_Small) * Lit_Value; 1401 -- Result_Value = Left_Value * (Left_Small * Lit_Value) / Result_Small; 1402 1403 -- The result is required to be in the perfect result set if the literal 1404 -- can be factored so that the resulting small ratio is an integer or the 1405 -- reciprocal of an integer (RM G.2.3(21-22)). We now give a detailed 1406 -- analysis of these RM requirements: 1407 1408 -- We must factor the literal, finding an integer K: 1409 1410 -- Lit_Value = K * Right_Small 1411 -- Right_Small = Lit_Value / K 1412 1413 -- such that the small ratio: 1414 1415 -- Left_Small * (Lit_Value / K) 1416 -- ---------------------------- 1417 -- Result_Small 1418 1419 -- Left_Small * Lit_Value 1 1420 -- = ---------------------- * - 1421 -- Result_Small K 1422 1423 -- is an integer or the reciprocal of an integer, and for 1424 -- implementation efficiency we need the smallest such K. 1425 1426 -- First we reduce the left fraction to lowest terms. 1427 1428 -- If denominator = 1, then for K = 1, the small ratio is an 1429 -- integer, and this is clearly the minimum K case, so set 1430 -- K = 1, Right_Small = Lit_Value. 1431 1432 -- If denominator > 1, then set K to the numerator of the 1433 -- fraction, so that the resulting small ratio is the 1434 -- reciprocal of the integer (the denominator value). 1435 1436 procedure Do_Multiply_Fixed_Universal 1437 (N : Node_Id; 1438 Left, Right : Node_Id) 1439 is 1440 Left_Type : constant Entity_Id := Etype (Left); 1441 Result_Type : constant Entity_Id := Etype (N); 1442 Left_Small : constant Ureal := Small_Value (Left_Type); 1443 Lit_Value : constant Ureal := Realval (Right); 1444 1445 Result_Small : Ureal; 1446 Frac : Ureal; 1447 Frac_Num : Uint; 1448 Frac_Den : Uint; 1449 Lit_K : Node_Id; 1450 Lit_Int : Node_Id; 1451 1452 begin 1453 -- Get result small. If the result is an integer, treat it as though 1454 -- it had a small of 1.0, all other processing is identical. 1455 1456 if Is_Integer_Type (Result_Type) then 1457 Result_Small := Ureal_1; 1458 else 1459 Result_Small := Small_Value (Result_Type); 1460 end if; 1461 1462 -- Determine if literal can be rewritten successfully 1463 1464 Frac := (Left_Small * Lit_Value) / Result_Small; 1465 Frac_Num := Norm_Num (Frac); 1466 Frac_Den := Norm_Den (Frac); 1467 1468 -- Case where fraction is an integer (K = 1, integer = numerator). If 1469 -- this integer is not too large, this is the case where the result can 1470 -- be obtained by multiplying by this integer value. 1471 1472 if Frac_Den = 1 then 1473 Lit_Int := Integer_Literal (N, Frac_Num); 1474 1475 if Present (Lit_Int) then 1476 Set_Result (N, Build_Multiply (N, Left, Lit_Int)); 1477 return; 1478 end if; 1479 1480 -- Case where we choose K to make fraction the reciprocal of an integer 1481 -- (K = numerator of fraction, integer = denominator of fraction). If 1482 -- both K and the denominator are small enough, this is the case where 1483 -- the result can be obtained by first multiplying by K, and then 1484 -- dividing by the integer value. 1485 1486 else 1487 Lit_Int := Integer_Literal (N, Frac_Den); 1488 Lit_K := Integer_Literal (N, Frac_Num); 1489 1490 if Present (Lit_Int) and then Present (Lit_K) then 1491 Set_Result (N, Build_Scaled_Divide (N, Left, Lit_K, Lit_Int)); 1492 return; 1493 end if; 1494 end if; 1495 1496 -- Fall through if the literal cannot be successfully rewritten, or if 1497 -- the small ratio is out of range of integer arithmetic. In the former 1498 -- case it is fine to use floating-point to get the close result set, 1499 -- and in the latter case, it means that the result is zero or raises 1500 -- constraint error, and we can do that accurately in floating-point. 1501 1502 -- If we end up using floating-point, then we take the right integer 1503 -- to be one, and its small to be the value of the original right real 1504 -- literal. That way, we need only one floating-point multiplication. 1505 1506 Set_Result (N, 1507 Build_Multiply (N, Fpt_Value (Left), Real_Literal (N, Frac))); 1508 1509 end Do_Multiply_Fixed_Universal; 1510 1511 --------------------------------- 1512 -- Expand_Convert_Fixed_Static -- 1513 --------------------------------- 1514 1515 procedure Expand_Convert_Fixed_Static (N : Node_Id) is 1516 begin 1517 Rewrite (N, 1518 Convert_To (Etype (N), 1519 Make_Real_Literal (Sloc (N), Expr_Value_R (Expression (N))))); 1520 Analyze_And_Resolve (N); 1521 end Expand_Convert_Fixed_Static; 1522 1523 ----------------------------------- 1524 -- Expand_Convert_Fixed_To_Fixed -- 1525 ----------------------------------- 1526 1527 -- We have: 1528 1529 -- Result_Value * Result_Small = Source_Value * Source_Small 1530 -- Result_Value = Source_Value * (Source_Small / Result_Small) 1531 1532 -- If the small ratio (Source_Small / Result_Small) is a sufficiently small 1533 -- integer, then the perfect result set is obtained by a single integer 1534 -- multiplication. 1535 1536 -- If the small ratio is the reciprocal of a sufficiently small integer, 1537 -- then the perfect result set is obtained by a single integer division. 1538 1539 -- In other cases, we obtain the close result set by calculating the 1540 -- result in floating-point. 1541 1542 procedure Expand_Convert_Fixed_To_Fixed (N : Node_Id) is 1543 Rng_Check : constant Boolean := Do_Range_Check (N); 1544 Expr : constant Node_Id := Expression (N); 1545 Result_Type : constant Entity_Id := Etype (N); 1546 Source_Type : constant Entity_Id := Etype (Expr); 1547 Small_Ratio : Ureal; 1548 Ratio_Num : Uint; 1549 Ratio_Den : Uint; 1550 Lit : Node_Id; 1551 1552 begin 1553 if Is_OK_Static_Expression (Expr) then 1554 Expand_Convert_Fixed_Static (N); 1555 return; 1556 end if; 1557 1558 Small_Ratio := Small_Value (Source_Type) / Small_Value (Result_Type); 1559 Ratio_Num := Norm_Num (Small_Ratio); 1560 Ratio_Den := Norm_Den (Small_Ratio); 1561 1562 if Ratio_Den = 1 then 1563 1564 if Ratio_Num = 1 then 1565 Set_Result (N, Expr); 1566 return; 1567 1568 else 1569 Lit := Integer_Literal (N, Ratio_Num); 1570 1571 if Present (Lit) then 1572 Set_Result (N, Build_Multiply (N, Expr, Lit)); 1573 return; 1574 end if; 1575 end if; 1576 1577 elsif Ratio_Num = 1 then 1578 Lit := Integer_Literal (N, Ratio_Den); 1579 1580 if Present (Lit) then 1581 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check); 1582 return; 1583 end if; 1584 end if; 1585 1586 -- Fall through to use floating-point for the close result set case 1587 -- either as a result of the small ratio not being an integer or the 1588 -- reciprocal of an integer, or if the integer is out of range. 1589 1590 Set_Result (N, 1591 Build_Multiply (N, 1592 Fpt_Value (Expr), 1593 Real_Literal (N, Small_Ratio)), 1594 Rng_Check); 1595 1596 end Expand_Convert_Fixed_To_Fixed; 1597 1598 ----------------------------------- 1599 -- Expand_Convert_Fixed_To_Float -- 1600 ----------------------------------- 1601 1602 -- If the small of the fixed type is 1.0, then we simply convert the 1603 -- integer value directly to the target floating-point type, otherwise 1604 -- we first have to multiply by the small, in Long_Long_Float, and then 1605 -- convert the result to the target floating-point type. 1606 1607 procedure Expand_Convert_Fixed_To_Float (N : Node_Id) is 1608 Rng_Check : constant Boolean := Do_Range_Check (N); 1609 Expr : constant Node_Id := Expression (N); 1610 Source_Type : constant Entity_Id := Etype (Expr); 1611 Small : constant Ureal := Small_Value (Source_Type); 1612 1613 begin 1614 if Is_OK_Static_Expression (Expr) then 1615 Expand_Convert_Fixed_Static (N); 1616 return; 1617 end if; 1618 1619 if Small = Ureal_1 then 1620 Set_Result (N, Expr); 1621 1622 else 1623 Set_Result (N, 1624 Build_Multiply (N, 1625 Fpt_Value (Expr), 1626 Real_Literal (N, Small)), 1627 Rng_Check); 1628 end if; 1629 end Expand_Convert_Fixed_To_Float; 1630 1631 ------------------------------------- 1632 -- Expand_Convert_Fixed_To_Integer -- 1633 ------------------------------------- 1634 1635 -- We have: 1636 1637 -- Result_Value = Source_Value * Source_Small 1638 1639 -- If the small value is a sufficiently small integer, then the perfect 1640 -- result set is obtained by a single integer multiplication. 1641 1642 -- If the small value is the reciprocal of a sufficiently small integer, 1643 -- then the perfect result set is obtained by a single integer division. 1644 1645 -- In other cases, we obtain the close result set by calculating the 1646 -- result in floating-point. 1647 1648 procedure Expand_Convert_Fixed_To_Integer (N : Node_Id) is 1649 Rng_Check : constant Boolean := Do_Range_Check (N); 1650 Expr : constant Node_Id := Expression (N); 1651 Source_Type : constant Entity_Id := Etype (Expr); 1652 Small : constant Ureal := Small_Value (Source_Type); 1653 Small_Num : constant Uint := Norm_Num (Small); 1654 Small_Den : constant Uint := Norm_Den (Small); 1655 Lit : Node_Id; 1656 1657 begin 1658 if Is_OK_Static_Expression (Expr) then 1659 Expand_Convert_Fixed_Static (N); 1660 return; 1661 end if; 1662 1663 if Small_Den = 1 then 1664 Lit := Integer_Literal (N, Small_Num); 1665 1666 if Present (Lit) then 1667 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check); 1668 return; 1669 end if; 1670 1671 elsif Small_Num = 1 then 1672 Lit := Integer_Literal (N, Small_Den); 1673 1674 if Present (Lit) then 1675 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check); 1676 return; 1677 end if; 1678 end if; 1679 1680 -- Fall through to use floating-point for the close result set case 1681 -- either as a result of the small value not being an integer or the 1682 -- reciprocal of an integer, or if the integer is out of range. 1683 1684 Set_Result (N, 1685 Build_Multiply (N, 1686 Fpt_Value (Expr), 1687 Real_Literal (N, Small)), 1688 Rng_Check); 1689 1690 end Expand_Convert_Fixed_To_Integer; 1691 1692 ----------------------------------- 1693 -- Expand_Convert_Float_To_Fixed -- 1694 ----------------------------------- 1695 1696 -- We have 1697 1698 -- Result_Value * Result_Small = Operand_Value 1699 1700 -- so compute: 1701 1702 -- Result_Value = Operand_Value * (1.0 / Result_Small) 1703 1704 -- We do the small scaling in floating-point, and we do a multiplication 1705 -- rather than a division, since it is accurate enough for the perfect 1706 -- result cases, and faster. 1707 1708 procedure Expand_Convert_Float_To_Fixed (N : Node_Id) is 1709 Rng_Check : constant Boolean := Do_Range_Check (N); 1710 Expr : constant Node_Id := Expression (N); 1711 Result_Type : constant Entity_Id := Etype (N); 1712 Small : constant Ureal := Small_Value (Result_Type); 1713 1714 begin 1715 -- Optimize small = 1, where we can avoid the multiply completely 1716 1717 if Small = Ureal_1 then 1718 Set_Result (N, Expr, Rng_Check); 1719 1720 -- Normal case where multiply is required 1721 1722 else 1723 Set_Result (N, 1724 Build_Multiply (N, 1725 Fpt_Value (Expr), 1726 Real_Literal (N, Ureal_1 / Small)), 1727 Rng_Check); 1728 end if; 1729 end Expand_Convert_Float_To_Fixed; 1730 1731 ------------------------------------- 1732 -- Expand_Convert_Integer_To_Fixed -- 1733 ------------------------------------- 1734 1735 -- We have 1736 1737 -- Result_Value * Result_Small = Operand_Value 1738 -- Result_Value = Operand_Value / Result_Small 1739 1740 -- If the small value is a sufficiently small integer, then the perfect 1741 -- result set is obtained by a single integer division. 1742 1743 -- If the small value is the reciprocal of a sufficiently small integer, 1744 -- the perfect result set is obtained by a single integer multiplication. 1745 1746 -- In other cases, we obtain the close result set by calculating the 1747 -- result in floating-point using a multiplication by the reciprocal 1748 -- of the Result_Small. 1749 1750 procedure Expand_Convert_Integer_To_Fixed (N : Node_Id) is 1751 Rng_Check : constant Boolean := Do_Range_Check (N); 1752 Expr : constant Node_Id := Expression (N); 1753 Result_Type : constant Entity_Id := Etype (N); 1754 Small : constant Ureal := Small_Value (Result_Type); 1755 Small_Num : constant Uint := Norm_Num (Small); 1756 Small_Den : constant Uint := Norm_Den (Small); 1757 Lit : Node_Id; 1758 1759 begin 1760 if Small_Den = 1 then 1761 Lit := Integer_Literal (N, Small_Num); 1762 1763 if Present (Lit) then 1764 Set_Result (N, Build_Divide (N, Expr, Lit), Rng_Check); 1765 return; 1766 end if; 1767 1768 elsif Small_Num = 1 then 1769 Lit := Integer_Literal (N, Small_Den); 1770 1771 if Present (Lit) then 1772 Set_Result (N, Build_Multiply (N, Expr, Lit), Rng_Check); 1773 return; 1774 end if; 1775 end if; 1776 1777 -- Fall through to use floating-point for the close result set case 1778 -- either as a result of the small value not being an integer or the 1779 -- reciprocal of an integer, or if the integer is out of range. 1780 1781 Set_Result (N, 1782 Build_Multiply (N, 1783 Fpt_Value (Expr), 1784 Real_Literal (N, Ureal_1 / Small)), 1785 Rng_Check); 1786 1787 end Expand_Convert_Integer_To_Fixed; 1788 1789 -------------------------------- 1790 -- Expand_Decimal_Divide_Call -- 1791 -------------------------------- 1792 1793 -- We have four operands 1794 1795 -- Dividend 1796 -- Divisor 1797 -- Quotient 1798 -- Remainder 1799 1800 -- All of which are decimal types, and which thus have associated 1801 -- decimal scales. 1802 1803 -- Computing the quotient is a similar problem to that faced by the 1804 -- normal fixed-point division, except that it is simpler, because 1805 -- we always have compatible smalls. 1806 1807 -- Quotient = (Dividend / Divisor) * 10**q 1808 1809 -- where 10 ** q = Dividend'Small / (Divisor'Small * Quotient'Small) 1810 -- so q = Divisor'Scale + Quotient'Scale - Dividend'Scale 1811 1812 -- For q >= 0, we compute 1813 1814 -- Numerator := Dividend * 10 ** q 1815 -- Denominator := Divisor 1816 -- Quotient := Numerator / Denominator 1817 1818 -- For q < 0, we compute 1819 1820 -- Numerator := Dividend 1821 -- Denominator := Divisor * 10 ** q 1822 -- Quotient := Numerator / Denominator 1823 1824 -- Both these divisions are done in truncated mode, and the remainder 1825 -- from these divisions is used to compute the result Remainder. This 1826 -- remainder has the effective scale of the numerator of the division, 1827 1828 -- For q >= 0, the remainder scale is Dividend'Scale + q 1829 -- For q < 0, the remainder scale is Dividend'Scale 1830 1831 -- The result Remainder is then computed by a normal truncating decimal 1832 -- conversion from this scale to the scale of the remainder, i.e. by a 1833 -- division or multiplication by the appropriate power of 10. 1834 1835 procedure Expand_Decimal_Divide_Call (N : Node_Id) is 1836 Loc : constant Source_Ptr := Sloc (N); 1837 1838 Dividend : Node_Id := First_Actual (N); 1839 Divisor : Node_Id := Next_Actual (Dividend); 1840 Quotient : Node_Id := Next_Actual (Divisor); 1841 Remainder : Node_Id := Next_Actual (Quotient); 1842 1843 Dividend_Type : constant Entity_Id := Etype (Dividend); 1844 Divisor_Type : constant Entity_Id := Etype (Divisor); 1845 Quotient_Type : constant Entity_Id := Etype (Quotient); 1846 Remainder_Type : constant Entity_Id := Etype (Remainder); 1847 1848 Dividend_Scale : constant Uint := Scale_Value (Dividend_Type); 1849 Divisor_Scale : constant Uint := Scale_Value (Divisor_Type); 1850 Quotient_Scale : constant Uint := Scale_Value (Quotient_Type); 1851 Remainder_Scale : constant Uint := Scale_Value (Remainder_Type); 1852 1853 Q : Uint; 1854 Numerator_Scale : Uint; 1855 Stmts : List_Id; 1856 Qnn : Entity_Id; 1857 Rnn : Entity_Id; 1858 Computed_Remainder : Node_Id; 1859 Adjusted_Remainder : Node_Id; 1860 Scale_Adjust : Uint; 1861 1862 begin 1863 -- Relocate the operands, since they are now list elements, and we 1864 -- need to reference them separately as operands in the expanded code. 1865 1866 Dividend := Relocate_Node (Dividend); 1867 Divisor := Relocate_Node (Divisor); 1868 Quotient := Relocate_Node (Quotient); 1869 Remainder := Relocate_Node (Remainder); 1870 1871 -- Now compute Q, the adjustment scale 1872 1873 Q := Divisor_Scale + Quotient_Scale - Dividend_Scale; 1874 1875 -- If Q is non-negative then we need a scaled divide 1876 1877 if Q >= 0 then 1878 Build_Scaled_Divide_Code 1879 (N, 1880 Dividend, 1881 Integer_Literal (N, Uint_10 ** Q), 1882 Divisor, 1883 Qnn, Rnn, Stmts); 1884 1885 Numerator_Scale := Dividend_Scale + Q; 1886 1887 -- If Q is negative, then we need a double divide 1888 1889 else 1890 Build_Double_Divide_Code 1891 (N, 1892 Dividend, 1893 Divisor, 1894 Integer_Literal (N, Uint_10 ** (-Q)), 1895 Qnn, Rnn, Stmts); 1896 1897 Numerator_Scale := Dividend_Scale; 1898 end if; 1899 1900 -- Add statement to set quotient value 1901 1902 -- Quotient := quotient-type!(Qnn); 1903 1904 Append_To (Stmts, 1905 Make_Assignment_Statement (Loc, 1906 Name => Quotient, 1907 Expression => 1908 Unchecked_Convert_To (Quotient_Type, 1909 Build_Conversion (N, Quotient_Type, 1910 New_Occurrence_Of (Qnn, Loc))))); 1911 1912 -- Now we need to deal with computing and setting the remainder. The 1913 -- scale of the remainder is in Numerator_Scale, and the desired 1914 -- scale is the scale of the given Remainder argument. There are 1915 -- three cases: 1916 1917 -- Numerator_Scale > Remainder_Scale 1918 1919 -- in this case, there are extra digits in the computed remainder 1920 -- which must be eliminated by an extra division: 1921 1922 -- computed-remainder := Numerator rem Denominator 1923 -- scale_adjust = Numerator_Scale - Remainder_Scale 1924 -- adjusted-remainder := computed-remainder / 10 ** scale_adjust 1925 1926 -- Numerator_Scale = Remainder_Scale 1927 1928 -- in this case, the we have the remainder we need 1929 1930 -- computed-remainder := Numerator rem Denominator 1931 -- adjusted-remainder := computed-remainder 1932 1933 -- Numerator_Scale < Remainder_Scale 1934 1935 -- in this case, we have insufficient digits in the computed 1936 -- remainder, which must be eliminated by an extra multiply 1937 1938 -- computed-remainder := Numerator rem Denominator 1939 -- scale_adjust = Remainder_Scale - Numerator_Scale 1940 -- adjusted-remainder := computed-remainder * 10 ** scale_adjust 1941 1942 -- Finally we assign the adjusted-remainder to the result Remainder 1943 -- with conversions to get the proper fixed-point type representation. 1944 1945 Computed_Remainder := New_Occurrence_Of (Rnn, Loc); 1946 1947 if Numerator_Scale > Remainder_Scale then 1948 Scale_Adjust := Numerator_Scale - Remainder_Scale; 1949 Adjusted_Remainder := 1950 Build_Divide 1951 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust)); 1952 1953 elsif Numerator_Scale = Remainder_Scale then 1954 Adjusted_Remainder := Computed_Remainder; 1955 1956 else -- Numerator_Scale < Remainder_Scale 1957 Scale_Adjust := Remainder_Scale - Numerator_Scale; 1958 Adjusted_Remainder := 1959 Build_Multiply 1960 (N, Computed_Remainder, Integer_Literal (N, 10 ** Scale_Adjust)); 1961 end if; 1962 1963 -- Assignment of remainder result 1964 1965 Append_To (Stmts, 1966 Make_Assignment_Statement (Loc, 1967 Name => Remainder, 1968 Expression => 1969 Unchecked_Convert_To (Remainder_Type, Adjusted_Remainder))); 1970 1971 -- Final step is to rewrite the call with a block containing the 1972 -- above sequence of constructed statements for the divide operation. 1973 1974 Rewrite (N, 1975 Make_Block_Statement (Loc, 1976 Handled_Statement_Sequence => 1977 Make_Handled_Sequence_Of_Statements (Loc, 1978 Statements => Stmts))); 1979 1980 Analyze (N); 1981 1982 end Expand_Decimal_Divide_Call; 1983 1984 ----------------------------------------------- 1985 -- Expand_Divide_Fixed_By_Fixed_Giving_Fixed -- 1986 ----------------------------------------------- 1987 1988 procedure Expand_Divide_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is 1989 Left : constant Node_Id := Left_Opnd (N); 1990 Right : constant Node_Id := Right_Opnd (N); 1991 1992 begin 1993 -- Suppress expansion of a fixed-by-fixed division if the 1994 -- operation is supported directly by the target. 1995 1996 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then 1997 return; 1998 end if; 1999 2000 if Etype (Left) = Universal_Real then 2001 Do_Divide_Universal_Fixed (N); 2002 2003 elsif Etype (Right) = Universal_Real then 2004 Do_Divide_Fixed_Universal (N); 2005 2006 else 2007 Do_Divide_Fixed_Fixed (N); 2008 end if; 2009 2010 end Expand_Divide_Fixed_By_Fixed_Giving_Fixed; 2011 2012 ----------------------------------------------- 2013 -- Expand_Divide_Fixed_By_Fixed_Giving_Float -- 2014 ----------------------------------------------- 2015 2016 -- The division is done in long_long_float, and the result is multiplied 2017 -- by the small ratio, which is Small (Right) / Small (Left). Special 2018 -- treatment is required for universal operands, which represent their 2019 -- own value and do not require conversion. 2020 2021 procedure Expand_Divide_Fixed_By_Fixed_Giving_Float (N : Node_Id) is 2022 Left : constant Node_Id := Left_Opnd (N); 2023 Right : constant Node_Id := Right_Opnd (N); 2024 2025 Left_Type : constant Entity_Id := Etype (Left); 2026 Right_Type : constant Entity_Id := Etype (Right); 2027 2028 begin 2029 -- Case of left operand is universal real, the result we want is: 2030 2031 -- Left_Value / (Right_Value * Right_Small) 2032 2033 -- so we compute this as: 2034 2035 -- (Left_Value / Right_Small) / Right_Value 2036 2037 if Left_Type = Universal_Real then 2038 Set_Result (N, 2039 Build_Divide (N, 2040 Real_Literal (N, Realval (Left) / Small_Value (Right_Type)), 2041 Fpt_Value (Right))); 2042 2043 -- Case of right operand is universal real, the result we want is 2044 2045 -- (Left_Value * Left_Small) / Right_Value 2046 2047 -- so we compute this as: 2048 2049 -- Left_Value * (Left_Small / Right_Value) 2050 2051 -- Note we invert to a multiplication since usually floating-point 2052 -- multiplication is much faster than floating-point division. 2053 2054 elsif Right_Type = Universal_Real then 2055 Set_Result (N, 2056 Build_Multiply (N, 2057 Fpt_Value (Left), 2058 Real_Literal (N, Small_Value (Left_Type) / Realval (Right)))); 2059 2060 -- Both operands are fixed, so the value we want is 2061 2062 -- (Left_Value * Left_Small) / (Right_Value * Right_Small) 2063 2064 -- which we compute as: 2065 2066 -- (Left_Value / Right_Value) * (Left_Small / Right_Small) 2067 2068 else 2069 Set_Result (N, 2070 Build_Multiply (N, 2071 Build_Divide (N, Fpt_Value (Left), Fpt_Value (Right)), 2072 Real_Literal (N, 2073 Small_Value (Left_Type) / Small_Value (Right_Type)))); 2074 end if; 2075 2076 end Expand_Divide_Fixed_By_Fixed_Giving_Float; 2077 2078 ------------------------------------------------- 2079 -- Expand_Divide_Fixed_By_Fixed_Giving_Integer -- 2080 ------------------------------------------------- 2081 2082 procedure Expand_Divide_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is 2083 Left : constant Node_Id := Left_Opnd (N); 2084 Right : constant Node_Id := Right_Opnd (N); 2085 2086 begin 2087 if Etype (Left) = Universal_Real then 2088 Do_Divide_Universal_Fixed (N); 2089 2090 elsif Etype (Right) = Universal_Real then 2091 Do_Divide_Fixed_Universal (N); 2092 2093 else 2094 Do_Divide_Fixed_Fixed (N); 2095 end if; 2096 2097 end Expand_Divide_Fixed_By_Fixed_Giving_Integer; 2098 2099 ------------------------------------------------- 2100 -- Expand_Divide_Fixed_By_Integer_Giving_Fixed -- 2101 ------------------------------------------------- 2102 2103 -- Since the operand and result fixed-point type is the same, this is 2104 -- a straight divide by the right operand, the small can be ignored. 2105 2106 procedure Expand_Divide_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is 2107 Left : constant Node_Id := Left_Opnd (N); 2108 Right : constant Node_Id := Right_Opnd (N); 2109 2110 begin 2111 Set_Result (N, Build_Divide (N, Left, Right)); 2112 end Expand_Divide_Fixed_By_Integer_Giving_Fixed; 2113 2114 ------------------------------------------------- 2115 -- Expand_Multiply_Fixed_By_Fixed_Giving_Fixed -- 2116 ------------------------------------------------- 2117 2118 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Fixed (N : Node_Id) is 2119 Left : constant Node_Id := Left_Opnd (N); 2120 Right : constant Node_Id := Right_Opnd (N); 2121 2122 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id); 2123 -- The operand may be a non-static universal value, such an 2124 -- exponentiation with a non-static exponent. In that case, treat 2125 -- as a fixed * fixed multiplication, and convert the argument to 2126 -- the target fixed type. 2127 2128 procedure Rewrite_Non_Static_Universal (Opnd : Node_Id) is 2129 Loc : constant Source_Ptr := Sloc (N); 2130 2131 begin 2132 Rewrite (Opnd, 2133 Make_Type_Conversion (Loc, 2134 Subtype_Mark => New_Occurrence_Of (Etype (N), Loc), 2135 Expression => Expression (Opnd))); 2136 Analyze_And_Resolve (Opnd, Etype (N)); 2137 end Rewrite_Non_Static_Universal; 2138 2139 begin 2140 -- Suppress expansion of a fixed-by-fixed multiplication if the 2141 -- operation is supported directly by the target. 2142 2143 if Target_Has_Fixed_Ops (Etype (Left), Etype (Right), Etype (N)) then 2144 return; 2145 end if; 2146 2147 if Etype (Left) = Universal_Real then 2148 if Nkind (Left) = N_Real_Literal then 2149 Do_Multiply_Fixed_Universal (N, Right, Left); 2150 2151 elsif Nkind (Left) = N_Type_Conversion then 2152 Rewrite_Non_Static_Universal (Left); 2153 Do_Multiply_Fixed_Fixed (N); 2154 end if; 2155 2156 elsif Etype (Right) = Universal_Real then 2157 if Nkind (Right) = N_Real_Literal then 2158 Do_Multiply_Fixed_Universal (N, Left, Right); 2159 2160 elsif Nkind (Right) = N_Type_Conversion then 2161 Rewrite_Non_Static_Universal (Right); 2162 Do_Multiply_Fixed_Fixed (N); 2163 end if; 2164 2165 else 2166 Do_Multiply_Fixed_Fixed (N); 2167 end if; 2168 2169 end Expand_Multiply_Fixed_By_Fixed_Giving_Fixed; 2170 2171 ------------------------------------------------- 2172 -- Expand_Multiply_Fixed_By_Fixed_Giving_Float -- 2173 ------------------------------------------------- 2174 2175 -- The multiply is done in long_long_float, and the result is multiplied 2176 -- by the adjustment for the smalls which is Small (Right) * Small (Left). 2177 -- Special treatment is required for universal operands. 2178 2179 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Float (N : Node_Id) is 2180 Left : constant Node_Id := Left_Opnd (N); 2181 Right : constant Node_Id := Right_Opnd (N); 2182 2183 Left_Type : constant Entity_Id := Etype (Left); 2184 Right_Type : constant Entity_Id := Etype (Right); 2185 2186 begin 2187 -- Case of left operand is universal real, the result we want is 2188 2189 -- Left_Value * (Right_Value * Right_Small) 2190 2191 -- so we compute this as: 2192 2193 -- (Left_Value * Right_Small) * Right_Value; 2194 2195 if Left_Type = Universal_Real then 2196 Set_Result (N, 2197 Build_Multiply (N, 2198 Real_Literal (N, Realval (Left) * Small_Value (Right_Type)), 2199 Fpt_Value (Right))); 2200 2201 -- Case of right operand is universal real, the result we want is 2202 2203 -- (Left_Value * Left_Small) * Right_Value 2204 2205 -- so we compute this as: 2206 2207 -- Left_Value * (Left_Small * Right_Value) 2208 2209 elsif Right_Type = Universal_Real then 2210 Set_Result (N, 2211 Build_Multiply (N, 2212 Fpt_Value (Left), 2213 Real_Literal (N, Small_Value (Left_Type) * Realval (Right)))); 2214 2215 -- Both operands are fixed, so the value we want is 2216 2217 -- (Left_Value * Left_Small) * (Right_Value * Right_Small) 2218 2219 -- which we compute as: 2220 2221 -- (Left_Value * Right_Value) * (Right_Small * Left_Small) 2222 2223 else 2224 Set_Result (N, 2225 Build_Multiply (N, 2226 Build_Multiply (N, Fpt_Value (Left), Fpt_Value (Right)), 2227 Real_Literal (N, 2228 Small_Value (Right_Type) * Small_Value (Left_Type)))); 2229 end if; 2230 2231 end Expand_Multiply_Fixed_By_Fixed_Giving_Float; 2232 2233 --------------------------------------------------- 2234 -- Expand_Multiply_Fixed_By_Fixed_Giving_Integer -- 2235 --------------------------------------------------- 2236 2237 procedure Expand_Multiply_Fixed_By_Fixed_Giving_Integer (N : Node_Id) is 2238 Left : constant Node_Id := Left_Opnd (N); 2239 Right : constant Node_Id := Right_Opnd (N); 2240 2241 begin 2242 if Etype (Left) = Universal_Real then 2243 Do_Multiply_Fixed_Universal (N, Right, Left); 2244 2245 elsif Etype (Right) = Universal_Real then 2246 Do_Multiply_Fixed_Universal (N, Left, Right); 2247 2248 else 2249 Do_Multiply_Fixed_Fixed (N); 2250 end if; 2251 2252 end Expand_Multiply_Fixed_By_Fixed_Giving_Integer; 2253 2254 --------------------------------------------------- 2255 -- Expand_Multiply_Fixed_By_Integer_Giving_Fixed -- 2256 --------------------------------------------------- 2257 2258 -- Since the operand and result fixed-point type is the same, this is 2259 -- a straight multiply by the right operand, the small can be ignored. 2260 2261 procedure Expand_Multiply_Fixed_By_Integer_Giving_Fixed (N : Node_Id) is 2262 begin 2263 Set_Result (N, 2264 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N))); 2265 end Expand_Multiply_Fixed_By_Integer_Giving_Fixed; 2266 2267 --------------------------------------------------- 2268 -- Expand_Multiply_Integer_By_Fixed_Giving_Fixed -- 2269 --------------------------------------------------- 2270 2271 -- Since the operand and result fixed-point type is the same, this is 2272 -- a straight multiply by the right operand, the small can be ignored. 2273 2274 procedure Expand_Multiply_Integer_By_Fixed_Giving_Fixed (N : Node_Id) is 2275 begin 2276 Set_Result (N, 2277 Build_Multiply (N, Left_Opnd (N), Right_Opnd (N))); 2278 end Expand_Multiply_Integer_By_Fixed_Giving_Fixed; 2279 2280 --------------- 2281 -- Fpt_Value -- 2282 --------------- 2283 2284 function Fpt_Value (N : Node_Id) return Node_Id is 2285 Typ : constant Entity_Id := Etype (N); 2286 2287 begin 2288 if Is_Integer_Type (Typ) 2289 or else Is_Floating_Point_Type (Typ) 2290 then 2291 return 2292 Build_Conversion 2293 (N, Standard_Long_Long_Float, N); 2294 2295 -- Fixed-point case, must get integer value first 2296 2297 else 2298 return 2299 Build_Conversion (N, Standard_Long_Long_Float, N); 2300 end if; 2301 2302 end Fpt_Value; 2303 2304 --------------------- 2305 -- Integer_Literal -- 2306 --------------------- 2307 2308 function Integer_Literal (N : Node_Id; V : Uint) return Node_Id is 2309 T : Entity_Id; 2310 L : Node_Id; 2311 2312 begin 2313 if V < Uint_2 ** 7 then 2314 T := Standard_Integer_8; 2315 2316 elsif V < Uint_2 ** 15 then 2317 T := Standard_Integer_16; 2318 2319 elsif V < Uint_2 ** 31 then 2320 T := Standard_Integer_32; 2321 2322 elsif V < Uint_2 ** 63 then 2323 T := Standard_Integer_64; 2324 2325 else 2326 return Empty; 2327 end if; 2328 2329 L := Make_Integer_Literal (Sloc (N), V); 2330 2331 -- Set type of result in case used elsewhere (see note at start) 2332 2333 Set_Etype (L, T); 2334 Set_Is_Static_Expression (L); 2335 2336 -- We really need to set Analyzed here because we may be creating a 2337 -- very strange beast, namely an integer literal typed as fixed-point 2338 -- and the analyzer won't like that. Probably we should allow the 2339 -- Treat_Fixed_As_Integer flag to appear on integer literal nodes 2340 -- and teach the analyzer how to handle them ??? 2341 2342 Set_Analyzed (L); 2343 return L; 2344 end Integer_Literal; 2345 2346 ------------------ 2347 -- Real_Literal -- 2348 ------------------ 2349 2350 function Real_Literal (N : Node_Id; V : Ureal) return Node_Id is 2351 L : Node_Id; 2352 2353 begin 2354 L := Make_Real_Literal (Sloc (N), V); 2355 2356 -- Set type of result in case used elsewhere (see note at start) 2357 2358 Set_Etype (L, Standard_Long_Long_Float); 2359 return L; 2360 end Real_Literal; 2361 2362 ------------------------ 2363 -- Rounded_Result_Set -- 2364 ------------------------ 2365 2366 function Rounded_Result_Set (N : Node_Id) return Boolean is 2367 K : constant Node_Kind := Nkind (N); 2368 2369 begin 2370 if (K = N_Type_Conversion or else 2371 K = N_Op_Divide or else 2372 K = N_Op_Multiply) 2373 and then Rounded_Result (N) 2374 then 2375 return True; 2376 else 2377 return False; 2378 end if; 2379 end Rounded_Result_Set; 2380 2381 ---------------- 2382 -- Set_Result -- 2383 ---------------- 2384 2385 procedure Set_Result 2386 (N : Node_Id; 2387 Expr : Node_Id; 2388 Rchk : Boolean := False) 2389 is 2390 Cnode : Node_Id; 2391 2392 Expr_Type : constant Entity_Id := Etype (Expr); 2393 Result_Type : constant Entity_Id := Etype (N); 2394 2395 begin 2396 -- No conversion required if types match and no range check 2397 2398 if Result_Type = Expr_Type and then not Rchk then 2399 Cnode := Expr; 2400 2401 -- Else perform required conversion 2402 2403 else 2404 Cnode := Build_Conversion (N, Result_Type, Expr, Rchk); 2405 end if; 2406 2407 Rewrite (N, Cnode); 2408 Analyze_And_Resolve (N, Result_Type); 2409 2410 end Set_Result; 2411 2412end Exp_Fixd; 2413