1 //===-- include/flang/Evaluate/integer.h ------------------------*- C++ -*-===// 2 // 3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. 4 // See https://llvm.org/LICENSE.txt for license information. 5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception 6 // 7 //===----------------------------------------------------------------------===// 8 9 #ifndef FORTRAN_EVALUATE_INTEGER_H_ 10 #define FORTRAN_EVALUATE_INTEGER_H_ 11 12 // Emulates binary integers of an arbitrary (but fixed) bit size for use 13 // when the host C++ environment does not support that size or when the 14 // full suite of Fortran's integer intrinsic scalar functions are needed. 15 // The data model is typeless, so signed* and unsigned operations 16 // are distinguished from each other with distinct member function interfaces. 17 // (*"Signed" here means two's-complement, just to be clear. Ones'-complement 18 // and signed-magnitude encodings appear to be extinct in 2018.) 19 20 #include "flang/Common/bit-population-count.h" 21 #include "flang/Common/leading-zero-bit-count.h" 22 #include "flang/Evaluate/common.h" 23 #include <cinttypes> 24 #include <climits> 25 #include <cstddef> 26 #include <cstdint> 27 #include <string> 28 #include <type_traits> 29 30 // Some environments, viz. clang on Darwin, allow the macro HUGE 31 // to leak out of <math.h> even when it is never directly included. 32 #undef HUGE 33 34 namespace Fortran::evaluate::value { 35 36 // Implements an integer as an assembly of smaller host integer parts 37 // that constitute the digits of a large-radix fixed-point number. 38 // For best performance, the type of these parts should be half of the 39 // size of the largest efficient integer supported by the host processor. 40 // These parts are stored in either little- or big-endian order, which can 41 // match that of the host's endianness or not; but if the ordering matches 42 // that of the host, raw host data can be overlaid with a properly configured 43 // instance of this class and used in situ. 44 // To facilitate exhaustive testing of what would otherwise be more rare 45 // edge cases, this class template may be configured to use other part 46 // types &/or partial fields in the parts. The radix (i.e., the number 47 // of possible values in a part), however, must be a power of two; this 48 // template class is not generalized to enable, say, decimal arithmetic. 49 // Member functions that correspond to Fortran intrinsic functions are 50 // named accordingly in ALL CAPS so that they can be referenced easily in 51 // the language standard. 52 template <int BITS, bool IS_LITTLE_ENDIAN = isHostLittleEndian, 53 int PARTBITS = BITS <= 32 ? BITS : 32, 54 typename PART = HostUnsignedInt<PARTBITS>, 55 typename BIGPART = HostUnsignedInt<PARTBITS * 2>> 56 class Integer { 57 public: 58 static constexpr int bits{BITS}; 59 static constexpr int partBits{PARTBITS}; 60 using Part = PART; 61 using BigPart = BIGPART; 62 static_assert(std::is_integral_v<Part>); 63 static_assert(std::is_unsigned_v<Part>); 64 static_assert(std::is_integral_v<BigPart>); 65 static_assert(std::is_unsigned_v<BigPart>); 66 static_assert(CHAR_BIT * sizeof(BigPart) >= 2 * partBits); 67 static constexpr bool littleEndian{IS_LITTLE_ENDIAN}; 68 69 private: 70 static constexpr int maxPartBits{CHAR_BIT * sizeof(Part)}; 71 static_assert(partBits > 0 && partBits <= maxPartBits); 72 static constexpr int extraPartBits{maxPartBits - partBits}; 73 static constexpr int parts{(bits + partBits - 1) / partBits}; 74 static_assert(parts >= 1); 75 static constexpr int extraTopPartBits{ 76 extraPartBits + (parts * partBits) - bits}; 77 static constexpr int topPartBits{maxPartBits - extraTopPartBits}; 78 static_assert(topPartBits > 0 && topPartBits <= partBits); 79 static_assert((parts - 1) * partBits + topPartBits == bits); 80 static constexpr Part partMask{static_cast<Part>(~0) >> extraPartBits}; 81 static constexpr Part topPartMask{static_cast<Part>(~0) >> extraTopPartBits}; 82 83 public: 84 // Some types used for member function results 85 struct ValueWithOverflow { 86 Integer value; 87 bool overflow; 88 }; 89 90 struct ValueWithCarry { 91 Integer value; 92 bool carry; 93 }; 94 95 struct Product { SignedMultiplicationOverflowedProduct96 bool SignedMultiplicationOverflowed() const { 97 return lower.IsNegative() ? (upper.POPCNT() != bits) : !upper.IsZero(); 98 } 99 Integer upper, lower; 100 }; 101 102 struct QuotientWithRemainder { 103 Integer quotient, remainder; 104 bool divisionByZero, overflow; 105 }; 106 107 struct PowerWithErrors { 108 Integer power; 109 bool divisionByZero{false}, overflow{false}, zeroToZero{false}; 110 }; 111 112 // Constructors and value-generating static functions Integer()113 constexpr Integer() { Clear(); } // default constructor: zero 114 constexpr Integer(const Integer &) = default; 115 constexpr Integer(Integer &&) = default; 116 117 // C++'s integral types can all be converted to Integer 118 // with silent truncation. 119 template <typename INT, typename = std::enable_if_t<std::is_integral_v<INT>>> Integer(INT n)120 constexpr Integer(INT n) { 121 constexpr int nBits = CHAR_BIT * sizeof n; 122 if constexpr (nBits < partBits) { 123 if constexpr (std::is_unsigned_v<INT>) { 124 // Zero-extend an unsigned smaller value. 125 SetLEPart(0, n); 126 for (int j{1}; j < parts; ++j) { 127 SetLEPart(j, 0); 128 } 129 } else { 130 // n has a signed type smaller than the usable 131 // bits in a Part. 132 // Avoid conversions that change both size and sign. 133 using SignedPart = std::make_signed_t<Part>; 134 Part p = static_cast<SignedPart>(n); 135 SetLEPart(0, p); 136 if constexpr (parts > 1) { 137 Part signExtension = static_cast<SignedPart>(-(n < 0)); 138 for (int j{1}; j < parts; ++j) { 139 SetLEPart(j, signExtension); 140 } 141 } 142 } 143 } else { 144 // n has some integral type no smaller than the usable 145 // bits in a Part. 146 // Ensure that all shifts are smaller than a whole word. 147 if constexpr (std::is_unsigned_v<INT>) { 148 for (int j{0}; j < parts; ++j) { 149 SetLEPart(j, static_cast<Part>(n)); 150 if constexpr (nBits > partBits) { 151 n >>= partBits; 152 } else { 153 n = 0; 154 } 155 } 156 } else { 157 INT signExtension{-(n < 0)}; 158 static_assert(nBits >= partBits); 159 if constexpr (nBits > partBits) { 160 signExtension <<= nBits - partBits; 161 for (int j{0}; j < parts; ++j) { 162 SetLEPart(j, static_cast<Part>(n)); 163 n >>= partBits; 164 n |= signExtension; 165 } 166 } else { 167 SetLEPart(0, static_cast<Part>(n)); 168 for (int j{1}; j < parts; ++j) { 169 SetLEPart(j, static_cast<Part>(signExtension)); 170 } 171 } 172 } 173 } 174 } 175 176 constexpr Integer &operator=(const Integer &) = default; 177 178 constexpr bool operator<(const Integer &that) const { 179 return CompareSigned(that) == Ordering::Less; 180 } 181 constexpr bool operator<=(const Integer &that) const { 182 return CompareSigned(that) != Ordering::Greater; 183 } 184 constexpr bool operator==(const Integer &that) const { 185 return CompareSigned(that) == Ordering::Equal; 186 } 187 constexpr bool operator!=(const Integer &that) const { 188 return !(*this == that); 189 } 190 constexpr bool operator>=(const Integer &that) const { 191 return CompareSigned(that) != Ordering::Less; 192 } 193 constexpr bool operator>(const Integer &that) const { 194 return CompareSigned(that) == Ordering::Greater; 195 } 196 197 // Left-justified mask (e.g., MASKL(1) has only its sign bit set) MASKL(int places)198 static constexpr Integer MASKL(int places) { 199 if (places <= 0) { 200 return {}; 201 } else if (places >= bits) { 202 return MASKR(bits); 203 } else { 204 return MASKR(bits - places).NOT(); 205 } 206 } 207 208 // Right-justified mask (e.g., MASKR(1) == 1, MASKR(2) == 3, &c.) MASKR(int places)209 static constexpr Integer MASKR(int places) { 210 Integer result{nullptr}; 211 int j{0}; 212 for (; j + 1 < parts && places >= partBits; ++j, places -= partBits) { 213 result.LEPart(j) = partMask; 214 } 215 if (places > 0) { 216 if (j + 1 < parts) { 217 result.LEPart(j++) = partMask >> (partBits - places); 218 } else if (j + 1 == parts) { 219 if (places >= topPartBits) { 220 result.LEPart(j++) = topPartMask; 221 } else { 222 result.LEPart(j++) = topPartMask >> (topPartBits - places); 223 } 224 } 225 } 226 for (; j < parts; ++j) { 227 result.LEPart(j) = 0; 228 } 229 return result; 230 } 231 232 static constexpr ValueWithOverflow Read( 233 const char *&pp, std::uint64_t base = 10, bool isSigned = false) { 234 Integer result; 235 bool overflow{false}; 236 const char *p{pp}; 237 while (*p == ' ' || *p == '\t') { 238 ++p; 239 } 240 bool negate{*p == '-'}; 241 if (negate || *p == '+') { 242 while (*++p == ' ' || *p == '\t') { 243 } 244 } 245 Integer radix{base}; 246 // This code makes assumptions about local contiguity in regions of the 247 // character set and only works up to base 36. These assumptions hold 248 // for all current combinations of surviving character sets (ASCII, UTF-8, 249 // EBCDIC) and the bases used in Fortran source and formatted I/O 250 // (viz., 2, 8, 10, & 16). But: management thought that a disclaimer 251 // might be needed here to warn future users of this code about these 252 // assumptions, so here you go, future programmer in some postapocalyptic 253 // hellscape, and best of luck with the inexorable killer robots. 254 for (; std::uint64_t digit = *p; ++p) { 255 if (digit >= '0' && digit <= '9' && digit < '0' + base) { 256 digit -= '0'; 257 } else if (base > 10 && digit >= 'A' && digit < 'A' + base - 10) { 258 digit -= 'A' - 10; 259 } else if (base > 10 && digit >= 'a' && digit < 'a' + base - 10) { 260 digit -= 'a' - 10; 261 } else { 262 break; 263 } 264 Product shifted{result.MultiplyUnsigned(radix)}; 265 overflow |= !shifted.upper.IsZero(); 266 ValueWithCarry next{shifted.lower.AddUnsigned(Integer{digit})}; 267 overflow |= next.carry; 268 result = next.value; 269 } 270 pp = p; 271 if (negate) { 272 result = result.Negate().value; 273 overflow |= isSigned && !result.IsNegative() && !result.IsZero(); 274 } else { 275 overflow |= isSigned && result.IsNegative(); 276 } 277 return {result, overflow}; 278 } 279 280 template <typename FROM> ConvertUnsigned(const FROM & that)281 static constexpr ValueWithOverflow ConvertUnsigned(const FROM &that) { 282 std::uint64_t field{that.ToUInt64()}; 283 ValueWithOverflow result{field, false}; 284 if constexpr (bits < 64) { 285 result.overflow = (field >> bits) != 0; 286 } 287 for (int j{64}; j < that.bits && !result.overflow; j += 64) { 288 field = that.SHIFTR(j).ToUInt64(); 289 if (bits <= j) { 290 result.overflow = field != 0; 291 } else { 292 result.value = result.value.IOR(Integer{field}.SHIFTL(j)); 293 if (bits < j + 64) { 294 result.overflow = (field >> (bits - j)) != 0; 295 } 296 } 297 } 298 return result; 299 } 300 301 template <typename FROM> ConvertSigned(const FROM & that)302 static constexpr ValueWithOverflow ConvertSigned(const FROM &that) { 303 ValueWithOverflow result{ConvertUnsigned(that)}; 304 if constexpr (bits > FROM::bits) { 305 if (that.IsNegative()) { 306 result.value = result.value.IOR(MASKL(bits - FROM::bits)); 307 } 308 result.overflow = false; 309 } else if constexpr (bits < FROM::bits) { 310 auto back{FROM::template ConvertSigned(result.value)}; 311 result.overflow = back.value.CompareUnsigned(that) != Ordering::Equal; 312 } 313 return result; 314 } 315 UnsignedDecimal()316 std::string UnsignedDecimal() const { 317 if constexpr (bits < 4) { 318 char digit = '0' + ToUInt64(); 319 return {digit}; 320 } else if (IsZero()) { 321 return {'0'}; 322 } else { 323 QuotientWithRemainder qr{DivideUnsigned(10)}; 324 char digit = '0' + qr.remainder.ToUInt64(); 325 if (qr.quotient.IsZero()) { 326 return {digit}; 327 } else { 328 return qr.quotient.UnsignedDecimal() + digit; 329 } 330 } 331 } 332 SignedDecimal()333 std::string SignedDecimal() const { 334 if (IsNegative()) { 335 return std::string{'-'} + Negate().value.UnsignedDecimal(); 336 } else { 337 return UnsignedDecimal(); 338 } 339 } 340 341 // Omits a leading "0x". Hexadecimal()342 std::string Hexadecimal() const { 343 std::string result; 344 int digits{(bits + 3) >> 2}; 345 for (int j{0}; j < digits; ++j) { 346 int pos{(digits - 1 - j) * 4}; 347 char nybble = IBITS(pos, 4).ToUInt64(); 348 if (nybble != 0 || !result.empty() || j + 1 == digits) { 349 char digit = '0' + nybble; 350 if (digit > '9') { 351 digit += 'a' - ('9' + 1); 352 } 353 result += digit; 354 } 355 } 356 return result; 357 } 358 359 static constexpr int DIGITS{bits - 1}; // don't count the sign bit HUGE()360 static constexpr Integer HUGE() { return MASKR(bits - 1); } 361 static constexpr int RANGE{// in the sense of SELECTED_INT_KIND 362 // This magic value is LOG10(2.)*1E12. 363 static_cast<int>(((bits - 1) * 301029995664) / 1000000000000)}; 364 IsZero()365 constexpr bool IsZero() const { 366 for (int j{0}; j < parts; ++j) { 367 if (part_[j] != 0) { 368 return false; 369 } 370 } 371 return true; 372 } 373 IsNegative()374 constexpr bool IsNegative() const { 375 return (LEPart(parts - 1) >> (topPartBits - 1)) & 1; 376 } 377 CompareToZeroSigned()378 constexpr Ordering CompareToZeroSigned() const { 379 if (IsNegative()) { 380 return Ordering::Less; 381 } else if (IsZero()) { 382 return Ordering::Equal; 383 } else { 384 return Ordering::Greater; 385 } 386 } 387 388 // Count the number of contiguous most-significant bit positions 389 // that are clear. LEADZ()390 constexpr int LEADZ() const { 391 if (LEPart(parts - 1) != 0) { 392 int lzbc{common::LeadingZeroBitCount(LEPart(parts - 1))}; 393 return lzbc - extraTopPartBits; 394 } 395 int upperZeroes{topPartBits}; 396 for (int j{1}; j < parts; ++j) { 397 if (Part p{LEPart(parts - 1 - j)}) { 398 int lzbc{common::LeadingZeroBitCount(p)}; 399 return upperZeroes + lzbc - extraPartBits; 400 } 401 upperZeroes += partBits; 402 } 403 return bits; 404 } 405 406 // Count the number of bit positions that are set. POPCNT()407 constexpr int POPCNT() const { 408 int count{0}; 409 for (int j{0}; j < parts; ++j) { 410 count += common::BitPopulationCount(part_[j]); 411 } 412 return count; 413 } 414 415 // True when POPCNT is odd. POPPAR()416 constexpr bool POPPAR() const { return POPCNT() & 1; } 417 TRAILZ()418 constexpr int TRAILZ() const { 419 auto minus1{AddUnsigned(MASKR(bits))}; // { x-1, carry = x > 0 } 420 if (!minus1.carry) { 421 return bits; // was zero 422 } else { 423 // x ^ (x-1) has all bits set at and below original least-order set bit. 424 return IEOR(minus1.value).POPCNT() - 1; 425 } 426 } 427 BTEST(int pos)428 constexpr bool BTEST(int pos) const { 429 if (pos < 0 || pos >= bits) { 430 return false; 431 } else { 432 return (LEPart(pos / partBits) >> (pos % partBits)) & 1; 433 } 434 } 435 CompareUnsigned(const Integer & y)436 constexpr Ordering CompareUnsigned(const Integer &y) const { 437 for (int j{parts}; j-- > 0;) { 438 if (LEPart(j) > y.LEPart(j)) { 439 return Ordering::Greater; 440 } 441 if (LEPart(j) < y.LEPart(j)) { 442 return Ordering::Less; 443 } 444 } 445 return Ordering::Equal; 446 } 447 BGE(const Integer & y)448 constexpr bool BGE(const Integer &y) const { 449 return CompareUnsigned(y) != Ordering::Less; 450 } BGT(const Integer & y)451 constexpr bool BGT(const Integer &y) const { 452 return CompareUnsigned(y) == Ordering::Greater; 453 } BLE(const Integer & y)454 constexpr bool BLE(const Integer &y) const { return !BGT(y); } BLT(const Integer & y)455 constexpr bool BLT(const Integer &y) const { return !BGE(y); } 456 CompareSigned(const Integer & y)457 constexpr Ordering CompareSigned(const Integer &y) const { 458 bool isNegative{IsNegative()}; 459 if (isNegative != y.IsNegative()) { 460 return isNegative ? Ordering::Less : Ordering::Greater; 461 } 462 return CompareUnsigned(y); 463 } 464 ToUInt()465 template <typename UINT = std::uint64_t> constexpr UINT ToUInt() const { 466 UINT n{LEPart(0)}; 467 std::size_t filled{partBits}; 468 constexpr std::size_t maxBits{CHAR_BIT * sizeof n}; 469 for (int j{1}; filled < maxBits && j < parts; ++j, filled += partBits) { 470 n |= UINT{LEPart(j)} << filled; 471 } 472 return n; 473 } 474 475 template <typename SINT = std::int64_t, typename UINT = std::uint64_t> ToSInt()476 constexpr SINT ToSInt() const { 477 SINT n = ToUInt<UINT>(); 478 constexpr std::size_t maxBits{CHAR_BIT * sizeof n}; 479 if constexpr (bits < maxBits) { 480 n |= -(n >> (bits - 1)) << bits; 481 } 482 return n; 483 } 484 ToUInt64()485 constexpr std::uint64_t ToUInt64() const { return ToUInt<std::uint64_t>(); } 486 ToInt64()487 constexpr std::int64_t ToInt64() const { 488 return ToSInt<std::int64_t, std::uint64_t>(); 489 } 490 491 // Ones'-complement (i.e., C's ~) NOT()492 constexpr Integer NOT() const { 493 Integer result{nullptr}; 494 for (int j{0}; j < parts; ++j) { 495 result.SetLEPart(j, ~LEPart(j)); 496 } 497 return result; 498 } 499 500 // Two's-complement negation (-x = ~x + 1). 501 // An overflow flag accompanies the result, and will be true when the 502 // operand is the most negative signed number (MASKL(1)). Negate()503 constexpr ValueWithOverflow Negate() const { 504 Integer result{nullptr}; 505 Part carry{1}; 506 for (int j{0}; j + 1 < parts; ++j) { 507 Part newCarry{LEPart(j) == 0 && carry}; 508 result.SetLEPart(j, ~LEPart(j) + carry); 509 carry = newCarry; 510 } 511 Part top{LEPart(parts - 1)}; 512 result.SetLEPart(parts - 1, ~top + carry); 513 bool overflow{top != 0 && result.LEPart(parts - 1) == top}; 514 return {result, overflow}; 515 } 516 ABS()517 constexpr ValueWithOverflow ABS() const { 518 if (IsNegative()) { 519 return Negate(); 520 } else { 521 return {*this, false}; 522 } 523 } 524 525 // Shifts the operand left when the count is positive, right when negative. 526 // Vacated bit positions are filled with zeroes. ISHFT(int count)527 constexpr Integer ISHFT(int count) const { 528 if (count < 0) { 529 return SHIFTR(-count); 530 } else { 531 return SHIFTL(count); 532 } 533 } 534 535 // Left shift with zero fill. SHIFTL(int count)536 constexpr Integer SHIFTL(int count) const { 537 if (count <= 0) { 538 return *this; 539 } else { 540 Integer result{nullptr}; 541 int shiftParts{count / partBits}; 542 int bitShift{count - partBits * shiftParts}; 543 int j{parts - 1}; 544 if (bitShift == 0) { 545 for (; j >= shiftParts; --j) { 546 result.SetLEPart(j, LEPart(j - shiftParts)); 547 } 548 for (; j >= 0; --j) { 549 result.LEPart(j) = 0; 550 } 551 } else { 552 for (; j > shiftParts; --j) { 553 result.SetLEPart(j, 554 ((LEPart(j - shiftParts) << bitShift) | 555 (LEPart(j - shiftParts - 1) >> (partBits - bitShift)))); 556 } 557 if (j == shiftParts) { 558 result.SetLEPart(j, LEPart(0) << bitShift); 559 --j; 560 } 561 for (; j >= 0; --j) { 562 result.LEPart(j) = 0; 563 } 564 } 565 return result; 566 } 567 } 568 569 // Circular shift of a field of least-significant bits. The least-order 570 // "size" bits are shifted circularly in place by "count" positions; 571 // the shift is leftward if count is nonnegative, rightward otherwise. 572 // Higher-order bits are unchanged. 573 constexpr Integer ISHFTC(int count, int size = bits) const { 574 if (count == 0 || size <= 0) { 575 return *this; 576 } 577 if (size > bits) { 578 size = bits; 579 } 580 count %= size; 581 if (count == 0) { 582 return *this; 583 } 584 int middleBits{size - count}, leastBits{count}; 585 if (count < 0) { 586 middleBits = -count; 587 leastBits = size + count; 588 } 589 if (size == bits) { 590 return SHIFTL(leastBits).IOR(SHIFTR(middleBits)); 591 } 592 Integer unchanged{IAND(MASKL(bits - size))}; 593 Integer middle{IAND(MASKR(middleBits)).SHIFTL(leastBits)}; 594 Integer least{SHIFTR(middleBits).IAND(MASKR(leastBits))}; 595 return unchanged.IOR(middle).IOR(least); 596 } 597 598 // Double shifts, aka shifts with specific fill. SHIFTLWithFill(const Integer & fill,int count)599 constexpr Integer SHIFTLWithFill(const Integer &fill, int count) const { 600 if (count <= 0) { 601 return *this; 602 } else if (count >= 2 * bits) { 603 return {}; 604 } else if (count > bits) { 605 return fill.SHIFTL(count - bits); 606 } else if (count == bits) { 607 return fill; 608 } else { 609 return SHIFTL(count).IOR(fill.SHIFTR(bits - count)); 610 } 611 } 612 SHIFTRWithFill(const Integer & fill,int count)613 constexpr Integer SHIFTRWithFill(const Integer &fill, int count) const { 614 if (count <= 0) { 615 return *this; 616 } else if (count >= 2 * bits) { 617 return {}; 618 } else if (count > bits) { 619 return fill.SHIFTR(count - bits); 620 } else if (count == bits) { 621 return fill; 622 } else { 623 return SHIFTR(count).IOR(fill.SHIFTL(bits - count)); 624 } 625 } 626 DSHIFTL(const Integer & fill,int count)627 constexpr Integer DSHIFTL(const Integer &fill, int count) const { 628 // DSHIFTL(I,J) shifts I:J left; the second argument is the right fill. 629 return SHIFTLWithFill(fill, count); 630 } 631 DSHIFTR(const Integer & value,int count)632 constexpr Integer DSHIFTR(const Integer &value, int count) const { 633 // DSHIFTR(I,J) shifts I:J right; the *first* argument is the left fill. 634 return value.SHIFTRWithFill(*this, count); 635 } 636 637 // Vacated upper bits are filled with zeroes. SHIFTR(int count)638 constexpr Integer SHIFTR(int count) const { 639 if (count <= 0) { 640 return *this; 641 } else { 642 Integer result{nullptr}; 643 int shiftParts{count / partBits}; 644 int bitShift{count - partBits * shiftParts}; 645 int j{0}; 646 if (bitShift == 0) { 647 for (; j + shiftParts < parts; ++j) { 648 result.LEPart(j) = LEPart(j + shiftParts); 649 } 650 for (; j < parts; ++j) { 651 result.LEPart(j) = 0; 652 } 653 } else { 654 for (; j + shiftParts + 1 < parts; ++j) { 655 result.SetLEPart(j, 656 (LEPart(j + shiftParts) >> bitShift) | 657 (LEPart(j + shiftParts + 1) << (partBits - bitShift))); 658 } 659 if (j + shiftParts + 1 == parts) { 660 result.LEPart(j++) = LEPart(parts - 1) >> bitShift; 661 } 662 for (; j < parts; ++j) { 663 result.LEPart(j) = 0; 664 } 665 } 666 return result; 667 } 668 } 669 670 // Be advised, an arithmetic (sign-filling) right shift is not 671 // the same as a division by a power of two in all cases. SHIFTA(int count)672 constexpr Integer SHIFTA(int count) const { 673 if (count <= 0) { 674 return *this; 675 } else if (IsNegative()) { 676 return SHIFTR(count).IOR(MASKL(count)); 677 } else { 678 return SHIFTR(count); 679 } 680 } 681 682 // Clears a single bit. IBCLR(int pos)683 constexpr Integer IBCLR(int pos) const { 684 if (pos < 0 || pos >= bits) { 685 return *this; 686 } else { 687 Integer result{*this}; 688 result.LEPart(pos / partBits) &= ~(Part{1} << (pos % partBits)); 689 return result; 690 } 691 } 692 693 // Sets a single bit. IBSET(int pos)694 constexpr Integer IBSET(int pos) const { 695 if (pos < 0 || pos >= bits) { 696 return *this; 697 } else { 698 Integer result{*this}; 699 result.LEPart(pos / partBits) |= Part{1} << (pos % partBits); 700 return result; 701 } 702 } 703 704 // Extracts a field. IBITS(int pos,int size)705 constexpr Integer IBITS(int pos, int size) const { 706 return SHIFTR(pos).IAND(MASKR(size)); 707 } 708 IAND(const Integer & y)709 constexpr Integer IAND(const Integer &y) const { 710 Integer result{nullptr}; 711 for (int j{0}; j < parts; ++j) { 712 result.LEPart(j) = LEPart(j) & y.LEPart(j); 713 } 714 return result; 715 } 716 IOR(const Integer & y)717 constexpr Integer IOR(const Integer &y) const { 718 Integer result{nullptr}; 719 for (int j{0}; j < parts; ++j) { 720 result.LEPart(j) = LEPart(j) | y.LEPart(j); 721 } 722 return result; 723 } 724 IEOR(const Integer & y)725 constexpr Integer IEOR(const Integer &y) const { 726 Integer result{nullptr}; 727 for (int j{0}; j < parts; ++j) { 728 result.LEPart(j) = LEPart(j) ^ y.LEPart(j); 729 } 730 return result; 731 } 732 MERGE_BITS(const Integer & y,const Integer & mask)733 constexpr Integer MERGE_BITS(const Integer &y, const Integer &mask) const { 734 return IAND(mask).IOR(y.IAND(mask.NOT())); 735 } 736 MAX(const Integer & y)737 constexpr Integer MAX(const Integer &y) const { 738 if (CompareSigned(y) == Ordering::Less) { 739 return y; 740 } else { 741 return *this; 742 } 743 } 744 MIN(const Integer & y)745 constexpr Integer MIN(const Integer &y) const { 746 if (CompareSigned(y) == Ordering::Less) { 747 return *this; 748 } else { 749 return y; 750 } 751 } 752 753 // Unsigned addition with carry. 754 constexpr ValueWithCarry AddUnsigned( 755 const Integer &y, bool carryIn = false) const { 756 Integer sum{nullptr}; 757 BigPart carry{carryIn}; 758 for (int j{0}; j + 1 < parts; ++j) { 759 carry += LEPart(j); 760 carry += y.LEPart(j); 761 sum.SetLEPart(j, carry); 762 carry >>= partBits; 763 } 764 carry += LEPart(parts - 1); 765 carry += y.LEPart(parts - 1); 766 sum.SetLEPart(parts - 1, carry); 767 return {sum, carry > topPartMask}; 768 } 769 AddSigned(const Integer & y)770 constexpr ValueWithOverflow AddSigned(const Integer &y) const { 771 bool isNegative{IsNegative()}; 772 bool sameSign{isNegative == y.IsNegative()}; 773 ValueWithCarry sum{AddUnsigned(y)}; 774 bool overflow{sameSign && sum.value.IsNegative() != isNegative}; 775 return {sum.value, overflow}; 776 } 777 SubtractSigned(const Integer & y)778 constexpr ValueWithOverflow SubtractSigned(const Integer &y) const { 779 bool isNegative{IsNegative()}; 780 bool sameSign{isNegative == y.IsNegative()}; 781 ValueWithCarry diff{AddUnsigned(y.Negate().value)}; 782 bool overflow{!sameSign && diff.value.IsNegative() != isNegative}; 783 return {diff.value, overflow}; 784 } 785 786 // MAX(X-Y, 0) DIM(const Integer & y)787 constexpr Integer DIM(const Integer &y) const { 788 if (CompareSigned(y) != Ordering::Greater) { 789 return {}; 790 } else { 791 return SubtractSigned(y).value; 792 } 793 } 794 SIGN(bool toNegative)795 constexpr ValueWithOverflow SIGN(bool toNegative) const { 796 if (toNegative == IsNegative()) { 797 return {*this, false}; 798 } else if (toNegative) { 799 return Negate(); 800 } else { 801 return ABS(); 802 } 803 } 804 SIGN(const Integer & sign)805 constexpr ValueWithOverflow SIGN(const Integer &sign) const { 806 return SIGN(sign.IsNegative()); 807 } 808 MultiplyUnsigned(const Integer & y)809 constexpr Product MultiplyUnsigned(const Integer &y) const { 810 Part product[2 * parts]{}; // little-endian full product 811 for (int j{0}; j < parts; ++j) { 812 if (Part xpart{LEPart(j)}) { 813 for (int k{0}; k < parts; ++k) { 814 if (Part ypart{y.LEPart(k)}) { 815 BigPart xy{xpart}; 816 xy *= ypart; 817 #if defined __GNUC__ && __GNUC__ < 8 818 // && to < (2 * parts) was added to avoid GCC < 8 build failure on 819 // -Werror=array-bounds. This can be removed if -Werror is disable. 820 for (int to{j + k}; xy != 0 && to < (2 * parts); ++to) { 821 #else 822 for (int to{j + k}; xy != 0; ++to) { 823 #endif 824 xy += product[to]; 825 product[to] = xy & partMask; 826 xy >>= partBits; 827 } 828 } 829 } 830 } 831 } 832 Integer upper{nullptr}, lower{nullptr}; 833 for (int j{0}; j < parts; ++j) { 834 lower.LEPart(j) = product[j]; 835 upper.LEPart(j) = product[j + parts]; 836 } 837 if constexpr (topPartBits < partBits) { 838 upper = upper.SHIFTL(partBits - topPartBits); 839 upper.LEPart(0) |= lower.LEPart(parts - 1) >> topPartBits; 840 lower.LEPart(parts - 1) &= topPartMask; 841 } 842 return {upper, lower}; 843 } 844 845 constexpr Product MultiplySigned(const Integer &y) const { 846 bool yIsNegative{y.IsNegative()}; 847 Integer absy{y}; 848 if (yIsNegative) { 849 absy = y.Negate().value; 850 } 851 bool isNegative{IsNegative()}; 852 Integer absx{*this}; 853 if (isNegative) { 854 absx = Negate().value; 855 } 856 Product product{absx.MultiplyUnsigned(absy)}; 857 if (isNegative != yIsNegative) { 858 product.lower = product.lower.NOT(); 859 product.upper = product.upper.NOT(); 860 Integer one{1}; 861 auto incremented{product.lower.AddUnsigned(one)}; 862 product.lower = incremented.value; 863 if (incremented.carry) { 864 product.upper = product.upper.AddUnsigned(one).value; 865 } 866 } 867 return product; 868 } 869 870 constexpr QuotientWithRemainder DivideUnsigned(const Integer &divisor) const { 871 if (divisor.IsZero()) { 872 return {MASKR(bits), Integer{}, true, false}; // overflow to max value 873 } 874 int bitsDone{LEADZ()}; 875 Integer top{SHIFTL(bitsDone)}; 876 Integer quotient, remainder; 877 for (; bitsDone < bits; ++bitsDone) { 878 auto doubledTop{top.AddUnsigned(top)}; 879 top = doubledTop.value; 880 remainder = remainder.AddUnsigned(remainder, doubledTop.carry).value; 881 bool nextBit{remainder.CompareUnsigned(divisor) != Ordering::Less}; 882 quotient = quotient.AddUnsigned(quotient, nextBit).value; 883 if (nextBit) { 884 remainder = remainder.SubtractSigned(divisor).value; 885 } 886 } 887 return {quotient, remainder, false, false}; 888 } 889 890 // A nonzero remainder has the sign of the dividend, i.e., it computes 891 // the MOD intrinsic (X-INT(X/Y)*Y), not MODULO (which is below). 892 // 8/5 = 1r3; -8/5 = -1r-3; 8/-5 = -1r3; -8/-5 = 1r-3 893 constexpr QuotientWithRemainder DivideSigned(Integer divisor) const { 894 bool dividendIsNegative{IsNegative()}; 895 bool negateQuotient{dividendIsNegative}; 896 Ordering divisorOrdering{divisor.CompareToZeroSigned()}; 897 if (divisorOrdering == Ordering::Less) { 898 negateQuotient = !negateQuotient; 899 auto negated{divisor.Negate()}; 900 if (negated.overflow) { 901 // divisor was (and is) the most negative number 902 if (CompareUnsigned(divisor) == Ordering::Equal) { 903 return {MASKR(1), Integer{}, false, bits <= 1}; 904 } else { 905 return {Integer{}, *this, false, false}; 906 } 907 } 908 divisor = negated.value; 909 } else if (divisorOrdering == Ordering::Equal) { 910 // division by zero 911 if (dividendIsNegative) { 912 return {MASKL(1), Integer{}, true, false}; 913 } else { 914 return {MASKR(bits - 1), Integer{}, true, false}; 915 } 916 } 917 Integer dividend{*this}; 918 if (dividendIsNegative) { 919 auto negated{Negate()}; 920 if (negated.overflow) { 921 // Dividend was (and remains) the most negative number. 922 // See whether the original divisor was -1 (if so, it's 1 now). 923 if (divisorOrdering == Ordering::Less && 924 divisor.CompareUnsigned(Integer{1}) == Ordering::Equal) { 925 // most negative number / -1 is the sole overflow case 926 return {*this, Integer{}, false, true}; 927 } 928 } else { 929 dividend = negated.value; 930 } 931 } 932 // Overflow is not possible, and both the dividend and divisor 933 // are now positive. 934 QuotientWithRemainder result{dividend.DivideUnsigned(divisor)}; 935 if (negateQuotient) { 936 result.quotient = result.quotient.Negate().value; 937 } 938 if (dividendIsNegative) { 939 result.remainder = result.remainder.Negate().value; 940 } 941 return result; 942 } 943 944 // Result has the sign of the divisor argument. 945 // 8 mod 5 = 3; -8 mod 5 = 2; 8 mod -5 = -2; -8 mod -5 = -3 946 constexpr ValueWithOverflow MODULO(const Integer &divisor) const { 947 bool negativeDivisor{divisor.IsNegative()}; 948 bool distinctSigns{IsNegative() != negativeDivisor}; 949 QuotientWithRemainder divided{DivideSigned(divisor)}; 950 if (distinctSigns && !divided.remainder.IsZero()) { 951 return {divided.remainder.AddUnsigned(divisor).value, divided.overflow}; 952 } else { 953 return {divided.remainder, divided.overflow}; 954 } 955 } 956 957 constexpr PowerWithErrors Power(const Integer &exponent) const { 958 PowerWithErrors result{1, false, false, false}; 959 if (exponent.IsZero()) { 960 // x**0 -> 1, including the case 0**0, which is not defined specifically 961 // in F'18 afaict; however, other Fortrans tested all produce 1, not 0, 962 // apart from nagfor, which stops with an error at runtime. 963 // Ada, APL, C's pow(), Haskell, Julia, MATLAB, and R all produce 1 too. 964 // F'77 explicitly states that 0**0 is mathematically undefined and 965 // therefore prohibited. 966 result.zeroToZero = IsZero(); 967 } else if (exponent.IsNegative()) { 968 if (IsZero()) { 969 result.divisionByZero = true; 970 result.power = MASKR(bits - 1); 971 } else if (CompareSigned(Integer{1}) == Ordering::Equal) { 972 result.power = *this; // 1**x -> 1 973 } else if (CompareSigned(Integer{-1}) == Ordering::Equal) { 974 if (exponent.BTEST(0)) { 975 result.power = *this; // (-1)**x -> -1 if x is odd 976 } 977 } else { 978 result.power.Clear(); // j**k -> 0 if |j| > 1 and k < 0 979 } 980 } else { 981 Integer shifted{*this}; 982 Integer pow{exponent}; 983 int nbits{bits - pow.LEADZ()}; 984 for (int j{0}; j < nbits; ++j) { 985 if (pow.BTEST(j)) { 986 Product product{result.power.MultiplySigned(shifted)}; 987 result.power = product.lower; 988 result.overflow |= product.SignedMultiplicationOverflowed(); 989 } 990 if (j + 1 < nbits) { 991 Product squared{shifted.MultiplySigned(shifted)}; 992 result.overflow |= squared.SignedMultiplicationOverflowed(); 993 shifted = squared.lower; 994 } 995 } 996 } 997 return result; 998 } 999 1000 private: 1001 // A private constructor, selected by the use of nullptr, 1002 // that is used by member functions when it would be a waste 1003 // of time to initialize parts_[]. 1004 constexpr Integer(std::nullptr_t) {} 1005 1006 // Accesses parts in little-endian order. 1007 constexpr const Part &LEPart(int part) const { 1008 if constexpr (littleEndian) { 1009 return part_[part]; 1010 } else { 1011 return part_[parts - 1 - part]; 1012 } 1013 } 1014 1015 constexpr Part &LEPart(int part) { 1016 if constexpr (littleEndian) { 1017 return part_[part]; 1018 } else { 1019 return part_[parts - 1 - part]; 1020 } 1021 } 1022 1023 constexpr void SetLEPart(int part, Part x) { 1024 LEPart(part) = x & PartMask(part); 1025 } 1026 1027 static constexpr Part PartMask(int part) { 1028 return part == parts - 1 ? topPartMask : partMask; 1029 } 1030 1031 constexpr void Clear() { 1032 for (int j{0}; j < parts; ++j) { 1033 part_[j] = 0; 1034 } 1035 } 1036 1037 Part part_[parts]{}; 1038 }; 1039 1040 extern template class Integer<8>; 1041 extern template class Integer<16>; 1042 extern template class Integer<32>; 1043 extern template class Integer<64>; 1044 extern template class Integer<80>; 1045 extern template class Integer<128>; 1046 } // namespace Fortran::evaluate::value 1047 #endif // FORTRAN_EVALUATE_INTEGER_H_ 1048