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