Skip to content

Commit 3e254ed

Browse files
[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 <[email protected]>
1 parent 1a65e63 commit 3e254ed

File tree

9 files changed

+123
-1
lines changed

9 files changed

+123
-1
lines changed

flang-rt/lib/runtime/extensions.cpp

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,7 @@ inline void CtimeBuffer(char *buffer, size_t bufsize, const time_t cur_time,
6060

6161
namespace Fortran::runtime {
6262

63-
// Common implementation that could be used for either SECNDS() or SECNDSD(),
63+
// Common implementation that could be used for either SECNDS() or DSECNDS(),
6464
// which are defined for float or double.
6565
template <typename T> T SecndsImpl(T *refTime) {
6666
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) {
381381
return FORTRAN_PROCEDURE_NAME(secnds)(refTime);
382382
}
383383

384+
// PGI extension function DSECNDS(refTime)
385+
double FORTRAN_PROCEDURE_NAME(dsecnds)(double *refTime) {
386+
return SecndsImpl(refTime);
387+
}
388+
389+
double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line) {
390+
Terminator terminator{sourceFile, line};
391+
RUNTIME_CHECK(terminator, refTime != nullptr);
392+
return FORTRAN_PROCEDURE_NAME(dsecnds)(refTime);
393+
}
394+
384395
// GNU extension function TIME()
385396
std::int64_t RTNAME(time)() { return time(nullptr); }
386397

flang/docs/Intrinsics.md

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1149,6 +1149,32 @@ PROGRAM example_secnds
11491149
PRINT *, "Elapsed seconds:", elapsed
11501150
END PROGRAM example_secnds
11511151
```
1152+
### Non-Standard Intrinsics: DSECNDS
1153+
#### Description
1154+
`DSECNDS(refTime)` is the double precision variant of `SECNDS`. It returns the number of seconds
1155+
since midnight minus a user-supplied reference time `refTime`. Uses `REAL(KIND=8)` for higher precision.
1156+
1157+
#### Usage and Info
1158+
- **Standard:** PGI extension
1159+
- **Class:** function
1160+
- **Syntax:** result = `DSECNDS(refTime)`
1161+
- **Arguments:**
1162+
1163+
| ARGUMENT | INTENT | TYPE | KIND | Description |
1164+
|-----------|--------|---------------|-------------------------|------------------------------------------|
1165+
| `refTime` | `IN` | `REAL, scalar`| REAL(KIND=8), required | Reference time in seconds since midnight |
1166+
1167+
- **Return Value:** REAL(KIND=8), scalar — seconds elapsed since `refTime`.
1168+
- **Purity:** Impure
1169+
1170+
#### Example
1171+
```fortran
1172+
PROGRAM example_dsecnds
1173+
DOUBLE PRECISION :: refTime
1174+
refTime = 0.0D0
1175+
PRINT '(F24.15)', DSECNDS(refTime)
1176+
END PROGRAM example_dsecnds
1177+
```
11521178

11531179
### Non-standard Intrinsics: SECOND
11541180
This intrinsic is an alias for `CPU_TIME`: supporting both a subroutine and a

flang/include/flang/Optimizer/Builder/IntrinsicCall.h

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -253,6 +253,8 @@ struct IntrinsicLibrary {
253253
mlir::Value genCosd(mlir::Type, llvm::ArrayRef<mlir::Value>);
254254
mlir::Value genCospi(mlir::Type, llvm::ArrayRef<mlir::Value>);
255255
void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
256+
fir::ExtendedValue genDsecnds(mlir::Type resultType,
257+
llvm::ArrayRef<fir::ExtendedValue> args);
256258
mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
257259
fir::ExtendedValue genDotProduct(mlir::Type,
258260
llvm::ArrayRef<fir::ExtendedValue>);

flang/include/flang/Optimizer/Builder/Runtime/Intrinsics.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,10 @@ void genDateAndTime(fir::FirOpBuilder &, mlir::Location,
4444
std::optional<fir::CharBoxValue> date,
4545
std::optional<fir::CharBoxValue> time,
4646
std::optional<fir::CharBoxValue> zone, mlir::Value values);
47+
48+
mlir::Value genDsecnds(fir::FirOpBuilder &builder, mlir::Location loc,
49+
mlir::Value refTime);
50+
4751
void genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
4852
mlir::Value values, mlir::Value time);
4953

flang/include/flang/Runtime/extensions.h

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,10 @@ typedef std::uint32_t gid_t;
2828

2929
extern "C" {
3030

31+
// PGI extension function DSECNDS(refTime)
32+
double FORTRAN_PROCEDURE_NAME(dsecnds)(double *refTime);
33+
double RTNAME(Dsecnds)(double *refTime, const char *sourceFile, int line);
34+
3135
// CALL FLUSH(n) antedates the Fortran 2003 FLUSH statement.
3236
void FORTRAN_PROCEDURE_NAME(flush)(const int &unit);
3337

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -462,6 +462,10 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
462462
{"vector_b", AnyNumeric, Rank::vector}},
463463
ResultNumeric, Rank::scalar, IntrinsicClass::transformationalFunction},
464464
{"dprod", {{"x", DefaultReal}, {"y", DefaultReal}}, DoublePrecision},
465+
{"dsecnds",
466+
{{"refTime", TypePattern{RealType, KindCode::exactKind, 8},
467+
Rank::scalar}},
468+
TypePattern{RealType, KindCode::exactKind, 8}, Rank::scalar},
465469
{"dshiftl",
466470
{{"i", SameIntOrUnsigned},
467471
{"j", SameIntOrUnsigned, Rank::elementalOrBOZ}, {"shift", AnyInt}},

flang/lib/Optimizer/Builder/IntrinsicCall.cpp

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -455,6 +455,10 @@ static constexpr IntrinsicHandler handlers[]{
455455
{{{"vector_a", asBox}, {"vector_b", asBox}}},
456456
/*isElemental=*/false},
457457
{"dprod", &I::genDprod},
458+
{"dsecnds",
459+
&I::genDsecnds,
460+
{{{"refTime", asAddr}}},
461+
/*isElemental=*/false},
458462
{"dshiftl", &I::genDshiftl},
459463
{"dshiftr", &I::genDshiftr},
460464
{"eoshift",
@@ -4048,6 +4052,23 @@ mlir::Value IntrinsicLibrary::genDprod(mlir::Type resultType,
40484052
return mlir::arith::MulFOp::create(builder, loc, a, b);
40494053
}
40504054

4055+
// DSECNDS
4056+
// Double precision variant of SECNDS (PGI extension)
4057+
fir::ExtendedValue
4058+
IntrinsicLibrary::genDsecnds(mlir::Type resultType,
4059+
llvm::ArrayRef<fir::ExtendedValue> args) {
4060+
assert(args.size() == 1 && "DSECNDS expects one argument");
4061+
4062+
mlir::Value refTime = fir::getBase(args[0]);
4063+
4064+
if (!refTime)
4065+
fir::emitFatalError(loc, "expected REFERENCE TIME parameter");
4066+
4067+
mlir::Value result = fir::runtime::genDsecnds(builder, loc, refTime);
4068+
4069+
return builder.createConvert(loc, resultType, result);
4070+
}
4071+
40514072
// DSHIFTL
40524073
mlir::Value IntrinsicLibrary::genDshiftl(mlir::Type resultType,
40534074
llvm::ArrayRef<mlir::Value> args) {

flang/lib/Optimizer/Builder/Runtime/Intrinsics.cpp

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,23 @@ void fir::runtime::genDateAndTime(fir::FirOpBuilder &builder,
106106
fir::CallOp::create(builder, loc, callee, args);
107107
}
108108

109+
mlir::Value fir::runtime::genDsecnds(fir::FirOpBuilder &builder,
110+
mlir::Location loc, mlir::Value refTime) {
111+
auto runtimeFunc =
112+
fir::runtime::getRuntimeFunc<mkRTKey(Dsecnds)>(loc, builder);
113+
114+
mlir::FunctionType runtimeFuncTy = runtimeFunc.getFunctionType();
115+
116+
mlir::Value sourceFile = fir::factory::locationToFilename(builder, loc);
117+
mlir::Value sourceLine =
118+
fir::factory::locationToLineNo(builder, loc, runtimeFuncTy.getInput(2));
119+
120+
llvm::SmallVector<mlir::Value> args = {refTime, sourceFile, sourceLine};
121+
args = fir::runtime::createArguments(builder, loc, runtimeFuncTy, args);
122+
123+
return fir::CallOp::create(builder, loc, runtimeFunc, args).getResult(0);
124+
}
125+
109126
void fir::runtime::genEtime(fir::FirOpBuilder &builder, mlir::Location loc,
110127
mlir::Value values, mlir::Value time) {
111128
auto runtimeFunc = fir::runtime::getRuntimeFunc<mkRTKey(Etime)>(loc, builder);
Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
2+
3+
! CHECK-LABEL: func.func @_QPuse_dsecnds(
4+
! CHECK-SAME: %[[arg0:.*]]: !fir.ref<f64>
5+
function use_dsecnds(refTime) result(elapsed)
6+
double precision :: refTime, elapsed
7+
elapsed = dsecnds(refTime)
8+
end function
9+
10+
! The argument is lowered with hlfir.declare, which returns two results.
11+
! Capture it here to check that the correct SSA value (%...#0)
12+
! is passed to the runtime call later
13+
! CHECK: %[[DECL:.*]]:2 = hlfir.declare %[[arg0]] dummy_scope
14+
15+
! The file name and source line are also lowered and passed as runtime arguments
16+
! Capture the constant line number and convert the file name to i8*.
17+
! CHECK: %[[STRADDR:.*]] = fir.address_of(
18+
! CHECK: %[[LINE:.*]] = arith.constant {{.*}} : i32
19+
! CHECK: %[[FNAME8:.*]] = fir.convert %[[STRADDR]] : (!fir.ref<!fir.char<1,{{.*}}>>) -> !fir.ref<i8>
20+
21+
! Verify the runtime call is made with:
22+
! - the declared refTime value (%[[DECL]]#0)
23+
! - the converted filename
24+
! - the source line constant
25+
! CHECK: %[[CALL:.*]] = fir.call @_FortranADsecnds(%[[DECL]]#0, %[[FNAME8]], %[[LINE]]) {{.*}} : (!fir.ref<f64>, !fir.ref<i8>, i32) -> f64
26+
27+
! Ensure there is no illegal conversion of a value result into a reference
28+
! CHECK-NOT: fir.convert {{.*}} : (f64) -> !fir.ref<f64>
29+
30+
! Confirm the function result is returned as a plain f64
31+
! CHECK: return {{.*}} : f64
32+
33+

0 commit comments

Comments
 (0)