ext/Time/HiRes/HiRes.xs

   1 #ifdef __cplusplus
   2 extern "C" {
   3 #endif
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8 #include "ppport.h"
   9 #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H)
  10 # include <w32api/windows.h>
  11 # define CYGWIN_WITH_W32API
  12 #endif
  13 #ifdef WIN32
  14 # include <time.h>
  15 #else
  16 # include <sys/time.h>
  17 #endif
  18 #ifdef HAS_SELECT
  19 # ifdef I_SYS_SELECT
  20 #  include <sys/select.h>
  21 # endif
  22 #endif
  23 #ifdef __cplusplus
  24 }
  25 #endif
  26
  27 #ifndef PerlProc_pause
  28 #   define PerlProc_pause() Pause()
  29 #endif
  30
  31 #ifdef HAS_PAUSE
  32 #   define Pause   pause
  33 #else
  34 #   define Pause() sleep(~0) /* Zzz for a long time. */
  35 #endif
  36
  37 /* Though the cpp define ITIMER_VIRTUAL is available the functionality
  38  * is not supported in Cygwin as of August 2004, ditto for Win32.
  39  * Neither are ITIMER_PROF or ITIMER_REALPROF implemented.  --jhi
  40  */
  41 #if defined(__CYGWIN__) || defined(WIN32)
  42 #   undef ITIMER_VIRTUAL
  43 #   undef ITIMER_PROF
  44 #   undef ITIMER_REALPROF
  45 #endif
  46
  47 /* 5.004 doesn't define PL_sv_undef */
  48 #ifndef ATLEASTFIVEOHOHFIVE
  49 # ifndef PL_sv_undef
  50 #  define PL_sv_undef sv_undef
  51 # endif
  52 #endif
  53
  54 #include "const-c.inc"
  55
  56 #if defined(WIN32) || defined(CYGWIN_WITH_W32API)
  57
  58 #ifndef HAS_GETTIMEOFDAY
  59 #   define HAS_GETTIMEOFDAY
  60 #endif
  61
  62 /* shows up in winsock.h?
  63 struct timeval {
  64  long tv_sec;
  65  long tv_usec;
  66 }
  67 */
  68
  69 typedef union {
  70     unsigned __int64    ft_i64;
  71     FILETIME            ft_val;
  72 } FT_t;
  73
  74 #define MY_CXT_KEY "Time::HiRes_" XS_VERSION
  75
  76 typedef struct {
  77     unsigned long run_count;
  78     unsigned __int64 base_ticks;
  79     unsigned __int64 tick_frequency;
  80     FT_t base_systime_as_filetime;
  81     unsigned __int64 reset_time;
  82 } my_cxt_t;
  83
  84 START_MY_CXT
  85
  86 /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
  87 #ifdef __GNUC__
  88 # define Const64(x) x##LL
  89 #else
  90 # define Const64(x) x##i64
  91 #endif
  92 #define EPOCH_BIAS  Const64(116444736000000000)
  93
  94 /* NOTE: This does not compute the timezone info (doing so can be expensive,
  95  * and appears to be unsupported even by glibc) */
  96
  97 /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT
  98    for performance reasons */
  99
 100 #undef gettimeofday
 101 #define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used)
 102
 103 /* If the performance counter delta drifts more than 0.5 seconds from the
 104  * system time then we recalibrate to the system time.  This means we may
 105  * move *backwards* in time! */
 106 #define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */
 107
 108 /* Reset reading from the performance counter every five minutes.
 109  * Many PC clocks just seem to be so bad. */
 110 #define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */
 111
 112 static int
 113 _gettimeofday(pTHX_ struct timeval *tp, void *not_used)
 114 {
 115     dMY_CXT;
 116
 117     unsigned __int64 ticks;
 118     FT_t ft;
 119
 120     if (MY_CXT.run_count++ == 0 ||
 121         MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) {
 122         QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency);
 123         QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks);
 124         GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 125         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 126         MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS;
 127     }
 128     else {
 129         __int64 diff;
 130         QueryPerformanceCounter((LARGE_INTEGER*)&ticks);
 131         ticks -= MY_CXT.base_ticks;
 132         ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64
 133                     + Const64(10000000) * (ticks / MY_CXT.tick_frequency)
 134                     +(Const64(10000000) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency;
 135         diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64;
 136         if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) {
 137             MY_CXT.base_ticks += ticks;
 138             GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val);
 139             ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64;
 140         }
 141     }
 142
 143     /* seconds since epoch */
 144     tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000));
 145
 146     /* microseconds remaining */
 147     tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000));
 148
 149     return 0;
 150 }
 151 #endif
 152
 153 #if defined(WIN32) && !defined(ATLEASTFIVEOHOHFIVE)
 154 static unsigned int
 155 sleep(unsigned int t)
 156 {
 157     Sleep(t*1000);
 158     return 0;
 159 }
 160 #endif
 161
 162 #if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
 163 #define HAS_GETTIMEOFDAY
 164
 165 #include <lnmdef.h>
 166 #include <time.h> /* gettimeofday */
 167 #include <stdlib.h> /* qdiv */
 168 #include <starlet.h> /* sys$gettim */
 169 #include <descrip.h>
 170 #ifdef __VAX
 171 #include <lib$routines.h> /* lib$ediv() */
 172 #endif
 173
 174 /*
 175         VMS binary time is expressed in 100 nano-seconds since
 176         system base time which is 17-NOV-1858 00:00:00.00
 177 */
 178
 179 #define DIV_100NS_TO_SECS  10000000L
 180 #define DIV_100NS_TO_USECS 10L
 181
 182 /*
 183         gettimeofday is supposed to return times since the epoch
 184         so need to determine this in terms of VMS base time
 185 */
 186 static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
 187
 188 #ifdef __VAX
 189 static long base_adjust[2]={0L,0L};
 190 #else
 191 static __int64 base_adjust=0;
 192 #endif
 193
 194 /*
 195
 196    If we don't have gettimeofday, then likely we are on a VMS machine that
 197    operates on local time rather than UTC...so we have to zone-adjust.
 198    This code gleefully swiped from VMS.C
 199
 200 */
 201 /* method used to handle UTC conversions:
 202  *   1 == CRTL gmtime();  2 == SYS$TIMEZONE_DIFFERENTIAL;  3 == no correction
 203  */
 204 static int gmtime_emulation_type;
 205 /* number of secs to add to UTC POSIX-style time to get local time */
 206 static long int utc_offset_secs;
 207 static struct dsc$descriptor_s fildevdsc =
 208   { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" };
 209 static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL };
 210
 211 static time_t toutc_dst(time_t loc) {
 212   struct tm *rsltmp;
 213
 214   if ((rsltmp = localtime(&loc)) == NULL) return -1;
 215   loc -= utc_offset_secs;
 216   if (rsltmp->tm_isdst) loc -= 3600;
 217   return loc;
 218 }
 219
 220 static time_t toloc_dst(time_t utc) {
 221   struct tm *rsltmp;
 222
 223   utc += utc_offset_secs;
 224   if ((rsltmp = localtime(&utc)) == NULL) return -1;
 225   if (rsltmp->tm_isdst) utc += 3600;
 226   return utc;
 227 }
 228
 229 #define _toutc(secs)  ((secs) == (time_t) -1 ? (time_t) -1 : \
 230        ((gmtime_emulation_type || timezone_setup()), \
 231        (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
 232        ((secs) - utc_offset_secs))))
 233
 234 #define _toloc(secs)  ((secs) == (time_t) -1 ? (time_t) -1 : \
 235        ((gmtime_emulation_type || timezone_setup()), \
 236        (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
 237        ((secs) + utc_offset_secs))))
 238
 239 static int
 240 timezone_setup(void)
 241 {
 242   struct tm *tm_p;
 243
 244   if (gmtime_emulation_type == 0) {
 245     int dstnow;
 246     time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between    */
 247                               /* results of calls to gmtime() and localtime() */
 248                               /* for same &base */
 249
 250     gmtime_emulation_type++;
 251     if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
 252       char off[LNM$C_NAMLENGTH+1];;
 253
 254       gmtime_emulation_type++;
 255       if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) {
 256         gmtime_emulation_type++;
 257         utc_offset_secs = 0;
 258         Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC");
 259       }
 260       else { utc_offset_secs = atol(off); }
 261     }
 262     else { /* We've got a working gmtime() */
 263       struct tm gmt, local;
 264
 265       gmt = *tm_p;
 266       tm_p = localtime(&base);
 267       local = *tm_p;
 268       utc_offset_secs  = (local.tm_mday - gmt.tm_mday) * 86400;
 269       utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600;
 270       utc_offset_secs += (local.tm_min  - gmt.tm_min)  * 60;
 271       utc_offset_secs += (local.tm_sec  - gmt.tm_sec);
 272     }
 273   }
 274   return 1;
 275 }
 276
 277
 278 int
 279 gettimeofday (struct timeval *tp, void *tpz)
 280 {
 281  long ret;
 282 #ifdef __VAX
 283  long quad[2];
 284  long quad1[2];
 285  long div_100ns_to_secs;
 286  long div_100ns_to_usecs;
 287  long quo,rem;
 288  long quo1,rem1;
 289 #else
 290  __int64 quad;
 291  __qdiv_t ans1,ans2;
 292 #endif
 293 /*
 294         In case of error, tv_usec = 0 and tv_sec = VMS condition code.
 295         The return from function is also set to -1.
 296         This is not exactly as per the manual page.
 297 */
 298
 299  tp->tv_usec = 0;
 300
 301 #ifdef __VAX
 302  if (base_adjust[0]==0 && base_adjust[1]==0) {
 303 #else
 304  if (base_adjust==0) { /* Need to determine epoch adjustment */
 305 #endif
 306         ret=sys$bintim(&dscepoch,&base_adjust);
 307         if (1 != (ret &&1)) {
 308                 tp->tv_sec = ret;
 309                 return -1;
 310         }
 311  }
 312
 313  ret=sys$gettim(&quad); /* Get VMS system time */
 314  if ((1 && ret) == 1) {
 315 #ifdef __VAX
 316         quad[0] -= base_adjust[0]; /* convert to epoch offset */
 317         quad[1] -= base_adjust[1]; /* convert 2nd half of quadword */
 318         div_100ns_to_secs = DIV_100NS_TO_SECS;
 319         div_100ns_to_usecs = DIV_100NS_TO_USECS;
 320         lib$ediv(&div_100ns_to_secs,&quad,&quo,&rem);
 321         quad1[0] = rem;
 322         quad1[1] = 0L;
 323         lib$ediv(&div_100ns_to_usecs,&quad1,&quo1,&rem1);
 324         tp->tv_sec = quo; /* Whole seconds */
 325         tp->tv_usec = quo1; /* Micro-seconds */
 326 #else
 327         quad -= base_adjust; /* convert to epoch offset */
 328         ans1=qdiv(quad,DIV_100NS_TO_SECS);
 329         ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
 330         tp->tv_sec = ans1.quot; /* Whole seconds */
 331         tp->tv_usec = ans2.quot; /* Micro-seconds */
 332 #endif
 333  } else {
 334         tp->tv_sec = ret;
 335         return -1;
 336  }
 337 # ifdef VMSISH_TIME
 338 # ifdef RTL_USES_UTC
 339   if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec);
 340 # else
 341   if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec);
 342 # endif
 343 # endif
 344  return 0;
 345 }
 346 #endif
 347
 348
 349  /* Do not use H A S _ N A N O S L E E P
 350   * so that Perl Configure doesn't scan for it.
 351   * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */
 352 #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP)
 353 #define HAS_USLEEP
 354 #define usleep hrt_unanosleep  /* could conflict with ncurses for static build */
 355
 356 void
 357 hrt_unanosleep(unsigned long usec) /* This is used to emulate usleep. */
 358 {
 359     struct timespec res;
 360     res.tv_sec = usec/1000/1000;
 361     res.tv_nsec = ( usec - res.tv_sec*1000*1000 ) * 1000;
 362     nanosleep(&res, NULL);
 363 }
 364
 365 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */
 366
 367 #if !defined(HAS_USLEEP) && defined(HAS_SELECT)
 368 #ifndef SELECT_IS_BROKEN
 369 #define HAS_USLEEP
 370 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 371
 372 void
 373 hrt_usleep(unsigned long usec)
 374 {
 375     struct timeval tv;
 376     tv.tv_sec = 0;
 377     tv.tv_usec = usec;
 378     select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
 379                 (Select_fd_set_t)NULL, &tv);
 380 }
 381 #endif
 382 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */
 383
 384 #if !defined(HAS_USLEEP) && defined(WIN32)
 385 #define HAS_USLEEP
 386 #define usleep hrt_usleep  /* could conflict with ncurses for static build */
 387
 388 void
 389 hrt_usleep(unsigned long usec)
 390 {
 391     long msec;
 392     msec = usec / 1000;
 393     Sleep (msec);
 394 }
 395 #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */
 396
 397
 398 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
 399 #define HAS_UALARM
 400 #define ualarm hrt_ualarm  /* could conflict with ncurses for static build */
 401
 402 int
 403 hrt_ualarm(int usec, int interval)
 404 {
 405    struct itimerval itv;
 406    itv.it_value.tv_sec = usec / 1000000;
 407    itv.it_value.tv_usec = usec % 1000000;
 408    itv.it_interval.tv_sec = interval / 1000000;
 409    itv.it_interval.tv_usec = interval % 1000000;
 410    return setitimer(ITIMER_REAL, &itv, 0);
 411 }
 412 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */
 413
 414 #if !defined(HAS_UALARM) && defined(VMS)
 415 #define HAS_UALARM
 416 #define ualarm vms_ualarm
 417
 418 #include <lib$routines.h>
 419 #include <ssdef.h>
 420 #include <starlet.h>
 421 #include <descrip.h>
 422 #include <signal.h>
 423 #include <jpidef.h>
 424 #include <psldef.h>
 425
 426 #define VMSERR(s)   (!((s)&1))
 427
 428 static void
 429 us_to_VMS(useconds_t mseconds, unsigned long v[])
 430 {
 431     int iss;
 432     unsigned long qq[2];
 433
 434     qq[0] = mseconds;
 435     qq[1] = 0;
 436     v[0] = v[1] = 0;
 437
 438     iss = lib$addx(qq,qq,qq);
 439     if (VMSERR(iss)) lib$signal(iss);
 440     iss = lib$subx(v,qq,v);
 441     if (VMSERR(iss)) lib$signal(iss);
 442     iss = lib$addx(qq,qq,qq);
 443     if (VMSERR(iss)) lib$signal(iss);
 444     iss = lib$subx(v,qq,v);
 445     if (VMSERR(iss)) lib$signal(iss);
 446     iss = lib$subx(v,qq,v);
 447     if (VMSERR(iss)) lib$signal(iss);
 448 }
 449
 450 static int
 451 VMS_to_us(unsigned long v[])
 452 {
 453     int iss;
 454     unsigned long div=10,quot, rem;
 455
 456     iss = lib$ediv(&div,v,&quot,&rem);
 457     if (VMSERR(iss)) lib$signal(iss);
 458
 459     return quot;
 460 }
 461
 462 typedef unsigned short word;
 463 typedef struct _ualarm {
 464     int function;
 465     int repeat;
 466     unsigned long delay[2];
 467     unsigned long interval[2];
 468     unsigned long remain[2];
 469 } Alarm;
 470
 471
 472 static int alarm_ef;
 473 static Alarm *a0, alarm_base;
 474 #define UAL_NULL   0
 475 #define UAL_SET    1
 476 #define UAL_CLEAR  2
 477 #define UAL_ACTIVE 4
 478 static void ualarm_AST(Alarm *a);
 479
 480 static int
 481 vms_ualarm(int mseconds, int interval)
 482 {
 483     Alarm *a, abase;
 484     struct item_list3 {
 485         word length;
 486         word code;
 487         void *bufaddr;
 488         void *retlenaddr;
 489     } ;
 490     static struct item_list3 itmlst[2];
 491     static int first = 1;
 492     unsigned long asten;
 493     int iss, enabled;
 494
 495     if (first) {
 496         first = 0;
 497         itmlst[0].code       = JPI$_ASTEN;
 498         itmlst[0].length     = sizeof(asten);
 499         itmlst[0].retlenaddr = NULL;
 500         itmlst[1].code       = 0;
 501         itmlst[1].length     = 0;
 502         itmlst[1].bufaddr    = NULL;
 503         itmlst[1].retlenaddr = NULL;
 504
 505         iss = lib$get_ef(&alarm_ef);
 506         if (VMSERR(iss)) lib$signal(iss);
 507
 508         a0 = &alarm_base;
 509         a0->function = UAL_NULL;
 510     }
 511     itmlst[0].bufaddr    = &asten;
 512
 513     iss = sys$getjpiw(0,0,0,itmlst,0,0,0);
 514     if (VMSERR(iss)) lib$signal(iss);
 515     if (!(asten&0x08)) return -1;
 516
 517     a = &abase;
 518     if (mseconds) {
 519         a->function = UAL_SET;
 520     } else {
 521         a->function = UAL_CLEAR;
 522     }
 523
 524     us_to_VMS(mseconds, a->delay);
 525     if (interval) {
 526         us_to_VMS(interval, a->interval);
 527         a->repeat = 1;
 528     } else
 529         a->repeat = 0;
 530
 531     iss = sys$clref(alarm_ef);
 532     if (VMSERR(iss)) lib$signal(iss);
 533
 534     iss = sys$dclast(ualarm_AST,a,0);
 535     if (VMSERR(iss)) lib$signal(iss);
 536
 537     iss = sys$waitfr(alarm_ef);
 538     if (VMSERR(iss)) lib$signal(iss);
 539
 540     if (a->function == UAL_ACTIVE)
 541         return VMS_to_us(a->remain);
 542     else
 543         return 0;
 544 }
 545
 546
 547
 548 static void
 549 ualarm_AST(Alarm *a)
 550 {
 551     int iss;
 552     unsigned long now[2];
 553
 554     iss = sys$gettim(now);
 555     if (VMSERR(iss)) lib$signal(iss);
 556
 557     if (a->function == UAL_SET || a->function == UAL_CLEAR) {
 558         if (a0->function == UAL_ACTIVE) {
 559             iss = sys$cantim(a0,PSL$C_USER);
 560             if (VMSERR(iss)) lib$signal(iss);
 561
 562             iss = lib$subx(a0->remain, now, a->remain);
 563             if (VMSERR(iss)) lib$signal(iss);
 564
 565             if (a->remain[1] & 0x80000000)
 566                 a->remain[0] = a->remain[1] = 0;
 567         }
 568
 569         if (a->function == UAL_SET) {
 570             a->function = a0->function;
 571             a0->function = UAL_ACTIVE;
 572             a0->repeat = a->repeat;
 573             if (a0->repeat) {
 574                 a0->interval[0] = a->interval[0];
 575                 a0->interval[1] = a->interval[1];
 576             }
 577             a0->delay[0] = a->delay[0];
 578             a0->delay[1] = a->delay[1];
 579
 580             iss = lib$subx(now, a0->delay, a0->remain);
 581             if (VMSERR(iss)) lib$signal(iss);
 582
 583             iss = sys$setimr(0,a0->delay,ualarm_AST,a0);
 584             if (VMSERR(iss)) lib$signal(iss);
 585         } else {
 586             a->function = a0->function;
 587             a0->function = UAL_NULL;
 588         }
 589         iss = sys$setef(alarm_ef);
 590         if (VMSERR(iss)) lib$signal(iss);
 591     } else if (a->function == UAL_ACTIVE) {
 592         if (a->repeat) {
 593             iss = lib$subx(now, a->interval, a->remain);
 594             if (VMSERR(iss)) lib$signal(iss);
 595
 596             iss = sys$setimr(0,a->interval,ualarm_AST,a);
 597             if (VMSERR(iss)) lib$signal(iss);
 598         } else {
 599             a->function = UAL_NULL;
 600         }
 601         iss = sys$wake(0,0);
 602         if (VMSERR(iss)) lib$signal(iss);
 603         lib$signal(SS$_ASTFLT);
 604     } else {
 605         lib$signal(SS$_BADPARAM);
 606     }
 607 }
 608
 609 #endif /* #if !defined(HAS_UALARM) && defined(VMS) */
 610
 611 #ifdef HAS_GETTIMEOFDAY
 612
 613 static int
 614 myU2time(pTHX_ UV *ret)
 615 {
 616   struct timeval Tp;
 617   int status;
 618   status = gettimeofday (&Tp, NULL);
 619   ret[0] = Tp.tv_sec;
 620   ret[1] = Tp.tv_usec;
 621   return status;
 622 }
 623
 624 static NV
 625 myNVtime()
 626 {
 627 #ifdef WIN32
 628   dTHX;
 629 #endif
 630   struct timeval Tp;
 631   int status;
 632   status = gettimeofday (&Tp, NULL);
 633   return status == 0 ? Tp.tv_sec + (Tp.tv_usec / 1000000.) : -1.0;
 634 }
 635
 636 #endif /* #ifdef HAS_GETTIMEOFDAY */
 637
 638 MODULE = Time::HiRes            PACKAGE = Time::HiRes
 639
 640 PROTOTYPES: ENABLE
 641
 642 BOOT:
 643 {
 644 #ifdef MY_CXT_KEY
 645   MY_CXT_INIT;
 646 #endif
 647 #ifdef ATLEASTFIVEOHOHFIVE
 648 #ifdef HAS_GETTIMEOFDAY
 649   {
 650     UV auv[2];
 651     hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0);
 652     if (myU2time(aTHX_ auv) == 0)
 653       hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0);
 654   }
 655 #endif
 656 #endif
 657 }
 658
 659 #if defined(USE_ITHREADS) && defined(MY_CXT_KEY)
 660
 661 void
 662 CLONE(...)
 663     CODE:
 664     MY_CXT_CLONE;
 665
 666 #endif
 667
 668 INCLUDE: const-xs.inc
 669
 670 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 671
 672 NV
 673 usleep(useconds)
 674         NV useconds
 675         PREINIT:
 676         struct timeval Ta, Tb;
 677         CODE:
 678         gettimeofday(&Ta, NULL);
 679         if (items > 0) {
 680             if (useconds > 1E6) {
 681                 IV seconds = (IV) (useconds / 1E6);
 682                 /* If usleep() has been implemented using setitimer()
 683                  * then this contortion is unnecessary-- but usleep()
 684                  * may be implemented in some other way, so let's contort. */
 685                 if (seconds) {
 686                     sleep(seconds);
 687                     useconds -= 1E6 * seconds;
 688                 }
 689             } else if (useconds < 0.0)
 690                 croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds);
 691             usleep((U32)useconds);
 692         } else
 693             PerlProc_pause();
 694         gettimeofday(&Tb, NULL);
 695 #if 0
 696         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 697 #endif
 698         RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
 699
 700         OUTPUT:
 701         RETVAL
 702
 703 #if defined(TIME_HIRES_NANOSLEEP)
 704
 705 NV
 706 nanosleep(nseconds)
 707         NV nseconds
 708         PREINIT:
 709         struct timeval Ta, Tb;
 710         CODE:
 711         gettimeofday(&Ta, NULL);
 712         if (items > 0) {
 713             struct timespec tsa;
 714             if (nseconds > 1E9) {
 715                 IV seconds = (IV) (nseconds / 1E9);
 716                 if (seconds) {
 717                     sleep(seconds);
 718                     nseconds -= 1E9 * seconds;
 719                 }
 720             } else if (nseconds < 0.0)
 721                 croak("Time::HiRes::nanosleep(%"NVgf"): negative time not invented yet", nseconds);
 722             tsa.tv_sec  = (IV) (nseconds / 1E9);
 723             tsa.tv_nsec = (IV) nseconds - tsa.tv_sec * 1E9;
 724             nanosleep(&tsa, NULL);
 725         } else
 726             PerlProc_pause();
 727         gettimeofday(&Tb, NULL);
 728         RETVAL = 1E3*(1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec));
 729
 730         OUTPUT:
 731         RETVAL
 732
 733 #endif /* #if defined(TIME_HIRES_NANOSLEEP) */
 734
 735 NV
 736 sleep(...)
 737         PREINIT:
 738         struct timeval Ta, Tb;
 739         CODE:
 740         gettimeofday(&Ta, NULL);
 741         if (items > 0) {
 742             NV seconds  = SvNV(ST(0));
 743             if (seconds >= 0.0) {
 744                  UV useconds = (UV)(1E6 * (seconds - (UV)seconds));
 745                  if (seconds >= 1.0)
 746                      sleep((U32)seconds);
 747                  if ((IV)useconds < 0) {
 748 #if defined(__sparc64__) && defined(__GNUC__)
 749                    /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug
 750                     * where (0.5 - (UV)(0.5)) will under certain
 751                     * circumstances (if the double is cast to UV more
 752                     * than once?) evaluate to -0.5, instead of 0.5. */
 753                    useconds = -(IV)useconds;
 754 #endif /* #if defined(__sparc64__) && defined(__GNUC__) */
 755                    if ((IV)useconds < 0)
 756                      croak("Time::HiRes::sleep(%"NVgf"): internal error: useconds < 0 (unsigned %"UVuf" signed %"IVdf")", seconds, useconds, (IV)useconds);
 757                  }
 758                  usleep(useconds);
 759             } else
 760                 croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds);
 761         } else
 762             PerlProc_pause();
 763         gettimeofday(&Tb, NULL);
 764 #if 0
 765         printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
 766 #endif
 767         RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
 768
 769         OUTPUT:
 770         RETVAL
 771
 772 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */
 773
 774 #ifdef HAS_UALARM
 775
 776 int
 777 ualarm(useconds,interval=0)
 778         int useconds
 779         int interval
 780         CODE:
 781         if (useconds < 0 || interval < 0)
 782             croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval);
 783         RETVAL = ualarm(useconds, interval);
 784
 785         OUTPUT:
 786         RETVAL
 787
 788 NV
 789 alarm(seconds,interval=0)
 790         NV seconds
 791         NV interval
 792         CODE:
 793         if (seconds < 0.0 || interval < 0.0)
 794             croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval);
 795         RETVAL = (NV)ualarm(seconds  * 1000000,
 796                             interval * 1000000) / 1E6;
 797
 798         OUTPUT:
 799         RETVAL
 800
 801 #endif /* #ifdef HAS_UALARM */
 802
 803 #ifdef HAS_GETTIMEOFDAY
 804 #    ifdef MACOS_TRADITIONAL    /* fix epoch TZ and use unsigned time_t */
 805 void
 806 gettimeofday()
 807         PREINIT:
 808         struct timeval Tp;
 809         struct timezone Tz;
 810         PPCODE:
 811         int status;
 812         status = gettimeofday (&Tp, &Tz);
 813         Tp.tv_sec += Tz.tz_minuteswest * 60;    /* adjust for TZ */
 814
 815         if (GIMME == G_ARRAY) {
 816              EXTEND(sp, 2);
 817              /* Mac OS (Classic) has unsigned time_t */
 818              PUSHs(sv_2mortal(newSVuv(Tp.tv_sec)));
 819              PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
 820         } else {
 821              EXTEND(sp, 1);
 822              PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
 823         }
 824
 825 NV
 826 time()
 827         PREINIT:
 828         struct timeval Tp;
 829         struct timezone Tz;
 830         CODE:
 831         int status;
 832         status = gettimeofday (&Tp, &Tz);
 833         Tp.tv_sec += Tz.tz_minuteswest * 60;    /* adjust for TZ */
 834         RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0);
 835         OUTPUT:
 836         RETVAL
 837
 838 #    else       /* MACOS_TRADITIONAL */
 839 void
 840 gettimeofday()
 841         PREINIT:
 842         struct timeval Tp;
 843         PPCODE:
 844         int status;
 845         status = gettimeofday (&Tp, NULL);
 846         if (GIMME == G_ARRAY) {
 847              EXTEND(sp, 2);
 848              PUSHs(sv_2mortal(newSViv(Tp.tv_sec)));
 849              PUSHs(sv_2mortal(newSViv(Tp.tv_usec)));
 850         } else {
 851              EXTEND(sp, 1);
 852              PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0))));
 853         }
 854
 855 NV
 856 time()
 857         PREINIT:
 858         struct timeval Tp;
 859         CODE:
 860         int status;
 861         status = gettimeofday (&Tp, NULL);
 862         RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
 863         OUTPUT:
 864         RETVAL
 865
 866 #    endif      /* MACOS_TRADITIONAL */
 867 #endif /* #ifdef HAS_GETTIMEOFDAY */
 868
 869 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER)
 870
 871 #define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec))
 872
 873 void
 874 setitimer(which, seconds, interval = 0)
 875         int which
 876         NV seconds
 877         NV interval
 878     PREINIT:
 879         struct itimerval newit;
 880         struct itimerval oldit;
 881     PPCODE:
 882         if (seconds < 0.0 || interval < 0.0)
 883             croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", (IV)which, seconds, interval);
 884         newit.it_value.tv_sec  = seconds;
 885         newit.it_value.tv_usec =
 886           (seconds  - (NV)newit.it_value.tv_sec)    * 1000000.0;
 887         newit.it_interval.tv_sec  = interval;
 888         newit.it_interval.tv_usec =
 889           (interval - (NV)newit.it_interval.tv_sec) * 1000000.0;
 890         if (setitimer(which, &newit, &oldit) == 0) {
 891           EXTEND(sp, 1);
 892           PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value))));
 893           if (GIMME == G_ARRAY) {
 894             EXTEND(sp, 1);
 895             PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval))));
 896           }
 897         }
 898
 899 void
 900 getitimer(which)
 901         int which
 902     PREINIT:
 903         struct itimerval nowit;
 904     PPCODE:
 905         if (getitimer(which, &nowit) == 0) {
 906           EXTEND(sp, 1);
 907           PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value))));
 908           if (GIMME == G_ARRAY) {
 909             EXTEND(sp, 1);
 910             PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval))));
 911           }
 912         }
 913
 914 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */
 915
 916