#include "big-radix-floating-point.h"
#include "flang/Common/bit-population-count.h"
#include "flang/Common/leading-zero-bit-count.h"
#include "flang/Decimal/binary-floating-point.h"
#include "flang/Decimal/decimal.h"
#include "flang/Runtime/freestanding-tools.h"
#include <cinttypes>
#include <cstring>
#include <utility>
#undef HUGE
namespace Fortran::decimal {
template <int PREC, int LOG10RADIX>
bool BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ParseNumber(
const char *&p, bool &inexact, const char *end) {
SetToZero();
if (end && p >= end) {
return false;
}
for (; p != end && *p == ' '; ++p) {
}
if (p == end) {
return false;
}
const char *q{p};
isNegative_ = *q == '-';
if (*q == '-' || *q == '+') {
++q;
}
const char *start{q};
for (; q != end && *q == '0'; ++q) {
}
const char *firstDigit{q};
for (; q != end && *q >= '0' && *q <= '9'; ++q) {
}
const char *point{nullptr};
if (q != end && *q == '.') {
point = q;
for (++q; q != end && *q >= '0' && *q <= '9'; ++q) {
}
}
if (q == start || (q == start + 1 && start == point)) {
return false;
}
p = q;
if (point) {
while (q[-1] == '0') {
--q;
}
if (q[-1] == '.') {
point = nullptr;
--q;
}
}
if (!point) {
while (q > firstDigit && q[-1] == '0') {
--q;
++exponent_;
}
}
const char *limit{firstDigit + maxDigits * log10Radix + (point != nullptr)};
if (q > limit) {
inexact = true;
if (point >= limit) {
q = point;
point = nullptr;
}
if (!point) {
exponent_ += q - limit;
}
q = limit;
}
if (point) {
exponent_ -= static_cast<int>(q - point - 1);
}
if (q == firstDigit) {
exponent_ = 0;
}
for (auto times{radix}; q-- > firstDigit;) {
if (*q != '.') {
if (times == radix) {
digit_[digits_++] = *q - '0';
times = 10;
} else {
digit_[digits_ - 1] += times * (*q - '0');
times *= 10;
}
}
}
if (p == end) {
return true;
}
q = p;
switch (*q) {
case 'e':
case 'E':
case 'd':
case 'D':
case 'q':
case 'Q': {
if (++q == end) {
break;
}
bool negExpo{*q == '-'};
if (*q == '-' || *q == '+') {
++q;
}
if (q != end && *q >= '0' && *q <= '9') {
int expo{0};
for (; q != end && *q == '0'; ++q) {
}
const char *expDig{q};
for (; q != end && *q >= '0' && *q <= '9'; ++q) {
expo = 10 * expo + *q - '0';
}
if (q >= expDig + 8) {
expo = 10 * Real::decimalRange;
exponent_ = 0;
}
p = q;
if (negExpo) {
exponent_ -= expo;
} else {
exponent_ += expo;
}
}
} break;
default:
break;
}
return true;
}
template <int PREC, int LOG10RADIX>
void BigRadixFloatingPointNumber<PREC,
LOG10RADIX>::LoseLeastSignificantDigit() {
Digit LSD{digit_[0]};
for (int j{0}; j < digits_ - 1; ++j) {
digit_[j] = digit_[j + 1];
}
digit_[digits_ - 1] = 0;
bool incr{false};
switch (rounding_) {
case RoundNearest:
incr = LSD > radix / 2 || (LSD == radix / 2 && digit_[0] % 2 != 0);
break;
case RoundUp:
incr = LSD > 0 && !isNegative_;
break;
case RoundDown:
incr = LSD > 0 && isNegative_;
break;
case RoundToZero:
break;
case RoundCompatible:
incr = LSD >= radix / 2;
break;
}
for (int j{0}; (digit_[j] += incr) == radix; ++j) {
digit_[j] = 0;
}
}
template <int PREC> class IntermediateFloat {
public:
static constexpr int precision{PREC};
using IntType = common::HostUnsignedIntType<precision>;
static constexpr IntType topBit{IntType{1} << (precision - 1)};
static constexpr IntType mask{topBit + (topBit - 1)};
RT_API_ATTRS IntermediateFloat() {}
IntermediateFloat(const IntermediateFloat &) = default;
template <typename UINT> RT_API_ATTRS bool SetTo(UINT n) {
static constexpr int nBits{CHAR_BIT * sizeof n};
if constexpr (precision >= nBits) {
value_ = n;
guard_ = 0;
return 0;
} else {
int shift{common::BitsNeededFor(n) - precision};
if (shift <= 0) {
value_ = n;
guard_ = 0;
return 0;
} else {
value_ = n >> shift;
exponent_ += shift;
n <<= nBits - shift;
guard_ = (n >> (nBits - guardBits)) | ((n << guardBits) != 0);
return shift;
}
}
}
RT_API_ATTRS void ShiftIn(int bit = 0) { value_ = value_ + value_ + bit; }
RT_API_ATTRS bool IsFull() const { return value_ >= topBit; }
RT_API_ATTRS void AdjustExponent(int by) { exponent_ += by; }
RT_API_ATTRS void SetGuard(int g) {
guard_ |= (static_cast<GuardType>(g & 6) << (guardBits - 3)) | (g & 1);
}
RT_API_ATTRS ConversionToBinaryResult<PREC> ToBinary(
bool isNegative, FortranRounding) const;
private:
static constexpr int guardBits{3};
using GuardType = int;
static constexpr GuardType oneHalf{GuardType{1} << (guardBits - 1)};
IntType value_{0};
GuardType guard_{0};
int exponent_{0};
};
static inline RT_API_ATTRS constexpr bool RoundOverflowToHuge(
enum FortranRounding rounding, bool isNegative) {
return rounding == RoundToZero || (!isNegative && rounding == RoundDown) ||
(isNegative && rounding == RoundUp);
}
template <int PREC>
ConversionToBinaryResult<PREC> IntermediateFloat<PREC>::ToBinary(
bool isNegative, FortranRounding rounding) const {
using Binary = BinaryFloatingPointNumber<PREC>;
IntType fraction{value_};
GuardType guard{guard_};
int expo{exponent_ + Binary::exponentBias + (precision - 1)};
while (expo < 1 && (fraction > 0 || guard > oneHalf)) {
guard = (guard & 1) | (guard >> 1) |
((static_cast<GuardType>(fraction) & 1) << (guardBits - 1));
fraction >>= 1;
++expo;
}
int flags{Exact};
if (guard != 0) {
flags |= Inexact;
}
if (fraction == 0) {
if (guard <= oneHalf) {
if ((!isNegative && rounding == RoundUp) ||
(isNegative && rounding == RoundDown)) {
expo = 0;
} else {
if (guard != 0) {
flags |= Underflow;
}
Binary zero;
if (isNegative) {
zero.Negate();
}
return {
std::move(zero), static_cast<enum ConversionResultFlags>(flags)};
}
}
} else {
while (fraction < topBit && expo > 1) {
--expo;
fraction = fraction * 2 + (guard >> (guardBits - 2));
guard =
(((guard >> (guardBits - 2)) & 1) << (guardBits - 1)) | (guard & 1);
}
}
bool incr{false};
switch (rounding) {
case RoundNearest:
incr = guard > oneHalf || (guard == oneHalf && (fraction & 1));
break;
case RoundUp:
incr = guard != 0 && !isNegative;
break;
case RoundDown:
incr = guard != 0 && isNegative;
break;
case RoundToZero:
break;
case RoundCompatible:
incr = guard >= oneHalf;
break;
}
if (incr) {
if (fraction == mask) {
++expo;
fraction = topBit;
} else {
++fraction;
}
}
if (expo == 1 && fraction < topBit) {
expo = 0;
flags |= Underflow;
} else if (expo == 0) {
flags |= Underflow;
} else if (expo >= Binary::maxExponent) {
if (RoundOverflowToHuge(rounding, isNegative)) {
expo = Binary::maxExponent - 1;
fraction = mask;
} else {
expo = Binary::maxExponent;
flags |= Overflow;
if constexpr (Binary::bits == 80) {
fraction = IntType{1} << 63;
} else {
fraction = 0;
}
}
}
using Raw = typename Binary::RawType;
Raw raw = static_cast<Raw>(isNegative) << (Binary::bits - 1);
raw |= static_cast<Raw>(expo) << Binary::significandBits;
if constexpr (Binary::isImplicitMSB) {
fraction &= ~topBit;
}
raw |= fraction;
return {Binary(raw), static_cast<enum ConversionResultFlags>(flags)};
}
template <int PREC, int LOG10RADIX>
ConversionToBinaryResult<PREC>
BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToBinary() {
Normalize();
if (digits_ == 0) {
return {Real{SignBit()}};
}
exponent_ += digits_ * log10Radix;
static constexpr int crazy{2 * Real::decimalRange + log10Radix};
if (exponent_ < -crazy) {
enum ConversionResultFlags flags {
static_cast<enum ConversionResultFlags>(Inexact | Underflow)
};
if ((!isNegative_ && rounding_ == RoundUp) ||
(isNegative_ && rounding_ == RoundDown)) {
return {Real{Raw{1} | SignBit()}, flags};
} else {
return {Real{SignBit()}, flags};
}
} else if (exponent_ > crazy) {
if (RoundOverflowToHuge(rounding_, isNegative_)) {
return {Real{HUGE()}};
} else {
return {Real{Infinity()}, Overflow};
}
}
IntermediateFloat<PREC> f;
while (exponent_ < log10Radix) {
f.AdjustExponent(-9);
digitLimit_ = digits_;
if (int carry{MultiplyWithoutNormalization<512>()}) {
PushCarry(carry);
exponent_ += log10Radix;
}
}
while (exponent_ > log10Radix) {
digitLimit_ = digits_;
int carry;
if (exponent_ >= log10Radix + 4) {
exponent_ -= 4;
carry = MultiplyWithoutNormalization<(5 * 5 * 5 * 5)>();
f.AdjustExponent(4);
} else {
--exponent_;
carry = MultiplyWithoutNormalization<5>();
f.AdjustExponent(1);
}
if (carry != 0) {
PushCarry(carry);
exponent_ += log10Radix;
}
}
int guardShift{f.SetTo(digit_[--digits_])};
digitLimit_ = digits_;
while (!f.IsFull()) {
f.AdjustExponent(-1);
std::uint32_t carry = MultiplyWithoutNormalization<2>();
f.ShiftIn(carry);
}
int guard{0};
if (guardShift == 0) {
guard = MultiplyWithoutNormalization<4>();
} else if (guardShift == 1) {
guard = MultiplyWithoutNormalization<2>();
}
guard = guard + guard + !IsZero();
f.SetGuard(guard);
return f.ToBinary(isNegative_, rounding_);
}
template <int PREC, int LOG10RADIX>
ConversionToBinaryResult<PREC>
BigRadixFloatingPointNumber<PREC, LOG10RADIX>::ConvertToBinary(
const char *&p, const char *limit) {
bool inexact{false};
if (ParseNumber(p, inexact, limit)) {
auto result{ConvertToBinary()};
if (inexact) {
result.flags =
static_cast<enum ConversionResultFlags>(result.flags | Inexact);
}
return result;
} else {
const char *q{p};
if (!limit || q < limit) {
isNegative_ = *q == '-';
if (isNegative_ || *q == '+') {
++q;
}
}
if ((!limit || limit >= q + 3) && runtime::toupper(q[0]) == 'N' &&
runtime::toupper(q[1]) == 'A' && runtime::toupper(q[2]) == 'N') {
p = q + 3;
bool isQuiet{true};
if ((!limit || p < limit) && *p == '(') {
int depth{1};
do {
++p;
if (limit && p >= limit) {
return {Real{NaN(false)}, Invalid};
} else if (*p == '(') {
++depth;
} else if (*p == ')') {
--depth;
} else if (*p != ' ') {
}
} while (depth > 0);
++p;
}
return {Real{NaN(isQuiet)}};
} else {
if ((!limit || limit >= q + 3) && runtime::toupper(q[0]) == 'I' &&
runtime::toupper(q[1]) == 'N' && runtime::toupper(q[2]) == 'F') {
if ((!limit || limit >= q + 8) && runtime::toupper(q[3]) == 'I' &&
runtime::toupper(q[4]) == 'N' && runtime::toupper(q[5]) == 'I' &&
runtime::toupper(q[6]) == 'T' && runtime::toupper(q[7]) == 'Y') {
p = q + 8;
} else {
p = q + 3;
}
return {Real{Infinity()}};
} else {
return {Real{NaN()}, Invalid};
}
}
}
}
template <int PREC>
ConversionToBinaryResult<PREC> ConvertToBinary(
const char *&p, enum FortranRounding rounding, const char *end) {
return BigRadixFloatingPointNumber<PREC>{rounding}.ConvertToBinary(p, end);
}
template ConversionToBinaryResult<8> ConvertToBinary<8>(
const char *&, enum FortranRounding, const char *end);
template ConversionToBinaryResult<11> ConvertToBinary<11>(
const char *&, enum FortranRounding, const char *end);
template ConversionToBinaryResult<24> ConvertToBinary<24>(
const char *&, enum FortranRounding, const char *end);
template ConversionToBinaryResult<53> ConvertToBinary<53>(
const char *&, enum FortranRounding, const char *end);
template ConversionToBinaryResult<64> ConvertToBinary<64>(
const char *&, enum FortranRounding, const char *end);
template ConversionToBinaryResult<113> ConvertToBinary<113>(
const char *&, enum FortranRounding, const char *end);
extern "C" {
RT_EXT_API_GROUP_BEGIN
enum ConversionResultFlags ConvertDecimalToFloat(
const char **p, float *f, enum FortranRounding rounding) {
auto result{Fortran::decimal::ConvertToBinary<24>(*p, rounding)};
std::memcpy(reinterpret_cast<void *>(f),
reinterpret_cast<const void *>(&result.binary), sizeof *f);
return result.flags;
}
enum ConversionResultFlags ConvertDecimalToDouble(
const char **p, double *d, enum FortranRounding rounding) {
auto result{Fortran::decimal::ConvertToBinary<53>(*p, rounding)};
std::memcpy(reinterpret_cast<void *>(d),
reinterpret_cast<const void *>(&result.binary), sizeof *d);
return result.flags;
}
enum ConversionResultFlags ConvertDecimalToLongDouble(
const char **p, long double *ld, enum FortranRounding rounding) {
auto result{Fortran::decimal::ConvertToBinary<64>(*p, rounding)};
std::memcpy(reinterpret_cast<void *>(ld),
reinterpret_cast<const void *>(&result.binary), sizeof *ld);
return result.flags;
}
RT_EXT_API_GROUP_END
}
}