[flang] Lower entry statement

[clementval]

Summary

This patch add the lowering for the entry statement.

This patch is part of the upstreaming effort from fir-dev branch.

Depends on D121697

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Lower/Bridge.cpp

mlir::Value resultVal = resultSymBox.match(
         [&](const auto &) -> mlir::Value {
           mlir::Value resultRef = resultSymBox.getAddr();
           mlir::Type resultType = genType(resultSym);
           mlir::Type resultRefType = builder->getRefType(resultType);
           // A function with multiple entry points returning different types
           // tags all result variables with one of the largest types to allow
           // them to share the same storage.  Convert this to the actual type.
           if (resultRef.getType() != resultRefType)
-            TODO(loc, "Convert to actual type");
+            resultRef = builder->createConvert(loc, resultRefType, resultRef);
           return builder->create<fir::LoadOp>(loc, resultRef);
         });
     builder->create<mlir::func::ReturnOp>(loc, resultVal);
   }
 
+  /// Get the return value of a call to \p symbol, which is a subroutine entry
+  /// point that has alternative return specifiers.
+  const mlir::Value
+  getAltReturnResult(const Fortran::semantics::Symbol &symbol) {
+    assert(Fortran::semantics::HasAlternateReturns(symbol) &&
+           "subroutine does not have alternate returns");
+    return getSymbolAddress(symbol);
+  }
+
   void genFIRProcedureExit(Fortran::lower::pft::FunctionLikeUnit &funit,
                            const Fortran::semantics::Symbol &symbol) {
     if (mlir::Block *finalBlock = funit.finalBlock) {
       // The current block must end with a terminator.
       if (blockIsUnterminated())
         builder->create<mlir::cf::BranchOp>(toLocation(), finalBlock);
       // Set insertion point to final block.
       builder->setInsertionPoint(finalBlock, finalBlock->end());
     }
     if (Fortran::semantics::IsFunction(symbol)) {
       genReturnSymbol(symbol);
+    } else if (Fortran::semantics::HasAlternateReturns(symbol)) {
+      mlir::Value retval = builder->create<fir::LoadOp>(
+          toLocation(), getAltReturnResult(symbol));
+      builder->create<mlir::func::ReturnOp>(toLocation(), retval);
     } else {
       genExitRoutine();
     }
   }
 
   //
   // Statements that have control-flow semantics
   //

 
   // Nop statements - No code, or code is generated at the construct level.
   void genFIR(const Fortran::parser::AssociateStmt &) {}     // nop
   void genFIR(const Fortran::parser::ContinueStmt &) {}      // nop
   void genFIR(const Fortran::parser::EndAssociateStmt &) {}  // nop
   void genFIR(const Fortran::parser::EndFunctionStmt &) {}   // nop
   void genFIR(const Fortran::parser::EndIfStmt &) {}         // nop
   void genFIR(const Fortran::parser::EndSubroutineStmt &) {} // nop
-
-  void genFIR(const Fortran::parser::EntryStmt &) {
-    TODO(toLocation(), "EntryStmt lowering");
-  }
+  void genFIR(const Fortran::parser::EntryStmt &) {}         // nop
 
   void genFIR(const Fortran::parser::IfStmt &) {
     TODO(toLocation(), "IfStmt lowering");
   }
 
   void genFIR(const Fortran::parser::IfThenStmt &) {
     TODO(toLocation(), "IfThenStmt lowering");
   }

flang/lib/Lower/ConvertExpr.cpp

mlir::Value createFltCmpOp(mlir::arith::CmpFPredicate pred,
     fir::emitFatalError(getLoc(), "array compare should be handled in genarr");
   }
   template <typename OpTy, typename A>
   mlir::Value createFltCmpOp(const A &ex, mlir::arith::CmpFPredicate pred) {
     ExtValue left = genval(ex.left());
     return createFltCmpOp<OpTy>(pred, left, genval(ex.right()));
   }
 
