[flang] Support PDT type descriptors in codegen

[jeanPerier]

Summary

This change updates the mapping of derived types and type descriptor
object names to support kind parametrized derived types (PDT).
It moves the custom name mapping to the internal name utility.

To improve robustness and error reporting, type descriptors are also now
required to be generated in all compilation unit that manipulates
derived types. The previous codegen relied on the fact that descriptors
not defined in the current FIR module were available externally. Errors
with missing type descriptors were only caught at link time.

This patch makes derived type definition mandatory, except if the
derived types are expected to not have derived type descriptors (builtin
types), or if the newly added debug switch --ignore-missing-type-desc
is set. In those cases, a null pointer is used as type descriptor
pointer. The debug switch intends to help testing FIR to LLVM passes
without having to bother providing type descriptor data structures that
are normally built by the front-end.

[clementval]

LGTM

flang/include/flang/Optimizer/CodeGen/CodeGen.h

struct TargetRewriteOptions {
   bool noComplexConversion{};
 };
 
 /// Prerequiste pass for code gen. Perform intermediate rewrites to tailor the
 /// FIR for the chosen target.
 std::unique_ptr<mlir::OperationPass<mlir::ModuleOp>> createFirTargetRewritePass(
     const TargetRewriteOptions &options = TargetRewriteOptions());
 
-/// Convert FIR to the LLVM IR dialect
+/// FIR to LLVM translation pass options.
+struct FIRToLLVMPassOptions {
+  // Do not fail when type descriptors are not found when translating
+  // operations that uses them at the LLVM level like fir.embox. Instead,
+  // just use a null pointer.
+  // This is useful to test translating programs manually written where a
+  // frontend did not generate type descriptor data structures. However, note
+  // that this programs would crash at runtime if the derived type descriptors
+  // are required by the runtime, so this only an option to help debugging.
+  bool ignoreMissingTypeDescriptors = false;
+};
+
+/// Convert FIR to the LLVM IR dialect with default options.
 std::unique_ptr<mlir::Pass> createFIRToLLVMPass();
 
+/// Convert FIR to the LLVM IR dialect
+std::unique_ptr<mlir::Pass> createFIRToLLVMPass(FIRToLLVMPassOptions options);
+
 using LLVMIRLoweringPrinter =
     std::function<void(llvm::Module &, llvm::raw_ostream &)>;
 /// Convert the LLVM IR dialect to LLVM-IR proper
 std::unique_ptr<mlir::Pass> createLLVMDialectToLLVMPass(
     llvm::raw_ostream &output,
     LLVMIRLoweringPrinter printer =
         [](llvm::Module &m, llvm::raw_ostream &out) { m.print(out, nullptr); });
 
 // declarative passes
 #define GEN_PASS_REGISTRATION
 #include "flang/Optimizer/CodeGen/CGPasses.h.inc"
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_CODEGEN_CODEGEN_H

flang/include/flang/Optimizer/Dialect/FIRTypes.td

mlir::Type getType(unsigned index) {
       assert(index < getNumFields());
       return getTypeList()[index].second;
     }
     unsigned getNumFields() { return getTypeList().size(); }
     unsigned getNumLenParams() { return getLenParamList().size(); }
 
     void finalize(llvm::ArrayRef<TypePair> lenPList,
                   llvm::ArrayRef<TypePair> typeList);
