llvm-project

1
//===-- runtime/type-info.cpp ---------------------------------------------===//
2
//
3
// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
4
// See https://llvm.org/LICENSE.txt for license information.
5
// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
6
//
7
//===----------------------------------------------------------------------===//
8

9
#include "type-info.h"
10
#include "terminator.h"
11
#include "tools.h"
12
#include <cstdio>
13

14
namespace Fortran::runtime::typeInfo {
15

16
RT_OFFLOAD_API_GROUP_BEGIN
17

18
RT_API_ATTRS Fortran::common::optional<TypeParameterValue> Value::GetValue(
19
    const Descriptor *descriptor) const {
20
  switch (genre_) {
21
  case Genre::Explicit:
22
    return value_;
23
  case Genre::LenParameter:
24
    if (descriptor) {
25
      if (const auto *addendum{descriptor->Addendum()}) {
26
        return addendum->LenParameterValue(value_);
27
      }
28
    }
29
    return Fortran::common::nullopt;
30
  default:
31
    return Fortran::common::nullopt;
32
  }
33
}
34

35
RT_API_ATTRS std::size_t Component::GetElementByteSize(
36
    const Descriptor &instance) const {
37
  switch (category()) {
38
  case TypeCategory::Integer:
39
  case TypeCategory::Real:
40
  case TypeCategory::Logical:
41
    return kind_;
42
  case TypeCategory::Complex:
43
    return 2 * kind_;
44
  case TypeCategory::Character:
45
    if (auto value{characterLen_.GetValue(&instance)}) {
46
      return kind_ * *value;
47
    }
48
    break;
49
  case TypeCategory::Derived:
50
    if (const auto *type{derivedType()}) {
51
      return type->sizeInBytes();
52
    }
53
    break;
54
  }
55
  return 0;
56
}
57

58
RT_API_ATTRS std::size_t Component::GetElements(
59
    const Descriptor &instance) const {
60
  std::size_t elements{1};
61
  if (int rank{rank_}) {
62
    if (const Value * boundValues{bounds()}) {
63
      for (int j{0}; j < rank; ++j) {
64
        TypeParameterValue lb{
65
            boundValues[2 * j].GetValue(&instance).value_or(0)};
66
        TypeParameterValue ub{
67
            boundValues[2 * j + 1].GetValue(&instance).value_or(0)};
68
        if (ub >= lb) {
69
          elements *= ub - lb + 1;
70
        } else {
71
          return 0;
72
        }
73
      }
74
    } else {
75
      return 0;
76
    }
77
  }
78
  return elements;
79
}
80

81
RT_API_ATTRS std::size_t Component::SizeInBytes(
82
    const Descriptor &instance) const {
83
  if (genre() == Genre::Data) {
84
    return GetElementByteSize(instance) * GetElements(instance);
85
  } else if (category() == TypeCategory::Derived) {
86
    const DerivedType *type{derivedType()};
87
    return Descriptor::SizeInBytes(
88
        rank_, true, type ? type->LenParameters() : 0);
89
  } else {
90
    return Descriptor::SizeInBytes(rank_);
91
  }
92
}
93

94
RT_API_ATTRS void Component::EstablishDescriptor(Descriptor &descriptor,
95
    const Descriptor &container, Terminator &terminator) const {
96
  ISO::CFI_attribute_t attribute{static_cast<ISO::CFI_attribute_t>(
97
      genre_ == Genre::Allocatable   ? CFI_attribute_allocatable
98
          : genre_ == Genre::Pointer ? CFI_attribute_pointer
99
                                     : CFI_attribute_other)};
100
  TypeCategory cat{category()};
101
  if (cat == TypeCategory::Character) {
102
    std::size_t lengthInChars{0};
103
    if (auto length{characterLen_.GetValue(&container)}) {
104
      lengthInChars = static_cast<std::size_t>(*length);
105
    } else {
106
      RUNTIME_CHECK(
107
          terminator, characterLen_.genre() == Value::Genre::Deferred);
108
    }
109
    descriptor.Establish(
110
        kind_, lengthInChars, nullptr, rank_, nullptr, attribute);
111
  } else if (cat == TypeCategory::Derived) {
112
    if (const DerivedType * type{derivedType()}) {
113
      descriptor.Establish(*type, nullptr, rank_, nullptr, attribute);
114
    } else { // unlimited polymorphic
115
      descriptor.Establish(TypeCode{TypeCategory::Derived, 0}, 0, nullptr,
116
          rank_, nullptr, attribute, true);
117
    }
118
  } else {
119
    descriptor.Establish(cat, kind_, nullptr, rank_, nullptr, attribute);
120
  }
121
  if (rank_ && genre_ != Genre::Allocatable && genre_ != Genre::Pointer) {
122
    const typeInfo::Value *boundValues{bounds()};
123
    RUNTIME_CHECK(terminator, boundValues != nullptr);
124
    auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
125
    for (int j{0}; j < rank_; ++j) {
126
      auto lb{boundValues++->GetValue(&container)};
127
      auto ub{boundValues++->GetValue(&container)};
128
      RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
129
      Dimension &dim{descriptor.GetDimension(j)};
130
      dim.SetBounds(*lb, *ub);
131
      dim.SetByteStride(byteStride);
132
      byteStride *= dim.Extent();
133
    }
134
  }
135
}
136

137
RT_API_ATTRS void Component::CreatePointerDescriptor(Descriptor &descriptor,
138
    const Descriptor &container, Terminator &terminator,
139
    const SubscriptValue *subscripts) const {
140
  RUNTIME_CHECK(terminator, genre_ == Genre::Data);
141
  EstablishDescriptor(descriptor, container, terminator);
142
  if (subscripts) {
143
    descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
144
  } else {
145
    descriptor.set_base_addr(container.OffsetElement<char>() + offset_);
146
  }
147
  descriptor.raw().attribute = CFI_attribute_pointer;
148
}
149

150
RT_API_ATTRS const DerivedType *DerivedType::GetParentType() const {
151
  if (hasParent_) {
152
    const Descriptor &compDesc{component()};
153
    const Component &component{*compDesc.OffsetElement<const Component>()};
154
    return component.derivedType();
155
  } else {
156
    return nullptr;
157
  }
158
}
159

160
RT_API_ATTRS const Component *DerivedType::FindDataComponent(
161
    const char *compName, std::size_t compNameLen) const {
162
  const Descriptor &compDesc{component()};
163
  std::size_t n{compDesc.Elements()};
164
  SubscriptValue at[maxRank];
165
  compDesc.GetLowerBounds(at);
166
  for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
167
    const Component *component{compDesc.Element<Component>(at)};
168
    INTERNAL_CHECK(component != nullptr);
169
    const Descriptor &nameDesc{component->name()};
170
    if (nameDesc.ElementBytes() == compNameLen &&
171
        Fortran::runtime::memcmp(
172
            compName, nameDesc.OffsetElement(), compNameLen) == 0) {
173
      return component;
174
    }
175
  }
176
  const DerivedType *parent{GetParentType()};
177
  return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
178
}
179

