1 //===-- Runtime.cpp -------------------------------------------------------===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Lower/Runtime.h"
10 #include "flang/Lower/Bridge.h"
11 #include "flang/Lower/StatementContext.h"
12 #include "flang/Lower/Todo.h"
13 #include "flang/Optimizer/Builder/FIRBuilder.h"
14 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
15 #include "flang/Parser/parse-tree.h"
16 #include "flang/Runtime/stop.h"
17 #include "flang/Semantics/tools.h"
18 #include "llvm/Support/Debug.h"
19 
20 #define DEBUG_TYPE "flang-lower-runtime"
21 
22 using namespace Fortran::runtime;
23 
24 /// Runtime calls that do not return to the caller indicate this condition by
25 /// terminating the current basic block with an unreachable op.
26 static void genUnreachable(fir::FirOpBuilder &builder, mlir::Location loc) {
27   builder.create<fir::UnreachableOp>(loc);
28   mlir::Block *newBlock =
29       builder.getBlock()->splitBlock(builder.getInsertionPoint());
30   builder.setInsertionPointToStart(newBlock);
31 }
32 
33 //===----------------------------------------------------------------------===//
34 // Misc. Fortran statements that lower to runtime calls
35 //===----------------------------------------------------------------------===//
36 
37 void Fortran::lower::genStopStatement(
38     Fortran::lower::AbstractConverter &converter,
39     const Fortran::parser::StopStmt &stmt) {
40   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
41   mlir::Location loc = converter.getCurrentLocation();
42   Fortran::lower::StatementContext stmtCtx;
43   llvm::SmallVector<mlir::Value> operands;
44   mlir::FuncOp callee;
45   mlir::FunctionType calleeType;
46   // First operand is stop code (zero if absent)
47   if (const auto &code =
48           std::get<std::optional<Fortran::parser::StopCode>>(stmt.t)) {
49     auto expr =
50         converter.genExprValue(*Fortran::semantics::GetExpr(*code), stmtCtx);
51     LLVM_DEBUG(llvm::dbgs() << "stop expression: "; expr.dump();
52                llvm::dbgs() << '\n');
53     expr.match(
54         [&](const fir::CharBoxValue &x) {
55           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatementText)>(
56               loc, builder);
57           calleeType = callee.getType();
58           // Creates a pair of operands for the CHARACTER and its LEN.
59           operands.push_back(
60               builder.createConvert(loc, calleeType.getInput(0), x.getAddr()));
61           operands.push_back(
62               builder.createConvert(loc, calleeType.getInput(1), x.getLen()));
63         },
64         [&](fir::UnboxedValue x) {
65           callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(
66               loc, builder);
67           calleeType = callee.getType();
68           mlir::Value cast =
69               builder.createConvert(loc, calleeType.getInput(0), x);
70           operands.push_back(cast);
71         },
72         [&](auto) {
73           mlir::emitError(loc, "unhandled expression in STOP");
74           std::exit(1);
75         });
76   } else {
77     callee = fir::runtime::getRuntimeFunc<mkRTKey(StopStatement)>(loc, builder);
78     calleeType = callee.getType();
79     operands.push_back(
80         builder.createIntegerConstant(loc, calleeType.getInput(0), 0));
81   }
82 
83   // Second operand indicates ERROR STOP
84   bool isError = std::get<Fortran::parser::StopStmt::Kind>(stmt.t) ==
85                  Fortran::parser::StopStmt::Kind::ErrorStop;
86   operands.push_back(builder.createIntegerConstant(
87       loc, calleeType.getInput(operands.size()), isError));
88 
89   // Third operand indicates QUIET (default to false).
90   if (const auto &quiet =
91           std::get<std::optional<Fortran::parser::ScalarLogicalExpr>>(stmt.t)) {
92     const SomeExpr *expr = Fortran::semantics::GetExpr(*quiet);
93     assert(expr && "failed getting typed expression");
94     mlir::Value q = fir::getBase(converter.genExprValue(*expr, stmtCtx));
95     operands.push_back(
96         builder.createConvert(loc, calleeType.getInput(operands.size()), q));
97   } else {
98     operands.push_back(builder.createIntegerConstant(
99         loc, calleeType.getInput(operands.size()), 0));
100   }
101 
102   builder.create<fir::CallOp>(loc, callee, operands);
103   genUnreachable(builder, loc);
104 }
105 
106 void Fortran::lower::genPauseStatement(
107     Fortran::lower::AbstractConverter &converter,
108     const Fortran::parser::PauseStmt &) {
109   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
110   mlir::Location loc = converter.getCurrentLocation();
111   mlir::FuncOp callee =
112       fir::runtime::getRuntimeFunc<mkRTKey(PauseStatement)>(loc, builder);
113   builder.create<fir::CallOp>(loc, callee, llvm::None);
114 }
115