ext/Time/HiRes/hints/dec_osf.pl Hint for Time::HiRes for named architecture
ext/Time/HiRes/hints/dynixptx.pl Hint for Time::HiRes for named architecture
ext/Time/HiRes/hints/irix.pl Hint for Time::HiRes for named architecture
+ext/Time/HiRes/hints/linux.pl Hints for Time::HiRes for named architecture
ext/Time/HiRes/hints/sco.pl Hints for Time::HiRes for named architecture
ext/Time/HiRes/hints/solaris.pl Hints for Time::HiRes for named architecture
ext/Time/HiRes/hints/svr4.pl Hints for Time::HiRes for named architecture
Revision history for the Perl extension Time::HiRes.
+1.9705 [2007-02-06]
+ - nanosleep() and clock_nanosleep() detection and use were
+ quite broken; in Linux -lrt needed; fixes from Zefram
+ - [internal] slightly cleaner building of $DEFINE in Makefile.PL,
+ should avoid double/conflicting -D flags
+
1.9704 [2007-01-01]
- allow 10% of slop in test #14 (testing difference between
CORE::time() and Time::HiRes::time()), there seem to be often
stat
);
-$VERSION = '1.9704';
+$VERSION = '1.9705';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
$realtime = clock_gettime(CLOCK_REALTIME);
$resolution = clock_getres(CLOCK_REALTIME);
- clock_nanosleep(CLOCK_REALTIME, 1.5);
- clock_nanosleep(CLOCK_REALTIME, time() + 10, TIMER_ABSTIME);
+ clock_nanosleep(CLOCK_REALTIME, 1.5e9);
+ clock_nanosleep(CLOCK_REALTIME, time()*1e9 + 10e9, TIMER_ABSTIME);
my $ticktock = clock();
resolution timers are supposed to support at least the C<$which> value
of C<CLOCK_REALTIME>, see L</clock_gettime>.
-=item clock_nanosleep ( $which, $seconds, $flags = 0)
+=item clock_nanosleep ( $which, $nanoseconds, $flags = 0)
-Sleeps for the number of seconds (1e9ths of a second) specified.
-Returns the number of seconds actually slept. The $which is the
+Sleeps for the number of nanoseconds (1e9ths of a second) specified.
+Returns the number of nanoseconds actually slept. The $which is the
"clock id", as with clock_gettime() and clock_getres(). The flags
default to zero but C<TIMER_ABSTIME> can specified (must be exported
explicitly) which means that C<$nanoseconds> is not a time interval
nanosleep(nsec)
NV nsec
PREINIT:
- int status = -1;
- struct timeval Ta, Tb;
+ struct timespec sleepfor, unslept;
CODE:
- gettimeofday(&Ta, NULL);
- if (items > 0) {
- struct timespec ts1;
- if (nsec > 1E9) {
- IV sec = (IV) (nsec / 1E9);
- if (sec) {
- sleep(sec);
- nsec -= 1E9 * sec;
- }
- } else if (nsec < 0.0)
- croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
- ts1.tv_sec = (IV) (nsec / 1E9);
- ts1.tv_nsec = (IV) nsec - (IV) (ts1.tv_sec * NV_1E9);
- status = nanosleep(&ts1, NULL);
+ if (nsec < 0.0)
+ croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
+ sleepfor.tv_sec = nsec / 1e9;
+ sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+ if (!nanosleep(&sleepfor, &unslept)) {
+ RETVAL = nsec;
} else {
- PerlProc_pause();
- status = 0;
+ sleepfor.tv_sec -= unslept.tv_sec;
+ sleepfor.tv_nsec -= unslept.tv_nsec;
+ if (sleepfor.tv_nsec < 0) {
+ sleepfor.tv_sec--;
+ sleepfor.tv_nsec += 1000000000;
+ }
+ RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
}
- gettimeofday(&Tb, NULL);
- RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
- OUTPUT:
+ OUTPUT:
RETVAL
#else /* #if defined(TIME_HIRES_NANOSLEEP) */
#if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
NV
-clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0)
+clock_nanosleep(clock_id, nsec, flags = 0)
int clock_id
- NV sec
+ NV nsec
int flags
PREINIT:
- int status = -1;
- struct timespec ts;
- struct timeval Ta, Tb;
+ struct timespec sleepfor, unslept;
CODE:
- gettimeofday(&Ta, NULL);
- if (items > 1) {
- ts.tv_sec = (IV) sec;
- ts.tv_nsec = (sec - (NV) ts.tv_sec) * (NV) 1E9;
- status = clock_nanosleep(clock_id, flags, &ts, NULL);
+ if (nsec < 0.0)
+ croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec);
+ sleepfor.tv_sec = nsec / 1e9;
+ sleepfor.tv_nsec = nsec - ((NV)sleepfor.tv_sec) * 1e9;
+ if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) {
+ RETVAL = nsec;
} else {
- PerlProc_pause();
- status = 0;
+ sleepfor.tv_sec -= unslept.tv_sec;
+ sleepfor.tv_nsec -= unslept.tv_nsec;
+ if (sleepfor.tv_nsec < 0) {
+ sleepfor.tv_sec--;
+ sleepfor.tv_nsec += 1000000000;
+ }
+ RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
}
- gettimeofday(&Tb, NULL);
- RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
-
OUTPUT:
RETVAL
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
+#include <time.h>
int main(int argc, char** argv)
{
int ret;
- struct timerspec ts1;
- struct timerspec ts2;
+ struct timespec ts1;
+ struct timespec ts2;
ts1.tv_sec = 0;
ts1.tv_nsec = 750000000;;
ret = clock_nanosleep(CLOCK_MONOTONIC, 0, &ts1, &ts2);
EOM
}
+sub DEFINE {
+ my ($def, $val) = @_;
+ my $define = defined $val ? "$def=$val" : $def ;
+ unless ($DEFINE =~ /(?:^| )-D\Q$define\E(?: |$)/) {
+ $DEFINE .= " -D$define";
+ }
+}
+
sub init {
my $hints = File::Spec->catfile("hints", "$^O.pl");
if (-f $hints) {
}
EOM
$has_stat_st_xtimespec++;
- $DEFINE .= ' -DTIME_HIRES_STAT=1';
+ DEFINE('TIME_HIRES_STAT', 1);
}
if ($has_stat_st_xtimespec) {
}
EOM
$has_stat_st_xtimensec++;
- $DEFINE .= ' -DTIME_HIRES_STAT=2';
+ DEFINE('TIME_HIRES_STAT', 2);
}
if ($has_stat_st_xtimensec) {
}
EOM
$has_stat_st_xtime_n++;
- $DEFINE .= ' -DTIME_HIRES_STAT=3';
+ DEFINE('TIME_HIRES_STAT', 3);
}
if ($has_stat_st_xtime_n) {
}
EOM
$has_stat_st_xtim++;
- $DEFINE .= ' -DTIME_HIRES_STAT=4';
+ DEFINE('TIME_HIRES_STAT', 4);
}
if ($has_stat_st_xtim) {
}
EOM
$has_stat_st_uxtime++;
- $DEFINE .= ' -DTIME_HIRES_STAT=5';
+ DEFINE('TIME_HIRES_STAT', 5);
}
if ($has_stat_st_uxtime) {
print "Looking for <w32api/windows.h>... ";
if (has_include('w32api/windows.h')) {
$has_w32api_windows_h++;
- $DEFINE .= ' -DHAS_W32API_WINDOWS_H';
+ DEFINE('HAS_W32API_WINDOWS_H');
}
if ($has_w32api_windows_h) {
print "found.\n";
'AUTHOR' => 'Jarkko Hietaniemi <jhi@iki.fi>',
'ABSTRACT_FROM' => 'HiRes.pm',
);
- $DEFINE .= " -DATLEASTFIVEOHOHFIVE";
+ DEFINE('ATLEASTFIVEOHOHFIVE');
}
push (@makefileopts,
}
if ($^O =~ /Win32/i) {
- $DEFINE = '-DSELECT_IS_BROKEN';
+ DEFINE('SELECT_IS_BROKEN');
$LIBS = [];
print "System is $^O, skipping full configure...\n";
} else {
--- /dev/null
+# needs to explicitly link against librt to pull in clock_nanosleep
+$self->{LIBS} = ['-lrt'];
if ($have_clock_nanosleep &&
has_symbol('CLOCK_REALTIME')) {
- my $s = 1.5;
+ my $s = 1.5e9;
my $t = clock_nanosleep(&CLOCK_REALTIME, $s);
my $r = abs(1 - $t / $s);
if ($r < 2 * $limit) {
projects / platform / upstream / perl.git / commitdiff