From: Jarkko Hietaniemi Date: Sun, 15 Apr 2001 12:36:33 +0000 (+0000) Subject: Add interval timer (setitimer, getitimer) support to Time::HiRes. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c72ec0095d5296c829ece3ce089509b7f8a14ab;p=p5sagit%2Fp5-mst-13.2.git Add interval timer (setitimer, getitimer) support to Time::HiRes. p4raw-id: //depot/perl@9705 --- diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm index 0bc152b..11848db 100644 --- a/ext/Time/HiRes/HiRes.pm +++ b/ext/Time/HiRes/HiRes.pm @@ -1,21 +1,35 @@ package Time::HiRes; use strict; -use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL); +use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD); require Exporter; -require DynaLoader; +use XSLoader; -@ISA = qw(Exporter DynaLoader); +@ISA = qw(Exporter); @EXPORT = qw( ); -@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval); - -$VERSION = do{my@r=q$Revision: 1.20 $=~/\d+/g;sprintf '%02d.'.'%02d'x$#r,@r}; - -bootstrap Time::HiRes $VERSION; +@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval + getitimer setitimer ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF); + +$VERSION = '1.21'; + +sub AUTOLOAD { + my $constname; + ($constname= $AUTOLOAD) =~ s/.*:://; + my $val = constant($constname, @_ ? $_[0] : 0); + if ($!) { + my ($pack,$file,$line) = caller; + die "Your vendor has not defined Time::HiRes macro $constname, used at $file line $line.\n"; + } + { + no strict 'refs'; + *$AUTOLOAD = sub { $val }; + } + goto &$AUTOLOAD; +} -@EXPORT_FAIL = grep { ! defined &$_ } @EXPORT_OK; +XSLoader::load 'Time::HiRes', $VERSION; # Preloaded methods go here. @@ -26,14 +40,6 @@ sub tv_interval { (${$b}[0] - ${$a}[0]) + ((${$b}[1] - ${$a}[1]) / 1_000_000); } -# I'm only supplying this because the version of it in 5.003's Export.pm -# is buggy (it doesn't shift off the class name). - -sub export_fail { - my $self = shift; - @_; -} - # Autoload methods go after =cut, and are processed by the autosplit program. 1; @@ -60,11 +66,18 @@ Time::HiRes - High resolution ualarm, usleep, and gettimeofday $elapsed = tv_interval ( $t0 ); use Time::HiRes qw ( time alarm sleep ); + $now_fractions = time; sleep ($floating_seconds); alarm ($floating_seconds); alarm ($floating_seconds, $floating_interval); + use Time::HiRes qw( setitimer getitimer + ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF ); + + setitimer ($which, $floating_seconds, $floating_interval ); + getitimer ($which); + =head1 DESCRIPTION The C module implements a Perl interface to the usleep, ualarm, @@ -75,12 +88,12 @@ the underlying gettimeofday, usleep, and ualarm calls. If your system lacks gettimeofday(2) you don't get gettimeofday() or the one-arg form of tv_interval(). If you don't have usleep(3) or select(2) you don't get usleep() or sleep(). If your system don't have ualarm(3) -or setitimer(2) you don't -get ualarm() or alarm(). If you try to import an unimplemented function -in the C statement it will fail at compile time. +or setitimer(2) you don't get ualarm() or alarm(). +If you try to import an unimplemented function in the C statement +it will fail at compile time. -The following functions can be imported from this module. No -functions are exported by default. +The following functions can be imported from this module. +No functions are exported by default. =over 4 @@ -126,6 +139,52 @@ is optional and will be 0 if unspecified, resulting in alarm-like behaviour. This function can be imported, resulting in a nice drop-in replacement for the C provided with perl, see the EXAMPLES below. +=item setitimer ( $which, $floating_seconds [, $interval_floating_seconds ] ) + +Start up an interval timer: after a certain time, a signal is arrives, +and more may keep arriving at certain intervals. To disable a timer, +use time of zero. If interval is set to zero (or unspecified), the +timer is disabled after the next delivered signal. + +Use of interval timers may interfere with alarm(), sleep(), and usleep(). +In standard-speak the "interaction is unspecified", which means that +I may happen: it may work, it may not. + +In scalar context, the remaining time in the timer is returned. + +In list context, both the remaining time and the interval are returned. + +There are three interval timers: the $which can be ITIMER_REAL, +ITIMER_VIRTUAL, or ITIMER_PROF. + +ITIMER_REAL results in alarm()-like behavior. Time is counted in +I, that is, wallclock time. SIGALRM is delivered when +the timer expires. + +ITIMER_VIRTUAL counts time in (process) I, that is, only +when the process is running. In multiprocessing/user/CPU systems this +may be much less than real time. (This time is also known as the +I.) SIGVTALRM is delivered when the timer expires. + +ITIMER_PROF counts time when either the process virtual time or when +the operating system is running on behalf of the process (such as +I/O). (This time is also known as the I.) (Collectively +these times are also known as the I.) SIGPROF is delivered +when the timer expires. SIGPROF can interrupt system calls. + +The semantics of interval timers for multithreaded programs are +system-specific, and some systems may support additional interval +timers. See your setitimer() documentation. + +=item getitimer ( $which ) + +Return the remaining time in the interval timer specified by $which. + +In scalar context, the remaining time is returned. + +In list context, both the remaining time and the interval are returned. +The interval is always what you put in using setitimer(). + =back =head1 EXAMPLES @@ -166,6 +225,14 @@ replacement for the C provided with perl, see the EXAMPLES below. sleep (2.5); alarm (10.6666666); + # Arm an interval timer to go off first at 10 seconds and + # after that every 2.5 seconds, in process virtual time + + use Time::HiRes qw ( setitimer ITIMER_VIRTUAL time ); + + $SIG{VTLARM} = sub { print time, "\n" }; + setitimer(ITIMER_VIRTUAL, 10, 2.5); + =head1 C API In addition to the perl API described above, a C API is available for diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 043b3e3..2100375 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -13,6 +13,46 @@ extern "C" { } #endif +static IV +constant(char *name, int arg) +{ + errno = 0; + switch (*name) { + case 'I': + if (strEQ(name, "ITIMER_REAL")) +#ifdef ITIMER_REAL + return ITIMER_REAL; +#else + goto not_there; +#endif + if (strEQ(name, "ITIMER_REALPROF")) +#ifdef ITIMER_REALPROF + return ITIMER_REALPROF; +#else + goto not_there; +#endif + if (strEQ(name, "ITIMER_VIRTUAL")) +#ifdef ITIMER_VIRTUAL + return ITIMER_VIRTUAL; +#else + goto not_there; +#endif + if (strEQ(name, "ITIMER_PROF")) +#ifdef ITIMER_PROF + return ITIMER_PROF; +#else + goto not_there; +#endif + break; + } + errno = EINVAL; + return 0; + +not_there: + errno = ENOENT; + return 0; +} + #if !defined(HAS_GETTIMEOFDAY) && defined(WIN32) #define HAS_GETTIMEOFDAY @@ -166,7 +206,7 @@ myU2time(UV *ret) ret[1] = Tp.tv_usec; } -static double +static NV myNVtime() { struct timeval Tp; @@ -187,6 +227,11 @@ BOOT: hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) myU2time), 0); #endif +IV +constant(name, arg) + char * name + int arg + #ifdef HAS_USLEEP void @@ -195,7 +240,7 @@ usleep(useconds) void sleep(fseconds) - double fseconds + NV fseconds CODE: int useconds = fseconds * 1000000; usleep (useconds); @@ -211,8 +256,8 @@ ualarm(useconds,interval=0) int alarm(fseconds,finterval=0) - double fseconds - double finterval + NV fseconds + NV finterval PREINIT: int useconds, uinterval; CODE: @@ -240,7 +285,7 @@ gettimeofday() PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); } -double +NV time() PREINIT: struct timeval Tp; @@ -253,6 +298,51 @@ time() #endif +#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) + +#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec)) + +void +setitimer(which, seconds, interval = 0) + int which + NV seconds + NV interval + PREINIT: + struct itimerval newit; + struct itimerval oldit; + PPCODE: + newit.it_value.tv_sec = seconds; + newit.it_value.tv_usec = + (seconds - (NV)newit.it_value.tv_sec) * 1000000.0; + newit.it_interval.tv_sec = interval; + newit.it_interval.tv_usec = + (interval - (NV)newit.it_interval.tv_sec) * 1000000.0; + if (setitimer(which, &newit, &oldit) == 0) { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); + if (GIMME == G_ARRAY) { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); + } + } + +void +getitimer(which) + int which + PREINIT: + struct itimerval nowit; + PPCODE: + if (getitimer(which, &nowit) == 0) { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); + if (GIMME == G_ARRAY) { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval)))); + } + } + +#endif + # $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $ # $Log: HiRes.xs,v $ diff --git a/t/lib/time-hires.t b/t/lib/time-hires.t index 50c20f0..1e68acf 100644 --- a/t/lib/time-hires.t +++ b/t/lib/time-hires.t @@ -3,7 +3,7 @@ BEGIN { @INC = '../lib'; } -BEGIN { $| = 1; print "1..17\n"; } +BEGIN { $| = 1; print "1..19\n"; } END {print "not ok 1\n" unless $loaded;} @@ -23,6 +23,8 @@ import Time::HiRes 'gettimeofday' if $have_gettimeofday; import Time::HiRes 'usleep' if $have_usleep; import Time::HiRes 'ualarm' if $have_ualarm; +use Config; + sub skip { map { print "ok $_ (skipped)\n" } @_; } @@ -161,16 +163,47 @@ unless (defined &Time::HiRes::gettimeofday { alarm(2.5); select (undef, undef, undef, 10); - print "# Select returned! ", Time::HiRes::tv_interval ($r), "\n"; + print "# Select returned! $i ", Time::HiRes::tv_interval ($r), "\n"; } sub tick { - print "# Tick! ", Time::HiRes::tv_interval ($r), "\n"; $i--; + print "# Tick! $i ", Time::HiRes::tv_interval ($r), "\n"; } $SIG{ALRM} = 'DEFAULT'; print "ok 17\n"; } +unless (defined &Time::HiRes::setitimer + && defined &Time::HiRes::getitimer + && exists &Time::HiRes::ITIMER_VIRTUAL + && $Config{d_select}) { + for (18..19) { + print "ok $_ # skipped\n"; + } +} else { + use Time::HiRes qw (setitimer getitimer ITIMER_VIRTUAL); + + my $i = 3; + my $r = [Time::HiRes::gettimeofday]; + + $SIG{VTALRM} = sub { + $i ? $i-- : setitimer(ITIMER_VIRTUAL, 0); + print "# Tick! $i ", Time::HiRes::tv_interval($r), "\n"; + }; + + print "# setitimer: ", join(" ", setitimer(ITIMER_VIRTUAL, 3, 0.5)), "\n"; + + print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; + + while ($i) { + my $j; $j++ for 1..1000; + } + + print "# getitimer: ", join(" ", getitimer(ITIMER_VIRTUAL)), "\n"; + + $SIG{VTALRM} = 'DEFAULT'; +} +