Lower derived array assignment and improve derived scalar assignment

jeanPerier · jeanPerier · commit de7bbdd9d576 · 2021-08-25T00:46:27.000-07:00
Move the genRecordAssignment scalar assignment helper in fir::factory so
that it can be used for the array case in ArrayCopyValue.cpp.

Simplify genRecordAssignment to only lower as inline code the cases where
a mem copy can be done to implement the derive type assignment (that is
when their are no allocatable component, automatic component, or
component requiring a user defined assignment calls). For the rest, use
the runtime genAssign() that handles deep copies and user defined
assignments.

For the inline version, instead of working component by component, and
using the array expression framework for array components, simply emit a
derived type load + store. This is OK since the derived types assigned
inlined have constant size. LLVM transform this into element by element
assignment of llvm.memmove itself (opt --memcpyopt inserts memmove calls).

This allows implementing the simple cases inlined without depending on
the array expression framework (which is not possible during the
ArrayCopyValue pass), or manually creating llvm.memmove, which would
require inserting a fir.sizeof of to compute the byte size for the
memmove.
diff --git a/flang/include/flang/Optimizer/Builder/FIRBuilder.h b/flang/include/flang/Optimizer/Builder/FIRBuilder.h
@@ -39,6 +39,9 @@ class FirOpBuilder : public mlir::OpBuilder {
 public:
   explicit FirOpBuilder(mlir::Operation *op, const fir::KindMapping &kindMap)
       : OpBuilder{op}, kindMap{kindMap} {}
+  explicit FirOpBuilder(mlir::OpBuilder &builder,
+                        const fir::KindMapping &kindMap)
+      : OpBuilder{builder}, kindMap{kindMap} {}
 
   /// Get the current Region of the insertion point.
   mlir::Region &getRegion() { return *getBlock()->getParent(); }
@@ -422,6 +425,12 @@ fir::ExtendedValue componentToExtendedValue(fir::FirOpBuilder &builder,
                                             mlir::Location loc,
                                             mlir::Value component);
 
+/// Assign \p rhs to \p lhs. Both \p rhs and \p lhs must be scalar derived
+/// types. The assignment follows Fortran intrinsic assignment semantic for
+/// derived types (10.2.1.3 point 13).
+void genRecordAssignment(fir::FirOpBuilder &builder, mlir::Location loc,
+                         const fir::ExtendedValue &lhs,
+                         const fir::ExtendedValue &rhs);
 } // namespace fir::factory
 
 #endif // FORTRAN_OPTIMIZER_BUILDER_FIRBUILDER_H
diff --git a/flang/include/flang/Optimizer/Runtime/Assign.h b/flang/include/flang/Optimizer/Runtime/Assign.h
@@ -0,0 +1,32 @@
+//===-- Assign.h - generate assignment 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_RUNTIME_ASSIGN_H
+#define FORTRAN_OPTIMIZER_RUNTIME_ASSIGN_H
+
+namespace mlir {
+class Value;
+class Location;
+} // namespace mlir
+
+namespace fir {
+class FirOpBuilder;
+}
+
+namespace fir::runtime {
+
+/// Generate runtime call to assign \p sourceBox to \p destBox.
+/// \p destBox must be a fir.ref<fir.box<T>> and \p sourceBox a fir.box<T>.
+/// \p destBox Fortran descriptor may be modified if destBox is an allocatable
+/// according to Fortran allocatable assignment rules, otherwise it is not
+/// modified.
+void genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
+               mlir::Value destBox, mlir::Value sourceBox);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_RUNTIME_ASSIGN_H
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
@@ -1729,69 +1729,6 @@ class FirConverter : public Fortran::lower::AbstractConverter {
            !Fortran::evaluate::HasVectorSubscript(expr);
   }
 
