1 //===-- lib/Semantics/runtime-type-info.cpp ---------------------*- C++ -*-===//
2 //
3 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4 // See https://llvm.org/LICENSE.txt for license information.
5 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6 //
7 //===----------------------------------------------------------------------===//
8 
9 #include "flang/Semantics/runtime-type-info.h"
10 #include "mod-file.h"
11 #include "flang/Evaluate/fold-designator.h"
12 #include "flang/Evaluate/fold.h"
13 #include "flang/Evaluate/tools.h"
14 #include "flang/Evaluate/type.h"
15 #include "flang/Semantics/scope.h"
16 #include "flang/Semantics/tools.h"
17 #include <functional>
18 #include <list>
19 #include <map>
20 #include <string>
21 
22 namespace Fortran::semantics {
23 
24 static int FindLenParameterIndex(
25     const SymbolVector &parameters, const Symbol &symbol) {
26   int lenIndex{0};
27   for (SymbolRef ref : parameters) {
28     if (&*ref == &symbol) {
29       return lenIndex;
30     }
31     if (ref->get<TypeParamDetails>().attr() == common::TypeParamAttr::Len) {
32       ++lenIndex;
33     }
34   }
35   DIE("Length type parameter not found in parameter order");
36   return -1;
37 }
38 
39 class RuntimeTableBuilder {
40 public:
41   RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &);
42   void DescribeTypes(Scope &scope, bool inSchemata);
43 
44 private:
45   const Symbol *DescribeType(Scope &);
46   const Symbol &GetSchemaSymbol(const char *) const;
47   const DeclTypeSpec &GetSchema(const char *) const;
48   SomeExpr GetEnumValue(const char *) const;
49   Symbol &CreateObject(const std::string &, const DeclTypeSpec &, Scope &);
50   // The names of created symbols are saved in and owned by the
51   // RuntimeDerivedTypeTables instance returned by
52   // BuildRuntimeDerivedTypeTables() so that references to those names remain
53   // valid for lowering.
54   SourceName SaveObjectName(const std::string &);
55   SomeExpr SaveNameAsPointerTarget(Scope &, const std::string &);
56   const SymbolVector *GetTypeParameters(const Symbol &);
57   evaluate::StructureConstructor DescribeComponent(const Symbol &,
58       const ObjectEntityDetails &, Scope &, Scope &,
59       const std::string &distinctName, const SymbolVector *parameters);
60   evaluate::StructureConstructor DescribeComponent(
61       const Symbol &, const ProcEntityDetails &, Scope &);
62   bool InitializeDataPointer(evaluate::StructureConstructorValues &,
63       const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
64       Scope &dtScope, const std::string &distinctName);
65   evaluate::StructureConstructor PackageIntValue(
66       const SomeExpr &genre, std::int64_t = 0) const;
67   SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
68   std::vector<const Symbol *> CollectBindings(const Scope &dtScope) const;
69   std::vector<evaluate::StructureConstructor> DescribeBindings(
70       const Scope &dtScope, Scope &);
71   void DescribeGeneric(
72       const GenericDetails &, std::map<int, evaluate::StructureConstructor> &);
73   void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &,
74       const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
75       std::optional<GenericKind::DefinedIo>);
76   void IncorporateDefinedIoGenericInterfaces(
77       std::map<int, evaluate::StructureConstructor> &, SourceName,
78       GenericKind::DefinedIo, const Scope *);
79 
80   // Instantiated for ParamValue and Bound
81   template <typename A>
82   evaluate::StructureConstructor GetValue(
83       const A &x, const SymbolVector *parameters) {
84     if (x.isExplicit()) {
85       return GetValue(x.GetExplicit(), parameters);
86     } else {
87       return PackageIntValue(deferredEnum_);
88     }
89   }
90 
91   // Specialization for optional<Expr<SomeInteger and SubscriptInteger>>
92   template <typename T>
93   evaluate::StructureConstructor GetValue(
94       const std::optional<evaluate::Expr<T>> &expr,
95       const SymbolVector *parameters) {
96     if (auto constValue{evaluate::ToInt64(expr)}) {
97       return PackageIntValue(explicitEnum_, *constValue);
98     }
99     if (expr) {
100       if (parameters) {
101         if (const Symbol * lenParam{evaluate::ExtractBareLenParameter(*expr)}) {
102           return PackageIntValue(
103               lenParameterEnum_, FindLenParameterIndex(*parameters, *lenParam));
104         }
105       }
106       context_.Say(location_,
107           "Specification expression '%s' is neither constant nor a length "
108           "type parameter"_err_en_US,
109           expr->AsFortran());
110     }
111     return PackageIntValue(deferredEnum_);
112   }
113 
114   SemanticsContext &context_;
115   RuntimeDerivedTypeTables &tables_;
116   std::map<const Symbol *, SymbolVector> orderedTypeParameters_;
117   int anonymousTypes_{0};
118 
119   const DeclTypeSpec &derivedTypeSchema_; // TYPE(DerivedType)
120   const DeclTypeSpec &componentSchema_; // TYPE(Component)
121   const DeclTypeSpec &procPtrSchema_; // TYPE(ProcPtrComponent)
122   const DeclTypeSpec &valueSchema_; // TYPE(Value)
123   const DeclTypeSpec &bindingSchema_; // TYPE(Binding)
124   const DeclTypeSpec &specialSchema_; // TYPE(SpecialBinding)
125   SomeExpr deferredEnum_; // Value::Genre::Deferred
126   SomeExpr explicitEnum_; // Value::Genre::Explicit
127   SomeExpr lenParameterEnum_; // Value::Genre::LenParameter
128   SomeExpr scalarAssignmentEnum_; // SpecialBinding::Which::ScalarAssignment
129   SomeExpr
130       elementalAssignmentEnum_; // SpecialBinding::Which::ElementalAssignment
131   SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
132   SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted
133   SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
134   SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
135   SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
136   SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
137   SomeExpr scalarFinalEnum_; // SpecialBinding::Which::ScalarFinal
138   parser::CharBlock location_;
139   std::set<const Scope *> ignoreScopes_;
140 };
141 
142 RuntimeTableBuilder::RuntimeTableBuilder(
143     SemanticsContext &c, RuntimeDerivedTypeTables &t)
144     : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
145       componentSchema_{GetSchema("component")}, procPtrSchema_{GetSchema(
146                                                     "procptrcomponent")},
147       valueSchema_{GetSchema("value")}, bindingSchema_{GetSchema("binding")},
148       specialSchema_{GetSchema("specialbinding")}, deferredEnum_{GetEnumValue(
149                                                        "deferred")},
150       explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
151                                                    "lenparameter")},
152       scalarAssignmentEnum_{GetEnumValue("scalarassignment")},
153       elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
154       readFormattedEnum_{GetEnumValue("readformatted")},
155       readUnformattedEnum_{GetEnumValue("readunformatted")},
156       writeFormattedEnum_{GetEnumValue("writeformatted")},
157       writeUnformattedEnum_{GetEnumValue("writeunformatted")},
158       elementalFinalEnum_{GetEnumValue("elementalfinal")},
159       assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
160       scalarFinalEnum_{GetEnumValue("scalarfinal")} {
161   ignoreScopes_.insert(tables_.schemata);
162 }
163 
164 void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) {
165   inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end();
166   if (scope.IsDerivedType()) {
167     if (!inSchemata) { // don't loop trying to describe a schema
168       DescribeType(scope);
169     }
170   } else {
171     scope.InstantiateDerivedTypes();
172   }
173   for (Scope &child : scope.children()) {
174     DescribeTypes(child, inSchemata);
175   }
176 }
177 
178 // Returns derived type instantiation's parameters in declaration order
179 const SymbolVector *RuntimeTableBuilder::GetTypeParameters(
180     const Symbol &symbol) {
181   auto iter{orderedTypeParameters_.find(&symbol)};
182   if (iter != orderedTypeParameters_.end()) {
183     return &iter->second;
184   } else {
185     return &orderedTypeParameters_
186                 .emplace(&symbol, OrderParameterDeclarations(symbol))
187                 .first->second;
188   }
189 }
190 
191 static Scope &GetContainingNonDerivedScope(Scope &scope) {
192   Scope *p{&scope};
193   while (p->IsDerivedType()) {
194     p = &p->parent();
195   }
196   return *p;
197 }
198 
199 static const Symbol &GetSchemaField(
200     const DerivedTypeSpec &derived, const std::string &name) {
201   const Scope &scope{
202       DEREF(derived.scope() ? derived.scope() : derived.typeSymbol().scope())};
203   auto iter{scope.find(SourceName(name))};
204   CHECK(iter != scope.end());
205   return *iter->second;
206 }
207 
208 static const Symbol &GetSchemaField(
209     const DeclTypeSpec &derived, const std::string &name) {
210   return GetSchemaField(DEREF(derived.AsDerived()), name);
211 }
212 
213 static evaluate::StructureConstructorValues &AddValue(
214     evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
215     const std::string &name, SomeExpr &&x) {
216   values.emplace(GetSchemaField(spec, name), std::move(x));
217   return values;
218 }
219 
220 static evaluate::StructureConstructorValues &AddValue(
221     evaluate::StructureConstructorValues &values, const DeclTypeSpec &spec,
222     const std::string &name, const SomeExpr &x) {
223   values.emplace(GetSchemaField(spec, name), x);
224   return values;
225 }
226 
227 static SomeExpr IntToExpr(std::int64_t n) {
228   return evaluate::AsGenericExpr(evaluate::ExtentExpr{n});
229 }
230 
231 static evaluate::StructureConstructor Structure(
232     const DeclTypeSpec &spec, evaluate::StructureConstructorValues &&values) {
233   return {DEREF(spec.AsDerived()), std::move(values)};
234 }
235 
236 static SomeExpr StructureExpr(evaluate::StructureConstructor &&x) {
237   return SomeExpr{evaluate::Expr<evaluate::SomeDerived>{std::move(x)}};
238 }
239 
240 static int GetIntegerKind(const Symbol &symbol) {
241   auto dyType{evaluate::DynamicType::From(symbol)};
242   CHECK(dyType && dyType->category() == TypeCategory::Integer);
243   return dyType->kind();
244 }
245 
246 static void SetReadOnlyCompilerCreatedFlags(Symbol &symbol) {
247   symbol.set(Symbol::Flag::CompilerCreated);
248   // Runtime type info symbols may have types that are incompatible with the
249   // PARAMETER attribute (the main issue is that they may be TARGET, and normal
250   // Fortran parameters cannot be TARGETs).
251   if (symbol.has<semantics::ObjectEntityDetails>() ||
252       symbol.has<semantics::ProcEntityDetails>()) {
253     symbol.set(Symbol::Flag::ReadOnly);
254   }
255 }
256 
257 // Save a rank-1 array constant of some numeric type as an
258 // initialized data object in a scope.
259 template <typename T>
260 static SomeExpr SaveNumericPointerTarget(
261     Scope &scope, SourceName name, std::vector<typename T::Scalar> &&x) {
262   if (x.empty()) {
263     return SomeExpr{evaluate::NullPointer{}};
264   } else {
265     ObjectEntityDetails object;
266     if (const auto *spec{scope.FindType(
267             DeclTypeSpec{NumericTypeSpec{T::category, KindExpr{T::kind}}})}) {
268       object.set_type(*spec);
269     } else {
270       object.set_type(scope.MakeNumericType(T::category, KindExpr{T::kind}));
271     }
272     auto elements{static_cast<evaluate::ConstantSubscript>(x.size())};
273     ArraySpec arraySpec;
274     arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{elements - 1}));
275     object.set_shape(arraySpec);
276     object.set_init(evaluate::AsGenericExpr(evaluate::Constant<T>{
277         std::move(x), evaluate::ConstantSubscripts{elements}}));
278     Symbol &symbol{*scope
279                         .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
280                             std::move(object))
281                         .first->second};
282     SetReadOnlyCompilerCreatedFlags(symbol);
283     return evaluate::AsGenericExpr(
284         evaluate::Expr<T>{evaluate::Designator<T>{symbol}});
285   }
286 }
287 
288 // Save an arbitrarily shaped array constant of some derived type
289 // as an initialized data object in a scope.
290 static SomeExpr SaveDerivedPointerTarget(Scope &scope, SourceName name,
291     std::vector<evaluate::StructureConstructor> &&x,
292     evaluate::ConstantSubscripts &&shape) {
293   if (x.empty()) {
294     return SomeExpr{evaluate::NullPointer{}};
295   } else {
296     const auto &derivedType{x.front().GetType().GetDerivedTypeSpec()};
297     ObjectEntityDetails object;
298     DeclTypeSpec typeSpec{DeclTypeSpec::TypeDerived, derivedType};
299     if (const DeclTypeSpec * spec{scope.FindType(typeSpec)}) {
300       object.set_type(*spec);
301     } else {
302       object.set_type(scope.MakeDerivedType(
303           DeclTypeSpec::TypeDerived, common::Clone(derivedType)));
304     }
305     if (!shape.empty()) {
306       ArraySpec arraySpec;
307       for (auto n : shape) {
308         arraySpec.push_back(ShapeSpec::MakeExplicit(Bound{0}, Bound{n - 1}));
309       }
310       object.set_shape(arraySpec);
311     }
312     object.set_init(
313         evaluate::AsGenericExpr(evaluate::Constant<evaluate::SomeDerived>{
314             derivedType, std::move(x), std::move(shape)}));
315     Symbol &symbol{*scope
316                         .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
317                             std::move(object))
318                         .first->second};
319     SetReadOnlyCompilerCreatedFlags(symbol);
320     return evaluate::AsGenericExpr(
321         evaluate::Designator<evaluate::SomeDerived>{symbol});
322   }
323 }
324 
325 static SomeExpr SaveObjectInit(
326     Scope &scope, SourceName name, const ObjectEntityDetails &object) {
327   Symbol &symbol{*scope
328                       .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
329                           ObjectEntityDetails{object})
330                       .first->second};
331   CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
332   SetReadOnlyCompilerCreatedFlags(symbol);
333   return evaluate::AsGenericExpr(
334       evaluate::Designator<evaluate::SomeDerived>{symbol});
335 }
336 
337 template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
338   return evaluate::AsGenericExpr(
339       evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
340 }
341 
342 const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
343   if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) {
344     return info;
345   }
346   const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()};
347   if (!derivedTypeSpec && !dtScope.IsParameterizedDerivedType() &&
348       dtScope.symbol()) {
349     // This derived type was declared (obviously, there's a Scope) but never
350     // used in this compilation (no instantiated DerivedTypeSpec points here).
351     // Create a DerivedTypeSpec now for it so that ComponentIterator
352     // will work. This covers the case of a derived type that's declared in
353     // a module but used only by clients and submodules, enabling the
354     // run-time "no initialization needed here" flag to work.
355     DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()};
356     DeclTypeSpec &decl{
357         dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))};
358     derivedTypeSpec = &decl.derivedTypeSpec();
359   }
360   const Symbol *dtSymbol{
361       derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
362   if (!dtSymbol) {
363     return nullptr;
364   }
365   auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
366   // Check for an existing description that can be imported from a USE'd module
367   std::string typeName{dtSymbol->name().ToString()};
368   if (typeName.empty() ||
369       (typeName.front() == '.' && !context_.IsTempName(typeName))) {
370     return nullptr;
371   }
372   std::string distinctName{typeName};
373   if (&dtScope != dtSymbol->scope()) {
374     distinctName += "."s + std::to_string(anonymousTypes_++);
375   }
376   std::string dtDescName{".dt."s + distinctName};
377   Scope &scope{GetContainingNonDerivedScope(dtScope)};
378   if (distinctName == typeName && scope.IsModule()) {
379     if (const Symbol * description{scope.FindSymbol(SourceName{dtDescName})}) {
380       dtScope.set_runtimeDerivedTypeDescription(*description);
381       return description;
382     }
383   }
384   // Create a new description object before populating it so that mutual
385   // references will work as pointer targets.
386   Symbol &dtObject{CreateObject(dtDescName, derivedTypeSchema_, scope)};
387   dtScope.set_runtimeDerivedTypeDescription(dtObject);
388   evaluate::StructureConstructorValues dtValues;
389   AddValue(dtValues, derivedTypeSchema_, "name"s,
390       SaveNameAsPointerTarget(scope, typeName));
391   bool isPDTdefinition{
392       !derivedTypeSpec && dtScope.IsParameterizedDerivedType()};
393   if (!isPDTdefinition) {
394     auto sizeInBytes{static_cast<common::ConstantSubscript>(dtScope.size())};
395     if (auto alignment{dtScope.alignment().value_or(0)}) {
396       sizeInBytes += alignment - 1;
397       sizeInBytes /= alignment;
398       sizeInBytes *= alignment;
399     }
400     AddValue(
401         dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
402   }
403   bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
404   if (isPDTinstantiation) {
405     // is PDT instantiation
406     const Symbol *uninstDescObject{
407         DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
408     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
409         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
410             evaluate::Designator<evaluate::SomeDerived>{
411                 DEREF(uninstDescObject)}}));
412   } else {
413     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
414         SomeExpr{evaluate::NullPointer{}});
415   }
416   using Int8 = evaluate::Type<TypeCategory::Integer, 8>;
417   using Int1 = evaluate::Type<TypeCategory::Integer, 1>;
418   std::vector<Int8::Scalar> kinds;
419   std::vector<Int1::Scalar> lenKinds;
420   const SymbolVector *parameters{GetTypeParameters(*dtSymbol)};
421   if (parameters) {
422     // Package the derived type's parameters in declaration order for
423     // each category of parameter.  KIND= type parameters are described
424     // by their instantiated (or default) values, while LEN= type
425     // parameters are described by their INTEGER kinds.
426     for (SymbolRef ref : *parameters) {
427       const auto &tpd{ref->get<TypeParamDetails>()};
428       if (tpd.attr() == common::TypeParamAttr::Kind) {
429         auto value{evaluate::ToInt64(tpd.init()).value_or(0)};
430         if (derivedTypeSpec) {
431           if (const auto *pv{derivedTypeSpec->FindParameter(ref->name())}) {
432             if (pv->GetExplicit()) {
433               if (auto instantiatedValue{
434                       evaluate::ToInt64(*pv->GetExplicit())}) {
435                 value = *instantiatedValue;
436               }
437             }
438           }
439         }
440         kinds.emplace_back(value);
441       } else { // LEN= parameter
442         lenKinds.emplace_back(GetIntegerKind(*ref));
443       }
444     }
445   }
446   AddValue(dtValues, derivedTypeSchema_, "kindparameter"s,
447       SaveNumericPointerTarget<Int8>(
448           scope, SaveObjectName(".kp."s + distinctName), std::move(kinds)));
449   AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s,
450       SaveNumericPointerTarget<Int1>(
451           scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
452   // Traverse the components of the derived type
453   if (!isPDTdefinition) {
454     std::vector<const Symbol *> dataComponentSymbols;
455     std::vector<evaluate::StructureConstructor> procPtrComponents;
456     std::map<int, evaluate::StructureConstructor> specials;
457     for (const auto &pair : dtScope) {
458       const Symbol &symbol{*pair.second};
459       auto locationRestorer{common::ScopedSet(location_, symbol.name())};
460       std::visit(
461           common::visitors{
462               [&](const TypeParamDetails &) {
463                 // already handled above in declaration order
464               },
465               [&](const ObjectEntityDetails &) {
466                 dataComponentSymbols.push_back(&symbol);
467               },
468               [&](const ProcEntityDetails &proc) {
469                 if (IsProcedurePointer(symbol)) {
470                   procPtrComponents.emplace_back(
471                       DescribeComponent(symbol, proc, scope));
472                 }
473               },
474               [&](const ProcBindingDetails &) { // handled in a later pass
475               },
476               [&](const GenericDetails &generic) {
477                 DescribeGeneric(generic, specials);
478               },
479               [&](const auto &) {
480                 common::die(
481                     "unexpected details on symbol '%s' in derived type scope",
482                     symbol.name().ToString().c_str());
483               },
484           },
485           symbol.details());
486     }
487     // Sort the data component symbols by offset before emitting them
488     std::sort(dataComponentSymbols.begin(), dataComponentSymbols.end(),
489         [](const Symbol *x, const Symbol *y) {
490           return x->offset() < y->offset();
491         });
492     std::vector<evaluate::StructureConstructor> dataComponents;
493     for (const Symbol *symbol : dataComponentSymbols) {
494       auto locationRestorer{common::ScopedSet(location_, symbol->name())};
495       dataComponents.emplace_back(
496           DescribeComponent(*symbol, symbol->get<ObjectEntityDetails>(), scope,
497               dtScope, distinctName, parameters));
498     }
499     AddValue(dtValues, derivedTypeSchema_, "component"s,
500         SaveDerivedPointerTarget(scope, SaveObjectName(".c."s + distinctName),
501             std::move(dataComponents),
502             evaluate::ConstantSubscripts{
503                 static_cast<evaluate::ConstantSubscript>(
504                     dataComponents.size())}));
505     AddValue(dtValues, derivedTypeSchema_, "procptr"s,
506         SaveDerivedPointerTarget(scope, SaveObjectName(".p."s + distinctName),
507             std::move(procPtrComponents),
508             evaluate::ConstantSubscripts{
509                 static_cast<evaluate::ConstantSubscript>(
510                     procPtrComponents.size())}));
511     // Compile the "vtable" of type-bound procedure bindings
512     std::vector<evaluate::StructureConstructor> bindings{
513         DescribeBindings(dtScope, scope)};
514     AddValue(dtValues, derivedTypeSchema_, "binding"s,
515         SaveDerivedPointerTarget(scope, SaveObjectName(".v."s + distinctName),
516             std::move(bindings),
517             evaluate::ConstantSubscripts{
518                 static_cast<evaluate::ConstantSubscript>(bindings.size())}));
519     // Describe "special" bindings to defined assignments, FINAL subroutines,
520     // and user-defined derived type I/O subroutines.
521     const DerivedTypeDetails &dtDetails{dtSymbol->get<DerivedTypeDetails>()};
522     for (const auto &pair : dtDetails.finals()) {
523       DescribeSpecialProc(
524           specials, *pair.second, false /*!isAssignment*/, true, std::nullopt);
525     }
526     IncorporateDefinedIoGenericInterfaces(specials,
527         SourceName{"read(formatted)", 15},
528         GenericKind::DefinedIo::ReadFormatted, &scope);
529     IncorporateDefinedIoGenericInterfaces(specials,
530         SourceName{"read(unformatted)", 17},
531         GenericKind::DefinedIo::ReadUnformatted, &scope);
532     IncorporateDefinedIoGenericInterfaces(specials,
533         SourceName{"write(formatted)", 16},
534         GenericKind::DefinedIo::WriteFormatted, &scope);
535     IncorporateDefinedIoGenericInterfaces(specials,
536         SourceName{"write(unformatted)", 18},
537         GenericKind::DefinedIo::WriteUnformatted, &scope);
538     // Pack the special procedure bindings in ascending order of their "which"
539     // code values, and compile a little-endian bit-set of those codes for
540     // use in O(1) look-up at run time.
541     std::vector<evaluate::StructureConstructor> sortedSpecials;
542     std::uint32_t specialBitSet{0};
543     for (auto &pair : specials) {
544       auto bit{std::uint32_t{1} << pair.first};
545       CHECK(!(specialBitSet & bit));
546       specialBitSet |= bit;
547       sortedSpecials.emplace_back(std::move(pair.second));
548     }
549     AddValue(dtValues, derivedTypeSchema_, "special"s,
550         SaveDerivedPointerTarget(scope, SaveObjectName(".s."s + distinctName),
551             std::move(sortedSpecials),
552             evaluate::ConstantSubscripts{
553                 static_cast<evaluate::ConstantSubscript>(specials.size())}));
554     AddValue(dtValues, derivedTypeSchema_, "specialbitset"s,
555         IntExpr<4>(specialBitSet));
556     // Note the presence/absence of a parent component
557     AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
558         IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
559     // To avoid wasting run time attempting to initialize derived type
560     // instances without any initialized components, analyze the type
561     // and set a flag if there's nothing to do for it at run time.
562     AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
563         IntExpr<1>(
564             derivedTypeSpec && !derivedTypeSpec->HasDefaultInitialization()));
565     // Similarly, a flag to short-circuit destruction when not needed.
566     AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
567         IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
568     // Similarly, a flag to short-circuit finalization when not needed.
569     AddValue(dtValues, derivedTypeSchema_, "nofinalizationneeded"s,
570         IntExpr<1>(derivedTypeSpec && !IsFinalizable(*derivedTypeSpec)));
571   }
572   dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
573       StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
574   return &dtObject;
575 }
576 
577 static const Symbol &GetSymbol(const Scope &schemata, SourceName name) {
578   auto iter{schemata.find(name)};
579   CHECK(iter != schemata.end());
580   const Symbol &symbol{*iter->second};
581   return symbol;
582 }
583 
584 const Symbol &RuntimeTableBuilder::GetSchemaSymbol(const char *name) const {
585   return GetSymbol(
586       DEREF(tables_.schemata), SourceName{name, std::strlen(name)});
587 }
588 
589 const DeclTypeSpec &RuntimeTableBuilder::GetSchema(
590     const char *schemaName) const {
591   Scope &schemata{DEREF(tables_.schemata)};
592   SourceName name{schemaName, std::strlen(schemaName)};
593   const Symbol &symbol{GetSymbol(schemata, name)};
594   CHECK(symbol.has<DerivedTypeDetails>());
595   CHECK(symbol.scope());
596   CHECK(symbol.scope()->IsDerivedType());
597   const DeclTypeSpec *spec{nullptr};
598   if (symbol.scope()->derivedTypeSpec()) {
599     DeclTypeSpec typeSpec{
600         DeclTypeSpec::TypeDerived, *symbol.scope()->derivedTypeSpec()};
601     spec = schemata.FindType(typeSpec);
602   }
603   if (!spec) {
604     DeclTypeSpec typeSpec{
605         DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol}};
606     spec = schemata.FindType(typeSpec);
607   }
608   if (!spec) {
609     spec = &schemata.MakeDerivedType(
610         DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol});
611   }
612   CHECK(spec->AsDerived());
613   return *spec;
614 }
615 
616 SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
617   const Symbol &symbol{GetSchemaSymbol(name)};
618   auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
619   CHECK(value.has_value());
620   return IntExpr<1>(*value);
621 }
622 
623 Symbol &RuntimeTableBuilder::CreateObject(
624     const std::string &name, const DeclTypeSpec &type, Scope &scope) {
625   ObjectEntityDetails object;
626   object.set_type(type);
627   auto pair{scope.try_emplace(SaveObjectName(name),
628       Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))};
629   CHECK(pair.second);
630   Symbol &result{*pair.first->second};
631   SetReadOnlyCompilerCreatedFlags(result);
632   return result;
633 }
634 
635 SourceName RuntimeTableBuilder::SaveObjectName(const std::string &name) {
636   return *tables_.names.insert(name).first;
637 }
638 
639 SomeExpr RuntimeTableBuilder::SaveNameAsPointerTarget(
640     Scope &scope, const std::string &name) {
641   CHECK(!name.empty());
642   CHECK(name.front() != '.' || context_.IsTempName(name));
643   ObjectEntityDetails object;
644   auto len{static_cast<common::ConstantSubscript>(name.size())};
645   if (const auto *spec{scope.FindType(DeclTypeSpec{CharacterTypeSpec{
646           ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}}})}) {
647     object.set_type(*spec);
648   } else {
649     object.set_type(scope.MakeCharacterType(
650         ParamValue{len, common::TypeParamAttr::Len}, KindExpr{1}));
651   }
652   using evaluate::Ascii;
653   using AsciiExpr = evaluate::Expr<Ascii>;
654   object.set_init(evaluate::AsGenericExpr(AsciiExpr{name}));
655   Symbol &symbol{*scope
656                       .try_emplace(SaveObjectName(".n."s + name),
657                           Attrs{Attr::TARGET, Attr::SAVE}, std::move(object))
658                       .first->second};
659   SetReadOnlyCompilerCreatedFlags(symbol);
660   return evaluate::AsGenericExpr(
661       AsciiExpr{evaluate::Designator<Ascii>{symbol}});
662 }
663 
664 evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
665     const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
666     Scope &dtScope, const std::string &distinctName,
667     const SymbolVector *parameters) {
668   evaluate::StructureConstructorValues values;
669   auto &foldingContext{context_.foldingContext()};
670   auto typeAndShape{evaluate::characteristics::TypeAndShape::Characterize(
671       symbol, foldingContext)};
672   CHECK(typeAndShape.has_value());
673   auto dyType{typeAndShape->type()};
674   const auto &shape{typeAndShape->shape()};
675   AddValue(values, componentSchema_, "name"s,
676       SaveNameAsPointerTarget(scope, symbol.name().ToString()));
677   AddValue(values, componentSchema_, "category"s,
678       IntExpr<1>(static_cast<int>(dyType.category())));
679   if (dyType.IsUnlimitedPolymorphic() ||
680       dyType.category() == TypeCategory::Derived) {
681     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(0));
682   } else {
683     AddValue(values, componentSchema_, "kind"s, IntExpr<1>(dyType.kind()));
684   }
685   AddValue(values, componentSchema_, "offset"s, IntExpr<8>(symbol.offset()));
686   // CHARACTER length
687   auto len{typeAndShape->LEN()};
688   if (const semantics::DerivedTypeSpec *
689       pdtInstance{dtScope.derivedTypeSpec()}) {
690     auto restorer{foldingContext.WithPDTInstance(*pdtInstance)};
691     len = Fold(foldingContext, std::move(len));
692   }
693   if (dyType.category() == TypeCategory::Character && len) {
694     // Ignore IDIM(x) (represented as MAX(0, x))
695     if (const auto *clamped{evaluate::UnwrapExpr<
696             evaluate::Extremum<evaluate::SubscriptInteger>>(*len)}) {
697       if (clamped->ordering == evaluate::Ordering::Greater &&
698           clamped->left() == evaluate::Expr<evaluate::SubscriptInteger>{0}) {
699         len = clamped->right();
700       }
701     }
702     AddValue(values, componentSchema_, "characterlen"s,
703         evaluate::AsGenericExpr(GetValue(len, parameters)));
704   } else {
705     AddValue(values, componentSchema_, "characterlen"s,
706         PackageIntValueExpr(deferredEnum_));
707   }
708   // Describe component's derived type
709   std::vector<evaluate::StructureConstructor> lenParams;
710   if (dyType.category() == TypeCategory::Derived &&
711       !dyType.IsUnlimitedPolymorphic()) {
712     const DerivedTypeSpec &spec{dyType.GetDerivedTypeSpec()};
713     Scope *derivedScope{const_cast<Scope *>(
714         spec.scope() ? spec.scope() : spec.typeSymbol().scope())};
715     const Symbol *derivedDescription{DescribeType(DEREF(derivedScope))};
716     AddValue(values, componentSchema_, "derived"s,
717         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
718             evaluate::Designator<evaluate::SomeDerived>{
719                 DEREF(derivedDescription)}}));
720     // Package values of LEN parameters, if any
721     if (const SymbolVector * specParams{GetTypeParameters(spec.typeSymbol())}) {
722       for (SymbolRef ref : *specParams) {
723         const auto &tpd{ref->get<TypeParamDetails>()};
724         if (tpd.attr() == common::TypeParamAttr::Len) {
725           if (const ParamValue * paramValue{spec.FindParameter(ref->name())}) {
726             lenParams.emplace_back(GetValue(*paramValue, parameters));
727           } else {
728             lenParams.emplace_back(GetValue(tpd.init(), parameters));
729           }
730         }
731       }
732     }
733   } else {
734     // Subtle: a category of Derived with a null derived type pointer
735     // signifies CLASS(*)
736     AddValue(values, componentSchema_, "derived"s,
737         SomeExpr{evaluate::NullPointer{}});
738   }
739   // LEN type parameter values for the component's type
740   if (!lenParams.empty()) {
741     AddValue(values, componentSchema_, "lenvalue"s,
742         SaveDerivedPointerTarget(scope,
743             SaveObjectName(
744                 ".lv."s + distinctName + "."s + symbol.name().ToString()),
745             std::move(lenParams),
746             evaluate::ConstantSubscripts{
747                 static_cast<evaluate::ConstantSubscript>(lenParams.size())}));
748   } else {
749     AddValue(values, componentSchema_, "lenvalue"s,
750         SomeExpr{evaluate::NullPointer{}});
751   }
752   // Shape information
753   int rank{evaluate::GetRank(shape)};
754   AddValue(values, componentSchema_, "rank"s, IntExpr<1>(rank));
755   if (rank > 0 && !IsAllocatable(symbol) && !IsPointer(symbol)) {
756     std::vector<evaluate::StructureConstructor> bounds;
757     evaluate::NamedEntity entity{symbol};
758     for (int j{0}; j < rank; ++j) {
759       bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound(
760                                        foldingContext, entity, j)),
761           parameters));
762       bounds.emplace_back(GetValue(
763           evaluate::GetUpperBound(foldingContext, entity, j), parameters));
764     }
765     AddValue(values, componentSchema_, "bounds"s,
766         SaveDerivedPointerTarget(scope,
767             SaveObjectName(
768                 ".b."s + distinctName + "."s + symbol.name().ToString()),
769             std::move(bounds), evaluate::ConstantSubscripts{2, rank}));
770   } else {
771     AddValue(
772         values, componentSchema_, "bounds"s, SomeExpr{evaluate::NullPointer{}});
773   }
774   // Default component initialization
775   bool hasDataInit{false};
776   if (IsAllocatable(symbol)) {
777     AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
778   } else if (IsPointer(symbol)) {
779     AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
780     hasDataInit = InitializeDataPointer(
781         values, symbol, object, scope, dtScope, distinctName);
782   } else if (IsAutomatic(symbol)) {
783     AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic"));
784   } else {
785     AddValue(values, componentSchema_, "genre"s, GetEnumValue("data"));
786     hasDataInit = object.init().has_value();
787     if (hasDataInit) {
788       AddValue(values, componentSchema_, "initialization"s,
789           SaveObjectInit(scope,
790               SaveObjectName(
791                   ".di."s + distinctName + "."s + symbol.name().ToString()),
792               object));
793     }
794   }
795   if (!hasDataInit) {
796     AddValue(values, componentSchema_, "initialization"s,
797         SomeExpr{evaluate::NullPointer{}});
798   }
799   return {DEREF(componentSchema_.AsDerived()), std::move(values)};
800 }
801 
802 evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
803     const Symbol &symbol, const ProcEntityDetails &proc, Scope &scope) {
804   evaluate::StructureConstructorValues values;
805   AddValue(values, procPtrSchema_, "name"s,
806       SaveNameAsPointerTarget(scope, symbol.name().ToString()));
807   AddValue(values, procPtrSchema_, "offset"s, IntExpr<8>(symbol.offset()));
808   if (auto init{proc.init()}; init && *init) {
809     AddValue(values, procPtrSchema_, "initialization"s,
810         SomeExpr{evaluate::ProcedureDesignator{**init}});
811   } else {
812     AddValue(values, procPtrSchema_, "initialization"s,
813         SomeExpr{evaluate::NullPointer{}});
814   }
815   return {DEREF(procPtrSchema_.AsDerived()), std::move(values)};
816 }
817 
818 // Create a static pointer object with the same initialization
819 // from whence the runtime can memcpy() the data pointer
820 // component initialization.
821 // Creates and interconnects the symbols, scopes, and types for
822 //   TYPE :: ptrDt
823 //     type, POINTER :: name
824 //   END TYPE
825 //   TYPE(ptrDt), TARGET, SAVE :: ptrInit = ptrDt(designator)
826 // and then initializes the original component by setting
827 //   initialization = ptrInit
828 // which takes the address of ptrInit because the type is C_PTR.
829 // This technique of wrapping the data pointer component into
830 // a derived type instance disables any reason for lowering to
831 // attempt to dereference the RHS of an initializer, thereby
832 // allowing the runtime to actually perform the initialization
833 // by means of a simple memcpy() of the wrapped descriptor in
834 // ptrInit to the data pointer component being initialized.
835 bool RuntimeTableBuilder::InitializeDataPointer(
836     evaluate::StructureConstructorValues &values, const Symbol &symbol,
837     const ObjectEntityDetails &object, Scope &scope, Scope &dtScope,
838     const std::string &distinctName) {
839   if (object.init().has_value()) {
840     SourceName ptrDtName{SaveObjectName(
841         ".dp."s + distinctName + "."s + symbol.name().ToString())};
842     Symbol &ptrDtSym{
843         *scope.try_emplace(ptrDtName, Attrs{}, UnknownDetails{}).first->second};
844     SetReadOnlyCompilerCreatedFlags(ptrDtSym);
845     Scope &ptrDtScope{scope.MakeScope(Scope::Kind::DerivedType, &ptrDtSym)};
846     ignoreScopes_.insert(&ptrDtScope);
847     ObjectEntityDetails ptrDtObj;
848     ptrDtObj.set_type(DEREF(object.type()));
849     ptrDtObj.set_shape(object.shape());
850     Symbol &ptrDtComp{*ptrDtScope
851                            .try_emplace(symbol.name(), Attrs{Attr::POINTER},
852                                std::move(ptrDtObj))
853                            .first->second};
854     DerivedTypeDetails ptrDtDetails;
855     ptrDtDetails.add_component(ptrDtComp);
856     ptrDtSym.set_details(std::move(ptrDtDetails));
857     ptrDtSym.set_scope(&ptrDtScope);
858     DeclTypeSpec &ptrDtDeclType{
859         scope.MakeDerivedType(DeclTypeSpec::Category::TypeDerived,
860             DerivedTypeSpec{ptrDtName, ptrDtSym})};
861     DerivedTypeSpec &ptrDtDerived{DEREF(ptrDtDeclType.AsDerived())};
862     ptrDtDerived.set_scope(ptrDtScope);
863     ptrDtDerived.CookParameters(context_.foldingContext());
864     ptrDtDerived.Instantiate(scope);
865     ObjectEntityDetails ptrInitObj;
866     ptrInitObj.set_type(ptrDtDeclType);
867     evaluate::StructureConstructorValues ptrInitValues;
868     AddValue(
869         ptrInitValues, ptrDtDeclType, symbol.name().ToString(), *object.init());
870     ptrInitObj.set_init(evaluate::AsGenericExpr(
871         Structure(ptrDtDeclType, std::move(ptrInitValues))));
872     AddValue(values, componentSchema_, "initialization"s,
873         SaveObjectInit(scope,
874             SaveObjectName(
875                 ".di."s + distinctName + "."s + symbol.name().ToString()),
876             ptrInitObj));
877     return true;
878   } else {
879     return false;
880   }
881 }
882 
883 evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue(
884     const SomeExpr &genre, std::int64_t n) const {
885   evaluate::StructureConstructorValues xs;
886   AddValue(xs, valueSchema_, "genre"s, genre);
887   AddValue(xs, valueSchema_, "value"s, IntToExpr(n));
888   return Structure(valueSchema_, std::move(xs));
889 }
890 
891 SomeExpr RuntimeTableBuilder::PackageIntValueExpr(
892     const SomeExpr &genre, std::int64_t n) const {
893   return StructureExpr(PackageIntValue(genre, n));
894 }
895 
896 std::vector<const Symbol *> RuntimeTableBuilder::CollectBindings(
897     const Scope &dtScope) const {
898   std::vector<const Symbol *> result;
899   std::map<SourceName, const Symbol *> localBindings;
900   // Collect local bindings
901   for (auto pair : dtScope) {
902     const Symbol &symbol{*pair.second};
903     if (symbol.has<ProcBindingDetails>()) {
904       localBindings.emplace(symbol.name(), &symbol);
905     }
906   }
907   if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
908     result = CollectBindings(*parentScope);
909     // Apply overrides from the local bindings of the extended type
910     for (auto iter{result.begin()}; iter != result.end(); ++iter) {
911       const Symbol &symbol{**iter};
912       auto overridden{localBindings.find(symbol.name())};
913       if (overridden != localBindings.end()) {
914         *iter = overridden->second;
915         localBindings.erase(overridden);
916       }
917     }
918   }
919   // Add remaining (non-overriding) local bindings in name order to the result
920   for (auto pair : localBindings) {
921     result.push_back(pair.second);
922   }
923   return result;
924 }
925 
926 std::vector<evaluate::StructureConstructor>
927 RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) {
928   std::vector<evaluate::StructureConstructor> result;
929   for (const Symbol *symbol : CollectBindings(dtScope)) {
930     evaluate::StructureConstructorValues values;
931     AddValue(values, bindingSchema_, "proc"s,
932         SomeExpr{evaluate::ProcedureDesignator{
933             symbol->get<ProcBindingDetails>().symbol()}});
934     AddValue(values, bindingSchema_, "name"s,
935         SaveNameAsPointerTarget(scope, symbol->name().ToString()));
936     result.emplace_back(DEREF(bindingSchema_.AsDerived()), std::move(values));
937   }
938   return result;
939 }
940 
941 void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic,
942     std::map<int, evaluate::StructureConstructor> &specials) {
943   std::visit(common::visitors{
944                  [&](const GenericKind::OtherKind &k) {
945                    if (k == GenericKind::OtherKind::Assignment) {
946                      for (auto ref : generic.specificProcs()) {
947                        DescribeSpecialProc(specials, *ref, true,
948                            false /*!final*/, std::nullopt);
949                      }
950                    }
951                  },
952                  [&](const GenericKind::DefinedIo &io) {
953                    switch (io) {
954                    case GenericKind::DefinedIo::ReadFormatted:
955                    case GenericKind::DefinedIo::ReadUnformatted:
956                    case GenericKind::DefinedIo::WriteFormatted:
957                    case GenericKind::DefinedIo::WriteUnformatted:
958                      for (auto ref : generic.specificProcs()) {
959                        DescribeSpecialProc(
960                            specials, *ref, false, false /*!final*/, io);
961                      }
962                      break;
963                    }
964                  },
965                  [](const auto &) {},
966              },
967       generic.kind().u);
968 }
969 
970 void RuntimeTableBuilder::DescribeSpecialProc(
971     std::map<int, evaluate::StructureConstructor> &specials,
972     const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
973     std::optional<GenericKind::DefinedIo> io) {
974   const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
975   const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)};
976   if (auto proc{evaluate::characteristics::Procedure::Characterize(
977           specific, context_.foldingContext())}) {
978     std::uint8_t isArgDescriptorSet{0};
979     int argThatMightBeDescriptor{0};
980     MaybeExpr which;
981     if (isAssignment) {
982       // Only type-bound asst's with the same type on both dummy arguments
983       // are germane to the runtime, which needs only these to implement
984       // component assignment as part of intrinsic assignment.
985       // Non-type-bound generic INTERFACEs and assignments from distinct
986       // types must not be used for component intrinsic assignment.
987       CHECK(proc->dummyArguments.size() == 2);
988       const auto t1{
989           DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
990                     &proc->dummyArguments[0].u))
991               .type.type()};
992       const auto t2{
993           DEREF(std::get_if<evaluate::characteristics::DummyDataObject>(
994                     &proc->dummyArguments[1].u))
995               .type.type()};
996       if (!binding || t1.category() != TypeCategory::Derived ||
997           t2.category() != TypeCategory::Derived ||
998           t1.IsUnlimitedPolymorphic() || t2.IsUnlimitedPolymorphic() ||
999           t1.GetDerivedTypeSpec() != t2.GetDerivedTypeSpec()) {
1000         return;
1001       }
1002       which = proc->IsElemental() ? elementalAssignmentEnum_
1003                                   : scalarAssignmentEnum_;
1004       if (binding && binding->passName() &&
1005           *binding->passName() == proc->dummyArguments[1].name) {
1006         argThatMightBeDescriptor = 1;
1007         isArgDescriptorSet |= 2;
1008       } else {
1009         argThatMightBeDescriptor = 2; // the non-passed-object argument
1010         isArgDescriptorSet |= 1;
1011       }
1012     } else if (isFinal) {
1013       CHECK(binding == nullptr); // FINALs are not bindings
1014       CHECK(proc->dummyArguments.size() == 1);
1015       if (proc->IsElemental()) {
1016         which = elementalFinalEnum_;
1017       } else {
1018         const auto &typeAndShape{
1019             std::get<evaluate::characteristics::DummyDataObject>(
1020                 proc->dummyArguments.at(0).u)
1021                 .type};
1022         if (typeAndShape.attrs().test(
1023                 evaluate::characteristics::TypeAndShape::Attr::AssumedRank)) {
1024           which = assumedRankFinalEnum_;
1025           isArgDescriptorSet |= 1;
1026         } else {
1027           which = scalarFinalEnum_;
1028           if (int rank{evaluate::GetRank(typeAndShape.shape())}; rank > 0) {
1029             argThatMightBeDescriptor = 1;
1030             which = IntExpr<1>(ToInt64(which).value() + rank);
1031           }
1032         }
1033       }
1034     } else { // user defined derived type I/O
1035       CHECK(proc->dummyArguments.size() >= 4);
1036       if (binding) {
1037         isArgDescriptorSet |= 1;
1038       }
1039       switch (io.value()) {
1040       case GenericKind::DefinedIo::ReadFormatted:
1041         which = readFormattedEnum_;
1042         break;
1043       case GenericKind::DefinedIo::ReadUnformatted:
1044         which = readUnformattedEnum_;
1045         break;
1046       case GenericKind::DefinedIo::WriteFormatted:
1047         which = writeFormattedEnum_;
1048         break;
1049       case GenericKind::DefinedIo::WriteUnformatted:
1050         which = writeUnformattedEnum_;
1051         break;
1052       }
1053     }
1054     if (argThatMightBeDescriptor != 0 &&
1055         !proc->dummyArguments.at(argThatMightBeDescriptor - 1)
1056              .CanBePassedViaImplicitInterface()) {
1057       isArgDescriptorSet |= 1 << (argThatMightBeDescriptor - 1);
1058     }
1059     evaluate::StructureConstructorValues values;
1060     auto index{evaluate::ToInt64(which)};
1061     CHECK(index.has_value());
1062     AddValue(
1063         values, specialSchema_, "which"s, SomeExpr{std::move(which.value())});
1064     AddValue(values, specialSchema_, "isargdescriptorset"s,
1065         IntExpr<1>(isArgDescriptorSet));
1066     AddValue(values, specialSchema_, "proc"s,
1067         SomeExpr{evaluate::ProcedureDesignator{specific}});
1068     auto pair{specials.try_emplace(
1069         *index, DEREF(specialSchema_.AsDerived()), std::move(values))};
1070     CHECK(pair.second); // ensure not already present
1071   }
1072 }
1073 
1074 void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces(
1075     std::map<int, evaluate::StructureConstructor> &specials, SourceName name,
1076     GenericKind::DefinedIo definedIo, const Scope *scope) {
1077   for (; !scope->IsGlobal(); scope = &scope->parent()) {
1078     if (auto asst{scope->find(name)}; asst != scope->end()) {
1079       const Symbol &generic{asst->second->GetUltimate()};
1080       const auto &genericDetails{generic.get<GenericDetails>()};
1081       CHECK(std::holds_alternative<GenericKind::DefinedIo>(
1082           genericDetails.kind().u));
1083       CHECK(std::get<GenericKind::DefinedIo>(genericDetails.kind().u) ==
1084           definedIo);
1085       for (auto ref : genericDetails.specificProcs()) {
1086         DescribeSpecialProc(specials, *ref, false, false, definedIo);
1087       }
1088     }
1089   }
1090 }
1091 
1092 RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
1093     SemanticsContext &context) {
1094   RuntimeDerivedTypeTables result;
1095   result.schemata = context.GetBuiltinModule(typeInfoBuiltinModule);
1096   if (result.schemata) {
1097     RuntimeTableBuilder builder{context, result};
1098     builder.DescribeTypes(context.globalScope(), false);
1099   }
1100   return result;
1101 }
1102 } // namespace Fortran::semantics
1103