[flang-commits] [flang] ef93417 - [flang] Support for PowerPC vector type

Kelvin Li via flang-commits flang-commits at lists.llvm.org
Wed May 24 10:11:16 PDT 2023


Author: Kelvin Li
Date: 2023-05-24T13:10:56-04:00
New Revision: ef934174704b75c8e04830bfd4f0c0bbedde9621

URL: https://github.com/llvm/llvm-project/commit/ef934174704b75c8e04830bfd4f0c0bbedde9621
DIFF: https://github.com/llvm/llvm-project/commit/ef934174704b75c8e04830bfd4f0c0bbedde9621.diff

LOG: [flang] Support for PowerPC vector type

The following PowerPC vector type syntax is added:

  VECTOR ( element-type-spec )

where element-type-sec is integer-type-spec, real-type-sec or unsigned-type-spec.

Two opaque types (__VECTOR_PAIR and __VECTOR_QUAD) are also added.

A finite set of functionalities are implemented in order to support the new types:
1. declare objects
2. declare function result
3. declare type dummy arguments
4. intrinsic assignment between the new type objects (e.g. v1=v2)
5. reference functions that return the new types

Submit on behalf of @tislam @danielcchen

Authors: @tislam @danielcchen

Differential Revision: https://reviews.llvm.org/D150876

Added: 
    flang/module/__fortran_ppc_types.f90
    flang/test/Lower/ppc-vector-types.f90
    flang/test/Semantics/ppc-vector-types.f90

Modified: 
    flang/include/flang/Common/Fortran-features.h
    flang/include/flang/Common/Fortran.h
    flang/include/flang/Parser/dump-parse-tree.h
    flang/include/flang/Parser/parse-tree.h
    flang/include/flang/Semantics/semantics.h
    flang/include/flang/Semantics/type.h
    flang/lib/Evaluate/type.cpp
    flang/lib/Lower/Bridge.cpp
    flang/lib/Lower/CallInterface.cpp
    flang/lib/Lower/ConvertType.cpp
    flang/lib/Parser/Fortran-parsers.cpp
    flang/lib/Parser/type-parsers.h
    flang/lib/Parser/unparse.cpp
    flang/lib/Semantics/resolve-names-utils.cpp
    flang/lib/Semantics/resolve-names.cpp
    flang/lib/Semantics/semantics.cpp
    flang/tools/f18/CMakeLists.txt

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 987e56200ae62..2e33ec1df792c 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -36,7 +36,7 @@ ENUM_CLASS(LanguageFeature, BackslashEscapes, OldDebugLines,
     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
index 49235cda89633..4a3e261373f37 100644
--- a/flang/include/flang/Common/Fortran.h
+++ b/flang/include/flang/Common/Fortran.h
@@ -21,6 +21,7 @@ namespace Fortran::common {
 
 // 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
index 5b680ea3403d0..fa8db77b1ffbf 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -715,11 +715,17 @@ class ParseTreeDumper {
   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
index 9059cfbe7f8c8..23f1fafc98ae0 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -708,6 +708,21 @@ struct IntrinsicTypeSpec {
       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);
@@ -748,7 +763,9 @@ struct DeclarationTypeSpec {
   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

diff  --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
index 569147cfa7536..37ea0d746b8ba 100644
--- a/flang/include/flang/Semantics/semantics.h
+++ b/flang/include/flang/Semantics/semantics.h
@@ -215,7 +215,9 @@ class SemanticsContext {
   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 @@ class SemanticsContext {
   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_;

diff  --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 3fcd438eaf134..e30ec2dd61205 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -249,6 +249,8 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &, const ArraySpec &);
 // 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>;
@@ -305,6 +307,13 @@ class DerivedTypeSpec {
   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 @@ class DerivedTypeSpec {
   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
index 0b9292a18d3fa..8311299fbb78d 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -152,8 +152,21 @@ std::optional<Expr<SubscriptInteger>> DynamicType::GetCharLength() const {
 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
index ea34da28d0bac..b5b5691bce408 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -3388,7 +3388,10 @@ class FirConverter : public Fortran::lower::AbstractConverter {
               // 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 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 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 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                 // 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
index 833ad73d164a4..034bce4b13885 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -788,10 +788,12 @@ class Fortran::lower::CallInterfaceImpl {
       }
     } 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
index 21de165e01762..9dfe982a65048 100644
--- 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 @@ int getIntegerBits() {
   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");
@@ -308,6 +315,56 @@ struct TypeBuilderImpl {
     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;
@@ -315,6 +372,10 @@ struct TypeBuilderImpl {
     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
index 4236addf67c30..e6198ee651057 100644
--- a/flang/lib/Parser/Fortran-parsers.cpp
+++ b/flang/lib/Parser/Fortran-parsers.cpp
@@ -191,7 +191,8 @@ TYPE_CONTEXT_PARSER("declaration type spec"_en_US,
                 // 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 |
@@ -218,6 +219,28 @@ TYPE_CONTEXT_PARSER("intrinsic type spec"_en_US,
             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)))
 

diff  --git a/flang/lib/Parser/type-parsers.h b/flang/lib/Parser/type-parsers.h
index b5f6e34d3a723..b886af4a72a09 100644
--- a/flang/lib/Parser/type-parsers.h
+++ b/flang/lib/Parser/type-parsers.h
@@ -137,5 +137,8 @@ constexpr Parser<OpenACCDeclarativeConstruct> openaccDeclarativeConstruct;
 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_

diff  --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 4490f7a7cc57b..4b6c03cd26dfb 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -161,6 +161,15 @@ class UnparseVisitor {
   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
index 507f88a633afe..c3be572bf51f1 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -614,7 +614,8 @@ bool EquivalenceSets::CheckObject(const parser::Name &name) {
     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
index 650166aa5557e..d7ea003bf905a 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -942,6 +942,8 @@ class DeclarationVisitor : public ArraySpecVisitor,
   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 @@ class DeclarationVisitor : public ArraySpecVisitor,
   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();
@@ -1087,6 +1091,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   // 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 &);
@@ -4621,10 +4626,14 @@ Symbol &DeclarationVisitor::DeclareObjectEntity(
 }
 
 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 @@ bool DeclarationVisitor::Pre(const parser::KindParam &x) {
   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;

diff  --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 65c44336a7438..e25a139b69100 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -470,6 +470,12 @@ void SemanticsContext::UseFortranBuiltinsModule() {
   }
 }
 
+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 @@ bool Semantics::Perform() {
                     .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();
@@ -500,6 +509,7 @@ bool Semantics::Perform() {
           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
index 0000000000000..9eea95159ce11
--- /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
index 0000000000000..6dc038f884b6f
--- /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<!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

diff  --git a/flang/test/Semantics/ppc-vector-types.f90 b/flang/test/Semantics/ppc-vector-types.f90
new file mode 100644
index 0000000000000..ad69b69a47f76
--- /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
index 71de5e71ae5e3..b76d01c284a36 100644
--- a/flang/tools/f18/CMakeLists.txt
+++ b/flang/tools/f18/CMakeLists.txt
@@ -8,6 +8,7 @@ set(MODULES
   "__fortran_builtins"
   "__fortran_ieee_exceptions"
   "__fortran_type_info"
+  "__fortran_ppc_types"
   "__fortran_ppc_intrinsics"
   "ieee_arithmetic"
   "ieee_exceptions"
@@ -28,8 +29,10 @@ if (NOT CMAKE_CROSSCOMPILING)
     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")


        


More information about the flang-commits mailing list