[flang-commits] [flang] 6e85b88 - [flang] Add fir.dispatch code generation

Valentin Clement via flang-commits flang-commits at lists.llvm.org
Wed Oct 19 00:41:55 PDT 2022


Author: Valentin Clement
Date: 2022-10-19T09:41:47+02:00
New Revision: 6e85b8807fd473f58ac6a9a58a400a50c5c3c76e

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

LOG: [flang] Add fir.dispatch code generation

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.

Reviewed By: jeanPerier, PeteSteinfeld

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

Added: 
    flang/test/Fir/dispatch.f90

Modified: 
    flang/include/flang/Optimizer/CodeGen/CGOps.td
    flang/lib/Lower/ConvertExpr.cpp
    flang/lib/Optimizer/CodeGen/CodeGen.cpp
    flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
    flang/lib/Optimizer/CodeGen/TypeConverter.h

Removed: 
    flang/test/Fir/Todo/dispatch.fir


################################################################################
diff  --git a/flang/include/flang/Optimizer/CodeGen/CGOps.td b/flang/include/flang/Optimizer/CodeGen/CGOps.td
index 258c66ed27731..4bf417a934d7e 100644
--- a/flang/include/flang/Optimizer/CodeGen/CGOps.td
+++ b/flang/include/flang/Optimizer/CodeGen/CGOps.td
@@ -58,7 +58,7 @@ def fircg_XEmboxOp : fircg_Op<"ext_embox", [AttrSizedOperandSegments]> {
     Variadic<AnyIntegerType>:$substr,
     Variadic<AnyIntegerType>:$lenParams
   );
-  let results = (outs fir_BoxType);
+  let results = (outs BoxOrClassType);
 
   let assemblyFormat = [{
     $memref (`(`$shape^`)`)? (`origin` $shift^)? (`[`$slice^`]`)?
@@ -107,14 +107,14 @@ def fircg_XReboxOp : fircg_Op<"ext_rebox", [AttrSizedOperandSegments]> {
   }];
 
   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^`]`)?

diff  --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index a180553ae0190..8122ed49d83eb 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2745,8 +2745,8 @@ class ScalarExprLowering {
       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 =
@@ -2754,9 +2754,9 @@ class ScalarExprLowering {
         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();

diff  --git a/flang/lib/Optimizer/CodeGen/CodeGen.cpp b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
index b23e4bd2595f2..7766d5c4bebe8 100644
--- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp
+++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp
@@ -893,8 +893,123 @@ struct DispatchOpConversion : public FIROpConversion<fir::DispatchOp> {
   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();
   }
 };
 
@@ -1127,7 +1242,7 @@ 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;
@@ -1136,15 +1251,15 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
     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));
   }
 
@@ -1342,11 +1457,11 @@ struct EmboxCommonConversion : public FIROpConversion<OP> {
   }
 
   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();
@@ -3367,7 +3482,7 @@ class FIRToLLVMLowering
     // 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>()) {

diff  --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
index 1e40bead7a55e..c134ff911ce81 100644
--- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
+++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp
@@ -277,10 +277,8 @@ class CodeGenRewrite : public fir::impl::CodeGenRewriteBase<CodeGenRewrite> {
     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>());
     });

diff  --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h
index b3730d2608e12..13e7d7602093e 100644
--- a/flang/lib/Optimizer/CodeGen/TypeConverter.h
+++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h
@@ -64,10 +64,8 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
       // 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(
@@ -203,7 +201,7 @@ class LLVMTypeConverter : public mlir::LLVMTypeConverter {
 
   // 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();

diff  --git a/flang/test/Fir/Todo/dispatch.fir b/flang/test/Fir/Todo/dispatch.fir
deleted file mode 100644
index 93ff86a800f9b..0000000000000
--- a/flang/test/Fir/Todo/dispatch.fir
+++ /dev/null
@@ -1,10 +0,0 @@
-// 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
-}

diff  --git a/flang/test/Fir/dispatch.f90 b/flang/test/Fir/dispatch.f90
new file mode 100644
index 0000000000000..17cfc99966274
--- /dev/null
+++ b/flang/test/Fir/dispatch.f90
@@ -0,0 +1,227 @@
+! 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: }


        


More information about the flang-commits mailing list