diff --git a/flang/include/flang/Lower/Runtime.h b/flang/include/flang/Lower/Runtime.h index 0f6f1e684b0ca..fa1bfaa8578c6 100644 --- a/flang/include/flang/Lower/Runtime.h +++ b/flang/include/flang/Lower/Runtime.h @@ -16,12 +16,18 @@ #ifndef FORTRAN_LOWER_RUNTIME_H #define FORTRAN_LOWER_RUNTIME_H +namespace llvm { +template +class Optional; +} + namespace mlir { class Location; class Value; } // namespace mlir namespace fir { +class CharBoxValue; class FirOpBuilder; } // namespace fir @@ -63,6 +69,12 @@ 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 date, + llvm::Optional time, + llvm::Optional 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); diff --git a/flang/lib/Lower/IntrinsicCall.cpp b/flang/lib/Lower/IntrinsicCall.cpp index b04224e910c4a..196ed24d1c257 100644 --- a/flang/lib/Lower/IntrinsicCall.cpp +++ b/flang/lib/Lower/IntrinsicCall.cpp @@ -441,6 +441,8 @@ struct IntrinsicLibrary { template fir::ExtendedValue genCharacterCompare(mlir::Type, llvm::ArrayRef); + void genCpuTime(llvm::ArrayRef); + void genDateAndTime(llvm::ArrayRef); template mlir::Value genExtremum(mlir::Type, llvm::ArrayRef); /// Lowering for the IAND intrinsic. The IAND intrinsic expects two arguments @@ -574,6 +576,17 @@ static constexpr IntrinsicHandler handlers[]{ {{{"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, @@ -1602,6 +1615,34 @@ IntrinsicLibrary::genDotProduct(mlir::Type resultType, stmtCtx, args); } +// CPU_TIME +void IntrinsicLibrary::genCpuTime(llvm::ArrayRef 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(loc, res2, *arg); +} + +// DATE_AND_TIME +void IntrinsicLibrary::genDateAndTime(llvm::ArrayRef args) { + assert(args.size() == 4 && "date_and_time has 4 args"); + llvm::SmallVector> 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( + 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 args) { diff --git a/flang/lib/Lower/Runtime.cpp b/flang/lib/Lower/Runtime.cpp index ea42c91378679..a6507e15bbf20 100644 --- a/flang/lib/Lower/Runtime.cpp +++ b/flang/lib/Lower/Runtime.cpp @@ -16,6 +16,7 @@ #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" @@ -127,6 +128,56 @@ mlir::Value Fortran::lower::genAssociated(fir::FirOpBuilder &builder, return builder.create(loc, func, args).getResult(0); } +mlir::Value Fortran::lower::genCpuTime(fir::FirOpBuilder &builder, + mlir::Location loc) { + mlir::FuncOp func = + fir::runtime::getRuntimeFunc(loc, builder); + return builder.create(loc, func, llvm::None).getResult(0); +} + +void Fortran::lower::genDateAndTime(fir::FirOpBuilder &builder, + mlir::Location loc, + llvm::Optional date, + llvm::Optional time, + llvm::Optional zone, + mlir::Value values) { + mlir::FuncOp callee = + fir::runtime::getRuntimeFunc(loc, builder); + mlir::FunctionType funcTy = callee.getType(); + mlir::Type idxTy = builder.getIndexType(); + mlir::Value zero; + auto splitArg = [&](llvm::Optional 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 args = fir::runtime::createArguments( + builder, loc, funcTy, dateBuffer, dateLen, timeBuffer, timeLen, + zoneBuffer, zoneLen, sourceFile, sourceLine, values); + builder.create(loc, callee, args); +} + void Fortran::lower::genRandomInit(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value repeatable, mlir::Value imageDistinct) { diff --git a/flang/test/Lower/Intrinsics/cpu_time.f90 b/flang/test/Lower/Intrinsics/cpu_time.f90 new file mode 100644 index 0000000000000..1bcd08755b60c --- /dev/null +++ b/flang/test/Lower/Intrinsics/cpu_time.f90 @@ -0,0 +1,11 @@ +! 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 + call cpu_time(t) + end subroutine + \ No newline at end of file diff --git a/flang/test/Lower/Intrinsics/date_and_time.f90 b/flang/test/Lower/Intrinsics/date_and_time.f90 new file mode 100644 index 0000000000000..533bbc10ae9a6 --- /dev/null +++ b/flang/test/Lower/Intrinsics/date_and_time.f90 @@ -0,0 +1,73 @@ +! 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>{{.*}}) { +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>, index) + ! CHECK: %[[timeUnbox:.*]]:2 = fir.unboxchar %[[time]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[zoneUnbox:.*]]:2 = fir.unboxchar %[[zone]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[dateBuffer:.*]] = fir.convert %[[dateUnbox]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[dateLen:.*]] = fir.convert %[[dateUnbox]]#1 : (index) -> i64 + ! CHECK: %[[timeBuffer:.*]] = fir.convert %[[timeUnbox]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[timeLen:.*]] = fir.convert %[[timeUnbox]]#1 : (index) -> i64 + ! CHECK: %[[zoneBuffer:.*]] = fir.convert %[[zoneUnbox]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[zoneLen:.*]] = fir.convert %[[zoneUnbox]]#1 : (index) -> i64 + ! CHECK: %[[valuesCast:.*]] = fir.convert %[[values]] : (!fir.box>) -> !fir.box + ! CHECK: fir.call @_FortranADateAndTime(%[[dateBuffer]], %[[dateLen]], %[[timeBuffer]], %[[timeLen]], %[[zoneBuffer]], %[[zoneLen]], %{{.*}}, %{{.*}}, %[[valuesCast]]) : (!fir.ref, i64, !fir.ref, i64, !fir.ref, i64, !fir.ref, i32, !fir.box) -> 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>, index) + ! CHECK: %[[values:.*]] = fir.absent !fir.box + ! CHECK: %[[dateBuffer:.*]] = fir.convert %[[dateUnbox]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[dateLen:.*]] = fir.convert %[[dateUnbox]]#1 : (index) -> i64 + ! CHECK: %[[timeBuffer:.*]] = fir.convert %c0{{.*}} : (index) -> !fir.ref + ! CHECK: %[[timeLen:.*]] = fir.convert %c0{{.*}} : (index) -> i64 + ! CHECK: %[[zoneBuffer:.*]] = fir.convert %c0{{.*}} : (index) -> !fir.ref + ! CHECK: %[[zoneLen:.*]] = fir.convert %c0{{.*}} : (index) -> i64 + ! CHECK: fir.call @_FortranADateAndTime(%[[dateBuffer]], %[[dateLen]], %[[timeBuffer]], %[[timeLen]], %[[zoneBuffer]], %[[zoneLen]], %{{.*}}, %{{.*}}, %[[values]]) : (!fir.ref, i64, !fir.ref, i64, !fir.ref, i64, !fir.ref, i32, !fir.box) -> 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>>> + ! CHECK-SAME: %[[VAL_2:.*]]: !fir.boxchar<1> + ! CHECK-SAME: %[[VAL_3:.*]]: !fir.ref>>> + 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>, index) + ! CHECK: %[[VAL_5:.*]]:2 = fir.unboxchar %[[VAL_2]] : (!fir.boxchar<1>) -> (!fir.ref>, index) + ! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_1]] : !fir.ref>>> + ! CHECK: %[[VAL_7:.*]] = fir.box_elesize %[[VAL_6]] : (!fir.box>>) -> index + ! CHECK: %[[VAL_8:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[VAL_9:.*]] = fir.load %[[VAL_3]] : !fir.ref>>> + ! CHECK: %[[VAL_10:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box>>) -> !fir.ptr> + ! CHECK: %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.ptr>) -> 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>>> + ! CHECK: %[[VAL_15:.*]] = fir.absent !fir.box>> + ! CHECK: %[[VAL_16:.*]] = arith.select %[[VAL_13]], %[[VAL_14]], %[[VAL_15]] : !fir.box>> + ! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_4]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_20:.*]] = fir.convert %[[VAL_4]]#1 : (index) -> i64 + ! CHECK: %[[VAL_21:.*]] = fir.convert %[[VAL_8]] : (!fir.ptr>) -> !fir.ref + ! CHECK: %[[VAL_22:.*]] = fir.convert %[[VAL_7]] : (index) -> i64 + ! CHECK: %[[VAL_23:.*]] = fir.convert %[[VAL_5]]#0 : (!fir.ref>) -> !fir.ref + ! CHECK: %[[VAL_24:.*]] = fir.convert %[[VAL_5]]#1 : (index) -> i64 + ! CHECK: %[[VAL_26:.*]] = fir.convert %[[VAL_16]] : (!fir.box>>) -> !fir.box + ! CHECK: %[[VAL_28:.*]] = fir.call @_FortranADateAndTime(%[[VAL_19]], %[[VAL_20]], %[[VAL_21]], %[[VAL_22]], %[[VAL_23]], %[[VAL_24]], %{{.*}}, %{{.*}}, %[[VAL_26]]) : (!fir.ref, i64, !fir.ref, i64, !fir.ref, i64, !fir.ref, i32, !fir.box) -> none + end subroutine