diff --git a/flang/include/flang/Lower/ConvertExpr.h b/flang/include/flang/Lower/ConvertExpr.h --- a/flang/include/flang/Lower/ConvertExpr.h +++ b/flang/include/flang/Lower/ConvertExpr.h @@ -234,6 +234,10 @@ builder.getUnitAttr()}; } +Fortran::semantics::SymbolRef getPointer(Fortran::semantics::SymbolRef sym); +mlir::Value addCrayPointerInst(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value ptrVal, mlir::Type ptrTy, + mlir::Type pteTy); } // namespace Fortran::lower #endif // FORTRAN_LOWER_CONVERTEXPR_H diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -3578,6 +3578,26 @@ // to a result variable of one of the other types requires // conversion to the actual type. mlir::Type toTy = genType(assign.lhs); + + // If Cray pointee, need to handle the address + // Array is handled in genCoordinateOp. + if (sym->test(Fortran::semantics::Symbol::Flag::CrayPointee) && + sym->Rank() == 0) { + // get the corresponding Cray pointer + + auto ptrSym = Fortran::lower::getPointer(*sym); + fir::ExtendedValue ptr = + getSymbolExtendedValue(ptrSym, nullptr); + mlir::Value ptrVal = fir::getBase(ptr); + mlir::Type ptrTy = genType(*ptrSym); + + fir::ExtendedValue pte = + getSymbolExtendedValue(*sym, nullptr); + mlir::Value pteVal = fir::getBase(pte); + mlir::Value cnvrt = Fortran::lower::addCrayPointerInst( + loc, *builder, ptrVal, ptrTy, pteVal.getType()); + addr = builder->create(loc, cnvrt); + } mlir::Value cast = isVector ? val : builder->convertWithSemantics(loc, toTy, val); diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -849,7 +849,7 @@ ExtValue genval(Fortran::semantics::SymbolRef sym) { mlir::Location loc = getLoc(); ExtValue var = gen(sym); - if (const fir::UnboxedValue *s = var.getUnboxed()) + if (const fir::UnboxedValue *s = var.getUnboxed()) { if (fir::isa_ref_type(s->getType())) { // A function with multiple entry points returning different types // tags all result variables with one of the largest types to allow @@ -861,9 +861,23 @@ if (addr.getType() != resultType) addr = builder.createConvert(loc, builder.getRefType(resultType), addr); + } else if (sym->test(Fortran::semantics::Symbol::Flag::CrayPointee)) { + // get the corresponding Cray pointer + auto ptrSym = Fortran::lower::getPointer(sym); + ExtValue ptr = gen(ptrSym); + mlir::Value ptrVal = fir::getBase(ptr); + mlir::Type ptrTy = converter.genType(*ptrSym); + + ExtValue pte = gen(sym); + mlir::Value pteVal = fir::getBase(pte); + + mlir::Value cnvrt = Fortran::lower::addCrayPointerInst( + loc, builder, ptrVal, ptrTy, pteVal.getType()); + addr = builder.create(loc, cnvrt); } return genLoad(addr); } + } return var; } @@ -1553,6 +1567,21 @@ args.push_back(builder.create(loc, ty, val, lb)); } mlir::Value base = fir::getBase(array); + + auto baseSym = getFirstSym(aref); + if (baseSym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) { + // get the corresponding Cray pointer + auto ptrSym = Fortran::lower::getPointer(baseSym); + + fir::ExtendedValue ptr = gen(ptrSym); + mlir::Value ptrVal = fir::getBase(ptr); + mlir::Type ptrTy = ptrVal.getType(); + + mlir::Value cnvrt = Fortran::lower::addCrayPointerInst( + loc, builder, ptrVal, ptrTy, base.getType()); + base = builder.create(loc, cnvrt); + } + mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy(base.getType()); if (auto classTy = eleTy.dyn_cast()) eleTy = classTy.getEleTy(); @@ -5632,7 +5661,8 @@ } /// Base case of generating an array reference, - CC genarr(const ExtValue &extMemref, ComponentPath &components) { + CC genarr(const ExtValue &extMemref, ComponentPath &components, + mlir::Value CrayPtr = nullptr) { mlir::Location loc = getLoc(); mlir::Value memref = fir::getBase(extMemref); mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy(memref.getType()); @@ -5777,6 +5807,16 @@ } auto arrLoad = builder.create( loc, arrTy, memref, shape, slice, fir::getTypeParams(extMemref)); + + if (CrayPtr) { + mlir::Type ptrTy = CrayPtr.getType(); + mlir::Value cnvrt = Fortran::lower::addCrayPointerInst( + loc, builder, CrayPtr, ptrTy, memref.getType()); + auto addr = builder.create(loc, cnvrt); + arrLoad = builder.create(loc, arrTy, addr, shape, slice, + fir::getTypeParams(extMemref)); + } + mlir::Value arrLd = arrLoad.getResult(); if (isProjectedCopyInCopyOut()) { // Semantics are projected copy-in copy-out. @@ -6930,6 +6970,21 @@ return genImplicitArrayAccess(x.GetComponent(), components); } + CC genImplicitArrayAccess(const Fortran::semantics::Symbol &x, + ComponentPath &components) { + mlir::Value ptrVal = nullptr; + if (x.test(Fortran::semantics::Symbol::Flag::CrayPointee)) { + auto ptrSym = Fortran::lower::getPointer(x); + ExtValue ptr = converter.getSymbolExtendedValue(ptrSym); + ptrVal = fir::getBase(ptr); + } + components.reversePath.push_back(ImplicitSubscripts{}); + ExtValue exv = asScalarRef(x); + lowerPath(exv, components); + auto lambda = genarr(exv, components, ptrVal); + return [=](IterSpace iters) { return lambda(components.pc(iters)); }; + } + template CC genAsScalar(const A &x) { mlir::Location loc = getLoc(); @@ -7573,3 +7628,37 @@ esp.resetBindings(); esp.incrementCounter(); } + +Fortran::semantics::SymbolRef +Fortran::lower::getPointer(Fortran::semantics::SymbolRef sym) { + assert(!sym->owner().crayPointers().empty() && + "empty Cray pointer/pointee map"); + for (const auto &[pointee, pointer] : sym->owner().crayPointers()) { + if (pointee == sym->name()) { + Fortran::semantics::SymbolRef v{pointer.get()}; + return v; + } + } + llvm_unreachable("corresponding Cray pointer cannot be found"); +} + +mlir::Value Fortran::lower::addCrayPointerInst(mlir::Location loc, + fir::FirOpBuilder &builder, + mlir::Value ptrVal, + mlir::Type ptrTy, + mlir::Type pteTy) { + + mlir::Value empty; + mlir::ValueRange emptyRange; + auto boxTy = fir::BoxType::get(ptrTy); + auto box = builder.create(loc, boxTy, ptrVal, empty, empty, + emptyRange); + mlir::Value addrof = + (ptrTy.isa()) + ? builder.create(loc, ptrTy, box) + : builder.create(loc, builder.getRefType(ptrTy), box); + + auto refPtrTy = + builder.getRefType(fir::PointerType::get(fir::dyn_cast_ptrEleTy(pteTy))); + return builder.createConvert(loc, refPtrTy, addrof); +} diff --git a/flang/test/Lower/cray-pointer.f90 b/flang/test/Lower/cray-pointer.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/cray-pointer.f90 @@ -0,0 +1,404 @@ +! RUN: bbc %s -emit-fir -o - | FileCheck %s +! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s + +! Test Cray Pointers + +! Test Scalar Case + +! CHECK-LABEL: func.func @_QPcray_scalar() { +subroutine cray_scalar() + integer :: i, pte + integer :: data = 3 + integer :: j = -3 + pointer(ptr, pte) + ptr = loc(data) + +! CHECK: %[[data:.*]] = fir.address_of(@_QFcray_scalarEdata) {{.*}} +! CHECK: %[[i:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[j:.*]] = fir.address_of(@_QFcray_scalarEj) {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[databox:.*]] = fir.embox %[[data]] : (!fir.ref) -> !fir.box +! CHECK: %[[dataaddr:.*]] = fir.box_addr %[[databox]] : (!fir.box) -> !fir.ref +! CHECK: %[[dataaddrval:.*]] = fir.convert %[[dataaddr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[dataaddrval]] to %[[ptr]] : !fir.ref + + i = pte + print *, i + +! CHECK: %[[ptrbox:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr:.*]] = fir.box_addr %[[ptrbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval:.*]] = fir.convert %[[ptraddr]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld:.*]] = fir.load %[[ptraddrval]] : !fir.ref> +! CHECK: %[[ptrldd:.*]] = fir.load %[[ptrld]] : !fir.ptr +! CHECK: fir.store %[[ptrldd]] to %[[i]] : !fir.ref + + pte = j + print *, data, pte + +! CHECK: %[[jld:.*]] = fir.load %[[j]] : !fir.ref +! CHECK: %[[ptrbox1:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr1:.*]] = fir.box_addr %[[ptrbox1]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval1:.*]] = fir.convert %[[ptraddr1]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld1:.*]] = fir.load %[[ptraddrval1]] : !fir.ref> +! CHECK: fir.store %[[jld]] to %[[ptrld1]] : !fir.ptr + +end + +! Test Derived Type Case + +! CHECK-LABEL: func.func @_QPcray_derivedtype() { +subroutine cray_derivedType() + integer :: pte, k + type dt + integer :: i, j + end type + type(dt) :: xdt + pointer(ptr, pte) + xdt = dt(-1, -3) + ptr = loc(xdt) + +! CHECK: %[[dt:.*]] = fir.alloca !fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}> +! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[pte:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFcray_derivedtypeTdt{i:i32,j:i32}> {{.*}} +! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[xdtaddr:.*]] = fir.box_addr %[[xdtbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xdtaddrval:.*]] = fir.convert %[[xdtaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xdtaddrval]] to %[[ptr]] : !fir.ref + + k = pte + print *, k + +! CHECK: %[[ptrbox:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr:.*]] = fir.box_addr %[[ptrbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval:.*]] = fir.convert %[[ptraddr]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld:.*]] = fir.load %[[ptraddrval]] : !fir.ref> +! CHECK: %[[ptrldd:.*]] = fir.load %[[ptrld]] : !fir.ptr +! CHECK: fir.store %[[ptrldd]] to %[[k]] : !fir.ref + + pte = k + 2 + print *, xdt, pte + +! CHECK: %[[kld:.*]] = fir.load %[[k]] : !fir.ref +! CHECK: %[[kld1:.*]] = fir.load %[[k]] : !fir.ref +! CHECK: %[[const:.*]] = arith.constant 2 : i32 +! CHECK: %[[add:.*]] = arith.addi %[[kld1]], %[[const]] : i32 +! CHECK: %[[ptrbox1:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr1:.*]] = fir.box_addr %[[ptrbox1]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval1:.*]] = fir.convert %[[ptraddr1]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld1:.*]] = fir.load %[[ptraddrval1]] : !fir.ref> +! CHECK: fir.store %[[add]] to %[[ptrld1]] : !fir.ptr + +end + +! Test Ptr arithmetic Case + +! CHECK-LABEL: func.func @_QPcray_ptrarth() { +subroutine cray_ptrArth() + integer :: pte, i + pointer(ptr, pte) + type dt + integer :: x, y, z + end type + type(dt) :: xdt + xdt = dt(5, 11, 2) + ptr = loc(xdt) + +! CHECK: %[[dt:.*]] = fir.alloca !fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}> +! CHECK: %[[i:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[pte:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[xdt:.*]] = fir.alloca !fir.type<_QFcray_ptrarthTdt{x:i32,y:i32,z:i32}> {{.*}} +! CHECK: %[[xdtbox:.*]] = fir.embox %[[xdt]] : (!fir.ref>) -> !fir.box> +! CHECK: %[[xdtaddr:.*]] = fir.box_addr %[[xdtbox]] : (!fir.box>) -> !fir.ref> +! CHECK: %[[xdtaddrval:.*]] = fir.convert %[[xdtaddr]] : (!fir.ref>) -> i64 +! CHECK: fir.store %[[xdtaddrval]] to %[[ptr]] : !fir.ref + + ptr = ptr + 4 + i = pte + print *, i + +! CHECK: %[[ptrbox:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr:.*]] = fir.box_addr %[[ptrbox]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval:.*]] = fir.convert %[[ptraddr]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld:.*]] = fir.load %[[ptraddrval]] : !fir.ref> +! CHECK: %[[ptrldd:.*]] = fir.load %[[ptrld]] : !fir.ptr +! CHECK: fir.store %[[ptrldd]] to %[[i]] : !fir.ref + + ptr = ptr + 4 + pte = -7 + print *, xdt + +! CHECK: %[[ld:.*]] = fir.load %[[ptr]] : !fir.ref +! CHECK: %[[const:.*]] = arith.constant 4 : i64 +! CHECK: %[[add:.*]] = arith.addi %[[ld]], %[[const]] : i64 +! CHECK: fir.store %[[add]] to %[[ptr]] : !fir.ref +! CHECK: %[[const1:.*]] = arith.constant -7 : i32 +! CHECK: %[[ptrbox1:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box +! CHECK: %[[ptraddr1:.*]] = fir.box_addr %[[ptrbox1]] : (!fir.box) -> !fir.ref +! CHECK: %[[ptraddrval1:.*]] = fir.convert %[[ptraddr1]] : (!fir.ref) -> !fir.ref> +! CHECK: %[[ptrld1:.*]] = fir.load %[[ptraddrval1]] : !fir.ref> +! CHECK: fir.store %[[const1]] to %[[ptrld1]] : !fir.ptr + +end + +! Test Array element Case + +! CHECK-LABEL: func.func @_QPcray_arrayelement() { +subroutine cray_arrayElement() + integer :: pte, k, data(5) + pointer (ptr, pte(3)) + data = [ 1, 2, 3, 4, 5 ] + ptr = loc(data(2)) + +! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}} +! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[c2:.*]] = arith.constant 2 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[data]], %[[sub]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[box:.*]] = fir.embox %[[cor]] : (!fir.ref) -> !fir.box +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[val]] to %[[ptr]] : !fir.ref + + k = pte(3) + print *, k + +! CHECK: %[[c3:.*]] = arith.constant 3 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub:.*]] = arith.subi %[[c3]], %[[c1]] : i64 +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld1:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[ld1]], %[[sub]] : (!fir.ptr>, i64) -> !fir.ref +! CHECK: %[[ld2:.*]] = fir.load %[[cor]] : !fir.ref +! CHECK: fir.store %[[ld2]] to %[[k]] : !fir.ref + + pte(2) = -2 + print *, data + +! CHECK: %[[c2n:.*]] = arith.constant -2 : i32 +! CHECK: %[[c2:.*]] = arith.constant 2 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld1:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[ld1]], %[[sub]] : (!fir.ptr>, i64) -> !fir.ref +! CHECK: fir.store %[[c2n]] to %[[cor]] : !fir.ref + +end + +! Test 2d Array element Case + +! CHECK-LABEL: func.func @_QPcray_2darrayelement() { +subroutine cray_2darrayElement() + integer :: pte, k, data(2,4) + pointer (ptr, pte(2,3)) + data = reshape([1,2,3,4,5,6,7,8], [2,4]) + ptr = loc(data(2,2)) + +! CHECK: %[[data:.*]] = fir.alloca !fir.array<2x4xi32> {{.*}} +! CHECK: %[[k:.*]] = fir.alloca i32 {{.*}} +! CHECK: %[[pte:.*]] = fir.alloca !fir.array<2x3xi32> {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[c2:.*]] = arith.constant 2 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub1:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[c22:.*]] = arith.constant 2 : i64 +! CHECK: %[[c12:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub2:.*]] = arith.subi %[[c22]], %[[c12]] : i64 +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[data]], %[[sub1]], %[[sub2]] : (!fir.ref>, i64, i64) -> !fir.ref +! CHECK: %[[box:.*]] = fir.embox %[[cor]] : (!fir.ref) -> !fir.box +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[val]] to %[[ptr]] : !fir.ref + + k = pte(1,1) + print *, k + +! CHECK: %[[c2:.*]] = arith.constant 1 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub1:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[c22:.*]] = arith.constant 1 : i64 +! CHECK: %[[c12:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub2:.*]] = arith.subi %[[c22]], %[[c12]] : i64 +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld1:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[ld1]], %[[sub1]], %[[sub2]] : (!fir.ptr>, i64, i64) -> !fir.ref +! CHECK: %[[ld2:.*]] = fir.load %[[cor]] : !fir.ref +! CHECK: fir.store %[[ld2]] to %[[k]] : !fir.ref + + pte(1,2) = -2 + print *, data + +! CHECK: %[[c2n:.*]] = arith.constant -2 : i32 +! CHECK: %[[c2:.*]] = arith.constant 1 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub1:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[c22:.*]] = arith.constant 2 : i64 +! CHECK: %[[c12:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub2:.*]] = arith.subi %[[c22]], %[[c12]] : i64 +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld1:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[ld1]], %[[sub1]], %[[sub2]] : (!fir.ptr>, i64, i64) -> !fir.ref +! CHECK: fir.store %[[c2n]] to %[[cor]] : !fir.ref + +end + +! Test Whole Array case + +! CHECK-LABEL: func.func @_QPcray_array() { +subroutine cray_array() + integer :: pte, k(3), data(5) + pointer (ptr, pte(3)) + data = [ 1, 2, 3, 4, 5 ] + ptr = loc(data(2)) + +! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}} +! CHECK: %[[c3:.*]] = arith.constant 3 : index +! CHECK: %[[k:.*]] = fir.alloca !fir.array<3xi32> {{.*}} +! CHECK: %[[c31:.*]] = arith.constant 3 : index +! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[c2:.*]] = arith.constant 2 : i64 +! CHECK: %[[c1:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub:.*]] = arith.subi %[[c2]], %[[c1]] : i64 +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[data]], %[[sub]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[box:.*]] = fir.embox %[[cor]] : (!fir.ref) -> !fir.box +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[val]] to %[[ptr]] : !fir.ref + + k = pte + print *, k + +! CHECK: %[[shape1:.*]] = fir.shape %[[c3]] : (index) -> !fir.shape<1> +! CHECK: %[[arrayld1:.*]] = fir.array_load %[[k]](%[[shape1]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<3xi32> +! CHECK: %[[shape:.*]] = fir.shape %[[c31]] : (index) -> !fir.shape<1> +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[arrayld:.*]] = fir.array_load %[[ld]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.array<3xi32> +! CHECK: %[[c1:.*]] = arith.constant 1 : index +! CHECK: %[[c0:.*]] = arith.constant 0 : index +! CHECK: %[[sub:.*]] = arith.subi %[[c3]], %[[c1]] : index +! CHECK: %[[doloop:.*]] = fir.do_loop %arg0 = %[[c0]] to %[[sub]] step %[[c1]] unordered iter_args(%arg1 = %[[arrayld1]]) -> (!fir.array<3xi32>) { +! CHECK: %[[arrayfetch:.*]] = fir.array_fetch %[[arrayld]], %arg0 : (!fir.array<3xi32>, index) -> i32 +! CHECK: %[[arrayupdate:.*]] = fir.array_update %arg1, %[[arrayfetch]], %arg0 : (!fir.array<3xi32>, i32, index) -> !fir.array<3xi32> +! CHECK: fir.result %[[arrayupdate]] : !fir.array<3xi32> +! CHECK: fir.array_merge_store %[[arrayld1]], %[[doloop]] to %[[k]] : !fir.array<3xi32>, !fir.array<3xi32>, !fir.ref> + + pte = -2 + print *, data + +! CHECK: %[[shape:.*]] = fir.shape %[[c31]] : (index) -> !fir.shape<1> +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[arrayld:.*]] = fir.array_load %[[ld]](%[[shape]]) : (!fir.ptr>, !fir.shape<1>) -> !fir.array<3xi32> +! CHECK: %[[c2n:.*]] = arith.constant -2 : i32 +! CHECK: %[[c1:.*]] = arith.constant 1 : index +! CHECK: %[[c0:.*]] = arith.constant 0 : index +! CHECK: %[[sub1:.*]] = arith.subi %[[c31]], %[[c1]] : index +! CHECK: %[[doloop:.*]] = fir.do_loop %arg0 = %[[c0]] to %[[sub1]] step %[[c1]] unordered iter_args(%arg1 = %[[arrayld]]) -> (!fir.array<3xi32>) { +! CHECK: %[[arrayupdate:.*]] = fir.array_update %arg1, %[[c2n]], %arg0 : (!fir.array<3xi32>, i32, index) -> !fir.array<3xi32> +! CHECK: fir.result %[[arrayupdate]] : !fir.array<3xi32> +! CHECK: fir.array_merge_store %[[arrayld]], %[[doloop]] to %[[ld]] : !fir.array<3xi32>, !fir.array<3xi32>, !fir.ptr> +end + +! Test Array Section case + +! CHECK-LABEL: func.func @_QPcray_arraysection() { +subroutine cray_arraySection() + integer :: pte, k(2), data(5) + pointer (ptr, pte(3)) + data = [ 1, 2, 3, 4, 5 ] + ptr = loc(data(2)) + +! CHECK: %[[c5:.*]] = arith.constant 5 : index +! CHECK: %[[data:.*]] = fir.alloca !fir.array<5xi32> {{.*}} +! CHECK: %[[c2:.*]] = arith.constant 2 : index +! CHECK: %[[k:.*]] = fir.alloca !fir.array<2xi32> {{.*}} +! CHECK: %[[c3:.*]] = arith.constant 3 : index +! CHECK: %[[pte:.*]] = fir.alloca !fir.array<3xi32> {{.*}} +! CHECK: %[[ptr:.*]] = fir.alloca i64 {{.*}} +! CHECK: %[[c1:.*]] = arith.constant 2 : i64 +! CHECK: %[[c0:.*]] = arith.constant 1 : i64 +! CHECK: %[[sub:.*]] = arith.subi %[[c1]], %[[c0]] : i64 +! CHECK: %[[cor:.*]] = fir.coordinate_of %[[data]], %[[sub]] : (!fir.ref>, i64) -> !fir.ref +! CHECK: %[[box:.*]] = fir.embox %[[cor]] : (!fir.ref) -> !fir.box +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> i64 +! CHECK: fir.store %[[val]] to %[[ptr]] : !fir.ref + + k = pte(2:3) + print *, k + +! CHECK: %[[shape1:.*]] = fir.shape %[[c2]] : (index) -> !fir.shape<1> +! CHECK: %[[arrayld1:.*]] = fir.array_load %[[k]](%[[shape1]]) : (!fir.ref>, !fir.shape<1>) -> !fir.array<2xi32> +! CHECK: %[[c2i64:.*]] = arith.constant 2 : i64 +! CHECK: %[[conv:.*]] = fir.convert %[[c2i64]] : (i64) -> index +! CHECK: %[[c1i64:.*]] = arith.constant 1 : i64 +! CHECK: %[[conv1:.*]] = fir.convert %[[c1i64]] : (i64) -> index +! CHECK: %[[c3i64:.*]] = arith.constant 3 : i64 +! CHECK: %[[conv2:.*]] = fir.convert %[[c3i64]] : (i64) -> index +! CHECK: %[[shape:.*]] = fir.shape %[[c3]] : (index) -> !fir.shape<1> +! CHECK: %[[slice:.*]] = fir.slice %[[conv]], %[[conv2]], %[[conv1]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[arrayld:.*]] = fir.array_load %[[ld]](%[[shape]]) [%[[slice]]] : (!fir.ptr>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<3xi32> +! CHECK: %[[c1_3:.*]] = arith.constant 1 : index +! CHECK: %[[c0_4:.*]] = arith.constant 0 : index +! CHECK: %[[sub:.*]] = arith.subi %[[c2]], %[[c1_3]] : index +! CHECK: %[[doloop:.*]] = fir.do_loop %arg0 = %[[c0_4]] to %[[sub]] step %[[c1_3]] unordered iter_args(%arg1 = %[[arrayld1]]) -> (!fir.array<2xi32>) { +! CHECK: %[[arrayfetch:.*]] = fir.array_fetch %[[arrayld]], %arg0 : (!fir.array<3xi32>, index) -> i32 +! CHECK: %[[arrayupdate:.*]] = fir.array_update %arg1, %[[arrayfetch]], %arg0 : (!fir.array<2xi32>, i32, index) -> !fir.array<2xi32> +! CHECK: fir.result %[[arrayupdate]] : !fir.array<2xi32> +! CHECK: fir.array_merge_store %[[arrayld1]], %[[doloop]] to %[[k]] : !fir.array<2xi32>, !fir.array<2xi32>, !fir.ref> + + pte(1:2) = -2 + print *, data + +! CHECK: %[[c1_5:.*]] = arith.constant 1 : i64 +! CHECK: %[[conv:.*]] = fir.convert %[[c1_5]] : (i64) -> index +! CHECK: %[[c1_6:.*]] = arith.constant 1 : i64 +! CHECK: %[[conv1:.*]] = fir.convert %[[c1_6]] : (i64) -> index +! CHECK: %[[c2_7:.*]] = arith.constant 2 : i64 +! CHECK: %[[conv2:.*]] = fir.convert %[[c2_7]] : (i64) -> index +! CHECK: %[[c0_8:.*]] = arith.constant 0 : index +! CHECK: %[[sub:.*]] = arith.subi %[[conv2]], %[[conv]] : index +! CHECK: %[[add:.*]] = arith.addi %[[sub]], %[[conv1]] : index +! CHECK: %[[div:.*]] = arith.divsi %[[add]], %[[conv1]] : index +! CHECK: %[[cmp:.*]] = arith.cmpi sgt, %[[div]], %[[c0_8]] : index +! CHECK: %[[sel:.*]] = arith.select %[[cmp]], %[[div]], %[[c0_8]] : index +! CHECK: %[[shape:.*]] = fir.shape %[[c3]] : (index) -> !fir.shape<1> +! CHECK: %[[slice:.*]] = fir.slice %[[conv]], %[[conv2]], %[[conv1]] : (index, index, index) -> !fir.slice<1> +! CHECK: %[[box:.*]] = fir.embox %[[ptr]] : (!fir.ref) -> !fir.box> +! CHECK: %[[addr:.*]] = fir.box_addr %[[box]] : (!fir.box>) -> !fir.ref +! CHECK: %[[val:.*]] = fir.convert %[[addr]] : (!fir.ref) -> !fir.ref>> +! CHECK: %[[ld:.*]] = fir.load %[[val]] : !fir.ref>> +! CHECK: %[[arrayld:.*]] = fir.array_load %[[ld]](%[[shape]]) [%[[slice]]] : (!fir.ptr>, !fir.shape<1>, !fir.slice<1>) -> !fir.array<3xi32> +! CHECK: %[[c2n:.*]] = arith.constant -2 : i32 +! CHECK: %[[c1_9:.*]] = arith.constant 1 : index +! CHECK: %[[c0_8:.*]] = arith.constant 0 : index +! CHECK: %[[sub1:.*]] = arith.subi %[[sel]], %[[c1_9]] : index +! CHECK: %[[doloop:.*]] = fir.do_loop %arg0 = %[[c0_8]] to %[[sub1]] step %[[c1_9]] unordered iter_args(%arg1 = %[[arrayld]]) -> (!fir.array<3xi32>) { +! CHECK: %[[arrayupdate:.*]] = fir.array_update %arg1, %[[c2n]], %arg0 : (!fir.array<3xi32>, i32, index) -> !fir.array<3xi32> +! CHECK: fir.result %[[arrayupdate]] : !fir.array<3xi32> +! CHECK: fir.array_merge_store %[[arrayld]], %[[doloop]] to %[[ld]][%[[slice]]] : !fir.array<3xi32>, !fir.array<3xi32>, !fir.ptr>, !fir.slice<1> +end