[flang] Rework handling of non-type-bound user-defined I/O

A fairly recent introduction of runtime I/O APIs called OutputDerivedType()
and InputDerivedType() didn't cover NAMELIST I/O's need to access
non-type-bound generic interfaces for user-defined derived type I/O
when those generic interfaces are defined in some scope other than the
one that defines the derived type.

The patch adds a new data structure shared between lowering
and the runtime that can represent all of the cases that can
arise with non-type-bound defined I/O.  It can represent
scopes in which non-type-bound defined I/O generic interfaces
are inaccessible, too, due to IMPORT statements.

The data structure is now an operand to OutputDerivedType() and
InputDerivedType() as well as a data member in the NamelistGroup
structure.

Differential Revision: https://reviews.llvm.org/D148257

12 files changed, 224 insertions, 100 deletions

diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt
index 15da5a20aaec..20e78ff6654a 100644
--- a/flang/runtime/CMakeLists.txt
+++ b/flang/runtime/CMakeLists.txt
@@ -130,6 +130,7 @@ add_flang_library(FortranRuntime
   memory.cpp
   misc-intrinsic.cpp
   namelist.cpp
+  non-tbp-dio.cpp
   numeric.cpp
   ragged.cpp
   random.cpp
diff --git a/flang/runtime/descriptor-io.cpp b/flang/runtime/descriptor-io.cpp
index c51a36b1a7bd..563a69e999d5 100644
--- a/flang/runtime/descriptor-io.cpp
+++ b/flang/runtime/descriptor-io.cpp
@@ -11,7 +11,7 @@
 
 namespace Fortran::runtime::io::descr {
 
-// User-defined derived type formatted I/O (maybe)
+// Defined formatted I/O (maybe)
 std::optional<bool> DefinedFormattedIo(IoStatementState &io,
     const Descriptor &descriptor, const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special) {
@@ -19,7 +19,7 @@ std::optional<bool> DefinedFormattedIo(IoStatementState &io,
   if (peek &&
       (peek->descriptor == DataEdit::DefinedDerivedType ||
           peek->descriptor == DataEdit::ListDirected)) {
-    // User-defined derived type formatting
+    // Defined formatting
     IoErrorHandler &handler{io.GetIoErrorHandler()};
     DataEdit edit{*io.GetNextDataEdit(1)}; // now consume it; no repeats
     RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
@@ -105,14 +105,14 @@ std::optional<bool> DefinedFormattedIo(IoStatementState &io,
     }
     return handler.GetIoStat() == IostatOk;
   } else {
-    // There's a user-defined I/O subroutine, but there's a FORMAT present and
+    // There's a defined I/O subroutine, but there's a FORMAT present and
     // it does not have a DT data edit descriptor, so apply default formatting
     // to the components of the derived type as usual.
     return std::nullopt;
   }
 }
 
-// User-defined derived type unformatted I/O
+// Defined unformatted I/O
 bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor,
     const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special) {
diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h
index 7bf55ded31d3..80b5d87a6efb 100644
--- a/flang/runtime/descriptor-io.h
+++ b/flang/runtime/descriptor-io.h
@@ -17,6 +17,7 @@
 #include "edit-input.h"
 #include "edit-output.h"
 #include "io-stmt.h"
+#include "namelist.h"
 #include "terminator.h"
 #include "type-info.h"
 #include "unit.h"
@@ -239,20 +240,22 @@ inline bool FormattedLogicalIO(
 }
 
 template <Direction DIR>
-static bool DescriptorIO(IoStatementState &, const Descriptor &);
+static bool DescriptorIO(IoStatementState &, const Descriptor &,
+    const NonTbpDefinedIoTable * = nullptr);
 
-// For default (not user-defined) derived type I/O, formatted & unformatted
+// For intrinsic (not defined) derived type I/O, formatted & unformatted
 template <Direction DIR>
 static bool DefaultComponentIO(IoStatementState &io,
     const typeInfo::Component &component, const Descriptor &origDescriptor,
-    const SubscriptValue origSubscripts[], Terminator &terminator) {
+    const SubscriptValue origSubscripts[], Terminator &terminator,
+    const NonTbpDefinedIoTable *table) {
   if (component.genre() == typeInfo::Component::Genre::Data) {
     // Create a descriptor for the component
     StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
     Descriptor &desc{statDesc.descriptor()};
     component.CreatePointerDescriptor(
         desc, origDescriptor, terminator, origSubscripts);
-    return DescriptorIO<DIR>(io, desc);
+    return DescriptorIO<DIR>(io, desc, table);
   } else {
     // Component is itself a descriptor
     char *pointer{
@@ -260,13 +263,14 @@ static bool DefaultComponentIO(IoStatementState &io,
     RUNTIME_CHECK(
         terminator, component.genre() == typeInfo::Component::Genre::Automatic);
     const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
-    return DescriptorIO<DIR>(io, compDesc);
+    return DescriptorIO<DIR>(io, compDesc, table);
   }
 }
 
 template <Direction DIR>
 static bool DefaultComponentwiseIO(IoStatementState &io,
-    const Descriptor &descriptor, const typeInfo::DerivedType &type) {
+    const Descriptor &descriptor, const typeInfo::DerivedType &type,
+    const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   const Descriptor &compArray{type.component()};
   RUNTIME_CHECK(handler, compArray.rank() == 1);
@@ -283,7 +287,7 @@ static bool DefaultComponentwiseIO(IoStatementState &io,
       const typeInfo::Component &component{
           *compArray.Element<typeInfo::Component>(at)};
       if (!DefaultComponentIO<DIR>(
-              io, component, descriptor, subscripts, handler)) {
+              io, component, descriptor, subscripts, handler, table)) {
         return false;
       }
     }
@@ -295,24 +299,44 @@ std::optional<bool> DefinedFormattedIo(IoStatementState &, const Descriptor &,
     const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
 
 template <Direction DIR>
-static bool FormattedDerivedTypeIO(
-    IoStatementState &io, const Descriptor &descriptor) {
+static bool FormattedDerivedTypeIO(IoStatementState &io,
+    const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   // Derived type information must be present for formatted I/O.
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   RUNTIME_CHECK(handler, addendum != nullptr);
   const typeInfo::DerivedType *type{addendum->derivedType()};
   RUNTIME_CHECK(handler, type != nullptr);
+  if (table) {
+    if (const auto *definedIo{table->Find(*type,
+            DIR == Direction::Input ? common::DefinedIo::ReadFormatted
+                                    : common::DefinedIo::WriteFormatted)}) {
+      if (definedIo->subroutine) {
+        typeInfo::SpecialBinding special{DIR == Direction::Input
+                ? typeInfo::SpecialBinding::Which::ReadFormatted
+                : typeInfo::SpecialBinding::Which::WriteFormatted,
+            definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+        if (std::optional<bool> wasDefined{
+                DefinedFormattedIo(io, descriptor, *type, special)}) {
+          return *wasDefined;
+        }
+      } else {
+        return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+      }
+    }
+  }
   if (const typeInfo::SpecialBinding *
       special{type->FindSpecialBinding(DIR == Direction::Input
               ? typeInfo::SpecialBinding::Which::ReadFormatted
               : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
-    if (std::optional<bool> wasDefined{
-            DefinedFormattedIo(io, descriptor, *type, *special)}) {
-      return *wasDefined; // user-defined I/O was applied
+    if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
+      if (std::optional<bool> wasDefined{
+              DefinedFormattedIo(io, descriptor, *type, *special)}) {
+        return *wasDefined; // defined I/O was applied
+      }
     }
   }
-  return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
+  return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
 }
 
 bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
@@ -320,26 +344,45 @@ bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
 
 // Unformatted I/O
 template <Direction DIR>
-static bool UnformattedDescriptorIO(
-    IoStatementState &io, const Descriptor &descriptor) {
+static bool UnformattedDescriptorIO(IoStatementState &io,
+    const Descriptor &descriptor, const NonTbpDefinedIoTable *table = nullptr) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   if (const typeInfo::DerivedType *
       type{addendum ? addendum->derivedType() : nullptr}) {
     // derived type unformatted I/O
+    if (table) {
+      if (const auto *definedIo{table->Find(*type,
+              DIR == Direction::Input ? common::DefinedIo::ReadUnformatted
+                                      : common::DefinedIo::WriteUnformatted)}) {
+        if (definedIo->subroutine) {
+          typeInfo::SpecialBinding special{DIR == Direction::Input
+                  ? typeInfo::SpecialBinding::Which::ReadUnformatted
+                  : typeInfo::SpecialBinding::Which::WriteUnformatted,
+              definedIo->subroutine, definedIo->isDtvArgPolymorphic, false};
+          if (std::optional<bool> wasDefined{
+                  DefinedUnformattedIo(io, descriptor, *type, special)}) {
+            return *wasDefined;
+          }
+        } else {
+          return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
+        }
+      }
+    }
     if (const typeInfo::SpecialBinding *
         special{type->FindSpecialBinding(DIR == Direction::Input
                 ? typeInfo::SpecialBinding::Which::ReadUnformatted
                 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
-      // User-defined derived type unformatted I/O
-      return DefinedUnformattedIo(io, descriptor, *type, *special);
-    } else {
-      // Default derived type unformatted I/O
-      // TODO: If no component at any level has user defined READ or WRITE
-      // (as appropriate), the elements are contiguous, and no byte swapping
-      // is active, do a block transfer via the code below.
-      return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
+      if (!table || !table->ignoreNonTbpEntries || special->isTypeBound()) {
+        // defined derived type unformatted I/O
+        return DefinedUnformattedIo(io, descriptor, *type, *special);
+      }
     }
+    // Default derived type unformatted I/O
+    // TODO: If no component at any level has defined READ or WRITE
+    // (as appropriate), the elements are contiguous, and no byte swapping
+    // is active, do a block transfer via the code below.
+    return DefaultComponentwiseIO<DIR>(io, descriptor, *type, table);
   } else {
     // intrinsic type unformatted I/O
     auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
@@ -397,7 +440,8 @@ static bool UnformattedDescriptorIO(
 }
 
 template <Direction DIR>
-static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
+static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor,
+    const NonTbpDefinedIoTable *table) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   if (handler.InError()) {
     return false;
@@ -413,7 +457,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
     }
   }
   if (!io.get_if<FormattedIoStatementState<DIR>>()) {
-    return UnformattedDescriptorIO<DIR>(io, descriptor);
+    return UnformattedDescriptorIO<DIR>(io, descriptor, table);
   }
   if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
     TypeCategory cat{catAndKind->first};
@@ -509,7 +553,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
         return false;
       }
     case TypeCategory::Derived:
-      return FormattedDerivedTypeIO<DIR>(io, descriptor);
+      return FormattedDerivedTypeIO<DIR>(io, descriptor, table);
     }
   }
   handler.Crash("DescriptorIO: bad type code (%d) in descriptor",
diff --git a/flang/runtime/format-implementation.h b/flang/runtime/format-implementation.h
index 79063e2f9eba..0daacc6bcccb 100644
--- a/flang/runtime/format-implementation.h
+++ b/flang/runtime/format-implementation.h
@@ -423,7 +423,7 @@ std::optional<DataEdit> FormatControl<CONTEXT>::GetNextDataEdit(
       ++offset_;
     }
   } else if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
-    // DT['iotype'][(v_list)] user-defined derived type I/O
+    // DT['iotype'][(v_list)] defined I/O
     edit.descriptor = DataEdit::DefinedDerivedType;
     ++offset_;
     if (auto quote{static_cast<char>(PeekNext())};
diff --git a/flang/runtime/format.h b/flang/runtime/format.h
index 9077a849eaec..b9f8f73a48de 100644
--- a/flang/runtime/format.h
+++ b/flang/runtime/format.h
@@ -61,7 +61,7 @@ struct DataEdit {
     return IsListDirected() && modes.inNamelist;
   }
 
-  static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
+  static constexpr char DefinedDerivedType{'d'}; // DT defined I/O
 
   char variation{'\0'}; // N, S, or X for EN, ES, EX
   std::optional<int> width; // the 'w' field; optional for A
@@ -71,7 +71,7 @@ struct DataEdit {
   int repeat{1};
 
   // "iotype" &/or "v_list" values for a DT'iotype'(v_list)
-  // user-defined derived type data edit descriptor
+  // defined I/O data edit descriptor
   static constexpr std::size_t maxIoTypeChars{32};
   static constexpr std::size_t maxVListEntries{4};
   std::uint8_t ioTypeChars{0};
diff --git a/flang/runtime/io-api.cpp b/flang/runtime/io-api.cpp
index dd27c6c54dd6..09639c136c2a 100644
--- a/flang/runtime/io-api.cpp
+++ b/flang/runtime/io-api.cpp
@@ -1379,59 +1379,14 @@ bool IONAME(InputLogical)(Cookie cookie, bool &truth) {
   return descr::DescriptorIO<Direction::Input>(*cookie, descriptor);
 }
 
-template <Direction DIR>
-static bool DoDerivedTypeIo(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic, const char *which) {
-  IoStatementState &io{*cookie};
-  IoErrorHandler &handler{io.GetIoErrorHandler()};
-  if (handler.InError()) {
-    return false;
-  }
-  const DescriptorAddendum *addendum{descriptor.Addendum()};
-  const typeInfo::DerivedType *type{
-      addendum ? addendum->derivedType() : nullptr};
-  RUNTIME_CHECK(handler, type != nullptr);
-  if (!procedure) {
-    if constexpr (DIR == Direction::Output) {
-      return IONAME(OutputDescriptor)(cookie, descriptor);
-    } else {
-      return IONAME(InputDescriptor)(cookie, descriptor);
-    }
-  }
-  if (!io.get_if<IoDirectionState<DIR>>()) {
-    handler.Crash("%s called for I/O statement that is not %s", which,
-        DIR == Direction::Output ? "output" : "input");
-  }
-  std::uint8_t isArgDesc{isPolymorphic};
-  if (io.get_if<FormattedIoStatementState<DIR>>()) {
-    if (std::optional<bool> wasDefined{
-            descr::DefinedFormattedIo(io, descriptor, *type,
-                typeInfo::SpecialBinding{DIR == Direction::Output
-                        ? typeInfo::SpecialBinding::Which::WriteFormatted
-                        : typeInfo::SpecialBinding::Which::ReadFormatted,
-                    procedure, isArgDesc})}) {
-      return *wasDefined;
-    }
-    return descr::DefaultComponentwiseIO<DIR>(io, descriptor, *type);
-  } else { // unformatted
-    return descr::DefinedUnformattedIo(io, descriptor, *type,
-        typeInfo::SpecialBinding{DIR == Direction::Output
-                ? typeInfo::SpecialBinding::Which::WriteUnformatted
-                : typeInfo::SpecialBinding::Which::ReadUnformatted,
-            procedure, isArgDesc});
-  }
-}
-
 bool IONAME(OutputDerivedType)(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic) {
-  return DoDerivedTypeIo<Direction::Output>(
-      cookie, descriptor, procedure, isPolymorphic, "OutputDerivedType");
+    const NonTbpDefinedIoTable *table) {
+  return descr::DescriptorIO<Direction::Output>(*cookie, descriptor, table);
 }
 
 bool IONAME(InputDerivedType)(Cookie cookie, const Descriptor &descriptor,
-    void (*procedure)(), bool isPolymorphic) {
-  return DoDerivedTypeIo<Direction::Output>(
-      cookie, descriptor, procedure, isPolymorphic, "InputDerivedType");
+    const NonTbpDefinedIoTable *table) {
+  return descr::DescriptorIO<Direction::Input>(*cookie, descriptor, table);
 }
 
 std::size_t IONAME(GetSize)(Cookie cookie) {
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index 48761a90e4dc..71d6388a7f89 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -6,6 +6,11 @@
 //
 //===----------------------------------------------------------------------===//
 
+// TODO: When lowering has been updated to used the new pointer data member in
+// the NamelistGroup structure, delete this definition and the two #ifndef
+// directives below that test it.
+#define DISABLE_NON_TBP_DIO 1
+
 #include "namelist.h"
 #include "descriptor-io.h"
 #include "emit-encoded.h"
@@ -62,9 +67,20 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
     if (listOutput) {
       listOutput->set_lastWasUndelimitedCharacter(false);
     }
-    if (!(EmitWithAdvance(j == 0 ? ' ' : comma) && EmitUpperCase(item.name) &&
-            EmitWithAdvance('=') &&
-            descr::DescriptorIO<Direction::Output>(io, item.descriptor))) {
+    if (!EmitWithAdvance(j == 0 ? ' ' : comma) || !EmitUpperCase(item.name) ||
+        !EmitWithAdvance('=')) {
+      return false;
+    }
+    if (const auto *addendum{item.descriptor.Addendum()};
+        addendum && addendum->derivedType()) {
+      NonTbpDefinedIoTable *table{nullptr};
+#ifndef DISABLE_NON_TBP_DIO
+      table = group.nonTbpDefinedIo;
+#endif
+      if (!IONAME(OutputDerivedType)(cookie, item.descriptor, table)) {
+        return false;
+      }
+    } else if (!descr::DescriptorIO<Direction::Output>(io, item.descriptor)) {
       return false;
     }
   }
@@ -515,7 +531,16 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
     io.HandleRelativePosition(byteCount);
     // Read the values into the descriptor.  An array can be short.
     listInput->ResetForNextNamelistItem(useDescriptor->rank() > 0);
-    if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
+    if (const auto *addendum{useDescriptor->Addendum()};
+        addendum && addendum->derivedType()) {
+      NonTbpDefinedIoTable *table{nullptr};
+#ifndef DISABLE_NON_TBP_DIO
+      table = group.nonTbpDefinedIo;
+#endif
+      if (!IONAME(InputDerivedType)(cookie, *useDescriptor, table)) {
+        return false;
+      }
+    } else if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
       return false;
     }
     next = io.GetNextNonBlank(byteCount);
diff --git a/flang/runtime/namelist.h b/flang/runtime/namelist.h
index be40310cb0e0..9a5da33a907e 100644
--- a/flang/runtime/namelist.h
+++ b/flang/runtime/namelist.h
@@ -11,6 +11,8 @@
 #ifndef FORTRAN_RUNTIME_NAMELIST_H_
 #define FORTRAN_RUNTIME_NAMELIST_H_
 
+#include "non-tbp-dio.h"
+
 #include <cstddef>
 
 namespace Fortran::runtime {
@@ -30,9 +32,15 @@ public:
     const char *name; // NUL-terminated lower-case
     const Descriptor &descriptor;
   };
-  const char *groupName; // NUL-terminated lower-case
-  std::size_t items;
-  const Item *item; // in original declaration order
+  const char *groupName{nullptr}; // NUL-terminated lower-case
+  std::size_t items{0};
+  const Item *item{nullptr}; // in original declaration order
+
+  // When the uses of a namelist group appear in scopes with distinct sets
+  // of non-type-bound defined formatted I/O interfaces, they require the
+  // use of distinct NamelistGroups pointing to distinct NonTbpDefinedIoTables.
+  // Multiple NamelistGroup instances may share a NonTbpDefinedIoTable..
+  const NonTbpDefinedIoTable *nonTbpDefinedIo{nullptr};
 };
 
 // Look ahead on input for a '/' or an identifier followed by a '=', '(', or '%'
diff --git a/flang/runtime/non-tbp-dio.cpp b/flang/runtime/non-tbp-dio.cpp
new file mode 100644
index 000000000000..9419adb7631c
--- /dev/null
+++ b/flang/runtime/non-tbp-dio.cpp
@@ -0,0 +1,32 @@
+//===-- flang/runtime/non-tbp-dio.cpp ---------------------------*- 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
+//
+//===----------------------------------------------------------------------===//
+
+#include "non-tbp-dio.h"
+#include "type-info.h"
+
+namespace Fortran::runtime::io {
+
+const NonTbpDefinedIo *NonTbpDefinedIoTable::Find(
+    const typeInfo::DerivedType &type, common::DefinedIo definedIo) const {
+  std::size_t j{items};
+  for (const auto *p{item}; j-- > 0; ++p) {
+    if (&p->derivedType == &type && p->definedIo == definedIo) {
+      return p;
+    } else if (p->isDtvArgPolymorphic) {
+      for (const typeInfo::DerivedType *t{type.GetParentType()}; t;
+           t = t->GetParentType()) {
+        if (&p->derivedType == t && p->definedIo == definedIo) {
+          return p;
+        }
+      }
+    }
+  }
+  return nullptr;
+}
+
+} // namespace Fortran::runtime::io
diff --git a/flang/runtime/non-tbp-dio.h b/flang/runtime/non-tbp-dio.h
new file mode 100644
index 000000000000..49b23cea1954
--- /dev/null
+++ b/flang/runtime/non-tbp-dio.h
@@ -0,0 +1,55 @@
+//===-- flang/runtime/non-tbp-dio.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
+//
+//===----------------------------------------------------------------------===//
+
+// Defines a structure used to identify the non-type-bound defined I/O
+// generic interfaces that are accessible in a particular scope.  This
+// table is used by some I/O APIs and is also part of the NAMELIST
+// group table.
+//
+// A specific procedure for a particular derived type must appear in
+// this table if it (a) is a dummy procedure or procedure pointer,
+// (b) is part of the defined I/O generic definition in a scope other
+// than the one that contains the derived type definition, or (c)
+// is a null pointer signifying that some specific procedure from
+// a containing scope has become inaccessible in a nested scope due
+// to the use of "IMPORT, NONE" or "IMPORT, ONLY:".
+
+#ifndef FORTRAN_RUNTIME_NON_TBP_DIO_H_
+#define FORTRAN_RUNTIME_NON_TBP_DIO_H_
+
+#include "flang/Common/Fortran.h"
+#include <cstddef>
+
+namespace Fortran::runtime::typeInfo {
+class DerivedType;
+} // namespace Fortran::runtime::typeInfo
+
+namespace Fortran::runtime::io {
+
+struct NonTbpDefinedIo {
+  const typeInfo::DerivedType &derivedType;
+  void (*subroutine)(); // null means no non-TBP defined I/O here
+  common::DefinedIo definedIo;
+  bool isDtvArgPolymorphic; // first dummy arg is CLASS(T)
+};
+
+struct NonTbpDefinedIoTable {
+  const NonTbpDefinedIo *Find(
+      const typeInfo::DerivedType &, common::DefinedIo) const;
+  std::size_t items{0};
+  const NonTbpDefinedIo *item{nullptr};
+  // True when the only procedures to be used are the type-bound special
+  // procedures in the type information tables and any non-null procedures
+  // in this table.  When false, the entries in this table override whatever
+  // non-type-bound specific procedures might be in the type inforamtion,
+  // but the remaining specifics remain visible.
+  bool ignoreNonTbpEntries{false};
+};
+
+} // namespace Fortran::runtime::io
+#endif // FORTRAN_RUNTIME_NON_TBP_DIO_H_
diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h
index 63939d7fd9bc..3e6a51c57a3e 100644
--- a/flang/runtime/type-info.h
+++ b/flang/runtime/type-info.h
@@ -133,10 +133,12 @@ public:
     // higher-ranked final procedures follow
   };
 
-  // Special bindings can be created during execution to handle user-defined
-  // derived type I/O procedures that are not type-bound.
-  SpecialBinding(Which which, ProcedurePointer proc, std::uint8_t isArgDescSet)
-      : which_{which}, isArgDescriptorSet_{isArgDescSet}, proc_{proc} {}
+  // Special bindings can be created during execution to handle defined
+  // I/O procedures that are not type-bound.
+  SpecialBinding(Which which, ProcedurePointer proc, std::uint8_t isArgDescSet,
+      std::uint8_t isTypeBound)
+      : which_{which}, isArgDescriptorSet_{isArgDescSet},
+        isTypeBound_{isTypeBound}, proc_{proc} {}
 
   static constexpr Which RankFinal(int rank) {
     return static_cast<Which>(static_cast<int>(Which::ScalarFinal) + rank);
@@ -146,6 +148,7 @@ public:
   bool IsArgDescriptor(int zeroBasedArg) const {
     return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
   }
+  bool isTypeBound() const { return isTypeBound_; }
   template <typename PROC> PROC GetProc() const {
     return reinterpret_cast<PROC>(proc_);
   }
@@ -175,12 +178,13 @@ private:
   //     elemental final subroutine must be scalar and monomorphic, but
   //     use a descriptors when the type has LEN parameters.)
   //   Which::AssumedRankFinal: flag must necessarily be set
-  //   User derived type I/O:
+  //   Defined I/O:
   //     Set to 1 when "dtv" initial dummy argument is polymorphic, which is
   //     the case when and only when the derived type is extensible.
-  //     When false, the user derived type I/O subroutine must have been
+  //     When false, the defined I/O subroutine must have been
   //     called via a generic interface, not a generic TBP.
   std::uint8_t isArgDescriptorSet_{0};
+  std::uint8_t isTypeBound_{0};
 
   ProcedurePointer proc_{nullptr};
 };
diff --git a/flang/runtime/unit.h b/flang/runtime/unit.h
index aad896afce51..b6007a9b1538 100644
--- a/flang/runtime/unit.h
+++ b/flang/runtime/unit.h
@@ -165,14 +165,14 @@ private:
   // Points to the active alternative (if any) in u_ for use as a Cookie
   std::optional<IoStatementState> io_;
 
-  // A stack of child I/O pseudo-units for user-defined derived type
-  // I/O that have this unit number.
+  // A stack of child I/O pseudo-units for defined I/O that have this
+  // unit number.
   OwningPtr<ChildIo> child_;
 };
 
-// A pseudo-unit for child I/O statements in user-defined derived type
-// I/O subroutines; it forwards operations to the parent I/O statement,
-// which can also be a child I/O statement.
+// A pseudo-unit for child I/O statements in defined I/O subroutines;
+// it forwards operations to the parent I/O statement, which might also
+// be a child I/O statement.
 class ChildIo {
 public:
   ChildIo(IoStatementState &parent, OwningPtr<ChildIo> &&previous)