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