[clang] [flang] [flang] Add UNSIGNED (PR #113504)
Peter Klausler via cfe-commits
cfe-commits at lists.llvm.org
Sun Nov 17 14:45:22 PST 2024
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/113504
>From 14c859debae5ccdc61dfa007d28e5492e885143b Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 16 Oct 2024 14:12:09 -0700
Subject: [PATCH] [flang] Add UNSIGNED
Implement the UNSIGNED extension type and operations under control
of a language feature flag (-funsigned).
This is nearly identical to the UNSIGNED feature that has been
available in Sun Fortran for years, and now implemented in GNU
Fortran for gfortran 15, and proposed for ISO standardization
in J3/24-116.txt.
See the new documentation for details; but in short, this is C's
unsigned type, with guaranteed modular arithmetic for +, -, and *,
and the related transformational intrinsic functions SUM & al.
---
clang/include/clang/Driver/Options.td | 1 +
clang/lib/Driver/ToolChains/Flang.cpp | 3 +-
flang/docs/Extensions.md | 1 +
flang/docs/Unsigned.md | 119 +++
flang/docs/index.md | 1 +
flang/include/flang/Common/Fortran-features.h | 3 +-
flang/include/flang/Common/Fortran.h | 9 +-
flang/include/flang/Evaluate/complex.h | 5 +-
flang/include/flang/Evaluate/expression.h | 47 +-
flang/include/flang/Evaluate/fold.h | 11 +
flang/include/flang/Evaluate/integer.h | 11 +-
flang/include/flang/Evaluate/real.h | 3 +-
flang/include/flang/Evaluate/tools.h | 10 +-
flang/include/flang/Evaluate/type.h | 40 +-
flang/include/flang/ISO_Fortran_binding.h | 7 +-
.../flang/Optimizer/Builder/FIRBuilder.h | 25 +
.../Optimizer/Builder/Runtime/RTBuilder.h | 89 +++
.../Dialect/CanonicalizationPatterns.td | 4 +-
.../include/flang/Optimizer/Dialect/FIROps.td | 5 +-
.../flang/Optimizer/Dialect/FIRTypes.td | 19 +-
flang/include/flang/Optimizer/Support/Utils.h | 20 +-
flang/include/flang/Parser/dump-parse-tree.h | 4 +-
flang/include/flang/Parser/parse-tree.h | 20 +-
flang/include/flang/Runtime/cpp-type.h | 4 +
flang/include/flang/Runtime/numeric.h | 2 +-
flang/include/flang/Runtime/reduce.h | 83 ++
flang/include/flang/Runtime/reduction.h | 93 +++
flang/include/flang/Semantics/expression.h | 5 +-
flang/lib/Common/default-kinds.cpp | 1 +
flang/lib/Evaluate/expression.cpp | 6 +
flang/lib/Evaluate/fold-implementation.h | 58 +-
flang/lib/Evaluate/fold-integer.cpp | 750 ++++++++++--------
flang/lib/Evaluate/fold-logical.cpp | 24 +-
flang/lib/Evaluate/fold-matmul.h | 4 +-
flang/lib/Evaluate/fold-reduction.h | 19 +-
flang/lib/Evaluate/formatting.cpp | 9 +-
flang/lib/Evaluate/intrinsics.cpp | 191 +++--
flang/lib/Evaluate/target.cpp | 2 +
flang/lib/Evaluate/tools.cpp | 62 +-
flang/lib/Evaluate/type.cpp | 10 +
flang/lib/Frontend/CompilerInvocation.cpp | 6 +
flang/lib/Lower/Bridge.cpp | 9 +-
flang/lib/Lower/ConvertConstant.cpp | 16 +-
flang/lib/Lower/ConvertExpr.cpp | 127 ++-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 84 +-
flang/lib/Lower/ConvertType.cpp | 8 +-
flang/lib/Lower/IO.cpp | 35 +-
flang/lib/Lower/Mangler.cpp | 2 +
flang/lib/Optimizer/Builder/IntrinsicCall.cpp | 388 ++++++---
.../Optimizer/Builder/Runtime/Reduction.cpp | 191 +++++
flang/lib/Optimizer/CodeGen/CodeGen.cpp | 12 +-
flang/lib/Optimizer/Dialect/FIRType.cpp | 53 +-
flang/lib/Parser/Fortran-parsers.cpp | 21 +-
flang/lib/Parser/type-parsers.h | 1 +
flang/lib/Semantics/check-arithmeticif.cpp | 3 +
flang/lib/Semantics/check-case.cpp | 8 +-
flang/lib/Semantics/expression.cpp | 107 ++-
flang/lib/Semantics/resolve-names.cpp | 11 +
flang/lib/Semantics/scope.cpp | 1 +
flang/lib/Semantics/tools.cpp | 8 +-
flang/module/iso_c_binding.f90 | 29 +
flang/module/iso_fortran_env.f90 | 7 +
flang/module/iso_fortran_env_impl.f90 | 30 +
flang/runtime/descriptor-io.h | 38 +-
flang/runtime/dot-product.cpp | 23 +
flang/runtime/edit-input.cpp | 19 +-
flang/runtime/edit-input.h | 2 +-
flang/runtime/edit-output.cpp | 14 +-
flang/runtime/edit-output.h | 14 +-
flang/runtime/extrema.cpp | 134 +++-
flang/runtime/findloc.cpp | 20 +-
flang/runtime/io-api-minimal.cpp | 2 +-
flang/runtime/numeric.cpp | 4 +-
flang/runtime/product.cpp | 43 +
flang/runtime/reduce.cpp | 214 +++++
flang/runtime/reduction-templates.h | 8 +-
flang/runtime/reduction.cpp | 46 +-
flang/runtime/sum.cpp | 33 +
flang/runtime/tools.h | 2 +-
flang/runtime/type-code.cpp | 29 +
flang/runtime/type-info.cpp | 1 +
flang/test/Evaluate/fold-unsigned.f90 | 120 +++
flang/test/Lower/Intrinsics/shifta.f90 | 10 +-
flang/test/Lower/allocatable-polymorphic.f90 | 2 +-
flang/test/Lower/unsigned-ops.f90 | 26 +
flang/test/Semantics/typeinfo01.f90 | 8 +-
flang/test/Semantics/typeinfo08.f90 | 2 +-
flang/test/Semantics/unsigned-errors.f90 | 77 ++
flang/unittests/Evaluate/real.cpp | 4 +-
89 files changed, 3065 insertions(+), 767 deletions(-)
create mode 100644 flang/docs/Unsigned.md
create mode 100644 flang/test/Evaluate/fold-unsigned.f90
create mode 100644 flang/test/Lower/unsigned-ops.f90
create mode 100644 flang/test/Semantics/unsigned-errors.f90
diff --git a/clang/include/clang/Driver/Options.td b/clang/include/clang/Driver/Options.td
index 0a94a7185df8c7..20384a3d9cc05f 100644
--- a/clang/include/clang/Driver/Options.td
+++ b/clang/include/clang/Driver/Options.td
@@ -6879,6 +6879,7 @@ defm underscoring : OptInFC1FFlag<"underscoring", "Appends one trailing undersco
defm ppc_native_vec_elem_order: BoolOptionWithoutMarshalling<"f", "ppc-native-vector-element-order",
PosFlag<SetTrue, [], [ClangOption], "Specifies PowerPC native vector element order (default)">,
NegFlag<SetFalse, [], [ClangOption], "Specifies PowerPC non-native vector element order">>;
+defm unsigned : OptInFC1FFlag<"unsigned", "Enables UNSIGNED type">;
def fno_automatic : Flag<["-"], "fno-automatic">, Group<f_Group>,
HelpText<"Implies the SAVE attribute for non-automatic local objects in subprograms unless RECURSIVE">;
diff --git a/clang/lib/Driver/ToolChains/Flang.cpp b/clang/lib/Driver/ToolChains/Flang.cpp
index 11070c23c75f4a..be0e96ca2fb8a3 100644
--- a/clang/lib/Driver/ToolChains/Flang.cpp
+++ b/clang/lib/Driver/ToolChains/Flang.cpp
@@ -120,7 +120,8 @@ void Flang::addOtherOptions(const ArgList &Args, ArgStringList &CmdArgs) const {
options::OPT_fintrinsic_modules_path, options::OPT_pedantic,
options::OPT_std_EQ, options::OPT_W_Joined,
options::OPT_fconvert_EQ, options::OPT_fpass_plugin_EQ,
- options::OPT_funderscoring, options::OPT_fno_underscoring});
+ options::OPT_funderscoring, options::OPT_fno_underscoring,
+ options::OPT_funsigned, options::OPT_fno_unsigned});
llvm::codegenoptions::DebugInfoKind DebugInfoKind;
if (Args.hasArg(options::OPT_gN_Group)) {
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index f85a3eb39ed191..5867d9a14c084c 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -417,6 +417,7 @@ end
[-fimplicit-none-type-never]
* Old-style `PARAMETER pi=3.14` statement without parentheses
[-falternative-parameter-statement]
+* `UNSIGNED` type (-funsigned)
### Extensions and legacy features deliberately not supported
diff --git a/flang/docs/Unsigned.md b/flang/docs/Unsigned.md
new file mode 100644
index 00000000000000..675ba77d188268
--- /dev/null
+++ b/flang/docs/Unsigned.md
@@ -0,0 +1,119 @@
+<!--===- docs/Unsigned.md
+
+ Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+ See https://llvm.org/LICENSE.txt for license information.
+ SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+
+-->
+
+# Fortran Extensions supported by Flang
+
+```{contents}
+---
+local:
+---
+```
+
+For better compatibility with GNU Fortran and Sun Fortran,
+this compiler supports an option (`-funsigned`) that enables
+the `UNSIGNED` data type, constants, intrinsic functions,
+its use with intrinsic operations and `SELECT CASE`, and C
+language interoperability.
+
+## `UNSIGNED` type
+
+`UNSIGNED` is a numeric type with the same kinds as `INTEGER`.
+It may appear as a type-spec in any context, including
+a type declaration statement, a type-decl in an array
+constructor or `ALLOCATE` statement, `IMPLICIT`, or a
+function statement's prefix.
+
+`UNSIGNED` constants are nonempty strings of decimal digits
+followed by the letter `U` and optionally a kind suffix with
+an underscore.
+
+## `UNSIGNED` operations
+
+`UNSIGNED` operands are accepted for unary negation (`-`),
+the basic four binary arithmetic intrinsic operations `+`, `-`, `*`, and `/`,
+and for numeric relational operators.
+The power operator `**` does not accept `UNSIGNED` operands.
+
+Mixed operations with other types are not allowed.
+Mixed operations with one `UNSIGNED` operand and one BOZ literal
+constant operand are allowed.
+When the operands' kinds differ, the smaller operand is zero-extended
+to the size of the larger.
+
+The arithmetic operations `u+v`, `-u`, `u-v`, and `u*v` are implemented
+modulo `MAX(HUGE(u),HUGE(v))+1`;
+informally speaking, they always truncate their results, or are
+guaranteed to "wrap".
+
+## `UNSIGNED` intrinsic functions
+
+`UNSIGNED` operands are accepted as operands to,
+or may be returned as results from,
+several intrinsic procedures.
+
+Bitwise operations:
+* `NOT`
+* `IAND`, `IOR`, `IEOR`, `IBCLR`, `IBSET`, `IBITS`, `MERGE_BITS`
+* `BTEST`
+* `ISHFT`, `ISHFTC`
+* `SHIFTA`, `SHIFTL`, `SHIFTR`
+* `TRANSFER`
+* `MVBITS`
+
+The existing unsigned comparisons `BLT`, `BLE`, `BGE`, and `BGT`.
+
+The inquiries `BIT_SIZE`, `DIGITS`, `HUGE`, and `RANGE`.
+
+Homogeneous `MAX` and `MIN`.
+
+The intrinsic array functions:
+* `MAXVAL`, `MINVAL`
+* `SUM`, `PRODUCT`
+* `IALL`, `IANY`, `IPARITY`
+* `DOT_PRODUCT`, `MATMUL`
+
+All of the restructuring array transformational intrinsics: `CSHIFT`, `EOSHIFT`,
+ `PACK`, `RESHAPE`, `SPREAD`, `TRANSPOSE`, and `UNPACK`.
+
+The location transformationals `FINDLOC`, `MAXLOC`, and `MINLOC`.
+
+There is a new `SELECTED_UNSIGNED_KIND` intrinsic function; it happens
+to work identically to the existing `SELECTED_INT_KIND`.
+
+Two new intrinsic functions `UMASKL` and `UMASKR` work just like
+`MASKL` and `MASKR`, returning unsigned results instead of integers.
+
+Conversions to `UNSIGNED`, or between `UNSIGNED` kinds, can be done
+via the new `UINT` intrinsic. The `UNSIGNED` intrinsic name is also
+supported as an alias.
+
+Support for `UNSIGNED` in the `OUT_OF_RANGE` predicate and `RANDOM_NUMBER`
+remains to be implemented.
+
+## Other usage
+
+`UNSIGNED` is allowed in `SELECT CASE`, but not in `DO` loop indices or
+limits, or an arithmetic `IF` expression.
+
+`UNSIGNED` array indices are not allowed.
+
+`UNSIGNED` data may be used as data items in I/O statements, including
+list-directed and `NAMELIST` I/O.
+Format-directed I/O may edit `UNSIGNED` data with `I`, `G`, `B`, `O`, and `Z`
+edit descriptors.
+
+## C interoperability
+
+`UNSIGNED` data map to type codes for C's `unsigned` types in the
+`type` member of a `cdesc_t` descriptor in the `ISO_Fortran_binding.h`
+header file.
+
+## Standard modules
+
+New definitions (`C_UNSIGNED`, `C_UINT8_T`, &c.) were added to ISO_C_BINDING
+and new constants (`UINT8`, `UINT16`, &c.) to ISO_FORTRAN_ENV.
diff --git a/flang/docs/index.md b/flang/docs/index.md
index 70478fa0936d0b..c35f634746e68b 100644
--- a/flang/docs/index.md
+++ b/flang/docs/index.md
@@ -87,6 +87,7 @@ on how to get in touch with us and to learn more about the current status.
f2018-grammar.md
fstack-arrays
Real16MathSupport
+ Unsigned
```
# Indices and tables
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index c6ab846cce2fc0..7a246c4f6880fe 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -53,7 +53,8 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
NonBindCInteroperability, CudaManaged, CudaUnified,
PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy,
UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr,
- SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank)
+ SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank,
+ Unsigned)
// Portability and suspicious usage warnings
ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h
index cb109ad574cf6e..23c6aee8617356 100644
--- a/flang/include/flang/Common/Fortran.h
+++ b/flang/include/flang/Common/Fortran.h
@@ -21,12 +21,15 @@
namespace Fortran::common {
class LanguageFeatureControl;
-// Fortran has five kinds of intrinsic data types, plus the derived types.
-ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived)
+// Fortran has five kinds of standard intrinsic data types, the Unsigned
+// extension, and derived types.
+ENUM_CLASS(
+ TypeCategory, Integer, Unsigned, Real, Complex, Character, Logical, Derived)
ENUM_CLASS(VectorElementCategory, Integer, Unsigned, Real)
constexpr bool IsNumericTypeCategory(TypeCategory category) {
- return category == TypeCategory::Integer || category == TypeCategory::Real ||
+ return category == TypeCategory::Integer ||
+ category == TypeCategory::Unsigned || category == TypeCategory::Real ||
category == TypeCategory::Complex;
}
diff --git a/flang/include/flang/Evaluate/complex.h b/flang/include/flang/Evaluate/complex.h
index 06eef842410944..2dcd28b59968cd 100644
--- a/flang/include/flang/Evaluate/complex.h
+++ b/flang/include/flang/Evaluate/complex.h
@@ -61,10 +61,11 @@ template <typename REAL_TYPE> class Complex {
template <typename INT>
static ValueWithRealFlags<Complex> FromInteger(const INT &n,
+ bool isUnsigned = false,
Rounding rounding = TargetCharacteristics::defaultRounding) {
ValueWithRealFlags<Complex> result;
- result.value.re_ =
- Part::FromInteger(n, rounding).AccumulateFlags(result.flags);
+ result.value.re_ = Part::FromInteger(n, isUnsigned, rounding)
+ .AccumulateFlags(result.flags);
return result;
}
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 2a40193e32306b..9ea037a2f7c429 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -209,10 +209,12 @@ template <typename TO, TypeCategory FROMCAT = TO::category>
struct Convert : public Operation<Convert<TO, FROMCAT>, TO, SomeKind<FROMCAT>> {
// Fortran doesn't have conversions between kinds of CHARACTER apart from
// assignments, and in those the data must be convertible to/from 7-bit ASCII.
- static_assert(((TO::category == TypeCategory::Integer ||
- TO::category == TypeCategory::Real) &&
- (FROMCAT == TypeCategory::Integer ||
- FROMCAT == TypeCategory::Real)) ||
+ static_assert(
+ ((TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Real ||
+ TO::category == TypeCategory::Unsigned) &&
+ (FROMCAT == TypeCategory::Integer || FROMCAT == TypeCategory::Real ||
+ FROMCAT == TypeCategory::Unsigned)) ||
TO::category == FROMCAT);
using Result = TO;
using Operand = SomeKind<FROMCAT>;
@@ -526,7 +528,8 @@ class Expr<Type<TypeCategory::Integer, KIND>>
private:
using Conversions = std::tuple<Convert<Result, TypeCategory::Integer>,
- Convert<Result, TypeCategory::Real>>;
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
using Operations = std::tuple<Parentheses<Result>, Negate<Result>,
Add<Result>, Subtract<Result>, Multiply<Result>, Divide<Result>,
Power<Result>, Extremum<Result>>;
@@ -547,6 +550,29 @@ class Expr<Type<TypeCategory::Integer, KIND>>
u;
};
+template <int KIND>
+class Expr<Type<TypeCategory::Unsigned, KIND>>
+ : public ExpressionBase<Type<TypeCategory::Unsigned, KIND>> {
+public:
+ using Result = Type<TypeCategory::Unsigned, KIND>;
+
+ EVALUATE_UNION_CLASS_BOILERPLATE(Expr)
+
+private:
+ using Conversions = std::tuple<Convert<Result, TypeCategory::Integer>,
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
+ using Operations =
+ std::tuple<Parentheses<Result>, Negate<Result>, Add<Result>,
+ Subtract<Result>, Multiply<Result>, Divide<Result>, Extremum<Result>>;
+ using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
+ Designator<Result>, FunctionRef<Result>>;
+
+public:
+ common::TupleToVariant<common::CombineTuples<Operations, Conversions, Others>>
+ u;
+};
+
template <int KIND>
class Expr<Type<TypeCategory::Real, KIND>>
: public ExpressionBase<Type<TypeCategory::Real, KIND>> {
@@ -560,7 +586,8 @@ class Expr<Type<TypeCategory::Real, KIND>>
// N.B. Real->Complex and Complex->Real conversions are done with CMPLX
// and part access operations (resp.).
using Conversions = std::variant<Convert<Result, TypeCategory::Integer>,
- Convert<Result, TypeCategory::Real>>;
+ Convert<Result, TypeCategory::Real>,
+ Convert<Result, TypeCategory::Unsigned>>;
using Operations = std::variant<ComplexComponent<KIND>, Parentheses<Result>,
Negate<Result>, Add<Result>, Subtract<Result>, Multiply<Result>,
Divide<Result>, Power<Result>, RealToIntPower<Result>, Extremum<Result>>;
@@ -590,6 +617,7 @@ class Expr<Type<TypeCategory::Complex, KIND>>
};
FOR_EACH_INTEGER_KIND(extern template class Expr, )
+FOR_EACH_UNSIGNED_KIND(extern template class Expr, )
FOR_EACH_REAL_KIND(extern template class Expr, )
FOR_EACH_COMPLEX_KIND(extern template class Expr, )
@@ -629,7 +657,8 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
static_assert(Operand::category == TypeCategory::Integer ||
Operand::category == TypeCategory::Real ||
Operand::category == TypeCategory::Complex ||
- Operand::category == TypeCategory::Character);
+ Operand::category == TypeCategory::Character ||
+ Operand::category == TypeCategory::Unsigned);
CLASS_BOILERPLATE(Relational)
Relational(
RelationalOperator r, const Expr<Operand> &a, const Expr<Operand> &b)
@@ -642,7 +671,7 @@ class Relational : public Operation<Relational<T>, LogicalResult, T, T> {
template <> class Relational<SomeType> {
using DirectlyComparableTypes = common::CombineTuples<IntegerTypes, RealTypes,
- ComplexTypes, CharacterTypes>;
+ ComplexTypes, CharacterTypes, UnsignedTypes>;
public:
using Result = LogicalResult;
@@ -656,6 +685,7 @@ template <> class Relational<SomeType> {
};
FOR_EACH_INTEGER_KIND(extern template class Relational, )
+FOR_EACH_UNSIGNED_KIND(extern template class Relational, )
FOR_EACH_REAL_KIND(extern template class Relational, )
FOR_EACH_CHARACTER_KIND(extern template class Relational, )
extern template class Relational<SomeType>;
@@ -886,6 +916,7 @@ FOR_EACH_INTRINSIC_KIND(extern template class ArrayConstructor, )
FOR_EACH_INTRINSIC_KIND(template class Expr, ) \
FOR_EACH_CATEGORY_TYPE(template class Expr, ) \
FOR_EACH_INTEGER_KIND(template class Relational, ) \
+ FOR_EACH_UNSIGNED_KIND(template class Relational, ) \
FOR_EACH_REAL_KIND(template class Relational, ) \
FOR_EACH_CHARACTER_KIND(template class Relational, ) \
template class Relational<SomeType>; \
diff --git a/flang/include/flang/Evaluate/fold.h b/flang/include/flang/Evaluate/fold.h
index d2a153fb7919e4..b21c0f311fd35b 100644
--- a/flang/include/flang/Evaluate/fold.h
+++ b/flang/include/flang/Evaluate/fold.h
@@ -89,8 +89,19 @@ constexpr std::optional<std::int64_t> ToInt64(
return std::nullopt;
}
}
+template <int KIND>
+constexpr std::optional<std::int64_t> ToInt64(
+ const Expr<Type<TypeCategory::Unsigned, KIND>> &expr) {
+ if (auto scalar{
+ GetScalarConstantValue<Type<TypeCategory::Unsigned, KIND>>(expr)}) {
+ return scalar->ToInt64();
+ } else {
+ return std::nullopt;
+ }
+}
std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &);
+std::optional<std::int64_t> ToInt64(const Expr<SomeUnsigned> &);
std::optional<std::int64_t> ToInt64(const Expr<SomeType> &);
std::optional<std::int64_t> ToInt64(const ActualArgument &);
diff --git a/flang/include/flang/Evaluate/integer.h b/flang/include/flang/Evaluate/integer.h
index e420eb75e3dff0..fccc2ad774a8fc 100644
--- a/flang/include/flang/Evaluate/integer.h
+++ b/flang/include/flang/Evaluate/integer.h
@@ -33,6 +33,12 @@
namespace Fortran::evaluate::value {
+// Computes decimal range in the sense of SELECTED_INT_KIND
+static constexpr int DecimalRange(int bits) {
+ // This magic value is LOG10(2.)*1E12.
+ return static_cast<int>((bits * 301029995664) / 1000000000000);
+}
+
// Implements an integer as an assembly of smaller host integer parts
// that constitute the digits of a large-radix fixed-point number.
// For best performance, the type of these parts should be half of the
@@ -367,9 +373,8 @@ class Integer {
static constexpr int DIGITS{bits - 1}; // don't count the sign bit
static constexpr Integer HUGE() { return MASKR(bits - 1); }
static constexpr Integer Least() { return MASKL(1); }
- static constexpr int RANGE{// in the sense of SELECTED_INT_KIND
- // This magic value is LOG10(2.)*1E12.
- static_cast<int>(((bits - 1) * 301029995664) / 1000000000000)};
+ static constexpr int RANGE{DecimalRange(bits - 1)};
+ static constexpr int UnsignedRANGE{DecimalRange(bits)};
constexpr bool IsZero() const {
for (int j{0}; j < parts; ++j) {
diff --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index 11cc8f776b0e95..03294881850a13 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -288,8 +288,9 @@ template <typename WORD, int PREC> class Real {
template <typename INT>
static ValueWithRealFlags<Real> FromInteger(const INT &n,
+ bool isUnsigned = false,
Rounding rounding = TargetCharacteristics::defaultRounding) {
- bool isNegative{n.IsNegative()};
+ bool isNegative{!isUnsigned && n.IsNegative()};
INT absN{n};
if (isNegative) {
absN = n.Negate().value; // overflow is safe to ignore
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index a8a6eb922a045d..c83f382c19dd36 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -582,7 +582,8 @@ Expr<TO> ConvertToType(Expr<Type<FROMCAT, FROMKIND>> &&x) {
template <typename TO> Expr<TO> ConvertToType(BOZLiteralConstant &&x) {
static_assert(IsSpecificIntrinsicType<TO>);
- if constexpr (TO::category == TypeCategory::Integer) {
+ if constexpr (TO::category == TypeCategory::Integer ||
+ TO::category == TypeCategory::Unsigned) {
return Expr<TO>{
Constant<TO>{Scalar<TO>::ConvertUnsigned(std::move(x)).value}};
} else {
@@ -754,11 +755,11 @@ Expr<SomeKind<CAT>> PromoteAndCombine(
// one of the operands to the type of the other. Handles special cases with
// typeless literal operands and with REAL/COMPLEX exponentiation to INTEGER
// powers.
-template <template <typename> class OPR>
+template <template <typename> class OPR, bool CAN_BE_UNSIGNED = true>
std::optional<Expr<SomeType>> NumericOperation(parser::ContextualMessages &,
Expr<SomeType> &&, Expr<SomeType> &&, int defaultRealKind);
-extern template std::optional<Expr<SomeType>> NumericOperation<Power>(
+extern template std::optional<Expr<SomeType>> NumericOperation<Power, false>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
extern template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
@@ -910,6 +911,9 @@ common::IfNoLvalue<std::optional<Expr<SomeType>>, WRAPPED> TypedWrapper(
case TypeCategory::Integer:
return WrapperHelper<TypeCategory::Integer, WRAPPER, WRAPPED>(
dyType.kind(), std::move(x));
+ case TypeCategory::Unsigned:
+ return WrapperHelper<TypeCategory::Unsigned, WRAPPER, WRAPPED>(
+ dyType.kind(), std::move(x));
case TypeCategory::Real:
return WrapperHelper<TypeCategory::Real, WRAPPER, WRAPPED>(
dyType.kind(), std::move(x));
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index bd8887dbce4e82..1f9296ac4fea75 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -69,6 +69,7 @@ static constexpr bool IsValidKindOfIntrinsicType(
TypeCategory category, std::int64_t kind) {
switch (category) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
return kind == 1 || kind == 2 || kind == 4 || kind == 8 || kind == 16;
case TypeCategory::Real:
case TypeCategory::Complex:
@@ -287,6 +288,13 @@ class Type<TypeCategory::Integer, KIND>
using Scalar = value::Integer<8 * KIND>;
};
+template <int KIND>
+class Type<TypeCategory::Unsigned, KIND>
+ : public TypeBase<TypeCategory::Unsigned, KIND> {
+public:
+ using Scalar = value::Integer<8 * KIND>;
+};
+
template <int KIND>
class Type<TypeCategory::Real, KIND>
: public TypeBase<TypeCategory::Real, KIND> {
@@ -367,11 +375,13 @@ using RealTypes = CategoryTypes<TypeCategory::Real>;
using ComplexTypes = CategoryTypes<TypeCategory::Complex>;
using CharacterTypes = CategoryTypes<TypeCategory::Character>;
using LogicalTypes = CategoryTypes<TypeCategory::Logical>;
+using UnsignedTypes = CategoryTypes<TypeCategory::Unsigned>;
using FloatingTypes = common::CombineTuples<RealTypes, ComplexTypes>;
-using NumericTypes = common::CombineTuples<IntegerTypes, FloatingTypes>;
-using RelationalTypes =
- common::CombineTuples<IntegerTypes, RealTypes, CharacterTypes>;
+using NumericTypes =
+ common::CombineTuples<IntegerTypes, FloatingTypes, UnsignedTypes>;
+using RelationalTypes = common::CombineTuples<IntegerTypes, RealTypes,
+ CharacterTypes, UnsignedTypes>;
using AllIntrinsicTypes =
common::CombineTuples<NumericTypes, CharacterTypes, LogicalTypes>;
using LengthlessIntrinsicTypes =
@@ -397,11 +407,13 @@ template <TypeCategory CATEGORY> struct SomeKind {
}
};
-using NumericCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
- SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>>;
-using AllIntrinsicCategoryTypes = std::tuple<SomeKind<TypeCategory::Integer>,
- SomeKind<TypeCategory::Real>, SomeKind<TypeCategory::Complex>,
- SomeKind<TypeCategory::Character>, SomeKind<TypeCategory::Logical>>;
+using NumericCategoryTypes =
+ std::tuple<SomeKind<TypeCategory::Integer>, SomeKind<TypeCategory::Real>,
+ SomeKind<TypeCategory::Complex>, SomeKind<TypeCategory::Unsigned>>;
+using AllIntrinsicCategoryTypes =
+ std::tuple<SomeKind<TypeCategory::Integer>, SomeKind<TypeCategory::Real>,
+ SomeKind<TypeCategory::Complex>, SomeKind<TypeCategory::Character>,
+ SomeKind<TypeCategory::Logical>, SomeKind<TypeCategory::Unsigned>>;
// Represents a completely generic type (or, for Expr<SomeType>, a typeless
// value like a BOZ literal or NULL() pointer).
@@ -448,9 +460,10 @@ using SomeReal = SomeKind<TypeCategory::Real>;
using SomeComplex = SomeKind<TypeCategory::Complex>;
using SomeCharacter = SomeKind<TypeCategory::Character>;
using SomeLogical = SomeKind<TypeCategory::Logical>;
+using SomeUnsigned = SomeKind<TypeCategory::Unsigned>;
using SomeDerived = SomeKind<TypeCategory::Derived>;
using SomeCategory = std::tuple<SomeInteger, SomeReal, SomeComplex,
- SomeCharacter, SomeLogical, SomeDerived>;
+ SomeCharacter, SomeLogical, SomeUnsigned, SomeDerived>;
using AllTypes =
common::CombineTuples<AllIntrinsicTypes, std::tuple<SomeDerived>>;
@@ -507,6 +520,7 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
#define EXPAND_FOR_EACH_CHARACTER_KIND(M, P, S) M(P, S, 1) M(P, S, 2) M(P, S, 4)
#define EXPAND_FOR_EACH_LOGICAL_KIND(M, P, S) \
M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8)
+#define EXPAND_FOR_EACH_UNSIGNED_KIND EXPAND_FOR_EACH_INTEGER_KIND
#define FOR_EACH_INTEGER_KIND_HELP(PREFIX, SUFFIX, K) \
PREFIX<Type<TypeCategory::Integer, K>> SUFFIX;
@@ -518,6 +532,8 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
PREFIX<Type<TypeCategory::Character, K>> SUFFIX;
#define FOR_EACH_LOGICAL_KIND_HELP(PREFIX, SUFFIX, K) \
PREFIX<Type<TypeCategory::Logical, K>> SUFFIX;
+#define FOR_EACH_UNSIGNED_KIND_HELP(PREFIX, SUFFIX, K) \
+ PREFIX<Type<TypeCategory::Unsigned, K>> SUFFIX;
#define FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
EXPAND_FOR_EACH_INTEGER_KIND(FOR_EACH_INTEGER_KIND_HELP, PREFIX, SUFFIX)
@@ -529,12 +545,15 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
EXPAND_FOR_EACH_CHARACTER_KIND(FOR_EACH_CHARACTER_KIND_HELP, PREFIX, SUFFIX)
#define FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
EXPAND_FOR_EACH_LOGICAL_KIND(FOR_EACH_LOGICAL_KIND_HELP, PREFIX, SUFFIX)
+#define FOR_EACH_UNSIGNED_KIND(PREFIX, SUFFIX) \
+ EXPAND_FOR_EACH_UNSIGNED_KIND(FOR_EACH_UNSIGNED_KIND_HELP, PREFIX, SUFFIX)
#define FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_INTEGER_KIND(PREFIX, SUFFIX) \
FOR_EACH_REAL_KIND(PREFIX, SUFFIX) \
FOR_EACH_COMPLEX_KIND(PREFIX, SUFFIX) \
- FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX)
+ FOR_EACH_LOGICAL_KIND(PREFIX, SUFFIX) \
+ FOR_EACH_UNSIGNED_KIND(PREFIX, SUFFIX)
#define FOR_EACH_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_LENGTHLESS_INTRINSIC_KIND(PREFIX, SUFFIX) \
FOR_EACH_CHARACTER_KIND(PREFIX, SUFFIX)
@@ -548,6 +567,7 @@ bool AreSameDerivedTypeIgnoringTypeParameters(
PREFIX<SomeComplex> SUFFIX; \
PREFIX<SomeCharacter> SUFFIX; \
PREFIX<SomeLogical> SUFFIX; \
+ PREFIX<SomeUnsigned> SUFFIX; \
PREFIX<SomeDerived> SUFFIX; \
PREFIX<SomeType> SUFFIX;
#define FOR_EACH_TYPE_AND_KIND(PREFIX, SUFFIX) \
diff --git a/flang/include/flang/ISO_Fortran_binding.h b/flang/include/flang/ISO_Fortran_binding.h
index 89a10ce69a2ba2..945f8fef89f0b4 100644
--- a/flang/include/flang/ISO_Fortran_binding.h
+++ b/flang/include/flang/ISO_Fortran_binding.h
@@ -96,7 +96,12 @@ typedef signed char CFI_type_t;
#define CFI_type_struct 42
#define CFI_type_char16_t 43 /* extension kind=2 */
#define CFI_type_char32_t 44 /* extension kind=4 */
-#define CFI_TYPE_LAST CFI_type_char32_t
+#define CFI_type_uint8_t 45 /* extension: unsigned */
+#define CFI_type_uint16_t 46
+#define CFI_type_uint32_t 47
+#define CFI_type_uint64_t 48
+#define CFI_type_uint128_t 49
+#define CFI_TYPE_LAST CFI_type_uint128_t
#define CFI_type_other (-1) // must be negative
/* Error code macros - skip some of the small values to avoid conflicts with
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
index 09f7b892f1ecbe..1101ac5b80bfe2 100644
--- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -551,6 +551,31 @@ class FirOpBuilder : public mlir::OpBuilder, public mlir::OpBuilder::Listener {
/// Construct a data layout on demand and return it
mlir::DataLayout &getDataLayout();
+ /// Convert operands &/or result from/to unsigned so that the operation
+ /// only receives/produces signless operands.
+ template <typename OpTy>
+ mlir::Value createUnsigned(mlir::Location loc, mlir::Type resultType,
+ mlir::Value left, mlir::Value right) {
+ if (!resultType.isIntOrFloat())
+ return create<OpTy>(loc, resultType, left, right);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Type opResType = resultType;
+ if (left.getType().isUnsignedInteger()) {
+ left = createConvert(loc, signlessType, left);
+ opResType = signlessType;
+ }
+ if (right.getType().isUnsignedInteger()) {
+ right = createConvert(loc, signlessType, right);
+ opResType = signlessType;
+ }
+ mlir::Value result = create<OpTy>(loc, opResType, left, right);
+ if (resultType.isUnsignedInteger())
+ result = createConvert(loc, resultType, result);
+ return result;
+ }
+
private:
/// Set attributes (e.g. FastMathAttr) to \p op operation
/// based on the current attributes setting.
diff --git a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
index 66e11b5585d521..09b49b95fefe57 100644
--- a/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/RTBuilder.h
@@ -400,6 +400,84 @@ constexpr TypeBuilderFunc getModel<bool &>() {
return fir::ReferenceType::get(f(context));
};
}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned short>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return mlir::IntegerType::get(
+ context, 8 * sizeof(unsigned short),
+ mlir::IntegerType::SignednessSemantics::Unsigned);
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned char *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::ReferenceType::get(mlir::IntegerType::get(context, 8));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned char *>() {
+ return getModel<unsigned char *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned short *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::ReferenceType::get(
+ mlir::IntegerType::get(context, 8 * sizeof(unsigned short)));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned short *>() {
+ return getModel<unsigned short *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned *>() {
+ return getModel<int *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned *>() {
+ return getModel<unsigned *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::ReferenceType::get(
+ mlir::IntegerType::get(context, 8 * sizeof(unsigned long)));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned long *>() {
+ return getModel<unsigned long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<unsigned long long *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ return fir::ReferenceType::get(
+ mlir::IntegerType::get(context, 8 * sizeof(unsigned long long)));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<const unsigned long long *>() {
+ return getModel<unsigned long long *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::uint128_t>() {
+ return getModel<Fortran::common::int128_t>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::int128_t *>() {
+ return [](mlir::MLIRContext *context) -> mlir::Type {
+ TypeBuilderFunc f{getModel<Fortran::common::int128_t>()};
+ return fir::ReferenceType::get(f(context));
+ };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::common::uint128_t *>() {
+ return getModel<Fortran::common::int128_t *>();
+}
+template <>
+constexpr TypeBuilderFunc getModel<const Fortran::common::uint128_t *>() {
+ return getModel<Fortran::common::uint128_t *>();
+}
// getModel<std::complex<T>> are not implemented on purpose.
// Prefer passing/returning the complex by reference in the runtime to
@@ -512,6 +590,17 @@ REDUCTION_VALUE_OPERATION_MODEL(std::int64_t)
REDUCTION_REF_OPERATION_MODEL(Fortran::common::int128_t)
REDUCTION_VALUE_OPERATION_MODEL(Fortran::common::int128_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint8_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint8_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint16_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint16_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint32_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint32_t)
+REDUCTION_REF_OPERATION_MODEL(std::uint64_t)
+REDUCTION_VALUE_OPERATION_MODEL(std::uint64_t)
+REDUCTION_REF_OPERATION_MODEL(Fortran::common::uint128_t)
+REDUCTION_VALUE_OPERATION_MODEL(Fortran::common::uint128_t)
+
REDUCTION_REF_OPERATION_MODEL(float)
REDUCTION_VALUE_OPERATION_MODEL(float)
REDUCTION_REF_OPERATION_MODEL(double)
diff --git a/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td b/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
index 0ef37a37ce94f8..1dbde5c1c73024 100644
--- a/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
+++ b/flang/include/flang/Optimizer/Dialect/CanonicalizationPatterns.td
@@ -29,7 +29,9 @@ def IndexTypePred : Constraint<CPred<
def MonotonicTypePred
: Constraint<CPred<"((mlir::isa<mlir::IntegerType>($0.getType()) && "
" mlir::isa<mlir::IntegerType>($1.getType()) && "
- " mlir::isa<mlir::IntegerType>($2.getType())) || "
+ " mlir::isa<mlir::IntegerType>($2.getType()) && "
+ " $0.getType().isUnsignedInteger() == $1.getType().isUnsignedInteger() && "
+ " $1.getType().isUnsignedInteger() == $2.getType().isUnsignedInteger()) || "
" (mlir::isa<mlir::FloatType>($0.getType()) && "
" mlir::isa<mlir::FloatType>($1.getType()) && "
" mlir::isa<mlir::FloatType>($2.getType()))) && "
diff --git a/flang/include/flang/Optimizer/Dialect/FIROps.td b/flang/include/flang/Optimizer/Dialect/FIROps.td
index eda8f26e936fb6..01f588b3c8ba5f 100644
--- a/flang/include/flang/Optimizer/Dialect/FIROps.td
+++ b/flang/include/flang/Optimizer/Dialect/FIROps.td
@@ -2735,8 +2735,9 @@ def fir_ConvertOp : fir_SimpleOneResultOp<"convert", [NoMemoryEffect]> {
}
def FortranTypeAttr : Attr<And<[CPred<"mlir::isa<mlir::TypeAttr>($_self)">,
- Or<[CPred<"mlir::isa<fir::CharacterType, fir::IntegerType,"
- "fir::LogicalType, mlir::FloatType, mlir::ComplexType,"
+ Or<[CPred<"mlir::isa<fir::CharacterType, fir::IntegerType, "
+ "fir::UnsignedType, fir::LogicalType, mlir::FloatType, "
+ "mlir::ComplexType, "
"fir::RecordType>(mlir::cast<mlir::TypeAttr>($_self).getValue())"
>]>]>, "Fortran surface type"> {
let storageType = [{ ::mlir::TypeAttr }];
diff --git a/flang/include/flang/Optimizer/Dialect/FIRTypes.td b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
index bfd00c34558349..3919c9191c2122 100644
--- a/flang/include/flang/Optimizer/Dialect/FIRTypes.td
+++ b/flang/include/flang/Optimizer/Dialect/FIRTypes.td
@@ -213,6 +213,22 @@ def fir_IntegerType : FIR_Type<"Integer", "int"> {
}];
}
+def fir_UnsignedType : FIR_Type<"Unsigned", "unsigned"> {
+ let summary = "FIR unsigned type";
+
+ let description = [{
+ Model of a Fortran UNSIGNED extension intrinsic type, including
+ the KIND type parameter.
+ }];
+
+ let parameters = (ins "KindTy":$fKind);
+ let hasCustomAssemblyFormat = 1;
+
+ let extraClassDeclaration = [{
+ using KindTy = unsigned;
+ }];
+}
+
def fir_LenType : FIR_Type<"Len", "len"> {
let summary = "A LEN parameter (in a RecordType) argument's type";
@@ -558,7 +574,8 @@ def fir_BaseBoxType : Type<IsBaseBoxTypePred, "fir.box or fir.class type">;
// Generalized FIR and standard dialect types representing intrinsic types
def AnyIntegerLike : TypeConstraint<Or<[SignlessIntegerLike.predicate,
- AnySignedInteger.predicate, fir_IntegerType.predicate]>, "any integer">;
+ AnySignedInteger.predicate, AnyUnsignedInteger.predicate,
+ fir_IntegerType.predicate, fir_UnsignedType.predicate]>, "any integer">;
def AnyLogicalLike : TypeConstraint<Or<[BoolLike.predicate,
fir_LogicalType.predicate]>, "any logical">;
def AnyRealLike : TypeConstraint<FloatLike.predicate, "any real">;
diff --git a/flang/include/flang/Optimizer/Support/Utils.h b/flang/include/flang/Optimizer/Support/Utils.h
index 2e25ef5f19bbe1..50024b10273118 100644
--- a/flang/include/flang/Optimizer/Support/Utils.h
+++ b/flang/include/flang/Optimizer/Support/Utils.h
@@ -162,15 +162,25 @@ mlirTypeToCategoryKind(mlir::Location loc, mlir::Type type) {
if (std::optional<int> kind = mlirFloatTypeToKind(cplxTy.getElementType()))
return {Fortran::common::TypeCategory::Complex, *kind};
} else if (type.isInteger(8))
- return {Fortran::common::TypeCategory::Integer, 1};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 1};
else if (type.isInteger(16))
- return {Fortran::common::TypeCategory::Integer, 2};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 2};
else if (type.isInteger(32))
- return {Fortran::common::TypeCategory::Integer, 4};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 4};
else if (type.isInteger(64))
- return {Fortran::common::TypeCategory::Integer, 8};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 8};
else if (type.isInteger(128))
- return {Fortran::common::TypeCategory::Integer, 16};
+ return {type.isUnsignedInteger() ? Fortran::common::TypeCategory::Unsigned
+ : Fortran::common::TypeCategory::Integer,
+ 16};
else if (auto logicalType = mlir::dyn_cast<fir::LogicalType>(type))
return {Fortran::common::TypeCategory::Logical, logicalType.getFKind()};
else if (auto charType = mlir::dyn_cast<fir::CharacterType>(type))
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 5886e384b986b6..ac1e2724d97dd8 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -772,6 +772,7 @@ class ParseTreeDumper {
NODE(Union, EndUnionStmt)
NODE(Union, UnionStmt)
NODE(parser, UnlockStmt)
+ NODE(parser, UnsignedLiteralConstant)
NODE(parser, UnsignedTypeSpec)
NODE(parser, UseStmt)
NODE_ENUM(UseStmt, ModuleNature)
@@ -894,7 +895,8 @@ class ParseTreeDumper {
asFortran_->call(ss, *x.typedCall);
}
} else if constexpr (std::is_same_v<T, IntLiteralConstant> ||
- std::is_same_v<T, SignedIntLiteralConstant>) {
+ std::is_same_v<T, SignedIntLiteralConstant> ||
+ std::is_same_v<T, UnsignedLiteralConstant>) {
ss << std::get<CharBlock>(x.t);
} else if constexpr (std::is_same_v<T, RealLiteralConstant::Real>) {
ss << x.source;
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 10d7840775e88d..fd89f289c7ab16 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -656,6 +656,8 @@ struct KindSelector {
// R705 integer-type-spec -> INTEGER [kind-selector]
WRAPPER_CLASS(IntegerTypeSpec, std::optional<KindSelector>);
+WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
+
// R723 char-length -> ( type-param-value ) | digit-string
struct CharLength {
UNION_CLASS_BOILERPLATE(CharLength);
@@ -693,7 +695,7 @@ struct CharSelector {
// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
// COMPLEX [kind-selector] | CHARACTER [char-selector] |
// LOGICAL [kind-selector]
-// Extensions: DOUBLE COMPLEX
+// Extensions: DOUBLE COMPLEX & UNSIGNED [kind-selector]
struct IntrinsicTypeSpec {
UNION_CLASS_BOILERPLATE(IntrinsicTypeSpec);
struct Real {
@@ -718,13 +720,12 @@ struct IntrinsicTypeSpec {
std::optional<KindSelector> kind;
};
EMPTY_CLASS(DoubleComplex);
- std::variant<IntegerTypeSpec, Real, DoublePrecision, Complex, Character,
- Logical, DoubleComplex>
+ std::variant<IntegerTypeSpec, UnsignedTypeSpec, Real, DoublePrecision,
+ Complex, Character, Logical, DoubleComplex>
u;
};
// Extension: Vector type
-WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
struct VectorElementType {
UNION_CLASS_BOILERPLATE(VectorElementType);
std::variant<IntegerTypeSpec, IntrinsicTypeSpec::Real, UnsignedTypeSpec> u;
@@ -802,6 +803,12 @@ struct IntLiteralConstant {
std::tuple<CharBlock, std::optional<KindParam>> t;
};
+// extension: unsigned-literal-constant -> digit-string U [_ kind-param]
+struct UnsignedLiteralConstant {
+ TUPLE_CLASS_BOILERPLATE(UnsignedLiteralConstant);
+ std::tuple<CharBlock, std::optional<KindParam>> t;
+};
+
// R712 sign -> + | -
enum class Sign { Positive, Negative };
@@ -893,7 +900,7 @@ struct LiteralConstant {
UNION_CLASS_BOILERPLATE(LiteralConstant);
std::variant<HollerithLiteralConstant, IntLiteralConstant,
RealLiteralConstant, ComplexLiteralConstant, BOZLiteralConstant,
- CharLiteralConstant, LogicalLiteralConstant>
+ CharLiteralConstant, LogicalLiteralConstant, UnsignedLiteralConstant>
u;
};
@@ -1467,7 +1474,8 @@ struct DataStmtConstant {
mutable TypedExpr typedExpr;
std::variant<LiteralConstant, SignedIntLiteralConstant,
SignedRealLiteralConstant, SignedComplexLiteralConstant, NullInit,
- common::Indirection<Designator>, StructureConstructor>
+ common::Indirection<Designator>, StructureConstructor,
+ UnsignedLiteralConstant>
u;
};
diff --git a/flang/include/flang/Runtime/cpp-type.h b/flang/include/flang/Runtime/cpp-type.h
index f6180b4a9ab60c..132c685b431967 100644
--- a/flang/include/flang/Runtime/cpp-type.h
+++ b/flang/include/flang/Runtime/cpp-type.h
@@ -47,6 +47,10 @@ template <int KIND> struct CppTypeForHelper<TypeCategory::Integer, KIND> {
using type = common::HostSignedIntType<8 * KIND>;
};
+template <int KIND> struct CppTypeForHelper<TypeCategory::Unsigned, KIND> {
+ using type = common::HostUnsignedIntType<8 * KIND>;
+};
+
#if HAS_FP16
template <> struct CppTypeForHelper<TypeCategory::Real, 2> {
using type = std::float16_t;
diff --git a/flang/include/flang/Runtime/numeric.h b/flang/include/flang/Runtime/numeric.h
index 9e6bf357861e75..794c8f4768826e 100644
--- a/flang/include/flang/Runtime/numeric.h
+++ b/flang/include/flang/Runtime/numeric.h
@@ -374,7 +374,7 @@ CppTypeFor<TypeCategory::Real, 16> RTDECL(Scale16)(
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedCharKind)(
const char *, int, const char *, std::size_t);
-// SELECTED_INT_KIND
+// SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKind)(
const char *, int, void *, int);
CppTypeFor<TypeCategory::Integer, 4> RTDECL(SelectedIntKindMasked)(
diff --git a/flang/include/flang/Runtime/reduce.h b/flang/include/flang/Runtime/reduce.h
index c63782b85f22f5..26a61be455b123 100644
--- a/flang/include/flang/Runtime/reduce.h
+++ b/flang/include/flang/Runtime/reduce.h
@@ -123,6 +123,89 @@ void RTDECL(ReduceInteger16DimValue)(Descriptor &result,
const common::int128_t *identity = nullptr, bool ordered = true);
#endif
+std::uint8_t RTDECL(ReduceUnsigned1Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+std::uint8_t RTDECL(ReduceUnsigned1Value)(const Descriptor &,
+ ValueReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned1DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned1DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint8_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint8_t *identity = nullptr, bool ordered = true);
+std::uint16_t RTDECL(ReduceUnsigned2Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+std::uint16_t RTDECL(ReduceUnsigned2Value)(const Descriptor &,
+ ValueReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned2DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned2DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint16_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint16_t *identity = nullptr, bool ordered = true);
+std::uint32_t RTDECL(ReduceUnsigned4Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+std::uint32_t RTDECL(ReduceUnsigned4Value)(const Descriptor &,
+ ValueReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned4DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned4DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint32_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint32_t *identity = nullptr, bool ordered = true);
+std::uint64_t RTDECL(ReduceUnsigned8Ref)(const Descriptor &,
+ ReferenceReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+std::uint64_t RTDECL(ReduceUnsigned8Value)(const Descriptor &,
+ ValueReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned8DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t>, const char *source, int line,
+ int dim, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned8DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<std::uint64_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const std::uint64_t *identity = nullptr, bool ordered = true);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(ReduceUnsigned16Ref)(const Descriptor &,
+ ReferenceReductionOperation<common::uint128_t>, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+common::uint128_t RTDECL(ReduceUnsigned16Value)(const Descriptor &,
+ ValueReductionOperation<common::uint128_t>, const char *source, int line,
+ int dim = 0, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned16DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t>, const char *source,
+ int line, int dim, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+void RTDECL(ReduceUnsigned16DimValue)(Descriptor &result,
+ const Descriptor &array, ValueReductionOperation<common::uint128_t>,
+ const char *source, int line, int dim, const Descriptor *mask = nullptr,
+ const common::uint128_t *identity = nullptr, bool ordered = true);
+#endif
+
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(ReduceReal2Ref)(const Descriptor &,
ReferenceReductionOperation<float>, const char *source, int line,
diff --git a/flang/include/flang/Runtime/reduction.h b/flang/include/flang/Runtime/reduction.h
index 91811581f645d5..6945ed4a653204 100644
--- a/flang/include/flang/Runtime/reduction.h
+++ b/flang/include/flang/Runtime/reduction.h
@@ -58,6 +58,18 @@ std::int64_t RTDECL(SumInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(SumInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(SumUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(SumUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(SumUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(SumUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(SumUnsigned16)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#endif
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(SumReal2)(const Descriptor &, const char *source, int line,
@@ -119,6 +131,19 @@ common::int128_t RTDECL(ProductInteger16)(const Descriptor &,
const char *source, int line, int dim = 0,
const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(ProductUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(ProductUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(ProductUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(ProductUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(ProductUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
// REAL/COMPLEX(2 & 3) return 32-bit float results for the caller to downconvert
float RTDECL(ProductReal2)(const Descriptor &, const char *source, int line,
@@ -239,6 +264,21 @@ void RTDECL(MaxlocInteger8)(Descriptor &, const Descriptor &, int kind,
void RTDECL(MaxlocInteger16)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
+void RTDECL(MaxlocUnsigned1)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned2)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned4)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned8)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MaxlocUnsigned16)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
void RTDECL(MaxlocReal4)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
@@ -272,6 +312,21 @@ void RTDECL(MinlocInteger8)(Descriptor &, const Descriptor &, int kind,
void RTDECL(MinlocInteger16)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
+void RTDECL(MinlocUnsigned1)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned2)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned4)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned8)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
+void RTDECL(MinlocUnsigned16)(Descriptor &, const Descriptor &, int kind,
+ const char *source, int line, const Descriptor *mask = nullptr,
+ bool back = false);
void RTDECL(MinlocReal4)(Descriptor &, const Descriptor &, int kind,
const char *source, int line, const Descriptor *mask = nullptr,
bool back = false);
@@ -301,6 +356,19 @@ std::int64_t RTDECL(MaxvalInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(MaxvalInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(MaxvalUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(MaxvalUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(MaxvalUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(MaxvalUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(MaxvalUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
float RTDECL(MaxvalReal2)(const Descriptor &, const char *source, int line,
int dim = 0, const Descriptor *mask = nullptr);
float RTDECL(MaxvalReal3)(const Descriptor &, const char *source, int line,
@@ -333,6 +401,19 @@ std::int64_t RTDECL(MinvalInteger8)(const Descriptor &, const char *source,
common::int128_t RTDECL(MinvalInteger16)(const Descriptor &, const char *source,
int line, int dim = 0, const Descriptor *mask = nullptr);
#endif
+std::uint8_t RTDECL(MinvalUnsigned1)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint16_t RTDECL(MinvalUnsigned2)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint32_t RTDECL(MinvalUnsigned4)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+std::uint64_t RTDECL(MinvalUnsigned8)(const Descriptor &, const char *source,
+ int line, int dim = 0, const Descriptor *mask = nullptr);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(MinvalUnsigned16)(const Descriptor &,
+ const char *source, int line, int dim = 0,
+ const Descriptor *mask = nullptr);
+#endif
float RTDECL(MinvalReal2)(const Descriptor &, const char *source, int line,
int dim = 0, const Descriptor *mask = nullptr);
float RTDECL(MinvalReal3)(const Descriptor &, const char *source, int line,
@@ -409,6 +490,18 @@ std::int64_t RTDECL(DotProductInteger8)(const Descriptor &, const Descriptor &,
common::int128_t RTDECL(DotProductInteger16)(const Descriptor &,
const Descriptor &, const char *source = nullptr, int line = 0);
#endif
+std::uint8_t RTDECL(DotProductUnsigned1)(const Descriptor &, const Descriptor &,
+ const char *source = nullptr, int line = 0);
+std::uint16_t RTDECL(DotProductUnsigned2)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+std::uint32_t RTDECL(DotProductUnsigned4)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+std::uint64_t RTDECL(DotProductUnsigned8)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDECL(DotProductUnsigned16)(const Descriptor &,
+ const Descriptor &, const char *source = nullptr, int line = 0);
+#endif
float RTDECL(DotProductReal2)(const Descriptor &, const Descriptor &,
const char *source = nullptr, int line = 0);
float RTDECL(DotProductReal3)(const Descriptor &, const Descriptor &,
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index a90801db7338cc..bb1674a9f88778 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -274,6 +274,7 @@ class ExpressionAnalyzer {
}
MaybeExpr Analyze(const parser::IntLiteralConstant &, bool negated = false);
+ MaybeExpr Analyze(const parser::UnsignedLiteralConstant &);
MaybeExpr Analyze(const parser::RealLiteralConstant &);
MaybeExpr Analyze(const parser::ComplexPart &);
MaybeExpr Analyze(const parser::ComplexLiteralConstant &);
@@ -327,8 +328,8 @@ class ExpressionAnalyzer {
const std::optional<parser::KindParam> &, int defaultKind);
template <typename PARSED>
MaybeExpr ExprOrVariable(const PARSED &, parser::CharBlock source);
- template <typename PARSED>
- MaybeExpr IntLiteralConstant(const PARSED &, bool negated = false);
+ template <typename TYPES, TypeCategory CAT, typename PARSED>
+ MaybeExpr IntLiteralConstant(const PARSED &, bool isNegated = false);
MaybeExpr AnalyzeString(std::string &&, int kind);
std::optional<Expr<SubscriptInteger>> AsSubscript(MaybeExpr &&);
std::optional<Expr<SubscriptInteger>> TripletPart(
diff --git a/flang/lib/Common/default-kinds.cpp b/flang/lib/Common/default-kinds.cpp
index 0c708fcd605094..fbafd827ff0d0b 100644
--- a/flang/lib/Common/default-kinds.cpp
+++ b/flang/lib/Common/default-kinds.cpp
@@ -68,6 +68,7 @@ IntrinsicTypeDefaultKinds &IntrinsicTypeDefaultKinds::set_defaultLogicalKind(
int IntrinsicTypeDefaultKinds::GetDefaultKind(TypeCategory category) const {
switch (category) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
return defaultIntegerKind_;
case TypeCategory::Real:
case TypeCategory::Complex:
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index 1a65d4c7362fea..9514ac8e3f6565 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -229,6 +229,12 @@ bool Expr<Type<TypeCategory::Character, KIND>>::operator==(
return u == that.u;
}
+template <int KIND>
+bool Expr<Type<TypeCategory::Unsigned, KIND>>::operator==(
+ const Expr<Type<TypeCategory::Unsigned, KIND>> &that) const {
+ return u == that.u;
+}
+
template <TypeCategory CAT>
bool Expr<SomeKind<CAT>>::operator==(const Expr<SomeKind<CAT>> &that) const {
return u == that.u;
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index b9c75448b75422..c82995c38f79f7 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -794,6 +794,7 @@ template <typename T> Expr<T> Folder<T>::EOSHIFT(FunctionRef<T> &&funcRef) {
}
resultElements.push_back(boundary->At(boundaryAt));
} else if constexpr (T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex ||
T::category == TypeCategory::Logical) {
@@ -1086,6 +1087,7 @@ template <typename T>
Expr<T> FoldMINorMAX(
FoldingContext &context, FunctionRef<T> &&funcRef, Ordering order) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Character);
auto &args{funcRef.arguments()};
@@ -1183,6 +1185,10 @@ template <int KIND>
Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
FoldingContext &context, FunctionRef<Type<TypeCategory::Integer, KIND>> &&);
template <int KIND>
+Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&);
+template <int KIND>
Expr<Type<TypeCategory::Real, KIND>> FoldIntrinsicFunction(
FoldingContext &context, FunctionRef<Type<TypeCategory::Real, KIND>> &&);
template <int KIND>
@@ -1741,6 +1747,17 @@ Expr<TO> FoldOperation(
converted.value.SignedDecimal());
}
return ScalarConstantToExpr(std::move(converted.value));
+ } else if constexpr (FromCat == TypeCategory::Unsigned) {
+ auto converted{Scalar<TO>::ConvertUnsigned(*value)};
+ if ((converted.overflow || converted.value.IsNegative()) &&
+ msvcWorkaround.context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ ctx.messages().Say(common::UsageWarning::FoldingException,
+ "conversion of %s_U%d to INTEGER(%d) overflowed; result is %s"_warn_en_US,
+ value->UnsignedDecimal(), Operand::kind, TO::kind,
+ converted.value.SignedDecimal());
+ }
+ return ScalarConstantToExpr(std::move(converted.value));
} else if constexpr (FromCat == TypeCategory::Real) {
auto converted{value->template ToInteger<Scalar<TO>>()};
if (msvcWorkaround.context.languageFeatures().ShouldWarn(
@@ -1757,9 +1774,20 @@ Expr<TO> FoldOperation(
}
return ScalarConstantToExpr(std::move(converted.value));
}
+ } else if constexpr (TO::category == TypeCategory::Unsigned) {
+ if constexpr (FromCat == TypeCategory::Integer ||
+ FromCat == TypeCategory::Unsigned) {
+ return Expr<TO>{
+ Constant<TO>{Scalar<TO>::ConvertUnsigned(*value).value}};
+ } else if constexpr (FromCat == TypeCategory::Real) {
+ return Expr<TO>{
+ Constant<TO>{value->template ToInteger<Scalar<TO>>().value}};
+ }
} else if constexpr (TO::category == TypeCategory::Real) {
- if constexpr (FromCat == TypeCategory::Integer) {
- auto converted{Scalar<TO>::FromInteger(*value)};
+ if constexpr (FromCat == TypeCategory::Integer ||
+ FromCat == TypeCategory::Unsigned) {
+ auto converted{Scalar<TO>::FromInteger(
+ *value, FromCat == TypeCategory::Unsigned)};
if (!converted.flags.empty()) {
char buffer[64];
std::snprintf(buffer, sizeof buffer,
@@ -1869,6 +1897,8 @@ Expr<T> FoldOperation(FoldingContext &context, Negate<T> &&x) {
"INTEGER(%d) negation overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{std::move(negated.value)}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{Constant<T>{std::move(value->Negate().value)}};
} else {
// REAL & COMPLEX negation: no exceptions possible
return Expr<T>{Constant<T>{value->Negate()}};
@@ -1911,6 +1941,9 @@ Expr<T> FoldOperation(FoldingContext &context, Add<T> &&x) {
"INTEGER(%d) addition overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{sum.value}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.AddUnsigned(folded->second).value}};
} else {
auto sum{folded->first.Add(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -1939,6 +1972,9 @@ Expr<T> FoldOperation(FoldingContext &context, Subtract<T> &&x) {
"INTEGER(%d) subtraction overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{difference.value}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.SubtractSigned(folded->second).value}};
} else {
auto difference{folded->first.Subtract(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -1967,6 +2003,9 @@ Expr<T> FoldOperation(FoldingContext &context, Multiply<T> &&x) {
"INTEGER(%d) multiplication overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{product.lower}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ return Expr<T>{
+ Constant<T>{folded->first.MultiplyUnsigned(folded->second).lower}};
} else {
auto product{folded->first.Multiply(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2021,6 +2060,17 @@ Expr<T> FoldOperation(FoldingContext &context, Divide<T> &&x) {
"INTEGER(%d) division overflowed"_warn_en_US, T::kind);
}
return Expr<T>{Constant<T>{quotAndRem.quotient}};
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ auto quotAndRem{folded->first.DivideUnsigned(folded->second)};
+ if (quotAndRem.divisionByZero) {
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "UNSIGNED(%d) division by zero"_warn_en_US, T::kind);
+ }
+ return Expr<T>{std::move(x)};
+ }
+ return Expr<T>{Constant<T>{quotAndRem.quotient}};
} else {
auto quotient{folded->first.Divide(
folded->second, context.targetCharacteristics().roundingMode())};
@@ -2121,6 +2171,10 @@ Expr<T> FoldOperation(FoldingContext &context, Extremum<T> &&x) {
if (folded->first.CompareSigned(folded->second) == x.ordering) {
return Expr<T>{Constant<T>{folded->first}};
}
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ if (folded->first.CompareUnsigned(folded->second) == x.ordering) {
+ return Expr<T>{Constant<T>{folded->first}};
+ }
} else if constexpr (T::category == TypeCategory::Real) {
if (folded->first.IsNotANumber() ||
(folded->first.Compare(folded->second) == Relation::Less) ==
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 0ad09d76a6555d..d51b164b79eb21 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -535,7 +535,8 @@ template <typename T>
static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
Scalar<T> (Scalar<T>::*operation)(const Scalar<T> &) const,
Scalar<T> identity) {
- static_assert(T::category == TypeCategory::Integer);
+ static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned);
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
ProcessReductionArgs<T>(context, ref.arguments(), dim,
@@ -547,78 +548,17 @@ static Expr<T> FoldBitReduction(FoldingContext &context, FunctionRef<T> &&ref,
return Expr<T>{std::move(ref)};
}
-template <int KIND>
-Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
- FoldingContext &context,
- FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
- using T = Type<TypeCategory::Integer, KIND>;
- using Int4 = Type<TypeCategory::Integer, 4>;
+// Common cases for INTEGER and UNSIGNED
+template <typename T>
+std::optional<Expr<T>> FoldIntrinsicFunctionCommon(
+ FoldingContext &context, FunctionRef<T> &funcRef) {
ActualArguments &args{funcRef.arguments()};
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
- auto FromInt64{[&name, &context](std::int64_t n) {
- Scalar<T> result{n};
- if (result.ToInt64() != n &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
- name, std::intmax_t{n});
- }
- return result;
- }};
- if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
- return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
- ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
- typename Scalar<T>::ValueWithOverflow j{i.ABS()};
- if (j.overflow &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
- }
- return j.value;
- }));
- } else if (name == "bit_size") {
+ using Int4 = Type<TypeCategory::Integer, 4>;
+ if (name == "bit_size") {
return Expr<T>{Scalar<T>::bits};
- } else if (name == "ceiling" || name == "floor" || name == "nint") {
- if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- // NINT rounds ties away from zero, not to even
- common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
- : name == "floor" ? common::RoundingMode::Down
- : common::RoundingMode::TiesAwayFromZero};
- return common::visit(
- [&](const auto &kx) {
- using TR = ResultType<decltype(kx)>;
- return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
- ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
- auto y{x.template ToInteger<Scalar<T>>(mode)};
- if (y.flags.test(RealFlag::Overflow) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(
- common::UsageWarning::FoldingException,
- "%s intrinsic folding overflow"_warn_en_US, name);
- }
- return y.value;
- }));
- },
- cx->u);
- }
- } else if (name == "count") {
- int maskKind = args[0]->GetType()->kind();
- switch (maskKind) {
- SWITCH_COVERS_ALL_CASES
- case 1:
- return FoldCount<T, 1>(context, std::move(funcRef));
- case 2:
- return FoldCount<T, 2>(context, std::move(funcRef));
- case 4:
- return FoldCount<T, 4>(context, std::move(funcRef));
- case 8:
- return FoldCount<T, 8>(context, std::move(funcRef));
- }
} else if (name == "digits") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return Expr<T>{common::visit(
@@ -626,6 +566,12 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Scalar<ResultType<decltype(kx)>>::DIGITS;
},
cx->u)};
+ } else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
+ return Expr<T>{common::visit(
+ [](const auto &kx) {
+ return Scalar<ResultType<decltype(kx)>>::DIGITS + 1;
+ },
+ cx->u)};
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
[](const auto &kx) {
@@ -639,19 +585,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
cx->u)};
}
- } else if (name == "dim") {
- return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
- ScalarFunc<T, T, T>([&context](const Scalar<T> &x,
- const Scalar<T> &y) -> Scalar<T> {
- auto result{x.DIM(y)};
- if (result.overflow &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::FoldingException)) {
- context.messages().Say(common::UsageWarning::FoldingException,
- "DIM intrinsic folding overflow"_warn_en_US);
- }
- return result.value;
- }));
} else if (name == "dot_product") {
return FoldDotProduct<T>(context, std::move(funcRef));
} else if (name == "dshiftl" || name == "dshiftr") {
@@ -682,66 +615,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
const Scalar<Int4> &shift) -> Scalar<T> {
return std::invoke(fptr, i, j, static_cast<int>(shift.ToInt64()));
}));
- } else if (name == "exponent") {
- if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
- return common::visit(
- [&funcRef, &context](const auto &x) -> Expr<T> {
- using TR = typename std::decay_t<decltype(x)>::Result;
- return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
- &Scalar<TR>::template EXPONENT<Scalar<T>>);
- },
- sx->u);
- } else {
- DIE("exponent argument must be real");
- }
- } else if (name == "findloc") {
- return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
- } else if (name == "huge") {
- return Expr<T>{Scalar<T>::HUGE()};
- } else if (name == "iachar" || name == "ichar") {
- auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
- CHECK(someChar);
- if (auto len{ToInt64(someChar->LEN())}) {
- if (len.value() < 1) {
- context.messages().Say(
- "Character in intrinsic function %s must have length one"_err_en_US,
- name);
- } else if (len.value() > 1 &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::Portability)) {
- // Do not die, this was not checked before
- context.messages().Say(common::UsageWarning::Portability,
- "Character in intrinsic function %s should have length one"_port_en_US,
- name);
- } else {
- return common::visit(
- [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
- using Char = typename std::decay_t<decltype(str)>::Result;
- (void)FromInt64;
- return FoldElementalIntrinsic<T, Char>(context,
- std::move(funcRef),
- ScalarFunc<T, Char>(
-#ifndef _MSC_VER
- [&FromInt64](const Scalar<Char> &c) {
- return FromInt64(CharacterUtils<Char::kind>::ICHAR(
- CharacterUtils<Char::kind>::Resize(c, 1)));
- }));
-#else // _MSC_VER
- // MSVC 14 get confused by the original code above and
- // ends up emitting an error about passing a std::string
- // to the std::u16string instantiation of
- // CharacterUtils<2>::ICHAR(). Can't find a work-around,
- // so remove the FromInt64 error checking lambda that
- // seems to have caused the proble.
- [](const Scalar<Char> &c) {
- return CharacterUtils<Char::kind>::ICHAR(
- CharacterUtils<Char::kind>::Resize(c, 1));
- }));
-#endif // _MSC_VER
- },
- someChar->u);
- }
- }
} else if (name == "iand" || name == "ior" || name == "ieor") {
auto fptr{&Scalar<T>::IAND};
if (name == "iand") { // done in fptr declaration
@@ -827,13 +700,346 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
}
}
- return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
- ScalarFunc<T, T, Int4, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &pos,
- const Scalar<Int4> &len) -> Scalar<T> {
- return i.IBITS(static_cast<int>(pos.ToInt64()),
- static_cast<int>(len.ToInt64()));
- }));
+ return FoldElementalIntrinsic<T, T, Int4, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, T, Int4, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &pos,
+ const Scalar<Int4> &len) -> Scalar<T> {
+ return i.IBITS(static_cast<int>(pos.ToInt64()),
+ static_cast<int>(len.ToInt64()));
+ }));
+ } else if (name == "int" || name == "int2" || name == "int8" ||
+ name == "uint") {
+ if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+ return common::visit(
+ [&](auto &&x) -> Expr<T> {
+ using From = std::decay_t<decltype(x)>;
+ if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
+ IsNumericCategoryExpr<From>()) {
+ return Fold(context, ConvertToType<T>(std::move(x)));
+ }
+ DIE("int() argument type not valid");
+ },
+ std::move(expr->u));
+ }
+ } else if (name == "iparity") {
+ return FoldBitReduction(
+ context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
+ } else if (name == "ishft" || name == "ishftc") {
+ const auto *argCon{Folder<T>(context).Folding(args[0])};
+ const auto *shiftCon{Folder<Int4>(context).Folding(args[1])};
+ const auto *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
+ const auto *sizeCon{args.size() == 3
+ ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
+ args[2])
+ : nullptr};
+ const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
+ if ((argCon && argCon->empty()) || !shiftVals || shiftVals->empty() ||
+ (sizeVals && sizeVals->empty())) {
+ // size= and shift= values don't need to be checked
+ } else {
+ for (const auto &scalar : *shiftVals) {
+ std::int64_t shiftVal{scalar.ToInt64()};
+ if (shiftVal < -T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is less than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, -T::Scalar::bits);
+ break;
+ } else if (shiftVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is greater than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ break;
+ }
+ }
+ if (sizeVals) {
+ for (const auto &scalar : *sizeVals) {
+ std::int64_t sizeVal{scalar.ToInt64()};
+ if (sizeVal <= 0) {
+ context.messages().Say(
+ "SIZE=%jd count for ishftc is not positive"_err_en_US,
+ std::intmax_t{sizeVal}, name);
+ break;
+ } else if (sizeVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SIZE=%jd count for ishftc is greater than %d"_err_en_US,
+ std::intmax_t{sizeVal}, T::Scalar::bits);
+ break;
+ }
+ }
+ if (shiftVals->size() == 1 || sizeVals->size() == 1 ||
+ shiftVals->size() == sizeVals->size()) {
+ auto iters{std::max(shiftVals->size(), sizeVals->size())};
+ for (std::size_t j{0}; j < iters; ++j) {
+ auto shiftVal{static_cast<int>(
+ (*shiftVals)[j % shiftVals->size()].ToInt64())};
+ auto sizeVal{
+ static_cast<int>((*sizeVals)[j % sizeVals->size()].ToInt64())};
+ if (sizeVal > 0 && std::abs(shiftVal) > sizeVal) {
+ context.messages().Say(
+ "SHIFT=%jd count for ishftc is greater in magnitude than SIZE=%jd"_err_en_US,
+ std::intmax_t{shiftVal}, std::intmax_t{sizeVal});
+ break;
+ }
+ }
+ }
+ }
+ }
+ if (name == "ishft") {
+ return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, T, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
+ return i.ISHFT(static_cast<int>(shift.ToInt64()));
+ }));
+ } else if (!args.at(2)) { // ISHFTC(no SIZE=)
+ return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, T, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
+ return i.ISHFTC(static_cast<int>(shift.ToInt64()));
+ }));
+ } else { // ISHFTC(with SIZE=)
+ return FoldElementalIntrinsic<T, T, Int4, Int4>(context,
+ std::move(funcRef),
+ ScalarFunc<T, T, Int4, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &shift,
+ const Scalar<Int4> &size) -> Scalar<T> {
+ auto shiftVal{static_cast<int>(shift.ToInt64())};
+ auto sizeVal{static_cast<int>(size.ToInt64())};
+ return i.ISHFTC(shiftVal, sizeVal);
+ }),
+ /*hasOptionalArgument=*/true);
+ }
+ } else if (name == "izext" || name == "jzext") {
+ if (args.size() == 1) {
+ if (auto *expr{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
+ // Rewrite to IAND(INT(n,k),255_k) for k=KIND(T)
+ intrinsic->name = "iand";
+ auto converted{ConvertToType<T>(std::move(*expr))};
+ *expr =
+ Fold(context, Expr<SomeKind<T::category>>{std::move(converted)});
+ args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
+ return FoldIntrinsicFunction(context, std::move(funcRef));
+ }
+ }
+ } else if (name == "maskl" || name == "maskr" || name == "umaskl" ||
+ name == "umaskr") {
+ // Argument can be of any kind but value has to be smaller than BIT_SIZE.
+ // It can be safely converted to Int4 to simplify.
+ const auto fptr{name == "maskl" || name == "umaskl" ? &Scalar<T>::MASKL
+ : &Scalar<T>::MASKR};
+ return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
+ return fptr(static_cast<int>(places.ToInt64()));
+ }));
+ } else if (name == "matmul") {
+ return FoldMatmul(context, std::move(funcRef));
+ } else if (name == "max") {
+ return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
+ } else if (name == "maxval") {
+ return FoldMaxvalMinval<T>(context, std::move(funcRef),
+ RelationalOperator::GT, T::Scalar::Least());
+ } else if (name == "merge_bits") {
+ return FoldElementalIntrinsic<T, T, T, T>(
+ context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
+ } else if (name == "min") {
+ return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
+ } else if (name == "minval") {
+ return FoldMaxvalMinval<T>(
+ context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
+ } else if (name == "not") {
+ return FoldElementalIntrinsic<T, T>(
+ context, std::move(funcRef), &Scalar<T>::NOT);
+ } else if (name == "product") {
+ return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
+ } else if (name == "radix") {
+ return Expr<T>{2};
+ } else if (name == "shifta" || name == "shiftr" || name == "shiftl") {
+ // Second argument can be of any kind. However, it must be smaller or
+ // equal than BIT_SIZE. It can be converted to Int4 to simplify.
+ auto fptr{&Scalar<T>::SHIFTA};
+ if (name == "shifta") { // done in fptr definition
+ } else if (name == "shiftr") {
+ fptr = &Scalar<T>::SHIFTR;
+ } else if (name == "shiftl") {
+ fptr = &Scalar<T>::SHIFTL;
+ } else {
+ common::die("missing case to fold intrinsic function %s", name.c_str());
+ }
+ if (const auto *argCon{Folder<T>(context).Folding(args[0])};
+ argCon && argCon->empty()) {
+ } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[1])}) {
+ for (const auto &scalar : shiftCon->values()) {
+ std::int64_t shiftVal{scalar.ToInt64()};
+ if (shiftVal < 0) {
+ context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
+ std::intmax_t{shiftVal}, name, -T::Scalar::bits);
+ break;
+ } else if (shiftVal > T::Scalar::bits) {
+ context.messages().Say(
+ "SHIFT=%jd count for %s is greater than %d"_err_en_US,
+ std::intmax_t{shiftVal}, name, T::Scalar::bits);
+ break;
+ }
+ }
+ }
+ return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
+ ScalarFunc<T, T, Int4>(
+ [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
+ return std::invoke(fptr, i, static_cast<int>(shift.ToInt64()));
+ }));
+ } else if (name == "sum") {
+ return FoldSum<T>(context, std::move(funcRef));
+ }
+ return std::nullopt;
+}
+
+template <int KIND>
+Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
+ if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
+ return std::move(*foldedCommon);
+ }
+
+ using T = Type<TypeCategory::Integer, KIND>;
+ ActualArguments &args{funcRef.arguments()};
+ auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
+ CHECK(intrinsic);
+ std::string name{intrinsic->name};
+
+ auto FromInt64{[&name, &context](std::int64_t n) {
+ Scalar<T> result{n};
+ if (result.ToInt64() != n &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "Result of intrinsic function '%s' (%jd) overflows its result type"_warn_en_US,
+ name, std::intmax_t{n});
+ }
+ return result;
+ }};
+
+ if (name == "abs") { // incl. babs, iiabs, jiaabs, & kiabs
+ return FoldElementalIntrinsic<T, T>(context, std::move(funcRef),
+ ScalarFunc<T, T>([&context](const Scalar<T> &i) -> Scalar<T> {
+ typename Scalar<T>::ValueWithOverflow j{i.ABS()};
+ if (j.overflow &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "abs(integer(kind=%d)) folding overflowed"_warn_en_US, KIND);
+ }
+ return j.value;
+ }));
+ } else if (name == "ceiling" || name == "floor" || name == "nint") {
+ if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
+ // NINT rounds ties away from zero, not to even
+ common::RoundingMode mode{name == "ceiling" ? common::RoundingMode::Up
+ : name == "floor" ? common::RoundingMode::Down
+ : common::RoundingMode::TiesAwayFromZero};
+ return common::visit(
+ [&](const auto &kx) {
+ using TR = ResultType<decltype(kx)>;
+ return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
+ ScalarFunc<T, TR>([&](const Scalar<TR> &x) {
+ auto y{x.template ToInteger<Scalar<T>>(mode)};
+ if (y.flags.test(RealFlag::Overflow) &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(
+ common::UsageWarning::FoldingException,
+ "%s intrinsic folding overflow"_warn_en_US, name);
+ }
+ return y.value;
+ }));
+ },
+ cx->u);
+ }
+ } else if (name == "count") {
+ int maskKind = args[0]->GetType()->kind();
+ switch (maskKind) {
+ SWITCH_COVERS_ALL_CASES
+ case 1:
+ return FoldCount<T, 1>(context, std::move(funcRef));
+ case 2:
+ return FoldCount<T, 2>(context, std::move(funcRef));
+ case 4:
+ return FoldCount<T, 4>(context, std::move(funcRef));
+ case 8:
+ return FoldCount<T, 8>(context, std::move(funcRef));
+ }
+ } else if (name == "dim") {
+ return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ ScalarFunc<T, T, T>(
+ [&context](const Scalar<T> &x, const Scalar<T> &y) -> Scalar<T> {
+ auto result{x.DIM(y)};
+ if (result.overflow &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingException)) {
+ context.messages().Say(common::UsageWarning::FoldingException,
+ "DIM intrinsic folding overflow"_warn_en_US);
+ }
+ return result.value;
+ }));
+ } else if (name == "exponent") {
+ if (auto *sx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
+ return common::visit(
+ [&funcRef, &context](const auto &x) -> Expr<T> {
+ using TR = typename std::decay_t<decltype(x)>::Result;
+ return FoldElementalIntrinsic<T, TR>(context, std::move(funcRef),
+ &Scalar<TR>::template EXPONENT<Scalar<T>>);
+ },
+ sx->u);
+ } else {
+ DIE("exponent argument must be real");
+ }
+ } else if (name == "findloc") {
+ return FoldLocation<WhichLocation::Findloc, T>(context, std::move(funcRef));
+ } else if (name == "huge") {
+ return Expr<T>{Scalar<T>::HUGE()};
+ } else if (name == "iachar" || name == "ichar") {
+ auto *someChar{UnwrapExpr<Expr<SomeCharacter>>(args[0])};
+ CHECK(someChar);
+ if (auto len{ToInt64(someChar->LEN())}) {
+ if (len.value() < 1) {
+ context.messages().Say(
+ "Character in intrinsic function %s must have length one"_err_en_US,
+ name);
+ } else if (len.value() > 1 &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::Portability)) {
+ // Do not die, this was not checked before
+ context.messages().Say(common::UsageWarning::Portability,
+ "Character in intrinsic function %s should have length one"_port_en_US,
+ name);
+ } else {
+ return common::visit(
+ [&funcRef, &context, &FromInt64](const auto &str) -> Expr<T> {
+ using Char = typename std::decay_t<decltype(str)>::Result;
+ (void)FromInt64;
+ return FoldElementalIntrinsic<T, Char>(context,
+ std::move(funcRef),
+ ScalarFunc<T, Char>(
+#ifndef _MSC_VER
+ [&FromInt64](const Scalar<Char> &c) {
+ return FromInt64(CharacterUtils<Char::kind>::ICHAR(
+ CharacterUtils<Char::kind>::Resize(c, 1)));
+ }));
+#else // _MSC_VER
+ // MSVC 14 get confused by the original code above and
+ // ends up emitting an error about passing a std::string
+ // to the std::u16string instantiation of
+ // CharacterUtils<2>::ICHAR(). Can't find a work-around,
+ // so remove the FromInt64 error checking lambda that
+ // seems to have caused the proble.
+ [](const Scalar<Char> &c) {
+ return CharacterUtils<Char::kind>::ICHAR(
+ CharacterUtils<Char::kind>::Resize(c, 1));
+ }));
+#endif // _MSC_VER
+ },
+ someChar->u);
+ }
+ }
} else if (name == "index" || name == "scan" || name == "verify") {
if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) {
return common::visit(
@@ -873,19 +1079,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else {
DIE("first argument must be CHARACTER");
}
- } else if (name == "int" || name == "int2" || name == "int8") {
- if (auto *expr{UnwrapExpr<Expr<SomeType>>(args[0])}) {
- return common::visit(
- [&](auto &&x) -> Expr<T> {
- using From = std::decay_t<decltype(x)>;
- if constexpr (std::is_same_v<From, BOZLiteralConstant> ||
- IsNumericCategoryExpr<From>()) {
- return Fold(context, ConvertToType<T>(std::move(x)));
- }
- DIE("int() argument type not valid");
- },
- std::move(expr->u));
- }
} else if (name == "int_ptr_kind") {
return Expr<T>{8};
} else if (name == "kind") {
@@ -906,109 +1099,11 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{dyType->kind()};
}
}
- } else if (name == "iparity") {
- return FoldBitReduction(
- context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{});
- } else if (name == "ishft" || name == "ishftc") {
- const auto *argCon{Folder<T>(context).Folding(args[0])};
- const auto *shiftCon{Folder<Int4>(context).Folding(args[1])};
- const auto *shiftVals{shiftCon ? &shiftCon->values() : nullptr};
- const auto *sizeCon{args.size() == 3
- ? Folder<Int4>{context, /*forOptionalArgument=*/true}.Folding(
- args[2])
- : nullptr};
- const auto *sizeVals{sizeCon ? &sizeCon->values() : nullptr};
- if ((argCon && argCon->empty()) || !shiftVals || shiftVals->empty() ||
- (sizeVals && sizeVals->empty())) {
- // size= and shift= values don't need to be checked
- } else {
- for (const auto &scalar : *shiftVals) {
- std::int64_t shiftVal{scalar.ToInt64()};
- if (shiftVal < -T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is less than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, -T::Scalar::bits);
- break;
- } else if (shiftVal > T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
- break;
- }
- }
- if (sizeVals) {
- for (const auto &scalar : *sizeVals) {
- std::int64_t sizeVal{scalar.ToInt64()};
- if (sizeVal <= 0) {
- context.messages().Say(
- "SIZE=%jd count for ishftc is not positive"_err_en_US,
- std::intmax_t{sizeVal}, name);
- break;
- } else if (sizeVal > T::Scalar::bits) {
- context.messages().Say(
- "SIZE=%jd count for ishftc is greater than %d"_err_en_US,
- std::intmax_t{sizeVal}, T::Scalar::bits);
- break;
- }
- }
- if (shiftVals->size() == 1 || sizeVals->size() == 1 ||
- shiftVals->size() == sizeVals->size()) {
- auto iters{std::max(shiftVals->size(), sizeVals->size())};
- for (std::size_t j{0}; j < iters; ++j) {
- auto shiftVal{static_cast<int>(
- (*shiftVals)[j % shiftVals->size()].ToInt64())};
- auto sizeVal{
- static_cast<int>((*sizeVals)[j % sizeVals->size()].ToInt64())};
- if (sizeVal > 0 && std::abs(shiftVal) > sizeVal) {
- context.messages().Say(
- "SHIFT=%jd count for ishftc is greater in magnitude than SIZE=%jd"_err_en_US,
- std::intmax_t{shiftVal}, std::intmax_t{sizeVal});
- break;
- }
- }
- }
- }
- }
- if (name == "ishft") {
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
- ScalarFunc<T, T, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
- return i.ISHFT(static_cast<int>(shift.ToInt64()));
- }));
- } else if (!args.at(2)) { // ISHFTC(no SIZE=)
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
- ScalarFunc<T, T, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
- return i.ISHFTC(static_cast<int>(shift.ToInt64()));
- }));
- } else { // ISHFTC(with SIZE=)
- return FoldElementalIntrinsic<T, T, Int4, Int4>(context,
- std::move(funcRef),
- ScalarFunc<T, T, Int4, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &shift,
- const Scalar<Int4> &size) -> Scalar<T> {
- auto shiftVal{static_cast<int>(shift.ToInt64())};
- auto sizeVal{static_cast<int>(size.ToInt64())};
- return i.ISHFTC(shiftVal, sizeVal);
- }),
- /*hasOptionalArgument=*/true);
- }
- } else if (name == "izext" || name == "jzext") {
- if (args.size() == 1) {
- if (auto *expr{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
- // Rewrite to IAND(INT(n,k),255_k) for k=KIND(T)
- intrinsic->name = "iand";
- auto converted{ConvertToType<T>(std::move(*expr))};
- *expr = Fold(context, Expr<SomeInteger>{std::move(converted)});
- args.emplace_back(AsGenericExpr(Expr<T>{Scalar<T>{255}}));
- return FoldIntrinsicFunction(context, std::move(funcRef));
- }
- }
} else if (name == "lbound") {
return LBOUND(context, std::move(funcRef));
} else if (name == "leadz" || name == "trailz" || name == "poppar" ||
name == "popcnt") {
- if (auto *sn{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
+ if (auto *sn{UnwrapExpr<Expr<SomeKind<T::category>>>(args[0])}) {
return common::visit(
[&funcRef, &context, &name](const auto &n) -> Expr<T> {
using TI = typename std::decay_t<decltype(n)>::Result;
@@ -1072,18 +1167,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
} else {
DIE("len_trim() argument must be of character type");
}
- } else if (name == "maskl" || name == "maskr") {
- // Argument can be of any kind but value has to be smaller than BIT_SIZE.
- // It can be safely converted to Int4 to simplify.
- const auto fptr{name == "maskl" ? &Scalar<T>::MASKL : &Scalar<T>::MASKR};
- return FoldElementalIntrinsic<T, Int4>(context, std::move(funcRef),
- ScalarFunc<T, Int4>([&fptr](const Scalar<Int4> &places) -> Scalar<T> {
- return fptr(static_cast<int>(places.ToInt64()));
- }));
- } else if (name == "matmul") {
- return FoldMatmul(context, std::move(funcRef));
- } else if (name == "max") {
- return FoldMINorMAX(context, std::move(funcRef), Ordering::Greater);
} else if (name == "max0" || name == "max1") {
return RewriteSpecificMINorMAX(context, std::move(funcRef));
} else if (name == "maxexponent") {
@@ -1097,14 +1180,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "maxloc") {
return FoldLocation<WhichLocation::Maxloc, T>(context, std::move(funcRef));
- } else if (name == "maxval") {
- return FoldMaxvalMinval<T>(context, std::move(funcRef),
- RelationalOperator::GT, T::Scalar::Least());
- } else if (name == "merge_bits") {
- return FoldElementalIntrinsic<T, T, T, T>(
- context, std::move(funcRef), &Scalar<T>::MERGE_BITS);
- } else if (name == "min") {
- return FoldMINorMAX(context, std::move(funcRef), Ordering::Less);
} else if (name == "min0" || name == "min1") {
return RewriteSpecificMINorMAX(context, std::move(funcRef));
} else if (name == "minexponent") {
@@ -1118,9 +1193,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
} else if (name == "minloc") {
return FoldLocation<WhichLocation::Minloc, T>(context, std::move(funcRef));
- } else if (name == "minval") {
- return FoldMaxvalMinval<T>(
- context, std::move(funcRef), RelationalOperator::LT, T::Scalar::HUGE());
} else if (name == "mod") {
bool badPConst{false};
if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
@@ -1179,9 +1251,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
return result.value;
}));
- } else if (name == "not") {
- return FoldElementalIntrinsic<T, T>(
- context, std::move(funcRef), &Scalar<T>::NOT);
} else if (name == "precision") {
if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
@@ -1196,10 +1265,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
},
cx->u)};
}
- } else if (name == "product") {
- return FoldProduct<T>(context, std::move(funcRef), Scalar<T>{1});
- } else if (name == "radix") {
- return Expr<T>{2};
} else if (name == "range") {
if (const auto *cx{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return Expr<T>{common::visit(
@@ -1207,6 +1272,12 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Scalar<ResultType<decltype(kx)>>::RANGE;
},
cx->u)};
+ } else if (const auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
+ return Expr<T>{common::visit(
+ [](const auto &kx) {
+ return Scalar<ResultType<decltype(kx)>>::UnsignedRANGE;
+ },
+ cx->u)};
} else if (const auto *cx{UnwrapExpr<Expr<SomeReal>>(args[0])}) {
return Expr<T>{common::visit(
[](const auto &kx) {
@@ -1246,7 +1317,7 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{SelectedCharKind(*value, defaultKind)};
}
}
- } else if (name == "selected_int_kind") {
+ } else if (name == "selected_int_kind" || name == "selected_unsigned_kind") {
if (auto p{ToInt64(args[0])}) {
return Expr<T>{context.targetCharacteristics().SelectedIntKind(*p)};
}
@@ -1270,40 +1341,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
}
}
- } else if (name == "shifta" || name == "shiftr" || name == "shiftl") {
- // Second argument can be of any kind. However, it must be smaller or
- // equal than BIT_SIZE. It can be converted to Int4 to simplify.
- auto fptr{&Scalar<T>::SHIFTA};
- if (name == "shifta") { // done in fptr definition
- } else if (name == "shiftr") {
- fptr = &Scalar<T>::SHIFTR;
- } else if (name == "shiftl") {
- fptr = &Scalar<T>::SHIFTL;
- } else {
- common::die("missing case to fold intrinsic function %s", name.c_str());
- }
- if (const auto *argCon{Folder<T>(context).Folding(args[0])};
- argCon && argCon->empty()) {
- } else if (const auto *shiftCon{Folder<Int4>(context).Folding(args[1])}) {
- for (const auto &scalar : shiftCon->values()) {
- std::int64_t shiftVal{scalar.ToInt64()};
- if (shiftVal < 0) {
- context.messages().Say("SHIFT=%jd count for %s is negative"_err_en_US,
- std::intmax_t{shiftVal}, name, -T::Scalar::bits);
- break;
- } else if (shiftVal > T::Scalar::bits) {
- context.messages().Say(
- "SHIFT=%jd count for %s is greater than %d"_err_en_US,
- std::intmax_t{shiftVal}, name, T::Scalar::bits);
- break;
- }
- }
- }
- return FoldElementalIntrinsic<T, T, Int4>(context, std::move(funcRef),
- ScalarFunc<T, T, Int4>(
- [&](const Scalar<T> &i, const Scalar<Int4> &shift) -> Scalar<T> {
- return std::invoke(fptr, i, static_cast<int>(shift.ToInt64()));
- }));
} else if (name == "sign") {
return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
ScalarFunc<T, T, T>([&context](const Scalar<T> &j,
@@ -1353,8 +1390,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
Fold(context, Expr<T>{8} * ConvertToType<T>(std::move(*bytes)))};
}
}
- } else if (name == "sum") {
- return FoldSum<T>(context, std::move(funcRef));
} else if (name == "ubound") {
return UBOUND(context, std::move(funcRef));
} else if (name == "__builtin_numeric_storage_size") {
@@ -1382,6 +1417,52 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return Expr<T>{std::move(funcRef)};
}
+template <int KIND>
+Expr<Type<TypeCategory::Unsigned, KIND>> FoldIntrinsicFunction(
+ FoldingContext &context,
+ FunctionRef<Type<TypeCategory::Unsigned, KIND>> &&funcRef) {
+ if (auto foldedCommon{FoldIntrinsicFunctionCommon(context, funcRef)}) {
+ return std::move(*foldedCommon);
+ }
+ using T = Type<TypeCategory::Unsigned, KIND>;
+ ActualArguments &args{funcRef.arguments()};
+ auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
+ CHECK(intrinsic);
+ std::string name{intrinsic->name};
+ if (name == "huge") {
+ return Expr<T>{Scalar<T>{}.NOT()};
+ } else if (name == "mod" || name == "modulo") {
+ bool badPConst{false};
+ if (auto *pExpr{UnwrapExpr<Expr<T>>(args[1])}) {
+ *pExpr = Fold(context, std::move(*pExpr));
+ if (auto pConst{GetScalarConstantValue<T>(*pExpr)}; pConst &&
+ pConst->IsZero() &&
+ context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ context.messages().Say(common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "%s: P argument is zero"_warn_en_US, name);
+ badPConst = true;
+ }
+ }
+ return FoldElementalIntrinsic<T, T, T>(context, std::move(funcRef),
+ ScalarFuncWithContext<T, T, T>(
+ [badPConst, &name](FoldingContext &context, const Scalar<T> &x,
+ const Scalar<T> &y) -> Scalar<T> {
+ auto quotRem{x.DivideUnsigned(y)};
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash)) {
+ if (!badPConst && quotRem.divisionByZero) {
+ context.messages().Say(
+ common::UsageWarning::FoldingAvoidsRuntimeCrash,
+ "%s() by zero"_warn_en_US, name);
+ }
+ }
+ return quotRem.remainder;
+ }));
+ }
+ return Expr<T>{std::move(funcRef)};
+}
+
// Substitutes a bare type parameter reference with its value if it has one now
// in an instantiation. Bare LEN type parameters are substituted only when
// the known value is constant.
@@ -1448,8 +1529,19 @@ std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
[](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
}
+std::optional<std::int64_t> ToInt64(const Expr<SomeUnsigned> &expr) {
+ return common::visit(
+ [](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
+}
+
std::optional<std::int64_t> ToInt64(const Expr<SomeType> &expr) {
- return ToInt64(UnwrapExpr<Expr<SomeInteger>>(expr));
+ if (const auto *intExpr{UnwrapExpr<Expr<SomeInteger>>(expr)}) {
+ return ToInt64(*intExpr);
+ } else if (const auto *unsignedExpr{UnwrapExpr<Expr<SomeUnsigned>>(expr)}) {
+ return ToInt64(*unsignedExpr);
+ } else {
+ return std::nullopt;
+ }
}
std::optional<std::int64_t> ToInt64(const ActualArgument &arg) {
@@ -1460,5 +1552,7 @@ std::optional<std::int64_t> ToInt64(const ActualArgument &arg) {
#pragma warning(disable : 4661)
#endif
FOR_EACH_INTEGER_KIND(template class ExpressionBase, )
+FOR_EACH_UNSIGNED_KIND(template class ExpressionBase, )
template class ExpressionBase<SomeInteger>;
+template class ExpressionBase<SomeUnsigned>;
} // namespace Fortran::evaluate
diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index f5bbe7e4293359..67682019d4472f 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -44,6 +44,7 @@ static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
// OUT_OF_RANGE(x,mold[,round]) references are entirely rewritten here into
// expressions, which are then folded into constants when 'x' and 'round'
// are constant. It is guaranteed that 'x' is evaluated at most once.
+// TODO: unsigned
template <int X_RKIND, int MOLD_IKIND>
Expr<SomeReal> RealToIntBoundHelper(bool round, bool negate) {
@@ -648,7 +649,6 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
auto *intrinsic{std::get_if<SpecificIntrinsic>(&funcRef.proc().u)};
CHECK(intrinsic);
std::string name{intrinsic->name};
- using SameInt = Type<TypeCategory::Integer, KIND>;
if (name == "all") {
return FoldAllAnyParity(
context, std::move(funcRef), &Scalar<T>::AND, Scalar<T>{true});
@@ -719,6 +719,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
return Expr<T>{std::move(funcRef)};
}
} else if (name == "btest") {
+ using SameInt = Type<TypeCategory::Integer, KIND>;
if (const auto *ix{UnwrapExpr<Expr<SomeInteger>>(args[0])}) {
return common::visit(
[&](const auto &x) {
@@ -737,6 +738,24 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
}));
},
ix->u);
+ } else if (const auto *ux{UnwrapExpr<Expr<SomeUnsigned>>(args[0])}) {
+ return common::visit(
+ [&](const auto &x) {
+ using UT = ResultType<decltype(x)>;
+ return FoldElementalIntrinsic<T, UT, SameInt>(context,
+ std::move(funcRef),
+ ScalarFunc<T, UT, SameInt>(
+ [&](const Scalar<UT> &x, const Scalar<SameInt> &pos) {
+ auto posVal{pos.ToInt64()};
+ if (posVal < 0 || posVal >= x.bits) {
+ context.messages().Say(
+ "POS=%jd out of range for BTEST"_err_en_US,
+ static_cast<std::intmax_t>(posVal));
+ }
+ return Scalar<T>{x.BTEST(posVal)};
+ }));
+ },
+ ux->u);
}
} else if (name == "dot_product") {
return FoldDotProduct<T>(context, std::move(funcRef));
@@ -912,6 +931,9 @@ Expr<LogicalResult> FoldOperation(
if constexpr (T::category == TypeCategory::Integer) {
result =
Satisfies(relation.opr, folded->first.CompareSigned(folded->second));
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ result = Satisfies(
+ relation.opr, folded->first.CompareUnsigned(folded->second));
} else if constexpr (T::category == TypeCategory::Real) {
result = Satisfies(relation.opr, folded->first.Compare(folded->second));
} else if constexpr (T::category == TypeCategory::Complex) {
diff --git a/flang/lib/Evaluate/fold-matmul.h b/flang/lib/Evaluate/fold-matmul.h
index be9c547d45286c..36a1aff1a5eff1 100644
--- a/flang/lib/Evaluate/fold-matmul.h
+++ b/flang/lib/Evaluate/fold-matmul.h
@@ -75,13 +75,13 @@ static Expr<T> FoldMatmul(FoldingContext &context, FunctionRef<T> &&funcRef) {
sum = std::move(added.value);
}
} else if constexpr (T::category == TypeCategory::Integer) {
- // Don't use Kahan summation in numeric MATMUL folding;
- // the runtime doesn't use it, and results should match.
auto product{aElt.MultiplySigned(bElt)};
overflow |= product.SignedMultiplicationOverflowed();
auto added{sum.AddSigned(product.lower)};
overflow |= added.overflow;
sum = std::move(added.value);
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ sum = sum.AddUnsigned(aElt.MultiplyUnsigned(bElt).lower).value;
} else {
static_assert(T::category == TypeCategory::Logical);
sum = sum.OR(aElt.AND(bElt));
diff --git a/flang/lib/Evaluate/fold-reduction.h b/flang/lib/Evaluate/fold-reduction.h
index 8ca0794ab0fc7c..75134100cfa235 100644
--- a/flang/lib/Evaluate/fold-reduction.h
+++ b/flang/lib/Evaluate/fold-reduction.h
@@ -81,6 +81,13 @@ static Expr<T> FoldDotProduct(
overflow |= next.overflow;
sum = std::move(next.value);
}
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ Expr<T> products{
+ Fold(context, Expr<T>{Constant<T>{*va}} * Expr<T>{Constant<T>{*vb}})};
+ Constant<T> &cProducts{DEREF(UnwrapConstantValue<T>(products))};
+ for (const Element &x : cProducts.values()) {
+ sum = sum.AddUnsigned(x).value;
+ }
} else {
static_assert(T::category == TypeCategory::Real);
Expr<T> products{
@@ -273,13 +280,14 @@ template <typename T>
static Expr<T> FoldMaxvalMinval(FoldingContext &context, FunctionRef<T> &&ref,
RelationalOperator opr, const Scalar<T> &identity) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Character);
std::optional<int> dim;
if (std::optional<ArrayAndMask<T>> arrayAndMask{
ProcessReductionArgs<T>(context, ref.arguments(), dim,
/*ARRAY=*/0, /*DIM=*/1, /*MASK=*/2)}) {
- MaxvalMinvalAccumulator accumulator{opr, context, arrayAndMask->array};
+ MaxvalMinvalAccumulator<T> accumulator{opr, context, arrayAndMask->array};
return Expr<T>{DoReduction<T>(
arrayAndMask->array, arrayAndMask->mask, dim, identity, accumulator)};
}
@@ -296,6 +304,8 @@ template <typename T> class ProductAccumulator {
auto prod{element.MultiplySigned(array_.At(at))};
overflow_ |= prod.SignedMultiplicationOverflowed();
element = prod.lower;
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ element = element.MultiplyUnsigned(array_.At(at)).lower;
} else { // Real & Complex
auto prod{element.Multiply(array_.At(at))};
overflow_ |= prod.flags.test(RealFlag::Overflow);
@@ -314,6 +324,7 @@ template <typename T>
static Expr<T> FoldProduct(
FoldingContext &context, FunctionRef<T> &&ref, Scalar<T> identity) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
std::optional<int> dim;
@@ -347,6 +358,8 @@ template <typename T> class SumAccumulator {
auto sum{element.AddSigned(array_.At(at))};
overflow_ |= sum.overflow;
element = sum.value;
+ } else if constexpr (T::category == TypeCategory::Unsigned) {
+ element = element.AddUnsigned(array_.At(at)).value;
} else { // Real & Complex: use Kahan summation
auto next{array_.At(at).Add(correction_, rounding_)};
overflow_ |= next.flags.test(RealFlag::Overflow);
@@ -361,7 +374,8 @@ template <typename T> class SumAccumulator {
}
bool overflow() const { return overflow_; }
void Done([[maybe_unused]] Element &element) {
- if constexpr (T::category != TypeCategory::Integer) {
+ if constexpr (T::category != TypeCategory::Integer &&
+ T::category != TypeCategory::Unsigned) {
auto corrected{element.Add(correction_, rounding_)};
overflow_ |= corrected.flags.test(RealFlag::Overflow);
correction_ = Scalar<T>{};
@@ -379,6 +393,7 @@ template <typename T> class SumAccumulator {
template <typename T>
static Expr<T> FoldSum(FoldingContext &context, FunctionRef<T> &&ref) {
static_assert(T::category == TypeCategory::Integer ||
+ T::category == TypeCategory::Unsigned ||
T::category == TypeCategory::Real ||
T::category == TypeCategory::Complex);
using Element = typename Constant<T>::Element;
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 3581b9c96c19bf..f3a53c1f983dfa 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -71,6 +71,8 @@ llvm::raw_ostream &ConstantBase<RESULT, VALUE>::AsFortran(
}
if constexpr (Result::category == TypeCategory::Integer) {
o << value.SignedDecimal() << '_' << Result::kind;
+ } else if constexpr (Result::category == TypeCategory::Unsigned) {
+ o << value.UnsignedDecimal() << "U_" << Result::kind;
} else if constexpr (Result::category == TypeCategory::Real ||
Result::category == TypeCategory::Complex) {
value.AsFortran(o, Result::kind);
@@ -478,7 +480,8 @@ llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const {
TO::category == TypeCategory::Real ||
TO::category == TypeCategory::Complex ||
TO::category == TypeCategory::Character ||
- TO::category == TypeCategory::Logical,
+ TO::category == TypeCategory::Logical ||
+ TO::category == TypeCategory::Unsigned,
"Convert<> to bad category!");
if constexpr (TO::category == TypeCategory::Character) {
this->left().AsFortran(o << "achar(iachar(") << ')';
@@ -488,8 +491,10 @@ llvm::raw_ostream &Convert<TO, FROMCAT>::AsFortran(llvm::raw_ostream &o) const {
this->left().AsFortran(o << "real(");
} else if constexpr (TO::category == TypeCategory::Complex) {
this->left().AsFortran(o << "cmplx(");
- } else {
+ } else if constexpr (TO::category == TypeCategory::Logical) {
this->left().AsFortran(o << "logical(");
+ } else {
+ this->left().AsFortran(o << "uint(");
}
return o << ",kind=" << TO::kind << ')';
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 1e27c0ae4216c5..2af86fecb860bc 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -60,19 +60,25 @@ class FoldingContext;
// AnyType + Rank::arrayOrAssumedRank, or AnyType + Kind::addressable.
using CategorySet = common::EnumSet<TypeCategory, 8>;
static constexpr CategorySet IntType{TypeCategory::Integer};
+static constexpr CategorySet UnsignedType{TypeCategory::Unsigned};
static constexpr CategorySet RealType{TypeCategory::Real};
static constexpr CategorySet ComplexType{TypeCategory::Complex};
static constexpr CategorySet CharType{TypeCategory::Character};
static constexpr CategorySet LogicalType{TypeCategory::Logical};
+static constexpr CategorySet IntOrUnsignedType{IntType | UnsignedType};
static constexpr CategorySet IntOrRealType{IntType | RealType};
+static constexpr CategorySet IntUnsignedOrRealType{
+ IntType | UnsignedType | RealType};
static constexpr CategorySet IntOrRealOrCharType{IntType | RealType | CharType};
static constexpr CategorySet IntOrLogicalType{IntType | LogicalType};
static constexpr CategorySet FloatingType{RealType | ComplexType};
-static constexpr CategorySet NumericType{IntType | RealType | ComplexType};
-static constexpr CategorySet RelatableType{IntType | RealType | CharType};
+static constexpr CategorySet NumericType{
+ IntType | UnsignedType | RealType | ComplexType};
+static constexpr CategorySet RelatableType{
+ IntType | UnsignedType | RealType | CharType};
static constexpr CategorySet DerivedType{TypeCategory::Derived};
static constexpr CategorySet IntrinsicType{
- IntType | RealType | ComplexType | CharType | LogicalType};
+ IntType | UnsignedType | RealType | ComplexType | CharType | LogicalType};
static constexpr CategorySet AnyType{IntrinsicType | DerivedType};
ENUM_CLASS(KindCode, none, defaultIntegerKind,
@@ -135,8 +141,11 @@ static constexpr TypePattern SubscriptInt{IntType, KindCode::subscript};
// Match any kind of some intrinsic or derived types
static constexpr TypePattern AnyInt{IntType, KindCode::any};
+static constexpr TypePattern AnyIntOrUnsigned{IntOrUnsignedType, KindCode::any};
static constexpr TypePattern AnyReal{RealType, KindCode::any};
static constexpr TypePattern AnyIntOrReal{IntOrRealType, KindCode::any};
+static constexpr TypePattern AnyIntUnsignedOrReal{
+ IntUnsignedOrRealType, KindCode::any};
static constexpr TypePattern AnyIntOrRealOrChar{
IntOrRealOrCharType, KindCode::any};
static constexpr TypePattern AnyIntOrLogical{IntOrLogicalType, KindCode::any};
@@ -158,8 +167,12 @@ static constexpr TypePattern Addressable{AnyType, KindCode::addressable};
// Can be used to specify a result so long as at least one argument is
// a "Same".
static constexpr TypePattern SameInt{IntType, KindCode::same};
+static constexpr TypePattern SameIntOrUnsigned{
+ IntOrUnsignedType, KindCode::same};
static constexpr TypePattern SameReal{RealType, KindCode::same};
static constexpr TypePattern SameIntOrReal{IntOrRealType, KindCode::same};
+static constexpr TypePattern SameIntUnsignedOrReal{
+ IntUnsignedOrRealType, KindCode::same};
static constexpr TypePattern SameComplex{ComplexType, KindCode::same};
static constexpr TypePattern SameFloating{FloatingType, KindCode::same};
static constexpr TypePattern SameNumeric{NumericType, KindCode::same};
@@ -174,10 +187,12 @@ static constexpr TypePattern SameType{AnyType, KindCode::same};
// &/or kinds differ, their values are converted as if they were operands to
// an intrinsic operation like addition. This is a nonstandard but nearly
// universal extension feature.
-static constexpr TypePattern OperandReal{RealType, KindCode::operand};
static constexpr TypePattern OperandInt{IntType, KindCode::operand};
+static constexpr TypePattern OperandReal{RealType, KindCode::operand};
static constexpr TypePattern OperandIntOrReal{IntOrRealType, KindCode::operand};
+static constexpr TypePattern OperandUnsigned{UnsignedType, KindCode::operand};
+
// For ASSOCIATED, the first argument is a typeless pointer
static constexpr TypePattern AnyPointer{AnyType, KindCode::nullPointerType};
@@ -187,6 +202,8 @@ static constexpr TypePattern ResultNumeric{NumericType, KindCode::likeMultiply};
// Result types with known category and KIND=
static constexpr TypePattern KINDInt{IntType, KindCode::effectiveKind};
+static constexpr TypePattern KINDUnsigned{
+ UnsignedType, KindCode::effectiveKind};
static constexpr TypePattern KINDReal{RealType, KindCode::effectiveKind};
static constexpr TypePattern KINDComplex{ComplexType, KindCode::effectiveKind};
static constexpr TypePattern KINDChar{CharType, KindCode::effectiveKind};
@@ -364,33 +381,34 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"x", SameReal, Rank::scalar}},
SameReal, Rank::vector, IntrinsicClass::transformationalFunction},
{"bge",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"bgt",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"bit_size",
- {{"i", SameInt, Rank::anyOrAssumedRank, Optionality::required,
+ {{"i", SameIntOrUnsigned, Rank::anyOrAssumedRank, Optionality::required,
common::Intent::In, {ArgFlag::canBeMoldNull}}},
SameInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"ble",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
{"blt",
- {{"i", AnyInt, Rank::elementalOrBOZ},
- {"j", AnyInt, Rank::elementalOrBOZ}},
+ {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ},
+ {"j", AnyIntOrUnsigned, Rank::elementalOrBOZ}},
DefaultLogical},
- {"btest", {{"i", AnyInt, Rank::elementalOrBOZ}, {"pos", AnyInt}},
+ {"btest", {{"i", AnyIntOrUnsigned, Rank::elementalOrBOZ}, {"pos", AnyInt}},
DefaultLogical},
{"ceiling", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
{"char", {{"i", AnyInt, Rank::elementalOrBOZ}, DefaultingKIND}, KINDChar},
{"cmplx", {{"x", AnyComplex}, DefaultingKIND}, KINDComplex},
{"cmplx",
- {{"x", AnyIntOrReal, Rank::elementalOrBOZ},
- {"y", AnyIntOrReal, Rank::elementalOrBOZ, Optionality::optional},
+ {{"x", AnyIntUnsignedOrReal, Rank::elementalOrBOZ},
+ {"y", AnyIntUnsignedOrReal, Rank::elementalOrBOZ,
+ Optionality::optional},
DefaultingKIND},
KINDComplex},
{"command_argument_count", {}, DefaultInt, Rank::scalar,
@@ -407,8 +425,9 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameType, Rank::conformable, IntrinsicClass::transformationalFunction},
{"dble", {{"a", AnyNumeric, Rank::elementalOrBOZ}}, DoublePrecision},
{"digits",
- {{"x", AnyIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
+ {{"x", AnyIntUnsignedOrReal, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
DefaultInt, Rank::scalar, IntrinsicClass::inquiryFunction},
{"dim", {{"x", OperandIntOrReal}, {"y", OperandIntOrReal}},
OperandIntOrReal},
@@ -422,20 +441,22 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
ResultNumeric, Rank::scalar, // conjugates vector_a
IntrinsicClass::transformationalFunction},
{"dot_product",
- {{"vector_a", AnyIntOrReal, Rank::vector},
+ {{"vector_a", AnyIntUnsignedOrReal, Rank::vector},
{"vector_b", AnyNumeric, Rank::vector}},
ResultNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision},
{"dshiftl",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
- {"shift", AnyInt}},
- SameInt},
- {"dshiftl", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
+ {{"i", SameIntOrUnsigned},
+ {"j", SameIntOrUnsigned, Rank::elementalOrBOZ}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"dshiftl", {{"i", BOZ}, {"j", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"dshiftr",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
- {"shift", AnyInt}},
- SameInt},
- {"dshiftr", {{"i", BOZ}, {"j", SameInt}, {"shift", AnyInt}}, SameInt},
+ {{"i", SameIntOrUnsigned},
+ {"j", SameIntOrUnsigned, Rank::elementalOrBOZ}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"dshiftr", {{"i", BOZ}, {"j", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"eoshift",
{{"array", SameType, Rank::array},
{"shift", AnyInt, Rank::dimRemovedOrScalar},
@@ -523,33 +544,53 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"getpid", {}, DefaultInt},
{"getuid", {}, DefaultInt},
{"huge",
- {{"x", SameIntOrReal, Rank::anyOrAssumedRank, Optionality::required,
- common::Intent::In, {ArgFlag::canBeMoldNull}}},
- SameIntOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
+ {{"x", SameIntUnsignedOrReal, Rank::anyOrAssumedRank,
+ Optionality::required, common::Intent::In,
+ {ArgFlag::canBeMoldNull}}},
+ SameIntUnsignedOrReal, Rank::scalar, IntrinsicClass::inquiryFunction},
{"hypot", {{"x", OperandReal}, {"y", OperandReal}}, OperandReal},
{"iachar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
- {"iall", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iall", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"iany", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iany", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
- {"iparity", {{"array", SameInt, Rank::array}, RequiredDIM, OptionalMASK},
- SameInt, Rank::dimReduced, IntrinsicClass::transformationalFunction},
- {"iparity", {{"array", SameInt, Rank::array}, MissingDIM, OptionalMASK},
- SameInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"iall",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iall",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
+ {"iany",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iany",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
+ {"iparity",
+ {{"array", SameIntOrUnsigned, Rank::array}, RequiredDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::dimReduced,
+ IntrinsicClass::transformationalFunction},
+ {"iparity",
+ {{"array", SameIntOrUnsigned, Rank::array}, MissingDIM, OptionalMASK},
+ SameIntOrUnsigned, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
{"iand", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"iand", {{"i", BOZ}, {"j", SameInt}}, SameInt},
- {"ibclr", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
- {"ibits", {{"i", SameInt}, {"pos", AnyInt}, {"len", AnyInt}}, SameInt},
- {"ibset", {{"i", SameInt}, {"pos", AnyInt}}, SameInt},
+ {"iand",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"iand", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
+ {"ibclr", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}}, SameIntOrUnsigned},
+ {"ibits", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}, {"len", AnyInt}},
+ SameIntOrUnsigned},
+ {"ibset", {{"i", SameIntOrUnsigned}, {"pos", AnyInt}}, SameIntOrUnsigned},
{"ichar", {{"c", AnyChar}, DefaultingKIND}, KINDInt},
{"ieor", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
+ {"ieor",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"ieor", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
{"image_index",
{{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector}},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
@@ -575,12 +616,15 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"int_ptr_kind", {}, DefaultInt, Rank::scalar},
{"ior", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
- {"ior", {{"i", BOZ}, {"j", SameInt}}, SameInt},
- {"ishft", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
+ {"ior",
+ {{"i", OperandUnsigned}, {"j", OperandUnsigned, Rank::elementalOrBOZ}},
+ OperandUnsigned},
+ {"ior", {{"i", BOZ}, {"j", SameIntOrUnsigned}}, SameIntOrUnsigned},
+ {"ishft", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}}, SameIntOrUnsigned},
{"ishftc",
- {{"i", SameInt}, {"shift", AnyInt},
+ {{"i", SameIntOrUnsigned}, {"shift", AnyInt},
{"size", AnyInt, Rank::elemental, Optionality::optional}},
- SameInt},
+ SameIntOrUnsigned},
{"isnan", {{"a", AnyFloating}}, DefaultLogical},
{"is_contiguous", {{"array", Addressable, Rank::anyOrAssumedRank}},
DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
@@ -653,6 +697,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"a1", OperandIntOrReal}, {"a2", OperandIntOrReal},
{"a3", OperandIntOrReal, Rank::elemental, Optionality::repeats}},
OperandIntOrReal},
+ {"max",
+ {{"a1", OperandUnsigned}, {"a2", OperandUnsigned},
+ {"a3", OperandUnsigned, Rank::elemental, Optionality::repeats}},
+ OperandUnsigned},
{"max",
{{"a1", SameCharNoLen}, {"a2", SameCharNoLen},
{"a3", SameCharNoLen, Rank::elemental, Optionality::repeats}},
@@ -682,16 +730,22 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"tsource", SameType}, {"fsource", SameType}, {"mask", AnyLogical}},
SameType},
{"merge_bits",
- {{"i", SameInt}, {"j", SameInt, Rank::elementalOrBOZ},
- {"mask", SameInt, Rank::elementalOrBOZ}},
- SameInt},
+ {{"i", SameIntOrUnsigned},
+ {"j", SameIntOrUnsigned, Rank::elementalOrBOZ},
+ {"mask", SameIntOrUnsigned, Rank::elementalOrBOZ}},
+ SameIntOrUnsigned},
{"merge_bits",
- {{"i", BOZ}, {"j", SameInt}, {"mask", SameInt, Rank::elementalOrBOZ}},
- SameInt},
+ {{"i", BOZ}, {"j", SameIntOrUnsigned},
+ {"mask", SameIntOrUnsigned, Rank::elementalOrBOZ}},
+ SameIntOrUnsigned},
{"min",
{{"a1", OperandIntOrReal}, {"a2", OperandIntOrReal},
{"a3", OperandIntOrReal, Rank::elemental, Optionality::repeats}},
OperandIntOrReal},
+ {"min",
+ {{"a1", OperandUnsigned}, {"a2", OperandUnsigned},
+ {"a3", OperandUnsigned, Rank::elemental, Optionality::repeats}},
+ OperandUnsigned},
{"min",
{{"a1", SameCharNoLen}, {"a2", SameCharNoLen},
{"a3", SameCharNoLen, Rank::elemental, Optionality::repeats}},
@@ -719,8 +773,11 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
SameRelatable, Rank::scalar, IntrinsicClass::transformationalFunction},
{"mod", {{"a", OperandIntOrReal}, {"p", OperandIntOrReal}},
OperandIntOrReal},
+ {"mod", {{"a", OperandUnsigned}, {"p", OperandUnsigned}}, OperandUnsigned},
{"modulo", {{"a", OperandIntOrReal}, {"p", OperandIntOrReal}},
OperandIntOrReal},
+ {"modulo", {{"a", OperandUnsigned}, {"p", OperandUnsigned}},
+ OperandUnsigned},
{"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
{"new_line",
{{"a", SameCharNoLen, Rank::anyOrAssumedRank, Optionality::required,
@@ -731,7 +788,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
Rank::dimReduced, IntrinsicClass::transformationalFunction},
{"norm2", {{"x", SameReal, Rank::array}, MissingDIM}, SameReal,
Rank::scalar, IntrinsicClass::transformationalFunction},
- {"not", {{"i", SameInt}}, SameInt},
+ {"not", {{"i", SameIntOrUnsigned}}, SameIntOrUnsigned},
// NULL() is a special case handled in Probe() below
{"num_images", {}, DefaultInt, Rank::scalar,
IntrinsicClass::transformationalFunction},
@@ -847,12 +904,17 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"r", AnyInt, Rank::scalar, Optionality::optional},
{"radix", AnyInt, Rank::scalar}},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"selected_unsigned_kind", {{"r", AnyInt, Rank::scalar}}, DefaultInt,
+ Rank::scalar, IntrinsicClass::transformationalFunction},
{"set_exponent", {{"x", SameReal}, {"i", AnyInt}}, SameReal},
{"shape", {{"source", AnyData, Rank::anyOrAssumedRank}, SizeDefaultKIND},
KINDInt, Rank::vector, IntrinsicClass::inquiryFunction},
- {"shifta", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
- {"shiftl", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
- {"shiftr", {{"i", SameInt}, {"shift", AnyInt}}, SameInt},
+ {"shifta", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"shiftl", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
+ {"shiftr", {{"i", SameIntOrUnsigned}, {"shift", AnyInt}},
+ SameIntOrUnsigned},
{"sign", {{"a", SameInt}, {"b", AnyInt}}, SameInt},
{"sign", {{"a", SameReal}, {"b", AnyReal}}, SameReal},
{"sin", {{"x", SameFloating}}, SameFloating},
@@ -925,6 +987,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"ucobound",
{{"coarray", AnyData, Rank::coarray}, OptionalDIM, SizeDefaultKIND},
KINDInt, Rank::scalarIfDim, IntrinsicClass::inquiryFunction},
+ {"uint", {{"a", AnyNumeric, Rank::elementalOrBOZ}, DefaultingKIND},
+ KINDUnsigned},
+ {"umaskl", {{"i", AnyInt}, DefaultingKIND}, KINDUnsigned},
+ {"umaskr", {{"i", AnyInt}, DefaultingKIND}, KINDUnsigned},
{"unpack",
{{"vector", SameType, Rank::vector}, {"mask", AnyLogical, Rank::array},
{"field", SameType, Rank::conformable}},
@@ -1015,6 +1081,7 @@ static const std::pair<const char *, const char *> genericAlias[]{
{"lshift", "shiftl"},
{"or", "ior"},
{"rshift", "shifta"},
+ {"unsigned", "uint"}, // Sun vs gfortran names
{"xor", "ieor"},
{"__builtin_ieee_selected_real_kind", "selected_real_kind"},
};
@@ -1457,8 +1524,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
common::Intent::InOut}},
{}, Rank::elemental, IntrinsicClass::pureSubroutine},
{"mvbits",
- {{"from", SameInt}, {"frompos", AnyInt}, {"len", AnyInt},
- {"to", SameInt, Rank::elemental, Optionality::required,
+ {{"from", SameIntOrUnsigned}, {"frompos", AnyInt}, {"len", AnyInt},
+ {"to", SameIntOrUnsigned, Rank::elemental, Optionality::required,
common::Intent::Out},
{"topos", AnyInt}},
{}, Rank::elemental, IntrinsicClass::elementalSubroutine}, // elemental
diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp
index 1e2cf6b0d298d4..f2aa43be5a5b44 100644
--- a/flang/lib/Evaluate/target.cpp
+++ b/flang/lib/Evaluate/target.cpp
@@ -44,6 +44,7 @@ TargetCharacteristics::TargetCharacteristics() {
enableCategoryKinds(TypeCategory::Complex);
enableCategoryKinds(TypeCategory::Character);
enableCategoryKinds(TypeCategory::Logical);
+ enableCategoryKinds(TypeCategory::Unsigned);
isBigEndian_ = !isHostLittleEndian;
@@ -113,6 +114,7 @@ void TargetCharacteristics::set_roundingMode(Rounding rounding) {
}
// SELECTED_INT_KIND() -- F'2018 16.9.169
+// and SELECTED_UNSIGNED_KIND() extension (same results)
class SelectedIntKindVisitor {
public:
SelectedIntKindVisitor(
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 4d98220a7065ca..13cecdd9416fd2 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -437,7 +437,7 @@ Expr<SomeComplex> PromoteMixedComplexReal(
// N.B. When a "typeless" BOZ literal constant appears as one (not both!) of
// the operands to a dyadic operation where one is permitted, it assumes the
// type and kind of the other operand.
-template <template <typename> class OPR>
+template <template <typename> class OPR, bool CAN_BE_UNSIGNED>
std::optional<Expr<SomeType>> NumericOperation(
parser::ContextualMessages &messages, Expr<SomeType> &&x,
Expr<SomeType> &&y, int defaultRealKind) {
@@ -451,6 +451,15 @@ std::optional<Expr<SomeType>> NumericOperation(
return Package(PromoteAndCombine<OPR, TypeCategory::Real>(
std::move(rx), std::move(ry)));
},
+ [&](Expr<SomeUnsigned> &&ix, Expr<SomeUnsigned> &&iy) {
+ if constexpr (CAN_BE_UNSIGNED) {
+ return Package(PromoteAndCombine<OPR, TypeCategory::Unsigned>(
+ std::move(ix), std::move(iy)));
+ } else {
+ messages.Say("Operands must not be UNSIGNED"_err_en_US);
+ return NoExpr();
+ }
+ },
// Mixed REAL/INTEGER operations
[](Expr<SomeReal> &&rx, Expr<SomeInteger> &&iy) {
return MixedRealLeft<OPR>(std::move(rx), std::move(iy));
@@ -508,24 +517,44 @@ std::optional<Expr<SomeType>> NumericOperation(
},
// Operations with one typeless operand
[&](BOZLiteralConstant &&bx, Expr<SomeInteger> &&iy) {
- return NumericOperation<OPR>(messages,
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
+ defaultRealKind);
+ },
+ [&](BOZLiteralConstant &&bx, Expr<SomeUnsigned> &&iy) {
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
AsGenericExpr(ConvertTo(iy, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](BOZLiteralConstant &&bx, Expr<SomeReal> &&ry) {
- return NumericOperation<OPR>(messages,
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
AsGenericExpr(ConvertTo(ry, std::move(bx))), std::move(y),
defaultRealKind);
},
[&](Expr<SomeInteger> &&ix, BOZLiteralConstant &&by) {
- return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(ix, std::move(by))), defaultRealKind);
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(ix, std::move(by))),
+ defaultRealKind);
+ },
+ [&](Expr<SomeUnsigned> &&ix, BOZLiteralConstant &&by) {
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(ix, std::move(by))),
+ defaultRealKind);
},
[&](Expr<SomeReal> &&rx, BOZLiteralConstant &&by) {
- return NumericOperation<OPR>(messages, std::move(x),
- AsGenericExpr(ConvertTo(rx, std::move(by))), defaultRealKind);
+ return NumericOperation<OPR, CAN_BE_UNSIGNED>(messages,
+ std::move(x), AsGenericExpr(ConvertTo(rx, std::move(by))),
+ defaultRealKind);
+ },
+ // Error cases
+ [&](Expr<SomeUnsigned> &&, auto &&) {
+ messages.Say("Both operands must be UNSIGNED"_err_en_US);
+ return NoExpr();
+ },
+ [&](auto &&, Expr<SomeUnsigned> &&) {
+ messages.Say("Both operands must be UNSIGNED"_err_en_US);
+ return NoExpr();
},
- // Default case
[&](auto &&, auto &&) {
messages.Say("non-numeric operands to numeric operation"_err_en_US);
return NoExpr();
@@ -534,7 +563,7 @@ std::optional<Expr<SomeType>> NumericOperation(
std::move(x.u), std::move(y.u));
}
-template std::optional<Expr<SomeType>> NumericOperation<Power>(
+template std::optional<Expr<SomeType>> NumericOperation<Power, false>(
parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&,
int defaultRealKind);
template std::optional<Expr<SomeType>> NumericOperation<Multiply>(
@@ -581,6 +610,7 @@ std::optional<Expr<SomeType>> Negation(
messages.Say("LOGICAL cannot be negated"_err_en_US);
return NoExpr();
},
+ [&](Expr<SomeUnsigned> &&x) { return Package(-std::move(x)); },
[&](Expr<SomeDerived> &&) {
messages.Say("Operand cannot be negated"_err_en_US);
return NoExpr();
@@ -613,6 +643,10 @@ std::optional<Expr<LogicalResult>> Relate(parser::ContextualMessages &messages,
Expr<SomeInteger> &&iy) -> std::optional<Expr<LogicalResult>> {
return PromoteAndRelate(opr, std::move(ix), std::move(iy));
},
+ [=](Expr<SomeUnsigned> &&ix,
+ Expr<SomeUnsigned> &&iy) -> std::optional<Expr<LogicalResult>> {
+ return PromoteAndRelate(opr, std::move(ix), std::move(iy));
+ },
[=](Expr<SomeReal> &&rx,
Expr<SomeReal> &&ry) -> std::optional<Expr<LogicalResult>> {
return PromoteAndRelate(opr, std::move(rx), std::move(ry));
@@ -718,6 +752,16 @@ std::optional<Expr<SomeType>> ConvertToType(
ConvertToKind<TypeCategory::Integer>(type.kind(), std::move(*boz))};
}
return ConvertToNumeric<TypeCategory::Integer>(type.kind(), std::move(x));
+ case TypeCategory::Unsigned:
+ if (auto *boz{std::get_if<BOZLiteralConstant>(&x.u)}) {
+ return Expr<SomeType>{
+ ConvertToKind<TypeCategory::Unsigned>(type.kind(), std::move(*boz))};
+ }
+ if (auto *cx{UnwrapExpr<Expr<SomeUnsigned>>(x)}) {
+ return Expr<SomeType>{
+ ConvertToKind<TypeCategory::Unsigned>(type.kind(), std::move(*cx))};
+ }
+ break;
case TypeCategory::Real:
if (auto *boz{std::get_if<BOZLiteralConstant>(&x.u)}) {
return Expr<SomeType>{
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index c00688853cd006..0c2784d9cbe301 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -181,6 +181,7 @@ std::optional<Expr<SubscriptInteger>> DynamicType::MeasureSizeInBytes(
std::optional<std::int64_t> charLength) const {
switch (category_) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Complex:
case TypeCategory::Logical:
@@ -682,6 +683,14 @@ DynamicType DynamicType::ResultTypeForMultiply(const DynamicType &that) const {
CRASH_NO_CASE;
}
break;
+ case TypeCategory::Unsigned:
+ switch (that.category_) {
+ case TypeCategory::Unsigned:
+ return DynamicType{TypeCategory::Unsigned, std::max(kind(), that.kind())};
+ default:
+ CRASH_NO_CASE;
+ }
+ break;
case TypeCategory::Real:
switch (that.category_) {
case TypeCategory::Integer:
@@ -820,6 +829,7 @@ std::optional<bool> IsInteroperableIntrinsicType(const DynamicType &type,
const common::LanguageFeatureControl *features, bool checkCharLength) {
switch (type.category()) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
return true;
case TypeCategory::Real:
case TypeCategory::Complex:
diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 1214a2ea6bf1f3..d4279199275a39 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -747,6 +747,12 @@ static bool parseFrontendArgs(FrontendOptions &opts, llvm::opt::ArgList &args,
clang::driver::options::OPT_fno_logical_abbreviations,
false));
+ // -f{no-}unsigned
+ opts.features.Enable(Fortran::common::LanguageFeature::Unsigned,
+ args.hasFlag(clang::driver::options::OPT_funsigned,
+ clang::driver::options::OPT_fno_unsigned,
+ false));
+
// -f{no-}xor-operator
opts.features.Enable(
Fortran::common::LanguageFeature::XOROperator,
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index da53edf7e734b0..18f4e282609cac 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3071,7 +3071,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
}
/// Generate FIR for a SELECT CASE statement.
- /// The selector may have CHARACTER, INTEGER, or LOGICAL type.
+ /// The selector may have CHARACTER, INTEGER, UNSIGNED, or LOGICAL type.
void genFIR(const Fortran::parser::SelectCaseStmt &stmt) {
Fortran::lower::pft::Evaluation &eval = getEval();
Fortran::lower::pft::Evaluation *parentConstruct = eval.parentConstruct;
@@ -3107,6 +3107,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
selector = builder->createConvert(loc, builder->getI1Type(), selector);
}
mlir::Type selectType = selector.getType();
+ if (selectType.isUnsignedInteger())
+ selectType = mlir::IntegerType::get(
+ builder->getContext(), selectType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
llvm::SmallVector<mlir::Attribute> attrList;
llvm::SmallVector<mlir::Value> valueList;
llvm::SmallVector<mlir::Block *> blockList;
@@ -3120,9 +3124,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
else if (isLogicalSelector)
valueList.push_back(builder->createConvert(
loc, selectType, createFIRExpr(toLocation(), expr, stmtCtx)));
- else
+ else {
valueList.push_back(builder->createIntegerConstant(
loc, selectType, *Fortran::evaluate::ToInt64(*expr)));
+ }
};
for (Fortran::lower::pft::Evaluation *e = eval.controlSuccessor; e;
e = e->controlSuccessor) {
diff --git a/flang/lib/Lower/ConvertConstant.cpp b/flang/lib/Lower/ConvertConstant.cpp
index 556b330b967ce1..e56fde247828b6 100644
--- a/flang/lib/Lower/ConvertConstant.cpp
+++ b/flang/lib/Lower/ConvertConstant.cpp
@@ -226,12 +226,18 @@ template <Fortran::common::TypeCategory TC, int KIND>
static mlir::Value genScalarLit(
fir::FirOpBuilder &builder, mlir::Location loc,
const Fortran::evaluate::Scalar<Fortran::evaluate::Type<TC, KIND>> &value) {
- if constexpr (TC == Fortran::common::TypeCategory::Integer) {
- mlir::Type ty = Fortran::lower::getFIRType(builder.getContext(), TC, KIND,
- std::nullopt);
+ if constexpr (TC == Fortran::common::TypeCategory::Integer ||
+ TC == Fortran::common::TypeCategory::Unsigned) {
+ // MLIR requires constants to be signless
+ mlir::Type ty = Fortran::lower::getFIRType(
+ builder.getContext(), Fortran::common::TypeCategory::Integer, KIND,
+ std::nullopt);
if (KIND == 16) {
- auto bigInt =
- llvm::APInt(ty.getIntOrFloatBitWidth(), value.SignedDecimal(), 10);
+ auto bigInt = llvm::APInt(ty.getIntOrFloatBitWidth(),
+ TC == Fortran::common::TypeCategory::Unsigned
+ ? value.UnsignedDecimal()
+ : value.SignedDecimal(),
+ 10);
return builder.create<mlir::arith::ConstantOp>(
loc, ty, mlir::IntegerAttr::get(ty, bigInt));
}
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 46168b81dd3a03..a66d5c561e62f0 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -194,7 +194,7 @@ enum class ConstituentSemantics {
/// Convert parser's INTEGER relational operators to MLIR. TODO: using
/// unordered, but we may want to cons ordered in certain situation.
static mlir::arith::CmpIPredicate
-translateRelational(Fortran::common::RelationalOperator rop) {
+translateSignedRelational(Fortran::common::RelationalOperator rop) {
switch (rop) {
case Fortran::common::RelationalOperator::LT:
return mlir::arith::CmpIPredicate::slt;
@@ -212,6 +212,25 @@ translateRelational(Fortran::common::RelationalOperator rop) {
llvm_unreachable("unhandled INTEGER relational operator");
}
+static mlir::arith::CmpIPredicate
+translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
+ switch (rop) {
+ case Fortran::common::RelationalOperator::LT:
+ return mlir::arith::CmpIPredicate::ult;
+ case Fortran::common::RelationalOperator::LE:
+ return mlir::arith::CmpIPredicate::ule;
+ case Fortran::common::RelationalOperator::EQ:
+ return mlir::arith::CmpIPredicate::eq;
+ case Fortran::common::RelationalOperator::NE:
+ return mlir::arith::CmpIPredicate::ne;
+ case Fortran::common::RelationalOperator::GT:
+ return mlir::arith::CmpIPredicate::ugt;
+ case Fortran::common::RelationalOperator::GE:
+ return mlir::arith::CmpIPredicate::uge;
+ }
+ llvm_unreachable("unhandled UNSIGNED relational operator");
+}
+
/// Convert parser's REAL relational operators to MLIR.
/// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
/// requirements in the IEEE context (table 17.1 of F2018). This choice is
@@ -793,16 +812,28 @@ class ScalarExprLowering {
template <typename OpTy>
mlir::Value createCompareOp(mlir::arith::CmpIPredicate pred,
- const ExtValue &left, const ExtValue &right) {
- if (const fir::UnboxedValue *lhs = left.getUnboxed())
- if (const fir::UnboxedValue *rhs = right.getUnboxed())
- return builder.create<OpTy>(getLoc(), pred, *lhs, *rhs);
+ const ExtValue &left, const ExtValue &right,
+ std::optional<int> unsignedKind = std::nullopt) {
+ if (const fir::UnboxedValue *lhs = left.getUnboxed()) {
+ if (const fir::UnboxedValue *rhs = right.getUnboxed()) {
+ auto loc = getLoc();
+ if (unsignedKind) {
+ mlir::Type signlessType = converter.genType(
+ Fortran::common::TypeCategory::Integer, *unsignedKind);
+ mlir::Value lhsSL = builder.createConvert(loc, signlessType, *lhs);
+ mlir::Value rhsSL = builder.createConvert(loc, signlessType, *rhs);
+ return builder.create<OpTy>(loc, pred, lhsSL, rhsSL);
+ }
+ return builder.create<OpTy>(loc, pred, *lhs, *rhs);
+ }
+ }
fir::emitFatalError(getLoc(), "array compare should be handled in genarr");
}
template <typename OpTy, typename A>
- mlir::Value createCompareOp(const A &ex, mlir::arith::CmpIPredicate pred) {
+ mlir::Value createCompareOp(const A &ex, mlir::arith::CmpIPredicate pred,
+ std::optional<int> unsignedKind = std::nullopt) {
ExtValue left = genval(ex.left());
- return createCompareOp<OpTy>(pred, left, genval(ex.right()));
+ return createCompareOp<OpTy>(pred, left, genval(ex.right()), unsignedKind);
}
template <typename OpTy>
@@ -1049,6 +1080,18 @@ class ScalarExprLowering {
return builder.create<mlir::arith::SubIOp>(getLoc(), zero, input);
}
template <int KIND>
+ ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &op) {
+ auto loc = getLoc();
+ mlir::Type signlessType =
+ converter.genType(Fortran::common::TypeCategory::Integer, KIND);
+ mlir::Value input = genunbox(op.left());
+ mlir::Value signless = builder.createConvert(loc, signlessType, input);
+ mlir::Value zero = genIntegerConstant<KIND>(builder.getContext(), 0);
+ mlir::Value neg = builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return builder.createConvert(loc, input.getType(), neg);
+ }
+ template <int KIND>
ExtValue genval(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Real, KIND>> &op) {
return builder.create<mlir::arith::NegFOp>(getLoc(), genunbox(op.left()));
@@ -1065,7 +1108,7 @@ class ScalarExprLowering {
mlir::Value lhs = fir::getBase(left);
mlir::Value rhs = fir::getBase(right);
assert(lhs.getType() == rhs.getType() && "types must be the same");
- return builder.create<OpTy>(getLoc(), lhs, rhs);
+ return builder.createUnsigned<OpTy>(getLoc(), lhs.getType(), lhs, rhs);
}
template <typename OpTy, typename A>
@@ -1083,15 +1126,19 @@ class ScalarExprLowering {
}
GENBIN(Add, Integer, mlir::arith::AddIOp)
+ GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+ GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+ GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+ GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -1200,8 +1247,14 @@ class ScalarExprLowering {
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Integer, KIND>> &op) {
- return createCompareOp<mlir::arith::CmpIOp>(op,
- translateRelational(op.opr));
+ return createCompareOp<mlir::arith::CmpIOp>(
+ op, translateSignedRelational(op.opr));
+ }
+ template <int KIND>
+ ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &op) {
+ return createCompareOp<mlir::arith::CmpIOp>(
+ op, translateUnsignedRelational(op.opr), KIND);
}
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
@@ -1217,7 +1270,7 @@ class ScalarExprLowering {
template <int KIND>
ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &op) {
- return createCharCompare(op, translateRelational(op.opr));
+ return createCharCompare(op, translateSignedRelational(op.opr));
}
ExtValue
@@ -5100,20 +5153,36 @@ class ArrayExprLowering {
return fir::substBase(val, newBase);
};
}
- template <int KIND>
- CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
- Fortran::common::TypeCategory::Integer, KIND>> &x) {
+ template <Fortran::common::TypeCategory CAT, int KIND>
+ CC genarrIntNeg(
+ const Fortran::evaluate::Expr<Fortran::evaluate::Type<CAT, KIND>> &left) {
mlir::Location loc = getLoc();
- auto f = genarr(x.left());
+ auto f = genarr(left);
return [=](IterSpace iters) -> ExtValue {
mlir::Value val = fir::getBase(f(iters));
mlir::Type ty =
converter.genType(Fortran::common::TypeCategory::Integer, KIND);
mlir::Value zero = builder.createIntegerConstant(loc, ty, 0);
+ if constexpr (CAT == Fortran::common::TypeCategory::Unsigned) {
+ mlir::Value signless = builder.createConvert(loc, ty, val);
+ mlir::Value neg =
+ builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return builder.createConvert(loc, val.getType(), neg);
+ }
return builder.create<mlir::arith::SubIOp>(loc, zero, val);
};
}
template <int KIND>
+ CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Integer, KIND>> &x) {
+ return genarrIntNeg(x.left());
+ }
+ template <int KIND>
+ CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &x) {
+ return genarrIntNeg(x.left());
+ }
+ template <int KIND>
CC genarr(const Fortran::evaluate::Negate<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Real, KIND>> &x) {
mlir::Location loc = getLoc();
@@ -5144,7 +5213,8 @@ class ArrayExprLowering {
return [=](IterSpace iters) -> ExtValue {
mlir::Value left = fir::getBase(lambda(iters));
mlir::Value right = fir::getBase(rf(iters));
- return builder.create<OP>(loc, left, right);
+ assert(left.getType() == right.getType() && "types must be the same");
+ return builder.createUnsigned<OP>(loc, left.getType(), left, right);
};
}
@@ -5157,15 +5227,19 @@ class ArrayExprLowering {
}
GENBIN(Add, Integer, mlir::arith::AddIOp)
+ GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+ GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+ GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+ GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -6546,13 +6620,21 @@ class ArrayExprLowering {
//===--------------------------------------------------------------------===//
template <typename OP, typename PRED, typename A>
- CC createCompareOp(PRED pred, const A &x) {
+ CC createCompareOp(PRED pred, const A &x,
+ std::optional<int> unsignedKind = std::nullopt) {
mlir::Location loc = getLoc();
auto lf = genarr(x.left());
auto rf = genarr(x.right());
return [=](IterSpace iters) -> ExtValue {
mlir::Value lhs = fir::getBase(lf(iters));
mlir::Value rhs = fir::getBase(rf(iters));
+ if (unsignedKind) {
+ mlir::Type signlessType = converter.genType(
+ Fortran::common::TypeCategory::Integer, *unsignedKind);
+ mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
+ mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
+ return builder.create<OP>(loc, pred, lhsSL, rhsSL);
+ }
return builder.create<OP>(loc, pred, lhs, rhs);
};
}
@@ -6570,12 +6652,19 @@ class ArrayExprLowering {
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Integer, KIND>> &x) {
- return createCompareOp<mlir::arith::CmpIOp>(translateRelational(x.opr), x);
+ return createCompareOp<mlir::arith::CmpIOp>(
+ translateSignedRelational(x.opr), x);
+ }
+ template <int KIND>
+ CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
+ Fortran::common::TypeCategory::Unsigned, KIND>> &x) {
+ return createCompareOp<mlir::arith::CmpIOp>(
+ translateUnsignedRelational(x.opr), x, KIND);
}
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
Fortran::common::TypeCategory::Character, KIND>> &x) {
- return createCompareCharOp(translateRelational(x.opr), x);
+ return createCompareCharOp(translateSignedRelational(x.opr), x);
}
template <int KIND>
CC genarr(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index e93fbc562f9b13..d00bfa0145009b 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -969,21 +969,32 @@ struct BinaryOp {};
fir::FirOpBuilder &builder, \
const Op &, hlfir::Entity lhs, \
hlfir::Entity rhs) { \
- return hlfir::EntityWithAttributes{ \
- builder.create<GenBinFirOp>(loc, lhs, rhs)}; \
+ if constexpr (Fortran::common::TypeCategory::GenBinTyCat == \
+ Fortran::common::TypeCategory::Unsigned) { \
+ return hlfir::EntityWithAttributes{ \
+ builder.createUnsigned<GenBinFirOp>(loc, lhs.getType(), lhs, \
+ rhs)}; \
+ } else { \
+ return hlfir::EntityWithAttributes{ \
+ builder.create<GenBinFirOp>(loc, lhs, rhs)}; \
+ } \
} \
};
GENBIN(Add, Integer, mlir::arith::AddIOp)
+GENBIN(Add, Unsigned, mlir::arith::AddIOp)
GENBIN(Add, Real, mlir::arith::AddFOp)
GENBIN(Add, Complex, fir::AddcOp)
GENBIN(Subtract, Integer, mlir::arith::SubIOp)
+GENBIN(Subtract, Unsigned, mlir::arith::SubIOp)
GENBIN(Subtract, Real, mlir::arith::SubFOp)
GENBIN(Subtract, Complex, fir::SubcOp)
GENBIN(Multiply, Integer, mlir::arith::MulIOp)
+GENBIN(Multiply, Unsigned, mlir::arith::MulIOp)
GENBIN(Multiply, Real, mlir::arith::MulFOp)
GENBIN(Multiply, Complex, fir::MulcOp)
GENBIN(Divide, Integer, mlir::arith::DivSIOp)
+GENBIN(Divide, Unsigned, mlir::arith::DivUIOp)
GENBIN(Divide, Real, mlir::arith::DivFOp)
template <int KIND>
@@ -1068,7 +1079,7 @@ struct BinaryOp<Fortran::evaluate::Extremum<
/// Convert parser's INTEGER relational operators to MLIR.
static mlir::arith::CmpIPredicate
-translateRelational(Fortran::common::RelationalOperator rop) {
+translateSignedRelational(Fortran::common::RelationalOperator rop) {
switch (rop) {
case Fortran::common::RelationalOperator::LT:
return mlir::arith::CmpIPredicate::slt;
@@ -1086,6 +1097,25 @@ translateRelational(Fortran::common::RelationalOperator rop) {
llvm_unreachable("unhandled INTEGER relational operator");
}
+static mlir::arith::CmpIPredicate
+translateUnsignedRelational(Fortran::common::RelationalOperator rop) {
+ switch (rop) {
+ case Fortran::common::RelationalOperator::LT:
+ return mlir::arith::CmpIPredicate::ult;
+ case Fortran::common::RelationalOperator::LE:
+ return mlir::arith::CmpIPredicate::ule;
+ case Fortran::common::RelationalOperator::EQ:
+ return mlir::arith::CmpIPredicate::eq;
+ case Fortran::common::RelationalOperator::NE:
+ return mlir::arith::CmpIPredicate::ne;
+ case Fortran::common::RelationalOperator::GT:
+ return mlir::arith::CmpIPredicate::ugt;
+ case Fortran::common::RelationalOperator::GE:
+ return mlir::arith::CmpIPredicate::uge;
+ }
+ llvm_unreachable("unhandled UNSIGNED relational operator");
+}
+
/// Convert parser's REAL relational operators to MLIR.
/// The choice of order (O prefix) vs unorder (U prefix) follows Fortran 2018
/// requirements in the IEEE context (table 17.1 of F2018). This choice is
@@ -1123,7 +1153,29 @@ struct BinaryOp<Fortran::evaluate::Relational<
const Op &op, hlfir::Entity lhs,
hlfir::Entity rhs) {
auto cmp = builder.create<mlir::arith::CmpIOp>(
- loc, translateRelational(op.opr), lhs, rhs);
+ loc, translateSignedRelational(op.opr), lhs, rhs);
+ return hlfir::EntityWithAttributes{cmp};
+ }
+};
+
+template <int KIND>
+struct BinaryOp<Fortran::evaluate::Relational<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ using Op = Fortran::evaluate::Relational<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ static hlfir::EntityWithAttributes gen(mlir::Location loc,
+ fir::FirOpBuilder &builder,
+ const Op &op, hlfir::Entity lhs,
+ hlfir::Entity rhs) {
+ int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
+ KIND>::Scalar::bits;
+ auto signlessType = mlir::IntegerType::get(
+ builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value lhsSL = builder.createConvert(loc, signlessType, lhs);
+ mlir::Value rhsSL = builder.createConvert(loc, signlessType, rhs);
+ auto cmp = builder.create<mlir::arith::CmpIOp>(
+ loc, translateUnsignedRelational(op.opr), lhsSL, rhsSL);
return hlfir::EntityWithAttributes{cmp};
}
};
@@ -1172,7 +1224,7 @@ struct BinaryOp<Fortran::evaluate::Relational<
auto [rhsExv, rhsCleanUp] =
hlfir::translateToExtendedValue(loc, builder, rhs);
auto cmp = fir::runtime::genCharCompare(
- builder, loc, translateRelational(op.opr), lhsExv, rhsExv);
+ builder, loc, translateSignedRelational(op.opr), lhsExv, rhsExv);
if (lhsCleanUp)
(*lhsCleanUp)();
if (rhsCleanUp)
@@ -1313,6 +1365,28 @@ struct UnaryOp<Fortran::evaluate::Negate<
}
};
+template <int KIND>
+struct UnaryOp<Fortran::evaluate::Negate<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>> {
+ using Op = Fortran::evaluate::Negate<
+ Fortran::evaluate::Type<Fortran::common::TypeCategory::Unsigned, KIND>>;
+ static hlfir::EntityWithAttributes gen(mlir::Location loc,
+ fir::FirOpBuilder &builder, const Op &,
+ hlfir::Entity lhs) {
+ int bits = Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
+ KIND>::Scalar::bits;
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value signless = builder.createConvert(loc, signlessType, lhs);
+ mlir::Value negated =
+ builder.create<mlir::arith::SubIOp>(loc, zero, signless);
+ return hlfir::EntityWithAttributes(
+ builder.createConvert(loc, lhs.getType(), negated));
+ }
+};
+
template <int KIND>
struct UnaryOp<Fortran::evaluate::Negate<
Fortran::evaluate::Type<Fortran::common::TypeCategory::Real, KIND>>> {
diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp
index 8664477b50078a..452ddda426fa10 100644
--- a/flang/lib/Lower/ConvertType.cpp
+++ b/flang/lib/Lower/ConvertType.cpp
@@ -76,7 +76,7 @@ static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind,
return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness);
}
}
- llvm_unreachable("INTEGER kind not translated");
+ llvm_unreachable("INTEGER or UNSIGNED kind not translated");
}
static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
@@ -107,7 +107,9 @@ genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
case Fortran::common::TypeCategory::Real:
return genRealType(context, kind);
case Fortran::common::TypeCategory::Integer:
- return genIntegerType(context, kind);
+ return genIntegerType(context, kind, false);
+ case Fortran::common::TypeCategory::Unsigned:
+ return genIntegerType(context, kind, true);
case Fortran::common::TypeCategory::Complex:
return genComplexType(context, kind);
case Fortran::common::TypeCategory::Logical:
@@ -156,7 +158,7 @@ struct TypeBuilderImpl {
} else if (category == Fortran::common::TypeCategory::Derived) {
baseType = genDerivedType(dynamicType->GetDerivedTypeSpec());
} else {
- // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
+ // INTEGER, UNSIGNED, REAL, COMPLEX, CHARACTER, LOGICAL
llvm::SmallVector<Fortran::lower::LenParameterTy> params;
translateLenParameters(params, category, expr);
baseType = genFIRType(context, category, dynamicType->kind(), params);
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index 1894b0cfd1bec2..0fcbdb19245316 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -661,21 +661,23 @@ static mlir::func::FuncOp getOutputFunc(mlir::Location loc,
if (!isFormatted)
return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type)) {
- switch (ty.getWidth()) {
- case 1:
- return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
- case 8:
- return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
- case 16:
- return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
- case 32:
- return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
- case 64:
- return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
- case 128:
- return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
+ if (!ty.isUnsigned()) {
+ switch (ty.getWidth()) {
+ case 1:
+ return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
+ case 8:
+ return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
+ case 16:
+ return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
+ case 32:
+ return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
+ case 64:
+ return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
+ case 128:
+ return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
+ }
+ llvm_unreachable("unknown OutputInteger kind");
}
- llvm_unreachable("unknown OutputInteger kind");
}
if (auto ty = mlir::dyn_cast<mlir::FloatType>(type)) {
if (auto width = ty.getWidth(); width == 32)
@@ -777,10 +779,13 @@ static mlir::func::FuncOp getInputFunc(mlir::Location loc,
return getIORuntimeFunc<mkIOKey(InputDerivedType)>(loc, builder);
if (!isFormatted)
return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
- if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type))
+ if (auto ty = mlir::dyn_cast<mlir::IntegerType>(type)) {
+ if (type.isUnsignedInteger())
+ return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
return ty.getWidth() == 1
? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder)
: getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder);
+ }
if (auto ty = mlir::dyn_cast<mlir::FloatType>(type)) {
if (auto width = ty.getWidth(); width == 32)
return getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder);
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index a66dae8851a866..1165417ef89a28 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -266,6 +266,8 @@ static std::string typeToString(Fortran::common::TypeCategory cat, int kind,
switch (cat) {
case Fortran::common::TypeCategory::Integer:
return "i" + std::to_string(kind);
+ case Fortran::common::TypeCategory::Unsigned:
+ return "u" + std::to_string(kind);
case Fortran::common::TypeCategory::Real:
return "r" + std::to_string(kind);
case Fortran::common::TypeCategory::Complex:
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index a2b327f45c6939..06f9c6073f9692 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -602,6 +602,10 @@ static constexpr IntrinsicHandler handlers[]{
{"range", asAddr, handleDynamicOptional},
{"radix", asAddr, handleDynamicOptional}}},
/*isElemental=*/false},
+ {"selected_unsigned_kind",
+ &I::genSelectedIntKind, // same results as selected_int_kind
+ {{{"scalar", asAddr}}},
+ /*isElemental=*/false},
{"set_exponent", &I::genSetExponent},
{"shape",
&I::genShape,
@@ -665,6 +669,8 @@ static constexpr IntrinsicHandler handlers[]{
&I::genUbound,
{{{"array", asBox}, {"dim", asValue}, {"kind", asValue}}},
/*isElemental=*/false},
+ {"umaskl", &I::genMask<mlir::arith::ShLIOp>},
+ {"umaskr", &I::genMask<mlir::arith::ShRUIOp>},
{"unpack",
&I::genUnpack,
{{{"vector", asBox}, {"mask", asBox}, {"field", asBox}}},
@@ -2777,8 +2783,8 @@ IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
mlir::Value arg1 = args[1];
mlir::Type arg0Ty = arg0.getType();
mlir::Type arg1Ty = arg1.getType();
- unsigned bits0 = arg0Ty.getIntOrFloatBitWidth();
- unsigned bits1 = arg1Ty.getIntOrFloatBitWidth();
+ int bits0 = arg0Ty.getIntOrFloatBitWidth();
+ int bits1 = arg1Ty.getIntOrFloatBitWidth();
// Arguments do not have to be of the same integer type. However, if neither
// of the arguments is a BOZ literal, then the shorter of the two needs
@@ -2790,12 +2796,18 @@ IntrinsicLibrary::genBitwiseCompare(mlir::Type resultType,
// However, that seems to be relevant for the case where the type of the
// result must match the type of the BOZ literal. That is not the case for
// these intrinsics, so, again, zero-extend to the larger type.
- //
- if (bits0 > bits1)
- arg1 = builder.create<mlir::arith::ExtUIOp>(loc, arg0Ty, arg1);
- else if (bits0 < bits1)
- arg0 = builder.create<mlir::arith::ExtUIOp>(loc, arg1Ty, arg0);
-
+ int widest = bits0 > bits1 ? bits0 : bits1;
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), widest,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ if (arg0Ty.isUnsignedInteger())
+ arg0 = builder.createConvert(loc, signlessType, arg0);
+ else if (bits0 < widest)
+ arg0 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg0);
+ if (arg1Ty.isUnsignedInteger())
+ arg1 = builder.createConvert(loc, signlessType, arg1);
+ else if (bits1 < widest)
+ arg1 = builder.create<mlir::arith::ExtUIOp>(loc, signlessType, arg1);
return builder.create<mlir::arith::CmpIOp>(loc, pred, arg0, arg1);
}
@@ -2807,12 +2819,14 @@ mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
// POS < BIT_SIZE(I)
// Return: (I >> POS) & 1
assert(args.size() == 2);
- mlir::Type argType = args[0].getType();
- mlir::Value pos = builder.createConvert(loc, argType, args[1]);
- auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
- mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
- auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
- return builder.createConvert(loc, resultType, res);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), args[0].getType().getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value shifted = builder.createUnsigned<mlir::arith::ShRUIOp>(
+ loc, signlessType, args[0], args[1]);
+ mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
+ mlir::Value bit = builder.create<mlir::arith::AndIOp>(loc, shifted, one);
+ return builder.createConvert(loc, resultType, bit);
}
static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder,
@@ -3258,21 +3272,30 @@ mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
mlir::Value i = args[0];
mlir::Value j = args[1];
- mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
- mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, resultType.getIntOrFloatBitWidth());
+ int bits = resultType.getIntOrFloatBitWidth();
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ if (resultType.isUnsignedInteger()) {
+ i = builder.createConvert(loc, signlessType, i);
+ j = builder.createConvert(loc, signlessType, j);
+ }
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);
+ mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
// Per the standard, the value of DSHIFTL(I, J, SHIFT) is equal to
// IOR (SHIFTL(I, SHIFT), SHIFTR(J, BIT_SIZE(J) - SHIFT))
mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
mlir::Value lArgs[2]{i, shift};
- mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
+ mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);
mlir::Value rArgs[2]{j, diff};
- mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
-
- return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
+ mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);
+ mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// DSHIFTR
@@ -3282,21 +3305,30 @@ mlir::Value IntrinsicLibrary::genDshiftr(mlir::Type resultType,
mlir::Value i = args[0];
mlir::Value j = args[1];
- mlir::Value shift = builder.createConvert(loc, resultType, args[2]);
- mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, resultType.getIntOrFloatBitWidth());
+ int bits = resultType.getIntOrFloatBitWidth();
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ if (resultType.isUnsignedInteger()) {
+ i = builder.createConvert(loc, signlessType, i);
+ j = builder.createConvert(loc, signlessType, j);
+ }
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[2]);
+ mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
// Per the standard, the value of DSHIFTR(I, J, SHIFT) is equal to
// IOR (SHIFTL(I, BIT_SIZE(I) - SHIFT), SHIFTR(J, SHIFT))
mlir::Value diff = builder.create<mlir::arith::SubIOp>(loc, bitSize, shift);
mlir::Value lArgs[2]{i, diff};
- mlir::Value lft = genShift<mlir::arith::ShLIOp>(resultType, lArgs);
+ mlir::Value lft = genShift<mlir::arith::ShLIOp>(signlessType, lArgs);
mlir::Value rArgs[2]{j, shift};
- mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(resultType, rArgs);
-
- return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
+ mlir::Value rgt = genShift<mlir::arith::ShRUIOp>(signlessType, rArgs);
+ mlir::Value result = builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// EOSHIFT
@@ -3858,9 +3890,8 @@ IntrinsicLibrary::genIall(mlir::Type resultType,
mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- auto arg0 = builder.createConvert(loc, resultType, args[0]);
- auto arg1 = builder.createConvert(loc, resultType, args[1]);
- return builder.create<mlir::arith::AndIOp>(loc, arg0, arg1);
+ return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],
+ args[1]);
}
// IANY
@@ -3879,12 +3910,18 @@ mlir::Value IntrinsicLibrary::genIbclr(mlir::Type resultType,
// POS < BIT_SIZE(I)
// Return: I & (!(1 << POS))
assert(args.size() == 2);
- mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
- mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
- auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
- auto res = builder.create<mlir::arith::XOrIOp>(loc, ones, mask);
- return builder.create<mlir::arith::AndIOp>(loc, args[0], res);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
+ mlir::Value pos = args[1];
+ if (pos.getType().isUnsignedInteger())
+ pos = builder.createConvert(loc, signlessType, pos);
+ mlir::Value bit = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
+ mlir::Value mask = builder.create<mlir::arith::XOrIOp>(loc, ones, bit);
+ return builder.createUnsigned<mlir::arith::AndIOp>(loc, resultType, args[0],
+ mask);
}
// IBITS
@@ -3899,19 +3936,32 @@ mlir::Value IntrinsicLibrary::genIbits(mlir::Type resultType,
// unsigned shift produces the same result. For a nonconformant call,
// the two choices may produce different results.
assert(args.size() == 3);
- mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
- mlir::Value len = builder.createConvert(loc, resultType, args[2]);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value word = args[0];
+ if (word.getType().isUnsignedInteger())
+ word = builder.createConvert(loc, signlessType, word);
+ mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);
+ mlir::Value len = builder.createConvert(loc, signlessType, args[2]);
mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
- auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
- auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
- auto res1 = builder.create<mlir::arith::ShRSIOp>(loc, args[0], pos);
- auto res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
- auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
+ loc, signlessType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
+ mlir::Value shiftCount =
+ builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
+ mlir::Value mask =
+ builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
+ mlir::Value res1 = builder.createUnsigned<mlir::arith::ShRSIOp>(
+ loc, signlessType, word, pos);
+ mlir::Value res2 = builder.create<mlir::arith::AndIOp>(loc, res1, mask);
+ mlir::Value lenIsZero = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::eq, len, zero);
- return builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
+ mlir::Value result =
+ builder.create<mlir::arith::SelectOp>(loc, lenIsZero, zero, res2);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// IBSET
@@ -3922,10 +3972,14 @@ mlir::Value IntrinsicLibrary::genIbset(mlir::Type resultType,
// POS < BIT_SIZE(I)
// Return: I | (1 << POS)
assert(args.size() == 2);
- mlir::Value pos = builder.createConvert(loc, resultType, args[1]);
- mlir::Value one = builder.createIntegerConstant(loc, resultType, 1);
- auto mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
- return builder.create<mlir::arith::OrIOp>(loc, args[0], mask);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value one = builder.createIntegerConstant(loc, signlessType, 1);
+ mlir::Value pos = builder.createConvert(loc, signlessType, args[1]);
+ mlir::Value mask = builder.create<mlir::arith::ShLIOp>(loc, one, pos);
+ return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],
+ mask);
}
// ICHAR
@@ -5385,7 +5439,8 @@ mlir::Value IntrinsicLibrary::genIeeeValue(mlir::Type resultType,
mlir::Value IntrinsicLibrary::genIeor(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- return builder.create<mlir::arith::XOrIOp>(loc, args[0], args[1]);
+ return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],
+ args[1]);
}
// INDEX
@@ -5446,7 +5501,8 @@ IntrinsicLibrary::genIndex(mlir::Type resultType,
mlir::Value IntrinsicLibrary::genIor(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- return builder.create<mlir::arith::OrIOp>(loc, args[0], args[1]);
+ return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, args[0],
+ args[1]);
}
// IPARITY
@@ -5489,20 +5545,31 @@ mlir::Value IntrinsicLibrary::genIshft(mlir::Type resultType,
// ? I >> abs(SHIFT)
// : I << abs(SHIFT)
assert(args.size() == 2);
- mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
- mlir::Value absShift = genAbs(resultType, {shift});
- auto left = builder.create<mlir::arith::ShLIOp>(loc, args[0], absShift);
- auto right = builder.create<mlir::arith::ShRUIOp>(loc, args[0], absShift);
+ int intWidth = resultType.getIntOrFloatBitWidth();
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), intWidth,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value bitSize =
+ builder.createIntegerConstant(loc, signlessType, intWidth);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
+ mlir::Value absShift = genAbs(signlessType, {shift});
+ mlir::Value word = args[0];
+ if (word.getType().isUnsignedInteger())
+ word = builder.createConvert(loc, signlessType, word);
+ auto left = builder.create<mlir::arith::ShLIOp>(loc, word, absShift);
+ auto right = builder.create<mlir::arith::ShRUIOp>(loc, word, absShift);
auto shiftIsLarge = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::sge, absShift, bitSize);
auto shiftIsNegative = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::slt, shift, zero);
auto sel =
builder.create<mlir::arith::SelectOp>(loc, shiftIsNegative, right, left);
- return builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
+ mlir::Value result =
+ builder.create<mlir::arith::SelectOp>(loc, shiftIsLarge, zero, sel);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// ISHFTC
@@ -5525,15 +5592,21 @@ mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
// right = (I & (-1 >> rightMaskShift)) << leftSize
// Return: SHIFT == 0 || SIZE == abs(SHIFT) ? I : (unchanged | left | right)
assert(args.size() == 3);
- mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
- mlir::Value I = args[0];
- mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
+ int intWidth = resultType.getIntOrFloatBitWidth();
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), intWidth,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value bitSize =
+ builder.createIntegerConstant(loc, signlessType, intWidth);
+ mlir::Value word = args[0];
+ if (word.getType().isUnsignedInteger())
+ word = builder.createConvert(loc, signlessType, word);
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
mlir::Value size =
- args[2] ? builder.createConvert(loc, resultType, args[2]) : bitSize;
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
- mlir::Value absShift = genAbs(resultType, {shift});
+ args[2] ? builder.createConvert(loc, signlessType, args[2]) : bitSize;
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
+ mlir::Value absShift = genAbs(signlessType, {shift});
auto elseSize = builder.create<mlir::arith::SubIOp>(loc, size, absShift);
auto shiftIsZero = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::eq, shift, zero);
@@ -5549,7 +5622,7 @@ mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
elseSize, absShift);
auto hasUnchanged = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::ne, size, bitSize);
- auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, I, size);
+ auto unchangedTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, word, size);
auto unchangedTmp2 =
builder.create<mlir::arith::ShLIOp>(loc, unchangedTmp1, size);
auto unchanged = builder.create<mlir::arith::SelectOp>(loc, hasUnchanged,
@@ -5558,17 +5631,21 @@ mlir::Value IntrinsicLibrary::genIshftc(mlir::Type resultType,
builder.create<mlir::arith::SubIOp>(loc, bitSize, leftSize);
auto leftMask =
builder.create<mlir::arith::ShRUIOp>(loc, ones, leftMaskShift);
- auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, I, rightSize);
+ auto leftTmp = builder.create<mlir::arith::ShRUIOp>(loc, word, rightSize);
auto left = builder.create<mlir::arith::AndIOp>(loc, leftTmp, leftMask);
auto rightMaskShift =
builder.create<mlir::arith::SubIOp>(loc, bitSize, rightSize);
auto rightMask =
builder.create<mlir::arith::ShRUIOp>(loc, ones, rightMaskShift);
- auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, I, rightMask);
+ auto rightTmp = builder.create<mlir::arith::AndIOp>(loc, word, rightMask);
auto right = builder.create<mlir::arith::ShLIOp>(loc, rightTmp, leftSize);
auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, left);
auto res = builder.create<mlir::arith::OrIOp>(loc, resTmp, right);
- return builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, I, res);
+ mlir::Value result =
+ builder.create<mlir::arith::SelectOp>(loc, shiftIsNop, word, res);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// LEADZ
@@ -5668,17 +5745,20 @@ mlir::Value IntrinsicLibrary::genMalloc(mlir::Type resultType,
fir::runtime::genMalloc(builder, loc, args[0]));
}
-// MASKL, MASKR
+// MASKL, MASKR, UMASKL, UMASKR
template <typename Shift>
mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
- mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, resultType.getIntOrFloatBitWidth());
- mlir::Value bitsToSet = builder.createConvert(loc, resultType, args[0]);
+ int bits = resultType.getIntOrFloatBitWidth();
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
+ mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
+ mlir::Value bitsToSet = builder.createConvert(loc, signlessType, args[0]);
// The standard does not specify what to return if the number of bits to be
// set, I < 0 or I >= BIT_SIZE(KIND). The shift instruction used below will
@@ -5690,8 +5770,11 @@ mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
mlir::Value shifted = builder.create<Shift>(loc, ones, shift);
mlir::Value isZero = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::eq, bitsToSet, zero);
-
- return builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted);
+ mlir::Value result =
+ builder.create<mlir::arith::SelectOp>(loc, isZero, zero, shifted);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// MATMUL
@@ -5805,23 +5888,31 @@ mlir::Value IntrinsicLibrary::genMergeBits(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 3);
- mlir::Value i = builder.createConvert(loc, resultType, args[0]);
- mlir::Value j = builder.createConvert(loc, resultType, args[1]);
- mlir::Value mask = builder.createConvert(loc, resultType, args[2]);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
-
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
// MERGE_BITS(I, J, MASK) = IOR(IAND(I, MASK), IAND(J, NOT(MASK)))
- mlir::Value notMask = builder.create<mlir::arith::XOrIOp>(loc, mask, ones);
- mlir::Value lft = builder.create<mlir::arith::AndIOp>(loc, i, mask);
- mlir::Value rgt = builder.create<mlir::arith::AndIOp>(loc, j, notMask);
-
- return builder.create<mlir::arith::OrIOp>(loc, lft, rgt);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
+ mlir::Value notMask = builder.createUnsigned<mlir::arith::XOrIOp>(
+ loc, resultType, args[2], ones);
+ mlir::Value lft = builder.createUnsigned<mlir::arith::AndIOp>(
+ loc, resultType, args[0], args[2]);
+ mlir::Value rgt = builder.createUnsigned<mlir::arith::AndIOp>(
+ loc, resultType, args[1], notMask);
+ return builder.createUnsigned<mlir::arith::OrIOp>(loc, resultType, lft, rgt);
}
// MOD
mlir::Value IntrinsicLibrary::genMod(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 2);
+ if (resultType.isUnsignedInteger()) {
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,
+ args[0], args[1]);
+ }
if (mlir::isa<mlir::IntegerType>(resultType))
return builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
@@ -5844,6 +5935,13 @@ mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
// - Otherwise, when A/P < 0 and MOD(A,P) !=0, then MODULO(A, P) =
// A-FLOOR(A/P)*P = A-(INT(A/P)-1)*P = A-INT(A/P)*P+P = MOD(A,P)+P
// Note that A/P < 0 if and only if A and P signs are different.
+ if (resultType.isUnsignedInteger()) {
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ return builder.createUnsigned<mlir::arith::RemUIOp>(loc, signlessType,
+ args[0], args[1]);
+ }
if (mlir::isa<mlir::IntegerType>(resultType)) {
auto remainder =
builder.create<mlir::arith::RemSIOp>(loc, args[0], args[1]);
@@ -5947,23 +6045,30 @@ void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
};
mlir::Value from = unbox(args[0]);
mlir::Type resultType = from.getType();
- mlir::Value frompos = builder.createConvert(loc, resultType, unbox(args[1]));
- mlir::Value len = builder.createConvert(loc, resultType, unbox(args[2]));
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value frompos =
+ builder.createConvert(loc, signlessType, unbox(args[1]));
+ mlir::Value len = builder.createConvert(loc, signlessType, unbox(args[2]));
mlir::Value toAddr = unbox(args[3]);
assert(fir::dyn_cast_ptrEleTy(toAddr.getType()) == resultType &&
"mismatched mvbits types");
- auto to = builder.create<fir::LoadOp>(loc, resultType, toAddr);
- mlir::Value topos = builder.createConvert(loc, resultType, unbox(args[4]));
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value ones = builder.createAllOnesInteger(loc, resultType);
+ auto to = builder.create<fir::LoadOp>(loc, signlessType, toAddr);
+ mlir::Value topos = builder.createConvert(loc, signlessType, unbox(args[4]));
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value ones = builder.createAllOnesInteger(loc, signlessType);
mlir::Value bitSize = builder.createIntegerConstant(
- loc, resultType, mlir::cast<mlir::IntegerType>(resultType).getWidth());
+ loc, signlessType,
+ mlir::cast<mlir::IntegerType>(signlessType).getWidth());
auto shiftCount = builder.create<mlir::arith::SubIOp>(loc, bitSize, len);
auto mask = builder.create<mlir::arith::ShRUIOp>(loc, ones, shiftCount);
auto unchangedTmp1 = builder.create<mlir::arith::ShLIOp>(loc, mask, topos);
auto unchangedTmp2 =
builder.create<mlir::arith::XOrIOp>(loc, unchangedTmp1, ones);
auto unchanged = builder.create<mlir::arith::AndIOp>(loc, unchangedTmp2, to);
+ if (resultType.isUnsignedInteger())
+ from = builder.createConvert(loc, signlessType, from);
auto frombitsTmp1 = builder.create<mlir::arith::ShRUIOp>(loc, from, frompos);
auto frombitsTmp2 =
builder.create<mlir::arith::AndIOp>(loc, frombitsTmp1, mask);
@@ -5971,7 +6076,10 @@ void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
auto resTmp = builder.create<mlir::arith::OrIOp>(loc, unchanged, frombits);
auto lenIsZero = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::eq, len, zero);
- auto res = builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
+ mlir::Value res =
+ builder.create<mlir::arith::SelectOp>(loc, lenIsZero, to, resTmp);
+ if (resultType.isUnsignedInteger())
+ res = builder.createConvert(loc, resultType, res);
builder.create<fir::StoreOp>(loc, res, toAddr);
}
@@ -6204,8 +6312,12 @@ IntrinsicLibrary::genNorm2(mlir::Type resultType,
mlir::Value IntrinsicLibrary::genNot(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
assert(args.size() == 1);
- mlir::Value allOnes = builder.createAllOnesInteger(loc, resultType);
- return builder.create<mlir::arith::XOrIOp>(loc, args[0], allOnes);
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), resultType.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value allOnes = builder.createAllOnesInteger(loc, signlessType);
+ return builder.createUnsigned<mlir::arith::XOrIOp>(loc, resultType, args[0],
+ allOnes);
}
// NULL
@@ -6895,9 +7007,12 @@ mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
// maintain compatibility with them to an extent.
unsigned bits = resultType.getIntOrFloatBitWidth();
- mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
mlir::Value tooSmall = builder.create<mlir::arith::CmpIOp>(
loc, mlir::arith::CmpIPredicate::slt, shift, zero);
@@ -6905,34 +7020,49 @@ mlir::Value IntrinsicLibrary::genShift(mlir::Type resultType,
loc, mlir::arith::CmpIPredicate::sge, shift, bitSize);
mlir::Value outOfBounds =
builder.create<mlir::arith::OrIOp>(loc, tooSmall, tooLarge);
-
- mlir::Value shifted = builder.create<Shift>(loc, args[0], shift);
- return builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
+ mlir::Value word = args[0];
+ if (word.getType().isUnsignedInteger())
+ word = builder.createConvert(loc, signlessType, word);
+ mlir::Value shifted = builder.create<Shift>(loc, word, shift);
+ mlir::Value result =
+ builder.create<mlir::arith::SelectOp>(loc, outOfBounds, zero, shifted);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// SHIFTA
mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
unsigned bits = resultType.getIntOrFloatBitWidth();
- mlir::Value bitSize = builder.createIntegerConstant(loc, resultType, bits);
- mlir::Value shift = builder.createConvert(loc, resultType, args[1]);
- mlir::Value shiftEqBitSize = builder.create<mlir::arith::CmpIOp>(
- loc, mlir::arith::CmpIPredicate::eq, shift, bitSize);
+ mlir::Type signlessType =
+ mlir::IntegerType::get(builder.getContext(), bits,
+ mlir::IntegerType::SignednessSemantics::Signless);
+ mlir::Value bitSize = builder.createIntegerConstant(loc, signlessType, bits);
+ mlir::Value shift = builder.createConvert(loc, signlessType, args[1]);
+ mlir::Value shiftGeBitSize = builder.create<mlir::arith::CmpIOp>(
+ loc, mlir::arith::CmpIPredicate::uge, shift, bitSize);
// Lowering of mlir::arith::ShRSIOp is using `ashr`. `ashr` is undefined when
// the shift amount is equal to the element size.
// So if SHIFT is equal to the bit width then it is handled as a special case.
- mlir::Value zero = builder.createIntegerConstant(loc, resultType, 0);
- mlir::Value minusOne = builder.createMinusOneInteger(loc, resultType);
+ // When negative or larger than the bit width, handle it like other
+ // Fortran compiler do (treat it as bit width, minus 1).
+ mlir::Value zero = builder.createIntegerConstant(loc, signlessType, 0);
+ mlir::Value minusOne = builder.createMinusOneInteger(loc, signlessType);
+ mlir::Value word = args[0];
+ if (word.getType().isUnsignedInteger())
+ word = builder.createConvert(loc, signlessType, word);
mlir::Value valueIsNeg = builder.create<mlir::arith::CmpIOp>(
- loc, mlir::arith::CmpIPredicate::slt, args[0], zero);
+ loc, mlir::arith::CmpIPredicate::slt, word, zero);
mlir::Value specialRes =
builder.create<mlir::arith::SelectOp>(loc, valueIsNeg, minusOne, zero);
-
- mlir::Value shifted =
- builder.create<mlir::arith::ShRSIOp>(loc, args[0], shift);
- return builder.create<mlir::arith::SelectOp>(loc, shiftEqBitSize, specialRes,
- shifted);
+ mlir::Value shifted = builder.create<mlir::arith::ShRSIOp>(loc, word, shift);
+ mlir::Value result = builder.create<mlir::arith::SelectOp>(
+ loc, shiftGeBitSize, specialRes, shifted);
+ if (resultType.isUnsignedInteger())
+ return builder.createConvert(loc, resultType, result);
+ return result;
}
// SIGNAL
@@ -7416,13 +7546,16 @@ template <Extremum extremum, ExtremumBehavior behavior>
static mlir::Value createExtremumCompare(mlir::Location loc,
fir::FirOpBuilder &builder,
mlir::Value left, mlir::Value right) {
- static constexpr mlir::arith::CmpIPredicate integerPredicate =
- extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
- : mlir::arith::CmpIPredicate::slt;
+ mlir::Type type = left.getType();
+ mlir::arith::CmpIPredicate integerPredicate =
+ type.isUnsignedInteger() ? extremum == Extremum::Max
+ ? mlir::arith::CmpIPredicate::ugt
+ : mlir::arith::CmpIPredicate::ult
+ : extremum == Extremum::Max ? mlir::arith::CmpIPredicate::sgt
+ : mlir::arith::CmpIPredicate::slt;
static constexpr mlir::arith::CmpFPredicate orderedCmp =
extremum == Extremum::Max ? mlir::arith::CmpFPredicate::OGT
: mlir::arith::CmpFPredicate::OLT;
- mlir::Type type = left.getType();
mlir::Value result;
if (fir::isa_real(type)) {
// Note: the signaling/quit aspect of the result required by IEEE
@@ -7460,6 +7593,13 @@ static mlir::Value createExtremumCompare(mlir::Location loc,
"ieeeMinNum/ieeeMaxNum behavior not implemented");
}
} else if (fir::isa_integer(type)) {
+ if (type.isUnsignedInteger()) {
+ mlir::Type signlessType = mlir::IntegerType::get(
+ builder.getContext(), type.getIntOrFloatBitWidth(),
+ mlir::IntegerType::SignednessSemantics::Signless);
+ left = builder.createConvert(loc, signlessType, left);
+ right = builder.createConvert(loc, signlessType, right);
+ }
result =
builder.create<mlir::arith::CmpIOp>(loc, integerPredicate, left, right);
} else if (fir::isa_char(type) || fir::isa_char(fir::unwrapRefType(type))) {
diff --git a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
index b768733bd2fd8f..1aa941bd2131c2 100644
--- a/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Reduction.cpp
@@ -71,6 +71,24 @@ struct ForcedMaxvalInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Maxval Intrinsic
+struct ForcedMaxvalUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(MaxvalUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for real*10 version of Minval Intrinsic
struct ForcedMinvalReal10 {
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(MinvalReal10));
@@ -120,15 +138,35 @@ struct ForcedMinvalInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Minval Intrinsic
+struct ForcedMinvalUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(MinvalUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
// Maxloc/Minloc take descriptor, so these runtime signature are not ifdef
// and the mkRTKey can safely be used here. Define alias so that the
// REAL_INTRINSIC_INSTANCES macro works with them too
using ForcedMaxlocReal10 = mkRTKey(MaxlocReal10);
using ForcedMaxlocReal16 = mkRTKey(MaxlocReal16);
using ForcedMaxlocInteger16 = mkRTKey(MaxlocInteger16);
+using ForcedMaxlocUnsigned16 = mkRTKey(MaxlocUnsigned16);
using ForcedMinlocReal10 = mkRTKey(MinlocReal10);
using ForcedMinlocReal16 = mkRTKey(MinlocReal16);
using ForcedMinlocInteger16 = mkRTKey(MinlocInteger16);
+using ForcedMinlocUnsigned16 = mkRTKey(MinlocUnsigned16);
/// Placeholder for real*10 version of Norm2 Intrinsic
struct ForcedNorm2Real10 {
@@ -225,6 +263,24 @@ struct ForcedProductInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Product Intrinsic
+struct ForcedProductUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ProductUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Product Intrinsic
struct ForcedProductComplex10 {
static constexpr const char *name =
@@ -345,6 +401,23 @@ struct ForcedDotProductInteger16 {
}
};
+/// Placeholder for unsigned*16 version of DotProduct Intrinsic
+struct ForcedDotProductUnsigned16 {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(DotProductUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, boxTy, strTy, intTy}, {ty});
+ };
+ }
+};
+
/// Placeholder for real*10 version of Sum Intrinsic
struct ForcedSumReal10 {
static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumReal10));
@@ -393,6 +466,23 @@ struct ForcedSumInteger16 {
}
};
+/// Placeholder for unsigned*16 version of Sum Intrinsic
+struct ForcedSumUnsigned16 {
+ static constexpr const char *name = ExpandAndQuoteKey(RTNAME(SumUnsigned16));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ return mlir::FunctionType::get(ctx, {boxTy, strTy, intTy, intTy, boxTy},
+ {ty});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Sum Intrinsic
struct ForcedSumComplex10 {
static constexpr const char *name =
@@ -665,6 +755,26 @@ struct ForcedReduceInteger16Ref {
}
};
+/// Placeholder for unsigned*16 version of Reduce Intrinsic
+struct ForcedReduceUnsigned16Ref {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16Ref));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(ctx, 128);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {refTy, refTy}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+ };
+ }
+};
+
/// Placeholder for integer*16 with value version of Reduce Intrinsic
struct ForcedReduceInteger16Value {
static constexpr const char *name =
@@ -685,6 +795,26 @@ struct ForcedReduceInteger16Value {
}
};
+/// Placeholder for unsigned*16 with value version of Reduce Intrinsic
+struct ForcedReduceUnsigned16Value {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16Value));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(ctx, 128);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty}, {ty});
+ };
+ }
+};
+
/// Placeholder for DIM integer*16 version of Reduce Intrinsic
struct ForcedReduceInteger16DimRef {
static constexpr const char *name =
@@ -707,6 +837,29 @@ struct ForcedReduceInteger16DimRef {
}
};
+/// Placeholder for DIM unsigned*16 version of Reduce Intrinsic
+struct ForcedReduceUnsigned16DimRef {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16DimRef));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {refTy, refTy}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto refBoxTy = fir::ReferenceType::get(boxTy);
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {refBoxTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+ {});
+ };
+ }
+};
+
/// Placeholder for DIM integer*16 with value version of Reduce Intrinsic
struct ForcedReduceInteger16DimValue {
static constexpr const char *name =
@@ -729,6 +882,29 @@ struct ForcedReduceInteger16DimValue {
}
};
+/// Placeholder for DIM unsigned*16 with value version of Reduce Intrinsic
+struct ForcedReduceUnsigned16DimValue {
+ static constexpr const char *name =
+ ExpandAndQuoteKey(RTNAME(ReduceUnsigned16DimValue));
+ static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+ return [](mlir::MLIRContext *ctx) {
+ auto ty = mlir::IntegerType::get(
+ ctx, 128, mlir::IntegerType::SignednessSemantics::Unsigned);
+ auto boxTy =
+ fir::runtime::getModel<const Fortran::runtime::Descriptor &>()(ctx);
+ auto refTy = fir::ReferenceType::get(ty);
+ auto opTy = mlir::FunctionType::get(ctx, {ty, ty}, refTy);
+ auto strTy = fir::ReferenceType::get(mlir::IntegerType::get(ctx, 8));
+ auto intTy = mlir::IntegerType::get(ctx, 8 * sizeof(int));
+ auto refBoxTy = fir::ReferenceType::get(boxTy);
+ auto i1Ty = mlir::IntegerType::get(ctx, 1);
+ return mlir::FunctionType::get(
+ ctx, {refBoxTy, boxTy, opTy, strTy, intTy, intTy, boxTy, refTy, i1Ty},
+ {});
+ };
+ }
+};
+
/// Placeholder for complex(10) version of Reduce Intrinsic
struct ForcedReduceComplex10Ref {
static constexpr const char *name =
@@ -919,6 +1095,13 @@ struct ForcedReduceComplex16DimValue {
INTRINSIC_INSTANCE(NAME, Integer, 8, SUFFIX) \
FORCED_INTRINSIC_INSTANCE(NAME, Integer, 16, SUFFIX)
+#define UNSIGNED_INTRINSIC_INSTANCES(NAME, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 1, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 2, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 4, SUFFIX) \
+ INTRINSIC_INSTANCE(NAME, Unsigned, 8, SUFFIX) \
+ FORCED_INTRINSIC_INSTANCE(NAME, Unsigned, 16, SUFFIX)
+
#define REAL_INTRINSIC_INSTANCES(NAME, SUFFIX) \
INTRINSIC_INSTANCE(NAME, Real, 4, SUFFIX) \
INTRINSIC_INSTANCE(NAME, Real, 8, SUFFIX) \
@@ -933,6 +1116,7 @@ struct ForcedReduceComplex16DimValue {
#define NUMERICAL_INTRINSIC_INSTANCES(NAME) \
INTEGER_INTRINSIC_INSTANCES(NAME, ) \
+ UNSIGNED_INTRINSIC_INSTANCES(NAME, ) \
REAL_INTRINSIC_INSTANCES(NAME, ) \
COMPLEX_INTRINSIC_INSTANCES(NAME, )
@@ -944,6 +1128,7 @@ struct ForcedReduceComplex16DimValue {
#define NUMERICAL_AND_LOGICAL_INSTANCES(NAME, SUFFIX) \
INTEGER_INTRINSIC_INSTANCES(NAME, SUFFIX) \
+ UNSIGNED_INTRINSIC_INSTANCES(NAME, SUFFIX) \
REAL_INTRINSIC_INSTANCES(NAME, SUFFIX) \
COMPLEX_INTRINSIC_INSTANCES(NAME, SUFFIX) \
LOGICAL_INTRINSIC_INSTANCES(NAME, SUFFIX)
@@ -1163,6 +1348,7 @@ void fir::runtime::genMaxloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Maxloc, )
INTEGER_INTRINSIC_INSTANCES(Maxloc, )
+ UNSIGNED_INTRINSIC_INSTANCES(Maxloc, )
if (charHelper.isCharacterScalar(eleTy))
func = fir::runtime::getRuntimeFunc<mkRTKey(MaxlocCharacter)>(loc, builder);
if (!func)
@@ -1195,6 +1381,7 @@ mlir::Value fir::runtime::genMaxval(fir::FirOpBuilder &builder,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Maxval, )
INTEGER_INTRINSIC_INSTANCES(Maxval, )
+ UNSIGNED_INTRINSIC_INSTANCES(Maxval, )
if (!func)
fir::intrinsicTypeTODO(builder, eleTy, loc, "MAXVAL");
@@ -1246,6 +1433,7 @@ void fir::runtime::genMinloc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Minloc, )
INTEGER_INTRINSIC_INSTANCES(Minloc, )
+ UNSIGNED_INTRINSIC_INSTANCES(Minloc, )
fir::factory::CharacterExprHelper charHelper{builder, loc};
if (charHelper.isCharacterScalar(eleTy))
func = fir::runtime::getRuntimeFunc<mkRTKey(MinlocCharacter)>(loc, builder);
@@ -1305,6 +1493,7 @@ mlir::Value fir::runtime::genMinval(fir::FirOpBuilder &builder,
mlir::func::FuncOp func;
REAL_INTRINSIC_INSTANCES(Minval, )
INTEGER_INTRINSIC_INSTANCES(Minval, )
+ UNSIGNED_INTRINSIC_INSTANCES(Minval, )
if (!func)
fir::intrinsicTypeTODO(builder, eleTy, loc, "MINVAL");
@@ -1659,11 +1848,13 @@ mlir::Value fir::runtime::genReduce(fir::FirOpBuilder &builder,
REAL_2_3_INTRINSIC_INSTANCES(Reduce, Ref)
REAL_INTRINSIC_INSTANCES(Reduce, Ref)
INTEGER_INTRINSIC_INSTANCES(Reduce, Ref)
+ UNSIGNED_INTRINSIC_INSTANCES(Reduce, Ref)
LOGICAL_INTRINSIC_INSTANCES(Reduce, Ref)
} else {
REAL_2_3_INTRINSIC_INSTANCES(Reduce, Value)
REAL_INTRINSIC_INSTANCES(Reduce, Value)
INTEGER_INTRINSIC_INSTANCES(Reduce, Value)
+ UNSIGNED_INTRINSIC_INSTANCES(Reduce, Value)
LOGICAL_INTRINSIC_INSTANCES(Reduce, Value)
}
if (!func)
diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
index 3452a662f7a194..67b421e74fc6d3 100644
--- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp
+++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
@@ -783,7 +783,10 @@ struct ConvertOpConversion : public fir::FIROpConversion<fir::ConvertOp> {
return mlir::success();
}
if (mlir::isa<mlir::IntegerType>(toTy)) {
- rewriter.replaceOpWithNewOp<mlir::LLVM::FPToSIOp>(convert, toTy, op0);
+ if (toTy.isUnsignedInteger())
+ rewriter.replaceOpWithNewOp<mlir::LLVM::FPToUIOp>(convert, toTy, op0);
+ else
+ rewriter.replaceOpWithNewOp<mlir::LLVM::FPToSIOp>(convert, toTy, op0);
return mlir::success();
}
} else if (mlir::isa<mlir::IntegerType>(fromTy)) {
@@ -796,7 +799,7 @@ struct ConvertOpConversion : public fir::FIROpConversion<fir::ConvertOp> {
rewriter.replaceOpWithNewOp<mlir::LLVM::TruncOp>(convert, toTy, op0);
return mlir::success();
}
- if (fromFirTy == i1Type) {
+ if (fromFirTy == i1Type || fromFirTy.isUnsignedInteger()) {
rewriter.replaceOpWithNewOp<mlir::LLVM::ZExtOp>(convert, toTy, op0);
return mlir::success();
}
@@ -805,7 +808,10 @@ struct ConvertOpConversion : public fir::FIROpConversion<fir::ConvertOp> {
}
// Integer to floating point conversion.
if (isFloatingPointTy(toTy)) {
- rewriter.replaceOpWithNewOp<mlir::LLVM::SIToFPOp>(convert, toTy, op0);
+ if (fromTy.isUnsignedInteger())
+ rewriter.replaceOpWithNewOp<mlir::LLVM::UIToFPOp>(convert, toTy, op0);
+ else
+ rewriter.replaceOpWithNewOp<mlir::LLVM::SIToFPOp>(convert, toTy, op0);
return mlir::success();
}
// Integer to pointer conversion.
diff --git a/flang/lib/Optimizer/Dialect/FIRType.cpp b/flang/lib/Optimizer/Dialect/FIRType.cpp
index 70c0fd66d18aee..cba7fa64128502 100644
--- a/flang/lib/Optimizer/Dialect/FIRType.cpp
+++ b/flang/lib/Optimizer/Dialect/FIRType.cpp
@@ -442,19 +442,35 @@ unsigned getBoxRank(mlir::Type boxTy) {
/// Return the ISO_C_BINDING intrinsic module value of type \p ty.
int getTypeCode(mlir::Type ty, const fir::KindMapping &kindMap) {
if (mlir::IntegerType intTy = mlir::dyn_cast<mlir::IntegerType>(ty)) {
- switch (intTy.getWidth()) {
- case 8:
- return CFI_type_int8_t;
- case 16:
- return CFI_type_int16_t;
- case 32:
- return CFI_type_int32_t;
- case 64:
- return CFI_type_int64_t;
- case 128:
- return CFI_type_int128_t;
+ if (intTy.isUnsigned()) {
+ switch (intTy.getWidth()) {
+ case 8:
+ return CFI_type_uint8_t;
+ case 16:
+ return CFI_type_uint16_t;
+ case 32:
+ return CFI_type_uint32_t;
+ case 64:
+ return CFI_type_uint64_t;
+ case 128:
+ return CFI_type_uint128_t;
+ }
+ llvm_unreachable("unsupported integer type");
+ } else {
+ switch (intTy.getWidth()) {
+ case 8:
+ return CFI_type_int8_t;
+ case 16:
+ return CFI_type_int16_t;
+ case 32:
+ return CFI_type_int32_t;
+ case 64:
+ return CFI_type_int64_t;
+ case 128:
+ return CFI_type_int128_t;
+ }
+ llvm_unreachable("unsupported integer type");
}
- llvm_unreachable("unsupported integer type");
}
if (fir::LogicalType logicalTy = mlir::dyn_cast<fir::LogicalType>(ty)) {
switch (kindMap.getLogicalBitsize(logicalTy.getFKind())) {
@@ -804,6 +820,19 @@ void fir::IntegerType::print(mlir::AsmPrinter &printer) const {
printer << "<" << getFKind() << '>';
}
+//===----------------------------------------------------------------------===//
+// UnsignedType
+//===----------------------------------------------------------------------===//
+
+// `unsigned` `<` kind `>`
+mlir::Type fir::UnsignedType::parse(mlir::AsmParser &parser) {
+ return parseKindSingleton<fir::UnsignedType>(parser);
+}
+
+void fir::UnsignedType::print(mlir::AsmPrinter &printer) const {
+ printer << "<" << getFKind() << '>';
+}
+
//===----------------------------------------------------------------------===//
// LogicalType
//===----------------------------------------------------------------------===//
diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp
index 0bdc4c4e033c76..71d7d5c97d29ae 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -134,7 +134,8 @@ TYPE_CONTEXT_PARSER("internal subprogram part"_en_US,
// R605 literal-constant ->
// int-literal-constant | real-literal-constant |
// complex-literal-constant | logical-literal-constant |
-// char-literal-constant | boz-literal-constant
+// char-literal-constant | boz-literal-constant |
+// unsigned-literal-constant
TYPE_PARSER(
first(construct<LiteralConstant>(Parser<HollerithLiteralConstant>{}),
construct<LiteralConstant>(realLiteralConstant),
@@ -142,7 +143,8 @@ TYPE_PARSER(
construct<LiteralConstant>(Parser<ComplexLiteralConstant>{}),
construct<LiteralConstant>(Parser<BOZLiteralConstant>{}),
construct<LiteralConstant>(charLiteralConstant),
- construct<LiteralConstant>(Parser<LogicalLiteralConstant>{})))
+ construct<LiteralConstant>(Parser<LogicalLiteralConstant>{}),
+ construct<LiteralConstant>(unsignedLiteralConstant)))
// R606 named-constant -> name
TYPE_PARSER(construct<NamedConstant>(name))
@@ -213,6 +215,7 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
"CHARACTER" >> maybe(Parser<CharSelector>{}))),
construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
"LOGICAL" >> maybe(kindSelector))),
+ construct<IntrinsicTypeSpec>(unsignedTypeSpec),
extension<LanguageFeature::DoubleComplex>(
"nonstandard usage: DOUBLE COMPLEX"_port_en_US,
construct<IntrinsicTypeSpec>("DOUBLE COMPLEX"_sptok >>
@@ -233,7 +236,7 @@ TYPE_CONTEXT_PARSER("vector type spec"_en_US,
construct<VectorTypeSpec::QuadVectorTypeSpec>()))))
// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |
-// VECTOR(unsigend-type-spec) |
+// VECTOR(unsigned-type-spec) |
TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>
parenthesized(construct<VectorElementType>(integerTypeSpec) ||
construct<VectorElementType>(unsignedTypeSpec) ||
@@ -266,7 +269,11 @@ TYPE_PARSER(sourced(
// R708 int-literal-constant -> digit-string [_ kind-param]
// The negated look-ahead for a trailing underscore prevents misrecognition
// when the digit string is a numeric kind parameter of a character literal.
-TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString,
+TYPE_PARSER(construct<IntLiteralConstant>(space >> digitString / !"u"_ch,
+ maybe(underscore >> noSpace >> kindParam) / !underscore))
+
+// unsigned-literal-constant -> digit-string U [_ kind-param]
+TYPE_PARSER(construct<UnsignedLiteralConstant>(space >> digitString / "u"_ch,
maybe(underscore >> noSpace >> kindParam) / !underscore))
// R709 kind-param -> digit-string | scalar-int-constant-name
@@ -1026,8 +1033,10 @@ constexpr auto implicitSpecDeclarationTypeSpecRetry{
construct<IntrinsicTypeSpec::Complex>("COMPLEX" >> noKindSelector)),
construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Character>(
"CHARACTER" >> construct<std::optional<CharSelector>>())),
- construct<IntrinsicTypeSpec>(construct<IntrinsicTypeSpec::Logical>(
- "LOGICAL" >> noKindSelector))))};
+ construct<IntrinsicTypeSpec>(
+ construct<IntrinsicTypeSpec::Logical>("LOGICAL" >> noKindSelector)),
+ construct<IntrinsicTypeSpec>(
+ construct<UnsignedTypeSpec>("UNSIGNED" >> noKindSelector))))};
TYPE_PARSER(construct<ImplicitSpec>(declarationTypeSpec,
parenthesized(nonemptyList(Parser<LetterSpec>{}))) ||
diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h
index adbf6d23cbd99a..7ad7e242ddc4b1 100644
--- a/flang/lib/Parser/type-parsers.h
+++ b/flang/lib/Parser/type-parsers.h
@@ -59,6 +59,7 @@ constexpr Parser<IntegerTypeSpec> integerTypeSpec; // R705
constexpr Parser<KindSelector> kindSelector; // R706
constexpr Parser<SignedIntLiteralConstant> signedIntLiteralConstant; // R707
constexpr Parser<IntLiteralConstant> intLiteralConstant; // R708
+constexpr Parser<UnsignedLiteralConstant> unsignedLiteralConstant;
constexpr Parser<KindParam> kindParam; // R709
constexpr Parser<RealLiteralConstant> realLiteralConstant; // R714
constexpr Parser<CharLength> charLength; // R723
diff --git a/flang/lib/Semantics/check-arithmeticif.cpp b/flang/lib/Semantics/check-arithmeticif.cpp
index f87a0045fff5b5..8559bef6ce2f71 100644
--- a/flang/lib/Semantics/check-arithmeticif.cpp
+++ b/flang/lib/Semantics/check-arithmeticif.cpp
@@ -32,6 +32,9 @@ void ArithmeticIfStmtChecker::Leave(
} else if (ExprHasTypeCategory(*expr, common::TypeCategory::Complex)) {
context_.Say(parsedExpr.source,
"ARITHMETIC IF expression must not be a COMPLEX expression"_err_en_US);
+ } else if (ExprHasTypeCategory(*expr, common::TypeCategory::Unsigned)) {
+ context_.Say(parsedExpr.source,
+ "ARITHMETIC IF expression must not be an UNSIGNED expression"_err_en_US);
} else if (!IsNumericExpr(*expr)) {
context_.Say(parsedExpr.source,
"ARITHMETIC IF expression must be a numeric expression"_err_en_US);
diff --git a/flang/lib/Semantics/check-case.cpp b/flang/lib/Semantics/check-case.cpp
index caa8f8b6e70be8..5ce143c9aec91a 100644
--- a/flang/lib/Semantics/check-case.cpp
+++ b/flang/lib/Semantics/check-case.cpp
@@ -253,6 +253,10 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
common::SearchTypes(
TypeVisitor<TypeCategory::Integer>{context_, *exprType, caseList});
return;
+ case TypeCategory::Unsigned:
+ common::SearchTypes(
+ TypeVisitor<TypeCategory::Unsigned>{context_, *exprType, caseList});
+ return;
case TypeCategory::Logical:
CaseValues<evaluate::Type<TypeCategory::Logical, 1>>{context_, *exprType}
.Check(caseList);
@@ -266,6 +270,8 @@ void CaseChecker::Enter(const parser::CaseConstruct &construct) {
}
}
context_.Say(selectExpr.source,
- "SELECT CASE expression must be integer, logical, or character"_err_en_US);
+ context_.IsEnabled(common::LanguageFeature::Unsigned)
+ ? "SELECT CASE expression must be integer, unsigned, logical, or character"_err_en_US
+ : "SELECT CASE expression must be integer, logical, or character"_err_en_US);
}
} // namespace Fortran::semantics
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index ead99821126787..0fc0ffb1e744ac 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -650,10 +650,11 @@ int ExpressionAnalyzer::AnalyzeKindParam(
return static_cast<int>(kind);
}
-// Common handling of parser::IntLiteralConstant and SignedIntLiteralConstant
-struct IntTypeVisitor {
+// Common handling of parser::IntLiteralConstant, SignedIntLiteralConstant,
+// and UnsignedLiteralConstant
+template <typename TYPES, TypeCategory CAT> struct IntTypeVisitor {
using Result = MaybeExpr;
- using Types = IntegerTypes;
+ using Types = TYPES;
template <typename T> Result Test() {
if (T::kind >= kind) {
const char *p{digits.begin()};
@@ -668,7 +669,7 @@ struct IntTypeVisitor {
"negated maximum INTEGER(KIND=%d) literal"_port_en_US, T::kind);
}
} else {
- num = Int::Read(p, 10, true /*signed*/);
+ num = Int::Read(p, 10, /*isSigned=*/CAT == TypeCategory::Integer);
}
if (!num.overflow) {
if (T::kind > kind) {
@@ -676,14 +677,16 @@ struct IntTypeVisitor {
!analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) {
return std::nullopt;
} else {
+ const char *typeName{
+ CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"};
analyzer.Warn(LanguageFeature::BigIntLiterals, digits,
- "Integer literal is too large for default INTEGER(KIND=%d); "
- "assuming INTEGER(KIND=%d)"_port_en_US,
- kind, T::kind);
+ "Integer literal is too large for default %s(KIND=%d); "
+ "assuming %s(KIND=%d)"_port_en_US,
+ typeName, kind, typeName, T::kind);
}
}
return Expr<SomeType>{
- Expr<SomeInteger>{Expr<T>{Constant<T>{std::move(num.value)}}}};
+ Expr<SomeKind<CAT>>{Expr<T>{Constant<T>{std::move(num.value)}}}};
}
}
return std::nullopt;
@@ -695,24 +698,25 @@ struct IntTypeVisitor {
bool isNegated;
};
-template <typename PARSED>
+template <typename TYPES, TypeCategory CAT, typename PARSED>
MaybeExpr ExpressionAnalyzer::IntLiteralConstant(
const PARSED &x, bool isNegated) {
const auto &kindParam{std::get<std::optional<parser::KindParam>>(x.t)};
bool isDefaultKind{!kindParam};
- int kind{AnalyzeKindParam(kindParam, GetDefaultKind(TypeCategory::Integer))};
- if (CheckIntrinsicKind(TypeCategory::Integer, kind)) {
+ int kind{AnalyzeKindParam(kindParam, GetDefaultKind(CAT))};
+ const char *typeName{CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"};
+ if (CheckIntrinsicKind(CAT, kind)) {
auto digits{std::get<parser::CharBlock>(x.t)};
- if (MaybeExpr result{common::SearchTypes(
- IntTypeVisitor{*this, digits, kind, isDefaultKind, isNegated})}) {
+ if (MaybeExpr result{common::SearchTypes(IntTypeVisitor<TYPES, CAT>{
+ *this, digits, kind, isDefaultKind, isNegated})}) {
return result;
} else if (isDefaultKind) {
Say(digits,
- "Integer literal is too large for any allowable "
- "kind of INTEGER"_err_en_US);
+ "Integer literal is too large for any allowable kind of %s"_err_en_US,
+ typeName);
} else {
- Say(digits, "Integer literal is too large for INTEGER(KIND=%d)"_err_en_US,
- kind);
+ Say(digits, "Integer literal is too large for %s(KIND=%d)"_err_en_US,
+ typeName, kind);
}
}
return std::nullopt;
@@ -722,13 +726,25 @@ MaybeExpr ExpressionAnalyzer::Analyze(
const parser::IntLiteralConstant &x, bool isNegated) {
auto restorer{
GetContextualMessages().SetLocation(std::get<parser::CharBlock>(x.t))};
- return IntLiteralConstant(x, isNegated);
+ return IntLiteralConstant<IntegerTypes, TypeCategory::Integer>(x, isNegated);
}
MaybeExpr ExpressionAnalyzer::Analyze(
const parser::SignedIntLiteralConstant &x) {
auto restorer{GetContextualMessages().SetLocation(x.source)};
- return IntLiteralConstant(x);
+ return IntLiteralConstant<IntegerTypes, TypeCategory::Integer>(x);
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(
+ const parser::UnsignedLiteralConstant &x) {
+ parser::CharBlock at{std::get<parser::CharBlock>(x.t)};
+ auto restorer{GetContextualMessages().SetLocation(at)};
+ if (!context().IsEnabled(common::LanguageFeature::Unsigned) &&
+ !context().AnyFatalError()) {
+ context().Say(
+ at, "-funsigned is required to enable UNSIGNED constants"_err_en_US);
+ }
+ return IntLiteralConstant<UnsignedTypes, TypeCategory::Unsigned>(x);
}
template <typename TYPE>
@@ -3498,9 +3514,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedUnary &x) {
// Binary (dyadic) operations
-template <template <typename> class OPR>
-MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
- const parser::Expr::IntrinsicBinary &x) {
+template <template <typename> class OPR, NumericOperator opr>
+MaybeExpr NumericBinaryHelper(
+ ExpressionAnalyzer &context, const parser::Expr::IntrinsicBinary &x) {
ArgumentAnalyzer analyzer{context};
analyzer.Analyze(std::get<0>(x.t));
analyzer.Analyze(std::get<1>(x.t));
@@ -3509,9 +3525,10 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
analyzer.CheckForNullPointer();
analyzer.CheckForAssumedRank();
analyzer.CheckConformance();
- return NumericOperation<OPR>(context.GetContextualMessages(),
- analyzer.MoveExpr(0), analyzer.MoveExpr(1),
- context.GetDefaultKind(TypeCategory::Real));
+ constexpr bool canBeUnsigned{opr != NumericOperator::Power};
+ return NumericOperation<OPR, canBeUnsigned>(
+ context.GetContextualMessages(), analyzer.MoveExpr(0),
+ analyzer.MoveExpr(1), context.GetDefaultKind(TypeCategory::Real));
} else {
return analyzer.TryDefinedOp(AsFortran(opr),
"Operands of %s must be numeric; have %s and %s"_err_en_US);
@@ -3521,23 +3538,23 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Power &x) {
- return NumericBinaryHelper<Power>(*this, NumericOperator::Power, x);
+ return NumericBinaryHelper<Power, NumericOperator::Power>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Multiply &x) {
- return NumericBinaryHelper<Multiply>(*this, NumericOperator::Multiply, x);
+ return NumericBinaryHelper<Multiply, NumericOperator::Multiply>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Divide &x) {
- return NumericBinaryHelper<Divide>(*this, NumericOperator::Divide, x);
+ return NumericBinaryHelper<Divide, NumericOperator::Divide>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Add &x) {
- return NumericBinaryHelper<Add>(*this, NumericOperator::Add, x);
+ return NumericBinaryHelper<Add, NumericOperator::Add>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Subtract &x) {
- return NumericBinaryHelper<Subtract>(*this, NumericOperator::Subtract, x);
+ return NumericBinaryHelper<Subtract, NumericOperator::Subtract>(*this, x);
}
MaybeExpr ExpressionAnalyzer::Analyze(
@@ -4268,12 +4285,14 @@ bool ArgumentAnalyzer::IsIntrinsicNumeric(NumericOperator opr) const {
}
} else {
std::optional<DynamicType> rightType{GetType(1)};
- if (IsBOZLiteral(0) && rightType) { // BOZ opr Integer/Real
+ if (IsBOZLiteral(0) && rightType) { // BOZ opr Integer/Unsigned/Real
auto cat1{rightType->category()};
- return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Real;
- } else if (IsBOZLiteral(1) && leftType) { // Integer/Real opr BOZ
+ return cat1 == TypeCategory::Integer || cat1 == TypeCategory::Unsigned ||
+ cat1 == TypeCategory::Real;
+ } else if (IsBOZLiteral(1) && leftType) { // Integer/Unsigned/Real opr BOZ
auto cat0{leftType->category()};
- return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Real;
+ return cat0 == TypeCategory::Integer || cat0 == TypeCategory::Unsigned ||
+ cat0 == TypeCategory::Real;
} else {
return leftType && rightType &&
semantics::IsIntrinsicNumeric(
@@ -4327,9 +4346,9 @@ bool ArgumentAnalyzer::CheckConformance() {
}
bool ArgumentAnalyzer::CheckAssignmentConformance() {
- if (actuals_.size() == 2) {
- const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
- const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
+ if (actuals_.size() == 2 && actuals_[0] && actuals_[1]) {
+ const auto *lhs{actuals_[0]->UnwrapExpr()};
+ const auto *rhs{actuals_[1]->UnwrapExpr()};
if (lhs && rhs) {
auto &foldingContext{context_.GetFoldingContext()};
auto lhShape{GetShape(foldingContext, *lhs)};
@@ -4521,6 +4540,7 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
}
} else {
if (lhsType->category() == TypeCategory::Integer ||
+ lhsType->category() == TypeCategory::Unsigned ||
lhsType->category() == TypeCategory::Real) {
ConvertBOZ(nullptr, 1, lhsType);
}
@@ -4755,7 +4775,8 @@ int ArgumentAnalyzer::GetRank(std::size_t i) const {
}
// If the argument at index i is a BOZ literal, convert its type to match the
-// otherType. If it's REAL convert to REAL, otherwise convert to INTEGER.
+// otherType. If it's REAL, convert to REAL; if it's UNSIGNED, convert to
+// UNSIGNED; otherwise, convert to INTEGER.
// Note that IBM supports comparing BOZ literals to CHARACTER operands. That
// is not currently supported.
void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> *thisType,
@@ -4767,10 +4788,18 @@ void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> *thisType,
int kind{context_.context().GetDefaultKind(TypeCategory::Real)};
MaybeExpr realExpr{
ConvertToKind<TypeCategory::Real>(kind, std::move(*boz))};
- actuals_[i] = std::move(*realExpr);
+ actuals_[i] = std::move(realExpr.value());
if (thisType) {
thisType->emplace(TypeCategory::Real, kind);
}
+ } else if (otherType && otherType->category() == TypeCategory::Unsigned) {
+ int kind{context_.context().GetDefaultKind(TypeCategory::Unsigned)};
+ MaybeExpr unsignedExpr{
+ ConvertToKind<TypeCategory::Unsigned>(kind, std::move(*boz))};
+ actuals_[i] = std::move(unsignedExpr.value());
+ if (thisType) {
+ thisType->emplace(TypeCategory::Unsigned, kind);
+ }
} else {
int kind{context_.context().GetDefaultKind(TypeCategory::Integer)};
MaybeExpr intExpr{
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 09120e3ed0e971..3d2b5089595aa7 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -984,6 +984,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
bool Pre(const parser::TypeDeclarationStmt &);
void Post(const parser::TypeDeclarationStmt &);
void Post(const parser::IntegerTypeSpec &);
+ void Post(const parser::UnsignedTypeSpec &);
void Post(const parser::IntrinsicTypeSpec::Real &);
void Post(const parser::IntrinsicTypeSpec::Complex &);
void Post(const parser::IntrinsicTypeSpec::Logical &);
@@ -5329,6 +5330,15 @@ void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) {
SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v));
}
}
+void DeclarationVisitor::Post(const parser::UnsignedTypeSpec &x) {
+ if (!isVectorType_) {
+ if (!context().IsEnabled(common::LanguageFeature::Unsigned) &&
+ !context().AnyFatalError()) {
+ context().Say("-funsigned is required to enable UNSIGNED type"_err_en_US);
+ }
+ SetDeclTypeSpec(MakeNumericType(TypeCategory::Unsigned, x.v));
+ }
+}
void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) {
if (!isVectorType_) {
SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind));
@@ -7635,6 +7645,7 @@ const DeclTypeSpec &ConstructVisitor::ToDeclTypeSpec(
switch (type.category()) {
SWITCH_COVERS_ALL_CASES
case common::TypeCategory::Integer:
+ case common::TypeCategory::Unsigned:
case common::TypeCategory::Real:
case common::TypeCategory::Complex:
return context().MakeNumericType(type.category(), type.kind());
diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 6ee53cde56866c..9c5682bed06cbb 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -215,6 +215,7 @@ const DeclTypeSpec *Scope::GetType(const SomeExpr &expr) {
} else {
switch (dyType->category()) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Complex:
return &MakeNumericType(dyType->category(), KindExpr{dyType->kind()});
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 379d5d0eb3eef0..9e180605c1b3bd 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -143,7 +143,9 @@ Tristate IsDefinedAssignment(
return Tristate::Yes;
} else if (lhsCat != TypeCategory::Derived) {
return ToTristate(lhsCat != rhsCat &&
- (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat)));
+ (!IsNumericTypeCategory(lhsCat) || !IsNumericTypeCategory(rhsCat) ||
+ lhsCat == TypeCategory::Unsigned ||
+ rhsCat == TypeCategory::Unsigned));
} else if (MightBeSameDerivedType(lhsType, rhsType)) {
return Tristate::Maybe; // TYPE(t) = TYPE(t) can be defined or intrinsic
} else {
@@ -159,7 +161,9 @@ bool IsIntrinsicRelational(common::RelationalOperator opr,
} else {
auto cat0{type0.category()};
auto cat1{type1.category()};
- if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
+ if (cat0 == TypeCategory::Unsigned || cat1 == TypeCategory::Unsigned) {
+ return cat0 == cat1;
+ } else if (IsNumericTypeCategory(cat0) && IsNumericTypeCategory(cat1)) {
// numeric types: EQ/NE always ok, others ok for non-complex
return opr == common::RelationalOperator::EQ ||
opr == common::RelationalOperator::NE ||
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index eb0f8f2ef59ad6..73d712cf3e75c9 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -110,6 +110,35 @@ module iso_c_binding
integer, parameter, public :: &
c_float128 = 16, &
c_float128_complex = c_float128
+ integer, parameter, public :: &
+ c_uint8_t = 1, &
+ c_uint16_t = 2, &
+ c_uint32_t = 4, &
+ c_uint64_t = 8, &
+ c_uint128_t = 16
+ integer, parameter, public :: &
+ c_unsigned_char = c_uint8_t, &
+ c_unsigned_short = c_uint16_t, &
+ c_unsigned = c_uint32_t, &
+ c_unsigned_long = c_uint64_t, &
+ c_unsigned_long_long = c_unsigned_long, &
+#if __powerpc__
+ c_uintmax_t = c_uint64_t
+#else
+ c_uintmax_t = c_uint128_t
+#endif
+ integer, parameter, public :: &
+ c_uint_fast8_t = c_uint8_t, &
+ c_uint_fast16_t = c_uint16_t, &
+ c_uint_fast32_t = c_uint32_t, &
+ c_uint_fast64_t = c_uint64_t, &
+ c_uint_fast128_t = c_uint128_t
+ integer, parameter, public :: &
+ c_uint_least8_t = c_uint8_t, &
+ c_uint_least16_t = c_uint16_t, &
+ c_uint_least32_t = c_uint32_t, &
+ c_uint_least64_t = c_uint64_t, &
+ c_uint_least128_t = c_uint128_t
contains
diff --git a/flang/module/iso_fortran_env.f90 b/flang/module/iso_fortran_env.f90
index 4e575b422c2a04..3729b95a339f30 100644
--- a/flang/module/iso_fortran_env.f90
+++ b/flang/module/iso_fortran_env.f90
@@ -26,6 +26,9 @@ module iso_fortran_env
selectedInt8, selectedInt16, selectedInt32, selectedInt64, selectedInt128, &
safeInt8, safeInt16, safeInt32, safeInt64, safeInt128, &
int8, int16, int32, int64, int128, &
+ selectedUInt8, selectedUInt16, selectedUInt32, selectedUInt64, selectedUInt128, &
+ safeUInt8, safeUInt16, safeUInt32, safeUInt64, safeUInt128, &
+ uint8, uint16, uint32, uint64, uint128, &
logical8, logical16, logical32, logical64, &
selectedReal16, selectedBfloat16, selectedReal32, &
selectedReal64, selectedReal80, selectedReal64x2, &
@@ -59,6 +62,10 @@ module iso_fortran_env
safeInt8, safeInt16, safeInt32, safeInt64, safeInt128, &
int8, int16, int32, int64, int128
+ public :: selectedUInt8, selectedUInt16, selectedUInt32, selectedUInt64, selectedUInt128, &
+ safeUInt8, safeUInt16, safeUInt32, safeUInt64, safeUInt128, &
+ uint8, uint16, uint32, uint64, uint128
+
public :: logical8, logical16, logical32, logical64
public :: selectedReal16, selectedBfloat16, selectedReal32, &
diff --git a/flang/module/iso_fortran_env_impl.f90 b/flang/module/iso_fortran_env_impl.f90
index 4de54dda7bab1c..5408e7de370011 100644
--- a/flang/module/iso_fortran_env_impl.f90
+++ b/flang/module/iso_fortran_env_impl.f90
@@ -44,6 +44,36 @@ module iso_fortran_env_impl
int128 = merge(selectedInt128, merge(-2, -1, selectedInt128 >= 0), &
digits(int(0,kind=safeInt128)) == 127)
+ ! UNSIGNED types
+ integer, parameter, public :: &
+ selectedUInt8 = selected_unsigned_kind(2), &
+ selectedUInt16 = selected_unsigned_kind(4), &
+ selectedUInt32 = selected_unsigned_kind(9), &
+ selectedUInt64 = selected_unsigned_kind(18),&
+ selectedUInt128 = selected_unsigned_kind(38), &
+ safeUInt8 = merge(selectedUInt8, selected_unsigned_kind(0), &
+ selectedUInt8 >= 0), &
+ safeUInt16 = merge(selectedUInt16, selected_unsigned_kind(0), &
+ selectedUInt16 >= 0), &
+ safeUInt32 = merge(selectedUInt32, selected_unsigned_kind(0), &
+ selectedUInt32 >= 0), &
+ safeUInt64 = merge(selectedUInt64, selected_unsigned_kind(0), &
+ selectedUInt64 >= 0), &
+ safeUInt128 = merge(selectedUInt128, selected_unsigned_kind(0), &
+ selectedUInt128 >= 0)
+
+ integer, parameter, public :: &
+ uint8 = merge(selectedUInt8, merge(-2, -1, selectedUInt8 >= 0), &
+ digits(uint(0,kind=safeUInt8)) == 8), &
+ uint16 = merge(selectedUInt16, merge(-2, -1, selectedUInt16 >= 0), &
+ digits(uint(0,kind=safeUInt16)) == 16), &
+ uint32 = merge(selectedUInt32, merge(-2, -1, selectedUInt32 >= 0), &
+ digits(uint(0,kind=safeUInt32)) == 32), &
+ uint64 = merge(selectedUInt64, merge(-2, -1, selectedUInt64 >= 0), &
+ digits(uint(0,kind=safeUInt64)) == 64), &
+ uint128 = merge(selectedUInt128, merge(-2, -1, selectedUInt128 >= 0), &
+ digits(uint(0,kind=safeUInt128)) == 128)
+
integer, parameter, dimension(*), public :: __builtin_integer_kinds = [ &
selected_int_kind(0), &
[(pack([selected_int_kind(k)], &
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index ff5f683c6da52f..1034958bf654ab 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -45,22 +45,23 @@ inline RT_API_ATTRS A &ExtractElement(IoStatementState &io,
// NAMELIST array output.
template <int KIND, Direction DIR>
-inline RT_API_ATTRS bool FormattedIntegerIO(
- IoStatementState &io, const Descriptor &descriptor) {
+inline RT_API_ATTRS bool FormattedIntegerIO(IoStatementState &io,
+ const Descriptor &descriptor, [[maybe_unused]] bool isSigned) {
std::size_t numElements{descriptor.Elements()};
SubscriptValue subscripts[maxRank];
descriptor.GetLowerBounds(subscripts);
- using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+ using IntType = CppTypeFor<common::TypeCategory::Integer, KIND>;
bool anyInput{false};
for (std::size_t j{0}; j < numElements; ++j) {
if (auto edit{io.GetNextDataEdit()}) {
IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
if constexpr (DIR == Direction::Output) {
- if (!EditIntegerOutput<KIND>(io, *edit, x)) {
+ if (!EditIntegerOutput<KIND>(io, *edit, x, isSigned)) {
return false;
}
} else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
- if (EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
+ if (EditIntegerInput(
+ io, *edit, reinterpret_cast<void *>(&x), KIND, isSigned)) {
anyInput = true;
} else {
return anyInput && edit->IsNamelist();
@@ -517,20 +518,37 @@ static RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
case TypeCategory::Integer:
switch (kind) {
case 1:
- return FormattedIntegerIO<1, DIR>(io, descriptor);
+ return FormattedIntegerIO<1, DIR>(io, descriptor, true);
case 2:
- return FormattedIntegerIO<2, DIR>(io, descriptor);
+ return FormattedIntegerIO<2, DIR>(io, descriptor, true);
case 4:
- return FormattedIntegerIO<4, DIR>(io, descriptor);
+ return FormattedIntegerIO<4, DIR>(io, descriptor, true);
case 8:
- return FormattedIntegerIO<8, DIR>(io, descriptor);
+ return FormattedIntegerIO<8, DIR>(io, descriptor, true);
case 16:
- return FormattedIntegerIO<16, DIR>(io, descriptor);
+ return FormattedIntegerIO<16, DIR>(io, descriptor, true);
default:
handler.Crash(
"not yet implemented: INTEGER(KIND=%d) in formatted IO", kind);
return false;
}
+ case TypeCategory::Unsigned:
+ switch (kind) {
+ case 1:
+ return FormattedIntegerIO<1, DIR>(io, descriptor, false);
+ case 2:
+ return FormattedIntegerIO<2, DIR>(io, descriptor, false);
+ case 4:
+ return FormattedIntegerIO<4, DIR>(io, descriptor, false);
+ case 8:
+ return FormattedIntegerIO<8, DIR>(io, descriptor, false);
+ case 16:
+ return FormattedIntegerIO<16, DIR>(io, descriptor, false);
+ default:
+ handler.Crash(
+ "not yet implemented: UNSIGNED(KIND=%d) in formatted IO", kind);
+ return false;
+ }
case TypeCategory::Real:
switch (kind) {
case 2:
diff --git a/flang/runtime/dot-product.cpp b/flang/runtime/dot-product.cpp
index 335e5929f0865e..712497a3a50aca 100644
--- a/flang/runtime/dot-product.cpp
+++ b/flang/runtime/dot-product.cpp
@@ -180,6 +180,29 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(DotProductInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(DotProductUnsigned1)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 1>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(DotProductUnsigned2)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 2>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(DotProductUnsigned4)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 4>{}(x, y, source, line);
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(DotProductUnsigned8)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 8>{}(x, y, source, line);
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(DotProductUnsigned16)(
+ const Descriptor &x, const Descriptor &y, const char *source, int line) {
+ return DotProduct<TypeCategory::Unsigned, 16>{}(x, y, source, line);
+}
+#endif
+
// TODO: REAL/COMPLEX(2 & 3)
// Intermediate results and operations are at least 64 bits
CppTypeFor<TypeCategory::Real, 4> RTDEF(DotProductReal4)(
diff --git a/flang/runtime/edit-input.cpp b/flang/runtime/edit-input.cpp
index 2cee35e23f31a3..c8636155e86c99 100644
--- a/flang/runtime/edit-input.cpp
+++ b/flang/runtime/edit-input.cpp
@@ -97,7 +97,6 @@ static RT_API_ATTRS bool EditBOZInput(
return false;
}
if (digits++ == 0) {
- significantBits = 4;
if (ch >= '0' && ch <= '1') {
significantBits = 1;
} else if (ch >= '2' && ch <= '3') {
@@ -125,7 +124,11 @@ static RT_API_ATTRS bool EditBOZInput(
int increment{isHostLittleEndian ? -1 : 1};
auto *data{reinterpret_cast<unsigned char *>(n) +
(isHostLittleEndian ? significantBytes - 1 : bytes - significantBytes)};
- int shift{((digits - 1) * LOG2_BASE) & 7};
+ int bitsAfterFirstDigit{(digits - 1) * LOG2_BASE};
+ int shift{bitsAfterFirstDigit & 7};
+ if (shift + (significantBits - bitsAfterFirstDigit) > 8) {
+ shift = shift - 8; // misaligned octal
+ }
while (digits > 0) {
char32_t ch{*io.NextInField(remaining, edit)};
int digit{0};
@@ -182,8 +185,8 @@ static RT_API_ATTRS char ScanNumericPrefix(IoStatementState &io,
return sign;
}
-RT_API_ATTRS bool EditIntegerInput(
- IoStatementState &io, const DataEdit &edit, void *n, int kind) {
+RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit,
+ void *n, int kind, bool isSigned) {
RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
switch (edit.descriptor) {
case DataEdit::ListDirected:
@@ -211,10 +214,15 @@ RT_API_ATTRS bool EditIntegerInput(
Fortran::common::optional<int> remaining;
Fortran::common::optional<char32_t> next;
char sign{ScanNumericPrefix(io, edit, next, remaining)};
+ if (sign == '-' && !isSigned) {
+ io.GetIoErrorHandler().SignalError("Negative sign in UNSIGNED input field");
+ return false;
+ }
common::UnsignedInt128 value{0};
bool any{!!sign};
bool overflow{false};
const char32_t comma{GetSeparatorChar(edit)};
+ static constexpr auto maxu128{~common::UnsignedInt128{0}};
for (; next; next = io.NextInField(remaining, edit)) {
char32_t ch{*next};
if (ch == ' ' || ch == '\t') {
@@ -248,7 +256,6 @@ RT_API_ATTRS bool EditIntegerInput(
"Bad character '%lc' in INTEGER input field", ch);
return false;
}
- static constexpr auto maxu128{~common::UnsignedInt128{0}};
static constexpr auto maxu128OverTen{maxu128 / 10};
static constexpr int maxLastDigit{
static_cast<int>(maxu128 - (maxu128OverTen * 10))};
@@ -263,7 +270,7 @@ RT_API_ATTRS bool EditIntegerInput(
"Integer value absent from NAMELIST or list-directed input");
return false;
}
- auto maxForKind{common::UnsignedInt128{1} << ((8 * kind) - 1)};
+ auto maxForKind{maxu128 >> (((16 - kind) * 8) + (isSigned ? 1 : 0))};
overflow |= value >= maxForKind && (value > maxForKind || sign != '-');
if (overflow) {
io.GetIoErrorHandler().SignalError(IostatIntegerInputOverflow,
diff --git a/flang/runtime/edit-input.h b/flang/runtime/edit-input.h
index a90180b8ee2ebd..55a7a455781719 100644
--- a/flang/runtime/edit-input.h
+++ b/flang/runtime/edit-input.h
@@ -16,7 +16,7 @@
namespace Fortran::runtime::io {
RT_API_ATTRS bool EditIntegerInput(
- IoStatementState &, const DataEdit &, void *, int kind);
+ IoStatementState &, const DataEdit &, void *, int kind, bool isSigned);
template <int KIND>
RT_API_ATTRS bool EditRealInput(IoStatementState &, const DataEdit &, void *);
diff --git a/flang/runtime/edit-output.cpp b/flang/runtime/edit-output.cpp
index 9d60732258bfbc..9db9a3d4a511b0 100644
--- a/flang/runtime/edit-output.cpp
+++ b/flang/runtime/edit-output.cpp
@@ -109,10 +109,10 @@ static RT_API_ATTRS bool EditBOZOutput(IoStatementState &io,
template <int KIND>
bool RT_API_ATTRS EditIntegerOutput(IoStatementState &io, const DataEdit &edit,
- common::HostSignedIntType<8 * KIND> n) {
+ common::HostSignedIntType<8 * KIND> n, bool isSigned) {
addSpaceBeforeCharacter(io);
char buffer[130], *end{&buffer[sizeof buffer]}, *p{end};
- bool isNegative{n < 0};
+ bool isNegative{isSigned && n < 0};
using Unsigned = common::HostUnsignedIntType<8 * KIND>;
Unsigned un{static_cast<Unsigned>(n)};
int signChars{0};
@@ -933,15 +933,15 @@ RT_API_ATTRS bool EditCharacterOutput(IoStatementState &io,
}
template RT_API_ATTRS bool EditIntegerOutput<1>(
- IoStatementState &, const DataEdit &, std::int8_t);
+ IoStatementState &, const DataEdit &, std::int8_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<2>(
- IoStatementState &, const DataEdit &, std::int16_t);
+ IoStatementState &, const DataEdit &, std::int16_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<4>(
- IoStatementState &, const DataEdit &, std::int32_t);
+ IoStatementState &, const DataEdit &, std::int32_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<8>(
- IoStatementState &, const DataEdit &, std::int64_t);
+ IoStatementState &, const DataEdit &, std::int64_t, bool);
template RT_API_ATTRS bool EditIntegerOutput<16>(
- IoStatementState &, const DataEdit &, common::int128_t);
+ IoStatementState &, const DataEdit &, common::int128_t, bool);
template class RealOutputEditing<2>;
template class RealOutputEditing<3>;
diff --git a/flang/runtime/edit-output.h b/flang/runtime/edit-output.h
index 365bc2e2a4d10b..42cc993f98cc1c 100644
--- a/flang/runtime/edit-output.h
+++ b/flang/runtime/edit-output.h
@@ -30,8 +30,8 @@ namespace Fortran::runtime::io {
// one edit descriptor with a repeat factor may safely serve to edit
// multiple elements of an array.
template <int KIND>
-RT_API_ATTRS bool EditIntegerOutput(
- IoStatementState &, const DataEdit &, common::HostSignedIntType<8 * KIND>);
+RT_API_ATTRS bool EditIntegerOutput(IoStatementState &, const DataEdit &,
+ common::HostSignedIntType<8 * KIND>, bool isSigned);
// Encapsulates the state of a REAL output conversion.
class RealOutputEditingBase {
@@ -119,15 +119,15 @@ extern template RT_API_ATTRS bool EditCharacterOutput(
IoStatementState &, const DataEdit &, const char32_t *, std::size_t chars);
extern template RT_API_ATTRS bool EditIntegerOutput<1>(
- IoStatementState &, const DataEdit &, std::int8_t);
+ IoStatementState &, const DataEdit &, std::int8_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<2>(
- IoStatementState &, const DataEdit &, std::int16_t);
+ IoStatementState &, const DataEdit &, std::int16_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<4>(
- IoStatementState &, const DataEdit &, std::int32_t);
+ IoStatementState &, const DataEdit &, std::int32_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<8>(
- IoStatementState &, const DataEdit &, std::int64_t);
+ IoStatementState &, const DataEdit &, std::int64_t, bool);
extern template RT_API_ATTRS bool EditIntegerOutput<16>(
- IoStatementState &, const DataEdit &, common::int128_t);
+ IoStatementState &, const DataEdit &, common::int128_t, bool);
extern template class RealOutputEditing<2>;
extern template class RealOutputEditing<3>;
diff --git a/flang/runtime/extrema.cpp b/flang/runtime/extrema.cpp
index 9442fa50f4c794..4cd17f26a8d57d 100644
--- a/flang/runtime/extrema.cpp
+++ b/flang/runtime/extrema.cpp
@@ -226,6 +226,33 @@ void RTDEF(MaxlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
"MAXLOC", result, x, kind, source, line, mask, back);
}
#endif
+void RTDEF(MaxlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 1, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 2, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 4, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MaxlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 8, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+#ifdef __SIZEOF_INT128__
+void RTDEF(MaxlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 16, true>(
+ "MAXLOC", result, x, kind, source, line, mask, back);
+}
+#endif
void RTDEF(MaxlocReal4)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, true>(
@@ -255,7 +282,7 @@ void RTDEF(MinlocCharacter)(Descriptor &result, const Descriptor &x, int kind,
CharacterMaxOrMinLoc<false>(
"MINLOC", result, x, kind, source, line, mask, back);
}
-void RTDEF(MinlocInteger1)(Descriptor &result, const Descriptor &x, int kind,
+void RTDEF(Minloc1)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Integer, 1, false>(
"MINLOC", result, x, kind, source, line, mask, back);
@@ -282,6 +309,33 @@ void RTDEF(MinlocInteger16)(Descriptor &result, const Descriptor &x, int kind,
"MINLOC", result, x, kind, source, line, mask, back);
}
#endif
+void RTDEF(MinlocUnsigned1)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 1, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned2)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 2, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned4)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 4, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+void RTDEF(MinlocUnsigned8)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 8, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+#ifdef __SIZEOF_INT128__
+void RTDEF(MinlocUnsigned16)(Descriptor &result, const Descriptor &x, int kind,
+ const char *source, int line, const Descriptor *mask, bool back) {
+ TotalNumericMaxOrMinLoc<TypeCategory::Unsigned, 16, false>(
+ "MINLOC", result, x, kind, source, line, mask, back);
+}
+#endif
void RTDEF(MinlocReal4)(Descriptor &result, const Descriptor &x, int kind,
const char *source, int line, const Descriptor *mask, bool back) {
TotalNumericMaxOrMinLoc<TypeCategory::Real, 4, false>(
@@ -386,6 +440,12 @@ inline RT_API_ATTRS void TypedPartialMaxOrMinLoc(const char *intrinsic,
void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
maskToUse, back, terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<DoPartialMaxOrMinLocHelper<TypeCategory::Unsigned, IS_MAX,
+ NumericCompare>::template Functor,
+ void>(catKind->second, terminator, intrinsic, result, x, kind, dim,
+ maskToUse, back, terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<DoPartialMaxOrMinLocHelper<TypeCategory::Real,
IS_MAX, NumericCompare>::template Functor,
@@ -497,6 +557,12 @@ inline RT_API_ATTRS void NumericMaxOrMin(Descriptor &result,
void>(
type->second, terminator, result, x, dim, mask, intrinsic, terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<
+ MaxOrMinHelper<TypeCategory::Unsigned, IS_MAXVAL>::template Functor,
+ void>(
+ type->second, terminator, result, x, dim, mask, intrinsic, terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<
MaxOrMinHelper<TypeCategory::Real, IS_MAXVAL>::template Functor, void>(
@@ -603,6 +669,39 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(MaxvalInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(MaxvalUnsigned1)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 1, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(MaxvalUnsigned2)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 2, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(MaxvalUnsigned4)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 4, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(MaxvalUnsigned8)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 8, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(MaxvalUnsigned16)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 16, true>(
+ x, source, line, dim, mask, "MAXVAL");
+}
+#endif
+
// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MaxvalReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
@@ -663,6 +762,39 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(MinvalInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(MinvalUnsigned1)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 1, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(MinvalUnsigned2)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 2, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(MinvalUnsigned4)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 4, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(MinvalUnsigned8)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 8, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(MinvalUnsigned16)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return TotalNumericMaxOrMin<TypeCategory::Unsigned, 16, false>(
+ x, source, line, dim, mask, "MINVAL");
+}
+#endif
+
// TODO: REAL(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(MinvalReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
diff --git a/flang/runtime/findloc.cpp b/flang/runtime/findloc.cpp
index 674a21ae50b853..811fe9f278d96f 100644
--- a/flang/runtime/findloc.cpp
+++ b/flang/runtime/findloc.cpp
@@ -23,7 +23,13 @@ struct Equality {
using Type2 = CppTypeFor<CAT2, KIND2>;
RT_API_ATTRS bool operator()(const Descriptor &array,
const SubscriptValue at[], const Descriptor &target) const {
- return *array.Element<Type1>(at) == *target.OffsetElement<Type2>();
+ if constexpr (KIND1 >= KIND2) {
+ return *array.Element<Type1>(at) ==
+ static_cast<Type1>(*target.OffsetElement<Type2>());
+ } else {
+ return static_cast<Type2>(*array.Element<Type1>(at)) ==
+ *target.OffsetElement<Type2>();
+ }
}
};
@@ -158,6 +164,12 @@ struct NumericFindlocHelper {
targetKind, terminator, result, x, target, kind, dim, mask, back,
terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<
+ HELPER<CAT, KIND, TypeCategory::Unsigned>::template Functor, void>(
+ targetKind, terminator, result, x, target, kind, dim, mask, back,
+ terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<
HELPER<CAT, KIND, TypeCategory::Real>::template Functor, void>(
@@ -228,6 +240,12 @@ void RTDEF(Findloc)(Descriptor &result, const Descriptor &x,
void>(xType->second, terminator, targetType->first, targetType->second,
result, x, target, kind, 0, mask, back, terminator);
break;
+ case TypeCategory::Unsigned:
+ ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Unsigned,
+ TotalNumericFindlocHelper>::template Functor,
+ void>(xType->second, terminator, targetType->first, targetType->second,
+ result, x, target, kind, 0, mask, back, terminator);
+ break;
case TypeCategory::Real:
ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real,
TotalNumericFindlocHelper>::template Functor,
diff --git a/flang/runtime/io-api-minimal.cpp b/flang/runtime/io-api-minimal.cpp
index ad76fe3de0324c..68768427be0c23 100644
--- a/flang/runtime/io-api-minimal.cpp
+++ b/flang/runtime/io-api-minimal.cpp
@@ -37,7 +37,7 @@ inline RT_API_ATTRS bool FormattedScalarIntegerOutput(
IoStatementState &io, INT x, const char *whence) {
if (io.CheckFormattedStmtType<Direction::Output>(whence)) {
auto edit{io.GetNextDataEdit()};
- return edit && EditIntegerOutput<KIND>(io, *edit, x);
+ return edit && EditIntegerOutput<KIND>(io, *edit, x, /*isSigned=*/true);
} else {
return false;
}
diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp
index 4797ecf58fa711..45fb56348fd44f 100644
--- a/flang/runtime/numeric.cpp
+++ b/flang/runtime/numeric.cpp
@@ -94,7 +94,7 @@ template <typename T> inline RT_API_ATTRS T Scale(T x, std::int64_t p) {
return std::ldexp(x, ip); // x*2**p
}
-// SELECTED_INT_KIND (16.9.169)
+// SELECTED_INT_KIND (16.9.169) and SELECTED_UNSIGNED_KIND extension
template <typename X, typename M>
inline RT_API_ATTRS CppTypeFor<TypeCategory::Integer, 4> SelectedIntKind(
X x, M mask) {
@@ -781,7 +781,7 @@ CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedCharKind)(
return -1;
}
}
-// SELECTED_INT_KIND
+// SELECTED_INT_KIND and SELECTED_UNSIGNED_KIND extension
CppTypeFor<TypeCategory::Integer, 4> RTDEF(SelectedIntKind)(
const char *source, int line, void *x, int xKind) {
return RTNAME(SelectedIntKindMasked)(source, line, x, xKind,
diff --git a/flang/runtime/product.cpp b/flang/runtime/product.cpp
index aef0f7c4a0bfd9..293ffd301ba2ec 100644
--- a/flang/runtime/product.cpp
+++ b/flang/runtime/product.cpp
@@ -96,6 +96,49 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(ProductInteger16)(
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(ProductUnsigned1)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(x, source, line, dim,
+ mask,
+ NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "PRODUCT");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(ProductUnsigned2)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(x, source, line, dim,
+ mask,
+ NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "PRODUCT");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(ProductUnsigned4)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(x, source, line, dim,
+ mask,
+ NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "PRODUCT");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(ProductUnsigned8)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(x, source, line, dim,
+ mask,
+ NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 8>>{x},
+ "PRODUCT");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(ProductUnsigned16)(
+ const Descriptor &x, const char *source, int line, int dim,
+ const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(x, source, line, dim,
+ mask,
+ NonComplexProductAccumulator<CppTypeFor<TypeCategory::Unsigned, 16>>{x},
+ "PRODUCT");
+}
+#endif
+
// TODO: real/complex(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(ProductReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
diff --git a/flang/runtime/reduce.cpp b/flang/runtime/reduce.cpp
index 8fc0bb8c7157e4..6c42c5ef50e4f0 100644
--- a/flang/runtime/reduce.cpp
+++ b/flang/runtime/reduce.cpp
@@ -322,6 +322,220 @@ void RTDEF(ReduceInteger16DimValue)(Descriptor &result, const Descriptor &array,
}
#endif
+std::uint8_t RTDEF(ReduceUnsigned1Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint8_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint8_t RTDEF(ReduceUnsigned1Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint8_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned1DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint8_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 1>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned1DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint8_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint8_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint8_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 1>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint16_t RTDEF(ReduceUnsigned2Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint16_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint16_t RTDEF(ReduceUnsigned2Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint16_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned2DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint16_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 2>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned2DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint16_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint16_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint16_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 2>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint32_t RTDEF(ReduceUnsigned4Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint32_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint32_t RTDEF(ReduceUnsigned4Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint32_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned4DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint32_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 4>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned4DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint32_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint32_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint32_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 4>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+std::uint64_t RTDEF(ReduceUnsigned8Ref)(const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint64_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+std::uint64_t RTDEF(ReduceUnsigned8Value)(const Descriptor &array,
+ ValueReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<std::uint64_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned8DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint64_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 8>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned8DimValue)(Descriptor &result, const Descriptor &array,
+ ValueReductionOperation<std::uint64_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask, const std::uint64_t *identity,
+ bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<std::uint64_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 8>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+#ifdef __SIZEOF_INT128__
+common::uint128_t RTDEF(ReduceUnsigned16Ref)(const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t> operation,
+ const char *source, int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<common::uint128_t, false>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+common::uint128_t RTDEF(ReduceUnsigned16Value)(const Descriptor &array,
+ ValueReductionOperation<common::uint128_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(array, source, line, dim,
+ mask,
+ ReduceAccumulator<common::uint128_t, true>{
+ array, operation, identity, terminator},
+ "REDUCE");
+}
+void RTDEF(ReduceUnsigned16DimRef)(Descriptor &result, const Descriptor &array,
+ ReferenceReductionOperation<common::uint128_t> operation,
+ const char *source, int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<common::uint128_t, false>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 16>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+void RTDEF(ReduceUnsigned16DimValue)(Descriptor &result,
+ const Descriptor &array,
+ ValueReductionOperation<common::uint128_t> operation, const char *source,
+ int line, int dim, const Descriptor *mask,
+ const common::uint128_t *identity, bool ordered) {
+ Terminator terminator{source, line};
+ using Accumulator = ReduceAccumulator<common::uint128_t, true>;
+ Accumulator accumulator{array, operation, identity, terminator};
+ PartialReduction<Accumulator, TypeCategory::Unsigned, 16>(result, array,
+ array.ElementBytes(), dim, mask, terminator, "REDUCE", accumulator);
+}
+#endif
+
// TODO: real/complex(2 & 3)
float RTDEF(ReduceReal4Ref)(const Descriptor &array,
ReferenceReductionOperation<float> operation, const char *source, int line,
diff --git a/flang/runtime/reduction-templates.h b/flang/runtime/reduction-templates.h
index 2a85595bad7dbd..b20b03655c3d00 100644
--- a/flang/runtime/reduction-templates.h
+++ b/flang/runtime/reduction-templates.h
@@ -81,9 +81,13 @@ inline RT_API_ATTRS void DoTotalReduction(const Descriptor &x, int dim,
template <TypeCategory CAT, int KIND, typename ACCUMULATOR>
inline RT_API_ATTRS CppTypeFor<CAT, KIND> GetTotalReduction(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask,
- ACCUMULATOR &&accumulator, const char *intrinsic) {
+ ACCUMULATOR &&accumulator, const char *intrinsic,
+ bool allowUnsignedForInteger = false) {
Terminator terminator{source, line};
- RUNTIME_CHECK(terminator, TypeCode(CAT, KIND) == x.type());
+ RUNTIME_CHECK(terminator,
+ TypeCode(CAT, KIND) == x.type() ||
+ (CAT == TypeCategory::Integer && allowUnsignedForInteger &&
+ TypeCode(TypeCategory::Unsigned, KIND) == x.type()));
using CppType = CppTypeFor<CAT, KIND>;
DoTotalReduction<CppType>(x, dim, mask, accumulator, intrinsic, terminator);
if constexpr (std::is_void_v<CppType>) {
diff --git a/flang/runtime/reduction.cpp b/flang/runtime/reduction.cpp
index 074a270cb50838..a790cdeb7d29db 100644
--- a/flang/runtime/reduction.cpp
+++ b/flang/runtime/reduction.cpp
@@ -86,29 +86,33 @@ extern "C" {
CppTypeFor<TypeCategory::Integer, 1> RTDEF(IAll1)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
- IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
+ IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 2> RTDEF(IAll2)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
- IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
+ IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 4> RTDEF(IAll4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
- IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL");
+ IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IALL",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 8> RTDEF(IAll8)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
- IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IALL");
+ IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IALL",
+ /*allowUnsignedForInteger=*/true);
}
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> RTDEF(IAll16)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
mask, IntegerAndAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
- "IALL");
+ "IALL", /*allowUnsignedForInteger=*/true);
}
#endif
void RTDEF(IAllDim)(Descriptor &result, const Descriptor &x, int dim,
@@ -124,29 +128,33 @@ void RTDEF(IAllDim)(Descriptor &result, const Descriptor &x, int dim,
CppTypeFor<TypeCategory::Integer, 1> RTDEF(IAny1)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
- IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
+ IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 2> RTDEF(IAny2)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
- IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
+ IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 4> RTDEF(IAny4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
- IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY");
+ IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IANY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 8> RTDEF(IAny8)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
- IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IANY");
+ IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IANY",
+ /*allowUnsignedForInteger=*/true);
}
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> RTDEF(IAny16)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
mask, IntegerOrAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
- "IANY");
+ "IANY", /*allowUnsignedForInteger=*/true);
}
#endif
void RTDEF(IAnyDim)(Descriptor &result, const Descriptor &x, int dim,
@@ -162,33 +170,33 @@ void RTDEF(IAnyDim)(Descriptor &result, const Descriptor &x, int dim,
CppTypeFor<TypeCategory::Integer, 1> RTDEF(IParity1)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 1>(x, source, line, dim, mask,
- IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
- "IPARITY");
+ IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IPARITY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 2> RTDEF(IParity2)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 2>(x, source, line, dim, mask,
- IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
- "IPARITY");
+ IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IPARITY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 4> RTDEF(IParity4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 4>(x, source, line, dim, mask,
- IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x},
- "IPARITY");
+ IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 4>>{x}, "IPARITY",
+ /*allowUnsignedForInteger=*/true);
}
CppTypeFor<TypeCategory::Integer, 8> RTDEF(IParity8)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 8>(x, source, line, dim, mask,
- IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x},
- "IPARITY");
+ IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 8>>{x}, "IPARITY",
+ /*allowUnsignedForInteger=*/true);
}
#ifdef __SIZEOF_INT128__
CppTypeFor<TypeCategory::Integer, 16> RTDEF(IParity16)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
return GetTotalReduction<TypeCategory::Integer, 16>(x, source, line, dim,
mask, IntegerXorAccumulator<CppTypeFor<TypeCategory::Integer, 16>>{x},
- "IPARITY");
+ "IPARITY", /*allowUnsignedForInteger=*/true);
}
#endif
void RTDEF(IParityDim)(Descriptor &result, const Descriptor &x, int dim,
diff --git a/flang/runtime/sum.cpp b/flang/runtime/sum.cpp
index 04241443275eb9..d198f31c9af3d3 100644
--- a/flang/runtime/sum.cpp
+++ b/flang/runtime/sum.cpp
@@ -130,6 +130,39 @@ CppTypeFor<TypeCategory::Integer, 16> RTDEF(SumInteger16)(const Descriptor &x,
}
#endif
+CppTypeFor<TypeCategory::Unsigned, 1> RTDEF(SumUnsigned1)(const Descriptor &x,
+ const char *source, int line, int dim, const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 1>(x, source, line, dim,
+ mask, IntegerSumAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "SUM");
+}
+CppTypeFor<TypeCategory::Unsigned, 2> RTDEF(SumUnsigned2)(const Descriptor &x,
+ const char *source, int line, int dim, const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 2>(x, source, line, dim,
+ mask, IntegerSumAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "SUM");
+}
+CppTypeFor<TypeCategory::Unsigned, 4> RTDEF(SumUnsigned4)(const Descriptor &x,
+ const char *source, int line, int dim, const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 4>(x, source, line, dim,
+ mask, IntegerSumAccumulator<CppTypeFor<TypeCategory::Unsigned, 4>>{x},
+ "SUM");
+}
+CppTypeFor<TypeCategory::Unsigned, 8> RTDEF(SumUnsigned8)(const Descriptor &x,
+ const char *source, int line, int dim, const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 8>(x, source, line, dim,
+ mask, IntegerSumAccumulator<CppTypeFor<TypeCategory::Unsigned, 8>>{x},
+ "SUM");
+}
+#ifdef __SIZEOF_INT128__
+CppTypeFor<TypeCategory::Unsigned, 16> RTDEF(SumUnsigned16)(const Descriptor &x,
+ const char *source, int line, int dim, const Descriptor *mask) {
+ return GetTotalReduction<TypeCategory::Unsigned, 16>(x, source, line, dim,
+ mask, IntegerSumAccumulator<CppTypeFor<TypeCategory::Unsigned, 16>>{x},
+ "SUM");
+}
+#endif
+
// TODO: real/complex(2 & 3)
CppTypeFor<TypeCategory::Real, 4> RTDEF(SumReal4)(const Descriptor &x,
const char *source, int line, int dim, const Descriptor *mask) {
diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h
index dc12e5c4533e2e..66d1d9f44d7ae0 100644
--- a/flang/runtime/tools.h
+++ b/flang/runtime/tools.h
@@ -303,7 +303,7 @@ inline RT_API_ATTRS RESULT ApplyIntegerKind(
return FUNC<16>{}(std::forward<A>(x)...);
#endif
default:
- terminator.Crash("not yet implemented: INTEGER(KIND=%d)", kind);
+ terminator.Crash("not yet implemented: INTEGER/UNSIGNED(KIND=%d)", kind);
}
}
diff --git a/flang/runtime/type-code.cpp b/flang/runtime/type-code.cpp
index cb1b944433aae5..d6948983bfe9f3 100644
--- a/flang/runtime/type-code.cpp
+++ b/flang/runtime/type-code.cpp
@@ -33,6 +33,25 @@ RT_API_ATTRS TypeCode::TypeCode(TypeCategory f, int kind) {
break;
}
break;
+ case TypeCategory::Unsigned:
+ switch (kind) {
+ case 1:
+ raw_ = CFI_type_uint8_t;
+ break;
+ case 2:
+ raw_ = CFI_type_uint16_t;
+ break;
+ case 4:
+ raw_ = CFI_type_uint32_t;
+ break;
+ case 8:
+ raw_ = CFI_type_uint64_t;
+ break;
+ case 16:
+ raw_ = CFI_type_uint128_t;
+ break;
+ }
+ break;
case TypeCategory::Real:
switch (kind) {
case 2:
@@ -203,6 +222,16 @@ TypeCode::GetCategoryAndKind() const {
return std::make_pair(TypeCategory::Character, 2);
case CFI_type_char32_t:
return std::make_pair(TypeCategory::Character, 4);
+ case CFI_type_uint8_t:
+ return std::make_pair(TypeCategory::Unsigned, 1);
+ case CFI_type_uint16_t:
+ return std::make_pair(TypeCategory::Unsigned, 2);
+ case CFI_type_uint32_t:
+ return std::make_pair(TypeCategory::Unsigned, 4);
+ case CFI_type_uint64_t:
+ return std::make_pair(TypeCategory::Unsigned, 8);
+ case CFI_type_uint128_t:
+ return std::make_pair(TypeCategory::Unsigned, 16);
default:
return Fortran::common::nullopt;
}
diff --git a/flang/runtime/type-info.cpp b/flang/runtime/type-info.cpp
index cb18c5669b5ffc..d4daa72aee6a13 100644
--- a/flang/runtime/type-info.cpp
+++ b/flang/runtime/type-info.cpp
@@ -36,6 +36,7 @@ RT_API_ATTRS std::size_t Component::GetElementByteSize(
const Descriptor &instance) const {
switch (category()) {
case TypeCategory::Integer:
+ case TypeCategory::Unsigned:
case TypeCategory::Real:
case TypeCategory::Logical:
return kind_;
diff --git a/flang/test/Evaluate/fold-unsigned.f90 b/flang/test/Evaluate/fold-unsigned.f90
new file mode 100644
index 00000000000000..719bdcc1a40b95
--- /dev/null
+++ b/flang/test/Evaluate/fold-unsigned.f90
@@ -0,0 +1,120 @@
+! RUN: %python %S/test_folding.py %s %flang_fc1 -funsigned
+! UNSIGNED operations and intrinsic functions
+
+module m
+
+ logical, parameter :: test_neg0 = -0u_1 == 0u_1
+ logical, parameter :: test_neg0_k = kind(-0u_1) == 1
+ logical, parameter :: test_neg1 = -1u_1 == 255u
+ logical, parameter :: test_neg255 = -255u_1 == 1u
+ logical, parameter :: test_add1 = 0u_1 + 1u_1 == 1u_1
+ logical, parameter :: test_add1_k = kind(0u_1 + 1u_1) == 1
+ logical, parameter :: test_addprom = 255u_1 + 1u == 256u
+ logical, parameter :: test_addmix = 255u_1 + z'1' == 0u
+ logical, parameter :: test_sub1 = 0u_1 - 1u_1 == 255u_1
+ logical, parameter :: test_sub1_k = kind(0u_1 + 1u_1) == 1
+ logical, parameter :: test_mul15 = 15u_1 * 15u_1 == 225u_1
+ logical, parameter :: test_mul15_k = kind(15u_1 * 15u_1) == 1
+ logical, parameter :: test_mul152 = 5u_1 * 52u_1 == 4u_1
+ logical, parameter :: test_div15 = 225u_1 / 15u_1 == 15u_1
+ logical, parameter :: test_div15_k = kind(225u_1 / 15u_1) == 1
+
+ logical, parameter :: test_rel = all([0u_1 < 255u_1, 255u_1 > 0u_1, &
+ 0u_1 <= 255u_1, 255u_1 >= 0u_1])
+
+ logical, parameter :: test_cus0 = int(0u,1) == 0
+ logical, parameter :: test_cus0_k = kind(int(0u,1)) == 1
+ !WARN: warning: conversion of 255_U1 to INTEGER(1) overflowed; result is -1
+ logical, parameter :: test_cus255 = int(255u_1,1) == -1
+ logical, parameter :: test_cur255 = real(255u) == 255.
+
+ logical, parameter :: test_csu255 = uint(255,1) == 255u_1
+ logical, parameter :: test_csu255_k = kind(uint(255,1)) == 1
+ logical, parameter :: test_cru255 = uint(255.) == 255u
+ logical, parameter :: test_ctu255 = uint(z'ff',1) == 255u_1
+ logical, parameter :: test_ctu255_k = kind(uint(z'ff',1)) == 1
+
+ logical, parameter :: test_not1a = not(0u_1) == 255u_1
+ logical, parameter :: test_not1b = not(255u_1) == 0u_1
+ logical, parameter :: test_not4a = not(0u) == huge(0u)
+ logical, parameter :: test_not4b = not(huge(0u)) == 0u
+
+ logical, parameter :: test_iand1 = iand(170u,240u) == 160u
+ logical, parameter :: test_ior1 = ior(170u,240u) == 250u
+ logical, parameter :: test_ieor1 = ieor(170u,240u) == 90u
+ logical, parameter :: test_ibclr1 = all(ibclr(255u,[(j,j=7,0,-1)]) == &
+ [127u,191u,223u,239u, &
+ 247u,251u,253u,254u])
+ logical, parameter :: test_ibset1 = all(ibset(0u,[(j,j=7,0,-1)]) == &
+ [128u,64u,32u,16u,8u,4u,2u,1u])
+ logical, parameter :: test_ibits1 = all(ibits(126u,[(j,j=0,7)],3) == &
+ [6u,7u,7u,7u,7u,3u,1u,0u])
+
+ logical, parameter :: test_mb_1 = merge_bits(13u_1, 18u_1, 22u_1) .EQ. 4u_1
+ logical, parameter :: test_mb_2 = merge_bits(13u_2, 18u_2, 22u_2) .EQ. 4u_2
+ logical, parameter :: test_mb_4 = merge_bits(13u_4, 18u_4, 22u_4) .EQ. 4u_4
+ logical, parameter :: test_mb_8 = merge_bits(13u_8, 18u_8, 22u_8) .EQ. 4u_8
+ logical, parameter :: test_mb_16 = merge_bits(13u_16, 18u_16, 22u_16) .EQ. 4u_16
+
+ logical, parameter :: test_mb_z11 = merge_bits(13u_1, B'00010010', 22u_1) .EQ. 4u_1
+ logical, parameter :: test_mb_z12 = merge_bits(13u_2, B'00010010', 22u_2) .EQ. 4u_2
+ logical, parameter :: test_mb_z14 = merge_bits(13u_4, B'00010010', 22u_4) .EQ. 4u_4
+ logical, parameter :: test_mb_z18 = merge_bits(13u_8, B'00010010', 22u_8) .EQ. 4u_8
+ logical, parameter :: test_mb_z116 = merge_bits(13u_16, B'00010010', 22u_16) .EQ. 4u_16
+
+ logical, parameter :: test_mb_z01 = merge_bits(Z'0D', 18u_1, 22u_1) .EQ. 4u_1
+ logical, parameter :: test_mb_z02 = merge_bits(Z'0D', 18u_2, 22u_2) .EQ. 4u_2
+ logical, parameter :: test_mb_z04 = merge_bits(Z'0D', 18u_4, 22u_4) .EQ. 4u_4
+ logical, parameter :: test_mb_z08 = merge_bits(Z'0D', 18u_8, 22u_8) .EQ. 4u_8
+ logical, parameter :: test_mb_z016 = merge_bits(Z'0D', 18u_16, 22u_16) .EQ. 4u_16
+
+ logical, parameter :: test_btest1 = all(btest(uint(b'00011011'),[(j,j=0,7)]) .eqv. &
+ [.true., .true., .false., .true., &
+ .true., .false., .false., .false.])
+
+ logical, parameter :: test_ishft1 = all(ishft(1u_1,[(j,j=0,8)]) == &
+ [1u, 2u, 4u, 8u, 16u, 32u, 64u, 128u, 0u])
+ logical, parameter :: test_ishft2 = all(ishft(255u,[(j,j=0,-8,-1)]) == &
+ [255u, 127u, 63u, 31u, 15u, 7u, 3u, 1u, 0u])
+
+ logical, parameter :: test_ishftc1 = all(ishftc(254u_1,[(j,j=0,8)]) == &
+ [254u, 253u, 251u, 247u, 239u, 223u, 191u, 127u, 254u])
+ logical, parameter :: test_ishftc2 = all(ishftc(254u_1,[(j,j=0,-8,-1)]) == &
+ [254u, 127u, 191u, 223u, 239u, 247u, 251u, 253u, 254u])
+
+ logical, parameter :: test_shifta1 = all(shifta(128u_1,[(j,j=0,8)]) == &
+ [128u, 192u, 224u, 240u, 248u, 252u, 254u, 255u, 255u])
+ logical, parameter :: test_shiftl1 = all(shiftl(1u_1,[(j,j=0,8)]) == &
+ [1u, 2u, 4u, 8u, 16u, 32u, 64u, 128u, 0u])
+ logical, parameter :: test_shiftr1 = all(shiftr(128u_1,[(j,j=0,8)]) == &
+ [128u,64u,32u,16u,8u,4u,2u,1u,0u])
+ logical, parameter :: test_shiftr2 = all(shiftr(255u,[(j,j=0,8)]) == &
+ [255u, 127u, 63u, 31u, 15u, 7u, 3u, 1u, 0u])
+
+ logical, parameter :: test_transfer1 = transfer(1.,0u) == uint(z'3f800000')
+ logical, parameter :: test_transfer2 = transfer(uint(z'3f800000'),0.) == 1.
+
+ logical, parameter :: test_bit_size = &
+ all([integer::bit_size(0u_1), bit_size(0u_2), &
+ bit_size(0u_4), bit_size(0u_8), &
+ bit_size(0u_16)] == [8,16,32,64,128])
+
+ logical, parameter :: test_digits = &
+ all([digits(0u_1), digits(0u_2), digits(0u_4), digits(0u_8), &
+ digits(0u_16)] == [8,16,32,64,128])
+
+ logical, parameter :: test_huge_1 = huge(0u_1) == 255u_1
+ logical, parameter :: test_huge_2 = huge(0u_2) == 65535u_2
+ logical, parameter :: test_huge_4 = huge(0u_4) == uint(huge(0_4),4) * 2u + 1u
+ logical, parameter :: test_huge_8 = huge(0u_8) == uint(huge(0_8),8) * 2u + 1u
+ logical, parameter :: test_huge_16 = huge(0u_16) == uint(huge(0_16),16) * 2u + 1u
+
+ logical, parameter :: test_range = &
+ all([range(0u_1), range(0u_2), range(0u_4), range(0u_8), range(0u_16)] == &
+ [2,4,9,19,38])
+
+ logical, parameter :: test_max1 = max(0u,255u,128u) == 255u
+ logical, parameter :: test_max1k = kind(max(0u_1,255u_1,128u_1)) == 1
+ logical, parameter :: test_min1 = min(0u,255u,128u) == 0u
+ logical, parameter :: test_min1k = kind(min(0u_1,255u_1,128u_1)) == 1
+end
diff --git a/flang/test/Lower/Intrinsics/shifta.f90 b/flang/test/Lower/Intrinsics/shifta.f90
index 11d3b13866ff01..ac72c535460ff7 100644
--- a/flang/test/Lower/Intrinsics/shifta.f90
+++ b/flang/test/Lower/Intrinsics/shifta.f90
@@ -13,7 +13,7 @@ subroutine shifta1_test(a, b, c)
c = shifta(a, b)
! CHECK: %[[C_BITS:.*]] = arith.constant 8 : i8
! CHECK: %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i32) -> i8
- ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi eq, %[[B_CONV]], %[[C_BITS]] : i8
+ ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi uge, %[[B_CONV]], %[[C_BITS]] : i8
! CHECK: %[[C0:.*]] = arith.constant 0 : i8
! CHECK: %[[CM1:.*]] = arith.constant -1 : i8
! CHECK: %[[IS_NEG:.*]] = arith.cmpi slt, %[[A_VAL]], %[[C0]] : i8
@@ -34,7 +34,7 @@ subroutine shifta2_test(a, b, c)
c = shifta(a, b)
! CHECK: %[[C_BITS:.*]] = arith.constant 16 : i16
! CHECK: %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i32) -> i16
- ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi eq, %[[B_CONV]], %[[C_BITS]] : i16
+ ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi uge, %[[B_CONV]], %[[C_BITS]] : i16
! CHECK: %[[C0:.*]] = arith.constant 0 : i16
! CHECK: %[[CM1:.*]] = arith.constant -1 : i16
! CHECK: %[[IS_NEG:.*]] = arith.cmpi slt, %[[A_VAL]], %[[C0]] : i16
@@ -54,7 +54,7 @@ subroutine shifta4_test(a, b, c)
! CHECK: %[[B_VAL:.*]] = fir.load %[[B]] : !fir.ref<i32>
c = shifta(a, b)
! CHECK: %[[C_BITS:.*]] = arith.constant 32 : i32
- ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi eq, %[[B_VAL]], %[[C_BITS]] : i32
+ ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi uge, %[[B_VAL]], %[[C_BITS]] : i32
! CHECK: %[[C0:.*]] = arith.constant 0 : i32
! CHECK: %[[CM1:.*]] = arith.constant -1 : i32
! CHECK: %[[IS_NEG:.*]] = arith.cmpi slt, %[[A_VAL]], %[[C0]] : i32
@@ -75,7 +75,7 @@ subroutine shifta8_test(a, b, c)
c = shifta(a, b)
! CHECK: %[[C_BITS:.*]] = arith.constant 64 : i64
! CHECK: %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i32) -> i64
- ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi eq, %[[B_CONV]], %[[C_BITS]] : i64
+ ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi uge, %[[B_CONV]], %[[C_BITS]] : i64
! CHECK: %[[C0:.*]] = arith.constant 0 : i64
! CHECK: %[[CM1:.*]] = arith.constant -1 : i64
! CHECK: %[[IS_NEG:.*]] = arith.cmpi slt, %[[A_VAL]], %[[C0]] : i64
@@ -96,7 +96,7 @@ subroutine shifta16_test(a, b, c)
c = shifta(a, b)
! CHECK: %[[C_BITS:.*]] = arith.constant 128 : i128
! CHECK: %[[B_CONV:.*]] = fir.convert %[[B_VAL]] : (i32) -> i128
- ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi eq, %[[B_CONV]], %[[C_BITS]] : i128
+ ! CHECK: %[[SHIFT_IS_BITWIDTH:.*]] = arith.cmpi uge, %[[B_CONV]], %[[C_BITS]] : i128
! CHECK: %[[C0:.*]] = arith.constant 0 : i128
! CHECK: %[[CM1:.*]] = arith.constant {{.*}} : i128
! CHECK: %[[IS_NEG:.*]] = arith.cmpi slt, %[[A_VAL]], %[[C0]] : i128
diff --git a/flang/test/Lower/allocatable-polymorphic.f90 b/flang/test/Lower/allocatable-polymorphic.f90
index 4d70e1ea4c739a..bbc54754ca1ab1 100644
--- a/flang/test/Lower/allocatable-polymorphic.f90
+++ b/flang/test/Lower/allocatable-polymorphic.f90
@@ -393,7 +393,7 @@ subroutine test_unlimited_polymorphic_with_intrinsic_type_spec()
! CHECK: %{{.*}} = fir.call @_FortranAAllocatableAllocate(%[[BOX_NONE]], %{{.*}}, %{{.*}}, %{{.*}}, %{{.*}}) {{.*}} : (!fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
! CHECK: %[[BOX_NONE:.*]] = fir.convert %[[PTR_DECL]]#1 : (!fir.ref<!fir.class<!fir.ptr<none>>>) -> !fir.ref<!fir.box<none>>
-! CHECK: %[[CAT:.*]] = arith.constant 1 : i32
+! CHECK: %[[CAT:.*]] = arith.constant 2 : i32
! CHECK: %[[KIND:.*]] = arith.constant 4 : i32
! CHECK: %[[RANK:.*]] = arith.constant 0 : i32
! CHECK: %[[CORANK:.*]] = arith.constant 0 : i32
diff --git a/flang/test/Lower/unsigned-ops.f90 b/flang/test/Lower/unsigned-ops.f90
new file mode 100644
index 00000000000000..f61f10656159ac
--- /dev/null
+++ b/flang/test/Lower/unsigned-ops.f90
@@ -0,0 +1,26 @@
+! RUN: %flang_fc1 -funsigned -emit-mlir %s -o - | FileCheck %s
+
+unsigned function f01(u, v)
+ unsigned, intent(in) :: u, v
+ f01 = u + v - 1u
+end
+
+!CHECK: func.func @_QPf01(%[[ARG0:.*]]: !fir.ref<ui32> {fir.bindc_name = "u"}, %[[ARG1:.*]]: !fir.ref<ui32> {fir.bindc_name = "v"}) -> ui32 {
+!CHECK: %[[C1_I32:.*]] = arith.constant 1 : i32
+!CHECK: %[[VAL_0:.*]] = fir.dummy_scope : !fir.dscope
+!CHECK: %[[VAL_1:.*]] = fir.alloca ui32 {bindc_name = "f01", uniq_name = "_QFf01Ef01"}
+!CHECK: %[[VAL_2:.*]] = fir.declare %[[VAL_1]] {uniq_name = "_QFf01Ef01"} : (!fir.ref<ui32>) -> !fir.ref<ui32>
+!CHECK: %[[VAL_3:.*]] = fir.declare %[[ARG0]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFf01Eu"} : (!fir.ref<ui32>, !fir.dscope) -> !fir.ref<ui32>
+!CHECK: %[[VAL_4:.*]] = fir.declare %[[ARG1]] dummy_scope %[[VAL_0]] {fortran_attrs = #fir.var_attrs<intent_in>, uniq_name = "_QFf01Ev"} : (!fir.ref<ui32>, !fir.dscope) -> !fir.ref<ui32>
+!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_3]] : !fir.ref<ui32>
+!CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_4]] : !fir.ref<ui32>
+!CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (ui32) -> i32
+!CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_6]] : (ui32) -> i32
+!CHECK: %[[VAL_9:.*]] = arith.addi %[[VAL_7]], %[[VAL_8]] : i32
+!CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> ui32
+!CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (ui32) -> i32
+!CHECK: %[[VAL_12:.*]] = arith.subi %[[VAL_11]], %[[C1_I32]] : i32
+!CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> ui32
+!CHECK: fir.store %[[VAL_13]] to %[[VAL_2]] : !fir.ref<ui32>
+!CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_2]] : !fir.ref<ui32>
+!CHECK: return %[[VAL_14]] : ui32
diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90
index 0d381f10b04831..454d73098408df 100644
--- a/flang/test/Semantics/typeinfo01.f90
+++ b/flang/test/Semantics/typeinfo01.f90
@@ -21,7 +21,7 @@ module m02
type, extends(parent) :: child
integer :: cn
end type
-!CHECK: .c.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .c.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.child, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .dt.parent, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
@@ -33,7 +33,7 @@ module m03
real(kind=k) :: a
end type
type(kpdt(4)) :: x
-!CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=2_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=.kp.kpdt.4,lenparameterkind=NULL(),component=.c.kpdt.4,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .kp.kpdt.4, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
end module
@@ -83,7 +83,7 @@ subroutine s2(x, y)
class(t2), intent(out) :: x
class(t), intent(in) :: y
end subroutine
-!CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,specialbitset=2_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .dt.t2, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .s.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=1_1,isargdescriptorset=3_1,istypebound=1_1,isargcontiguousset=0_1,proc=s1)]
@@ -230,7 +230,7 @@ module m11
real :: automatic(len)
end type
!CHECK: .b.t.automatic, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
-!CHECK: .c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.pointer),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.automatic,initialization=NULL())]
+!CHECK: .c.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=2_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=2_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.pointer),component(name=.n.chauto,genre=4_1,category=4_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=2_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.automatic,initialization=NULL())]
!CHECK: .di.t.pointer, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(.dp.t.pointer) init:.dp.t.pointer(pointer=target)
!CHECK: .dp.t.pointer (CompilerCreated): DerivedType components: pointer
!CHECK: .dt.t, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t,component=.c.t,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1,nofinalizationneeded=1_1)
diff --git a/flang/test/Semantics/typeinfo08.f90 b/flang/test/Semantics/typeinfo08.f90
index 7509070fa3eec5..689cf469dee3bd 100644
--- a/flang/test/Semantics/typeinfo08.f90
+++ b/flang/test/Semantics/typeinfo08.f90
@@ -12,7 +12,7 @@ module m
end module
!CHECK: Module scope: m size=0 alignment=1 sourceRange=113 bytes
-!CHECK: .c.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t1,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
+!CHECK: .c.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t1,genre=1_1,category=6_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
!CHECK: .dt.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.s,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.s,component=.c.s,procptr=NULL(),special=NULL(),specialbitset=0_4,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1,nofinalizationneeded=1_1)
!CHECK: .lpk.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::4_1]
!CHECK: .n.s, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: CHARACTER(1_8,1) init:"s"
diff --git a/flang/test/Semantics/unsigned-errors.f90 b/flang/test/Semantics/unsigned-errors.f90
new file mode 100644
index 00000000000000..24d6460bc2fe35
--- /dev/null
+++ b/flang/test/Semantics/unsigned-errors.f90
@@ -0,0 +1,77 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -funsigned
+
+implicit unsigned(u)
+real a(10)
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+real(kind=4u) x
+
+!ERROR: Both operands must be UNSIGNED
+print *, 0 + 1u
+!ERROR: Both operands must be UNSIGNED
+print *, 0u + 1
+!ERROR: Both operands must be UNSIGNED
+print *, 0. + 1u
+!ERROR: Both operands must be UNSIGNED
+print *, 0u + 1.
+
+print *, -0u ! ok
+print *, 0u + 1u ! ok
+print *, 0u - 1u ! ok
+print *, 0u * 1u ! ok
+print *, 0u / 1u ! ok
+!ERROR: Operands must not be UNSIGNED
+print *, 0u ** 1u
+
+print *, uint((0.,0.)) ! ok
+print *, uint(z'123') ! ok
+!ERROR: Actual argument for 'a=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
+print *, uint("a")
+!ERROR: Actual argument for 'a=' has bad type 'LOGICAL(4)'
+print *, uint(.true.)
+!ERROR: Actual argument for 'l=' has bad type 'UNSIGNED(4)'
+print *, logical(0u)
+!ERROR: Actual argument for 'i=' has bad type 'UNSIGNED(4)'
+print *, char(0u)
+
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+do u = 0u, 1u
+end do
+!ERROR: DO controls should be INTEGER
+do u = 0, 1
+end do
+!ERROR: DO controls should be INTEGER
+!ERROR: DO controls should be INTEGER
+do j = 0u, 1u
+end do
+
+select case (u) ! ok
+case(0u) ! ok
+!ERROR: CASE value has type 'INTEGER(4)' which is not compatible with the SELECT CASE expression's type 'UNSIGNED(4)'
+case(1)
+end select
+
+select case (j)
+!ERROR: CASE value has type 'UNSIGNED(4)' which is not compatible with the SELECT CASE expression's type 'INTEGER(4)'
+case(0u)
+end select
+
+u = z'1' ! ok
+!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types UNSIGNED(4) and INTEGER(4)
+u = 1
+!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types INTEGER(4) and UNSIGNED(4)
+j = 1u
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+write(6u,*) 'hi'
+
+!ERROR: ARITHMETIC IF expression must not be an UNSIGNED expression
+if (1u) 1,1,1
+1 continue
+
+!ERROR: Must have INTEGER type, but is UNSIGNED(4)
+print *, a(u)
+
+end
diff --git a/flang/unittests/Evaluate/real.cpp b/flang/unittests/Evaluate/real.cpp
index a6152d346762fa..1bf7fa1016a9e9 100644
--- a/flang/unittests/Evaluate/real.cpp
+++ b/flang/unittests/Evaluate/real.cpp
@@ -142,7 +142,7 @@ template <typename R> void basicTests(int rm, Rounding rounding) {
Integer8 ix{x};
TEST(!ix.IsNegative())(ldesc);
MATCH(x, ix.ToUInt64())(ldesc);
- vr = R::FromInteger(ix, rounding);
+ vr = R::FromInteger(ix, false, rounding);
TEST(!vr.value.IsNegative())(ldesc);
TEST(!vr.value.IsNotANumber())(ldesc);
TEST(!vr.value.IsZero())(ldesc);
@@ -303,7 +303,7 @@ void inttest(std::int64_t x, int pass, Rounding rounding) {
ScopedHostFloatingPointEnvironment fpenv;
Integer8 ix{x};
ValueWithRealFlags<REAL> real;
- real = real.value.FromInteger(ix, rounding);
+ real = real.value.FromInteger(ix, false, rounding);
#ifndef __clang__ // broken and also slow
fpenv.ClearFlags();
#endif
More information about the cfe-commits
mailing list