X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FTime%2FHiRes%2FHiRes.xs;h=9d3586dee8325d74b05d4474371f564e0f9e58b7;hb=6e3b076d535420d10e4d928a62445e7e7b46eef7;hp=3bb1aa416227a781907c93296926d5154af1d7de;hpb=92bc48ca26b0fb2ba59389610ad13851aac4fcb8;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs index 3bb1aa4..9d3586d 100644 --- a/ext/Time/HiRes/HiRes.xs +++ b/ext/Time/HiRes/HiRes.xs @@ -9,6 +9,11 @@ extern "C" { #else #include #endif +#ifdef HAS_SELECT +# ifdef I_SYS_SELECT +# include +# endif +#endif #ifdef __cplusplus } #endif @@ -69,7 +74,12 @@ typedef union { } FT_t; /* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */ -#define EPOCH_BIAS 116444736000000000i64 +#ifdef __GNUC__ +#define Const64(x) x##LL +#else +#define Const64(x) x##i64 +#endif +#define EPOCH_BIAS Const64(116444736000000000) /* NOTE: This does not compute the timezone info (doing so can be expensive, * and appears to be unsupported even by glibc) */ @@ -82,10 +92,10 @@ gettimeofday (struct timeval *tp, void *not_used) GetSystemTimeAsFileTime(&ft.ft_val); /* seconds since epoch */ - tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / 10000000i64); + tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / Const64(10000000)); /* microseconds remaining */ - tp->tv_usec = (long)((ft.ft_i64 / 10i64) % 1000000i64); + tp->tv_usec = (long)((ft.ft_i64 / Const64(10)) % Const64(1000000)); return 0; } @@ -324,6 +334,205 @@ hrt_ualarm(int usec, int interval) } #endif +#if !defined(HAS_UALARM) && defined(VMS) +#define HAS_UALARM +#define ualarm vms_ualarm + +#include +#include +#include +#include +#include +#include +#include + +#define VMSERR(s) (!((s)&1)) + +static void +us_to_VMS(useconds_t mseconds, unsigned long v[]) +{ + int iss; + unsigned long qq[2]; + + qq[0] = mseconds; + qq[1] = 0; + v[0] = v[1] = 0; + + iss = lib$addx(qq,qq,qq); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$addx(qq,qq,qq); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); + iss = lib$subx(v,qq,v); + if (VMSERR(iss)) lib$signal(iss); +} + +static int +VMS_to_us(unsigned long v[]) +{ + int iss; + unsigned long div=10,quot, rem; + + iss = lib$ediv(&div,v,",&rem); + if (VMSERR(iss)) lib$signal(iss); + + return quot; +} + +typedef unsigned short word; +typedef struct _ualarm { + int function; + int repeat; + unsigned long delay[2]; + unsigned long interval[2]; + unsigned long remain[2]; +} Alarm; + + +static int alarm_ef; +static Alarm *a0, alarm_base; +#define UAL_NULL 0 +#define UAL_SET 1 +#define UAL_CLEAR 2 +#define UAL_ACTIVE 4 +static void ualarm_AST(Alarm *a); + +static int +vms_ualarm(int mseconds, int interval) +{ + Alarm *a, abase; + struct item_list3 { + word length; + word code; + void *bufaddr; + void *retlenaddr; + } ; + static struct item_list3 itmlst[2]; + static int first = 1; + unsigned long asten; + int iss, enabled; + + if (first) { + first = 0; + itmlst[0].code = JPI$_ASTEN; + itmlst[0].length = sizeof(asten); + itmlst[0].retlenaddr = NULL; + itmlst[1].code = 0; + itmlst[1].length = 0; + itmlst[1].bufaddr = NULL; + itmlst[1].retlenaddr = NULL; + + iss = lib$get_ef(&alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + a0 = &alarm_base; + a0->function = UAL_NULL; + } + itmlst[0].bufaddr = &asten; + + iss = sys$getjpiw(0,0,0,itmlst,0,0,0); + if (VMSERR(iss)) lib$signal(iss); + if (!(asten&0x08)) return -1; + + a = &abase; + if (mseconds) { + a->function = UAL_SET; + } else { + a->function = UAL_CLEAR; + } + + us_to_VMS(mseconds, a->delay); + if (interval) { + us_to_VMS(interval, a->interval); + a->repeat = 1; + } else + a->repeat = 0; + + iss = sys$clref(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$dclast(ualarm_AST,a,0); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$waitfr(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + + if (a->function == UAL_ACTIVE) + return VMS_to_us(a->remain); + else + return 0; +} + + + +static void +ualarm_AST(Alarm *a) +{ + int iss; + unsigned long now[2]; + + iss = sys$gettim(now); + if (VMSERR(iss)) lib$signal(iss); + + if (a->function == UAL_SET || a->function == UAL_CLEAR) { + if (a0->function == UAL_ACTIVE) { + iss = sys$cantim(a0,PSL$C_USER); + if (VMSERR(iss)) lib$signal(iss); + + iss = lib$subx(a0->remain, now, a->remain); + if (VMSERR(iss)) lib$signal(iss); + + if (a->remain[1] & 0x80000000) + a->remain[0] = a->remain[1] = 0; + } + + if (a->function == UAL_SET) { + a->function = a0->function; + a0->function = UAL_ACTIVE; + a0->repeat = a->repeat; + if (a0->repeat) { + a0->interval[0] = a->interval[0]; + a0->interval[1] = a->interval[1]; + } + a0->delay[0] = a->delay[0]; + a0->delay[1] = a->delay[1]; + + iss = lib$subx(now, a0->delay, a0->remain); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$setimr(0,a0->delay,ualarm_AST,a0); + if (VMSERR(iss)) lib$signal(iss); + } else { + a->function = a0->function; + a0->function = UAL_NULL; + } + iss = sys$setef(alarm_ef); + if (VMSERR(iss)) lib$signal(iss); + } else if (a->function == UAL_ACTIVE) { + if (a->repeat) { + iss = lib$subx(now, a->interval, a->remain); + if (VMSERR(iss)) lib$signal(iss); + + iss = sys$setimr(0,a->interval,ualarm_AST,a); + if (VMSERR(iss)) lib$signal(iss); + } else { + a->function = UAL_NULL; + } + iss = sys$wake(0,0); + if (VMSERR(iss)) lib$signal(iss); + lib$signal(SS$_ASTFLT); + } else { + lib$signal(SS$_BADPARAM); + } +} + +#endif /* !HAS_UALARM && VMS */ + + + #ifdef HAS_GETTIMEOFDAY static int @@ -356,7 +565,7 @@ BOOT: #ifdef HAS_GETTIMEOFDAY { UV auv[2]; - hv_store(PL_modglobal, "Time::NVtime", 12, newSViv((IV) myNVtime()), 0); + hv_store(PL_modglobal, "Time::NVtime", 12, newSViv(PTR2IV(myNVtime)), 0); if (myU2time(auv) == 0) hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) auv[0]), 0); } @@ -379,9 +588,15 @@ usleep(useconds) if (items > 0) { if (useconds > 1E6) { IV seconds = (IV) (useconds / 1E6); - sleep(seconds); - useconds -= 1E6 * seconds; - } + /* If usleep() has been implemented using setitimer() + * then this contortion is unnecessary-- but usleep() + * may be implemented in some other way, so let's contort. */ + if (seconds) { + sleep(seconds); + useconds -= 1E6 * seconds; + } + } else if (useconds < 0.0) + croak("Time::HiRes::usleep(%"NVgf"): negative time not invented yet", useconds); usleep((UV)useconds); } else PerlProc_pause(); @@ -402,9 +617,13 @@ sleep(...) gettimeofday(&Ta, NULL); if (items > 0) { NV seconds = SvNV(ST(0)); - IV useconds = 1E6 * (seconds - (IV)seconds); - sleep(seconds); - usleep(useconds); + if (seconds >= 0.0) { + UV useconds = (UV)(1E6 * (seconds - (UV)seconds)); + if (seconds >= 1.0) + sleep((UV)seconds); + usleep(useconds); + } else + croak("Time::HiRes::sleep(%"NVgf"): negative time not invented yet", seconds); } else PerlProc_pause(); gettimeofday(&Tb, NULL); @@ -424,17 +643,23 @@ int ualarm(useconds,interval=0) int useconds int interval + CODE: + if (useconds < 0 || interval < 0) + croak("Time::HiRes::ualarm(%d, %d): negative time not invented yet", useconds, interval); + RETVAL = ualarm(useconds, interval); -int -alarm(fseconds,finterval=0) - NV fseconds - NV finterval - PREINIT: - int useconds, uinterval; + OUTPUT: + RETVAL + +NV +alarm(seconds,interval=0) + NV seconds + NV interval CODE: - useconds = fseconds * 1000000; - uinterval = finterval * 1000000; - RETVAL = ualarm (useconds, uinterval); + if (seconds < 0.0 || interval < 0.0) + croak("Time::HiRes::alarm(%"NVgf", %"NVgf"): negative time not invented yet", seconds, interval); + RETVAL = (NV)ualarm(seconds * 1000000, + interval * 1000000) / 1E6; OUTPUT: RETVAL @@ -442,7 +667,41 @@ alarm(fseconds,finterval=0) #endif #ifdef HAS_GETTIMEOFDAY +# ifdef MACOS_TRADITIONAL /* fix epoch TZ and use unsigned time_t */ +void +gettimeofday() + PREINIT: + struct timeval Tp; + struct timezone Tz; + PPCODE: + int status; + status = gettimeofday (&Tp, &Tz); + Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ + + if (GIMME == G_ARRAY) { + EXTEND(sp, 2); + /* Mac OS (Classic) has unsigned time_t */ + PUSHs(sv_2mortal(newSVuv(Tp.tv_sec))); + PUSHs(sv_2mortal(newSViv(Tp.tv_usec))); + } else { + EXTEND(sp, 1); + PUSHs(sv_2mortal(newSVnv(Tp.tv_sec + (Tp.tv_usec / 1000000.0)))); + } + +NV +time() + PREINIT: + struct timeval Tp; + struct timezone Tz; + CODE: + int status; + status = gettimeofday (&Tp, &Tz); + Tp.tv_sec += Tz.tz_minuteswest * 60; /* adjust for TZ */ + RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.0); + OUTPUT: + RETVAL +# else /* MACOS_TRADITIONAL */ void gettimeofday() PREINIT: @@ -470,6 +729,7 @@ time() OUTPUT: RETVAL +# endif /* MACOS_TRADITIONAL */ #endif #if defined(HAS_GETITIMER) && defined(HAS_SETITIMER) @@ -485,6 +745,8 @@ setitimer(which, seconds, interval = 0) struct itimerval newit; struct itimerval oldit; PPCODE: + if (seconds < 0.0 || interval < 0.0) + croak("Time::HiRes::setitimer(%"IVdf", %"NVgf", %"NVgf"): negative time not invented yet", which, seconds, interval); newit.it_value.tv_sec = seconds; newit.it_value.tv_usec = (seconds - (NV)newit.it_value.tv_sec) * 1000000.0;