Index: flang/include/flang/Lower/IntrinsicCall.h =================================================================== --- flang/include/flang/Lower/IntrinsicCall.h +++ flang/include/flang/Lower/IntrinsicCall.h @@ -45,7 +45,9 @@ /// Lower argument without assuming that the argument is fully defined. /// It can be used on unallocated allocatable, disassociated pointer, /// or absent optional. This is meant for inquiry intrinsic arguments. - Inquired + Inquired, + /// C address of argument + BaseAddr }; /// Define how a given intrinsic argument must be lowered. @@ -61,6 +63,8 @@ // - absent box // AsInquired: // - no-op + // BaseAddr + // - assumed type: TODO bool handleDynamicOptional; }; Index: flang/lib/Lower/ConvertExpr.cpp =================================================================== --- flang/lib/Lower/ConvertExpr.cpp +++ flang/lib/Lower/ConvertExpr.cpp @@ -2267,6 +2267,9 @@ case Fortran::lower::LowerIntrinsicArgAs::Inquired: operands.emplace_back(optional); continue; + case Fortran::lower::LowerIntrinsicArgAs::BaseAddr: + TODO(loc, "intrinsic procedure with base address argument"); + continue; } llvm_unreachable("bad switch"); } @@ -2283,6 +2286,18 @@ case Fortran::lower::LowerIntrinsicArgAs::Inquired: operands.emplace_back(lowerIntrinsicArgumentAsInquired(*expr)); continue; + case Fortran::lower::LowerIntrinsicArgAs::BaseAddr: { + if (arg.value()->Rank() > 0 && + Fortran::evaluate::IsObjectPointer(*expr, + converter.getFoldingContext())) + TODO(loc, "pointer array argument as base address in procedure"); + Fortran::lower::CallerInterface caller(procRef, converter); + CopyOutPairs copyOutPairs; + operands.emplace_back(prepareActualToBaseAddressLike( + *expr, caller.getPassedArguments()[arg.index()], copyOutPairs, + /*byValue=*/false)); + } + continue; } llvm_unreachable("bad switch"); } @@ -4944,6 +4959,9 @@ case Fortran::lower::LowerIntrinsicArgAs::Inquired: TODO(loc, "intrinsic function with inquired argument"); break; + case Fortran::lower::LowerIntrinsicArgAs::BaseAddr: + TODO(loc, "intrinsic function with base address argument"); + break; } } } Index: flang/lib/Lower/IntrinsicCall.cpp =================================================================== --- flang/lib/Lower/IntrinsicCall.cpp +++ flang/lib/Lower/IntrinsicCall.cpp @@ -472,6 +472,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, @@ -626,13 +627,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; @@ -648,6 +651,7 @@ constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr; constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box; constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired; +constexpr auto asBaseAddr = Fortran::lower::LowerIntrinsicArgAs::BaseAddr; using I = IntrinsicLibrary; /// Flag to indicate that an intrinsic argument has to be handled as @@ -655,8 +659,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 @@ -693,6 +697,7 @@ {{{"pointer", asInquired}, {"target", asInquired}}}, /*isElemental=*/false}, {"btest", &I::genBtest}, + {"c_loc", &I::genCLoc, {{{"x", asBaseAddr}}}, /*isElemental=*/false}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, {"cmplx", @@ -2355,6 +2360,27 @@ 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); + mlir::Value argAddrVal = + builder.createConvert(loc, fieldTy, fir::getBase(args[0])); + 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) { @@ -4231,12 +4257,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; Index: flang/test/Lower/Intrinsics/c_loc.f90 =================================================================== --- /dev/null +++ flang/test/Lower/Intrinsics/c_loc.f90 @@ -0,0 +1,542 @@ +! 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_no_attribute() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_no_attributeEi) : !fir.ref +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_no_attributeEptr"} +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_4]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_3]] to %[[VAL_5]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine c_loc_no_attribute() + use iso_c_binding + type(c_ptr) :: ptr + integer :: i = 10 + ptr = c_loc(i) +end + +! 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.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_0]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_4]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_3]] to %[[VAL_5]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! 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.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_4]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_3]] to %[[VAL_5]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! 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:.*]] = fir.convert %[[VAL_2]] : (i64) -> index +! CHECK: %[[VAL_4:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_5:.*]] = arith.subi %[[VAL_3]], %[[VAL_4]] : index +! CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> !fir.ref>> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_5]] : (!fir.ref>>, index) -> !fir.ref> +! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref>) -> !fir.ref> +! CHECK: %[[VAL_9:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_11:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_11]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_15]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: fir.store %[[VAL_17]] to %[[VAL_16]] : !fir.ref +! CHECK: return +! 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:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arrayEptr"} +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_4]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_3]] to %[[VAL_5]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! 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:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_chararrayEptr"} +! CHECK: %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_3:.*]] = fir.convert %[[VAL_0]] : (!fir.ref>>) -> i64 +! CHECK: %[[VAL_4:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_4]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_3]] to %[[VAL_5]] : !fir.ref +! CHECK: %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_6]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.load %[[VAL_7]] : !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_9]] : !fir.ref +! CHECK: return +! 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.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_5]] : (!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_6]], %[[VAL_8]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_7]] to %[[VAL_9]] : !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_10]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_12]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_11]] : !fir.ref +! CHECK: fir.store %[[VAL_14]] to %[[VAL_13]] : !fir.ref +! CHECK: return +! 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.box_addr %[[VAL_14]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[VAL_16:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_17:.*]] = fir.convert %[[VAL_15]] : (!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_16]], %[[VAL_18]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_17]] to %[[VAL_19]] : !fir.ref +! CHECK: %[[VAL_20:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_20]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_22:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_23:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_22]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.load %[[VAL_21]] : !fir.ref +! CHECK: fir.store %[[VAL_24]] to %[[VAL_23]] : !fir.ref +! CHECK: return +! 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_allocatable_array() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box>> {bindc_name = "a", uniq_name = "_QFc_loc_allocatable_arrayEa"} +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.heap> {uniq_name = "_QFc_loc_allocatable_arrayEa.addr"} +! CHECK: %[[VAL_2:.*]] = fir.alloca index {uniq_name = "_QFc_loc_allocatable_arrayEa.lb0"} +! CHECK: %[[VAL_3:.*]] = fir.alloca index {uniq_name = "_QFc_loc_allocatable_arrayEa.ext0"} +! CHECK: %[[VAL_4:.*]] = fir.zero_bits !fir.heap> +! CHECK: fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_allocatable_arrayEptr"} +! CHECK: %[[VAL_6:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i32) -> index +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_9:.*]] = arith.cmpi sgt, %[[VAL_7]], %[[VAL_8]] : index +! CHECK: %[[VAL_10:.*]] = arith.select %[[VAL_9]], %[[VAL_7]], %[[VAL_8]] : index +! CHECK: %[[VAL_11:.*]] = fir.allocmem !fir.array, %[[VAL_10]] {uniq_name = "_QFc_loc_allocatable_arrayEa.alloc"} +! CHECK: fir.store %[[VAL_11]] to %[[VAL_1]] : !fir.ref>> +! CHECK: fir.store %[[VAL_10]] to %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_12:.*]] = arith.constant 1 : index +! CHECK: fir.store %[[VAL_12]] to %[[VAL_2]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_14:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_16:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_17:.*]] = arith.cmpi ne, %[[VAL_15]], %[[VAL_16]] : i64 +! CHECK: %[[VAL_18:.*]]:2 = fir.if %[[VAL_17]] -> (i1, !fir.heap>) { +! CHECK: %[[VAL_19:.*]] = arith.constant false +! CHECK: %[[VAL_20:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.if %[[VAL_19]] -> (!fir.heap>) { +! CHECK: %[[VAL_22:.*]] = fir.allocmem !fir.array, %[[VAL_20]] {uniq_name = ".auto.alloc"} +! CHECK: %[[VAL_23:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.shape %[[VAL_23]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_25:.*]] = fir.array_load %[[VAL_22]](%[[VAL_24]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK: %[[VAL_26:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_27:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_28:.*]] = arith.subi %[[VAL_23]], %[[VAL_26]] : index +! CHECK: %[[VAL_29:.*]] = fir.do_loop %[[VAL_30:.*]] = %[[VAL_27]] to %[[VAL_28]] step %[[VAL_26]] unordered iter_args(%[[VAL_31:.*]] = %[[VAL_25]]) -> (!fir.array) { +! CHECK: %[[VAL_32:.*]] = fir.array_update %[[VAL_31]], %[[VAL_13]], %[[VAL_30]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[VAL_32]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_25]], %[[VAL_33:.*]] to %[[VAL_22]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_22]] : !fir.heap> +! CHECK: } else { +! CHECK: %[[VAL_34:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_35:.*]] = fir.shape %[[VAL_34]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_36:.*]] = fir.array_load %[[VAL_14]](%[[VAL_35]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK: %[[VAL_37:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_38:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_39:.*]] = arith.subi %[[VAL_34]], %[[VAL_37]] : index +! CHECK: %[[VAL_40:.*]] = fir.do_loop %[[VAL_41:.*]] = %[[VAL_38]] to %[[VAL_39]] step %[[VAL_37]] unordered iter_args(%[[VAL_42:.*]] = %[[VAL_36]]) -> (!fir.array) { +! CHECK: %[[VAL_43:.*]] = fir.array_update %[[VAL_42]], %[[VAL_13]], %[[VAL_41]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[VAL_43]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_36]], %[[VAL_44:.*]] to %[[VAL_14]] : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.result %[[VAL_14]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_19]], %[[VAL_45:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: fir.result %{{.*}}, %[[VAL_14]] : i1, !fir.heap> +! CHECK: } +! CHECK: %[[VAL_53:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: fir.if %[[VAL_54:.*]]#0 { +! CHECK: %[[VAL_55:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: fir.if %[[VAL_17]] { +! CHECK: fir.freemem %[[VAL_14]] : !fir.heap> +! CHECK: } +! CHECK: fir.store %[[VAL_54]]#1 to %[[VAL_1]] : !fir.ref>> +! CHECK: fir.store %[[VAL_53]] to %[[VAL_3]] : !fir.ref +! CHECK: fir.store %[[VAL_55]] to %[[VAL_2]] : !fir.ref +! CHECK: } +! CHECK: %[[VAL_56:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_57:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_58:.*]] = fir.convert %[[VAL_56]] : (!fir.heap>) -> i64 +! CHECK: %[[VAL_59:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_60:.*]] = fir.coordinate_of %[[VAL_57]], %[[VAL_59]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_58]] to %[[VAL_60]] : !fir.ref +! CHECK: %[[VAL_61:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_62:.*]] = fir.coordinate_of %[[VAL_57]], %[[VAL_61]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_63:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_64:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_63]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_65:.*]] = fir.load %[[VAL_62]] : !fir.ref +! CHECK: fir.store %[[VAL_65]] to %[[VAL_64]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine c_loc_allocatable_array() + use iso_c_binding + type(c_ptr) :: ptr + integer, allocatable :: a(:) + allocate(a(10)) + a = 10 + ptr = c_loc(a) +end + +! CHECK-LABEL: func.func @_QPc_loc_non_save_allocatable_scalar() { +! CHECK: %[[VAL_0:.*]] = fir.alloca !fir.box> {bindc_name = "i", uniq_name = "_QFc_loc_non_save_allocatable_scalarEi"} +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.heap {uniq_name = "_QFc_loc_non_save_allocatable_scalarEi.addr"} +! CHECK: %[[VAL_2:.*]] = fir.zero_bits !fir.heap +! 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_allocatable_scalarEptr"} +! CHECK: %[[VAL_4:.*]] = fir.allocmem i32 {uniq_name = "_QFc_loc_non_save_allocatable_scalarEi.alloc"} +! CHECK: fir.store %[[VAL_4]] to %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_5:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_9:.*]] = arith.cmpi ne, %[[VAL_7]], %[[VAL_8]] : i64 +! CHECK: %[[VAL_10:.*]]:2 = fir.if %[[VAL_9]] -> (i1, !fir.heap) { +! CHECK: %[[VAL_11:.*]] = arith.constant false +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_11]] -> (!fir.heap) { +! CHECK: %[[VAL_13:.*]] = fir.allocmem i32 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_13]] : !fir.heap +! CHECK: } else { +! CHECK: fir.result %[[VAL_6]] : !fir.heap +! CHECK: } +! CHECK: fir.result %[[VAL_11]], %[[VAL_14:.*]] : i1, !fir.heap +! CHECK: } else { +! CHECK: %[[VAL_15:.*]] = arith.constant true +! CHECK: %[[VAL_16:.*]] = fir.allocmem i32 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_15]], %[[VAL_16]] : i1, !fir.heap +! CHECK: } +! CHECK: fir.store %[[VAL_5]] to %[[VAL_17:.*]]#1 : !fir.heap +! CHECK: fir.if %[[VAL_17]]#0 { +! CHECK: fir.if %[[VAL_9]] { +! CHECK: fir.freemem %[[VAL_6]] : !fir.heap +! CHECK: } +! CHECK: fir.store %[[VAL_17]]#1 to %[[VAL_1]] : !fir.ref> +! CHECK: } +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_1]] : !fir.ref> +! CHECK: %[[VAL_19:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_18]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_21:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_22:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_21]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_20]] to %[[VAL_22]] : !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_24:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_23]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_25:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_26:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_25]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_27:.*]] = fir.load %[[VAL_24]] : !fir.ref +! CHECK: fir.store %[[VAL_27]] to %[[VAL_26]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine c_loc_non_save_allocatable_scalar() + use iso_c_binding + type(c_ptr) :: ptr + integer, allocatable :: i + allocate(i) + i = 10 + ptr = c_loc(i) +end + +! CHECK-LABEL: func.func @_QPc_loc_save_allocatable_scalar() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_save_allocatable_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_save_allocatable_scalarEptr"} +! CHECK: %[[VAL_2:.*]] = fir.allocmem i32 {uniq_name = "_QFc_loc_save_allocatable_scalarEi.alloc"} +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_2]] : (!fir.heap) -> !fir.box> +! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_8:.*]] = arith.constant 0 : i64 +! CHECK: %[[VAL_9:.*]] = arith.cmpi ne, %[[VAL_7]], %[[VAL_8]] : i64 +! CHECK: %[[VAL_10:.*]]:2 = fir.if %[[VAL_9]] -> (i1, !fir.heap) { +! CHECK: %[[VAL_11:.*]] = arith.constant false +! CHECK: %[[VAL_12:.*]] = fir.if %[[VAL_11]] -> (!fir.heap) { +! CHECK: %[[VAL_13:.*]] = fir.allocmem i32 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_13]] : !fir.heap +! CHECK: } else { +! CHECK: fir.result %[[VAL_6]] : !fir.heap +! CHECK: } +! CHECK: fir.result %[[VAL_11]], %[[VAL_14:.*]] : i1, !fir.heap +! CHECK: } else { +! CHECK: %[[VAL_15:.*]] = arith.constant true +! CHECK: %[[VAL_16:.*]] = fir.allocmem i32 {uniq_name = ".auto.alloc"} +! CHECK: fir.result %[[VAL_15]], %[[VAL_16]] : i1, !fir.heap +! CHECK: } +! CHECK: fir.store %[[VAL_4]] to %[[VAL_17:.*]]#1 : !fir.heap +! CHECK: fir.if %[[VAL_17]]#0 { +! CHECK: fir.if %[[VAL_9]] { +! CHECK: fir.freemem %[[VAL_6]] : !fir.heap +! CHECK: } +! CHECK: %[[VAL_18:.*]] = fir.embox %[[VAL_17]]#1 : (!fir.heap) -> !fir.box> +! CHECK: fir.store %[[VAL_18]] to %[[VAL_0]] : !fir.ref>> +! CHECK: } +! CHECK: %[[VAL_19:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_20:.*]] = fir.box_addr %[[VAL_19]] : (!fir.box>) -> !fir.heap +! CHECK: %[[VAL_21:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_20]] : (!fir.heap) -> i64 +! CHECK: %[[VAL_23:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_24:.*]] = fir.coordinate_of %[[VAL_21]], %[[VAL_23]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_22]] to %[[VAL_24]] : !fir.ref +! CHECK: %[[VAL_25:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_26:.*]] = fir.coordinate_of %[[VAL_21]], %[[VAL_25]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_27:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_28:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_27]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_29:.*]] = fir.load %[[VAL_26]] : !fir.ref +! CHECK: fir.store %[[VAL_29]] to %[[VAL_28]] : !fir.ref +! CHECK: return +! CHECK: } + +subroutine c_loc_save_allocatable_scalar() + use iso_c_binding + type(c_ptr) :: ptr + integer, allocatable, save :: i + allocate(i) + i = 10 + ptr = c_loc(i) +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.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_11:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_11]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_15]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: fir.store %[[VAL_17]] to %[[VAL_16]] : !fir.ref +! CHECK: return +! 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_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_save_pointer_scalarEptr"} +! CHECK: %[[VAL_2:.*]] = fir.allocmem i32 {uniq_name = "_QFc_loc_save_pointer_scalarEi.alloc"} +! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_2]] : (!fir.heap) -> !fir.box> +! CHECK: fir.store %[[VAL_3]] to %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_4:.*]] = arith.constant 10 : i32 +! CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_0]] : !fir.ref>> +! CHECK: %[[VAL_6:.*]] = fir.box_addr %[[VAL_5]] : (!fir.box>) -> !fir.ptr +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ptr +! 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.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.convert %[[VAL_8]] : (!fir.ptr) -> i64 +! CHECK: %[[VAL_11:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_11]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_10]] to %[[VAL_12]] : !fir.ref +! CHECK: %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_15]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_14]] : !fir.ref +! CHECK: fir.store %[[VAL_17]] to %[[VAL_16]] : !fir.ref +! CHECK: return +! 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_0:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_derived_typeEptr"} +! 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_2:.*]] = fir.embox %[[VAL_1]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[VAL_5:.*]] = fir.convert %[[VAL_2]] : (!fir.box>) -> !fir.box +! CHECK: %[[VAL_7:.*]] = fir.call @_FortranAInitialize(%[[VAL_5]], %{{.*}}, %{{.*}}) : (!fir.box, !fir.ref, i32) -> none +! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_1]] : (!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_8]], %[[VAL_10]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_9]] to %[[VAL_11]] : !fir.ref +! CHECK: %[[VAL_12:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_8]], %[[VAL_12]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_14:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_14]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.load %[[VAL_13]] : !fir.ref +! CHECK: fir.store %[[VAL_16]] to %[[VAL_15]] : !fir.ref +! CHECK: return +! 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 + +! TODO: +!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