[flang][OpenMP] Support common block in OpenMP private clause

[NimishMishra]

Summary

This supports the common block in OpenMP private clause by making each
common block member host-associated privatization and adds the test case.

[peixin]

Need rebase

[peixin]

Rebase

[peixin]

@kiranchandramohan Hi Kiran, could you please help commandeer this patch? I cannot continue working on it due to work changes.

[NimishMishra]

@kiranchandramohan @peixin If it is okay, I can rebase and merge this patch

[peixin]

In D127215#4481642, @NimishMishra wrote:

@kiranchandramohan @peixin If it is okay, I can rebase and merge this patch

Sure. Thanks, Nimish. But I think this needs review before landing. @kiranchandramohan What do you think?

[kiranchandramohan]

In D127215#4482821, @peixin wrote:

In D127215#4481642, @NimishMishra wrote:

@kiranchandramohan @peixin If it is okay, I can rebase and merge this patch

Sure. Thanks, Nimish. But I think this needs review before landing. @kiranchandramohan What do you think?

Thanks @peixin for your work here. If @NimishMishra can rebase, then I will review it.

[NimishMishra]

Hello @kiranchandramohan and @peixin. I was working towards rebasing this patch. I observed that createHostAssociateVarClone has changed considerably. Basically, present version of createHostAssociateVarClone has none of the following operations:

mlir::Region &curRegion = getFirOpBuilder().getRegion();
mlir::Value oldVal = fir::getBase(getExtendedValue(hsb));
mlir::Value cloneVal = fir::getBase(exv);
for (auto &oper : curRegion.getOps()) {
  for (unsigned int ii = 0; ii < oper.getNumOperands(); ++ii) {
    if (oper.getOperand(ii) == oldVal) {
      oper.setOperand(ii, cloneVal);
    }
  }
}

As such, I was wondering if it would be a better approach to tackle this problem as done here: https://github.com/NimishMishra/f18-llvm-project/commit/10e5acf5ed91375b651951a384cd04b7029b36e8. Basically, instead of working with createHostAssociateVarClone, we work with the argument to this function. Let me know if this sounds cleaner. Or whether there can be some problems in this approach?

[kiranchandramohan]

In D127215#4506065, @NimishMishra wrote:

Hello @kiranchandramohan and @peixin. I was working towards rebasing this patch. I observed that createHostAssociateVarClone has changed considerably. Basically, present version of createHostAssociateVarClone has none of the following operations:

mlir::Region &curRegion = getFirOpBuilder().getRegion();
mlir::Value oldVal = fir::getBase(getExtendedValue(hsb));
mlir::Value cloneVal = fir::getBase(exv);
for (auto &oper : curRegion.getOps()) {
  for (unsigned int ii = 0; ii < oper.getNumOperands(); ++ii) {
    if (oper.getOperand(ii) == oldVal) {
      oper.setOperand(ii, cloneVal);
    }
  }
}

As such, I was wondering if it would be a better approach to tackle this problem as done here: https://github.com/NimishMishra/f18-llvm-project/commit/10e5acf5ed91375b651951a384cd04b7029b36e8. Basically, instead of working with createHostAssociateVarClone, we work with the argument to this function. Let me know if this sounds cleaner. Or whether there can be some problems in this approach?

The code you are pointing to above was a temporary HACK to support the privatisation of the worksharing loop operands. Its removal would not otherwise alter the functionality of createHostAssociateVarClone. If this patch works without big changes, I would prefer that. You can always submit an improvement after that.

[NimishMishra]

Rebasing.

[NimishMishra]

flang/lib/Lower/OpenMP.cpp

206 ↗

