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