diff --git a/flang/include/flang/Optimizer/CodeGen/CGOps.td b/flang/include/flang/Optimizer/CodeGen/CGOps.td --- a/flang/include/flang/Optimizer/CodeGen/CGOps.td +++ b/flang/include/flang/Optimizer/CodeGen/CGOps.td @@ -58,7 +58,7 @@ Variadic:$substr, Variadic:$lenParams ); - let results = (outs fir_BoxType); + let results = (outs BoxOrClassType); let assemblyFormat = [{ $memref (`(`$shape^`)`)? (`origin` $shift^)? (`[`$slice^`]`)? @@ -107,14 +107,14 @@ }]; let arguments = (ins - fir_BoxType:$box, + BoxOrClassType:$box, Variadic:$shape, Variadic:$shift, Variadic:$slice, Variadic:$subcomponent, Variadic:$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 --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -2745,8 +2745,8 @@ if (std::optional passArg = caller.getPassArgIndex()) { // PASS, PASS(arg-name) dispatch = builder.create( - 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 @@ assert(component && "expect component for type-bound procedure call."); fir::ExtendedValue pass = symMap.lookupSymbol(component->GetFirstSymbol()).toExtendedValue(); - dispatch = builder.create(loc, funcType.getResults(), - procName, fir::getBase(pass), - operands, nullptr); + dispatch = builder.create( + 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 --- a/flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ b/flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -893,8 +893,123 @@ 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()) + TODO(loc, + "fir.dispatch with allocatable or pointer polymorphic entities"); + + // Get derived type information. + auto declaredType = dispatch.getObject().getType().getEleTy(); + assert(declaredType.isa() && "expecting fir.type"); + auto recordType = declaredType.dyn_cast(); + 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::Type typeDescTy; + if (auto global = module.lookupSymbol(typeDescName)) { + typeDescTy = global.getType(); + } else if (auto global = + module.lookupSymbol(typeDescName)) { + // The global may have already been translated to LLVM. + typeDescTy = global.getType(); + } + + auto isArray = fir::dyn_cast_ptrOrBoxEleTy(passedObject.getType()) + .template isa(); + unsigned typeDescFieldId = isArray ? kOptTypePtrPosInBox : kDimsPosInBox; + + auto descPtr = adaptor.getOperands()[0] + .getType() + .dyn_cast(); + + // Load the descriptor. + auto desc = rewriter.create( + loc, descPtr.getElementType(), adaptor.getOperands()[0]); + + // Load the type descriptor. + auto typeDescPtr = + rewriter.create(loc, desc, typeDescFieldId); + auto typeDesc = + rewriter.create(loc, typeDescTy, typeDescPtr); + + // Load the bindings descriptor. + auto typeDescStructTy = typeDescTy.dyn_cast(); + auto bindingDescType = + typeDescStructTy.getBody()[0].dyn_cast(); + auto bindingDesc = + rewriter.create(loc, typeDesc, 0); + + // Load the correct binding. + auto bindingType = + bindingDescType.getBody()[0].dyn_cast(); + auto baseBindingPtr = rewriter.create( + loc, bindingDesc, kAddrPosInBox); + auto bindingPtr = rewriter.create( + loc, bindingType, baseBindingPtr, + llvm::ArrayRef{static_cast(bindingIdx)}); + auto binding = rewriter.create( + loc, bindingType.getElementType(), bindingPtr); + + // Get the function type. + llvm::SmallVector 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(loc, binding, 0); + auto funcAddr = + rewriter.create(loc, builtinFuncPtr, 0); + auto funcPtr = rewriter.create( + loc, mlir::LLVM::LLVMPointerType::get(fctType), funcAddr); + + // Indirect call are done with the function pointer as the first operand. + llvm::SmallVector args; + args.push_back(funcPtr); + for (mlir::Value operand : adaptor.getOperands().drop_front()) + args.push_back(operand); + auto callOp = rewriter.replaceOpWithNewOp( + dispatch, + dispatch.getResults().empty() ? mlir::TypeRange{} + : fctType.getReturnType(), + "", args); + callOp.removeCalleeAttr(); // Indirect call do not have callee attr. + + return mlir::success(); } }; @@ -1127,7 +1242,7 @@ struct EmboxCommonConversion : public FIROpConversion { using FIROpConversion::FIROpConversion; - static int getCFIAttr(fir::BoxType boxTy) { + static int getCFIAttr(fir::BaseBoxType boxTy) { auto eleTy = boxTy.getEleTy(); if (eleTy.isa()) return CFI_attribute_pointer; @@ -1136,15 +1251,15 @@ 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(); } - 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(unwrapIfDerived(boxTy)); } @@ -1342,11 +1457,11 @@ } template - std::tuple + std::tuple consDescriptorPrefix(BOX box, mlir::ConversionPatternRewriter &rewriter, unsigned rank, mlir::ValueRange lenParams) const { auto loc = box.getLoc(); - auto boxTy = box.getType().template dyn_cast(); + auto boxTy = box.getType().template dyn_cast(); auto convTy = this->lowerTy().convertBoxType(boxTy, rank); auto llvmBoxPtrTy = convTy.template cast(); auto llvmBoxTy = llvmBoxPtrTy.getElementType(); @@ -3367,7 +3482,7 @@ // and binding index for later use by the fir.dispatch conversion pattern. BindingTables bindingTables; for (auto globalOp : mod.getOps()) { - if (globalOp.getSymName().contains(".v.")) { + if (globalOp.getSymName().contains(bindingTableSeparator)) { unsigned bindingIdx = 0; BindingTable bindings; for (auto addrOp : globalOp.getRegion().getOps()) { diff --git a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp --- a/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp +++ b/flang/lib/Optimizer/CodeGen/PreCGRewrite.cpp @@ -277,10 +277,8 @@ target.addIllegalOp(); target.addIllegalOp(); target.addDynamicallyLegalOp([](fir::EmboxOp embox) { - if (embox.getType().isa()) - TODO(embox.getLoc(), "fir.class type CodeGenRewrite"); return !(embox.getShape() || embox.getType() - .cast() + .cast() .getEleTy() .isa()); }); diff --git a/flang/lib/Optimizer/CodeGen/TypeConverter.h b/flang/lib/Optimizer/CodeGen/TypeConverter.h --- a/flang/lib/Optimizer/CodeGen/TypeConverter.h +++ b/flang/lib/Optimizer/CodeGen/TypeConverter.h @@ -64,10 +64,8 @@ // 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 @@ // 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 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 --- 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>) { -// CHECK: not yet implemented: fir.class type conversion - %0 = fir.dispatch "method"(%arg0 : !fir.class>) -> i32 - return -} diff --git a/flang/test/Fir/dispatch.f90 b/flang/test/Fir/dispatch.f90 new file mode 100644 --- /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>>}>> { +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Paproc) : (!fir.class>) -> () +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pdisplay1_p1) : (!fir.class>) -> () +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pdisplay2_p1) : (!fir.class>) -> () +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pget_value_p1) : (!fir.class>) -> i32 +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pproc_nopass_p1) : () -> () +! BT: %{{.*}} = fir.address_of(@_QMdispatch1Pproc_p1) : (!fir.class>, !fir.ref) -> () +! 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>>}>> { +! BT: %3 = fir.address_of(@_QMdispatch1Paproc) : (!fir.class>) -> () +! BT: %18 = fir.address_of(@_QMdispatch1Pdisplay1_p2) : (!fir.class>) -> () +! BT: %33 = fir.address_of(@_QMdispatch1Pdisplay2_p2) : (!fir.class>) -> () +! BT: %48 = fir.address_of(@_QMdispatch1Pget_value_p2) : (!fir.class>) -> i32 +! BT: %63 = fir.address_of(@_QMdispatch1Pproc_nopass_p2) : () -> () +! BT: %78 = fir.address_of(@_QMdispatch1Pproc_p2) : (!fir.class>, !fir.ref) -> () +! BT: %93 = fir.address_of(@_QMdispatch1Pdisplay3) : (!fir.class>) -> () +! BT: }