[flang] Add lowering of move_alloc to IntrinsicCall

This patch relies on D141286 for the runtime implementation of move_alloc. Reviewed By: jeanPerier Differential Revision: https://reviews.llvm.org/D141616
2026-01-26 12:26:52 +08:00 · 2023-01-20 14:32:14 +00:00
parent d47a0ace5d
commit 2ab1c6d375
8 changed files with 210 additions and 1 deletions
--- a/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
+++ b/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h
@@ -0,0 +1,33 @@
+//===-- Allocatable.h - generate Allocatable 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_ALLOCATABLE_H
+#define FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ALLOCATABLE_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.
+mlir::Value genMoveAlloc(fir::FirOpBuilder &builder, mlir::Location loc,
+                         mlir::Value to, mlir::Value from, mlir::Value hasStat,
+                         mlir::Value errMsg);
+
+} // namespace fir::runtime
+#endif // FORTRAN_OPTIMIZER_BUILDER_RUNTIME_ALLOCATABLE_H
--- a/flang/lib/Lower/IntrinsicCall.cpp
+++ b/flang/lib/Lower/IntrinsicCall.cpp
@@ -19,10 +19,12 @@
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
+#include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/Complex.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
+#include "flang/Optimizer/Builder/Runtime/Allocatable.h"
 #include "flang/Optimizer/Builder/Runtime/Character.h"
 #include "flang/Optimizer/Builder/Runtime/Command.h"
 #include "flang/Optimizer/Builder/Runtime/Derived.h"
@@ -267,6 +269,7 @@ struct IntrinsicLibrary {
  fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
  mlir::Value genMod(mlir::Type, llvm::ArrayRef<mlir::Value>);
  mlir::Value genModulo(mlir::Type, llvm::ArrayRef<mlir::Value>);
+  void genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue>);
  void genMvbits(llvm::ArrayRef<fir::ExtendedValue>);
  mlir::Value genNearest(mlir::Type, llvm::ArrayRef<mlir::Value>);
  mlir::Value genNint(mlir::Type, llvm::ArrayRef<mlir::Value>);
@@ -695,6 +698,13 @@ static constexpr IntrinsicHandler handlers[]{
     /*isElemental=*/false},
    {"mod", &I::genMod},
    {"modulo", &I::genModulo},
