Index: flang/include/flang/Common/Fortran-features.h =================================================================== --- flang/include/flang/Common/Fortran-features.h +++ 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, Index: flang/include/flang/Common/Fortran.h =================================================================== --- flang/include/flang/Common/Fortran.h +++ 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 || Index: flang/include/flang/Parser/dump-parse-tree.h =================================================================== --- flang/include/flang/Parser/dump-parse-tree.h +++ 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) Index: flang/include/flang/Parser/parse-tree.h =================================================================== --- flang/include/flang/Parser/parse-tree.h +++ 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 Index: flang/include/flang/Semantics/semantics.h =================================================================== --- flang/include/flang/Semantics/semantics.h +++ 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_; Index: flang/include/flang/Semantics/type.h =================================================================== --- flang/include/flang/Semantics/type.h +++ 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_; Index: flang/lib/Evaluate/type.cpp =================================================================== --- flang/lib/Evaluate/type.cpp +++ 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_); Index: flang/lib/Lower/Bridge.cpp =================================================================== --- flang/lib/Lower/Bridge.cpp +++ 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( Index: flang/lib/Lower/CallInterface.cpp =================================================================== --- flang/lib/Lower/CallInterface.cpp +++ 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); Index: flang/lib/Lower/ConvertType.cpp =================================================================== --- flang/lib/Lower/ConvertType.cpp +++ 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); Index: flang/lib/Parser/Fortran-parsers.cpp =================================================================== --- flang/lib/Parser/Fortran-parsers.cpp +++ 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))) Index: flang/lib/Parser/type-parsers.h =================================================================== --- flang/lib/Parser/type-parsers.h +++ 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_ Index: flang/lib/Parser/unparse.cpp =================================================================== --- flang/lib/Parser/unparse.cpp +++ 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"); } Index: flang/lib/Semantics/resolve-names-utils.cpp =================================================================== --- flang/lib/Semantics/resolve-names-utils.cpp +++ 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) Index: flang/lib/Semantics/resolve-names.cpp =================================================================== --- flang/lib/Semantics/resolve-names.cpp +++ flang/lib/Semantics/resolve-names.cpp @@ -934,6 +934,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 &); @@ -995,6 +997,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(); @@ -1079,6 +1083,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 &); @@ -4585,10 +4590,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)); @@ -4649,6 +4658,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; Index: flang/lib/Semantics/semantics.cpp =================================================================== --- flang/lib/Semantics/semantics.cpp +++ 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(); } } Index: flang/module/__fortran_ppc_types.f90 =================================================================== --- /dev/null +++ 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 Index: flang/tools/f18/CMakeLists.txt =================================================================== --- flang/tools/f18/CMakeLists.txt +++ 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")