dist/Time-HiRes/HiRes.xs

   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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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,&quot,&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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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
 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);