diff --git a/flang-rt/lib/runtime/extensions.cpp b/flang-rt/lib/runtime/extensions.cpp index be0eed6f49dc8..2c42597a56541 100644 --- a/flang-rt/lib/runtime/extensions.cpp +++ b/flang-rt/lib/runtime/extensions.cpp @@ -60,7 +60,7 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time, namespace Fortran::runtime { -// Common implementation that could be used for either SECNDS() or SECNDSD(), +// Common implementation that could be used for either SECNDS() or DSECNDS(), // which are defined for float or double. template T SecndsImpl(T *refTime) { static_assert(std::is_same::value || std::is_same::value, @@ -381,6 +381,17 @@ float RTNAME(Secnds)(float *refTime, const char *sourceFile, int line) { return FORTRAN_PROCEDURE_NAME(secnds)(refTime); } +// PGI extension function DSECNDS(refTime) +double FORTRAN_PROCEDURE_NAME(dsecnds)(double *refTime) { + return SecndsImpl(refTime); +} + +double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line) { + Terminator terminator{sourceFile, line}; + RUNTIME_CHECK(terminator, refTime != nullptr); + return FORTRAN_PROCEDURE_NAME(dsecnds)(refTime); +} + // GNU extension function TIME() std::int64_t RTNAME(time)() { return time(nullptr); } diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md index 4b000877e7844..3314d1bcc64a2 100644 --- a/flang/docs/Intrinsics.md +++ b/flang/docs/Intrinsics.md @@ -1149,6 +1149,32 @@ PROGRAM example_secnds PRINT *, "Elapsed seconds:", elapsed END PROGRAM example_secnds ``` +### Non-Standard Intrinsics: DSECNDS +#### Description +`DSECNDS(refTime)` is the double precision variant of `SECNDS`. It returns the number of seconds +since midnight minus a user-supplied reference time `refTime`. Uses `REAL(KIND=8)` for higher precision. + +#### Usage and Info +- **Standard:** PGI extension +- **Class:** function +- **Syntax:** result = `DSECNDS(refTime)` +- **Arguments:** + +| ARGUMENT | INTENT | TYPE | KIND | Description | +|-----------|--------|---------------|-------------------------|------------------------------------------| +| `refTime` | `IN` | `REAL, scalar`| REAL(KIND=8), required | Reference time in seconds since midnight | + +- **Return Value:** REAL(KIND=8), scalar — seconds elapsed since `refTime`. +- **Purity:** Impure + +#### Example +```fortran +PROGRAM example_dsecnds + DOUBLE PRECISION :: refTime + refTime = 0.0D0 + PRINT '(F24.15)', DSECNDS(refTime) +END PROGRAM example_dsecnds +``` ### Non-standard Intrinsics: SECOND This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h index d80ee9e861321..320f913858956 100644 --- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h +++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h @@ -253,6 +253,8 @@ struct IntrinsicLibrary { mlir::Value genCosd(mlir::Type, llvm::ArrayRef); mlir::Value genCospi(mlir::Type, llvm::ArrayRef); void genDateAndTime(llvm::ArrayRef); + fir::ExtendedValue genDsecnds(mlir::Type resultType, + llvm::ArrayRef args); mlir::Value genDim(mlir::Type, llvm::ArrayRef); fir::ExtendedValue genDotProduct(mlir::Type, llvm::ArrayRef); diff --git a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h index 548ee4bb65818..7a97172cfbb9a 100644 --- a/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h +++ b/flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h @@ -44,6 +44,10 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location, std::optional date, std::optional time, std::optional zone, mlir::Value values); + +mlir::Value genDsecnds(fir::FirOpBuilder &builder, mlir::Location loc, + mlir::Value refTime); + void genEtime(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value values, mlir::Value time); diff --git a/flang/include/flang/Runtime/extensions.h b/flang/include/flang/Runtime/extensions.h index 9a100cec9e6b9..7e4201f15171f 100644 --- a/flang/include/flang/Runtime/extensions.h +++ b/flang/include/flang/Runtime/extensions.h @@ -28,6 +28,10 @@ typedef std::uint32_t gid_t; extern "C" { +// PGI extension function DSECNDS(refTime) +double FORTRAN_PROCEDURE_NAME(dsecnds)(double *refTime); +double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line); + // CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement. void FORTRAN_PROCEDURE_NAME(flush)(const int &unit); diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index abe53c31210d0..c7f174f7989dd 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -462,6 +462,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{ {"vector_b", AnyNumeric, Rank::vector}}, ResultNumeric, Rank::scalar, IntrinsicClass::transformationalFunction}, {"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision}, + {"dsecnds", + {{"refTime", TypePattern{RealType, KindCode::exactKind, 8}, + Rank::scalar}}, + TypePattern{RealType, KindCode::exactKind, 8}, Rank::scalar}, {"dshiftl", {{"i", SameIntOrUnsigned}, {"j", SameIntOrUnsigned, Rank::elementalOrBOZ}, {"shift", AnyInt}}, diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp index aa12dbff5935b..ce1376fd209cc 100644 --- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp +++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp @@ -455,6 +455,10 @@ static constexpr IntrinsicHandler handlers[]{ {{{"vector_a", asBox}, {"vector_b", asBox}}}, /*isElemental=*/false}, {"dprod", &I::genDprod}, + {"dsecnds", + &I::genDsecnds, + {{{"refTime", asAddr}}}, + /*isElemental=*/false}, {"dshiftl", &I::genDshiftl}, {"dshiftr", &I::genDshiftr}, {"eoshift", @@ -4048,6 +4052,23 @@ mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType, return mlir::arith::MulFOp::create(builder, loc, a, b); } +// DSECNDS +// Double precision variant of SECNDS (PGI extension) +fir::ExtendedValue +IntrinsicLibrary::genDsecnds(mlir::Type resultType, + llvm::ArrayRef args) { + assert(args.size() == 1 && "DSECNDS expects one argument"); + + mlir::Value refTime = fir::getBase(args[0]); + + if (!refTime) + fir::emitFatalError(loc, "expected REFERENCE TIME parameter"); + + mlir::Value result = fir::runtime::genDsecnds(builder, loc, refTime); + + return builder.createConvert(loc, resultType, result); +} + // DSHIFTL mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType, llvm::ArrayRef args) { diff --git a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp index dc61903ddd369..110b1b20898c7 100644 --- a/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp +++ b/flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp @@ -106,6 +106,23 @@ void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder, fir::CallOp::create(builder, loc, callee, args); } +mlir::Value fir::runtime::genDsecnds(fir::FirOpBuilder &builder, + mlir::Location loc, mlir::Value refTime) { + auto runtimeFunc = + fir::runtime::getRuntimeFunc(loc, builder); + + mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType(); + + mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc); + mlir::Value sourceLine = + fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2)); + + llvm::SmallVector args = {refTime, sourceFile, sourceLine}; + args = fir::runtime::createArguments(builder, loc, runtimeFuncTy, args); + + return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0); +} + void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc, mlir::Value values, mlir::Value time) { auto runtimeFunc = fir::runtime::getRuntimeFunc(loc, builder); diff --git a/flang/test/Lower/Intrinsics/dsecnds.f90 b/flang/test/Lower/Intrinsics/dsecnds.f90 new file mode 100644 index 0000000000000..03814ff60bd80 --- /dev/null +++ b/flang/test/Lower/Intrinsics/dsecnds.f90 @@ -0,0 +1,33 @@ +! RUN: bbc -emit-hlfir %s -o - | FileCheck %s + +! CHECK-LABEL: func.func @_QPuse_dsecnds( +! CHECK-SAME: %[[arg0:.*]]: !fir.ref +function use_dsecnds(refTime) result(elapsed) + double precision :: refTime, elapsed + elapsed = dsecnds(refTime) +end function + +! The argument is lowered with hlfir.declare, which returns two results. +! Capture it here to check that the correct SSA value (%...#0) +! is passed to the runtime call later +! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[arg0]] dummy_scope + +! The file name and source line are also lowered and passed as runtime arguments +! Capture the constant line number and convert the file name to i8*. +! CHECK: %[[STRADDR:.*]] = fir.address_of( +! CHECK: %[[LINE:.*]] = arith.constant {{.*}} : i32 +! CHECK: %[[FNAME8:.*]] = fir.convert %[[STRADDR]] : (!fir.ref>) -> !fir.ref + +! Verify the runtime call is made with: +! - the declared refTime value (%[[DECL]]#0) +! - the converted filename +! - the source line constant +! CHECK: %[[CALL:.*]] = fir.call @_FortranADsecnds(%[[DECL]]#0, %[[FNAME8]], %[[LINE]]) {{.*}} : (!fir.ref, !fir.ref, i32) -> f64 + +! Ensure there is no illegal conversion of a value result into a reference +! CHECK-NOT: fir.convert {{.*}} : (f64) -> !fir.ref + +! Confirm the function result is returned as a plain f64 +! CHECK: return {{.*}} : f64 + +