(On Diff #541529)

@kiranchandramohan Do you have any suggestion on how to figure out whether a common block is private or firstprivate at this place in the code?

I looked at the flags for the symbols as well, but unfortunately, we don't have any way to do this as far as I can see. I have marked two test cases as XFAIL to let the build pass, but we need a better solution at this.

[NimishMishra]

rebase

[NimishMishra]

@kiranchandramohan Can you take a look at this patch when you are free?

[kiranchandramohan]

LG.

flang/lib/Lower/Bridge.cpp

456–457

Nit: Add braces here.

[kiranchandramohan]

One of the gfortran-testsuite tests started failing after this. I have disabled the test for now.

https://lab.llvm.org/buildbot/#/builders/198/builds/4206

https://github.com/llvm/llvm-test-suite/commit/867cb3ed7ee45376799d4d4af418aee31b6596da

[NimishMishra]

In D127215#4550059, @kiranchandramohan wrote:

One of the gfortran-testsuite tests started failing after this. I have disabled the test for now.

https://lab.llvm.org/buildbot/#/builders/198/builds/4206

https://github.com/llvm/llvm-test-suite/commit/867cb3ed7ee45376799d4d4af418aee31b6596da

I went through the test at https://github.com/llvm/llvm-test-suite/blob/main/Fortran/gfortran/regression/gomp/appendix-a/a.23.4.f90.

Seems like the same variable can't be both in common block as well as in a separate private(.). Is that so?

In any case, should I create an issue and fix this? It seems to be a semantics check with common blocks, and hence perhaps aligns with OpenMP 1.1.

flang/lib/Lower/Bridge.cpp

public:
   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
     return Fortran::lower::getFIRType(
         &getMLIRContext(), tc, bridge.getDefaultKinds().GetDefaultKind(tc),
         llvm::None);
   }
 
   bool createHostAssociateVarClone(
       const Fortran::semantics::Symbol &sym) override final {
-    mlir::Location loc = genLocation(sym.name());
-    mlir::Type symType = genType(sym);
+    if (const auto *commonDet =
+            sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
+      for (const auto &mem : commonDet->objects()) {
+        fir::ExtendedValue memExv = genHostAssociateValue(*mem);
+        if (!bindIfNewSymbol(*mem, memExv))
+          return false;
+      }
+      return true;
+    }
+
+    fir::ExtendedValue exv = genHostAssociateValue(sym);
     const auto *details = sym.detailsIf<Fortran::semantics::HostAssocDetails>();
-    assert(details && "No host-association found");
     const Fortran::semantics::Symbol &hsym = details->symbol();
     Fortran::lower::SymbolBox hsb = lookupSymbol(hsym);
 
-    auto allocate = [&](llvm::ArrayRef<mlir::Value> shape,
-                        llvm::ArrayRef<mlir::Value> typeParams) -> mlir::Value {
-      mlir::Value allocVal = builder->allocateLocal(
-          loc, symType, mangleName(sym), toStringRef(sym.GetUltimate().name()),
-          /*pinned=*/true, shape, typeParams,
-          sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET));
-      return allocVal;
-    };
-
-    fir::ExtendedValue hexv = getExtendedValue(hsb);
-    fir::ExtendedValue exv = hexv.match(
-        [&](const fir::BoxValue &box) -> fir::ExtendedValue {
-          const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
-          if (type && type->IsPolymorphic())
-            TODO(loc, "create polymorphic host associated copy");
-          // Create a contiguous temp with the same shape and length as
-          // the original variable described by a fir.box.
-          llvm::SmallVector<mlir::Value> extents =
-              fir::factory::getExtents(loc, *builder, hexv);
-          if (box.isDerivedWithLenParameters())
-            TODO(loc, "get length parameters from derived type BoxValue");
-          if (box.isCharacter()) {
-            mlir::Value len = fir::factory::readCharLen(*builder, loc, box);
-            mlir::Value temp = allocate(extents, {len});
-            return fir::CharArrayBoxValue{temp, len, extents};
-          }
-          return fir::ArrayBoxValue{allocate(extents, {}), extents};
-        },
-        [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
-          // Allocate storage for a pointer/allocatble descriptor.
-          // No shape/lengths to be passed to the alloca.
-          return fir::MutableBoxValue(allocate({}, {}),
-                                      box.nonDeferredLenParams(), {});
-        },
-        [&](const auto &) -> fir::ExtendedValue {
-          mlir::Value temp =
-              allocate(fir::factory::getExtents(loc, *builder, hexv),
-                       fir::factory::getTypeParams(loc, *builder, hexv));
-          return fir::substBase(hexv, temp);
-        });
-
     // Replace all uses of the original with the clone/copy,
     // esepcially for loop bounds (that uses the variable being privatised)
     // since loop bounds use old values that need to be fixed by using the
     // new copied value.
     // Not able to use replaceAllUsesWith() because uses outside
     // the loop body should not use the clone.
     // FIXME: Call privatization before the loop operation.
     mlir::Region &curRegion = getFirOpBuilder().getRegion();
-    mlir::Value oldVal = fir::getBase(hexv);
+    mlir::Value oldVal = fir::getBase(getExtendedValue(hsb));
     mlir::Value cloneVal = fir::getBase(exv);
     for (auto &oper : curRegion.getOps()) {
       for (unsigned int ii = 0; ii < oper.getNumOperands(); ++ii) {
         if (oper.getOperand(ii) == oldVal) {
           oper.setOperand(ii, cloneVal);
         }
       }
     }
fir::ExtendedValue getExtendedValue(Fortran::lower::SymbolBox sb) {
     return sb.match(
         [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &box) {
           return fir::factory::genMutableBoxRead(*builder, getCurrentLocation(),
                                                  box);
         },
         [&sb](auto &) { return sb.toExtendedValue(); });
   }
 
