[flang][hlfir] Alias analysis for host associated accesses.

flang/include/flang/Lower/ConvertVariable.h

@@ -18,6 +18,7 @@
 #define FORTRAN_LOWER_CONVERT_VARIABLE_H
 
 #include "flang/Lower/Support/Utils.h"
+#include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "mlir/IR/Value.h"
 #include "llvm/ADT/DenseMap.h"
 
@@ -115,15 +116,20 @@ void createRuntimeTypeInfoGlobal(Fortran::lower::AbstractConverter &converter,
 /// representation.
 fir::FortranVariableFlagsAttr
 translateSymbolAttributes(mlir::MLIRContext *mlirContext,
-                          const Fortran::semantics::Symbol &sym);
+                          const Fortran::semantics::Symbol &sym,
+                          fir::FortranVariableFlagsEnum extraFlags =
+                              fir::FortranVariableFlagsEnum::None);
 
 /// Map a symbol to a given fir::ExtendedValue. This will generate an
 /// hlfir.declare when lowering to HLFIR and map the hlfir.declare result to the
 /// symbol.
 void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
                       Fortran::lower::SymMap &symMap,
                       const Fortran::semantics::Symbol &sym,
-                      const fir::ExtendedValue &exv, bool force = false);
+                      const fir::ExtendedValue &exv,
+                      fir::FortranVariableFlagsEnum extraFlags =
+                          fir::FortranVariableFlagsEnum::None,
+                      bool force = false);
 
 /// For the given Cray pointee symbol return the corresponding
 /// Cray pointer symbol. Assert if the pointer symbol cannot be found.

flang/include/flang/Optimizer/Analysis/AliasAnalysis.h