+  /// Create a call to the runtime to compare two CHARACTER values.
+  /// Precondition: This assumes that the two values have `fir.boxchar` type.
+  mlir::Value createCharCompare(mlir::arith::CmpIPredicate pred,
+                                const ExtValue &left, const ExtValue &right) {
+    return fir::runtime::genCharCompare(builder, getLoc(), pred, left, right);
+  }
+
+  template <typename A>
+  mlir::Value createCharCompare(const A &ex, mlir::arith::CmpIPredicate pred) {
+    ExtValue left = genval(ex.left());
+    return createCharCompare(pred, left, genval(ex.right()));
+  }
+
   /// Returns a reference to a symbol or its box/boxChar descriptor if it has
   /// one.
   ExtValue gen(Fortran::semantics::SymbolRef sym) {
     if (Fortran::lower::SymbolBox val = symMap.lookupSymbol(sym))
       return val.match(
           [&](const Fortran::lower::SymbolBox::PointerOrAllocatable &boxAddr) {
             return fir::factory::genMutableBoxRead(builder, getLoc(), boxAddr);
           },
#define GENBIN(GenBinEvOp, GenBinTyCat, GenBinFirOp)                           \
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Complex, KIND>> &op) {
     TODO(getLoc(), "genval complex comparison");
   }
   template <int KIND>
   ExtValue genval(const Fortran::evaluate::Relational<Fortran::evaluate::Type<
                       Fortran::common::TypeCategory::Character, KIND>> &op) {
-    TODO(getLoc(), "genval char comparison");
+    return createCharCompare(op, translateRelational(op.opr));
   }
 
   ExtValue
   genval(const Fortran::evaluate::Relational<Fortran::evaluate::SomeType> &op) {
     return std::visit([&](const auto &x) { return genval(x); }, op.u);
   }
 
   template <Fortran::common::TypeCategory TC1, int KIND,

flang/test/Lower/entry-statement.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+
+! CHECK-LABEL: func @_QPcompare1(
+! CHECK-SAME:  %{{.*}}: !fir.ref<!fir.logical<4>>{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}) {
+subroutine compare1(x, c1, c2)
+    character(*) c1, c2, d1, d2
+    logical x, y
+    x = c1 < c2
+    return
+  
+  ! CHECK-LABEL: func @_QPcompare2(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.logical<4>>{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}) {
+  entry compare2(y, d2, d1)
+    y = d1 < d2
+  end
+  
+  program entries
+    character(10) hh, qq, m
+    character(len=4) s1, s2
+    integer mm
+    logical r
+    s1 = 'a111'
+    s2 = 'a222'
+    call compare1(r, s1, s2); print*, r
+    call compare2(r, s1, s2); print*, r
+    call ss(mm);     print*, mm
+    call e1(mm, 17); print*, mm
+    call e2(17, mm); print*, mm
+    call e3(mm);     print*, mm
+    print*, jj(11)
+    print*, rr(22)
+    m = 'abcd efgh'
+    print*, hh(m)
+    print*, qq(m)
+    call dd1
+    call dd2
+    call dd3(6)
+  6 continue
+  end
+  
+  ! CHECK-LABEL: func @_QPss(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) {
+  subroutine ss(n1)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Enx"}
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Eny"}
+    integer n17, n2
+    nx = 100
+    n1 = nx + 10
+    return
+  
+  ! CHECK-LABEL: func @_QPe1(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) {
+  entry e1(n2, n17)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Enx"}
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Eny"}
+    ny = 200
+    n2 = ny + 20
+    return
+  
+    ! CHECK-LABEL: func @_QPe2(
+    ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}, %{{.*}}: !fir.ref<i32>{{.*}}) {
+  entry e2(n3, n1)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Enx"}
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Eny"}
+  
+  ! CHECK-LABEL: func @_QPe3(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) {
+  entry e3(n1)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Enx"}
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Eny"}
+    n1 = 30
+  end
+  
+  ! CHECK-LABEL: func @_QPjj(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) -> i32
+  function jj(n1)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Ejj"}
+    jj = 100
+    jj = jj + n1
+    return
+  
+    ! CHECK-LABEL: func @_QPrr(
+    ! CHECK-SAME: %{{.*}}: !fir.ref<i32>{{.*}}) -> f32
+  entry rr(n2)
+    ! CHECK: fir.alloca i32 {{{.*}}uniq_name = "{{.*}}Ejj"}
+    rr = 200.0
+    rr = rr + n2
+  end
+  
+  ! CHECK-LABEL: func @_QPhh(
+  ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.char<1,10>>{{.*}}, %{{.*}}: index{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}) -> !fir.boxchar<1>
+  function hh(c1)
+    character(10) c1, hh, qq
+    hh = c1
+    return
+    ! CHECK-LABEL: func @_QPqq(
+    ! CHECK-SAME: %{{.*}}: !fir.ref<!fir.char<1,10>>{{.*}}, %{{.*}}: index{{.*}}, %{{.*}}: !fir.boxchar<1>{{.*}}) -> !fir.boxchar<1>
+  entry qq(c1)
+    qq = c1
+  end
+  
+  ! CHECK-LABEL: func @_QPchar_array()
+  function char_array()
+    character(10), c(5)
+  ! CHECK-LABEL: func @_QPchar_array_entry(
+  ! CHECK-SAME: %{{.*}}: !fir.boxchar<1>{{.*}}) -> f32 {
+  entry char_array_entry(c)
+  end
+  
+  ! CHECK-LABEL: func @_QPdd1()
+  subroutine dd1
+      ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
+      ! "_QFdd1Ekk"}
+      ! CHECK: br ^bb1
+      ! CHECK: ^bb1:  // pred: ^bb0
+      ! CHECK: %[[ten:.*]] = arith.constant 10 : i32
+      ! CHECK: fir.store %[[ten:.*]] to %[[kk]] : !fir.ref<i32>
+      ! CHECK: br ^bb2
+      ! CHECK: ^bb2:  // pred: ^bb1
+      ! CHECK: %[[twenty:.*]] = arith.constant 20 : i32
+      ! CHECK: fir.store %[[twenty:.*]] to %[[kk]] : !fir.ref<i32>
+      ! CHECK: br ^bb3
+      ! CHECK: ^bb3:  // pred: ^bb2
+      ! CHECK: return
+      kk = 10
+  
+      ! CHECK-LABEL: func @_QPdd2()
+      ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
+      ! "_QFdd1Ekk"}
+      ! CHECK: br ^bb1
+      ! CHECK: ^bb1:  // pred: ^bb0
+      ! CHECK: %[[twenty:.*]] = arith.constant 20 : i32
+      ! CHECK: fir.store %[[twenty:.*]] to %[[kk]] : !fir.ref<i32>
+      ! CHECK: br ^bb2
+      ! CHECK: ^bb2:  // pred: ^bb1
+      ! CHECK: return
+      entry dd2
+      kk = 20
+      return
+  
+      ! CHECK-LABEL: func @_QPdd3
+      ! CHECK: %[[dd3:[0-9]*]] = fir.alloca index {bindc_name = "dd3"}
+      ! CHECK: %[[kk:[0-9]*]] = fir.alloca i32 {bindc_name = "kk", uniq_name =
+      ! "_QFdd1Ekk"}
+      ! CHECK: %[[zero:.*]] = arith.constant 0 : index
+      ! CHECK: fir.store %[[zero:.*]] to %[[dd3]] : !fir.ref<index>
+      ! CHECK: br ^bb1
+      ! CHECK: ^bb1:  // pred: ^bb0
+      ! CHECK: %[[thirty:.*]] = arith.constant 30 : i32
+      ! CHECK: fir.store %[[thirty:.*]] to %[[kk:[0-9]*]] : !fir.ref<i32>
+      ! CHECK: br ^bb2
+      ! CHECK: ^bb2:  // pred: ^bb1
+      ! CHECK: %[[altret:[0-9]*]] = fir.load %[[dd3]] : !fir.ref<index>
+      ! CHECK: return %[[altret:[0-9]*]] : index
+      entry dd3(*)
+      kk = 30
+    end