Change 12574 by pudge@pudge-mobile on 2001/10/22 18:53:28
Sync Time::HiRes with bleadperl
Affected files ...
... //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.pm#2 edit
... //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.t#2 edit
... //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.xs#3 edit
Differences ...
==== //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.pm#2 (text) ====
Index: perl/macos/bundled_ext/Time/HiRes/HiRes.pm
--- perl/macos/bundled_ext/Time/HiRes/HiRes.pm.~1~ Mon Oct 22 13:00:07 2001
+++ perl/macos/bundled_ext/Time/HiRes/HiRes.pm Mon Oct 22 13:00:07 2001
@@ -105,8 +105,9 @@
=item usleep ( $useconds )
-Issues a usleep for the number of microseconds specified. See also
-Time::HiRes::sleep() below.
+Issues a usleep for the number of microseconds specified. Returns the
+number of microseconds actually slept. See also Time::HiRes::sleep()
+below.
=item ualarm ( $useconds [, $interval_useconds ] )
@@ -127,11 +128,27 @@
resulting in a nice drop-in replacement for the C<time> provided with perl,
see the EXAMPLES below.
+B<NOTE>: Since Sunday, September 9th, 2001 at 01:46:40 AM GMT
+(when the time() seconds since epoch rolled over to 1_000_000_000),
+the default floating point format of Perl and the seconds since epoch
+have conspired to produce an apparent bug: if you print the value of
+Time::HiRes::time() you seem to be getting only five decimals, not six
+as promised (microseconds). Not to worry, the microseconds are there
+(assuming your platform supports such granularity). What is going on
+is that the default floating point format of Perl only outputs 15
+digits. In this case that means ten digits before the decimal
+separator and five after. To see the microseconds you can use either
+printf/sprintf with C<%.6f>, or the gettimeofday() function in list
+context, which will give you the seconds and microseconds as two
+separate values.
+
=item sleep ( $floating_seconds )
-Converts $floating_seconds to microseconds and issues a usleep for the
-result. This function can be imported, resulting in a nice drop-in
-replacement for the C<sleep> provided with perl, see the EXAMPLES below.
+Converts $floating_seconds to microseconds and issues a usleep for the
+result. Returns the number of seconds actually slept (a floating
+point value). This function can be imported, resulting in a nice
+drop-in replacement for the C<sleep> provided with perl, see the
+EXAMPLES below.
=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
==== //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.t#2 (text) ====
Index: perl/macos/bundled_ext/Time/HiRes/HiRes.t
--- perl/macos/bundled_ext/Time/HiRes/HiRes.t.~1~ Mon Oct 22 13:00:07 2001
+++ perl/macos/bundled_ext/Time/HiRes/HiRes.t Mon Oct 22 13:00:07 2001
@@ -3,7 +3,7 @@
@INC = '../lib';
}
-BEGIN { $| = 1; print "1..19\n"; }
+BEGIN { $| = 1; print "1..21\n"; }
END {print "not ok 1\n" unless $loaded;}
@@ -86,7 +86,7 @@
# Two-arg tv_interval() is always available.
{
my $f = tv_interval [5, 100_000], [10, 500_000];
- ok 9, $f == 5.4, $f;
+ ok 9, abs($f - 5.4) < 0.001, $f;
}
if (!$have_gettimeofday) {
@@ -133,10 +133,16 @@
if (!$have_time) {
skip 14
} else {
- my $t = time();
- my $tf = Time::HiRes::time();
- ok 14, (abs($tf - $t) <= 1),
- "time $t differs from Time::HiRes::time $tf";
+ my ($t1, $tf, $t2);
+ for my $i (1 .. 9) {
+ $t1 = time();
+ $tf = Time::HiRes::time();
+ $t2 = 1 + time();
+ last if (($t2 - $t1) <= 1);
+ }
+ ok 14, (($t1 <= $tf) && ($tf <= $t2)),
+ "Time::HiRes::time $tf not bracketed by $t1 - $t2";
+
}
unless (defined &Time::HiRes::gettimeofday
@@ -217,3 +223,9 @@
$SIG{VTALRM} = 'DEFAULT';
}
+$a = abs(sleep(1.5) - 1.5);
+print $a < 0.1 ? "ok 20 # $a\n" : "not ok 20 # $a\n";
+
+$a = abs(usleep(1_500_000) / 1_500_000 - 1.0);
+print $a < 0.1 ? "ok 21 # $a\n" : "not ok 21 # $a\n";
+
==== //depot/maint-5.6/macperl/macos/bundled_ext/Time/HiRes/HiRes.xs#3 (text) ====
Index: perl/macos/bundled_ext/Time/HiRes/HiRes.xs
--- perl/macos/bundled_ext/Time/HiRes/HiRes.xs.~1~ Mon Oct 22 13:00:07 2001
+++ perl/macos/bundled_ext/Time/HiRes/HiRes.xs Mon Oct 22 13:00:07 2001
@@ -63,31 +63,38 @@
}
*/
+typedef union {
+ unsigned __int64 ft_i64;
+ FILETIME ft_val;
+} FT_t;
+
+/* Number of 100 nanosecond units from 1/1/1601 to 1/1/1970 */
+#define EPOCH_BIAS 116444736000000000i64
+
+/* NOTE: This does not compute the timezone info (doing so can be expensive,
+ * and appears to be unsupported even by glibc) */
int
-gettimeofday (struct timeval *tp, int nothing)
+gettimeofday (struct timeval *tp, void *not_used)
{
- SYSTEMTIME st;
- time_t tt;
- struct tm tmtm;
- /* mktime converts local to UTC */
- GetLocalTime (&st);
- tmtm.tm_sec = st.wSecond;
- tmtm.tm_min = st.wMinute;
- tmtm.tm_hour = st.wHour;
- tmtm.tm_mday = st.wDay;
- tmtm.tm_mon = st.wMonth - 1;
- tmtm.tm_year = st.wYear - 1900;
- tmtm.tm_isdst = -1;
- tt = mktime (&tmtm);
- tp->tv_sec = tt;
- tp->tv_usec = st.wMilliseconds * 1000;
- return 0;
+ FT_t ft;
+
+ /* this returns time in 100-nanosecond units (i.e. tens of usecs) */
+ GetSystemTimeAsFileTime(&ft.ft_val);
+
+ /* seconds since epoch */
+ tp->tv_sec = (long)((ft.ft_i64 - EPOCH_BIAS) / 10000000i64);
+
+ /* microseconds remaining */
+ tp->tv_usec = (long)((ft.ft_i64 / 10i64) % 1000000i64);
+
+ return 0;
}
#endif
#if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
#define HAS_GETTIMEOFDAY
+#include <lnmdef.h>
#include <time.h> /* gettimeofday */
#include <stdlib.h> /* qdiv */
#include <starlet.h> /* sys$gettim */
@@ -116,6 +123,90 @@
static __int64 base_adjust=0;
#endif
+/*
+
+ If we don't have gettimeofday, then likely we are on a VMS machine that
+ operates on local time rather than UTC...so we have to zone-adjust.
+ This code gleefully swiped from VMS.C
+
+*/
+/* method used to handle UTC conversions:
+ * 1 == CRTL gmtime(); 2 == SYS$TIMEZONE_DIFFERENTIAL; 3 == no correction
+ */
+static int gmtime_emulation_type;
+/* number of secs to add to UTC POSIX-style time to get local time */
+static long int utc_offset_secs;
+static struct dsc$descriptor_s fildevdsc =
+ { 12, DSC$K_DTYPE_T, DSC$K_CLASS_S, "LNM$FILE_DEV" };
+static struct dsc$descriptor_s *fildev[] = { &fildevdsc, NULL };
+
+static time_t toutc_dst(time_t loc) {
+ struct tm *rsltmp;
+
+ if ((rsltmp = localtime(&loc)) == NULL) return -1;
+ loc -= utc_offset_secs;
+ if (rsltmp->tm_isdst) loc -= 3600;
+ return loc;
+}
+
+static time_t toloc_dst(time_t utc) {
+ struct tm *rsltmp;
+
+ utc += utc_offset_secs;
+ if ((rsltmp = localtime(&utc)) == NULL) return -1;
+ if (rsltmp->tm_isdst) utc += 3600;
+ return utc;
+}
+
+#define _toutc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
+ ((gmtime_emulation_type || timezone_setup()), \
+ (gmtime_emulation_type == 1 ? toutc_dst(secs) : \
+ ((secs) - utc_offset_secs))))
+
+#define _toloc(secs) ((secs) == (time_t) -1 ? (time_t) -1 : \
+ ((gmtime_emulation_type || timezone_setup()), \
+ (gmtime_emulation_type == 1 ? toloc_dst(secs) : \
+ ((secs) + utc_offset_secs))))
+
+static int
+timezone_setup(void)
+{
+ struct tm *tm_p;
+
+ if (gmtime_emulation_type == 0) {
+ int dstnow;
+ time_t base = 15 * 86400; /* 15jan71; to avoid month/year ends between */
+ /* results of calls to gmtime() and localtime() */
+ /* for same &base */
+
+ gmtime_emulation_type++;
+ if ((tm_p = gmtime(&base)) == NULL) { /* CRTL gmtime() is a fake */
+ char off[LNM$C_NAMLENGTH+1];;
+
+ gmtime_emulation_type++;
+ if (!Perl_vmstrnenv("SYS$TIMEZONE_DIFFERENTIAL",off,0,fildev,0)) {
+ gmtime_emulation_type++;
+ utc_offset_secs = 0;
+ Perl_warn(aTHX_ "no UTC offset information; assuming local time is UTC");
+ }
+ else { utc_offset_secs = atol(off); }
+ }
+ else { /* We've got a working gmtime() */
+ struct tm gmt, local;
+
+ gmt = *tm_p;
+ tm_p = localtime(&base);
+ local = *tm_p;
+ utc_offset_secs = (local.tm_mday - gmt.tm_mday) * 86400;
+ utc_offset_secs += (local.tm_hour - gmt.tm_hour) * 3600;
+ utc_offset_secs += (local.tm_min - gmt.tm_min) * 60;
+ utc_offset_secs += (local.tm_sec - gmt.tm_sec);
+ }
+ }
+ return 1;
+}
+
+
int
gettimeofday (struct timeval *tp, void *tpz)
{
@@ -175,6 +266,13 @@
tp->tv_sec = ret;
return -1;
}
+# ifdef VMSISH_TIME
+# ifdef RTL_USES_UTC
+ if (VMSISH_TIME) tp->tv_sec = _toloc(tp->tv_sec);
+# else
+ if (!VMSISH_TIME) tp->tv_sec = _toutc(tp->tv_sec);
+# endif
+# endif
return 0;
}
#endif
@@ -269,18 +367,54 @@
char * name
int arg
-#ifdef HAS_USLEEP
+#if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
-void
+NV
usleep(useconds)
- int useconds
+ NV useconds
+ PREINIT:
+ struct timeval Ta, Tb;
+ CODE:
+ gettimeofday(&Ta, NULL);
+ if (items > 0) {
+ if (useconds > 1E6) {
+ IV seconds = (IV) (useconds / 1E6);
+ sleep(seconds);
+ useconds -= 1E6 * seconds;
+ }
+ usleep((UV)useconds);
+ } else
+ PerlProc_pause();
+ gettimeofday(&Tb, NULL);
+#if 0
+ printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
+#endif
+ RETVAL = 1E6*(Tb.tv_sec-Ta.tv_sec)+(NV)((IV)Tb.tv_usec-(IV)Ta.tv_usec);
+
+ OUTPUT:
+ RETVAL
-void
-sleep(fseconds)
- NV fseconds
+NV
+sleep(...)
+ PREINIT:
+ struct timeval Ta, Tb;
CODE:
- int useconds = fseconds * 1000000;
- usleep (useconds);
+ gettimeofday(&Ta, NULL);
+ if (items > 0) {
+ NV seconds = SvNV(ST(0));
+ IV useconds = 1E6 * (seconds - (IV)seconds);
+ sleep(seconds);
+ usleep(useconds);
+ } else
+ PerlProc_pause();
+ gettimeofday(&Tb, NULL);
+#if 0
+ printf("[%ld %ld] [%ld %ld]\n", Tb.tv_sec, Tb.tv_usec, Ta.tv_sec, Ta.tv_usec);
+#endif
+ RETVAL = (NV)(Tb.tv_sec-Ta.tv_sec)+0.000001*(NV)(Tb.tv_usec-Ta.tv_usec);
+
+ OUTPUT:
+ RETVAL
#endif
End of Patch.
