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