diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -36,7 +36,7 @@ ForwardRefImplicitNone, OpenAccessAppend, BOZAsDefaultInteger, DistinguishableSpecifics, DefaultSave, PointerInSeqType, NonCharacterFormat, SaveMainProgram, SaveBigMainProgramVariables, - DistinctArrayConstructorLengths) + DistinctArrayConstructorLengths, PPCVector) // Portability and suspicious usage warnings for conforming code ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h --- a/flang/include/flang/Common/Fortran.h +++ b/flang/include/flang/Common/Fortran.h @@ -21,6 +21,7 @@ // Fortran has five kinds of intrinsic data types, plus the derived types. ENUM_CLASS(TypeCategory, Integer, Real, Complex, Character, Logical, Derived) +ENUM_CLASS(VectorElementCategory, Integer, Unsigned, Real) constexpr bool IsNumericTypeCategory(TypeCategory category) { return category == TypeCategory::Integer || category == TypeCategory::Real || diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -715,11 +715,17 @@ NODE(Union, EndUnionStmt) NODE(Union, UnionStmt) NODE(parser, UnlockStmt) + NODE(parser, UnsignedTypeSpec) NODE(parser, UseStmt) NODE_ENUM(UseStmt, ModuleNature) NODE(parser, Value) NODE(parser, ValueStmt) NODE(parser, Variable) + NODE(parser, VectorTypeSpec) + NODE(VectorTypeSpec, PairVectorTypeSpec) + NODE(VectorTypeSpec, QuadVectorTypeSpec) + NODE(parser, IntrinsicVectorTypeSpec) + NODE(parser, VectorElementType) NODE(parser, Verbatim) NODE(parser, Volatile) NODE(parser, VolatileStmt) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -708,6 +708,21 @@ u; }; +// Extension: Vector type +WRAPPER_CLASS(UnsignedTypeSpec, std::optional); +struct VectorElementType { + UNION_CLASS_BOILERPLATE(VectorElementType); + std::variant u; +}; +WRAPPER_CLASS(IntrinsicVectorTypeSpec, VectorElementType); +struct VectorTypeSpec { + UNION_CLASS_BOILERPLATE(VectorTypeSpec); + EMPTY_CLASS(PairVectorTypeSpec); + EMPTY_CLASS(QuadVectorTypeSpec); + std::variant + u; +}; + // R755 type-param-spec -> [keyword =] type-param-value struct TypeParamSpec { TUPLE_CLASS_BOILERPLATE(TypeParamSpec); @@ -748,7 +763,9 @@ EMPTY_CLASS(ClassStar); EMPTY_CLASS(TypeStar); WRAPPER_CLASS(Record, Name); - std::variant u; + std::variant + u; }; // R709 kind-param -> digit-string | scalar-int-constant-name diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -215,7 +215,9 @@ void UseFortranBuiltinsModule(); const Scope *GetBuiltinsScope() const { return builtinsScope_; } + void UsePPCFortranBuiltinTypesModule(); void UsePPCFortranBuiltinsModule(); + Scope *GetPPCBuiltinTypesScope() { return ppcBuiltinTypesScope_; } const Scope *GetPPCBuiltinsScope() const { return ppcBuiltinsScope_; } // Saves a module file's parse tree so that it remains available @@ -278,6 +280,7 @@ UnorderedSymbolSet errorSymbols_; std::set tempNames_; const Scope *builtinsScope_{nullptr}; // module __Fortran_builtins + Scope *ppcBuiltinTypesScope_{nullptr}; // module __Fortran_PPC_types const Scope *ppcBuiltinsScope_{nullptr}; // module __Fortran_PPC_intrinsics std::list modFileParseTrees_; std::unique_ptr commonBlockMap_; diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h --- a/flang/include/flang/Semantics/type.h +++ b/flang/include/flang/Semantics/type.h @@ -249,6 +249,8 @@ // The name may not match the symbol's name in case of a USE rename. class DerivedTypeSpec { public: + enum class Category { DerivedType, IntrinsicVector, PairVector, QuadVector }; + using RawParameter = std::pair; using RawParameters = std::vector; using ParameterMapType = std::map; @@ -305,6 +307,13 @@ bool Match(const DerivedTypeSpec &) const; std::string AsFortran() const; + Category category() const { return category_; } + void set_category(Category category) { category_ = category; } + bool IsVectorType() const { + return category_ == Category::IntrinsicVector || + category_ == Category::PairVector || category_ == Category::QuadVector; + } + private: SourceName name_; const Symbol &typeSymbol_; @@ -314,6 +323,7 @@ bool instantiated_{false}; RawParameters rawParameters_; ParameterMapType parameters_; + Category category_{Category::DerivedType}; bool RawEquals(const DerivedTypeSpec &that) const { return &typeSymbol_ == &that.typeSymbol_ && cooked_ == that.cooked_ && rawParameters_ == that.rawParameters_; diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -152,8 +152,21 @@ std::size_t DynamicType::GetAlignment( const TargetCharacteristics &targetCharacteristics) const { if (category_ == TypeCategory::Derived) { - if (derived_ && derived_->scope()) { - return derived_->scope()->alignment().value_or(1); + switch (GetDerivedTypeSpec().category()) { + SWITCH_COVERS_ALL_CASES + case semantics::DerivedTypeSpec::Category::DerivedType: + if (derived_ && derived_->scope()) { + return derived_->scope()->alignment().value_or(1); + } + break; + case semantics::DerivedTypeSpec::Category::IntrinsicVector: + case semantics::DerivedTypeSpec::Category::PairVector: + case semantics::DerivedTypeSpec::Category::QuadVector: + if (derived_ && derived_->scope()) { + return derived_->scope()->size(); + } else { + common::die("Missing scope for Vector type."); + } } } else { return targetCharacteristics.GetAlignment(category_, kind_); diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3388,7 +3388,10 @@ // Scalar assignment const bool isNumericScalar = isNumericScalarCategory(lhsType->category()); - fir::ExtendedValue rhs = isNumericScalar + const bool isVector = + isDerivedCategory(lhsType->category()) && + lhsType->GetDerivedTypeSpec().IsVectorType(); + fir::ExtendedValue rhs = (isNumericScalar || isVector) ? genExprValue(assign.rhs, stmtCtx) : genExprAddr(assign.rhs, stmtCtx); const bool lhsIsWholeAllocatable = @@ -3436,7 +3439,7 @@ return genExprAddr(assign.lhs, stmtCtx); }(); - if (isNumericScalar) { + if (isNumericScalar || isVector) { // Fortran 2018 10.2.1.3 p8 and p9 // Conversions should have been inserted by semantic analysis, // but they can be incorrect between the rhs and lhs. Correct @@ -3450,7 +3453,8 @@ // conversion to the actual type. mlir::Type toTy = genType(assign.lhs); mlir::Value cast = - builder->convertWithSemantics(loc, toTy, val); + isVector ? val + : builder->convertWithSemantics(loc, toTy, val); if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) { assert(isFuncResultDesignator(assign.lhs) && "type mismatch"); addr = builder->createConvert( diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp --- a/flang/lib/Lower/CallInterface.cpp +++ b/flang/lib/Lower/CallInterface.cpp @@ -788,10 +788,12 @@ } } else if (dynamicType.category() == Fortran::common::TypeCategory::Derived) { - // Derived result need to be allocated by the caller and the result value - // must be saved. Derived type in implicit interface cannot have length - // parameters. - setSaveResult(); + if (!dynamicType.GetDerivedTypeSpec().IsVectorType()) { + // Derived result need to be allocated by the caller and the result + // value must be saved. Derived type in implicit interface cannot have + // length parameters. + setSaveResult(); + } mlir::Type mlirType = translateDynamicType(dynamicType); addFirResult(mlirType, FirPlaceHolder::resultEntityPosition, Property::Value); diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -23,6 +23,8 @@ #define DEBUG_TYPE "flang-lower-type" +using Fortran::common::VectorElementCategory; + //===--------------------------------------------------------------------===// // Intrinsic type translation helpers //===--------------------------------------------------------------------===// @@ -53,20 +55,25 @@ return Fortran::evaluate::Type::Scalar::bits; } -static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind) { +static mlir::Type genIntegerType(mlir::MLIRContext *context, int kind, + bool isUnsigned = false) { if (Fortran::evaluate::IsValidKindOfIntrinsicType( Fortran::common::TypeCategory::Integer, kind)) { + mlir::IntegerType::SignednessSemantics signedness = + (isUnsigned ? mlir::IntegerType::SignednessSemantics::Unsigned + : mlir::IntegerType::SignednessSemantics::Signless); + switch (kind) { case 1: - return mlir::IntegerType::get(context, getIntegerBits<1>()); + return mlir::IntegerType::get(context, getIntegerBits<1>(), signedness); case 2: - return mlir::IntegerType::get(context, getIntegerBits<2>()); + return mlir::IntegerType::get(context, getIntegerBits<2>(), signedness); case 4: - return mlir::IntegerType::get(context, getIntegerBits<4>()); + return mlir::IntegerType::get(context, getIntegerBits<4>(), signedness); case 8: - return mlir::IntegerType::get(context, getIntegerBits<8>()); + return mlir::IntegerType::get(context, getIntegerBits<8>(), signedness); case 16: - return mlir::IntegerType::get(context, getIntegerBits<16>()); + return mlir::IntegerType::get(context, getIntegerBits<16>(), signedness); } } llvm_unreachable("INTEGER kind not translated"); @@ -308,6 +315,56 @@ return false; } + mlir::Type genVectorType(const Fortran::semantics::DerivedTypeSpec &tySpec) { + assert(tySpec.scope() && "Missing scope for Vector type"); + auto vectorSize{tySpec.scope()->size()}; + switch (tySpec.category()) { + SWITCH_COVERS_ALL_CASES + case (Fortran::semantics::DerivedTypeSpec::Category::IntrinsicVector): { + int64_t vecElemKind; + int64_t vecElemCategory; + + for (const auto &pair : tySpec.parameters()) { + if (pair.first == "element_category") { + vecElemCategory = + Fortran::evaluate::ToInt64(pair.second.GetExplicit()) + .value_or(-1); + } else if (pair.first == "element_kind") { + vecElemKind = + Fortran::evaluate::ToInt64(pair.second.GetExplicit()).value_or(0); + } + } + + assert((vecElemCategory >= 0 && + static_cast(vecElemCategory) < + Fortran::common::VectorElementCategory_enumSize) && + "Vector element type is not specified"); + assert(vecElemKind && "Vector element kind is not specified"); + + int64_t numOfElements = vectorSize / vecElemKind; + switch (static_cast(vecElemCategory)) { + SWITCH_COVERS_ALL_CASES + case VectorElementCategory::Integer: + return fir::VectorType::get(numOfElements, + genIntegerType(context, vecElemKind)); + case VectorElementCategory::Unsigned: + return fir::VectorType::get(numOfElements, + genIntegerType(context, vecElemKind, true)); + case VectorElementCategory::Real: + return fir::VectorType::get(numOfElements, + genRealType(context, vecElemKind)); + } + break; + } + case (Fortran::semantics::DerivedTypeSpec::Category::PairVector): + case (Fortran::semantics::DerivedTypeSpec::Category::QuadVector): + return fir::VectorType::get(vectorSize * 8, + mlir::IntegerType::get(context, 1)); + case (Fortran::semantics::DerivedTypeSpec::Category::DerivedType): + Fortran::common::die("Vector element type not implemented"); + } + } + mlir::Type genDerivedType(const Fortran::semantics::DerivedTypeSpec &tySpec) { std::vector> ps; std::vector> cs; @@ -315,6 +372,10 @@ if (mlir::Type ty = getTypeIfDerivedAlreadyInConstruction(typeSymbol)) return ty; + if (tySpec.IsVectorType()) { + return genVectorType(tySpec); + } + auto rec = fir::RecordType::get(context, converter.mangleName(tySpec)); // Maintain the stack of types for recursive references. derivedTypeInConstruction.emplace_back(typeSymbol, rec); diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -191,7 +191,8 @@ // the structure includes the surrounding slashes to avoid // name clashes. construct( - "RECORD" >> sourced("/" >> name / "/"))))) + "RECORD" >> sourced("/" >> name / "/")))) || + construct(vectorTypeSpec)) // R704 intrinsic-type-spec -> // integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION | @@ -218,6 +219,28 @@ construct(construct( "BYTE" >> construct>(pure(1))))))) +// Extension: Vector type +// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD +TYPE_CONTEXT_PARSER("vector type spec"_en_US, + extension( + "nonstandard usage: Vector type"_port_en_US, + first(construct(intrinsicVectorTypeSpec), + construct("__VECTOR_PAIR" >> + construct()), + construct("__VECTOR_QUAD" >> + construct())))) + +// VECTOR(integer-type-spec) | VECTOR(real-type-spec) | +// VECTOR(unsigend-type-spec) | +TYPE_PARSER(construct("VECTOR" >> + parenthesized(construct(integerTypeSpec) || + construct(unsignedTypeSpec) || + construct(construct( + "REAL" >> maybe(kindSelector)))))) + +// UNSIGNED type +TYPE_PARSER(construct("UNSIGNED" >> maybe(kindSelector))) + // R705 integer-type-spec -> INTEGER [kind-selector] TYPE_PARSER(construct("INTEGER" >> maybe(kindSelector))) diff --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h --- a/flang/lib/Parser/type-parsers.h +++ b/flang/lib/Parser/type-parsers.h @@ -137,5 +137,8 @@ constexpr Parser openmpConstruct; constexpr Parser openmpDeclarativeConstruct; constexpr Parser ompEndLoopDirective; +constexpr Parser intrinsicVectorTypeSpec; // Extension +constexpr Parser vectorTypeSpec; // Extension +constexpr Parser unsignedTypeSpec; // Extension } // namespace Fortran::parser #endif // FORTRAN_PARSER_TYPE_PARSERS_H_ diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -161,6 +161,15 @@ void Post(const IntrinsicTypeSpec::DoubleComplex &) { Word("DOUBLE COMPLEX"); } + void Before(const UnsignedTypeSpec &) { Word("UNSIGNED"); } + void Before(const IntrinsicVectorTypeSpec &) { Word("VECTOR("); } + void Post(const IntrinsicVectorTypeSpec &) { Put(')'); } + void Post(const VectorTypeSpec::PairVectorTypeSpec &) { + Word("__VECTOR_PAIR"); + } + void Post(const VectorTypeSpec::QuadVectorTypeSpec &) { + Word("__VECTOR_QUAD"); + } void Before(const IntegerTypeSpec &) { // R705 Word("INTEGER"); } diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp --- a/flang/lib/Semantics/resolve-names-utils.cpp +++ b/flang/lib/Semantics/resolve-names-utils.cpp @@ -614,7 +614,8 @@ msg = "Variable '%s' in common block with BIND attribute" " is not allowed in an equivalence set"_err_en_US; } else if (const auto *type{symbol.GetType()}) { - if (const auto *derived{type->AsDerived()}) { + const auto *derived{type->AsDerived()}; + if (derived && !derived->IsVectorType()) { if (const auto *comp{FindUltimateComponent( *derived, IsAllocatableOrPointer)}) { // C8106 msg = IsPointer(*comp) diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -942,6 +942,8 @@ void Post(const parser::CharLength &); void Post(const parser::LengthSelector &); bool Pre(const parser::KindParam &); + bool Pre(const parser::VectorTypeSpec &); + void Post(const parser::VectorTypeSpec &); bool Pre(const parser::DeclarationTypeSpec::Type &); void Post(const parser::DeclarationTypeSpec::Type &); bool Pre(const parser::DeclarationTypeSpec::Class &); @@ -1003,6 +1005,8 @@ void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &); const parser::Name *ResolveDesignator(const parser::Designator &); + int GetVectorElementKind( + TypeCategory category, const std::optional &kind); protected: bool BeginDecl(); @@ -1087,6 +1091,7 @@ // to warn about use of the implied DO intex therein. std::optional checkIndexUseInOwnBounds_; bool hasBindCName_{false}; + bool isVectorType_{false}; bool HandleAttributeStmt(Attr, const std::list &); Symbol &HandleAttributeStmt(Attr, const parser::Name &); @@ -4621,10 +4626,14 @@ } void DeclarationVisitor::Post(const parser::IntegerTypeSpec &x) { - SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); + if (!isVectorType_) { + SetDeclTypeSpec(MakeNumericType(TypeCategory::Integer, x.v)); + } } void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Real &x) { - SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); + if (!isVectorType_) { + SetDeclTypeSpec(MakeNumericType(TypeCategory::Real, x.kind)); + } } void DeclarationVisitor::Post(const parser::IntrinsicTypeSpec::Complex &x) { SetDeclTypeSpec(MakeNumericType(TypeCategory::Complex, x.kind)); @@ -4685,6 +4694,114 @@ return false; } +int DeclarationVisitor::GetVectorElementKind( + TypeCategory category, const std::optional &kind) { + KindExpr value{GetKindParamExpr(category, kind)}; + if (auto known{evaluate::ToInt64(value)}) { + return static_cast(*known); + } + common::die("Vector element kind must be known at compile-time"); +} + +bool DeclarationVisitor::Pre(const parser::VectorTypeSpec &) { + isVectorType_ = true; + return true; +} +// Create semantic::DerivedTypeSpec for Vector types here. +void DeclarationVisitor::Post(const parser::VectorTypeSpec &x) { + llvm::StringRef typeName; + llvm::SmallVector typeParams; + DerivedTypeSpec::Category vectorCategory; + + isVectorType_ = false; + common::visit( + common::visitors{ + [&](const parser::IntrinsicVectorTypeSpec &y) { + vectorCategory = DerivedTypeSpec::Category::IntrinsicVector; + int vecElemKind = 0; + typeName = "__builtin_ppc_intrinsic_vector"; + common::visit( + common::visitors{ + [&](const parser::IntegerTypeSpec &z) { + vecElemKind = GetVectorElementKind( + TypeCategory::Integer, std::move(z.v)); + typeParams.push_back(ParamValue( + static_cast( + common::VectorElementCategory::Integer), + common::TypeParamAttr::Kind)); + }, + [&](const parser::IntrinsicTypeSpec::Real &z) { + vecElemKind = GetVectorElementKind( + TypeCategory::Real, std::move(z.kind)); + typeParams.push_back( + ParamValue(static_cast( + common::VectorElementCategory::Real), + common::TypeParamAttr::Kind)); + }, + [&](const parser::UnsignedTypeSpec &z) { + vecElemKind = GetVectorElementKind( + TypeCategory::Integer, std::move(z.v)); + typeParams.push_back(ParamValue( + static_cast( + common::VectorElementCategory::Unsigned), + common::TypeParamAttr::Kind)); + }, + }, + y.v.u); + typeParams.push_back( + ParamValue(static_cast(vecElemKind), + common::TypeParamAttr::Kind)); + }, + [&](const parser::VectorTypeSpec::PairVectorTypeSpec &y) { + vectorCategory = DerivedTypeSpec::Category::PairVector; + typeName = "__builtin_ppc_pair_vector"; + }, + [&](const parser::VectorTypeSpec::QuadVectorTypeSpec &y) { + vectorCategory = DerivedTypeSpec::Category::QuadVector; + typeName = "__builtin_ppc_quad_vector"; + }, + }, + x.u); + + auto ppcBuiltinTypesScope = currScope().context().GetPPCBuiltinTypesScope(); + if (!ppcBuiltinTypesScope) { + common::die("INTERNAL: The __fortran_ppc_types module was not found "); + } + + auto iter{ppcBuiltinTypesScope->find( + semantics::SourceName{typeName.data(), typeName.size()})}; + if (iter == ppcBuiltinTypesScope->cend()) { + common::die("INTERNAL: The __fortran_ppc_types module does not define " + "the type '%s'", + typeName.data()); + } + + const semantics::Symbol &typeSymbol{*iter->second}; + DerivedTypeSpec vectorDerivedType{typeName.data(), typeSymbol}; + vectorDerivedType.set_category(vectorCategory); + if (typeParams.size()) { + vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[0])); + vectorDerivedType.AddRawParamValue(nullptr, std::move(typeParams[1])); + vectorDerivedType.CookParameters(GetFoldingContext()); + } + + if (const DeclTypeSpec * + extant{ppcBuiltinTypesScope->FindInstantiatedDerivedType( + vectorDerivedType, DeclTypeSpec::Category::TypeDerived)}) { + // This derived type and parameter expressions (if any) are already present + // in the __fortran_ppc_intrinsics scope. + SetDeclTypeSpec(*extant); + } else { + DeclTypeSpec &type{ppcBuiltinTypesScope->MakeDerivedType( + DeclTypeSpec::Category::TypeDerived, std::move(vectorDerivedType))}; + DerivedTypeSpec &derived{type.derivedTypeSpec()}; + auto restorer{ + GetFoldingContext().messages().SetLocation(currStmtSource().value())}; + derived.Instantiate(*ppcBuiltinTypesScope); + SetDeclTypeSpec(type); + } +} + bool DeclarationVisitor::Pre(const parser::DeclarationTypeSpec::Type &) { CHECK(GetDeclTypeSpecCategory() == DeclTypeSpec::Category::TypeDerived); return true; diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -470,6 +470,12 @@ } } +void SemanticsContext::UsePPCFortranBuiltinTypesModule() { + if (ppcBuiltinTypesScope_ == nullptr) { + ppcBuiltinTypesScope_ = GetBuiltinModule("__fortran_ppc_types"); + } +} + void SemanticsContext::UsePPCFortranBuiltinsModule() { if (ppcBuiltinsScope_ == nullptr) { ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics"); @@ -492,7 +498,10 @@ .statement.v.source == "__fortran_builtins" || std::get>( frontModule->value().t) - .statement.v.source == "__fortran_ppc_intrinsics")) { + .statement.v.source == "__fortran_ppc_intrinsics" || + std::get>( + frontModule->value().t) + .statement.v.source == "__fortran_ppc_types")) { // Don't try to read the builtins module when we're actually building it. } else { context_.UseFortranBuiltinsModule(); @@ -500,6 +509,7 @@ llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))}; // Only use __Fortran_PPC_intrinsics module when targetting PowerPC arch if (targetTriple.isPPC()) { + context_.UsePPCFortranBuiltinTypesModule(); context_.UsePPCFortranBuiltinsModule(); } } diff --git a/flang/module/__fortran_ppc_types.f90 b/flang/module/__fortran_ppc_types.f90 new file mode 100644 --- /dev/null +++ b/flang/module/__fortran_ppc_types.f90 @@ -0,0 +1,33 @@ +!===-- module/__fortran_ppc_types.f90----- ---------------------------------===! +! +! 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 +! +!===------------------------------------------------------------------------===! + +module __Fortran_PPC_types + private + ! Definition of derived-types that represent PowerPC vector types. + type __builtin_ppc_intrinsic_vector(element_category, element_kind) + integer, kind :: element_category, element_kind + integer(16) :: storage + end type + + type __builtin_ppc_pair_vector + integer(16) :: storage1 + integer(16) :: storage2 + end type + + type __builtin_ppc_quad_vector + integer(16) :: storage1 + integer(16) :: storage2 + integer(16) :: storage3 + integer(16) :: storage4 + end type + + public :: __builtin_ppc_intrinsic_vector + public :: __builtin_ppc_pair_vector + public :: __builtin_ppc_quad_vector + +end module __Fortran_PPC_types diff --git a/flang/test/Lower/ppc-vector-types.f90 b/flang/test/Lower/ppc-vector-types.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/ppc-vector-types.f90 @@ -0,0 +1,181 @@ +! RUN: %flang_fc1 -emit-fir -o - %s | FileCheck %s -check-prefix=CHECK-FIR +! RUN: %flang_fc1 -emit-llvm -o - %s | FileCheck %s -check-prefix=CHECK-LLVM +! REQUIRES: target=powerpc{{.*}} + +! CHECK-FIR-LABEL: func.func @_QQmain() +! CHECK-LLVM-LABEL: define void @_QQmain + program ppc_vec_unit + implicit none + ! CHECK-FIR-DAG: %[[VI1:.*]] = fir.alloca !fir.vector<4:i32> {bindc_name = "vi1", uniq_name = "_QFEvi1"} + ! CHECK-FIR-DAG: %[[VI2:.*]] = fir.alloca !fir.vector<4:i32> {bindc_name = "vi2", uniq_name = "_QFEvi2"} + + ! CHECK-LLVM-DAG: %[[VI1:.*]] = alloca <4 x i32>, i64 1, align 16 + ! CHECK-LLVM-DAG: %[[VI2:.*]] = alloca <4 x i32>, i64 1, align 16 + vector(integer(4)) :: vi1, vi2 + + ! CHECK-FIR-DAG: %[[VR1:.*]] = fir.alloca !fir.vector<2:f64> {bindc_name = "vr1", uniq_name = "_QFEvr1"} + ! CHECK-FIR-DAG: %[[VR2:.*]] = fir.alloca !fir.vector<2:f64> {bindc_name = "vr2", uniq_name = "_QFEvr2"} + + ! CHECK-LLVM-DAG: %[[VR1:.*]] = alloca <2 x double>, i64 1, align 16 + ! CHECK-LLVM-DAG: %[[VR2:.*]] = alloca <2 x double>, i64 1, align 16 + vector(real(8)) :: vr1, vr2 + + ! CHECK-FIR-DAG: %[[VU1:.*]] = fir.alloca !fir.vector<8:ui16> {bindc_name = "vu1", uniq_name = "_QFEvu1"} + ! CHECK-FIR-DAG: %[[VU2:.*]] = fir.alloca !fir.vector<8:ui16> {bindc_name = "vu2", uniq_name = "_QFEvu2"} + + ! CHECK-LLVM-DAG: %[[VU1:.*]] = alloca <8 x i16>, i64 1, align 16 + ! CHECK-LLVM-DAG: %[[VU2:.*]] = alloca <8 x i16>, i64 1, align 16 + vector(unsigned(2)) :: vu1, vu2 + + ! CHECK-FIR-DAG: %[[VP1:.*]] = fir.alloca !fir.vector<256:i1> {bindc_name = "vp1", uniq_name = "_QFEvp1"} + ! CHECK-FIR-DAG: %[[VP2:.*]] = fir.alloca !fir.vector<256:i1> {bindc_name = "vp2", uniq_name = "_QFEvp2"} + + ! CHECK-LLVM-DAG: %[[VP1:.*]] = alloca <256 x i1>, i64 1, align 32 + ! CHECK-LLVM-DAG: %[[VP2:.*]] = alloca <256 x i1>, i64 1, align 32 + __vector_pair :: vp1, vp2 + + ! CHECK-FIR-DAG: %[[VQ1:.*]] = fir.address_of(@_QFEvq1) : !fir.ref> + ! CHECK-FIR-DAG: %[[VQ2:.*]] = fir.address_of(@_QFEvq2) : !fir.ref> + __vector_quad :: vq1, vq2 + + ! CHECK-FIR: %[[RESI:.*]] = fir.call @_QFPtest_vec_integer_assign(%[[VI1]]){{.*}}: (!fir.ref>) -> !fir.vector<4:i32> + ! CHECK-LLVM: %[[RESI:.*]] = call <4 x i32> @_QFPtest_vec_integer_assign(ptr %[[VI1]]) + vi2 = test_vec_integer_assign(vi1) + ! CHECK-FIR-NEXT: fir.store %[[RESI]] to %[[VI2]] : !fir.ref> + ! CHECK-LLVM-NEXT: store <4 x i32> %[[RESI]], ptr %[[VI2]], align 16 + + ! CHECK-FIR-NEXT: %[[RESR:.*]] = fir.call @_QFPtest_vec_real_assign(%[[VR1]]){{.*}}: (!fir.ref>) -> !fir.vector<2:f64> + ! CHECK-LLVM-NEXT: %[[RESR:.*]] = call {{.*}}<2 x double> @_QFPtest_vec_real_assign(ptr %[[VR1]]) + vr2 = test_vec_real_assign(vr1) + ! CHECK-FIR-NEXT: fir.store %[[RESR]] to %[[VR2]] : !fir.ref> + ! CHECK-LLVM-NEXT: store <2 x double> %[[RESR]], ptr %[[VR2]], align 16 + + ! CHECK-FIR-NEXT: %[[RESU:.*]] = fir.call @_QFPtest_vec_unsigned_assign(%[[VU1]]){{.*}}: (!fir.ref>) -> !fir.vector<8:ui16> + ! CHECK-LLVM-NEXT: %[[RESU:.*]] = call <8 x i16> @_QFPtest_vec_unsigned_assign(ptr %[[VU1]]) + vu2 = test_vec_unsigned_assign(vu1) + ! CHECK-FIR-NEXT: fir.store %[[RESU]] to %[[VU2]] : !fir.ref> + ! CHECK-LLVM-NEXT: store <8 x i16> %[[RESU]], ptr %[[VU2]], align 16 + + ! CHECK-FIR-NEXT: %[[RESP:.*]] = fir.call @_QFPtest_vec_pair_assign(%[[VP1]]){{.*}}: (!fir.ref>) -> !fir.vector<256:i1> + ! CHECK-LLVM-NEXT: %[[RESP:.*]] = call <256 x i1> @_QFPtest_vec_pair_assign(ptr %[[VP1]]) + vp2 = test_vec_pair_assign(vp1) + ! CHECK-FIR-NEXT: fir.store %[[RESP]] to %[[VP2]] : !fir.ref> + ! CHECK-LLVM-NEXT: store <256 x i1> %[[RESP]], ptr %[[VP2]], align 32 + + ! CHECK-FIR-NEXT: %[[RESQ:.*]] = fir.call @_QFPtest_vec_quad_assign(%[[VQ1]]){{.*}}: (!fir.ref>) -> !fir.vector<512:i1> + ! CHECK-LLVM-NEXT: %[[RESQ:.*]] = call <512 x i1> @_QFPtest_vec_quad_assign(ptr @_QFEvq1) + vq2 = test_vec_quad_assign(vq1) + ! CHECK-FIR-NEXT: fir.store %[[RESQ]] to %[[VQ2]] : !fir.ref> + ! CHECK-LLVM-NEXT: store <512 x i1> %[[RESQ]], ptr @_QFEvq2, align 64 + + contains + ! CHECK-FIR-LABEL: func.func @_QFPtest_vec_integer_assign + ! CHECK-LLVM-LABEL: define <4 x i32> @_QFPtest_vec_integer_assign + function test_vec_integer_assign(arg1) + ! CHECK-FIR: %[[FUNC_RES:.*]] = fir.alloca !fir.vector<4:i32> {bindc_name = "test_vec_integer_assign" + ! CHECK-LLVM: %[[FUNC_RES:.*]] = alloca <4 x i32>, i64 1, align 16 + vector(integer(4)) :: arg1, test_vec_integer_assign + + ! CHECK-FIR-NEXT: %[[ARG0:.*]] = fir.load %arg0 : !fir.ref> + ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref> + + ! CHECK-LLVM-NEXT: %[[ARG0:.*]] = load <4 x i32>, ptr %0, align 16 + ! CHECK-LLVM-NEXT: store <4 x i32> %[[ARG0]], ptr %[[FUNC_RES]], align 16 + + test_vec_integer_assign = arg1 + ! CHECK-FIR-NEXT: %[[RET:.*]] = fir.load %[[FUNC_RES]] : !fir.ref> + ! CHECK-FIR-NEXT: return %[[RET]] : !fir.vector<4:i32> + + ! CHECK-LLVM-NEXT: %[[RET:.*]] = load <4 x i32>, ptr %[[FUNC_RES]], align 16 + ! CHECK-LLVM-NEXT: ret <4 x i32> %[[RET]] + end function test_vec_integer_assign + + ! CHECK-FIR-LABEL: func.func @_QFPtest_vec_real_assign + ! CHECK-LLVM-LABEL: define <2 x double> @_QFPtest_vec_real_assign + function test_vec_real_assign(arg1) + ! CHECK-FIR: %[[FUNC_RES:.*]] = fir.alloca !fir.vector<2:f64> {bindc_name = "test_vec_real_assign" + ! CHECK-LLVM: %[[FUNC_RES:.*]] = alloca <2 x double>, i64 1, align 16 + vector(real(8)) :: arg1, test_vec_real_assign + + ! CHECK-FIR-NEXT: %[[ARG0:.*]] = fir.load %arg0 : !fir.ref> + ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref> + + ! CHECK-LLVM-NEXT: %[[ARG0:.*]] = load <2 x double>, ptr %0, align 16 + ! CHECK-LLVM-NEXT: store <2 x double> %[[ARG0]], ptr %[[FUNC_RES]], align 16 + + test_vec_real_assign = arg1 + + ! CHECK-FIR-NEXT: %[[RET:.*]] = fir.load %[[FUNC_RES]] : !fir.ref> + ! CHECK-FIR-NEXT: return %[[RET]] : !fir.vector<2:f64> + + ! CHECK-LLVM-NEXT: %[[RET:.*]] = load <2 x double>, ptr %[[FUNC_RES]], align 16 + ! CHECK-LLVM-NEXT: ret <2 x double> %[[RET]] + end function test_vec_real_assign + + ! CHECK-FIR-LABEL: func.func @_QFPtest_vec_unsigned_assign + ! CHECK-LLVM-LABEL: define <8 x i16> @_QFPtest_vec_unsigned_assign + function test_vec_unsigned_assign(arg1) + ! CHECK-FIR: %[[FUNC_RES:.*]] = fir.alloca !fir.vector<8:ui16> {bindc_name = "test_vec_unsigned_assign" + ! CHECK-LLVM: %[[FUNC_RES:.*]] = alloca <8 x i16>, i64 1, align 16 + vector(unsigned(2)) :: arg1, test_vec_unsigned_assign + + ! CHECK-FIR-NEXT: %[[ARG0:.*]] = fir.load %arg0 : !fir.ref> + ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref> + + ! CHECK-LLVM-NEXT: %[[ARG0:.*]] = load <8 x i16>, ptr %0, align 16 + ! CHECK-LLVM-NEXT: store <8 x i16> %[[ARG0]], ptr %[[FUNC_RES]], align 16 + + test_vec_unsigned_assign = arg1 + + ! CHECK-FIR-NEXT: %[[RET:.*]] = fir.load %[[FUNC_RES]] : !fir.ref> + ! CHECK-FIR-NEXT: return %[[RET]] : !fir.vector<8:ui16> + + ! CHECK-LLVM-NEXT: %[[RET:.*]] = load <8 x i16>, ptr %[[FUNC_RES]], align 16 + ! CHECK-LLVM-NEXT: ret <8 x i16> %[[RET]] + end function test_vec_unsigned_assign + + ! CHECK-FIR-LABEL: func.func @_QFPtest_vec_pair_assign + ! CHECK-LLVM-LABEL: define <256 x i1> @_QFPtest_vec_pair_assign + function test_vec_pair_assign(arg1) + ! CHECK-FIR: %[[FUNC_RES:.*]] = fir.alloca !fir.vector<256:i1> {bindc_name = "test_vec_pair_assign" + ! CHECK-LLVM: %[[FUNC_RES:.*]] = alloca <256 x i1>, i64 1, align 32 + __vector_pair :: arg1, test_vec_pair_assign + + ! CHECK-FIR-NEXT: %[[ARG0:.*]] = fir.load %arg0 : !fir.ref> + ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref> + + ! CHECK-LLVM-NEXT: %[[ARG0:.*]] = load <256 x i1>, ptr %0, align 32 + ! CHECK-LLVM-NEXT: store <256 x i1> %[[ARG0]], ptr %[[FUNC_RES]], align 32 + + test_vec_pair_assign = arg1 + + ! CHECK-FIR-NEXT: %[[RET:.*]] = fir.load %[[FUNC_RES]] : !fir.ref> + ! CHECK-FIR-NEXT: return %[[RET]] : !fir.vector<256:i1> + + ! CHECK-LLVM-NEXT: %[[RET:.*]] = load <256 x i1>, ptr %[[FUNC_RES]], align 32 + ! CHECK-LLVM-NEXT: ret <256 x i1> %[[RET]] + end function test_vec_pair_assign + + ! CHECK-FIR-LABEL: func.func @_QFPtest_vec_quad_assign + ! CHECK-LLVM-LABEL: define <512 x i1> @_QFPtest_vec_quad_assign + function test_vec_quad_assign(arg1) + ! CHECK-FIR: %[[FUNC_RES:.*]] = fir.alloca !fir.vector<512:i1> {bindc_name = "test_vec_quad_assign" + ! CHECK-LLVM: %[[FUNC_RES:.*]] = alloca <512 x i1>, i64 1, align 64 + __vector_quad :: arg1, test_vec_quad_assign + + ! CHECK-FIR-NEXT: %[[ARG0:.*]] = fir.load %arg0 : !fir.ref> + ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref> + + ! CHECK-LLVM-NEXT: %[[ARG0:.*]] = load <512 x i1>, ptr %0, align 64 + ! CHECK-LLVM-NEXT: store <512 x i1> %[[ARG0]], ptr %[[FUNC_RES]], align 64 + + test_vec_quad_assign = arg1 + + ! CHECK-FIR-NEXT: %[[RET:.*]] = fir.load %[[FUNC_RES]] : !fir.ref> + ! CHECK-FIR-NEXT: return %[[RET]] : !fir.vector<512:i1> + + ! CHECK-LLVM-NEXT: %[[RET:.*]] = load <512 x i1>, ptr %[[FUNC_RES]], align 64 + ! CHECK-LLVM-NEXT: ret <512 x i1> %[[RET]] + end function test_vec_quad_assign + + end diff --git a/flang/test/Semantics/ppc-vector-types.f90 b/flang/test/Semantics/ppc-vector-types.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/ppc-vector-types.f90 @@ -0,0 +1,69 @@ +! RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s +! REQUIRES: target=powerpc{{.*}} + + ! CHECK-LABEL: PROGRAM ppc_vec_unit + program ppc_vec_unit + implicit none + ! CHECK: VECTOR(INTEGER(KIND=4_4)) :: vi1, vi2 + vector(integer(4)) :: vi1, vi2 + ! CHECK-NEXT: VECTOR(REAL(KIND=8_4)) :: vr1, vr2 + vector(real(8)) :: vr1, vr2 + ! CHECK-NEXT: VECTOR(UNSIGNED(KIND=2_4)) :: vu1, vu2 + vector(unsigned(2)) :: vu1, vu2 + ! CHECK-NEXT: __VECTOR_PAIR :: vp1, vp2 + __vector_pair :: vp1, vp2 + ! CHECK-NEXT: __VECTOR_QUAD :: vq1, vq2 + __vector_quad :: vq1, vq2 + ! CHECK-NEXT: vi2=test_vec_integer_assign(vi1) + vi2 = test_vec_integer_assign(vi1) + ! CHECK-NEXT: vr2=test_vec_real_assign(vr1) + vr2 = test_vec_real_assign(vr1) + ! CHECK-NEXT: vu2=test_vec_unsigned_assign(vu1) + vu2 = test_vec_unsigned_assign(vu1) + ! CHECK-NEXT: vp2=test_vec_pair_assign(vp1) + vp2 = test_vec_pair_assign(vp1) + ! CHECK-NEXT: vq2=test_vec_quad_assign(vq1) + vq2 = test_vec_quad_assign(vq1) + + contains + ! CHECK-LABEL: FUNCTION test_vec_integer_assign + function test_vec_integer_assign(arg1) + ! CHECK: VECTOR(INTEGER(KIND=4_4)) :: arg1, test_vec_integer_assign + vector(integer(4)) :: arg1, test_vec_integer_assign + ! CHECK-NEXT: test_vec_integer_assign=arg1 + test_vec_integer_assign = arg1 + end function test_vec_integer_assign + + ! CHECK-LABEL: FUNCTION test_vec_real_assign + function test_vec_real_assign(arg1) + ! CHECK: VECTOR(REAL(KIND=8_4)) :: arg1, test_vec_real_assign + vector(real(8)) :: arg1, test_vec_real_assign + ! CHECK-NEXT: test_vec_real_assign=arg1 + test_vec_real_assign = arg1 + end function test_vec_real_assign + + ! CHECK-LABEL: FUNCTION test_vec_unsigned_assign + function test_vec_unsigned_assign(arg1) + ! CHECK: VECTOR(UNSIGNED(KIND=2_4)) :: arg1, test_vec_unsigned_assign + vector(unsigned(2)) :: arg1, test_vec_unsigned_assign + ! CHECK-NEXT: test_vec_unsigned_assign=arg1 + test_vec_unsigned_assign = arg1 + end function test_vec_unsigned_assign + + ! CHECK-LABEL: FUNCTION test_vec_pair_assign + function test_vec_pair_assign(arg1) + ! CHECK: __VECTOR_PAIR :: arg1, test_vec_pair_assign + __vector_pair :: arg1, test_vec_pair_assign + ! CHECK-NEXT: test_vec_pair_assign=arg1 + test_vec_pair_assign = arg1 + end function test_vec_pair_assign + + ! CHECK-LABEL: FUNCTION test_vec_quad_assign + function test_vec_quad_assign(arg1) + ! CHECK: __VECTOR_QUAD :: arg1, test_vec_quad_assign + __vector_quad :: arg1, test_vec_quad_assign + ! CHECK-NEXT: test_vec_quad_assign=arg1 + test_vec_quad_assign = arg1 + end function test_vec_quad_assign + + end diff --git a/flang/tools/f18/CMakeLists.txt b/flang/tools/f18/CMakeLists.txt --- a/flang/tools/f18/CMakeLists.txt +++ b/flang/tools/f18/CMakeLists.txt @@ -8,6 +8,7 @@ "__fortran_builtins" "__fortran_ieee_exceptions" "__fortran_type_info" + "__fortran_ppc_types" "__fortran_ppc_intrinsics" "ieee_arithmetic" "ieee_exceptions" @@ -28,8 +29,10 @@ set(base ${FLANG_INTRINSIC_MODULES_DIR}/${filename}) if(${filename} STREQUAL "__fortran_builtins") set(depends "") - elseif(${filename} STREQUAL "__fortran_ppc_intrinsics") + elseif(${filename} STREQUAL "__fortran_ppc_types") set(depends "") + elseif(${filename} STREQUAL "__fortran_ppc_intrinsics") + set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_ppc_types.mod) else() set(depends ${FLANG_INTRINSIC_MODULES_DIR}/__fortran_builtins.mod) if(NOT ${filename} STREQUAL "__fortran_type_info")