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 @@ -1086,10 +1086,6 @@ TODO(toLocation(), "CaseStmt lowering"); } - void genFIR(const Fortran::parser::ContinueStmt &) { - TODO(toLocation(), "ContinueStmt lowering"); - } - void genFIR(const Fortran::parser::ElseIfStmt &) { TODO(toLocation(), "ElseIfStmt lowering"); } @@ -1119,6 +1115,7 @@ } // Nop statements - No code, or code is generated at the construct level. + void genFIR(const Fortran::parser::ContinueStmt &) {} // nop void genFIR(const Fortran::parser::EndFunctionStmt &) {} // nop void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp --- a/flang/lib/Lower/ConvertExpr.cpp +++ b/flang/lib/Lower/ConvertExpr.cpp @@ -23,6 +23,7 @@ #include "flang/Lower/StatementContext.h" #include "flang/Lower/SymbolMap.h" #include "flang/Lower/Todo.h" +#include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/Complex.h" #include "flang/Optimizer/Builder/Factory.h" #include "flang/Optimizer/Builder/MutableBox.h" @@ -850,6 +851,13 @@ return builder.createConvert(loc, ty, lb); } + static bool isSlice(const Fortran::evaluate::ArrayRef &aref) { + for (const Fortran::evaluate::Subscript &sub : aref.subscript()) + if (std::holds_alternative(sub.u)) + return true; + return false; + } + /// Lower an ArrayRef to a fir.coordinate_of given its lowered base. ExtValue genCoordinateOp(const ExtValue &array, const Fortran::evaluate::ArrayRef &aref) { @@ -862,7 +870,7 @@ if ((array.rank() > 1 && fir::hasDynamicSize(baseType)) || fir::characterWithDynamicLen(fir::unwrapSequenceType(baseType))) if (!array.getBoxOf()) - TODO(getLoc(), "genOffsetAndCoordinateOp"); + return genOffsetAndCoordinateOp(array, aref); // Generate a fir.coordinate_of with zero based array indexes. llvm::SmallVector args; for (const auto &subsc : llvm::enumerate(aref.subscript())) { @@ -883,13 +891,104 @@ return fir::factory::arrayElementToExtendedValue(builder, loc, array, addr); } + /// Lower an ArrayRef to a fir.coordinate_of using an element offset instead + /// of array indexes. + /// This generates offset computation from the indexes and length parameters, + /// and use the offset to access the element with a fir.coordinate_of. This + /// must only be used if it is not possible to generate a normal + /// fir.coordinate_of using array indexes (i.e. when the shape information is + /// unavailable in the IR). + ExtValue genOffsetAndCoordinateOp(const ExtValue &array, + const Fortran::evaluate::ArrayRef &aref) { + mlir::Location loc = getLoc(); + mlir::Value addr = fir::getBase(array); + mlir::Type arrTy = fir::dyn_cast_ptrEleTy(addr.getType()); + auto eleTy = arrTy.cast().getEleTy(); + mlir::Type seqTy = builder.getRefType(builder.getVarLenSeqTy(eleTy)); + mlir::Type refTy = builder.getRefType(eleTy); + mlir::Value base = builder.createConvert(loc, seqTy, addr); + mlir::IndexType idxTy = builder.getIndexType(); + mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1); + mlir::Value zero = builder.createIntegerConstant(loc, idxTy, 0); + auto getLB = [&](const auto &arr, unsigned dim) -> mlir::Value { + return arr.getLBounds().empty() ? one : arr.getLBounds()[dim]; + }; + auto genFullDim = [&](const auto &arr, mlir::Value delta) -> mlir::Value { + mlir::Value total = zero; + assert(arr.getExtents().size() == aref.subscript().size()); + delta = builder.createConvert(loc, idxTy, delta); + unsigned dim = 0; + for (auto [ext, sub] : llvm::zip(arr.getExtents(), aref.subscript())) { + ExtValue subVal = genSubscript(sub); + assert(fir::isUnboxedValue(subVal)); + mlir::Value val = + builder.createConvert(loc, idxTy, fir::getBase(subVal)); + mlir::Value lb = builder.createConvert(loc, idxTy, getLB(arr, dim)); + mlir::Value diff = builder.create(loc, val, lb); + mlir::Value prod = + builder.create(loc, delta, diff); + total = builder.create(loc, prod, total); + if (ext) + delta = builder.create(loc, delta, ext); + ++dim; + } + mlir::Type origRefTy = refTy; + if (fir::factory::CharacterExprHelper::isCharacterScalar(refTy)) { + fir::CharacterType chTy = + fir::factory::CharacterExprHelper::getCharacterType(refTy); + if (fir::characterWithDynamicLen(chTy)) { + mlir::MLIRContext *ctx = builder.getContext(); + fir::KindTy kind = + fir::factory::CharacterExprHelper::getCharacterKind(chTy); + fir::CharacterType singleTy = + fir::CharacterType::getSingleton(ctx, kind); + refTy = builder.getRefType(singleTy); + mlir::Type seqRefTy = + builder.getRefType(builder.getVarLenSeqTy(singleTy)); + base = builder.createConvert(loc, seqRefTy, base); + } + } + auto coor = builder.create( + loc, refTy, base, llvm::ArrayRef{total}); + // Convert to expected, original type after address arithmetic. + return builder.createConvert(loc, origRefTy, coor); + }; + return array.match( + [&](const fir::ArrayBoxValue &arr) -> ExtValue { + // FIXME: this check can be removed when slicing is implemented + if (isSlice(aref)) + fir::emitFatalError( + getLoc(), + "slice should be handled in array expression context"); + return genFullDim(arr, one); + }, + [&](const fir::CharArrayBoxValue &arr) -> ExtValue { + mlir::Value delta = arr.getLen(); + // If the length is known in the type, fir.coordinate_of will + // already take the length into account. + if (fir::factory::CharacterExprHelper::hasConstantLengthInType(arr)) + delta = one; + return fir::CharBoxValue(genFullDim(arr, delta), arr.getLen()); + }, + [&](const fir::BoxValue &arr) -> ExtValue { + // CoordinateOp for BoxValue is not generated here. The dimensions + // must be kept in the fir.coordinate_op so that potential fir.box + // strides can be applied by codegen. + fir::emitFatalError( + loc, "internal: BoxValue in dim-collapsed fir.coordinate_of"); + }, + [&](const auto &) -> ExtValue { + fir::emitFatalError(loc, "internal: array lowering failed"); + }); + } + ExtValue gen(const Fortran::evaluate::ArrayRef &aref) { ExtValue base = aref.base().IsSymbol() ? gen(aref.base().GetFirstSymbol()) : gen(aref.base().GetComponent()); return genCoordinateOp(base, aref); } ExtValue genval(const Fortran::evaluate::ArrayRef &aref) { - TODO(getLoc(), "genval ArrayRef"); + return genLoad(gen(aref)); } ExtValue gen(const Fortran::evaluate::CoarrayRef &coref) { diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp --- a/flang/lib/Lower/ConvertVariable.cpp +++ b/flang/lib/Lower/ConvertVariable.cpp @@ -728,6 +728,86 @@ } } + // Helper to generate scalars for the symbol properties. + auto genValue = [&](const Fortran::lower::SomeExpr &expr) { + return genScalarValue(converter, loc, expr, symMap, stmtCtx); + }; + + // For symbols reaching this point, all properties are constant and can be + // read/computed already into ssa values. + + // The origin must be \vec{1}. + auto populateShape = [&](auto &shapes, const auto &bounds, mlir::Value box) { + for (auto iter : llvm::enumerate(bounds)) { + auto *spec = iter.value(); + assert(spec->lbound().GetExplicit() && + "lbound must be explicit with constant value 1"); + if (auto high = spec->ubound().GetExplicit()) { + Fortran::lower::SomeExpr highEx{*high}; + mlir::Value ub = genValue(highEx); + shapes.emplace_back(builder.createConvert(loc, idxTy, ub)); + } else if (spec->ubound().isColon()) { + assert(box && "assumed bounds require a descriptor"); + mlir::Value dim = + builder.createIntegerConstant(loc, idxTy, iter.index()); + auto dimInfo = + builder.create(loc, idxTy, idxTy, idxTy, box, dim); + shapes.emplace_back(dimInfo.getResult(1)); + } else if (spec->ubound().isStar()) { + shapes.emplace_back(builder.create(loc, idxTy)); + } else { + llvm::report_fatal_error("unknown bound category"); + } + } + }; + + // The origin is not \vec{1}. + auto populateLBoundsExtents = [&](auto &lbounds, auto &extents, + const auto &bounds, mlir::Value box) { + for (auto iter : llvm::enumerate(bounds)) { + auto *spec = iter.value(); + fir::BoxDimsOp dimInfo; + mlir::Value ub, lb; + if (spec->lbound().isColon() || spec->ubound().isColon()) { + // This is an assumed shape because allocatables and pointers extents + // are not constant in the scope and are not read here. + assert(box && "deferred bounds require a descriptor"); + mlir::Value dim = + builder.createIntegerConstant(loc, idxTy, iter.index()); + dimInfo = + builder.create(loc, idxTy, idxTy, idxTy, box, dim); + extents.emplace_back(dimInfo.getResult(1)); + if (auto low = spec->lbound().GetExplicit()) { + auto expr = Fortran::lower::SomeExpr{*low}; + mlir::Value lb = builder.createConvert(loc, idxTy, genValue(expr)); + lbounds.emplace_back(lb); + } else { + // Implicit lower bound is 1 (Fortran 2018 section 8.5.8.3 point 3.) + lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, 1)); + } + } else { + if (auto low = spec->lbound().GetExplicit()) { + auto expr = Fortran::lower::SomeExpr{*low}; + lb = builder.createConvert(loc, idxTy, genValue(expr)); + } else { + TODO(loc, "assumed rank lowering"); + } + + if (auto high = spec->ubound().GetExplicit()) { + auto expr = Fortran::lower::SomeExpr{*high}; + ub = builder.createConvert(loc, idxTy, genValue(expr)); + lbounds.emplace_back(lb); + extents.emplace_back(computeExtent(builder, loc, lb, ub)); + } else { + // An assumed size array. The extent is not computed. + assert(spec->ubound().isStar() && "expected assumed size"); + lbounds.emplace_back(lb); + extents.emplace_back(builder.create(loc, idxTy)); + } + } + } + }; + // For symbols reaching this point, all properties are constant and can be // read/computed already into ssa values. @@ -827,7 +907,48 @@ //===--------------------------------------------------------------===// [&](const Fortran::lower::details::DynamicArray &x) { - TODO(loc, "DynamicArray variable lowering"); + // cast to the known constant parts from the declaration + mlir::Type varType = converter.genType(var); + mlir::Value addr = symMap.lookupSymbol(sym).getAddr(); + mlir::Value argBox; + mlir::Type castTy = builder.getRefType(varType); + if (addr) { + if (auto boxTy = addr.getType().dyn_cast()) { + argBox = addr; + mlir::Type refTy = builder.getRefType(boxTy.getEleTy()); + addr = builder.create(loc, refTy, argBox); + } + addr = builder.createConvert(loc, castTy, addr); + } + if (x.lboundAllOnes()) { + // if lower bounds are all ones, build simple shaped object + llvm::SmallVector shapes; + populateShape(shapes, x.bounds, argBox); + if (isDummy) { + symMap.addSymbolWithShape(sym, addr, shapes, true); + return; + } + // local array with computed bounds + assert(Fortran::lower::isExplicitShape(sym) || + Fortran::semantics::IsAllocatableOrPointer(sym)); + mlir::Value local = + createNewLocal(converter, loc, var, preAlloc, shapes); + symMap.addSymbolWithShape(sym, local, shapes); + return; + } + // if object is an array process the lower bound and extent values + llvm::SmallVector extents; + llvm::SmallVector lbounds; + populateLBoundsExtents(lbounds, extents, x.bounds, argBox); + if (isDummy) { + symMap.addSymbolWithBounds(sym, addr, extents, lbounds, true); + return; + } + // local array with computed bounds + assert(Fortran::lower::isExplicitShape(sym)); + mlir::Value local = + createNewLocal(converter, loc, var, preAlloc, extents); + symMap.addSymbolWithBounds(sym, local, extents, lbounds); }, //===--------------------------------------------------------------===// diff --git a/flang/test/Lower/io-statement-1.f90 b/flang/test/Lower/io-statement-1.f90 --- a/flang/test/Lower/io-statement-1.f90 +++ b/flang/test/Lower/io-statement-1.f90 @@ -1,4 +1,4 @@ -! RUN: bbc %s -o - | FileCheck %s +! RUN: bbc %s -emit-fir -o - | FileCheck %s logical :: existsvar integer :: length diff --git a/flang/test/Lower/io-statement-2.f90 b/flang/test/Lower/io-statement-2.f90 --- a/flang/test/Lower/io-statement-2.f90 +++ b/flang/test/Lower/io-statement-2.f90 @@ -22,6 +22,118 @@ 90 print*, exx, c, m, s end +! CHECK-LABEL: func @_QPcontrol0 +subroutine control0(n) ! no I/O condition specifier control flow +dimension c(n), d(n,n), e(n,n), f(n) +! CHECK-NOT: fir.if +! CHECK: BeginExternalFormattedInput +! CHECK-NOT: fir.if +! CHECK: SetAdvance +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: fir.do_loop +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: InputReal32 +! CHECK-NOT: fir.if +! CHECK: EndIoStatement +! CHECK-NOT: fir.if +read(*,'(F7.2)', advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end + +! CHECK-LABEL: func @_QPcontrol1 +subroutine control1(n) ! I/O condition specifier control flow +! CHECK: BeginExternalFormattedInput +! CHECK: EnableHandlers +! CHECK: SetAdvance +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: fir.iterate_while +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: fir.if +! CHECK: InputReal32 +! CHECK: EndIoStatement +dimension c(n), d(n,n), e(n,n), f(n) +read(*,'(F7.2)', iostat=mm, advance='no') a, b, (c(j), (d(k,j), e(k,j), k=1,n), f(j), j=1,n), g +end + +! CHECK-LABEL: func @_QPcontrol2 +subroutine control2() ! I/O condition specifier control flow (use index result) +c = 1; d = 9 +! CHECK: BeginExternalFormattedOutput +! CHECK: EnableHandlers +! CHECK: :2 = fir.iterate_while +! CHECK: = fir.if +! CHECK: OutputReal +! CHECK: = fir.if +! CHECK: OutputReal +! CHECK: fir.result +! CHECK: else +! CHECK: fir.result %false +! CHECK: fir.result +! CHECK: else +! CHECK: fir.result %false +! CHECK: = arith.addi %arg0, %c1 +! CHECK: = arith.select +! CHECK: fir.result +! CHECK: fir.if %{{[0-9]*}}#1 +! CHECK: OutputInteger +! CHECK: EndIoStatement +write(*,'(8F4.1,I5)',iostat=m) (c,d,j=11,14), j +end + +! CHECK-LABEL: func @_QPloopnest +subroutine loopnest + integer :: aa(3,3) + aa = 10 + ! CHECK: BeginExternalListOutput + ! CHECK: EnableHandlers + ! CHECK: {{.*}}:2 = fir.iterate_while ({{.*}} = {{.*}} to {{.*}} step {{.*}}) and ({{.*}} = {{.*}}) -> (index, i1) { + ! CHECK: fir.if {{.*}} -> (i1) { + ! CHECK: {{.*}}:2 = fir.iterate_while ({{.*}} = {{.*}} to {{.*}} step {{.*}}) and ({{.*}} = {{.*}}) -> (index, i1) { + ! CHECK: fir.if {{.*}} -> (i1) { + ! CHECK: OutputInteger32 + ! CHECK: fir.result {{.*}} : i1 + ! CHECK: } else { + ! CHECK: fir.result {{.*}} : i1 + ! CHECK: } + ! CHECK: fir.result {{.*}}, {{.*}} : index, i1 + ! CHECK: } + ! CHECK: fir.result {{.*}}#1 : i1 + ! CHECK: } else { + ! CHECK: fir.result {{.*}} : i1 + ! CHECK: } + ! CHECK: fir.result {{.*}}, {{.*}} : index, i1 + ! CHECK: } + ! CHECK: EndIoStatement + write(*,*,err=66) ((aa(j,k)+j+k,j=1,3),k=1,3) +66 continue +end + ! CHECK-LABEL: func @_QPimpliedformat subroutine impliedformat ! CHECK: BeginExternalListInput(%c-1