Mercurial > hg > CbC > CbC_llvm
view flang/runtime/namelist.cpp @ 207:2e18cbf3894f
LLVM12
author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
---|---|
date | Tue, 08 Jun 2021 06:07:14 +0900 |
parents | |
children | 5f17cb93ff66 |
line wrap: on
line source
//===-- runtime/namelist.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 "namelist.h" #include "descriptor-io.h" #include "io-api.h" #include "io-stmt.h" #include <cstring> #include <limits> namespace Fortran::runtime::io { bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) { IoStatementState &io{*cookie}; io.CheckFormattedStmtType<Direction::Output>("OutputNamelist"); ConnectionState &connection{io.GetConnectionState()}; connection.modes.inNamelist = true; // Internal functions to advance records and convert case const auto EmitWithAdvance{[&](char ch) -> bool { return (!connection.NeedAdvance(1) || io.AdvanceRecord()) && io.Emit(&ch, 1); }}; const auto EmitUpperCase{[&](const char *str) -> bool { if (connection.NeedAdvance(std::strlen(str)) && !(io.AdvanceRecord() && io.Emit(" ", 1))) { return false; } for (; *str; ++str) { char up{*str >= 'a' && *str <= 'z' ? static_cast<char>(*str - 'a' + 'A') : *str}; if (!io.Emit(&up, 1)) { return false; } } return true; }}; // &GROUP if (!(EmitWithAdvance('&') && EmitUpperCase(group.groupName))) { return false; } for (std::size_t j{0}; j < group.items; ++j) { // [,]ITEM=... const NamelistGroup::Item &item{group.item[j]}; if (!(EmitWithAdvance(j == 0 ? ' ' : ',') && EmitUpperCase(item.name) && EmitWithAdvance('=') && descr::DescriptorIO<Direction::Output>(io, item.descriptor))) { return false; } } // terminal / return EmitWithAdvance('/'); } static bool GetLowerCaseName( IoStatementState &io, char buffer[], std::size_t maxLength) { if (auto ch{io.GetCurrentChar()}) { static const auto IsLegalIdStart{[](char32_t ch) -> bool { return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' || ch == '@' || ch == '$'; }}; if (IsLegalIdStart(*ch)) { std::size_t j{0}; do { buffer[j] = static_cast<char>(*ch >= 'A' && *ch <= 'Z' ? *ch - 'A' + 'a' : *ch); io.HandleRelativePosition(1); ch = io.GetCurrentChar(); } while (++j < maxLength && ch && (IsLegalIdStart(*ch) || (*ch >= '0' && *ch <= '9'))); buffer[j++] = '\0'; if (j <= maxLength) { return true; } io.GetIoErrorHandler().SignalError( "Identifier '%s...' in NAMELIST input group is too long", buffer); } } return false; } static std::optional<SubscriptValue> GetSubscriptValue(IoStatementState &io) { std::optional<SubscriptValue> value; std::optional<char32_t> ch{io.GetCurrentChar()}; bool negate{ch && *ch == '-'}; if (negate) { io.HandleRelativePosition(1); ch = io.GetCurrentChar(); } bool overflow{false}; while (ch && *ch >= '0' && *ch <= '9') { SubscriptValue was{value.value_or(0)}; overflow |= was >= std::numeric_limits<SubscriptValue>::max() / 10; value = 10 * was + *ch - '0'; io.HandleRelativePosition(1); ch = io.GetCurrentChar(); } if (overflow) { io.GetIoErrorHandler().SignalError( "NAMELIST input subscript value overflow"); return std::nullopt; } if (negate) { if (value) { return -*value; } else { io.HandleRelativePosition(-1); // give back '-' with no digits } } return value; } static bool HandleSubscripts(IoStatementState &io, Descriptor &desc, const Descriptor &source, const char *name) { IoErrorHandler &handler{io.GetIoErrorHandler()}; io.HandleRelativePosition(1); // skip '(' // Allow for blanks in subscripts; it's nonstandard, but not ambiguous // within the parentheses SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank]; int j{0}; std::size_t elemLen{source.ElementBytes()}; bool ok{true}; std::optional<char32_t> ch{io.GetNextNonBlank()}; for (; ch && *ch != ')'; ++j) { SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; if (j < maxRank && j < source.rank()) { const Dimension &dim{source.GetDimension(j)}; dimLower = dim.LowerBound(); dimUpper = dim.UpperBound(); dimStride = elemLen ? dim.ByteStride() / elemLen : 1; } else if (ok) { handler.SignalError( "Too many subscripts for rank-%d NAMELIST group item '%s'", source.rank(), name); ok = false; } if (auto low{GetSubscriptValue(io)}) { if (*low < dimLower || (dimUpper >= dimLower && *low > dimUpper)) { if (ok) { handler.SignalError("Subscript %jd out of range %jd..%jd in NAMELIST " "group item '%s' dimension %d", static_cast<std::intmax_t>(*low), static_cast<std::intmax_t>(dimLower), static_cast<std::intmax_t>(dimUpper), name, j + 1); ok = false; } } else { dimLower = *low; } ch = io.GetNextNonBlank(); } if (ch && *ch == ':') { io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); if (auto high{GetSubscriptValue(io)}) { if (*high > dimUpper) { if (ok) { handler.SignalError( "Subscript triplet upper bound %jd out of range (>%jd) in " "NAMELIST group item '%s' dimension %d", static_cast<std::intmax_t>(*high), static_cast<std::intmax_t>(dimUpper), name, j + 1); ok = false; } } else { dimUpper = *high; } ch = io.GetNextNonBlank(); } if (ch && *ch == ':') { io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); if (auto str{GetSubscriptValue(io)}) { dimStride = *str; ch = io.GetNextNonBlank(); } } } else { // scalar dimUpper = dimLower; dimStride = 0; } if (ch && *ch == ',') { io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); } if (ok) { lower[j] = dimLower; upper[j] = dimUpper; stride[j] = dimStride; } } if (ok) { if (ch && *ch == ')') { io.HandleRelativePosition(1); if (desc.EstablishPointerSection(source, lower, upper, stride)) { return true; } else { handler.SignalError( "Bad subscripts for NAMELIST input group item '%s'", name); } } else { handler.SignalError( "Bad subscripts (missing ')') for NAMELIST input group item '%s'", name); } } return false; } bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) { IoStatementState &io{*cookie}; io.CheckFormattedStmtType<Direction::Input>("InputNamelist"); ConnectionState &connection{io.GetConnectionState()}; connection.modes.inNamelist = true; IoErrorHandler &handler{io.GetIoErrorHandler()}; // Check the group header std::optional<char32_t> next{io.GetNextNonBlank()}; if (!next || *next != '&') { handler.SignalError( "NAMELIST input group does not begin with '&' (at '%lc')", *next); return false; } io.HandleRelativePosition(1); char name[101]; if (!GetLowerCaseName(io, name, sizeof name)) { handler.SignalError("NAMELIST input group has no name"); return false; } RUNTIME_CHECK(handler, group.groupName != nullptr); if (std::strcmp(group.groupName, name) != 0) { handler.SignalError( "NAMELIST input group name '%s' is not the expected '%s'", name, group.groupName); return false; } // Read the group's items while (true) { next = io.GetNextNonBlank(); if (!next || *next == '/') { break; } if (!GetLowerCaseName(io, name, sizeof name)) { handler.SignalError( "NAMELIST input group '%s' was not terminated", group.groupName); return false; } std::size_t itemIndex{0}; for (; itemIndex < group.items; ++itemIndex) { if (std::strcmp(name, group.item[itemIndex].name) == 0) { break; } } if (itemIndex >= group.items) { handler.SignalError( "'%s' is not an item in NAMELIST group '%s'", name, group.groupName); return false; } // Handle indexing and components, if any. No spaces are allowed. // A copy of the descriptor is made if necessary. const Descriptor &itemDescriptor{group.item[itemIndex].descriptor}; const Descriptor *useDescriptor{&itemDescriptor}; StaticDescriptor<maxRank, true, 16> staticDesc[2]; int whichStaticDesc{0}; next = io.GetCurrentChar(); if (next && (*next == '(' || *next == '%')) { do { if (*next == '(') { Descriptor &mutableDescriptor{ staticDesc[whichStaticDesc].descriptor()}; whichStaticDesc ^= 1; HandleSubscripts(io, mutableDescriptor, *useDescriptor, name); useDescriptor = &mutableDescriptor; } else { handler.Crash("unimplemented: component references in NAMELIST"); } next = io.GetCurrentChar(); } while (next && (*next == '(' || *next == '%')); } // Skip the '=' next = io.GetNextNonBlank(); if (!next || *next != '=') { handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'", name, group.groupName); return false; } io.HandleRelativePosition(1); // Read the values into the descriptor if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) { return false; } next = io.GetNextNonBlank(); if (next && *next == ',') { io.HandleRelativePosition(1); } } if (!next || *next != '/') { handler.SignalError( "No '/' found after NAMELIST group '%s'", group.groupName); return false; } io.HandleRelativePosition(1); return true; } } // namespace Fortran::runtime::io