[flang] Lower IO open and close statements

[clementval]

Summary

This patch adds the lowering of open and close statements

This patch is part of the upstreaming effort from fir-dev branch.

flang/include/flang/Lower/IO.h

 #define FORTRAN_LOWER_IO_H
 
 namespace mlir {
 class Value;
 } // namespace mlir
 
 namespace Fortran {
 namespace parser {
+struct CloseStmt;
+struct OpenStmt;
 struct ReadStmt;
 struct PrintStmt;
 struct WriteStmt;
 } // namespace parser
 
 namespace lower {
 
 class AbstractConverter;
 
+/// Generate IO call(s) for CLOSE; return the IOSTAT code
+mlir::Value genCloseStatement(AbstractConverter &, const parser::CloseStmt &);
+
 /// Generate IO call(s) for READ; return the IOSTAT code
 mlir::Value genReadStatement(AbstractConverter &converter,
                              const parser::ReadStmt &stmt);
 
+/// Generate IO call(s) for OPEN; return the IOSTAT code
+mlir::Value genOpenStatement(AbstractConverter &, const parser::OpenStmt &);
+
 /// Generate IO call(s) for PRINT
 void genPrintStatement(AbstractConverter &converter,
                        const parser::PrintStmt &stmt);
 
 /// Generate IO call(s) for WRITE; return the IOSTAT code
 mlir::Value genWriteStatement(AbstractConverter &converter,
                               const parser::WriteStmt &stmt);
 
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_IO_H

flang/lib/Lower/Bridge.cpp

private:
   // IO statements (see io.h)
   //===--------------------------------------------------------------------===//
 
   void genFIR(const Fortran::parser::BackspaceStmt &stmt) {
     TODO(toLocation(), "BackspaceStmt lowering");
   }
 
   void genFIR(const Fortran::parser::CloseStmt &stmt) {
-    TODO(toLocation(), "CloseStmt lowering");
+    mlir::Value iostat = genCloseStatement(*this, stmt);
+    genIoConditionBranches(getEval(), stmt.v, iostat);
   }
 
   void genFIR(const Fortran::parser::EndfileStmt &stmt) {
     TODO(toLocation(), "EndfileStmt lowering");
   }
 
   void genFIR(const Fortran::parser::FlushStmt &stmt) {
     TODO(toLocation(), "FlushStmt lowering");
   }
 
   void genFIR(const Fortran::parser::InquireStmt &stmt) {
     TODO(toLocation(), "InquireStmt lowering");
   }
 
   void genFIR(const Fortran::parser::OpenStmt &stmt) {
-    TODO(toLocation(), "OpenStmt lowering");
+    mlir::Value iostat = genOpenStatement(*this, stmt);
+    genIoConditionBranches(getEval(), stmt.v, iostat);
   }
 
   void genFIR(const Fortran::parser::PrintStmt &stmt) {
     genPrintStatement(*this, stmt);
   }
 
   void genFIR(const Fortran::parser::ReadStmt &stmt) {
     mlir::Value iostat = genReadStatement(*this, stmt);

flang/lib/Lower/IO.cpp

 template <typename SEEK, typename A>
 static bool hasX(const A &list) {
   for (const auto &spec : list)
     if (std::holds_alternative<SEEK>(spec.u))
       return true;
   return false;
 }
 
+template <typename SEEK, typename A>
+static bool hasMem(const A &stmt) {
+  return hasX<SEEK>(stmt.v);
+}
+
+/// Get the sought expression from the specifier list.
+template <typename SEEK, typename A>
+static const Fortran::lower::SomeExpr *getExpr(const A &stmt) {
+  for (const auto &spec : stmt.v)
+    if (auto *f = std::get_if<SEEK>(&spec.u))
+      return Fortran::semantics::GetExpr(f->v);
+  llvm::report_fatal_error("must have a file unit");
+}
+
 /// For each specifier, build the appropriate call, threading the cookie.
 template <typename A>
 static void threadSpecs(Fortran::lower::AbstractConverter &converter,
                         mlir::Location loc, mlir::Value cookie,
                         const A &specList, bool checkResult, mlir::Value &ok) {
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   for (const auto &spec : specList) {
     makeNextConditionalOn(builder, loc, checkResult, ok);
mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
   if (auto *iounit = getIOControl<Fortran::parser::IoUnit>(stmt))
     return genIOUnit(converter, loc, *iounit, ty, stmtCtx);
   fir::FirOpBuilder &builder = converter.getFirOpBuilder();
   return builder.create<mlir::arith::ConstantOp>(
       loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
 }
 
 //===----------------------------------------------------------------------===//
+// Generators for each IO statement type.
+//===----------------------------------------------------------------------===//
+
+template <typename K, typename S>
+static mlir::Value genBasicIOStmt(Fortran::lower::AbstractConverter &converter,
+                                  const S &stmt) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  Fortran::lower::StatementContext stmtCtx;
+  mlir::Location loc = converter.getCurrentLocation();
+  mlir::FuncOp beginFunc = getIORuntimeFunc<K>(loc, builder);
+  mlir::FunctionType beginFuncTy = beginFunc.getType();
+  mlir::Value unit = fir::getBase(converter.genExprValue(
+      getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
+  mlir::Value un = builder.createConvert(loc, beginFuncTy.getInput(0), unit);
+  mlir::Value file = locToFilename(converter, loc, beginFuncTy.getInput(1));
+  mlir::Value line = locToLineNo(converter, loc, beginFuncTy.getInput(2));
+  auto call = builder.create<fir::CallOp>(loc, beginFunc,
+                                          mlir::ValueRange{un, file, line});
+  mlir::Value cookie = call.getResult(0);
+  ConditionSpecInfo csi;
+  genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
+  mlir::Value ok;
+  auto insertPt = builder.saveInsertionPoint();
+  threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
+  builder.restoreInsertionPoint(insertPt);
+  return genEndIO(converter, converter.getCurrentLocation(), cookie, csi,
+                  stmtCtx);
+}
+
+mlir::Value
+Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter,
+                                 const Fortran::parser::OpenStmt &stmt) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  Fortran::lower::StatementContext stmtCtx;
+  mlir::FuncOp beginFunc;
+  llvm::SmallVector<mlir::Value> beginArgs;
+  mlir::Location loc = converter.getCurrentLocation();
+  if (hasMem<Fortran::parser::FileUnitNumber>(stmt)) {
+    beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenUnit)>(loc, builder);
+    mlir::FunctionType beginFuncTy = beginFunc.getType();
+    mlir::Value unit = fir::getBase(converter.genExprValue(
+        getExpr<Fortran::parser::FileUnitNumber>(stmt), stmtCtx, loc));
+    beginArgs.push_back(
+        builder.createConvert(loc, beginFuncTy.getInput(0), unit));
+    beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1)));
+    beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2)));
+  } else {
+    assert(hasMem<Fortran::parser::ConnectSpec::Newunit>(stmt));
+    beginFunc = getIORuntimeFunc<mkIOKey(BeginOpenNewUnit)>(loc, builder);
+    mlir::FunctionType beginFuncTy = beginFunc.getType();
+    beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0)));
+    beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(1)));
+  }
+  auto cookie =
+      builder.create<fir::CallOp>(loc, beginFunc, beginArgs).getResult(0);
+  ConditionSpecInfo csi;
+  genConditionHandlerCall(converter, loc, cookie, stmt.v, csi);
+  mlir::Value ok;
+  auto insertPt = builder.saveInsertionPoint();
+  threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok);
+  builder.restoreInsertionPoint(insertPt);
+  return genEndIO(converter, loc, cookie, csi, stmtCtx);
+}
+
+mlir::Value
+Fortran::lower::genCloseStatement(Fortran::lower::AbstractConverter &converter,
+                                  const Fortran::parser::CloseStmt &stmt) {
+  return genBasicIOStmt<mkIOKey(BeginClose)>(converter, stmt);
+}
+
+//===----------------------------------------------------------------------===//
 // Data transfer statements.
 //
 // There are several dimensions to the API with regard to data transfer
 // statements that need to be considered.
 //
 //   - input (READ) vs. output (WRITE, PRINT)
 //   - unformatted vs. formatted vs. list vs. namelist
 //   - synchronous vs. asynchronous

