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