[flang] Support lowering of C_PTR and C_FUNPTR argument with VALUE attribute

[peixin]

Summary

As Fortran 2018 18.3.2, C_PTR is interoperable with any C object pointer
type. C_FUNPTR is interoperable with any C function pointer type. As
18.3.6, a C pointer can correspond to a Fortran dummy argument of type
C_PTR with the VALUE attribute.

The interface for type(C_PTR)/type(C_FUNPTR) argument with value
attribute is different from the the usual derived type. For type(C_PTR)
or type(C_FUNPTR), the component is the address, and the interface is
a pointer even with VALUE attribute. For a usual derived type such as
the drived type with the component of integer 64, the interface is a i64
value when it has VALUE attribute on aarch64 linux.

To lower the type(C_PTR)/type(C_FUNPTR) argument with value attribute,
get the value of the component of the type(C_PTR)/type(C_FUNPTR), which
is the address, and then convert it to the pointer and pass it.

[clementval]

flang/lib/Lower/CallInterface.cpp

890–891

What happen if a user make a type with a field with the same name? Cannot you make sure we are dealing with a type(c_ptr)?

type mytype
  integer :: __address
end type

892

Expand auto

flang/lib/Lower/ConvertExpr.cpp

2481–2482

Expand auto here as well.

[peixin]

flang/lib/Lower/CallInterface.cpp

890–891

Good catch. Update by checking if it is the type of builtin c_ptr/c_funptr.

892

Fixed.

flang/lib/Lower/ConvertExpr.cpp

2481–2482

Fixed.

BTW, when I read the lowering code, it uses auto sometimes, but uses mlir::Type or mlir::Value somtimes for the similar code. I am really confused about this. Is there one rule for this?

[peixin]

Add the check for the interface of "!fir.ref<i64>".

[clementval]

flang/lib/Lower/ConvertExpr.cpp

2481–2482

We follow LLVM guidelines. When the type is obvious you can use auto like you did in your code. Otherwise it is preferred to expand auto. We tried to update all occurrences of auto where it was needed during the upstreaming but we might have missed a couple.

auto recTy = fir::unwrapRefType(fromTy).dyn_cast_or_null<fir::RecordType>();

[peixin]

flang/lib/Lower/ConvertExpr.cpp

2481–2482

Got it. Thanks a lot.

[jeanPerier]

Thanks for looking into this. So, on aarch64, a struct containing an intptr is not passed as a void* ?

Basically, if in C, typedef struct {intptr_t ptr;} builtin_cptr; is guaranteed to be passed the same way as a void*, then I do not think something special is needed here. But I am not sure this is guaranteed by C, although this may hold true on the targets of interests for flang. Otherwise, your patch makes some sense to me, but I am wondering if we should not lower the builtinCPtr type to "fir.llvm_ptr<none>" instead of special casing the function interface (I have not tested this, and you might hit a few issues if you go that way, like passing C_PTR by reference. I am not sure fir.ref<fir.llvm_ptr<none>> is a legal type).

The reason I am thinking this is that having both C_PTR values lowered to "fir.ref<none>" and a !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> might be a pain. For instance, with your patch the following would probably crash because the patch dealt with the call side, but not the callee side where the fir.ref<none> should be converted back to a !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> so that later usages of it will behave correctly:

subroutine issue(ptr1) bind(c)
  use, intrinsic :: iso_c_binding
  type(c_ptr), value :: ptr1
  type(c_ptr) :: local
  local = ptr1
end subroutine

So I am wondering if C_PTR should not be a C pointer in FIR, after all, we have pointers.

[peixin]

In D131583#3742090, @jeanPerier wrote:

Thanks for looking into this. So, on aarch64, a struct containing an intptr is not passed as a void* ?

