diff options
Diffstat (limited to 'flang')
96 files changed, 3289 insertions, 744 deletions
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 4b4b516..626bf43 100644 --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -420,6 +420,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 0000000..5c90e2a --- /dev/null +++ b/flang/docs/Unsigned.md @@ -0,0 +1,121 @@ +<!--===- 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 `/`, +components in complex constructors, +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`. + +`RANDOM_NUMBER`. + +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 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 70478fa..c35f634 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-consts.h b/flang/include/flang/Common/Fortran-consts.h index cf7884e..3ce5b6a 100644 --- a/flang/include/flang/Common/Fortran-consts.h +++ b/flang/include/flang/Common/Fortran-consts.h @@ -14,8 +14,10 @@ namespace Fortran::common { -// 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) ENUM_CLASS(IoStmtKind, None, Backspace, Close, Endfile, Flush, Inquire, Open, diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index b04f611..44f8800 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -54,7 +54,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines, PolymorphicActualAllocatableOrPointerToMonomorphicDummy, RelaxedPureDummy, UndefinableAsynchronousOrVolatileActual, AutomaticInMainProgram, PrintCptr, SavedLocalInSpecExpr, PrintNamelist, AssumedRankPassedToNonAssumedRank, - IgnoreIrrelevantAttributes) + IgnoreIrrelevantAttributes, Unsigned) // Portability and suspicious usage warnings ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, @@ -73,7 +73,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, PreviousScalarUse, RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition, IncompatibleImplicitInterfaces, BadTypeForTarget, VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg, - MismatchingDummyProcedure, SubscriptedEmptyArray) + MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation) using LanguageFeatures = EnumSet<LanguageFeature, LanguageFeature_enumSize>; using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>; diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h index 72e4348..e1922f7 100644 --- a/flang/include/flang/Common/Fortran.h +++ b/flang/include/flang/Common/Fortran.h @@ -23,7 +23,8 @@ namespace Fortran::common { class LanguageFeatureControl; 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 06eef84..2dcd28b 100644 --- a/flang/include/flang/Evaluate/complex.h +++ b/flang/include/flang/Evaluate/complex.h @@ -61,10 +61,11 @@ public: 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 2a40193..9ea037a 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 @@ public: 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>>; @@ -548,6 +551,29 @@ public: }; 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>> { public: @@ -560,7 +586,8 @@ private: // 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 @@ public: }; 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 @@ public: 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 @@ public: template <> class Relational<SomeType> { using DirectlyComparableTypes = common::CombineTuples<IntegerTypes, RealTypes, - ComplexTypes, CharacterTypes>; + ComplexTypes, CharacterTypes, UnsignedTypes>; public: using Result = LogicalResult; @@ -656,6 +685,7 @@ public: }; 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 d2a153f..b21c0f3 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 e420eb7..fccc2ad 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 @@ public: 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 11cc8f7..0329488 100644 --- a/flang/include/flang/Evaluate/real.h +++ b/flang/include/flang/Evaluate/real.h @@ -288,8 +288,9 @@ public: 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 dafacdf..f586c59 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 bd8887d..1f9296a 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: @@ -288,6 +289,13 @@ public: }; 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> { public: @@ -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 89a10ce..945f8fef 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 b772c52..6ee4370 100644 --- a/flang/include/flang/Optimizer/Builder/FIRBuilder.h +++ b/flang/include/flang/Optimizer/Builder/FIRBuilder.h @@ -556,6 +556,31 @@ public: /// 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 66e11b5..09b49b9 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 0ef37a3..1dbde5c 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 eda8f26..01f588b 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 bfd00c3..3919c91 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 2e25ef5..d507f41 100644 --- a/flang/include/flang/Optimizer/Support/Utils.h +++ b/flang/include/flang/Optimizer/Support/Utils.h @@ -110,6 +110,17 @@ inline std::string mlirTypeToIntrinsicFortran(fir::FirOpBuilder &builder, } else if (auto cplxTy = mlir::dyn_cast<mlir::ComplexType>(type)) { if (std::optional<int> kind = mlirFloatTypeToKind(cplxTy.getElementType())) return "COMPLEX(KIND+"s + std::to_string(*kind) + ")"; + } else if (type.isUnsignedInteger()) { + if (type.isInteger(8)) + return "UNSIGNED(KIND=1)"; + else if (type.isInteger(16)) + return "UNSIGNED(KIND=2)"; + else if (type.isInteger(32)) + return "UNSIGNED(KIND=4)"; + else if (type.isInteger(64)) + return "UNSIGNED(KIND=8)"; + else if (type.isInteger(128)) + return "UNSIGNED(KIND=16)"; } else if (type.isInteger(8)) return "INTEGER(KIND=1)"; else if (type.isInteger(16)) @@ -162,15 +173,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 940caae..7821d40 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -806,6 +806,7 @@ public: NODE(Union, EndUnionStmt) NODE(Union, UnionStmt) NODE(parser, UnlockStmt) + NODE(parser, UnsignedLiteralConstant) NODE(parser, UnsignedTypeSpec) NODE(parser, UseStmt) NODE_ENUM(UseStmt, ModuleNature) @@ -928,7 +929,8 @@ protected: 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 f87a1cf..2ef593b 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -657,6 +657,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); @@ -694,7 +696,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 { @@ -719,13 +721,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; @@ -803,6 +804,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 }; @@ -894,7 +901,7 @@ struct LiteralConstant { UNION_CLASS_BOILERPLATE(LiteralConstant); std::variant<HollerithLiteralConstant, IntLiteralConstant, RealLiteralConstant, ComplexLiteralConstant, BOZLiteralConstant, - CharLiteralConstant, LogicalLiteralConstant> + CharLiteralConstant, LogicalLiteralConstant, UnsignedLiteralConstant> u; }; @@ -1484,7 +1491,7 @@ struct DataStmtConstant { std::variant<common::Indirection<CharLiteralConstantSubstring>, LiteralConstant, SignedIntLiteralConstant, SignedRealLiteralConstant, SignedComplexLiteralConstant, NullInit, common::Indirection<Designator>, - StructureConstructor> + StructureConstructor, UnsignedLiteralConstant> u; }; diff --git a/flang/include/flang/Runtime/cpp-type.h b/flang/include/flang/Runtime/cpp-type.h index b8c543d..cc31ce2 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/matmul-instances.inc b/flang/include/flang/Runtime/matmul-instances.inc index da31948..21269d0 100644 --- a/flang/include/flang/Runtime/matmul-instances.inc +++ b/flang/include/flang/Runtime/matmul-instances.inc @@ -56,6 +56,22 @@ macro(Integer, 4, Complex, 8) \ macro(Integer, 8, Complex, 4) \ macro(Integer, 8, Complex, 8) \ + macro(Unsigned, 1, Real, 4) \ + macro(Unsigned, 1, Real, 8) \ + macro(Unsigned, 2, Real, 4) \ + macro(Unsigned, 2, Real, 8) \ + macro(Unsigned, 4, Real, 4) \ + macro(Unsigned, 4, Real, 8) \ + macro(Unsigned, 8, Real, 4) \ + macro(Unsigned, 8, Real, 8) \ + macro(Unsigned, 1, Complex, 4) \ + macro(Unsigned, 1, Complex, 8) \ + macro(Unsigned, 2, Complex, 4) \ + macro(Unsigned, 2, Complex, 8) \ + macro(Unsigned, 4, Complex, 4) \ + macro(Unsigned, 4, Complex, 8) \ + macro(Unsigned, 8, Complex, 4) \ + macro(Unsigned, 8, Complex, 8) \ macro(Real, 4, Integer, 1) \ macro(Real, 4, Integer, 2) \ macro(Real, 4, Integer, 4) \ @@ -64,6 +80,14 @@ macro(Real, 8, Integer, 2) \ macro(Real, 8, Integer, 4) \ macro(Real, 8, Integer, 8) \ + macro(Real, 4, Unsigned, 1) \ + macro(Real, 4, Unsigned, 2) \ + macro(Real, 4, Unsigned, 4) \ + macro(Real, 4, Unsigned, 8) \ + macro(Real, 8, Unsigned, 1) \ + macro(Real, 8, Unsigned, 2) \ + macro(Real, 8, Unsigned, 4) \ + macro(Real, 8, Unsigned, 8) \ macro(Real, 4, Real, 4) \ macro(Real, 4, Real, 8) \ macro(Real, 8, Real, 4) \ @@ -80,6 +104,14 @@ macro(Complex, 8, Integer, 2) \ macro(Complex, 8, Integer, 4) \ macro(Complex, 8, Integer, 8) \ + macro(Complex, 4, Unsigned, 1) \ + macro(Complex, 4, Unsigned, 2) \ + macro(Complex, 4, Unsigned, 4) \ + macro(Complex, 4, Unsigned, 8) \ + macro(Complex, 8, Unsigned, 1) \ + macro(Complex, 8, Unsigned, 2) \ + macro(Complex, 8, Unsigned, 4) \ + macro(Complex, 8, Unsigned, 8) \ macro(Complex, 4, Real, 4) \ macro(Complex, 4, Real, 8) \ macro(Complex, 8, Real, 4) \ @@ -103,10 +135,18 @@ FOREACH_MATMUL_TYPE_PAIR(MATMUL_DIRECT_INSTANCE) macro(Integer, 16, Real, 8) \ macro(Integer, 16, Complex, 4) \ macro(Integer, 16, Complex, 8) \ + macro(Unsigned, 16, Real, 4) \ + macro(Unsigned, 16, Real, 8) \ + macro(Unsigned, 16, Complex, 4) \ + macro(Unsigned, 16, Complex, 8) \ macro(Real, 4, Integer, 16) \ macro(Real, 8, Integer, 16) \ macro(Complex, 4, Integer, 16) \ macro(Complex, 8, Integer, 16) \ + macro(Real, 4, Unsigned, 16) \ + macro(Real, 8, Unsigned, 16) \ + macro(Complex, 4, Unsigned, 16) \ + macro(Complex, 8, Unsigned, 16) \ FOREACH_MATMUL_TYPE_PAIR_WITH_INT16(MATMUL_INSTANCE) FOREACH_MATMUL_TYPE_PAIR_WITH_INT16(MATMUL_DIRECT_INSTANCE) @@ -116,20 +156,36 @@ MATMUL_INSTANCE(Integer, 16, Real, 10) MATMUL_INSTANCE(Integer, 16, Complex, 10) MATMUL_INSTANCE(Real, 10, Integer, 16) MATMUL_INSTANCE(Complex, 10, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_INSTANCE(Complex, 10, Unsigned, 16) MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 10) MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 10) MATMUL_DIRECT_INSTANCE(Real, 10, Integer, 16) MATMUL_DIRECT_INSTANCE(Complex, 10, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 10) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 10) +MATMUL_DIRECT_INSTANCE(Real, 10, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 10, Unsigned, 16) #endif #if MATMUL_FORCE_ALL_TYPES || (HAS_LDBL128 || HAS_FLOAT128) MATMUL_INSTANCE(Integer, 16, Real, 16) MATMUL_INSTANCE(Integer, 16, Complex, 16) MATMUL_INSTANCE(Real, 16, Integer, 16) MATMUL_INSTANCE(Complex, 16, Integer, 16) +MATMUL_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_INSTANCE(Complex, 16, Unsigned, 16) MATMUL_DIRECT_INSTANCE(Integer, 16, Real, 16) MATMUL_DIRECT_INSTANCE(Integer, 16, Complex, 16) MATMUL_DIRECT_INSTANCE(Real, 16, Integer, 16) MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Real, 16) +MATMUL_DIRECT_INSTANCE(Unsigned, 16, Complex, 16) +MATMUL_DIRECT_INSTANCE(Real, 16, Unsigned, 16) +MATMUL_DIRECT_INSTANCE(Complex, 16, Unsigned, 16) #endif #endif // MATMUL_FORCE_ALL_TYPES || (defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T) @@ -143,6 +199,14 @@ MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) macro(Integer, 4, Complex, 10) \ macro(Integer, 8, Real, 10) \ macro(Integer, 8, Complex, 10) \ + macro(Unsigned, 1, Real, 10) \ + macro(Unsigned, 1, Complex, 10) \ + macro(Unsigned, 2, Real, 10) \ + macro(Unsigned, 2, Complex, 10) \ + macro(Unsigned, 4, Real, 10) \ + macro(Unsigned, 4, Complex, 10) \ + macro(Unsigned, 8, Real, 10) \ + macro(Unsigned, 8, Complex, 10) \ macro(Real, 4, Real, 10) \ macro(Real, 4, Complex, 10) \ macro(Real, 8, Real, 10) \ @@ -151,6 +215,10 @@ MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) macro(Real, 10, Integer, 2) \ macro(Real, 10, Integer, 4) \ macro(Real, 10, Integer, 8) \ + macro(Real, 10, Unsigned, 1) \ + macro(Real, 10, Unsigned, 2) \ + macro(Real, 10, Unsigned, 4) \ + macro(Real, 10, Unsigned, 8) \ macro(Real, 10, Real, 4) \ macro(Real, 10, Real, 8) \ macro(Real, 10, Real, 10) \ @@ -165,6 +233,10 @@ MATMUL_DIRECT_INSTANCE(Complex, 16, Integer, 16) macro(Complex, 10, Integer, 2) \ macro(Complex, 10, Integer, 4) \ macro(Complex, 10, Integer, 8) \ + macro(Complex, 10, Unsigned, 1) \ + macro(Complex, 10, Unsigned, 2) \ + macro(Complex, 10, Unsigned, 4) \ + macro(Complex, 10, Unsigned, 8) \ macro(Complex, 10, Real, 4) \ macro(Complex, 10, Real, 8) \ macro(Complex, 10, Real, 10) \ diff --git a/flang/include/flang/Runtime/numeric.h b/flang/include/flang/Runtime/numeric.h index 9e6bf35..794c8f4 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 c63782b..26a61be 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 91811581..6945ed4 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 a90801d..bb1674a 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -274,6 +274,7 @@ private: } 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 @@ private: 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/Fortran-features.cpp b/flang/lib/Common/Fortran-features.cpp index c864328..3565275 100644 --- a/flang/lib/Common/Fortran-features.cpp +++ b/flang/lib/Common/Fortran-features.cpp @@ -83,6 +83,7 @@ LanguageFeatureControl::LanguageFeatureControl() { warnUsage_.set(UsageWarning::VectorSubscriptFinalization); warnUsage_.set(UsageWarning::UndefinedFunctionResult); warnUsage_.set(UsageWarning::UselessIomsg); + warnUsage_.set(UsageWarning::UnsignedLiteralTruncation); // New warnings, on by default warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr); } diff --git a/flang/lib/Common/default-kinds.cpp b/flang/lib/Common/default-kinds.cpp index 0c708fc..fbafd82 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 1a65d4c..9514ac8 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 b9c7544..c82995c 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 0ad09d7..26ae33f 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 @@ -834,46 +707,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( return i.IBITS(static_cast<int>(pos.ToInt64()), static_cast<int>(len.ToInt64())); })); - } else if (name == "index" || name == "scan" || name == "verify") { - if (auto *charExpr{UnwrapExpr<Expr<SomeCharacter>>(args[0])}) { - return common::visit( - [&](const auto &kch) -> Expr<T> { - using TC = typename std::decay_t<decltype(kch)>::Result; - if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK= - return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context, - std::move(funcRef), - ScalarFunc<T, TC, TC, LogicalResult>{ - [&name, &FromInt64](const Scalar<TC> &str, - const Scalar<TC> &other, - const Scalar<LogicalResult> &back) { - return FromInt64(name == "index" - ? CharacterUtils<TC::kind>::INDEX( - str, other, back.IsTrue()) - : name == "scan" - ? CharacterUtils<TC::kind>::SCAN( - str, other, back.IsTrue()) - : CharacterUtils<TC::kind>::VERIFY( - str, other, back.IsTrue())); - }}); - } else { - return FoldElementalIntrinsic<T, TC, TC>(context, - std::move(funcRef), - ScalarFunc<T, TC, TC>{ - [&name, &FromInt64]( - const Scalar<TC> &str, const Scalar<TC> &other) { - return FromInt64(name == "index" - ? CharacterUtils<TC::kind>::INDEX(str, other) - : name == "scan" - ? CharacterUtils<TC::kind>::SCAN(str, other) - : CharacterUtils<TC::kind>::VERIFY(str, other)); - }}); - } - }, - charExpr->u); - } else { - DIE("first argument must be CHARACTER"); - } - } else if (name == "int" || name == "int2" || name == "int8") { + } 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> { @@ -886,26 +721,6 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( }, std::move(expr->u)); } - } else if (name == "int_ptr_kind") { - return Expr<T>{8}; - } else if (name == "kind") { - // FoldOperation(FunctionRef &&) in fold-implementation.h will not - // have folded the argument; in the case of TypeParamInquiry, - // try to get the type of the parameter itself. - if (const auto *expr{args[0] ? args[0]->UnwrapExpr() : nullptr}) { - if (const auto *inquiry{UnwrapExpr<TypeParamInquiry>(*expr)}) { - if (const auto *typeSpec{inquiry->parameter().GetType()}) { - if (const auto *intrinType{typeSpec->AsIntrinsic()}) { - if (auto k{ToInt64(Fold( - context, Expr<SubscriptInteger>{intrinType->kind()}))}) { - return Expr<T>{*k}; - } - } - } - } else if (auto dyType{expr->GetType()}) { - return Expr<T>{dyType->kind()}; - } - } } else if (name == "iparity") { return FoldBitReduction( context, std::move(funcRef), &Scalar<T>::IEOR, Scalar<T>{}); @@ -995,20 +810,304 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction( } } else if (name == "izext" || name == "jzext") { if (args.size() == 1) { - if (auto *expr{UnwrapExpr<Expr<SomeInteger>>(args[0])}) { + 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<SomeInteger>{std::move(converted)}); + *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::category == TypeCategory::Unsigned ? typename T::Scalar{} + : 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::category == TypeCategory::Unsigned ? typename T::Scalar{}.NOT() + : 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( + [&](const auto &kch) -> Expr<T> { + using TC = typename std::decay_t<decltype(kch)>::Result; + if (UnwrapExpr<Expr<SomeLogical>>(args[2])) { // BACK= + return FoldElementalIntrinsic<T, TC, TC, LogicalResult>(context, + std::move(funcRef), + ScalarFunc<T, TC, TC, LogicalResult>{ + [&name, &FromInt64](const Scalar<TC> &str, + const Scalar<TC> &other, + const Scalar<LogicalResult> &back) { + return FromInt64(name == "index" + ? CharacterUtils<TC::kind>::INDEX( + str, other, back.IsTrue()) + : name == "scan" + ? CharacterUtils<TC::kind>::SCAN( + str, other, back.IsTrue()) + : CharacterUtils<TC::kind>::VERIFY( + str, other, back.IsTrue())); + }}); + } else { + return FoldElementalIntrinsic<T, TC, TC>(context, + std::move(funcRef), + ScalarFunc<T, TC, TC>{ + [&name, &FromInt64]( + const Scalar<TC> &str, const Scalar<TC> &other) { + return FromInt64(name == "index" + ? CharacterUtils<TC::kind>::INDEX(str, other) + : name == "scan" + ? CharacterUtils<TC::kind>::SCAN(str, other) + : CharacterUtils<TC::kind>::VERIFY(str, other)); + }}); + } + }, + charExpr->u); + } else { + DIE("first argument must be CHARACTER"); + } + } else if (name == "int_ptr_kind") { + return Expr<T>{8}; + } else if (name == "kind") { + // FoldOperation(FunctionRef &&) in fold-implementation.h will not + // have folded the argument; in the case of TypeParamInquiry, + // try to get the type of the parameter itself. + if (const auto *expr{args[0] ? args[0]->UnwrapExpr() : nullptr}) { + if (const auto *inquiry{UnwrapExpr<TypeParamInquiry>(*expr)}) { + if (const auto *typeSpec{inquiry->parameter().GetType()}) { + if (const auto *intrinType{typeSpec->AsIntrinsic()}) { + if (auto k{ToInt64(Fold( + context, Expr<SubscriptInteger>{intrinType->kind()}))}) { + return Expr<T>{*k}; + } + } + } + } else if (auto dyType{expr->GetType()}) { + return Expr<T>{dyType->kind()}; + } + } } 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 +1171,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 +1184,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 +1197,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 +1255,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 +1269,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 +1276,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 +1321,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 +1345,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 +1394,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 +1421,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 +1533,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 +1556,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 6f24f09e..6c7758e 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)); @@ -920,6 +939,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 c3d65a9..9237d6e 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 b1b81d8..b6f2d21 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 @@ public: 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 @@ public: 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).Subtract(correction_, rounding_)}; overflow_ |= next.flags.test(RealFlag::Overflow); @@ -361,7 +374,8 @@ public: } 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 @@ private: 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 3581b9c..f3a53c1 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 cdea572..28805ef 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}, @@ -655,6 +699,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"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}}, SameCharNoLen}, @@ -683,17 +731,23 @@ 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}}, SameCharNoLen}, @@ -720,8 +774,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, @@ -732,7 +789,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}, @@ -848,12 +905,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}, @@ -928,6 +990,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}}, @@ -1018,6 +1084,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"}, }; @@ -1460,8 +1527,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 @@ -1470,8 +1537,9 @@ static const IntrinsicInterface intrinsicSubroutine[]{ {"image_distinct", AnyLogical, Rank::scalar}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"random_number", - {{"harvest", AnyReal, Rank::known, Optionality::required, - common::Intent::Out, {ArgFlag::notAssumedSize}}}, + {{"harvest", {RealType | UnsignedType, KindCode::any}, Rank::known, + Optionality::required, common::Intent::Out, + {ArgFlag::notAssumedSize}}}, {}, Rank::elemental, IntrinsicClass::impureSubroutine}, {"random_seed", {{"size", DefaultInt, Rank::scalar, Optionality::optional, diff --git a/flang/lib/Evaluate/target.cpp b/flang/lib/Evaluate/target.cpp index 5a556b3..409e28c 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; @@ -137,6 +138,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 cb6c821..6299084 100644 --- a/flang/lib/Evaluate/tools.cpp +++ b/flang/lib/Evaluate/tools.cpp @@ -122,6 +122,35 @@ ConvertRealOperandsResult ConvertRealOperands( defaultRealKind, std::move(iy)))}; }, [&](Expr<SomeInteger> &&ix, + Expr<SomeUnsigned> &&iy) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(ix)), + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(iy)))}; + }, + [&](Expr<SomeUnsigned> &&ix, + Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(ix)), + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(iy)))}; + }, + [&](Expr<SomeUnsigned> &&ix, + Expr<SomeUnsigned> &&iy) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(ix)), + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(iy)))}; + }, + [&](Expr<SomeInteger> &&ix, + Expr<SomeReal> &&ry) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertTo(ry, std::move(ix)), std::move(ry))}; + }, + [&](Expr<SomeUnsigned> &&ix, Expr<SomeReal> &&ry) -> ConvertRealOperandsResult { return {AsSameKindExprs<TypeCategory::Real>( ConvertTo(ry, std::move(ix)), std::move(ry))}; @@ -132,6 +161,11 @@ ConvertRealOperandsResult ConvertRealOperands( std::move(rx), ConvertTo(rx, std::move(iy)))}; }, [&](Expr<SomeReal> &&rx, + Expr<SomeUnsigned> &&iy) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + std::move(rx), ConvertTo(rx, std::move(iy)))}; + }, + [&](Expr<SomeReal> &&rx, Expr<SomeReal> &&ry) -> ConvertRealOperandsResult { return {AsSameKindExprs<TypeCategory::Real>( std::move(rx), std::move(ry))}; @@ -144,6 +178,14 @@ ConvertRealOperandsResult ConvertRealOperands( ConvertToKind<TypeCategory::Real>( defaultRealKind, std::move(by)))}; }, + [&](Expr<SomeUnsigned> &&ix, + BOZLiteralConstant &&by) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(ix)), + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(by)))}; + }, [&](BOZLiteralConstant &&bx, Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult { return {AsSameKindExprs<TypeCategory::Real>( @@ -152,6 +194,14 @@ ConvertRealOperandsResult ConvertRealOperands( ConvertToKind<TypeCategory::Real>( defaultRealKind, std::move(iy)))}; }, + [&](BOZLiteralConstant &&bx, + Expr<SomeUnsigned> &&iy) -> ConvertRealOperandsResult { + return {AsSameKindExprs<TypeCategory::Real>( + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(bx)), + ConvertToKind<TypeCategory::Real>( + defaultRealKind, std::move(iy)))}; + }, [&](Expr<SomeReal> &&rx, BOZLiteralConstant &&by) -> ConvertRealOperandsResult { return {AsSameKindExprs<TypeCategory::Real>( @@ -163,7 +213,8 @@ ConvertRealOperandsResult ConvertRealOperands( ConvertTo(ry, std::move(bx)), std::move(ry))}; }, [&](auto &&, auto &&) -> ConvertRealOperandsResult { // C718 - messages.Say("operands must be INTEGER or REAL"_err_en_US); + messages.Say( + "operands must be INTEGER, UNSIGNED, REAL, or BOZ"_err_en_US); return std::nullopt; }, }, @@ -437,7 +488,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 +502,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 +568,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 +614,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 +661,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 +694,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 +803,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 c006888..0c2784d 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 6ef4ee8..79386c9 100644 --- a/flang/lib/Frontend/CompilerInvocation.cpp +++ b/flang/lib/Frontend/CompilerInvocation.cpp @@ -749,6 +749,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 f5883dce..2c02aa2 100644 --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3114,7 +3114,7 @@ private: } /// 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; @@ -3150,6 +3150,10 @@ private: 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; @@ -3163,9 +3167,10 @@ private: 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 556b330..e56fde2 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 7698fac..d9ae502 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 @@ public: 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> @@ -1050,6 +1081,18 @@ public: } 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 @@ public: 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 @@ public: } 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 @@ public: 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 @@ public: 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 @@ -5103,21 +5156,37 @@ private: 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(); auto f = genarr(x.left()); @@ -5147,7 +5216,8 @@ private: 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); }; } @@ -5160,15 +5230,19 @@ private: } 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> @@ -6549,13 +6623,21 @@ private: //===--------------------------------------------------------------------===// 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); }; } @@ -6573,12 +6655,19 @@ private: 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 4ab319b..3e54cef 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) @@ -1315,6 +1367,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>>> { using Op = 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 8664477..452ddda 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 89e0aa2..0d4f95f 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 a66dae8..1165417 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 547cebe..aad463e 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}}}, @@ -2771,8 +2777,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 @@ -2784,12 +2790,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); } @@ -2801,12 +2813,18 @@ 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::Value word = args[0]; + mlir::Type signlessType = mlir::IntegerType::get( + builder.getContext(), word.getType().getIntOrFloatBitWidth(), + mlir::IntegerType::SignednessSemantics::Signless); + if (word.getType().isUnsignedInteger()) + word = builder.createConvert(loc, signlessType, word); + mlir::Value shiftCount = builder.createConvert(loc, signlessType, args[1]); + mlir::Value shifted = + builder.create<mlir::arith::ShRUIOp>(loc, word, shiftCount); + 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, @@ -3252,21 +3270,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 @@ -3276,21 +3303,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 @@ -3852,9 +3888,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 @@ -3873,12 +3908,16 @@ 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 = builder.createConvert(loc, signlessType, args[1]); + 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 @@ -3893,19 +3932,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 @@ -3916,10 +3968,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 @@ -5396,7 +5452,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 @@ -5457,7 +5514,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 @@ -5500,20 +5558,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 @@ -5536,15 +5605,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); @@ -5560,7 +5635,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, @@ -5569,17 +5644,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 @@ -5679,17 +5758,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 @@ -5701,8 +5783,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 @@ -5816,23 +5901,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]); @@ -5855,6 +5948,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]); @@ -5957,24 +6057,32 @@ void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) { return *arg; }; 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 fromType = from.getType(); + mlir::Type signlessType = mlir::IntegerType::get( + builder.getContext(), fromType.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 && + mlir::Type toType{fir::dyn_cast_ptrEleTy(toAddr.getType())}; + assert(toType.getIntOrFloatBitWidth() == fromType.getIntOrFloatBitWidth() && "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 (fromType.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); @@ -5982,7 +6090,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 (toType.isUnsignedInteger()) + res = builder.createConvert(loc, toType, res); builder.create<fir::StoreOp>(loc, res, toAddr); } @@ -6215,8 +6326,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 @@ -6906,9 +7021,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); @@ -6916,34 +7034,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 @@ -7443,13 +7576,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 @@ -7487,6 +7623,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 b768733..1aa941b 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/Builder/Runtime/Transformational.cpp b/flang/lib/Optimizer/Builder/Runtime/Transformational.cpp index 50f14ab..517ba37 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Transformational.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Transformational.cpp @@ -372,9 +372,12 @@ void fir::runtime::genMatmul(fir::FirOpBuilder &builder, mlir::Location loc, auto arrBEleTy = mlir::cast<fir::SequenceType>(arrBTy).getElementType(); auto [bCat, bKind] = fir::mlirTypeToCategoryKind(loc, arrBEleTy); +// Unsigned is treated as Integer when both operands are unsigned/integer #define MATMUL_INSTANCE(ACAT, AKIND, BCAT, BKIND) \ - if (!func && aCat == TypeCategory::ACAT && aKind == AKIND && \ - bCat == TypeCategory::BCAT && bKind == BKIND) { \ + if (!func && aKind == AKIND && bKind == BKIND && \ + ((aCat == TypeCategory::ACAT && bCat == TypeCategory::BCAT) || \ + ((aCat == TypeCategory::Integer || aCat == TypeCategory::Unsigned) && \ + (bCat == TypeCategory::Integer || bCat == TypeCategory::Unsigned)))) { \ func = \ fir::runtime::getRuntimeFunc<ForcedMatmul##ACAT##AKIND##BCAT##BKIND>( \ loc, builder); \ diff --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp index 082f2b1..88af5e3 100644 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -791,7 +791,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)) { @@ -804,7 +807,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(); } @@ -813,7 +816,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 70c0fd6..cba7fa6 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())) { @@ -805,6 +821,19 @@ void fir::IntegerType::print(mlir::AsmPrinter &printer) const { } //===----------------------------------------------------------------------===// +// 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 aa0a2a6..7cb35c1 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 @@ -1043,8 +1050,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 623437f..8e91ede 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 f87a004..8559bef 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 caa8f8b..5ce143c 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 0dbd6ea..c2eb17c 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -651,40 +651,52 @@ 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()}; using Int = typename T::Scalar; typename Int::ValueWithOverflow num{0, false}; + const char *typeName{ + CAT == TypeCategory::Integer ? "INTEGER" : "UNSIGNED"}; if (isNegated) { auto unsignedNum{Int::Read(p, 10, false /*unsigned*/)}; num.value = unsignedNum.value.Negate().value; - num.overflow = unsignedNum.overflow || num.value > Int{0}; + num.overflow = unsignedNum.overflow || + (CAT == TypeCategory::Integer && num.value > Int{0}); if (!num.overflow && num.value.Negate().overflow) { analyzer.Warn(LanguageFeature::BigIntLiterals, digits, "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 (num.overflow) { + if constexpr (CAT == TypeCategory::Unsigned) { + analyzer.Warn(common::UsageWarning::UnsignedLiteralTruncation, + "Unsigned literal too large for UNSIGNED(KIND=%d); truncated"_warn_en_US, + kind); + return Expr<SomeType>{ + Expr<SomeKind<CAT>>{Expr<T>{Constant<T>{std::move(num.value)}}}}; + } + } else { if (T::kind > kind) { if (!isDefaultKind || !analyzer.context().IsEnabled(LanguageFeature::BigIntLiterals)) { return std::nullopt; } else { 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; @@ -696,24 +708,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; @@ -723,13 +736,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> @@ -3520,9 +3545,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)); @@ -3531,9 +3556,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); @@ -3543,23 +3569,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( @@ -4290,12 +4316,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( @@ -4349,9 +4377,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)}; @@ -4543,6 +4571,7 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() { } } else { if (lhsType->category() == TypeCategory::Integer || + lhsType->category() == TypeCategory::Unsigned || lhsType->category() == TypeCategory::Real) { ConvertBOZ(nullptr, 1, lhsType); } @@ -4777,7 +4806,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, @@ -4789,10 +4819,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 51e8b15..122c0a2 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -985,6 +985,7 @@ public: 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 &); @@ -5359,6 +5360,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)); @@ -7665,6 +7675,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 6ee53cd..9c5682b 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 379d5d0..9e18060 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 eb0f8f2..73d712c 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 4e575b4..3729b95 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 4de54dd..5408e7d 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/Float128Math/random.cpp b/flang/runtime/Float128Math/random.cpp index e34bb2c..93c5c14 100644 --- a/flang/runtime/Float128Math/random.cpp +++ b/flang/runtime/Float128Math/random.cpp @@ -16,7 +16,7 @@ extern "C" { #if HAS_LDBL128 || HAS_FLOAT128 void RTDEF(RandomNumber16)( const Descriptor &harvest, const char *source, int line) { - return Generate<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest); + return GenerateReal<CppTypeFor<TypeCategory::Real, 16>, 113>(harvest); } #endif diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h index ff5f683..1034958 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 335e592..712497a 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 b5725a9..c714a85 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,8 +270,13 @@ RT_API_ATTRS bool EditIntegerInput( "Integer value absent from NAMELIST or list-directed input"); return false; } - auto maxForKind{common::UnsignedInt128{1} << ((8 * kind) - 1)}; - overflow |= value >= maxForKind && (value > maxForKind || sign != '-'); + if (isSigned) { + auto maxForKind{common::UnsignedInt128{1} << ((8 * kind) - 1)}; + overflow |= value >= maxForKind && (value > maxForKind || sign != '-'); + } else { + auto maxForKind{maxu128 >> (((16 - kind) * 8) + (isSigned ? 1 : 0))}; + overflow |= value >= maxForKind; + } if (overflow) { io.GetIoErrorHandler().SignalError(IostatIntegerInputOverflow, "Decimal input overflows INTEGER(%d) variable", kind); diff --git a/flang/runtime/edit-input.h b/flang/runtime/edit-input.h index a90180b..55a7a45 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 9d60732..9db9a3d 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 365bc2e..42cc993 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 9442fa5..7ecdf4b 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>( @@ -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 674a21a..d05e9c5 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, @@ -318,6 +336,12 @@ void RTDEF(FindlocDim)(Descriptor &result, const Descriptor &x, void>(xType->second, terminator, targetType->first, targetType->second, result, x, target, kind, dim, mask, back, terminator); break; + case TypeCategory::Unsigned: + ApplyIntegerKind<NumericFindlocHelper<TypeCategory::Unsigned, + PartialNumericFindlocHelper>::template Functor, + void>(xType->second, terminator, targetType->first, targetType->second, + result, x, target, kind, dim, mask, back, terminator); + break; case TypeCategory::Real: ApplyFloatingPointKind<NumericFindlocHelper<TypeCategory::Real, PartialNumericFindlocHelper>::template Functor, diff --git a/flang/runtime/io-api-minimal.cpp b/flang/runtime/io-api-minimal.cpp index ad76fe3..6876842 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/matmul.cpp b/flang/runtime/matmul.cpp index a5737a9..f726010 100644 --- a/flang/runtime/matmul.cpp +++ b/flang/runtime/matmul.cpp @@ -432,8 +432,13 @@ struct MatmulHelper { auto xCatKind{x.type().GetCategoryAndKind()}; auto yCatKind{y.type().GetCategoryAndKind()}; RUNTIME_CHECK(terminator, xCatKind.has_value() && yCatKind.has_value()); - RUNTIME_CHECK(terminator, xCatKind->first == XCAT); - RUNTIME_CHECK(terminator, yCatKind->first == YCAT); + RUNTIME_CHECK(terminator, + (xCatKind->first == XCAT && yCatKind->first == YCAT) || + (XCAT == TypeCategory::Integer && YCAT == TypeCategory::Integer && + ((xCatKind->first == TypeCategory::Integer || + xCatKind->first == TypeCategory::Unsigned) && + (yCatKind->first == TypeCategory::Integer || + yCatKind->first == TypeCategory::Unsigned)))); if constexpr (constexpr auto resultType{ GetResultType(XCAT, XKIND, YCAT, YKIND)}) { return DoMatmul<IS_ALLOCATING, resultType->first, resultType->second, diff --git a/flang/runtime/numeric.cpp b/flang/runtime/numeric.cpp index 4797ecf..45fb563 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 aef0f7c..293ffd3 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/random-templates.h b/flang/runtime/random-templates.h index f34422f..38859417 100644 --- a/flang/runtime/random-templates.h +++ b/flang/runtime/random-templates.h @@ -48,7 +48,7 @@ static GeneratedWord GetNextValue() { } template <typename REAL, int PREC> -inline void Generate(const Descriptor &harvest) { +inline void GenerateReal(const Descriptor &harvest) { static constexpr std::size_t minBits{ std::max<std::size_t>(PREC, 8 * sizeof(GeneratedWord))}; using Int = common::HostUnsignedIntType<minBits>; @@ -83,6 +83,29 @@ inline void Generate(const Descriptor &harvest) { } } +template <typename UINT> +inline void GenerateUnsigned(const Descriptor &harvest) { + static constexpr std::size_t words{ + (8 * sizeof(UINT) + rangeBits - 1) / rangeBits}; + std::size_t elements{harvest.Elements()}; + SubscriptValue at[maxRank]; + harvest.GetLowerBounds(at); + { + CriticalSection critical{lock}; + for (std::size_t j{0}; j < elements; ++j) { + UINT next{static_cast<UINT>(GetNextValue())}; + if constexpr (words > 1) { + for (std::size_t k{1}; k < words; ++k) { + next <<= rangeBits; + next |= GetNextValue(); + } + } + *harvest.Element<UINT>(at) = next; + harvest.IncrementSubscripts(at); + } + } +} + } // namespace Fortran::runtime::random #endif // FORTRAN_RUNTIME_RANDOM_TEMPLATES_H_ diff --git a/flang/runtime/random.cpp b/flang/runtime/random.cpp index 9ec961f..8f15800 100644 --- a/flang/runtime/random.cpp +++ b/flang/runtime/random.cpp @@ -54,27 +54,58 @@ void RTNAME(RandomNumber)( const Descriptor &harvest, const char *source, int line) { Terminator terminator{source, line}; auto typeCode{harvest.type().GetCategoryAndKind()}; - RUNTIME_CHECK(terminator, typeCode && typeCode->first == TypeCategory::Real); + RUNTIME_CHECK(terminator, + typeCode && + (typeCode->first == TypeCategory::Real || + typeCode->first == TypeCategory::Unsigned)); int kind{typeCode->second}; - switch (kind) { - // TODO: REAL (2 & 3) - case 4: - Generate<CppTypeFor<TypeCategory::Real, 4>, 24>(harvest); - return; - case 8: - Generate<CppTypeFor<TypeCategory::Real, 8>, 53>(harvest); - return; - case 10: - if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) { + if (typeCode->first == TypeCategory::Real) { + switch (kind) { + // TODO: REAL (2 & 3) + case 4: + GenerateReal<CppTypeFor<TypeCategory::Real, 4>, 24>(harvest); + return; + case 8: + GenerateReal<CppTypeFor<TypeCategory::Real, 8>, 53>(harvest); + return; + case 10: + if constexpr (HasCppTypeFor<TypeCategory::Real, 10>) { #if HAS_FLOAT80 - Generate<CppTypeFor<TypeCategory::Real, 10>, 64>(harvest); + GenerateReal<CppTypeFor<TypeCategory::Real, 10>, 64>(harvest); + return; +#endif + } + break; + } + terminator.Crash( + "not yet implemented: intrinsic: REAL(KIND=%d) in RANDOM_NUMBER", kind); + } else if (typeCode->first == TypeCategory::Unsigned) { + switch (kind) { + case 1: + GenerateUnsigned<CppTypeFor<TypeCategory::Unsigned, 1>>(harvest); + return; + case 2: + GenerateUnsigned<CppTypeFor<TypeCategory::Unsigned, 2>>(harvest); + return; + case 4: + GenerateUnsigned<CppTypeFor<TypeCategory::Unsigned, 4>>(harvest); return; + case 8: + GenerateUnsigned<CppTypeFor<TypeCategory::Unsigned, 8>>(harvest); + return; +#ifdef __SIZEOF_INT128__ + case 16: + if constexpr (HasCppTypeFor<TypeCategory::Unsigned, 16>) { + GenerateUnsigned<CppTypeFor<TypeCategory::Unsigned, 16>>(harvest); + return; + } + break; #endif } - break; + terminator.Crash( + "not yet implemented: intrinsic: UNSIGNED(KIND=%d) in RANDOM_NUMBER", + kind); } - terminator.Crash( - "not yet implemented: intrinsic: REAL(KIND=%d) in RANDOM_NUMBER", kind); } void RTNAME(RandomSeedSize)( diff --git a/flang/runtime/reduce.cpp b/flang/runtime/reduce.cpp index 8fc0bb8..6c42c5e 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 2a85595..b20b036 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 074a270..a8fcde7 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, @@ -116,7 +120,9 @@ void RTDEF(IAllDim)(Descriptor &result, const Descriptor &x, int dim, Terminator terminator{source, line}; auto catKind{x.type().GetCategoryAndKind()}; RUNTIME_CHECK(terminator, - catKind.has_value() && catKind->first == TypeCategory::Integer); + catKind.has_value() && + (catKind->first == TypeCategory::Integer || + catKind->first == TypeCategory::Unsigned)); PartialIntegerReduction<IntegerAndAccumulator>( result, x, dim, catKind->second, mask, "IALL", terminator); } @@ -124,29 +130,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, @@ -154,7 +164,9 @@ void RTDEF(IAnyDim)(Descriptor &result, const Descriptor &x, int dim, Terminator terminator{source, line}; auto catKind{x.type().GetCategoryAndKind()}; RUNTIME_CHECK(terminator, - catKind.has_value() && catKind->first == TypeCategory::Integer); + catKind.has_value() && + (catKind->first == TypeCategory::Integer || + catKind->first == TypeCategory::Unsigned)); PartialIntegerReduction<IntegerOrAccumulator>( result, x, dim, catKind->second, mask, "IANY", terminator); } @@ -162,33 +174,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, @@ -196,7 +208,9 @@ void RTDEF(IParityDim)(Descriptor &result, const Descriptor &x, int dim, Terminator terminator{source, line}; auto catKind{x.type().GetCategoryAndKind()}; RUNTIME_CHECK(terminator, - catKind.has_value() && catKind->first == TypeCategory::Integer); + catKind.has_value() && + (catKind->first == TypeCategory::Integer || + catKind->first == TypeCategory::Unsigned)); PartialIntegerReduction<IntegerXorAccumulator>( result, x, dim, catKind->second, mask, "IPARITY", terminator); } diff --git a/flang/runtime/sum.cpp b/flang/runtime/sum.cpp index 10b8124..3cb7a2b 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 dc12e5c..3fe3283 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); } } @@ -396,9 +396,26 @@ GetResultType(TypeCategory xCat, int xKind, TypeCategory yCat, int yKind) { break; } break; + case TypeCategory::Unsigned: + switch (yCat) { + case TypeCategory::Unsigned: + return std::make_pair(TypeCategory::Unsigned, maxKind); + case TypeCategory::Real: + case TypeCategory::Complex: +#if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T) + if (xKind == 16) { + break; + } +#endif + return std::make_pair(yCat, yKind); + default: + break; + } + break; case TypeCategory::Real: switch (yCat) { case TypeCategory::Integer: + case TypeCategory::Unsigned: #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T) if (yKind == 16) { break; @@ -415,6 +432,7 @@ GetResultType(TypeCategory xCat, int xKind, TypeCategory yCat, int yKind) { case TypeCategory::Complex: switch (yCat) { case TypeCategory::Integer: + case TypeCategory::Unsigned: #if !(defined __SIZEOF_INT128__ && !AVOID_NATIVE_UINT128_T) if (yKind == 16) { break; diff --git a/flang/runtime/type-code.cpp b/flang/runtime/type-code.cpp index cb1b944..d694898 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 cb18c56..d4daa72 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 0000000..719bdcc --- /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 11d3b13..ac72c53 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 4d70e1e..bbc5475 100644 --- a/flang/test/Lower/allocatable-polymorphic.f90 +++ b/flang/test/Lower/allocatable-polymorphic.f90 @@ -393,7 +393,7 @@ contains ! 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 0000000..f61f106 --- /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/complex01.f90 b/flang/test/Semantics/complex01.f90 index f28ffe1..c9d408e 100644 --- a/flang/test/Semantics/complex01.f90 +++ b/flang/test/Semantics/complex01.f90 @@ -26,8 +26,8 @@ subroutine s() !ERROR: must be a constant !ERROR: must be a constant complex :: cvar10 = (rvar, ivar) - !ERROR: operands must be INTEGER or REAL + !ERROR: operands must be INTEGER, UNSIGNED, REAL, or BOZ complex :: cvar11 = (cconst, 1.0) - !ERROR: operands must be INTEGER or REAL + !ERROR: operands must be INTEGER, UNSIGNED, REAL, or BOZ complex :: cvar12 = (lconst, 1.0) end subroutine s diff --git a/flang/test/Semantics/typeinfo01.f90 b/flang/test/Semantics/typeinfo01.f90 index 0d381f1..454d730 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 @@ module m06 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 7509070..689cf46 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 0000000..24d6460 --- /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 a6152d3..1bf7fa1 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 |