File Coverage

HiRes.xs
Criterion Covered Total %
statement 166 202 82.1
branch 95 174 54.6
condition n/a
subroutine n/a
pod n/a
total 261 376 69.4


line stmt bran cond sub pod time code
1             /*
2             *
3             * Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved.
4             *
5             * Copyright (c) 2002-2010 Jarkko Hietaniemi.
6             * All rights reserved.
7             *
8             * Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram)
9             *
10             * This program is free software; you can redistribute it and/or modify
11             * it under the same terms as Perl itself.
12             */
13              
14             #ifdef __cplusplus
15             extern "C" {
16             #endif
17             #define PERL_NO_GET_CONTEXT
18             #include "EXTERN.h"
19             #include "perl.h"
20             #include "XSUB.h"
21             #include "reentr.h"
22             #ifdef USE_PPPORT_H
23             # include "ppport.h"
24             #endif
25             #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
26             # include
27             # define CYGWIN_WITH_W32API
28             #endif
29             #ifdef WIN32
30             # include
31             #else
32             # include
33             #endif
34             #ifdef HAS_SELECT
35             # ifdef I_SYS_SELECT
36             # include
37             # endif
38             #endif
39             #if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL)
40             # include
41             #endif
42             #ifdef __cplusplus
43             }
44             #endif
45              
46             #ifndef GCC_DIAG_IGNORE
47             # define GCC_DIAG_IGNORE(x)
48             # define GCC_DIAG_RESTORE
49             #endif
50             #ifndef GCC_DIAG_IGNORE_STMT
51             # define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP
52             # define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP
53             #endif
54              
55             #if PERL_VERSION_GE(5,7,3) && !PERL_VERSION_GE(5,10,1)
56             # undef SAVEOP
57             # define SAVEOP() SAVEVPTR(PL_op)
58             #endif
59              
60             #define IV_1E6 1000000
61             #define IV_1E7 10000000
62             #define IV_1E9 1000000000
63              
64             #define NV_1E6 1000000.0
65             #define NV_1E7 10000000.0
66             #define NV_1E9 1000000000.0
67              
68             #ifndef PerlProc_pause
69             # define PerlProc_pause() Pause()
70             #endif
71              
72             #ifdef HAS_PAUSE
73             # define Pause pause
74             #else
75             # undef Pause /* In case perl.h did it already. */
76             # define Pause() sleep(~0) /* Zzz for a long time. */
77             #endif
78              
79             /* Though the cpp define ITIMER_VIRTUAL is available the functionality
80             * is not supported in Cygwin as of August 2004, ditto for Win32.
81             * Neither are ITIMER_PROF or ITIMER_REALPROF implemented. --jhi
82             */
83             #if defined(__CYGWIN__) || defined(WIN32)
84             # undef ITIMER_VIRTUAL
85             # undef ITIMER_PROF
86             # undef ITIMER_REALPROF
87             #endif
88              
89             #ifndef ENV_LOCALE_LOCK
90             # define ENV_LOCALE_LOCK
91             #endif
92             #ifndef ENV_LOCALE_UNLOCK
93             # define ENV_LOCALE_UNLOCK
94             #endif
95              
96             #ifndef TIME_HIRES_CLOCKID_T
97             typedef int clockid_t;
98             #endif
99              
100             #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC)
101              
102             /* HP-UX has CLOCK_XXX values but as enums, not as defines.
103             * The only way to detect these would be to test compile for each. */
104             # ifdef __hpux
105             /* However, it seems that at least in HP-UX 11.31 ia64 there *are*
106             * defines for these, so let's try detecting them. */
107             # ifndef CLOCK_REALTIME
108             # define CLOCK_REALTIME CLOCK_REALTIME
109             # define CLOCK_VIRTUAL CLOCK_VIRTUAL
110             # define CLOCK_PROFILE CLOCK_PROFILE
111             # endif
112             # endif /* # ifdef __hpux */
113              
114             #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
115              
116             #if defined(WIN32) || defined(CYGWIN_WITH_W32API)
117              
118             # ifndef HAS_GETTIMEOFDAY
119             # define HAS_GETTIMEOFDAY
120             # endif
121              
122             /* shows up in winsock.h?
123             struct timeval {
124             long tv_sec;
125             long tv_usec;
126             }
127             */
128              
129             typedef union {
130             unsigned __int64 ft_i64;
131             FILETIME ft_val;
132             } FT_t;
133              
134             # define MY_CXT_KEY "Time::HiRes_" XS_VERSION
135              
136             typedef struct {
137             unsigned long run_count;
138             unsigned __int64 base_ticks;
139             unsigned __int64 tick_frequency;
140             FT_t base_systime_as_filetime;
141             unsigned __int64 reset_time;
142             } my_cxt_t;
143              
144             /* Visual C++ 2013 and older don't have the timespec structure */
145             # if defined(_MSC_VER) && _MSC_VER < 1900
146             struct timespec {
147             time_t tv_sec;
148             long tv_nsec;
149             };
150             # endif
151              
152             START_MY_CXT
153              
154             /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
155             # ifdef __GNUC__
156             # define Const64(x) x##LL
157             # else
158             # define Const64(x) x##i64
159             # endif
160             # define EPOCH_BIAS Const64(116444736000000000)
161              
162             # ifdef Const64
163             # ifdef __GNUC__
164             # define IV_1E6LL 1000000LL /* Needed because of Const64() ##-appends LL (or i64). */
165             # define IV_1E7LL 10000000LL
166             # define IV_1E9LL 1000000000LL
167             # else
168             # define IV_1E6i64 1000000i64
169             # define IV_1E7i64 10000000i64
170             # define IV_1E9i64 1000000000i64
171             # endif
172             # endif
173              
174             /* NOTE: This does not compute the timezone info (doing so can be expensive,
175             * and appears to be unsupported even by glibc) */
176              
177             /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT
178             for performance reasons */
179              
180             # undef gettimeofday
181             # define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used)
182              
183             # undef GetSystemTimePreciseAsFileTime
184             # define GetSystemTimePreciseAsFileTime(out) _GetSystemTimePreciseAsFileTime(aTHX_ out)
185              
186             # undef clock_gettime
187             # define clock_gettime(clock_id, tp) _clock_gettime(aTHX_ clock_id, tp)
188              
189             # undef clock_getres
190             # define clock_getres(clock_id, tp) _clock_getres(clock_id, tp)
191              
192             # ifndef CLOCK_REALTIME
193             # define CLOCK_REALTIME 1
194             # define CLOCK_MONOTONIC 2
195             # endif
196              
197             /* If the performance counter delta drifts more than 0.5 seconds from the
198             * system time then we recalibrate to the system time. This means we may
199             * move *backwards* in time! */
200             # define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */
201              
202             /* Reset reading from the performance counter every five minutes.
203             * Many PC clocks just seem to be so bad. */
204             # define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */
205              
206             /*
207             * Windows 8 introduced GetSystemTimePreciseAsFileTime(), but currently we have
208             * to support older systems, so for now we provide our own implementation.
209             * In the future we will switch to the real deal.
210             */
211             static void
212             _GetSystemTimePreciseAsFileTime(pTHX_ FILETIME *out)
213             {
214             dMY_CXT;
215             FT_t ft;
216              
217             if (MY_CXT.run_count++ == 0 ||
218             MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) {
219              
220             QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency);
221             QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks);
222             GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
223             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
224             MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS;
225             }
226             else {
227             __int64 diff;
228             unsigned __int64 ticks;
229             QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
230             ticks -= MY_CXT.base_ticks;
231             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
232             + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency)
233             +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency;
234             diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64;
235             if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) {
236             MY_CXT.base_ticks += ticks;
237             GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
238             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
239             }
240             }
241              
242             *out = ft.ft_val;
243              
244             return;
245             }
246              
247             static int
248             _gettimeofday(pTHX_ struct timeval *tp, void *not_used)
249             {
250             FT_t ft;
251              
252             PERL_UNUSED_ARG(not_used);
253              
254             GetSystemTimePreciseAsFileTime(&ft.ft_val);
255              
256             /* seconds since epoch */
257             tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7));
258              
259             /* microseconds remaining */
260             tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6));
261              
262             return 0;
263             }
264              
265             static int
266             _clock_gettime(pTHX_ clockid_t clock_id, struct timespec *tp)
267             {
268             FT_t ft;
269              
270             switch (clock_id) {
271             case CLOCK_REALTIME: {
272             FT_t ft;
273              
274             GetSystemTimePreciseAsFileTime(&ft.ft_val);
275             tp->tv_sec = (time_t)((ft.ft_i64 - EPOCH_BIAS) / IV_1E7);
276             tp->tv_nsec = (long)((ft.ft_i64 % IV_1E7) * 100);
277             break;
278             }
279             case CLOCK_MONOTONIC: {
280             unsigned __int64 freq, ticks;
281              
282             QueryPerformanceFrequency((LARGE_INTEGER*)&freq);
283             QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
284              
285             tp->tv_sec = (time_t)(ticks / freq);
286             tp->tv_nsec = (long)((IV_1E9 * (ticks % freq)) / freq);
287             break;
288             }
289             default:
290             errno = EINVAL;
291             return 1;
292             }
293              
294             return 0;
295             }
296              
297             static int
298             _clock_getres(clockid_t clock_id, struct timespec *tp)
299             {
300             unsigned __int64 freq, qpc_res_ns;
301              
302             QueryPerformanceFrequency((LARGE_INTEGER*)&freq);
303             qpc_res_ns = IV_1E9 > freq ? IV_1E9 / freq : 1;
304              
305             switch (clock_id) {
306             case CLOCK_REALTIME:
307             tp->tv_sec = 0;
308             /* the resolution can't be smaller than 100ns because our implementation
309             * of CLOCK_REALTIME is using FILETIME internally */
310             tp->tv_nsec = (long)(qpc_res_ns > 100 ? qpc_res_ns : 100);
311             break;
312              
313             case CLOCK_MONOTONIC:
314             tp->tv_sec = 0;
315             tp->tv_nsec = (long)qpc_res_ns;
316             break;
317              
318             default:
319             errno = EINVAL;
320             return 1;
321             }
322              
323             return 0;
324             }
325              
326             #endif /* #if defined(WIN32) || defined(CYGWIN_WITH_W32API) */
327              
328             /* Do not use H A S _ N A N O S L E E P
329             * so that Perl Configure doesn't scan for it (and pull in -lrt and
330             * the like which are not usually good ideas for the default Perl).
331             * (We are part of the core perl now.)
332             * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
333             #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
334             # define HAS_USLEEP
335             # define usleep hrt_usleep /* could conflict with ncurses for static build */
336              
337             static void
338             hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */
339             {
340             struct timespec res;
341             res.tv_sec = usec / IV_1E6;
342             res.tv_nsec = ( usec - res.tv_sec * IV_1E6 ) * 1000;
343             nanosleep(&res, NULL);
344             }
345              
346             #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
347              
348             #if !defined(HAS_USLEEP) && defined(HAS_SELECT)
349             # ifndef SELECT_IS_BROKEN
350             # define HAS_USLEEP
351             # define usleep hrt_usleep /* could conflict with ncurses for static build */
352              
353             static void
354             hrt_usleep(unsigned long usec)
355             {
356             struct timeval tv;
357             tv.tv_sec = 0;
358             tv.tv_usec = usec;
359             select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
360             (Select_fd_set_t)NULL, &tv);
361             }
362             # endif
363             #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
364              
365             #if !defined(HAS_USLEEP) && defined(WIN32)
366             # define HAS_USLEEP
367             # define usleep hrt_usleep /* could conflict with ncurses for static build */
368              
369             static void
370             hrt_usleep(unsigned long usec)
371             {
372             long msec;
373             msec = usec / 1000;
374             Sleep (msec);
375             }
376             #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
377              
378             #if !defined(HAS_USLEEP) && defined(HAS_POLL)
379             # define HAS_USLEEP
380             # define usleep hrt_usleep /* could conflict with ncurses for static build */
381              
382             static void
383             hrt_usleep(unsigned long usec)
384             {
385             int msec = usec / 1000;
386             poll(0, 0, msec);
387             }
388              
389             #endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
390              
391             #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
392              
393             static int
394 11           hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval)
395             {
396             struct itimerval itv;
397 11           itv.it_value.tv_sec = usec / IV_1E6;
398 11           itv.it_value.tv_usec = usec % IV_1E6;
399 11           itv.it_interval.tv_sec = uinterval / IV_1E6;
400 11           itv.it_interval.tv_usec = uinterval % IV_1E6;
401 11           return setitimer(ITIMER_REAL, &itv, oitv);
402             }
403              
404             #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
405              
406             #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
407             # define HAS_UALARM
408             # define ualarm hrt_ualarm_itimer /* could conflict with ncurses for static build */
409             #endif
410              
411             #if !defined(HAS_UALARM) && defined(VMS)
412             # define HAS_UALARM
413             # define ualarm vms_ualarm
414              
415             # include
416             # include
417             # include
418             # include
419             # include
420             # include
421             # include
422              
423             # define VMSERR(s) (!((s)&1))
424              
425             static void
426             us_to_VMS(useconds_t mseconds, unsigned long v[])
427             {
428             int iss;
429             unsigned long qq[2];
430              
431             qq[0] = mseconds;
432             qq[1] = 0;
433             v[0] = v[1] = 0;
434              
435             iss = lib$addx(qq,qq,qq);
436             if (VMSERR(iss)) lib$signal(iss);
437             iss = lib$subx(v,qq,v);
438             if (VMSERR(iss)) lib$signal(iss);
439             iss = lib$addx(qq,qq,qq);
440             if (VMSERR(iss)) lib$signal(iss);
441             iss = lib$subx(v,qq,v);
442             if (VMSERR(iss)) lib$signal(iss);
443             iss = lib$subx(v,qq,v);
444             if (VMSERR(iss)) lib$signal(iss);
445             }
446              
447             static int
448             VMS_to_us(unsigned long v[])
449             {
450             int iss;
451             unsigned long div=10,quot, rem;
452              
453             iss = lib$ediv(&div,v,",&rem);
454             if (VMSERR(iss)) lib$signal(iss);
455              
456             return quot;
457             }
458              
459             typedef unsigned short word;
460             typedef struct _ualarm {
461             int function;
462             int repeat;
463             unsigned long delay[2];
464             unsigned long interval[2];
465             unsigned long remain[2];
466             } Alarm;
467              
468              
469             static int alarm_ef;
470             static Alarm *a0, alarm_base;
471             # define UAL_NULL 0
472             # define UAL_SET 1
473             # define UAL_CLEAR 2
474             # define UAL_ACTIVE 4
475             static void ualarm_AST(Alarm *a);
476              
477             static int
478             vms_ualarm(int mseconds, int interval)
479             {
480             Alarm *a, abase;
481             struct item_list3 {
482             word length;
483             word code;
484             void *bufaddr;
485             void *retlenaddr;
486             } ;
487             static struct item_list3 itmlst[2];
488             static int first = 1;
489             unsigned long asten;
490             int iss, enabled;
491              
492             if (first) {
493             first = 0;
494             itmlst[0].code = JPI$_ASTEN;
495             itmlst[0].length = sizeof(asten);
496             itmlst[0].retlenaddr = NULL;
497             itmlst[1].code = 0;
498             itmlst[1].length = 0;
499             itmlst[1].bufaddr = NULL;
500             itmlst[1].retlenaddr = NULL;
501              
502             iss = lib$get_ef(&alarm_ef);
503             if (VMSERR(iss)) lib$signal(iss);
504              
505             a0 = &alarm_base;
506             a0->function = UAL_NULL;
507             }
508             itmlst[0].bufaddr = &asten;
509              
510             iss = sys$getjpiw(0,0,0,itmlst,0,0,0);
511             if (VMSERR(iss)) lib$signal(iss);
512             if (!(asten&0x08)) return -1;
513              
514             a = &abase;
515             if (mseconds) {
516             a->function = UAL_SET;
517             } else {
518             a->function = UAL_CLEAR;
519             }
520              
521             us_to_VMS(mseconds, a->delay);
522             if (interval) {
523             us_to_VMS(interval, a->interval);
524             a->repeat = 1;
525             } else
526             a->repeat = 0;
527              
528             iss = sys$clref(alarm_ef);
529             if (VMSERR(iss)) lib$signal(iss);
530              
531             iss = sys$dclast(ualarm_AST,a,0);
532             if (VMSERR(iss)) lib$signal(iss);
533              
534             iss = sys$waitfr(alarm_ef);
535             if (VMSERR(iss)) lib$signal(iss);
536              
537             if (a->function == UAL_ACTIVE)
538             return VMS_to_us(a->remain);
539             else
540             return 0;
541             }
542              
543              
544              
545             static void
546             ualarm_AST(Alarm *a)
547             {
548             int iss;
549             unsigned long now[2];
550              
551             iss = sys$gettim(now);
552             if (VMSERR(iss)) lib$signal(iss);
553              
554             if (a->function == UAL_SET || a->function == UAL_CLEAR) {
555             if (a0->function == UAL_ACTIVE) {
556             iss = sys$cantim(a0,PSL$C_USER);
557             if (VMSERR(iss)) lib$signal(iss);
558              
559             iss = lib$subx(a0->remain, now, a->remain);
560             if (VMSERR(iss)) lib$signal(iss);
561              
562             if (a->remain[1] & 0x80000000)
563             a->remain[0] = a->remain[1] = 0;
564             }
565              
566             if (a->function == UAL_SET) {
567             a->function = a0->function;
568             a0->function = UAL_ACTIVE;
569             a0->repeat = a->repeat;
570             if (a0->repeat) {
571             a0->interval[0] = a->interval[0];
572             a0->interval[1] = a->interval[1];
573             }
574             a0->delay[0] = a->delay[0];
575             a0->delay[1] = a->delay[1];
576              
577             iss = lib$subx(now, a0->delay, a0->remain);
578             if (VMSERR(iss)) lib$signal(iss);
579              
580             iss = sys$setimr(0,a0->delay,ualarm_AST,a0);
581             if (VMSERR(iss)) lib$signal(iss);
582             } else {
583             a->function = a0->function;
584             a0->function = UAL_NULL;
585             }
586             iss = sys$setef(alarm_ef);
587             if (VMSERR(iss)) lib$signal(iss);
588             } else if (a->function == UAL_ACTIVE) {
589             if (a->repeat) {
590             iss = lib$subx(now, a->interval, a->remain);
591             if (VMSERR(iss)) lib$signal(iss);
592              
593             iss = sys$setimr(0,a->interval,ualarm_AST,a);
594             if (VMSERR(iss)) lib$signal(iss);
595             } else {
596             a->function = UAL_NULL;
597             }
598             iss = sys$wake(0,0);
599             if (VMSERR(iss)) lib$signal(iss);
600             lib$signal(SS$_ASTFLT);
601             } else {
602             lib$signal(SS$_BADPARAM);
603             }
604             }
605              
606             #endif /* #if !defined(HAS_UALARM) && defined(VMS) */
607              
608             #ifdef HAS_GETTIMEOFDAY
609              
610             static int
611 0           myU2time(pTHX_ UV *ret)
612             {
613             struct timeval Tp;
614             int status;
615 0           status = gettimeofday (&Tp, NULL);
616 0           ret[0] = Tp.tv_sec;
617 0           ret[1] = Tp.tv_usec;
618 0           return status;
619             }
620              
621             static NV
622 0           myNVtime()
623             {
624             # ifdef WIN32
625             dTHX;
626             # endif
627             struct timeval Tp;
628             int status;
629 0           status = gettimeofday (&Tp, NULL);
630 0 0         return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
631             }
632              
633             #endif /* #ifdef HAS_GETTIMEOFDAY */
634              
635             static void
636 34           hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
637             {
638             dTHX;
639             #if TIME_HIRES_STAT == 1
640             *atime_nsec = PL_statcache.st_atimespec.tv_nsec;
641             *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec;
642             *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec;
643             #elif TIME_HIRES_STAT == 2
644             *atime_nsec = PL_statcache.st_atimensec;
645             *mtime_nsec = PL_statcache.st_mtimensec;
646             *ctime_nsec = PL_statcache.st_ctimensec;
647             #elif TIME_HIRES_STAT == 3
648             *atime_nsec = PL_statcache.st_atime_n;
649             *mtime_nsec = PL_statcache.st_mtime_n;
650             *ctime_nsec = PL_statcache.st_ctime_n;
651             #elif TIME_HIRES_STAT == 4
652 34           *atime_nsec = PL_statcache.st_atim.tv_nsec;
653 34           *mtime_nsec = PL_statcache.st_mtim.tv_nsec;
654 34           *ctime_nsec = PL_statcache.st_ctim.tv_nsec;
655             #elif TIME_HIRES_STAT == 5
656             *atime_nsec = PL_statcache.st_uatime * 1000;
657             *mtime_nsec = PL_statcache.st_umtime * 1000;
658             *ctime_nsec = PL_statcache.st_uctime * 1000;
659             #else /* !TIME_HIRES_STAT */
660             *atime_nsec = 0;
661             *mtime_nsec = 0;
662             *ctime_nsec = 0;
663             #endif /* !TIME_HIRES_STAT */
664 34           }
665              
666             /* Until Apple implements clock_gettime()
667             * (ditto clock_getres() and clock_nanosleep())
668             * we will emulate them using the Mach kernel interfaces. */
669             #if defined(PERL_DARWIN) && \
670             (defined(TIME_HIRES_CLOCK_GETTIME_EMULATION) || \
671             defined(TIME_HIRES_CLOCK_GETRES_EMULATION) || \
672             defined(TIME_HIRES_CLOCK_NANOSLEEP_EMULATION))
673              
674             # ifndef CLOCK_REALTIME
675             # define CLOCK_REALTIME 0x01
676             # define CLOCK_MONOTONIC 0x02
677             # endif
678              
679             # ifndef TIMER_ABSTIME
680             # define TIMER_ABSTIME 0x01
681             # endif
682              
683             # ifdef USE_ITHREADS
684             # define PERL_DARWIN_MUTEX
685             # endif
686              
687             # ifdef PERL_DARWIN_MUTEX
688             STATIC perl_mutex darwin_time_mutex;
689             # endif
690              
691             # include
692              
693             static uint64_t absolute_time_init;
694             static mach_timebase_info_data_t timebase_info;
695             static struct timespec timespec_init;
696              
697             static int darwin_time_init() {
698             struct timeval tv;
699             int success = 1;
700             # ifdef PERL_DARWIN_MUTEX
701             MUTEX_LOCK(&darwin_time_mutex);
702             # endif
703             if (absolute_time_init == 0) {
704             /* mach_absolute_time() cannot fail */
705             absolute_time_init = mach_absolute_time();
706             success = mach_timebase_info(&timebase_info) == KERN_SUCCESS;
707             if (success) {
708             success = gettimeofday(&tv, NULL) == 0;
709             if (success) {
710             timespec_init.tv_sec = tv.tv_sec;
711             timespec_init.tv_nsec = tv.tv_usec * 1000;
712             }
713             }
714             }
715             # ifdef PERL_DARWIN_MUTEX
716             MUTEX_UNLOCK(&darwin_time_mutex);
717             # endif
718             return success;
719             }
720              
721             # ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION
722             static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) {
723             if (darwin_time_init() && timebase_info.denom) {
724             switch (clock_id) {
725             case CLOCK_REALTIME:
726             {
727             uint64_t nanos =
728             ((mach_absolute_time() - absolute_time_init) *
729             (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom;
730             ts->tv_sec = timespec_init.tv_sec + nanos / IV_1E9;
731             ts->tv_nsec = timespec_init.tv_nsec + nanos % IV_1E9;
732             return 0;
733             }
734              
735             case CLOCK_MONOTONIC:
736             {
737             uint64_t nanos =
738             (mach_absolute_time() *
739             (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom;
740             ts->tv_sec = nanos / IV_1E9;
741             ts->tv_nsec = nanos - ts->tv_sec * IV_1E9;
742             return 0;
743             }
744              
745             default:
746             break;
747             }
748             }
749              
750             SETERRNO(EINVAL, LIB_INVARG);
751             return -1;
752             }
753              
754             # define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts))
755              
756             # endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */
757              
758             # ifdef TIME_HIRES_CLOCK_GETRES_EMULATION
759             static int th_clock_getres(clockid_t clock_id, struct timespec *ts) {
760             if (darwin_time_init() && timebase_info.denom) {
761             switch (clock_id) {
762             case CLOCK_REALTIME:
763             case CLOCK_MONOTONIC:
764             ts->tv_sec = 0;
765             /* In newer kernels both the numer and denom are one,
766             * resulting in conversion factor of one, which is of
767             * course unrealistic. */
768             ts->tv_nsec = timebase_info.numer / timebase_info.denom;
769             return 0;
770             default:
771             break;
772             }
773             }
774              
775             SETERRNO(EINVAL, LIB_INVARG);
776             return -1;
777             }
778              
779             # define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts))
780             # endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */
781              
782             # ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION
783             static int th_clock_nanosleep(clockid_t clock_id, int flags,
784             const struct timespec *rqtp,
785             struct timespec *rmtp) {
786             if (darwin_time_init()) {
787             switch (clock_id) {
788             case CLOCK_REALTIME:
789             case CLOCK_MONOTONIC:
790             {
791             uint64_t nanos = rqtp->tv_sec * IV_1E9 + rqtp->tv_nsec;
792             int success;
793             if ((flags & TIMER_ABSTIME)) {
794             uint64_t back =
795             timespec_init.tv_sec * IV_1E9 + timespec_init.tv_nsec;
796             nanos = nanos > back ? nanos - back : 0;
797             }
798             success =
799             mach_wait_until(mach_absolute_time() + nanos) == KERN_SUCCESS;
800              
801             /* In the relative sleep, the rmtp should be filled in with
802             * the 'unused' part of the rqtp in case the sleep gets
803             * interrupted by a signal. But it is unknown how signals
804             * interact with mach_wait_until(). In the absolute sleep,
805             * the rmtp should stay untouched. */
806             rmtp->tv_sec = 0;
807             rmtp->tv_nsec = 0;
808              
809             return success;
810             }
811              
812             default:
813             break;
814             }
815             }
816              
817             SETERRNO(EINVAL, LIB_INVARG);
818             return -1;
819             }
820              
821             # define clock_nanosleep(clock_id, flags, rqtp, rmtp) \
822             th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp))
823              
824             # endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */
825              
826             #endif /* PERL_DARWIN */
827              
828             /* The macOS headers warn about using certain interfaces in
829             * OS-release-ignorant manner, for example:
830             *
831             * warning: 'futimens' is only available on macOS 10.13 or newer
832             * [-Wunguarded-availability-new]
833             *
834             * (ditto for utimensat)
835             *
836             * There is clang __builtin_available() *runtime* check for this.
837             * The gotchas are that neither __builtin_available() nor __has_builtin()
838             * are always available.
839             */
840             #ifndef __has_builtin
841             # define __has_builtin(x) 0 /* non-clang */
842             #endif
843             #ifdef HAS_FUTIMENS
844             # if defined(PERL_DARWIN) && __has_builtin(__builtin_available)
845             # define FUTIMENS_AVAILABLE __builtin_available(macOS 10.13, *)
846             # else
847             # define FUTIMENS_AVAILABLE 1
848             # endif
849             #else
850             # define FUTIMENS_AVAILABLE 0
851             #endif
852             #ifdef HAS_UTIMENSAT
853             # if defined(PERL_DARWIN) && __has_builtin(__builtin_available)
854             # define UTIMENSAT_AVAILABLE __builtin_available(macOS 10.13, *)
855             # else
856             # define UTIMENSAT_AVAILABLE 1
857             # endif
858             #else
859             # define UTIMENSAT_AVAILABLE 0
860             #endif
861              
862             #include "const-c.inc"
863              
864             #if (defined(TIME_HIRES_NANOSLEEP)) || \
865             (defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME))
866              
867             static void
868 4           nanosleep_init(NV nsec,
869             struct timespec *sleepfor,
870             struct timespec *unslept) {
871 4           sleepfor->tv_sec = (Time_t)(nsec / NV_1E9);
872 4           sleepfor->tv_nsec = (long)(nsec - ((NV)sleepfor->tv_sec) * NV_1E9);
873 4           unslept->tv_sec = 0;
874 4           unslept->tv_nsec = 0;
875 4           }
876              
877             static NV
878 0           nsec_without_unslept(struct timespec *sleepfor,
879             const struct timespec *unslept) {
880 0 0         if (sleepfor->tv_sec >= unslept->tv_sec) {
881 0           sleepfor->tv_sec -= unslept->tv_sec;
882 0 0         if (sleepfor->tv_nsec >= unslept->tv_nsec) {
883 0           sleepfor->tv_nsec -= unslept->tv_nsec;
884 0 0         } else if (sleepfor->tv_sec > 0) {
885 0           sleepfor->tv_sec--;
886 0           sleepfor->tv_nsec += IV_1E9;
887 0           sleepfor->tv_nsec -= unslept->tv_nsec;
888             } else {
889 0           sleepfor->tv_sec = 0;
890 0           sleepfor->tv_nsec = 0;
891             }
892             } else {
893 0           sleepfor->tv_sec = 0;
894 0           sleepfor->tv_nsec = 0;
895             }
896 0           return ((NV)sleepfor->tv_sec) * NV_1E9 + ((NV)sleepfor->tv_nsec);
897             }
898              
899             #endif
900              
901             /* In case Perl and/or Devel::PPPort are too old, minimally emulate
902             * IS_SAFE_PATHNAME() (which looks for zero bytes in the pathname). */
903             #ifndef IS_SAFE_PATHNAME
904             # if PERL_VERSION_GE(5,12,0) /* Perl_ck_warner is 5.10.0 -> */
905             # ifdef WARN_SYSCALLS
906             # define WARNEMUCAT WARN_SYSCALLS /* 5.22.0 -> */
907             # else
908             # define WARNEMUCAT WARN_MISC
909             # endif
910             # define WARNEMU(opname) Perl_ck_warner(aTHX_ packWARN(WARNEMUCAT), "Invalid \\0 character in pathname for %s",opname)
911             # else
912             # define WARNEMU(opname) Perl_warn(aTHX_ "Invalid \\0 character in pathname for %s",opname)
913             # endif
914             # define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE))
915             #endif
916              
917             MODULE = Time::HiRes PACKAGE = Time::HiRes
918              
919             PROTOTYPES: ENABLE
920              
921             BOOT:
922             {
923             #ifdef MY_CXT_KEY
924             MY_CXT_INIT;
925             #endif
926             #ifdef HAS_GETTIMEOFDAY
927             {
928 12           (void) hv_store(PL_modglobal, "Time::NVtime", 12,
929             newSViv(PTR2IV(myNVtime)), 0);
930 12           (void) hv_store(PL_modglobal, "Time::U2time", 12,
931             newSViv(PTR2IV(myU2time)), 0);
932             }
933             #endif
934             #if defined(PERL_DARWIN)
935             # if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX)
936             MUTEX_INIT(&darwin_time_mutex);
937             # endif
938             #endif
939             }
940              
941             #if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
942              
943             void
944             CLONE(...)
945             CODE:
946             MY_CXT_CLONE;
947              
948             #endif
949              
950             INCLUDE: const-xs.inc
951              
952             #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
953              
954             NV
955             usleep(useconds)
956             NV useconds
957             PREINIT:
958             struct timeval Ta, Tb;
959             CODE:
960 5           gettimeofday(&Ta, NULL);
961 5 50         if (items > 0) {
962 5 100         if (useconds >= NV_1E6) {
963 1           IV seconds = (IV) (useconds / NV_1E6);
964             /* If usleep() has been implemented using setitimer()
965             * then this contortion is unnecessary-- but usleep()
966             * may be implemented in some other way, so let's contort. */
967 1 50         if (seconds) {
968 1           sleep(seconds);
969 1           useconds -= NV_1E6 * seconds;
970             }
971 4 100         } else if (useconds < 0.0)
972 1           croak("Time::HiRes::usleep(%" NVgf
973             "): negative time not invented yet", useconds);
974              
975 4           usleep((U32)useconds);
976             } else
977 0           PerlProc_pause();
978              
979 4           gettimeofday(&Tb, NULL);
980             # if 0
981             printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
982             # endif
983 4           RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
984              
985             OUTPUT:
986             RETVAL
987              
988             # if defined(TIME_HIRES_NANOSLEEP)
989              
990             NV
991             nanosleep(nsec)
992             NV nsec
993             PREINIT:
994             struct timespec sleepfor, unslept;
995             CODE:
996 4 100         if (nsec < 0.0)
997 1           croak("Time::HiRes::nanosleep(%" NVgf
998             "): negative time not invented yet", nsec);
999 3           nanosleep_init(nsec, &sleepfor, &unslept);
1000 3 50         if (nanosleep(&sleepfor, &unslept) == 0) {
1001 3           RETVAL = nsec;
1002             } else {
1003 0           RETVAL = nsec_without_unslept(&sleepfor, &unslept);
1004             }
1005             OUTPUT:
1006             RETVAL
1007              
1008             # else /* #if defined(TIME_HIRES_NANOSLEEP) */
1009              
1010             NV
1011             nanosleep(nsec)
1012             NV nsec
1013             CODE:
1014             PERL_UNUSED_ARG(nsec);
1015             croak("Time::HiRes::nanosleep(): unimplemented in this platform");
1016             RETVAL = 0.0;
1017             OUTPUT:
1018             RETVAL
1019              
1020             # endif /* #if defined(TIME_HIRES_NANOSLEEP) */
1021              
1022             NV
1023             sleep(...)
1024             PREINIT:
1025             struct timeval Ta, Tb;
1026             CODE:
1027 16           gettimeofday(&Ta, NULL);
1028 16 50         if (items > 0) {
1029 16 100         NV seconds = SvNV(ST(0));
1030 16 100         if (seconds >= 0.0) {
1031 15           UV useconds = (UV)(1E6 * (seconds - (UV)seconds));
1032 15 100         if (seconds >= 1.0)
1033 2           sleep((U32)seconds);
1034 15 50         if ((IV)useconds < 0) {
1035             # if defined(__sparc64__) && defined(__GNUC__)
1036             /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug
1037             * where (0.5 - (UV)(0.5)) will under certain
1038             * circumstances (if the double is cast to UV more
1039             * than once?) evaluate to -0.5, instead of 0.5. */
1040             useconds = -(IV)useconds;
1041             # endif /* #if defined(__sparc64__) && defined(__GNUC__) */
1042 0 0         if ((IV)useconds < 0)
1043 0           croak("Time::HiRes::sleep(%" NVgf
1044             "): internal error: useconds < 0 (unsigned %" UVuf
1045             " signed %" IVdf ")",
1046             seconds, useconds, (IV)useconds);
1047             }
1048 15           usleep(useconds);
1049             } else
1050 16           croak("Time::HiRes::sleep(%" NVgf
1051             "): negative time not invented yet", seconds);
1052             } else
1053 0           PerlProc_pause();
1054              
1055 15           gettimeofday(&Tb, NULL);
1056             # if 0
1057             printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
1058             # endif
1059 15           RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
1060              
1061             OUTPUT:
1062             RETVAL
1063              
1064             #else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
1065              
1066             NV
1067             usleep(useconds)
1068             NV useconds
1069             CODE:
1070             PERL_UNUSED_ARG(useconds);
1071             croak("Time::HiRes::usleep(): unimplemented in this platform");
1072             RETVAL = 0.0;
1073             OUTPUT:
1074             RETVAL
1075              
1076             #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
1077              
1078             #ifdef HAS_UALARM
1079              
1080             IV
1081             ualarm(useconds,uinterval=0)
1082             int useconds
1083             int uinterval
1084             CODE:
1085 12 100         if (useconds < 0 || uinterval < 0)
    50          
1086 1           croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval);
1087             # if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
1088             {
1089             struct itimerval itv;
1090 11 50         if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
1091             /* To conform to ualarm's interface, we're actually ignoring
1092             an error here. */
1093 0           RETVAL = 0;
1094             } else {
1095 11           RETVAL = itv.it_value.tv_sec * IV_1E6 + itv.it_value.tv_usec;
1096             }
1097             }
1098             # else
1099             if (useconds >= IV_1E6 || uinterval >= IV_1E6)
1100             croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval"
1101             " equal to or more than %" IVdf,
1102             useconds, uinterval, IV_1E6);
1103              
1104             RETVAL = ualarm(useconds, uinterval);
1105             # endif
1106              
1107             OUTPUT:
1108             RETVAL
1109              
1110             NV
1111             alarm(seconds,interval=0)
1112             NV seconds
1113             NV interval
1114             CODE:
1115 13 100         if (seconds < 0.0 || interval < 0.0)
    50          
