[flang][hlfir] Lower Cray pointee references. (#65563)

A Cray pointee reference must be done using the characteristics
(bounds, type params) of the original pointee declaration, but
using the actual address value of the associated Cray pointer.
There might be multiple Cray pointees associated with the same
Cray pointer.

The proposed solution is to lower each Cray pointee into a POINTER
variable with a descriptor. The descriptor is initialized at the point
of declaration of the pointee, though its base_addr is set to null.
Before each reference of the Cray pointee its descriptor's base_addr
is updated to the current value of the Cray pointer.

The update of the base_addr is done using PointerAssociateScalar
runtime call, which just updates the base_addr of the descriptor.
This is a temporary solution just to make Cray pointers work
to the same extent they work with FIR lowering.

Author: vzakhari

flang/include/flang/Lower/ConvertExpr.h

@@ -234,7 +234,6 @@ inline mlir::NamedAttribute getAdaptToByRefAttr(fir::FirOpBuilder &builder) {
           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);

flang/include/flang/Lower/ConvertVariable.h

@@ -125,5 +125,9 @@ void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
                       const Fortran::semantics::Symbol &sym,
                       const fir::ExtendedValue &exv, bool force = false);
 
+/// For the given Cray pointee symbol return the corresponding
+/// Cray pointer symbol. Assert if the pointer symbol cannot be found.
+Fortran::semantics::SymbolRef getCrayPointer(Fortran::semantics::SymbolRef sym);
+
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H

flang/include/flang/Optimizer/Builder/Runtime/Pointer.h