+  fir::ExtendedValue
+  genHostAssociateValue(const Fortran::semantics::Symbol &sym) {
+    mlir::Location loc = genLocation(sym.name());
+    mlir::Type symType = genType(sym);
+    const auto *details = sym.detailsIf<Fortran::semantics::HostAssocDetails>();
+    assert(details && "No host-association found");
+    const Fortran::semantics::Symbol &hsym = details->symbol();
+    Fortran::lower::SymbolBox hsb = lookupSymbol(hsym);
+
+    auto allocate = [&](llvm::ArrayRef<mlir::Value> shape,
+                        llvm::ArrayRef<mlir::Value> typeParams) -> mlir::Value {
+      mlir::Value allocVal = builder->allocateLocal(
+          loc, symType, mangleName(sym), toStringRef(sym.GetUltimate().name()),
+          /*pinned=*/true, shape, typeParams,
+          sym.GetUltimate().attrs().test(Fortran::semantics::Attr::TARGET));
+      return allocVal;
+    };
+
+    fir::ExtendedValue hexv = getExtendedValue(hsb);
+    return hexv.match(
+        [&](const fir::BoxValue &box) -> fir::ExtendedValue {
+          const Fortran::semantics::DeclTypeSpec *type = sym.GetType();
+          if (type && type->IsPolymorphic())
+            TODO(loc, "create polymorphic host associated copy");
+          // Create a contiguous temp with the same shape and length as
+          // the original variable described by a fir.box.
+          llvm::SmallVector<mlir::Value> extents =
+              fir::factory::getExtents(loc, *builder, hexv);
+          if (box.isDerivedWithLenParameters())
+            TODO(loc, "get length parameters from derived type BoxValue");
+          if (box.isCharacter()) {
+            mlir::Value len = fir::factory::readCharLen(*builder, loc, box);
+            mlir::Value temp = allocate(extents, {len});
+            return fir::CharArrayBoxValue{temp, len, extents};
+          }
+          return fir::ArrayBoxValue{allocate(extents, {}), extents};
+        },
+        [&](const fir::MutableBoxValue &box) -> fir::ExtendedValue {
+          // Allocate storage for a pointer/allocatble descriptor.
+          // No shape/lengths to be passed to the alloca.
+          return fir::MutableBoxValue(allocate({}, {}),
+                                      box.nonDeferredLenParams(), {});
+        },
+        [&](const auto &) -> fir::ExtendedValue {
+          mlir::Value temp =
+              allocate(fir::factory::getExtents(loc, *builder, hexv),
+                       fir::getTypeParams(hexv));
+          return fir::substBase(hexv, temp);
+        });
+  }
+
   /// Generate the address of loop variable \p sym.
   /// If \p sym is not mapped yet, allocate local storage for it.
   mlir::Value genLoopVariableAddress(mlir::Location loc,
                                      const Fortran::semantics::Symbol &sym,
                                      bool isUnordered) {
     if (isUnordered || sym.has<Fortran::semantics::HostAssocDetails>() ||
         sym.has<Fortran::semantics::UseDetails>()) {
       if (!shallowLookupSymbol(sym)) {

flang/test/Lower/OpenMP/omp-parallel-private-clause.f90

subroutine private_clause_allocatable()
 
         print *, x, x2, x3, x4
 
 !$OMP PARALLEL PRIVATE(x, x2, x3, x4)
         print *, x, x2, x3, x4
 !$OMP END PARALLEL
 
 end subroutine
+
+! CHECK-LABEL: func.func @_QPprivate_clause_commonblock() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QBblk) : !fir.ref<!fir.array<102xi8>>
+! CHECK:         %[[VAL_1:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<102xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:         %[[VAL_2:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_3:.*]] = fir.coordinate_of %[[VAL_1]], %[[VAL_2]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_3]] : (!fir.ref<i8>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<102xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:         %[[VAL_6:.*]] = arith.constant 4 : index
+! CHECK:         %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_6]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<10xf32>>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<102xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:         %[[VAL_10:.*]] = arith.constant 48 : index
+! CHECK:         %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_10]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+! CHECK:         %[[VAL_13:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<102xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:         %[[VAL_14:.*]] = arith.constant 72 : index
+! CHECK:         %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_13]], %[[VAL_14]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:         %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (!fir.ref<i8>) -> !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_17:.*]] = arith.constant 5 : index
+! CHECK:         %[[VAL_18:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.array<102xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:         %[[VAL_19:.*]] = arith.constant 77 : index
+! CHECK:         %[[VAL_20:.*]] = fir.coordinate_of %[[VAL_18]], %[[VAL_19]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:         %[[VAL_21:.*]] = fir.convert %[[VAL_20]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<5x!fir.char<1,5>>>
+! CHECK:         %[[VAL_22:.*]] = arith.constant 5 : index
+! CHECK:         %[[VAL_23:.*]] = fir.load %[[VAL_12]] : !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+! CHECK:         %[[VAL_24:.*]] = fir.box_addr %[[VAL_23]] : (!fir.box<!fir.ptr<!fir.complex<4>>>) -> !fir.ptr<!fir.complex<4>>
+! CHECK:         %[[VAL_25:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_26:.*]] = fir.emboxchar %[[VAL_25]], %[[VAL_17]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         %[[VAL_27:.*]] = fir.convert %[[VAL_21]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_28:.*]] = fir.emboxchar %[[VAL_27]], %[[VAL_22]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         %[[VAL_29:.*]] = fir.convert %[[VAL_24]] : (!fir.ptr<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+! CHECK:         fir.call @_QPsub1(%[[VAL_4]], %[[VAL_8]], %[[VAL_29]], %[[VAL_26]], %[[VAL_28]]) : (!fir.ref<i32>, !fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.complex<4>>, !fir.boxchar<1>, !fir.boxchar<1>) -> ()
+! CHECK:         omp.parallel   {
+! CHECK:           %[[VAL_30:.*]] = fir.alloca i32 {bindc_name = "a", pinned, uniq_name = "_QFprivate_clause_commonblockEa"}
+! CHECK:           %[[VAL_31:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "b", pinned, uniq_name = "_QFprivate_clause_commonblockEb"}
+! CHECK:           %[[VAL_32:.*]] = fir.alloca !fir.complex<4> {bindc_name = "c", pinned, uniq_name = "_QFprivate_clause_commonblockEc"}
+! CHECK:           %[[VAL_33:.*]] = fir.alloca !fir.char<1,5> {bindc_name = "d", pinned, uniq_name = "_QFprivate_clause_commonblockEd"}
+! CHECK:           %[[VAL_34:.*]] = fir.alloca !fir.array<5x!fir.char<1,5>> {bindc_name = "e", pinned, uniq_name = "_QFprivate_clause_commonblockEe"}
+! CHECK:           %[[VAL_35:.*]] = fir.convert %[[VAL_33]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:           %[[VAL_36:.*]] = fir.emboxchar %[[VAL_35]], %[[VAL_17]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:           %[[VAL_37:.*]] = fir.convert %[[VAL_34]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:           %[[VAL_38:.*]] = fir.emboxchar %[[VAL_37]], %[[VAL_22]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:           fir.call @_QPsub2(%[[VAL_30]], %[[VAL_31]], %[[VAL_32]], %[[VAL_36]], %[[VAL_38]]) : (!fir.ref<i32>, !fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.complex<4>>, !fir.boxchar<1>, !fir.boxchar<1>) -> ()
+! CHECK:           omp.terminator
+! CHECK:         }
+! CHECK:         %[[VAL_39:.*]] = fir.load %[[VAL_12]] : !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+! CHECK:         %[[VAL_40:.*]] = fir.box_addr %[[VAL_39]] : (!fir.box<!fir.ptr<!fir.complex<4>>>) -> !fir.ptr<!fir.complex<4>>
+! CHECK:         %[[VAL_41:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_42:.*]] = fir.emboxchar %[[VAL_41]], %[[VAL_17]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         %[[VAL_43:.*]] = fir.convert %[[VAL_21]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_44:.*]] = fir.emboxchar %[[VAL_43]], %[[VAL_22]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+! CHECK:         %[[VAL_45:.*]] = fir.convert %[[VAL_40]] : (!fir.ptr<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+! CHECK:         fir.call @_QPsub3(%[[VAL_4]], %[[VAL_8]], %[[VAL_45]], %[[VAL_42]], %[[VAL_44]]) : (!fir.ref<i32>, !fir.ref<!fir.array<10xf32>>, !fir.ref<!fir.complex<4>>, !fir.boxchar<1>, !fir.boxchar<1>) -> ()
+! CHECK:         return
+! CHECK:       }
+
+subroutine private_clause_commonblock()
+  
+        integer :: a
+        real :: b(10)
+        complex, pointer :: c
+        character(5) :: d, e(5)
+        common /blk/ a, b, c, d, e
+
+        call sub1(a, b, c, d, e)
+
+!$OMP PARALLEL PRIVATE(/blk/)
+        call sub2(a, b, c, d, e)
+!$OMP END PARALLEL
+
+        call sub3(a, b, c, d, e)
+
+end subroutine