Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 29 additions & 2 deletions dist/Time-HiRes/HiRes.pm
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ our @EXPORT = qw( );
# More or less this same list is in Makefile.PL. Should unify.
our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
getitimer setitimer nanosleep clock_gettime clock_getres
clock clock_nanosleep
clock clock_nanosleep hrtime
CLOCKS_PER_SEC
CLOCK_BOOTTIME
CLOCK_HIGHRES
Expand Down Expand Up @@ -45,7 +45,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval
TIMER_ABSTIME
d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep d_clock_gettime d_clock_getres
d_clock d_clock_nanosleep d_hires_stat
d_clock d_clock_nanosleep d_hrtime d_hires_stat
d_futimens d_utimensat d_hires_utime
stat lstat utime
);
Expand Down Expand Up @@ -82,6 +82,7 @@ sub import {
($i eq 'nanosleep' && !&d_nanosleep) ||
($i eq 'usleep' && !&d_usleep) ||
($i eq 'utime' && !&d_hires_utime) ||
($i eq 'hrtime' && !&d_hrtime) ||
($i eq 'ualarm' && !&d_ualarm)) {
require Carp;
Carp::croak("Time::HiRes::$i(): unimplemented in this platform");
Expand Down Expand Up @@ -153,6 +154,11 @@ Time::HiRes - High resolution alarm, sleep, gettimeofday, interval timers

my $ticktock = clock();

use Time::HiRes qw( hrtime );

my $nanoseconds = hrtime();
my ($seconds, $nanosec) = hrtime(1);

use Time::HiRes qw( stat lstat );

my @stat = stat("file");
Expand Down Expand Up @@ -429,6 +435,27 @@ but not necessarily identical. Note that due to backward
compatibility limitations the returned value may wrap around at about
2147 seconds or at about 36 minutes.

=item hrtime ()

=item hrtime ($as_array)

Returns a 64-bit unsigned integer representing the value of the
CLOCK_MONOTONIC clock in nanoseconds. When called with a true
argument, returns a two-element array of (seconds, nanoseconds)
from the same clock.

This is a monotonic clock, meaning that it is unaffected by system
clock adjustments. The reference epoch of this clock is not
specified, so only I<differences> between hrtime() values are
meaningful.

On 64bit systems the counter will roll after 584 years. On 32bit
systems the counter will roll after ~4.2 seconds.

This function was added in Time::HiRes 1.9780 and requires a
system that supports clock_gettime() (i.e., a POSIX-like system
or equivalent).

=item stat

=item stat FH
Expand Down
36 changes: 36 additions & 0 deletions dist/Time-HiRes/HiRes.xs
Original file line number Diff line number Diff line change
Expand Up @@ -1409,6 +1409,42 @@ clock_gettime(clock_id = 0)

#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */

#if defined(TIME_HIRES_CLOCK_GETTIME)

void
hrtime(as_array = 0)
bool as_array

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This argument is illogical in the Perl 5 language and shows zero knowledge of Perl coding.

Either call PP wantarray or C GIMME_V to learn this information the PP Grammar correct way.

PREINIT:
struct timespec ts;
int status;
PPCODE:
# ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
status = syscall(SYS_clock_gettime, CLOCK_MONOTONIC, &ts);
# else
status = clock_gettime(CLOCK_MONOTONIC, &ts);
# endif
if (status != 0)
XSRETURN_EMPTY;

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

XSRETURN_EMPTY should not be used in a PPCODE: block. XSRETURN_FOOs are intended for CODE: blocks where local nor global SP has never been rewound to zero, or the validity/non-SEGV Ness of local var SP is unknown, such as in EU::PXS codegen blocks that can not determine if call_sv() indirectly ever got executed in the body of a XSUB thus causing a possible Perl stack realloc grow event, and the end dev was sloppy or careless in writing SPAGAIN in the correct locations. PPCODE: puts a XSprePuSH: in the codegen at the top, rewinding local SP to 0. "PUTBACK; return;" is all that is needed to return an empty list in a PPCODE block.

if (as_array) {
EXTEND(sp, 2);
PUSHs(sv_2mortal(newSViv(ts.tv_sec)));
PUSHs(sv_2mortal(newSViv(ts.tv_nsec)));
} else {
EXTEND(sp, 1);

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Eliminate EXTEND 1, it's not needed, all XSUBs are guaranteed 1 slot on PL_stack_sp bc pp_entersub removes 1 SV* from the stack to invoke your CV*. The alternative is to do EXTEND 2 on all paths, the Perl stack is incapable of shrinking for the life of the process. If 8 bytes of malloc() space is the difference between the kernel OOM killing Perl and a successful app run, there r much bigger problems going on. It's not worth the code space or CPU wall Time to bother branching between bounds check of 1 and 2. just do 2 always, or check for 2 on the list return path and no check on scalar return path.

PUSHs(sv_2mortal(newSVuv((UV)ts.tv_sec * (UV)IV_1E9 + (UV)ts.tv_nsec)));
}

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What if UV is size 32bits such as on i386 Perl? You might want type U64 math here or throw a C syntax error. Truncate to 32 bits 3 times silently is a bad idea here if all 3 inputs are size 64b. Even Visual C 6.0 can be beaten with a heavy stick to cough up support for types U64 and I64 .


#else /* if defined(TIME_HIRES_CLOCK_GETTIME) */

void
hrtime(as_array = 0)
bool as_array
PPCODE:
PERL_UNUSED_ARG(as_array);
croak("Time::HiRes::hrtime(): unimplemented in this platform");

Copy link
Copy Markdown
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

     croak("Time::HiRes::hrtime(): unimplemented in this platform");

Replace with "%s" and Split off string "Time::HiRes::hrtime" into arg 1 of croak(), nobody needs ASCII string "Time::HiRes::hrtime" to appear twice in the .so/.dll file.


#endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */

#if defined(TIME_HIRES_CLOCK_GETRES)

NV
Expand Down
7 changes: 6 additions & 1 deletion dist/Time-HiRes/Makefile.PL
Original file line number Diff line number Diff line change
Expand Up @@ -984,7 +984,7 @@ sub doConstants {
);
foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
d_nanosleep d_clock_gettime d_clock_getres
d_clock d_clock_nanosleep d_hires_stat
d_clock d_clock_nanosleep d_hrtime d_hires_stat
d_futimens d_utimensat d_hires_utime)) {
my $macro = $_;
if ($macro =~ /^(d_nanosleep|d_clock)$/) {
Expand All @@ -1003,6 +1003,11 @@ sub doConstants {
push @names, {name => $_, macro => "TIME_HIRES_UTIME", value => $d_hires_utime,
default => ["IV", "0"]};
next;
} elsif ($macro =~ /^d_hrtime$/) {
my $d_hrtime = ($DEFINE =~ /-DTIME_HIRES_CLOCK_GETTIME\b/) ? 1 : 0;
push @names, {name => $_, macro => "TIME_HIRES_CLOCK_GETTIME", value => $d_hrtime,
default => ["IV", "0"]};
next;
} elsif ($macro =~ /^(d_clock_gettime|d_clock_getres|d_clock_nanosleep)$/) {
$macro =~ s/^d_(.+)/TIME_HIRES_\U$1/;
my $val = ($DEFINE =~ /-D$macro\b/) ? 1 : 0;
Expand Down
14 changes: 13 additions & 1 deletion dist/Time-HiRes/t/clock.t
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
use strict;

use Test::More tests => 5;
use Test::More tests => 6;
BEGIN { push @INC, '.' }
use t::Watchdog;

Expand All @@ -18,6 +18,7 @@ printf("# have_clock_gettime = %d\n", &Time::HiRes::d_clock_gettime);
printf("# have_clock_getres = %d\n", &Time::HiRes::d_clock_getres);
printf("# have_clock_nanosleep = %d\n", &Time::HiRes::d_clock_nanosleep);
printf("# have_clock = %d\n", &Time::HiRes::d_clock);
printf("# have_hrtime = %d\n", &Time::HiRes::d_hrtime);

# Ideally, we'd like to test that the timers are rather precise.
# However, if the system is busy, there are no guarantees on how
Expand Down Expand Up @@ -97,3 +98,14 @@ SKIP: {
$clock[2] > $clock[1] &&
$clock[3] > $clock[2];
}

SKIP: {
skip "no hrtime", 1 unless &Time::HiRes::d_hrtime;
my @got = Time::HiRes::hrtime(1);
my $ok = @got == 2
&& $got[0] >= 0
&& $got[1] >= 0
&& $got[1] < 1_000_000_000;
ok $ok
or print("# got: @got, size: " . scalar(@got) . "\n");
}
Loading