#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
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);
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
{{{"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,
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) {
#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"
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) {
--- /dev/null
+! 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
--- /dev/null
+! 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