@@ -0,0 +1,30 @@
+//===-- Pointer.h - generate pointer runtime API calls-----------*- C++ -*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_OPTIMIZER_BUILDER_RUNTIME_POINTER_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_POINTER_H
+
+#include "mlir/IR/Value.h"
+
+namespace mlir {
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace fir::runtime {
+
+/// Generate runtime call to associate \p target address of scalar
+/// with the \p desc pointer descriptor.
+void genPointerAssociateScalar(fir::FirOpBuilder &builder, mlir::Location loc,
+                               mlir::Value desc, mlir::Value target);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_POINTER_H

flang/lib/Lower/Bridge.cpp

@@ -3629,7 +3629,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
                     sym->Rank() == 0) {
                   // get the corresponding Cray pointer
 
-                  auto ptrSym = Fortran::lower::getPointer(*sym);
+                  auto ptrSym = Fortran::lower::getCrayPointer(*sym);
                   fir::ExtendedValue ptr =
                       getSymbolExtendedValue(ptrSym, nullptr);
                   mlir::Value ptrVal = fir::getBase(ptr);

flang/lib/Lower/ConvertExpr.cpp

@@ -863,7 +863,7 @@ class ScalarExprLowering {
                                          addr);
         } else if (sym->test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
           // get the corresponding Cray pointer
-          auto ptrSym = Fortran::lower::getPointer(sym);
+          auto ptrSym = Fortran::lower::getCrayPointer(sym);
           ExtValue ptr = gen(ptrSym);
           mlir::Value ptrVal = fir::getBase(ptr);
           mlir::Type ptrTy = converter.genType(*ptrSym);
@@ -1571,7 +1571,7 @@ class ScalarExprLowering {
     auto baseSym = getFirstSym(aref);
     if (baseSym.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
       // get the corresponding Cray pointer
-      auto ptrSym = Fortran::lower::getPointer(baseSym);
+      auto ptrSym = Fortran::lower::getCrayPointer(baseSym);
 
       fir::ExtendedValue ptr = gen(ptrSym);
       mlir::Value ptrVal = fir::getBase(ptr);
@@ -6974,7 +6974,7 @@ class ArrayExprLowering {
                             ComponentPath &components) {
     mlir::Value ptrVal = nullptr;
     if (x.test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
-      auto ptrSym = Fortran::lower::getPointer(x);
+      auto ptrSym = Fortran::lower::getCrayPointer(x);
       ExtValue ptr = converter.getSymbolExtendedValue(ptrSym);
       ptrVal = fir::getBase(ptr);
     }
@@ -7629,19 +7629,6 @@ void Fortran::lower::createArrayMergeStores(
   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,

flang/lib/Lower/ConvertExprToHLFIR.cpp

@@ -28,6 +28,7 @@
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Runtime/Derived.h"
+#include "flang/Optimizer/Builder/Runtime/Pointer.h"
 #include "flang/Optimizer/Builder/Todo.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "llvm/ADT/TypeSwitch.h"
@@ -268,8 +269,36 @@ class HlfirDesignatorBuilder {
   fir::FortranVariableOpInterface
   gen(const Fortran::evaluate::SymbolRef &symbolRef) {
     if (std::optional<fir::FortranVariableOpInterface> varDef =
-            getSymMap().lookupVariableDefinition(symbolRef))
+            getSymMap().lookupVariableDefinition(symbolRef)) {
+      if (symbolRef->test(Fortran::semantics::Symbol::Flag::CrayPointee)) {
+        // The pointee is represented with a descriptor inheriting
+        // the shape and type parameters of the pointee.
+        // We have to update the base_addr to point to the current
+        // value of the Cray pointer variable.
+        fir::FirOpBuilder &builder = getBuilder();
+        fir::FortranVariableOpInterface ptrVar =
+            gen(Fortran::lower::getCrayPointer(symbolRef));
+        mlir::Value ptrAddr = ptrVar.getBase();
+
+        // Reinterpret the reference to a Cray pointer so that
+        // we have a pointer-compatible value after loading
+        // the Cray pointer value.
+        mlir::Type refPtrType = builder.getRefType(
+            fir::PointerType::get(fir::dyn_cast_ptrEleTy(ptrAddr.getType())));
+        mlir::Value cast = builder.createConvert(loc, refPtrType, ptrAddr);
+        mlir::Value ptrVal = builder.create<fir::LoadOp>(loc, cast);
+
+        // Update the base_addr to the value of the Cray pointer.
+        // This is a hacky way to do the update, and it may harm
+        // performance around Cray pointer references.
+        // TODO: we should introduce an operation that updates
+        // just the base_addr of the given box. The CodeGen
+        // will just convert it into a single store.
+        fir::runtime::genPointerAssociateScalar(builder, loc, varDef->getBase(),
+                                                ptrVal);
+      }
       return *varDef;
+    }
     TODO(getLoc(), "lowering symbol to HLFIR");
   }
 

flang/lib/Lower/ConvertVariable.cpp

@@ -1477,6 +1477,8 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
       !Fortran::semantics::IsProcedure(sym) &&
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
+    bool isCrayPointee =
+        sym.test(Fortran::semantics::Symbol::Flag::CrayPointee);
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     const mlir::Location loc = genLocation(converter, sym);
     mlir::Value shapeOrShift;
@@ -1492,6 +1494,51 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
     auto name = converter.mangleName(sym);
     fir::FortranVariableFlagsAttr attributes =
         Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
+
+    if (isCrayPointee) {
+      mlir::Type baseType =
+          hlfir::getFortranElementOrSequenceType(base.getType());
+      if (auto seqType = mlir::dyn_cast<fir::SequenceType>(baseType)) {
+        // The pointer box's sequence type must be with unknown shape.
+        llvm::SmallVector<int64_t> shape(seqType.getDimension(),
+                                         fir::SequenceType::getUnknownExtent());
+        baseType = fir::SequenceType::get(shape, seqType.getEleTy());
+      }
+      fir::BoxType ptrBoxType =
+          fir::BoxType::get(fir::PointerType::get(baseType));
+      mlir::Value boxAlloc = builder.createTemporary(loc, ptrBoxType);
+
+      // Declare a local pointer variable.
+      attributes = fir::FortranVariableFlagsAttr::get(
+          builder.getContext(), fir::FortranVariableFlagsEnum::pointer);
+      auto newBase = builder.create<hlfir::DeclareOp>(
+          loc, boxAlloc, name, /*shape=*/nullptr, lenParams, attributes);
+      mlir::Value nullAddr =
+          builder.createNullConstant(loc, ptrBoxType.getEleTy());
+
+      // If the element type is known-length character, then
+      // EmboxOp does not need the length parameters.
+      if (auto charType = mlir::dyn_cast<fir::CharacterType>(
+              fir::unwrapSequenceType(baseType)))
+        if (!charType.hasDynamicLen())
+          lenParams.clear();
+
+      // Inherit the shape (and maybe length parameters) from the pointee
+      // declaration.
+      mlir::Value initVal =
+          builder.create<fir::EmboxOp>(loc, ptrBoxType, nullAddr, shapeOrShift,
+                                       /*slice=*/nullptr, lenParams);
+      builder.create<fir::StoreOp>(loc, initVal, newBase.getBase());
+
+      // Any reference to the pointee is going to be using the pointer
+      // box from now on. The base_addr of the descriptor must be updated
+      // to hold the value of the Cray pointer at the point of the pointee
+      // access.
+      // Note that the same Cray pointer may be associated with
+      // multiple pointees and each of them has its own descriptor.
+      symMap.addVariableDefinition(sym, newBase, force);
+      return;
+    }
     auto newBase = builder.create<hlfir::DeclareOp>(
         loc, base, name, shapeOrShift, lenParams, attributes);
     symMap.addVariableDefinition(sym, newBase, force);
@@ -2056,3 +2103,16 @@ void Fortran::lower::createRuntimeTypeInfoGlobal(
   mlir::StringAttr linkage = getLinkageAttribute(builder, var);
   defineGlobal(converter, var, globalName, linkage);
 }
+
+Fortran::semantics::SymbolRef
+Fortran::lower::getCrayPointer(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");
+}

flang/lib/Optimizer/Builder/CMakeLists.txt

@@ -22,6 +22,7 @@ add_flang_library(FIRBuilder
   Runtime/Inquiry.cpp
   Runtime/Intrinsics.cpp
   Runtime/Numeric.cpp
+  Runtime/Pointer.cpp
   Runtime/Ragged.cpp
   Runtime/Reduction.cpp
   Runtime/Stop.cpp

flang/lib/Optimizer/Builder/Runtime/Pointer.cpp

@@ -0,0 +1,27 @@
+//===-- Pointer.cpp -- generate pointer runtime API calls------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Optimizer/Builder/Runtime/Pointer.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/pointer.h"
+
+using namespace Fortran::runtime;
+
+void fir::runtime::genPointerAssociateScalar(fir::FirOpBuilder &builder,
+                                             mlir::Location loc,
+                                             mlir::Value desc,
+                                             mlir::Value target) {
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateScalar)>(loc,
+                                                                    builder)};
+  mlir::FunctionType fTy{func.getFunctionType()};
+  llvm::SmallVector<mlir::Value> args{
+      fir::runtime::createArguments(builder, loc, fTy, desc, target)};
+  builder.create<fir::CallOp>(loc, func, args);
+}