cpan/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 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 "ppport.h"
  22 #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
  23 # include <w32api/windows.h>
  24 # define CYGWIN_WITH_W32API
  25 #endif
  26 #ifdef WIN32
  27 # include <time.h>
  28 #else
  29 # include <sys/time.h>
  30 #endif
  31 #ifdef HAS_SELECT
  32 # ifdef I_SYS_SELECT
  33 #  include <sys/select.h>
  34 # endif
  35 #endif
  36 #if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL)
  37 #include <syscall.h>
  38 #endif
  39 #ifdef __cplusplus
  40 }
  41 #endif
  42
  43 /* At least ppport.h 3.13 gets this wrong: one really cannot
  44  * have NVgf as anything else than "g" under Perl 5.6.x. */
  45 #if PERL_REVISION == 5 && PERL_VERSION == 6
  46 # undef NVgf
  47 # define NVgf "g"
  48 #endif
  49
  50 #define IV_1E6 1000000
  51 #define IV_1E7 10000000
  52 #define IV_1E9 1000000000
  53
  54 #define NV_1E6 1000000.0
  55 #define NV_1E7 10000000.0
  56 #define NV_1E9 1000000000.0
  57
  58 #ifndef PerlProc_pause
  59 #   define PerlProc_pause() Pause()
  60 #endif
  61
  62 #ifdef HAS_PAUSE
  63 #   define Pause   pause
  64 #else
  65 #   undef Pause /* In case perl.h did it already. */
  66 #   define Pause() sleep(~0) /* Zzz for a long time. */
  67 #endif
  68
  69 /* Though the cpp define ITIMER_VIRTUAL is available the functionality
  70  * is not supported in Cygwin as of August 2004, ditto for Win32.
  71  * Neither are ITIMER_PROF or ITIMER_REALPROF implemented.  --jhi
  72  */
  73 #if defined(__CYGWIN__) || defined(WIN32)
  74 #   undef ITIMER_VIRTUAL
  75 #   undef ITIMER_PROF
  76 #   undef ITIMER_REALPROF
  77 #endif
  78
  79 #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC)
  80
  81 /* HP-UX has CLOCK_XXX values but as enums, not as defines.
  82  * The only way to detect these would be to test compile for each. */
  83 # ifdef __hpux
  84 /* However, it seems that at least in HP-UX 11.31 ia64 there *are*
  85  * defines for these, so let's try detecting them. */
  86 #  ifndef CLOCK_REALTIME
  87 #    define CLOCK_REALTIME CLOCK_REALTIME
  88 #    define CLOCK_VIRTUAL  CLOCK_VIRTUAL
  89 #    define CLOCK_PROFILE  CLOCK_PROFILE
  90 #  endif
  91 # endif /* # ifdef __hpux */
  92
  93 #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */
  94
  95 #if defined(WIN32) || defined(CYGWIN_WITH_W32API)
  96
  97 #ifndef HAS_GETTIMEOFDAY
  98 #   define HAS_GETTIMEOFDAY
  99 #endif
 100
 101 /* shows up in winsock.h?
 102 struct timeval {
 103  long tv_sec;
 104  long tv_usec;
 105 }
 106 */
 107
 108 typedef union {
 109     unsigned __int64    ft_i64;
 110     FILETIME            ft_val;
 111 } FT_t;
 112
 113 #define MY_CXT_KEY "Time::HiRes_" XS_VERSION
 114
 115 typedef struct {
 116     unsigned long run_count;
 117     unsigned __int64 base_ticks;
 118     unsigned __int64 tick_frequency;
 119     FT_t base_systime_as_filetime;
 120     unsigned __int64 reset_time;
 121 } my_cxt_t;
 122
 123 START_MY_CXT
 124
 125 /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
 126 #ifdef __GNUC__
 127 # define Const64(x) x##LL
 128 #else
 129 # define Const64(x) x##i64
 130 #endif
 131 #define EPOCH_BIAS  Const64(116444736000000000)
 132
 133 #ifdef Const64
 134 # ifdef __GNUC__
 135 #  define IV_1E6LL  1000000LL /* Needed because of Const64() ##-appends LL (or i64). */
 136 #  define IV_1E7LL  10000000LL
 137 #  define IV_1E9LL  1000000000LL
 138 # else
 139 #  define IV_1E6i64 1000000i64
 140 #  define IV_1E7i64 10000000i64
 141 #  define IV_1E9i64 1000000000i64
 142 # endif
 143 #endif
 144
 145 /* NOTE: This does not compute the timezone info (doing so can be expensive,
 146  * and appears to be unsupported even by glibc) */
 147
 148 /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT
 149    for performance reasons */
 150
 151 #undef gettimeofday
 152 #define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used)
 153
 154 /* If the performance counter delta drifts more than 0.5 seconds from the
 155  * system time then we recalibrate to the system time.  This means we may
 156  * move *backwards* in time! */
 157 #define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */
 158
 159 /* Reset reading from the performance counter every five minutes.
 160  * Many PC clocks just seem to be so bad. */
 161 #define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */
 162
 163 static int
 164 _gettimeofday(pTHX_ struct timeval *tp, void *not_used)
 165 {
 166     dMY_CXT;
 167
 168     unsigned __int64 ticks;
 169     FT_t ft;
 170
 171     if (MY_CXT.run_count++ == 0 ||
 172         MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) {
 173         QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency);
 174         QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks);
 175         GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 176         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 177         MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS;
 178     }
 179     else {
 180         __int64 diff;
 181         QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
 182         ticks -= MY_CXT.base_ticks;
 183         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
 184                     + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency)
 185                     +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency;
 186         diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64;
 187         if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) {
 188             MY_CXT.base_ticks += ticks;
 189             GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 190             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 191         }
 192     }
 193
 194     /* seconds since epoch */
 195     tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7));
 196
 197     /* microseconds remaining */
 198     tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6));
 199
 200     return 0;
 201 }
 202 #endif
 203
 204 #if defined(WIN32) && !defined(ATLEASTFIVEOHOHFIVE)
 205 static unsigned int
 206 sleep(unsigned int t)
 207 {
 208     Sleep(t*1000);
 209     return 0;
 210 }
 211 #endif
 212
 213 #if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
 214 #define HAS_GETTIMEOFDAY
 215
 216 #include <lnmdef.h>
 217 #include <time.h> /* gettimeofday */
 218 #include <stdlib.h> /* qdiv */
 219 #include <starlet.h> /* sys$gettim */
 220 #include <descrip.h>
 221 #ifdef __VAX
 222 #include <lib$routines.h> /* lib$ediv() */
 223 #endif
 224
 225 /*
 226         VMS binary time is expressed in 100 nano-seconds since
 227         system base time which is 17-NOV-1858 00:00:00.00
 228 */
 229
 230 #define DIV_100NS_TO_SECS  10000000L
 231 #define DIV_100NS_TO_USECS 10L
 232
 233 /*
 234         gettimeofday is supposed to return times since the epoch
 235         so need to determine this in terms of VMS base time
 236 */
 237 static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
 238
 239 #ifdef __VAX
 240 static long base_adjust[2]={0L,0L};
 241 #else
 242 static __int64 base_adjust=0;
 243 #endif
 244
 245 /*
 246
 247    If we don't have gettimeofday, then likely we are on a VMS machine that
 248    operates on local time rather than UTC...so we have to zone-adjust.
 249    This code gleefully swiped from VMS.C
 250
 251 */
 252 /* method used to handle UTC conversions:
 253  *   1 == CRTL gmtime();  2 == SYS$TIMEZONE_DIFFERENTIAL;  3 == no correction
 254  */
 255 static int gmtime_emulation_type;
 256 /* number of secs to add to UTC POSIX-style time to get local time */
 257 static long int utc_offset_secs;
 258 static struct dsc$descriptor_s fildevdsc =
 259   { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" };
 260 static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL };
 261
 262 static time_t toutc_dst(time_t loc) {
 263   struct tm *rsltmp;
 264
 265   if ((rsltmp = localtime(&loc)) == NULL) return -1;
 266   loc -= utc_offset_secs;
 267   if (rsltmp->tm_isdst) loc -= 3600;
 268   return loc;
 269 }
 270
 271 static time_t toloc_dst(time_t utc) {
 272   struct tm *rsltmp;
 273
 274   utc += utc_offset_secs;
 275   if ((rsltmp = localtime(&utc)) == NULL) return -1;
 276   if (rsltmp->tm_isdst) utc += 3600;
 277   return utc;
 278 }
 279
 280 #define _toutc(secs)  ((secs) == (time_t) -1 ? (time_t) -1 : \
 281        ((gmtime_emulation_type || timezone_setup()), \
 282        (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
 283        ((secs) - utc_offset_secs))))
 284
 285 #define _toloc(secs)  ((secs) == (time_t) -1 ? (time_t) -1 : \
 286        ((gmtime_emulation_type || timezone_setup()), \
 287        (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
 288        ((secs) + utc_offset_secs))))
 289
 290 static int
 291 timezone_setup(void)
 292 {
 293   struct tm *tm_p;
 294
 295   if (gmtime_emulation_type == 0) {
 296     int dstnow;
 297     time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between    */
 298                               /* results of calls to gmtime() and localtime() */
 299                               /* for same &base */
 300
 301     gmtime_emulation_type++;
 302     if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
 303       char off[LNM$C_NAMLENGTH+1];;
 304
 305       gmtime_emulation_type++;
 306       if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) {
 307         gmtime_emulation_type++;
 308         utc_offset_secs = 0;
 309         Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC");
 310       }
 311       else { utc_offset_secs = atol(off); }
 312     }
 313     else { /* We've got a working gmtime() */
 314       struct tm gmt, local;
 315
 316       gmt = *tm_p;
 317       tm_p = localtime(&base);
 318       local = *tm_p;
 319       utc_offset_secs  = (local.tm_mday - gmt.tm_mday) * 86400;
 320       utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600;
 321       utc_offset_secs += (local.tm_min  - gmt.tm_min)  * 60;
 322       utc_offset_secs += (local.tm_sec  - gmt.tm_sec);
 323     }
 324   }
 325   return 1;
 326 }
 327
 328
 329 int
 330 gettimeofday (struct timeval *tp, void *tpz)
 331 {
 332  long ret;
 333 #ifdef __VAX
 334  long quad[2];
 335  long quad1[2];
 336  long div_100ns_to_secs;
 337  long div_100ns_to_usecs;
 338  long quo,rem;
 339  long quo1,rem1;
 340 #else
 341  __int64 quad;
 342  __qdiv_t ans1,ans2;
 343 #endif
 344 /*
 345         In case of error, tv_usec = 0 and tv_sec = VMS condition code.
 346         The return from function is also set to -1.
 347         This is not exactly as per the manual page.
 348 */
 349
 350  tp->tv_usec = 0;
 351
 352 #ifdef __VAX
 353  if (base_adjust[0]==0 && base_adjust[1]==0) {
 354 #else
 355  if (base_adjust==0) { /* Need to determine epoch adjustment */
 356 #endif
 357         ret=sys$bintim(&dscepoch,&base_adjust);
 358         if (1 != (ret &&1)) {
 359                 tp->tv_sec = ret;
 360                 return -1;
 361         }
 362  }
 363
 364  ret=sys$gettim(&quad); /* Get VMS system time */
 365  if ((1 && ret) == 1) {
 366 #ifdef __VAX
 367         quad[0] -= base_adjust[0]; /* convert to epoch offset */
 368         quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
 369         div_100ns_to_secs = DIV_100NS_TO_SECS;
 370         div_100ns_to_usecs = DIV_100NS_TO_USECS;
 371         lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
 372         quad1[0] = rem;
 373         quad1[1] = 0L;
 374         lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
 375         tp->tv_sec = quo; /* Whole seconds */
 376         tp->tv_usec = quo1; /* Micro-seconds */
 377 #else
 378         quad -= base_adjust; /* convert to epoch offset */
 379         ans1=qdiv(quad,DIV_100NS_TO_SECS);
 380         ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
 381         tp->tv_sec = ans1.quot; /* Whole seconds */
 382         tp->tv_usec = ans2.quot; /* Micro-seconds */
 383 #endif
 384  } else {
 385         tp->tv_sec = ret;
 386         return -1;
 387  }
 388 # ifdef VMSISH_TIME
 389 # ifdef RTL_USES_UTC
 390   if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec);
 391 # else
 392   if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec);
 393 # endif
 394 # endif
 395  return 0;
 396 }
 397 #endif
 398
 399
 400  /* Do not use H A S _ N A N O S L E E P
 401   * so that Perl Configure doesn't scan for it (and pull in -lrt and
 402   * the like which are not usually good ideas for the default Perl).
 403   * (We are part of the core perl now.)
 404   * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
 405 #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
 406 #define HAS_USLEEP
 407 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 408
 409 void
 410 hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */
 411 {
 412     struct timespec res;
 413     res.tv_sec = usec / IV_1E6;
 414     res.tv_nsec = ( usec - res.tv_sec * IV_1E6 ) * 1000;
 415     nanosleep(&res, NULL);
 416 }
 417
 418 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
 419
 420 #if !defined(HAS_USLEEP) && defined(HAS_SELECT)
 421 #ifndef SELECT_IS_BROKEN
 422 #define HAS_USLEEP
 423 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 424
 425 void
 426 hrt_usleep(unsigned long usec)
 427 {
 428     struct timeval tv;
 429     tv.tv_sec = 0;
 430     tv.tv_usec = usec;
 431     select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
 432                 (Select_fd_set_t)NULL, &tv);
 433 }
 434 #endif
 435 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
 436
 437 #if !defined(HAS_USLEEP) && defined(WIN32)
 438 #define HAS_USLEEP
 439 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 440
 441 void
 442 hrt_usleep(unsigned long usec)
 443 {
 444     long msec;
 445     msec = usec / 1000;
 446     Sleep (msec);
 447 }
 448 #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
 449
 450 #if !defined(HAS_USLEEP) && defined(HAS_POLL)
 451 #define HAS_USLEEP
 452 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 453
 454 void
 455 hrt_usleep(unsigned long usec)
 456 {
 457     int msec = usec / 1000;
 458     poll(0, 0, msec);
 459 }
 460
 461 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
 462
 463 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 464
 465 static int
 466 hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval)
 467 {
 468    struct itimerval itv;
 469    itv.it_value.tv_sec = usec / IV_1E6;
 470    itv.it_value.tv_usec = usec % IV_1E6;
 471    itv.it_interval.tv_sec = uinterval / IV_1E6;
 472    itv.it_interval.tv_usec = uinterval % IV_1E6;
 473    return setitimer(ITIMER_REAL, &itv, oitv);
 474 }
 475
 476 int
 477 hrt_ualarm_itimer(int usec, int uinterval)
 478 {
 479   return hrt_ualarm_itimero(NULL, usec, uinterval);
 480 }
 481
 482 #ifdef HAS_UALARM
 483 int
 484 hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
 485 {
 486    return hrt_ualarm_itimer(usec, interval);
 487 }
 488 #endif /* #ifdef HAS_UALARM */
 489 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 490
 491 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
 492 #define HAS_UALARM
 493 #define ualarm hrt_ualarm_itimer  /* could conflict with ncurses for static build */
 494 #endif
 495
 496 #if !defined(HAS_UALARM) && defined(VMS)
 497 #define HAS_UALARM
 498 #define ualarm vms_ualarm
 499
 500 #include <lib$routines.h>
 501 #include <ssdef.h>
 502 #include <starlet.h>
 503 #include <descrip.h>
 504 #include <signal.h>
 505 #include <jpidef.h>
 506 #include <psldef.h>
 507
 508 #define VMSERR(s)   (!((s)&1))
 509
 510 static void
 511 us_to_VMS(useconds_t mseconds, unsigned long v[])
 512 {
 513     int iss;
 514     unsigned long qq[2];
 515
 516     qq[0] = mseconds;
 517     qq[1] = 0;
 518     v[0] = v[1] = 0;
 519
 520     iss = lib$addx(qq,qq,qq);
 521     if (VMSERR(iss)) lib$signal(iss);
 522     iss = lib$subx(v,qq,v);
 523     if (VMSERR(iss)) lib$signal(iss);
 524     iss = lib$addx(qq,qq,qq);
 525     if (VMSERR(iss)) lib$signal(iss);
 526     iss = lib$subx(v,qq,v);
 527     if (VMSERR(iss)) lib$signal(iss);
 528     iss = lib$subx(v,qq,v);
 529     if (VMSERR(iss)) lib$signal(iss);
 530 }
 531
 532 static int
 533 VMS_to_us(unsigned long v[])
 534 {
 535     int iss;
 536     unsigned long div=10,quot, rem;
 537
 538     iss = lib$ediv(&div,v,&quot,&rem);
 539     if (VMSERR(iss)) lib$signal(iss);
 540
 541     return quot;
 542 }
 543
 544 typedef unsigned short word;
 545 typedef struct _ualarm {
 546     int function;
 547     int repeat;
 548     unsigned long delay[2];
 549     unsigned long interval[2];
 550     unsigned long remain[2];
 551 } Alarm;
 552
 553
 554 static int alarm_ef;
 555 static Alarm *a0, alarm_base;
 556 #define UAL_NULL   0
 557 #define UAL_SET    1
 558 #define UAL_CLEAR  2
 559 #define UAL_ACTIVE 4
 560 static void ualarm_AST(Alarm *a);
 561
 562 static int
 563 vms_ualarm(int mseconds, int interval)
 564 {
 565     Alarm *a, abase;
 566     struct item_list3 {
 567         word length;
 568         word code;
 569         void *bufaddr;
 570         void *retlenaddr;
 571     } ;
 572     static struct item_list3 itmlst[2];
 573     static int first = 1;
 574     unsigned long asten;
 575     int iss, enabled;
 576
 577     if (first) {
 578         first = 0;
 579         itmlst[0].code       = JPI$_ASTEN;
 580         itmlst[0].length     = sizeof(asten);
 581         itmlst[0].retlenaddr = NULL;
 582         itmlst[1].code       = 0;
 583         itmlst[1].length     = 0;
 584         itmlst[1].bufaddr    = NULL;
 585         itmlst[1].retlenaddr = NULL;
 586
 587         iss = lib$get_ef(&alarm_ef);
 588         if (VMSERR(iss)) lib$signal(iss);
 589
 590         a0 = &alarm_base;
 591         a0->function = UAL_NULL;
 592     }
 593     itmlst[0].bufaddr    = &asten;
 594
 595     iss = sys$getjpiw(0,0,0,itmlst,0,0,0);
 596     if (VMSERR(iss)) lib$signal(iss);
 597     if (!(asten&0x08)) return -1;
 598
 599     a = &abase;
 600     if (mseconds) {
 601         a->function = UAL_SET;
 602     } else {
 603         a->function = UAL_CLEAR;
 604     }
 605
 606     us_to_VMS(mseconds, a->delay);
 607     if (interval) {
 608         us_to_VMS(interval, a->interval);
 609         a->repeat = 1;
 610     } else
 611         a->repeat = 0;
 612
 613     iss = sys$clref(alarm_ef);
 614     if (VMSERR(iss)) lib$signal(iss);
 615
 616     iss = sys$dclast(ualarm_AST,a,0);
 617     if (VMSERR(iss)) lib$signal(iss);
 618
 619     iss = sys$waitfr(alarm_ef);
 620     if (VMSERR(iss)) lib$signal(iss);
 621
 622     if (a->function == UAL_ACTIVE)
 623         return VMS_to_us(a->remain);
 624     else
 625         return 0;
 626 }
 627
 628
 629
 630 static void
 631 ualarm_AST(Alarm *a)
 632 {
 633     int iss;
 634     unsigned long now[2];
 635
 636     iss = sys$gettim(now);
 637     if (VMSERR(iss)) lib$signal(iss);
 638
 639     if (a->function == UAL_SET || a->function == UAL_CLEAR) {
 640         if (a0->function == UAL_ACTIVE) {
 641             iss = sys$cantim(a0,PSL$C_USER);
 642             if (VMSERR(iss)) lib$signal(iss);
 643
 644             iss = lib$subx(a0->remain, now, a->remain);
 645             if (VMSERR(iss)) lib$signal(iss);
 646
 647             if (a->remain[1] & 0x80000000)
 648                 a->remain[0] = a->remain[1] = 0;
 649         }
 650
 651         if (a->function == UAL_SET) {
 652             a->function = a0->function;
 653             a0->function = UAL_ACTIVE;
 654             a0->repeat = a->repeat;
 655             if (a0->repeat) {
 656                 a0->interval[0] = a->interval[0];
 657                 a0->interval[1] = a->interval[1];
 658             }
 659             a0->delay[0] = a->delay[0];
 660             a0->delay[1] = a->delay[1];
 661
 662             iss = lib$subx(now, a0->delay, a0->remain);
 663             if (VMSERR(iss)) lib$signal(iss);
 664
 665             iss = sys$setimr(0,a0->delay,ualarm_AST,a0);
 666             if (VMSERR(iss)) lib$signal(iss);
 667         } else {
 668             a->function = a0->function;
 669             a0->function = UAL_NULL;
 670         }
 671         iss = sys$setef(alarm_ef);
 672         if (VMSERR(iss)) lib$signal(iss);
 673     } else if (a->function == UAL_ACTIVE) {
 674         if (a->repeat) {
 675             iss = lib$subx(now, a->interval, a->remain);
 676             if (VMSERR(iss)) lib$signal(iss);
 677
 678             iss = sys$setimr(0,a->interval,ualarm_AST,a);
 679             if (VMSERR(iss)) lib$signal(iss);
 680         } else {
 681             a->function = UAL_NULL;
 682         }
 683         iss = sys$wake(0,0);
 684         if (VMSERR(iss)) lib$signal(iss);
 685         lib$signal(SS$_ASTFLT);
 686     } else {
 687         lib$signal(SS$_BADPARAM);
 688     }
 689 }
 690
 691 #endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 692
 693 #ifdef HAS_GETTIMEOFDAY
 694
 695 static int
 696 myU2time(pTHX_ UV *ret)
 697 {
 698   struct timeval Tp;
 699   int status;
 700   status = gettimeofday (&Tp, NULL);
 701   ret[0] = Tp.tv_sec;
 702   ret[1] = Tp.tv_usec;
 703   return status;
 704 }
 705
 706 static NV
 707 myNVtime()
 708 {
 709 #ifdef WIN32
 710   dTHX;
 711 #endif
 712   struct timeval Tp;
 713   int status;
 714   status = gettimeofday (&Tp, NULL);
 715   return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
 716 }
 717
 718 #endif /* #ifdef HAS_GETTIMEOFDAY */
 719
 720 static void
 721 hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
 722 {
 723   dTHXR;
 724 #if TIME_HIRES_STAT == 1
 725   *atime_nsec = PL_statcache.st_atimespec.tv_nsec;
 726   *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec;
 727   *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec;
 728 #elif TIME_HIRES_STAT == 2
 729   *atime_nsec = PL_statcache.st_atimensec;
 730   *mtime_nsec = PL_statcache.st_mtimensec;
 731   *ctime_nsec = PL_statcache.st_ctimensec;
 732 #elif TIME_HIRES_STAT == 3
 733   *atime_nsec = PL_statcache.st_atime_n;
 734   *mtime_nsec = PL_statcache.st_mtime_n;
 735   *ctime_nsec = PL_statcache.st_ctime_n;
 736 #elif TIME_HIRES_STAT == 4
 737   *atime_nsec = PL_statcache.st_atim.tv_nsec;
 738   *mtime_nsec = PL_statcache.st_mtim.tv_nsec;
 739   *ctime_nsec = PL_statcache.st_ctim.tv_nsec;
 740 #elif TIME_HIRES_STAT == 5
 741   *atime_nsec = PL_statcache.st_uatime * 1000;
 742   *mtime_nsec = PL_statcache.st_umtime * 1000;
 743   *ctime_nsec = PL_statcache.st_uctime * 1000;
 744 #else /* !TIME_HIRES_STAT */
 745   *atime_nsec = 0;
 746   *mtime_nsec = 0;
 747   *ctime_nsec = 0;
 748 #endif /* !TIME_HIRES_STAT */
 749 }
 750
 751 #include "const-c.inc"
 752
 753 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 754
 755 PROTOTYPES: ENABLE
 756
 757 BOOT:
 758 {
 759 #ifdef MY_CXT_KEY
 760   MY_CXT_INIT;
 761 #endif
 762 #ifdef ATLEASTFIVEOHOHFIVE
 763 #   ifdef HAS_GETTIMEOFDAY
 764   {
 765     (void) hv_store(PL_modglobal, "Time::NVtime", 12,
 766                 newSViv(PTR2IV(myNVtime)), 0);
 767     (void) hv_store(PL_modglobal, "Time::U2time", 12,
 768                 newSViv(PTR2IV(myU2time)), 0);
 769   }
 770 #   endif
 771 #endif
 772 }
 773
 774 #if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
 775
 776 void
 777 CLONE(...)
 778     CODE:
 779     MY_CXT_CLONE;
 780
 781 #endif
 782
 783 INCLUDE: const-xs.inc
 784
 785 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 786
 787 NV
 788 usleep(useconds)
 789         NV useconds
 790         PREINIT:
 791         struct timeval Ta, Tb;
 792         CODE:
 793         gettimeofday(&Ta, NULL);
 794         if (items > 0) {
 795             if (useconds > 1E6) {
 796                 IV seconds = (IV) (useconds / 1E6);
 797                 /* If usleep() has been implemented using setitimer()
 798                  * then this contortion is unnecessary-- but usleep()
 799                  * may be implemented in some other way, so let's contort. */
 800                 if (seconds) {
 801                     sleep(seconds);
 802                     useconds -= 1E6 * seconds;
 803                 }
 804             } else if (useconds < 0.0)
 805                 croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds);
 806             usleep((U32)useconds);
 807         } else
 808             PerlProc_pause();
 809         gettimeofday(&Tb, NULL);
 810 #if 0
 811         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 812 #endif
 813         RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
 814
 815         OUTPUT:
 816         RETVAL
 817
 818 #if defined(TIME_HIRES_NANOSLEEP)
 819
 820 NV
 821 nanosleep(nsec)
 822         NV nsec
 823         PREINIT:
 824         struct timespec sleepfor, unslept;
 825         CODE:
 826         if (nsec < 0.0)
 827             croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
 828         sleepfor.tv_sec = (Time_t)(nsec / 1e9);
 829         sleepfor.tv_nsec = (long)(nsec - ((NV)sleepfor.tv_sec) * 1e9);
 830         if (!nanosleep(&sleepfor, &unslept)) {
 831             RETVAL = nsec;
 832         } else {
 833             sleepfor.tv_sec -= unslept.tv_sec;
 834             sleepfor.tv_nsec -= unslept.tv_nsec;
 835             if (sleepfor.tv_nsec < 0) {
 836                 sleepfor.tv_sec--;
 837                 sleepfor.tv_nsec += 1000000000;
 838             }
 839             RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
 840         }
 841     OUTPUT:
 842         RETVAL
 843
 844 #else  /* #if defined(TIME_HIRES_NANOSLEEP) */
 845
 846 NV
 847 nanosleep(nsec)
 848         NV nsec
 849     CODE:
 850         croak("Time::HiRes::nanosleep(): unimplemented in this platform");
 851         RETVAL = 0.0;
 852
 853 #endif /* #if defined(TIME_HIRES_NANOSLEEP) */
 854
 855 NV
 856 sleep(...)
 857         PREINIT:
 858         struct timeval Ta, Tb;
 859         CODE:
 860         gettimeofday(&Ta, NULL);
 861         if (items > 0) {
 862             NV seconds  = SvNV(ST(0));
 863             if (seconds >= 0.0) {
 864                  UV useconds = (UV)(1E6 * (seconds - (UV)seconds));
 865                  if (seconds >= 1.0)
 866                      sleep((U32)seconds);
 867                  if ((IV)useconds < 0) {
 868 #if defined(__sparc64__) && defined(__GNUC__)
 869                    /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug
 870                     * where (0.5 - (UV)(0.5)) will under certain
 871                     * circumstances (if the double is cast to UV more
 872                     * than once?) evaluate to -0.5, instead of 0.5. */
 873                    useconds = -(IV)useconds;
 874 #endif /* #if defined(__sparc64__) && defined(__GNUC__) */
 875                    if ((IV)useconds < 0)
 876                      croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds);
 877                  }
 878                  usleep(useconds);
 879             } else
 880                 croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds);
 881         } else
 882             PerlProc_pause();
 883         gettimeofday(&Tb, NULL);
 884 #if 0
 885         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 886 #endif
 887         RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
 888
 889         OUTPUT:
 890         RETVAL
 891
 892 #else  /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 893
 894 NV
 895 usleep(useconds)
 896         NV useconds
 897     CODE:
 898         croak("Time::HiRes::usleep(): unimplemented in this platform");
 899         RETVAL = 0.0;
 900
 901 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 902
 903 #ifdef HAS_UALARM
 904
 905 IV
 906 ualarm(useconds,uinterval=0)
 907         int useconds
 908         int uinterval
 909         CODE:
 910         if (useconds < 0 || uinterval < 0)
 911             croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval);
 912 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 913           {
 914                 struct itimerval itv;
 915                 if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
 916                   /* To conform to ualarm's interface, we're actually ignoring
 917                      an error here.  */
 918                   RETVAL = 0;
 919                 } else {
 920                   RETVAL = itv.it_value.tv_sec * IV_1E6 + itv.it_value.tv_usec;
 921                 }
 922           }
 923 #else
 924         if (useconds >= IV_1E6 || uinterval >= IV_1E6)
 925                 croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval equal to or more than %"IVdf, useconds, uinterval, IV_1E6);
 926         RETVAL = ualarm(useconds, uinterval);
 927 #endif
 928
 929         OUTPUT:
 930         RETVAL
 931
 932 NV
 933 alarm(seconds,interval=0)
 934         NV seconds
 935         NV interval
 936         CODE:
 937         if (seconds < 0.0 || interval < 0.0)
 938             croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
 939         {
 940           IV useconds     = IV_1E6 * seconds;
 941           IV uinterval    = IV_1E6 * interval;
 942 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 943           {
 944                 struct itimerval itv;
 945                 if (hrt_ualarm_itimero(&itv, useconds, uinterval)) {
 946                   /* To conform to alarm's interface, we're actually ignoring
 947                      an error here.  */
 948                   RETVAL = 0;
 949                 } else {
 950                   RETVAL = itv.it_value.tv_sec + ((NV)itv.it_value.tv_usec) / NV_1E6;
 951                 }
 952           }
 953 #else
 954           if (useconds >= IV_1E6 || uinterval >= IV_1E6)
 955                 croak("Time::HiRes::alarm(%d, %d): seconds or interval equal to or more than 1.0 ", useconds, uinterval, IV_1E6);
 956             RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6;
 957 #endif
 958         }
 959
 960         OUTPUT:
 961         RETVAL
 962
 963 #else
 964
 965 int
 966 ualarm(useconds,interval=0)
 967         int useconds
 968         int interval
 969     CODE:
 970         croak("Time::HiRes::ualarm(): unimplemented in this platform");
 971         RETVAL = -1;
 972
 973 NV
 974 alarm(seconds,interval=0)
 975         NV seconds
 976         NV interval
 977     CODE:
 978         croak("Time::HiRes::alarm(): unimplemented in this platform");
 979         RETVAL = 0.0;
 980
 981 #endif /* #ifdef HAS_UALARM */
 982
 983 #ifdef HAS_GETTIMEOFDAY
 984 #    ifdef MACOS_TRADITIONAL    /* fix epoch TZ and use unsigned time_t */
 985 void
 986 gettimeofday()
 987         PREINIT:
 988         struct timeval Tp;
 989         struct timezone Tz;
 990         PPCODE:
 991         int status;
 992         status = gettimeofday (&Tp, &Tz);
 993
 994         if (status == 0) {
 995              Tp.tv_sec += Tz.tz_minuteswest * 60;       /* adjust for TZ */
 996              if (GIMME == G_ARRAY) {
 997                  EXTEND(sp, 2);
 998                  /* Mac OS (Classic) has unsigned time_t */
 999                  PUSHs(sv_2mortal(newSVuv(Tp.tv_sec)));
1000                  PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
1001              } else {
1002                  EXTEND(sp, 1);
1003                  PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
1004              }
1005         }
1006
1007 NV
1008 time()
1009         PREINIT:
1010         struct timeval Tp;
1011         struct timezone Tz;
1012         CODE:
1013         int status;
1014         status = gettimeofday (&Tp, &Tz);
1015         if (status == 0) {
1016             Tp.tv_sec += Tz.tz_minuteswest * 60;        /* adjust for TZ */
1017             RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1018         } else {
1019             RETVAL = -1.0;
1020         }
1021         OUTPUT:
1022         RETVAL
1023
1024 #    else       /* MACOS_TRADITIONAL */
1025 void
1026 gettimeofday()
1027         PREINIT:
1028         struct timeval Tp;
1029         PPCODE:
1030         int status;
1031         status = gettimeofday (&Tp, NULL);
1032         if (status == 0) {
1033              if (GIMME == G_ARRAY) {
1034                  EXTEND(sp, 2);
1035                  PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
1036                  PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
1037              } else {
1038                  EXTEND(sp, 1);
1039                  PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
1040              }
1041         }
1042
1043 NV
1044 time()
1045         PREINIT:
1046         struct timeval Tp;
1047         CODE:
1048         int status;
1049         status = gettimeofday (&Tp, NULL);
1050         if (status == 0) {
1051             RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1052         } else {
1053             RETVAL = -1.0;
1054         }
1055         OUTPUT:
1056         RETVAL
1057
1058 #    endif      /* MACOS_TRADITIONAL */
1059 #endif /* #ifdef HAS_GETTIMEOFDAY */
1060
1061 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
1062
1063 #define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
1064
1065 void
1066 setitimer(which, seconds, interval = 0)
1067         int which
1068         NV seconds
1069         NV interval
1070     PREINIT:
1071         struct itimerval newit;
1072         struct itimerval oldit;
1073     PPCODE:
1074         if (seconds < 0.0 || interval < 0.0)
1075             croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", (IV)which, seconds, interval);
1076         newit.it_value.tv_sec  = (IV)seconds;
1077         newit.it_value.tv_usec =
1078           (IV)((seconds  - (NV)newit.it_value.tv_sec)    * NV_1E6);
1079         newit.it_interval.tv_sec  = (IV)interval;
1080         newit.it_interval.tv_usec =
1081           (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6);
1082         if (setitimer(which, &newit, &oldit) == 0) {
1083           EXTEND(sp, 1);
1084           PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
1085           if (GIMME == G_ARRAY) {
1086             EXTEND(sp, 1);
1087             PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
1088           }
1089         }
1090
1091 void
1092 getitimer(which)
1093         int which
1094     PREINIT:
1095         struct itimerval nowit;
1096     PPCODE:
1097         if (getitimer(which, &nowit) == 0) {
1098           EXTEND(sp, 1);
1099           PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
1100           if (GIMME == G_ARRAY) {
1101             EXTEND(sp, 1);
1102             PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
1103           }
1104         }
1105
1106 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
1107
1108 #if defined(TIME_HIRES_CLOCK_GETTIME)
1109
1110 NV
1111 clock_gettime(clock_id = CLOCK_REALTIME)
1112         int clock_id
1113     PREINIT:
1114         struct timespec ts;
1115         int status = -1;
1116     CODE:
1117 #ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
1118         status = syscall(SYS_clock_gettime, clock_id, &ts);
1119 #else
1120         status = clock_gettime(clock_id, &ts);
1121 #endif
1122         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
1123
1124     OUTPUT:
1125         RETVAL
1126
1127 #else  /* if defined(TIME_HIRES_CLOCK_GETTIME) */
1128
1129 NV
1130 clock_gettime(clock_id = 0)
1131         int clock_id
1132     CODE:
1133         croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
1134         RETVAL = 0.0;
1135
1136 #endif /*  #if defined(TIME_HIRES_CLOCK_GETTIME) */
1137
1138 #if defined(TIME_HIRES_CLOCK_GETRES)
1139
1140 NV
1141 clock_getres(clock_id = CLOCK_REALTIME)
1142         int clock_id
1143     PREINIT:
1144         int status = -1;
1145         struct timespec ts;
1146     CODE:
1147 #ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL
1148         status = syscall(SYS_clock_getres, clock_id, &ts);
1149 #else
1150         status = clock_getres(clock_id, &ts);
1151 #endif
1152         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
1153
1154     OUTPUT:
1155         RETVAL
1156
1157 #else  /* if defined(TIME_HIRES_CLOCK_GETRES) */
1158
1159 NV
1160 clock_getres(clock_id = 0)
1161         int clock_id
1162     CODE:
1163         croak("Time::HiRes::clock_getres(): unimplemented in this platform");
1164         RETVAL = 0.0;
1165
1166 #endif /*  #if defined(TIME_HIRES_CLOCK_GETRES) */
1167
1168 #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
1169
1170 NV
1171 clock_nanosleep(clock_id, nsec, flags = 0)
1172         int clock_id
1173         NV  nsec
1174         int flags
1175     PREINIT:
1176         struct timespec sleepfor, unslept;
1177     CODE:
1178         if (nsec < 0.0)
1179             croak("Time::HiRes::clock_nanosleep(..., %"NVgf"): negative time not invented yet", nsec);
1180         sleepfor.tv_sec = (Time_t)(nsec / 1e9);
1181         sleepfor.tv_nsec = (long)(nsec - ((NV)sleepfor.tv_sec) * 1e9);
1182         if (!clock_nanosleep(clock_id, flags, &sleepfor, &unslept)) {
1183             RETVAL = nsec;
1184         } else {
1185             sleepfor.tv_sec -= unslept.tv_sec;
1186             sleepfor.tv_nsec -= unslept.tv_nsec;
1187             if (sleepfor.tv_nsec < 0) {
1188                 sleepfor.tv_sec--;
1189                 sleepfor.tv_nsec += 1000000000;
1190             }
1191             RETVAL = ((NV)sleepfor.tv_sec) * 1e9 + ((NV)sleepfor.tv_nsec);
1192         }
1193     OUTPUT:
1194         RETVAL
1195
1196 #else  /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1197
1198 NV
1199 clock_nanosleep()
1200     CODE:
1201         croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform");
1202         RETVAL = 0.0;
1203
1204 #endif /*  #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1205
1206 #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC)
1207
1208 NV
1209 clock()
1210     PREINIT:
1211         clock_t clocks;
1212     CODE:
1213         clocks = clock();
1214         RETVAL = clocks == -1 ? -1 : (NV)clocks / (NV)CLOCKS_PER_SEC;
1215
1216     OUTPUT:
1217         RETVAL
1218
1219 #else  /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1220
1221 NV
1222 clock()
1223     CODE:
1224         croak("Time::HiRes::clock(): unimplemented in this platform");
1225         RETVAL = 0.0;
1226
1227 #endif /*  #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1228
1229 void
1230 stat(...)
1231 PROTOTYPE: ;$
1232     PPCODE:
1233         PUSHMARK(SP);
1234         XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
1235         PUTBACK;
1236         ENTER;
1237         PL_laststatval = -1;
1238         (void)*(PL_ppaddr[OP_STAT])(aTHXR);
1239         SPAGAIN;
1240         LEAVE;
1241         if (PL_laststatval == 0) {
1242           /* We assume that pp_stat() left us with 13 valid stack items,
1243            * and that the timestamps are at offsets 8, 9, and 10. */
1244           UV atime = SvUV(ST( 8));
1245           UV mtime = SvUV(ST( 9));
1246           UV ctime = SvUV(ST(10));
1247           UV atime_nsec;
1248           UV mtime_nsec;
1249           UV ctime_nsec;
1250           hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec);
1251           if (atime_nsec)
1252             ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec));
1253           if (mtime_nsec)
1254             ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec));
1255           if (ctime_nsec)
1256             ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec));
1257           XSRETURN(13);
1258         }
1259         XSRETURN(0);