180
RT_OFFLOAD_API_GROUP_END
181

182
static void DumpScalarCharacter(
183
    FILE *f, const Descriptor &desc, const char *what) {
184
  if (desc.raw().version == CFI_VERSION &&
185
      desc.type() == TypeCode{TypeCategory::Character, 1} &&
186
      desc.ElementBytes() > 0 && desc.rank() == 0 &&
187
      desc.OffsetElement() != nullptr) {
188
    std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
189
  } else {
190
    std::fprintf(f, "bad %s descriptor: ", what);
191
    desc.Dump(f);
192
  }
193
}
194

195
FILE *DerivedType::Dump(FILE *f) const {
196
  std::fprintf(f, "DerivedType @ %p:\n", reinterpret_cast<const void *>(this));
197
  const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
198
  for (int j{0}; j < 64; ++j) {
199
    int offset{j * static_cast<int>(sizeof *uints)};
200
    std::fprintf(f, "    [+%3d](%p) 0x%016jx", offset,
201
        reinterpret_cast<const void *>(&uints[j]),
202
        static_cast<std::uintmax_t>(uints[j]));
203
    if (offset == offsetof(DerivedType, binding_)) {
204
      std::fputs(" <-- binding_\n", f);
205
    } else if (offset == offsetof(DerivedType, name_)) {
206
      std::fputs(" <-- name_\n", f);
207
    } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
208
      std::fputs(" <-- sizeInBytes_\n", f);
209
    } else if (offset == offsetof(DerivedType, uninstantiated_)) {
210
      std::fputs(" <-- uninstantiated_\n", f);
211
    } else if (offset == offsetof(DerivedType, kindParameter_)) {
212
      std::fputs(" <-- kindParameter_\n", f);
213
    } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
214
      std::fputs(" <-- lenParameterKind_\n", f);
215
    } else if (offset == offsetof(DerivedType, component_)) {
216
      std::fputs(" <-- component_\n", f);
217
    } else if (offset == offsetof(DerivedType, procPtr_)) {
218
      std::fputs(" <-- procPtr_\n", f);
219
    } else if (offset == offsetof(DerivedType, special_)) {
220
      std::fputs(" <-- special_\n", f);
221
    } else if (offset == offsetof(DerivedType, specialBitSet_)) {
222
      std::fputs(" <-- specialBitSet_\n", f);
223
    } else if (offset == offsetof(DerivedType, hasParent_)) {
224
      std::fputs(" <-- (flags)\n", f);
225
    } else {
226
      std::fputc('\n', f);
227
    }
