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