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,
// 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 ||
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)
u;
};
+// Extension: Vector type
+WRAPPER_CLASS(UnsignedTypeSpec, std::optional<KindSelector>);
+struct VectorElementType {
+ UNION_CLASS_BOILERPLATE(VectorElementType);
+ std::variant<IntegerTypeSpec, IntrinsicTypeSpec::Real, UnsignedTypeSpec> u;
+};
+WRAPPER_CLASS(IntrinsicVectorTypeSpec, VectorElementType);
+struct VectorTypeSpec {
+ UNION_CLASS_BOILERPLATE(VectorTypeSpec);
+ EMPTY_CLASS(PairVectorTypeSpec);
+ EMPTY_CLASS(QuadVectorTypeSpec);
+ std::variant<IntrinsicVectorTypeSpec, PairVectorTypeSpec, QuadVectorTypeSpec>
+ u;
+};
+
// R755 type-param-spec -> [keyword =] type-param-value
struct TypeParamSpec {
TUPLE_CLASS_BOILERPLATE(TypeParamSpec);
EMPTY_CLASS(ClassStar);
EMPTY_CLASS(TypeStar);
WRAPPER_CLASS(Record, Name);
- std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record> u;
+ std::variant<IntrinsicTypeSpec, Type, Class, ClassStar, TypeStar, Record,
+ VectorTypeSpec>
+ u;
};
// R709 kind-param -> digit-string | scalar-int-constant-name
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
UnorderedSymbolSet errorSymbols_;
std::set<std::string> 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<parser::Program> modFileParseTrees_;
std::unique_ptr<CommonBlockMap> commonBlockMap_;
// 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<const parser::Keyword *, ParamValue>;
using RawParameters = std::vector<RawParameter>;
using ParameterMapType = std::map<SourceName, ParamValue>;
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_;
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_;
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_);
// 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 =
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
// 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(
}
} 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);
#define DEBUG_TYPE "flang-lower-type"
+using Fortran::common::VectorElementCategory;
+
//===--------------------------------------------------------------------===//
// Intrinsic type translation helpers
//===--------------------------------------------------------------------===//
return Fortran::evaluate::Type<Fortran::common::TypeCategory::Integer,
KIND>::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");
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<size_t>(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<VectorElementCategory>(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<std::pair<std::string, mlir::Type>> ps;
std::vector<std::pair<std::string, mlir::Type>> cs;
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);
// the structure includes the surrounding slashes to avoid
// name clashes.
construct<DeclarationTypeSpec::Record>(
- "RECORD" >> sourced("/" >> name / "/")))))
+ "RECORD" >> sourced("/" >> name / "/")))) ||
+ construct<DeclarationTypeSpec>(vectorTypeSpec))
// R704 intrinsic-type-spec ->
// integer-type-spec | REAL [kind-selector] | DOUBLE PRECISION |
construct<IntrinsicTypeSpec>(construct<IntegerTypeSpec>(
"BYTE" >> construct<std::optional<KindSelector>>(pure(1)))))))
+// Extension: Vector type
+// VECTOR(intrinsic-type-spec) | __VECTOR_PAIR | __VECTOR_QUAD
+TYPE_CONTEXT_PARSER("vector type spec"_en_US,
+ extension<LanguageFeature::PPCVector>(
+ "nonstandard usage: Vector type"_port_en_US,
+ first(construct<VectorTypeSpec>(intrinsicVectorTypeSpec),
+ construct<VectorTypeSpec>("__VECTOR_PAIR" >>
+ construct<VectorTypeSpec::PairVectorTypeSpec>()),
+ construct<VectorTypeSpec>("__VECTOR_QUAD" >>
+ construct<VectorTypeSpec::QuadVectorTypeSpec>()))))
+
+// VECTOR(integer-type-spec) | VECTOR(real-type-spec) |
+// VECTOR(unsigend-type-spec) |
+TYPE_PARSER(construct<IntrinsicVectorTypeSpec>("VECTOR" >>
+ parenthesized(construct<VectorElementType>(integerTypeSpec) ||
+ construct<VectorElementType>(unsignedTypeSpec) ||
+ construct<VectorElementType>(construct<IntrinsicTypeSpec::Real>(
+ "REAL" >> maybe(kindSelector))))))
+
+// UNSIGNED type
+TYPE_PARSER(construct<UnsignedTypeSpec>("UNSIGNED" >> maybe(kindSelector)))
+
// R705 integer-type-spec -> INTEGER [kind-selector]
TYPE_PARSER(construct<IntegerTypeSpec>("INTEGER" >> maybe(kindSelector)))
constexpr Parser<OpenMPConstruct> openmpConstruct;
constexpr Parser<OpenMPDeclarativeConstruct> openmpDeclarativeConstruct;
constexpr Parser<OmpEndLoopDirective> ompEndLoopDirective;
+constexpr Parser<IntrinsicVectorTypeSpec> intrinsicVectorTypeSpec; // Extension
+constexpr Parser<VectorTypeSpec> vectorTypeSpec; // Extension
+constexpr Parser<UnsignedTypeSpec> unsignedTypeSpec; // Extension
} // namespace Fortran::parser
#endif // FORTRAN_PARSER_TYPE_PARSERS_H_
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");
}
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)
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 &);
void CheckBindings(const parser::TypeBoundProcedureStmt::WithoutInterface &);
const parser::Name *ResolveDesignator(const parser::Designator &);
+ int GetVectorElementKind(
+ TypeCategory category, const std::optional<parser::KindSelector> &kind);
protected:
bool BeginDecl();
// to warn about use of the implied DO intex therein.
std::optional<SourceName> checkIndexUseInOwnBounds_;
bool hasBindCName_{false};
+ bool isVectorType_{false};
bool HandleAttributeStmt(Attr, const std::list<parser::Name> &);
Symbol &HandleAttributeStmt(Attr, const parser::Name &);
}
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));
return false;
}
+int DeclarationVisitor::GetVectorElementKind(
+ TypeCategory category, const std::optional<parser::KindSelector> &kind) {
+ KindExpr value{GetKindParamExpr(category, kind)};
+ if (auto known{evaluate::ToInt64(value)}) {
+ return static_cast<int>(*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<ParamValue> 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::ConstantSubscript>(
+ 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::ConstantSubscript>(
+ 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::ConstantSubscript>(
+ common::VectorElementCategory::Unsigned),
+ common::TypeParamAttr::Kind));
+ },
+ },
+ y.v.u);
+ typeParams.push_back(
+ ParamValue(static_cast<common::ConstantSubscript>(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;
}
}
+void SemanticsContext::UsePPCFortranBuiltinTypesModule() {
+ if (ppcBuiltinTypesScope_ == nullptr) {
+ ppcBuiltinTypesScope_ = GetBuiltinModule("__fortran_ppc_types");
+ }
+}
+
void SemanticsContext::UsePPCFortranBuiltinsModule() {
if (ppcBuiltinsScope_ == nullptr) {
ppcBuiltinsScope_ = GetBuiltinModule("__fortran_ppc_intrinsics");
.statement.v.source == "__fortran_builtins" ||
std::get<parser::Statement<parser::ModuleStmt>>(
frontModule->value().t)
- .statement.v.source == "__fortran_ppc_intrinsics")) {
+ .statement.v.source == "__fortran_ppc_intrinsics" ||
+ std::get<parser::Statement<parser::ModuleStmt>>(
+ 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();
llvm::Triple::normalize(llvm::sys::getDefaultTargetTriple()))};
// Only use __Fortran_PPC_intrinsics module when targetting PowerPC arch
if (targetTriple.isPPC()) {
+ context_.UsePPCFortranBuiltinTypesModule();
context_.UsePPCFortranBuiltinsModule();
}
}
--- /dev/null
+!===-- 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
--- /dev/null
+! 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<!fir.vector<512:i1>>
+ ! CHECK-FIR-DAG: %[[VQ2:.*]] = fir.address_of(@_QFEvq2) : !fir.ref<!fir.vector<512:i1>>
+ __vector_quad :: vq1, vq2
+
+ ! CHECK-FIR: %[[RESI:.*]] = fir.call @_QFPtest_vec_integer_assign(%[[VI1]]){{.*}}: (!fir.ref<!fir.vector<4:i32>>) -> !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<!fir.vector<4:i32>>
+ ! 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>>) -> !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<!fir.vector<2:f64>>
+ ! 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>>) -> !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<!fir.vector<8:ui16>>
+ ! 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>>) -> !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<!fir.vector<256:i1>>
+ ! 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>>) -> !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<!fir.vector<512:i1>>
+ ! 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<!fir.vector<4:i32>>
+ ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref<!fir.vector<4:i32>>
+
+ ! 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<!fir.vector<4:i32>>
+ ! 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<!fir.vector<2:f64>>
+ ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref<!fir.vector<2:f64>>
+
+ ! 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<!fir.vector<2:f64>>
+ ! 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<!fir.vector<8:ui16>>
+ ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref<!fir.vector<8:ui16>>
+
+ ! 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<!fir.vector<8:ui16>>
+ ! 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<!fir.vector<256:i1>>
+ ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref<!fir.vector<256:i1>>
+
+ ! 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<!fir.vector<256:i1>>
+ ! 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<!fir.vector<512:i1>>
+ ! CHECK-FIR-NEXT: fir.store %[[ARG0]] to %[[FUNC_RES]] : !fir.ref<!fir.vector<512:i1>>
+
+ ! 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<!fir.vector<512:i1>>
+ ! 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
--- /dev/null
+! 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
"__fortran_builtins"
"__fortran_ieee_exceptions"
"__fortran_type_info"
+ "__fortran_ppc_types"
"__fortran_ppc_intrinsics"
"ieee_arithmetic"
"ieee_exceptions"
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")