228
  }
229
  std::fputs("  name: ", f);
230
  DumpScalarCharacter(f, name(), "DerivedType::name");
231
  const Descriptor &bindingDesc{binding()};
232
  std::fprintf(
233
      f, "\n  binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
234
  bindingDesc.Dump(f);
235
  const Descriptor &compDesc{component()};
236
  std::fputs("\n  components:\n", f);
237
  if (compDesc.raw().version == CFI_VERSION &&
238
      compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
239
      compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
240
    std::size_t n{compDesc.Elements()};
241
    for (std::size_t j{0}; j < n; ++j) {
242
      const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
243
      std::fprintf(f, "  [%3zd] ", j);
244
      comp.Dump(f);
245
    }
246
  } else {
247
    std::fputs("    bad descriptor: ", f);
248
    compDesc.Dump(f);
249
  }
250
  const Descriptor &specialDesc{special()};
251
  std::fprintf(
252
      f, "\n  special descriptor (byteSize 0x%zx): ", special_.byteSize);
253
  specialDesc.Dump(f);
254
  if (specialDesc.IsAllocated()) {
255
    std::size_t specials{specialDesc.Elements()};
256
    for (std::size_t j{0}; j < specials; ++j) {
257
      std::fprintf(f, "  [%3zd] ", j);
258
      specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
259
    }
260
  }
261
  return f;
262
}
263

264
FILE *Component::Dump(FILE *f) const {
265
  std::fprintf(f, "Component @ %p:\n", reinterpret_cast<const void *>(this));
266
  std::fputs("    name: ", f);
267
  DumpScalarCharacter(f, name(), "Component::name");
268
  if (genre_ == Genre::Data) {
269
    std::fputs("    Data       ", f);
270
  } else if (genre_ == Genre::Pointer) {
271
    std::fputs("    Pointer    ", f);
272
  } else if (genre_ == Genre::Allocatable) {
273
    std::fputs("    Allocatable", f);
274
  } else if (genre_ == Genre::Automatic) {
275
    std::fputs("    Automatic  ", f);
276
  } else {
277
    std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
278
  }
279
  std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
280
      kind_, rank_, static_cast<std::size_t>(offset_));
281
  if (initialization_) {
282
    std::fprintf(f, " initialization @ %p:\n",
283
        reinterpret_cast<const void *>(initialization_));
284
    for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
285
      std::fprintf(f, " [%3d] 0x%016jx\n", j,
286
          static_cast<std::uintmax_t>(
287
              *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
288
    }
289
  }
290
  return f;
291
}
292

293
FILE *SpecialBinding::Dump(FILE *f) const {
294
  std::fprintf(
295
      f, "SpecialBinding @ %p:\n", reinterpret_cast<const void *>(this));
296
  switch (which_) {
297
  case Which::ScalarAssignment:
298
    std::fputs("    ScalarAssignment", f);
299
    break;
300
  case Which::ElementalAssignment:
301
    std::fputs("    ElementalAssignment", f);
302
    break;
303
  case Which::ReadFormatted:
304
    std::fputs("    ReadFormatted", f);
305
    break;
306
  case Which::ReadUnformatted:
307
    std::fputs("    ReadUnformatted", f);
308
    break;
309
  case Which::WriteFormatted:
310
    std::fputs("    WriteFormatted", f);
311
    break;
312
  case Which::WriteUnformatted:
313
    std::fputs("    WriteUnformatted", f);
314
    break;
315
  case Which::ElementalFinal:
316
    std::fputs("    ElementalFinal", f);
317
    break;
318
  case Which::AssumedRankFinal:
319
    std::fputs("    AssumedRankFinal", f);
320
    break;
321
  default:
322
    std::fprintf(f, "    rank-%d final:",
323
        static_cast<int>(which_) - static_cast<int>(Which::ScalarFinal));
324
    break;
325
  }
326
  std::fprintf(f, "    isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
327
  std::fprintf(f, "    isTypeBound: 0x%x\n", isTypeBound_);
328
  std::fprintf(f, "    isArgContiguousSet: 0x%x\n", isArgContiguousSet_);
329
  std::fprintf(f, "    proc: %p\n", reinterpret_cast<void *>(proc_));
330
  return f;
331
}
332

333
} // namespace Fortran::runtime::typeInfo
334