diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -478,6 +478,7 @@ fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef); void genCpuTime(llvm::ArrayRef); fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef); + fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef); void genDateAndTime(llvm::ArrayRef); mlir::Value genDim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genDotProduct(mlir::Type, @@ -645,13 +646,15 @@ bool handleDynamicOptional = false; }; +/// This is shared by intrinsics and intrinsic module procedures. struct Fortran::lower::IntrinsicArgumentLoweringRules { /// There is no more than 7 non repeated arguments in Fortran intrinsics. IntrinsicDummyArgument args[7]; constexpr bool hasDefaultRules() const { return args[0].name == nullptr; } }; -/// Structure describing what needs to be done to lower intrinsic "name". +/// Structure describing what needs to be done to lower intrinsic or intrinsic +/// module procedure "name". struct IntrinsicHandler { const char *name; IntrinsicLibrary::Generator generator; @@ -674,8 +677,8 @@ /// argument is an optional variable in the current scope). static constexpr bool handleDynamicOptional = true; -/// Table that drives the fir generation depending on the intrinsic. -/// one to one mapping with Fortran arguments. If no mapping is +/// Table that drives the fir generation depending on the intrinsic or intrinsic +/// module procedure one to one mapping with Fortran arguments. If no mapping is /// defined here for a generic intrinsic, genRuntimeCall will be called /// to look for a match in the runtime a emit a call. Note that the argument /// lowering rules for an intrinsic need to be provided only if at least one @@ -716,6 +719,7 @@ {"ble", &I::genBitwiseCompare}, {"blt", &I::genBitwiseCompare}, {"btest", &I::genBtest}, + {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, {"cmplx", @@ -2381,6 +2385,30 @@ return builder.createConvert(loc, resultType, res); } +// C_LOC +fir::ExtendedValue +IntrinsicLibrary::genCLoc(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1 && resultType.isa()); + auto resTy = resultType.dyn_cast(); + assert(resTy.getTypeList().size() == 1); + auto fieldName = resTy.getTypeList()[0].first; + auto fieldTy = resTy.getTypeList()[0].second; + mlir::Value res = builder.create(loc, resultType); + const auto *box = args[0].getBoxOf(); + assert(box && "c_loc argument must have been lowered to a fix.box"); + mlir::Value argAddr = + builder.create(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( + loc, fieldIndexType, fieldName, resTy, /*typeParams=*/mlir::ValueRange{}); + mlir::Value resAddr = builder.create( + loc, builder.getRefType(fieldTy), res, field); + builder.create(loc, argAddrVal, resAddr); + return res; +} + // CEILING mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, llvm::ArrayRef args) { @@ -4450,12 +4478,14 @@ } //===----------------------------------------------------------------------===// -// Argument lowering rules interface +// Argument lowering rules interface for intrinsic or intrinsic module +// procedure. //===----------------------------------------------------------------------===// const Fortran::lower::IntrinsicArgumentLoweringRules * -Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) { - if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName)) +Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef specificName) { + llvm::StringRef name = genericName(specificName); + if (const IntrinsicHandler *handler = findIntrinsicHandler(name)) if (!handler->argLoweringRules.hasDefaultRules()) return &handler->argLoweringRules; return nullptr; diff --git a/flang/test/Lower/Intrinsics/c_loc.f90 b/flang/test/Lower/Intrinsics/c_loc.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/Intrinsics/c_loc.f90 @@ -0,0 +1,266 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! Test intrinsic module procedure c_loc + +! CHECK-LABEL: func.func @_QPc_loc_scalar() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_scalarEi) : !fir.ref +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_scalarEptr"} +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box) -> !fir.ref +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_5]] to %[[VAL_7]] : !fir.ref +! CHECK: } + +subroutine c_loc_scalar() + use iso_c_binding + type(c_ptr) :: ptr + integer, target :: i = 10 + ptr = c_loc(i) +end + +! CHECK-LABEL: func.func @_QPc_loc_char() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_charEichr) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_charEptr"} +! CHECK: %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_4:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_5]] to %[[VAL_7]] : !fir.ref +! CHECK: } + +subroutine c_loc_char() + use iso_c_binding + type(c_ptr) :: ptr + character(5, kind=c_char), target :: ichr = "abcde" + ptr = c_loc(ichr) +end + +! CHECK-LABEL: func.func @_QPc_loc_substring() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_substringEichr) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_substringEptr"} +! CHECK: %[[VAL_2:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_3:.*]] = arith.constant 5 : i64 +! CHECK: %[[VAL_4:.*]] = fir.convert %[[VAL_2]] : (i64) -> index +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_3]] : (i64) -> index +! CHECK: %[[VAL_6:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_7:.*]] = arith.subi %[[VAL_4]], %[[VAL_6]] : index +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_8]], %[[VAL_7]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_5]], %[[VAL_4]] : index +! CHECK: %[[VAL_12:.*]] = arith.addi %[[VAL_11]], %[[VAL_6]] : index +! CHECK: %[[VAL_13:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_14:.*]] = arith.cmpi slt, %[[VAL_12]], %[[VAL_13]] : index +! CHECK: %[[VAL_15:.*]] = arith.select %[[VAL_14]], %[[VAL_13]], %[[VAL_12]] : index +! CHECK: %[[VAL_16:.*]] = fir.embox %[[VAL_10]] typeparams %[[VAL_15]] : (!fir.ref>, index) -> !fir.box> +! CHECK: %[[VAL_17:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_18:.*]] = fir.box_addr %[[VAL_16]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_20:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_17]], %[[VAL_20]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_19]] to %[[VAL_21]] : !fir.ref +! CHECK: } + +subroutine c_loc_substring() + use iso_c_binding + type(c_ptr) :: ptr + character(5, kind=c_char), target :: ichr = "abcde" + ptr = c_loc(ichr(2:)) +end + +! CHECK-LABEL: func.func @_QPc_loc_array() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arrayEa) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arrayEptr"} +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_0]](%[[VAL_3]]) : (!fir.ref>, !fir.shape<1>) -> !fir.box> +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_7]] to %[[VAL_9]] : !fir.ref +! CHECK: } + +subroutine c_loc_array + use iso_c_binding + type(c_ptr) :: ptr + integer, target :: a(10) = 10 + ptr = c_loc(a) +end + +! CHECK-LABEL: func.func @_QPc_loc_chararray() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_chararrayEichr) : !fir.ref>> +! CHECK: %[[VAL_1:.*]] = arith.constant 2 : index +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_chararrayEptr"} +! CHECK: %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_4:.*]] = fir.embox %[[VAL_0]](%[[VAL_3]]) : (!fir.ref>>, !fir.shape<1>) -> !fir.box>> +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box>>) -> !fir.ref>> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref>>) -> i64 +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_7]] to %[[VAL_9]] : !fir.ref +! CHECK: } + +subroutine c_loc_chararray() + use iso_c_binding + type(c_ptr) :: ptr + character(5, kind=c_char), target :: ichr(2) = "abcde" + ptr = c_loc(ichr) +end + +! CHECK-LABEL: func.func @_QPc_loc_arrayelement() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arrayelementEa) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arrayelementEptr"} +! CHECK: %[[VAL_2:.*]] = arith.constant 2 : i64 +! CHECK: %[[VAL_3:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_4:.*]] = arith.subi %[[VAL_2]], %[[VAL_3]] : i64 +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ref) -> !fir.box +! CHECK: %[[VAL_7:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_10:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_7]], %[[VAL_10]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_9]] to %[[VAL_11]] : !fir.ref +! CHECK: } + +subroutine c_loc_arrayelement() + use iso_c_binding + type(c_ptr) :: ptr + integer, target :: a(10) = 10 + ptr = c_loc(a(2)) +end + +! CHECK-LABEL: func.func @_QPc_loc_arraysection() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arraysectionEa) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = arith.constant 10 : index +! CHECK: %[[VAL_2:.*]] = fir.address_of(@_QFc_loc_arraysectionEind) : !fir.ref +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arraysectionEptr"} +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 1 : i64 +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index +! CHECK: %[[VAL_10:.*]] = arith.addi %[[VAL_4]], %[[VAL_1]] : index +! CHECK: %[[VAL_11:.*]] = arith.subi %[[VAL_10]], %[[VAL_4]] : index +! CHECK: %[[VAL_12:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_13:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[VAL_14:.*]] = fir.embox %[[VAL_0]](%[[VAL_12]]) {{\[}}%[[VAL_13]]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>) -> !fir.box> +! CHECK: %[[VAL_15:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_16:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_18:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_15]], %[[VAL_18]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_17]] to %[[VAL_19]] : !fir.ref +! CHECK: } + +subroutine c_loc_arraysection() + use iso_c_binding + type(c_ptr) :: ptr + integer :: ind = 3 + integer, target :: a(10) = 10 + ptr = c_loc(a(ind:)) +end + +! CHECK-LABEL: func.func @_QPc_loc_non_save_pointer_scalar() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "i", uniq_name = "_QFc_loc_non_save_pointer_scalarEi"} +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.ptr {uniq_name = "_QFc_loc_non_save_pointer_scalarEi.addr"} +! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.ptr +! CHECK: fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_non_save_pointer_scalarEptr"} +! CHECK: %[[VAL_4:.*]] = fir.allocmem i32 {uniq_name = "_QFc_loc_non_save_pointer_scalarEi.alloc"} +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.heap) -> !fir.ptr +! CHECK: fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref> +! CHECK: fir.store %[[VAL_6]] to %[[VAL_7]] : !fir.ptr +! CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8]] : (!fir.ptr) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box) -> !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_10]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_12]] to %[[VAL_14]] : !fir.ref +! CHECK: } + +subroutine c_loc_non_save_pointer_scalar() + use iso_c_binding + type(c_ptr) :: ptr + integer, pointer :: i + allocate(i) + i = 10 + ptr = c_loc(i) +end + +! CHECK-LABEL: func.func @_QPc_loc_save_pointer_scalar() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_save_pointer_scalarEi) : !fir.ref>> +! CHECK: %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box>) -> !fir.ptr +! CHECK: %[[VAL_9:.*]] = fir.embox %[[VAL_8:.*]] : (!fir.ptr) -> !fir.box +! CHECK: %[[VAL_10:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_11:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box) -> !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_10]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_12]] to %[[VAL_14]] : !fir.ref +! CHECK: } + +subroutine c_loc_save_pointer_scalar() + use iso_c_binding + type(c_ptr) :: ptr + integer, pointer, save :: i + allocate(i) + i = 10 + ptr = c_loc(i) +end + +! CHECK-LABEL: func.func @_QPc_loc_derived_type() { +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QFc_loc_derived_typeTt{i:i32}> {bindc_name = "tt", fir.target, uniq_name = "_QFc_loc_derived_typeEtt"} +! CHECK: %[[VAL_8:.*]] = fir.embox %[[VAL_1]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_8:.*]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_12:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_12]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_13]] : !fir.ref +! CHECK: } + +subroutine c_loc_derived_type + use iso_c_binding + type(c_ptr) :: ptr + type t + integer :: i = 1 + end type + type(t), target :: tt + ptr = c_loc(tt) +end + +! CHECK-LABEL: func.func @_QPc_loc_pointer_array() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "a", uniq_name = "_QFc_loc_pointer_arrayEa"} +! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_0]] : !fir.ref>>> +! CHECK: %[[VAL_31:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_32:.*]] = fir.box_addr %[[VAL_30:.*]] : (!fir.box>>) -> !fir.ptr> +! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.ptr>) -> i64 +! CHECK: %[[VAL_34:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_35:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_34]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_33]] to %[[VAL_35]] : !fir.ref +! CHECK: } + +subroutine c_loc_pointer_array + use iso_c_binding + type(c_ptr) :: ptr + integer, pointer :: a(:) + allocate(a(10)) + a = 10 + ptr = c_loc(a) +end