-  // Recursively assign members of a record type.
-  void genRecordAssignment(const fir::ExtendedValue &lhs,
-                           const fir::ExtendedValue &rhs,
-                           Fortran::lower::StatementContext &stmtCtx) {
-    auto loc = genLocation();
-    auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
-    assert(baseTy && "must be a memory type");
-    auto lhsTy = baseTy.dyn_cast<fir::RecordType>();
-    assert(lhsTy && "must be a record type");
-    auto fieldTy = fir::FieldType::get(lhsTy.getContext());
-    for (auto [fldName, fldType] : lhsTy.getTypeList()) {
-      mlir::Value field = builder->create<fir::FieldIndexOp>(
-          loc, fieldTy, fldName, lhsTy, fir::getTypeParams(lhs));
-      auto fldRefTy = builder->getRefType(fldType);
-      auto fromCoor = builder->create<fir::CoordinateOp>(
-          loc, fldRefTy, fir::getBase(rhs), field);
-      auto from =
-          fir::factory::componentToExtendedValue(*builder, loc, fromCoor);
-      auto toCoor = builder->create<fir::CoordinateOp>(
-          loc, fldRefTy, fir::getBase(lhs), field);
-      auto to = fir::factory::componentToExtendedValue(*builder, loc, toCoor);
-      to.match(
-          [&](const fir::UnboxedValue &toPtr) {
-            // FIXME: this is incorrect after F95 to simply load/store derived
-            // type since they may have allocatable components that require
-            // deep-copy or may have defined assignment procedures.
-            auto loadVal =
-                builder->create<fir::LoadOp>(loc, fir::getBase(from));
-            builder->create<fir::StoreOp>(loc, loadVal, toPtr);
-          },
-          [&](const fir::CharBoxValue &) {
-            fir::factory::CharacterExprHelper{*builder, loc}.createAssign(to,
-                                                                          from);
-          },
-          [&](const fir::ArrayBoxValue &) {
-            Fortran::lower::createSomeArrayAssignment(*this, to, from,
-                                                      localSymbols, stmtCtx);
-          },
-          [&](const fir::CharArrayBoxValue &) {
-            Fortran::lower::createSomeArrayAssignment(*this, to, from,
-                                                      localSymbols, stmtCtx);
-          },
-          [&](const fir::BoxValue &toBox) {
-            fir::emitFatalError(loc, "derived type components must not be "
-                                     "represented by fir::BoxValue");
-          },
-          [&](const fir::MutableBoxValue &toBox) {
-            if (toBox.isPointer()) {
-              // Copy association status by copying the fir.box.
-              auto loadVal =
-                  builder->create<fir::LoadOp>(loc, fir::getBase(from));
-              builder->create<fir::StoreOp>(loc, loadVal, fir::getBase(to));
-              return;
-            }
-            // For allocatable components, a deep copy is needed.
-            TODO(loc, "allocatable components in derived type assignment");
-          },
-          [&](const fir::ProcBoxValue &toBox) {
-            TODO(loc, "procedure pointer component in derived type assignment");
-          });
-    }
-  }
-
   [[maybe_unused]] static bool
   isFuncResultDesignator(const Fortran::lower::SomeExpr &expr) {
     const auto *sym = Fortran::evaluate::GetFirstSymbol(expr);
@@ -1892,7 +1829,7 @@ class FirConverter : public Fortran::lower::AbstractConverter {
               if (isDerivedCategory(lhsType->category())) {
                 // Fortran 2018 10.2.1.3 p13 and p14
                 // Recursively gen an assignment on each element pair.
-                genRecordAssignment(lhs, rhs, stmtCtx);
+                fir::factory::genRecordAssignment(*builder, loc, lhs, rhs);
                 return;
               }
               llvm_unreachable("unknown category");
diff --git a/flang/lib/Optimizer/Builder/FIRBuilder.cpp b/flang/lib/Optimizer/Builder/FIRBuilder.cpp
@@ -14,6 +14,7 @@
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Dialect/FIRAttr.h"
 #include "flang/Optimizer/Dialect/FIROpsSupport.h"
+#include "flang/Optimizer/Runtime/Assign.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Optimizer/Support/InternalNames.h"
 #include "mlir/Dialect/OpenMP/OpenMPDialect.h"
@@ -740,3 +741,56 @@ fir::ExtendedValue fir::factory::componentToExtendedValue(
     return fir::ArrayBoxValue{component, extents};
   return component;
 }
+
+/// Can the assignment of this record type be implement with a simple memory
+/// copy ?
+static bool recordTypeCanBeMemCopied(fir::RecordType recordType) {
+  if (fir::hasDynamicSize(recordType))
+    return false;
+  for (auto [_, fieldType] : recordType.getTypeList()) {
+    // Derived type component may have user assignment (so far, we cannot tell
+    // in FIR, so assume it is always the case, TODO: get the actual info).
+    if (fir::unwrapSequenceType(fieldType).isa<fir::RecordType>())
+      return false;
+    // Allocatable components need deep copy.
+    if (auto boxType = fieldType.dyn_cast<fir::BoxType>())
+      if (boxType.getEleTy().isa<fir::HeapType>())
+        return false;
+  }
+  // Constant size components without user defined assignment and pointers can
+  // be memcopied.
+  return true;
+}
+
+void fir::factory::genRecordAssignment(fir::FirOpBuilder &builder,
+                                       mlir::Location loc,
+                                       const fir::ExtendedValue &lhs,
+                                       const fir::ExtendedValue &rhs) {
+  assert(lhs.rank() == 0 && rhs.rank() == 0 && "assume scalar assignment");
+  auto baseTy = fir::dyn_cast_ptrOrBoxEleTy(fir::getBase(lhs).getType());
+  assert(baseTy && "must be a memory type");
+  // Box operands may be polymorphic, it is not entirely clear from 10.2.1.3
+  // if the assignment is performed on the dynamic of declared type. Use the
+  // runtime assuming it is performed on the dynamic type.
+  bool hasBoxOperands = fir::getBase(lhs).getType().isa<fir::BoxType>() ||
+                        fir::getBase(rhs).getType().isa<fir::BoxType>();
+  auto recTy = baseTy.dyn_cast<fir::RecordType>();
+  assert(recTy && "must be a record type");
+  if (hasBoxOperands || !recordTypeCanBeMemCopied(recTy)) {
+    auto to = fir::getBase(builder.createBox(loc, lhs));
+    auto from = fir::getBase(builder.createBox(loc, rhs));
+    // The runtime entry point may modify the LHS descriptor if it is
+    // an allocatable. Allocatable assignment is handle elsewhere in lowering,
+    // so just create a fir.ref<fir.box<>> from the fir.box to comply with the
+    // runtime interface, but assume the fir.box is unchanged.
+    // TODO: does this holds true with polymorphic entities ?
+    auto toMutableBox = builder.createTemporary(loc, to.getType());
+    builder.create<fir::StoreOp>(loc, to, toMutableBox);
+    fir::runtime::genAssign(builder, loc, toMutableBox, from);
+    return;
+  }
+  // Otherwise, the derived type has compile time constant size and for which
+  // the component by component assignment can be replaced by a memory copy.
+  auto load = builder.create<fir::LoadOp>(loc, fir::getBase(rhs));
+  builder.create<fir::StoreOp>(loc, load, fir::getBase(lhs));
+}
diff --git a/flang/lib/Optimizer/Runtime/Assign.cpp b/flang/lib/Optimizer/Runtime/Assign.cpp
@@ -0,0 +1,26 @@
+//===-- Assign.cpp -- generate assignment 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/Runtime/Assign.h"
+#include "../../../runtime/assign.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Runtime/RTBuilder.h"
+
+using namespace Fortran::runtime;
+
+void fir::runtime::genAssign(fir::FirOpBuilder &builder, mlir::Location loc,
+                             mlir::Value destBox, mlir::Value sourceBox) {
+  auto func = fir::runtime::getRuntimeFunc<mkRTKey(Assign)>(loc, builder);
+  auto fTy = func.getType();
+  auto sourceFile = fir::factory::locationToFilename(builder, loc);
+  auto sourceLine =
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(3));
+  auto args = fir::runtime::createArguments(builder, loc, fTy, destBox,
+                                            sourceBox, sourceFile, sourceLine);
+  builder.create<fir::CallOp>(loc, func, args);
+}
diff --git a/flang/lib/Optimizer/Runtime/CMakeLists.txt b/flang/lib/Optimizer/Runtime/CMakeLists.txt
@@ -1,6 +1,7 @@
 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FIRRuntime
+  Assign.cpp
   Character.cpp
   Derived.cpp
   Numeric.cpp
diff --git a/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp b/flang/lib/Optimizer/Transforms/ArrayValueCopy.cpp
@@ -8,7 +8,10 @@
 
 #include "PassDetail.h"
 #include "flang/Lower/Todo.h" // delete!
+#include "flang/Optimizer/Builder/BoxValue.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
+#include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Optimizer/Transforms/Factory.h"
 #include "flang/Optimizer/Transforms/Passes.h"
 #include "mlir/Dialect/SCF/SCF.h"
@@ -519,7 +522,21 @@ class ArrayUpdateConversion : public mlir::OpRewritePattern<ArrayUpdateOp> {
           fir::factory::genCharacterCopy(input, recoverCharLen(input), coor,
                                          recoverCharLen(coor), rewriter, loc);
         } else if (inEleTy.isa<fir::RecordType>()) {
-          TODO(loc, "copy derived type");
+          fir::FirOpBuilder builder(
+              rewriter,
+              fir::getKindMapping(update->getParentOfType<mlir::ModuleOp>()));
+          if (!update.typeparams().empty()) {
+            auto boxTy = fir::BoxType::get(inEleTy);
+            mlir::Value emptyShape, emptySlice;
+            auto lhs = rewriter.create<fir::EmboxOp>(
+                loc, boxTy, coor, emptyShape, emptySlice, update.typeparams());
+            auto rhs = rewriter.create<fir::EmboxOp>(
+                loc, boxTy, input, emptyShape, emptySlice, update.typeparams());
+            fir::factory::genRecordAssignment(builder, loc, fir::BoxValue(lhs),
+                                              fir::BoxValue(rhs));
+          } else {
+            fir::factory::genRecordAssignment(builder, loc, coor, input);
+          }
         } else {
           llvm::report_fatal_error("not a legal reference type");
         }
diff --git a/flang/test/Lower/array-derived-assignments.f90 b/flang/test/Lower/array-derived-assignments.f90
@@ -0,0 +1,77 @@
+! Test derived type assignment lowering inside array expression
+! RUN: bbc %s -o - | FileCheck %s
+
+module array_derived_assign
+  type simple_copy
+    integer :: i
+    character(10) :: c(20)
+    real, pointer :: p(:)
+  end type
+  type deep_copy
+    integer :: i
+    real, allocatable :: a(:)
+  end type
+contains
+
+! Simple copies are implemented inline.
+! CHECK-LABEL: func @_QMarray_derived_assignPtest_simple_copy(
+! CHECK-SAME: %[[T1:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{i:i32,c:!fir.array<20x!fir.char<1,10>>,p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>,
+! CHECK-SAME: %[[T2:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{i:i32,c:!fir.array<20x!fir.char<1,10>>,p:!fir.box<!fir.ptr<!fir.array<?xf32>>>}>>>) {
+subroutine test_simple_copy(t1, t2)
+  type(simple_copy) :: t1(10), t2(10)
+! CHECK-DAG:   %[[VAL_0:.*]] = constant 10 : index
+! CHECK-DAG:   %[[VAL_1:.*]] = constant 0 : index
+! CHECK-DAG:   %[[VAL_2:.*]] = constant 1 : index
+! CHECK:   %[[VAL_3:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1>
+! CHECK:   br ^bb1(%[[VAL_1]], %[[VAL_0]] : index, index)
+! CHECK: ^bb1(%[[VAL_4:.*]]: index, %[[VAL_5:.*]]: index):
+! CHECK:   %[[VAL_6:.*]] = cmpi sgt, %[[VAL_5]], %[[VAL_1]] : index
+! CHECK:   cond_br %[[VAL_6]], ^bb2, ^bb3
+! CHECK: ^bb2:
+! CHECK:   %[[VAL_7:.*]] = addi %[[VAL_4]], %[[VAL_2]] : index
+! CHECK:   %[[VAL_8:.*]] = fir.array_coor %[[T2:.*]](%[[VAL_3]]) %[[VAL_7]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
+! CHECK:   %[[VAL_10:.*]] = fir.array_coor %[[T1:.*]](%[[VAL_3]]) %[[VAL_7]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
+! CHECK:   %[[VAL_12:.*]] = fir.load %[[VAL_8]] : !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
+! CHECK:   fir.store %[[VAL_12]] to %[[VAL_10]] : !fir.ref<!fir.type<_QMarray_derived_assignTsimple_copy{{.*}}>>
+! CHECK:   %[[VAL_13:.*]] = subi %[[VAL_5]], %[[VAL_2]] : index
+! CHECK:   br ^bb1(%[[VAL_7]], %[[VAL_13]] : index, index)
+! CHECK: ^bb3:
+! CHECK:   return
+  t1 = t2
+end subroutine
+
+! Types require more complex assignments are passed to the runtime
+! CHECK-LABEL: func @_QMarray_derived_assignPtest_deep_copy(
+! CHECK-SAME: %[[T1:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{i:i32,a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>,
+! CHECK-SAME: %[[T2:.*]]: !fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{i:i32,a:!fir.box<!fir.heap<!fir.array<?xf32>>>}>>>) {
+subroutine test_deep_copy(t1, t2)
+  type(deep_copy) :: t1(10), t2(10)
+! CHECK-DAG:   %[[VAL_15:.*]] = constant 10 : index
+! CHECK-DAG:   %[[VAL_16:.*]] = constant 0 : index
+! CHECK-DAG:   %[[VAL_17:.*]] = constant 1 : index
+! CHECK:   %[[VAL_18:.*]] = fir.alloca !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>> {uniq_name = ""}
+! CHECK:   %[[VAL_19:.*]] = fir.shape %[[VAL_15]] : (index) -> !fir.shape<1>
+! CHECK:   br ^bb1(%[[VAL_16]], %[[VAL_15]] : index, index)
+! CHECK: ^bb1(%[[VAL_20:.*]]: index, %[[VAL_21:.*]]: index):
+! CHECK:   %[[VAL_22:.*]] = cmpi sgt, %[[VAL_21]], %[[VAL_16]] : index
+! CHECK:   cond_br %[[VAL_22]], ^bb2, ^bb3
+! CHECK: ^bb2:
+! CHECK:   %[[VAL_23:.*]] = addi %[[VAL_20]], %[[VAL_17]] : index
+! CHECK:   %[[VAL_24:.*]] = fir.array_coor %[[T2:.*]](%[[VAL_19]]) %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
+! CHECK:   %[[VAL_26:.*]] = fir.array_coor %[[T1:.*]](%[[VAL_19]]) %[[VAL_23]] : (!fir.ref<!fir.array<10x!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>, !fir.shape<1>, index) -> !fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
+! CHECK:   %[[VAL_28:.*]] = fir.embox %[[VAL_26]] : (!fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
+! CHECK:   %[[VAL_29:.*]] = fir.embox %[[VAL_24]] : (!fir.ref<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>
+! CHECK:   fir.store %[[VAL_28]] to %[[VAL_18]] : !fir.ref<!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>
+! CHECK:   %[[VAL_30:.*]] = fir.address_of({{.*}}) : !fir.ref<!fir.char<1,{{.*}}>>
+! CHECK:   %[[VAL_31:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>>) -> !fir.ref<!fir.box<none>>
+! CHECK:   %[[VAL_32:.*]] = fir.convert %[[VAL_29]] : (!fir.box<!fir.type<_QMarray_derived_assignTdeep_copy{{.*}}>>) -> !fir.box<none>
+! CHECK:   %[[VAL_33:.*]] = fir.convert %[[VAL_30]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
+! CHECK:   %[[VAL_34:.*]] = fir.call @_FortranAAssign(%[[VAL_31]], %[[VAL_32]], %[[VAL_33]], %{{.*}}) : (!fir.ref<!fir.box<none>>, !fir.box<none>, !fir.ref<i8>, i32) -> none
+! CHECK:   %[[VAL_35:.*]] = subi %[[VAL_21]], %[[VAL_17]] : index
+! CHECK:   br ^bb1(%[[VAL_23]], %[[VAL_35]] : index, index)
+! CHECK: ^bb3:
+! CHECK:   return
+  t1 = t2
+end subroutine
+  
+end module
diff --git a/flang/test/Lower/derived-assignments.f90 b/flang/test/Lower/derived-assignments.f90
