[flang] Add fir.dispatch code generation

[clementval]

Summary

fir.dispatch code generation uses the binding table stored in the
type descriptor. There is no runtime call involved. The binding table
is always build from the parent type so the index of a specific binding
is the same in the parent derived-type or in the extended type.

Follow-up patches will deal cases not present here such as allocatable
polymorphic entities or pointers.

[jeanPerier]

Overall looks good, just some questions about points I do not understand.

flang/lib/Optimizer/CodeGen/CodeGen.cpp

960–963

Is this code working if typeDescTy came from a fir::GloablOp and not an mlir::LLVM::GlobalOp above ? I would expect it to have a fir type in that case.

982–983

I do not follow how this is accounting for the pass/nopass and pass position aspects (also below when placing the argument values).

[PeteSteinfeld]

Aside from a few nits, all builds and tests correctly and looks good.

flang/lib/Optimizer/CodeGen/CodeGen.cpp

1000

"Indirect calls"

1010

"Indirect calls"

[clementval]

flang/lib/Optimizer/CodeGen/CodeGen.cpp

960–963

Good point. I'll add a convertType for the fir::GlobalOp case.

982–983

The semantic is giving us the correct list of operand with the passed-object included if needed. We just drop the first operand that represent the passed-object in any case but the passed object is also present at its right position in case of a PASS procedure.

[clementval]

Address review comments

[jeanPerier]

LGTM

flang/lib/Optimizer/CodeGen/CodeGen.cpp

982–983

That explains, thanks.

flang/include/flang/Optimizer/CodeGen/CGOps.td

let arguments = (ins
     AnyReferenceLike:$memref,
     Variadic<AnyIntegerType>:$shape,
     Variadic<AnyIntegerType>:$shift,
     Variadic<AnyIntegerType>:$slice,
     Variadic<AnyCoordinateType>:$subcomponent,
     Variadic<AnyIntegerType>:$substr,
     Variadic<AnyIntegerType>:$lenParams
   );
-  let results = (outs fir_BoxType);
+  let results = (outs BoxOrClassType);
 
   let assemblyFormat = [{
     $memref (`(`$shape^`)`)? (`origin` $shift^)? (`[`$slice^`]`)?
       (`path` $subcomponent^)? (`substr` $substr^)? (`typeparams` $lenParams^)?
       attr-dict `:` functional-type(operands, results)
   }];
 
   let extraClassDeclaration = [{
arguments.
        - subcomponent: A vector of indices for subobject slicing.
        - substring: A substring operator (offset, length) for CHARACTER.
 
     The box argument is mandatory, the other arguments are optional.
     There must not both be a shape and slice/subcomponent arguments
   }];
 
   let arguments = (ins
-    fir_BoxType:$box,
+    BoxOrClassType:$box,
     Variadic<AnyIntegerType>:$shape,
     Variadic<AnyIntegerType>:$shift,
     Variadic<AnyIntegerType>:$slice,
     Variadic<AnyCoordinateType>:$subcomponent,
     Variadic<AnyIntegerType>:$substr
   );
