projects / p5sagit/p5-mst-13.2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Upgrade to Time::HiRes 1.46.
[p5sagit/p5-mst-13.2.git] / ext / Time / HiRes / HiRes.xs
CommitLineData
dcf686c9 1#ifdef __cplusplus
2extern "C" {
3#endif
4#include "EXTERN.h"
5#include "perl.h"
6#include "XSUB.h"
7#ifdef WIN32
8#include <time.h>
9#else
10#include <sys/time.h>
11#endif
36df99d6 12#ifdef HAS_SELECT
13# ifdef I_SYS_SELECT
14# include <sys/select.h>
15# endif
16#endif
dcf686c9 17#ifdef __cplusplus
18}
19#endif
20
3f2ee006 21#ifndef aTHX_
22# define aTHX_
23# define pTHX_
24#endif
25
26#ifndef NVTYPE
27# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
28# define NVTYPE long double
29# else
30# define NVTYPE double
31# endif
32typedef NVTYPE NV;
33#endif
34
35#ifndef IVdf
36# ifdef IVSIZE
37# if IVSIZE == LONGSIZE
38# define IVdf "ld"
39# else
40# if IVSIZE == INTSIZE
41# define IVdf "d"
42# endif
43# endif
44# else
45# define IVdf "ld"
46# endif
47#endif
48
49#ifndef NVef
50# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
51 defined(PERL_PRIgldbl) /* Not very likely, but let's try anyway. */
52# define NVgf PERL_PRIgldbl
53# else
54# define NVgf "g"
55# endif
56#endif
57
58#ifndef INT2PTR
59
60#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
61# define PTRV UV
62# define INT2PTR(any,d) (any)(d)
63#else
64# if PTRSIZE == LONGSIZE
65# define PTRV unsigned long
66# else
67# define PTRV unsigned
68# endif
69# define INT2PTR(any,d) (any)(PTRV)(d)
70#endif
71#define PTR2IV(p) INT2PTR(IV,p)
72
73#endif /* !INT2PTR */
74
75#ifndef SvPV_nolen
76static char *
77sv_2pv_nolen(pTHX_ register SV *sv)
78{
79 STRLEN n_a;
80 return sv_2pv(sv, &n_a);
81}
82# define SvPV_nolen(sv) \
83 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
84 ? SvPVX(sv) : sv_2pv_nolen(sv))
85#endif
86
87#ifndef PerlProc_pause
88# define PerlProc_pause() Pause()
89#endif
90
91/* Though the cpp define ITIMER_VIRTUAL is available the functionality
92 * is not supported in Cygwin as of August 2002, ditto for Win32.
93 * Neither are ITIMER_PROF or ITIMER_REALPROF implemented. --jhi
94 */
95#if defined(__CYGWIN__) || defined(WIN32)
96# undef ITIMER_VIRTUAL
97# undef ITIMER_PROF
98# undef ITIMER_REALPROF
99#endif
100
98b50af3 101/* 5.004 doesn't define PL_sv_undef */
102#ifndef ATLEASTFIVEOHOHFIVE
103#ifndef PL_sv_undef
104#define PL_sv_undef sv_undef
3f2ee006 105#endif
3c72ec00 106#endif
3c72ec00 107
98b50af3 108#include "const-c.inc"
3c72ec00 109
fd44fdfd 110#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
111#define HAS_GETTIMEOFDAY
112
6e3b076d 113/* shows up in winsock.h?
114struct timeval {
115 long tv_sec;
116 long tv_usec;
117}
118*/
119
fd44fdfd 120typedef union {
121 unsigned __int64 ft_i64;
122 FILETIME ft_val;
123} FT_t;
124
6e3b076d 125/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
fd44fdfd 126#ifdef __GNUC__
127#define Const64(x) x##LL
128#else
129#define Const64(x) x##i64
130#endif
fd44fdfd 131#define EPOCH_BIAS Const64(116444736000000000)
132
133/* NOTE: This does not compute the timezone info (doing so can be expensive,
134 * and appears to be unsupported even by glibc) */
6e3b076d 135int
136gettimeofday (struct timeval *tp, void *not_used)
fd44fdfd 137{
138 FT_t ft;
139
140 /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
141 GetSystemTimeAsFileTime(&ft.ft_val);
142
143 /* seconds since epoch */
144 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
145
146 /* microseconds remaining */
147 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
148
149 return 0;
150}
6e3b076d 151#endif
fd44fdfd 152
dcf686c9 153#if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
154#define HAS_GETTIMEOFDAY
155
9b6f56ad 156#include <lnmdef.h>
dcf686c9 157#include <time.h> /* gettimeofday */
158#include <stdlib.h> /* qdiv */
159#include <starlet.h> /* sys$gettim */
160#include <descrip.h>
3785778e 161#ifdef __VAX
162#include <lib$routines.h> /* lib$ediv() */
163#endif
dcf686c9 164
165/*
166 VMS binary time is expressed in 100 nano-seconds since
167 system base time which is 17-NOV-1858 00:00:00.00
168*/
169
170#define DIV_100NS_TO_SECS 10000000L
171#define DIV_100NS_TO_USECS 10L
172
173/*
174 gettimeofday is supposed to return times since the epoch
175 so need to determine this in terms of VMS base time
176*/
177static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
178
5cdb7193 179#ifdef __VAX
3785778e 180static long base_adjust[2]={0L,0L};
5cdb7193 181#else
dcf686c9 182static __int64 base_adjust=0;
5cdb7193 183#endif
dcf686c9 184
9b6f56ad 185/*
186
187 If we don't have gettimeofday, then likely we are on a VMS machine that
188 operates on local time rather than UTC...so we have to zone-adjust.
189 This code gleefully swiped from VMS.C
190
191*/
192/* method used to handle UTC conversions:
193 * 1 == CRTL gmtime(); 2 == SYS$TIMEZONE_DIFFERENTIAL; 3 == no correction
194 */
195static int gmtime_emulation_type;
196/* number of secs to add to UTC POSIX-style time to get local time */
197static long int utc_offset_secs;
198static struct dsc$descriptor_s fildevdsc =
199 { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" };
200static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL };
201
202static time_t toutc_dst(time_t loc) {
203 struct tm *rsltmp;
204
205 if ((rsltmp = localtime(&loc)) == NULL) return -1;
206 loc -= utc_offset_secs;
207 if (rsltmp->tm_isdst) loc -= 3600;
208 return loc;
209}
210
211static time_t toloc_dst(time_t utc) {
212 struct tm *rsltmp;
213
214 utc += utc_offset_secs;
215 if ((rsltmp = localtime(&utc)) == NULL) return -1;
216 if (rsltmp->tm_isdst) utc += 3600;
217 return utc;
218}
219
220#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
221 ((gmtime_emulation_type || timezone_setup()), \
222 (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
223 ((secs) - utc_offset_secs))))
224
225#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
226 ((gmtime_emulation_type || timezone_setup()), \
227 (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
228 ((secs) + utc_offset_secs))))
229
230static int
231timezone_setup(void)
232{
233 struct tm *tm_p;
234
235 if (gmtime_emulation_type == 0) {
236 int dstnow;
237 time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */
238 /* results of calls to gmtime() and localtime() */
239 /* for same &base */
240
241 gmtime_emulation_type++;
242 if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
243 char off[LNM$C_NAMLENGTH+1];;
244
245 gmtime_emulation_type++;
246 if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) {
247 gmtime_emulation_type++;
248 utc_offset_secs = 0;
249 Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC");
250 }
251 else { utc_offset_secs = atol(off); }
252 }
253 else { /* We've got a working gmtime() */
254 struct tm gmt, local;
255
256 gmt = *tm_p;
257 tm_p = localtime(&base);
258 local = *tm_p;
259 utc_offset_secs = (local.tm_mday - gmt.tm_mday) * 86400;
260 utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600;
261 utc_offset_secs += (local.tm_min - gmt.tm_min) * 60;
262 utc_offset_secs += (local.tm_sec - gmt.tm_sec);
263 }
264 }
265 return 1;
266}
267
268
dcf686c9 269int
270gettimeofday (struct timeval *tp, void *tpz)
271{
272 long ret;
5cdb7193 273#ifdef __VAX
3785778e 274 long quad[2];
275 long quad1[2];
276 long div_100ns_to_secs;
277 long div_100ns_to_usecs;
278 long quo,rem;
279 long quo1,rem1;
5cdb7193 280#else
dcf686c9 281 __int64 quad;
282 __qdiv_t ans1,ans2;
5cdb7193 283#endif
dcf686c9 284/*
285 In case of error, tv_usec = 0 and tv_sec = VMS condition code.
286 The return from function is also set to -1.
287 This is not exactly as per the manual page.
288*/
289
290 tp->tv_usec = 0;
291
3785778e 292#ifdef __VAX
293 if (base_adjust[0]==0 && base_adjust[1]==0) {
294#else
dcf686c9 295 if (base_adjust==0) { /* Need to determine epoch adjustment */
3785778e 296#endif
dcf686c9 297 ret=sys$bintim(&dscepoch,&base_adjust);
298 if (1 != (ret &&1)) {
299 tp->tv_sec = ret;
300 return -1;
301 }
302 }
303
304 ret=sys$gettim(&quad); /* Get VMS system time */
305 if ((1 && ret) == 1) {
5cdb7193 306#ifdef __VAX
3785778e 307 quad[0] -= base_adjust[0]; /* convert to epoch offset */
308 quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
309 div_100ns_to_secs = DIV_100NS_TO_SECS;
310 div_100ns_to_usecs = DIV_100NS_TO_USECS;
311 lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
312 quad1[0] = rem;
313 quad1[1] = 0L;
314 lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
315 tp->tv_sec = quo; /* Whole seconds */
316 tp->tv_usec = quo1; /* Micro-seconds */
5cdb7193 317#else
3785778e 318 quad -= base_adjust; /* convert to epoch offset */
dcf686c9 319 ans1=qdiv(quad,DIV_100NS_TO_SECS);
320 ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
321 tp->tv_sec = ans1.quot; /* Whole seconds */
322 tp->tv_usec = ans2.quot; /* Micro-seconds */
3785778e 323#endif
dcf686c9 324 } else {
325 tp->tv_sec = ret;
326 return -1;
327 }
9b6f56ad 328# ifdef VMSISH_TIME
329# ifdef RTL_USES_UTC
330 if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec);
331# else
332 if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec);
333# endif
334# endif
dcf686c9 335 return 0;
336}
337#endif
338
3f2ee006 339
340#if !defined(HAS_USLEEP) && defined(HAS_NANOSLEEP)
341#define HAS_USLEEP
342#define usleep hrt_nanosleep /* could conflict with ncurses for static build */
343
344void
345hrt_nanosleep(unsigned long usec)
346{
347 struct timespec res;
348 res.tv_sec = usec/1000/1000;
349 res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000;
350 nanosleep(&res, NULL);
351}
352#endif
353
354
dcf686c9 355#if !defined(HAS_USLEEP) && defined(HAS_SELECT)
356#ifndef SELECT_IS_BROKEN
357#define HAS_USLEEP
358#define usleep hrt_usleep /* could conflict with ncurses for static build */
359
360void
361hrt_usleep(unsigned long usec)
362{
363 struct timeval tv;
364 tv.tv_sec = 0;
365 tv.tv_usec = usec;
366 select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
367 (Select_fd_set_t)NULL, &tv);
368}
369#endif
370#endif
371
372#if !defined(HAS_USLEEP) && defined(WIN32)
373#define HAS_USLEEP
374#define usleep hrt_usleep /* could conflict with ncurses for static build */
375
376void
377hrt_usleep(unsigned long usec)
378{
379 long msec;
380 msec = usec / 1000;
381 Sleep (msec);
382}
383#endif
384
385
386#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
387#define HAS_UALARM
388#define ualarm hrt_ualarm /* could conflict with ncurses for static build */
389
390int
391hrt_ualarm(int usec, int interval)
392{
393 struct itimerval itv;
394 itv.it_value.tv_sec = usec / 1000000;
395 itv.it_value.tv_usec = usec % 1000000;
396 itv.it_interval.tv_sec = interval / 1000000;
397 itv.it_interval.tv_usec = interval % 1000000;
398 return setitimer(ITIMER_REAL, &itv, 0);
399}
400#endif
401
ca40fe49 402#if !defined(HAS_UALARM) && defined(VMS)
403#define HAS_UALARM
404#define ualarm vms_ualarm
405
406#include <lib$routines.h>
407#include <ssdef.h>
408#include <starlet.h>
409#include <descrip.h>
410#include <signal.h>
411#include <jpidef.h>
412#include <psldef.h>
413
414#define VMSERR(s) (!((s)&1))
415
416static void
417us_to_VMS(useconds_t mseconds, unsigned long v[])
418{
419 int iss;
420 unsigned long qq[2];
421
422 qq[0] = mseconds;
423 qq[1] = 0;
424 v[0] = v[1] = 0;
425
426 iss = lib$addx(qq,qq,qq);
427 if (VMSERR(iss)) lib$signal(iss);
428 iss = lib$subx(v,qq,v);
429 if (VMSERR(iss)) lib$signal(iss);
430 iss = lib$addx(qq,qq,qq);
431 if (VMSERR(iss)) lib$signal(iss);
432 iss = lib$subx(v,qq,v);
433 if (VMSERR(iss)) lib$signal(iss);
434 iss = lib$subx(v,qq,v);
435 if (VMSERR(iss)) lib$signal(iss);
436}
437
438static int
439VMS_to_us(unsigned long v[])
440{
441 int iss;
442 unsigned long div=10,quot, rem;
443
444 iss = lib$ediv(&div,v,&quot,&rem);
445 if (VMSERR(iss)) lib$signal(iss);
446
447 return quot;
448}
449
450typedef unsigned short word;
451typedef struct _ualarm {
452 int function;
453 int repeat;
454 unsigned long delay[2];
455 unsigned long interval[2];
456 unsigned long remain[2];
457} Alarm;
458
459
460static int alarm_ef;
461static Alarm *a0, alarm_base;
462#define UAL_NULL 0
463#define UAL_SET 1
464#define UAL_CLEAR 2
465#define UAL_ACTIVE 4
466static void ualarm_AST(Alarm *a);
467
468static int
469vms_ualarm(int mseconds, int interval)
470{
471 Alarm *a, abase;
472 struct item_list3 {
473 word length;
474 word code;
475 void *bufaddr;
476 void *retlenaddr;
477 } ;
478 static struct item_list3 itmlst[2];
479 static int first = 1;
480 unsigned long asten;
481 int iss, enabled;
482
483 if (first) {
484 first = 0;
485 itmlst[0].code = JPI$_ASTEN;
486 itmlst[0].length = sizeof(asten);
487 itmlst[0].retlenaddr = NULL;
488 itmlst[1].code = 0;
489 itmlst[1].length = 0;
490 itmlst[1].bufaddr = NULL;
491 itmlst[1].retlenaddr = NULL;
492
493 iss = lib$get_ef(&alarm_ef);
494 if (VMSERR(iss)) lib$signal(iss);
495
496 a0 = &alarm_base;
497 a0->function = UAL_NULL;
498 }
499 itmlst[0].bufaddr = &asten;
500
501 iss = sys$getjpiw(0,0,0,itmlst,0,0,0);
502 if (VMSERR(iss)) lib$signal(iss);
503 if (!(asten&0x08)) return -1;
504
505 a = &abase;
506 if (mseconds) {
507 a->function = UAL_SET;
508 } else {
509 a->function = UAL_CLEAR;
510 }
511
512 us_to_VMS(mseconds, a->delay);
513 if (interval) {
514 us_to_VMS(interval, a->interval);
515 a->repeat = 1;
516 } else
517 a->repeat = 0;
518
519 iss = sys$clref(alarm_ef);
520 if (VMSERR(iss)) lib$signal(iss);
521
522 iss = sys$dclast(ualarm_AST,a,0);
523 if (VMSERR(iss)) lib$signal(iss);
524
525 iss = sys$waitfr(alarm_ef);
526 if (VMSERR(iss)) lib$signal(iss);
527
528 if (a->function == UAL_ACTIVE)
529 return VMS_to_us(a->remain);
530 else
531 return 0;
532}
533
534
535
536static void
537ualarm_AST(Alarm *a)
538{
539 int iss;
540 unsigned long now[2];
541
542 iss = sys$gettim(now);
543 if (VMSERR(iss)) lib$signal(iss);
544
545 if (a->function == UAL_SET || a->function == UAL_CLEAR) {
546 if (a0->function == UAL_ACTIVE) {
547 iss = sys$cantim(a0,PSL$C_USER);
548 if (VMSERR(iss)) lib$signal(iss);
549
550 iss = lib$subx(a0->remain, now, a->remain);
551 if (VMSERR(iss)) lib$signal(iss);
552
553 if (a->remain[1] & 0x80000000)
554 a->remain[0] = a->remain[1] = 0;
555 }
556
557 if (a->function == UAL_SET) {
558 a->function = a0->function;
559 a0->function = UAL_ACTIVE;
560 a0->repeat = a->repeat;
561 if (a0->repeat) {
562 a0->interval[0] = a->interval[0];
563 a0->interval[1] = a->interval[1];
564 }
565 a0->delay[0] = a->delay[0];
566 a0->delay[1] = a->delay[1];
567
568 iss = lib$subx(now, a0->delay, a0->remain);
569 if (VMSERR(iss)) lib$signal(iss);
570
571 iss = sys$setimr(0,a0->delay,ualarm_AST,a0);
572 if (VMSERR(iss)) lib$signal(iss);
573 } else {
574 a->function = a0->function;
575 a0->function = UAL_NULL;
576 }
577 iss = sys$setef(alarm_ef);
578 if (VMSERR(iss)) lib$signal(iss);
579 } else if (a->function == UAL_ACTIVE) {
580 if (a->repeat) {
581 iss = lib$subx(now, a->interval, a->remain);
582 if (VMSERR(iss)) lib$signal(iss);
583
584 iss = sys$setimr(0,a->interval,ualarm_AST,a);
585 if (VMSERR(iss)) lib$signal(iss);
586 } else {
587 a->function = UAL_NULL;
588 }
589 iss = sys$wake(0,0);
590 if (VMSERR(iss)) lib$signal(iss);
591 lib$signal(SS$_ASTFLT);
592 } else {
593 lib$signal(SS$_BADPARAM);
594 }
595}
596
597#endif /* !HAS_UALARM && VMS */
598
dcf686c9 599#ifdef HAS_GETTIMEOFDAY
600
a2e20b18 601static int
dcf686c9 602myU2time(UV *ret)
603{
604 struct timeval Tp;
605 int status;
6e3b076d 606 status = gettimeofday (&Tp, NULL);
dcf686c9 607 ret[0] = Tp.tv_sec;
608 ret[1] = Tp.tv_usec;
a2e20b18 609 return status;
dcf686c9 610}
611
3c72ec00 612static NV
dcf686c9 613myNVtime()
614{
615 struct timeval Tp;
616 int status;
6e3b076d 617 status = gettimeofday (&Tp, NULL);
a2e20b18 618 return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
dcf686c9 619}
620
621#endif
622
623MODULE = Time::HiRes PACKAGE = Time::HiRes
624
625PROTOTYPES: ENABLE
626
627BOOT:
3f2ee006 628#ifdef ATLEASTFIVEOHOHFIVE
dcf686c9 629#ifdef HAS_GETTIMEOFDAY
a2e20b18 630{
631 UV auv[2];
cfb1f18c 632 hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
a2e20b18 633 if (myU2time(auv) == 0)
634 hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
635}
dcf686c9 636#endif
3f2ee006 637#endif
dcf686c9 638
98b50af3 639INCLUDE: const-xs.inc
3c72ec00 640
52d72fba 641#if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
dcf686c9 642
92bc48ca 643NV
dcf686c9 644usleep(useconds)
92bc48ca 645 NV useconds
52d72fba 646 PREINIT:
647 struct timeval Ta, Tb;
648 CODE:
6e3b076d 649 gettimeofday(&Ta, NULL);
52d72fba 650 if (items > 0) {
92bc48ca 651 if (useconds > 1E6) {
652 IV seconds = (IV) (useconds / 1E6);
f7916ddb 653 /* If usleep() has been implemented using setitimer()
654 * then this contortion is unnecessary-- but usleep()
655 * may be implemented in some other way, so let's contort. */
656 if (seconds) {
657 sleep(seconds);
658 useconds -= 1E6 * seconds;
659 }
660 } else if (useconds < 0.0)
661 croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds);
9a2ac92c 662 usleep((U32)useconds);
52d72fba 663 } else
664 PerlProc_pause();
6e3b076d 665 gettimeofday(&Tb, NULL);
92bc48ca 666#if 0
667 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
668#endif
669 RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
dcf686c9 670
52d72fba 671 OUTPUT:
672 RETVAL
673
674NV
f9d00e57 675sleep(...)
52d72fba 676 PREINIT:
677 struct timeval Ta, Tb;
dcf686c9 678 CODE:
6e3b076d 679 gettimeofday(&Ta, NULL);
92bc48ca 680 if (items > 0) {
681 NV seconds = SvNV(ST(0));
f7916ddb 682 if (seconds >= 0.0) {
7c436af3 683 UV useconds = (UV)(1E6 * (seconds - (UV)seconds));
4880edd6 684 if (seconds >= 1.0)
9a2ac92c 685 sleep((U32)seconds);
f7916ddb 686 usleep(useconds);
687 } else
688 croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds);
92bc48ca 689 } else
f9d00e57 690 PerlProc_pause();
6e3b076d 691 gettimeofday(&Tb, NULL);
92bc48ca 692#if 0
693 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
694#endif
52d72fba 695 RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
696
697 OUTPUT:
698 RETVAL
dcf686c9 699
700#endif
701
702#ifdef HAS_UALARM
703
3de7a4ec 704int
dcf686c9 705ualarm(useconds,interval=0)
706 int useconds
707 int interval
f7916ddb 708 CODE:
709 if (useconds < 0 || interval < 0)
3de7a4ec 710 croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval);
f7916ddb 711 RETVAL = ualarm(useconds, interval);
dcf686c9 712
f7916ddb 713 OUTPUT:
714 RETVAL
715
716NV
717alarm(seconds,interval=0)
718 NV seconds
719 NV interval
dcf686c9 720 CODE:
f7916ddb 721 if (seconds < 0.0 || interval < 0.0)
722 croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
723 RETVAL = (NV)ualarm(seconds * 1000000,
724 interval * 1000000) / 1E6;
dcf686c9 725
c6c619a9 726 OUTPUT:
727 RETVAL
728
dcf686c9 729#endif
730
731#ifdef HAS_GETTIMEOFDAY
db835671 732# ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */
733void
734gettimeofday()
735 PREINIT:
736 struct timeval Tp;
737 struct timezone Tz;
738 PPCODE:
739 int status;
6e3b076d 740 status = gettimeofday (&Tp, &Tz);
db835671 741 Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */
742
743 if (GIMME == G_ARRAY) {
744 EXTEND(sp, 2);
745 /* Mac OS (Classic) has unsigned time_t */
746 PUSHs(sv_2mortal(newSVuv(Tp.tv_sec)));
747 PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
748 } else {
749 EXTEND(sp, 1);
750 PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
751 }
752
753NV
754time()
755 PREINIT:
756 struct timeval Tp;
757 struct timezone Tz;
758 CODE:
759 int status;
6e3b076d 760 status = gettimeofday (&Tp, &Tz);
db835671 761 Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */
762 RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0);
763 OUTPUT:
764 RETVAL
dcf686c9 765
db835671 766# else /* MACOS_TRADITIONAL */
dcf686c9 767void
768gettimeofday()
769 PREINIT:
770 struct timeval Tp;
771 PPCODE:
772 int status;
6e3b076d 773 status = gettimeofday (&Tp, NULL);
dcf686c9 774 if (GIMME == G_ARRAY) {
775 EXTEND(sp, 2);
776 PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
777 PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
778 } else {
779 EXTEND(sp, 1);
780 PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
781 }
782
3c72ec00 783NV
dcf686c9 784time()
785 PREINIT:
786 struct timeval Tp;
787 CODE:
788 int status;
6e3b076d 789 status = gettimeofday (&Tp, NULL);
dcf686c9 790 RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
791 OUTPUT:
792 RETVAL
793
db835671 794# endif /* MACOS_TRADITIONAL */
dcf686c9 795#endif
796
3c72ec00 797#if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
798
799#define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
800
801void
802setitimer(which, seconds, interval = 0)
803 int which
804 NV seconds
805 NV interval
806 PREINIT:
807 struct itimerval newit;
808 struct itimerval oldit;
809 PPCODE:
f7916ddb 810 if (seconds < 0.0 || interval < 0.0)
436c6dd3 811 croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", (IV)which, seconds, interval);
3c72ec00 812 newit.it_value.tv_sec = seconds;
813 newit.it_value.tv_usec =
814 (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;
815 newit.it_interval.tv_sec = interval;
816 newit.it_interval.tv_usec =
817 (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
818 if (setitimer(which, &newit, &oldit) == 0) {
819 EXTEND(sp, 1);
820 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
821 if (GIMME == G_ARRAY) {
822 EXTEND(sp, 1);
823 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
824 }
825 }
826
827void
828getitimer(which)
829 int which
830 PREINIT:
831 struct itimerval nowit;
832 PPCODE:
833 if (getitimer(which, &nowit) == 0) {
834 EXTEND(sp, 1);
835 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
836 if (GIMME == G_ARRAY) {
837 EXTEND(sp, 1);
838 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
839 }
840 }
841
842#endif
843
Unnamed repository; edit this file to name it for gitweb.