flang/test/Lower/io-statement-1.f90

 ! RUN: bbc %s -emit-fir -o - | FileCheck %s
 ! UNSUPPORTED: system-windows
 
  logical :: existsvar
  integer :: length
  real :: a(100)
 
   ! CHECK-LABEL: _QQmain
+  ! CHECK: call {{.*}}BeginOpenUnit
+  ! CHECK-DAG: call {{.*}}SetFile
+  ! CHECK-DAG: call {{.*}}SetAccess
+  ! CHECK: call {{.*}}EndIoStatement
+  open(8, file="foo", access="sequential")
+
   ! CHECK: call {{.*}}BeginExternalListInput
   ! CHECK: call {{.*}}InputInteger
   ! CHECK: call {{.*}}InputReal32
   ! CHECK: call {{.*}}EndIoStatement
   read (8,*) i, f
 
   ! CHECK: call {{.*}}BeginExternalListOutput
   ! CHECK: call {{.*}}OutputInteger32
   ! CHECK: call {{.*}}OutputReal32
   ! CHECK: call {{.*}}EndIoStatement
   write (8,*) i, f
 
+  ! CHECK: call {{.*}}BeginClose
+  ! CHECK: call {{.*}}EndIoStatement
+  close(8)
+
   ! CHECK: call {{.*}}BeginExternalListOutput
   ! CHECK: call {{.*}}OutputAscii
   ! CHECK: call {{.*}}EndIoStatement
   print *, "A literal string"
 end
 
 ! CHECK-LABEL: @_QPboz
 subroutine boz