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