-    
-    std::string translateNameToFrontendMangledName() const;
-
     detail::RecordTypeStorage const *uniqueKey() const;
   }];
 }
 
 def fir_ReferenceType : FIR_Type<"Reference", "ref"> {
   let summary = "Reference to an entity type";
 
   let description = [{

flang/include/flang/Optimizer/Support/InternalNames.h

struct NameUniquer {
 
   /// Check whether the name should be re-mangle with external ABI convention.
   static bool needExternalNameMangling(llvm::StringRef uniquedName);
 
   /// Does \p uniquedName belong to module \p moduleName?
   static bool belongsToModule(llvm::StringRef uniquedName,
                               llvm::StringRef moduleName);
 
+  /// Given a mangled derived type name, get the name of the related derived
+  /// type descriptor object. Returns an empty string if \p mangledTypeName is
+  /// not a valid mangled derived type name.
+  static std::string getTypeDescriptorName(llvm::StringRef mangledTypeName);
+
 private:
   static std::string intAsString(std::int64_t i);
   static std::string doKind(std::int64_t kind);
   static std::string doKinds(llvm::ArrayRef<std::int64_t> kinds);
   static std::string toLower(llvm::StringRef name);
 
   NameUniquer() = delete;
   NameUniquer(const NameUniquer &) = delete;
   NameUniquer(NameUniquer &&) = delete;
   NameUniquer &operator=(const NameUniquer &) = delete;
 };
 
 } // namespace fir
 
 #endif // FORTRAN_OPTIMIZER_SUPPORT_INTERNALNAMES_H

flang/include/flang/Tools/CLOptions.inc

 /// Shared option in tools to set a maximum value for the number of elements in
 /// a compile-time sized array that can be allocated on the stack.
 static llvm::cl::opt<std::size_t> arrayStackAllocationThreshold(
     "fstack-array-size",
     llvm::cl::desc(
         "place all array allocations more than <size> elements on the heap"),
     llvm::cl::init(~static_cast<std::size_t>(0)), llvm::cl::Hidden);
 
+/// Shared option in tools to ignore missing runtime type descriptor objects
+/// when translating FIR to LLVM. The resulting program will crash if the
+/// runtime needs the derived type descriptors, this is only a debug option to
+/// allow compiling manually written FIR programs involving derived types
+/// without having to write the derived type descriptors which are normally
+/// generated by the frontend.
+static llvm::cl::opt<bool> ignoreMissingTypeDescriptors(
+    "ignore-missing-type-desc",
+    llvm::cl::desc("ignore failures to find derived type descriptors when "
+                   "translating FIR to LLVM"),
+    llvm::cl::init(false), llvm::cl::Hidden);
+
 namespace {
 /// Optimizer Passes
 DisableOption(CfgConversion, "cfg-conversion", "disable FIR to CFG pass");
 DisableOption(FirAvc, "avc", "array value copy analysis and transformation");
 DisableOption(
     FirMao, "memory-allocation-opt", "memory allocation optimization");
 
 /// CodeGen Passes

 
 inline void addTargetRewritePass(mlir::PassManager &pm) {
   addPassConditionally(pm, disableTargetRewrite, []() {
     return fir::createFirTargetRewritePass(fir::TargetRewriteOptions{});
   });
 }
 
 inline void addFIRToLLVMPass(mlir::PassManager &pm) {
-  addPassConditionally(pm, disableFirToLlvmIr, fir::createFIRToLLVMPass);
+  fir::FIRToLLVMPassOptions options;
+  options.ignoreMissingTypeDescriptors = ignoreMissingTypeDescriptors;
+  addPassConditionally(pm, disableFirToLlvmIr,
+      [&]() { return fir::createFIRToLLVMPass(options); });
 }
 
 inline void addLLVMDialectToLLVMPass(
     mlir::PassManager &pm, llvm::raw_ostream &output) {
   addPassConditionally(pm, disableLlvmIrToLlvm,
       [&]() { return fir::createLLVMDialectToLLVMPass(output); });
 }
 #endif

flang/lib/Optimizer/CodeGen/CodeGen.cpp

return rewriter.createBlock(insertBefore->getParent(),
                               mlir::Region::iterator(insertBefore));
 }
 
 namespace {
 /// FIR conversion pattern template
 template <typename FromOp>
 class FIROpConversion : public mlir::ConvertOpToLLVMPattern<FromOp> {
 public:
-  explicit FIROpConversion(fir::LLVMTypeConverter &lowering)
-      : mlir::ConvertOpToLLVMPattern<FromOp>(lowering) {}
+  explicit FIROpConversion(fir::LLVMTypeConverter &lowering,
+                           const fir::FIRToLLVMPassOptions &options)
+      : mlir::ConvertOpToLLVMPattern<FromOp>(lowering), options(options) {}
 
 protected:
   mlir::Type convertType(mlir::Type ty) const {
     return lowerTy().convertType(ty);
   }
   mlir::Type voidPtrTy() const { return getVoidPtrType(); }
 
   mlir::Type getVoidPtrType() const {
mlir::LLVM::GEPOp genGEP(mlir::Location loc, mlir::Type ty,
                            mlir::Value base, ARGS... args) const {
     SmallVector<mlir::Value> cv{args...};
     return rewriter.create<mlir::LLVM::GEPOp>(loc, ty, base, cv);
   }
 
   fir::LLVMTypeConverter &lowerTy() const {
     return *static_cast<fir::LLVMTypeConverter *>(this->getTypeConverter());
   }
+
+  const fir::FIRToLLVMPassOptions &options;
 };
 
 /// FIR conversion pattern template
 template <typename FromOp>
 class FIROpAndTypeConversion : public FIROpConversion<FromOp> {
 public:
   using FIROpConversion<FromOp>::FIROpConversion;
   using OpAdaptor = typename FromOp::Adaptor;
struct EmboxCommonConversion : public FIROpConversion<OP> {
   }
 
   /// Get the address of the type descriptor global variable that was created by
   /// lowering for derived type \p recType.
   template <typename BOX>
   mlir::Value
   getTypeDescriptor(BOX box, mlir::ConversionPatternRewriter &rewriter,
                     mlir::Location loc, fir::RecordType recType) const {
-    std::string name = recType.translateNameToFrontendMangledName();
+    std::string name =
+        fir::NameUniquer::getTypeDescriptorName(recType.getName());
     auto module = box->template getParentOfType<mlir::ModuleOp>();
     if (auto global = module.template lookupSymbol<fir::GlobalOp>(name)) {
       auto ty = mlir::LLVM::LLVMPointerType::get(
           this->lowerTy().convertType(global.getType()));
       return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty,
                                                       global.getSymName());
     }
     if (auto global =
             module.template lookupSymbol<mlir::LLVM::GlobalOp>(name)) {
       // The global may have already been translated to LLVM.
       auto ty = mlir::LLVM::LLVMPointerType::get(global.getType());
       return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty,
                                                       global.getSymName());
     }
-    if (fir::NameUniquer::belongsToModule(
-            name, Fortran::semantics::typeInfoBuiltinModule)) {
-      // Type info derived types do not have type descriptors since they are the
-      // types defining type descriptors.
-      return rewriter.create<mlir::LLVM::NullOp>(
-          loc, ::getVoidPtrType(box.getContext()));
-    }
-    // The global does not exist in the current translation unit, but may be
-    // defined elsewhere (e.g., type defined in a module).
-    // Create an available_externally global to require the symbols to be
-    // defined elsewhere and to cause link-time failure otherwise.
-    auto i8Ty = rewriter.getIntegerType(8);
-    mlir::OpBuilder modBuilder(module.getBodyRegion());
-    modBuilder.create<mlir::LLVM::GlobalOp>(
-        loc, i8Ty, /*isConstant=*/true,
-        mlir::LLVM::Linkage::AvailableExternally, name, mlir::Attribute{});
-    auto ty = mlir::LLVM::LLVMPointerType::get(i8Ty);
-    return rewriter.create<mlir::LLVM::AddressOfOp>(loc, ty, name);
-  }
+    if (!this->options.ignoreMissingTypeDescriptors &&
+        !fir::NameUniquer::belongsToModule(
+            name, Fortran::semantics::typeInfoBuiltinModule))
+      fir::emitFatalError(
+          loc, "runtime derived type info descriptor was not generated");
 
   template <typename BOX>
   std::tuple<fir::BoxType, mlir::Value, mlir::Value>
   consDescriptorPrefix(BOX box, mlir::ConversionPatternRewriter &rewriter,
                        unsigned rank, mlir::ValueRange lenParams) const {
     auto loc = box.getLoc();
     auto boxTy = box.getType().template dyn_cast<fir::BoxType>();
     auto convTy = this->lowerTy().convertBoxType(boxTy, rank);

 };
 
 /// Conversion pattern for operation that must be dead. The information in these
 /// operations is used by other operation. At this point they should not have
 /// anymore uses.
 /// These operations are normally dead after the pre-codegen pass.
 template <typename FromOp>
 struct MustBeDeadConversion : public FIROpConversion<FromOp> {
-  explicit MustBeDeadConversion(fir::LLVMTypeConverter &lowering)
-      : FIROpConversion<FromOp>(lowering) {}
+  explicit MustBeDeadConversion(fir::LLVMTypeConverter &lowering,
+                                const fir::FIRToLLVMPassOptions &options)
+      : FIROpConversion<FromOp>(lowering, options) {}
   using OpAdaptor = typename FromOp::Adaptor;
 
   mlir::LogicalResult
   matchAndRewrite(FromOp op, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const final {
     if (!op->getUses().empty())
       return rewriter.notifyMatchFailure(op, "op must be dead");
     rewriter.eraseOp(op);

 /// Convert FIR dialect to LLVM dialect
 ///
 /// This pass lowers all FIR dialect operations to LLVM IR dialect. An
 /// MLIR pass is used to lower residual Std dialect to LLVM IR dialect.
 ///
 /// This pass is not complete yet. We are upstreaming it in small patches.
 class FIRToLLVMLowering : public fir::FIRToLLVMLoweringBase<FIRToLLVMLowering> {
 public:
+  FIRToLLVMLowering() = default;
+  FIRToLLVMLowering(fir::FIRToLLVMPassOptions options) : options{options} {}
   mlir::ModuleOp getModule() { return getOperation(); }
 
   void runOnOperation() override final {
     auto mod = getModule();
     if (!forcedTargetTriple.empty()) {
       fir::setTargetTriple(mod, forcedTargetTriple);
     }
 
pattern.insert<
         InsertValueOpConversion, IsPresentOpConversion,
         LenParamIndexOpConversion, LoadOpConversion, MulcOpConversion,
         NegcOpConversion, NoReassocOpConversion, SelectCaseOpConversion,
         SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion,
         ShapeOpConversion, ShapeShiftOpConversion, ShiftOpConversion,
         SliceOpConversion, StoreOpConversion, StringLitOpConversion,
         SubcOpConversion, UnboxCharOpConversion, UnboxProcOpConversion,
         UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion,
-        XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(
-        typeConverter);
+        XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(typeConverter,
+                                                                  options);
     mlir::populateStdToLLVMConversionPatterns(typeConverter, pattern);
     mlir::arith::populateArithmeticToLLVMConversionPatterns(typeConverter,
                                                             pattern);
     mlir::cf::populateControlFlowToLLVMConversionPatterns(typeConverter,
                                                           pattern);
     mlir::ConversionTarget target{*context};
     target.addLegalDialect<mlir::LLVM::LLVMDialect>();
 
     // required NOPs for applying a full conversion
     target.addLegalOp<mlir::ModuleOp>();
 
     // apply the patterns
     if (mlir::failed(mlir::applyFullConversion(getModule(), target,
                                                std::move(pattern)))) {
       signalPassFailure();
     }
   }
+
+private:
+  fir::FIRToLLVMPassOptions options;
 };
 
 /// Lower from LLVM IR dialect to proper LLVM-IR and dump the module
 struct LLVMIRLoweringPass
     : public mlir::PassWrapper<LLVMIRLoweringPass,
                                mlir::OperationPass<mlir::ModuleOp>> {
   using Printer = fir::LLVMIRLoweringPrinter;
   LLVMIRLoweringPass(raw_ostream &output, Printer p)

 
 } // namespace
 
 std::unique_ptr<mlir::Pass> fir::createFIRToLLVMPass() {
   return std::make_unique<FIRToLLVMLowering>();
 }
 
 std::unique_ptr<mlir::Pass>
+fir::createFIRToLLVMPass(FIRToLLVMPassOptions options) {
+  return std::make_unique<FIRToLLVMLowering>(options);
+}
+
+std::unique_ptr<mlir::Pass>
 fir::createLLVMDialectToLLVMPass(raw_ostream &output,
                                  fir::LLVMIRLoweringPrinter printer) {
   return std::make_unique<LLVMIRLoweringPass>(output, printer);
 }

flang/lib/Optimizer/Dialect/FIRType.cpp

 
 unsigned fir::RecordType::getFieldIndex(llvm::StringRef ident) {
   for (auto f : llvm::enumerate(getTypeList()))
     if (ident == f.value().first)
       return f.index();
   return std::numeric_limits<unsigned>::max();
 }
 
-std::string fir::RecordType::translateNameToFrontendMangledName() const {
-  auto split = getName().split('T');
-  std::string name = (split.first + "E.dt." + split.second).str();
-  return name;
-}
-
 //===----------------------------------------------------------------------===//
 // ReferenceType
 //===----------------------------------------------------------------------===//
 
 // `ref` `<` type `>`
 mlir::Type fir::ReferenceType::parse(mlir::AsmParser &parser) {
   return parseTypeSingleton<fir::ReferenceType>(parser);
 }

flang/lib/Optimizer/Support/InternalNames.cpp

 }
 
 bool fir::NameUniquer::belongsToModule(llvm::StringRef uniquedName,
                                        llvm::StringRef moduleName) {
   auto result = fir::NameUniquer::deconstruct(uniquedName);
   return !result.second.modules.empty() &&
          result.second.modules[0] == moduleName;
 }
+
+static std::string
+mangleTypeDescriptorKinds(llvm::ArrayRef<std::int64_t> kinds) {
+  if (kinds.empty())
+    return "";
+  std::string result = "";
+  for (std::int64_t kind : kinds)
+    result += "." + std::to_string(kind);
+  return result;
+}
+
+std::string
+fir::NameUniquer::getTypeDescriptorName(llvm::StringRef mangledTypeName) {
+  auto result = deconstruct(mangledTypeName);
+  if (result.first != NameKind::DERIVED_TYPE)
+    return "";
+  std::string varName = ".dt." + result.second.name +
+                        mangleTypeDescriptorKinds(result.second.kinds);
+  llvm::SmallVector<llvm::StringRef> modules;
+  for (const std::string &mod : result.second.modules)
+    modules.push_back(mod);
+  llvm::Optional<llvm::StringRef> host;
+  if (result.second.host)
+    host = *result.second.host;
+  return doVariable(modules, host, varName);
+}

flang/test/Fir/convert-to-llvm.fir

 
 // Test `fir.embox` conversion. This test creates a global so it needs to be
 // split from others.
 
 // Check descriptor for a derived type. Check that the f18Addendum flag is set
 // to 1 meaning the addendum is present (true) and the addendum values are
 // inserted.
 
+fir.global linkonce @_QMtest_dinitE.dt.tseq constant : i8
+
 func @embox1(%arg0: !fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>) {
   %0 = fir.embox %arg0() : (!fir.ref<!fir.type<_QMtest_dinitTtseq{i:i32}>>) -> !fir.box<!fir.type<_QMtest_dinitTtseq{i:i32}>>
   return
 }
 
-// CHECK: llvm.mlir.global available_externally constant @_QMtest_dinitE.dt.tseq() : i8
+// CHECK: llvm.mlir.global linkonce constant @_QMtest_dinitE.dt.tseq() : i8
 // CHECK-LABEL: llvm.func @embox1
 // CHECK:         %[[TYPE_CODE:.*]] = llvm.mlir.constant(42 : i32) : i32
 // CHECK:         %[[TYPE_CODE_I8:.*]] = llvm.trunc %[[TYPE_CODE]] : i32 to i8
 // CHECK:         %{{.*}} = llvm.insertvalue %[[TYPE_CODE_I8]], %{{.*}}[4 : i32] : !llvm.struct<(ptr<struct<"_QMtest_dinitTtseq", (i32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, ptr<i{{.*}}>, array<1 x i{{.*}}>)>
 // CHECK:         %[[F18ADDENDUM:.*]] = llvm.mlir.constant(1 : i32) : i32
 // CHECK:         %[[F18ADDENDUM_I8:.*]] = llvm.trunc %[[F18ADDENDUM]] : i32 to i8
 // CHECK:         %{{.*}} = llvm.insertvalue %[[F18ADDENDUM_I8]], %18[6 : i32] : !llvm.struct<(ptr<struct<"_QMtest_dinitTtseq", (i32)>>, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, i{{.*}}, ptr<i{{.*}}>, array<1 x i{{.*}}>)>
 // CHECK:         %[[TDESC:.*]] = llvm.mlir.addressof @_QMtest_dinitE.dt.tseq : !llvm.ptr<i8>

flang/test/Fir/ignore-missing-type-descriptor.fir

+// Test the option to avoid failing if derived type descriptors are not found.
+// This is a debug option to allow manually writing derived type fir.embox without
+// having to care with providing an ABI compliant derived type descriptor object.
+// Missing derived type descriptor pointers are replaced by null pointers.
+// RUN: tco --ignore-missing-type-desc -o - %s | FileCheck %s
+
+!some_freestyle_type = type !fir.type<some_not_mangled_type{j:i32}>
+
+func private @bar(!fir.box<!some_freestyle_type>)
+
+func @test_embox(%addr: !fir.ref<!some_freestyle_type>) {
+  %0 = fir.embox %addr : (!fir.ref<!some_freestyle_type>) -> !fir.box<!some_freestyle_type>
+  fir.call @bar(%0) : (!fir.box<!some_freestyle_type>) -> ()
+  return
+}
+// CHECK-LABEL: define void @test_embox(
+// CHECK-SAME: %some_not_mangled_type* %[[ADDR:.*]])
+// CHECK: insertvalue { %some_not_mangled_type*, i64, i32, i8, i8, i8, i8, i8*, [1 x i64] }
+// CHECK-SAME: { %some_not_mangled_type* undef, i64 ptrtoint (%some_not_mangled_type* getelementptr (%some_not_mangled_type, %some_not_mangled_type* null, i32 1) to i64),
+// CHECK-SAME: i32 20180515, i8 0, i8 42, i8 0, i8 1, i8* null, [1 x i64] undef },
+// CHECK-SAME: %some_not_mangled_type* %[[ADDR]], 0,