[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

239

@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

572–573

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),
         std::nullopt);
   }
 
   bool createHostAssociateVarClone(
       const Fortran::semantics::Symbol &sym) override final {
+    bool success{false};
+    if (const auto *commonDet =
+            sym.detailsIf<Fortran::semantics::CommonBlockDetails>()) {
+      for (const auto &mem : commonDet->objects())
+        success = genHostAssociateVarClone(*mem);
+    } else {
+      success = genHostAssociateVarClone(sym);
+    }
+    return success;
+  }
+
+  bool genHostAssociateVarClone(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();
     mlir::Type hSymType = genType(hsym);
     Fortran::lower::SymbolBox hsb = lookupSymbol(hsym);
 

flang/lib/Lower/OpenMP.cpp

if (const auto &privateClause =
                        &clause.u)) {
       collectOmpObjectListSymbol(lastPrivateClause->v, privatizedSymbols);
       hasLastPrivateOp = true;
     } else if (std::get_if<Fortran::parser::OmpClause::Collapse>(&clause.u)) {
       hasCollapse = true;
     }
   }
 
-  for (const Fortran::semantics::Symbol *ps : privatizedSymbols) {
-    if (ps->has<Fortran::semantics::CommonBlockDetails>())
-      TODO(converter.getCurrentLocation(),
-           "Common Block in privatization clause");
-  }
-
   if (hasCollapse && hasLastPrivateOp)
     TODO(converter.getCurrentLocation(), "Collapse clause with lastprivate");
 }
 
 bool DataSharingProcessor ::needBarrier() {
   for (const Fortran::semantics::Symbol *sym : privatizedSymbols) {
     if (sym->test(Fortran::semantics::Symbol::Flag::OmpFirstPrivate) &&
         sym->test(Fortran::semantics::Symbol::Flag::OmpLastPrivate))

flang/test/Lower/OpenMP/Todo/firstprivate-commonblock.f90

 ! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 ! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
+! XFAIL: *
 
 ! CHECK: not yet implemented: Common Block in privatization clause
 subroutine firstprivate_common
   common /c/ x, y
   real x, y
   !$omp parallel firstprivate(/c/)
   !$omp end parallel
 end subroutine

flang/test/Lower/OpenMP/Todo/lastprivate-commonblock.f90

 ! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
 ! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
+! XFAIL: *
 
 ! CHECK: not yet implemented: Common Block in privatization clause
 subroutine lastprivate_common
   common /c/ x, y
   real x, y
   !$omp do lastprivate(/c/)
   do i=1,100
   end do
   !$omp end do
 end subroutine

flang/test/Lower/OpenMP/Todo/private-commonblock.f90

-! RUN: %not_todo_cmd bbc -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-! RUN: %not_todo_cmd %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
-
-! CHECK: not yet implemented: Common Block in privatization clause
-subroutine private_common
-  common /c/ x, y
-  real x, y
-  !$omp parallel private(/c/)
-  !$omp end parallel
-end subroutine

flang/test/Lower/OpenMP/private-commonblock.f90

+! RUN: %flang_fc1 -emit-fir -fopenmp -o - %s 2>&1 | FileCheck %s
+
+!CHECK: func.func @_QPprivate_common() {
+!CHECK: omp.parallel {
+!CHECK: %[[X:.*]] = fir.alloca f32 {bindc_name = "x", pinned, uniq_name = "_QFprivate_commonEx"}
+!CHECK: %[[Y:.*]] = fir.alloca f32 {bindc_name = "y", pinned, uniq_name = "_QFprivate_commonEy"}
+!CHECK: omp.terminator
+!CHECK: }
+!CHECK: return
+!CHECK: }
+subroutine private_common
+  common /c/ x, y
+  real x, y
+  !$omp parallel private(/c/)
+  !$omp end parallel
+end subroutine
+
+!CHECK: %[[val_0:.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<74xi8>>
+!CHECK: %[[val_1:.*]] = fir.convert %0 : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c0:.*]] = arith.constant 0 : index
+!CHECK: %[[val_2:.*]] = fir.coordinate_of %[[val_1]], %[[val_c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_3:.*]] = fir.convert %[[val_2]] : (!fir.ref<i8>) -> !fir.ref<i32>
+!CHECK: %[[val_4:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c4:.*]] = arith.constant 4 : index
+!CHECK: %[[val_5:.*]] = fir.coordinate_of %[[val_4]], %[[val_c4]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_6:.*]] = fir.convert %[[val_5]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<10xf32>>
+!CHECK: %[[val_7:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c44:.*]] = arith.constant 44 : index
+!CHECK: %[[val_8:.*]] = fir.coordinate_of %[[val_7]], %[[val_c44]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_9:.*]] = fir.convert %[[val_8]] : (!fir.ref<i8>) -> !fir.ref<!fir.char<1,5>>
+!CHECK: %[[val_c5:.*]] = arith.constant 5 : index
+!CHECK: %[[val_10:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c49:.*]] = arith.constant 49 : index
+!CHECK: %[[val_11:.*]] = fir.coordinate_of %[[val_10]], %[[val_c49]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_12:.*]] = fir.convert %[[val_11]] : (!fir.ref<i8>) -> !fir.ref<!fir.array<5x!fir.char<1,5>>>
+!CHECK: %[[val_c5_0:.*]] = arith.constant 5 : index
+!CHECK: %[[val_13:.*]] = fir.convert %[[val_9]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_14:.*]] = fir.emboxchar %[[val_13]], %[[val_c5]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: %[[val_15:.*]] = fir.convert %[[val_12]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_16:.*]] = fir.emboxchar %[[val_15]], %[[val_c5_0]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPsub1(%[[val_3]], %[[val_6]], %[[val_14]], %[[val_16]]) fastmath<contract> : (!fir.ref<i32>, !fir.ref<!fir.array<10xf32>>, !fir.boxchar<1>, !fir.boxchar<1>) -> ()
+!CHECK: omp.parallel {
+!CHECK: %[[val_21:.*]] = fir.alloca i32 {bindc_name = "a", pinned, uniq_name = "_QFprivate_clause_commonblockEa"}
+!CHECK: %[[val_22:.*]] = fir.alloca !fir.array<10xf32> {bindc_name = "b", pinned, uniq_name = "_QFprivate_clause_commonblockEb"}
+!CHECK: %[[val_23:.*]] = fir.alloca !fir.char<1,5> {bindc_name = "c", pinned, uniq_name = "_QFprivate_clause_commonblockEc"}
+!CHECK: %[[val_24:.*]] = fir.alloca !fir.array<5x!fir.char<1,5>> {bindc_name = "d", pinned, uniq_name = "_QFprivate_clause_commonblockEd"}
+!CHECK: %[[val_25:.*]] = fir.convert %[[val_23]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_26:.*]] = fir.emboxchar %[[val_25]], %[[val_c5]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: %[[val_27:.*]] = fir.convert %[[val_24]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_28:.*]] = fir.emboxchar %[[val_27]], %[[val_c5_0]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPsub2(%[[val_21]], %[[val_22]], %[[val_26]], %[[val_28]]) fastmath<contract> : (!fir.ref<i32>, !fir.ref<!fir.array<10xf32>>, !fir.boxchar<1>, !fir.boxchar<1>) -> ()
+!CHECK: omp.terminator
+!CHECK: }
+!CHECK: %[[val_17:.*]] = fir.convert %[[val_9]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_18:.*]] = fir.emboxchar %[[val_17]], %[[val_c5]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: %[[val_19:.*]] = fir.convert %[[val_12]] : (!fir.ref<!fir.array<5x!fir.char<1,5>>>) -> !fir.ref<!fir.char<1,?>>
+!CHECK: %[[val_20:.*]] = fir.emboxchar %[[val_19]], %[[val_c5_0]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.boxchar<1>
+!CHECK: fir.call @_QPsub3(%[[val_3]], %[[val_6]], %[[val_18]], %[[val_20]]) fastmath<contract> : {{.*}}
+!CHECK: return
+!CHECK: }
+subroutine private_clause_commonblock()
+  integer::a
+  real::b(10)
+  character(5):: c, d(5)
+  common /blk/ a, b, c, d
+  
+  call sub1(a, b, c, d)
+  !$omp parallel private(/blk/)
+        call sub2(a, b, c, d)
+  !$omp end parallel
+  call sub3(a, b, c, d)
+end subroutine
+
+!CHECK: func.func @_QPprivate_clause_commonblock_pointer() {
+!CHECK: %[[val_0:.*]] = fir.address_of(@_QCblk) : !fir.ref<!fir.array<74xi8>>
+!CHECK: %[[val_1:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c24:.*]] = arith.constant 24 : index
+!CHECK: %[[val_2:.*]] = fir.coordinate_of %[[val_1]], %[[val_c24]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_3:.*]] = fir.convert %[[val_2]] : (!fir.ref<i8>) -> !fir.ref<i32>
+!CHECK: %[[val_4:.*]] = fir.convert %[[val_0]] : (!fir.ref<!fir.array<74xi8>>) -> !fir.ref<!fir.array<?xi8>>
+!CHECK: %[[val_c0:.*]] = arith.constant 0 : index
+!CHECK: %[[val_5:.*]] = fir.coordinate_of %[[val_4]], %[[val_c0]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+!CHECK: %[[val_6:.*]] = fir.convert %[[val_5]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+!CHECK: %[[val_7:.*]] = fir.load %[[val_6]] : !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+!CHECK: %[[val_8:.*]] = fir.box_addr %[[val_7]] : (!fir.box<!fir.ptr<!fir.complex<4>>>) -> !fir.ptr<!fir.complex<4>>
+!CHECK: %[[val_9:.*]] = fir.convert %[[val_8]] : (!fir.ptr<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+!CHECK: fir.call @_QPsub4(%[[val_9]], %[[val_3]]) fastmath<contract> : (!fir.ref<!fir.complex<4>>, !fir.ref<i32>) -> ()
+!CHECK: omp.parallel {
+!CHECK: %[[val_13:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.complex<4>>> {bindc_name = "c", pinned, uniq_name = "_QFprivate_clause_commonblock_pointerEc"}
+!CHECK: %[[val_14:.*]] = fir.alloca i32 {bindc_name = "a", pinned, uniq_name = "_QFprivate_clause_commonblock_pointerEa"}
+!CHECK: %[[val_15:.*]] = fir.load %[[val_13]] : !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+!CHECK: %[[val_16:.*]] = fir.box_addr %[[val_15]] : (!fir.box<!fir.ptr<!fir.complex<4>>>) -> !fir.ptr<!fir.complex<4>>
+!CHECK: %[[val_17:.*]] = fir.convert %[[val_16]] : (!fir.ptr<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+!CHECK: fir.call @_QPsub5(%[[val_17]], %[[val_14]]) fastmath<contract> : (!fir.ref<!fir.complex<4>>, !fir.ref<i32>) -> ()
+!CHECK: omp.terminator
+!CHECK: }
+!CHECK: %[[val_10:.*]] = fir.load %[[val_6]] : !fir.ref<!fir.box<!fir.ptr<!fir.complex<4>>>>
+!CHECK: %[[val_11:.*]] = fir.box_addr %[[val_10]] : (!fir.box<!fir.ptr<!fir.complex<4>>>) -> !fir.ptr<!fir.complex<4>>
+!CHECK: %[[val_12:.*]] = fir.convert %[[val_11]] : (!fir.ptr<!fir.complex<4>>) -> !fir.ref<!fir.complex<4>>
+!CHECK: fir.call @_QPsub6(%[[val_12]], %[[val_3]]) fastmath<contract> : (!fir.ref<!fir.complex<4>>, !fir.ref<i32>) -> ()
+!CHECK: return
+!CHECK: }
+subroutine private_clause_commonblock_pointer()
+  complex, pointer :: c
+  integer:: a
+  common /blk/ c, a
+  call sub4(c, a)
+  !$omp parallel private(/blk/)
+        call sub5(c, a)
+  !$omp end parallel
+  call sub6(c, a)
+end subroutine