Skip to content

[flang] implement show_descriptor intrinsic, a non-standard extension #169137

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 10 commits into
base: main
Choose a base branch
from
Open

[flang] implement show_descriptor intrinsic, a non-standard extension #169137

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
e690b76
[flang] implement show_descriptor intrinsic, a non-standard extension
valerydmit Nov 22, 2025
3c485e9
fix formatting
valerydmit Nov 22, 2025
49f1092
adjust test checks
valerydmit Nov 22, 2025
885e8d8
address review comments
valerydmit Nov 24, 2025
f7c1135
format
valerydmit Nov 24, 2025
b58c119
extend flang-rt/unittests with descriptor's dump
valerydmit Nov 25, 2025
685e3a1
Rename show_descriptor into __builtin_show_descriptor.
valerydmit Nov 25, 2025
f4a754b
document show_descriptor intrinsic
valerydmit Nov 25, 2025
7a71455
format
valerydmit Nov 25, 2025
b3e063e
update test to invoke show_descriptor via flang_debug module
valerydmit Nov 26, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 3 additions & 1 deletion flang-rt/include/flang-rt/runtime/descriptor.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -510,7 +510,9 @@ class Descriptor {

RT_API_ATTRS void Check() const;

void Dump(FILE * = stdout) const;
// When dumpRawType, dumps stringified CFI_type_*, otherwise
// try to canonicalize and pront as a Fortran type.
void Dump(FILE * = stdout, bool dumpRawType = true) const;

RT_API_ATTRS inline bool HasAddendum() const {
return raw_.extra & _CFI_ADDENDUM_FLAG;
Expand Down
164 changes: 159 additions & 5 deletions flang-rt/lib/runtime/descriptor.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -292,14 +292,168 @@ RT_API_ATTRS void Descriptor::Check() const {
// TODO
}

void Descriptor::Dump(FILE *f) const {
static const char *GetTypeStr(ISO::CFI_type_t type, bool dumpRawType) {
Copy link
Member

@alexey-bataev alexey-bataev Nov 24, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

StringRef instead if const char*?

Copy link
Contributor Author

@valerydmit valerydmit Nov 24, 2025

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Using llvm::StringRef would be a precedent for flang-rt.

if (dumpRawType) {
#define CASE(x) \
case (x): \
return #x;
switch (type) {
CASE(CFI_type_signed_char)
CASE(CFI_type_short)
CASE(CFI_type_int)
CASE(CFI_type_long)
CASE(CFI_type_long_long)
CASE(CFI_type_size_t)
CASE(CFI_type_int8_t)
CASE(CFI_type_int16_t)
CASE(CFI_type_int32_t)
CASE(CFI_type_int64_t)
CASE(CFI_type_int128_t)
CASE(CFI_type_int_least8_t)
CASE(CFI_type_int_least16_t)
CASE(CFI_type_int_least32_t)
CASE(CFI_type_int_least64_t)
CASE(CFI_type_int_least128_t)
CASE(CFI_type_int_fast8_t)
CASE(CFI_type_int_fast16_t)
CASE(CFI_type_int_fast32_t)
CASE(CFI_type_int_fast64_t)
CASE(CFI_type_int_fast128_t)
CASE(CFI_type_intmax_t)
CASE(CFI_type_intptr_t)
CASE(CFI_type_ptrdiff_t)
CASE(CFI_type_half_float)
CASE(CFI_type_bfloat)
CASE(CFI_type_float)
CASE(CFI_type_double)
CASE(CFI_type_extended_double)
CASE(CFI_type_long_double)
CASE(CFI_type_float128)
CASE(CFI_type_half_float_Complex)
CASE(CFI_type_bfloat_Complex)
CASE(CFI_type_float_Complex)
CASE(CFI_type_double_Complex)
CASE(CFI_type_extended_double_Complex)
CASE(CFI_type_long_double_Complex)
CASE(CFI_type_float128_Complex)
CASE(CFI_type_Bool)
CASE(CFI_type_char)
CASE(CFI_type_cptr)
CASE(CFI_type_struct)
CASE(CFI_type_char16_t)
CASE(CFI_type_char32_t)
CASE(CFI_type_uint8_t)
CASE(CFI_type_uint16_t)
CASE(CFI_type_uint32_t)
CASE(CFI_type_uint64_t)
CASE(CFI_type_uint128_t)
}
#undef CASE
return nullptr;
}
TypeCode code{type};

if (!code.IsValid())
return "invalid";

common::optional<std::pair<TypeCategory, int>> categoryAndKind =
code.GetCategoryAndKind();
if (!categoryAndKind)
return nullptr;

TypeCategory tcat;
int kind;
std::tie(tcat, kind) = *categoryAndKind;

#define CASE(cat, k) \
case (k): \
return #cat "(kind=" #k ")";
switch (tcat) {
case TypeCategory::Integer:
switch (kind) {
CASE(INTEGER, 1)
CASE(INTEGER, 2)
CASE(INTEGER, 4)
CASE(INTEGER, 8)
CASE(INTEGER, 16)
}
break;
case TypeCategory::Unsigned:
switch (kind) {
CASE(UNSIGNED, 1)
CASE(UNSIGNED, 2)
CASE(UNSIGNED, 4)
CASE(UNSIGNED, 8)
CASE(UNSIGNED, 16)
}
break;
case TypeCategory::Real:
switch (kind) {
CASE(REAL, 2)
CASE(REAL, 3)
CASE(REAL, 4)
CASE(REAL, 8)
CASE(REAL, 10)
CASE(REAL, 16)
}
break;
case TypeCategory::Complex:
switch (kind) {
CASE(COMPLEX, 2)
CASE(COMPLEX, 3)
CASE(COMPLEX, 4)
CASE(COMPLEX, 8)
CASE(COMPLEX, 10)
CASE(COMPLEX, 16)
}
break;
case TypeCategory::Character:
switch (kind) {
CASE(CHARACTER, 1)
CASE(CHARACTER, 2)
CASE(CHARACTER, 4)
}
break;
case TypeCategory::Logical:
switch (kind) {
CASE(LOGICAL, 1)
CASE(LOGICAL, 2)
CASE(LOGICAL, 4)
CASE(LOGICAL, 8)
}
break;
case TypeCategory::Derived:
return "DERIVED";
}
#undef CASE
return nullptr;
}

void Descriptor::Dump(FILE *f, bool dumpRawType) const {
std::fprintf(f, "Descriptor @ %p:\n", reinterpret_cast<const void *>(this));
std::fprintf(f, " base_addr %p\n", raw_.base_addr);
std::fprintf(f, " elem_len %zd\n", static_cast<std::size_t>(raw_.elem_len));
std::fprintf(f, " elem_len %zd\n", ElementBytes());
std::fprintf(f, " version %d\n", static_cast<int>(raw_.version));
std::fprintf(f, " rank %d\n", static_cast<int>(raw_.rank));
std::fprintf(f, " type %d\n", static_cast<int>(raw_.type));
std::fprintf(f, " attribute %d\n", static_cast<int>(raw_.attribute));
if (rank() > 0) {
std::fprintf(f, " rank %d\n", rank());
} else {
std::fprintf(f, " scalar\n");
}
int ty = static_cast<int>(raw_.type);
if (const char *tyStr = GetTypeStr(raw_.type, dumpRawType)) {
std::fprintf(f, " type %d \"%s\"\n", ty, tyStr);
} else {
std::fprintf(f, " type %d\n", ty);
}
int attr = static_cast<int>(raw_.attribute);
if (IsPointer()) {
std::fprintf(f, " attribute %d (pointer) \n", attr);
} else if (IsAllocatable()) {
std::fprintf(f, " attribute %d (allocatable)\n", attr);
} else {
std::fprintf(f, " attribute %d\n", attr);
}

std::fprintf(f, " extra %d\n", static_cast<int>(raw_.extra));
std::fprintf(f, " addendum %d\n", static_cast<int>(HasAddendum()));
std::fprintf(f, " alloc_idx %d\n", static_cast<int>(GetAllocIdx()));
Expand Down
9 changes: 9 additions & 0 deletions flang-rt/lib/runtime/extensions.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -398,6 +398,15 @@ std::int64_t RTNAME(time)() { return time(nullptr); }
// MCLOCK: returns accumulated CPU time in ticks
std::int32_t FORTRAN_PROCEDURE_NAME(mclock)() { return std::clock(); }

void RTNAME(ShowDescriptor)(const char *descr) {
if (descr) {
reinterpret_cast<const Fortran::runtime::Descriptor *>(descr)->Dump(
stderr, /*dumpRawType=*/false);
} else {
std::fprintf(stderr, "NULL\n");
}
}

// Extension procedures related to I/O

namespace io {
Expand Down
1 change: 1 addition & 0 deletions flang/include/flang/Optimizer/Builder/IntrinsicCall.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -408,6 +408,7 @@ struct IntrinsicLibrary {
template <typename Shift>
mlir::Value genShift(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
mlir::Value genShiftA(mlir::Type resultType, llvm::ArrayRef<mlir::Value>);
void genShowDescriptor(llvm::ArrayRef<fir::ExtendedValue>);
mlir::Value genSign(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genSind(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genSinpi(mlir::Type, llvm::ArrayRef<mlir::Value>);
Expand Down
3 changes: 3 additions & 0 deletions flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -109,6 +109,9 @@ void genSleep(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value genChdir(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value name);

/// generate dump of a descriptor
void genShowDescriptor(fir::FirOpBuilder &builder, mlir::Location loc,
mlir::Value descriptor);
} // namespace runtime
} // namespace fir

Expand Down
3 changes: 3 additions & 0 deletions flang/include/flang/Runtime/extensions.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -101,5 +101,8 @@ int FORTRAN_PROCEDURE_NAME(mclock)();
float FORTRAN_PROCEDURE_NAME(secnds)(float *refTime);
float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line);

// Extension subroutine SHOW_DESCRIPTOR(D)
void RTNAME(ShowDescriptor)(const char *descr);

} // extern "C"
#endif // FORTRAN_RUNTIME_EXTENSIONS_H_
2 changes: 2 additions & 0 deletions flang/lib/Evaluate/intrinsics.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1701,6 +1701,8 @@ static const IntrinsicInterface intrinsicSubroutine[]{
{}, Rank::scalar, IntrinsicClass::impureSubroutine},
{"second", {{"time", DefaultReal, Rank::scalar}}, {}, Rank::scalar,
IntrinsicClass::impureSubroutine},
{"show_descriptor", {{"d", AnyData, Rank::anyOrAssumedRank}}, {},
Rank::elemental, IntrinsicClass::impureSubroutine},
{"system",
{{"command", DefaultChar, Rank::scalar},
{"exitstat", DefaultInt, Rank::scalar, Optionality::optional,
Expand Down
14 changes: 14 additions & 0 deletions flang/lib/Optimizer/Builder/IntrinsicCall.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -710,6 +710,10 @@ static constexpr IntrinsicHandler handlers[]{
{"shifta", &I::genShiftA},
{"shiftl", &I::genShift<mlir::arith::ShLIOp>},
{"shiftr", &I::genShift<mlir::arith::ShRUIOp>},
{"show_descriptor",
&I::genShowDescriptor,
{{{"d", asBox}}},
/*isElemental=*/false},
{"sign", &I::genSign},
{"signal",
&I::genSignalSubroutine,
Expand Down Expand Up @@ -7814,6 +7818,16 @@ mlir::Value IntrinsicLibrary::genShiftA(mlir::Type resultType,
return result;
}

void IntrinsicLibrary::genShowDescriptor(
llvm::ArrayRef<fir::ExtendedValue> args) {
assert(args.size() == 1);
const mlir::Value descriptor = fir::getBase(args[0]);

assert(fir::isa_box_type(descriptor.getType()) &&
"argument must have been lowered to box type");
fir::runtime::genShowDescriptor(builder, loc, descriptor);
}

// SIGNAL
void IntrinsicLibrary::genSignalSubroutine(
llvm::ArrayRef<fir::ExtendedValue> args) {
Expand Down
7 changes: 7 additions & 0 deletions flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -461,3 +461,10 @@ mlir::Value fir::runtime::genChdir(fir::FirOpBuilder &builder,
fir::runtime::createArguments(builder, loc, func.getFunctionType(), name);
return fir::CallOp::create(builder, loc, func, args).getResult(0);
}

void fir::runtime::genShowDescriptor(fir::FirOpBuilder &builder,
mlir::Location loc, mlir::Value descAddr) {
mlir::func::FuncOp func{
fir::runtime::getRuntimeFunc<mkRTKey(ShowDescriptor)>(loc, builder)};
fir::CallOp::create(builder, loc, func, descAddr);
}
Loading