ext/Time/HiRes/HiRes.xs

   1 /*
   2  *
   3  * Copyright (c) 1996-2002 Douglas E. Wegscheid.  All rights reserved.
   4  *
   5  * Copyright (c) 2002,2003,2004,2005,2006 Jarkko Hietaniemi.  All rights reserved.
   6  *
   7  * This program is free software; you can redistribute it and/or modify
   8  * it under the same terms as Perl itself.
   9  */
  10
  11 #ifdef __cplusplus
  12 extern "C" {
  13 #endif
  14 #define PERL_NO_GET_CONTEXT
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17 #include "XSUB.h"
  18 #include "ppport.h"
  19 #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
  20 # include <w32api/windows.h>
  21 # define CYGWIN_WITH_W32API
  22 #endif
  23 #ifdef WIN32
  24 # include <time.h>
  25 #else
  26 # include <sys/time.h>
  27 #endif
  28 #ifdef HAS_SELECT
  29 # ifdef I_SYS_SELECT
  30 #  include <sys/select.h>
  31 # endif
  32 #endif
  33 #if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL)
  34 #include <syscall.h>
  35 #endif
  36 #ifdef __cplusplus
  37 }
  38 #endif
  39
  40 #define IV_1E6 1000000
  41 #define IV_1E7 10000000
  42 #define IV_1E9 1000000000
  43
  44 #define NV_1E6 1000000.0
  45 #define NV_1E7 10000000.0
  46 #define NV_1E9 1000000000.0
  47
  48 #ifndef PerlProc_pause
  49 #   define PerlProc_pause() Pause()
  50 #endif
  51
  52 #ifdef HAS_PAUSE
  53 #   define Pause   pause
  54 #else
  55 #   undef Pause /* In case perl.h did it already. */
  56 #   define Pause() sleep(~0) /* Zzz for a long time. */
  57 #endif
  58
  59 /* Though the cpp define ITIMER_VIRTUAL is available the functionality
  60  * is not supported in Cygwin as of August 2004, ditto for Win32.
  61  * Neither are ITIMER_PROF or ITIMER_REALPROF implemented.  --jhi
  62  */
  63 #if defined(__CYGWIN__) || defined(WIN32)
  64 #   undef ITIMER_VIRTUAL
  65 #   undef ITIMER_PROF
  66 #   undef ITIMER_REALPROF
  67 #endif
  68
  69 /* 5.004 doesn't define PL_sv_undef */
  70 #ifndef ATLEASTFIVEOHOHFIVE
  71 # ifndef PL_sv_undef
  72 #  define PL_sv_undef sv_undef
  73 # endif
  74 #endif
  75
  76 /* PL_ppaddr is not available in Perl 5.005_04 */
  77 #if (PERL_VERSION < 5) || (PERL_VERSION == 5 && PERL_SUBVERSION <50)
  78 # ifndef PL_ppaddr
  79 #  define PL_ppaddr ppaddr
  80 # endif
  81 #endif
  82
  83 #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC)
  84
  85 /* HP-UX has CLOCK_XXX values but as enums, not as defines.
  86  * The only way to detect these would be to test compile for each. */
  87 # ifdef __hpux
  88 #  define CLOCK_REALTIME CLOCK_REALTIME
  89 #  define CLOCK_VIRTUAL  CLOCK_VIRTUAL
  90 #  define CLOCK_PROFILE  CLOCK_PROFILE
  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_nanosleep  /* could conflict with ncurses for static build */
 408
 409 void
 410 hrt_nanosleep(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(TIME_HIRES_NANOSLEEP)
 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         struct timespec ts1;
 458         ts1.tv_sec  = usec * 1000; /* Ignoring wraparound. */
 459         ts1.tv_nsec = 0;
 460         nanosleep(&ts1, NULL);
 461 }
 462
 463 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
 464
 465 #if !defined(HAS_USLEEP) && defined(HAS_POLL)
 466 #define HAS_USLEEP
 467 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 468
 469 void
 470 hrt_usleep(unsigned long usec)
 471 {
 472     int msec = usec / 1000;
 473     poll(0, 0, msec);
 474 }
 475
 476 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */
 477
 478 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 479 int
 480 hrt_ualarm_itimer(int usec, int interval)
 481 {
 482    struct itimerval itv;
 483    itv.it_value.tv_sec = usec / IV_1E6;
 484    itv.it_value.tv_usec = usec % IV_1E6;
 485    itv.it_interval.tv_sec = interval / IV_1E6;
 486    itv.it_interval.tv_usec = interval % IV_1E6;
 487    return setitimer(ITIMER_REAL, &itv, 0);
 488 }
 489 #ifdef HAS_UALARM
 490 int
 491 hrt_ualarm(int usec, int interval) /* for binary compat before 1.91 */
 492 {
 493    return hrt_ualarm_itimer(usec, interval);
 494 }
 495 #endif /* #ifdef HAS_UALARM */
 496 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 497
 498 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
 499 #define HAS_UALARM
 500 #define ualarm hrt_ualarm_itimer  /* could conflict with ncurses for static build */
 501 #endif
 502
 503 #if !defined(HAS_UALARM) && defined(VMS)
 504 #define HAS_UALARM
 505 #define ualarm vms_ualarm
 506
 507 #include <lib$routines.h>
 508 #include <ssdef.h>
 509 #include <starlet.h>
 510 #include <descrip.h>
 511 #include <signal.h>
 512 #include <jpidef.h>
 513 #include <psldef.h>
 514
 515 #define VMSERR(s)   (!((s)&1))
 516
 517 static void
 518 us_to_VMS(useconds_t mseconds, unsigned long v[])
 519 {
 520     int iss;
 521     unsigned long qq[2];
 522
 523     qq[0] = mseconds;
 524     qq[1] = 0;
 525     v[0] = v[1] = 0;
 526
 527     iss = lib$addx(qq,qq,qq);
 528     if (VMSERR(iss)) lib$signal(iss);
 529     iss = lib$subx(v,qq,v);
 530     if (VMSERR(iss)) lib$signal(iss);
 531     iss = lib$addx(qq,qq,qq);
 532     if (VMSERR(iss)) lib$signal(iss);
 533     iss = lib$subx(v,qq,v);
 534     if (VMSERR(iss)) lib$signal(iss);
 535     iss = lib$subx(v,qq,v);
 536     if (VMSERR(iss)) lib$signal(iss);
 537 }
 538
 539 static int
 540 VMS_to_us(unsigned long v[])
 541 {
 542     int iss;
 543     unsigned long div=10,quot, rem;
 544
 545     iss = lib$ediv(&div,v,&quot,&rem);
 546     if (VMSERR(iss)) lib$signal(iss);
 547
 548     return quot;
 549 }
 550
 551 typedef unsigned short word;
 552 typedef struct _ualarm {
 553     int function;
 554     int repeat;
 555     unsigned long delay[2];
 556     unsigned long interval[2];
 557     unsigned long remain[2];
 558 } Alarm;
 559
 560
 561 static int alarm_ef;
 562 static Alarm *a0, alarm_base;
 563 #define UAL_NULL   0
 564 #define UAL_SET    1
 565 #define UAL_CLEAR  2
 566 #define UAL_ACTIVE 4
 567 static void ualarm_AST(Alarm *a);
 568
 569 static int
 570 vms_ualarm(int mseconds, int interval)
 571 {
 572     Alarm *a, abase;
 573     struct item_list3 {
 574         word length;
 575         word code;
 576         void *bufaddr;
 577         void *retlenaddr;
 578     } ;
 579     static struct item_list3 itmlst[2];
 580     static int first = 1;
 581     unsigned long asten;
 582     int iss, enabled;
 583
 584     if (first) {
 585         first = 0;
 586         itmlst[0].code       = JPI$_ASTEN;
 587         itmlst[0].length     = sizeof(asten);
 588         itmlst[0].retlenaddr = NULL;
 589         itmlst[1].code       = 0;
 590         itmlst[1].length     = 0;
 591         itmlst[1].bufaddr    = NULL;
 592         itmlst[1].retlenaddr = NULL;
 593
 594         iss = lib$get_ef(&alarm_ef);
 595         if (VMSERR(iss)) lib$signal(iss);
 596
 597         a0 = &alarm_base;
 598         a0->function = UAL_NULL;
 599     }
 600     itmlst[0].bufaddr    = &asten;
 601
 602     iss = sys$getjpiw(0,0,0,itmlst,0,0,0);
 603     if (VMSERR(iss)) lib$signal(iss);
 604     if (!(asten&0x08)) return -1;
 605
 606     a = &abase;
 607     if (mseconds) {
 608         a->function = UAL_SET;
 609     } else {
 610         a->function = UAL_CLEAR;
 611     }
 612
 613     us_to_VMS(mseconds, a->delay);
 614     if (interval) {
 615         us_to_VMS(interval, a->interval);
 616         a->repeat = 1;
 617     } else
 618         a->repeat = 0;
 619
 620     iss = sys$clref(alarm_ef);
 621     if (VMSERR(iss)) lib$signal(iss);
 622
 623     iss = sys$dclast(ualarm_AST,a,0);
 624     if (VMSERR(iss)) lib$signal(iss);
 625
 626     iss = sys$waitfr(alarm_ef);
 627     if (VMSERR(iss)) lib$signal(iss);
 628
 629     if (a->function == UAL_ACTIVE)
 630         return VMS_to_us(a->remain);
 631     else
 632         return 0;
 633 }
 634
 635
 636
 637 static void
 638 ualarm_AST(Alarm *a)
 639 {
 640     int iss;
 641     unsigned long now[2];
 642
 643     iss = sys$gettim(now);
 644     if (VMSERR(iss)) lib$signal(iss);
 645
 646     if (a->function == UAL_SET || a->function == UAL_CLEAR) {
 647         if (a0->function == UAL_ACTIVE) {
 648             iss = sys$cantim(a0,PSL$C_USER);
 649             if (VMSERR(iss)) lib$signal(iss);
 650
 651             iss = lib$subx(a0->remain, now, a->remain);
 652             if (VMSERR(iss)) lib$signal(iss);
 653
 654             if (a->remain[1] & 0x80000000)
 655                 a->remain[0] = a->remain[1] = 0;
 656         }
 657
 658         if (a->function == UAL_SET) {
 659             a->function = a0->function;
 660             a0->function = UAL_ACTIVE;
 661             a0->repeat = a->repeat;
 662             if (a0->repeat) {
 663                 a0->interval[0] = a->interval[0];
 664                 a0->interval[1] = a->interval[1];
 665             }
 666             a0->delay[0] = a->delay[0];
 667             a0->delay[1] = a->delay[1];
 668
 669             iss = lib$subx(now, a0->delay, a0->remain);
 670             if (VMSERR(iss)) lib$signal(iss);
 671
 672             iss = sys$setimr(0,a0->delay,ualarm_AST,a0);
 673             if (VMSERR(iss)) lib$signal(iss);
 674         } else {
 675             a->function = a0->function;
 676             a0->function = UAL_NULL;
 677         }
 678         iss = sys$setef(alarm_ef);
 679         if (VMSERR(iss)) lib$signal(iss);
 680     } else if (a->function == UAL_ACTIVE) {
 681         if (a->repeat) {
 682             iss = lib$subx(now, a->interval, a->remain);
 683             if (VMSERR(iss)) lib$signal(iss);
 684
 685             iss = sys$setimr(0,a->interval,ualarm_AST,a);
 686             if (VMSERR(iss)) lib$signal(iss);
 687         } else {
 688             a->function = UAL_NULL;
 689         }
 690         iss = sys$wake(0,0);
 691         if (VMSERR(iss)) lib$signal(iss);
 692         lib$signal(SS$_ASTFLT);
 693     } else {
 694         lib$signal(SS$_BADPARAM);
 695     }
 696 }
 697
 698 #endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 699
 700 #ifdef HAS_GETTIMEOFDAY
 701
 702 static int
 703 myU2time(pTHX_ UV *ret)
 704 {
 705   struct timeval Tp;
 706   int status;
 707   status = gettimeofday (&Tp, NULL);
 708   ret[0] = Tp.tv_sec;
 709   ret[1] = Tp.tv_usec;
 710   return status;
 711 }
 712
 713 static NV
 714 myNVtime()
 715 {
 716 #ifdef WIN32
 717   dTHX;
 718 #endif
 719   struct timeval Tp;
 720   int status;
 721   status = gettimeofday (&Tp, NULL);
 722   return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0;
 723 }
 724
 725 #endif /* #ifdef HAS_GETTIMEOFDAY */
 726
 727 static void
 728 hrstatns(UV atime, UV mtime, UV ctime, UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec)
 729 {
 730   dTHX;
 731   *atime_nsec = 0;
 732   *mtime_nsec = 0;
 733   *ctime_nsec = 0;
 734 #ifdef TIME_HIRES_STAT
 735 #if TIME_HIRES_STAT == 1
 736   *atime_nsec = PL_statcache.st_atimespec.tv_nsec;
 737   *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec;
 738   *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec;
 739 #endif
 740 #if TIME_HIRES_STAT == 2
 741   *atime_nsec = PL_statcache.st_atimensec;
 742   *mtime_nsec = PL_statcache.st_mtimensec;
 743   *ctime_nsec = PL_statcache.st_ctimensec;
 744 #endif
 745 #if TIME_HIRES_STAT == 3
 746   *atime_nsec = PL_statcache.st_atime_n;
 747   *mtime_nsec = PL_statcache.st_mtime_n;
 748   *ctime_nsec = PL_statcache.st_ctime_n;
 749 #endif
 750 #if TIME_HIRES_STAT == 4
 751   *atime_nsec = PL_statcache.st_atim.tv_nsec;
 752   *mtime_nsec = PL_statcache.st_mtim.tv_nsec;
 753   *ctime_nsec = PL_statcache.st_ctim.tv_nsec;
 754 #endif
 755 #if TIME_HIRES_STAT == 5
 756   *atime_nsec = PL_statcache.st_uatime * 1000;
 757   *mtime_nsec = PL_statcache.st_umtime * 1000;
 758   *ctime_nsec = PL_statcache.st_uctime * 1000;
 759 #endif
 760 #endif
 761 }
 762
 763 #include "const-c.inc"
 764
 765 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 766
 767 PROTOTYPES: ENABLE
 768
 769 BOOT:
 770 {
 771 #ifdef MY_CXT_KEY
 772   MY_CXT_INIT;
 773 #endif
 774 #ifdef ATLEASTFIVEOHOHFIVE
 775 #ifdef HAS_GETTIMEOFDAY
 776   {
 777     hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
 778     hv_store(PL_modglobal, "Time::U2time", 12, newSViv(PTR2IV(myU2time)), 0);
 779   }
 780 #endif
 781 #endif
 782 }
 783
 784 #if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
 785
 786 void
 787 CLONE(...)
 788     CODE:
 789     MY_CXT_CLONE;
 790
 791 #endif
 792
 793 INCLUDE: const-xs.inc
 794
 795 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 796
 797 NV
 798 usleep(useconds)
 799         NV useconds
 800         PREINIT:
 801         struct timeval Ta, Tb;
 802         CODE:
 803         gettimeofday(&Ta, NULL);
 804         if (items > 0) {
 805             if (useconds > 1E6) {
 806                 IV seconds = (IV) (useconds / 1E6);
 807                 /* If usleep() has been implemented using setitimer()
 808                  * then this contortion is unnecessary-- but usleep()
 809                  * may be implemented in some other way, so let's contort. */
 810                 if (seconds) {
 811                     sleep(seconds);
 812                     useconds -= 1E6 * seconds;
 813                 }
 814             } else if (useconds < 0.0)
 815                 croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds);
 816             usleep((U32)useconds);
 817         } else
 818             PerlProc_pause();
 819         gettimeofday(&Tb, NULL);
 820 #if 0
 821         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 822 #endif
 823         RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
 824
 825         OUTPUT:
 826         RETVAL
 827
 828 #if defined(TIME_HIRES_NANOSLEEP)
 829
 830 NV
 831 nanosleep(nsec)
 832         NV nsec
 833         PREINIT:
 834         int status = -1;
 835         struct timeval Ta, Tb;
 836         CODE:
 837         gettimeofday(&Ta, NULL);
 838         if (items > 0) {
 839             struct timespec ts1;
 840             if (nsec > 1E9) {
 841                 IV sec = (IV) (nsec / 1E9);
 842                 if (sec) {
 843                     sleep(sec);
 844                     nsec -= 1E9 * sec;
 845                 }
 846             } else if (nsec < 0.0)
 847                 croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nsec);
 848             ts1.tv_sec  = (IV) (nsec / 1E9);
 849             ts1.tv_nsec = (IV) nsec - (IV) (ts1.tv_sec * NV_1E9);
 850             status = nanosleep(&ts1, NULL);
 851         } else {
 852             PerlProc_pause();
 853             status = 0;
 854         }
 855         gettimeofday(&Tb, NULL);
 856         RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
 857
 858         OUTPUT:
 859         RETVAL
 860
 861 #else  /* #if defined(TIME_HIRES_NANOSLEEP) */
 862
 863 NV
 864 nanosleep(nsec)
 865         NV nsec
 866     CODE:
 867         croak("Time::HiRes::nanosleep(): unimplemented in this platform");
 868         RETVAL = 0.0;
 869
 870 #endif /* #if defined(TIME_HIRES_NANOSLEEP) */
 871
 872 NV
 873 sleep(...)
 874         PREINIT:
 875         struct timeval Ta, Tb;
 876         CODE:
 877         gettimeofday(&Ta, NULL);
 878         if (items > 0) {
 879             NV seconds  = SvNV(ST(0));
 880             if (seconds >= 0.0) {
 881                  UV useconds = (UV)(1E6 * (seconds - (UV)seconds));
 882                  if (seconds >= 1.0)
 883                      sleep((U32)seconds);
 884                  if ((IV)useconds < 0) {
 885 #if defined(__sparc64__) && defined(__GNUC__)
 886                    /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug
 887                     * where (0.5 - (UV)(0.5)) will under certain
 888                     * circumstances (if the double is cast to UV more
 889                     * than once?) evaluate to -0.5, instead of 0.5. */
 890                    useconds = -(IV)useconds;
 891 #endif /* #if defined(__sparc64__) && defined(__GNUC__) */
 892                    if ((IV)useconds < 0)
 893                      croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds);
 894                  }
 895                  usleep(useconds);
 896             } else
 897                 croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds);
 898         } else
 899             PerlProc_pause();
 900         gettimeofday(&Tb, NULL);
 901 #if 0
 902         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 903 #endif
 904         RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
 905
 906         OUTPUT:
 907         RETVAL
 908
 909 #else  /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 910
 911 NV
 912 usleep(useconds)
 913         NV useconds
 914     CODE:
 915         croak("Time::HiRes::usleep(): unimplemented in this platform");
 916         RETVAL = 0.0;
 917
 918 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 919
 920 #ifdef HAS_UALARM
 921
 922 int
 923 ualarm(useconds,interval=0)
 924         int useconds
 925         int interval
 926         CODE:
 927         if (useconds < 0 || interval < 0)
 928             croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval);
 929         if (useconds >= IV_1E6 || interval >= IV_1E6)
 930 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL)
 931                 RETVAL = hrt_ualarm_itimer(useconds, interval);
 932 #else
 933                 croak("Time::HiRes::ualarm(%d, %d): useconds or interval equal or more than %"IVdf, useconds, interval, IV_1E6);
 934 #endif
 935         else
 936                 RETVAL = ualarm(useconds, interval);
 937
 938         OUTPUT:
 939         RETVAL
 940
 941 NV
 942 alarm(seconds,interval=0)
 943         NV seconds
 944         NV interval
 945         CODE:
 946         if (seconds < 0.0 || interval < 0.0)
 947             croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
 948         RETVAL = (NV)ualarm((IV)(seconds  * IV_1E6),
 949                             (IV)(interval * IV_1E6)) / NV_1E6;
 950
 951         OUTPUT:
 952         RETVAL
 953
 954 #else
 955
 956 int
 957 ualarm(useconds,interval=0)
 958         int useconds
 959         int interval
 960     CODE:
 961         croak("Time::HiRes::ualarm(): unimplemented in this platform");
 962         RETVAL = -1;
 963
 964 NV
 965 alarm(seconds,interval=0)
 966         NV seconds
 967         NV interval
 968     CODE:
 969         croak("Time::HiRes::alarm(): unimplemented in this platform");
 970         RETVAL = 0.0;
 971
 972 #endif /* #ifdef HAS_UALARM */
 973
 974 #ifdef HAS_GETTIMEOFDAY
 975 #    ifdef MACOS_TRADITIONAL    /* fix epoch TZ and use unsigned time_t */
 976 void
 977 gettimeofday()
 978         PREINIT:
 979         struct timeval Tp;
 980         struct timezone Tz;
 981         PPCODE:
 982         int status;
 983         status = gettimeofday (&Tp, &Tz);
 984
 985         if (status == 0) {
 986              Tp.tv_sec += Tz.tz_minuteswest * 60;       /* adjust for TZ */
 987              if (GIMME == G_ARRAY) {
 988                  EXTEND(sp, 2);
 989                  /* Mac OS (Classic) has unsigned time_t */
 990                  PUSHs(sv_2mortal(newSVuv(Tp.tv_sec)));
 991                  PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
 992              } else {
 993                  EXTEND(sp, 1);
 994                  PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
 995              }
 996         }
 997
 998 NV
 999 time()
