ext/Time/HiRes/HiRes.xs

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