-  let results = (outs fir_BoxType);
+  let results = (outs BoxOrClassType);
 
   let assemblyFormat = [{
     $box (`(`$shape^`)`)? (`origin` $shift^)? (`[`$slice^`]`)?
       (`path` $subcomponent^)? (`substr` $substr^)? attr-dict `:`
       functional-type(operands, results)
   }];
 
   let extraClassDeclaration = [{

flang/lib/Lower/ConvertExpr.cpp

if (caller.requireDispatchCall()) {
       const auto &ultimateSymbol =
           caller.getCallDescription().proc().GetSymbol()->GetUltimate();
       auto procName = toStringRef(ultimateSymbol.name());
 
       fir::DispatchOp dispatch;
       if (std::optional<unsigned> passArg = caller.getPassArgIndex()) {
         // PASS, PASS(arg-name)
         dispatch = builder.create<fir::DispatchOp>(
-            loc, funcType.getResults(), procName, operands[*passArg], operands,
-            builder.getI32IntegerAttr(*passArg));
+            loc, funcType.getResults(), builder.getStringAttr(procName),
+            operands[*passArg], operands, builder.getI32IntegerAttr(*passArg));
       } else {
         // NOPASS
         const Fortran::evaluate::Component *component =
             caller.getCallDescription().proc().GetComponent();
         assert(component && "expect component for type-bound procedure call.");
         fir::ExtendedValue pass =
             symMap.lookupSymbol(component->GetFirstSymbol()).toExtendedValue();
-        dispatch = builder.create<fir::DispatchOp>(loc, funcType.getResults(),
-                                                   procName, fir::getBase(pass),
-                                                   operands, nullptr);
+        dispatch = builder.create<fir::DispatchOp>(
+            loc, funcType.getResults(), builder.getStringAttr(procName),
+            fir::getBase(pass), operands, nullptr);
       }
       callResult = dispatch.getResult(0);
       callNumResults = dispatch.getNumResults();
     } else {
       // Standard procedure call with fir.call.
       auto call = builder.create<fir::CallOp>(loc, funcType.getResults(),
                                               funcSymbolAttr, operands);
       callResult = call.getResult(0);

flang/lib/Optimizer/CodeGen/CodeGen.cpp

 /// Lower `fir.dispatch` operation. A virtual call to a method in a dispatch
 /// table.
 struct DispatchOpConversion : public FIROpConversion<fir::DispatchOp> {
   using FIROpConversion::FIROpConversion;
 
   mlir::LogicalResult
   matchAndRewrite(fir::DispatchOp dispatch, OpAdaptor adaptor,
                   mlir::ConversionPatternRewriter &rewriter) const override {
-    TODO(dispatch.getLoc(), "fir.dispatch codegen");
-    return mlir::failure();
+    mlir::Location loc = dispatch.getLoc();
+
+    if (bindingTables.empty())
+      return emitError(loc) << "no binding tables found";
+
+    if (dispatch.getObject()
+            .getType()
+            .getEleTy()
+            .isa<fir::HeapType, fir::PointerType>())
+      TODO(loc,
+           "fir.dispatch with allocatable or pointer polymorphic entities");
+
+    // Get derived type information.
+    auto declaredType = dispatch.getObject().getType().getEleTy();
+    assert(declaredType.isa<fir::RecordType>() && "expecting fir.type");
+    auto recordType = declaredType.dyn_cast<fir::RecordType>();
+    std::string typeDescName =
+        fir::NameUniquer::getTypeDescriptorName(recordType.getName());
+    std::string typeDescBindingTableName =
+        fir::NameUniquer::getTypeDescriptorBindingTableName(
+            recordType.getName());
+
+    // Lookup for the binding table.
+    auto bindingsIter = bindingTables.find(typeDescBindingTableName);
+    if (bindingsIter == bindingTables.end())
+      return emitError(loc)
+             << "cannot find binding table for " << typeDescBindingTableName;
+
+    // Lookup for the binding.
+    const BindingTable &bindingTable = bindingsIter->second;
+    auto bindingIter = bindingTable.find(dispatch.getMethod());
+    if (bindingIter == bindingTable.end())
+      return emitError(loc)
+             << "cannot find binding for " << dispatch.getMethod();
+    unsigned bindingIdx = bindingIter->second;
+
+    mlir::Value passedObject = dispatch.getObject();
+
+    auto module = dispatch.getOperation()->getParentOfType<mlir::ModuleOp>();
+    mlir::Type typeDescTy;
+    if (auto global = module.lookupSymbol<fir::GlobalOp>(typeDescName)) {
+      typeDescTy = convertType(global.getType());
+    } else if (auto global =
+                   module.lookupSymbol<mlir::LLVM::GlobalOp>(typeDescName)) {
+      // The global may have already been translated to LLVM.
+      typeDescTy = global.getType();
+    }
+
+    auto isArray = fir::dyn_cast_ptrOrBoxEleTy(passedObject.getType())
+                       .template isa<fir::SequenceType>();
+    unsigned typeDescFieldId = isArray ? kOptTypePtrPosInBox : kDimsPosInBox;
+
+    auto descPtr = adaptor.getOperands()[0]
+                       .getType()
+                       .dyn_cast<mlir::LLVM::LLVMPointerType>();
+
+    // Load the descriptor.
+    auto desc = rewriter.create<mlir::LLVM::LoadOp>(
+        loc, descPtr.getElementType(), adaptor.getOperands()[0]);
+
+    // Load the type descriptor.
+    auto typeDescPtr =
+        rewriter.create<mlir::LLVM::ExtractValueOp>(loc, desc, typeDescFieldId);
+    auto typeDesc =
+        rewriter.create<mlir::LLVM::LoadOp>(loc, typeDescTy, typeDescPtr);
+
+    // Load the bindings descriptor.
+    auto typeDescStructTy = typeDescTy.dyn_cast<mlir::LLVM::LLVMStructType>();
+    auto bindingDescType =
+        typeDescStructTy.getBody()[0].dyn_cast<mlir::LLVM::LLVMStructType>();
+    auto bindingDesc =
+        rewriter.create<mlir::LLVM::ExtractValueOp>(loc, typeDesc, 0);
+
+    // Load the correct binding.
+    auto bindingType =
+        bindingDescType.getBody()[0].dyn_cast<mlir::LLVM::LLVMPointerType>();
+    auto baseBindingPtr = rewriter.create<mlir::LLVM::ExtractValueOp>(
+        loc, bindingDesc, kAddrPosInBox);
+    auto bindingPtr = rewriter.create<mlir::LLVM::GEPOp>(
+        loc, bindingType, baseBindingPtr,
+        llvm::ArrayRef<mlir::LLVM::GEPArg>{static_cast<int32_t>(bindingIdx)});
+    auto binding = rewriter.create<mlir::LLVM::LoadOp>(
+        loc, bindingType.getElementType(), bindingPtr);
+
+    // Get the function type.
+    llvm::SmallVector<mlir::Type> argTypes;
+    for (mlir::Value operand : adaptor.getOperands().drop_front())
+      argTypes.push_back(operand.getType());
+    mlir::Type resultType;
+    if (dispatch.getResults().empty())
+      resultType = mlir::LLVM::LLVMVoidType::get(dispatch.getContext());
+    else
+      resultType = convertType(dispatch.getResults()[0].getType());
+    auto fctType = mlir::LLVM::LLVMFunctionType::get(resultType, argTypes,
+                                                     /*isVarArg=*/false);
+
+    // Get the function pointer.
+    auto builtinFuncPtr =
+        rewriter.create<mlir::LLVM::ExtractValueOp>(loc, binding, 0);
+    auto funcAddr =
+        rewriter.create<mlir::LLVM::ExtractValueOp>(loc, builtinFuncPtr, 0);
+    auto funcPtr = rewriter.create<mlir::LLVM::IntToPtrOp>(
+        loc, mlir::LLVM::LLVMPointerType::get(fctType), funcAddr);
+
+    // Indirect calls are done with the function pointer as the first operand.
+    llvm::SmallVector<mlir::Value> args;
+    args.push_back(funcPtr);
+    for (mlir::Value operand : adaptor.getOperands().drop_front())
+      args.push_back(operand);
+    auto callOp = rewriter.replaceOpWithNewOp<mlir::LLVM::CallOp>(
+        dispatch,
+        dispatch.getResults().empty() ? mlir::TypeRange{}
+                                      : fctType.getReturnType(),
+        "", args);
+    callOp.removeCalleeAttr(); // Indirect calls do not have callee attr.
+
+    return mlir::success();
   }
 };
 
 /// Lower `fir.dispatch_table` operation. The dispatch table for a Fortran
 /// derived type.
 struct DispatchTableOpConversion
     : public FIROpConversion<fir::DispatchTableOp> {
   using FIROpConversion::FIROpConversion;

 };
 } // namespace
 
 /// Common base class for embox to descriptor conversion.
 template <typename OP>
 struct EmboxCommonConversion : public FIROpConversion<OP> {
   using FIROpConversion<OP>::FIROpConversion;
 
-  static int getCFIAttr(fir::BoxType boxTy) {
+  static int getCFIAttr(fir::BaseBoxType boxTy) {
     auto eleTy = boxTy.getEleTy();
     if (eleTy.isa<fir::PointerType>())
       return CFI_attribute_pointer;
     if (eleTy.isa<fir::HeapType>())
       return CFI_attribute_allocatable;
     return CFI_attribute_other;
   }
 
-  static fir::RecordType unwrapIfDerived(fir::BoxType boxTy) {
+  static fir::RecordType unwrapIfDerived(fir::BaseBoxType boxTy) {
     return fir::unwrapSequenceType(fir::dyn_cast_ptrOrBoxEleTy(boxTy))
         .template dyn_cast<fir::RecordType>();
   }
-  static bool isDerivedTypeWithLenParams(fir::BoxType boxTy) {
+  static bool isDerivedTypeWithLenParams(fir::BaseBoxType boxTy) {
     auto recTy = unwrapIfDerived(boxTy);
     return recTy && recTy.getNumLenParams() > 0;
   }
-  static bool isDerivedType(fir::BoxType boxTy) {
+  static bool isDerivedType(fir::BaseBoxType boxTy) {
     return static_cast<bool>(unwrapIfDerived(boxTy));
   }
 
   // Get the element size and CFI type code of the boxed value.
   std::tuple<mlir::Value, mlir::Value> getSizeAndTypeCode(
       mlir::Location loc, mlir::ConversionPatternRewriter &rewriter,
       mlir::Type boxEleTy, mlir::ValueRange lenParams = {}) const {
     auto i64Ty = mlir::IntegerType::get(rewriter.getContext(), 64);
if (!this->options.ignoreMissingTypeDescriptors &&
             name, Fortran::semantics::typeInfoBuiltinModule))
       fir::emitFatalError(
           loc, "runtime derived type info descriptor was not generated");
     return rewriter.create<mlir::LLVM::NullOp>(
         loc, ::getVoidPtrType(box.getContext()));
   }
 
   template <typename BOX>
-  std::tuple<fir::BoxType, mlir::Value, mlir::Value>
+  std::tuple<fir::BaseBoxType, 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 boxTy = box.getType().template dyn_cast<fir::BaseBoxType>();
     auto convTy = this->lowerTy().convertBoxType(boxTy, rank);
     auto llvmBoxPtrTy = convTy.template cast<mlir::LLVM::LLVMPointerType>();
     auto llvmBoxTy = llvmBoxPtrTy.getElementType();
     mlir::Value descriptor =
         rewriter.create<mlir::LLVM::UndefOp>(loc, llvmBoxTy);
 
     llvm::SmallVector<mlir::Value> typeparams = lenParams;
     if constexpr (!std::is_same_v<BOX, fir::EmboxOp>) {
if (mlir::failed(runPipeline(mathConvertionPM, mod)))
       return signalPassFailure();
 
     // Reconstruct binding tables for dynamic dispatch. The binding tables
     // are defined in FIR from semantics as fir.global operation with region
     // initializer. Go through each bining tables and store the procedure name
     // and binding index for later use by the fir.dispatch conversion pattern.
     BindingTables bindingTables;
     for (auto globalOp : mod.getOps<fir::GlobalOp>()) {
-      if (globalOp.getSymName().contains(".v.")) {
+      if (globalOp.getSymName().contains(bindingTableSeparator)) {
         unsigned bindingIdx = 0;
         BindingTable bindings;
         for (auto addrOp : globalOp.getRegion().getOps<fir::AddrOfOp>()) {
           if (fir::isa_char(fir::unwrapRefType(addrOp.getType()))) {
             if (auto nameGlobal =
                     mod.lookupSymbol<fir::GlobalOp>(addrOp.getSymbol())) {
               auto stringLit = llvm::to_vector(
                   nameGlobal.getRegion().getOps<fir::StringLitOp>())[0];

flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp

void runOn(mlir::Operation *op, mlir::Region &region) {
     auto &context = getContext();
     mlir::OpBuilder rewriter(&context);
     mlir::ConversionTarget target(context);
     target.addLegalDialect<mlir::arith::ArithDialect, fir::FIROpsDialect,
                            fir::FIRCodeGenDialect, mlir::func::FuncDialect>();
     target.addIllegalOp<fir::ArrayCoorOp>();
     target.addIllegalOp<fir::ReboxOp>();
     target.addDynamicallyLegalOp<fir::EmboxOp>([](fir::EmboxOp embox) {
-      if (embox.getType().isa<fir::ClassType>())
-        TODO(embox.getLoc(), "fir.class type CodeGenRewrite");
       return !(embox.getShape() || embox.getType()
-                                       .cast<fir::BoxType>()
+                                       .cast<fir::BaseBoxType>()
                                        .getEleTy()
                                        .isa<fir::SequenceType>());
     });
     mlir::RewritePatternSet patterns(&context);
     patterns.insert<EmboxConversion, ArrayCoorConversion, ReboxConversion>(
         &context);
     if (mlir::failed(
             mlir::applyPartialConversion(op, target, std::move(patterns)))) {

flang/lib/Optimizer/CodeGen/TypeConverter.h

addConversion([&](BoxCharType boxchar) {
       LLVM_DEBUG(llvm::dbgs() << "type convert: " << boxchar << '\n');
       return convertType(specifics->boxcharMemoryType(boxchar.getEleTy()));
     });
     addConversion([&](BoxProcType boxproc) {
       // TODO: Support for this type will be added later when the Fortran 2003
       // procedure pointer feature is implemented.
       return llvm::None;
     });
-    addConversion([&](fir::ClassType classTy) {
-      TODO_NOLOC("fir.class type conversion");
-      return llvm::None;
-    });
+    addConversion(
+        [&](fir::ClassType classTy) { return convertBoxType(classTy); });
     addConversion(
         [&](fir::CharacterType charTy) { return convertCharType(charTy); });
     addConversion(
         [&](fir::ComplexType cmplx) { return convertComplexType(cmplx); });
     addConversion([&](fir::FieldType field) {
       // Convert to i32 because of LLVM GEP indexing restriction.
       return mlir::IntegerType::get(field.getContext(), 32);
     });
public:
   }
 
   // Magic value to indicate we do not know the rank of an entity, either
   // because it is assumed rank or because we have not determined it yet.
   static constexpr int unknownRank() { return -1; }
 
   // This corresponds to the descriptor as defined in ISO_Fortran_binding.h and
   // the addendum defined in descriptor.h.
-  mlir::Type convertBoxType(BoxType box, int rank = unknownRank()) {
+  mlir::Type convertBoxType(BaseBoxType box, int rank = unknownRank()) {
     // (base_addr*, elem_len, version, rank, type, attribute, f18Addendum, [dim]
     llvm::SmallVector<mlir::Type> dataDescFields;
     mlir::Type ele = box.getEleTy();
     // remove fir.heap/fir.ref/fir.ptr
     if (auto removeIndirection = fir::dyn_cast_ptrEleTy(ele))
       ele = removeIndirection;
     auto eleTy = convertType(ele);
     // base_addr*

flang/test/Fir/Todo/dispatch.fir

-// RUN: %not_todo_cmd fir-opt --fir-to-llvm-ir="target=x86_64-unknown-linux-gnu" %s 2>&1 | FileCheck %s
-
-// Test `fir.dispatch` conversion to llvm.
-// Not implemented yet.
-
-func.func @dispatch(%arg0: !fir.class<!fir.type<derived3{f:f32}>>) {
-// CHECK: not yet implemented: fir.class type conversion
-  %0 = fir.dispatch "method"(%arg0 : !fir.class<!fir.type<derived3{f:f32}>>) -> i32
-  return
-}

flang/test/Fir/dispatch.f90

+! RUN: bbc -polymorphic-type -emit-fir %s -o - | tco | FileCheck %s
+! RUN: bbc -polymorphic-type -emit-fir %s -o - | FileCheck %s --check-prefix=BT
+
+! Tests codegen of fir.dispatch operation. This test is intentionally run from
+! Fortran through bbc and tco so we have all the binding tables lowered to FIR
+! from semantics.
+
+module dispatch1
+
+  type p1
+    integer :: a
+    integer :: b
+  contains
+    procedure :: aproc
+    procedure :: display1 => display1_p1
+    procedure :: display2 => display2_p1
+    procedure :: get_value => get_value_p1
+    procedure :: proc_with_values => proc_p1
+    procedure, nopass :: proc_nopass => proc_nopass_p1
+  end type
+
+  type, extends(p1) :: p2
+    integer :: c
+  contains
+    procedure :: display1 => display1_p2
+    procedure :: display2 => display2_p2
+    procedure :: display3
+    procedure :: get_value => get_value_p2
+    procedure :: proc_with_values => proc_p2
+    procedure, nopass :: proc_nopass => proc_nopass_p2
+  end type
+
+contains
+
+  subroutine display1_p1(this)
+    class(p1) :: this
+    print*,'call display1_p1'
+  end subroutine
+
+  subroutine display2_p1(this)
+    class(p1) :: this
+    print*,'call display2_p1'
+  end subroutine
+
+  subroutine display1_p2(this)
+    class(p2) :: this
+    print*,'call display1_p2'
+  end subroutine
+
+  subroutine display2_p2(this)
+    class(p2) :: this
+    print*,'call display2_p2'
+  end subroutine
+
+  subroutine aproc(this)
+    class(p1) :: this
+    print*,'call aproc'
+  end subroutine
+
+  subroutine display3(this)
+    class(p2) :: this
+    print*,'call display3'
+  end subroutine
+
+  function get_value_p1(this)
+    class(p1) :: this
+    integer :: get_value_p1
+    get_value_p1 = 10
+  end function
+
+  function get_value_p2(this)
+    class(p2) :: this
+    integer :: get_value_p2
+    get_value_p2 = 10
+  end function
+
+  subroutine proc_p1(this, v)
+    class(p1) :: this
+    real :: v
+    print*, 'call proc1 with ', v
+  end subroutine
+
+  subroutine proc_p2(this, v)
+    class(p2) :: this
+    real :: v
+    print*, 'call proc1 with ', v
+  end subroutine
+
+  subroutine proc_nopass_p1()
+    print*, 'call proc_nopass_p1'
+  end subroutine
+
+  subroutine proc_nopass_p2()
+    print*, 'call proc_nopass_p1'
+  end subroutine
+
+  subroutine display_class(p)
+    class(p1) :: p
+    integer :: i
+    call p%display2()
+    call p%display1()
+    call p%aproc()
+    i = p%get_value()
+    call p%proc_with_values(2.5)
+    call p%proc_nopass()
+  end subroutine
+
+end module
+
+program test_type_to_class
+  use dispatch1
+  type(p1) :: t1 = p1(1,2)
+  type(p2) :: t2 = p2(1,2,3)
+
+  call display_class(t1)
+  call display_class(t2)
+end
+
+
+! CHECK-LABEL: define void @_QMdispatch1Pdisplay_class(
+! CHECK-SAME: ptr %[[CLASS:.*]])
+
+! CHECK-DAG: %[[REAL:.*]] = alloca float, i64 1
+! CHECK-DAG: %[[I:.*]] = alloca i32, i64 1
+
+! Check dynamic dispatch equal to `call p%display2()` with binding index = 2.
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 2
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: call void %[[FUNC_PTR]](ptr %[[CLASS]])
+
+! Check dynamic dispatch equal to `call p%display1()` with binding index = 1.
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 1
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: call void %[[FUNC_PTR]](ptr %[[CLASS]])
+
+! Check dynamic dispatch equal to `call p%aproc()` with binding index = 0.
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 0
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: call void %[[FUNC_PTR]](ptr %[[CLASS]])
+
+! Check dynamic dispatch of a function with result.
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 3
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: %[[RET:.*]] = call i32 %[[FUNC_PTR]](ptr %[[CLASS]])
+! CHECK: store i32 %[[RET]], ptr %[[I]]
+
+! Check dynamic dispatch of call with passed-object and additional argument
+! CHECK: store float 2.500000e+00, ptr %[[REAL]]
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 5
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: call void %[[FUNC_PTR]](ptr %[[CLASS]], ptr %[[REAL]])
+
+! Check dynamic dispatch of a call with NOPASS
+! CHECK: %[[LOADED_CLASS:.*]] = load { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] }, ptr %[[CLASS]]
+! CHECK: %[[TYPEDESCPTR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, ptr, [1 x i64] } %[[LOADED_CLASS]], 7
+! CHECK: %[[LOADED_TYPEDESC:.*]] = load %_QM__fortran_type_infoTderivedtype, ptr %[[TYPEDESCPTR]]
+! CHECK: %[[DT:.*]] = extractvalue %_QM__fortran_type_infoTderivedtype %[[LOADED_TYPEDESC]], 0
+! CHECK: %[[BINDING_BASE_ADDR:.*]] = extractvalue { ptr, i64, i32, i8, i8, i8, i8, [1 x [3 x i64]], ptr, [1 x i64] } %[[DT]], 0
+! CHECK: %[[BINDING_PTR:.*]] = getelementptr %_QM__fortran_type_infoTbinding, ptr %[[BINDING_BASE_ADDR]], i32 4
+! CHECK: %[[LOADED_BINDING:.*]] = load %_QM__fortran_type_infoTbinding, ptr %[[BINDING_PTR]]
+! CHECK: %[[BUILTIN_FUNC_PTR:.*]] = extractvalue %_QM__fortran_type_infoTbinding %[[LOADED_BINDING]], 0
+! CHECK: %[[FUNC_ADDR:.*]] = extractvalue %_QM__fortran_builtinsT__builtin_c_funptr %[[BUILTIN_FUNC_PTR]], 0
+! CHECK: %[[FUNC_PTR:.*]] = inttoptr i64 %[[FUNC_ADDR]] to ptr
+! CHECK: call void %[[FUNC_PTR]]()
+
+
+! Check the layout of the binding table. This is easier to do in FIR than in 
+! LLVM IR.
+
+! BT-LABEL: fir.global linkonce_odr @_QMdispatch1E.v.p1 constant target : !fir.array<6x!fir.type<_QM__fortran_type_infoTbinding{proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>,name:!fir.box<!fir.ptr<!fir.char<1,?>>>}>> {
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Paproc) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> ()
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pdisplay1_p1) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> ()
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pdisplay2_p1) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> ()
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pget_value_p1) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> i32
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pproc_nopass_p1) : () -> ()
+! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pproc_p1) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>, !fir.ref<f32>) -> ()
+! BT: }
+
+! BT-LABEL: fir.global linkonce_odr @_QMdispatch1E.v.p2 constant target : !fir.array<7x!fir.type<_QM__fortran_type_infoTbinding{proc:!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>,name:!fir.box<!fir.ptr<!fir.char<1,?>>>}>> {
+! BT: %3 = fir.address_of(@_QMdispatch1Paproc) : (!fir.class<!fir.type<_QMdispatch1Tp1{a:i32,b:i32}>>) -> ()
+! BT: %18 = fir.address_of(@_QMdispatch1Pdisplay1_p2) : (!fir.class<!fir.type<_QMdispatch1Tp2{a:i32,b:i32,c:i32}>>) -> ()
+! BT: %33 = fir.address_of(@_QMdispatch1Pdisplay2_p2) : (!fir.class<!fir.type<_QMdispatch1Tp2{a:i32,b:i32,c:i32}>>) -> ()
+! BT: %48 = fir.address_of(@_QMdispatch1Pget_value_p2) : (!fir.class<!fir.type<_QMdispatch1Tp2{a:i32,b:i32,c:i32}>>) -> i32
+! BT: %63 = fir.address_of(@_QMdispatch1Pproc_nopass_p2) : () -> ()
+! BT: %78 = fir.address_of(@_QMdispatch1Pproc_p2) : (!fir.class<!fir.type<_QMdispatch1Tp2{a:i32,b:i32,c:i32}>>, !fir.ref<f32>) -> ()
+! BT: %93 = fir.address_of(@_QMdispatch1Pdisplay3) : (!fir.class<!fir.type<_QMdispatch1Tp2{a:i32,b:i32,c:i32}>>) -> ()
+! BT: }