[flang] Lower date_and_time and cpu_time intrinsics

[clementval]

Summary

This patch lowers the cpu_time and the date_and_time instrinsics to
FIR and runtime calls.

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

Depends on D121704

[PeteSteinfeld]

It looks like this update is missing the file .../flang/test/Lower/Intrinsics/date_and_time.f90.

[clementval]

Rebase + add missing tests

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Lower/Runtime.h

 // style (https://mlir.llvm.org/getting_started/DeveloperGuide/) is used in this
 // module.
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_LOWER_RUNTIME_H
 #define FORTRAN_LOWER_RUNTIME_H
 
+namespace llvm {
+template <typename T>
+class Optional;
+}
+
 namespace mlir {
 class Location;
 class Value;
 } // namespace mlir
 
 namespace fir {
+class CharBoxValue;
 class FirOpBuilder;
 } // namespace fir
 
 namespace Fortran {
 
 namespace parser {
 struct EventPostStmt;
 struct EventWaitStmt;
void genSyncMemoryStatement(AbstractConverter &,
                             const parser::SyncMemoryStmt &);
 void genSyncTeamStatement(AbstractConverter &, const parser::SyncTeamStmt &);
 void genUnlockStatement(AbstractConverter &, const parser::UnlockStmt &);
 void genPauseStatement(AbstractConverter &, const parser::PauseStmt &);
 
 mlir::Value genAssociated(fir::FirOpBuilder &, mlir::Location,
                           mlir::Value pointer, mlir::Value target);
 
+mlir::Value genCpuTime(fir::FirOpBuilder &, mlir::Location);
+void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
+                    llvm::Optional<fir::CharBoxValue> date,
+                    llvm::Optional<fir::CharBoxValue> time,
+                    llvm::Optional<fir::CharBoxValue> zone, mlir::Value values);
+
 void genRandomInit(fir::FirOpBuilder &, mlir::Location, mlir::Value repeatable,
                    mlir::Value imageDistinct);
 void genRandomNumber(fir::FirOpBuilder &, mlir::Location, mlir::Value harvest);
 void genRandomSeed(fir::FirOpBuilder &, mlir::Location, int argIndex,
                    mlir::Value argBox);
 
 } // namespace lower
 } // namespace Fortran
 
 #endif // FORTRAN_LOWER_RUNTIME_H

flang/lib/Lower/IntrinsicCall.cpp