1116 1           croak("Time::HiRes::alarm(%" NVgf ", %" NVgf
1117             "): negative time not invented yet", seconds, interval);
1118              
1119             {
1120 12           IV iseconds = (IV)seconds;
1121 12           IV iinterval = (IV)interval;
1122 12           NV fseconds = seconds - iseconds;
1123 12           NV finterval = interval - iinterval;
1124             IV useconds, uinterval;
1125 12 50         if (fseconds >= 1.0 || finterval >= 1.0)
    50          
1126 0           croak("Time::HiRes::alarm(%" NVgf ", %" NVgf
1127             "): seconds or interval too large to split correctly",
1128             seconds, interval);
1129              
1130 12           useconds = IV_1E6 * fseconds;
1131 12           uinterval = IV_1E6 * finterval;
1132             # if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
1133             {
1134             struct itimerval nitv, oitv;
1135 12           nitv.it_value.tv_sec = iseconds;
1136 12           nitv.it_value.tv_usec = useconds;
1137 12           nitv.it_interval.tv_sec = iinterval;
1138 12           nitv.it_interval.tv_usec = uinterval;
1139 12 50         if (setitimer(ITIMER_REAL, &nitv, &oitv)) {
1140             /* To conform to alarm's interface, we're actually ignoring
1141             an error here. */
1142 0           RETVAL = 0;
1143             } else {
1144 12           RETVAL = oitv.it_value.tv_sec + ((NV)oitv.it_value.tv_usec) / NV_1E6;
1145             }
1146             }
1147             # else
1148             if (iseconds || iinterval)
1149             croak("Time::HiRes::alarm(%" NVgf ", %" NVgf
1150             "): seconds or interval equal to or more than 1.0 ",
1151             seconds, interval);
1152              
1153             RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
1154             # endif
1155             }
1156              
1157             OUTPUT:
1158             RETVAL
1159              
1160             #else /* #ifdef HAS_UALARM */
1161              
1162             int
1163             ualarm(useconds,interval=0)
1164             int useconds
1165             int interval
1166             CODE:
1167             PERL_UNUSED_ARG(useconds);
1168             PERL_UNUSED_ARG(interval);
1169             croak("Time::HiRes::ualarm(): unimplemented in this platform");
1170             RETVAL = -1;
1171             OUTPUT:
1172             RETVAL
1173              
1174             NV
1175             alarm(seconds,interval=0)
1176             NV seconds
1177             NV interval
1178             CODE:
1179             PERL_UNUSED_ARG(seconds);
1180             PERL_UNUSED_ARG(interval);
1181             croak("Time::HiRes::alarm(): unimplemented in this platform");
1182             RETVAL = 0.0;
1183             OUTPUT:
1184             RETVAL
1185              
1186             #endif /* #ifdef HAS_UALARM */
1187              
1188             #ifdef HAS_GETTIMEOFDAY
1189              
1190             void
1191             gettimeofday()
1192             PREINIT:
1193             struct timeval Tp;
1194             PPCODE:
1195             int status;
1196 28           status = gettimeofday (&Tp, NULL);
1197 28 50         if (status == 0) {
1198 28 50         if (GIMME == G_ARRAY) {
    100          
1199 24 50         EXTEND(sp, 2);
1200 24           PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
1201 24           PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
1202             } else {
1203 4 50         EXTEND(sp, 1);
1204 4           PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
1205             }
1206             }
1207              
1208             NV
1209             time()
1210             PREINIT:
1211             struct timeval Tp;
1212             CODE:
1213             int status;
1214 14596943           status = gettimeofday (&Tp, NULL);
1215 14596943 50         if (status == 0) {
1216 14596943           RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1217             } else {
1218 0           RETVAL = -1.0;
1219             }
1220             OUTPUT:
1221             RETVAL
1222              
1223             #endif /* #ifdef HAS_GETTIMEOFDAY */
1224              
1225             #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
1226              
1227             # define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
1228              
1229             void
1230             setitimer(which, seconds, interval = 0)
1231             int which
1232             NV seconds
1233             NV interval
1234             PREINIT:
1235             struct itimerval newit;
1236             struct itimerval oldit;
1237             PPCODE:
1238 2 50         if (seconds < 0.0 || interval < 0.0)
    50          
