@@ -849,7 +849,7 @@ class ScalarExprLowering {
849
849
ExtValue genval (Fortran::semantics::SymbolRef sym) {
850
850
mlir::Location loc = getLoc ();
851
851
ExtValue var = gen (sym);
852
- if (const fir::UnboxedValue *s = var.getUnboxed ())
852
+ if (const fir::UnboxedValue *s = var.getUnboxed ()) {
853
853
if (fir::isa_ref_type (s->getType ())) {
854
854
// A function with multiple entry points returning different types
855
855
// tags all result variables with one of the largest types to allow
@@ -861,9 +861,23 @@ class ScalarExprLowering {
861
861
if (addr.getType () != resultType)
862
862
addr = builder.createConvert (loc, builder.getRefType (resultType),
863
863
addr);
864
+ } else if (sym->test (Fortran::semantics::Symbol::Flag::CrayPointee)) {
865
+ // get the corresponding Cray pointer
866
+ auto ptrSym = Fortran::lower::getPointer (sym);
867
+ ExtValue ptr = gen (ptrSym);
868
+ mlir::Value ptrVal = fir::getBase (ptr);
869
+ mlir::Type ptrTy = converter.genType (*ptrSym);
870
+
871
+ ExtValue pte = gen (sym);
872
+ mlir::Value pteVal = fir::getBase (pte);
873
+
874
+ mlir::Value cnvrt = Fortran::lower::addCrayPointerInst (
875
+ loc, builder, ptrVal, ptrTy, pteVal.getType ());
876
+ addr = builder.create <fir::LoadOp>(loc, cnvrt);
864
877
}
865
878
return genLoad (addr);
866
879
}
880
+ }
867
881
return var;
868
882
}
869
883
@@ -1553,6 +1567,21 @@ class ScalarExprLowering {
1553
1567
args.push_back (builder.create <mlir::arith::SubIOp>(loc, ty, val, lb));
1554
1568
}
1555
1569
mlir::Value base = fir::getBase (array);
1570
+
1571
+ auto baseSym = getFirstSym (aref);
1572
+ if (baseSym.test (Fortran::semantics::Symbol::Flag::CrayPointee)) {
1573
+ // get the corresponding Cray pointer
1574
+ auto ptrSym = Fortran::lower::getPointer (baseSym);
1575
+
1576
+ fir::ExtendedValue ptr = gen (ptrSym);
1577
+ mlir::Value ptrVal = fir::getBase (ptr);
1578
+ mlir::Type ptrTy = ptrVal.getType ();
1579
+
1580
+ mlir::Value cnvrt = Fortran::lower::addCrayPointerInst (
1581
+ loc, builder, ptrVal, ptrTy, base.getType ());
1582
+ base = builder.create <fir::LoadOp>(loc, cnvrt);
1583
+ }
1584
+
1556
1585
mlir::Type eleTy = fir::dyn_cast_ptrOrBoxEleTy (base.getType ());
1557
1586
if (auto classTy = eleTy.dyn_cast <fir::ClassType>())
1558
1587
eleTy = classTy.getEleTy ();
@@ -5632,7 +5661,8 @@ class ArrayExprLowering {
5632
5661
}
5633
5662
5634
5663
// / Base case of generating an array reference,
5635
- CC genarr (const ExtValue &extMemref, ComponentPath &components) {
5664
+ CC genarr (const ExtValue &extMemref, ComponentPath &components,
5665
+ mlir::Value CrayPtr = nullptr ) {
5636
5666
mlir::Location loc = getLoc ();
5637
5667
mlir::Value memref = fir::getBase (extMemref);
5638
5668
mlir::Type arrTy = fir::dyn_cast_ptrOrBoxEleTy (memref.getType ());
@@ -5777,6 +5807,16 @@ class ArrayExprLowering {
5777
5807
}
5778
5808
auto arrLoad = builder.create <fir::ArrayLoadOp>(
5779
5809
loc, arrTy, memref, shape, slice, fir::getTypeParams (extMemref));
5810
+
5811
+ if (CrayPtr) {
5812
+ mlir::Type ptrTy = CrayPtr.getType ();
5813
+ mlir::Value cnvrt = Fortran::lower::addCrayPointerInst (
5814
+ loc, builder, CrayPtr, ptrTy, memref.getType ());
5815
+ auto addr = builder.create <fir::LoadOp>(loc, cnvrt);
5816
+ arrLoad = builder.create <fir::ArrayLoadOp>(loc, arrTy, addr, shape, slice,
5817
+ fir::getTypeParams (extMemref));
5818
+ }
5819
+
5780
5820
mlir::Value arrLd = arrLoad.getResult ();
5781
5821
if (isProjectedCopyInCopyOut ()) {
5782
5822
// Semantics are projected copy-in copy-out.
@@ -6930,6 +6970,21 @@ class ArrayExprLowering {
6930
6970
return genImplicitArrayAccess (x.GetComponent (), components);
6931
6971
}
6932
6972
6973
+ CC genImplicitArrayAccess (const Fortran::semantics::Symbol &x,
6974
+ ComponentPath &components) {
6975
+ mlir::Value ptrVal = nullptr ;
6976
+ if (x.test (Fortran::semantics::Symbol::Flag::CrayPointee)) {
6977
+ auto ptrSym = Fortran::lower::getPointer (x);
6978
+ ExtValue ptr = converter.getSymbolExtendedValue (ptrSym);
6979
+ ptrVal = fir::getBase (ptr);
6980
+ }
6981
+ components.reversePath .push_back (ImplicitSubscripts{});
6982
+ ExtValue exv = asScalarRef (x);
6983
+ lowerPath (exv, components);
6984
+ auto lambda = genarr (exv, components, ptrVal);
6985
+ return [=](IterSpace iters) { return lambda (components.pc (iters)); };
6986
+ }
6987
+
6933
6988
template <typename A>
6934
6989
CC genAsScalar (const A &x) {
6935
6990
mlir::Location loc = getLoc ();
@@ -7573,3 +7628,37 @@ void Fortran::lower::createArrayMergeStores(
7573
7628
esp.resetBindings ();
7574
7629
esp.incrementCounter ();
7575
7630
}
7631
+
7632
+ Fortran::semantics::SymbolRef
7633
+ Fortran::lower::getPointer (Fortran::semantics::SymbolRef sym) {
7634
+ assert (!sym->owner ().crayPointers ().empty () &&
7635
+ " empty Cray pointer/pointee map" );
7636
+ for (const auto &[pointee, pointer] : sym->owner ().crayPointers ()) {
7637
+ if (pointee == sym->name ()) {
7638
+ Fortran::semantics::SymbolRef v{pointer.get ()};
7639
+ return v;
7640
+ }
7641
+ }
7642
+ llvm_unreachable (" corresponding Cray pointer cannot be found" );
7643
+ }
7644
+
7645
+ mlir::Value Fortran::lower::addCrayPointerInst (mlir::Location loc,
7646
+ fir::FirOpBuilder &builder,
7647
+ mlir::Value ptrVal,
7648
+ mlir::Type ptrTy,
7649
+ mlir::Type pteTy) {
7650
+
7651
+ mlir::Value empty;
7652
+ mlir::ValueRange emptyRange;
7653
+ auto boxTy = fir::BoxType::get (ptrTy);
7654
+ auto box = builder.create <fir::EmboxOp>(loc, boxTy, ptrVal, empty, empty,
7655
+ emptyRange);
7656
+ mlir::Value addrof =
7657
+ (ptrTy.isa <fir::ReferenceType>())
7658
+ ? builder.create <fir::BoxAddrOp>(loc, ptrTy, box)
7659
+ : builder.create <fir::BoxAddrOp>(loc, builder.getRefType (ptrTy), box);
7660
+
7661
+ auto refPtrTy =
7662
+ builder.getRefType (fir::PointerType::get (fir::dyn_cast_ptrEleTy (pteTy)));
7663
+ return builder.createConvert (loc, refPtrTy, addrof);
7664
+ }
0 commit comments