@@ -33,6 +33,9 @@ class AliasAnalysis {
              /// Memory allocated outside of a function and passed
              /// to the function as a by-ref argument.
              Argument,
+             /// Represents memory allocated outside of a function
+             /// and passed to the function via host association tuple.
+             HostAssoc,
              /// Represents memory allocated by unknown means and
              /// with the memory address defined by a memory reading
              /// operation (e.g. fir::LoadOp).

flang/include/flang/Optimizer/Dialect/FIRAttr.td

@@ -32,13 +32,14 @@ def FIRpointer      : I32BitEnumAttrCaseBit<"pointer", 9>;
 def FIRtarget       : I32BitEnumAttrCaseBit<"target", 10>;
 def FIRvalue        : I32BitEnumAttrCaseBit<"value", 11>;
 def FIRvolatile     : I32BitEnumAttrCaseBit<"fortran_volatile", 12, "volatile">;
+def FIRHostAssoc    : I32BitEnumAttrCaseBit<"host_assoc", 13>;
 
 def fir_FortranVariableFlagsEnum : I32BitEnumAttr<
     "FortranVariableFlagsEnum",
     "Fortran variable attributes",
     [FIRnoAttributes, FIRallocatable, FIRasynchronous, FIRbind_c, FIRcontiguous,
      FIRintent_in, FIRintent_inout, FIRintent_out, FIRoptional, FIRparameter,
-     FIRpointer, FIRtarget, FIRvalue, FIRvolatile]> {
+     FIRpointer, FIRtarget, FIRvalue, FIRvolatile, FIRHostAssoc]> {
   let separator = ", ";
   let cppNamespace = "::fir";
   let printBitEnumPrimaryGroups = 1;

flang/include/flang/Optimizer/Dialect/FortranVariableInterface.td

@@ -170,6 +170,13 @@ def fir_FortranVariableOpInterface : OpInterface<"FortranVariableOpInterface"> {
                         fir::FortranVariableFlagsEnum::parameter);
     }
 
+    /// Is this a host associated variable?
+    bool isHostAssoc() {
+      auto attrs = getFortranAttrs();
+      return attrs && bitEnumContainsAny(*attrs,
+                        fir::FortranVariableFlagsEnum::host_assoc);
+    }
+
     /// Interface verifier imlementation for declare operations.
     mlir::LogicalResult verifyDeclareLikeOpImpl(mlir::Value memRef);
 

flang/lib/Lower/Bridge.cpp

@@ -1005,7 +1005,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     if (!forced && lookupSymbol(sym))
       return false;
     if (lowerToHighLevelFIR()) {
-      Fortran::lower::genDeclareSymbol(*this, localSymbols, sym, val, forced);
+      Fortran::lower::genDeclareSymbol(*this, localSymbols, sym, val,
+                                       fir::FortranVariableFlagsEnum::None,
+                                       forced);
     } else {
       localSymbols.addSymbol(sym, val, forced);
     }

flang/lib/Lower/ConvertVariable.cpp

@@ -1422,8 +1422,9 @@ recoverShapeVector(llvm::ArrayRef<std::int64_t> shapeVec, mlir::Value initVal) {
 }
 
 fir::FortranVariableFlagsAttr Fortran::lower::translateSymbolAttributes(
-    mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym) {
-  fir::FortranVariableFlagsEnum flags = fir::FortranVariableFlagsEnum::None;
+    mlir::MLIRContext *mlirContext, const Fortran::semantics::Symbol &sym,
+    fir::FortranVariableFlagsEnum extraFlags) {
+  fir::FortranVariableFlagsEnum flags = extraFlags;
   const auto &attrs = sym.attrs();
   if (attrs.test(Fortran::semantics::Attr::ALLOCATABLE))
     flags = flags | fir::FortranVariableFlagsEnum::allocatable;
@@ -1571,14 +1572,16 @@ static void genDeclareSymbol(Fortran::lower::AbstractConverter &converter,
 void Fortran::lower::genDeclareSymbol(
     Fortran::lower::AbstractConverter &converter,
     Fortran::lower::SymMap &symMap, const Fortran::semantics::Symbol &sym,
-    const fir::ExtendedValue &exv, bool force) {
+    const fir::ExtendedValue &exv, fir::FortranVariableFlagsEnum extraFlags,
+    bool force) {
   if (converter.getLoweringOptions().getLowerToHighLevelFIR() &&
       !Fortran::semantics::IsProcedure(sym) &&
       !sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
     fir::FirOpBuilder &builder = converter.getFirOpBuilder();
     const mlir::Location loc = genLocation(converter, sym);
     fir::FortranVariableFlagsAttr attributes =
-        Fortran::lower::translateSymbolAttributes(builder.getContext(), sym);
+        Fortran::lower::translateSymbolAttributes(builder.getContext(), sym,
+                                                  extraFlags);
     auto name = converter.mangleName(sym);
     hlfir::EntityWithAttributes declare =
         hlfir::genDeclare(loc, builder, exv, name, attributes);
@@ -1625,8 +1628,9 @@ static void genBoxDeclare(Fortran::lower::AbstractConverter &converter,
                           bool replace = false) {
   if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
     fir::BoxValue boxValue{box, lbounds, explicitParams, explicitExtents};
-    Fortran::lower::genDeclareSymbol(converter, symMap, sym,
-                                     std::move(boxValue), replace);
+    Fortran::lower::genDeclareSymbol(
+        converter, symMap, sym, std::move(boxValue),
+        fir::FortranVariableFlagsEnum::None, replace);
     return;
   }
   symMap.addBoxSymbol(sym, box, lbounds, explicitParams, explicitExtents,

flang/lib/Lower/HostAssociations.cpp

@@ -73,13 +73,11 @@ static void bindCapturedSymbol(const Fortran::semantics::Symbol &sym,
                                fir::ExtendedValue val,
                                Fortran::lower::AbstractConverter &converter,
                                Fortran::lower::SymMap &symMap) {
-  if (converter.getLoweringOptions().getLowerToHighLevelFIR()) {
-    // TODO: add an indication that this is a host variable in the declare to
-    // allow alias analysis to detect this case.
-    Fortran::lower::genDeclareSymbol(converter, symMap, sym, val);
-  } else {
+  if (converter.getLoweringOptions().getLowerToHighLevelFIR())
+    Fortran::lower::genDeclareSymbol(converter, symMap, sym, val,
+                                     fir::FortranVariableFlagsEnum::host_assoc);
+  else
     symMap.addSymbol(sym, val);
-  }
 }
 
 namespace {

flang/lib/Optimizer/Analysis/AliasAnalysis.cpp

@@ -10,6 +10,7 @@
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
 #include "flang/Optimizer/Dialect/FIRType.h"
+#include "flang/Optimizer/Dialect/FortranVariableInterface.h"
 #include "flang/Optimizer/HLFIR/HLFIROps.h"
 #include "mlir/Analysis/AliasAnalysis.h"
 #include "mlir/IR/BuiltinOps.h"
@@ -93,6 +94,10 @@ AliasResult AliasAnalysis::alias(Value lhs, Value rhs) {
       return AliasResult::MustAlias;
     }
 
+    // Two host associated accesses may overlap due to an equivalence.
+    if (lhsSrc.kind == SourceKind::HostAssoc)
+      return AliasResult::MayAlias;
+
     // Allocate and global memory address cannot physically alias
     if (lhsSrc.kind == SourceKind::Allocate ||
         lhsSrc.kind == SourceKind::Global)
@@ -128,13 +133,37 @@ AliasResult AliasAnalysis::alias(Value lhs, Value rhs) {
     src2 = &lhsSrc;
   }
 
-  assert(src2->kind <= SourceKind::Argument && "unexpected memory source kind");
+  assert(src2->kind <= SourceKind::HostAssoc &&
+         "unexpected memory source kind");
   if (src1->kind == SourceKind::Allocate)
     return AliasResult::NoAlias;
 
-  assert(src1->kind == SourceKind::Global &&
-         src2->kind == SourceKind::Argument &&
-         "unexpected memory source kinds");
+  assert((src1->kind == SourceKind::Global &&
+          (src2->kind == SourceKind::Argument ||
+           src2->kind == SourceKind::HostAssoc)) ||
+         (src1->kind == SourceKind::Argument &&
+          src2->kind == SourceKind::HostAssoc) &&
+             "unexpected memory source kinds");
+
+  if (src1->kind == SourceKind::Argument &&
+      src2->kind == SourceKind::HostAssoc) {
+    // Treat the host entity as TARGET for the purpose of disambiguating
+    // it with a dummy access. It is required for this particular case:
+    // subroutine test
+    //   integer :: x(10)
+    //   call inner(x)
+    // contains
+    //   subroutine inner(y)
+    //     integer, target :: y(:)
+    //     x(1) = y(1)
+    //   end subroutine inner
+    // end subroutine test
+    //
+    // F18 15.5.2.13 (4) (b) allows 'x' and 'y' to address the same object.
+    // 'y' has an explicit TARGET attribute, but 'x' has neither TARGET
+    // nor POINTER.
+    src2->attributes.set(Attribute::Target);
+  }
 
   // Dummy TARGET/POINTER argument may alias with a global TARGET/POINTER.
   if (src1->isTargetOrPointer() && src2->isTargetOrPointer())
@@ -235,6 +264,21 @@ AliasAnalysis::Source AliasAnalysis::getSource(mlir::Value v) {
           breakFromLoop = true;
         })
         .Case<hlfir::DeclareOp, fir::DeclareOp>([&](auto op) {
+          auto varIf = llvm::cast<fir::FortranVariableOpInterface>(defOp);
+          if (varIf.isHostAssoc()) {
+            // Do not track past such DeclareOp, because it does not
+            // currently provide any useful information. The host associated
+            // access will end up dereferencing the host association tuple,
+            // so we may as well stop right now.
+            v = defOp->getResult(0);
+            // TODO: if the host associated variable is a dummy argument
+            // of the host, I think, we can treat it as SourceKind::Argument
+            // for the purpose of alias analysis inside the internal procedure.
+            type = SourceKind::HostAssoc;
+            breakFromLoop = true;
+            return;
+          }
+
           // Track further through the operand
           v = op.getMemref();
           defOp = v.getDefiningOp();