1239 0           croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf
1240             "): negative time not invented yet",
1241             (IV)which, seconds, interval);
1242 2           newit.it_value.tv_sec = (IV)seconds;
1243 2           newit.it_value.tv_usec =
1244 2           (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6);
1245 2           newit.it_interval.tv_sec = (IV)interval;
1246 2           newit.it_interval.tv_usec =
1247 2           (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6);
1248             /* on some platforms the 1st arg to setitimer is an enum, which
1249             * causes -Wc++-compat to complain about passing an int instead
1250             */
1251             GCC_DIAG_IGNORE_STMT(-Wc++-compat);
1252 2 50         if (setitimer(which, &newit, &oldit) == 0) {
1253 2 50         EXTEND(sp, 1);
1254 2           PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
1255 2 50         if (GIMME == G_ARRAY) {
    100          
1256 1 50         EXTEND(sp, 1);
1257 1           PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
1258             }
1259             }
1260             GCC_DIAG_RESTORE_STMT;
1261              
1262             void
1263             getitimer(which)
1264             int which
1265             PREINIT:
1266             struct itimerval nowit;
1267             PPCODE:
1268             /* on some platforms the 1st arg to getitimer is an enum, which
1269             * causes -Wc++-compat to complain about passing an int instead
1270             */
1271             GCC_DIAG_IGNORE_STMT(-Wc++-compat);
1272 2201 50         if (getitimer(which, &nowit) == 0) {
1273 2201 50         EXTEND(sp, 1);
1274 2201           PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
1275 2201 50         if (GIMME == G_ARRAY) {
    100          
1276 2199 50         EXTEND(sp, 1);
1277 2199           PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
1278             }
1279             }
1280             GCC_DIAG_RESTORE_STMT;
1281              
1282             #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
1283              
1284             #if defined(TIME_HIRES_UTIME)
1285              
1286             I32
1287             utime(accessed, modified, ...)
1288             PROTOTYPE: $$@
1289             PREINIT:
1290             SV* accessed;
1291             SV* modified;
1292             SV* file;
1293              
1294             struct timespec utbuf[2];
1295 8           struct timespec *utbufp = utbuf;
1296             int tot;
1297              
1298             CODE:
1299 8           accessed = ST(0);
1300 8           modified = ST(1);
1301 8           items -= 2;
1302 8           tot = 0;
1303              
1304 8 100         if ( accessed == &PL_sv_undef && modified == &PL_sv_undef )
    50          
