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