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