fir::ExtendedValue genAssociated(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genChar(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genDotProduct(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   template <mlir::arith::CmpIPredicate pred>
   fir::ExtendedValue genCharacterCompare(mlir::Type,
                                          llvm::ArrayRef<fir::ExtendedValue>);
+  void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
+  void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
   template <Extremum, ExtremumBehavior>
   mlir::Value genExtremum(mlir::Type, llvm::ArrayRef<mlir::Value>);
   /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments
   /// in the llvm::ArrayRef.
   mlir::Value genIand(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genIbits(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genLbound(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genNull(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
static constexpr IntrinsicHandler handlers[]{
      &I::genAny,
      {{{"mask", asAddr}, {"dim", asValue}}},
      /*isElemental=*/false},
     {"associated",
      &I::genAssociated,
      {{{"pointer", asInquired}, {"target", asInquired}}},
      /*isElemental=*/false},
     {"char", &I::genChar},
+    {"cpu_time",
+     &I::genCpuTime,
+     {{{"time", asAddr}}},
+     /*isElemental=*/false},
+    {"date_and_time",
+     &I::genDateAndTime,
+     {{{"date", asAddr, handleDynamicOptional},
+       {"time", asAddr, handleDynamicOptional},
+       {"zone", asAddr, handleDynamicOptional},
+       {"values", asBox, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"dim", &I::genDim},
     {"dot_product",
      &I::genDotProduct,
      {{{"vector_a", asBox}, {"vector_b", asBox}}},
      /*isElemental=*/false},
     {"iand", &I::genIand},
     {"ibits", &I::genIbits},
     {"len",

 // DOT_PRODUCT
 fir::ExtendedValue
 IntrinsicLibrary::genDotProduct(mlir::Type resultType,
                                 llvm::ArrayRef<fir::ExtendedValue> args) {
   return genDotProd(fir::runtime::genDotProduct, resultType, builder, loc,
                     stmtCtx, args);
 }
 
+// CPU_TIME
+void IntrinsicLibrary::genCpuTime(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1);
+  const mlir::Value *arg = args[0].getUnboxed();
+  assert(arg && "nonscalar cpu_time argument");
+  mlir::Value res1 = Fortran::lower::genCpuTime(builder, loc);
+  mlir::Value res2 =
+      builder.createConvert(loc, fir::dyn_cast_ptrEleTy(arg->getType()), res1);
+  builder.create<fir::StoreOp>(loc, res2, *arg);
+}
+
+// DATE_AND_TIME
+void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 4 && "date_and_time has 4 args");
+  llvm::SmallVector<llvm::Optional<fir::CharBoxValue>> charArgs(3);
+  for (unsigned i = 0; i < 3; ++i)
+    if (const fir::CharBoxValue *charBox = args[i].getCharBox())
+      charArgs[i] = *charBox;
+
+  mlir::Value values = fir::getBase(args[3]);
+  if (!values)
+    values = builder.create<fir::AbsentOp>(
+        loc, fir::BoxType::get(builder.getNoneType()));
+
+  Fortran::lower::genDateAndTime(builder, loc, charArgs[0], charArgs[1],
+                                 charArgs[2], values);
+}
+
 // IAND
 mlir::Value IntrinsicLibrary::genIand(mlir::Type resultType,
                                       llvm::ArrayRef<mlir::Value> args) {
   assert(args.size() == 2);
   return builder.create<mlir::arith::AndIOp>(loc, args[0], args[1]);
 }
 
 // IBITS

flang/lib/Lower/Runtime.cpp

 #include "flang/Lower/StatementContext.h"
 #include "flang/Lower/Todo.h"
 #include "flang/Optimizer/Builder/FIRBuilder.h"
 #include "flang/Optimizer/Builder/Runtime/RTBuilder.h"
 #include "flang/Parser/parse-tree.h"
 #include "flang/Runtime/pointer.h"
 #include "flang/Runtime/random.h"
 #include "flang/Runtime/stop.h"
+#include "flang/Runtime/time-intrinsic.h"
 #include "flang/Semantics/tools.h"
 #include "llvm/Support/Debug.h"
 
 #define DEBUG_TYPE "flang-lower-runtime"
 
 using namespace Fortran::runtime;
 
 /// Runtime calls that do not return to the caller indicate this condition by
mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder,
   mlir::FuncOp func =
       fir::runtime::getRuntimeFunc<mkRTKey(PointerIsAssociatedWith)>(loc,
                                                                      builder);
   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
       builder, loc, func.getType(), pointer, target);
   return builder.create<fir::CallOp>(loc, func, args).getResult(0);
 }
 
+mlir::Value Fortran::lower::genCpuTime(fir::FirOpBuilder &builder,
+                                       mlir::Location loc) {
+  mlir::FuncOp func =
+      fir::runtime::getRuntimeFunc<mkRTKey(CpuTime)>(loc, builder);
+  return builder.create<fir::CallOp>(loc, func, llvm::None).getResult(0);
+}
+
+void Fortran::lower::genDateAndTime(fir::FirOpBuilder &builder,
+                                    mlir::Location loc,
+                                    llvm::Optional<fir::CharBoxValue> date,
+                                    llvm::Optional<fir::CharBoxValue> time,
+                                    llvm::Optional<fir::CharBoxValue> zone,
+                                    mlir::Value values) {
+  mlir::FuncOp callee =
+      fir::runtime::getRuntimeFunc<mkRTKey(DateAndTime)>(loc, builder);
+  mlir::FunctionType funcTy = callee.getType();
+  mlir::Type idxTy = builder.getIndexType();
+  mlir::Value zero;
+  auto splitArg = [&](llvm::Optional<fir::CharBoxValue> arg,
+                      mlir::Value &buffer, mlir::Value &len) {
+    if (arg) {
+      buffer = arg->getBuffer();
+      len = arg->getLen();
+    } else {
+      if (!zero)
+        zero = builder.createIntegerConstant(loc, idxTy, 0);
+      buffer = zero;
+      len = zero;
+    }
+  };
+  mlir::Value dateBuffer;
+  mlir::Value dateLen;
+  splitArg(date, dateBuffer, dateLen);
+  mlir::Value timeBuffer;
+  mlir::Value timeLen;
+  splitArg(time, timeBuffer, timeLen);
+  mlir::Value zoneBuffer;
+  mlir::Value zoneLen;
+  splitArg(zone, zoneBuffer, zoneLen);
+
+  mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
+  mlir::Value sourceLine =
+      fir::factory::locationToLineNo(builder, loc, funcTy.getInput(7));
+
+  llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
+      builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen,
+      zoneBuffer, zoneLen, sourceFile, sourceLine, values);
+  builder.create<fir::CallOp>(loc, callee, args);
+}
+
 void Fortran::lower::genRandomInit(fir::FirOpBuilder &builder,
                                    mlir::Location loc, mlir::Value repeatable,
                                    mlir::Value imageDistinct) {
   mlir::FuncOp func =
       fir::runtime::getRuntimeFunc<mkRTKey(RandomInit)>(loc, builder);
   llvm::SmallVector<mlir::Value> args = fir::runtime::createArguments(
       builder, loc, func.getType(), repeatable, imageDistinct);
   builder.create<fir::CallOp>(loc, func, args);

flang/test/Lower/Intrinsics/cpu_time.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: cpu_time_test
+subroutine cpu_time_test(t)
+    real :: t
+    ! CHECK: %[[result64:[0-9]+]] = fir.call @_FortranACpuTime() : () -> f64
+    ! CHECK: %[[result32:[0-9]+]] = fir.convert %[[result64]] : (f64) -> f32
+    ! CHECK: fir.store %[[result32]] to %arg0 : !fir.ref<f32>
+    call cpu_time(t)
+  end subroutine
+  
 No newline at end of file

flang/test/Lower/Intrinsics/date_and_time.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPdate_and_time_test(
+! CHECK-SAME: %[[date:[^:]+]]: !fir.boxchar<1>{{.*}}, %[[time:[^:]+]]: !fir.boxchar<1>{{.*}}, %[[zone:.*]]: !fir.boxchar<1>{{.*}}, %[[values:.*]]: !fir.box<!fir.array<?xi64>>{{.*}}) {
+subroutine date_and_time_test(date, time, zone, values)
+    character(*) :: date, time, zone
+    integer(8) :: values(:)
+    ! CHECK: %[[dateUnbox:.*]]:2 = fir.unboxchar %[[date]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[timeUnbox:.*]]:2 = fir.unboxchar %[[time]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[zoneUnbox:.*]]:2 = fir.unboxchar %[[zone]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[dateBuffer:.*]] = fir.convert %[[dateUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+    ! CHECK: %[[dateLen:.*]] = fir.convert %[[dateUnbox]]#1 : (index) -> i64
+    ! CHECK: %[[timeBuffer:.*]] = fir.convert %[[timeUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+    ! CHECK: %[[timeLen:.*]] = fir.convert %[[timeUnbox]]#1 : (index) -> i64
+    ! CHECK: %[[zoneBuffer:.*]] = fir.convert %[[zoneUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+    ! CHECK: %[[zoneLen:.*]] = fir.convert %[[zoneUnbox]]#1 : (index) -> i64
+    ! CHECK: %[[valuesCast:.*]] = fir.convert %[[values]] : (!fir.box<!fir.array<?xi64>>) -> !fir.box<none>
+    ! CHECK: fir.call @_FortranADateAndTime(%[[dateBuffer]], %[[dateLen]], %[[timeBuffer]], %[[timeLen]], %[[zoneBuffer]], %[[zoneLen]], %{{.*}}, %{{.*}}, %[[valuesCast]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i32, !fir.box<none>) -> none
+    call date_and_time(date, time, zone, values)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPdate_and_time_test2(
+  ! CHECK-SAME: %[[date:.*]]: !fir.boxchar<1>{{.*}})
+  subroutine date_and_time_test2(date)
+    character(*) :: date
+    ! CHECK: %[[dateUnbox:.*]]:2 = fir.unboxchar %[[date]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+    ! CHECK: %[[values:.*]] = fir.absent !fir.box<none> 
+    ! CHECK: %[[dateBuffer:.*]] = fir.convert %[[dateUnbox]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+    ! CHECK: %[[dateLen:.*]] = fir.convert %[[dateUnbox]]#1 : (index) -> i64
+    ! CHECK: %[[timeBuffer:.*]] = fir.convert %c0{{.*}} : (index) -> !fir.ref<i8>
+    ! CHECK: %[[timeLen:.*]] = fir.convert %c0{{.*}} : (index) -> i64
+    ! CHECK: %[[zoneBuffer:.*]] = fir.convert %c0{{.*}} : (index) -> !fir.ref<i8>
+    ! CHECK: %[[zoneLen:.*]] = fir.convert %c0{{.*}} : (index) -> i64
+    ! CHECK: fir.call @_FortranADateAndTime(%[[dateBuffer]], %[[dateLen]], %[[timeBuffer]], %[[timeLen]], %[[zoneBuffer]], %[[zoneLen]], %{{.*}}, %{{.*}}, %[[values]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i32, !fir.box<none>) -> none
+    call date_and_time(date)
+  end subroutine
+  
+  ! CHECK-LABEL: func @_QPdate_and_time_dynamic_optional(
+  ! CHECK-SAME:  %[[VAL_0:[^:]*]]: !fir.boxchar<1>
+  ! CHECK-SAME:  %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+  ! CHECK-SAME:  %[[VAL_2:.*]]: !fir.boxchar<1>
+  ! CHECK-SAME:  %[[VAL_3:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+  subroutine date_and_time_dynamic_optional(date, time, zone, values)
+    ! Nothing special is required for the pointer/optional characters (the null address will
+    ! directly be understood as meaning absent in the runtime). However, disassociated pointer
+    ! `values` need to be transformed into an absent fir.box (nullptr descriptor address).
+    character(*)  :: date
+    character(:), pointer :: time
+    character(*), optional :: zone
+    integer, pointer :: values(:)
+    call date_and_time(date, time, zone, values)
+  ! CHECK:  %[[VAL_4:.*]]:2 = fir.unboxchar %[[VAL_0]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  ! CHECK:  %[[VAL_5:.*]]:2 = fir.unboxchar %[[VAL_2]] : (!fir.boxchar<1>) -> (!fir.ref<!fir.char<1,?>>, index)
+  ! CHECK:  %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.char<1,?>>>>
+  ! CHECK:  %[[VAL_7:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> index
+  ! CHECK:  %[[VAL_8:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<!fir.ptr<!fir.char<1,?>>>) -> !fir.ptr<!fir.char<1,?>>
+  ! CHECK:  %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+  ! CHECK:  %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
+  ! CHECK:  %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.ptr<!fir.array<?xi32>>) -> i64
+  ! CHECK:  %[[VAL_12:.*]] = arith.constant 0 : i64
+  ! CHECK:  %[[VAL_13:.*]] = arith.cmpi ne, %[[VAL_11]], %[[VAL_12]] : i64
+  ! CHECK:  %[[VAL_14:.*]] = fir.load %[[VAL_3]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+    ! CHECK:  %[[VAL_15:.*]] = fir.absent !fir.box<!fir.ptr<!fir.array<?xi32>>>
+  ! CHECK:  %[[VAL_16:.*]] = arith.select %[[VAL_13]], %[[VAL_14]], %[[VAL_15]] : !fir.box<!fir.ptr<!fir.array<?xi32>>>
+  ! CHECK:  %[[VAL_19:.*]] = fir.convert %[[VAL_4]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+  ! CHECK:  %[[VAL_20:.*]] = fir.convert %[[VAL_4]]#1 : (index) -> i64
+  ! CHECK:  %[[VAL_21:.*]] = fir.convert %[[VAL_8]] : (!fir.ptr<!fir.char<1,?>>) -> !fir.ref<i8>
+  ! CHECK:  %[[VAL_22:.*]] = fir.convert %[[VAL_7]] : (index) -> i64
+  ! CHECK:  %[[VAL_23:.*]] = fir.convert %[[VAL_5]]#0 : (!fir.ref<!fir.char<1,?>>) -> !fir.ref<i8>
+  ! CHECK:  %[[VAL_24:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64
+  ! CHECK:  %[[VAL_26:.*]] = fir.convert %[[VAL_16]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.box<none>
+  ! CHECK:  %[[VAL_28:.*]] = fir.call @_FortranADateAndTime(%[[VAL_19]], %[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_24]], %{{.*}}, %{{.*}}, %[[VAL_26]]) : (!fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i64, !fir.ref<i8>, i32, !fir.box<none>) -> none
+  end subroutine