Basically, if in C, typedef struct {intptr_t ptr;} builtin_cptr; is guaranteed to be passed the same way as a void*, then I do not think something special is needed here. But I am not sure this is guaranteed by C, although this may hold true on the targets of interests for flang. Otherwise, your patch makes some sense to me, but I am wondering if we should not lower the builtinCPtr type to "fir.llvm_ptr<none>" instead of special casing the function interface (I have not tested this, and you might hit a few issues if you go that way, like passing C_PTR by reference. I am not sure fir.ref<fir.llvm_ptr<none>> is a legal type).

I don't think this is arch-dependent. Check the following case:

$ cat func.c 
#include<stdio.h>
struct builtin_cptr {
  __intptr_t ptr;
};

void c_func_(struct builtin_cptr t1) {
  printf("%ld\n", t1.ptr);
}

$ clang func.c -S -emit-llvm
$ cat func.ll 

target triple = "aarch64-unknown-linux-gnu"
%struct.builtin_cptr = type { i64 }
define dso_local void @c_func_(i64 %0) #0 {

$ clang func.c -S -emit-llvm --target=x86_64-unknown-linux-gnu
$ cat func.ll 
...
target triple = "x86_64-unknown-linux-gnu"
%struct.builtin_cptr = type { i64 }
define dso_local void @c_func_(i64 %0) #0 {

The reason I am thinking this is that having both C_PTR values lowered to "fir.ref<none>" and a !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> might be a pain. For instance, with your patch the following would probably crash because the patch dealt with the call side, but not the callee side where the fir.ref<none> should be converted back to a !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> so that later usages of it will behave correctly:

subroutine issue(ptr1) bind(c)
  use, intrinsic :: iso_c_binding
  type(c_ptr), value :: ptr1
  type(c_ptr) :: local
  local = ptr1
end subroutine

So I am wondering if C_PTR should not be a C pointer in FIR, after all, we have pointers.

Well, I missed this case. This is also not supported without this patch. Here is what LLVMIR classic-flang generated:

%struct.BSS1 = type <{ [8 x i8] }>
%struct_iso_c_binding_10_ = type <{ [16 x i8] }>
%struct.c_ptr.dt57 = type { i64 }

@.BSS1 = internal global %struct.BSS1 zeroinitializer, align 32
@_iso_c_binding_10_ = external global %struct_iso_c_binding_10_, align 64

define void @issue(i64* %_V_ptr1.arg) #0 !dbg !5 {
L.entry:
  %_V_ptr1.addr = alloca %struct.c_ptr.dt57, align 8
  %ptr1_343 = alloca %struct.c_ptr.dt57, align 8
  %"issue__$eq_342" = alloca [16 x i8], align 4
  %0 = bitcast %struct.c_ptr.dt57* %_V_ptr1.addr to i64**
  store i64* %_V_ptr1.arg, i64** %0, align 8
  %1 = bitcast %struct.c_ptr.dt57* %_V_ptr1.addr to i64*
  %2 = load volatile i64, i64* %1, align 8
  %3 = bitcast %struct.c_ptr.dt57* %ptr1_343 to i64*
  store i64 %2, i64* %3, align 8
  br label %L.LB1_361

L.LB1_361:                                        ; preds = %L.entry
  %4 = bitcast %struct.c_ptr.dt57* %ptr1_343 to i64*, !dbg !12
  %5 = load i64, i64* %4, align 8, !dbg !12
  %6 = bitcast %struct.BSS1* @.BSS1 to i64*, !dbg !12
  store i64 %5, i64* %6, align 8, !dbg !12
  ret void, !dbg !13
}

We can also allocate one temporary TYPE(C_PTR) and assign the value of argument to it and map the mlir::Value of temporary TYPE(C_PTR)` to the symbol ptr1`. Is that right?

[jeanPerier]

We can also allocate one temporary TYPE(C_PTR) and assign the value of argument to it and map the mlir::Value of temporary TYPE(C_PTR) to the symbol ptr1. Is that right?

Yes, I think that would work too.

[peixin]

1. Support the callee side.

2. Add TODO for derived type passed by value in callee, which has unexpected behaviors previously.

[jeanPerier]

