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.convert %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/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, @@ -693,6 +694,7 @@ {{{"pointer", asInquired}, {"target", asInquired}}}, /*isElemental=*/false}, {"btest", &I::genBtest}, + {"c_loc", &I::genCLoc, {{{"x", asAddr}}}, /*isElemental=*/false}, {"ceiling", &I::genCeiling}, {"char", &I::genChar}, {"cmplx", @@ -2355,6 +2357,31 @@ 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::Type argType = fir::getBase(args[0]).getType(); + if (!argType.isa()) + TODO(loc, "c_loc with argument lowered as value"); + 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, fir::getBase(args[0])); + 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) { Index: flang/lib/Optimizer/CodeGen/CodeGen.cpp =================================================================== --- flang/lib/Optimizer/CodeGen/CodeGen.cpp +++ flang/lib/Optimizer/CodeGen/CodeGen.cpp @@ -2774,6 +2774,22 @@ 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(); + assert(operands.size() == 1); + 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 +3379,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,39 @@ +! RUN: bbc -emit-fir %s -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! Test c_loc intrinsic + +! CHECK-LABEL: func.func @_QPc_loc_test() { +! CHECK: %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_testEp_i) : !fir.ref> +! CHECK: %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_testEptr"} +! 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_test() + use iso_c_binding + implicit none + type(c_ptr) :: ptr + integer, target :: p_i(10) = 1 + ptr = c_loc(p_i) +end + +! TODO : p_i is scalar non-character intrinsic +!subroutine c_loc_test2() +! use iso_c_binding +! implicit none +! type(c_ptr) :: ptr +! integer, target :: p_i = 1 +! ptr = c_loc(p_i) +!end