[flang-commits] [flang] 1094254 - [flang] Lowering LOC intrinsic
Kelvin Li via flang-commits
flang-commits at lists.llvm.org
Thu Nov 24 07:34:13 PST 2022
Author: Kelvin Li
Date: 2022-11-24T10:33:27-05:00
New Revision: 109425471602f471c64bbccc7f566d638d562966
URL: https://github.com/llvm/llvm-project/commit/109425471602f471c64bbccc7f566d638d562966
DIFF: https://github.com/llvm/llvm-project/commit/109425471602f471c64bbccc7f566d638d562966.diff
LOG: [flang] Lowering LOC intrinsic
This patch is to implement the lowering of the LOC intrinsic.
Differential Revision: https://reviews.llvm.org/D138572
Added:
flang/test/Lower/Intrinsics/loc.f90
Modified:
flang/docs/Intrinsics.md
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Lower/IntrinsicCall.cpp
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 2af87f6adc84b..0ecee23c56911 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -749,7 +749,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Coarray intrinsic functions | IMAGE_INDEX, COSHAPE |
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
-| Non-standard intrinsic functions | AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, LOC, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
+| Non-standard intrinsic functions | AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
| Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
| Atomic intrinsic subroutines | ATOMIC_ADD |
| Collective intrinsic subroutines | CO_REDUCE |
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 0c4206bfacc97..39af09478f398 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -574,8 +574,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
DefaultLogical},
{"llt", {{"string_a", SameCharNoLen}, {"string_b", SameCharNoLen}},
DefaultLogical},
- {"loc", {{"loc_argument", Addressable, Rank::anyOrAssumedRank}},
- SubscriptInt, Rank::scalar},
+ {"loc", {{"x", Addressable, Rank::anyOrAssumedRank}}, SubscriptInt,
+ Rank::scalar},
{"log", {{"x", SameFloating}}, SameFloating},
{"log10", {{"x", SameReal}}, SameReal},
{"logical", {{"l", AnyLogical}, DefaultingKIND}, KINDLogical},
diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp
index 04a24b490a98c..ab930e32229fe 100644
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -530,6 +530,7 @@ struct IntrinsicLibrary {
mlir::Value genLeadz(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genLen(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genLenTrim(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+ fir::ExtendedValue genLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
template <typename Shift>
mlir::Value genMask(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genMatmul(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
@@ -879,6 +880,7 @@ static constexpr IntrinsicHandler handlers[]{
{"lgt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sgt>},
{"lle", &I::genCharacterCompare<mlir::arith::CmpIPredicate::sle>},
{"llt", &I::genCharacterCompare<mlir::arith::CmpIPredicate::slt>},
+ {"loc", &I::genLoc, {{{"x", asBox}}}, /*isElemental=*/false},
{"maskl", &I::genMask<mlir::arith::ShLIOp>},
{"maskr", &I::genMask<mlir::arith::ShRUIOp>},
{"matmul",
@@ -2672,6 +2674,22 @@ mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
return builder.createConvert(loc, resultType, res);
}
+static mlir::Value getAddrFromBox(fir::FirOpBuilder &builder,
+ mlir::Location loc, fir::ExtendedValue arg,
+ bool isFunc) {
+ mlir::Value argValue = fir::getBase(arg);
+ mlir::Value addr{nullptr};
+ if (isFunc) {
+ auto funcTy = argValue.getType().cast<fir::BoxProcType>().getEleTy();
+ addr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
+ } else {
+ const auto *box = arg.getBoxOf<fir::BoxValue>();
+ addr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
+ fir::getBase(*box));
+ }
+ return addr;
+}
+
static fir::ExtendedValue
genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Type resultType, llvm::ArrayRef<fir::ExtendedValue> args,
@@ -2680,19 +2698,9 @@ genCLocOrCFunLoc(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
mlir::Value resAddr =
fir::factory::genCPtrOrCFunptrAddr(builder, loc, res, resultType);
- mlir::Value argAddr;
- if (isFunc) {
- mlir::Value argValue = fir::getBase(args[0]);
- assert(argValue.getType().isa<fir::BoxProcType>() &&
- "c_funloc argument must have been lowered to a fir.boxproc");
- auto funcTy = argValue.getType().cast<fir::BoxProcType>().getEleTy();
- argAddr = builder.create<fir::BoxAddrOp>(loc, funcTy, argValue);
- } else {
- const auto *box = args[0].getBoxOf<fir::BoxValue>();
- assert(box && "c_loc argument must have been lowered to a fir.box");
- argAddr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(),
- fir::getBase(*box));
- }
+ assert(fir::isa_box_type(fir::getBase(args[0]).getType()) &&
+ "argument must have been lowered to box type");
+ mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
mlir::Value argAddrVal = builder.createConvert(
loc, fir::unwrapRefType(resAddr.getType()), argAddr);
builder.create<fir::StoreOp>(loc, argAddrVal, resAddr);
@@ -3748,6 +3756,19 @@ IntrinsicLibrary::genCharacterCompare(mlir::Type resultType,
fir::getBase(args[1]), fir::getLen(args[1]));
}
+// LOC
+fir::ExtendedValue
+IntrinsicLibrary::genLoc(mlir::Type resultType,
+ llvm::ArrayRef<fir::ExtendedValue> args) {
+ assert(args.size() == 1);
+ mlir::Value argValue = fir::getBase(args[0]);
+ assert(fir::isa_box_type(argValue.getType()) &&
+ "argument must have been lowered to box type");
+ bool isFunc = argValue.getType().isa<fir::BoxProcType>();
+ mlir::Value argAddr = getAddrFromBox(builder, loc, args[0], isFunc);
+ return builder.createConvert(loc, fir::unwrapRefType(resultType), argAddr);
+}
+
// MASKL, MASKR
template <typename Shift>
mlir::Value IntrinsicLibrary::genMask(mlir::Type resultType,
diff --git a/flang/test/Lower/Intrinsics/loc.f90 b/flang/test/Lower/Intrinsics/loc.f90
new file mode 100644
index 0000000000000..c95547b81358e
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/loc.f90
@@ -0,0 +1,250 @@
+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! Test LOC intrinsic
+
+! CHECK-LABEL: func.func @_QPloc_scalar() {
+subroutine loc_scalar()
+ integer(8) :: p
+ integer :: x
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[x:.*]] = fir.alloca i32 {{.*}}
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<i32>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_char() {
+subroutine loc_char()
+ integer(8) :: p
+ character(5) :: x = "abcde"
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_charEx) : !fir.ref<!fir.char<1,5>>
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ref<!fir.char<1,5>>) -> !fir.box<!fir.char<1,5>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,5>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.char<1,5>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_substring() {
+subroutine loc_substring()
+ integer(8) :: p
+ character(5) :: x = "abcde"
+ p = loc(x(2:))
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_substringEx) : !fir.ref<!fir.char<1,5>>
+! CHECK: %[[sslb:.*]] = arith.constant 2 : i64
+! CHECK: %[[ssub:.*]] = arith.constant 5 : i64
+! CHECK: %[[sslbidx:.*]] = fir.convert %[[sslb]] : (i64) -> index
+! CHECK: %[[ssubidx:.*]] = fir.convert %[[ssub]] : (i64) -> index
+! CHECK: %[[one:.*]] = arith.constant 1 : index
+! CHECK: %[[lboffset:.*]] = arith.subi %[[sslbidx]], %c1 : index
+! CHECK: %[[xarr:.*]] = fir.convert %[[x]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.array<5x!fir.char<1>>>
+! CHECK: %[[xarrcoord:.*]] = fir.coordinate_of %[[xarr]], %[[lboffset]] : (!fir.ref<!fir.array<5x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+! CHECK: %[[xss:.*]] = fir.convert %[[xarrcoord]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[rng:.*]] = arith.subi %[[ssubidx]], %[[sslbidx]] : index
+! CHECK: %[[rngp1:.*]] = arith.addi %[[rng]], %[[one]] : index
+! CHECK: %[[zero:.*]] = arith.constant 0 : index
+! CHECK: %[[cmpval:.*]] = arith.cmpi slt, %[[rngp1]], %[[zero]] : index
+! CHECK: %[[sltval:.*]] = arith.select %[[cmpval]], %[[zero]], %[[rngp1]] : index
+! CHECK: %[[xssbox:.*]] = fir.embox %[[xss]] typeparams %[[sltval]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK: %[[xssaddr:.*]] = fir.box_addr %[[xssbox]] : (!fir.box<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK: %[[xssaddrval:.*]] = fir.convert %[[xssaddr]] : (!fir.ref<!fir.char<1,?>>) -> i64
+! CHECK: fir.store %[[xssaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_array() {
+subroutine loc_array
+ integer(8) :: p
+ integer :: x(10)
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[ten:.*]] = arith.constant 10 : index
+! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}}
+! CHECK: %[[xshp:.*]] = fir.shape %[[ten]] : (index) -> !fir.shape<1>
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<10xi32>>) -> !fir.ref<!fir.array<10xi32>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<10xi32>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_chararray() {
+subroutine loc_chararray()
+ integer(8) :: p
+ character(5) :: x(2)
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[two:.*]] = arith.constant 2 : index
+! CHECK: %[[x:.*]] = fir.alloca !fir.array<2x!fir.char<1,5>> {{.*}}
+! CHECK: %[[xshp:.*]] = fir.shape %[[two]] : (index) -> !fir.shape<1>
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) : (!fir.ref<!fir.array<2x!fir.char<1,5>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.char<1,5>>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<2x!fir.char<1,5>>>) -> !fir.ref<!fir.array<2x!fir.char<1,5>>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<2x!fir.char<1,5>>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_arrayelement() {
+subroutine loc_arrayelement()
+ integer(8) :: p
+ integer :: x(10)
+ p = loc(x(7))
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[x:.*]] = fir.alloca !fir.array<10xi32> {{.*}}
+! CHECK: %[[idx:.*]] = arith.constant 7 : i64
+! CHECK: %[[lb:.*]] = arith.constant 1 : i64
+! CHECK: %[[offset:.*]] = arith.subi %[[idx]], %[[lb]] : i64
+! CHECK: %[[xelemcoord:.*]] = fir.coordinate_of %[[x]], %[[offset]] : (!fir.ref<!fir.array<10xi32>>, i64) -> !fir.ref<i32>
+! CHECK: %[[xelembox:.*]] = fir.embox %[[xelemcoord]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK: %[[xelemaddr:.*]] = fir.box_addr %[[xelembox]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK: %[[xelemaddrval:.*]] = fir.convert %[[xelemaddr]] : (!fir.ref<i32>) -> i64
+! CHECK: fir.store %[[xelemaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_arraysection(
+! CHECK-SAME: %[[arg:.*]]: !fir.ref<i32> {{.*}}) {
+subroutine loc_arraysection(i)
+ integer(8) :: p
+ integer :: i
+ real :: x(11)
+ p = loc(x(i:))
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[eleven:.*]] = arith.constant 11 : index
+! CHECK: %[[x:.*]] = fir.alloca !fir.array<11xf32> {{.*}}
+! CHECK: %[[one:.*]] = arith.constant 1 : index
+! CHECK: %[[i:.*]] = fir.load %[[arg]] : !fir.ref<i32>
+! CHECK: %[[il:.*]] = fir.convert %[[i]] : (i32) -> i64
+! CHECK: %[[iidx:.*]] = fir.convert %[[il]] : (i64) -> index
+! CHECK: %[[onel:.*]] = arith.constant 1 : i64
+! CHECK: %[[stpidx:.*]] = fir.convert %[[onel]] : (i64) -> index
+! CHECK: %[[xrng:.*]] = arith.addi %[[one]], %[[eleven]] : index
+! CHECK: %[[xub:.*]] = arith.subi %[[xrng]], %[[one]] : index
+! CHECK: %[[xshp:.*]] = fir.shape %[[eleven]] : (index) -> !fir.shape<1>
+! CHECK: %[[xslice:.*]] = fir.slice %[[iidx]], %[[xub]], %[[stpidx]] : (index, index, index) -> !fir.slice<1>
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]](%[[xshp]]) [%[[xslice]]] : (!fir.ref<!fir.array<11xf32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xf32>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<?xf32>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_non_save_pointer_scalar() {
+subroutine loc_non_save_pointer_scalar()
+ integer(8) :: p
+ real, pointer :: x
+ real, target :: t
+ x => t
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[t:.*]] = fir.alloca f32 {{.*}}
+! CHECK: %2 = fir.alloca !fir.box<!fir.ptr<f32>> {{.*}}
+! CHECK: %[[xa:.*]] = fir.alloca !fir.ptr<f32> {{.*}}
+! CHECK: %[[zero:.*]] = fir.zero_bits !fir.ptr<f32>
+! CHECK: fir.store %[[zero]] to %[[xa]] : !fir.ref<!fir.ptr<f32>>
+! CHECK: %[[taddr:.*]] = fir.convert %[[t]] : (!fir.ref<f32>) -> !fir.ptr<f32>
+! CHECK: fir.store %[[taddr]] to %[[xa]] : !fir.ref<!fir.ptr<f32>>
+! CHECK: %[[x:.*]] = fir.load %[[xa]] : !fir.ref<!fir.ptr<f32>>
+! CHECK: %[[xbox:.*]] = fir.embox %[[x]] : (!fir.ptr<f32>) -> !fir.box<f32>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<f32>) -> !fir.ref<f32>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<f32>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_save_pointer_scalar() {
+subroutine loc_save_pointer_scalar()
+ integer :: p
+ real, pointer, save :: x
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i32 {{.*}}
+! CHECK: %[[x:.*]] = fir.address_of(@_QFloc_save_pointer_scalarEx) : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[xref:.*]] = fir.load %[[x]] : !fir.ref<!fir.box<!fir.ptr<f32>>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xref]] : (!fir.box<!fir.ptr<f32>>) -> !fir.ptr<f32>
+! CHECK: %[[xbox:.*]] = fir.embox %[[xaddr]] : (!fir.ptr<f32>) -> !fir.box<f32>
+! CHECK: %[[xaddr2:.*]] = fir.box_addr %[[xbox]] : (!fir.box<f32>) -> !fir.ref<f32>
+! CHECK: %[[xaddr2vall:.*]] = fir.convert %[[xaddr2]] : (!fir.ref<f32>) -> i64
+! CHECK: %[[xaddr2val:.*]] = fir.convert %[[xaddr2vall]] : (i64) -> i32
+! CHECK: fir.store %[[xaddr2val]] to %[[p]] : !fir.ref<i32>
+end
+
+! CHECK-LABEL: func.func @_QPloc_derived_type() {
+subroutine loc_derived_type
+ integer(8) :: p
+ type dt
+ integer :: i
+ end type
+ type(dt) :: xdt
+ p = loc(xdt)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFloc_derived_typeTdt{i:i32}> {{.*}}
+! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> !fir.box<!fir.type<_QFloc_derived_typeTdt{i:i32}>>
+! CHECK: %[[xdtaddr:.*]] = fir.box_addr %[[xdtbox]] : (!fir.box<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> !fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>
+! CHECK: %[[xdtaddrval:.*]] = fir.convert %[[xdtaddr]] : (!fir.ref<!fir.type<_QFloc_derived_typeTdt{i:i32}>>) -> i64
+! CHECK: fir.store %[[xdtaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_pointer_array() {
+subroutine loc_pointer_array
+ integer(8) :: p
+ integer, pointer :: x(:)
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[x:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {{.*}}
+! CHECK: %2 = fir.zero_bits !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[zero:.*]] = arith.constant 0 : index
+! CHECK: %[[xshp:.*]] = fir.shape %[[zero]] : (index) -> !fir.shape<1>
+! CHECK: %[[xbox0:.*]] = fir.embox %2(%[[xshp]]) : (!fir.ptr<!fir.array<?xi32>>, !fir.shape<1>) -> !fir.box<!fir.ptr<!fir.array<?xi32>>>
+! CHECK: fir.store %[[xbox0]] to %[[x]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[xbox:.*]] = fir.load %[[x]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ptr<!fir.array<?xi32>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPloc_allocatable_array() {
+subroutine loc_allocatable_array
+ integer(8) :: p
+ integer, allocatable :: x(:)
+ p = loc(x)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %1 = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>> {{.*}}
+! CHECK: %[[stg:.*]] = fir.alloca !fir.heap<!fir.array<?xi32>> {{.*}}
+! CHECK: %[[lb:.*]] = fir.alloca index {{.*}}
+! CHECK: %[[ext:.*]] = fir.alloca index {{.*}}
+! CHECK: %[[zstg:.*]] = fir.zero_bits !fir.heap<!fir.array<?xi32>>
+! CHECK: fir.store %[[zstg]] to %[[stg]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[lbval:.*]] = fir.load %[[lb]] : !fir.ref<index>
+! CHECK: %[[extval:.*]] = fir.load %[[ext]] : !fir.ref<index>
+! CHECK: %[[stgaddr:.*]] = fir.load %[[stg]] : !fir.ref<!fir.heap<!fir.array<?xi32>>>
+! CHECK: %[[ss:.*]] = fir.shape_shift %[[lbval]], %[[extval]] : (index, index) -> !fir.shapeshift<1>
+! CHECK: %[[xbox:.*]] = fir.embox %[[stgaddr]](%[[ss]]) : (!fir.heap<!fir.array<?xi32>>, !fir.shapeshift<1>) -> !fir.box<!fir.array<?xi32>>
+! CHECK: %[[xaddr:.*]] = fir.box_addr %[[xbox]] : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK: %[[xaddrval:.*]] = fir.convert %[[xaddr]] : (!fir.ref<!fir.array<?xi32>>) -> i64
+! CHECK: fir.store %[[xaddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPtest_external() {
+subroutine test_external()
+ integer(8) :: p
+ integer, external :: f
+ p = loc(x=f)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[f:.*]] = fir.address_of(@_QPf) : () -> i32
+! CHECK: %[[fbox:.*]] = fir.emboxproc %[[f]] : (() -> i32) -> !fir.boxproc<() -> i32>
+! CHECK: %[[faddr:.*]] = fir.box_addr %[[fbox]] : (!fir.boxproc<() -> i32>) -> (() -> i32)
+! CHECK: %[[faddrval:.*]] = fir.convert %[[faddr]] : (() -> i32) -> i64
+! CHECK: fir.store %[[faddrval]] to %[[p]] : !fir.ref<i64>
+end
+
+! CHECK-LABEL: func.func @_QPtest_proc() {
+subroutine test_proc()
+ integer(8) :: p
+ procedure() :: g
+ p = loc(x=g)
+! CHECK: %[[p:.*]] = fir.alloca i64 {{.*}}
+! CHECK: %[[g:.*]] = fir.address_of(@_QPg) : () -> ()
+! CHECK: %[[gbox:.*]] = fir.emboxproc %[[g]] : (() -> ()) -> !fir.boxproc<() -> ()>
+! CHECK: %[[gaddr:.*]] = fir.box_addr %[[gbox]] : (!fir.boxproc<() -> ()>) -> (() -> ())
+! CHECK: %[[gaddrval:.*]] = fir.convert %[[gaddr]] : (() -> ()) -> i64
+! CHECK: fir.store %[[gaddrval]] to %[[p]] : !fir.ref<i64>
+end
More information about the flang-commits
mailing list