Overall strategy looks reasonable to me.

flang/lib/Lower/Bridge.cpp

2731 ↗

(On Diff #455581)

I think you should share "isBuiltinCPtr" that is used here: https://github.com/llvm/llvm-project/blob/dc477a8161984dc5b8e245800e1166eb81394df6/flang/lib/Lower/ConvertExpr.cpp#L960

flang/lib/Lower/CallInterface.cpp

893

It would make sense to me to have a fir::isa_builtin_cptr_type(fir::recordType) helper defined in FIRType.h/.cpp to centralize the magic string definition and test (it is done here and in ConvertExpr.cpp).

[peixin]

Address the comments.

[peixin]

flang/lib/Lower/Bridge.cpp

2731 ↗

(On Diff #455581)

Thanks for pointing out the helper function. Fixed.

flang/lib/Lower/CallInterface.cpp

893

Good point. Fixed.

[jeanPerier]

LGTM, thanks for addressing the comments.

flang/lib/Lower/CallInterface.cpp

if (obj.attrs.test(Attrs::Allocatable) || obj.attrs.test(Attrs::Pointer)) {
       // Pass as fir.ref unless it's by VALUE and BIND(C)
       mlir::Type passType = fir::ReferenceType::get(type);
       PassEntityBy passBy = PassEntityBy::BaseAddress;
       Property prop = Property::BaseAddress;
       if (isValueAttr) {
         if (isBindC) {
           passBy = PassEntityBy::Value;
           prop = Property::Value;
+          auto recTy = type.dyn_cast_or_null<fir::RecordType>();
+          llvm::StringRef builtinCPtrName = "T__builtin_c_ptr";
+          llvm::StringRef builtinCFunptrName = "T__builtin_c_funptr";
+          if (recTy && (recTy.getName().endswith(builtinCPtrName) ||
+                        recTy.getName().endswith(builtinCFunptrName))) {
+            mlir::Type fieldTy = recTy.getTypeList()[0].second;
+            passType = fir::ReferenceType::get(fieldTy);
+          } else {
             passType = type;
+          }
         } else {
           passBy = PassEntityBy::BaseAddressValueAttribute;
         }
       }
       addFirOperand(passType, nextPassedArgPosition(), prop, attrs);
       addPassedArg(passBy, entity, characteristics);
     }
   }

flang/lib/Lower/ConvertExpr.cpp

ExtValue genProcedureRef(const Fortran::evaluate::ProcedureRef &procRef,
     // or pointer variable on the caller side (see 8.5.3 note 1 for
     // allocatables). The few context where this can happen must call
     // genRawProcedureRef directly.
     if (const auto *box = res.getBoxOf<fir::MutableBoxValue>())
       return fir::factory::genMutableBoxRead(builder, getLoc(), *box);
     return res;
   }
 
+  /// Lower a type(C_PTR/C_FUNPTR) argument with VALUE attribute into a
+  /// reference. A C pointer can correspond to a Fortran dummy argument of type
+  /// C_PTR with the VALUE attribute. (see 18.3.6 note 3).
+  static mlir::Value
+  genRecordCPtrValueArg(Fortran::lower::AbstractConverter &converter,
+                        mlir::Value rec, mlir::Type ty) {
+    assert(fir::isa_derived(ty));
+    auto recTy = ty.dyn_cast<fir::RecordType>();
+    assert(recTy.getTypeList().size() == 1);
+    auto fieldName = recTy.getTypeList()[0].first;
+    mlir::Type fieldTy = recTy.getTypeList()[0].second;
+    fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+    mlir::Location loc = converter.getCurrentLocation();
+    auto fieldIndexType = fir::FieldType::get(ty.getContext());
+    mlir::Value field =
+        builder.create<fir::FieldIndexOp>(loc, fieldIndexType, fieldName, recTy,
+                                          /*typeParams=*/mlir::ValueRange{});
+    mlir::Value cAddr = builder.create<fir::CoordinateOp>(
+        loc, builder.getRefType(fieldTy), rec, field);
+    mlir::Value val = builder.create<fir::LoadOp>(loc, cAddr);
+    return builder.createConvert(loc, builder.getRefType(fieldTy), val);
+  }
+
   /// Given a call site for which the arguments were already lowered, generate
   /// the call and return the result. This function deals with explicit result
   /// allocation and lowering if needed. It also deals with passing the host
   /// link to internal procedures.
   ExtValue genCallOpAndResult(Fortran::lower::CallerInterface &caller,
                               mlir::FunctionType callSiteType,
                               llvm::Optional<mlir::Type> resultType) {
     mlir::Location loc = getLoc();
for (auto [fst, snd] :
         auto boxProcTy = builder.getBoxProcType(funcTy);
         if (mlir::Value host = argumentHostAssocs(converter, fst)) {
           cast = builder.create<fir::EmboxProcOp>(
               loc, boxProcTy, llvm::ArrayRef<mlir::Value>{fst, host});
         } else {
           cast = builder.create<fir::EmboxProcOp>(loc, boxProcTy, fst);
         }
       } else {
-        if (fir::isa_derived(snd)) {
+        mlir::Type fromTy = fst.getType();
+        auto recTy =
+            fir::unwrapRefType(fromTy).dyn_cast_or_null<fir::RecordType>();
+        // The interface for type(C_PTR/C_FUNPTR) is "!fir.ref<i64>".
+        llvm::StringRef builtinCPtrName = "T__builtin_c_ptr";
+        llvm::StringRef builtinCFunptrName = "T__builtin_c_funptr";
+        if (recTy &&
+            (recTy.getName().endswith(builtinCPtrName) ||
+             recTy.getName().endswith(builtinCFunptrName)) &&
+            snd.isa<fir::ReferenceType>() &&
+            fir::isa_integer(fir::unwrapRefType(snd))) {
+          cast = genRecordCPtrValueArg(converter, fst, recTy);
+        } else if (fir::isa_derived(snd)) {
           // FIXME: This seems like a serious bug elsewhere in lowering. Paper
           // over the problem for now.
           TODO(loc, "derived type argument passed by value");
-        }
-        assert(!fir::isa_derived(snd));
+        } else {
           cast = builder.convertWithSemantics(loc, snd, fst,
                                               callingImplicitInterface);
         }
+      }
       operands.push_back(cast);
     }
 
     // Add host associations as necessary.
     if (addHostAssociations)
       operands.push_back(converter.hostAssocTupleValue());
 
     auto call = builder.create<fir::CallOp>(loc, funcType.getResults(),

flang/test/Lower/c-interoperability-c-pointer.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func.func @_QPtest(
+! CHECK-SAME:                     %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "ptr1"},
+! CHECK-SAME:                     %[[VAL_1:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>> {fir.bindc_name = "ptr2"}) {
+! CHECK:         %[[VAL_2:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_2]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         %[[VAL_4:.*]] = fir.load %[[VAL_3]] : !fir.ref<i64>
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (i64) -> !fir.ref<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_1]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_funptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<i64>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> !fir.ref<i64>
+! CHECK:         fir.call @c_func(%[[VAL_5]], %[[VAL_9]]) : (!fir.ref<i64>, !fir.ref<i64>) -> ()
+! CHECK:         return
+! CHECK:       }
+! CHECK:       func.func private @c_func(!fir.ref<i64>, !fir.ref<i64>) attributes {fir.bindc_name = "c_func"}
+
+subroutine test(ptr1, ptr2)
+  use, intrinsic :: iso_c_binding
+  type(c_ptr) :: ptr1
+  type(c_funptr) :: ptr2
+
+  interface
+    subroutine c_func(c_t1, c_t2) bind(c, name="c_func")
+      import :: c_ptr, c_funptr
+      type(c_ptr), value :: c_t1
+      type(c_funptr), value :: c_t2
+    end
+  end interface
+
+  call c_func(ptr1, ptr2)
+end