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 @@ -28,6 +28,7 @@ #include "flang/Optimizer/Builder/BoxValue.h" #include "flang/Optimizer/Builder/Character.h" #include "flang/Optimizer/Builder/MutableBox.h" +#include "flang/Optimizer/Dialect/FIRAttr.h" #include "flang/Optimizer/Support/FIRContext.h" #include "flang/Optimizer/Support/InternalNames.h" #include "flang/Runtime/iostat.h" @@ -963,15 +964,124 @@ } void genFIR(const Fortran::parser::ComputedGotoStmt &stmt) { - TODO(toLocation(), "ComputedGotoStmt lowering"); + Fortran::lower::StatementContext stmtCtx; + Fortran::lower::pft::Evaluation &eval = getEval(); + mlir::Value selectExpr = + createFIRExpr(toLocation(), + Fortran::semantics::GetExpr( + std::get(stmt.t)), + stmtCtx); + stmtCtx.finalize(); + llvm::SmallVector indexList; + llvm::SmallVector blockList; + int64_t index = 0; + for (Fortran::parser::Label label : + std::get>(stmt.t)) { + indexList.push_back(++index); + blockList.push_back(blockOfLabel(eval, label)); + } + blockList.push_back(eval.nonNopSuccessor().block); // default + builder->create(toLocation(), selectExpr, indexList, + blockList); } void genFIR(const Fortran::parser::ArithmeticIfStmt &stmt) { - TODO(toLocation(), "ArithmeticIfStmt lowering"); + Fortran::lower::StatementContext stmtCtx; + Fortran::lower::pft::Evaluation &eval = getEval(); + mlir::Value expr = createFIRExpr( + toLocation(), + Fortran::semantics::GetExpr(std::get(stmt.t)), + stmtCtx); + stmtCtx.finalize(); + mlir::Type exprType = expr.getType(); + mlir::Location loc = toLocation(); + if (exprType.isSignlessInteger()) { + // Arithmetic expression has Integer type. Generate a SelectCaseOp + // with ranges {(-inf:-1], 0=default, [1:inf)}. + MLIRContext *context = builder->getContext(); + llvm::SmallVector attrList; + llvm::SmallVector valueList; + llvm::SmallVector blockList; + attrList.push_back(fir::UpperBoundAttr::get(context)); + valueList.push_back(builder->createIntegerConstant(loc, exprType, -1)); + blockList.push_back(blockOfLabel(eval, std::get<1>(stmt.t))); + attrList.push_back(fir::LowerBoundAttr::get(context)); + valueList.push_back(builder->createIntegerConstant(loc, exprType, 1)); + blockList.push_back(blockOfLabel(eval, std::get<3>(stmt.t))); + attrList.push_back(mlir::UnitAttr::get(context)); // 0 is the "default" + blockList.push_back(blockOfLabel(eval, std::get<2>(stmt.t))); + builder->create(loc, expr, attrList, valueList, + blockList); + return; + } + // Arithmetic expression has Real type. Generate + // sum = expr + expr [ raise an exception if expr is a NaN ] + // if (sum < 0.0) goto L1 else if (sum > 0.0) goto L3 else goto L2 + auto sum = builder->create(loc, expr, expr); + auto zero = builder->create( + loc, exprType, builder->getFloatAttr(exprType, 0.0)); + auto cond1 = builder->create( + loc, mlir::arith::CmpFPredicate::OLT, sum, zero); + mlir::Block *elseIfBlock = + builder->getBlock()->splitBlock(builder->getInsertionPoint()); + genFIRConditionalBranch(cond1, blockOfLabel(eval, std::get<1>(stmt.t)), + elseIfBlock); + startBlock(elseIfBlock); + auto cond2 = builder->create( + loc, mlir::arith::CmpFPredicate::OGT, sum, zero); + genFIRConditionalBranch(cond2, blockOfLabel(eval, std::get<3>(stmt.t)), + blockOfLabel(eval, std::get<2>(stmt.t))); } void genFIR(const Fortran::parser::AssignedGotoStmt &stmt) { - TODO(toLocation(), "AssignedGotoStmt lowering"); + // Program requirement 1990 8.2.4 - + // + // At the time of execution of an assigned GOTO statement, the integer + // variable must be defined with the value of a statement label of a + // branch target statement that appears in the same scoping unit. + // Note that the variable may be defined with a statement label value + // only by an ASSIGN statement in the same scoping unit as the assigned + // GOTO statement. + + mlir::Location loc = toLocation(); + Fortran::lower::pft::Evaluation &eval = getEval(); + const Fortran::lower::pft::SymbolLabelMap &symbolLabelMap = + eval.getOwningProcedure()->assignSymbolLabelMap; + const Fortran::semantics::Symbol &symbol = + *std::get(stmt.t).symbol; + auto selectExpr = + builder->create(loc, getSymbolAddress(symbol)); + auto iter = symbolLabelMap.find(symbol); + if (iter == symbolLabelMap.end()) { + // Fail for a nonconforming program unit that does not have any ASSIGN + // statements. The front end should check for this. + mlir::emitError(loc, "(semantics issue) no assigned goto targets"); + exit(1); + } + auto labelSet = iter->second; + llvm::SmallVector indexList; + llvm::SmallVector blockList; + auto addLabel = [&](Fortran::parser::Label label) { + indexList.push_back(label); + blockList.push_back(blockOfLabel(eval, label)); + }; + // Add labels from an explicit list. The list may have duplicates. + for (Fortran::parser::Label label : + std::get>(stmt.t)) { + if (labelSet.count(label) && + std::find(indexList.begin(), indexList.end(), label) == + indexList.end()) { // ignore duplicates + addLabel(label); + } + } + // Absent an explicit list, add all possible label targets. + if (indexList.empty()) + for (auto &label : labelSet) + addLabel(label); + // Add a nop/fallthrough branch to the switch for a nonconforming program + // unit that violates the program requirement above. + blockList.push_back(eval.nonNopSuccessor().block); // default + builder->create(loc, selectExpr, indexList, blockList); } void genFIR(const Fortran::parser::DoConstruct &doConstruct) { @@ -1380,7 +1490,12 @@ } void genFIR(const Fortran::parser::AssignStmt &stmt) { - TODO(toLocation(), "AssignStmt lowering"); + const Fortran::semantics::Symbol &symbol = + *std::get(stmt.t).symbol; + mlir::Location loc = toLocation(); + mlir::Value labelValue = builder->createIntegerConstant( + loc, genType(symbol), std::get(stmt.t)); + builder->create(loc, labelValue, getSymbolAddress(symbol)); } void genFIR(const Fortran::parser::FormatStmt &) { diff --git a/flang/test/Lower/arithmetic-goto.f90 b/flang/test/Lower/arithmetic-goto.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/arithmetic-goto.f90 @@ -0,0 +1,37 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + +! CHECK-LABEL: func @_QPkagi +function kagi(index) + ! CHECK: fir.select_case %{{.}} : i32 [#fir.upper, %c-1_i32, ^bb{{.}}, #fir.lower, %c1_i32, ^bb{{.}}, unit, ^bb{{.}}] + if (index) 7, 8, 9 + kagi = 0; return + 7 kagi = 1; return + 8 kagi = 2; return + 9 kagi = 3; return + end + + ! CHECK-LABEL: func @_QPkagf + function kagf(findex) + ! CHECK: %[[zero:.+]] = arith.constant 0.0 + ! CHECK: %{{.+}} = arith.cmpf olt, %{{.+}}, %[[zero]] : f32 + ! CHECK: cond_br % + ! CHECK: %{{.+}} = arith.cmpf ogt, %{{.+}}, %[[zero]] : f32 + ! CHECK: cond_br % + ! CHECK: br ^ + if (findex+findex) 7, 8, 9 + kagf = 0; return + 7 kagf = 1; return + 8 kagf = 2; return + 9 kagf = 3; return + end + + ! CHECK-LABEL: func @_QQmain + + print*, kagf(-2.0) + print*, kagf(-1.0) + print*, kagf(-0.0) + print*, kagf( 0.0) + print*, kagf(+0.0) + print*, kagf(+1.0) + print*, kagf(+2.0) + end diff --git a/flang/test/Lower/assigned-goto.f90 b/flang/test/Lower/assigned-goto.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Lower/assigned-goto.f90 @@ -0,0 +1,35 @@ +! RUN: bbc -emit-fir -o - %s | FileCheck %s + + ! CHECK-LABEL: func @_QPnolist + subroutine nolist + integer L, V + 11 V = 1 + ! CHECK: fir.store %c31{{.*}} to %{{.}} + assign 31 to L + ! CHECK: fir.select %{{.}} : i32 [31, ^bb{{.}}, unit, ^bb{{.}}] + goto L ! no list + 21 V = 2 + go to 41 + 31 V = 3 + 41 print*, 3, V + end + + ! CHECK-LABEL: func @_QPlist + subroutine list + integer L, V + ! CHECK: fir.store %c22{{.*}} to %{{.}} + assign 22 to L + 12 V = 100 + ! CHECK: fir.store %c32{{.*}} to %{{.}} + assign 32 to L + ! CHECK: fir.select %{{.}} : i32 [32, ^bb{{.}}, 22, ^bb{{.}}, unit, ^bb{{.}}] + goto L (42, 32, 22, 32, 32) ! duplicate labels are allowed + 22 V = 200 + go to 42 + 32 V = 300 + 42 print*, 300, V + end + + call nolist + call list + end