1000         PREINIT:
1001         struct timeval Tp;
1002         struct timezone Tz;
1003         CODE:
1004         int status;
1005         status = gettimeofday (&Tp, &Tz);
1006         if (status == 0) {
1007             Tp.tv_sec += Tz.tz_minuteswest * 60;        /* adjust for TZ */
1008             RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1009         } else {
1010             RETVAL = -1.0;
1011         }
1012         OUTPUT:
1013         RETVAL
1014
1015 #    else       /* MACOS_TRADITIONAL */
1016 void
1017 gettimeofday()
1018         PREINIT:
1019         struct timeval Tp;
1020         PPCODE:
1021         int status;
1022         status = gettimeofday (&Tp, NULL);
1023         if (status == 0) {
1024              if (GIMME == G_ARRAY) {
1025                  EXTEND(sp, 2);
1026                  PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
1027                  PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
1028              } else {
1029                  EXTEND(sp, 1);
1030                  PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6))));
1031              }
1032         }
1033
1034 NV
1035 time()
1036         PREINIT:
1037         struct timeval Tp;
1038         CODE:
1039         int status;
1040         status = gettimeofday (&Tp, NULL);
1041         if (status == 0) {
1042             RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6);
1043         } else {
1044             RETVAL = -1.0;
1045         }
1046         OUTPUT:
1047         RETVAL
1048
1049 #    endif      /* MACOS_TRADITIONAL */
1050 #endif /* #ifdef HAS_GETTIMEOFDAY */
1051
1052 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
1053
1054 #define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
1055
1056 void
1057 setitimer(which, seconds, interval = 0)
1058         int which
1059         NV seconds
1060         NV interval
1061     PREINIT:
1062         struct itimerval newit;
1063         struct itimerval oldit;
1064     PPCODE:
1065         if (seconds < 0.0 || interval < 0.0)
1066             croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", (IV)which, seconds, interval);
1067         newit.it_value.tv_sec  = (IV)seconds;
1068         newit.it_value.tv_usec =
1069           (IV)((seconds  - (NV)newit.it_value.tv_sec)    * NV_1E6);
1070         newit.it_interval.tv_sec  = (IV)interval;
1071         newit.it_interval.tv_usec =
1072           (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6);
1073         if (setitimer(which, &newit, &oldit) == 0) {
1074           EXTEND(sp, 1);
1075           PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
1076           if (GIMME == G_ARRAY) {
1077             EXTEND(sp, 1);
1078             PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
1079           }
1080         }
1081
1082 void
1083 getitimer(which)
1084         int which
1085     PREINIT:
1086         struct itimerval nowit;
1087     PPCODE:
1088         if (getitimer(which, &nowit) == 0) {
1089           EXTEND(sp, 1);
1090           PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
1091           if (GIMME == G_ARRAY) {
1092             EXTEND(sp, 1);
1093             PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
1094           }
1095         }
1096
1097 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
1098
1099 #if defined(TIME_HIRES_CLOCK_GETTIME)
1100
1101 NV
1102 clock_gettime(clock_id = CLOCK_REALTIME)
1103         int clock_id
1104     PREINIT:
1105         struct timespec ts;
1106         int status = -1;
1107     CODE:
1108 #ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL
1109         status = syscall(SYS_clock_gettime, clock_id, &ts);
1110 #else
1111         status = clock_gettime(clock_id, &ts);
1112 #endif
1113         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
1114
1115     OUTPUT:
1116         RETVAL
1117
1118 #else  /* if defined(TIME_HIRES_CLOCK_GETTIME) */
1119
1120 NV
1121 clock_gettime(clock_id = 0)
1122         int clock_id
1123     CODE:
1124         croak("Time::HiRes::clock_gettime(): unimplemented in this platform");
1125         RETVAL = 0.0;
1126
1127 #endif /*  #if defined(TIME_HIRES_CLOCK_GETTIME) */
1128
1129 #if defined(TIME_HIRES_CLOCK_GETRES)
1130
1131 NV
1132 clock_getres(clock_id = CLOCK_REALTIME)
1133         int clock_id
1134     PREINIT:
1135         int status = -1;
1136         struct timespec ts;
1137     CODE:
1138 #ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL
1139         status = syscall(SYS_clock_getres, clock_id, &ts);
1140 #else
1141         status = clock_getres(clock_id, &ts);
1142 #endif
1143         RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / (NV) 1e9 : -1;
1144
1145     OUTPUT:
1146         RETVAL
1147
1148 #else  /* if defined(TIME_HIRES_CLOCK_GETRES) */
1149
1150 NV
1151 clock_getres(clock_id = 0)
1152         int clock_id
1153     CODE:
1154         croak("Time::HiRes::clock_getres(): unimplemented in this platform");
1155         RETVAL = 0.0;
1156
1157 #endif /*  #if defined(TIME_HIRES_CLOCK_GETRES) */
1158
1159 #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)
1160
1161 NV
1162 clock_nanosleep(clock_id = CLOCK_REALTIME, sec = 0.0, flags = 0)
1163         int clock_id
1164         NV  sec
1165         int flags
1166     PREINIT:
1167         int status = -1;
1168         struct timespec ts;
1169         struct timeval Ta, Tb;
1170     CODE:
1171         gettimeofday(&Ta, NULL);
1172         if (items > 1) {
1173             ts.tv_sec  = (IV) sec;
1174             ts.tv_nsec = (sec - (NV) ts.tv_sec) * (NV) 1E9;
1175             status = clock_nanosleep(clock_id, flags, &ts, NULL);
1176         } else {
1177             PerlProc_pause();
1178             status = 0;
1179         }
1180         gettimeofday(&Tb, NULL);
1181         RETVAL = status == 0 ? 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec)) : -1;
1182
1183     OUTPUT:
1184         RETVAL
1185
1186 #else  /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1187
1188 NV
1189 clock_nanosleep()
1190     CODE:
1191         croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform");
1192         RETVAL = 0.0;
1193
1194 #endif /*  #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */
1195
1196 #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC)
1197
1198 NV
1199 clock()
1200     PREINIT:
1201         clock_t clocks;
1202     CODE:
1203         clocks = clock();
1204         RETVAL = clocks == -1 ? -1 : (NV)clocks / (NV)CLOCKS_PER_SEC;
1205
1206     OUTPUT:
1207         RETVAL
1208
1209 #else  /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1210
1211 NV
1212 clock()
1213     CODE:
1214         croak("Time::HiRes::clock(): unimplemented in this platform");
1215         RETVAL = 0.0;
1216
1217 #endif /*  #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */
1218
1219 void
1220 stat(...)
1221 PROTOTYPE: ;$
1222     PPCODE:
1223         dTHX;
1224         PUSHMARK(SP);
1225         XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV)));
1226         PUTBACK;
1227         ENTER;
1228         PL_laststatval = -1;
1229         (void)*(PL_ppaddr[OP_STAT])(aTHX);
1230         SPAGAIN;
1231         LEAVE;
1232         if (PL_laststatval == 0) {
1233           /* We assume that pp_stat() left us with 13 valid stack items,
1234            * and that the timestamps are at offsets 8, 9, and 10. */
1235           UV atime = SvUV(ST( 8));
1236           UV mtime = SvUV(ST( 9));
1237           UV ctime = SvUV(ST(10));
1238           UV atime_nsec;
1239           UV mtime_nsec;
1240           UV ctime_nsec;
1241           hrstatns(atime, mtime, ctime,
1242                    &atime_nsec, &mtime_nsec, &ctime_nsec);
1243           if (atime_nsec)
1244             ST( 8) = sv_2mortal(newSVnv(atime + 1e-9 * (NV) atime_nsec));
1245           if (mtime_nsec)
1246             ST( 9) = sv_2mortal(newSVnv(mtime + 1e-9 * (NV) mtime_nsec));
1247           if (ctime_nsec)
1248             ST(10) = sv_2mortal(newSVnv(ctime + 1e-9 * (NV) ctime_nsec));
1249           XSRETURN(13);
1250         }
1251         XSRETURN(0);