1305 1           utbufp = NULL;
1306             else {
1307 7 100         if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0)
    50          
    50          
    100          
    50          
    50          
1308 2 50         croak("Time::HiRes::utime(%" NVgf ", %" NVgf
    50          
1309             "): negative time not invented yet",
1310 8           SvNV(accessed), SvNV(modified));
1311 5           Zero(&utbuf, sizeof utbuf, char);
1312              
1313 5 50         utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */
1314 5           utbuf[0].tv_nsec = (long)(
1315 5 50         (SvNV(accessed) - (NV)utbuf[0].tv_sec)
1316 5           * NV_1E9 + (NV)0.5);
1317              
1318 5 50         utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */
1319 5           utbuf[1].tv_nsec = (long)(
1320 5 50         (SvNV(modified) - (NV)utbuf[1].tv_sec)
1321 5           * NV_1E9 + (NV)0.5);
1322             }
1323              
1324 14 100         while (items > 0) {
1325 8           file = POPs; items--;
1326              
1327 11 100         if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) {
    50          
    50          
    0          
    50          
    50          
    50          
1328 3           int fd = PerlIO_fileno(IoIFP(sv_2io(file)));
1329 3 50         if (fd < 0) {
1330 0           SETERRNO(EBADF,RMS_IFI);
1331             } else {
1332             # ifdef HAS_FUTIMENS
1333             if (FUTIMENS_AVAILABLE) {
1334 3 50         if (futimens(fd, utbufp) == 0) {
1335 3           tot++;
1336             }
1337             } else {
1338             croak("futimens unimplemented in this platform");
1339             }
1340             # else /* HAS_FUTIMENS */
1341             croak("futimens unimplemented in this platform");
1342             # endif /* HAS_FUTIMENS */
1343             }
1344             }
1345             else {
1346             # ifdef HAS_UTIMENSAT
1347             if (UTIMENSAT_AVAILABLE) {
1348             STRLEN len;
1349 5 50         char * name = SvPV(file, len);
1350 10           if (IS_SAFE_PATHNAME(name, len, "utime") &&
1351 5           utimensat(AT_FDCWD, name, utbufp, 0) == 0) {
1352              
1353 5           tot++;
1354             }
1355             } else {
1356             croak("utimensat unimplemented in this platform");
1357             }
1358             # else /* HAS_UTIMENSAT */
1359             croak("utimensat unimplemented in this platform");
1360             # endif /* HAS_UTIMENSAT */
1361             }
1362             } /* while items */
1363 6           RETVAL = tot;
1364              
1365             OUTPUT:
1366             RETVAL
1367              
1368             #else /* #if defined(TIME_HIRES_UTIME) */
1369              
1370             I32
1371             utime(accessed, modified, ...)
1372             CODE:
1373             croak("Time::HiRes::utime(): unimplemented in this platform");
1374             RETVAL = 0;
1375             OUTPUT:
1376             RETVAL
1377              
1378             #endif /* #if defined(TIME_HIRES_UTIME) */
1379              
1380             #if defined(TIME_HIRES_CLOCK_GETTIME)
1381              
1382             NV
1383             clock_gettime(clock_id = CLOCK_REALTIME)
1384             clockid_t clock_id
1385             PREINIT:
1386             struct timespec ts;
1387 2           int status = -1;
1388             CODE:
1389             # ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
1390             status = syscall(SYS_clock_gettime, clock_id, &ts);
1391             # else
1392 2           status = clock_gettime(clock_id, &ts);
1393             # endif
1394 2 50         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1;
1395              
1396             OUTPUT:
1397             RETVAL
1398              
1399             #else /* if defined(TIME_HIRES_CLOCK_GETTIME) */
1400              
1401             NV
1402             clock_gettime(clock_id = 0)
1403             clockid_t clock_id
1404             CODE:
1405             PERL_UNUSED_ARG(clock_id);
1406             croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
1407             RETVAL = 0.0;
1408             OUTPUT:
1409             RETVAL
1410              
1411             #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */
1412              
1413             #if defined(TIME_HIRES_CLOCK_GETRES)
1414              
1415             NV
1416             clock_getres(clock_id = CLOCK_REALTIME)
1417             clockid_t clock_id
1418             PREINIT:
1419 1           int status = -1;
1420             struct timespec ts;
1421             CODE:
1422             # ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL
1423             status = syscall(SYS_clock_getres, clock_id, &ts);
1424             # else
1425 1           status = clock_getres(clock_id, &ts);
1426             # endif
1427 1 50         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1;
1428              
1429             OUTPUT:
1430             RETVAL
1431              
1432             #else /* if defined(TIME_HIRES_CLOCK_GETRES) */
1433              
1434             NV
1435             clock_getres(clock_id = 0)
1436             clockid_t clock_id
1437             CODE:
1438             PERL_UNUSED_ARG(clock_id);
1439             croak("Time::HiRes::clock_getres(): unimplemented in this platform");
1440             RETVAL = 0.0;
1441             OUTPUT:
1442             RETVAL
1443              
1444             #endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */
1445              
1446             #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
1447              
1448             NV
1449             clock_nanosleep(clock_id, nsec, flags = 0)
1450             clockid_t clock_id
1451             NV nsec
1452             int flags
1453             PREINIT:
1454             struct timespec sleepfor, unslept;
1455             CODE:
1456 1 50         if (nsec < 0.0)
1457 0           croak("Time::HiRes::clock_nanosleep(..., %" NVgf
1458             "): negative time not invented yet", nsec);
1459 1           nanosleep_init(nsec, &sleepfor, &unslept);
1460 1 50         if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) {
1461 1           RETVAL = nsec;
1462             } else {
1463 0           RETVAL = nsec_without_unslept(&sleepfor, &unslept);
1464             }
1465             OUTPUT:
1466             RETVAL
1467              
1468             #else /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1469              
1470             NV
1471             clock_nanosleep(clock_id, nsec, flags = 0)
1472             clockid_t clock_id
1473             NV nsec
1474             int flags
1475             CODE:
1476             PERL_UNUSED_ARG(clock_id);
1477             PERL_UNUSED_ARG(nsec);
1478             PERL_UNUSED_ARG(flags);
1479             croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform");
1480             RETVAL = 0.0;
1481             OUTPUT:
1482             RETVAL
1483              
1484             #endif /* #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1485              
1486             #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC)
1487              
1488             NV
1489             clock()
1490             PREINIT:
1491             clock_t clocks;
1492             CODE:
1493 4           clocks = clock();
1494 4 50         RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC;
1495              
1496             OUTPUT:
1497             RETVAL
1498              
1499             #else /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1500              
1501             NV
1502             clock()
1503             CODE:
1504             croak("Time::HiRes::clock(): unimplemented in this platform");
1505             RETVAL = 0.0;
1506             OUTPUT:
1507             RETVAL
1508              
1509             #endif /* #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1510              
1511             void
1512             stat(...)
1513             PROTOTYPE: ;$
1514             PREINIT:
1515             OP fakeop;
1516             int nret;
1517             ALIAS:
1518             Time::HiRes::lstat = 1
1519             PPCODE:
1520 34 50         XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
    50          
    0          
