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 ENV_LOCALE_LOCK
  90 #  define ENV_LOCALE_LOCK
  91 #endif
  92 #ifndef ENV_LOCALE_UNLOCK
  93 #  define ENV_LOCALE_UNLOCK
  94 #endif
  95
  96 #ifndef TIME_HIRES_CLOCKID_T
  97 typedef int clockid_t;
  98 #endif
  99
 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. */
 104 #  ifdef __hpux
 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. */
 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 */
 113
 114 #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
 115
 116 #if defined(WIN32) || defined(CYGWIN_WITH_W32API)
 117
 118 #  ifndef HAS_GETTIMEOFDAY
 119 #    define HAS_GETTIMEOFDAY
 120 #  endif
 121
 122 /* shows up in winsock.h?
 123 struct timeval {
 124     long tv_sec;
 125     long tv_usec;
 126 }
 127 */
 128
 129 typedef union {
 130     unsigned __int64    ft_i64;
 131     FILETIME            ft_val;
 132 } FT_t;
 133
 134 #  define MY_CXT_KEY "Time::HiRes_" XS_VERSION
 135
 136 typedef struct {
 137     unsigned long run_count;
 138     unsigned __int64 base_ticks;
 139     unsigned __int64 tick_frequency;
 140     FT_t base_systime_as_filetime;
 141     unsigned __int64 reset_time;
 142 } my_cxt_t;
 143
 144 /* Visual C++ 2013 and older don't have the timespec structure */
 145 #  if defined(_MSC_VER) && _MSC_VER < 1900
 146 struct timespec {
 147     time_t tv_sec;
 148     long   tv_nsec;
 149 };
 150 #  endif
 151
 152 START_MY_CXT
 153
 154 /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
 155 #  ifdef __GNUC__
 156 #    define Const64(x) x##LL
 157 #  else
 158 #    define Const64(x) x##i64
 159 #  endif
 160 #  define EPOCH_BIAS  Const64(116444736000000000)
 161
 162 #  ifdef Const64
 163 #    ifdef __GNUC__
 164 #      define IV_1E6LL  1000000LL /* Needed because of Const64() ##-appends LL (or i64). */
 165 #      define IV_1E7LL  10000000LL
 166 #      define IV_1E9LL  1000000000LL
 167 #    else
 168 #      define IV_1E6i64 1000000i64
 169 #      define IV_1E7i64 10000000i64
 170 #      define IV_1E9i64 1000000000i64
 171 #    endif
 172 #  endif
 173
 174 /* NOTE: This does not compute the timezone info (doing so can be expensive,
 175  * and appears to be unsupported even by glibc) */
 176
 177 /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT
 178    for performance reasons */
 179
 180 #  undef gettimeofday
 181 #  define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used)
 182
 183 #  undef GetSystemTimePreciseAsFileTime
 184 #  define GetSystemTimePreciseAsFileTime(out) _GetSystemTimePreciseAsFileTime(aTHX_ out)
 185
 186 #  undef clock_gettime
 187 #  define clock_gettime(clock_id, tp) _clock_gettime(aTHX_ clock_id, tp)
 188
 189 #  undef clock_getres
 190 #  define clock_getres(clock_id, tp) _clock_getres(clock_id, tp)
 191
 192 #  ifndef CLOCK_REALTIME
 193 #    define CLOCK_REALTIME  1
 194 #    define CLOCK_MONOTONIC 2
 195 #  endif
 196
 197 /* If the performance counter delta drifts more than 0.5 seconds from the
 198  * system time then we recalibrate to the system time.  This means we may
 199  * move *backwards* in time! */
 200 #  define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */
 201
 202 /* Reset reading from the performance counter every five minutes.
 203  * Many PC clocks just seem to be so bad. */
 204 #  define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */
 205
 206 /*
 207  * Windows 8 introduced GetSystemTimePreciseAsFileTime(), but currently we have
 208  * to support older systems, so for now we provide our own implementation.
 209  * In the future we will switch to the real deal.
 210  */
 211 static void
 212 _GetSystemTimePreciseAsFileTime(pTHX_ FILETIME *out)
 213 {
 214     dMY_CXT;
 215     FT_t ft;
 216
 217     if (MY_CXT.run_count++ == 0 ||
 218         MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) {
 219
 220         QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency);
 221         QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks);
 222         GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 223         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 224         MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS;
 225     }
 226     else {
 227         __int64 diff;
 228         unsigned __int64 ticks;
 229         QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
 230         ticks -= MY_CXT.base_ticks;
 231         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
 232                     + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency)
 233                     +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency;
 234         diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64;
 235         if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) {
 236             MY_CXT.base_ticks += ticks;
 237             GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 238             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 239         }
 240     }
 241
 242     *out = ft.ft_val;
 243
 244     return;
 245 }
 246
 247 static int
 248 _gettimeofday(pTHX_ struct timeval *tp, void *not_used)
 249 {
 250     FT_t ft;
 251
 252     PERL_UNUSED_ARG(not_used);
 253
 254     GetSystemTimePreciseAsFileTime(&ft.ft_val);
 255
 256     /* seconds since epoch */
 257     tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7));
 258
 259     /* microseconds remaining */
 260     tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6));
 261
 262     return 0;
 263 }
 264
 265 static int
 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
 297 static 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
 326 #endif /* #if defined(WIN32) || defined(CYGWIN_WITH_W32API) */
 327
 328  /* Do not use H A S _ N A N O S L E E P
 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).
 331   * (We are part of the core perl now.)
 332   * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
 333 #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
 334 #  define HAS_USLEEP
 335 #  define usleep hrt_usleep  /* could conflict with ncurses for static build */
 336
 337 static void
 338 hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */
 339 {
 340     struct timespec res;
 341     res.tv_sec = usec / IV_1E6;
 342     res.tv_nsec = ( usec - res.tv_sec * IV_1E6 ) * 1000;
 343     nanosleep(&res, NULL);
 344 }
 345
 346 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
 347
 348 #if !defined(HAS_USLEEP) && defined(HAS_SELECT)
 349 #  ifndef SELECT_IS_BROKEN
 350 #    define HAS_USLEEP
 351 #    define usleep hrt_usleep  /* could conflict with ncurses for static build */
 352
 353 static void
 354 hrt_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,
 360         (Select_fd_set_t)NULL, &tv);
 361 }
 362 #  endif
 363 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
 364
 365 #if !defined(HAS_USLEEP) && defined(WIN32)
 366 #  define HAS_USLEEP
 367 #  define usleep hrt_usleep  /* could conflict with ncurses for static build */
 368
 369 static void
 370 hrt_usleep(unsigned long usec)
 371 {
 372     long msec;
 373     msec = usec / 1000;
 374     Sleep (msec);
 375 }
 376 #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
 377
 378 #if !defined(HAS_USLEEP) && defined(HAS_POLL)
 379 #  define HAS_USLEEP
 380 #  define usleep hrt_usleep  /* could conflict with ncurses for static build */
 381
 382 static void
 383 hrt_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) */
 390
 391 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 392
 393 static int
 394 hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval)
 395 {
 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);
 402 }
 403
 404 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 405
 406 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
 407 #  define HAS_UALARM
 408 #  define ualarm hrt_ualarm_itimer  /* could conflict with ncurses for static build */
 409 #endif
 410
 411 #if !defined(HAS_UALARM) && defined(VMS)
 412 #  define HAS_UALARM
 413 #  define ualarm vms_ualarm
 414
 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>
 422
 423 #  define VMSERR(s)   (!((s)&1))
 424
 425 static void
 426 us_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
 447 static int
 448 VMS_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
 459 typedef unsigned short word;
 460 typedef 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
 469 static int alarm_ef;
 470 static Alarm *a0, alarm_base;
 471 #  define UAL_NULL   0
 472 #  define UAL_SET    1
 473 #  define UAL_CLEAR  2
 474 #  define UAL_ACTIVE 4
 475 static void ualarm_AST(Alarm *a);
 476
 477 static int
 478 vms_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;
 509
 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;
 525     } else
 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
 537     if (a->function == UAL_ACTIVE)
 538         return VMS_to_us(a->remain);
 539     else
 540         return 0;
 541 }
 542
 543
 544
 545 static void
 546 ualarm_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
 562             if (a->remain[1] & 0x80000000)
 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
 606 #endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 607
 608 #ifdef HAS_GETTIMEOFDAY
 609
 610 static int
 611 myU2time(pTHX_ UV *ret)
 612 {
 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;
 619 }
 620
 621 static NV
 622 myNVtime()
 623 {
 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;
 631 }
 632
 633 #endif /* #ifdef HAS_GETTIMEOFDAY */
 634
 635 static void
 636 hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
 637 {
 638     dTHX;
 639 #if TIME_HIRES_STAT == 1
 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;
 643 #elif TIME_HIRES_STAT == 2
 644     *atime_nsec = PL_statcache.st_atimensec;
 645     *mtime_nsec = PL_statcache.st_mtimensec;
 646     *ctime_nsec = PL_statcache.st_ctimensec;
 647 #elif TIME_HIRES_STAT == 3
 648     *atime_nsec = PL_statcache.st_atime_n;
 649     *mtime_nsec = PL_statcache.st_mtime_n;
 650     *ctime_nsec = PL_statcache.st_ctime_n;
 651 #elif TIME_HIRES_STAT == 4
 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;
 655 #elif TIME_HIRES_STAT == 5
 656     *atime_nsec = PL_statcache.st_uatime * 1000;
 657     *mtime_nsec = PL_statcache.st_umtime * 1000;
 658     *ctime_nsec = PL_statcache.st_uctime * 1000;
 659 #else /* !TIME_HIRES_STAT */
 660     *atime_nsec = 0;
 661     *mtime_nsec = 0;
 662     *ctime_nsec = 0;
 663 #endif /* !TIME_HIRES_STAT */
 664 }
 665
 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
 674 #  ifndef CLOCK_REALTIME
 675 #    define CLOCK_REALTIME  0x01
 676 #    define CLOCK_MONOTONIC 0x02
 677 #  endif
 678
 679 #  ifndef TIMER_ABSTIME
 680 #    define TIMER_ABSTIME   0x01
 681 #  endif
 682
 683 #  ifdef USE_ITHREADS
 684 #    define PERL_DARWIN_MUTEX
 685 #  endif
 686
 687 #  ifdef PERL_DARWIN_MUTEX
 688 STATIC perl_mutex darwin_time_mutex;
 689 #  endif
 690
 691 #  include <mach/mach_time.h>
 692
 693 static uint64_t absolute_time_init;
 694 static mach_timebase_info_data_t timebase_info;
 695 static struct timespec timespec_init;
 696
 697 static int darwin_time_init() {
 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         }
 714     }
 715 #  ifdef PERL_DARWIN_MUTEX
 716     MUTEX_UNLOCK(&darwin_time_mutex);
 717 #  endif
 718     return success;
 719 }
 720
 721 #  ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION
 722 static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) {
 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         }
 748     }
 749
 750     SETERRNO(EINVAL, LIB_INVARG);
 751     return -1;
 752 }
 753
 754 #    define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts))
 755
 756 #  endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */
 757
 758 #  ifdef TIME_HIRES_CLOCK_GETRES_EMULATION
 759 static int th_clock_getres(clockid_t clock_id, struct timespec *ts) {
 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         }
 773     }
 774
 775     SETERRNO(EINVAL, LIB_INVARG);
 776     return -1;
 777 }
 778
 779 #    define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts))
 780 #  endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */
 781
 782 #  ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION
 783 static int th_clock_nanosleep(clockid_t clock_id, int flags,
 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         }
 815     }
 816
 817     SETERRNO(EINVAL, LIB_INVARG);
 818     return -1;
 819 }
 820
 821 #    define clock_nanosleep(clock_id, flags, rqtp, rmtp) \
 822   th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp))
 823
 824 #  endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */
 825
 826 #endif /* PERL_DARWIN */
 827
 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
 841 #  define __has_builtin(x) 0 /* non-clang */
 842 #endif
 843 #ifdef HAS_FUTIMENS
 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
 849 #else
 850 #  define FUTIMENS_AVAILABLE 0
 851 #endif
 852 #ifdef HAS_UTIMENSAT
 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
 858 #else
 859 #  define UTIMENSAT_AVAILABLE 0
 860 #endif
 861
 862 #include "const-c.inc"
 863
 864 #if (defined(TIME_HIRES_NANOSLEEP)) || \
 865     (defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME))
 866
 867 static void
 868 nanosleep_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
 877 static NV
 878 nsec_without_unslept(struct timespec *sleepfor,
 879                      const struct timespec *unslept) {
 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         }
 892     } else {
 893         sleepfor->tv_sec = 0;
 894         sleepfor->tv_nsec = 0;
 895     }
 896     return ((NV)sleepfor->tv_sec) * NV_1E9 + ((NV)sleepfor->tv_nsec);
 897 }
 898
 899 #endif
 900
 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
 904 #  if PERL_VERSION_GE(5,12,0) /* Perl_ck_warner is 5.10.0 -> */
 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))
 915 #endif
 916
 917 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 918
 919 PROTOTYPES: ENABLE
 920
 921 BOOT:
 922     {
 923 #ifdef MY_CXT_KEY
 924         MY_CXT_INIT;
 925 #endif
 926 #ifdef HAS_GETTIMEOFDAY
 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         }
 933 #endif
 934 #if defined(PERL_DARWIN)
 935 #  if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX)
 936         MUTEX_INIT(&darwin_time_mutex);
 937 #  endif
 938 #endif
 939     }
 940
 941 #if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
 942
 943 void
 944 CLONE(...)
 945     CODE:
 946         MY_CXT_CLONE;
 947
 948 #endif
 949
 950 INCLUDE: const-xs.inc
 951
 952 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 953
 954 NV
 955 usleep(useconds)
 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
 973                       "): negative time not invented yet", useconds);
 974
 975             usleep((U32)useconds);
 976         } else
 977             PerlProc_pause();
 978
 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)
 989
 990 NV
 991 nanosleep(nsec)
 992     NV nsec
 993     PREINIT:
 994         struct timespec sleepfor, unslept;
 995     CODE:
 996         if (nsec < 0.0)
 997             croak("Time::HiRes::nanosleep(%" NVgf
 998                   "): negative time not invented yet", nsec);
 999         nanosleep_init(nsec, &sleepfor, &unslept);
