diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h b/flang/include/flang/Optimizer/Builder/Runtime/Allocatable.h new file mode 100644 --- /dev/null +++ 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> and \p sourceBox a fir.box. +/// \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 diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp --- 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 @@ fir::ExtendedValue genMinval(mlir::Type, llvm::ArrayRef); mlir::Value genMod(mlir::Type, llvm::ArrayRef); mlir::Value genModulo(mlir::Type, llvm::ArrayRef); + void genMoveAlloc(llvm::ArrayRef); void genMvbits(llvm::ArrayRef); mlir::Value genNearest(mlir::Type, llvm::ArrayRef); mlir::Value genNint(mlir::Type, llvm::ArrayRef); @@ -695,6 +698,13 @@ /*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}, @@ -3909,6 +3919,46 @@ remainder); } +void IntrinsicLibrary::genMoveAlloc(llvm::ArrayRef 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(loc, boxNoneTy).getResult(); + + const fir::MutableBoxValue *fromBox = from.getBoxOf(); + const fir::MutableBoxValue *toBox = to.getBoxOf(); + + 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 args) { // A conformant MVBITS(FROM,FROMPOS,LEN,TO,TOPOS) call satisfies: diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt --- a/flang/lib/Optimizer/Builder/CMakeLists.txt +++ b/flang/lib/Optimizer/Builder/CMakeLists.txt @@ -9,6 +9,7 @@ HLFIRTools.cpp LowLevelIntrinsics.cpp MutableBox.cpp + Runtime/Allocatable.cpp Runtime/Assign.cpp Runtime/Character.cpp Runtime/Command.cpp diff --git a/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp b/flang/lib/Optimizer/Builder/Runtime/Allocatable.cpp new file mode 100644 --- /dev/null +++ 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(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 args{fir::runtime::createArguments( + builder, loc, fTy, to, from, hasStat, errMsg, sourceFile, sourceLine)}; + + return builder.create(loc, func, args).getResult(0); +} diff --git a/flang/test/Lower/Intrinsics/move_alloc.f90 b/flang/test/Lower/Intrinsics/move_alloc.f90 new file mode 100644 --- /dev/null +++ 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>> + ! CHECK: %[[b1:.*]] = fir.alloca !fir.box>> + integer, allocatable :: from(:), to(:) + allocate(from(20)) + ! CHECK: %[[errMsg:.*]] = fir.absent !fir.box + ! CHECK: %[[false:.*]] = arith.constant false + ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref>>>) -> !fir.ref> + call move_alloc(from, to) + ! CHECK: fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[false]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath : (!fir.ref>, !fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + ! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref>>> + ! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box>>) -> !fir.heap> + ! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref>>> + ! CHECK-DAG: %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box>>) -> !fir.heap> +end subroutine to_from_only + +! CHECK-LABEL: to_from_stat +subroutine to_from_stat + ! CHECK-DAG: %[[a1:.*]] = fir.alloca !fir.box>> + ! CHECK-DAG: %[[b1:.*]] = fir.alloca !fir.box>> + integer, allocatable :: from(:), to(:) + ! CHECK-DAG: %[[stat1:.*]] = fir.alloca i32 + integer :: stat + allocate(from(20)) + ! CHECK: %[[errMsg:.*]] = fir.absent !fir.box + ! CHECK: %[[true:.*]] = arith.constant true + ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref>>>) -> !fir.ref> + call move_alloc(from, to, stat) + ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg]], %{{.*}}, %{{.*}}) fastmath : (!fir.ref>, !fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + ! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref>>> + ! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box>>) -> !fir.heap> + ! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref>>> + ! CHECK-DAG: %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box>>) -> !fir.heap> +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>> + ! CHECK-DAG: %[[b1:.*]] = fir.alloca !fir.box>> + 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.box> + ! CHECK: %[[true:.*]] = arith.constant true + ! CHECK-DAG: %[[errMsg3:.*]] = fir.convert %[[errMsg2]] : (!fir.box>) -> !fir.box + ! CHECK-DAG: %[[a2:.*]] = fir.convert %[[a1]] : (!fir.ref>>>) -> !fir.ref> + ! CHECK-DAG: %[[b2:.*]] = fir.convert %[[b1]] : (!fir.ref>>>) -> !fir.ref> + call move_alloc(from, to, stat, errMsg) + ! CHECK: %[[stat:.*]] = fir.call @_FortranAMoveAlloc(%[[b2]], %[[a2]], %[[true]], %[[errMsg3]], %{{.*}}, %{{.*}}) fastmath : (!fir.ref>, !fir.ref>, i1, !fir.box, !fir.ref, i32) -> i32 + ! CHECK-DAG: %[[a3:.*]] = fir.load %[[a1:.*]] : !fir.ref>>> + ! CHECK-DAG: %[[a4:.*]] = fir.box_addr %[[a3]] : (!fir.box>>) -> !fir.heap> + ! CHECK-DAG: %[[b3:.*]] = fir.load %[[b1]] : !fir.ref>>> + ! CHECK-DAG: %[[b4:.*]] = fir.box_addr %[[b3:.*]] : (!fir.box>>) -> !fir.heap> +end subroutine to_from_stat_errmsg diff --git a/flang/unittests/Optimizer/Builder/Runtime/Allocatable.cpp b/flang/unittests/Optimizer/Builder/Runtime/Allocatable.cpp new file mode 100644 diff --git a/flang/unittests/Optimizer/Builder/Runtime/AllocatableTest.cpp b/flang/unittests/Optimizer/Builder/Runtime/AllocatableTest.cpp new file mode 100644 --- /dev/null +++ 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(loc, seqTy); + mlir::Value to = firBuilder->create(loc, seqTy); + mlir::Value errMsg = firBuilder->create(loc, seqTy); + mlir::Value hasStat = firBuilder->createBool(loc, false); + fir::runtime::genMoveAlloc(*firBuilder, loc, to, from, hasStat, errMsg); + checkCallOpFromResultBox(to, "_FortranAMoveAlloc", 4); +} diff --git a/flang/unittests/Optimizer/CMakeLists.txt b/flang/unittests/Optimizer/CMakeLists.txt --- a/flang/unittests/Optimizer/CMakeLists.txt +++ b/flang/unittests/Optimizer/CMakeLists.txt @@ -16,6 +16,7 @@ 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