[flang-commits] [flang] ddc939f - [flang] Support lowering of intrinsic module procedure C_FUNLOC
Peixin Qiao via flang-commits
flang-commits at lists.llvm.org
Wed Aug 31 08:38:55 PDT 2022
Author: Peixin Qiao
Date: 2022-08-31T23:35:42+08:00
New Revision: ddc939fe15e420e2d3d9d156a8cfa8ce790573ab
URL: https://github.com/llvm/llvm-project/commit/ddc939fe15e420e2d3d9d156a8cfa8ce790573ab
DIFF: https://github.com/llvm/llvm-project/commit/ddc939fe15e420e2d3d9d156a8cfa8ce790573ab.diff
LOG: [flang] Support lowering of intrinsic module procedure C_FUNLOC
As Fortran 2018 18.2.3.5, the intrinsic c_funloc(x) gets the C address
of argument x. It returns the scalar of type C_FUNPTR. As defined in
iso_c_binding in flang/module/__fortran_builtins.f90, C_FUNPTR is the
derived type with only one component of integer 64.
This follows the implementation of https://reviews.llvm.org/D129659. The
argument is lowered as ProcBox and the address is generated using
fir.box_addr.
Reviewed By: jeanPerier, clementval
Differential Revision: https://reviews.llvm.org/D132273
Added:
flang/test/Lower/Intrinsics/c_funloc.f90
Modified:
flang/lib/Lower/ConvertExpr.cpp
flang/lib/Lower/IntrinsicCall.cpp
Removed:
################################################################################
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 0df629e0245ef..41930cce7f9d6 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -2186,6 +2186,12 @@ class ScalarExprLowering {
ExtValue lowerIntrinsicArgumentAsBox(const Fortran::lower::SomeExpr &expr) {
mlir::Location loc = getLoc();
ExtValue exv = genBoxArg(expr);
+ auto exvTy = fir::getBase(exv).getType();
+ if (exvTy.isa<mlir::FunctionType>()) {
+ auto boxProcTy = builder.getBoxProcType(exvTy.cast<mlir::FunctionType>());
+ return builder.create<fir::EmboxProcOp>(loc, boxProcTy,
+ fir::getBase(exv));
+ }
mlir::Value box = builder.createBox(loc, exv);
return fir::BoxValue(
box, fir::factory::getNonDefaultLowerBounds(builder, loc, exv),
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index a3aeeae691ce5..a8ebe10522968 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -480,6 +480,7 @@ struct IntrinsicLibrary {
fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genCFunLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -724,6 +725,7 @@ static constexpr IntrinsicHandler handlers[]{
{"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
{"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
{"btest", &I::genBtest},
+ {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},
{"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
{"ceiling", &I::genCeiling},
{"char", &I::genChar},
@@ -2468,20 +2470,29 @@ mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
return builder.createConvert(loc, resultType, res);
}
-// C_LOC
-fir::ExtendedValue
-IntrinsicLibrary::genCLoc(mlir::Type resultType,
- llvm::ArrayRef<fir::ExtendedValue> args) {
+static fir::ExtendedValue
+genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
+ mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
+ bool isFunc = false) {
assert(args.size() == 1 && resultType.isa<fir::RecordType>());
auto resTy = resultType.dyn_cast<fir::RecordType>();
assert(resTy.getTypeList().size() == 1);
auto fieldName = resTy.getTypeList()[0].first;
auto fieldTy = resTy.getTypeList()[0].second;
mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
- const auto *box = args[0].getBoxOf<fir::BoxValue>();
- assert(box && "c_loc argument must have been lowered to a fix.box");
- mlir::Value argAddr =
- builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), fir::getBase(*box));
+ mlir::Value argAddr;
+ if (isFunc) {
+ mlir::Value argValue = fir::getBase(args[0]);
+ assert(argValue.getType().isa<fir::BoxProcType>() &&
+ "c_funloc argument must have been lowered to a fir.boxproc");
+ auto funcTy = argValue.getType().cast<fir::BoxProcType>().getEleTy();
+ argAddr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
+ } else {
+ const auto *box = args[0].getBoxOf<fir::BoxValue>();
+ assert(box && "c_loc argument must have been lowered to a fir.box");
+ argAddr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
+ fir::getBase(*box));
+ }
mlir::Value argAddrVal = builder.createConvert(loc, fieldTy, argAddr);
auto fieldIndexType = fir::FieldType::get(resultType.getContext());
mlir::Value field = builder.create<fir::FieldIndexOp>(
@@ -2492,6 +2503,20 @@ IntrinsicLibrary::genCLoc(mlir::Type resultType,
return res;
}
+// C_FUNLOC
+fir::ExtendedValue
+IntrinsicLibrary::genCFunLoc(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ return genCLocOrCFunLoc(builder, loc, resultType, args, /*isFunc=*/true);
+}
+
+// C_LOC
+fir::ExtendedValue
+IntrinsicLibrary::genCLoc(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ return genCLocOrCFunLoc(builder, loc, resultType, args);
+}
+
// CEILING
mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
llvm::ArrayRef<mlir::Value> args) {
diff --git a/flang/test/Lower/Intrinsics/c_funloc.f90 b/flang/test/Lower/Intrinsics/c_funloc.f90
new file mode 100644
index 0000000000000..7faaaef00b0df
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/c_funloc.f90
@@ -0,0 +1,27 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! Test intrinsic module procedure c_funloc
+
+! CHECK-LABEL: func.func @_QPtest() {
+! CHECK: %[[VAL_1:.*]] = fir.address_of(@_QPfoo) : (!fir.ref<i32>) -> ()
+! CHECK: %[[VAL_2:.*]] = fir.emboxproc %[[VAL_1]] : ((!fir.ref<i32>) -> ()) -> !fir.boxproc<(!fir.ref<i32>) -> ()>
+! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_2]] : (!fir.boxproc<(!fir.ref<i32>) -> ()>) -> ((!fir.ref<i32>) -> ())
+! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : ((!fir.ref<i32>) -> ()) -> i64
+! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>
+! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK: fir.store %[[VAL_5]] to %[[VAL_7]] : !fir.ref<i64>
+
+subroutine test()
+ use iso_c_binding
+ interface
+ subroutine foo(i)
+ integer :: i
+ end
+ end interface
+
+ type(c_funptr) :: tmp_cptr
+
+ tmp_cptr = c_funloc(foo)
+end
More information about the flang-commits
mailing list