1521 34           PUTBACK;
1522 34           ENTER;
1523 34           PL_laststatval = -1;
1524 34           SAVEOP();
1525 34           Zero(&fakeop, 1, OP);
1526 34 100         fakeop.op_type = ix ? OP_LSTAT : OP_STAT;
1527 34           fakeop.op_ppaddr = PL_ppaddr[fakeop.op_type];
1528 34 50         fakeop.op_flags = GIMME_V == G_ARRAY ? OPf_WANT_LIST :
    50          
    0          
1529 0 0         GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID;
1530 34           PL_op = &fakeop;
1531 34           (void)fakeop.op_ppaddr(aTHX);
1532 34           SPAGAIN;
1533 34           LEAVE;
1534 34           nret = SP+1 - &ST(0);
1535 34 50         if (nret == 13) {
1536 34 50         UV atime = SvUV(ST( 8));
1537 34 50         UV mtime = SvUV(ST( 9));
1538 34 50         UV ctime = SvUV(ST(10));
1539             UV atime_nsec;
1540             UV mtime_nsec;
1541             UV ctime_nsec;
1542 34           hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec);
1543 34 50         if (atime_nsec)
1544 34           ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9));
1545 34 50         if (mtime_nsec)
1546 34           ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9));
1547 34 50         if (ctime_nsec)
1548 34           ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9));
1549             }
1550 34           XSRETURN(nret);