[flang] Lower basic IO statement

[clementval]

Summary

This patch enables the lowering of the print, read and write
IO statements.

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

[PeteSteinfeld]

All builds and tests correctly and looks good.

[clementval]

Attempt to fix windows pre-check

[clementval]

Add missing guard

flang/include/flang/Lower/AbstractConverter.h

 //===-- Lower/AbstractConverter.h -------------------------------*- 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
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_ABSTRACTCONVERTER_H
 #define FORTRAN_LOWER_ABSTRACTCONVERTER_H
 
 #include "flang/Common/Fortran.h"
+#include "flang/Lower/PFTDefs.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "mlir/IR/BuiltinOps.h"
 #include "llvm/ADT/ArrayRef.h"
 
 namespace fir {
 class KindMapping;
 class FirOpBuilder;
 } // namespace fir

 public:
   //===--------------------------------------------------------------------===//
   // Symbols
   //===--------------------------------------------------------------------===//
 
   /// Get the mlir instance of a symbol.
   virtual mlir::Value getSymbolAddress(SymbolRef sym) = 0;
 
+  /// Get the label set associated with a symbol.
+  virtual bool lookupLabelSet(SymbolRef sym, pft::LabelSet &labelSet) = 0;
+
+  /// Get the code defined by a label
+  virtual pft::Evaluation *lookupLabel(pft::Label label) = 0;
+
   //===--------------------------------------------------------------------===//
   // Expressions
   //===--------------------------------------------------------------------===//
 
   /// Generate the address of the location holding the expression, someExpr.
   virtual fir::ExtendedValue genExprAddr(const SomeExpr &, StatementContext &,
                                          mlir::Location *loc = nullptr) = 0;
   /// Generate the address of the location holding the expression, someExpr
   fir::ExtendedValue genExprAddr(const SomeExpr *someExpr,
                                  StatementContext &stmtCtx,
                                  mlir::Location loc) {
     return genExprAddr(*someExpr, stmtCtx, &loc);
   }
 
   /// Generate the computations of the expression to produce a value
   virtual fir::ExtendedValue genExprValue(const SomeExpr &, StatementContext &,
                                           mlir::Location *loc = nullptr) = 0;
   /// Generate the computations of the expression, someExpr, to produce a value
   fir::ExtendedValue genExprValue(const SomeExpr *someExpr,
                                   StatementContext &stmtCtx,
                                   mlir::Location loc) {
     return genExprValue(*someExpr, stmtCtx, &loc);
   }
 
+  /// Generate or get a fir.box describing the expression. If SomeExpr is
+  /// a Designator, the fir.box describes an entity over the Designator base
+  /// storage without making a temporary.
+  virtual fir::ExtendedValue genExprBox(const SomeExpr &, StatementContext &,
+                                        mlir::Location) = 0;
+
   /// Generate the address of the box describing the variable designated
   /// by the expression. The expression must be an allocatable or pointer
   /// designator.
   virtual fir::MutableBoxValue genExprMutableBox(mlir::Location loc,
                                                  const SomeExpr &) = 0;
 
   /// Get FoldingContext that is required for some expression
   /// analysis.
public:
   /// Generate the type of a DataRef
   virtual mlir::Type genType(const Fortran::evaluate::DataRef &) = 0;
   /// Generate the type of an Expr
   virtual mlir::Type genType(const SomeExpr &) = 0;
   /// Generate the type of a Symbol
   virtual mlir::Type genType(SymbolRef) = 0;
   /// Generate the type from a category
   virtual mlir::Type genType(Fortran::common::TypeCategory tc) = 0;
-  /// Generate the type from a category and kind
-  virtual mlir::Type genType(Fortran::common::TypeCategory tc, int kind) = 0;
+  /// Generate the type from a category and kind and length parameters.
+  virtual mlir::Type
+  genType(Fortran::common::TypeCategory tc, int kind,
+          llvm::ArrayRef<std::int64_t> lenParameters = llvm::None) = 0;
   /// Generate the type from a Variable
   virtual mlir::Type genType(const pft::Variable &) = 0;
 
   //===--------------------------------------------------------------------===//
   // Locations
   //===--------------------------------------------------------------------===//
 
   /// Get the converter's current location

flang/include/flang/Lower/ConvertExpr.h

 
 /// Create an extended expression value.
 fir::ExtendedValue createSomeExtendedExpression(mlir::Location loc,
                                                 AbstractConverter &converter,
                                                 const SomeExpr &expr,
                                                 SymMap &symMap,
                                                 StatementContext &stmtCtx);
 
+/// Create a global array symbol with the Dense attribute
+fir::GlobalOp createDenseGlobal(mlir::Location loc, mlir::Type symTy,
+                                llvm::StringRef globalName,
+                                mlir::StringAttr linkage, bool isConst,
+                                const SomeExpr &expr,
+                                Fortran::lower::AbstractConverter &converter);
+
+/// Create the IR for the expression \p expr in an initialization context.
+/// Expressions that appear in initializers may not allocate temporaries, do not
+/// have a stack, etc.
+fir::ExtendedValue createSomeInitializerExpression(mlir::Location loc,
+                                                   AbstractConverter &converter,
+                                                   const SomeExpr &expr,
+                                                   SymMap &symMap,
+                                                   StatementContext &stmtCtx);
+
 /// Create an extended expression address.
 fir::ExtendedValue createSomeExtendedAddress(mlir::Location loc,
                                              AbstractConverter &converter,
                                              const SomeExpr &expr,
                                              SymMap &symMap,
                                              StatementContext &stmtCtx);
 
+/// Create an address in an initializer context. Must be a constant or a symbol
+/// to be resolved at link-time. Expressions that appear in initializers may not
+/// allocate temporaries, do not have a stack, etc.
+fir::ExtendedValue createInitializerAddress(mlir::Location loc,
+                                            AbstractConverter &converter,
+                                            const SomeExpr &expr,
+                                            SymMap &symMap,
+                                            StatementContext &stmtCtx);
+
 /// Create the address of the box.
 /// \p expr must be the designator of an allocatable/pointer entity.
 fir::MutableBoxValue createMutableBox(mlir::Location loc,
                                       AbstractConverter &converter,
                                       const SomeExpr &expr, SymMap &symMap);
 
+/// Lower an array expression to a value of type box. The expression must be a
+/// variable.
+fir::ExtendedValue createSomeArrayBox(AbstractConverter &converter,
+                                      const SomeExpr &expr, SymMap &symMap,
+                                      StatementContext &stmtCtx);
+
 /// Lower a subroutine call. This handles both elemental and non elemental
 /// subroutines. \p isUserDefAssignment must be set if this is called in the
 /// context of a user defined assignment. For subroutines with alternate
 /// returns, the returned value indicates which label the code should jump to.
 /// The returned value is null otherwise.
 mlir::Value createSubroutineCall(AbstractConverter &converter,
                                  const evaluate::ProcedureRef &call,
                                  SymMap &symMap, StatementContext &stmtCtx);

flang/include/flang/Lower/ConvertType.h

 using SomeExpr = evaluate::Expr<evaluate::SomeType>;
 using SymbolRef = common::Reference<const semantics::Symbol>;
 
 // Type for compile time constant length type parameters.
 using LenParameterTy = std::int64_t;
 
 /// Get a FIR type based on a category and kind.
 mlir::Type getFIRType(mlir::MLIRContext *ctxt, common::TypeCategory tc,
-                      int kind);
+                      int kind, llvm::ArrayRef<LenParameterTy>);
 
 /// Translate a SomeExpr to an mlir::Type.
 mlir::Type translateSomeExprToFIRType(Fortran::lower::AbstractConverter &,
                                       const SomeExpr &expr);
 
 /// Translate a Fortran::semantics::Symbol to an mlir::Type.
 mlir::Type translateSymbolToFIRType(Fortran::lower::AbstractConverter &,
                                     const SymbolRef symbol);

flang/include/flang/Lower/ConvertVariable.h

 ///
 /// Instantiation of pft::Variable in FIR/MLIR.
 ///
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_CONVERT_VARIABLE_H
 #define FORTRAN_LOWER_CONVERT_VARIABLE_H
 
+#include "flang/Lower/Support/Utils.h"
 #include "mlir/IR/Value.h"
+#include "llvm/ADT/DenseMap.h"
 
 namespace Fortran ::lower {
 class AbstractConverter;
 class CallerInterface;
 class StatementContext;
 class SymMap;
 namespace pft {
 struct Variable;
 }
 
+/// AggregateStoreMap is used to keep track of instantiated aggregate stores
+/// when lowering a scope containing equivalences (aliases). It must only be
+/// owned by the code lowering a scope and provided to instantiateVariable.
+using AggregateStoreKey =
+    std::tuple<const Fortran::semantics::Scope *, std::size_t>;
+using AggregateStoreMap = llvm::DenseMap<AggregateStoreKey, mlir::Value>;
+
 /// Instantiate variable \p var and add it to \p symMap.
 /// The AbstractConverter builder must be set.
 /// The AbstractConverter own symbol mapping is not used during the
 /// instantiation and can be different form \p symMap.
 void instantiateVariable(AbstractConverter &, const pft::Variable &var,
-                         SymMap &symMap);
+                         SymMap &symMap, AggregateStoreMap &storeMap);
 
 /// Lower a symbol attributes given an optional storage \p and add it to the
 /// provided symbol map. If \preAlloc is not provided, a temporary storage will
 /// be allocated. This is a low level function that should only be used if
 /// instantiateVariable cannot be called.
 void mapSymbolAttributes(AbstractConverter &, const pft::Variable &, SymMap &,
                          StatementContext &, mlir::Value preAlloc = {});
 
 /// Instantiate the variables that appear in the specification expressions
 /// of the result of a function call. The instantiated variables are added
 /// to \p symMap.
 void mapCallInterfaceSymbols(AbstractConverter &,
                              const Fortran::lower::CallerInterface &caller,
                              SymMap &symMap);
 
+/// Create initial-data-target fir.box in a global initializer region.
+/// This handles the local instantiation of the target variable.
+mlir::Value genInitialDataTarget(Fortran::lower::AbstractConverter &,
+                                 mlir::Location, mlir::Type boxType,
+                                 const SomeExpr &initialTarget);
+
 } // namespace Fortran::lower
 #endif // FORTRAN_LOWER_CONVERT_VARIABLE_H

flang/include/flang/Lower/IO.h

