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/include/flang/Optimizer/Dialect/FIROps.td =================================================================== --- flang/include/flang/Optimizer/Dialect/FIROps.td +++ flang/include/flang/Optimizer/Dialect/FIROps.td @@ -2851,4 +2851,24 @@ let results = (outs BoolLike); } +def fir_PtrToIntOp : fir_OneResultOp<"ptrtoint", [NoSideEffect]> { + let summary = "Convert from pointer address to integer"; + + let description = [{ + Convert the address of a entity or procedure into integer. + + ```mlir + %i = fir.ptrtoint %addr : (!fir.ref) -> i64 + ``` + }]; + + let arguments = (ins fir_ReferenceType:$addr); + + let results = (outs AnyIntegerType); + + let assemblyFormat = [{ + $addr attr-dict `:` functional-type($addr, results) + }]; +} + #endif Index: flang/lib/Lower/ConvertExpr.cpp =================================================================== --- flang/lib/Lower/ConvertExpr.cpp +++ flang/lib/Lower/ConvertExpr.cpp @@ -2221,9 +2221,14 @@ 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"); } + CopyOutPairs copyOutPairs; + Fortran::lower::CallerInterface caller(procRef, converter); switch (argRules.lowerAs) { case Fortran::lower::LowerIntrinsicArgAs::Value: operands.emplace_back(genval(*expr)); @@ -2237,6 +2242,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"); } @@ -4876,6 +4893,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,29 @@ return builder.createConvert(loc, resultType, res); } +// C_LOC +fir::ExtendedValue +IntrinsicLibrary::genCLoc(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1 && resultType.isa()); + mlir::Value argAddr = fir::getBase(args[0]); + 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::Type addrTy = fir::ReferenceType::get(builder.getI8Type()); + mlir::Value addr = builder.createConvert(loc, addrTy, argAddr); + mlir::Value addrVal = builder.create(loc, fieldTy, addr); + 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, addrVal, resAddr); + return res; +} + // CEILING mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType, llvm::ArrayRef args) { @@ -4231,12 +4259,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/lib/Optimizer/CodeGen/CodeGen.cpp =================================================================== --- flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2774,6 +2774,21 @@ rewriter.setInsertionPointToEnd(newBlock); } +/// Conversion of `fir.ptrtoint` +struct PtrToIntOpConversion : public FIROpConversion { + using FIROpConversion::FIROpConversion; + + mlir::LogicalResult + matchAndRewrite(fir::PtrToIntOp ptrToIntOp, OpAdaptor adaptor, + mlir::ConversionPatternRewriter &rewriter) const override { + mlir::ValueRange operands = adaptor.getOperands(); + mlir::Type resTy = convertType(ptrToIntOp.getType()); + rewriter.replaceOpWithNewOp(ptrToIntOp, resTy, + operands[0]); + return mlir::success(); + } +}; + /// Conversion of `fir.select_case` /// /// The `fir.select_case` operation is converted to a if-then-else ladder. @@ -3363,14 +3378,14 @@ GlobalOpConversion, HasValueOpConversion, InsertOnRangeOpConversion, InsertValueOpConversion, IsPresentOpConversion, LenParamIndexOpConversion, LoadOpConversion, MulcOpConversion, - NegcOpConversion, NoReassocOpConversion, SelectCaseOpConversion, - SelectOpConversion, SelectRankOpConversion, SelectTypeOpConversion, - ShapeOpConversion, ShapeShiftOpConversion, ShiftOpConversion, - SliceOpConversion, StoreOpConversion, StringLitOpConversion, - SubcOpConversion, UnboxCharOpConversion, UnboxProcOpConversion, - UndefOpConversion, UnreachableOpConversion, XArrayCoorOpConversion, - XEmboxOpConversion, XReboxOpConversion, ZeroOpConversion>(typeConverter, - options); + NegcOpConversion, NoReassocOpConversion, PtrToIntOpConversion, + SelectCaseOpConversion, SelectOpConversion, SelectRankOpConversion, + SelectTypeOpConversion, ShapeOpConversion, ShapeShiftOpConversion, + ShiftOpConversion, SliceOpConversion, StoreOpConversion, + StringLitOpConversion, SubcOpConversion, UnboxCharOpConversion, + UnboxProcOpConversion, UndefOpConversion, UnreachableOpConversion, + XArrayCoorOpConversion, XEmboxOpConversion, XReboxOpConversion, + ZeroOpConversion>(typeConverter, options); mlir::populateFuncToLLVMConversionPatterns(typeConverter, pattern); mlir::populateOpenMPToLLVMConversionPatterns(typeConverter, pattern); mlir::arith::populateArithmeticToLLVMConversionPatterns(typeConverter, Index: flang/test/Fir/ptr-to-int.fir =================================================================== --- /dev/null +++ flang/test/Fir/ptr-to-int.fir @@ -0,0 +1,14 @@ +// RUN: tco %s | FileCheck %s +// RUN: %flang_fc1 -emit-llvm %s -o - | FileCheck %s + +// UNSUPPORTED: system-windows + +// CHECK-LABEL: define i64 @ptrtoint_test +// CHECK: %[[alloc:.*]] = alloca i8, i64 1 +// CHECK: %[[res:.*]] = ptrtoint ptr %[[alloc]] to i64 +// CHECK: ret i64 %[[res]] +func.func @ptrtoint_test() -> i64 { + %0 = fir.alloca i8 + %1 = fir.ptrtoint %0 : (!fir.ref) -> i64 + return %1 : i64 +} Index: flang/test/Lower/Intrinsics/c_loc.f90 =================================================================== --- /dev/null +++ flang/test/Lower/Intrinsics/c_loc.f90 @@ -0,0 +1,544 @@ +! 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) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.ptrtoint %[[VAL_3]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ref +! CHECK: %[[VAL_7:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !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) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.ptrtoint %[[VAL_3]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ref +! CHECK: %[[VAL_7:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !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>) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.ptrtoint %[[VAL_3]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ref +! CHECK: %[[VAL_7:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !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>) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.ptrtoint %[[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: %[[VAL_14:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_14]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_16]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_15]] : !fir.ref +! CHECK: fir.store %[[VAL_18]] to %[[VAL_17]] : !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>) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.ptrtoint %[[VAL_3]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ref +! CHECK: %[[VAL_7:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !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>>) -> !fir.ref +! CHECK: %[[VAL_4:.*]] = fir.ptrtoint %[[VAL_3]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_5:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_6:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_5]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_4]] to %[[VAL_6]] : !fir.ref +! CHECK: %[[VAL_7:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_8]] : !fir.ref +! CHECK: fir.store %[[VAL_11]] to %[[VAL_10]] : !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) -> !fir.ref +! CHECK: %[[VAL_8:.*]] = fir.ptrtoint %[[VAL_7]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_9:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_9]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_8]] to %[[VAL_10]] : !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_6]], %[[VAL_11]] : (!fir.ref>, !fir.field) -> !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_1]], %[[VAL_13]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_12]] : !fir.ref +! CHECK: fir.store %[[VAL_15]] to %[[VAL_14]] : !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>) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.ptrtoint %[[VAL_17]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_19:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_19]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_18]] to %[[VAL_20]] : !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_22:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_21]] : (!fir.ref>, !fir.field) -> !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_3]], %[[VAL_23]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_25:.*]] = fir.load %[[VAL_22]] : !fir.ref +! CHECK: fir.store %[[VAL_25]] to %[[VAL_24]] : !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: fir.result %[[VAL_22]] : !fir.heap> +! CHECK: } else { +! CHECK: fir.result %[[VAL_14]] : !fir.heap> +! CHECK: } +! CHECK: fir.result %[[VAL_19]], %[[VAL_23:.*]] : i1, !fir.heap> +! CHECK: } else { +! CHECK: fir.result +! CHECK: } +! CHECK: %[[VAL_31:.*]] = fir.load %[[VAL_3]] : !fir.ref +! CHECK: %[[VAL_32:.*]] = fir.shape %[[VAL_31]] : (index) -> !fir.shape<1> +! CHECK: %[[VAL_33:.*]] = fir.array_load %[[VAL_34:.*]]#1(%[[VAL_32]]) : (!fir.heap>, !fir.shape<1>) -> !fir.array +! CHECK: %[[VAL_35:.*]] = arith.constant 1 : index +! CHECK: %[[VAL_36:.*]] = arith.constant 0 : index +! CHECK: %[[VAL_37:.*]] = arith.subi %[[VAL_31]], %[[VAL_35]] : index +! CHECK: %[[VAL_38:.*]] = fir.do_loop %[[VAL_39:.*]] = %[[VAL_36]] to %[[VAL_37]] step %[[VAL_35]] unordered iter_args(%[[VAL_40:.*]] = %[[VAL_33]]) -> (!fir.array) { +! CHECK: %[[VAL_41:.*]] = fir.array_update %[[VAL_40]], %[[VAL_13]], %[[VAL_39]] : (!fir.array, i32, index) -> !fir.array +! CHECK: fir.result %[[VAL_41]] : !fir.array +! CHECK: } +! CHECK: fir.array_merge_store %[[VAL_33]], %[[VAL_42:.*]] to %[[VAL_34]]#1 : !fir.array, !fir.array, !fir.heap> +! CHECK: fir.if %[[VAL_34]]#0 { +! CHECK: %[[VAL_43:.*]] = fir.load %[[VAL_2]] : !fir.ref +! CHECK: fir.if %[[VAL_17]] { +! CHECK: fir.freemem %[[VAL_14]] : !fir.heap> +! CHECK: } +! CHECK: fir.store %[[VAL_34]]#1 to %[[VAL_1]] : !fir.ref>> +! CHECK: fir.store %[[VAL_31]] to %[[VAL_3]] : !fir.ref +! CHECK: fir.store %[[VAL_43]] to %[[VAL_2]] : !fir.ref +! CHECK: } +! CHECK: %[[VAL_44:.*]] = fir.load %[[VAL_1]] : !fir.ref>> +! CHECK: %[[VAL_45:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_44]] : (!fir.heap>) -> !fir.ref +! CHECK: %[[VAL_47:.*]] = fir.ptrtoint %[[VAL_46]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_48:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_49:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_48]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_47]] to %[[VAL_49]] : !fir.ref +! CHECK: %[[VAL_50:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_51:.*]] = fir.coordinate_of %[[VAL_45]], %[[VAL_50]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_52:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_53:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_52]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_54:.*]] = fir.load %[[VAL_51]] : !fir.ref +! CHECK: fir.store %[[VAL_54]] to %[[VAL_53]] : !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) -> !fir.ref +! CHECK: %[[VAL_21:.*]] = fir.ptrtoint %[[VAL_20]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_22:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_23:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_22]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_21]] to %[[VAL_23]] : !fir.ref +! CHECK: %[[VAL_24:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_19]], %[[VAL_24]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_27:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_26]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_28:.*]] = fir.load %[[VAL_25]] : !fir.ref +! CHECK: fir.store %[[VAL_28]] to %[[VAL_27]] : !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) -> !fir.ref +! CHECK: %[[VAL_23:.*]] = fir.ptrtoint %[[VAL_22]] : (!fir.ref) -> i64 +! CHECK: %[[VAL_24:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_21]], %[[VAL_24]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: fir.store %[[VAL_23]] to %[[VAL_25]] : !fir.ref +! CHECK: %[[VAL_26:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_27:.*]] = fir.coordinate_of %[[VAL_21]], %[[VAL_26]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_28:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_29:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_28]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_30:.*]] = fir.load %[[VAL_27]] : !fir.ref +! CHECK: fir.store %[[VAL_30]] to %[[VAL_29]] : !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) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.ptrtoint %[[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: %[[VAL_14:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_14]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_16]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_15]] : !fir.ref +! CHECK: fir.store %[[VAL_18]] to %[[VAL_17]] : !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) -> !fir.ref +! CHECK: %[[VAL_11:.*]] = fir.ptrtoint %[[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: %[[VAL_14:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_14]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_16:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_16]] : (!fir.ref>, !fir.field) -> !fir.ref +! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_15]] : !fir.ref +! CHECK: fir.store %[[VAL_18]] to %[[VAL_17]] : !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 +! CHECK: %[[VAL_8:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> +! CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_1]] : (!fir.ref>) -> !fir.ref +! CHECK: %[[VAL_10:.*]] = fir.ptrtoint %[[VAL_9]] : (!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_8]], %[[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_8]], %[[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_0]], %[[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_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