"Fossies" - the Fresh Open Source Software Archive

Member "Time-HiRes-1.9764/HiRes.xs" (10 Aug 2020, 49217 Bytes) of package /linux/privat/Time-HiRes-1.9764.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) C and C++ source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "HiRes.xs": 1.9758_vs_1.9760.

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