dda01632db
The current code was not taking provided lower bounds when the pointer is polymorphic and was just calling PointerAssociate. This patch updates the behavior and use PointerAssociateLowerBounds with the provided lower bounds. Reviewed By: jeanPerier Differential Revision: https://reviews.llvm.org/D143392
221 lines
9.0 KiB
C++
221 lines
9.0 KiB
C++
//===-- Runtime.cpp -------------------------------------------------------===//
|
|
//
|
|
// 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/Lower/Runtime.h"
|
|
#include "flang/Lower/Bridge.h"
|
|
#include "flang/Lower/StatementContext.h"
|
|
#include "flang/Optimizer/Builder/FIRBuilder.h"
|
|
#include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
|
|
#include "flang/Optimizer/Builder/Todo.h"
|
|
#include "flang/Optimizer/Dialect/FIROpsSupport.h"
|
|
#include "flang/Parser/parse-tree.h"
|
|
#include "flang/Runtime/misc-intrinsic.h"
|
|
#include "flang/Runtime/pointer.h"
|
|
#include "flang/Runtime/random.h"
|
|
#include "flang/Runtime/stop.h"
|
|
#include "flang/Runtime/time-intrinsic.h"
|
|
#include "flang/Semantics/tools.h"
|
|
#include "llvm/Support/Debug.h"
|
|
#include <optional>
|
|
|
|
#define DEBUG_TYPE "flang-lower-runtime"
|
|
|
|
using namespace Fortran::runtime;
|
|
|
|
/// Runtime calls that do not return to the caller indicate this condition by
|
|
/// terminating the current basic block with an unreachable op.
|
|
static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) {
|
|
builder.create<fir::UnreachableOp>(loc);
|
|
mlir::Block *newBlock =
|
|
builder.getBlock()->splitBlock(builder.getInsertionPoint());
|
|
builder.setInsertionPointToStart(newBlock);
|
|
}
|
|
|
|
//===----------------------------------------------------------------------===//
|
|
// Misc. Fortran statements that lower to runtime calls
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
void Fortran::lower::genStopStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::StopStmt &stmt) {
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
mlir::Location loc = converter.getCurrentLocation();
|
|
Fortran::lower::StatementContext stmtCtx;
|
|
llvm::SmallVector<mlir::Value> operands;
|
|
mlir::func::FuncOp callee;
|
|
mlir::FunctionType calleeType;
|
|
// First operand is stop code (zero if absent)
|
|
if (const auto &code =
|
|
std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
|
|
auto expr =
|
|
converter.genExprValue(*Fortran::semantics::GetExpr(*code), stmtCtx);
|
|
LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump();
|
|
llvm::dbgs() << '\n');
|
|
expr.match(
|
|
[&](const fir::CharBoxValue &x) {
|
|
callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatementText)>(
|
|
loc, builder);
|
|
calleeType = callee.getFunctionType();
|
|
// Creates a pair of operands for the CHARACTER and its LEN.
|
|
operands.push_back(
|
|
builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
|
|
operands.push_back(
|
|
builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
|
|
},
|
|
[&](fir::UnboxedValue x) {
|
|
callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
|
|
loc, builder);
|
|
calleeType = callee.getFunctionType();
|
|
mlir::Value cast =
|
|
builder.createConvert(loc, calleeType.getInput(0), x);
|
|
operands.push_back(cast);
|
|
},
|
|
[&](auto) {
|
|
mlir::emitError(loc, "unhandled expression in STOP");
|
|
std::exit(1);
|
|
});
|
|
} else {
|
|
callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);
|
|
calleeType = callee.getFunctionType();
|
|
operands.push_back(
|
|
builder.createIntegerConstant(loc, calleeType.getInput(0), 0));
|
|
}
|
|
|
|
// Second operand indicates ERROR STOP
|
|
bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==
|
|
Fortran::parser::StopStmt::Kind::ErrorStop;
|
|
operands.push_back(builder.createIntegerConstant(
|
|
loc, calleeType.getInput(operands.size()), isError));
|
|
|
|
// Third operand indicates QUIET (default to false).
|
|
if (const auto &quiet =
|
|
std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
|
|
const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);
|
|
assert(expr && "failed getting typed expression");
|
|
mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
|
|
operands.push_back(
|
|
builder.createConvert(loc, calleeType.getInput(operands.size()), q));
|
|
} else {
|
|
operands.push_back(builder.createIntegerConstant(
|
|
loc, calleeType.getInput(operands.size()), 0));
|
|
}
|
|
|
|
builder.create<fir::CallOp>(loc, callee, operands);
|
|
genUnreachable(builder, loc);
|
|
}
|
|
|
|
void Fortran::lower::genFailImageStatement(
|
|
Fortran::lower::AbstractConverter &converter) {
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
mlir::Location loc = converter.getCurrentLocation();
|
|
mlir::func::FuncOp callee =
|
|
fir::runtime::getRuntimeFunc<mkRTKey(FailImageStatement)>(loc, builder);
|
|
builder.create<fir::CallOp>(loc, callee, std::nullopt);
|
|
genUnreachable(builder, loc);
|
|
}
|
|
|
|
void Fortran::lower::genEventPostStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::EventPostStmt &) {
|
|
TODO(converter.getCurrentLocation(), "EVENT POST runtime");
|
|
}
|
|
|
|
void Fortran::lower::genEventWaitStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::EventWaitStmt &) {
|
|
TODO(converter.getCurrentLocation(), "EVENT WAIT runtime");
|
|
}
|
|
|
|
void Fortran::lower::genLockStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::LockStmt &) {
|
|
TODO(converter.getCurrentLocation(), "LOCK runtime");
|
|
}
|
|
|
|
void Fortran::lower::genUnlockStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::UnlockStmt &) {
|
|
TODO(converter.getCurrentLocation(), "UNLOCK runtime");
|
|
}
|
|
|
|
void Fortran::lower::genSyncAllStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::SyncAllStmt &) {
|
|
TODO(converter.getCurrentLocation(), "SYNC ALL runtime");
|
|
}
|
|
|
|
void Fortran::lower::genSyncImagesStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::SyncImagesStmt &) {
|
|
TODO(converter.getCurrentLocation(), "SYNC IMAGES runtime");
|
|
}
|
|
|
|
void Fortran::lower::genSyncMemoryStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::SyncMemoryStmt &) {
|
|
TODO(converter.getCurrentLocation(), "SYNC MEMORY runtime");
|
|
}
|
|
|
|
void Fortran::lower::genSyncTeamStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::SyncTeamStmt &) {
|
|
TODO(converter.getCurrentLocation(), "SYNC TEAM runtime");
|
|
}
|
|
|
|
void Fortran::lower::genPauseStatement(
|
|
Fortran::lower::AbstractConverter &converter,
|
|
const Fortran::parser::PauseStmt &) {
|
|
fir::FirOpBuilder &builder = converter.getFirOpBuilder();
|
|
mlir::Location loc = converter.getCurrentLocation();
|
|
mlir::func::FuncOp callee =
|
|
fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);
|
|
builder.create<fir::CallOp>(loc, callee, std::nullopt);
|
|
}
|
|
|
|
void Fortran::lower::genPointerAssociate(fir::FirOpBuilder &builder,
|
|
mlir::Location loc,
|
|
mlir::Value pointer,
|
|
mlir::Value target) {
|
|
mlir::func::FuncOp func =
|
|
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociate)>(loc, builder);
|
|
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
|
|
builder, loc, func.getFunctionType(), pointer, target);
|
|
builder.create<fir::CallOp>(loc, func, args).getResult(0);
|
|
}
|
|
|
|
void Fortran::lower::genPointerAssociateRemapping(fir::FirOpBuilder &builder,
|
|
mlir::Location loc,
|
|
mlir::Value pointer,
|
|
mlir::Value target,
|
|
mlir::Value bounds) {
|
|
mlir::func::FuncOp func =
|
|
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateRemapping)>(loc,
|
|
builder);
|
|
auto fTy = func.getFunctionType();
|
|
auto sourceFile = fir::factory::locationToFilename(builder, loc);
|
|
auto sourceLine =
|
|
fir::factory::locationToLineNo(builder, loc, fTy.getInput(4));
|
|
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
|
|
builder, loc, func.getFunctionType(), pointer, target, bounds, sourceFile,
|
|
sourceLine);
|
|
builder.create<fir::CallOp>(loc, func, args).getResult(0);
|
|
}
|
|
|
|
void Fortran::lower::genPointerAssociateLowerBounds(fir::FirOpBuilder &builder,
|
|
mlir::Location loc,
|
|
mlir::Value pointer,
|
|
mlir::Value target,
|
|
mlir::Value lbounds) {
|
|
mlir::func::FuncOp func =
|
|
fir::runtime::getRuntimeFunc<mkRTKey(PointerAssociateLowerBounds)>(
|
|
loc, builder);
|
|
llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
|
|
builder, loc, func.getFunctionType(), pointer, target, lbounds);
|
|
builder.create<fir::CallOp>(loc, func, args).getResult(0);
|
|
}
|