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