diff --git a/flang/include/flang/Lower/AbstractConverter.h b/flang/include/flang/Lower/AbstractConverter.h --- a/flang/include/flang/Lower/AbstractConverter.h +++ b/flang/include/flang/Lower/AbstractConverter.h @@ -159,6 +159,11 @@ /// Generate the type from a Variable virtual mlir::Type genType(const pft::Variable &) = 0; + /// Register a runtime derived type information object symbol to ensure its + /// object will be generated as a global. + virtual void registerRuntimeTypeInfo(mlir::Location loc, + SymbolRef typeInfoSym) = 0; + //===--------------------------------------------------------------------===// // Locations //===--------------------------------------------------------------------===// diff --git a/flang/include/flang/Lower/Support/Utils.h b/flang/include/flang/Lower/Support/Utils.h --- a/flang/include/flang/Lower/Support/Utils.h +++ b/flang/include/flang/Lower/Support/Utils.h @@ -57,4 +57,25 @@ return Fortran::evaluate::AsGenericExpr(Fortran::common::Clone(x)); } +template +static Fortran::lower::SomeExpr ignoreEvConvert( + const Fortran::evaluate::Convert< + Fortran::evaluate::Type, + FROM> &x) { + return toEvExpr(x.left()); +} +template +static Fortran::lower::SomeExpr ignoreEvConvert(const A &x) { + return toEvExpr(x); +} + +/// A vector subscript expression may be wrapped with a cast to INTEGER*8. +/// Get rid of it here so the vector can be loaded. Add it back when +/// generating the elemental evaluation (inside the loop nest). +inline Fortran::lower::SomeExpr +ignoreEvConvert(const Fortran::evaluate::Expr> &x) { + return std::visit([](const auto &v) { return ignoreEvConvert(v); }, x.u); +} + #endif // FORTRAN_LOWER_SUPPORT_UTILS_H diff --git a/flang/include/flang/Lower/VectorSubscripts.h b/flang/include/flang/Lower/VectorSubscripts.h new file mode 100644 --- /dev/null +++ b/flang/include/flang/Lower/VectorSubscripts.h @@ -0,0 +1,154 @@ +//===-- VectorSubscripts.h -- vector subscripts tools -----------*- 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 +// +//===----------------------------------------------------------------------===// +/// +/// \file +/// \brief Defines a compiler internal representation for lowered designators +/// containing vector subscripts. This representation allows working on such +/// designators in custom ways while ensuring the designator subscripts are +/// only evaluated once. It is mainly intended for cases that do not fit in +/// the array expression lowering framework like input IO in presence of +/// vector subscripts. +/// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_LOWER_VECTORSUBSCRIPTS_H +#define FORTRAN_LOWER_VECTORSUBSCRIPTS_H + +#include "flang/Optimizer/Builder/BoxValue.h" + +namespace fir { +class FirOpBuilder; +} + +namespace Fortran { + +namespace evaluate { +template +class Expr; +struct SomeType; +} // namespace evaluate + +namespace lower { + +class AbstractConverter; +class StatementContext; + +/// VectorSubscriptBox is a lowered representation for any Designator that +/// contain at least one vector subscript. +/// +/// A designator `x%a(i,j)%b(1:foo():1, vector, k)%c%d(m)%e1 +/// Is lowered into: +/// - an ExtendedValue for ranked base (x%a(i,j)%b) +/// - mlir:Values and ExtendedValues for the triplet, vector subscript and +/// scalar subscripts of the ranked array reference (1:foo():1, vector, k) +/// - a list of fir.field_index and scalar integers mlir::Value for the +/// component +/// path at the right of the ranked array ref (%c%d(m)%e). +/// +/// This representation allows later creating loops over the designator elements +/// and fir.array_coor to get the element addresses without re-evaluating any +/// sub-expressions. +class VectorSubscriptBox { +public: + /// Type of the callbacks that can be passed to work with the element + /// addresses. + using ElementalGenerator = std::function; + using ElementalGeneratorWithBoolReturn = + std::function; + struct LoweredVectorSubscript { + LoweredVectorSubscript(fir::ExtendedValue &&vector, mlir::Value size) + : vector{std::move(vector)}, size{size} {} + fir::ExtendedValue vector; + // Vector size, guaranteed to be of indexType. + mlir::Value size; + }; + struct LoweredTriplet { + // Triplets value, guaranteed to be of indexType. + mlir::Value lb; + mlir::Value ub; + mlir::Value stride; + }; + using LoweredSubscript = + std::variant; + using MaybeSubstring = llvm::SmallVector; + VectorSubscriptBox( + fir::ExtendedValue &&loweredBase, + llvm::SmallVector &&loweredSubscripts, + llvm::SmallVector &&componentPath, + MaybeSubstring substringBounds, mlir::Type elementType) + : loweredBase{std::move(loweredBase)}, loweredSubscripts{std::move( + loweredSubscripts)}, + componentPath{std::move(componentPath)}, + substringBounds{substringBounds}, elementType{elementType} {}; + + /// Loop over the elements described by the VectorSubscriptBox, and call + /// \p elementalGenerator inside the loops with the element addresses. + void loopOverElements(fir::FirOpBuilder &builder, mlir::Location loc, + const ElementalGenerator &elementalGenerator); + + /// Loop over the elements described by the VectorSubscriptBox while a + /// condition is true, and call \p elementalGenerator inside the loops with + /// the element addresses. The initial condition value is \p initialCondition, + /// and then it is the result of \p elementalGenerator. The value of the + /// condition after the loops is returned. + mlir::Value loopOverElementsWhile( + fir::FirOpBuilder &builder, mlir::Location loc, + const ElementalGeneratorWithBoolReturn &elementalGenerator, + mlir::Value initialCondition); + + /// Return the type of the elements of the array section. + mlir::Type getElementType() { return elementType; } + +private: + /// Common implementation for DoLoop and IterWhile loop creations. + template + mlir::Value loopOverElementsBase(fir::FirOpBuilder &builder, + mlir::Location loc, + const Generator &elementalGenerator, + mlir::Value initialCondition); + /// Create sliceOp for the designator. + mlir::Value createSlice(fir::FirOpBuilder &builder, mlir::Location loc); + + /// Create ExtendedValue the element inside the loop. + fir::ExtendedValue getElementAt(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value shape, + mlir::Value slice, + mlir::ValueRange inductionVariables); + + /// Generate the [lb, ub, step] to loop over the section (in loop order, not + /// Fortran dimension order). + llvm::SmallVector> + genLoopBounds(fir::FirOpBuilder &builder, mlir::Location loc); + + /// Lowered base of the ranked array ref. + fir::ExtendedValue loweredBase; + /// Subscripts values of the rank arrayRef part. + llvm::SmallVector loweredSubscripts; + /// Scalar subscripts and components at the right of the ranked + /// array ref part of any. + llvm::SmallVector componentPath; + /// List of substring bounds if this is a substring (only the lower bound if + /// the upper is implicit). + MaybeSubstring substringBounds; + /// Type of the elements described by this array section. + mlir::Type elementType; +}; + +/// Lower \p expr, that must be an designator containing vector subscripts, to a +/// VectorSubscriptBox representation. This causes evaluation of all the +/// subscripts. Any required clean-ups from subscript expression are added to \p +/// stmtCtx. +VectorSubscriptBox genVectorSubscriptBox( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx, + const Fortran::evaluate::Expr &expr); + +} // namespace lower +} // namespace Fortran + +#endif // FORTRAN_LOWER_VECTORSUBSCRIPTS_H diff --git a/flang/include/flang/Optimizer/Transforms/Passes.h b/flang/include/flang/Optimizer/Transforms/Passes.h --- a/flang/include/flang/Optimizer/Transforms/Passes.h +++ b/flang/include/flang/Optimizer/Transforms/Passes.h @@ -38,6 +38,7 @@ std::unique_ptr createMemoryAllocationPass(bool dynOnHeap, std::size_t maxStackSize); std::unique_ptr createAnnotateConstantOperandsPass(); +std::unique_ptr createSimplifyRegionLitePass(); // declarative passes #define GEN_PASS_REGISTRATION diff --git a/flang/include/flang/Optimizer/Transforms/Passes.td b/flang/include/flang/Optimizer/Transforms/Passes.td --- a/flang/include/flang/Optimizer/Transforms/Passes.td +++ b/flang/include/flang/Optimizer/Transforms/Passes.td @@ -188,4 +188,12 @@ let constructor = "::fir::createMemoryAllocationPass()"; } +def SimplifyRegionLite : Pass<"simplify-region-lite", "mlir::ModuleOp"> { + let summary = "Region simplification"; + let description = [{ + Run region DCE and erase unreachable blocks in regions. + }]; + let constructor = "::fir::createSimplifyRegionLitePass()"; +} + #endif // FLANG_OPTIMIZER_TRANSFORMS_PASSES diff --git a/flang/include/flang/Tools/CLOptions.inc b/flang/include/flang/Tools/CLOptions.inc --- a/flang/include/flang/Tools/CLOptions.inc +++ b/flang/include/flang/Tools/CLOptions.inc @@ -143,6 +143,7 @@ fir::addAVC(pm); pm.addNestedPass(fir::createCharacterConversionPass()); pm.addPass(mlir::createCanonicalizerPass(config)); + pm.addPass(fir::createSimplifyRegionLitePass()); fir::addMemoryAllocationOpt(pm); // The default inliner pass adds the canonicalizer pass with the default @@ -157,6 +158,7 @@ pm.addPass(mlir::createConvertSCFToCFPass()); pm.addPass(mlir::createCanonicalizerPass(config)); + pm.addPass(fir::createSimplifyRegionLitePass()); } #if !defined(FLANG_EXCLUDE_CODEGEN) diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -49,6 +49,68 @@ "fdebug-dump-pre-fir", llvm::cl::init(false), llvm::cl::desc("dump the Pre-FIR tree prior to FIR generation")); +namespace { +/// Helper class to generate the runtime type info global data. This data +/// is required to describe the derived type to the runtime so that it can +/// operate over it. It must be ensured this data will be generated for every +/// derived type lowered in the current translated unit. However, this data +/// cannot be generated before FuncOp have been created for functions since the +/// initializers may take their address (e.g for type bound procedures). This +/// class allows registering all the required runtime type info while it is not +/// possible to create globals, and to generate this data after function +/// lowering. +class RuntimeTypeInfoConverter { + /// Store the location and symbols of derived type info to be generated. + /// The location of the derived type instantiation is also stored because + /// runtime type descriptor symbol are compiler generated and cannot be mapped + /// to user code on their own. + struct TypeInfoSymbol { + Fortran::semantics::SymbolRef symbol; + mlir::Location loc; + }; + +public: + void registerTypeInfoSymbol(Fortran::lower::AbstractConverter &converter, + mlir::Location loc, + Fortran::semantics::SymbolRef typeInfoSym) { + if (seen.contains(typeInfoSym)) + return; + seen.insert(typeInfoSym); + if (!skipRegistration) { + registeredTypeInfoSymbols.emplace_back(TypeInfoSymbol{typeInfoSym, loc}); + return; + } + // Once the registration is closed, symbols cannot be added to the + // registeredTypeInfoSymbols list because it may be iterated over. + // However, after registration is closed, it is safe to directly generate + // the globals because all FuncOps whose addresses may be required by the + // initializers have been generated. + Fortran::lower::createRuntimeTypeInfoGlobal(converter, loc, + typeInfoSym.get()); + } + + void createTypeInfoGlobals(Fortran::lower::AbstractConverter &converter) { + skipRegistration = true; + for (const TypeInfoSymbol &info : registeredTypeInfoSymbols) + Fortran::lower::createRuntimeTypeInfoGlobal(converter, info.loc, + info.symbol.get()); + registeredTypeInfoSymbols.clear(); + } + +private: + /// Store the runtime type descriptors that will be required for the + /// derived type that have been converted to FIR derived types. + llvm::SmallVector registeredTypeInfoSymbols; + /// Create derived type runtime info global immediately without storing the + /// symbol in registeredTypeInfoSymbols. + bool skipRegistration = false; + /// Track symbols symbols processed during and after the registration + /// to avoid infinite loops between type conversions and global variable + /// creation. + llvm::SmallSetVector seen; +}; +} // namespace + //===----------------------------------------------------------------------===// // FirConverter //===----------------------------------------------------------------------===// @@ -101,6 +163,12 @@ }, u); } + + /// Once all the code has been translated, create runtime type info + /// global data structure for the derived types that have been + /// processed. + createGlobalOutsideOfFunctionLowering( + [&]() { runtimeTypeInfoConverter.createTypeInfoGlobals(*this); }); } /// Declare a function. @@ -689,6 +757,12 @@ hostAssocTuple = val; } + void registerRuntimeTypeInfo( + mlir::Location loc, + Fortran::lower::SymbolRef typeInfoSym) override final { + runtimeTypeInfoConverter.registerTypeInfoSymbol(*this, loc, typeInfoSym); + } + private: FirConverter() = delete; FirConverter(const FirConverter &) = delete; @@ -2319,6 +2393,7 @@ Fortran::lower::pft::Evaluation *evalPtr = nullptr; Fortran::lower::SymMap localSymbols; Fortran::parser::CharBlock currentPosition; + RuntimeTypeInfoConverter runtimeTypeInfoConverter; /// Tuple of host assoicated variables. mlir::Value hostAssocTuple; diff --git a/flang/lib/Lower/CMakeLists.txt b/flang/lib/Lower/CMakeLists.txt --- a/flang/lib/Lower/CMakeLists.txt +++ b/flang/lib/Lower/CMakeLists.txt @@ -21,6 +21,7 @@ PFTBuilder.cpp Runtime.cpp SymbolMap.cpp + VectorSubscripts.cpp DEPENDS FIRDialect diff --git a/flang/lib/Lower/ConvertType.cpp b/flang/lib/Lower/ConvertType.cpp --- a/flang/lib/Lower/ConvertType.cpp +++ b/flang/lib/Lower/ConvertType.cpp @@ -8,6 +8,8 @@ #include "flang/Lower/ConvertType.h" #include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/CallInterface.h" +#include "flang/Lower/ConvertVariable.h" #include "flang/Lower/Mangler.h" #include "flang/Lower/PFTBuilder.h" #include "flang/Lower/Support/Utils.h" @@ -128,8 +130,8 @@ /// Do not use the FirOpBuilder from the AbstractConverter to get fir/mlir types /// since it is not guaranteed to exist yet when we lower types. namespace { -class TypeBuilder { -public: +struct TypeBuilder { + TypeBuilder(Fortran::lower::AbstractConverter &converter) : converter{converter}, context{&converter.getMLIRContext()} {} @@ -196,8 +198,7 @@ }, [&](const Fortran::evaluate::ProcedureDesignator &proc) -> mlir::Type { - TODO(converter.getCurrentLocation(), - "genTypelessExprType ProcedureDesignator"); + return Fortran::lower::translateSignature(proc, converter); }, [&](const Fortran::evaluate::ProcedureRef &) -> mlir::Type { return mlir::NoneType::get(context); @@ -232,7 +233,7 @@ translateLenParameters(params, tySpec->category(), ultimate); ty = genFIRType(context, tySpec->category(), kind, params); } else if (type->IsPolymorphic()) { - TODO(loc, "genSymbolType polymorphic types"); + TODO(loc, "[genSymbolType] polymorphic types"); } else if (const Fortran::semantics::DerivedTypeSpec *tySpec = type->AsDerived()) { ty = genDerivedType(*tySpec); @@ -321,13 +322,20 @@ rec.finalize(ps, cs); popDerivedTypeInConstruction(); + mlir::Location loc = converter.genLocation(typeSymbol.name()); if (!ps.empty()) { // This type is a PDT (parametric derived type). Create the functions to // use for allocation, dereferencing, and address arithmetic here. - TODO(converter.genLocation(typeSymbol.name()), - "parametrized derived types lowering"); + TODO(loc, "parametrized derived types lowering"); } LLVM_DEBUG(llvm::dbgs() << "derived type: " << rec << '\n'); + + // Generate the type descriptor object if any + if (const Fortran::semantics::Scope *derivedScope = + tySpec.scope() ? tySpec.scope() : tySpec.typeSymbol().scope()) + if (const Fortran::semantics::Symbol *typeInfoSym = + derivedScope->runtimeDerivedTypeDescription()) + converter.registerRuntimeTypeInfo(loc, *typeInfoSym); return rec; } @@ -418,7 +426,6 @@ Fortran::lower::AbstractConverter &converter; mlir::MLIRContext *context; }; - } // namespace mlir::Type Fortran::lower::getFIRType(mlir::MLIRContext *context, diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp --- a/flang/lib/Lower/IO.cpp +++ b/flang/lib/Lower/IO.cpp @@ -12,18 +12,21 @@ #include "flang/Lower/IO.h" #include "flang/Common/uint128.h" +#include "flang/Lower/Allocatable.h" #include "flang/Lower/Bridge.h" +#include "flang/Lower/ConvertExpr.h" #include "flang/Lower/ConvertVariable.h" #include "flang/Lower/PFTBuilder.h" +#include "flang/Lower/Runtime.h" #include "flang/Lower/StatementContext.h" #include "flang/Lower/Support/Utils.h" #include "flang/Lower/Todo.h" -#include "flang/Optimizer/Builder/BoxValue.h" +#include "flang/Lower/VectorSubscripts.h" #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/Complex.h" #include "flang/Optimizer/Builder/FIRBuilder.h" -#include "flang/Optimizer/Builder/MutableBox.h" #include "flang/Optimizer/Builder/Runtime/RTBuilder.h" +#include "flang/Optimizer/Support/FIRContext.h" #include "flang/Parser/parse-tree.h" #include "flang/Runtime/io-api.h" #include "flang/Semantics/tools.h" @@ -31,8 +34,6 @@ #define DEBUG_TYPE "flang-lower-io" -using namespace mlir; - // Define additional runtime type models specific to IO. namespace fir::runtime { template <> @@ -86,18 +87,15 @@ mkIOKey(InputDescriptor), mkIOKey(OutputUnformattedBlock), mkIOKey(InputUnformattedBlock), mkIOKey(OutputInteger8), mkIOKey(OutputInteger16), mkIOKey(OutputInteger32), - mkIOKey(OutputInteger64), -#ifdef __SIZEOF_INT128__ - mkIOKey(OutputInteger128), -#endif - mkIOKey(InputInteger), mkIOKey(OutputReal32), mkIOKey(InputReal32), - mkIOKey(OutputReal64), mkIOKey(InputReal64), mkIOKey(OutputComplex32), - mkIOKey(InputComplex32), mkIOKey(OutputComplex64), mkIOKey(InputComplex64), - mkIOKey(OutputAscii), mkIOKey(InputAscii), mkIOKey(OutputLogical), - mkIOKey(InputLogical), mkIOKey(SetAccess), mkIOKey(SetAction), - mkIOKey(SetAsynchronous), mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), - mkIOKey(SetForm), mkIOKey(SetPosition), mkIOKey(SetRecl), - mkIOKey(SetStatus), mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize), + mkIOKey(OutputInteger64), mkIOKey(OutputInteger128), mkIOKey(InputInteger), + mkIOKey(OutputReal32), mkIOKey(InputReal32), mkIOKey(OutputReal64), + mkIOKey(InputReal64), mkIOKey(OutputComplex32), mkIOKey(InputComplex32), + mkIOKey(OutputComplex64), mkIOKey(InputComplex64), mkIOKey(OutputAscii), + mkIOKey(InputAscii), mkIOKey(OutputLogical), mkIOKey(InputLogical), + mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAsynchronous), + mkIOKey(SetCarriagecontrol), mkIOKey(SetEncoding), mkIOKey(SetForm), + mkIOKey(SetPosition), mkIOKey(SetRecl), mkIOKey(SetStatus), + mkIOKey(SetFile), mkIOKey(GetNewUnit), mkIOKey(GetSize), mkIOKey(GetIoLength), mkIOKey(GetIoMsg), mkIOKey(InquireCharacter), mkIOKey(InquireLogical), mkIOKey(InquirePendingId), mkIOKey(InquireInteger64), mkIOKey(EndIoStatement)> @@ -152,6 +150,10 @@ return std::get(Fortran::lower::newIOTable).getTypeModel(); } +inline int64_t getLength(mlir::Type argTy) { + return argTy.cast().getShape()[0]; +} + /// Get (or generate) the MLIR FuncOp for a given IO runtime function. template static mlir::FuncOp getIORuntimeFunc(mlir::Location loc, @@ -267,18 +269,22 @@ groupIsLocal = true; continue; } - std::string mangleName = converter.mangleName(s) + ".desc"; - if (builder.getNamedGlobal(mangleName)) - continue; - const auto expr = Fortran::evaluate::AsGenericExpr(s); - fir::BoxType boxTy = - fir::BoxType::get(fir::PointerType::get(converter.genType(s))); - auto descFunc = [&](fir::FirOpBuilder &b) { - auto box = - Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr); - b.create(loc, box); - }; - builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce); + // We know we have a global item. It it's not a pointer or allocatable, + // create a static pointer to it. + if (!IsAllocatableOrPointer(s)) { + std::string mangleName = converter.mangleName(s) + ".desc"; + if (builder.getNamedGlobal(mangleName)) + continue; + const auto expr = Fortran::evaluate::AsGenericExpr(s); + fir::BoxType boxTy = + fir::BoxType::get(fir::PointerType::get(converter.genType(s))); + auto descFunc = [&](fir::FirOpBuilder &b) { + auto box = + Fortran::lower::genInitialDataTarget(converter, loc, boxTy, *expr); + b.create(loc, box); + }; + builder.createGlobalConstant(loc, boxTy, mangleName, descFunc, linkOnce); + } } // Define the list of Items. @@ -301,8 +307,10 @@ builder.getArrayAttr(idx)); idx[1] = one; mlir::Value descAddr; + // Items that we created end in ".desc". + std::string suffix = IsAllocatableOrPointer(s) ? "" : ".desc"; if (auto desc = - builder.getNamedGlobal(converter.mangleName(s) + ".desc")) { + builder.getNamedGlobal(converter.mangleName(s) + suffix)) { descAddr = builder.create(loc, desc.resultType(), desc.getSymbol()); } else { @@ -408,10 +416,8 @@ return getIORuntimeFunc(loc, builder); case 64: return getIORuntimeFunc(loc, builder); -#ifdef __SIZEOF_INT128__ case 128: return getIORuntimeFunc(loc, builder); -#endif } llvm_unreachable("unknown OutputInteger kind"); } @@ -421,16 +427,27 @@ else if (width == 64) return getIORuntimeFunc(loc, builder); } + auto kindMap = fir::getKindMapping(builder.getModule()); if (auto ty = type.dyn_cast()) { - if (auto kind = ty.getFKind(); kind == 4) + // COMPLEX(KIND=k) corresponds to a pair of REAL(KIND=k). + auto width = kindMap.getRealBitsize(ty.getFKind()); + if (width == 32) return getIORuntimeFunc(loc, builder); - else if (kind == 8) + else if (width == 64) return getIORuntimeFunc(loc, builder); } if (type.isa()) return getIORuntimeFunc(loc, builder); - if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) - return getIORuntimeFunc(loc, builder); + if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) { + // TODO: What would it mean if the default CHARACTER KIND is set to a wide + // character encoding scheme? How do we handle UTF-8? Is it a distinct KIND + // value? For now, assume that if the default CHARACTER KIND is 8 bit, + // then it is an ASCII string and UTF-8 is unsupported. + auto asciiKind = kindMap.defaultCharacterKind(); + if (kindMap.getCharacterBitsize(asciiKind) == 8 && + fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind) + return getIORuntimeFunc(loc, builder); + } return getIORuntimeFunc(loc, builder); } @@ -509,19 +526,42 @@ else if (width <= 64) return getIORuntimeFunc(loc, builder); } + auto kindMap = fir::getKindMapping(builder.getModule()); if (auto ty = type.dyn_cast()) { - if (auto kind = ty.getFKind(); kind <= 4) + auto width = kindMap.getRealBitsize(ty.getFKind()); + if (width <= 32) return getIORuntimeFunc(loc, builder); - else if (kind <= 8) + else if (width <= 64) return getIORuntimeFunc(loc, builder); } if (type.isa()) return getIORuntimeFunc(loc, builder); - if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) - return getIORuntimeFunc(loc, builder); + if (fir::factory::CharacterExprHelper::isCharacterScalar(type)) { + auto asciiKind = kindMap.defaultCharacterKind(); + if (kindMap.getCharacterBitsize(asciiKind) == 8 && + fir::factory::CharacterExprHelper::getCharacterKind(type) == asciiKind) + return getIORuntimeFunc(loc, builder); + } return getIORuntimeFunc(loc, builder); } +/// Interpret the lowest byte of a LOGICAL and store that value into the full +/// storage of the LOGICAL. The load, convert, and store effectively (sign or +/// zero) extends the lowest byte into the full LOGICAL value storage, as the +/// runtime is unaware of the LOGICAL value's actual bit width (it was passed +/// as a `bool&` to the runtime in order to be set). +static void boolRefToLogical(mlir::Location loc, fir::FirOpBuilder &builder, + mlir::Value addr) { + auto boolType = builder.getRefType(builder.getI1Type()); + auto boolAddr = builder.createConvert(loc, boolType, addr); + auto boolValue = builder.create(loc, boolAddr); + auto logicalType = fir::unwrapPassByRefType(addr.getType()); + // The convert avoid making any assumptions about how LOGICALs are actually + // represented (it might end-up being either a signed or zero extension). + auto logicalValue = builder.createConvert(loc, logicalType, boolValue); + builder.create(loc, logicalValue, addr); +} + static mlir::Value createIoRuntimeCallForItem(mlir::Location loc, fir::FirOpBuilder &builder, mlir::FuncOp inputFunc, @@ -548,8 +588,12 @@ itemTy.cast().getWidth() / 8))); } } - return builder.create(loc, inputFunc, inputFuncArgs) - .getResult(0); + auto call = builder.create(loc, inputFunc, inputFuncArgs); + auto itemAddr = fir::getBase(item); + auto itemTy = fir::unwrapRefType(itemAddr.getType()); + if (itemTy.isa()) + boolRefToLogical(loc, builder, itemAddr); + return call.getResult(0); } /// Generate a sequence of input data transfer calls. @@ -573,7 +617,31 @@ if (!expr) fir::emitFatalError(loc, "internal error: could not get evaluate::Expr"); if (Fortran::evaluate::HasVectorSubscript(*expr)) { - TODO(loc, "genInputItemList with VectorSubscript"); + auto vectorSubscriptBox = + Fortran::lower::genVectorSubscriptBox(loc, converter, stmtCtx, *expr); + mlir::FuncOp inputFunc = getInputFunc( + loc, builder, vectorSubscriptBox.getElementType(), isFormatted); + const bool mustBox = inputFunc.getType().getInput(1).isa(); + if (!checkResult) { + auto elementalGenerator = [&](const fir::ExtendedValue &element) { + createIoRuntimeCallForItem(loc, builder, inputFunc, cookie, + mustBox ? builder.createBox(loc, element) + : element); + }; + vectorSubscriptBox.loopOverElements(builder, loc, elementalGenerator); + } else { + auto elementalGenerator = + [&](const fir::ExtendedValue &element) -> mlir::Value { + return createIoRuntimeCallForItem( + loc, builder, inputFunc, cookie, + mustBox ? builder.createBox(loc, element) : element); + }; + if (!ok) + ok = builder.createBool(loc, true); + ok = vectorSubscriptBox.loopOverElementsWhile(builder, loc, + elementalGenerator, ok); + } + continue; } mlir::Type itemTy = converter.genType(*expr); mlir::FuncOp inputFunc = getInputFunc(loc, builder, itemTy, isFormatted); @@ -653,8 +721,8 @@ genItemList(ioImpliedDo); // Unwind nested IO call scopes, filling in true and false ResultOp's. for (mlir::Operation *op = builder.getBlock()->getParentOp(); - isa(op); op = op->getBlock()->getParentOp()) { - auto ifOp = dyn_cast(op); + mlir::isa(op); op = op->getBlock()->getParentOp()) { + auto ifOp = mlir::dyn_cast(op); mlir::Operation *lastOp = &ifOp.getThenRegion().front().back(); builder.setInsertionPointAfter(lastOp); // The primary ifOp result is the result of an IO call or loop. @@ -924,24 +992,6 @@ return genIntIOOption(converter, loc, cookie, spec); } -template <> -mlir::Value genIOOption( - Fortran::lower::AbstractConverter &converter, mlir::Location loc, - mlir::Value cookie, const Fortran::parser::ConnectSpec::Newunit &spec) { - Fortran::lower::StatementContext stmtCtx; - fir::FirOpBuilder &builder = converter.getFirOpBuilder(); - mlir::FuncOp ioFunc = getIORuntimeFunc(loc, builder); - mlir::FunctionType ioFuncTy = ioFunc.getType(); - const auto *var = Fortran::semantics::GetExpr(spec); - mlir::Value addr = builder.createConvert( - loc, ioFuncTy.getInput(1), - fir::getBase(converter.genExprAddr(var, stmtCtx, loc))); - auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2), - var->GetType().value().kind()); - llvm::SmallVector ioArgs = {cookie, addr, kind}; - return builder.create(loc, ioFunc, ioArgs).getResult(0); -} - template <> mlir::Value genIOOption( Fortran::lower::AbstractConverter &converter, mlir::Location loc, @@ -1062,7 +1112,7 @@ } template -static bool hasMem(const A &stmt) { +static bool hasSpec(const A &stmt) { return hasX(stmt.v); } @@ -1090,6 +1140,12 @@ // before. return ok; }, + [&](const Fortran::parser::ConnectSpec::Newunit &x) -> mlir::Value { + // Newunit must be queried after OPEN specifier runtime calls + // that may fail to avoid modifying the newunit variable if + // there is an error. + return ok; + }, [&](const auto &x) { return genIOOption(converter, loc, cookie, x); }}, @@ -1539,6 +1595,29 @@ return genBasicIOStmt(converter, stmt); } +static mlir::Value +genNewunitSpec(Fortran::lower::AbstractConverter &converter, mlir::Location loc, + mlir::Value cookie, + const std::list &specList) { + for (const auto &spec : specList) + if (auto *newunit = + std::get_if(&spec.u)) { + Fortran::lower::StatementContext stmtCtx; + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::FuncOp ioFunc = getIORuntimeFunc(loc, builder); + mlir::FunctionType ioFuncTy = ioFunc.getType(); + const auto *var = Fortran::semantics::GetExpr(newunit->v); + mlir::Value addr = builder.createConvert( + loc, ioFuncTy.getInput(1), + fir::getBase(converter.genExprAddr(var, stmtCtx, loc))); + auto kind = builder.createIntegerConstant(loc, ioFuncTy.getInput(2), + var->GetType().value().kind()); + llvm::SmallVector ioArgs = {cookie, addr, kind}; + return builder.create(loc, ioFunc, ioArgs).getResult(0); + } + llvm_unreachable("missing Newunit spec"); +} + mlir::Value Fortran::lower::genOpenStatement(Fortran::lower::AbstractConverter &converter, const Fortran::parser::OpenStmt &stmt) { @@ -1547,7 +1626,8 @@ mlir::FuncOp beginFunc; llvm::SmallVector beginArgs; mlir::Location loc = converter.getCurrentLocation(); - if (hasMem(stmt)) { + bool hasNewunitSpec = false; + if (hasSpec(stmt)) { beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); mlir::Value unit = fir::getBase(converter.genExprValue( @@ -1557,7 +1637,8 @@ beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(1))); beginArgs.push_back(locToLineNo(converter, loc, beginFuncTy.getInput(2))); } else { - assert(hasMem(stmt)); + hasNewunitSpec = hasSpec(stmt); + assert(hasNewunitSpec && "missing unit specifier"); beginFunc = getIORuntimeFunc(loc, builder); mlir::FunctionType beginFuncTy = beginFunc.getType(); beginArgs.push_back(locToFilename(converter, loc, beginFuncTy.getInput(0))); @@ -1570,6 +1651,8 @@ mlir::Value ok; auto insertPt = builder.saveInsertionPoint(); threadSpecs(converter, loc, cookie, stmt.v, csi.hasErrorConditionSpec(), ok); + if (hasNewunitSpec) + genNewunitSpec(converter, loc, cookie, stmt.v); builder.restoreInsertionPoint(insertPt); return genEndIO(converter, loc, cookie, csi, stmtCtx); } @@ -1586,7 +1669,7 @@ fir::FirOpBuilder &builder = converter.getFirOpBuilder(); Fortran::lower::StatementContext stmtCtx; mlir::Location loc = converter.getCurrentLocation(); - bool hasId = hasMem(stmt); + bool hasId = hasSpec(stmt); mlir::FuncOp beginFunc = hasId ? getIORuntimeFunc(loc, builder) : getIORuntimeFunc(loc, builder); @@ -1911,9 +1994,9 @@ if (!eleTy) fir::emitFatalError(loc, "internal error: expected a memory reference type"); - auto bitWidth = eleTy.cast().getWidth(); + auto width = eleTy.cast().getWidth(); mlir::IndexType idxTy = builder.getIndexType(); - mlir::Value kind = builder.createIntegerConstant(loc, idxTy, bitWidth / 8); + mlir::Value kind = builder.createIntegerConstant(loc, idxTy, width / 8); llvm::SmallVector args = { builder.createConvert(loc, specFuncTy.getInput(0), cookie), builder.createIntegerConstant( @@ -1958,7 +2041,9 @@ Fortran::parser::InquireSpec::LogVar::EnumToString(logVarKind) .c_str()))); args.push_back(builder.createConvert(loc, specFuncTy.getInput(2), addr)); - return builder.create(loc, specFunc, args).getResult(0); + auto call = builder.create(loc, specFunc, args); + boolRefToLogical(loc, builder, addr); + return call.getResult(0); } /// If there is an IdExpr in the list of inquire-specs, then lower it and return diff --git a/flang/lib/Lower/VectorSubscripts.cpp b/flang/lib/Lower/VectorSubscripts.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Lower/VectorSubscripts.cpp @@ -0,0 +1,427 @@ +//===-- VectorSubscripts.cpp -- Vector subscripts tools -------------------===// +// +// 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 +// +//===----------------------------------------------------------------------===// +// +// Coding style: https://mlir.llvm.org/getting_started/DeveloperGuide/ +// +//===----------------------------------------------------------------------===// + +#include "flang/Lower/VectorSubscripts.h" +#include "flang/Lower/AbstractConverter.h" +#include "flang/Lower/Support/Utils.h" +#include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/Character.h" +#include "flang/Optimizer/Builder/Complex.h" +#include "flang/Optimizer/Builder/FIRBuilder.h" +#include "flang/Semantics/expression.h" + +namespace { +/// Helper class to lower a designator containing vector subscripts into a +/// lowered representation that can be worked with. +class VectorSubscriptBoxBuilder { +public: + VectorSubscriptBoxBuilder(mlir::Location loc, + Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx) + : converter{converter}, stmtCtx{stmtCtx}, loc{loc} {} + + Fortran::lower::VectorSubscriptBox gen(const Fortran::lower::SomeExpr &expr) { + elementType = genDesignator(expr); + return Fortran::lower::VectorSubscriptBox( + std::move(loweredBase), std::move(loweredSubscripts), + std::move(componentPath), substringBounds, elementType); + } + +private: + using LoweredVectorSubscript = + Fortran::lower::VectorSubscriptBox::LoweredVectorSubscript; + using LoweredTriplet = Fortran::lower::VectorSubscriptBox::LoweredTriplet; + using LoweredSubscript = Fortran::lower::VectorSubscriptBox::LoweredSubscript; + using MaybeSubstring = Fortran::lower::VectorSubscriptBox::MaybeSubstring; + + /// genDesignator unwraps a Designator and calls `gen` on what the + /// designator actually contains. + template + mlir::Type genDesignator(const A &) { + fir::emitFatalError(loc, "expr must contain a designator"); + } + template + mlir::Type genDesignator(const Fortran::evaluate::Expr &expr) { + using ExprVariant = decltype(Fortran::evaluate::Expr::u); + using Designator = Fortran::evaluate::Designator; + if constexpr (Fortran::common::HasMember) { + const auto &designator = std::get(expr.u); + return std::visit([&](const auto &x) { return gen(x); }, designator.u); + } else { + return std::visit([&](const auto &x) { return genDesignator(x); }, + expr.u); + } + } + + // The gen(X) methods visit X to lower its base and subscripts and return the + // type of X elements. + + mlir::Type gen(const Fortran::evaluate::DataRef &dataRef) { + return std::visit([&](const auto &ref) -> mlir::Type { return gen(ref); }, + dataRef.u); + } + + mlir::Type gen(const Fortran::evaluate::SymbolRef &symRef) { + // Never visited because expr lowering is used to lowered the ranked + // ArrayRef. + fir::emitFatalError( + loc, "expected at least one ArrayRef with vector susbcripts"); + } + + mlir::Type gen(const Fortran::evaluate::Substring &substring) { + // StaticDataObject::Pointer bases are constants and cannot be + // subscripted, so the base must be a DataRef here. + mlir::Type baseElementType = + gen(std::get(substring.parent())); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Type idxTy = builder.getIndexType(); + mlir::Value lb = genScalarValue(substring.lower()); + substringBounds.emplace_back(builder.createConvert(loc, idxTy, lb)); + if (const auto &ubExpr = substring.upper()) { + mlir::Value ub = genScalarValue(*ubExpr); + substringBounds.emplace_back(builder.createConvert(loc, idxTy, ub)); + } + return baseElementType; + } + + mlir::Type gen(const Fortran::evaluate::ComplexPart &complexPart) { + auto complexType = gen(complexPart.complex()); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Type i32Ty = builder.getI32Type(); // llvm's GEP requires i32 + mlir::Value offset = builder.createIntegerConstant( + loc, i32Ty, + complexPart.part() == Fortran::evaluate::ComplexPart::Part::RE ? 0 : 1); + componentPath.emplace_back(offset); + return fir::factory::Complex{builder, loc}.getComplexPartType(complexType); + } + + mlir::Type gen(const Fortran::evaluate::Component &component) { + auto recTy = gen(component.base()).cast(); + const Fortran::semantics::Symbol &componentSymbol = + component.GetLastSymbol(); + // Parent components will not be found here, they are not part + // of the FIR type and cannot be used in the path yet. + if (componentSymbol.test(Fortran::semantics::Symbol::Flag::ParentComp)) + TODO(loc, "Reference to parent component"); + mlir::Type fldTy = fir::FieldType::get(&converter.getMLIRContext()); + llvm::StringRef componentName = toStringRef(componentSymbol.name()); + // Parameters threading in field_index is not yet very clear. We only + // have the ones of the ranked array ref at hand, but it looks like + // the fir.field_index expects the one of the direct base. + if (recTy.getNumLenParams() != 0) + TODO(loc, "threading length parameters in field index op"); + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + componentPath.emplace_back(builder.create( + loc, fldTy, componentName, recTy, /*typeParams*/ llvm::None)); + return fir::unwrapSequenceType(recTy.getType(componentName)); + } + + mlir::Type gen(const Fortran::evaluate::ArrayRef &arrayRef) { + auto isTripletOrVector = + [](const Fortran::evaluate::Subscript &subscript) -> bool { + return std::visit( + Fortran::common::visitors{ + [](const Fortran::evaluate::IndirectSubscriptIntegerExpr &expr) { + return expr.value().Rank() != 0; + }, + [&](const Fortran::evaluate::Triplet &) { return true; }}, + subscript.u); + }; + if (llvm::any_of(arrayRef.subscript(), isTripletOrVector)) + return genRankedArrayRefSubscriptAndBase(arrayRef); + + // This is a scalar ArrayRef (only scalar indexes), collect the indexes and + // visit the base that must contain another arrayRef with the vector + // subscript. + mlir::Type elementType = gen(namedEntityToDataRef(arrayRef.base())); + for (const Fortran::evaluate::Subscript &subscript : arrayRef.subscript()) { + const auto &expr = + std::get( + subscript.u); + componentPath.emplace_back(genScalarValue(expr.value())); + } + return elementType; + } + + /// Lower the subscripts and base of the ArrayRef that is an array (there must + /// be one since there is a vector subscript, and there can only be one + /// according to C925). + mlir::Type genRankedArrayRefSubscriptAndBase( + const Fortran::evaluate::ArrayRef &arrayRef) { + // Lower the save the base + Fortran::lower::SomeExpr baseExpr = namedEntityToExpr(arrayRef.base()); + loweredBase = converter.genExprAddr(baseExpr, stmtCtx); + // Lower and save the subscripts + fir::FirOpBuilder &builder = converter.getFirOpBuilder(); + mlir::Type idxTy = builder.getIndexType(); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + for (const auto &subscript : llvm::enumerate(arrayRef.subscript())) { + std::visit( + Fortran::common::visitors{ + [&](const Fortran::evaluate::IndirectSubscriptIntegerExpr &expr) { + if (expr.value().Rank() == 0) { + // Simple scalar subscript + loweredSubscripts.emplace_back(genScalarValue(expr.value())); + } else { + // Vector subscript. + // Remove conversion if any to avoid temp creation that may + // have been added by the front-end to avoid the creation of a + // temp array value. + auto vector = converter.genExprAddr( + ignoreEvConvert(expr.value()), stmtCtx); + mlir::Value size = + fir::factory::readExtent(builder, loc, vector, /*dim=*/0); + size = builder.createConvert(loc, idxTy, size); + loweredSubscripts.emplace_back( + LoweredVectorSubscript{std::move(vector), size}); + } + }, + [&](const Fortran::evaluate::Triplet &triplet) { + mlir::Value lb, ub; + if (const auto &lbExpr = triplet.lower()) + lb = genScalarValue(*lbExpr); + else + lb = fir::factory::readLowerBound(builder, loc, loweredBase, + subscript.index(), one); + if (const auto &ubExpr = triplet.upper()) + ub = genScalarValue(*ubExpr); + else + ub = fir::factory::readExtent(builder, loc, loweredBase, + subscript.index()); + lb = builder.createConvert(loc, idxTy, lb); + ub = builder.createConvert(loc, idxTy, ub); + mlir::Value stride = genScalarValue(triplet.stride()); + stride = builder.createConvert(loc, idxTy, stride); + loweredSubscripts.emplace_back(LoweredTriplet{lb, ub, stride}); + }, + }, + subscript.value().u); + } + return fir::unwrapSequenceType( + fir::unwrapPassByRefType(fir::getBase(loweredBase).getType())); + } + + mlir::Type gen(const Fortran::evaluate::CoarrayRef &) { + // Is this possible/legal ? + TODO(loc, "Coarray ref with vector subscript in IO input"); + } + + template + mlir::Value genScalarValue(const A &expr) { + return fir::getBase(converter.genExprValue(toEvExpr(expr), stmtCtx)); + } + + Fortran::evaluate::DataRef + namedEntityToDataRef(const Fortran::evaluate::NamedEntity &namedEntity) { + if (namedEntity.IsSymbol()) + return Fortran::evaluate::DataRef{namedEntity.GetFirstSymbol()}; + return Fortran::evaluate::DataRef{namedEntity.GetComponent()}; + } + + Fortran::lower::SomeExpr + namedEntityToExpr(const Fortran::evaluate::NamedEntity &namedEntity) { + return Fortran::evaluate::AsGenericExpr(namedEntityToDataRef(namedEntity)) + .value(); + } + + Fortran::lower::AbstractConverter &converter; + Fortran::lower::StatementContext &stmtCtx; + mlir::Location loc; + /// Elements of VectorSubscriptBox being built. + fir::ExtendedValue loweredBase; + llvm::SmallVector loweredSubscripts; + llvm::SmallVector componentPath; + MaybeSubstring substringBounds; + mlir::Type elementType; +}; +} // namespace + +Fortran::lower::VectorSubscriptBox Fortran::lower::genVectorSubscriptBox( + mlir::Location loc, Fortran::lower::AbstractConverter &converter, + Fortran::lower::StatementContext &stmtCtx, + const Fortran::lower::SomeExpr &expr) { + return VectorSubscriptBoxBuilder(loc, converter, stmtCtx).gen(expr); +} + +template +mlir::Value Fortran::lower::VectorSubscriptBox::loopOverElementsBase( + fir::FirOpBuilder &builder, mlir::Location loc, + const Generator &elementalGenerator, + [[maybe_unused]] mlir::Value initialCondition) { + mlir::Value shape = builder.createShape(loc, loweredBase); + mlir::Value slice = createSlice(builder, loc); + + // Create loop nest for triplets and vector subscripts in column + // major order. + llvm::SmallVector inductionVariables; + LoopType outerLoop; + for (auto [lb, ub, step] : genLoopBounds(builder, loc)) { + LoopType loop; + if constexpr (std::is_same_v) { + loop = + builder.create(loc, lb, ub, step, initialCondition); + initialCondition = loop.getIterateVar(); + if (!outerLoop) + outerLoop = loop; + else + builder.create(loc, loop.getResult(0)); + } else { + loop = + builder.create(loc, lb, ub, step, /*unordered=*/false); + if (!outerLoop) + outerLoop = loop; + } + builder.setInsertionPointToStart(loop.getBody()); + inductionVariables.push_back(loop.getInductionVar()); + } + assert(outerLoop && !inductionVariables.empty() && + "at least one loop should be created"); + + fir::ExtendedValue elem = + getElementAt(builder, loc, shape, slice, inductionVariables); + + if constexpr (std::is_same_v) { + auto res = elementalGenerator(elem); + builder.create(loc, res); + builder.setInsertionPointAfter(outerLoop); + return outerLoop.getResult(0); + } else { + elementalGenerator(elem); + builder.setInsertionPointAfter(outerLoop); + return {}; + } +} + +void Fortran::lower::VectorSubscriptBox::loopOverElements( + fir::FirOpBuilder &builder, mlir::Location loc, + const ElementalGenerator &elementalGenerator) { + mlir::Value initialCondition; + loopOverElementsBase( + builder, loc, elementalGenerator, initialCondition); +} + +mlir::Value Fortran::lower::VectorSubscriptBox::loopOverElementsWhile( + fir::FirOpBuilder &builder, mlir::Location loc, + const ElementalGeneratorWithBoolReturn &elementalGenerator, + mlir::Value initialCondition) { + return loopOverElementsBase( + builder, loc, elementalGenerator, initialCondition); +} + +mlir::Value +Fortran::lower::VectorSubscriptBox::createSlice(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::Type idxTy = builder.getIndexType(); + llvm::SmallVector triples; + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + auto undef = builder.create(loc, idxTy); + for (const LoweredSubscript &subscript : loweredSubscripts) + std::visit(Fortran::common::visitors{ + [&](const LoweredTriplet &triplet) { + triples.emplace_back(triplet.lb); + triples.emplace_back(triplet.ub); + triples.emplace_back(triplet.stride); + }, + [&](const LoweredVectorSubscript &vector) { + triples.emplace_back(one); + triples.emplace_back(vector.size); + triples.emplace_back(one); + }, + [&](const mlir::Value &i) { + triples.emplace_back(i); + triples.emplace_back(undef); + triples.emplace_back(undef); + }, + }, + subscript); + return builder.create(loc, triples, componentPath); +} + +llvm::SmallVector> +Fortran::lower::VectorSubscriptBox::genLoopBounds(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::Type idxTy = builder.getIndexType(); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); + llvm::SmallVector> bounds; + size_t dimension = loweredSubscripts.size(); + for (const LoweredSubscript &subscript : llvm::reverse(loweredSubscripts)) { + --dimension; + if (std::holds_alternative(subscript)) + continue; + mlir::Value lb, ub, step; + if (const auto *triplet = std::get_if(&subscript)) { + mlir::Value extent = builder.genExtentFromTriplet( + loc, triplet->lb, triplet->ub, triplet->stride, idxTy); + mlir::Value baseLb = fir::factory::readLowerBound( + builder, loc, loweredBase, dimension, one); + baseLb = builder.createConvert(loc, idxTy, baseLb); + lb = baseLb; + ub = builder.create(loc, idxTy, extent, one); + ub = builder.create(loc, idxTy, ub, baseLb); + step = one; + } else { + const auto &vector = std::get(subscript); + lb = zero; + ub = builder.create(loc, idxTy, vector.size, one); + step = one; + } + bounds.emplace_back(lb, ub, step); + } + return bounds; +} + +fir::ExtendedValue Fortran::lower::VectorSubscriptBox::getElementAt( + fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value shape, + mlir::Value slice, mlir::ValueRange inductionVariables) { + /// Generate the indexes for the array_coor inside the loops. + mlir::Type idxTy = builder.getIndexType(); + llvm::SmallVector indexes; + size_t inductionIdx = inductionVariables.size() - 1; + for (const LoweredSubscript &subscript : loweredSubscripts) + std::visit(Fortran::common::visitors{ + [&](const LoweredTriplet &triplet) { + indexes.emplace_back(inductionVariables[inductionIdx--]); + }, + [&](const LoweredVectorSubscript &vector) { + mlir::Value vecIndex = inductionVariables[inductionIdx--]; + mlir::Value vecBase = fir::getBase(vector.vector); + mlir::Type vecEleTy = fir::unwrapSequenceType( + fir::unwrapPassByRefType(vecBase.getType())); + mlir::Type refTy = builder.getRefType(vecEleTy); + auto vecEltRef = builder.create( + loc, refTy, vecBase, vecIndex); + auto vecElt = + builder.create(loc, vecEleTy, vecEltRef); + indexes.emplace_back( + builder.createConvert(loc, idxTy, vecElt)); + }, + [&](const mlir::Value &i) { + indexes.emplace_back(builder.createConvert(loc, idxTy, i)); + }, + }, + subscript); + mlir::Type refTy = builder.getRefType(getElementType()); + auto elementAddr = builder.create( + loc, refTy, fir::getBase(loweredBase), shape, slice, indexes, + fir::getTypeParams(loweredBase)); + fir::ExtendedValue element = fir::factory::arraySectionElementToExtendedValue( + builder, loc, loweredBase, elementAddr, slice); + if (!substringBounds.empty()) { + const fir::CharBoxValue *charBox = element.getCharBox(); + assert(charBox && "substring requires CharBox base"); + fir::factory::CharacterExprHelper helper{builder, loc}; + return helper.createSubstring(*charBox, substringBounds); + } + return element; +} diff --git a/flang/lib/Optimizer/Transforms/CMakeLists.txt b/flang/lib/Optimizer/Transforms/CMakeLists.txt --- a/flang/lib/Optimizer/Transforms/CMakeLists.txt +++ b/flang/lib/Optimizer/Transforms/CMakeLists.txt @@ -9,6 +9,7 @@ MemoryAllocation.cpp MemRefDataFlowOpt.cpp RewriteLoop.cpp + SimplifyRegionLite.cpp DEPENDS FIRBuilder diff --git a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp --- a/flang/lib/Optimizer/Transforms/RewriteLoop.cpp +++ b/flang/lib/Optimizer/Transforms/RewriteLoop.cpp @@ -155,8 +155,9 @@ if (ifOp.getNumResults() == 0) { continueBlock = remainingOpsBlock; } else { - continueBlock = - rewriter.createBlock(remainingOpsBlock, ifOp.getResultTypes()); + continueBlock = rewriter.createBlock( + remainingOpsBlock, ifOp.getResultTypes(), + llvm::SmallVector(ifOp.getNumResults(), loc)); rewriter.create(loc, remainingOpsBlock); } diff --git a/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp b/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp new file mode 100644 --- /dev/null +++ b/flang/lib/Optimizer/Transforms/SimplifyRegionLite.cpp @@ -0,0 +1,47 @@ +//===- SimplifyRegionLite.cpp -- region simplification lite ---------------===// +// +// 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 "PassDetail.h" +#include "flang/Optimizer/Dialect/FIROps.h" +#include "flang/Optimizer/Transforms/Passes.h" +#include "mlir/IR/PatternMatch.h" +#include "mlir/Pass/Pass.h" +#include "mlir/Transforms/DialectConversion.h" +#include "mlir/Transforms/GreedyPatternRewriteDriver.h" +#include "mlir/Transforms/RegionUtils.h" + +namespace { + +class SimplifyRegionLitePass + : public fir::SimplifyRegionLiteBase { +public: + void runOnOperation() override; +}; + +class DummyRewriter : public mlir::PatternRewriter { +public: + DummyRewriter(mlir::MLIRContext *ctx) : mlir::PatternRewriter(ctx) {} +}; + +} // namespace + +void SimplifyRegionLitePass::runOnOperation() { + auto op = getOperation(); + auto regions = op->getRegions(); + mlir::RewritePatternSet patterns(op.getContext()); + DummyRewriter rewriter(op.getContext()); + if (regions.empty()) + return; + + (void)mlir::eraseUnreachableBlocks(rewriter, regions); + (void)mlir::runRegionDCE(rewriter, regions); +} + +std::unique_ptr fir::createSimplifyRegionLitePass() { + return std::make_unique(); +} diff --git a/flang/test/Lower/vector-subscript-io.f90 b/flang/test/Lower/vector-subscript-io.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/vector-subscript-io.f90 @@ -0,0 +1,581 @@ +! Test lowering of IO input items with vector subscripts +! RUN: bbc %s -o - | FileCheck %s + +! CHECK-LABEL: func @_QPsimple( +! CHECK-SAME: %[[VAL_20:.*]]: !fir.ref>{{.*}}, %[[VAL_16:.*]]: !fir.ref>{{.*}}) { +subroutine simple(x, y) + integer :: y(3) + integer :: x(10) + read(*,*) x(y) + ! CHECK-DAG: %[[VAL_0:.*]] = arith.constant 10 : index + ! CHECK-DAG: %[[VAL_1:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_3:.*]] = arith.constant 4 : i32 + ! CHECK-DAG: %[[VAL_4:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_5:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_6:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_7:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_8:.*]] = fir.convert %[[VAL_7]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_9:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_1]], %[[VAL_8]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_10:.*]] = fir.shape %[[VAL_0]] : (index) -> !fir.shape<1> + ! CHECK: %[[VAL_11:.*]] = fir.slice %[[VAL_6]], %[[VAL_4]], %[[VAL_6]] : (index, index, index) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_5]], %[[VAL_4]] : index, index) + ! CHECK: ^bb1(%[[VAL_12:.*]]: index, %[[VAL_13:.*]]: index): + ! CHECK: %[[VAL_14:.*]] = arith.cmpi sgt, %[[VAL_13]], %[[VAL_5]] : index + ! CHECK: cf.cond_br %[[VAL_14]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_15:.*]] = fir.coordinate_of %[[VAL_16]], %[[VAL_12]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_15]] : !fir.ref + ! CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> index + ! CHECK: %[[VAL_19:.*]] = fir.array_coor %[[VAL_20]](%[[VAL_10]]) {{\[}}%[[VAL_11]]] %[[VAL_18]] : (!fir.ref>, !fir.shape<1>, !fir.slice<1>, index) -> !fir.ref + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_19]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_22:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_9]], %[[VAL_21]], %[[VAL_3]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: %[[VAL_23:.*]] = arith.addi %[[VAL_12]], %[[VAL_6]] : index + ! CHECK: %[[VAL_24:.*]] = arith.subi %[[VAL_13]], %[[VAL_6]] : index + ! CHECK: cf.br ^bb1(%[[VAL_23]], %[[VAL_24]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_25:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_9]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPonly_once( + ! CHECK-SAME: %[[VAL_51:.*]]: !fir.box>{{.*}}) { + subroutine only_once(x) + interface + function get_vector() + integer, allocatable :: get_vector(:) + end function + integer function get_substcript() + end function + end interface + real :: x(:, :) + ! Test subscripts are only evaluated once. + read(*,*) x(get_substcript(), get_vector()) + ! CHECK-DAG: %[[VAL_26:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_28:.*]] = arith.constant 0 : i64 + ! CHECK-DAG: %[[VAL_29:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_30:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_31:.*]] = fir.alloca !fir.box>> {bindc_name = ".result"} + ! CHECK: %[[VAL_32:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_34:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_26]], %[[VAL_33]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_35:.*]] = fir.call @_QPget_substcript() : () -> i32 + ! CHECK: %[[VAL_36:.*]] = fir.convert %[[VAL_35]] : (i32) -> i64 + ! CHECK: %[[VAL_37:.*]] = fir.call @_QPget_vector() : () -> !fir.box>> + ! CHECK: fir.save_result %[[VAL_37]] to %[[VAL_31]] : !fir.box>>, !fir.ref>>> + ! CHECK: %[[VAL_38:.*]] = fir.load %[[VAL_31]] : !fir.ref>>> + ! CHECK: %[[VAL_39:.*]]:3 = fir.box_dims %[[VAL_38]], %[[VAL_29]] : (!fir.box>>, index) -> (index, index, index) + ! CHECK: %[[VAL_40:.*]] = fir.box_addr %[[VAL_38]] : (!fir.box>>) -> !fir.heap> + ! CHECK: %[[VAL_41:.*]] = fir.undefined index + ! CHECK: %[[VAL_42:.*]] = fir.slice %[[VAL_36]], %[[VAL_41]], %[[VAL_41]], %[[VAL_30]], %[[VAL_39]]#1, %[[VAL_30]] : (i64, index, index, index, index, index) -> !fir.slice<2> + ! CHECK: cf.br ^bb1(%[[VAL_29]], %[[VAL_39]]#1 : index, index) + ! CHECK: ^bb1(%[[VAL_43:.*]]: index, %[[VAL_44:.*]]: index): + ! CHECK: %[[VAL_45:.*]] = arith.cmpi sgt, %[[VAL_44]], %[[VAL_29]] : index + ! CHECK: cf.cond_br %[[VAL_45]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_46:.*]] = fir.convert %[[VAL_35]] : (i32) -> index + ! CHECK: %[[VAL_47:.*]] = fir.coordinate_of %[[VAL_40]], %[[VAL_43]] : (!fir.heap>, index) -> !fir.ref + ! CHECK: %[[VAL_48:.*]] = fir.load %[[VAL_47]] : !fir.ref + ! CHECK: %[[VAL_49:.*]] = fir.convert %[[VAL_48]] : (i32) -> index + ! CHECK: %[[VAL_50:.*]] = fir.array_coor %[[VAL_51]] {{\[}}%[[VAL_42]]] %[[VAL_46]], %[[VAL_49]] : (!fir.box>, !fir.slice<2>, index, index) -> !fir.ref + ! CHECK: %[[VAL_52:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_34]], %[[VAL_50]]) : (!fir.ref, !fir.ref) -> i1 + ! CHECK: %[[VAL_53:.*]] = arith.addi %[[VAL_43]], %[[VAL_30]] : index + ! CHECK: %[[VAL_54:.*]] = arith.subi %[[VAL_44]], %[[VAL_30]] : index + ! CHECK: cf.br ^bb1(%[[VAL_53]], %[[VAL_54]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_55:.*]] = fir.load %[[VAL_31]] : !fir.ref>>> + ! CHECK: %[[VAL_56:.*]] = fir.box_addr %[[VAL_55]] : (!fir.box>>) -> !fir.heap> + ! CHECK: %[[VAL_57:.*]] = fir.convert %[[VAL_56]] : (!fir.heap>) -> i64 + ! CHECK: %[[VAL_58:.*]] = arith.cmpi ne, %[[VAL_57]], %[[VAL_28]] : i64 + ! CHECK: cf.cond_br %[[VAL_58]], ^bb4, ^bb5 + ! CHECK: ^bb4: + ! CHECK: fir.freemem %[[VAL_56]] + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb5: + ! CHECK: %[[VAL_59:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_34]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPwith_assumed_shapes( + ! CHECK-SAME: %[[VAL_78:.*]]: !fir.box>{{.*}}, %[[VAL_69:.*]]: !fir.box>{{.*}}) { + subroutine with_assumed_shapes(x, y) + integer :: y(:) + integer :: x(:) + read(*,*) x(y) + ! CHECK-DAG: %[[VAL_60:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_62:.*]] = arith.constant 4 : i32 + ! CHECK-DAG: %[[VAL_63:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_64:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_65:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_66:.*]] = fir.convert %[[VAL_65]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_67:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_60]], %[[VAL_66]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_68:.*]]:3 = fir.box_dims %[[VAL_69]], %[[VAL_63]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_70:.*]] = fir.slice %[[VAL_64]], %[[VAL_68]]#1, %[[VAL_64]] : (index, index, index) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_63]], %[[VAL_68]]#1 : index, index) + ! CHECK: ^bb1(%[[VAL_71:.*]]: index, %[[VAL_72:.*]]: index): + ! CHECK: %[[VAL_73:.*]] = arith.cmpi sgt, %[[VAL_72]], %[[VAL_63]] : index + ! CHECK: cf.cond_br %[[VAL_73]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_69]], %[[VAL_71]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_75:.*]] = fir.load %[[VAL_74]] : !fir.ref + ! CHECK: %[[VAL_76:.*]] = fir.convert %[[VAL_75]] : (i32) -> index + ! CHECK: %[[VAL_77:.*]] = fir.array_coor %[[VAL_78]] {{\[}}%[[VAL_70]]] %[[VAL_76]] : (!fir.box>, !fir.slice<1>, index) -> !fir.ref + ! CHECK: %[[VAL_79:.*]] = fir.convert %[[VAL_77]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_80:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_67]], %[[VAL_79]], %[[VAL_62]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: %[[VAL_81:.*]] = arith.addi %[[VAL_71]], %[[VAL_64]] : index + ! CHECK: %[[VAL_82:.*]] = arith.subi %[[VAL_72]], %[[VAL_64]] : index + ! CHECK: cf.br ^bb1(%[[VAL_81]], %[[VAL_82]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_83:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_67]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPlower_bounds( + ! CHECK-SAME: %[[VAL_108:.*]]: !fir.ref>{{.*}}, %[[VAL_104:.*]]: !fir.ref>{{.*}}) { + subroutine lower_bounds(x, y) + integer :: y(3) + integer :: x(2:5,3:8) + read(*,*) x(3, y) + ! CHECK-DAG: %[[VAL_84:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_85:.*]] = arith.constant 6 : index + ! CHECK-DAG: %[[VAL_86:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_88:.*]] = arith.constant 3 : i64 + ! CHECK-DAG: %[[VAL_89:.*]] = arith.constant 2 : index + ! CHECK-DAG: %[[VAL_90:.*]] = arith.constant 4 : i32 + ! CHECK-DAG: %[[VAL_91:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_92:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_93:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_94:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_95:.*]] = fir.convert %[[VAL_94]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_96:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_86]], %[[VAL_95]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_97:.*]] = fir.shape_shift %[[VAL_89]], %[[VAL_84]], %[[VAL_91]], %[[VAL_85]] : (index, index, index, index) -> !fir.shapeshift<2> + ! CHECK: %[[VAL_98:.*]] = fir.undefined index + ! CHECK: %[[VAL_99:.*]] = fir.slice %[[VAL_88]], %[[VAL_98]], %[[VAL_98]], %[[VAL_93]], %[[VAL_91]], %[[VAL_93]] : (i64, index, index, index, index, index) -> !fir.slice<2> + ! CHECK: cf.br ^bb1(%[[VAL_92]], %[[VAL_91]] : index, index) + ! CHECK: ^bb1(%[[VAL_100:.*]]: index, %[[VAL_101:.*]]: index): + ! CHECK: %[[VAL_102:.*]] = arith.cmpi sgt, %[[VAL_101]], %[[VAL_92]] : index + ! CHECK: cf.cond_br %[[VAL_102]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_103:.*]] = fir.coordinate_of %[[VAL_104]], %[[VAL_100]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_105:.*]] = fir.load %[[VAL_103]] : !fir.ref + ! CHECK: %[[VAL_106:.*]] = fir.convert %[[VAL_105]] : (i32) -> index + ! CHECK: %[[VAL_107:.*]] = fir.array_coor %[[VAL_108]](%[[VAL_97]]) {{\[}}%[[VAL_99]]] %[[VAL_91]], %[[VAL_106]] : (!fir.ref>, !fir.shapeshift<2>, !fir.slice<2>, index, index) -> !fir.ref + ! CHECK: %[[VAL_109:.*]] = fir.convert %[[VAL_107]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_110:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_96]], %[[VAL_109]], %[[VAL_90]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: %[[VAL_111:.*]] = arith.addi %[[VAL_100]], %[[VAL_93]] : index + ! CHECK: %[[VAL_112:.*]] = arith.subi %[[VAL_101]], %[[VAL_93]] : index + ! CHECK: cf.br ^bb1(%[[VAL_111]], %[[VAL_112]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_113:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_96]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPtwo_vectors( + ! CHECK-SAME: %[[VAL_140:.*]]: !fir.ref>{{.*}}, %[[VAL_132:.*]]: !fir.ref>{{.*}}, %[[VAL_136:.*]]: !fir.ref>{{.*}}) { + subroutine two_vectors(x, y1, y2) + integer :: y1(3), y2(3) + real :: x(4, 4) + read(*,*) x(y1, y2) + ! CHECK-DAG: %[[VAL_114:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_115:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_117:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_118:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_119:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_120:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_121:.*]] = fir.convert %[[VAL_120]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_122:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_115]], %[[VAL_121]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_123:.*]] = fir.shape %[[VAL_114]], %[[VAL_114]] : (index, index) -> !fir.shape<2> + ! CHECK: %[[VAL_124:.*]] = fir.slice %[[VAL_119]], %[[VAL_117]], %[[VAL_119]], %[[VAL_119]], %[[VAL_117]], %[[VAL_119]] : (index, index, index, index, index, index) -> !fir.slice<2> + ! CHECK: cf.br ^bb1(%[[VAL_118]], %[[VAL_117]] : index, index) + ! CHECK: ^bb1(%[[VAL_125:.*]]: index, %[[VAL_126:.*]]: index): + ! CHECK: %[[VAL_127:.*]] = arith.cmpi sgt, %[[VAL_126]], %[[VAL_118]] : index + ! CHECK: cf.cond_br %[[VAL_127]], ^bb2(%[[VAL_118]], %[[VAL_117]] : index, index), ^bb5 + ! CHECK: ^bb2(%[[VAL_128:.*]]: index, %[[VAL_129:.*]]: index): + ! CHECK: %[[VAL_130:.*]] = arith.cmpi sgt, %[[VAL_129]], %[[VAL_118]] : index + ! CHECK: cf.cond_br %[[VAL_130]], ^bb3, ^bb4 + ! CHECK: ^bb3: + ! CHECK: %[[VAL_131:.*]] = fir.coordinate_of %[[VAL_132]], %[[VAL_128]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_133:.*]] = fir.load %[[VAL_131]] : !fir.ref + ! CHECK: %[[VAL_134:.*]] = fir.convert %[[VAL_133]] : (i32) -> index + ! CHECK: %[[VAL_135:.*]] = fir.coordinate_of %[[VAL_136]], %[[VAL_125]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_137:.*]] = fir.load %[[VAL_135]] : !fir.ref + ! CHECK: %[[VAL_138:.*]] = fir.convert %[[VAL_137]] : (i32) -> index + ! CHECK: %[[VAL_139:.*]] = fir.array_coor %[[VAL_140]](%[[VAL_123]]) {{\[}}%[[VAL_124]]] %[[VAL_134]], %[[VAL_138]] : (!fir.ref>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref + ! CHECK: %[[VAL_141:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_122]], %[[VAL_139]]) : (!fir.ref, !fir.ref) -> i1 + ! CHECK: %[[VAL_142:.*]] = arith.addi %[[VAL_128]], %[[VAL_119]] : index + ! CHECK: %[[VAL_143:.*]] = arith.subi %[[VAL_129]], %[[VAL_119]] : index + ! CHECK: cf.br ^bb2(%[[VAL_142]], %[[VAL_143]] : index, index) + ! CHECK: ^bb4: + ! CHECK: %[[VAL_144:.*]] = arith.addi %[[VAL_125]], %[[VAL_119]] : index + ! CHECK: %[[VAL_145:.*]] = arith.subi %[[VAL_126]], %[[VAL_119]] : index + ! CHECK: cf.br ^bb1(%[[VAL_144]], %[[VAL_145]] : index, index) + ! CHECK: ^bb5: + ! CHECK: %[[VAL_146:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_122]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPtriplets_and_vector( + ! CHECK-SAME: %[[VAL_170:.*]]: !fir.ref>>{{.*}}, %[[VAL_166:.*]]: !fir.ref>{{.*}}) { + subroutine triplets_and_vector(x, y) + integer :: y(3) + complex :: x(4, 4) + read(*,*) x(1:4:2, y) + ! CHECK-DAG: %[[VAL_147:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_149:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_150:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_151:.*]] = arith.constant 2 : index + ! CHECK-DAG: %[[VAL_152:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_153:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_154:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_155:.*]] = fir.convert %[[VAL_154]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_156:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_147]], %[[VAL_155]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_157:.*]] = fir.shape %[[VAL_149]], %[[VAL_149]] : (index, index) -> !fir.shape<2> + ! CHECK: %[[VAL_158:.*]] = fir.slice %[[VAL_153]], %[[VAL_149]], %[[VAL_151]], %[[VAL_153]], %[[VAL_150]], %[[VAL_153]] : (index, index, index, index, index, index) -> !fir.slice<2> + ! CHECK: cf.br ^bb1(%[[VAL_152]], %[[VAL_150]] : index, index) + ! CHECK: ^bb1(%[[VAL_159:.*]]: index, %[[VAL_160:.*]]: index): + ! CHECK: %[[VAL_161:.*]] = arith.cmpi sgt, %[[VAL_160]], %[[VAL_152]] : index + ! CHECK: cf.cond_br %[[VAL_161]], ^bb2(%[[VAL_153]], %[[VAL_151]] : index, index), ^bb5 + ! CHECK: ^bb2(%[[VAL_162:.*]]: index, %[[VAL_163:.*]]: index): + ! CHECK: %[[VAL_164:.*]] = arith.cmpi sgt, %[[VAL_163]], %[[VAL_152]] : index + ! CHECK: cf.cond_br %[[VAL_164]], ^bb3, ^bb4 + ! CHECK: ^bb3: + ! CHECK: %[[VAL_165:.*]] = fir.coordinate_of %[[VAL_166]], %[[VAL_159]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_167:.*]] = fir.load %[[VAL_165]] : !fir.ref + ! CHECK: %[[VAL_168:.*]] = fir.convert %[[VAL_167]] : (i32) -> index + ! CHECK: %[[VAL_169:.*]] = fir.array_coor %[[VAL_170]](%[[VAL_157]]) {{\[}}%[[VAL_158]]] %[[VAL_162]], %[[VAL_168]] : (!fir.ref>>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref> + ! CHECK: %[[VAL_171:.*]] = fir.convert %[[VAL_169]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_172:.*]] = fir.call @_FortranAioInputComplex32(%[[VAL_156]], %[[VAL_171]]) : (!fir.ref, !fir.ref) -> i1 + ! CHECK: %[[VAL_173:.*]] = arith.addi %[[VAL_162]], %[[VAL_153]] : index + ! CHECK: %[[VAL_174:.*]] = arith.subi %[[VAL_163]], %[[VAL_153]] : index + ! CHECK: cf.br ^bb2(%[[VAL_173]], %[[VAL_174]] : index, index) + ! CHECK: ^bb4: + ! CHECK: %[[VAL_175:.*]] = arith.addi %[[VAL_159]], %[[VAL_153]] : index + ! CHECK: %[[VAL_176:.*]] = arith.subi %[[VAL_160]], %[[VAL_153]] : index + ! CHECK: cf.br ^bb1(%[[VAL_175]], %[[VAL_176]] : index, index) + ! CHECK: ^bb5: + ! CHECK: %[[VAL_177:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_156]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPsimple_char( + ! CHECK-SAME: %[[VAL_185:.*]]: !fir.boxchar<1>{{.*}}, %[[VAL_196:.*]]: !fir.ref>{{.*}}) { + subroutine simple_char(x, y) + integer :: y(3) + character(*) :: x(3:8) + read(*,*) x(y) + ! CHECK-DAG: %[[VAL_178:.*]] = arith.constant 6 : index + ! CHECK-DAG: %[[VAL_179:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_181:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_182:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_183:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_184:.*]]:2 = fir.unboxchar %[[VAL_185]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[VAL_186:.*]] = fir.convert %[[VAL_184]]#0 : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[VAL_187:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_188:.*]] = fir.convert %[[VAL_187]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_189:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_179]], %[[VAL_188]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_190:.*]] = fir.shape_shift %[[VAL_181]], %[[VAL_178]] : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[VAL_191:.*]] = fir.slice %[[VAL_183]], %[[VAL_181]], %[[VAL_183]] : (index, index, index) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_182]], %[[VAL_181]] : index, index) + ! CHECK: ^bb1(%[[VAL_192:.*]]: index, %[[VAL_193:.*]]: index): + ! CHECK: %[[VAL_194:.*]] = arith.cmpi sgt, %[[VAL_193]], %[[VAL_182]] : index + ! CHECK: cf.cond_br %[[VAL_194]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_195:.*]] = fir.coordinate_of %[[VAL_196]], %[[VAL_192]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_197:.*]] = fir.load %[[VAL_195]] : !fir.ref + ! CHECK: %[[VAL_198:.*]] = fir.convert %[[VAL_197]] : (i32) -> index + ! CHECK: %[[VAL_199:.*]] = fir.array_coor %[[VAL_186]](%[[VAL_190]]) {{\[}}%[[VAL_191]]] %[[VAL_198]] typeparams %[[VAL_184]]#1 : (!fir.ref>>, !fir.shapeshift<1>, !fir.slice<1>, index, index) -> !fir.ref> + ! CHECK: %[[VAL_200:.*]] = fir.convert %[[VAL_199]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_201:.*]] = fir.convert %[[VAL_184]]#1 : (index) -> i64 + ! CHECK: %[[VAL_202:.*]] = fir.call @_FortranAioInputAscii(%[[VAL_189]], %[[VAL_200]], %[[VAL_201]]) : (!fir.ref, !fir.ref, i64) -> i1 + ! CHECK: %[[VAL_203:.*]] = arith.addi %[[VAL_192]], %[[VAL_183]] : index + ! CHECK: %[[VAL_204:.*]] = arith.subi %[[VAL_193]], %[[VAL_183]] : index + ! CHECK: cf.br ^bb1(%[[VAL_203]], %[[VAL_204]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_205:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_189]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPsubstring( + ! CHECK-SAME: %[[VAL_229:.*]]: !fir.box>>{{.*}}, %[[VAL_225:.*]]: !fir.ref>{{.*}}, %[[VAL_215:.*]]: !fir.ref{{.*}}, %[[VAL_218:.*]]: !fir.ref{{.*}}) { + subroutine substring(x, y, i, j) + integer :: y(3), i, j + character(*) :: x(:) + read(*,*) x(y)(i:j) + ! CHECK-DAG: %[[VAL_206:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_208:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_209:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_210:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_211:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_212:.*]] = fir.convert %[[VAL_211]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_213:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_206]], %[[VAL_212]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_214:.*]] = fir.load %[[VAL_215]] : !fir.ref + ! CHECK: %[[VAL_216:.*]] = fir.convert %[[VAL_214]] : (i32) -> index + ! CHECK: %[[VAL_217:.*]] = fir.load %[[VAL_218]] : !fir.ref + ! CHECK: %[[VAL_219:.*]] = fir.convert %[[VAL_217]] : (i32) -> index + ! CHECK: %[[VAL_220:.*]] = fir.slice %[[VAL_210]], %[[VAL_208]], %[[VAL_210]] : (index, index, index) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_209]], %[[VAL_208]] : index, index) + ! CHECK: ^bb1(%[[VAL_221:.*]]: index, %[[VAL_222:.*]]: index): + ! CHECK: %[[VAL_223:.*]] = arith.cmpi sgt, %[[VAL_222]], %[[VAL_209]] : index + ! CHECK: cf.cond_br %[[VAL_223]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_224:.*]] = fir.coordinate_of %[[VAL_225]], %[[VAL_221]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_226:.*]] = fir.load %[[VAL_224]] : !fir.ref + ! CHECK: %[[VAL_227:.*]] = fir.convert %[[VAL_226]] : (i32) -> index + ! CHECK: %[[VAL_228:.*]] = fir.array_coor %[[VAL_229]] {{\[}}%[[VAL_220]]] %[[VAL_227]] : (!fir.box>>, !fir.slice<1>, index) -> !fir.ref> + ! CHECK: %[[VAL_230:.*]] = arith.subi %[[VAL_216]], %[[VAL_210]] : index + ! CHECK: %[[VAL_231:.*]] = fir.convert %[[VAL_228]] : (!fir.ref>) -> !fir.ref>> + ! CHECK: %[[VAL_232:.*]] = fir.coordinate_of %[[VAL_231]], %[[VAL_230]] : (!fir.ref>>, index) -> !fir.ref> + ! CHECK: %[[VAL_233:.*]] = fir.convert %[[VAL_232]] : (!fir.ref>) -> !fir.ref> + ! CHECK: %[[VAL_234:.*]] = arith.subi %[[VAL_219]], %[[VAL_216]] : index + ! CHECK: %[[VAL_235:.*]] = arith.addi %[[VAL_234]], %[[VAL_210]] : index + ! CHECK: %[[VAL_236:.*]] = arith.cmpi slt, %[[VAL_235]], %[[VAL_209]] : index + ! CHECK: %[[VAL_237:.*]] = arith.select %[[VAL_236]], %[[VAL_209]], %[[VAL_235]] : index + ! CHECK: %[[VAL_238:.*]] = fir.convert %[[VAL_233]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_239:.*]] = fir.convert %[[VAL_237]] : (index) -> i64 + ! CHECK: %[[VAL_240:.*]] = fir.call @_FortranAioInputAscii(%[[VAL_213]], %[[VAL_238]], %[[VAL_239]]) : (!fir.ref, !fir.ref, i64) -> i1 + ! CHECK: %[[VAL_241:.*]] = arith.addi %[[VAL_221]], %[[VAL_210]] : index + ! CHECK: %[[VAL_242:.*]] = arith.subi %[[VAL_222]], %[[VAL_210]] : index + ! CHECK: cf.br ^bb1(%[[VAL_241]], %[[VAL_242]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_243:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_213]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPcomplex_part( + ! CHECK-SAME: %[[VAL_262:.*]]: !fir.box>>{{.*}}, %[[VAL_253:.*]]: !fir.box>{{.*}}) { + subroutine complex_part(z, y) + integer :: y(:) + complex :: z(:) + read(*,*) z(y)%IM + ! CHECK-DAG: %[[VAL_244:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_246:.*]] = arith.constant 1 : i32 + ! CHECK-DAG: %[[VAL_247:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_248:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_249:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_250:.*]] = fir.convert %[[VAL_249]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_251:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_244]], %[[VAL_250]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_252:.*]]:3 = fir.box_dims %[[VAL_253]], %[[VAL_247]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_254:.*]] = fir.slice %[[VAL_248]], %[[VAL_252]]#1, %[[VAL_248]] path %[[VAL_246]] : (index, index, index, i32) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_247]], %[[VAL_252]]#1 : index, index) + ! CHECK: ^bb1(%[[VAL_255:.*]]: index, %[[VAL_256:.*]]: index): + ! CHECK: %[[VAL_257:.*]] = arith.cmpi sgt, %[[VAL_256]], %[[VAL_247]] : index + ! CHECK: cf.cond_br %[[VAL_257]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_258:.*]] = fir.coordinate_of %[[VAL_253]], %[[VAL_255]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_259:.*]] = fir.load %[[VAL_258]] : !fir.ref + ! CHECK: %[[VAL_260:.*]] = fir.convert %[[VAL_259]] : (i32) -> index + ! CHECK: %[[VAL_261:.*]] = fir.array_coor %[[VAL_262]] {{\[}}%[[VAL_254]]] %[[VAL_260]] : (!fir.box>>, !fir.slice<1>, index) -> !fir.ref + ! CHECK: %[[VAL_263:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_251]], %[[VAL_261]]) : (!fir.ref, !fir.ref) -> i1 + ! CHECK: %[[VAL_264:.*]] = arith.addi %[[VAL_255]], %[[VAL_248]] : index + ! CHECK: %[[VAL_265:.*]] = arith.subi %[[VAL_256]], %[[VAL_248]] : index + ! CHECK: cf.br ^bb1(%[[VAL_264]], %[[VAL_265]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_266:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_251]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + module derived_types + type t + integer :: i + character(2) :: c + end type + type t2 + type(t) :: a(5,5) + end type + end module + + ! CHECK-LABEL: func @_QPsimple_derived( + ! CHECK-SAME: %[[VAL_287:.*]]: !fir.ref}>>>{{.*}}, %[[VAL_283:.*]]: !fir.ref>{{.*}}) { + subroutine simple_derived(x, y) + use derived_types + integer :: y(4) + type(t) :: x(3:8) + read(*,*) x(y) + ! CHECK-DAG: %[[VAL_267:.*]] = arith.constant 6 : index + ! CHECK-DAG: %[[VAL_268:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_270:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_271:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_272:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_273:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_274:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_275:.*]] = fir.convert %[[VAL_274]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_276:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_268]], %[[VAL_275]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_277:.*]] = fir.shape_shift %[[VAL_270]], %[[VAL_267]] : (index, index) -> !fir.shapeshift<1> + ! CHECK: %[[VAL_278:.*]] = fir.slice %[[VAL_273]], %[[VAL_271]], %[[VAL_273]] : (index, index, index) -> !fir.slice<1> + ! CHECK: cf.br ^bb1(%[[VAL_272]], %[[VAL_271]] : index, index) + ! CHECK: ^bb1(%[[VAL_279:.*]]: index, %[[VAL_280:.*]]: index): + ! CHECK: %[[VAL_281:.*]] = arith.cmpi sgt, %[[VAL_280]], %[[VAL_272]] : index + ! CHECK: cf.cond_br %[[VAL_281]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_282:.*]] = fir.coordinate_of %[[VAL_283]], %[[VAL_279]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_284:.*]] = fir.load %[[VAL_282]] : !fir.ref + ! CHECK: %[[VAL_285:.*]] = fir.convert %[[VAL_284]] : (i32) -> index + ! CHECK: %[[VAL_286:.*]] = fir.array_coor %[[VAL_287]](%[[VAL_277]]) {{\[}}%[[VAL_278]]] %[[VAL_285]] : (!fir.ref}>>>, !fir.shapeshift<1>, !fir.slice<1>, index) -> !fir.ref}>> + ! CHECK: %[[VAL_288:.*]] = fir.embox %[[VAL_286]] : (!fir.ref}>>) -> !fir.box}>> + ! CHECK: %[[VAL_289:.*]] = fir.convert %[[VAL_288]] : (!fir.box}>>) -> !fir.box + ! CHECK: %[[VAL_290:.*]] = fir.call @_FortranAioInputDescriptor(%[[VAL_276]], %[[VAL_289]]) : (!fir.ref, !fir.box) -> i1 + ! CHECK: %[[VAL_291:.*]] = arith.addi %[[VAL_279]], %[[VAL_273]] : index + ! CHECK: %[[VAL_292:.*]] = arith.subi %[[VAL_280]], %[[VAL_273]] : index + ! CHECK: cf.br ^bb1(%[[VAL_291]], %[[VAL_292]] : index, index) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_293:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_276]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPwith_path( + ! CHECK-SAME: [[VAL_326:.*]]: !fir.box}>>}>>>{{.*}}, [[VAL_310:.*]]: !fir.box>{{.*}}) { + subroutine with_path(b, i) + use derived_types + type(t2) :: b(4:, 4:, 4:) + integer :: i(:) + read (*, *) b(5, i, 8:9:1)%a(4,5)%i + ! CHECK-DAG: %[[VAL_294:.*]] = arith.constant 4 : index + ! CHECK-DAG: %[[VAL_295:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_297:.*]] = arith.constant 8 : index + ! CHECK-DAG: %[[VAL_298:.*]] = arith.constant 9 : index + ! CHECK-DAG: %[[VAL_299:.*]] = arith.constant 4 : i64 + ! CHECK-DAG: %[[VAL_300:.*]] = arith.constant 5 : i64 + ! CHECK-DAG: %[[VAL_301:.*]] = arith.constant 5 : index + ! CHECK-DAG: %[[VAL_302:.*]] = arith.constant 4 : i32 + ! CHECK-DAG: %[[VAL_303:.*]] = arith.constant 2 : index + ! CHECK-DAG: %[[VAL_304:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_305:.*]] = arith.constant 1 : index + ! CHECK: %[[VAL_306:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_307:.*]] = fir.convert %[[VAL_306]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_308:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_295]], %[[VAL_307]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_309:.*]]:3 = fir.box_dims %[[VAL_310:.*]], %[[VAL_304]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_311:.*]] = fir.field_index a, !fir.type<_QMderived_typesTt2{a:!fir.array<5x5x!fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}>>}> + ! CHECK: %[[VAL_312:.*]] = fir.field_index i, !fir.type<_QMderived_typesTt{i:i32,c:!fir.char<1,2>}> + ! CHECK: %[[VAL_313:.*]] = fir.shift %[[VAL_294]], %[[VAL_294]], %[[VAL_294]] : (index, index, index) -> !fir.shift<3> + ! CHECK: %[[VAL_314:.*]] = fir.undefined index + ! CHECK: %[[VAL_315:.*]] = fir.slice %[[VAL_300]], %[[VAL_314]], %[[VAL_314]], %[[VAL_305]], %[[VAL_309]]#1, %[[VAL_305]], %[[VAL_297]], %[[VAL_298]], %[[VAL_305]] path %[[VAL_311]], %[[VAL_299]], %[[VAL_300]], %[[VAL_312]] : (i64, index, index, index, index, index, index, index, index, !fir.field, i64, i64, !fir.field) -> !fir.slice<3> + ! CHECK: cf.br ^bb1(%[[VAL_294]], %[[VAL_303]] : index, index) + ! CHECK: ^bb1(%[[VAL_316:.*]]: index, %[[VAL_317:.*]]: index): + ! CHECK: %[[VAL_318:.*]] = arith.cmpi sgt, %[[VAL_317]], %[[VAL_304]] : index + ! CHECK: cf.cond_br %[[VAL_318]], ^bb2(%[[VAL_304]], %[[VAL_309]]#1 : index, index), ^bb5 + ! CHECK: ^bb2(%[[VAL_319:.*]]: index, %[[VAL_320:.*]]: index): + ! CHECK: %[[VAL_321:.*]] = arith.cmpi sgt, %[[VAL_320]], %[[VAL_304]] : index + ! CHECK: cf.cond_br %[[VAL_321]], ^bb3, ^bb4 + ! CHECK: ^bb3: + ! CHECK: %[[VAL_322:.*]] = fir.coordinate_of %[[VAL_310]], %[[VAL_319]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_323:.*]] = fir.load %[[VAL_322]] : !fir.ref + ! CHECK: %[[VAL_324:.*]] = fir.convert %[[VAL_323]] : (i32) -> index + ! CHECK: %[[VAL_325:.*]] = fir.array_coor %[[VAL_326:.*]](%[[VAL_313]]) {{\[}}%[[VAL_315]]] %[[VAL_301]], %[[VAL_324]], %[[VAL_316]] : (!fir.box}>>}>>>, !fir.shift<3>, !fir.slice<3>, index, index, index) -> !fir.ref + ! CHECK: %[[VAL_327:.*]] = fir.convert %[[VAL_325]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_328:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_308]], %[[VAL_327]], %[[VAL_302]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: %[[VAL_329:.*]] = arith.addi %[[VAL_319]], %[[VAL_305]] : index + ! CHECK: %[[VAL_330:.*]] = arith.subi %[[VAL_320]], %[[VAL_305]] : index + ! CHECK: cf.br ^bb2(%[[VAL_329]], %[[VAL_330]] : index, index) + ! CHECK: ^bb4: + ! CHECK: %[[VAL_331:.*]] = arith.addi %[[VAL_316]], %[[VAL_305]] : index + ! CHECK: %[[VAL_332:.*]] = arith.subi %[[VAL_317]], %[[VAL_305]] : index + ! CHECK: cf.br ^bb1(%[[VAL_331]], %[[VAL_332]] : index, index) + ! CHECK: ^bb5: + ! CHECK: %[[VAL_333:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_308]]) : (!fir.ref) -> i32 + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPsimple_iostat( + ! CHECK-SAME: %[[VAL_357:.*]]: !fir.box>{{.*}}, %[[VAL_346:.*]]: !fir.box>{{.*}}, %[[VAL_361:.*]]: !fir.ref{{.*}}, %[[VAL_364:.*]]: !fir.ref{{.*}}) { + subroutine simple_iostat(x, y, j, stat) + integer :: j, y(:), stat + real :: x(:) + read(*, *, iostat=stat) x(y), j + ! CHECK-DAG: %[[VAL_334:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_336:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_337:.*]] = arith.constant true + ! CHECK-DAG: %[[VAL_338:.*]] = arith.constant 1 : index + ! CHECK-DAG: %[[VAL_339:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_340:.*]] = arith.constant 4 : i32 + ! CHECK: %[[VAL_341:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_342:.*]] = fir.convert %[[VAL_341]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_343:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_334]], %[[VAL_342]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_344:.*]] = fir.call @_FortranAioEnableHandlers(%[[VAL_343]], %[[VAL_337]], %[[VAL_336]], %[[VAL_336]], %[[VAL_336]], %[[VAL_336]]) : (!fir.ref, i1, i1, i1, i1, i1) -> none + ! CHECK: %[[VAL_345:.*]]:3 = fir.box_dims %[[VAL_346]], %[[VAL_339]] : (!fir.box>, index) -> (index, index, index) + ! CHECK: %[[VAL_347:.*]] = fir.slice %[[VAL_338]], %[[VAL_345]]#1, %[[VAL_338]] : (index, index, index) -> !fir.slice<1> + ! CHECK: %[[VAL_348:.*]] = arith.subi %[[VAL_345]]#1, %[[VAL_338]] : index + ! CHECK: cf.br ^bb1(%[[VAL_339]], %[[VAL_337]] : index, i1) + ! CHECK: ^bb1(%[[VAL_349:.*]]: index, %[[VAL_350:.*]]: i1): + ! CHECK: %[[VAL_351:.*]] = arith.cmpi sle, %[[VAL_349]], %[[VAL_348]] : index + ! CHECK: %[[VAL_352:.*]] = arith.andi %[[VAL_350]], %[[VAL_351]] : i1 + ! CHECK: cf.cond_br %[[VAL_352]], ^bb2, ^bb3 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_353:.*]] = fir.coordinate_of %[[VAL_346]], %[[VAL_349]] : (!fir.box>, index) -> !fir.ref + ! CHECK: %[[VAL_354:.*]] = fir.load %[[VAL_353]] : !fir.ref + ! CHECK: %[[VAL_355:.*]] = fir.convert %[[VAL_354]] : (i32) -> index + ! CHECK: %[[VAL_356:.*]] = fir.array_coor %[[VAL_357]] {{\[}}%[[VAL_347]]] %[[VAL_355]] : (!fir.box>, !fir.slice<1>, index) -> !fir.ref + ! CHECK: %[[VAL_358:.*]] = fir.call @_FortranAioInputReal32(%[[VAL_343]], %[[VAL_356]]) : (!fir.ref, !fir.ref) -> i1 + ! CHECK: %[[VAL_359:.*]] = arith.addi %[[VAL_349]], %[[VAL_338]] : index + ! CHECK: cf.br ^bb1(%[[VAL_359]], %[[VAL_358]] : index, i1) + ! CHECK: ^bb3: + ! CHECK: cf.cond_br %[[VAL_350]], ^bb4, ^bb5 + ! CHECK: ^bb4: + ! CHECK: %[[VAL_360:.*]] = fir.convert %[[VAL_361]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_362:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_343]], %[[VAL_360]], %[[VAL_340]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: cf.br ^bb5 + ! CHECK: ^bb5: + ! CHECK: %[[VAL_363:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_343]]) : (!fir.ref) -> i32 + ! CHECK: fir.store %[[VAL_363]] to %[[VAL_364]] : !fir.ref + ! CHECK: return + end subroutine + + ! CHECK-LABEL: func @_QPiostat_in_io_loop( + ! CHECK-SAME: %[[VAL_400:.*]]: !fir.ref>{{.*}}, %[[VAL_396:.*]]: !fir.ref>{{.*}}, %[[VAL_408:.*]]: !fir.ref{{.*}}) { + subroutine iostat_in_io_loop(k, j, stat) + integer :: k(3, 5) + integer :: j(3) + integer :: stat + read(*, *, iostat=stat) (k(i, j), i=1,3,1) + ! CHECK-DAG: %[[VAL_365:.*]] = arith.constant 5 : index + ! CHECK-DAG: %[[VAL_366:.*]] = arith.constant -1 : i32 + ! CHECK-DAG: %[[VAL_368:.*]] = arith.constant 3 : index + ! CHECK-DAG: %[[VAL_369:.*]] = arith.constant true + ! CHECK-DAG: %[[VAL_370:.*]] = arith.constant false + ! CHECK-DAG: %[[VAL_371:.*]] = arith.constant 1 : index + ! CHECK-DAG: %[[VAL_372:.*]] = arith.constant 0 : index + ! CHECK-DAG: %[[VAL_373:.*]] = arith.constant 2 : index + ! CHECK-DAG: %[[VAL_374:.*]] = arith.constant 4 : i32 + ! CHECK: %[[VAL_375:.*]] = fir.alloca i32 + ! CHECK: %[[VAL_376:.*]] = fir.address_of(@_QQ{{.*}}) : !fir.ref> + ! CHECK: %[[VAL_377:.*]] = fir.convert %[[VAL_376]] : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_378:.*]] = fir.call @_FortranAioBeginExternalListInput(%[[VAL_366]], %[[VAL_377]], %{{.*}}) : (i32, !fir.ref, i32) -> !fir.ref + ! CHECK: %[[VAL_379:.*]] = fir.call @_FortranAioEnableHandlers(%[[VAL_378]], %[[VAL_369]], %[[VAL_370]], %[[VAL_370]], %[[VAL_370]], %[[VAL_370]]) : (!fir.ref, i1, i1, i1, i1, i1) -> none + ! CHECK: cf.br ^bb1(%[[VAL_371]], %[[VAL_369]] : index, i1) + ! CHECK: ^bb1(%[[VAL_380:.*]]: index, %[[VAL_381:.*]]: i1): + ! CHECK: %[[VAL_382:.*]] = arith.cmpi sle, %[[VAL_380]], %[[VAL_368]] : index + ! CHECK: %[[VAL_383:.*]] = arith.andi %[[VAL_381]], %[[VAL_382]] : i1 + ! CHECK: cf.cond_br %[[VAL_383]], ^bb2, ^bb7 + ! CHECK: ^bb2: + ! CHECK: %[[VAL_384:.*]] = fir.convert %[[VAL_380]] : (index) -> i32 + ! CHECK: fir.store %[[VAL_384]] to %[[VAL_375]] : !fir.ref + ! CHECK: cf.cond_br %[[VAL_381]], ^bb3, ^bb6(%[[VAL_370]] : i1) + ! CHECK: ^bb3: + ! CHECK: %[[VAL_385:.*]] = fir.load %[[VAL_375]] : !fir.ref + ! CHECK: %[[VAL_386:.*]] = fir.convert %[[VAL_385]] : (i32) -> i64 + ! CHECK: %[[VAL_387:.*]] = fir.shape %[[VAL_368]], %[[VAL_365]] : (index, index) -> !fir.shape<2> + ! CHECK: %[[VAL_388:.*]] = fir.undefined index + ! CHECK: %[[VAL_389:.*]] = fir.slice %[[VAL_386]], %[[VAL_388]], %[[VAL_388]], %[[VAL_371]], %[[VAL_368]], %[[VAL_371]] : (i64, index, index, index, index, index) -> !fir.slice<2> + ! CHECK: cf.br ^bb4(%[[VAL_372]], %[[VAL_369]] : index, i1) + ! CHECK: ^bb4(%[[VAL_390:.*]]: index, %[[VAL_391:.*]]: i1): + ! CHECK: %[[VAL_392:.*]] = arith.cmpi sle, %[[VAL_390]], %[[VAL_373]] : index + ! CHECK: %[[VAL_393:.*]] = arith.andi %[[VAL_391]], %[[VAL_392]] : i1 + ! CHECK: cf.cond_br %[[VAL_393]], ^bb5, ^bb6(%[[VAL_391]] : i1) + ! CHECK: ^bb5: + ! CHECK: %[[VAL_394:.*]] = fir.convert %[[VAL_385]] : (i32) -> index + ! CHECK: %[[VAL_395:.*]] = fir.coordinate_of %[[VAL_396]], %[[VAL_390]] : (!fir.ref>, index) -> !fir.ref + ! CHECK: %[[VAL_397:.*]] = fir.load %[[VAL_395]] : !fir.ref + ! CHECK: %[[VAL_398:.*]] = fir.convert %[[VAL_397]] : (i32) -> index + ! CHECK: %[[VAL_399:.*]] = fir.array_coor %[[VAL_400]](%[[VAL_387]]) {{\[}}%[[VAL_389]]] %[[VAL_394]], %[[VAL_398]] : (!fir.ref>, !fir.shape<2>, !fir.slice<2>, index, index) -> !fir.ref + ! CHECK: %[[VAL_401:.*]] = fir.convert %[[VAL_399]] : (!fir.ref) -> !fir.ref + ! CHECK: %[[VAL_402:.*]] = fir.call @_FortranAioInputInteger(%[[VAL_378]], %[[VAL_401]], %[[VAL_374]]) : (!fir.ref, !fir.ref, i32) -> i1 + ! CHECK: %[[VAL_403:.*]] = arith.addi %[[VAL_390]], %[[VAL_371]] : index + ! CHECK: cf.br ^bb4(%[[VAL_403]], %[[VAL_402]] : index, i1) + ! CHECK: ^bb6(%[[VAL_404:.*]]: i1): + ! CHECK: %[[VAL_405:.*]] = arith.addi %[[VAL_380]], %[[VAL_371]] : index + ! CHECK: cf.br ^bb1(%[[VAL_405]], %[[VAL_404]] : index, i1) + ! CHECK: ^bb7: + ! CHECK: %[[VAL_406:.*]] = fir.convert %[[VAL_380]] : (index) -> i32 + ! CHECK: fir.store %[[VAL_406]] to %[[VAL_375]] : !fir.ref + ! CHECK: %[[VAL_407:.*]] = fir.call @_FortranAioEndIoStatement(%[[VAL_378]]) : (!fir.ref) -> i32 + ! CHECK: fir.store %[[VAL_407]] to %[[VAL_408]] : !fir.ref + ! CHECK: return + end subroutine