+//===-- Lower/IO.h -- lower IO statements -----------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#ifndef FORTRAN_LOWER_IO_H
+#define FORTRAN_LOWER_IO_H
+
+namespace mlir {
+class Value;
+} // namespace mlir
+
+namespace Fortran {
+namespace parser {
+struct ReadStmt;
+struct PrintStmt;
+struct WriteStmt;
+} // namespace parser
+
+namespace lower {
+
+class AbstractConverter;
+
+/// Generate IO call(s) for READ; return the IOSTAT code
+mlir::Value genReadStatement(AbstractConverter &converter,
+                             const parser::ReadStmt &stmt);
+
+/// 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/include/flang/Lower/StatementContext.h

 //===-- StatementContext.h --------------------------------------*- 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
 //
 //===----------------------------------------------------------------------===//
 //
 // Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_STATEMENTCONTEXT_H
 #define FORTRAN_LOWER_STATEMENTCONTEXT_H
 
+#include "llvm/ADT/Optional.h"
+#include "llvm/ADT/SmallVector.h"
 #include <functional>
 
 namespace Fortran::lower {
 
 /// When lowering a statement, temporaries for intermediate results may be
 /// allocated on the heap.  A StatementContext enables their deallocation
 /// either explicitly with finalize() calls, or implicitly at the end of
 /// the context.  A context may prohibit temporary allocation.  Otherwise,

flang/include/flang/Optimizer/Dialect/FIROps.td

def fir_FieldIndexOp : fir_OneResultOp<"field_index", [NoSideEffect]> {
 
   let builders = [OpBuilder<(ins "llvm::StringRef":$fieldName,
       "mlir::Type":$recTy, CArg<"mlir::ValueRange","{}">:$operands)>];
 
   let extraClassDeclaration = [{
     static constexpr llvm::StringRef fieldAttrName() { return "field_id"; }
     static constexpr llvm::StringRef typeAttrName() { return "on_type"; }
     llvm::StringRef getFieldName() { return getFieldId(); }
+    llvm::SmallVector<mlir::Attribute> getAttributes();
   }];
 }
 
 def fir_ShapeOp : fir_Op<"shape", [NoSideEffect]> {
 
   let summary = "generate an abstract shape vector of type `!fir.shape`";
 
   let description = [{

flang/lib/Lower/Bridge.cpp

 //===----------------------------------------------------------------------===//
 
 #include "flang/Lower/Bridge.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Lower/CallInterface.h"
 #include "flang/Lower/ConvertExpr.h"
 #include "flang/Lower/ConvertType.h"
 #include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/IO.h"
 #include "flang/Lower/IterationSpace.h"
 #include "flang/Lower/Mangler.h"
 #include "flang/Lower/PFTBuilder.h"
 #include "flang/Lower/Runtime.h"
 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/SymbolMap.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/BoxValue.h"
 #include "flang/Optimizer/Builder/Character.h"
 #include "flang/Optimizer/Builder/MutableBox.h"
 #include "flang/Optimizer/Support/FIRContext.h"
+#include "flang/Runtime/iostat.h"
 #include "flang/Semantics/tools.h"
 #include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
 #include "mlir/IR/PatternMatch.h"
 #include "mlir/Transforms/RegionUtils.h"
 #include "llvm/Support/CommandLine.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-bridge"
public:
   //===--------------------------------------------------------------------===//
   // AbstractConverter overrides
   //===--------------------------------------------------------------------===//
 
   mlir::Value getSymbolAddress(Fortran::lower::SymbolRef sym) override final {
     return lookupSymbol(sym).getAddr();
   }
 
+  bool lookupLabelSet(Fortran::lower::SymbolRef sym,
+                      Fortran::lower::pft::LabelSet &labelSet) override final {
+    Fortran::lower::pft::FunctionLikeUnit &owningProc =
+        *getEval().getOwningProcedure();
+    auto iter = owningProc.assignSymbolLabelMap.find(sym);
+    if (iter == owningProc.assignSymbolLabelMap.end())
+      return false;
+    labelSet = iter->second;
+    return true;
+  }
+
+  Fortran::lower::pft::Evaluation *
+  lookupLabel(Fortran::lower::pft::Label label) override final {
+    Fortran::lower::pft::FunctionLikeUnit &owningProc =
+        *getEval().getOwningProcedure();
+    auto iter = owningProc.labelEvaluationMap.find(label);
+    if (iter == owningProc.labelEvaluationMap.end())
+      return nullptr;
+    return iter->second;
+  }
+
   fir::ExtendedValue genExprAddr(const Fortran::lower::SomeExpr &expr,
                                  Fortran::lower::StatementContext &context,
                                  mlir::Location *loc = nullptr) override final {
     return createSomeExtendedAddress(loc ? *loc : toLocation(), *this, expr,
                                      localSymbols, context);
   }
   fir::ExtendedValue
   genExprValue(const Fortran::lower::SomeExpr &expr,
                Fortran::lower::StatementContext &context,
                mlir::Location *loc = nullptr) override final {
     return createSomeExtendedExpression(loc ? *loc : toLocation(), *this, expr,
                                         localSymbols, context);
   }
   fir::MutableBoxValue
   genExprMutableBox(mlir::Location loc,
                     const Fortran::lower::SomeExpr &expr) override final {
     return Fortran::lower::createMutableBox(loc, *this, expr, localSymbols);
   }
+  fir::ExtendedValue genExprBox(const Fortran::lower::SomeExpr &expr,
+                                Fortran::lower::StatementContext &context,
+                                mlir::Location loc) override final {
+    if (expr.Rank() > 0 && Fortran::evaluate::IsVariable(expr) &&
+        !Fortran::evaluate::HasVectorSubscript(expr))
+      return Fortran::lower::createSomeArrayBox(*this, expr, localSymbols,
+                                                context);
+    return fir::BoxValue(
+        builder->createBox(loc, genExprAddr(expr, context, &loc)));
+  }
 
   Fortran::evaluate::FoldingContext &getFoldingContext() override final {
     return foldingContext;
   }
 
   mlir::Type genType(const Fortran::evaluate::DataRef &) override final {
     TODO_NOLOC("Not implemented genType DataRef. Needed for more complex "
                "expression lowering");
   }
   mlir::Type genType(const Fortran::lower::SomeExpr &expr) override final {
     return Fortran::lower::translateSomeExprToFIRType(*this, expr);
   }
   mlir::Type genType(Fortran::lower::SymbolRef sym) override final {
     return Fortran::lower::translateSymbolToFIRType(*this, sym);
   }
   mlir::Type genType(Fortran::common::TypeCategory tc) override final {
     TODO_NOLOC("Not implemented genType TypeCategory. Needed for more complex "
                "expression lowering");
   }
-  mlir::Type genType(Fortran::common::TypeCategory tc,
-                     int kind) override final {
-    return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind);
+  mlir::Type
+  genType(Fortran::common::TypeCategory tc, int kind,
+          llvm::ArrayRef<std::int64_t> lenParameters) override final {
+    return Fortran::lower::getFIRType(&getMLIRContext(), tc, kind,
+                                      lenParameters);
   }
   mlir::Type genType(const Fortran::lower::pft::Variable &var) override final {
     return Fortran::lower::translateVariableToFIRType(*this, var);
   }
 
   void setCurrentPosition(const Fortran::parser::CharBlock &position) {
     if (position != Fortran::parser::CharBlock{})
       currentPosition = position;
if (std::optional<Fortran::lower::CalleeInterface::PassedEntity>
           passedResult->entity->get() != *funit.primaryResult)
         addSymbol(*funit.primaryResult,
                   getSymbolAddress(passedResult->entity->get()));
     }
   }
 
   /// Instantiate variable \p var and add it to the symbol map.
   /// See ConvertVariable.cpp.
-  void instantiateVar(const Fortran::lower::pft::Variable &var) {
-    Fortran::lower::instantiateVariable(*this, var, localSymbols);
+  void instantiateVar(const Fortran::lower::pft::Variable &var,
+                      Fortran::lower::AggregateStoreMap &storeMap) {
+    Fortran::lower::instantiateVariable(*this, var, localSymbols, storeMap);
   }
 
   /// Prepare to translate a new function
   void startNewFunction(Fortran::lower::pft::FunctionLikeUnit &funit) {
     assert(!builder && "expected nullptr");
     Fortran::lower::CalleeInterface callee(funit, *this);
     mlir::FuncOp func = callee.addEntryBlockAndMapArguments();
     func.setVisibility(mlir::SymbolTable::Visibility::Public);
     builder = new fir::FirOpBuilder(func, bridge.getKindMap());
     assert(builder && "FirOpBuilder did not instantiate");
     builder->setInsertionPointToStart(&func.front());
 
     mapDummiesAndResults(funit, callee);
 
+    Fortran::lower::AggregateStoreMap storeMap;
     for (const Fortran::lower::pft::Variable &var :
          funit.getOrderedSymbolTable()) {
       const Fortran::semantics::Symbol &sym = var.getSymbol();
       if (!sym.IsFuncResult() || !funit.primaryResult) {
-        instantiateVar(var);
+        instantiateVar(var, storeMap);
       } else if (&sym == funit.primaryResult) {
-        instantiateVar(var);
+        instantiateVar(var, storeMap);
       }
     }
 
     // Create most function blocks in advance.
     createEmptyGlobalBlocks(funit.evaluationList);
 
     // Reinstate entry block as the current insertion point.
     builder->setInsertionPointToEnd(&func.front());
private:
   }
   bool isCharacterCategory(Fortran::common::TypeCategory cat) {
     return cat == Fortran::common::TypeCategory::Character;
   }
   bool isDerivedCategory(Fortran::common::TypeCategory cat) {
     return cat == Fortran::common::TypeCategory::Derived;
   }
 
+  mlir::Block *blockOfLabel(Fortran::lower::pft::Evaluation &eval,
+                            Fortran::parser::Label label) {
+    const Fortran::lower::pft::LabelEvalMap &labelEvaluationMap =
+        eval.getOwningProcedure()->labelEvaluationMap;
+    const auto iter = labelEvaluationMap.find(label);
+    assert(iter != labelEvaluationMap.end() && "label missing from map");
+    mlir::Block *block = iter->second->block;
+    assert(block && "missing labeled evaluation block");
+    return block;
+  }
+
   void genFIRBranch(mlir::Block *targetBlock) {
     assert(targetBlock && "missing unconditional target block");
     builder->create<cf::BranchOp>(toLocation(), targetBlock);
   }
 
   //===--------------------------------------------------------------------===//
   // Termination of symbolically referenced execution units
   //===--------------------------------------------------------------------===//
std::visit(
                     builder->convertWithSemantics(loc, toTy, val);
                 if (fir::dyn_cast_ptrEleTy(addr.getType()) != toTy) {
                   assert(isFuncResultDesignator(assign.lhs) && "type mismatch");
                   addr = builder->createConvert(
                       toLocation(), builder->getRefType(toTy), addr);
                 }
                 builder->create<fir::StoreOp>(loc, cast, addr);
               } else if (isCharacterCategory(lhsType->category())) {
-                TODO(toLocation(), "Character assignment");
+                // Fortran 2018 10.2.1.3 p10 and p11
+                fir::factory::CharacterExprHelper{*builder, loc}.createAssign(
+                    lhs, rhs);
               } else if (isDerivedCategory(lhsType->category())) {
                 TODO(toLocation(), "Derived type assignment");
               } else {
                 llvm_unreachable("unknown category");
               }
               if (lhsIsWholeAllocatable)
                 fir::factory::finalizeRealloc(
                     *builder, loc, lhsMutableBox.getValue(),
void genFIR(const Fortran::parser::InquireStmt &stmt) {
     TODO(toLocation(), "InquireStmt lowering");
   }
 
   void genFIR(const Fortran::parser::OpenStmt &stmt) {
     TODO(toLocation(), "OpenStmt lowering");
   }
 
   void genFIR(const Fortran::parser::PrintStmt &stmt) {
-    TODO(toLocation(), "PrintStmt lowering");
+    genPrintStatement(*this, stmt);
   }
 
   void genFIR(const Fortran::parser::ReadStmt &stmt) {
-    TODO(toLocation(), "ReadStmt lowering");
+    mlir::Value iostat = genReadStatement(*this, stmt);
+    genIoConditionBranches(getEval(), stmt.controls, iostat);
   }
 
   void genFIR(const Fortran::parser::RewindStmt &stmt) {
     TODO(toLocation(), "RewindStmt lowering");
   }
 
   void genFIR(const Fortran::parser::WaitStmt &stmt) {
     TODO(toLocation(), "WaitStmt lowering");
   }
 
   void genFIR(const Fortran::parser::WriteStmt &stmt) {
-    TODO(toLocation(), "WriteStmt lowering");
+    mlir::Value iostat = genWriteStatement(*this, stmt);
+    genIoConditionBranches(getEval(), stmt.controls, iostat);
+  }
+
+  template <typename A>
+  void genIoConditionBranches(Fortran::lower::pft::Evaluation &eval,
+                              const A &specList, mlir::Value iostat) {
+    if (!iostat)
+      return;
+
+    mlir::Block *endBlock = nullptr;
+    mlir::Block *eorBlock = nullptr;
+    mlir::Block *errBlock = nullptr;
+    for (const auto &spec : specList) {
+      std::visit(Fortran::common::visitors{
+                     [&](const Fortran::parser::EndLabel &label) {
+                       endBlock = blockOfLabel(eval, label.v);
+                     },
+                     [&](const Fortran::parser::EorLabel &label) {
+                       eorBlock = blockOfLabel(eval, label.v);
+                     },
+                     [&](const Fortran::parser::ErrLabel &label) {
+                       errBlock = blockOfLabel(eval, label.v);
+                     },
+                     [](const auto &) {}},
+                 spec.u);
+    }
+    if (!endBlock && !eorBlock && !errBlock)
+      return;
+
+    mlir::Location loc = toLocation();
+    mlir::Type indexType = builder->getIndexType();
+    mlir::Value selector = builder->createConvert(loc, indexType, iostat);
+    llvm::SmallVector<int64_t> indexList;
+    llvm::SmallVector<mlir::Block *> blockList;
+    if (eorBlock) {
+      indexList.push_back(Fortran::runtime::io::IostatEor);
+      blockList.push_back(eorBlock);
+    }
+    if (endBlock) {
+      indexList.push_back(Fortran::runtime::io::IostatEnd);
+      blockList.push_back(endBlock);
+    }
+    if (errBlock) {
+      indexList.push_back(0);
+      blockList.push_back(eval.nonNopSuccessor().block);
+      // ERR label statement is the default successor.
+      blockList.push_back(errBlock);
+    } else {
+      // Fallthrough successor statement is the default successor.
+      blockList.push_back(eval.nonNopSuccessor().block);
+    }
+    builder->create<fir::SelectOp>(loc, selector, indexList, blockList);
   }
 
   //===--------------------------------------------------------------------===//
   // Memory allocation and deallocation
   //===--------------------------------------------------------------------===//
 
   void genFIR(const Fortran::parser::AllocateStmt &stmt) {
     TODO(toLocation(), "AllocateStmt lowering");

flang/lib/Lower/CMakeLists.txt

 get_property(dialect_libs GLOBAL PROPERTY MLIR_DIALECT_LIBS)
 
 add_flang_library(FortranLower
   Allocatable.cpp
   Bridge.cpp
   CallInterface.cpp
   Coarray.cpp
   ConvertExpr.cpp
   ConvertType.cpp
   ConvertVariable.cpp
   IntrinsicCall.cpp
+  IO.cpp
   ComponentPath.cpp
   DumpEvaluateExpr.cpp
   IterationSpace.cpp
   Mangler.cpp
   OpenACC.cpp
   OpenMP.cpp
   PFTBuilder.cpp
   Runtime.cpp

flang/lib/Lower/ConvertExpr.cpp

 }
 template <>
 bool isElementalProcWithArrayArgs(const Fortran::lower::SomeExpr &x) {
   if (const auto *procRef = std::get_if<Fortran::evaluate::ProcedureRef>(&x.u))
     return isElementalProcWithArrayArgs(*procRef);
   return false;
 }
 
+/// Some auxiliary data for processing initialization in ScalarExprLowering
+/// below. This is currently used for generating dense attributed global
+/// arrays.
+struct InitializerData {
+  explicit InitializerData(bool getRawVals = false) : genRawVals{getRawVals} {}
+  llvm::SmallVector<mlir::Attribute> rawVals; // initialization raw values
+  mlir::Type rawType; // Type of elements processed for rawVals vector.
+  bool genRawVals;    // generate the rawVals vector if set.
+};
+
 /// If \p arg is the address of a function with a denoted host-association tuple
 /// argument, then return the host-associations tuple value of the current
 /// procedure. Otherwise, return nullptr.
 static mlir::Value
 argumentHostAssocs(Fortran::lower::AbstractConverter &converter,
                    mlir::Value arg) {
   if (auto addr = mlir::dyn_cast_or_null<fir::AddrOfOp>(arg.getDefiningOp())) {
     auto &builder = converter.getFirOpBuilder();

 /// Lowering of Fortran::evaluate::Expr<T> expressions
 class ScalarExprLowering {
 public:
   using ExtValue = fir::ExtendedValue;
 
   explicit ScalarExprLowering(mlir::Location loc,
                               Fortran::lower::AbstractConverter &converter,
                               Fortran::lower::SymMap &symMap,
-                              Fortran::lower::StatementContext &stmtCtx)
+                              Fortran::lower::StatementContext &stmtCtx,
+                              InitializerData *initializer = nullptr)
       : location{loc}, converter{converter},
         builder{converter.getFirOpBuilder()}, stmtCtx{stmtCtx}, symMap{symMap} {
   }
 
   ExtValue genExtAddr(const Fortran::lower::SomeExpr &expr) {
     return gen(expr);
   }
 
if (explicitSpaceIsActive()) {
       builder.create<fir::ArrayMergeStoreOp>(
           loc, destination, fir::getBase(exv), destination.getMemref(),
           destination.getSlice(), destination.getTypeparams());
     }
     fir::factory::finalizeRealloc(builder, loc, mutableBox, lbounds,
                                   takeLboundsIfRealloc, realloc);
   }
 
+  /// Entry point for when an array expression appears in a context where the
+  /// result must be boxed. (BoxValue semantics.)
+  static ExtValue
+  lowerBoxedArrayExpression(Fortran::lower::AbstractConverter &converter,
+                            Fortran::lower::SymMap &symMap,
+                            Fortran::lower::StatementContext &stmtCtx,
+                            const Fortran::lower::SomeExpr &expr) {
+    ArrayExprLowering ael{converter, stmtCtx, symMap,
+                          ConstituentSemantics::BoxValue};
+    return ael.lowerBoxedArrayExpr(expr);
+  }
+
+  ExtValue lowerBoxedArrayExpr(const Fortran::lower::SomeExpr &exp) {
+    return std::visit(
+        [&](const auto &e) {
+          auto f = genarr(e);
+          ExtValue exv = f(IterationSpace{});
+          if (fir::getBase(exv).getType().template isa<fir::BoxType>())
+            return exv;
+          fir::emitFatalError(getLoc(), "array must be emboxed");
+        },
+        exp.u);
+  }
+
   /// Entry point into lowering an expression with rank. This entry point is for
   /// lowering a rhs expression, for example. (RefTransparent semantics.)
   static ExtValue
   lowerNewArrayExpression(Fortran::lower::AbstractConverter &converter,
                           Fortran::lower::SymMap &symMap,
                           Fortran::lower::StatementContext &stmtCtx,
                           const Fortran::lower::SomeExpr &expr) {
     ArrayExprLowering ael{converter, stmtCtx, symMap};

 fir::ExtendedValue Fortran::lower::createSomeExtendedExpression(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
   return ScalarExprLowering{loc, converter, symMap, stmtCtx}.genval(expr);
 }
 
+fir::GlobalOp Fortran::lower::createDenseGlobal(
+    mlir::Location loc, mlir::Type symTy, llvm::StringRef globalName,
+    mlir::StringAttr linkage, bool isConst,
+    const Fortran::lower::SomeExpr &expr,
+    Fortran::lower::AbstractConverter &converter) {
+
+  Fortran::lower::StatementContext stmtCtx(/*prohibited=*/true);
+  Fortran::lower::SymMap emptyMap;
+  InitializerData initData(/*genRawVals=*/true);
+  ScalarExprLowering sel(loc, converter, emptyMap, stmtCtx,
+                         /*initializer=*/&initData);
+  sel.genval(expr);
+
+  size_t sz = initData.rawVals.size();
+  llvm::ArrayRef<mlir::Attribute> ar = {initData.rawVals.data(), sz};
+
+  mlir::RankedTensorType tensorTy;
+  auto &builder = converter.getFirOpBuilder();
+  mlir::Type iTy = initData.rawType;
+  if (!iTy)
+    return 0; // array extent is probably 0 in this case, so just return 0.
+  tensorTy = mlir::RankedTensorType::get(sz, iTy);
+  auto init = mlir::DenseElementsAttr::get(tensorTy, ar);
+  return builder.createGlobal(loc, symTy, globalName, linkage, init, isConst);
+}
+
+fir::ExtendedValue Fortran::lower::createSomeInitializerExpression(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "expr: ") << '\n');
+  InitializerData initData; // needed for initializations
+  return ScalarExprLowering{loc, converter, symMap, stmtCtx,
+                            /*initializer=*/&initData}
+      .genval(expr);
+}
+
 fir::ExtendedValue Fortran::lower::createSomeExtendedAddress(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
     Fortran::lower::StatementContext &stmtCtx) {
   LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "address: ") << '\n');
   return ScalarExprLowering{loc, converter, symMap, stmtCtx}.gen(expr);
 }
 
+fir::ExtendedValue Fortran::lower::createInitializerAddress(
+    mlir::Location loc, Fortran::lower::AbstractConverter &converter,
+    const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap,
+    Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "address: ") << '\n');
+  InitializerData init;
+  return ScalarExprLowering(loc, converter, symMap, stmtCtx, &init).gen(expr);
+}
+
+fir::ExtendedValue
+Fortran::lower::createSomeArrayBox(Fortran::lower::AbstractConverter &converter,
+                                   const Fortran::lower::SomeExpr &expr,
+                                   Fortran::lower::SymMap &symMap,
+                                   Fortran::lower::StatementContext &stmtCtx) {
+  LLVM_DEBUG(expr.AsFortran(llvm::dbgs() << "box designator: ") << '\n');
+  return ArrayExprLowering::lowerBoxedArrayExpression(converter, symMap,
+                                                      stmtCtx, expr);
+}
+
 fir::MutableBoxValue Fortran::lower::createMutableBox(
     mlir::Location loc, Fortran::lower::AbstractConverter &converter,
     const Fortran::lower::SomeExpr &expr, Fortran::lower::SymMap &symMap) {
   // MutableBox lowering StatementContext does not need to be propagated
   // to the caller because the result value is a variable, not a temporary
   // expression. The StatementContext clean-up can occur before using the
   // resulting MutableBoxValue. Variables of all other types are handled in the
   // bridge.

flang/lib/Lower/ConvertType.cpp

 
 static mlir::Type genLogicalType(mlir::MLIRContext *context, int KIND) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Logical, KIND))
     return fir::LogicalType::get(context, KIND);
   return {};
 }
 
+static mlir::Type genCharacterType(
+    mlir::MLIRContext *context, int KIND,
+    Fortran::lower::LenParameterTy len = fir::CharacterType::unknownLen()) {
+  if (Fortran::evaluate::IsValidKindOfIntrinsicType(
+          Fortran::common::TypeCategory::Character, KIND))
+    return fir::CharacterType::get(context, KIND, len);
+  return {};
+}
+
 static mlir::Type genComplexType(mlir::MLIRContext *context, int KIND) {
   if (Fortran::evaluate::IsValidKindOfIntrinsicType(
           Fortran::common::TypeCategory::Complex, KIND))
     return fir::ComplexType::get(context, KIND);
   return {};
 }
 
-static mlir::Type genFIRType(mlir::MLIRContext *context,
-                             Fortran::common::TypeCategory tc, int kind) {
+static mlir::Type
+genFIRType(mlir::MLIRContext *context, Fortran::common::TypeCategory tc,
+           int kind,
+           llvm::ArrayRef<Fortran::lower::LenParameterTy> lenParameters) {
   switch (tc) {
   case Fortran::common::TypeCategory::Real:
     return genRealType(context, kind);
   case Fortran::common::TypeCategory::Integer:
     return genIntegerType(context, kind);
   case Fortran::common::TypeCategory::Complex:
     return genComplexType(context, kind);
   case Fortran::common::TypeCategory::Logical:
     return genLogicalType(context, kind);
   case Fortran::common::TypeCategory::Character:
-    TODO_NOLOC("genFIRType Character");
+    if (!lenParameters.empty())
+      return genCharacterType(context, kind, lenParameters[0]);
+    return genCharacterType(context, kind);
   default:
     break;
   }
   llvm_unreachable("unhandled type category");
 }
 
 //===--------------------------------------------------------------------===//
 // Symbol and expression type translation
if (!dynamicType)
       return genTypelessExprType(expr);
     Fortran::common::TypeCategory category = dynamicType->category();
 
     mlir::Type baseType;
     if (category == Fortran::common::TypeCategory::Derived) {
       TODO(converter.getCurrentLocation(), "genExprType derived");
     } else {
       // LOGICAL, INTEGER, REAL, COMPLEX, CHARACTER
-      baseType = genFIRType(context, category, dynamicType->kind());
+      llvm::SmallVector<Fortran::lower::LenParameterTy> params;
+      translateLenParameters(params, category, expr);
+      baseType = genFIRType(context, category, dynamicType->kind(), params);
     }
     std::optional<Fortran::evaluate::Shape> shapeExpr =
         Fortran::evaluate::GetShape(converter.getFoldingContext(), expr);
     fir::SequenceType::Shape shape;
     if (shapeExpr) {
       translateShape(shape, std::move(*shapeExpr));
     } else {
       // Shape static analysis cannot return something useful for the shape.
mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
     // avoid issues with helper functions that would not follow association
     // links, the fir type is built based on the ultimate symbol. This relies
     // on the fact volatile and asynchronous are not reflected in fir types.
     const Fortran::semantics::Symbol &ultimate = symbol.GetUltimate();
     if (const Fortran::semantics::DeclTypeSpec *type = ultimate.GetType()) {
       if (const Fortran::semantics::IntrinsicTypeSpec *tySpec =
               type->AsIntrinsic()) {
         int kind = toInt64(Fortran::common::Clone(tySpec->kind())).value();
-        ty = genFIRType(context, tySpec->category(), kind);
+        llvm::SmallVector<Fortran::lower::LenParameterTy> params;
+        translateLenParameters(params, tySpec->category(), ultimate);
+        ty = genFIRType(context, tySpec->category(), kind, params);
       } else if (type->IsPolymorphic()) {
         TODO(loc, "genSymbolType polymorphic types");
       } else if (type->AsDerived()) {
         TODO(loc, "genSymbolType derived type");
       } else {
         fir::emitFatalError(loc, "symbol's type must have a type spec");
       }
     } else {
mlir::Type genSymbolType(const Fortran::semantics::Symbol &symbol,
     // or pointer semantics, so do not use box for them.
     if (isPtr)
       return fir::PointerType::get(ty);
     if (isAlloc)
       return fir::HeapType::get(ty);
     return ty;
   }
 
+  // To get the character length from a symbol, make an fold a designator for
+  // the symbol to cover the case where the symbol is an assumed length named
+  // constant and its length comes from its init expression length.
+  template <int Kind>
+  fir::SequenceType::Extent
+  getCharacterLengthHelper(const Fortran::semantics::Symbol &symbol) {
+    using TC =
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, Kind>;
+    auto designator = Fortran::evaluate::Fold(
+        converter.getFoldingContext(),
+        Fortran::evaluate::Expr<TC>{Fortran::evaluate::Designator<TC>{symbol}});
+    if (auto len = toInt64(std::move(designator.LEN())))
+      return *len;
+    return fir::SequenceType::getUnknownExtent();
+  }
+
+  template <typename T>
+  void translateLenParameters(
+      llvm::SmallVectorImpl<Fortran::lower::LenParameterTy> &params,
+      Fortran::common::TypeCategory category, const T &exprOrSym) {
+    if (category == Fortran::common::TypeCategory::Character)
+      params.push_back(getCharacterLength(exprOrSym));
+    else if (category == Fortran::common::TypeCategory::Derived)
+      TODO(converter.getCurrentLocation(),
+           "lowering derived type length parameters");
+    return;
+  }
+  Fortran::lower::LenParameterTy
+  getCharacterLength(const Fortran::semantics::Symbol &symbol) {
+    const Fortran::semantics::DeclTypeSpec *type = symbol.GetType();
+    if (!type ||
+        type->category() != Fortran::semantics::DeclTypeSpec::Character ||
+        !type->AsIntrinsic())
+      llvm::report_fatal_error("not a character symbol");
+    int kind =
+        toInt64(Fortran::common::Clone(type->AsIntrinsic()->kind())).value();
+    switch (kind) {
+    case 1:
+      return getCharacterLengthHelper<1>(symbol);
+    case 2:
+      return getCharacterLengthHelper<2>(symbol);
+    case 4:
+      return getCharacterLengthHelper<4>(symbol);
+    }
+    llvm_unreachable("unknown character kind");
+  }
+  Fortran::lower::LenParameterTy
+  getCharacterLength(const Fortran::lower::SomeExpr &expr) {
+    // Do not use dynamic type length here. We would miss constant
+    // lengths opportunities because dynamic type only has the length
+    // if it comes from a declaration.
+    auto charExpr =
+        std::get<Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(
+            expr.u);
+    if (auto constantLen = toInt64(charExpr.LEN()))
+      return *constantLen;
+    return fir::SequenceType::getUnknownExtent();
+  }
+
   mlir::Type genVariableType(const Fortran::lower::pft::Variable &var) {
     return genSymbolType(var.getSymbol(), var.isHeapAlloc(), var.isPointer());
   }
 
 private:
   Fortran::lower::AbstractConverter &converter;
   mlir::MLIRContext *context;
 };
 
 } // namespace
 
 mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context,
                                       Fortran::common::TypeCategory tc,
-                                      int kind) {
-  return genFIRType(context, tc, kind);
+                                      int kind,
+                                      llvm::ArrayRef<LenParameterTy> params) {
+  return genFIRType(context, tc, kind, params);
 }
 
 mlir::Type Fortran::lower::translateSomeExprToFIRType(
     Fortran::lower::AbstractConverter &converter, const SomeExpr &expr) {
   return TypeBuilder{converter}.genExprType(expr);
 }
 
 mlir::Type Fortran::lower::translateSymbolToFIRType(

flang/lib/Lower/ConvertVariable.cpp

 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Support/FIRContext.h"
 #include "flang/Optimizer/Support/FatalError.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-variable"
 
+/// Helper to retrieve a copy of a character literal string from a SomeExpr.
+/// Required to build character global initializers.
+template <int KIND>
+static llvm::Optional<std::tuple<std::string, std::size_t>>
+getCharacterLiteralCopy(
+    const Fortran::evaluate::Expr<
+        Fortran::evaluate::Type<Fortran::common::TypeCategory::Character, KIND>>
+        &x) {
+  if (const auto *con =
+          Fortran::evaluate::UnwrapConstantValue<Fortran::evaluate::Type<
+              Fortran::common::TypeCategory::Character, KIND>>(x))
+    if (auto val = con->GetScalarValue())
+      return std::tuple<std::string, std::size_t>{
+          std::string{(const char *)val->c_str(),
+                      KIND * (std::size_t)con->LEN()},
+          (std::size_t)con->LEN()};
+  return llvm::None;
+}
+static llvm::Optional<std::tuple<std::string, std::size_t>>
+getCharacterLiteralCopy(
+    const Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter> &x) {
+  return std::visit([](const auto &e) { return getCharacterLiteralCopy(e); },
+                    x.u);
+}
+static llvm::Optional<std::tuple<std::string, std::size_t>>
+getCharacterLiteralCopy(const Fortran::lower::SomeExpr &x) {
+  if (const auto *e = Fortran::evaluate::UnwrapExpr<
+          Fortran::evaluate::Expr<Fortran::evaluate::SomeCharacter>>(x))
+    return getCharacterLiteralCopy(*e);
+  return llvm::None;
+}
+template <typename A>
+static llvm::Optional<std::tuple<std::string, std::size_t>>
+getCharacterLiteralCopy(const std::optional<A> &x) {
+  if (x)
+    return getCharacterLiteralCopy(*x);
+  return llvm::None;
+}
+
 /// Helper to lower a scalar expression using a specific symbol mapping.
 static mlir::Value genScalarValue(Fortran::lower::AbstractConverter &converter,
                                   mlir::Location loc,
                                   const Fortran::lower::SomeExpr &expr,
                                   Fortran::lower::SymMap &symMap,
                                   Fortran::lower::StatementContext &context) {
   // This does not use the AbstractConverter member function to override the
   // symbol mapping to be used expression lowering.
   return fir::getBase(Fortran::lower::createSomeExtendedExpression(
       loc, converter, expr, symMap, context));
 }
 
+/// Does this variable have a default initialization?
+static bool hasDefaultInitialization(const Fortran::semantics::Symbol &sym) {
+  if (sym.has<Fortran::semantics::ObjectEntityDetails>() && sym.size())
+    if (!Fortran::semantics::IsAllocatableOrPointer(sym))
+      if (const Fortran::semantics::DeclTypeSpec *declTypeSpec = sym.GetType())
+        if (const Fortran::semantics::DerivedTypeSpec *derivedTypeSpec =
+                declTypeSpec->AsDerived())
+          return derivedTypeSpec->HasDefaultInitialization();
+  return false;
+}
+
+//===----------------------------------------------------------------===//
+// Global variables instantiation (not for alias and common)
+//===----------------------------------------------------------------===//
+
+/// Helper to generate expression value inside global initializer.
+static fir::ExtendedValue
+genInitializerExprValue(Fortran::lower::AbstractConverter &converter,
+                        mlir::Location loc,
+                        const Fortran::lower::SomeExpr &expr,
+                        Fortran::lower::StatementContext &stmtCtx) {
+  // Data initializer are constant value and should not depend on other symbols
+  // given the front-end fold parameter references. In any case, the "current"
+  // map of the converter should not be used since it holds mapping to
+  // mlir::Value from another mlir region. If these value are used by accident
+  // in the initializer, this will lead to segfaults in mlir code.
+  Fortran::lower::SymMap emptyMap;
+  return Fortran::lower::createSomeInitializerExpression(loc, converter, expr,
+                                                         emptyMap, stmtCtx);
+}
+
+/// Can this symbol constant be placed in read-only memory?
+static bool isConstant(const Fortran::semantics::Symbol &sym) {
+  return sym.attrs().test(Fortran::semantics::Attr::PARAMETER) ||
+         sym.test(Fortran::semantics::Symbol::Flag::ReadOnly);
+}
+
+/// Create the global op declaration without any initializer
+static fir::GlobalOp declareGlobal(Fortran::lower::AbstractConverter &converter,
+                                   const Fortran::lower::pft::Variable &var,
+                                   llvm::StringRef globalName,
+                                   mlir::StringAttr linkage) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (fir::GlobalOp global = builder.getNamedGlobal(globalName))
+    return global;
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  mlir::Location loc = converter.genLocation(sym.name());
+  // Resolve potential host and module association before checking that this
+  // symbol is an object of a function pointer.
+  const Fortran::semantics::Symbol &ultimate = sym.GetUltimate();
+  if (!ultimate.has<Fortran::semantics::ObjectEntityDetails>() &&
+      !ultimate.has<Fortran::semantics::ProcEntityDetails>())
+    mlir::emitError(loc, "lowering global declaration: symbol '")
+        << toStringRef(sym.name()) << "' has unexpected details\n";
+  return builder.createGlobal(loc, converter.genType(var), globalName, linkage,
+                              mlir::Attribute{}, isConstant(ultimate));
+}
+
+/// Temporary helper to catch todos in initial data target lowering.
+static bool
+hasDerivedTypeWithLengthParameters(const Fortran::semantics::Symbol &sym) {
+  if (const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType())
+    if (const Fortran::semantics::DerivedTypeSpec *derived =
+            declTy->AsDerived())
+      return Fortran::semantics::CountLenParameters(*derived) > 0;
+  return false;
+}
+
+static mlir::Type unwrapElementType(mlir::Type type) {
+  if (mlir::Type ty = fir::dyn_cast_ptrOrBoxEleTy(type))
+    type = ty;
+  if (auto seqType = type.dyn_cast<fir::SequenceType>())
+    type = seqType.getEleTy();
+  return type;
+}
+
+/// create initial-data-target fir.box in a global initializer region.
+mlir::Value Fortran::lower::genInitialDataTarget(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Type boxType, const Fortran::lower::SomeExpr &initialTarget) {
+  Fortran::lower::SymMap globalOpSymMap;
+  Fortran::lower::AggregateStoreMap storeMap;
+  Fortran::lower::StatementContext stmtCtx;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (Fortran::evaluate::UnwrapExpr<Fortran::evaluate::NullPointer>(
+          initialTarget))
+    return fir::factory::createUnallocatedBox(builder, loc, boxType,
+                                              /*nonDeferredParams=*/llvm::None);
+  // Pointer initial data target, and NULL(mold).
+  if (const Fortran::semantics::Symbol *sym =
+          Fortran::evaluate::GetFirstSymbol(initialTarget)) {
+    // Length parameters processing will need care in global initializer
+    // context.
+    if (hasDerivedTypeWithLengthParameters(*sym))
+      TODO(loc, "initial-data-target with derived type length parameters");
+
+    auto var = Fortran::lower::pft::Variable(*sym, /*global=*/true);
+    Fortran::lower::instantiateVariable(converter, var, globalOpSymMap,
+                                        storeMap);
+  }
+  mlir::Value box;
+  if (initialTarget.Rank() > 0) {
+    box = fir::getBase(Fortran::lower::createSomeArrayBox(
+        converter, initialTarget, globalOpSymMap, stmtCtx));
+  } else {
+    fir::ExtendedValue addr = Fortran::lower::createInitializerAddress(
+        loc, converter, initialTarget, globalOpSymMap, stmtCtx);
+    box = builder.createBox(loc, addr);
+  }
+  // box is a fir.box<T>, not a fir.box<fir.ptr<T>> as it should to be used
+  // for pointers. A fir.convert should not be used here, because it would
+  // not actually set the pointer attribute in the descriptor.
+  // In a normal context, fir.rebox would be used to set the pointer attribute
+  // while copying the projection from another fir.box. But fir.rebox cannot be
+  // used in initializer because its current codegen expects that the input
+  // fir.box is in memory, which is not the case in initializers.
+  // So, just replace the fir.embox that created addr with one with
+  // fir.box<fir.ptr<T>> result type.
+  // Note that the descriptor cannot have been created with fir.rebox because
+  // the initial-data-target cannot be a fir.box itself (it cannot be
+  // assumed-shape, deferred-shape, or polymorphic as per C765). However the
+  // case where the initial data target is a derived type with length parameters
+  // will most likely be a bit trickier, hence the TODO above.
+
+  mlir::Operation *op = box.getDefiningOp();
+  if (!op || !mlir::isa<fir::EmboxOp>(*op))
+    fir::emitFatalError(
+        loc, "fir.box must be created with embox in global initializers");
+  mlir::Type targetEleTy = unwrapElementType(box.getType());
+  if (!fir::isa_char(targetEleTy))
+    return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
+                                        op->getAttrs());
+
+  // Handle the character case length particularities: embox takes a length
+  // value argument when the result type has unknown length, but not when the
+  // result type has constant length. The type of the initial target must be
+  // constant length, but the one of the pointer may not be. In this case, a
+  // length operand must be added.
+  auto targetLen = targetEleTy.cast<fir::CharacterType>().getLen();
+  auto ptrLen = unwrapElementType(boxType).cast<fir::CharacterType>().getLen();
+  if (ptrLen == targetLen)
+    // Nothing to do
+    return builder.create<fir::EmboxOp>(loc, boxType, op->getOperands(),
+                                        op->getAttrs());
+  auto embox = mlir::cast<fir::EmboxOp>(*op);
+  auto ptrType = boxType.cast<fir::BoxType>().getEleTy();
+  mlir::Value memref = builder.createConvert(loc, ptrType, embox.getMemref());
+  if (targetLen == fir::CharacterType::unknownLen())
+    // Drop the length argument.
+    return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(),
+                                        embox.getSlice());
+  // targetLen is constant and ptrLen is unknown. Add a length argument.
+  mlir::Value targetLenValue =
+      builder.createIntegerConstant(loc, builder.getIndexType(), targetLen);
+  return builder.create<fir::EmboxOp>(loc, boxType, memref, embox.getShape(),
+                                      embox.getSlice(),
+                                      mlir::ValueRange{targetLenValue});
+}
+
+static mlir::Value genDefaultInitializerValue(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const Fortran::semantics::Symbol &sym, mlir::Type symTy,
+    Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Type scalarType = symTy;
+  fir::SequenceType sequenceType;
+  if (auto ty = symTy.dyn_cast<fir::SequenceType>()) {
+    sequenceType = ty;
+    scalarType = ty.getEleTy();
+  }
+  // Build a scalar default value of the symbol type, looping through the
+  // components to build each component initial value.
+  auto recTy = scalarType.cast<fir::RecordType>();
+  auto fieldTy = fir::FieldType::get(scalarType.getContext());
+  mlir::Value initialValue = builder.create<fir::UndefOp>(loc, scalarType);
+  const Fortran::semantics::DeclTypeSpec *declTy = sym.GetType();
+  assert(declTy && "var with default initialization must have a type");
+  Fortran::semantics::OrderedComponentIterator components(
+      declTy->derivedTypeSpec());
+  for (const auto &component : components) {
+    // Skip parent components, the sub-components of parent types are part of
+    // components and will be looped through right after.
+    if (component.test(Fortran::semantics::Symbol::Flag::ParentComp))
+      continue;
+    mlir::Value componentValue;
+    llvm::StringRef name = toStringRef(component.name());
+    mlir::Type componentTy = recTy.getType(name);
+    assert(componentTy && "component not found in type");
+    if (const auto *object{
+            component.detailsIf<Fortran::semantics::ObjectEntityDetails>()}) {
+      if (const auto &init = object->init()) {
+        // Component has explicit initialization.
+        if (Fortran::semantics::IsPointer(component))
+          // Initial data target.
+          componentValue =
+              genInitialDataTarget(converter, loc, componentTy, *init);
+        else
+          // Initial value.
+          componentValue = fir::getBase(
+              genInitializerExprValue(converter, loc, *init, stmtCtx));
+      } else if (Fortran::semantics::IsAllocatableOrPointer(component)) {
+        // Pointer or allocatable without initialization.
+        // Create deallocated/disassociated value.
+        // From a standard point of view, pointer without initialization do not
+        // need to be disassociated, but for sanity and simplicity, do it in
+        // global constructor since this has no runtime cost.
+        componentValue = fir::factory::createUnallocatedBox(
+            builder, loc, componentTy, llvm::None);
+      } else if (hasDefaultInitialization(component)) {
+        // Component type has default initialization.
+        componentValue = genDefaultInitializerValue(converter, loc, component,
+                                                    componentTy, stmtCtx);
+      } else {
+        // Component has no initial value.
+        componentValue = builder.create<fir::UndefOp>(loc, componentTy);
+      }
+    } else if (const auto *proc{
+                   component
+                       .detailsIf<Fortran::semantics::ProcEntityDetails>()}) {
+      if (proc->init().has_value())
+        TODO(loc, "procedure pointer component default initialization");
+      else
+        componentValue = builder.create<fir::UndefOp>(loc, componentTy);
+    }
+    assert(componentValue && "must have been computed");
+    componentValue = builder.createConvert(loc, componentTy, componentValue);
+    // FIXME: type parameters must come from the derived-type-spec
+    auto field = builder.create<fir::FieldIndexOp>(
+        loc, fieldTy, name, scalarType,
+        /*typeParams=*/mlir::ValueRange{} /*TODO*/);
+    initialValue = builder.create<fir::InsertValueOp>(
+        loc, recTy, initialValue, componentValue,
+        builder.getArrayAttr(field.getAttributes()));
+  }
+
+  if (sequenceType) {
+    // For arrays, duplicate the scalar value to all elements with an
+    // fir.insert_range covering the whole array.
+    auto arrayInitialValue = builder.create<fir::UndefOp>(loc, sequenceType);
+    llvm::SmallVector<int64_t> rangeBounds;
+    for (int64_t extent : sequenceType.getShape()) {
+      if (extent == fir::SequenceType::getUnknownExtent())
+        TODO(loc,
+             "default initial value of array component with length parameters");
+      rangeBounds.push_back(0);
+      rangeBounds.push_back(extent - 1);
+    }
+    return builder.create<fir::InsertOnRangeOp>(
+        loc, sequenceType, arrayInitialValue, initialValue,
+        builder.getIndexVectorAttr(rangeBounds));
+  }
+  return initialValue;
+}
+
+/// Does this global already have an initializer ?
+static bool globalIsInitialized(fir::GlobalOp global) {
+  return !global.getRegion().empty() || global.getInitVal();
+}
+
+/// Call \p genInit to generate code inside \p global initializer region.
+static void
+createGlobalInitialization(fir::FirOpBuilder &builder, fir::GlobalOp global,
+                           std::function<void(fir::FirOpBuilder &)> genInit) {
+  mlir::Region &region = global.getRegion();
+  region.push_back(new mlir::Block);
+  mlir::Block &block = region.back();
+  auto insertPt = builder.saveInsertionPoint();
+  builder.setInsertionPointToStart(&block);
+  genInit(builder);
+  builder.restoreInsertionPoint(insertPt);
+}
+
+/// Create the global op and its init if it has one
+static fir::GlobalOp defineGlobal(Fortran::lower::AbstractConverter &converter,
+                                  const Fortran::lower::pft::Variable &var,
+                                  llvm::StringRef globalName,
+                                  mlir::StringAttr linkage) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  mlir::Location loc = converter.genLocation(sym.name());
+  bool isConst = isConstant(sym);
+  fir::GlobalOp global = builder.getNamedGlobal(globalName);
+  mlir::Type symTy = converter.genType(var);
+
+  if (global && globalIsInitialized(global))
+    return global;
+  // If this is an array, check to see if we can use a dense attribute
+  // with a tensor mlir type.  This optimization currently only supports
+  // rank-1 Fortran arrays of integer, real, or logical. The tensor
+  // type does not support nested structures which are needed for
+  // complex numbers.
+  // To get multidimensional arrays to work, we will have to use column major
+  // array ordering with the tensor type (so it matches column major ordering
+  // with the Fortran fir.array).  By default, tensor types assume row major
+  // ordering. How to create this tensor type is to be determined.
+  if (symTy.isa<fir::SequenceType>() && sym.Rank() == 1 &&
+      !Fortran::semantics::IsAllocatableOrPointer(sym)) {
+    mlir::Type eleTy = symTy.cast<fir::SequenceType>().getEleTy();
+    if (eleTy.isa<mlir::IntegerType, mlir::FloatType, fir::LogicalType>()) {
+      const auto *details =
+          sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
+      if (details->init()) {
+        global = Fortran::lower::createDenseGlobal(
+            loc, symTy, globalName, linkage, isConst, details->init().value(),
+            converter);
+        if (global) {
+          global.setVisibility(mlir::SymbolTable::Visibility::Public);
+          return global;
+        }
+      }
+    }
+  }
+  if (!global)
+    global = builder.createGlobal(loc, symTy, globalName, linkage,
+                                  mlir::Attribute{}, isConst);
+  if (Fortran::semantics::IsAllocatableOrPointer(sym)) {
+    const auto *details =
+        sym.detailsIf<Fortran::semantics::ObjectEntityDetails>();
+    if (details && details->init()) {
+      auto expr = *details->init();
+      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
+        mlir::Value box =
+            Fortran::lower::genInitialDataTarget(converter, loc, symTy, expr);
+        b.create<fir::HasValueOp>(loc, box);
+      });
+    } else {
+      // Create unallocated/disassociated descriptor if no explicit init
+      createGlobalInitialization(builder, global, [&](fir::FirOpBuilder &b) {
+        mlir::Value box =
+            fir::factory::createUnallocatedBox(b, loc, symTy, llvm::None);
+        b.create<fir::HasValueOp>(loc, box);
+      });
+    }
+
+  } else if (const auto *details =
+                 sym.detailsIf<Fortran::semantics::ObjectEntityDetails>()) {
+    if (details->init()) {
+      if (fir::isa_char(symTy)) {
+        // CHARACTER literal
+        if (auto chLit = getCharacterLiteralCopy(details->init().value())) {
+          mlir::StringAttr init =
+              builder.getStringAttr(std::get<std::string>(*chLit));
+          global->setAttr(global.getInitValAttrName(), init);
+        } else {
+          fir::emitFatalError(loc, "CHARACTER has unexpected initial value");
+        }
+      } else {
+        createGlobalInitialization(
+            builder, global, [&](fir::FirOpBuilder &builder) {
+              Fortran::lower::StatementContext stmtCtx(
+                  /*cleanupProhibited=*/true);
+              fir::ExtendedValue initVal = genInitializerExprValue(
+                  converter, loc, details->init().value(), stmtCtx);
+              mlir::Value castTo =
+                  builder.createConvert(loc, symTy, fir::getBase(initVal));
+              builder.create<fir::HasValueOp>(loc, castTo);
+            });
+      }
+    } else if (hasDefaultInitialization(sym)) {
+      createGlobalInitialization(
+          builder, global, [&](fir::FirOpBuilder &builder) {
+            Fortran::lower::StatementContext stmtCtx(
+                /*cleanupProhibited=*/true);
+            mlir::Value initVal =
+                genDefaultInitializerValue(converter, loc, sym, symTy, stmtCtx);
+            mlir::Value castTo = builder.createConvert(loc, symTy, initVal);
+            builder.create<fir::HasValueOp>(loc, castTo);
+          });
+    }
+  } else if (sym.has<Fortran::semantics::CommonBlockDetails>()) {
+    mlir::emitError(loc, "COMMON symbol processed elsewhere");
+  } else {
+    TODO(loc, "global"); // Procedure pointer or something else
+  }
+  // Creates undefined initializer for globals without initializers
+  if (!globalIsInitialized(global))
+    createGlobalInitialization(
+        builder, global, [&](fir::FirOpBuilder &builder) {
+          builder.create<fir::HasValueOp>(
+              loc, builder.create<fir::UndefOp>(loc, symTy));
+        });
+  // Set public visibility to prevent global definition to be optimized out
+  // even if they have no initializer and are unused in this compilation unit.
+  global.setVisibility(mlir::SymbolTable::Visibility::Public);
+  return global;
+}
+
+/// Return linkage attribute for \p var.
+static mlir::StringAttr
+getLinkageAttribute(fir::FirOpBuilder &builder,
+                    const Fortran::lower::pft::Variable &var) {
+  if (var.isModuleVariable())
+    return {}; // external linkage
+  // Otherwise, the variable is owned by a procedure and must not be visible in
+  // other compilation units.
+  return builder.createInternalLinkage();
+}
+
+/// Instantiate a global variable. If it hasn't already been processed, add
+/// the global to the ModuleOp as a new uniqued symbol and initialize it with
+/// the correct value. It will be referenced on demand using `fir.addr_of`.
+static void instantiateGlobal(Fortran::lower::AbstractConverter &converter,
+                              const Fortran::lower::pft::Variable &var,
+                              Fortran::lower::SymMap &symMap) {
+  const Fortran::semantics::Symbol &sym = var.getSymbol();
+  assert(!var.isAlias() && "must be handled in instantiateAlias");
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  std::string globalName = Fortran::lower::mangle::mangleName(sym);
+  mlir::Location loc = converter.genLocation(sym.name());
+  fir::GlobalOp global = builder.getNamedGlobal(globalName);
+  mlir::StringAttr linkage = getLinkageAttribute(builder, var);
+  if (var.isModuleVariable()) {
+    // A module global was or will be defined when lowering the module. Emit
+    // only a declaration if the global does not exist at that point.
+    global = declareGlobal(converter, var, globalName, linkage);
+  } else {
+    global = defineGlobal(converter, var, globalName, linkage);
+  }
+  auto addrOf = builder.create<fir::AddrOfOp>(loc, global.resultType(),
+                                              global.getSymbol());
+  Fortran::lower::StatementContext stmtCtx;
+  mapSymbolAttributes(converter, var, symMap, stmtCtx, addrOf);
+}
+
 //===----------------------------------------------------------------===//
 // Local variables instantiation (not for alias)
 //===----------------------------------------------------------------===//
 
 /// Create a stack slot for a local variable. Precondition: the insertion
 /// point of the builder must be in the entry block, which is currently being
 /// constructed.
 static mlir::Value createNewLocal(Fortran::lower::AbstractConverter &converter,
ba.match(
       [&](const Fortran::lower::BoxAnalyzer::None &) {
         mlir::emitError(loc, "symbol analysis failed on ")
             << toStringRef(sym.name());
       });
 }
 
 void Fortran::lower::instantiateVariable(AbstractConverter &converter,
                                          const pft::Variable &var,
-                                         SymMap &symMap) {
+                                         SymMap &symMap,
+                                         AggregateStoreMap &storeMap) {
   const Fortran::semantics::Symbol &sym = var.getSymbol();
   const mlir::Location loc = converter.genLocation(sym.name());
   if (var.isAggregateStore()) {
     TODO(loc, "instantiateVariable AggregateStore");
   } else if (Fortran::semantics::FindCommonBlockContaining(
                  var.getSymbol().GetUltimate())) {
     TODO(loc, "instantiateVariable Common");
   } else if (var.isAlias()) {
     TODO(loc, "instantiateVariable Alias");
   } else if (var.isGlobal()) {
-    TODO(loc, "instantiateVariable Global");
+    instantiateGlobal(converter, var, symMap);
   } else {
     instantiateLocal(converter, var, symMap);
   }
 }
 
 void Fortran::lower::mapCallInterfaceSymbols(
     AbstractConverter &converter, const Fortran::lower::CallerInterface &caller,
     SymMap &symMap) {
+  Fortran::lower::AggregateStoreMap storeMap;
   const Fortran::semantics::Symbol &result = caller.getResultSymbol();
   for (Fortran::lower::pft::Variable var :
        Fortran::lower::pft::buildFuncResultDependencyList(result)) {
     if (var.isAggregateStore()) {
-      instantiateVariable(converter, var, symMap);
+      instantiateVariable(converter, var, symMap, storeMap);
     } else {
       const Fortran::semantics::Symbol &sym = var.getSymbol();
       const auto *hostDetails =
           sym.detailsIf<Fortran::semantics::HostAssocDetails>();
       if (hostDetails && !var.isModuleVariable()) {
         // The callee is an internal procedure `A` whose result properties
         // depend on host variables. The caller may be the host, or another
         // internal procedure `B` contained in the same host.  In the first
if (var.isAggregateStore()) {
         symMap.addSymbol(sym, caller.getArgumentValue(sym));
         // All the properties of the dummy variable may not come from the actual
         // argument, let instantiateVariable handle this.
       }
       // If this is neither a host associated or dummy symbol, it must be a
       // module or common block variable to satisfy specification expression
       // requirements in 10.1.11, instantiateVariable will get its address and
       // properties.
-      instantiateVariable(converter, var, symMap);
+      instantiateVariable(converter, var, symMap, storeMap);
     }
   }
 }

flang/lib/Lower/IO.cpp

+//===-- IO.cpp -- IO statement lowering -----------------------------------===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+//
+// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/
+//
+//===----------------------------------------------------------------------===//
+
+#include "flang/Lower/IO.h"
+#include "flang/Common/uint128.h"
+#include "flang/Lower/Bridge.h"
+#include "flang/Lower/ConvertVariable.h"
+#include "flang/Lower/PFTBuilder.h"
+#include "flang/Lower/StatementContext.h"
+#include "flang/Lower/Support/Utils.h"
+#include "flang/Lower/Todo.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/RTBuilder.h"
+#include "flang/Parser/parse-tree.h"
+#include "flang/Runtime/io-api.h"
+#include "flang/Semantics/tools.h"
+#include "mlir/Dialect/ControlFlow/IR/ControlFlowOps.h"
+
+#define DEBUG_TYPE "flang-lower-io"
+
+// Define additional runtime type models specific to IO.
+namespace fir::runtime {
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::io::IoStatementState *>() {
+  return getModel<char *>();
+}
+template <>
+constexpr TypeBuilderFunc
+getModel<const Fortran::runtime::io::NamelistGroup &>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return fir::ReferenceType::get(mlir::TupleType::get(context));
+  };
+}
+template <>
+constexpr TypeBuilderFunc getModel<Fortran::runtime::io::Iostat>() {
+  return [](mlir::MLIRContext *context) -> mlir::Type {
+    return mlir::IntegerType::get(context,
+                                  8 * sizeof(Fortran::runtime::io::Iostat));
+  };
+}
+} // namespace fir::runtime
+
+using namespace Fortran::runtime::io;
+
+#define mkIOKey(X) FirmkKey(IONAME(X))
+
+namespace Fortran::lower {
+/// Static table of IO runtime calls
+///
+/// This logical map contains the name and type builder function for each IO
+/// runtime function listed in the tuple. This table is fully constructed at
+/// compile-time. Use the `mkIOKey` macro to access the table.
+static constexpr std::tuple<
+    mkIOKey(BeginInternalArrayListOutput), mkIOKey(BeginInternalArrayListInput),
+    mkIOKey(BeginInternalArrayFormattedOutput),
+    mkIOKey(BeginInternalArrayFormattedInput), mkIOKey(BeginInternalListOutput),
+    mkIOKey(BeginInternalListInput), mkIOKey(BeginInternalFormattedOutput),
+    mkIOKey(BeginInternalFormattedInput), mkIOKey(BeginExternalListOutput),
+    mkIOKey(BeginExternalListInput), mkIOKey(BeginExternalFormattedOutput),
+    mkIOKey(BeginExternalFormattedInput), mkIOKey(BeginUnformattedOutput),
+    mkIOKey(BeginUnformattedInput), mkIOKey(BeginAsynchronousOutput),
+    mkIOKey(BeginAsynchronousInput), mkIOKey(BeginWait), mkIOKey(BeginWaitAll),
+    mkIOKey(BeginClose), mkIOKey(BeginFlush), mkIOKey(BeginBackspace),
+    mkIOKey(BeginEndfile), mkIOKey(BeginRewind), mkIOKey(BeginOpenUnit),
+    mkIOKey(BeginOpenNewUnit), mkIOKey(BeginInquireUnit),
+    mkIOKey(BeginInquireFile), mkIOKey(BeginInquireIoLength),
+    mkIOKey(EnableHandlers), mkIOKey(SetAdvance), mkIOKey(SetBlank),
+    mkIOKey(SetDecimal), mkIOKey(SetDelim), mkIOKey(SetPad), mkIOKey(SetPos),
+    mkIOKey(SetRec), mkIOKey(SetRound), mkIOKey(SetSign),
+    mkIOKey(OutputNamelist), mkIOKey(InputNamelist), mkIOKey(OutputDescriptor),
+    mkIOKey(InputDescriptor), mkIOKey(OutputUnformattedBlock),
+    mkIOKey(InputUnformattedBlock), mkIOKey(OutputInteger8),
+    mkIOKey(OutputInteger16), mkIOKey(OutputInteger32),
+    mkIOKey(OutputInteger64),
+#ifdef __SIZEOF_INT128__
+    mkIOKey(OutputInteger128),
+#endif
+    mkIOKey(InputInteger), mkIOKey(OutputReal32), mkIOKey(InputReal32),
+    mkIOKey(OutputReal64), mkIOKey(InputReal64), mkIOKey(OutputComplex32),
+    mkIOKey(InputComplex32), mkIOKey(OutputComplex64), mkIOKey(InputComplex64),
+    mkIOKey(OutputAscii), mkIOKey(InputAscii), mkIOKey(OutputLogical),
+    mkIOKey(InputLogical), mkIOKey(SetAccess), mkIOKey(SetAction),
+    mkIOKey(SetAsynchronous), mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding),
+    mkIOKey(SetForm), mkIOKey(SetPosition), mkIOKey(SetRecl),
+    mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize),
+    mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter),
+    mkIOKey(InquireLogical), mkIOKey(InquirePendingId),
+    mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)>
+    newIOTable;
+} // namespace Fortran::lower
+
+namespace {
+/// IO statements may require exceptional condition handling.  A statement that
+/// encounters an exceptional condition may branch to a label given on an ERR
+/// (error), END (end-of-file), or EOR (end-of-record) specifier.  An IOSTAT
+/// specifier variable may be set to a value that indicates some condition,
+/// and an IOMSG specifier variable may be set to a description of a condition.
+struct ConditionSpecInfo {
+  const Fortran::lower::SomeExpr *ioStatExpr{};
+  const Fortran::lower::SomeExpr *ioMsgExpr{};
+  bool hasErr{};
+  bool hasEnd{};
+  bool hasEor{};
+
+  /// Check for any condition specifier that applies to specifier processing.
+  bool hasErrorConditionSpec() const { return ioStatExpr != nullptr || hasErr; }
+
+  /// Check for any condition specifier that applies to data transfer items
+  /// in a PRINT, READ, WRITE, or WAIT statement.  (WAIT may be irrelevant.)
+  bool hasTransferConditionSpec() const {
+    return hasErrorConditionSpec() || hasEnd || hasEor;
+  }
+
+  /// Check for any condition specifier, including IOMSG.
+  bool hasAnyConditionSpec() const {
+    return hasTransferConditionSpec() || ioMsgExpr != nullptr;
+  }
+};
+} // namespace
+
+template <typename D>
+static void genIoLoop(Fortran::lower::AbstractConverter &converter,
+                      mlir::Value cookie, const D &ioImpliedDo,
+                      bool isFormatted, bool checkResult, mlir::Value &ok,
+                      bool inLoop, Fortran::lower::StatementContext &stmtCtx);
+
+/// Helper function to retrieve the name of the IO function given the key `A`
+template <typename A>
+static constexpr const char *getName() {
+  return std::get<A>(Fortran::lower::newIOTable).name;
+}
+
+/// Helper function to retrieve the type model signature builder of the IO
+/// function as defined by the key `A`
+template <typename A>
+static constexpr fir::runtime::FuncTypeBuilderFunc getTypeModel() {
+  return std::get<A>(Fortran::lower::newIOTable).getTypeModel();
+}
+
+/// Get (or generate) the MLIR FuncOp for a given IO runtime function.
+template <typename E>
+static mlir::FuncOp getIORuntimeFunc(mlir::Location loc,
+                                     fir::FirOpBuilder &builder) {
+  llvm::StringRef name = getName<E>();
+  mlir::FuncOp func = builder.getNamedFunction(name);
+  if (func)
+    return func;
+  auto funTy = getTypeModel<E>()(builder.getContext());
+  func = builder.createFunction(loc, name, funTy);
+  func->setAttr("fir.runtime", builder.getUnitAttr());
+  func->setAttr("fir.io", builder.getUnitAttr());
+  return func;
+}
+
+/// Generate calls to end an IO statement.  Return the IOSTAT value, if any.
+/// It is the caller's responsibility to generate branches on that value.
+static mlir::Value genEndIO(Fortran::lower::AbstractConverter &converter,
+                            mlir::Location loc, mlir::Value cookie,
+                            const ConditionSpecInfo &csi,
+                            Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  if (csi.ioMsgExpr) {
+    mlir::FuncOp getIoMsg = getIORuntimeFunc<mkIOKey(GetIoMsg)>(loc, builder);
+    fir::ExtendedValue ioMsgVar =
+        converter.genExprAddr(csi.ioMsgExpr, stmtCtx, loc);
+    builder.create<fir::CallOp>(
+        loc, getIoMsg,
+        mlir::ValueRange{
+            cookie,
+            builder.createConvert(loc, getIoMsg.getType().getInput(1),
+                                  fir::getBase(ioMsgVar)),
+            builder.createConvert(loc, getIoMsg.getType().getInput(2),
+                                  fir::getLen(ioMsgVar))});
+  }
+  mlir::FuncOp endIoStatement =
+      getIORuntimeFunc<mkIOKey(EndIoStatement)>(loc, builder);
+  auto call = builder.create<fir::CallOp>(loc, endIoStatement,
+                                          mlir::ValueRange{cookie});
+  if (csi.ioStatExpr) {
+    mlir::Value ioStatVar =
+        fir::getBase(converter.genExprAddr(csi.ioStatExpr, stmtCtx, loc));
+    mlir::Value ioStatResult = builder.createConvert(
+        loc, converter.genType(*csi.ioStatExpr), call.getResult(0));
+    builder.create<fir::StoreOp>(loc, ioStatResult, ioStatVar);
+  }
+  return csi.hasTransferConditionSpec() ? call.getResult(0) : mlir::Value{};
+}
+
+/// Make the next call in the IO statement conditional on runtime result `ok`.
+/// If a call returns `ok==false`, further suboperation calls for an IO
+/// statement will be skipped.  This may generate branch heavy, deeply nested
+/// conditionals for IO statements with a large number of suboperations.
+static void makeNextConditionalOn(fir::FirOpBuilder &builder,
+                                  mlir::Location loc, bool checkResult,
+                                  mlir::Value ok, bool inLoop = false) {
+  if (!checkResult || !ok)
+    // Either no IO calls need to be checked, or this will be the first call.
+    return;
+
+  // A previous IO call for a statement returned the bool `ok`.  If this call
+  // is in a fir.iterate_while loop, the result must be propagated up to the
+  // loop scope as an extra ifOp result. (The propagation is done in genIoLoop.)
+  mlir::TypeRange resTy;
+  if (inLoop)
+    resTy = builder.getI1Type();
+  auto ifOp = builder.create<fir::IfOp>(loc, resTy, ok,
+                                        /*withElseRegion=*/inLoop);
+  builder.setInsertionPointToStart(&ifOp.getThenRegion().front());
+}
+
+/// Retrieve or generate a runtime description of NAMELIST group `symbol`.
+/// The form of the description is defined in runtime header file namelist.h.
+/// Static descriptors are generated for global objects; local descriptors for
+/// local objects.  If all descriptors are static, the NamelistGroup is static.
+static mlir::Value
+getNamelistGroup(Fortran::lower::AbstractConverter &converter,
+                 const Fortran::semantics::Symbol &symbol,
+                 Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  std::string groupMangleName = converter.mangleName(symbol);
+  if (auto group = builder.getNamedGlobal(groupMangleName))
+    return builder.create<fir::AddrOfOp>(loc, group.resultType(),
+                                         group.getSymbol());
+
+  const auto &details =
+      symbol.GetUltimate().get<Fortran::semantics::NamelistDetails>();
+  mlir::MLIRContext *context = builder.getContext();
+  mlir::StringAttr linkOnce = builder.createLinkOnceLinkage();
+  mlir::IndexType idxTy = builder.getIndexType();
+  mlir::IntegerType sizeTy = builder.getIntegerType(8 * sizeof(std::size_t));
+  fir::ReferenceType charRefTy =
+      fir::ReferenceType::get(builder.getIntegerType(8));
+  fir::ReferenceType descRefTy =
+      fir::ReferenceType::get(fir::BoxType::get(mlir::NoneType::get(context)));
+  fir::SequenceType listTy = fir::SequenceType::get(
+      details.objects().size(),
+      mlir::TupleType::get(context, {charRefTy, descRefTy}));
+  mlir::TupleType groupTy = mlir::TupleType::get(
+      context, {charRefTy, sizeTy, fir::ReferenceType::get(listTy)});
+  auto stringAddress = [&](const Fortran::semantics::Symbol &symbol) {
+    return fir::factory::createStringLiteral(builder, loc,
+                                             symbol.name().ToString() + '\0');
+  };
+
+  // Define object names, and static descriptors for global objects.
+  bool groupIsLocal = false;
+  stringAddress(symbol);
+  for (const Fortran::semantics::Symbol &s : details.objects()) {
+    stringAddress(s);
+    if (!Fortran::lower::symbolIsGlobal(s)) {
+      groupIsLocal = true;
+      continue;
+    }
+    std::string mangleName = converter.mangleName(s) + ".desc";
+    if (builder.getNamedGlobal(mangleName))
+      continue;
+    const auto expr = Fortran::evaluate::AsGenericExpr(s);
+    fir::BoxType boxTy =
+        fir::BoxType::get(fir::PointerType::get(converter.genType(s)));
+    auto descFunc = [&](fir::FirOpBuilder &b) {
+      auto box =
+          Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr);
+      b.create<fir::HasValueOp>(loc, box);
+    };
+    builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce);
+  }
+
+  // Define the list of Items.
+  mlir::Value listAddr =
+      groupIsLocal ? builder.create<fir::AllocaOp>(loc, listTy) : mlir::Value{};
+  std::string listMangleName = groupMangleName + ".list";
+  auto listFunc = [&](fir::FirOpBuilder &builder) {
+    mlir::Value list = builder.create<fir::UndefOp>(loc, listTy);
+    mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0);
+    mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1);
+    llvm::SmallVector<mlir::Attribute, 2> idx = {mlir::Attribute{},
+                                                 mlir::Attribute{}};
+    size_t n = 0;
+    for (const Fortran::semantics::Symbol &s : details.objects()) {
+      idx[0] = builder.getIntegerAttr(idxTy, n);
+      idx[1] = zero;
+      mlir::Value nameAddr =
+          builder.createConvert(loc, charRefTy, fir::getBase(stringAddress(s)));
+      list = builder.create<fir::InsertValueOp>(loc, listTy, list, nameAddr,
+                                                builder.getArrayAttr(idx));
+      idx[1] = one;
+      mlir::Value descAddr;
+      if (auto desc =
+              builder.getNamedGlobal(converter.mangleName(s) + ".desc")) {
+        descAddr = builder.create<fir::AddrOfOp>(loc, desc.resultType(),
+                                                 desc.getSymbol());
+      } else {
+        const auto expr = Fortran::evaluate::AsGenericExpr(s);
+        fir::ExtendedValue exv = converter.genExprAddr(*expr, stmtCtx);
+        mlir::Type type = fir::getBase(exv).getType();
+        if (mlir::Type baseTy = fir::dyn_cast_ptrOrBoxEleTy(type))
+          type = baseTy;
+        fir::BoxType boxType = fir::BoxType::get(fir::PointerType::get(type));
+        descAddr = builder.createTemporary(loc, boxType);
+        fir::MutableBoxValue box = fir::MutableBoxValue(descAddr, {}, {});
+        fir::factory::associateMutableBox(builder, loc, box, exv,
+                                          /*lbounds=*/llvm::None);
+      }
+      descAddr = builder.createConvert(loc, descRefTy, descAddr);
+      list = builder.create<fir::InsertValueOp>(loc, listTy, list, descAddr,
+                                                builder.getArrayAttr(idx));
+      ++n;
+    }
+    if (groupIsLocal)
+      builder.create<fir::StoreOp>(loc, list, listAddr);
+    else
+      builder.create<fir::HasValueOp>(loc, list);
+  };
+  if (groupIsLocal)
+    listFunc(builder);
+  else
+    builder.createGlobalConstant(loc, listTy, listMangleName, listFunc,
+                                 linkOnce);
+
+  // Define the group.
+  mlir::Value groupAddr = groupIsLocal
+                              ? builder.create<fir::AllocaOp>(loc, groupTy)
+                              : mlir::Value{};
+  auto groupFunc = [&](fir::FirOpBuilder &builder) {
+    mlir::IntegerAttr zero = builder.getIntegerAttr(idxTy, 0);
+    mlir::IntegerAttr one = builder.getIntegerAttr(idxTy, 1);
+    mlir::IntegerAttr two = builder.getIntegerAttr(idxTy, 2);
+    mlir::Value group = builder.create<fir::UndefOp>(loc, groupTy);
+    mlir::Value nameAddr = builder.createConvert(
+        loc, charRefTy, fir::getBase(stringAddress(symbol)));
+    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, nameAddr,
+                                               builder.getArrayAttr(zero));
+    mlir::Value itemCount =
+        builder.createIntegerConstant(loc, sizeTy, details.objects().size());
+    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, itemCount,
+                                               builder.getArrayAttr(one));
+    if (fir::GlobalOp list = builder.getNamedGlobal(listMangleName))
+      listAddr = builder.create<fir::AddrOfOp>(loc, list.resultType(),
+                                               list.getSymbol());
+    assert(listAddr && "missing namelist object list");
+    group = builder.create<fir::InsertValueOp>(loc, groupTy, group, listAddr,
+                                               builder.getArrayAttr(two));
+    if (groupIsLocal)
+      builder.create<fir::StoreOp>(loc, group, groupAddr);
+    else
+      builder.create<fir::HasValueOp>(loc, group);
+  };
+  if (groupIsLocal) {
+    groupFunc(builder);
+  } else {
+    fir::GlobalOp group =
+        builder.createGlobal(loc, groupTy, groupMangleName,
+                             /*isConst=*/true, groupFunc, linkOnce);
+    groupAddr = builder.create<fir::AddrOfOp>(loc, group.resultType(),
+                                              group.getSymbol());
+  }
+  assert(groupAddr && "missing namelist group result");
+  return groupAddr;
+}
+
+/// Generate a namelist IO call.
+static void genNamelistIO(Fortran::lower::AbstractConverter &converter,
+                          mlir::Value cookie, mlir::FuncOp funcOp,
+                          Fortran::semantics::Symbol &symbol, bool checkResult,
+                          mlir::Value &ok,
+                          Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  makeNextConditionalOn(builder, loc, checkResult, ok);
+  mlir::Type argType = funcOp.getType().getInput(1);
+  mlir::Value groupAddr = getNamelistGroup(converter, symbol, stmtCtx);
+  groupAddr = builder.createConvert(loc, argType, groupAddr);
+  llvm::SmallVector<mlir::Value> args = {cookie, groupAddr};
+  ok = builder.create<fir::CallOp>(loc, funcOp, args).getResult(0);
+}
+
+/// Get the output function to call for a value of the given type.
+static mlir::FuncOp getOutputFunc(mlir::Location loc,
+                                  fir::FirOpBuilder &builder, mlir::Type type,
+                                  bool isFormatted) {
+  if (!isFormatted)
+    return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
+  if (auto ty = type.dyn_cast<mlir::IntegerType>()) {
+    switch (ty.getWidth()) {
+    case 1:
+      return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
+    case 8:
+      return getIORuntimeFunc<mkIOKey(OutputInteger8)>(loc, builder);
+    case 16:
+      return getIORuntimeFunc<mkIOKey(OutputInteger16)>(loc, builder);
+    case 32:
+      return getIORuntimeFunc<mkIOKey(OutputInteger32)>(loc, builder);
+    case 64:
+      return getIORuntimeFunc<mkIOKey(OutputInteger64)>(loc, builder);
+#ifdef __SIZEOF_INT128__
+    case 128:
+      return getIORuntimeFunc<mkIOKey(OutputInteger128)>(loc, builder);
+#endif
+    }
+    llvm_unreachable("unknown OutputInteger kind");
+  }
+  if (auto ty = type.dyn_cast<mlir::FloatType>()) {
+    if (auto width = ty.getWidth(); width == 32)
+      return getIORuntimeFunc<mkIOKey(OutputReal32)>(loc, builder);
+    else if (width == 64)
+      return getIORuntimeFunc<mkIOKey(OutputReal64)>(loc, builder);
+  }
+  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
+    if (auto kind = ty.getFKind(); kind == 4)
+      return getIORuntimeFunc<mkIOKey(OutputComplex32)>(loc, builder);
+    else if (kind == 8)
+      return getIORuntimeFunc<mkIOKey(OutputComplex64)>(loc, builder);
+  }
+  if (type.isa<fir::LogicalType>())
+    return getIORuntimeFunc<mkIOKey(OutputLogical)>(loc, builder);
+  if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
+    return getIORuntimeFunc<mkIOKey(OutputAscii)>(loc, builder);
+  return getIORuntimeFunc<mkIOKey(OutputDescriptor)>(loc, builder);
+}
+
+/// Generate a sequence of output data transfer calls.
+static void
+genOutputItemList(Fortran::lower::AbstractConverter &converter,
+                  mlir::Value cookie,
+                  const std::list<Fortran::parser::OutputItem> &items,
+                  bool isFormatted, bool checkResult, mlir::Value &ok,
+                  bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  for (const Fortran::parser::OutputItem &item : items) {
+    if (const auto &impliedDo = std::get_if<1>(&item.u)) {
+      genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
+                ok, inLoop, stmtCtx);
+      continue;
+    }
+    auto &pExpr = std::get<Fortran::parser::Expr>(item.u);
+    mlir::Location loc = converter.genLocation(pExpr.source);
+    makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
+
+    const auto *expr = Fortran::semantics::GetExpr(pExpr);
+    if (!expr)
+      fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
+    mlir::Type itemTy = converter.genType(*expr);
+    mlir::FuncOp outputFunc = getOutputFunc(loc, builder, itemTy, isFormatted);
+    mlir::Type argType = outputFunc.getType().getInput(1);
+    assert((isFormatted || argType.isa<fir::BoxType>()) &&
+           "expect descriptor for unformatted IO runtime");
+    llvm::SmallVector<mlir::Value> outputFuncArgs = {cookie};
+    fir::factory::CharacterExprHelper helper{builder, loc};
+    if (argType.isa<fir::BoxType>()) {
+      mlir::Value box = fir::getBase(converter.genExprBox(*expr, stmtCtx, loc));
+      outputFuncArgs.push_back(builder.createConvert(loc, argType, box));
+    } else if (helper.isCharacterScalar(itemTy)) {
+      fir::ExtendedValue exv = converter.genExprAddr(expr, stmtCtx, loc);
+      // scalar allocatable/pointer may also get here, not clear if
+      // genExprAddr will lower them as CharBoxValue or BoxValue.
+      if (!exv.getCharBox())
+        llvm::report_fatal_error(
+            "internal error: scalar character not in CharBox");
+      outputFuncArgs.push_back(builder.createConvert(
+          loc, outputFunc.getType().getInput(1), fir::getBase(exv)));
+      outputFuncArgs.push_back(builder.createConvert(
+          loc, outputFunc.getType().getInput(2), fir::getLen(exv)));
+    } else {
+      fir::ExtendedValue itemBox = converter.genExprValue(expr, stmtCtx, loc);
+      mlir::Value itemValue = fir::getBase(itemBox);
+      if (fir::isa_complex(itemTy)) {
+        auto parts =
+            fir::factory::Complex{builder, loc}.extractParts(itemValue);
+        outputFuncArgs.push_back(parts.first);
+        outputFuncArgs.push_back(parts.second);
+      } else {
+        itemValue = builder.createConvert(loc, argType, itemValue);
+        outputFuncArgs.push_back(itemValue);
+      }
+    }
+    ok = builder.create<fir::CallOp>(loc, outputFunc, outputFuncArgs)
+             .getResult(0);
+  }
+}
+
+/// Get the input function to call for a value of the given type.
+static mlir::FuncOp getInputFunc(mlir::Location loc, fir::FirOpBuilder &builder,
+                                 mlir::Type type, bool isFormatted) {
+  if (!isFormatted)
+    return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
+  if (auto ty = type.dyn_cast<mlir::IntegerType>())
+    return ty.getWidth() == 1
+               ? getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder)
+               : getIORuntimeFunc<mkIOKey(InputInteger)>(loc, builder);
+  if (auto ty = type.dyn_cast<mlir::FloatType>()) {
+    if (auto width = ty.getWidth(); width <= 32)
+      return getIORuntimeFunc<mkIOKey(InputReal32)>(loc, builder);
+    else if (width <= 64)
+      return getIORuntimeFunc<mkIOKey(InputReal64)>(loc, builder);
+  }
+  if (auto ty = type.dyn_cast<fir::ComplexType>()) {
+    if (auto kind = ty.getFKind(); kind <= 4)
+      return getIORuntimeFunc<mkIOKey(InputComplex32)>(loc, builder);
+    else if (kind <= 8)
+      return getIORuntimeFunc<mkIOKey(InputComplex64)>(loc, builder);
+  }
+  if (type.isa<fir::LogicalType>())
+    return getIORuntimeFunc<mkIOKey(InputLogical)>(loc, builder);
+  if (fir::factory::CharacterExprHelper::isCharacterScalar(type))
+    return getIORuntimeFunc<mkIOKey(InputAscii)>(loc, builder);
+  return getIORuntimeFunc<mkIOKey(InputDescriptor)>(loc, builder);
+}
+
+static mlir::Value createIoRuntimeCallForItem(mlir::Location loc,
+                                              fir::FirOpBuilder &builder,
+                                              mlir::FuncOp inputFunc,
+                                              mlir::Value cookie,
+                                              const fir::ExtendedValue &item) {
+  mlir::Type argType = inputFunc.getType().getInput(1);
+  llvm::SmallVector<mlir::Value> inputFuncArgs = {cookie};
+  if (argType.isa<fir::BoxType>()) {
+    mlir::Value box = fir::getBase(item);
+    assert(box.getType().isa<fir::BoxType>() && "must be previously emboxed");
+    inputFuncArgs.push_back(builder.createConvert(loc, argType, box));
+  } else {
+    mlir::Value itemAddr = fir::getBase(item);
+    mlir::Type itemTy = fir::unwrapPassByRefType(itemAddr.getType());
+    inputFuncArgs.push_back(builder.createConvert(loc, argType, itemAddr));
+    fir::factory::CharacterExprHelper charHelper{builder, loc};
+    if (charHelper.isCharacterScalar(itemTy)) {
+      mlir::Value len = fir::getLen(item);
+      inputFuncArgs.push_back(
+          builder.createConvert(loc, inputFunc.getType().getInput(2), len));
+    } else if (itemTy.isa<mlir::IntegerType>()) {
+      inputFuncArgs.push_back(builder.create<mlir::arith::ConstantOp>(
+          loc, builder.getI32IntegerAttr(
+                   itemTy.cast<mlir::IntegerType>().getWidth() / 8)));
+    }
+  }
+  return builder.create<fir::CallOp>(loc, inputFunc, inputFuncArgs)
+      .getResult(0);
+}
+
+/// Generate a sequence of input data transfer calls.
+static void genInputItemList(Fortran::lower::AbstractConverter &converter,
+                             mlir::Value cookie,
+                             const std::list<Fortran::parser::InputItem> &items,
+                             bool isFormatted, bool checkResult,
+                             mlir::Value &ok, bool inLoop,
+                             Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  for (const Fortran::parser::InputItem &item : items) {
+    if (const auto &impliedDo = std::get_if<1>(&item.u)) {
+      genIoLoop(converter, cookie, impliedDo->value(), isFormatted, checkResult,
+                ok, inLoop, stmtCtx);
+      continue;
+    }
+    auto &pVar = std::get<Fortran::parser::Variable>(item.u);
+    mlir::Location loc = converter.genLocation(pVar.GetSource());
+    makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
+    const auto *expr = Fortran::semantics::GetExpr(pVar);
+    if (!expr)
+      fir::emitFatalError(loc, "internal error: could not get evaluate::Expr");
+    if (Fortran::evaluate::HasVectorSubscript(*expr)) {
+      TODO(loc, "genInputItemList with VectorSubscript");
+    }
+    mlir::Type itemTy = converter.genType(*expr);
+    mlir::FuncOp inputFunc = getInputFunc(loc, builder, itemTy, isFormatted);
+    auto itemExv = inputFunc.getType().getInput(1).isa<fir::BoxType>()
+                       ? converter.genExprBox(*expr, stmtCtx, loc)
+                       : converter.genExprAddr(expr, stmtCtx, loc);
+    ok = createIoRuntimeCallForItem(loc, builder, inputFunc, cookie, itemExv);
+  }
+}
+
+/// Generate an io-implied-do loop.
+template <typename D>
+static void genIoLoop(Fortran::lower::AbstractConverter &converter,
+                      mlir::Value cookie, const D &ioImpliedDo,
+                      bool isFormatted, bool checkResult, mlir::Value &ok,
+                      bool inLoop, Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Location loc = converter.getCurrentLocation();
+  makeNextConditionalOn(builder, loc, checkResult, ok, inLoop);
+  const auto &itemList = std::get<0>(ioImpliedDo.t);
+  const auto &control = std::get<1>(ioImpliedDo.t);
+  const auto &loopSym = *control.name.thing.thing.symbol;
+  mlir::Value loopVar = converter.getSymbolAddress(loopSym);
+  auto genControlValue = [&](const Fortran::parser::ScalarIntExpr &expr) {
+    mlir::Value v = fir::getBase(
+        converter.genExprValue(*Fortran::semantics::GetExpr(expr), stmtCtx));
+    return builder.createConvert(loc, builder.getIndexType(), v);
+  };
+  mlir::Value lowerValue = genControlValue(control.lower);
+  mlir::Value upperValue = genControlValue(control.upper);
+  mlir::Value stepValue =
+      control.step.has_value()
+          ? genControlValue(*control.step)
+          : builder.create<mlir::arith::ConstantIndexOp>(loc, 1);
+  auto genItemList = [&](const D &ioImpliedDo) {
+    Fortran::lower::StatementContext loopCtx;
+    if constexpr (std::is_same_v<D, Fortran::parser::InputImpliedDo>)
+      genInputItemList(converter, cookie, itemList, isFormatted, checkResult,
+                       ok, /*inLoop=*/true, loopCtx);
+    else
+      genOutputItemList(converter, cookie, itemList, isFormatted, checkResult,
+                        ok, /*inLoop=*/true, loopCtx);
+  };
+  if (!checkResult) {
+    // No IO call result checks - the loop is a fir.do_loop op.
+    auto doLoopOp = builder.create<fir::DoLoopOp>(
+        loc, lowerValue, upperValue, stepValue, /*unordered=*/false,
+        /*finalCountValue=*/true);
+    builder.setInsertionPointToStart(doLoopOp.getBody());
+    mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
+                                            doLoopOp.getInductionVar());
+    builder.create<fir::StoreOp>(loc, lcv, loopVar);
+    genItemList(ioImpliedDo);
+    builder.setInsertionPointToEnd(doLoopOp.getBody());
+    mlir::Value result = builder.create<mlir::arith::AddIOp>(
+        loc, doLoopOp.getInductionVar(), doLoopOp.getStep());
+    builder.create<fir::ResultOp>(loc, result);
+    builder.setInsertionPointAfter(doLoopOp);
+    // The loop control variable may be used after the loop.
+    lcv = builder.createConvert(loc, converter.genType(loopSym),
+                                doLoopOp.getResult(0));
+    builder.create<fir::StoreOp>(loc, lcv, loopVar);
+    return;
+  }
+  // Check IO call results - the loop is a fir.iterate_while op.
+  if (!ok)
+    ok = builder.createBool(loc, true);
+  auto iterWhileOp = builder.create<fir::IterWhileOp>(
+      loc, lowerValue, upperValue, stepValue, ok, /*finalCountValue*/ true);
+  builder.setInsertionPointToStart(iterWhileOp.getBody());
+  mlir::Value lcv = builder.createConvert(loc, converter.genType(loopSym),
+                                          iterWhileOp.getInductionVar());
+  builder.create<fir::StoreOp>(loc, lcv, loopVar);
+  ok = iterWhileOp.getIterateVar();
+  mlir::Value falseValue =
+      builder.createIntegerConstant(loc, builder.getI1Type(), 0);
+  genItemList(ioImpliedDo);
+  // Unwind nested IO call scopes, filling in true and false ResultOp's.
+  for (mlir::Operation *op = builder.getBlock()->getParentOp();
+       isa<fir::IfOp>(op); op = op->getBlock()->getParentOp()) {
+    auto ifOp = dyn_cast<fir::IfOp>(op);
+    mlir::Operation *lastOp = &ifOp.getThenRegion().front().back();
+    builder.setInsertionPointAfter(lastOp);
+    // The primary ifOp result is the result of an IO call or loop.
+    if (mlir::isa<fir::CallOp, fir::IfOp>(*lastOp))
+      builder.create<fir::ResultOp>(loc, lastOp->getResult(0));
+    else
+      builder.create<fir::ResultOp>(loc, ok); // loop result
+    // The else branch propagates an early exit false result.
+    builder.setInsertionPointToStart(&ifOp.getElseRegion().front());
+    builder.create<fir::ResultOp>(loc, falseValue);
+  }
+  builder.setInsertionPointToEnd(iterWhileOp.getBody());
+  mlir::OpResult iterateResult = builder.getBlock()->back().getResult(0);
+  mlir::Value inductionResult0 = iterWhileOp.getInductionVar();
+  auto inductionResult1 = builder.create<mlir::arith::AddIOp>(
+      loc, inductionResult0, iterWhileOp.getStep());
+  auto inductionResult = builder.create<mlir::arith::SelectOp>(
+      loc, iterateResult, inductionResult1, inductionResult0);
+  llvm::SmallVector<mlir::Value> results = {inductionResult, iterateResult};
+  builder.create<fir::ResultOp>(loc, results);
+  ok = iterWhileOp.getResult(1);
+  builder.setInsertionPointAfter(iterWhileOp);
+  // The loop control variable may be used after the loop.
+  lcv = builder.createConvert(loc, converter.genType(loopSym),
+                              iterWhileOp.getResult(0));
+  builder.create<fir::StoreOp>(loc, lcv, loopVar);
+}
+
+//===----------------------------------------------------------------------===//
+// Default argument generation.
+//===----------------------------------------------------------------------===//
+
+static mlir::Value locToFilename(Fortran::lower::AbstractConverter &converter,
+                                 mlir::Location loc, mlir::Type toType) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  return builder.createConvert(loc, toType,
+                               fir::factory::locationToFilename(builder, loc));
+}
+
+static mlir::Value locToLineNo(Fortran::lower::AbstractConverter &converter,
+                               mlir::Location loc, mlir::Type toType) {
+  return fir::factory::locationToLineNo(converter.getFirOpBuilder(), loc,
+                                        toType);
+}
+
+static mlir::Value getDefaultScratch(fir::FirOpBuilder &builder,
+                                     mlir::Location loc, mlir::Type toType) {
+  mlir::Value null = builder.create<mlir::arith::ConstantOp>(
+      loc, builder.getI64IntegerAttr(0));
+  return builder.createConvert(loc, toType, null);
+}
+
+static mlir::Value getDefaultScratchLen(fir::FirOpBuilder &builder,
+                                        mlir::Location loc, mlir::Type toType) {
+  return builder.create<mlir::arith::ConstantOp>(
+      loc, builder.getIntegerAttr(toType, 0));
+}
+
+/// Generate a reference to a buffer and the length of buffer given
+/// a character expression. An array expression will be cast to scalar
+/// character as long as they are contiguous.
+static std::tuple<mlir::Value, mlir::Value>
+genBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+          const Fortran::lower::SomeExpr &expr, mlir::Type strTy,
+          mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  fir::ExtendedValue exprAddr = converter.genExprAddr(expr, stmtCtx);
+  fir::factory::CharacterExprHelper helper(builder, loc);
+  using ValuePair = std::pair<mlir::Value, mlir::Value>;
+  auto [buff, len] = exprAddr.match(
+      [&](const fir::CharBoxValue &x) -> ValuePair {
+        return {x.getBuffer(), x.getLen()};
+      },
+      [&](const fir::CharArrayBoxValue &x) -> ValuePair {
+        fir::CharBoxValue scalar = helper.toScalarCharacter(x);
+        return {scalar.getBuffer(), scalar.getLen()};
+      },
+      [&](const fir::BoxValue &) -> ValuePair {
+        // May need to copy before after IO to handle contiguous
+        // aspect. Not sure descriptor can get here though.
+        TODO(loc, "character descriptor to contiguous buffer");
+      },
+      [&](const auto &) -> ValuePair {
+        llvm::report_fatal_error(
+            "internal error: IO buffer is not a character");
+      });
+  buff = builder.createConvert(loc, strTy, buff);
+  len = builder.createConvert(loc, lenTy, len);
+  return {buff, len};
+}
+
+/// Lower a string literal. Many arguments to the runtime are conveyed as
+/// Fortran CHARACTER literals.
+template <typename A>
+static std::tuple<mlir::Value, mlir::Value, mlir::Value>
+lowerStringLit(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+               Fortran::lower::StatementContext &stmtCtx, const A &syntax,
+               mlir::Type strTy, mlir::Type lenTy, mlir::Type ty2 = {}) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  auto *expr = Fortran::semantics::GetExpr(syntax);
+  if (!expr)
+    fir::emitFatalError(loc, "internal error: null semantic expr in IO");
+  auto [buff, len] = genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx);
+  mlir::Value kind;
+  if (ty2) {
+    auto kindVal = expr->GetType().value().kind();
+    kind = builder.create<mlir::arith::ConstantOp>(
+        loc, builder.getIntegerAttr(ty2, kindVal));
+  }
+  return {buff, len, kind};
+}
+
+/// Pass the body of the FORMAT statement in as if it were a CHARACTER literal
+/// constant. NB: This is the prescribed manner in which the front-end passes
+/// this information to lowering.
+static std::tuple<mlir::Value, mlir::Value, mlir::Value>
+lowerSourceTextAsStringLit(Fortran::lower::AbstractConverter &converter,
+                           mlir::Location loc, llvm::StringRef text,
+                           mlir::Type strTy, mlir::Type lenTy) {
+  text = text.drop_front(text.find('('));
+  text = text.take_front(text.rfind(')') + 1);
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Value addrGlobalStringLit =
+      fir::getBase(fir::factory::createStringLiteral(builder, loc, text));
+  mlir::Value buff = builder.createConvert(loc, strTy, addrGlobalStringLit);
+  mlir::Value len = builder.createIntegerConstant(loc, lenTy, text.size());
+  return {buff, len, mlir::Value{}};
+}
+
+//===----------------------------------------------------------------------===//
+// Handle IO statement specifiers.
+// These are threaded together for a single statement via the passed cookie.
+//===----------------------------------------------------------------------===//
+
+/// Generic to build an integral argument to the runtime.
+template <typename A, typename B>
+mlir::Value genIntIOOption(Fortran::lower::AbstractConverter &converter,
+                           mlir::Location loc, mlir::Value cookie,
+                           const B &spec) {
+  Fortran::lower::StatementContext localStatementCtx;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  mlir::Value expr = fir::getBase(converter.genExprValue(
+      Fortran::semantics::GetExpr(spec.v), localStatementCtx, loc));
+  mlir::Value val = builder.createConvert(loc, ioFuncTy.getInput(1), expr);
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie, val};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+/// Generic to build a string argument to the runtime. This passes a CHARACTER
+/// as a pointer to the buffer and a LEN parameter.
+template <typename A, typename B>
+mlir::Value genCharIOOption(Fortran::lower::AbstractConverter &converter,
+                            mlir::Location loc, mlir::Value cookie,
+                            const B &spec) {
+  Fortran::lower::StatementContext localStatementCtx;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp ioFunc = getIORuntimeFunc<A>(loc, builder);
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
+      lowerStringLit(converter, loc, localStatementCtx, spec,
+                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
+                                           std::get<1>(tup)};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+template <typename A>
+mlir::Value genIOOption(Fortran::lower::AbstractConverter &converter,
+                        mlir::Location loc, mlir::Value cookie, const A &spec) {
+  // These specifiers are processed in advance elsewhere - skip them here.
+  using PreprocessedSpecs =
+      std::tuple<Fortran::parser::EndLabel, Fortran::parser::EorLabel,
+                 Fortran::parser::ErrLabel, Fortran::parser::FileUnitNumber,
+                 Fortran::parser::Format, Fortran::parser::IoUnit,
+                 Fortran::parser::MsgVariable, Fortran::parser::Name,
+                 Fortran::parser::StatVariable>;
+  static_assert(Fortran::common::HasMember<A, PreprocessedSpecs>,
+                "missing genIOOPtion specialization");
+  return {};
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::FileNameExpr>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::FileNameExpr &spec) {
+  Fortran::lower::StatementContext localStatementCtx;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  // has an extra KIND argument
+  mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(SetFile)>(loc, builder);
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
+      lowerStringLit(converter, loc, localStatementCtx, spec,
+                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
+  llvm::SmallVector<mlir::Value> ioArgs{cookie, std::get<0>(tup),
+                                        std::get<1>(tup)};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::ConnectSpec::CharExpr &spec) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp ioFunc;
+  switch (std::get<Fortran::parser::ConnectSpec::CharExpr::Kind>(spec.t)) {
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Access:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetAccess)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Action:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetAction)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Asynchronous:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetAsynchronous)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Blank:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Decimal:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Delim:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Encoding:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetEncoding)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Form:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Position:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetPosition)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Round:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Sign:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Carriagecontrol:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetCarriagecontrol)>(loc, builder);
+    break;
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Convert:
+    TODO(loc, "CONVERT not part of the runtime::io interface");
+  case Fortran::parser::ConnectSpec::CharExpr::Kind::Dispose:
+    TODO(loc, "DISPOSE not part of the runtime::io interface");
+  }
+  Fortran::lower::StatementContext localStatementCtx;
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
+      lowerStringLit(converter, loc, localStatementCtx,
+                     std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t),
+                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
+                                           std::get<1>(tup)};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::ConnectSpec::Recl>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::ConnectSpec::Recl &spec) {
+  return genIntIOOption<mkIOKey(SetRecl)>(converter, loc, cookie, spec);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::ConnectSpec::Newunit>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::ConnectSpec::Newunit &spec) {
+  Fortran::lower::StatementContext stmtCtx;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetNewUnit)>(loc, builder);
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  const auto *var = Fortran::semantics::GetExpr(spec);
+  mlir::Value addr = builder.createConvert(
+      loc, ioFuncTy.getInput(1),
+      fir::getBase(converter.genExprAddr(var, stmtCtx, loc)));
+  auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2),
+                                            var->GetType().value().kind());
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie, addr, kind};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::StatusExpr>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::StatusExpr &spec) {
+  return genCharIOOption<mkIOKey(SetStatus)>(converter, loc, cookie, spec.v);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::IoControlSpec::CharExpr &spec) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp ioFunc;
+  switch (std::get<Fortran::parser::IoControlSpec::CharExpr::Kind>(spec.t)) {
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Advance:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetAdvance)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Blank:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetBlank)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Decimal:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetDecimal)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Round:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetRound)>(loc, builder);
+    break;
+  case Fortran::parser::IoControlSpec::CharExpr::Kind::Sign:
+    ioFunc = getIORuntimeFunc<mkIOKey(SetSign)>(loc, builder);
+    break;
+  }
+  Fortran::lower::StatementContext localStatementCtx;
+  mlir::FunctionType ioFuncTy = ioFunc.getType();
+  std::tuple<mlir::Value, mlir::Value, mlir::Value> tup =
+      lowerStringLit(converter, loc, localStatementCtx,
+                     std::get<Fortran::parser::ScalarDefaultCharExpr>(spec.t),
+                     ioFuncTy.getInput(1), ioFuncTy.getInput(2));
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie, std::get<0>(tup),
+                                           std::get<1>(tup)};
+  return builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::IoControlSpec::Asynchronous>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie,
+    const Fortran::parser::IoControlSpec::Asynchronous &spec) {
+  return genCharIOOption<mkIOKey(SetAsynchronous)>(converter, loc, cookie,
+                                                   spec.v);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::IdVariable>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::IdVariable &spec) {
+  TODO(loc, "asynchronous ID not implemented");
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::IoControlSpec::Pos>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::IoControlSpec::Pos &spec) {
+  return genIntIOOption<mkIOKey(SetPos)>(converter, loc, cookie, spec);
+}
+
+template <>
+mlir::Value genIOOption<Fortran::parser::IoControlSpec::Rec>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    mlir::Value cookie, const Fortran::parser::IoControlSpec::Rec &spec) {
+  return genIntIOOption<mkIOKey(SetRec)>(converter, loc, cookie, spec);
+}
+
+/// Generate runtime call to query the read size after an input statement if
+/// the statement has SIZE control-spec.
+template <typename A>
+static void genIOReadSize(Fortran::lower::AbstractConverter &converter,
+                          mlir::Location loc, mlir::Value cookie,
+                          const A &specList, bool checkResult) {
+  // This call is not conditional on the current IO status (ok) because the size
+  // needs to be filled even if some error condition (end-of-file...) was met
+  // during the input statement (in which case the runtime may return zero for
+  // the size read).
+  for (const auto &spec : specList)
+    if (const auto *size =
+            std::get_if<Fortran::parser::IoControlSpec::Size>(&spec.u)) {
+
+      fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+      mlir::FuncOp ioFunc = getIORuntimeFunc<mkIOKey(GetSize)>(loc, builder);
+      auto sizeValue =
+          builder.create<fir::CallOp>(loc, ioFunc, mlir::ValueRange{cookie})
+              .getResult(0);
+      Fortran::lower::StatementContext localStatementCtx;
+      fir::ExtendedValue var = converter.genExprAddr(
+          Fortran::semantics::GetExpr(size->v), localStatementCtx, loc);
+      mlir::Value varAddr = fir::getBase(var);
+      mlir::Type varType = fir::unwrapPassByRefType(varAddr.getType());
+      mlir::Value sizeCast = builder.createConvert(loc, varType, sizeValue);
+      builder.create<fir::StoreOp>(loc, sizeCast, varAddr);
+      break;
+    }
+}
+
+//===----------------------------------------------------------------------===//
+// Gather IO statement condition specifier information (if any).
+//===----------------------------------------------------------------------===//
+
+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;
+}
+
+/// 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);
+    ok = std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::parser::IoControlSpec::Size &x) -> mlir::Value {
+              // Size must be queried after the related READ runtime calls, not
+              // before.
+              return ok;
+            },
+            [&](const auto &x) {
+              return genIOOption(converter, loc, cookie, x);
+            }},
+        spec.u);
+  }
+}
+
+/// Most IO statements allow one or more of five optional exception condition
+/// handling specifiers: ERR, EOR, END, IOSTAT, and IOMSG. The first three
+/// cause control flow to transfer to another statement. The final two return
+/// information from the runtime, via a variable, about the nature of the
+/// condition that occurred. These condition specifiers are handled here.
+template <typename A>
+static void
+genConditionHandlerCall(Fortran::lower::AbstractConverter &converter,
+                        mlir::Location loc, mlir::Value cookie,
+                        const A &specList, ConditionSpecInfo &csi) {
+  for (const auto &spec : specList) {
+    std::visit(
+        Fortran::common::visitors{
+            [&](const Fortran::parser::StatVariable &var) {
+              csi.ioStatExpr = Fortran::semantics::GetExpr(var);
+            },
+            [&](const Fortran::parser::InquireSpec::IntVar &var) {
+              if (std::get<Fortran::parser::InquireSpec::IntVar::Kind>(var.t) ==
+                  Fortran::parser::InquireSpec::IntVar::Kind::Iostat)
+                csi.ioStatExpr = Fortran::semantics::GetExpr(
+                    std::get<Fortran::parser::ScalarIntVariable>(var.t));
+            },
+            [&](const Fortran::parser::MsgVariable &var) {
+              csi.ioMsgExpr = Fortran::semantics::GetExpr(var);
+            },
+            [&](const Fortran::parser::InquireSpec::CharVar &var) {
+              if (std::get<Fortran::parser::InquireSpec::CharVar::Kind>(
+                      var.t) ==
+                  Fortran::parser::InquireSpec::CharVar::Kind::Iomsg)
+                csi.ioMsgExpr = Fortran::semantics::GetExpr(
+                    std::get<Fortran::parser::ScalarDefaultCharVariable>(
+                        var.t));
+            },
+            [&](const Fortran::parser::EndLabel &) { csi.hasEnd = true; },
+            [&](const Fortran::parser::EorLabel &) { csi.hasEor = true; },
+            [&](const Fortran::parser::ErrLabel &) { csi.hasErr = true; },
+            [](const auto &) {}},
+        spec.u);
+  }
+  if (!csi.hasAnyConditionSpec())
+    return;
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::FuncOp enableHandlers =
+      getIORuntimeFunc<mkIOKey(EnableHandlers)>(loc, builder);
+  mlir::Type boolType = enableHandlers.getType().getInput(1);
+  auto boolValue = [&](bool specifierIsPresent) {
+    return builder.create<mlir::arith::ConstantOp>(
+        loc, builder.getIntegerAttr(boolType, specifierIsPresent));
+  };
+  llvm::SmallVector<mlir::Value> ioArgs = {cookie,
+                                           boolValue(csi.ioStatExpr != nullptr),
+                                           boolValue(csi.hasErr),
+                                           boolValue(csi.hasEnd),
+                                           boolValue(csi.hasEor),
+                                           boolValue(csi.ioMsgExpr != nullptr)};
+  builder.create<fir::CallOp>(loc, enableHandlers, ioArgs);
+}
+
+//===----------------------------------------------------------------------===//
+// Data transfer helpers
+//===----------------------------------------------------------------------===//
+
+template <typename SEEK, typename A>
+static bool hasIOControl(const A &stmt) {
+  return hasX<SEEK>(stmt.controls);
+}
+
+template <typename SEEK, typename A>
+static const auto *getIOControl(const A &stmt) {
+  for (const auto &spec : stmt.controls)
+    if (const auto *result = std::get_if<SEEK>(&spec.u))
+      return result;
+  return static_cast<const SEEK *>(nullptr);
+}
+
+/// Returns true iff the expression in the parse tree is not really a format but
+/// rather a namelist group.
+template <typename A>
+static bool formatIsActuallyNamelist(const A &format) {
+  if (auto *e = std::get_if<Fortran::parser::Expr>(&format.u)) {
+    auto *expr = Fortran::semantics::GetExpr(*e);
+    if (const Fortran::semantics::Symbol *y =
+            Fortran::evaluate::UnwrapWholeSymbolDataRef(*expr))
+      return y->has<Fortran::semantics::NamelistDetails>();
+  }
+  return false;
+}
+
+template <typename A>
+static bool isDataTransferFormatted(const A &stmt) {
+  if (stmt.format)
+    return !formatIsActuallyNamelist(*stmt.format);
+  return hasIOControl<Fortran::parser::Format>(stmt);
+}
+template <>
+constexpr bool isDataTransferFormatted<Fortran::parser::PrintStmt>(
+    const Fortran::parser::PrintStmt &) {
+  return true; // PRINT is always formatted
+}
+
+template <typename A>
+static bool isDataTransferList(const A &stmt) {
+  if (stmt.format)
+    return std::holds_alternative<Fortran::parser::Star>(stmt.format->u);
+  if (auto *mem = getIOControl<Fortran::parser::Format>(stmt))
+    return std::holds_alternative<Fortran::parser::Star>(mem->u);
+  return false;
+}
+template <>
+bool isDataTransferList<Fortran::parser::PrintStmt>(
+    const Fortran::parser::PrintStmt &stmt) {
+  return std::holds_alternative<Fortran::parser::Star>(
+      std::get<Fortran::parser::Format>(stmt.t).u);
+}
+
+template <typename A>
+static bool isDataTransferInternal(const A &stmt) {
+  if (stmt.iounit.has_value())
+    return std::holds_alternative<Fortran::parser::Variable>(stmt.iounit->u);
+  if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt))
+    return std::holds_alternative<Fortran::parser::Variable>(unit->u);
+  return false;
+}
+template <>
+constexpr bool isDataTransferInternal<Fortran::parser::PrintStmt>(
+    const Fortran::parser::PrintStmt &) {
+  return false;
+}
+
+/// If the variable `var` is an array or of a KIND other than the default
+/// (normally 1), then a descriptor is required by the runtime IO API. This
+/// condition holds even in F77 sources.
+static llvm::Optional<fir::ExtendedValue> getVariableBufferRequiredDescriptor(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::parser::Variable &var,
+    Fortran::lower::StatementContext &stmtCtx) {
+  fir::ExtendedValue varBox =
+      converter.genExprAddr(var.typedExpr->v.value(), stmtCtx);
+  fir::KindTy defCharKind = converter.getKindMap().defaultCharacterKind();
+  mlir::Value varAddr = fir::getBase(varBox);
+  if (fir::factory::CharacterExprHelper::getCharacterOrSequenceKind(
+          varAddr.getType()) != defCharKind)
+    return varBox;
+  if (fir::factory::CharacterExprHelper::isArray(varAddr.getType()))
+    return varBox;
+  return llvm::None;
+}
+
+template <typename A>
+static llvm::Optional<fir::ExtendedValue>
+maybeGetInternalIODescriptor(Fortran::lower::AbstractConverter &converter,
+                             const A &stmt,
+                             Fortran::lower::StatementContext &stmtCtx) {
+  if (stmt.iounit.has_value())
+    if (auto *var = std::get_if<Fortran::parser::Variable>(&stmt.iounit->u))
+      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
+  if (auto *unit = getIOControl<Fortran::parser::IoUnit>(stmt))
+    if (auto *var = std::get_if<Fortran::parser::Variable>(&unit->u))
+      return getVariableBufferRequiredDescriptor(converter, *var, stmtCtx);
+  return llvm::None;
+}
+template <>
+inline llvm::Optional<fir::ExtendedValue>
+maybeGetInternalIODescriptor<Fortran::parser::PrintStmt>(
+    Fortran::lower::AbstractConverter &, const Fortran::parser::PrintStmt &,
+    Fortran::lower::StatementContext &) {
+  return llvm::None;
+}
+
+template <typename A>
+static bool isDataTransferAsynchronous(mlir::Location loc, const A &stmt) {
+  if (auto *asynch =
+          getIOControl<Fortran::parser::IoControlSpec::Asynchronous>(stmt)) {
+    // FIXME: should contain a string of YES or NO
+    TODO(loc, "asynchronous transfers not implemented in runtime");
+  }
+  return false;
+}
+template <>
+bool isDataTransferAsynchronous<Fortran::parser::PrintStmt>(
+    mlir::Location, const Fortran::parser::PrintStmt &) {
+  return false;
+}
+
+template <typename A>
+static bool isDataTransferNamelist(const A &stmt) {
+  if (stmt.format)
+    return formatIsActuallyNamelist(*stmt.format);
+  return hasIOControl<Fortran::parser::Name>(stmt);
+}
+template <>
+constexpr bool isDataTransferNamelist<Fortran::parser::PrintStmt>(
+    const Fortran::parser::PrintStmt &) {
+  return false;
+}
+
+/// Lowers a format statment that uses an assigned variable label reference as
+/// a select operation to allow for run-time selection of the format statement.
+static std::tuple<mlir::Value, mlir::Value, mlir::Value>
+lowerReferenceAsStringSelect(Fortran::lower::AbstractConverter &converter,
+                             mlir::Location loc,
+                             const Fortran::lower::SomeExpr &expr,
+                             mlir::Type strTy, mlir::Type lenTy,
+                             Fortran::lower::StatementContext &stmtCtx) {
+  // Possible optimization TODO: Instead of inlining a selectOp every time there
+  // is a variable reference to a format statement, a function with the selectOp
+  // could be generated to reduce code size. It is not clear if such an
+  // optimization would be deployed very often or improve the object code
+  // beyond, say, what GVN/GCM might produce.
+
+  // Create the requisite blocks to inline a selectOp.
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  mlir::Block *startBlock = builder.getBlock();
+  mlir::Block *endBlock = startBlock->splitBlock(builder.getInsertionPoint());
+  mlir::Block *block = startBlock->splitBlock(builder.getInsertionPoint());
+  builder.setInsertionPointToEnd(block);
+
+  llvm::SmallVector<int64_t> indexList;
+  llvm::SmallVector<mlir::Block *> blockList;
+
+  auto symbol = GetLastSymbol(&expr);
+  Fortran::lower::pft::LabelSet labels;
+  [[maybe_unused]] auto foundLabelSet =
+      converter.lookupLabelSet(*symbol, labels);
+  assert(foundLabelSet && "Label not found in map");
+
+  for (auto label : labels) {
+    indexList.push_back(label);
+    auto *eval = converter.lookupLabel(label);
+    assert(eval && "Label is missing from the table");
+
+    llvm::StringRef text = toStringRef(eval->position);
+    mlir::Value stringRef;
+    mlir::Value stringLen;
+    if (eval->isA<Fortran::parser::FormatStmt>()) {
+      assert(text.find('(') != llvm::StringRef::npos &&
+             "FORMAT is unexpectedly ill-formed");
+      // This is a format statement, so extract the spec from the text.
+      std::tuple<mlir::Value, mlir::Value, mlir::Value> stringLit =
+          lowerSourceTextAsStringLit(converter, loc, text, strTy, lenTy);
+      stringRef = std::get<0>(stringLit);
+      stringLen = std::get<1>(stringLit);
+    } else {
+      // This is not a format statement, so use null.
+      stringRef = builder.createConvert(
+          loc, strTy,
+          builder.createIntegerConstant(loc, builder.getIndexType(), 0));
+      stringLen = builder.createIntegerConstant(loc, lenTy, 0);
+    }
+
+    // Pass the format string reference and the string length out of the select
+    // statement.
+    llvm::SmallVector<mlir::Value> args = {stringRef, stringLen};
+    builder.create<mlir::cf::BranchOp>(loc, endBlock, args);
+
+    // Add block to the list of cases and make a new one.
+    blockList.push_back(block);
+    block = block->splitBlock(builder.getInsertionPoint());
+    builder.setInsertionPointToEnd(block);
+  }
+
+  // Create the unit case which should result in an error.
+  auto *unitBlock = block->splitBlock(builder.getInsertionPoint());
+  builder.setInsertionPointToEnd(unitBlock);
+
+  // Crash the program.
+  builder.create<fir::UnreachableOp>(loc);
+
+  // Add unit case to the select statement.
+  blockList.push_back(unitBlock);
+
+  // Lower the selectOp.
+  builder.setInsertionPointToEnd(startBlock);
+  auto label = fir::getBase(converter.genExprValue(&expr, stmtCtx, loc));
+  builder.create<fir::SelectOp>(loc, label, indexList, blockList);
+
+  builder.setInsertionPointToEnd(endBlock);
+  endBlock->addArgument(strTy, loc);
+  endBlock->addArgument(lenTy, loc);
+
+  // Handle and return the string reference and length selected by the selectOp.
+  auto buff = endBlock->getArgument(0);
+  auto len = endBlock->getArgument(1);
+
+  return {buff, len, mlir::Value{}};
+}
+
+/// Generate a reference to a format string.  There are four cases - a format
+/// statement label, a character format expression, an integer that holds the
+/// label of a format statement, and the * case.  The first three are done here.
+/// The * case is done elsewhere.
+static std::tuple<mlir::Value, mlir::Value, mlir::Value>
+genFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+          const Fortran::parser::Format &format, mlir::Type strTy,
+          mlir::Type lenTy, Fortran::lower::StatementContext &stmtCtx) {
+  if (const auto *label = std::get_if<Fortran::parser::Label>(&format.u)) {
+    // format statement label
+    auto eval = converter.lookupLabel(*label);
+    assert(eval && "FORMAT not found in PROCEDURE");
+    return lowerSourceTextAsStringLit(
+        converter, loc, toStringRef(eval->position), strTy, lenTy);
+  }
+  const auto *pExpr = std::get_if<Fortran::parser::Expr>(&format.u);
+  assert(pExpr && "missing format expression");
+  auto e = Fortran::semantics::GetExpr(*pExpr);
+  if (Fortran::semantics::ExprHasTypeCategory(
+          *e, Fortran::common::TypeCategory::Character))
+    // character expression
+    return lowerStringLit(converter, loc, stmtCtx, *pExpr, strTy, lenTy);
+
+  if (Fortran::semantics::ExprHasTypeCategory(
+          *e, Fortran::common::TypeCategory::Integer) &&
+      e->Rank() == 0 && Fortran::evaluate::UnwrapWholeSymbolDataRef(*e)) {
+    // Treat as a scalar integer variable containing an ASSIGN label.
+    return lowerReferenceAsStringSelect(converter, loc, *e, strTy, lenTy,
+                                        stmtCtx);
+  }
+
+  // Legacy extension: it is possible that `*e` is not a scalar INTEGER
+  // variable containing a label value. The output appears to be the source text
+  // that initialized the variable? Needs more investigatation.
+  TODO(loc, "io-control-spec contains a reference to a non-integer, "
+            "non-scalar, or non-variable");
+}
+
+template <typename A>
+std::tuple<mlir::Value, mlir::Value, mlir::Value>
+getFormat(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+          const A &stmt, mlir::Type strTy, mlir::Type lenTy,
+          Fortran ::lower::StatementContext &stmtCtx) {
+  if (stmt.format && !formatIsActuallyNamelist(*stmt.format))
+    return genFormat(converter, loc, *stmt.format, strTy, lenTy, stmtCtx);
+  return genFormat(converter, loc, *getIOControl<Fortran::parser::Format>(stmt),
+                   strTy, lenTy, stmtCtx);
+}
+template <>
+std::tuple<mlir::Value, mlir::Value, mlir::Value>
+getFormat<Fortran::parser::PrintStmt>(
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const Fortran::parser::PrintStmt &stmt, mlir::Type strTy, mlir::Type lenTy,
+    Fortran::lower::StatementContext &stmtCtx) {
+  return genFormat(converter, loc, std::get<Fortran::parser::Format>(stmt.t),
+                   strTy, lenTy, stmtCtx);
+}
+
+/// Get a buffer for an internal file data transfer.
+template <typename A>
+std::tuple<mlir::Value, mlir::Value>
+getBuffer(Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+          const A &stmt, mlir::Type strTy, mlir::Type lenTy,
+          Fortran::lower::StatementContext &stmtCtx) {
+  const Fortran::parser::IoUnit *iounit =
+      stmt.iounit ? &*stmt.iounit : getIOControl<Fortran::parser::IoUnit>(stmt);
+  if (iounit)
+    if (auto *var = std::get_if<Fortran::parser::Variable>(&iounit->u))
+      if (auto *expr = Fortran::semantics::GetExpr(*var))
+        return genBuffer(converter, loc, *expr, strTy, lenTy, stmtCtx);
+  llvm::report_fatal_error("failed to get IoUnit expr in lowering");
+}
+
+static mlir::Value genIOUnit(Fortran::lower::AbstractConverter &converter,
+                             mlir::Location loc,
+                             const Fortran::parser::IoUnit &iounit,
+                             mlir::Type ty,
+                             Fortran::lower::StatementContext &stmtCtx) {
+  auto &builder = converter.getFirOpBuilder();
+  if (auto *e = std::get_if<Fortran::parser::FileUnitNumber>(&iounit.u)) {
+    auto ex = fir::getBase(
+        converter.genExprValue(Fortran::semantics::GetExpr(*e), stmtCtx, loc));
+    return builder.createConvert(loc, ty, ex);
+  }
+  return builder.create<mlir::arith::ConstantOp>(
+      loc, builder.getIntegerAttr(ty, Fortran::runtime::io::DefaultUnit));
+}
+
+template <typename A>
+mlir::Value getIOUnit(Fortran::lower::AbstractConverter &converter,
+                      mlir::Location loc, const A &stmt, mlir::Type ty,
+                      Fortran::lower::StatementContext &stmtCtx) {
+  if (stmt.iounit)
+    return genIOUnit(converter, loc, *stmt.iounit, ty, stmtCtx);
+  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));
+}
+
+//===----------------------------------------------------------------------===//
+// 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
+//   - external vs. internal
+//===----------------------------------------------------------------------===//
+
+// Get the begin data transfer IO function to call for the given values.
+template <bool isInput>
+mlir::FuncOp
+getBeginDataTransferFunc(mlir::Location loc, fir::FirOpBuilder &builder,
+                         bool isFormatted, bool isListOrNml, bool isInternal,
+                         bool isInternalWithDesc, bool isAsync) {
+  if constexpr (isInput) {
+    if (isAsync)
+      return getIORuntimeFunc<mkIOKey(BeginAsynchronousInput)>(loc, builder);
+    if (isFormatted || isListOrNml) {
+      if (isInternal) {
+        if (isInternalWithDesc) {
+          if (isListOrNml)
+            return getIORuntimeFunc<mkIOKey(BeginInternalArrayListInput)>(
+                loc, builder);
+          return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedInput)>(
+              loc, builder);
+        }
+        if (isListOrNml)
+          return getIORuntimeFunc<mkIOKey(BeginInternalListInput)>(loc,
+                                                                   builder);
+        return getIORuntimeFunc<mkIOKey(BeginInternalFormattedInput)>(loc,
+                                                                      builder);
+      }
+      if (isListOrNml)
+        return getIORuntimeFunc<mkIOKey(BeginExternalListInput)>(loc, builder);
+      return getIORuntimeFunc<mkIOKey(BeginExternalFormattedInput)>(loc,
+                                                                    builder);
+    }
+    return getIORuntimeFunc<mkIOKey(BeginUnformattedInput)>(loc, builder);
+  } else {
+    if (isAsync)
+      return getIORuntimeFunc<mkIOKey(BeginAsynchronousOutput)>(loc, builder);
+    if (isFormatted || isListOrNml) {
+      if (isInternal) {
+        if (isInternalWithDesc) {
+          if (isListOrNml)
+            return getIORuntimeFunc<mkIOKey(BeginInternalArrayListOutput)>(
+                loc, builder);
+          return getIORuntimeFunc<mkIOKey(BeginInternalArrayFormattedOutput)>(
+              loc, builder);
+        }
+        if (isListOrNml)
+          return getIORuntimeFunc<mkIOKey(BeginInternalListOutput)>(loc,
+                                                                    builder);
+        return getIORuntimeFunc<mkIOKey(BeginInternalFormattedOutput)>(loc,
+                                                                       builder);
+      }
+      if (isListOrNml)
+        return getIORuntimeFunc<mkIOKey(BeginExternalListOutput)>(loc, builder);
+      return getIORuntimeFunc<mkIOKey(BeginExternalFormattedOutput)>(loc,
+                                                                     builder);
+    }
+    return getIORuntimeFunc<mkIOKey(BeginUnformattedOutput)>(loc, builder);
+  }
+}
+
+/// Generate the arguments of a begin data transfer statement call.
+template <bool hasIOCtrl, typename A>
+void genBeginDataTransferCallArgs(
+    llvm::SmallVectorImpl<mlir::Value> &ioArgs,
+    Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+    const A &stmt, mlir::FunctionType ioFuncTy, bool isFormatted,
+    bool isListOrNml, [[maybe_unused]] bool isInternal,
+    [[maybe_unused]] bool isAsync,
+    const llvm::Optional<fir::ExtendedValue> &descRef,
+    Fortran::lower::StatementContext &stmtCtx) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  auto maybeGetFormatArgs = [&]() {
+    if (!isFormatted || isListOrNml)
+      return;
+    auto pair =
+        getFormat(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()),
+                  ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx);
+    ioArgs.push_back(std::get<0>(pair)); // format character string
+    ioArgs.push_back(std::get<1>(pair)); // format length
+  };
+  if constexpr (hasIOCtrl) { // READ or WRITE
+    if (isInternal) {
+      // descriptor or scalar variable; maybe explicit format; scratch area
+      if (descRef.hasValue()) {
+        mlir::Value desc = builder.createBox(loc, *descRef);
+        ioArgs.push_back(
+            builder.createConvert(loc, ioFuncTy.getInput(ioArgs.size()), desc));
+      } else {
+        std::tuple<mlir::Value, mlir::Value> pair =
+            getBuffer(converter, loc, stmt, ioFuncTy.getInput(ioArgs.size()),
+                      ioFuncTy.getInput(ioArgs.size() + 1), stmtCtx);
+        ioArgs.push_back(std::get<0>(pair)); // scalar character variable
+        ioArgs.push_back(std::get<1>(pair)); // character length
+      }
+      maybeGetFormatArgs();
+      ioArgs.push_back( // internal scratch area buffer
+          getDefaultScratch(builder, loc, ioFuncTy.getInput(ioArgs.size())));
+      ioArgs.push_back( // buffer length
+          getDefaultScratchLen(builder, loc, ioFuncTy.getInput(ioArgs.size())));
+    } else if (isAsync) { // unit; REC; buffer and length
+      ioArgs.push_back(getIOUnit(converter, loc, stmt,
+                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
+      TODO(loc, "asynchronous");
+    } else { // external IO - maybe explicit format; unit
+      maybeGetFormatArgs();
+      ioArgs.push_back(getIOUnit(converter, loc, stmt,
+                                 ioFuncTy.getInput(ioArgs.size()), stmtCtx));
+    }
+  } else { // PRINT - maybe explicit format; default unit
+    maybeGetFormatArgs();
+    ioArgs.push_back(builder.create<mlir::arith::ConstantOp>(
+        loc, builder.getIntegerAttr(ioFuncTy.getInput(ioArgs.size()),
+                                    Fortran::runtime::io::DefaultUnit)));
+  }
+  // File name and line number are always the last two arguments.
+  ioArgs.push_back(
+      locToFilename(converter, loc, ioFuncTy.getInput(ioArgs.size())));
+  ioArgs.push_back(
+      locToLineNo(converter, loc, ioFuncTy.getInput(ioArgs.size())));
+}
+
+template <bool isInput, bool hasIOCtrl = true, typename A>
+static mlir::Value
+genDataTransferStmt(Fortran::lower::AbstractConverter &converter,
+                    const A &stmt) {
+  fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+  Fortran::lower::StatementContext stmtCtx;
+  mlir::Location loc = converter.getCurrentLocation();
+  const bool isFormatted = isDataTransferFormatted(stmt);
+  const bool isList = isFormatted ? isDataTransferList(stmt) : false;
+  const bool isInternal = isDataTransferInternal(stmt);
+  llvm::Optional<fir::ExtendedValue> descRef =
+      isInternal ? maybeGetInternalIODescriptor(converter, stmt, stmtCtx)
+                 : llvm::None;
+  const bool isInternalWithDesc = descRef.hasValue();
+  const bool isAsync = isDataTransferAsynchronous(loc, stmt);
+  const bool isNml = isDataTransferNamelist(stmt);
+
+  // Generate the begin data transfer function call.
+  mlir::FuncOp ioFunc = getBeginDataTransferFunc<isInput>(
+      loc, builder, isFormatted, isList || isNml, isInternal,
+      isInternalWithDesc, isAsync);
+  llvm::SmallVector<mlir::Value> ioArgs;
+  genBeginDataTransferCallArgs<hasIOCtrl>(
+      ioArgs, converter, loc, stmt, ioFunc.getType(), isFormatted,
+      isList || isNml, isInternal, isAsync, descRef, stmtCtx);
+  mlir::Value cookie =
+      builder.create<fir::CallOp>(loc, ioFunc, ioArgs).getResult(0);
+
+  // Generate an EnableHandlers call and remaining specifier calls.
+  ConditionSpecInfo csi;
+  auto insertPt = builder.saveInsertionPoint();
+  mlir::Value ok;
+  if constexpr (hasIOCtrl) {
+    genConditionHandlerCall(converter, loc, cookie, stmt.controls, csi);
+    threadSpecs(converter, loc, cookie, stmt.controls,
+                csi.hasErrorConditionSpec(), ok);
+  }
+
+  // Generate data transfer list calls.
+  if constexpr (isInput) { // READ
+    if (isNml)
+      genNamelistIO(converter, cookie,
+                    getIORuntimeFunc<mkIOKey(InputNamelist)>(loc, builder),
+                    *getIOControl<Fortran::parser::Name>(stmt)->symbol,
+                    csi.hasTransferConditionSpec(), ok, stmtCtx);
+    else
+      genInputItemList(converter, cookie, stmt.items, isFormatted,
+                       csi.hasTransferConditionSpec(), ok, /*inLoop=*/false,
+                       stmtCtx);
+  } else if constexpr (std::is_same_v<A, Fortran::parser::WriteStmt>) {
+    if (isNml)
+      genNamelistIO(converter, cookie,
+                    getIORuntimeFunc<mkIOKey(OutputNamelist)>(loc, builder),
+                    *getIOControl<Fortran::parser::Name>(stmt)->symbol,
+                    csi.hasTransferConditionSpec(), ok, stmtCtx);
+    else
+      genOutputItemList(converter, cookie, stmt.items, isFormatted,
+                        csi.hasTransferConditionSpec(), ok,
+                        /*inLoop=*/false, stmtCtx);
+  } else { // PRINT
+    genOutputItemList(converter, cookie, std::get<1>(stmt.t), isFormatted,
+                      csi.hasTransferConditionSpec(), ok,
+                      /*inLoop=*/false, stmtCtx);
+  }
+  stmtCtx.finalize();
+
+  builder.restoreInsertionPoint(insertPt);
+  if constexpr (hasIOCtrl) {
+    genIOReadSize(converter, loc, cookie, stmt.controls,
+                  csi.hasErrorConditionSpec());
+  }
+  // Generate end statement call/s.
+  return genEndIO(converter, loc, cookie, csi, stmtCtx);
+}
+
+void Fortran::lower::genPrintStatement(
+    Fortran::lower::AbstractConverter &converter,
+    const Fortran::parser::PrintStmt &stmt) {
+  // PRINT does not take an io-control-spec. It only has a format specifier, so
+  // it is a simplified case of WRITE.
+  genDataTransferStmt</*isInput=*/false, /*ioCtrl=*/false>(converter, stmt);
+}
+
+mlir::Value
+Fortran::lower::genWriteStatement(Fortran::lower::AbstractConverter &converter,
+                                  const Fortran::parser::WriteStmt &stmt) {
+  return genDataTransferStmt</*isInput=*/false>(converter, stmt);
+}
+
+mlir::Value
+Fortran::lower::genReadStatement(Fortran::lower::AbstractConverter &converter,
+                                 const Fortran::parser::ReadStmt &stmt) {
+  return genDataTransferStmt</*isInput=*/true>(converter, stmt);
+}

flang/lib/Optimizer/Dialect/FIROps.cpp

void fir::FieldIndexOp::build(mlir::OpBuilder &builder,
                               mlir::OperationState &result,
                               llvm::StringRef fieldName, mlir::Type recTy,
                               mlir::ValueRange operands) {
   result.addAttribute(fieldAttrName(), builder.getStringAttr(fieldName));
   result.addAttribute(typeAttrName(), TypeAttr::get(recTy));
   result.addOperands(operands);
 }
 
+llvm::SmallVector<mlir::Attribute> fir::FieldIndexOp::getAttributes() {
+  llvm::SmallVector<mlir::Attribute> attrs;
+  attrs.push_back(getFieldIdAttr());
+  attrs.push_back(getOnTypeAttr());
+  return attrs;
+}
+
 //===----------------------------------------------------------------------===//
 // InsertOnRangeOp
 //===----------------------------------------------------------------------===//
 
 static ParseResult
 parseCustomRangeSubscript(mlir::OpAsmParser &parser,
                           mlir::DenseIntElementsAttr &coord) {
   llvm::SmallVector<int64_t> lbounds;

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

+! RUN: bbc %s -o - | FileCheck %s
+! UNSUPPORTED: system-windows
+
+ logical :: existsvar
+ integer :: length
+ real :: a(100)
+
+  ! CHECK-LABEL: _QQmain
+  ! 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 {{.*}}BeginExternalListOutput
+  ! CHECK: call {{.*}}OutputAscii
+  ! CHECK: call {{.*}}EndIoStatement
+  print *, "A literal string"
+end
+
+! CHECK-LABEL: @_QPboz
+subroutine boz
+  ! CHECK: fir.call @_FortranAioOutputInteger8(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i8) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger16(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i16) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger128(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i128) -> i1
+  print '(*(Z3))', 96_1, 96_2, 96_4, 96_8, 96_16
+
+  ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  print '(I3,2Z44)', 40, 2**40_8, 2**40_8+1
+
+  ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  print '(I3,2I44)', 40, 1099511627776,  1099511627777
+
+  ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  print '(I3,2O44)', 40, 2**40_8, 2**40_8+1
+
+  ! CHECK: fir.call @_FortranAioOutputInteger32(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i32) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  ! CHECK: fir.call @_FortranAioOutputInteger64(%{{.*}}, %{{.*}}) : (!fir.ref<i8>, i64) -> i1
+  print '(I3,2B44)', 40, 2**40_8, 2**40_8+1
+end

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

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+   character*10 :: exx
+   character*30 :: m
+   integer*2 :: s
+   exx = 'AA'
+   m = 'CCCCCC'
+   s = -13
+   ! CHECK: call {{.*}}BeginExternalFormattedInput
+   ! CHECK: call {{.*}}EnableHandlers
+   ! CHECK: call {{.*}}SetAdvance
+   ! CHECK: call {{.*}}InputReal
+   ! CHECK: call {{.*}}GetIoMsg
+   ! CHECK: call {{.*}}EndIoStatement
+   ! CHECK: fir.select %{{.*}} : index [-2, ^bb4, -1, ^bb3, 0, ^bb1, unit, ^bb2]
+   read(*, '(A)', ADVANCE='NO', ERR=10, END=20, EOR=30, IOSTAT=s, IOMSG=m) f
+   ! CHECK-LABEL: ^bb1:
+   exx = 'Zip'; goto 90
+10 exx = 'Err'; goto 90
+20 exx = 'End'; goto 90
+30 exx = 'Eor'; goto 90
+90 print*, exx, c, m, s
+end
+
+! CHECK-LABEL: func @_QPimpliedformat
+subroutine impliedformat
+  ! CHECK: BeginExternalListInput(%c-1
+  ! CHECK: InputReal32
+  ! CHECK: EndIoStatement(%3) : (!fir.ref<i8>) -> i32
+  read*, x
+  ! CHECK: BeginExternalListOutput(%c-1
+  ! CHECK: OutputReal32
+  ! CHECK: EndIoStatement
+  print*, x
+end