| //===-- lib/Semantics/data-to-inits.cpp -----------------------------------===// |
| // |
| // 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 |
| // |
| //===----------------------------------------------------------------------===// |
| |
| // DATA statement object/value checking and conversion to static |
| // initializers |
| // - Applies specific checks to each scalar element initialization with a |
| // constant value or pointer target with class DataInitializationCompiler; |
| // - Collects the elemental initializations for each symbol and converts them |
| // into a single init() expression with member function |
| // DataChecker::ConstructInitializer(). |
| |
| #include "data-to-inits.h" |
| #include "pointer-assignment.h" |
| #include "flang/Evaluate/fold-designator.h" |
| #include "flang/Evaluate/tools.h" |
| #include "flang/Semantics/tools.h" |
| |
| namespace Fortran::semantics { |
| |
| // Steps through a list of values in a DATA statement set; implements |
| // repetition. |
| class ValueListIterator { |
| public: |
| explicit ValueListIterator(const parser::DataStmtSet &set) |
| : end_{std::get<std::list<parser::DataStmtValue>>(set.t).end()}, |
| at_{std::get<std::list<parser::DataStmtValue>>(set.t).begin()} { |
| SetRepetitionCount(); |
| } |
| bool hasFatalError() const { return hasFatalError_; } |
| bool IsAtEnd() const { return at_ == end_; } |
| const SomeExpr *operator*() const { return GetExpr(GetConstant()); } |
| parser::CharBlock LocateSource() const { return GetConstant().source; } |
| ValueListIterator &operator++() { |
| if (repetitionsRemaining_ > 0) { |
| --repetitionsRemaining_; |
| } else if (at_ != end_) { |
| ++at_; |
| SetRepetitionCount(); |
| } |
| return *this; |
| } |
| |
| private: |
| using listIterator = std::list<parser::DataStmtValue>::const_iterator; |
| void SetRepetitionCount(); |
| const parser::DataStmtConstant &GetConstant() const { |
| return std::get<parser::DataStmtConstant>(at_->t); |
| } |
| |
| listIterator end_; |
| listIterator at_; |
| ConstantSubscript repetitionsRemaining_{0}; |
| bool hasFatalError_{false}; |
| }; |
| |
| void ValueListIterator::SetRepetitionCount() { |
| for (repetitionsRemaining_ = 1; at_ != end_; ++at_) { |
| if (at_->repetitions < 0) { |
| hasFatalError_ = true; |
| } |
| if (at_->repetitions > 0) { |
| repetitionsRemaining_ = at_->repetitions - 1; |
| return; |
| } |
| } |
| repetitionsRemaining_ = 0; |
| } |
| |
| // Collects all of the elemental initializations from DATA statements |
| // into a single image for each symbol that appears in any DATA. |
| // Expands the implied DO loops and array references. |
| // Applies checks that validate each distinct elemental initialization |
| // of the variables in a data-stmt-set, as well as those that apply |
| // to the corresponding values being use to initialize each element. |
| class DataInitializationCompiler { |
| public: |
| DataInitializationCompiler(DataInitializations &inits, |
| evaluate::ExpressionAnalyzer &a, const parser::DataStmtSet &set) |
| : inits_{inits}, exprAnalyzer_{a}, values_{set} {} |
| const DataInitializations &inits() const { return inits_; } |
| bool HasSurplusValues() const { return !values_.IsAtEnd(); } |
| bool Scan(const parser::DataStmtObject &); |
| |
| private: |
| bool Scan(const parser::Variable &); |
| bool Scan(const parser::Designator &); |
| bool Scan(const parser::DataImpliedDo &); |
| bool Scan(const parser::DataIDoObject &); |
| |
| // Initializes all elements of a designator, which can be an array or section. |
| bool InitDesignator(const SomeExpr &); |
| // Initializes a single object. |
| bool InitElement(const evaluate::OffsetSymbol &, const SomeExpr &designator); |
| // If the returned flag is true, emit a warning about CHARACTER misusage. |
| std::optional<std::pair<SomeExpr, bool>> ConvertElement( |
| const SomeExpr &, const evaluate::DynamicType &); |
| |
| DataInitializations &inits_; |
| evaluate::ExpressionAnalyzer &exprAnalyzer_; |
| ValueListIterator values_; |
| }; |
| |
| bool DataInitializationCompiler::Scan(const parser::DataStmtObject &object) { |
| return std::visit( |
| common::visitors{ |
| [&](const common::Indirection<parser::Variable> &var) { |
| return Scan(var.value()); |
| }, |
| [&](const parser::DataImpliedDo &ido) { return Scan(ido); }, |
| }, |
| object.u); |
| } |
| |
| bool DataInitializationCompiler::Scan(const parser::Variable &var) { |
| if (const auto *expr{GetExpr(var)}) { |
| exprAnalyzer_.GetFoldingContext().messages().SetLocation(var.GetSource()); |
| if (InitDesignator(*expr)) { |
| return true; |
| } |
| } |
| return false; |
| } |
| |
| bool DataInitializationCompiler::Scan(const parser::Designator &designator) { |
| if (auto expr{exprAnalyzer_.Analyze(designator)}) { |
| exprAnalyzer_.GetFoldingContext().messages().SetLocation( |
| parser::FindSourceLocation(designator)); |
| if (InitDesignator(*expr)) { |
| return true; |
| } |
| } |
| return false; |
| } |
| |
| bool DataInitializationCompiler::Scan(const parser::DataImpliedDo &ido) { |
| const auto &bounds{std::get<parser::DataImpliedDo::Bounds>(ido.t)}; |
| auto name{bounds.name.thing.thing}; |
| const auto *lowerExpr{GetExpr(bounds.lower.thing.thing)}; |
| const auto *upperExpr{GetExpr(bounds.upper.thing.thing)}; |
| const auto *stepExpr{ |
| bounds.step ? GetExpr(bounds.step->thing.thing) : nullptr}; |
| if (lowerExpr && upperExpr) { |
| auto lower{ToInt64(*lowerExpr)}; |
| auto upper{ToInt64(*upperExpr)}; |
| auto step{stepExpr ? ToInt64(*stepExpr) : std::nullopt}; |
| auto stepVal{step.value_or(1)}; |
| if (stepVal == 0) { |
| exprAnalyzer_.Say(name.source, |
| "DATA statement implied DO loop has a step value of zero"_err_en_US); |
| } else if (lower && upper) { |
| int kind{evaluate::ResultType<evaluate::ImpliedDoIndex>::kind}; |
| if (const auto dynamicType{evaluate::DynamicType::From(*name.symbol)}) { |
| if (dynamicType->category() == TypeCategory::Integer) { |
| kind = dynamicType->kind(); |
| } |
| } |
| if (exprAnalyzer_.AddImpliedDo(name.source, kind)) { |
| auto &value{exprAnalyzer_.GetFoldingContext().StartImpliedDo( |
| name.source, *lower)}; |
| bool result{true}; |
| for (auto n{(*upper - value + stepVal) / stepVal}; n > 0; |
| --n, value += stepVal) { |
| for (const auto &object : |
| std::get<std::list<parser::DataIDoObject>>(ido.t)) { |
| if (!Scan(object)) { |
| result = false; |
| break; |
| } |
| } |
| } |
| exprAnalyzer_.GetFoldingContext().EndImpliedDo(name.source); |
| exprAnalyzer_.RemoveImpliedDo(name.source); |
| return result; |
| } |
| } |
| } |
| return false; |
| } |
| |
| bool DataInitializationCompiler::Scan(const parser::DataIDoObject &object) { |
| return std::visit( |
| common::visitors{ |
| [&](const parser::Scalar<common::Indirection<parser::Designator>> |
| &var) { return Scan(var.thing.value()); }, |
| [&](const common::Indirection<parser::DataImpliedDo> &ido) { |
| return Scan(ido.value()); |
| }, |
| }, |
| object.u); |
| } |
| |
| bool DataInitializationCompiler::InitDesignator(const SomeExpr &designator) { |
| evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()}; |
| evaluate::DesignatorFolder folder{context}; |
| while (auto offsetSymbol{folder.FoldDesignator(designator)}) { |
| if (folder.isOutOfRange()) { |
| if (auto bad{evaluate::OffsetToDesignator(context, *offsetSymbol)}) { |
| exprAnalyzer_.context().Say( |
| "DATA statement designator '%s' is out of range"_err_en_US, |
| bad->AsFortran()); |
| } else { |
| exprAnalyzer_.context().Say( |
| "DATA statement designator '%s' is out of range"_err_en_US, |
| designator.AsFortran()); |
| } |
| return false; |
| } else if (!InitElement(*offsetSymbol, designator)) { |
| return false; |
| } else { |
| ++values_; |
| } |
| } |
| return folder.isEmpty(); |
| } |
| |
| std::optional<std::pair<SomeExpr, bool>> |
| DataInitializationCompiler::ConvertElement( |
| const SomeExpr &expr, const evaluate::DynamicType &type) { |
| if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) { |
| return {std::make_pair(std::move(*converted), false)}; |
| } |
| if (std::optional<std::string> chValue{evaluate::GetScalarConstantValue< |
| evaluate::Type<TypeCategory::Character, 1>>(expr)}) { |
| // Allow DATA initialization with Hollerith and kind=1 CHARACTER like |
| // (most) other Fortran compilers do. Pad on the right with spaces |
| // when short, truncate the right if long. |
| // TODO: big-endian targets |
| auto bytes{static_cast<std::size_t>(evaluate::ToInt64( |
| type.MeasureSizeInBytes(exprAnalyzer_.GetFoldingContext(), false)) |
| .value())}; |
| evaluate::BOZLiteralConstant bits{0}; |
| for (std::size_t j{0}; j < bytes; ++j) { |
| char ch{j >= chValue->size() ? ' ' : chValue->at(j)}; |
| evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)}; |
| bits = bits.IOR(chBOZ.SHIFTL(8 * j)); |
| } |
| if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) { |
| return {std::make_pair(std::move(*converted), true)}; |
| } |
| } |
| return std::nullopt; |
| } |
| |
| bool DataInitializationCompiler::InitElement( |
| const evaluate::OffsetSymbol &offsetSymbol, const SomeExpr &designator) { |
| const Symbol &symbol{offsetSymbol.symbol()}; |
| const Symbol *lastSymbol{GetLastSymbol(designator)}; |
| bool isPointer{lastSymbol && IsPointer(*lastSymbol)}; |
| bool isProcPointer{lastSymbol && IsProcedurePointer(*lastSymbol)}; |
| evaluate::FoldingContext &context{exprAnalyzer_.GetFoldingContext()}; |
| auto restorer{context.messages().SetLocation(values_.LocateSource())}; |
| |
| const auto DescribeElement{[&]() { |
| if (auto badDesignator{ |
| evaluate::OffsetToDesignator(context, offsetSymbol)}) { |
| return badDesignator->AsFortran(); |
| } else { |
| // Error recovery |
| std::string buf; |
| llvm::raw_string_ostream ss{buf}; |
| ss << offsetSymbol.symbol().name() << " offset " << offsetSymbol.offset() |
| << " bytes for " << offsetSymbol.size() << " bytes"; |
| return ss.str(); |
| } |
| }}; |
| const auto GetImage{[&]() -> evaluate::InitialImage & { |
| auto &symbolInit{inits_.emplace(&symbol, symbol.size()).first->second}; |
| symbolInit.inits.emplace_back(offsetSymbol.offset(), offsetSymbol.size()); |
| return symbolInit.image; |
| }}; |
| const auto OutOfRangeError{[&]() { |
| evaluate::AttachDeclaration( |
| exprAnalyzer_.context().Say( |
| "DATA statement designator '%s' is out of range for its variable '%s'"_err_en_US, |
| DescribeElement(), symbol.name()), |
| symbol); |
| }}; |
| |
| if (values_.hasFatalError()) { |
| return false; |
| } else if (values_.IsAtEnd()) { |
| exprAnalyzer_.context().Say( |
| "DATA statement set has no value for '%s'"_err_en_US, |
| DescribeElement()); |
| return false; |
| } else if (static_cast<std::size_t>( |
| offsetSymbol.offset() + offsetSymbol.size()) > symbol.size()) { |
| OutOfRangeError(); |
| return false; |
| } |
| |
| const SomeExpr *expr{*values_}; |
| if (!expr) { |
| CHECK(exprAnalyzer_.context().AnyFatalError()); |
| } else if (isPointer) { |
| if (static_cast<std::size_t>(offsetSymbol.offset() + offsetSymbol.size()) > |
| symbol.size()) { |
| OutOfRangeError(); |
| } else if (evaluate::IsNullPointer(*expr)) { |
| // nothing to do; rely on zero initialization |
| return true; |
| } else if (isProcPointer) { |
| if (evaluate::IsProcedure(*expr)) { |
| if (CheckPointerAssignment(context, designator, *expr)) { |
| GetImage().AddPointer(offsetSymbol.offset(), *expr); |
| return true; |
| } |
| } else { |
| exprAnalyzer_.Say( |
| "Data object '%s' may not be used to initialize '%s', which is a procedure pointer"_err_en_US, |
| expr->AsFortran(), DescribeElement()); |
| } |
| } else if (evaluate::IsProcedure(*expr)) { |
| exprAnalyzer_.Say( |
| "Procedure '%s' may not be used to initialize '%s', which is not a procedure pointer"_err_en_US, |
| expr->AsFortran(), DescribeElement()); |
| } else if (CheckInitialTarget(context, designator, *expr)) { |
| GetImage().AddPointer(offsetSymbol.offset(), *expr); |
| return true; |
| } |
| } else if (evaluate::IsNullPointer(*expr)) { |
| exprAnalyzer_.Say("Initializer for '%s' must not be a pointer"_err_en_US, |
| DescribeElement()); |
| } else if (evaluate::IsProcedure(*expr)) { |
| exprAnalyzer_.Say("Initializer for '%s' must not be a procedure"_err_en_US, |
| DescribeElement()); |
| } else if (auto designatorType{designator.GetType()}) { |
| if (expr->Rank() > 0) { |
| // Because initial-data-target is ambiguous with scalar-constant and |
| // scalar-constant-subobject at parse time, enforcement of scalar-* |
| // must be deferred to here. |
| exprAnalyzer_.Say( |
| "DATA statement value initializes '%s' with an array"_err_en_US, |
| DescribeElement()); |
| } else if (auto converted{ConvertElement(*expr, *designatorType)}) { |
| // value non-pointer initialization |
| if (IsBOZLiteral(*expr) && |
| designatorType->category() != TypeCategory::Integer) { // 8.6.7(11) |
| exprAnalyzer_.Say( |
| "BOZ literal should appear in a DATA statement only as a value for an integer object, but '%s' is '%s'"_en_US, |
| DescribeElement(), designatorType->AsFortran()); |
| } else if (converted->second) { |
| exprAnalyzer_.context().Say( |
| "DATA statement value initializes '%s' of type '%s' with CHARACTER"_en_US, |
| DescribeElement(), designatorType->AsFortran()); |
| } |
| auto folded{evaluate::Fold(context, std::move(converted->first))}; |
| switch (GetImage().Add( |
| offsetSymbol.offset(), offsetSymbol.size(), folded, context)) { |
| case evaluate::InitialImage::Ok: |
| return true; |
| case evaluate::InitialImage::NotAConstant: |
| exprAnalyzer_.Say( |
| "DATA statement value '%s' for '%s' is not a constant"_err_en_US, |
| folded.AsFortran(), DescribeElement()); |
| break; |
| case evaluate::InitialImage::OutOfRange: |
| OutOfRangeError(); |
| break; |
| default: |
| CHECK(exprAnalyzer_.context().AnyFatalError()); |
| break; |
| } |
| } else { |
| exprAnalyzer_.context().Say( |
| "DATA statement value could not be converted to the type '%s' of the object '%s'"_err_en_US, |
| designatorType->AsFortran(), DescribeElement()); |
| } |
| } else { |
| CHECK(exprAnalyzer_.context().AnyFatalError()); |
| } |
| return false; |
| } |
| |
| void AccumulateDataInitializations(DataInitializations &inits, |
| evaluate::ExpressionAnalyzer &exprAnalyzer, |
| const parser::DataStmtSet &set) { |
| DataInitializationCompiler scanner{inits, exprAnalyzer, set}; |
| for (const auto &object : |
| std::get<std::list<parser::DataStmtObject>>(set.t)) { |
| if (!scanner.Scan(object)) { |
| return; |
| } |
| } |
| if (scanner.HasSurplusValues()) { |
| exprAnalyzer.context().Say( |
| "DATA statement set has more values than objects"_err_en_US); |
| } |
| } |
| |
| static bool CombineSomeEquivalencedInits( |
| DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) { |
| auto end{inits.end()}; |
| for (auto iter{inits.begin()}; iter != end; ++iter) { |
| const Symbol &symbol{*iter->first}; |
| Scope &scope{const_cast<Scope &>(symbol.owner())}; |
| if (scope.equivalenceSets().empty()) { |
| continue; // no problem to solve here |
| } |
| const auto *commonBlock{FindCommonBlockContaining(symbol)}; |
| // Sweep following DATA initializations in search of overlapping |
| // objects, accumulating into a vector; iterate to a fixed point. |
| std::vector<const Symbol *> conflicts; |
| auto minStart{symbol.offset()}; |
| auto maxEnd{symbol.offset() + symbol.size()}; |
| std::size_t minElementBytes{1}; |
| while (true) { |
| auto prevCount{conflicts.size()}; |
| conflicts.clear(); |
| for (auto scan{iter}; ++scan != end;) { |
| const Symbol &other{*scan->first}; |
| const Scope &otherScope{other.owner()}; |
| if (&otherScope == &scope && |
| FindCommonBlockContaining(other) == commonBlock && |
| maxEnd > other.offset() && |
| other.offset() + other.size() > minStart) { |
| // "other" conflicts with "symbol" or another conflict |
| conflicts.push_back(&other); |
| minStart = std::min(minStart, other.offset()); |
| maxEnd = std::max(maxEnd, other.offset() + other.size()); |
| } |
| } |
| if (conflicts.size() == prevCount) { |
| break; |
| } |
| } |
| if (conflicts.empty()) { |
| continue; |
| } |
| // Compute the minimum common granularity |
| if (auto dyType{evaluate::DynamicType::From(symbol)}) { |
| minElementBytes = evaluate::ToInt64( |
| dyType->MeasureSizeInBytes(exprAnalyzer.GetFoldingContext(), true)) |
| .value_or(1); |
| } |
| for (const Symbol *s : conflicts) { |
| if (auto dyType{evaluate::DynamicType::From(*s)}) { |
| minElementBytes = std::min<std::size_t>(minElementBytes, |
| evaluate::ToInt64(dyType->MeasureSizeInBytes( |
| exprAnalyzer.GetFoldingContext(), true)) |
| .value_or(1)); |
| } else { |
| minElementBytes = 1; |
| } |
| } |
| CHECK(minElementBytes > 0); |
| CHECK((minElementBytes & (minElementBytes - 1)) == 0); |
| auto bytes{static_cast<common::ConstantSubscript>(maxEnd - minStart)}; |
| CHECK(bytes % minElementBytes == 0); |
| const DeclTypeSpec &typeSpec{scope.MakeNumericType( |
| TypeCategory::Integer, KindExpr{minElementBytes})}; |
| // Combine "symbol" and "conflicts[]" into a compiler array temp |
| // that overlaps all of them, and merge their initial values into |
| // the temp's initializer. |
| SourceName name{exprAnalyzer.context().GetTempName(scope)}; |
| auto emplaced{ |
| scope.try_emplace(name, Attrs{Attr::SAVE}, ObjectEntityDetails{})}; |
| CHECK(emplaced.second); |
| Symbol &combinedSymbol{*emplaced.first->second}; |
| auto &details{combinedSymbol.get<ObjectEntityDetails>()}; |
| combinedSymbol.set_offset(minStart); |
| combinedSymbol.set_size(bytes); |
| details.set_type(typeSpec); |
| ArraySpec arraySpec; |
| arraySpec.emplace_back(ShapeSpec::MakeExplicit(Bound{ |
| bytes / static_cast<common::ConstantSubscript>(minElementBytes)})); |
| details.set_shape(arraySpec); |
| if (commonBlock) { |
| details.set_commonBlock(*commonBlock); |
| } |
| // Merge these EQUIVALENCE'd DATA initializations, and remove the |
| // original initializations from the map. |
| auto combinedInit{ |
| inits.emplace(&combinedSymbol, static_cast<std::size_t>(bytes))}; |
| evaluate::InitialImage &combined{combinedInit.first->second.image}; |
| combined.Incorporate(symbol.offset() - minStart, iter->second.image); |
| inits.erase(iter); |
| for (const Symbol *s : conflicts) { |
| auto sIter{inits.find(s)}; |
| CHECK(sIter != inits.end()); |
| combined.Incorporate(s->offset() - minStart, sIter->second.image); |
| inits.erase(sIter); |
| } |
| return true; // got one |
| } |
| return false; // no remaining EQUIVALENCE'd DATA initializations |
| } |
| |
| // Converts the initialization image for all the DATA statement appearances of |
| // a single symbol into an init() expression in the symbol table entry. |
| void ConstructInitializer(const Symbol &symbol, |
| SymbolDataInitialization &initialization, |
| evaluate::ExpressionAnalyzer &exprAnalyzer) { |
| auto &context{exprAnalyzer.GetFoldingContext()}; |
| initialization.inits.sort(); |
| ConstantSubscript next{0}; |
| for (const auto &init : initialization.inits) { |
| if (init.start() < next) { |
| auto badDesignator{evaluate::OffsetToDesignator( |
| context, symbol, init.start(), init.size())}; |
| CHECK(badDesignator); |
| exprAnalyzer.Say(symbol.name(), |
| "DATA statement initializations affect '%s' more than once"_err_en_US, |
| badDesignator->AsFortran()); |
| } |
| next = init.start() + init.size(); |
| CHECK(next <= static_cast<ConstantSubscript>(initialization.image.size())); |
| } |
| if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}) { |
| CHECK(IsProcedurePointer(symbol)); |
| const auto &procDesignator{initialization.image.AsConstantProcPointer()}; |
| CHECK(!procDesignator.GetComponent()); |
| auto &mutableProc{const_cast<ProcEntityDetails &>(*proc)}; |
| mutableProc.set_init(DEREF(procDesignator.GetSymbol())); |
| } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) { |
| if (auto symbolType{evaluate::DynamicType::From(symbol)}) { |
| auto &mutableObject{const_cast<ObjectEntityDetails &>(*object)}; |
| if (IsPointer(symbol)) { |
| mutableObject.set_init( |
| initialization.image.AsConstantDataPointer(*symbolType)); |
| } else { |
| if (auto extents{evaluate::GetConstantExtents(context, symbol)}) { |
| mutableObject.set_init( |
| initialization.image.AsConstant(context, *symbolType, *extents)); |
| } else { |
| exprAnalyzer.Say(symbol.name(), |
| "internal: unknown shape for '%s' while constructing initializer from DATA"_err_en_US, |
| symbol.name()); |
| return; |
| } |
| } |
| } else { |
| exprAnalyzer.Say(symbol.name(), |
| "internal: no type for '%s' while constructing initializer from DATA"_err_en_US, |
| symbol.name()); |
| return; |
| } |
| if (!object->init()) { |
| exprAnalyzer.Say(symbol.name(), |
| "internal: could not construct an initializer from DATA statements for '%s'"_err_en_US, |
| symbol.name()); |
| } |
| } else { |
| CHECK(exprAnalyzer.context().AnyFatalError()); |
| } |
| } |
| |
| void ConvertToInitializers( |
| DataInitializations &inits, evaluate::ExpressionAnalyzer &exprAnalyzer) { |
| while (CombineSomeEquivalencedInits(inits, exprAnalyzer)) { |
| } |
| for (auto &[symbolPtr, initialization] : inits) { |
| ConstructInitializer(*symbolPtr, initialization, exprAnalyzer); |
| } |
| } |
| } // namespace Fortran::semantics |