+    {"move_alloc",
+     &I::genMoveAlloc,
+     {{{"from", asInquired},
+       {"to", asInquired},
+       {"status", asAddr, handleDynamicOptional},
+       {"errMsg", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
    {"mvbits",
     &I::genMvbits,
     {{{"from", asValue},
@@ -3900,6 +3910,46 @@ mlir::Value IntrinsicLibrary::genModulo(mlir::Type resultType,
                                               remainder);
 }

+void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 4);
+
+  const fir::ExtendedValue &from = args[0];
+  const fir::ExtendedValue &to = args[1];
+  const fir::ExtendedValue &status = args[2];
+  const fir::ExtendedValue &errMsg = args[3];
+
+  mlir::Type boxNoneTy = fir::BoxType::get(builder.getNoneType());
+  mlir::Value errBox =
+      isStaticallyPresent(errMsg)
+          ? fir::getBase(errMsg)
+          : builder.create<fir::AbsentOp>(loc, boxNoneTy).getResult();
+
+  const fir::MutableBoxValue *fromBox = from.getBoxOf<fir::MutableBoxValue>();
+  const fir::MutableBoxValue *toBox = to.getBoxOf<fir::MutableBoxValue>();
+
+  assert(fromBox && toBox && "move_alloc parameters must be mutable arrays");
+
+  mlir::Value fromAddr = fir::factory::getMutableIRBox(builder, loc, *fromBox);
+  mlir::Value toAddr = fir::factory::getMutableIRBox(builder, loc, *toBox);
+
+  mlir::Value hasStat = builder.createBool(loc, isStaticallyPresent(status));
+
+  mlir::Value stat = fir::runtime::genMoveAlloc(builder, loc, toAddr, fromAddr,
+                                                hasStat, errBox);
+
+  fir::factory::syncMutableBoxFromIRBox(builder, loc, *fromBox);
+  fir::factory::syncMutableBoxFromIRBox(builder, loc, *toBox);
+
+  if (isStaticallyPresent(status)) {
+    mlir::Value statAddr = fir::getBase(status);
+    mlir::Value statIsPresentAtRuntime =
+        builder.genIsNotNullAddr(loc, statAddr);
+    builder.genIfThen(loc, statIsPresentAtRuntime)
+        .genThen([&]() { builder.createStoreWithConvert(loc, stat, statAddr); })
+        .end();
+  }
+}
+
 // MVBITS
 void IntrinsicLibrary::genMvbits(llvm::ArrayRef<fir::ExtendedValue> args) {
  // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies:
--- a/flang/lib/Optimizer/Builder/CMakeLists.txt
+++ b/flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -9,6 +9,7 @@ add_flang_library(FIRBuilder
  HLFIRTools.cpp
  LowLevelIntrinsics.cpp
  MutableBox.cpp
+  Runtime/Allocatable.cpp
  Runtime/Assign.cpp
  Runtime/Character.cpp
  Runtime/Command.cpp
--- a/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
+++ b/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp
@@ -0,0 +1,30 @@
+//===-- Allocatable.cpp -- generate allocatable 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/Allocatable.h"
+#include "flang/Optimizer/Builder/FIRBuilder.h"
+#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
+#include "flang/Runtime/allocatable.h"
+
+using namespace Fortran::runtime;
+
+mlir::Value fir::runtime::genMoveAlloc(fir::FirOpBuilder &builder,
+                                       mlir::Location loc, mlir::Value to,
+                                       mlir::Value from, mlir::Value hasStat,
+                                       mlir::Value errMsg) {
+  mlir::func::FuncOp func{
+      fir::runtime::getRuntimeFunc<mkRTKey(MoveAlloc)>(loc, builder)};
+  mlir::FunctionType fTy{func.getFunctionType()};
+  mlir::Value sourceFile{fir::factory::locationToFilename(builder, loc)};
+  mlir::Value sourceLine{
+      fir::factory::locationToLineNo(builder, loc, fTy.getInput(5))};
+  llvm::SmallVector<mlir::Value> args{fir::runtime::createArguments(
+      builder, loc, fTy, to, from, hasStat, errMsg, sourceFile, sourceLine)};
+
+  return builder.create<fir::CallOp>(loc, func, args).getResult(0);
+}
--- a/flang/test/Lower/Intrinsics/move_alloc.f90
+++ b/flang/test/Lower/Intrinsics/move_alloc.f90
@@ -0,0 +1,63 @@
+  ! RUN: bbc -emit-fir %s -o - | FileCheck  %s
+  ! RUN: flang-new -fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: to_from_only
+subroutine to_from_only
+  ! CHECK: %[[a1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  ! CHECK: %[[b1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  integer, allocatable :: from(:), to(:)
+  allocate(from(20))
+  ! CHECK: %[[errMsg:.*]] = fir.absent !fir.box<none>
+  ! CHECK: %[[false:.*]] = arith.constant false
+  ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  call move_alloc(from, to)
+  ! CHECK: fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[false]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+  ! CHECK-DAG:  %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+  ! CHECK-DAG:  %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+end subroutine to_from_only
+
+! CHECK-LABEL: to_from_stat
+subroutine to_from_stat
+  ! CHECK-DAG: %[[a1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  ! CHECK-DAG: %[[b1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  integer, allocatable :: from(:), to(:)
+  ! CHECK-DAG: %[[stat1:.*]] = fir.alloca i32
+  integer :: stat
+  allocate(from(20))
+  ! CHECK: %[[errMsg:.*]] = fir.absent !fir.box<none>
+  ! CHECK: %[[true:.*]] = arith.constant true
+  ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  call move_alloc(from, to, stat)
+  ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+  ! CHECK-DAG:  %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+  ! CHECK-DAG:  %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+end subroutine to_from_stat
+
+! CHECK-LABEL: to_from_stat_errmsg
+subroutine to_from_stat_errmsg
+  ! CHECK-DAG: %[[errMsg1:.*]] = fir.alloca !fir.char<1,64>
+  ! CHECK-DAG: %[[a1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  ! CHECK-DAG: %[[b1:.*]] = fir.alloca !fir.box<!fir.heap<!fir.array<?xi32>>>
+  integer, allocatable :: from(:), to(:)
+  ! CHECK-DAG: %[[stat1:.*]] = fir.alloca i32
+  integer :: stat
+  character :: errMsg*64
+  allocate(from(20))
+  ! CHECK: %[[errMsg2:.*]] = fir.embox %[[errMsg1]] : (!fir.ref<!fir.char<1,64>>) -> !fir.box<!fir.char<1,64>>
+  ! CHECK: %[[true:.*]] = arith.constant true
+  ! CHECK-DAG: %[[errMsg3:.*]] = fir.convert %[[errMsg2]] : (!fir.box<!fir.char<1,64>>) -> !fir.box<none>
+  ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>) -> !fir.ref<!fir.box<none>>
+  call move_alloc(from, to, stat, errMsg)
+  ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg3]], %{{.*}}, %{{.*}}) fastmath<contract> : (!fir.ref<!fir.box<none>>, !fir.ref<!fir.box<none>>, i1, !fir.box<none>, !fir.ref<i8>, i32) -> i32
+  ! CHECK-DAG:  %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+  ! CHECK-DAG:  %[[b3:.*]] = fir.load %[[b1]] : !fir.ref<!fir.box<!fir.heap<!fir.array<?xi32>>>>
+  ! CHECK-DAG:  %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box<!fir.heap<!fir.array<?xi32>>>) -> !fir.heap<!fir.array<?xi32>>
+end subroutine to_from_stat_errmsg
--- a/flang/unittests/Optimizer/Builder/Runtime/Allocatable.cpp
+++ b/flang/unittests/Optimizer/Builder/Runtime/Allocatable.cpp
--- a/flang/unittests/Optimizer/Builder/Runtime/AllocatableTest.cpp
+++ b/flang/unittests/Optimizer/Builder/Runtime/AllocatableTest.cpp
@@ -0,0 +1,26 @@
+//===- AllocatableTest.cpp -- allocatable runtime builder unit tests ------===//
+//
+// 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/Allocatable.h"
+#include "RuntimeCallTestBase.h"
+#include "gtest/gtest.h"
+#include "flang/Runtime/descriptor.h"
+
+using namespace Fortran::runtime;
+
+TEST_F(RuntimeCallTest, genMoveAlloc) {
+  mlir::Location loc = firBuilder->getUnknownLoc();
+  mlir::Type seqTy =
+      fir::SequenceType::get(fir::SequenceType::Shape(1, 10), i32Ty);
+  mlir::Value from = firBuilder->create<fir::UndefOp>(loc, seqTy);
+  mlir::Value to = firBuilder->create<fir::UndefOp>(loc, seqTy);
+  mlir::Value errMsg = firBuilder->create<fir::UndefOp>(loc, seqTy);
+  mlir::Value hasStat = firBuilder->createBool(loc, false);
+  fir::runtime::genMoveAlloc(*firBuilder, loc, to, from, hasStat, errMsg);
+  checkCallOpFromResultBox(to, "_FortranAMoveAlloc", 4);
+}
--- a/flang/unittests/Optimizer/CMakeLists.txt
+++ b/flang/unittests/Optimizer/CMakeLists.txt
@@ -16,6 +16,7 @@ add_flang_unittest(FlangOptimizerTests
  Builder/DoLoopHelperTest.cpp
  Builder/FIRBuilderTest.cpp
  Builder/HLFIRToolsTest.cpp
+  Builder/Runtime/AllocatableTest.cpp
  Builder/Runtime/AssignTest.cpp
  Builder/Runtime/CommandTest.cpp
  Builder/Runtime/CharacterTest.cpp
@@ -31,7 +32,12 @@ add_flang_unittest(FlangOptimizerTests
  InternalNamesTest.cpp
  KindMappingTest.cpp
  RTBuilder.cpp
-)
+DEPENDS
+  FIRDialect
+  FIRSupport
+  HLFIRDialect
+  ${dialect_libs})
+
 target_link_libraries(FlangOptimizerTests
  PRIVATE
  ${LIBS})