1 /* 2 * 3 * Copyright (c) 1996-2002 Douglas E. Wegscheid. All rights reserved. 4 * 5 * Copyright (c) 2002-2010 Jarkko Hietaniemi. 6 * All rights reserved. 7 * 8 * Copyright (C) 2011, 2012, 2013 Andrew Main (Zefram) <zefram@fysh.org> 9 * 10 * This program is free software; you can redistribute it and/or modify 11 * it under the same terms as Perl itself. 12 */ 13 14 #ifdef __cplusplus 15 extern "C" { 16 #endif 17 #define PERL_NO_GET_CONTEXT 18 #include "EXTERN.h" 19 #include "perl.h" 20 #include "XSUB.h" 21 #include "reentr.h" 22 #ifdef USE_PPPORT_H 23 #define NEED_ck_warner 24 # include "ppport.h" 25 #endif 26 #if defined(__CYGWIN__) && defined(HAS_W32API_WINDOWS_H) 27 # include <w32api/windows.h> 28 # define CYGWIN_WITH_W32API 29 #endif 30 #ifdef WIN32 31 # include <time.h> 32 #else 33 # include <sys/time.h> 34 #endif 35 #ifdef HAS_SELECT 36 # ifdef I_SYS_SELECT 37 # include <sys/select.h> 38 # endif 39 #endif 40 #if defined(TIME_HIRES_CLOCK_GETTIME_SYSCALL) || defined(TIME_HIRES_CLOCK_GETRES_SYSCALL) 41 # include <syscall.h> 42 #endif 43 #ifdef __cplusplus 44 } 45 #endif 46 47 #ifndef GCC_DIAG_IGNORE 48 # define GCC_DIAG_IGNORE(x) 49 # define GCC_DIAG_RESTORE 50 #endif 51 #ifndef GCC_DIAG_IGNORE_STMT 52 # define GCC_DIAG_IGNORE_STMT(x) GCC_DIAG_IGNORE(x) NOOP 53 # define GCC_DIAG_RESTORE_STMT GCC_DIAG_RESTORE NOOP 54 #endif 55 56 #if PERL_VERSION_GE(5,7,3) && !PERL_VERSION_GE(5,10,1) 57 # undef SAVEOP 58 # define SAVEOP() SAVEVPTR(PL_op) 59 #endif 60 61 #define IV_1E6 1000000 62 #define IV_1E7 10000000 63 #define IV_1E9 1000000000 64 65 #define NV_1E6 1000000.0 66 #define NV_1E7 10000000.0 67 #define NV_1E9 1000000000.0 68 69 #ifndef PerlProc_pause 70 # define PerlProc_pause() Pause() 71 #endif 72 73 #ifdef HAS_PAUSE 74 # define Pause pause 75 #else 76 # undef Pause /* In case perl.h did it already. */ 77 # define Pause() sleep(~0) /* Zzz for a long time. */ 78 #endif 79 80 /* Though the cpp define ITIMER_VIRTUAL is available the functionality 81 * is not supported in Cygwin as of August 2004, ditto for Win32. 82 * Neither are ITIMER_PROF or ITIMER_REALPROF implemented. --jhi 83 */ 84 #if defined(__CYGWIN__) || defined(WIN32) 85 # undef ITIMER_VIRTUAL 86 # undef ITIMER_PROF 87 # undef ITIMER_REALPROF 88 #endif 89 90 #ifndef TIME_HIRES_CLOCKID_T 91 typedef int clockid_t; 92 #endif 93 94 #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) 95 96 /* HP-UX has CLOCK_XXX values but as enums, not as defines. 97 * The only way to detect these would be to test compile for each. */ 98 # ifdef __hpux 99 /* However, it seems that at least in HP-UX 11.31 ia64 there *are* 100 * defines for these, so let's try detecting them. */ 101 # ifndef CLOCK_REALTIME 102 # define CLOCK_REALTIME CLOCK_REALTIME 103 # define CLOCK_VIRTUAL CLOCK_VIRTUAL 104 # define CLOCK_PROFILE CLOCK_PROFILE 105 # endif 106 # endif /* # ifdef __hpux */ 107 108 #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) && defined(_STRUCT_ITIMERSPEC) */ 109 110 #if defined(WIN32) || defined(CYGWIN_WITH_W32API) 111 112 # ifndef HAS_GETTIMEOFDAY 113 # define HAS_GETTIMEOFDAY 114 # endif 115 116 /* shows up in winsock.h? 117 struct timeval { 118 long tv_sec; 119 long tv_usec; 120 } 121 */ 122 123 typedef union { 124 unsigned __int64 ft_i64; 125 FILETIME ft_val; 126 } FT_t; 127 128 # define MY_CXT_KEY "Time::HiRes_" XS_VERSION 129 130 typedef struct { 131 unsigned long run_count; 132 unsigned __int64 base_ticks; 133 unsigned __int64 tick_frequency; 134 FT_t base_systime_as_filetime; 135 unsigned __int64 reset_time; 136 } my_cxt_t; 137 138 /* Visual C++ 2013 and older don't have the timespec structure. 139 * Neither do mingw.org compilers with MinGW runtimes older than 3.22. */ 140 # if((defined(_MSC_VER) && _MSC_VER < 1900) || \ 141 (defined(__MINGW32__) && !defined(__MINGW64_VERSION_MAJOR) && \ 142 defined(__MINGW32_MAJOR_VERSION) && (__MINGW32_MAJOR_VERSION < 3 || \ 143 (__MINGW32_MAJOR_VERSION == 3 && __MINGW32_MINOR_VERSION < 22)))) 144 struct timespec { 145 time_t tv_sec; 146 long tv_nsec; 147 }; 148 # endif 149 150 START_MY_CXT 151 152 /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ 153 # ifdef __GNUC__ 154 # define Const64(x) x##LL 155 # else 156 # define Const64(x) x##i64 157 # endif 158 # define EPOCH_BIAS Const64(116444736000000000) 159 160 # ifdef Const64 161 # ifdef __GNUC__ 162 # define IV_1E6LL 1000000LL /* Needed because of Const64() ##-appends LL (or i64). */ 163 # define IV_1E7LL 10000000LL 164 # define IV_1E9LL 1000000000LL 165 # else 166 # define IV_1E6i64 1000000i64 167 # define IV_1E7i64 10000000i64 168 # define IV_1E9i64 1000000000i64 169 # endif 170 # endif 171 172 /* NOTE: This does not compute the timezone info (doing so can be expensive, 173 * and appears to be unsupported even by glibc) */ 174 175 /* dMY_CXT needs a Perl context and we don't want to call PERL_GET_CONTEXT 176 for performance reasons */ 177 178 # undef gettimeofday 179 # define gettimeofday(tp, not_used) _gettimeofday(aTHX_ tp, not_used) 180 181 # undef GetSystemTimePreciseAsFileTime 182 # define GetSystemTimePreciseAsFileTime(out) _GetSystemTimePreciseAsFileTime(aTHX_ out) 183 184 # undef clock_gettime 185 # define clock_gettime(clock_id, tp) _clock_gettime(aTHX_ clock_id, tp) 186 187 # undef clock_getres 188 # define clock_getres(clock_id, tp) _clock_getres(clock_id, tp) 189 190 # ifndef CLOCK_REALTIME 191 # define CLOCK_REALTIME 1 192 # define CLOCK_MONOTONIC 2 193 # endif 194 195 /* If the performance counter delta drifts more than 0.5 seconds from the 196 * system time then we recalibrate to the system time. This means we may 197 * move *backwards* in time! */ 198 # define MAX_PERF_COUNTER_SKEW Const64(5000000) /* 0.5 seconds */ 199 200 /* Reset reading from the performance counter every five minutes. 201 * Many PC clocks just seem to be so bad. */ 202 # define MAX_PERF_COUNTER_TICKS Const64(300000000) /* 300 seconds */ 203 204 /* 205 * Windows 8 introduced GetSystemTimePreciseAsFileTime(), but currently we have 206 * to support older systems, so for now we provide our own implementation. 207 * In the future we will switch to the real deal. 208 */ 209 static void 210 _GetSystemTimePreciseAsFileTime(pTHX_ FILETIME *out) 211 { 212 dMY_CXT; 213 FT_t ft; 214 215 if (MY_CXT.run_count++ == 0 || 216 MY_CXT.base_systime_as_filetime.ft_i64 > MY_CXT.reset_time) { 217 218 QueryPerformanceFrequency((LARGE_INTEGER*)&MY_CXT.tick_frequency); 219 QueryPerformanceCounter((LARGE_INTEGER*)&MY_CXT.base_ticks); 220 GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); 221 ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; 222 MY_CXT.reset_time = ft.ft_i64 + MAX_PERF_COUNTER_TICKS; 223 } 224 else { 225 __int64 diff; 226 unsigned __int64 ticks; 227 QueryPerformanceCounter((LARGE_INTEGER*)&ticks); 228 ticks -= MY_CXT.base_ticks; 229 ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64 230 + Const64(IV_1E7) * (ticks / MY_CXT.tick_frequency) 231 +(Const64(IV_1E7) * (ticks % MY_CXT.tick_frequency)) / MY_CXT.tick_frequency; 232 diff = ft.ft_i64 - MY_CXT.base_systime_as_filetime.ft_i64; 233 if (diff < -MAX_PERF_COUNTER_SKEW || diff > MAX_PERF_COUNTER_SKEW) { 234 MY_CXT.base_ticks += ticks; 235 GetSystemTimeAsFileTime(&MY_CXT.base_systime_as_filetime.ft_val); 236 ft.ft_i64 = MY_CXT.base_systime_as_filetime.ft_i64; 237 } 238 } 239 240 *out = ft.ft_val; 241 242 return; 243 } 244 245 static int 246 _gettimeofday(pTHX_ struct timeval *tp, void *not_used) 247 { 248 FT_t ft; 249 250 PERL_UNUSED_ARG(not_used); 251 252 GetSystemTimePreciseAsFileTime(&ft.ft_val); 253 254 /* seconds since epoch */ 255 tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(IV_1E7)); 256 257 /* microseconds remaining */ 258 tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(IV_1E6)); 259 260 return 0; 261 } 262 263 static int 264 _clock_gettime(pTHX_ clockid_t clock_id, struct timespec *tp) 265 { 266 FT_t ft; 267 268 switch (clock_id) { 269 case CLOCK_REALTIME: { 270 FT_t ft; 271 272 GetSystemTimePreciseAsFileTime(&ft.ft_val); 273 tp->tv_sec = (time_t)((ft.ft_i64 - EPOCH_BIAS) / IV_1E7); 274 tp->tv_nsec = (long)((ft.ft_i64 % IV_1E7) * 100); 275 break; 276 } 277 case CLOCK_MONOTONIC: { 278 unsigned __int64 freq, ticks; 279 280 QueryPerformanceFrequency((LARGE_INTEGER*)&freq); 281 QueryPerformanceCounter((LARGE_INTEGER*)&ticks); 282 283 tp->tv_sec = (time_t)(ticks / freq); 284 tp->tv_nsec = (long)((IV_1E9 * (ticks % freq)) / freq); 285 break; 286 } 287 default: 288 errno = EINVAL; 289 return 1; 290 } 291 292 return 0; 293 } 294 295 static int 296 _clock_getres(clockid_t clock_id, struct timespec *tp) 297 { 298 unsigned __int64 freq, qpc_res_ns; 299 300 QueryPerformanceFrequency((LARGE_INTEGER*)&freq); 301 qpc_res_ns = IV_1E9 > freq ? IV_1E9 / freq : 1; 302 303 switch (clock_id) { 304 case CLOCK_REALTIME: 305 tp->tv_sec = 0; 306 /* the resolution can't be smaller than 100ns because our implementation 307 * of CLOCK_REALTIME is using FILETIME internally */ 308 tp->tv_nsec = (long)(qpc_res_ns > 100 ? qpc_res_ns : 100); 309 break; 310 311 case CLOCK_MONOTONIC: 312 tp->tv_sec = 0; 313 tp->tv_nsec = (long)qpc_res_ns; 314 break; 315 316 default: 317 errno = EINVAL; 318 return 1; 319 } 320 321 return 0; 322 } 323 324 #endif /* #if defined(WIN32) || defined(CYGWIN_WITH_W32API) */ 325 326 /* Do not use H A S _ N A N O S L E E P 327 * so that Perl Configure doesn't scan for it (and pull in -lrt and 328 * the like which are not usually good ideas for the default Perl). 329 * (We are part of the core perl now.) 330 * The TIME_HIRES_NANOSLEEP is set by Makefile.PL. */ 331 #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) 332 # define HAS_USLEEP 333 # define usleep hrt_usleep /* could conflict with ncurses for static build */ 334 335 static void 336 hrt_usleep(unsigned long usec) /* This is used to emulate usleep. */ 337 { 338 struct timespec res; 339 res.tv_sec = usec / IV_1E6; 340 res.tv_nsec = ( usec - res.tv_sec * IV_1E6 ) * 1000; 341 nanosleep(&res, NULL); 342 } 343 344 #endif /* #if !defined(HAS_USLEEP) && defined(TIME_HIRES_NANOSLEEP) */ 345 346 #if !defined(HAS_USLEEP) && defined(HAS_SELECT) 347 # ifndef SELECT_IS_BROKEN 348 # define HAS_USLEEP 349 # define usleep hrt_usleep /* could conflict with ncurses for static build */ 350 351 static void 352 hrt_usleep(unsigned long usec) 353 { 354 struct timeval tv; 355 tv.tv_sec = 0; 356 tv.tv_usec = usec; 357 select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL, 358 (Select_fd_set_t)NULL, &tv); 359 } 360 # endif 361 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_SELECT) */ 362 363 #if !defined(HAS_USLEEP) && defined(WIN32) 364 # define HAS_USLEEP 365 # define usleep hrt_usleep /* could conflict with ncurses for static build */ 366 367 static void 368 hrt_usleep(unsigned long usec) 369 { 370 long msec; 371 msec = usec / 1000; 372 Sleep (msec); 373 } 374 #endif /* #if !defined(HAS_USLEEP) && defined(WIN32) */ 375 376 #if !defined(HAS_USLEEP) && defined(HAS_POLL) 377 # define HAS_USLEEP 378 # define usleep hrt_usleep /* could conflict with ncurses for static build */ 379 380 static void 381 hrt_usleep(unsigned long usec) 382 { 383 int msec = usec / 1000; 384 poll(0, 0, msec); 385 } 386 387 #endif /* #if !defined(HAS_USLEEP) && defined(HAS_POLL) */ 388 389 #if defined(HAS_SETITIMER) && defined(ITIMER_REAL) 390 391 static int 392 hrt_ualarm_itimero(struct itimerval *oitv, int usec, int uinterval) 393 { 394 struct itimerval itv; 395 itv.it_value.tv_sec = usec / IV_1E6; 396 itv.it_value.tv_usec = usec % IV_1E6; 397 itv.it_interval.tv_sec = uinterval / IV_1E6; 398 itv.it_interval.tv_usec = uinterval % IV_1E6; 399 return setitimer(ITIMER_REAL, &itv, oitv); 400 } 401 402 #endif /* #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) */ 403 404 #if !defined(HAS_UALARM) && defined(HAS_SETITIMER) 405 # define HAS_UALARM 406 # define ualarm hrt_ualarm_itimer /* could conflict with ncurses for static build */ 407 #endif 408 409 #if !defined(HAS_UALARM) && defined(VMS) 410 # define HAS_UALARM 411 # define ualarm vms_ualarm 412 413 # include <lib$routines.h> 414 # include <ssdef.h> 415 # include <starlet.h> 416 # include <descrip.h> 417 # include <signal.h> 418 # include <jpidef.h> 419 # include <psldef.h> 420 421 # define VMSERR(s) (!((s)&1)) 422 423 static void 424 us_to_VMS(useconds_t mseconds, unsigned long v[]) 425 { 426 int iss; 427 unsigned long qq[2]; 428 429 qq[0] = mseconds; 430 qq[1] = 0; 431 v[0] = v[1] = 0; 432 433 iss = lib$addx(qq,qq,qq); 434 if (VMSERR(iss)) lib$signal(iss); 435 iss = lib$subx(v,qq,v); 436 if (VMSERR(iss)) lib$signal(iss); 437 iss = lib$addx(qq,qq,qq); 438 if (VMSERR(iss)) lib$signal(iss); 439 iss = lib$subx(v,qq,v); 440 if (VMSERR(iss)) lib$signal(iss); 441 iss = lib$subx(v,qq,v); 442 if (VMSERR(iss)) lib$signal(iss); 443 } 444 445 static int 446 VMS_to_us(unsigned long v[]) 447 { 448 int iss; 449 unsigned long div=10,quot, rem; 450 451 iss = lib$ediv(&div,v,",&rem); 452 if (VMSERR(iss)) lib$signal(iss); 453 454 return quot; 455 } 456 457 typedef unsigned short word; 458 typedef struct _ualarm { 459 int function; 460 int repeat; 461 unsigned long delay[2]; 462 unsigned long interval[2]; 463 unsigned long remain[2]; 464 } Alarm; 465 466 467 static int alarm_ef; 468 static Alarm *a0, alarm_base; 469 # define UAL_NULL 0 470 # define UAL_SET 1 471 # define UAL_CLEAR 2 472 # define UAL_ACTIVE 4 473 static void ualarm_AST(Alarm *a); 474 475 static int 476 vms_ualarm(int mseconds, int interval) 477 { 478 Alarm *a, abase; 479 struct item_list3 { 480 word length; 481 word code; 482 void *bufaddr; 483 void *retlenaddr; 484 } ; 485 static struct item_list3 itmlst[2]; 486 static int first = 1; 487 unsigned long asten; 488 int iss, enabled; 489 490 if (first) { 491 first = 0; 492 itmlst[0].code = JPI$_ASTEN; 493 itmlst[0].length = sizeof(asten); 494 itmlst[0].retlenaddr = NULL; 495 itmlst[1].code = 0; 496 itmlst[1].length = 0; 497 itmlst[1].bufaddr = NULL; 498 itmlst[1].retlenaddr = NULL; 499 500 iss = lib$get_ef(&alarm_ef); 501 if (VMSERR(iss)) lib$signal(iss); 502 503 a0 = &alarm_base; 504 a0->function = UAL_NULL; 505 } 506 itmlst[0].bufaddr = &asten; 507 508 iss = sys$getjpiw(0,0,0,itmlst,0,0,0); 509 if (VMSERR(iss)) lib$signal(iss); 510 if (!(asten&0x08)) return -1; 511 512 a = &abase; 513 if (mseconds) { 514 a->function = UAL_SET; 515 } else { 516 a->function = UAL_CLEAR; 517 } 518 519 us_to_VMS(mseconds, a->delay); 520 if (interval) { 521 us_to_VMS(interval, a->interval); 522 a->repeat = 1; 523 } else 524 a->repeat = 0; 525 526 iss = sys$clref(alarm_ef); 527 if (VMSERR(iss)) lib$signal(iss); 528 529 iss = sys$dclast(ualarm_AST,a,0); 530 if (VMSERR(iss)) lib$signal(iss); 531 532 iss = sys$waitfr(alarm_ef); 533 if (VMSERR(iss)) lib$signal(iss); 534 535 if (a->function == UAL_ACTIVE) 536 return VMS_to_us(a->remain); 537 else 538 return 0; 539 } 540 541 542 543 static void 544 ualarm_AST(Alarm *a) 545 { 546 int iss; 547 unsigned long now[2]; 548 549 iss = sys$gettim(now); 550 if (VMSERR(iss)) lib$signal(iss); 551 552 if (a->function == UAL_SET || a->function == UAL_CLEAR) { 553 if (a0->function == UAL_ACTIVE) { 554 iss = sys$cantim(a0,PSL$C_USER); 555 if (VMSERR(iss)) lib$signal(iss); 556 557 iss = lib$subx(a0->remain, now, a->remain); 558 if (VMSERR(iss)) lib$signal(iss); 559 560 if (a->remain[1] & 0x80000000) 561 a->remain[0] = a->remain[1] = 0; 562 } 563 564 if (a->function == UAL_SET) { 565 a->function = a0->function; 566 a0->function = UAL_ACTIVE; 567 a0->repeat = a->repeat; 568 if (a0->repeat) { 569 a0->interval[0] = a->interval[0]; 570 a0->interval[1] = a->interval[1]; 571 } 572 a0->delay[0] = a->delay[0]; 573 a0->delay[1] = a->delay[1]; 574 575 iss = lib$subx(now, a0->delay, a0->remain); 576 if (VMSERR(iss)) lib$signal(iss); 577 578 iss = sys$setimr(0,a0->delay,ualarm_AST,a0); 579 if (VMSERR(iss)) lib$signal(iss); 580 } else { 581 a->function = a0->function; 582 a0->function = UAL_NULL; 583 } 584 iss = sys$setef(alarm_ef); 585 if (VMSERR(iss)) lib$signal(iss); 586 } else if (a->function == UAL_ACTIVE) { 587 if (a->repeat) { 588 iss = lib$subx(now, a->interval, a->remain); 589 if (VMSERR(iss)) lib$signal(iss); 590 591 iss = sys$setimr(0,a->interval,ualarm_AST,a); 592 if (VMSERR(iss)) lib$signal(iss); 593 } else { 594 a->function = UAL_NULL; 595 } 596 iss = sys$wake(0,0); 597 if (VMSERR(iss)) lib$signal(iss); 598 lib$signal(SS$_ASTFLT); 599 } else { 600 lib$signal(SS$_BADPARAM); 601 } 602 } 603 604 #endif /* #if !defined(HAS_UALARM) && defined(VMS) */ 605 606 #ifdef HAS_GETTIMEOFDAY 607 608 static int 609 myU2time(pTHX_ UV *ret) 610 { 611 struct timeval Tp; 612 int status; 613 status = gettimeofday (&Tp, NULL); 614 ret[0] = Tp.tv_sec; 615 ret[1] = Tp.tv_usec; 616 return status; 617 } 618 619 static NV 620 myNVtime() 621 { 622 # ifdef WIN32 623 dTHX; 624 # endif 625 struct timeval Tp; 626 int status; 627 status = gettimeofday (&Tp, NULL); 628 return status == 0 ? Tp.tv_sec + (Tp.tv_usec / NV_1E6) : -1.0; 629 } 630 631 #endif /* #ifdef HAS_GETTIMEOFDAY */ 632 633 static void 634 hrstatns(UV *atime_nsec, UV *mtime_nsec, UV *ctime_nsec) 635 { 636 dTHX; 637 #if TIME_HIRES_STAT == 1 638 *atime_nsec = PL_statcache.st_atimespec.tv_nsec; 639 *mtime_nsec = PL_statcache.st_mtimespec.tv_nsec; 640 *ctime_nsec = PL_statcache.st_ctimespec.tv_nsec; 641 #elif TIME_HIRES_STAT == 2 642 *atime_nsec = PL_statcache.st_atimensec; 643 *mtime_nsec = PL_statcache.st_mtimensec; 644 *ctime_nsec = PL_statcache.st_ctimensec; 645 #elif TIME_HIRES_STAT == 3 646 *atime_nsec = PL_statcache.st_atime_n; 647 *mtime_nsec = PL_statcache.st_mtime_n; 648 *ctime_nsec = PL_statcache.st_ctime_n; 649 #elif TIME_HIRES_STAT == 4 650 *atime_nsec = PL_statcache.st_atim.tv_nsec; 651 *mtime_nsec = PL_statcache.st_mtim.tv_nsec; 652 *ctime_nsec = PL_statcache.st_ctim.tv_nsec; 653 #elif TIME_HIRES_STAT == 5 654 *atime_nsec = PL_statcache.st_uatime * 1000; 655 *mtime_nsec = PL_statcache.st_umtime * 1000; 656 *ctime_nsec = PL_statcache.st_uctime * 1000; 657 #else /* !TIME_HIRES_STAT */ 658 *atime_nsec = 0; 659 *mtime_nsec = 0; 660 *ctime_nsec = 0; 661 #endif /* !TIME_HIRES_STAT */ 662 } 663 664 /* Until Apple implements clock_gettime() 665 * (ditto clock_getres() and clock_nanosleep()) 666 * we will emulate them using the Mach kernel interfaces. */ 667 #if defined(PERL_DARWIN) && \ 668 (defined(TIME_HIRES_CLOCK_GETTIME_EMULATION) || \ 669 defined(TIME_HIRES_CLOCK_GETRES_EMULATION) || \ 670 defined(TIME_HIRES_CLOCK_NANOSLEEP_EMULATION)) 671 672 # ifndef CLOCK_REALTIME 673 # define CLOCK_REALTIME 0x01 674 # define CLOCK_MONOTONIC 0x02 675 # endif 676 677 # ifndef TIMER_ABSTIME 678 # define TIMER_ABSTIME 0x01 679 # endif 680 681 # ifdef USE_ITHREADS 682 # define PERL_DARWIN_MUTEX 683 # endif 684 685 # ifdef PERL_DARWIN_MUTEX 686 STATIC perl_mutex darwin_time_mutex; 687 # endif 688 689 # include <mach/mach_time.h> 690 691 static uint64_t absolute_time_init; 692 static mach_timebase_info_data_t timebase_info; 693 static struct timespec timespec_init; 694 695 static int darwin_time_init() { 696 struct timeval tv; 697 int success = 1; 698 # ifdef PERL_DARWIN_MUTEX 699 MUTEX_LOCK(&darwin_time_mutex); 700 # endif 701 if (absolute_time_init == 0) { 702 /* mach_absolute_time() cannot fail */ 703 absolute_time_init = mach_absolute_time(); 704 success = mach_timebase_info(&timebase_info) == KERN_SUCCESS; 705 if (success) { 706 success = gettimeofday(&tv, NULL) == 0; 707 if (success) { 708 timespec_init.tv_sec = tv.tv_sec; 709 timespec_init.tv_nsec = tv.tv_usec * 1000; 710 } 711 } 712 } 713 # ifdef PERL_DARWIN_MUTEX 714 MUTEX_UNLOCK(&darwin_time_mutex); 715 # endif 716 return success; 717 } 718 719 # ifdef TIME_HIRES_CLOCK_GETTIME_EMULATION 720 static int th_clock_gettime(clockid_t clock_id, struct timespec *ts) { 721 if (darwin_time_init() && timebase_info.denom) { 722 switch (clock_id) { 723 case CLOCK_REALTIME: 724 { 725 uint64_t nanos = 726 ((mach_absolute_time() - absolute_time_init) * 727 (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; 728 ts->tv_sec = timespec_init.tv_sec + nanos / IV_1E9; 729 ts->tv_nsec = timespec_init.tv_nsec + nanos % IV_1E9; 730 return 0; 731 } 732 733 case CLOCK_MONOTONIC: 734 { 735 uint64_t nanos = 736 (mach_absolute_time() * 737 (uint64_t)timebase_info.numer) / (uint64_t)timebase_info.denom; 738 ts->tv_sec = nanos / IV_1E9; 739 ts->tv_nsec = nanos - ts->tv_sec * IV_1E9; 740 return 0; 741 } 742 743 default: 744 break; 745 } 746 } 747 748 SETERRNO(EINVAL, LIB_INVARG); 749 return -1; 750 } 751 752 # define clock_gettime(clock_id, ts) th_clock_gettime((clock_id), (ts)) 753 754 # endif /* TIME_HIRES_CLOCK_GETTIME_EMULATION */ 755 756 # ifdef TIME_HIRES_CLOCK_GETRES_EMULATION 757 static int th_clock_getres(clockid_t clock_id, struct timespec *ts) { 758 if (darwin_time_init() && timebase_info.denom) { 759 switch (clock_id) { 760 case CLOCK_REALTIME: 761 case CLOCK_MONOTONIC: 762 ts->tv_sec = 0; 763 /* In newer kernels both the numer and denom are one, 764 * resulting in conversion factor of one, which is of 765 * course unrealistic. */ 766 ts->tv_nsec = timebase_info.numer / timebase_info.denom; 767 return 0; 768 default: 769 break; 770 } 771 } 772 773 SETERRNO(EINVAL, LIB_INVARG); 774 return -1; 775 } 776 777 # define clock_getres(clock_id, ts) th_clock_getres((clock_id), (ts)) 778 # endif /* TIME_HIRES_CLOCK_GETRES_EMULATION */ 779 780 # ifdef TIME_HIRES_CLOCK_NANOSLEEP_EMULATION 781 static int th_clock_nanosleep(clockid_t clock_id, int flags, 782 const struct timespec *rqtp, 783 struct timespec *rmtp) { 784 if (darwin_time_init()) { 785 switch (clock_id) { 786 case CLOCK_REALTIME: 787 case CLOCK_MONOTONIC: 788 { 789 uint64_t nanos = rqtp->tv_sec * IV_1E9 + rqtp->tv_nsec; 790 int success; 791 if ((flags & TIMER_ABSTIME)) { 792 uint64_t back = 793 timespec_init.tv_sec * IV_1E9 + timespec_init.tv_nsec; 794 nanos = nanos > back ? nanos - back : 0; 795 } 796 success = 797 mach_wait_until(mach_absolute_time() + nanos) == KERN_SUCCESS; 798 799 /* In the relative sleep, the rmtp should be filled in with 800 * the 'unused' part of the rqtp in case the sleep gets 801 * interrupted by a signal. But it is unknown how signals 802 * interact with mach_wait_until(). In the absolute sleep, 803 * the rmtp should stay untouched. */ 804 rmtp->tv_sec = 0; 805 rmtp->tv_nsec = 0; 806 807 return success; 808 } 809 810 default: 811 break; 812 } 813 } 814 815 SETERRNO(EINVAL, LIB_INVARG); 816 return -1; 817 } 818 819 # define clock_nanosleep(clock_id, flags, rqtp, rmtp) \ 820 th_clock_nanosleep((clock_id), (flags), (rqtp), (rmtp)) 821 822 # endif /* TIME_HIRES_CLOCK_NANOSLEEP_EMULATION */ 823 824 #endif /* PERL_DARWIN */ 825 826 /* The macOS headers warn about using certain interfaces in 827 * OS-release-ignorant manner, for example: 828 * 829 * warning: 'futimens' is only available on macOS 10.13 or newer 830 * [-Wunguarded-availability-new] 831 * 832 * (ditto for utimensat) 833 * 834 * There is clang __builtin_available() *runtime* check for this. 835 * The gotchas are that neither __builtin_available() nor __has_builtin() 836 * are always available. 837 */ 838 #ifndef __has_builtin 839 # define __has_builtin(x) 0 /* non-clang */ 840 #endif 841 #ifdef HAS_FUTIMENS 842 # if defined(PERL_DARWIN) && __has_builtin(__builtin_available) 843 # define FUTIMENS_AVAILABLE __builtin_available(macOS 10.13, *) 844 # else 845 # define FUTIMENS_AVAILABLE 1 846 # endif 847 #else 848 # define FUTIMENS_AVAILABLE 0 849 #endif 850 #ifdef HAS_UTIMENSAT 851 # if defined(PERL_DARWIN) && __has_builtin(__builtin_available) 852 # define UTIMENSAT_AVAILABLE __builtin_available(macOS 10.13, *) 853 # else 854 # define UTIMENSAT_AVAILABLE 1 855 # endif 856 #else 857 # define UTIMENSAT_AVAILABLE 0 858 #endif 859 860 #include "const-c.inc" 861 862 #if (defined(TIME_HIRES_NANOSLEEP)) || \ 863 (defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME)) 864 865 static void 866 nanosleep_init(NV nsec, 867 struct timespec *sleepfor, 868 struct timespec *unslept) { 869 sleepfor->tv_sec = (Time_t)(nsec / NV_1E9); 870 sleepfor->tv_nsec = (long)(nsec - ((NV)sleepfor->tv_sec) * NV_1E9); 871 unslept->tv_sec = 0; 872 unslept->tv_nsec = 0; 873 } 874 875 static NV 876 nsec_without_unslept(struct timespec *sleepfor, 877 const struct timespec *unslept) { 878 if (sleepfor->tv_sec >= unslept->tv_sec) { 879 sleepfor->tv_sec -= unslept->tv_sec; 880 if (sleepfor->tv_nsec >= unslept->tv_nsec) { 881 sleepfor->tv_nsec -= unslept->tv_nsec; 882 } else if (sleepfor->tv_sec > 0) { 883 sleepfor->tv_sec--; 884 sleepfor->tv_nsec += IV_1E9; 885 sleepfor->tv_nsec -= unslept->tv_nsec; 886 } else { 887 sleepfor->tv_sec = 0; 888 sleepfor->tv_nsec = 0; 889 } 890 } else { 891 sleepfor->tv_sec = 0; 892 sleepfor->tv_nsec = 0; 893 } 894 return ((NV)sleepfor->tv_sec) * NV_1E9 + ((NV)sleepfor->tv_nsec); 895 } 896 897 #endif 898 899 /* In case Perl and/or Devel::PPPort are too old, minimally emulate 900 * IS_SAFE_PATHNAME() (which looks for zero bytes in the pathname). */ 901 #ifndef IS_SAFE_PATHNAME 902 # if PERL_VERSION_GE(5,12,0) /* Perl_ck_warner is 5.10.0 -> */ 903 # ifdef WARN_SYSCALLS 904 # define WARNEMUCAT WARN_SYSCALLS /* 5.22.0 -> */ 905 # else 906 # define WARNEMUCAT WARN_MISC 907 # endif 908 # define WARNEMU(opname) Perl_ck_warner(aTHX_ packWARN(WARNEMUCAT), "Invalid \\0 character in pathname for %s",opname) 909 # else 910 # define WARNEMU(opname) Perl_warn(aTHX_ "Invalid \\0 character in pathname for %s",opname) 911 # endif 912 # define IS_SAFE_PATHNAME(pv, len, opname) (((len)>1)&&memchr((pv), 0, (len)-1)?(SETERRNO(ENOENT, LIB_INVARG),WARNEMU(opname),FALSE):(TRUE)) 913 #endif 914 915 MODULE = Time::HiRes PACKAGE = Time::HiRes 916 917 PROTOTYPES: ENABLE 918 919 BOOT: 920 { 921 #ifdef MY_CXT_KEY 922 MY_CXT_INIT; 923 #endif 924 #ifdef HAS_GETTIMEOFDAY 925 { 926 (void) hv_store(PL_modglobal, "Time::NVtime", 12, 927 newSViv(PTR2IV(myNVtime)), 0); 928 (void) hv_store(PL_modglobal, "Time::U2time", 12, 929 newSViv(PTR2IV(myU2time)), 0); 930 } 931 #endif 932 #if defined(PERL_DARWIN) 933 # if defined(USE_ITHREADS) && defined(PERL_DARWIN_MUTEX) 934 MUTEX_INIT(&darwin_time_mutex); 935 # endif 936 #endif 937 } 938 939 #if defined(USE_ITHREADS) && defined(MY_CXT_KEY) 940 941 void 942 CLONE(...) 943 CODE: 944 MY_CXT_CLONE; 945 946 #endif 947 948 INCLUDE: const-xs.inc 949 950 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) 951 952 NV 953 usleep(useconds) 954 NV useconds 955 PREINIT: 956 struct timeval Ta, Tb; 957 CODE: 958 gettimeofday(&Ta, NULL); 959 if (items > 0) { 960 if (useconds >= NV_1E6) { 961 IV seconds = (IV) (useconds / NV_1E6); 962 /* If usleep() has been implemented using setitimer() 963 * then this contortion is unnecessary-- but usleep() 964 * may be implemented in some other way, so let's contort. */ 965 if (seconds) { 966 sleep(seconds); 967 useconds -= NV_1E6 * seconds; 968 } 969 } else if (useconds < 0.0) 970 croak("Time::HiRes::usleep(%" NVgf 971 "): negative time not invented yet", useconds); 972 973 usleep((U32)useconds); 974 } else 975 PerlProc_pause(); 976 977 gettimeofday(&Tb, NULL); 978 # if 0 979 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); 980 # endif 981 RETVAL = NV_1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec); 982 983 OUTPUT: 984 RETVAL 985 986 # if defined(TIME_HIRES_NANOSLEEP) 987 988 NV 989 nanosleep(nsec) 990 NV nsec 991 PREINIT: 992 struct timespec sleepfor, unslept; 993 CODE: 994 if (nsec < 0.0) 995 croak("Time::HiRes::nanosleep(%" NVgf 996 "): negative time not invented yet", nsec); 997 nanosleep_init(nsec, &sleepfor, &unslept); 998 if (nanosleep(&sleepfor, &unslept) == 0) { 999 RETVAL = nsec; 1000 } else { 1001 RETVAL = nsec_without_unslept(&sleepfor, &unslept); 1002 } 1003 OUTPUT: 1004 RETVAL 1005 1006 # else /* #if defined(TIME_HIRES_NANOSLEEP) */ 1007 1008 NV 1009 nanosleep(nsec) 1010 NV nsec 1011 CODE: 1012 PERL_UNUSED_ARG(nsec); 1013 croak("Time::HiRes::nanosleep(): unimplemented in this platform"); 1014 RETVAL = 0.0; 1015 OUTPUT: 1016 RETVAL 1017 1018 # endif /* #if defined(TIME_HIRES_NANOSLEEP) */ 1019 1020 NV 1021 sleep(...) 1022 PREINIT: 1023 struct timeval Ta, Tb; 1024 CODE: 1025 gettimeofday(&Ta, NULL); 1026 if (items > 0) { 1027 NV seconds = SvNV(ST(0)); 1028 if (seconds >= 0.0) { 1029 UV useconds = (UV)(1E6 * (seconds - (UV)seconds)); 1030 if (seconds >= 1.0) 1031 sleep((U32)seconds); 1032 if ((IV)useconds < 0) { 1033 # if defined(__sparc64__) && defined(__GNUC__) 1034 /* Sparc64 gcc 2.95.3 (e.g. on NetBSD) has a bug 1035 * where (0.5 - (UV)(0.5)) will under certain 1036 * circumstances (if the double is cast to UV more 1037 * than once?) evaluate to -0.5, instead of 0.5. */ 1038 useconds = -(IV)useconds; 1039 # endif /* #if defined(__sparc64__) && defined(__GNUC__) */ 1040 if ((IV)useconds < 0) 1041 croak("Time::HiRes::sleep(%" NVgf 1042 "): internal error: useconds < 0 (unsigned %" UVuf 1043 " signed %" IVdf ")", 1044 seconds, useconds, (IV)useconds); 1045 } 1046 usleep(useconds); 1047 } else 1048 croak("Time::HiRes::sleep(%" NVgf 1049 "): negative time not invented yet", seconds); 1050 } else 1051 PerlProc_pause(); 1052 1053 gettimeofday(&Tb, NULL); 1054 # if 0 1055 printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec); 1056 # endif 1057 RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec); 1058 1059 OUTPUT: 1060 RETVAL 1061 1062 #else /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ 1063 1064 NV 1065 usleep(useconds) 1066 NV useconds 1067 CODE: 1068 PERL_UNUSED_ARG(useconds); 1069 croak("Time::HiRes::usleep(): unimplemented in this platform"); 1070 RETVAL = 0.0; 1071 OUTPUT: 1072 RETVAL 1073 1074 #endif /* #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY) */ 1075 1076 #ifdef HAS_UALARM 1077 1078 IV 1079 ualarm(useconds,uinterval=0) 1080 int useconds 1081 int uinterval 1082 CODE: 1083 if (useconds < 0 || uinterval < 0) 1084 croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, uinterval); 1085 # if defined(HAS_SETITIMER) && defined(ITIMER_REAL) 1086 { 1087 struct itimerval itv; 1088 if (hrt_ualarm_itimero(&itv, useconds, uinterval)) { 1089 /* To conform to ualarm's interface, we're actually ignoring 1090 an error here. */ 1091 RETVAL = 0; 1092 } else { 1093 RETVAL = itv.it_value.tv_sec * IV_1E6 + itv.it_value.tv_usec; 1094 } 1095 } 1096 # else 1097 if (useconds >= IV_1E6 || uinterval >= IV_1E6) 1098 croak("Time::HiRes::ualarm(%d, %d): useconds or uinterval" 1099 " equal to or more than %" IVdf, 1100 useconds, uinterval, IV_1E6); 1101 1102 RETVAL = ualarm(useconds, uinterval); 1103 # endif 1104 1105 OUTPUT: 1106 RETVAL 1107 1108 NV 1109 alarm(seconds,interval=0) 1110 NV seconds 1111 NV interval 1112 CODE: 1113 if (seconds < 0.0 || interval < 0.0) 1114 croak("Time::HiRes::alarm(%" NVgf ", %" NVgf 1115 "): negative time not invented yet", seconds, interval); 1116 1117 { 1118 IV iseconds = (IV)seconds; 1119 IV iinterval = (IV)interval; 1120 NV fseconds = seconds - iseconds; 1121 NV finterval = interval - iinterval; 1122 IV useconds, uinterval; 1123 if (fseconds >= 1.0 || finterval >= 1.0) 1124 croak("Time::HiRes::alarm(%" NVgf ", %" NVgf 1125 "): seconds or interval too large to split correctly", 1126 seconds, interval); 1127 1128 useconds = IV_1E6 * fseconds; 1129 uinterval = IV_1E6 * finterval; 1130 # if defined(HAS_SETITIMER) && defined(ITIMER_REAL) 1131 { 1132 struct itimerval nitv, oitv; 1133 nitv.it_value.tv_sec = iseconds; 1134 nitv.it_value.tv_usec = useconds; 1135 nitv.it_interval.tv_sec = iinterval; 1136 nitv.it_interval.tv_usec = uinterval; 1137 if (setitimer(ITIMER_REAL, &nitv, &oitv)) { 1138 /* To conform to alarm's interface, we're actually ignoring 1139 an error here. */ 1140 RETVAL = 0; 1141 } else { 1142 RETVAL = oitv.it_value.tv_sec + ((NV)oitv.it_value.tv_usec) / NV_1E6; 1143 } 1144 } 1145 # else 1146 if (iseconds || iinterval) 1147 croak("Time::HiRes::alarm(%" NVgf ", %" NVgf 1148 "): seconds or interval equal to or more than 1.0 ", 1149 seconds, interval); 1150 1151 RETVAL = (NV)ualarm( useconds, uinterval ) / NV_1E6; 1152 # endif 1153 } 1154 1155 OUTPUT: 1156 RETVAL 1157 1158 #else /* #ifdef HAS_UALARM */ 1159 1160 int 1161 ualarm(useconds,interval=0) 1162 int useconds 1163 int interval 1164 CODE: 1165 PERL_UNUSED_ARG(useconds); 1166 PERL_UNUSED_ARG(interval); 1167 croak("Time::HiRes::ualarm(): unimplemented in this platform"); 1168 RETVAL = -1; 1169 OUTPUT: 1170 RETVAL 1171 1172 NV 1173 alarm(seconds,interval=0) 1174 NV seconds 1175 NV interval 1176 CODE: 1177 PERL_UNUSED_ARG(seconds); 1178 PERL_UNUSED_ARG(interval); 1179 croak("Time::HiRes::alarm(): unimplemented in this platform"); 1180 RETVAL = 0.0; 1181 OUTPUT: 1182 RETVAL 1183 1184 #endif /* #ifdef HAS_UALARM */ 1185 1186 #ifdef HAS_GETTIMEOFDAY 1187 1188 void 1189 gettimeofday() 1190 PREINIT: 1191 struct timeval Tp; 1192 PPCODE: 1193 int status; 1194 status = gettimeofday (&Tp, NULL); 1195 if (status == 0) { 1196 if (GIMME == G_LIST) { 1197 EXTEND(sp, 2); 1198 PUSHs(sv_2mortal(newSViv(Tp.tv_sec))); 1199 PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); 1200 } else { 1201 EXTEND(sp, 1); 1202 PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / NV_1E6)))); 1203 } 1204 } 1205 1206 NV 1207 time() 1208 PREINIT: 1209 struct timeval Tp; 1210 CODE: 1211 int status; 1212 status = gettimeofday (&Tp, NULL); 1213 if (status == 0) { 1214 RETVAL = Tp.tv_sec + (Tp.tv_usec / NV_1E6); 1215 } else { 1216 RETVAL = -1.0; 1217 } 1218 OUTPUT: 1219 RETVAL 1220 1221 #endif /* #ifdef HAS_GETTIMEOFDAY */ 1222 1223 #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) 1224 1225 # define TV2NV(tv) ((NV)((tv).tv_sec) + 0.000001 * (NV)((tv).tv_usec)) 1226 1227 void 1228 setitimer(which, seconds, interval = 0) 1229 int which 1230 NV seconds 1231 NV interval 1232 PREINIT: 1233 struct itimerval newit; 1234 struct itimerval oldit; 1235 PPCODE: 1236 if (seconds < 0.0 || interval < 0.0) 1237 croak("Time::HiRes::setitimer(%" IVdf ", %" NVgf ", %" NVgf 1238 "): negative time not invented yet", 1239 (IV)which, seconds, interval); 1240 newit.it_value.tv_sec = (IV)seconds; 1241 newit.it_value.tv_usec = 1242 (IV)((seconds - (NV)newit.it_value.tv_sec) * NV_1E6); 1243 newit.it_interval.tv_sec = (IV)interval; 1244 newit.it_interval.tv_usec = 1245 (IV)((interval - (NV)newit.it_interval.tv_sec) * NV_1E6); 1246 /* on some platforms the 1st arg to setitimer is an enum, which 1247 * causes -Wc++-compat to complain about passing an int instead 1248 */ 1249 GCC_DIAG_IGNORE_STMT(-Wc++-compat); 1250 if (setitimer(which, &newit, &oldit) == 0) { 1251 EXTEND(sp, 1); 1252 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_value)))); 1253 if (GIMME == G_LIST) { 1254 EXTEND(sp, 1); 1255 PUSHs(sv_2mortal(newSVnv(TV2NV(oldit.it_interval)))); 1256 } 1257 } 1258 GCC_DIAG_RESTORE_STMT; 1259 1260 void 1261 getitimer(which) 1262 int which 1263 PREINIT: 1264 struct itimerval nowit; 1265 PPCODE: 1266 /* on some platforms the 1st arg to getitimer is an enum, which 1267 * causes -Wc++-compat to complain about passing an int instead 1268 */ 1269 GCC_DIAG_IGNORE_STMT(-Wc++-compat); 1270 if (getitimer(which, &nowit) == 0) { 1271 EXTEND(sp, 1); 1272 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_value)))); 1273 if (GIMME == G_LIST) { 1274 EXTEND(sp, 1); 1275 PUSHs(sv_2mortal(newSVnv(TV2NV(nowit.it_interval)))); 1276 } 1277 } 1278 GCC_DIAG_RESTORE_STMT; 1279 1280 #endif /* #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) */ 1281 1282 #if defined(TIME_HIRES_UTIME) 1283 1284 I32 1285 utime(accessed, modified, ...) 1286 PROTOTYPE: $$@ 1287 PREINIT: 1288 SV* accessed; 1289 SV* modified; 1290 SV* file; 1291 1292 struct timespec utbuf[2]; 1293 struct timespec *utbufp = utbuf; 1294 int tot; 1295 1296 CODE: 1297 accessed = ST(0); 1298 modified = ST(1); 1299 items -= 2; 1300 tot = 0; 1301 1302 if ( accessed == &PL_sv_undef && modified == &PL_sv_undef ) 1303 utbufp = NULL; 1304 else { 1305 if (SvNV(accessed) < 0.0 || SvNV(modified) < 0.0) 1306 croak("Time::HiRes::utime(%" NVgf ", %" NVgf 1307 "): negative time not invented yet", 1308 SvNV(accessed), SvNV(modified)); 1309 Zero(&utbuf, sizeof utbuf, char); 1310 1311 utbuf[0].tv_sec = (Time_t)SvNV(accessed); /* time accessed */ 1312 utbuf[0].tv_nsec = (long)( 1313 (SvNV(accessed) - (NV)utbuf[0].tv_sec) 1314 * NV_1E9 + (NV)0.5); 1315 1316 utbuf[1].tv_sec = (Time_t)SvNV(modified); /* time modified */ 1317 utbuf[1].tv_nsec = (long)( 1318 (SvNV(modified) - (NV)utbuf[1].tv_sec) 1319 * NV_1E9 + (NV)0.5); 1320 } 1321 1322 while (items > 0) { 1323 file = POPs; items--; 1324 1325 if (SvROK(file) && GvIO(SvRV(file)) && IoIFP(sv_2io(SvRV(file)))) { 1326 int fd = PerlIO_fileno(IoIFP(sv_2io(file))); 1327 if (fd < 0) { 1328 SETERRNO(EBADF,RMS_IFI); 1329 } else { 1330 # ifdef HAS_FUTIMENS 1331 if (FUTIMENS_AVAILABLE) { 1332 if (futimens(fd, utbufp) == 0) { 1333 tot++; 1334 } 1335 } else { 1336 croak("futimens unimplemented in this platform"); 1337 } 1338 # else /* HAS_FUTIMENS */ 1339 croak("futimens unimplemented in this platform"); 1340 # endif /* HAS_FUTIMENS */ 1341 } 1342 } 1343 else { 1344 # ifdef HAS_UTIMENSAT 1345 if (UTIMENSAT_AVAILABLE) { 1346 STRLEN len; 1347 char * name = SvPV(file, len); 1348 if (IS_SAFE_PATHNAME(name, len, "utime") && 1349 utimensat(AT_FDCWD, name, utbufp, 0) == 0) { 1350 1351 tot++; 1352 } 1353 } else { 1354 croak("utimensat unimplemented in this platform"); 1355 } 1356 # else /* HAS_UTIMENSAT */ 1357 croak("utimensat unimplemented in this platform"); 1358 # endif /* HAS_UTIMENSAT */ 1359 } 1360 } /* while items */ 1361 RETVAL = tot; 1362 1363 OUTPUT: 1364 RETVAL 1365 1366 #else /* #if defined(TIME_HIRES_UTIME) */ 1367 1368 I32 1369 utime(accessed, modified, ...) 1370 CODE: 1371 croak("Time::HiRes::utime(): unimplemented in this platform"); 1372 RETVAL = 0; 1373 OUTPUT: 1374 RETVAL 1375 1376 #endif /* #if defined(TIME_HIRES_UTIME) */ 1377 1378 #if defined(TIME_HIRES_CLOCK_GETTIME) 1379 1380 NV 1381 clock_gettime(clock_id = CLOCK_REALTIME) 1382 clockid_t clock_id 1383 PREINIT: 1384 struct timespec ts; 1385 int status = -1; 1386 CODE: 1387 # ifdef TIME_HIRES_CLOCK_GETTIME_SYSCALL 1388 status = syscall(SYS_clock_gettime, clock_id, &ts); 1389 # else 1390 status = clock_gettime(clock_id, &ts); 1391 # endif 1392 RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; 1393 1394 OUTPUT: 1395 RETVAL 1396 1397 #else /* if defined(TIME_HIRES_CLOCK_GETTIME) */ 1398 1399 NV 1400 clock_gettime(clock_id = 0) 1401 clockid_t clock_id 1402 CODE: 1403 PERL_UNUSED_ARG(clock_id); 1404 croak("Time::HiRes::clock_gettime(): unimplemented in this platform"); 1405 RETVAL = 0.0; 1406 OUTPUT: 1407 RETVAL 1408 1409 #endif /* #if defined(TIME_HIRES_CLOCK_GETTIME) */ 1410 1411 #if defined(TIME_HIRES_CLOCK_GETRES) 1412 1413 NV 1414 clock_getres(clock_id = CLOCK_REALTIME) 1415 clockid_t clock_id 1416 PREINIT: 1417 int status = -1; 1418 struct timespec ts; 1419 CODE: 1420 # ifdef TIME_HIRES_CLOCK_GETRES_SYSCALL 1421 status = syscall(SYS_clock_getres, clock_id, &ts); 1422 # else 1423 status = clock_getres(clock_id, &ts); 1424 # endif 1425 RETVAL = status == 0 ? ts.tv_sec + (NV) ts.tv_nsec / NV_1E9 : -1; 1426 1427 OUTPUT: 1428 RETVAL 1429 1430 #else /* if defined(TIME_HIRES_CLOCK_GETRES) */ 1431 1432 NV 1433 clock_getres(clock_id = 0) 1434 clockid_t clock_id 1435 CODE: 1436 PERL_UNUSED_ARG(clock_id); 1437 croak("Time::HiRes::clock_getres(): unimplemented in this platform"); 1438 RETVAL = 0.0; 1439 OUTPUT: 1440 RETVAL 1441 1442 #endif /* #if defined(TIME_HIRES_CLOCK_GETRES) */ 1443 1444 #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) 1445 1446 NV 1447 clock_nanosleep(clock_id, nsec, flags = 0) 1448 clockid_t clock_id 1449 NV nsec 1450 int flags 1451 PREINIT: 1452 struct timespec sleepfor, unslept; 1453 CODE: 1454 if (nsec < 0.0) 1455 croak("Time::HiRes::clock_nanosleep(..., %" NVgf 1456 "): negative time not invented yet", nsec); 1457 nanosleep_init(nsec, &sleepfor, &unslept); 1458 if (clock_nanosleep(clock_id, flags, &sleepfor, &unslept) == 0) { 1459 RETVAL = nsec; 1460 } else { 1461 RETVAL = nsec_without_unslept(&sleepfor, &unslept); 1462 } 1463 OUTPUT: 1464 RETVAL 1465 1466 #else /* if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */ 1467 1468 NV 1469 clock_nanosleep(clock_id, nsec, flags = 0) 1470 clockid_t clock_id 1471 NV nsec 1472 int flags 1473 CODE: 1474 PERL_UNUSED_ARG(clock_id); 1475 PERL_UNUSED_ARG(nsec); 1476 PERL_UNUSED_ARG(flags); 1477 croak("Time::HiRes::clock_nanosleep(): unimplemented in this platform"); 1478 RETVAL = 0.0; 1479 OUTPUT: 1480 RETVAL 1481 1482 #endif /* #if defined(TIME_HIRES_CLOCK_NANOSLEEP) && defined(TIMER_ABSTIME) */ 1483 1484 #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) 1485 1486 NV 1487 clock() 1488 PREINIT: 1489 clock_t clocks; 1490 CODE: 1491 clocks = clock(); 1492 RETVAL = clocks == (clock_t) -1 ? (clock_t) -1 : (NV)clocks / (NV)CLOCKS_PER_SEC; 1493 1494 OUTPUT: 1495 RETVAL 1496 1497 #else /* if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ 1498 1499 NV 1500 clock() 1501 CODE: 1502 croak("Time::HiRes::clock(): unimplemented in this platform"); 1503 RETVAL = 0.0; 1504 OUTPUT: 1505 RETVAL 1506 1507 #endif /* #if defined(TIME_HIRES_CLOCK) && defined(CLOCKS_PER_SEC) */ 1508 1509 void 1510 stat(...) 1511 PROTOTYPE: ;$ 1512 PREINIT: 1513 OP fakeop; 1514 int nret; 1515 ALIAS: 1516 Time::HiRes::lstat = 1 1517 PPCODE: 1518 XPUSHs(sv_2mortal(newSVsv(items == 1 ? ST(0) : DEFSV))); 1519 PUTBACK; 1520 ENTER; 1521 PL_laststatval = -1; 1522 SAVEOP(); 1523 Zero(&fakeop, 1, OP); 1524 fakeop.op_type = ix ? OP_LSTAT : OP_STAT; 1525 fakeop.op_ppaddr = PL_ppaddr[fakeop.op_type]; 1526 fakeop.op_flags = GIMME_V == G_LIST ? OPf_WANT_LIST : 1527 GIMME_V == G_SCALAR ? OPf_WANT_SCALAR : OPf_WANT_VOID; 1528 PL_op = &fakeop; 1529 (void)fakeop.op_ppaddr(aTHX); 1530 SPAGAIN; 1531 LEAVE; 1532 nret = SP+1 - &ST(0); 1533 if (nret == 13) { 1534 UV atime = SvUV(ST( 8)); 1535 UV mtime = SvUV(ST( 9)); 1536 UV ctime = SvUV(ST(10)); 1537 UV atime_nsec; 1538 UV mtime_nsec; 1539 UV ctime_nsec; 1540 hrstatns(&atime_nsec, &mtime_nsec, &ctime_nsec); 1541 if (atime_nsec) 1542 ST( 8) = sv_2mortal(newSVnv(atime + (NV) atime_nsec / NV_1E9)); 1543 if (mtime_nsec) 1544 ST( 9) = sv_2mortal(newSVnv(mtime + (NV) mtime_nsec / NV_1E9)); 1545 if (ctime_nsec) 1546 ST(10) = sv_2mortal(newSVnv(ctime + (NV) ctime_nsec / NV_1E9)); 1547 } 1548 XSRETURN(nret); 1549