[flang] Implement DSECNDS intrinsic (PGI extension) (#157573)

Add support for DSECNDS, the double-precision variant of SECNDS. 
The implementation mirrors SECNDS, reusing the shared `SecndsImpl<T>`
runtime template.
Includes:
- Registration in intrinsics table
- Lowering handler and runtime call wiring
- Hook into shared SecndsImpl in extensions.cpp
- Documentation in Intrinsics.md
- Regression test dsecnds.f90

CC @eugeneepshteyn @klausler

---------

Co-authored-by: Eugene Epshteyn <eepshteyn@nvidia.com>
This commit is contained in:
Šárka Holendová
2025-09-14 12:30:31 -04:00
committed by GitHub
parent 1a65e63c59
commit 3e254ed904
9 changed files with 123 additions and 1 deletions

View File

@@ -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 <typename T> T SecndsImpl(T *refTime) {
static_assert(std::is_same<T, float>::value || std::is_same<T, double>::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); }

View File

@@ -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

View File

@@ -253,6 +253,8 @@ struct IntrinsicLibrary {
mlir::Value genCosd(mlir::Type, llvm::ArrayRef<mlir::Value>);
mlir::Value genCospi(mlir::Type, llvm::ArrayRef<mlir::Value>);
void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
fir::ExtendedValue genDsecnds(mlir::Type resultType,
llvm::ArrayRef<fir::ExtendedValue> args);
mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
fir::ExtendedValue genDotProduct(mlir::Type,
llvm::ArrayRef<fir::ExtendedValue>);

View File

@@ -44,6 +44,10 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
std::optional<fir::CharBoxValue> date,
std::optional<fir::CharBoxValue> time,
std::optional<fir::CharBoxValue> 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);

View File

@@ -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);

View File

@@ -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}},

View File

@@ -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<fir::ExtendedValue> 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<mlir::Value> args) {

View File

@@ -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<mkRTKey(Dsecnds)>(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<mlir::Value> 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<mkRTKey(Etime)>(loc, builder);

View File

@@ -0,0 +1,33 @@
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
! CHECK-LABEL: func.func @_QPuse_dsecnds(
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f64>
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.char<1,{{.*}}>>) -> !fir.ref<i8>
! 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<f64>, !fir.ref<i8>, i32) -> f64
! Ensure there is no illegal conversion of a value result into a reference
! CHECK-NOT: fir.convert {{.*}} : (f64) -> !fir.ref<f64>
! Confirm the function result is returned as a plain f64
! CHECK: return {{.*}} : f64