1000         if (nanosleep(&sleepfor, &unslept) == 0) {
1001             RETVAL = nsec;
1002         } else {
1003             RETVAL = nsec_without_unslept(&sleepfor, &unslept);
1004         }
1005     OUTPUT:
1006         RETVAL
1007
1008 #  else  /* #if defined(TIME_HIRES_NANOSLEEP) */
1009
1010 NV
1011 nanosleep(nsec)
1012     NV nsec
1013     CODE:
1014         PERL_UNUSED_ARG(nsec);
1015         croak("Time::HiRes::nanosleep(): unimplemented in this platform");
1016         RETVAL = 0.0;
1017     OUTPUT:
1018         RETVAL
1019
1020 #  endif /* #if defined(TIME_HIRES_NANOSLEEP) */
1021
1022 NV
1023 sleep(...)
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
1051                       "): negative time not invented yet", seconds);
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);
1060
1061     OUTPUT:
1062         RETVAL
1063
1064 #else  /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
1065
1066 NV
1067 usleep(useconds)
1068     NV useconds
1069     CODE:
1070         PERL_UNUSED_ARG(useconds);
1071         croak("Time::HiRes::usleep(): unimplemented in this platform");
1072         RETVAL = 0.0;
1073     OUTPUT:
1074         RETVAL
1075
1076 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
1077
1078 #ifdef HAS_UALARM
1079
1080 IV
1081 ualarm(useconds,uinterval=0)
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);
1103
1104         RETVAL = ualarm(useconds, uinterval);
1105 #  endif
1106
1107     OUTPUT:
1108         RETVAL
1109
1110 NV
1111 alarm(seconds,interval=0)
1112     NV seconds
1113     NV interval
1114     CODE:
1115         if (seconds < 0.0 || interval < 0.0)
1116             croak("Time::HiRes::alarm(%" NVgf ", %" NVgf
1117                   "): negative time not invented yet", seconds, interval);
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
1127                       "): seconds or interval too large to split correctly",
1128                       seconds, interval);
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
1150                       "): seconds or interval equal to or more than 1.0 ",
1151                       seconds, interval);
1152
1153             RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
1154 #  endif
1155         }
1156
1157     OUTPUT:
1158         RETVAL
1159
1160 #else /* #ifdef HAS_UALARM */
1161
1162 int
1163 ualarm(useconds,interval=0)
1164     int useconds
1165     int interval
1166     CODE:
1167         PERL_UNUSED_ARG(useconds);
1168         PERL_UNUSED_ARG(interval);
1169         croak("Time::HiRes::ualarm(): unimplemented in this platform");
1170         RETVAL = -1;
1171     OUTPUT:
1172         RETVAL
1173
1174 NV
1175 alarm(seconds,interval=0)
1176     NV seconds
1177     NV interval
1178     CODE:
1179         PERL_UNUSED_ARG(seconds);
1180         PERL_UNUSED_ARG(interval);
1181         croak("Time::HiRes::alarm(): unimplemented in this platform");
1182         RETVAL = 0.0;
1183     OUTPUT:
1184         RETVAL
1185
1186 #endif /* #ifdef HAS_UALARM */
1187
1188 #ifdef HAS_GETTIMEOFDAY
1189
1190 void
1191 gettimeofday()
1192     PREINIT:
1193         struct timeval Tp;
1194     PPCODE:
1195         int status;
1196         status = gettimeofday (&Tp, NULL);
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             }
1206         }
1207
1208 NV
1209 time()
1210     PREINIT:
1211         struct timeval Tp;
1212     CODE:
1213         int status;
1214         status = gettimeofday (&Tp, NULL);
1215         if (status == 0) {
1216             RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1217         } else {
1218             RETVAL = -1.0;
1219         }
1220     OUTPUT:
1221         RETVAL
1222
1223 #endif /* #ifdef HAS_GETTIMEOFDAY */
1224
1225 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
1226
1227 #  define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
1228
1229 void
1230 setitimer(which, seconds, interval = 0)
1231     int which
1232     NV seconds
1233     NV interval
1234     PREINIT:
1235         struct itimerval newit;
1236         struct itimerval oldit;
1237     PPCODE:
1238         if (seconds < 0.0 || interval < 0.0)
1239             croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf
1240                   "): negative time not invented yet",
1241                   (IV)which, seconds, interval);
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);
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          */
1251         GCC_DIAG_IGNORE_STMT(-Wc++-compat);
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         }
1260         GCC_DIAG_RESTORE_STMT;
1261
1262 void
1263 getitimer(which)
1264     int which
1265     PREINIT:
1266         struct itimerval nowit;
1267     PPCODE:
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          */
1271         GCC_DIAG_IGNORE_STMT(-Wc++-compat);
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         }
1280         GCC_DIAG_RESTORE_STMT;
1281
1282 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
1283
1284 #if defined(TIME_HIRES_UTIME)
1285
1286 I32
1287 utime(accessed, modified, ...)
1288 PROTOTYPE: $$@
1289     PREINIT:
1290         SV* accessed;
1291         SV* modified;
1292         SV* file;
1293
1294         struct timespec utbuf[2];
1295         struct timespec *utbufp = utbuf;
1296         int tot;
1297
1298     CODE:
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++;
1336                         }
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) {
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) {
1352
1353                         tot++;
1354                     }
1355                 } else {
1356                     croak("utimensat unimplemented in this platform");
1357                 }
1358 #  else  /* HAS_UTIMENSAT */
1359                 croak("utimensat unimplemented in this platform");
1360 #  endif /* HAS_UTIMENSAT */
1361             }
1362         } /* while items */
1363         RETVAL = tot;
1364
1365     OUTPUT:
1366         RETVAL
1367
1368 #else  /* #if defined(TIME_HIRES_UTIME) */
1369
1370 I32
1371 utime(accessed, modified, ...)
1372     CODE:
1373         croak("Time::HiRes::utime(): unimplemented in this platform");
1374         RETVAL = 0;
1375     OUTPUT:
1376         RETVAL
1377
1378 #endif /* #if defined(TIME_HIRES_UTIME) */
1379
1380 #if defined(TIME_HIRES_CLOCK_GETTIME)
1381
1382 NV
1383 clock_gettime(clock_id = CLOCK_REALTIME)
1384     clockid_t clock_id
1385     PREINIT:
1386         struct timespec ts;
1387         int status = -1;
1388     CODE:
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;
1395
1396     OUTPUT:
1397         RETVAL
1398
1399 #else  /* if defined(TIME_HIRES_CLOCK_GETTIME) */
1400
1401 NV
1402 clock_gettime(clock_id = 0)
1403     clockid_t clock_id
1404     CODE:
1405         PERL_UNUSED_ARG(clock_id);
1406         croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
1407         RETVAL = 0.0;
1408     OUTPUT:
1409         RETVAL
1410
1411 #endif /*  #if defined(TIME_HIRES_CLOCK_GETTIME) */
1412
1413 #if defined(TIME_HIRES_CLOCK_GETRES)
1414
1415 NV
1416 clock_getres(clock_id = CLOCK_REALTIME)
1417     clockid_t clock_id
1418     PREINIT:
1419         int status = -1;
1420         struct timespec ts;
1421     CODE:
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;
1428
1429     OUTPUT:
1430         RETVAL
1431
1432 #else  /* if defined(TIME_HIRES_CLOCK_GETRES) */
1433
1434 NV
1435 clock_getres(clock_id = 0)
1436     clockid_t clock_id
1437     CODE:
1438         PERL_UNUSED_ARG(clock_id);
1439         croak("Time::HiRes::clock_getres(): unimplemented in this platform");
1440         RETVAL = 0.0;
1441     OUTPUT:
1442         RETVAL
1443
1444 #endif /*  #if defined(TIME_HIRES_CLOCK_GETRES) */
1445
1446 #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
1447
1448 NV
1449 clock_nanosleep(clock_id, nsec, flags = 0)
1450     clockid_t clock_id
1451     NV  nsec
1452     int flags
1453     PREINIT:
1454         struct timespec sleepfor, unslept;
1455     CODE:
1456         if (nsec < 0.0)
1457             croak("Time::HiRes::clock_nanosleep(..., %" NVgf
1458                   "): negative time not invented yet", nsec);
1459         nanosleep_init(nsec, &sleepfor, &unslept);
1460         if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) {
1461             RETVAL = nsec;
1462         } else {
1463             RETVAL = nsec_without_unslept(&sleepfor, &unslept);
1464         }
1465     OUTPUT:
1466         RETVAL
1467
1468 #else  /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1469
1470 NV
1471 clock_nanosleep(clock_id, nsec, flags = 0)
1472     clockid_t clock_id
1473     NV  nsec
1474     int flags
1475     CODE:
1476         PERL_UNUSED_ARG(clock_id);
1477         PERL_UNUSED_ARG(nsec);
1478         PERL_UNUSED_ARG(flags);
1479         croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform");
1480         RETVAL = 0.0;
1481     OUTPUT:
1482         RETVAL
1483
1484 #endif /*  #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1485
1486 #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC)
1487
1488 NV
1489 clock()
1490     PREINIT:
1491         clock_t clocks;
1492     CODE:
1493         clocks = clock();
1494         RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC;
1495
1496     OUTPUT:
1497         RETVAL
1498
1499 #else  /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1500
1501 NV
1502 clock()
1503     CODE:
1504         croak("Time::HiRes::clock(): unimplemented in this platform");
1505         RETVAL = 0.0;
1506     OUTPUT:
1507         RETVAL
1508
1509 #endif /*  #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1510
1511 void
1512 stat(...)
1513 PROTOTYPE: ;$
1514     PREINIT:
1515         OP fakeop;
1516         int nret;
1517     ALIAS:
1518         Time::HiRes::lstat = 1
1519     PPCODE:
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);