Integrate Time::Hires 1.20 from Douglas E. Wegscheid.

p4raw-id: //depot/perl@9690

4 files changed, 661 insertions, 0 deletions

diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
new file mode 100644
index 0000000000..16fc02782f
--- /dev/null
+++ b/ext/Time/HiRes/Changes
@@ -0,0 +1,99 @@
+Revision history for Perl extension Time::HiRes.
+
+1.20  Wed Feb 24 21:30 1999
+	- make our usleep and ualarm substitutes into hrt_usleep 
+	  and hrt_ualarm. This helps static links of Perl with other
+	  packages that also have usleep, etc. From
+	  Ilya Zakharevich <ilya@math.ohio-state.edu>
+	- add C API stuff. From Joshua Pritikin
+	  <joshua.pritikin@db.com>
+	- VMS Makefile.PL fun.  From pvhp@forte.com (Peter Prymmer)
+	- hopefully correct "-lc" fix for SCO.
+	- add PPD stuff
+
+1.19  Tue Sep 29 22:30 1998
+	- put VMS gettimeofday() in. Patch is from Sebastian Bazley
+	  <seb@stian.demon.co.uk>
+	- change GIMME_V to GIMME to help people with older versions of
+	  Perl.
+	- fix Win32 version of gettimeofday(). It didn't affect anything,
+	  but it confuses people reading the code when the return value
+	  is backwards (0 is success).
+	- fix Makefile.PL (more) so that detection of gettimeofday is
+	  more correct.
+
+1.18  Mon Jul 6 22:40 1998
+	- add usleep() for Win32.
+	- fix Makefile.PL to fix reported HP/UX feature where unresolved
+	  externals still cause an executable to be generated (though no
+	  x bit set). Thanks to David Kozinn for report and explanation.
+	  Problems with the fix are mine :)
+
+1.17  Wed Jul 1 20:10 1998
+	- fix setitimer calls so microseconds is not more than 1000000.
+	  Hp/UX 9 doesn't like that. Provided by Roland B Robert, PhD.
+        - make Win32. We only get gettimeofday (the select hack doesn't
+	  seem to work on my Win95 system).
+        - fix test 4 on 01test.t. add test to see if time() and 
+	  Time::HiRes::time() are close.
+
+1.16  Wed Nov 12 21:05 1997
+	- add missing EXTEND in new gettimeofday scalar code.
+
+1.15  Mon Nov 10 21:30 1997
+	- HiRes.pm: update pod. Provided by Gisle Aas.
+	- HiRes.xs: if gettimeofday() called in scalar context, do
+	  something more useful than before. Provided by Gisle Aas.
+	- README: tell of xsubpp '-nolinenumber' woes. thanks to
+	  Edward Henigin <ed@texas.net> for pointing out the problem.
+
+1.14  Wed Nov 5 9:40 1997
+	- Makefile.PL: look for setitimer
+	- HiRes.xs: if missing ualarm, but we have setitimer, make up
+	  our own setitimer. These were provided by Gisle Aas.
+
+1.13  Tue Nov 4 23:30 1997
+	- Makefile.PL: fix autodetect mechanism to do try linking in addition
+	  to just compiling; should fix Linux build problem. Fix was provided
+	  by Gisle Aas.
+
+1.12  Sun Oct 12 12:00:00 1997
+	- Makefile.PL: set XSOPT to '-nolinenumbers' to work around xsubpp bug;
+	  you may need to comment this back out if you have an older xsubpp.
+	- HiRes.xs: set PROTOTYPES: DISABLE
+
+1.11  Fri Sep 05 16:00:00 1997
+	- Makefile.PL:
+	  Had some line commented out that shouldn't have been (testing
+	  remnants)
+	- README:
+	  Previous version was corrupted.
+
+1.10  Thu May 22 20:20:00 1997
+	- HiRes.xs, HiRes.pm, t/*:
+	      -	only compile what we have OS support for (or can 
+		fake with select())
+	      - only test what we compiled 
+	      - gross improvement to the test suite
+	      - fix EXPORT_FAIL. 
+	  This work was all done by Roderick Schertler
+	  <roderick@argon.org>. If you run Linux or
+	  one of the other ualarm-less platoforms, and you like this 
+	  module, let Roderick know; without him, it still wouldn't 
+	  be working on those boxes...
+	- Makefile.PL: figure out what routines the OS has and
+	  only build what we need. These bits were written by Jarkko 
+	  Hietaniemi <jhi@iki.fi>. Again, gratitude is due...
+
+1.02  Mon Dec 30 08:00:00 1996
+	- HiRes.pm: update documentation to say what to do when missing
+	  ualarm() and friends.
+	- README: update to warn that ualarm() and friends need to exist
+
+1.01  Fri Oct 17 08:00:00 1996
+	- Makefile.PL: make XSPROTOARGS => '-noprototyopes'
+	- HiRes.pm: put blank line between __END__ and =head1 so that 
+	  pod2man works.
+
+1.00  Tue Sep 03 13:00:00 1996
+	- original version; created by h2xs 1.16
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
new file mode 100644
index 0000000000..0bc152b720
--- /dev/null
+++ b/ext/Time/HiRes/HiRes.pm
@@ -0,0 +1,255 @@
+package Time::HiRes;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL);
+
+require Exporter;
+require DynaLoader;
+
+@ISA = qw(Exporter DynaLoader);
+
+@EXPORT = qw( );
+@EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval);
+
+$VERSION = do{my@r=q$Revision: 1.20 $=~/\d+/g;sprintf '%02d.'.'%02d'x$#r,@r};
+
+bootstrap Time::HiRes $VERSION;
+
+@EXPORT_FAIL = grep { ! defined &$_ } @EXPORT_OK;
+
+# Preloaded methods go here.
+
+sub tv_interval {
+    # probably could have been done in C
+    my ($a, $b) = @_;
+    $b = [gettimeofday()] unless defined($b);
+    (${$b}[0] - ${$a}[0]) + ((${$b}[1] - ${$a}[1]) / 1_000_000);
+}
+
+# I'm only supplying this because the version of it in 5.003's Export.pm
+# is buggy (it doesn't shift off the class name).
+
+sub export_fail {
+    my $self = shift;
+    @_;
+}
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+
+=head1 NAME
+
+Time::HiRes - High resolution ualarm, usleep, and gettimeofday
+
+=head1 SYNOPSIS
+
+  use Time::HiRes qw( usleep ualarm gettimeofday tv_interval );
+
+  usleep ($microseconds);
+
+  ualarm ($microseconds);
+  ualarm ($microseconds, $interval_microseconds);
+
+  $t0 = [gettimeofday];
+  ($seconds, $microseconds) = gettimeofday;
+
+  $elapsed = tv_interval ( $t0, [$seconds, $microseconds]);
+  $elapsed = tv_interval ( $t0, [gettimeofday]);
+  $elapsed = tv_interval ( $t0 );
+
+  use Time::HiRes qw ( time alarm sleep );
+  $now_fractions = time;
+  sleep ($floating_seconds);
+  alarm ($floating_seconds);
+  alarm ($floating_seconds, $floating_interval);
+
+=head1 DESCRIPTION
+
+The C<Time::HiRes> module implements a Perl interface to the usleep, ualarm,
+and gettimeofday system calls. See the EXAMPLES section below and the test
+scripts for usage; see your system documentation for the description of
+the underlying gettimeofday, usleep, and ualarm calls.
+
+If your system lacks gettimeofday(2) you don't get gettimeofday() or the
+one-arg form of tv_interval().  If you don't have usleep(3) or select(2)
+you don't get usleep() or sleep().  If your system don't have ualarm(3)
+or setitimer(2) you don't
+get ualarm() or alarm().  If you try to import an unimplemented function
+in the C<use> statement it will fail at compile time.
+
+The following functions can be imported from this module.  No
+functions are exported by default.
+
+=over 4
+
+=item gettimeofday ()
+
+In array context it returns a 2 element array with the seconds and
+microseconds since the epoch.  In scalar context it returns floating
+seconds like Time::HiRes::time() (see below).
+
+=item usleep ( $useconds )
+
+Issues a usleep for the number of microseconds specified. See also 
+Time::HiRes::sleep() below.
+
+=item ualarm ( $useconds [, $interval_useconds ] )
+
+Issues a ualarm call; interval_useconds is optional and will be 0 if 
+unspecified, resulting in alarm-like behaviour.
+
+=item tv_interval ( $ref_to_gettimeofday [, $ref_to_later_gettimeofday] )
+
+Returns the floating seconds between the two times, which should have been 
+returned by gettimeofday(). If the second argument is omitted, then the
+current time is used.
+
+=item time ()
+
+Returns a floating seconds since the epoch. This function can be imported,
+resulting in a nice drop-in replacement for the C<time> provided with perl,
+see the EXAMPLES below.
+
+=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.
+
+=item alarm ( $floating_seconds [, $interval_floating_seconds ] )
+
+Converts $floating_seconds and $interval_floating_seconds and issues
+a ualarm for the results.  The $interval_floating_seconds argument
+is optional and will be 0 if unspecified, resulting in alarm-like
+behaviour.  This function can be imported, resulting in a nice drop-in
+replacement for the C<alarm> provided with perl, see the EXAMPLES below.
+
+=back
+
+=head1 EXAMPLES
+
+  use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
+
+  $microseconds = 750_000;
+  usleep $microseconds;
+
+  # signal alarm in 2.5s & every .1s thereafter
+  ualarm 2_500_000, 100_000;	
+
+  # get seconds and microseconds since the epoch
+  ($s, $usec) = gettimeofday;
+
+  # measure elapsed time 
+  # (could also do by subtracting 2 gettimeofday return values)
+  $t0 = [gettimeofday];
+  # do bunch of stuff here
+  $t1 = [gettimeofday];
+  # do more stuff here
+  $t0_t1 = tv_interval $t0, $t1;
+  
+  $elapsed = tv_interval ($t0, [gettimeofday]);
+  $elapsed = tv_interval ($t0);	# equivalent code
+
+  #
+  # replacements for time, alarm and sleep that know about
+  # floating seconds
+  #
+  use Time::HiRes;
+  $now_fractions = Time::HiRes::time;
+  Time::HiRes::sleep (2.5);
+  Time::HiRes::alarm (10.6666666);
+ 
+  use Time::HiRes qw ( time alarm sleep );
+  $now_fractions = time;
+  sleep (2.5);
+  alarm (10.6666666);
+
+=head1 C API
+
+In addition to the perl API described above, a C API is available for
+extension writers.  The following C functions are available in the
+modglobal hash:
+
+  name             C prototype
+  ---------------  ----------------------
+  Time::NVtime     double (*)()
+  Time::U2time     void (*)(UV ret[2])
+
+Both functions return equivalent information (like C<gettimeofday>)
+but with different representations.  The names C<NVtime> and C<U2time>
+were selected mainly because they are operating system independent.
+(C<gettimeofday> is Un*x-centric.)
+
+Here is an example of using NVtime from C:
+
+  double (*myNVtime)();
+  SV **svp = hv_fetch(PL_modglobal, "Time::NVtime", 12, 0);
+  if (!svp)         croak("Time::HiRes is required");
+  if (!SvIOK(*svp)) croak("Time::NVtime isn't a function pointer");
+  myNVtime = (double(*)()) SvIV(*svp);
+  printf("The current time is: %f\n", (*myNVtime)());
+
+=head1 AUTHORS
+
+D. Wegscheid <wegscd@whirlpool.com>
+R. Schertler <roderick@argon.org>
+J. Hietaniemi <jhi@iki.fi>
+G. Aas <gisle@aas.no>
+
+=head1 REVISION
+
+$Id: HiRes.pm,v 1.20 1999/03/16 02:26:13 wegscd Exp $
+
+$Log: HiRes.pm,v $
+Revision 1.20  1999/03/16 02:26:13  wegscd
+Add documentation for NVTime and U2Time.
+
+Revision 1.19  1998/09/30 02:34:42  wegscd
+No changes, bump version.
+
+Revision 1.18  1998/07/07 02:41:35  wegscd
+No changes, bump version.
+
+Revision 1.17  1998/07/02 01:45:13  wegscd
+Bump version to 1.17
+
+Revision 1.16  1997/11/13 02:06:36  wegscd
+version bump to accomodate HiRes.xs fix.
+
+Revision 1.15  1997/11/11 02:17:59  wegscd
+POD editing, courtesy of Gisle Aas.
+
+Revision 1.14  1997/11/06 03:14:35  wegscd
+Update version # for Makefile.PL and HiRes.xs changes.
+
+Revision 1.13  1997/11/05 05:36:25  wegscd
+change version # for Makefile.pl and HiRes.xs changes.
+
+Revision 1.12  1997/10/13 20:55:33  wegscd
+Force a new version for Makefile.PL changes.
+
+Revision 1.11  1997/09/05 19:59:33  wegscd
+New version to bump version for README and Makefile.PL fixes.
+Fix bad RCS log.
+
+Revision 1.10  1997/05/23 01:11:38  wegscd
+Conditional compilation; EXPORT_FAIL fixes.
+
+Revision 1.2  1996/12/30 13:28:40  wegscd
+Update documentation for what to do when missing ualarm() and friends.
+
+Revision 1.1  1996/10/17 20:53:31  wegscd
+Fix =head1 being next to __END__ so pod2man works
+
+Revision 1.0  1996/09/03 18:25:15  wegscd
+Initial revision
+
+=head1 COPYRIGHT
+
+Copyright (c) 1996-1997 Douglas E. Wegscheid.
+All rights reserved. This program is free software; you can
+redistribute it and/or modify it under the same terms as Perl itself.
+
+=cut
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
new file mode 100644
index 0000000000..7232b1cfb2
--- /dev/null
+++ b/ext/Time/HiRes/HiRes.xs
@@ -0,0 +1,295 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef WIN32
+#include <time.h>
+#else
+#include <sys/time.h>
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+#if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
+#define HAS_GETTIMEOFDAY
+
+/* shows up in winsock.h?
+struct timeval {
+ long tv_sec;
+ long tv_usec;
+}
+*/
+
+int
+gettimeofday (struct timeval *tp, int nothing)
+{
+ 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;
+}
+#endif
+
+#if !defined(HAS_GETTIMEOFDAY) && defined(VMS)
+#define HAS_GETTIMEOFDAY
+
+#include <time.h> /* gettimeofday */
+#include <stdlib.h> /* qdiv */
+#include <starlet.h> /* sys$gettim */
+#include <descrip.h>
+
+/*
+        VMS binary time is expressed in 100 nano-seconds since
+        system base time which is 17-NOV-1858 00:00:00.00
+*/
+
+#define DIV_100NS_TO_SECS  10000000L
+#define DIV_100NS_TO_USECS 10L
+
+/* 
+        gettimeofday is supposed to return times since the epoch
+        so need to determine this in terms of VMS base time
+*/
+static $DESCRIPTOR(dscepoch,"01-JAN-1970 00:00:00.00");
+
+static __int64 base_adjust=0;
+
+int
+gettimeofday (struct timeval *tp, void *tpz)
+{
+ long ret;
+ __int64 quad;
+ __qdiv_t ans1,ans2;
+
+/*
+        In case of error, tv_usec = 0 and tv_sec = VMS condition code.
+        The return from function is also set to -1.
+        This is not exactly as per the manual page.
+*/
+
+ tp->tv_usec = 0;
+
+ if (base_adjust==0) { /* Need to determine epoch adjustment */
+        ret=sys$bintim(&dscepoch,&base_adjust);
+        if (1 != (ret &&1)) {
+                tp->tv_sec = ret;
+                return -1;
+        }
+ }
+
+ ret=sys$gettim(&quad); /* Get VMS system time */
+ if ((1 && ret) == 1) {
+        quad -= base_adjust; /* convert to epoch offset */
+        ans1=qdiv(quad,DIV_100NS_TO_SECS);
+        ans2=qdiv(ans1.rem,DIV_100NS_TO_USECS);
+        tp->tv_sec = ans1.quot; /* Whole seconds */
+        tp->tv_usec = ans2.quot; /* Micro-seconds */
+ } else {
+        tp->tv_sec = ret;
+        return -1;
+ }
+ return 0;
+}
+#endif
+
+#if !defined(HAS_USLEEP) && defined(HAS_SELECT)
+#ifndef SELECT_IS_BROKEN
+#define HAS_USLEEP
+#define usleep hrt_usleep  /* could conflict with ncurses for static build */
+
+void
+hrt_usleep(unsigned long usec)
+{
+    struct timeval tv;
+    tv.tv_sec = 0;
+    tv.tv_usec = usec;
+    select(0, (Select_fd_set_t)NULL, (Select_fd_set_t)NULL,
+		(Select_fd_set_t)NULL, &tv);
+}
+#endif
+#endif
+
+#if !defined(HAS_USLEEP) && defined(WIN32)
+#define HAS_USLEEP
+#define usleep hrt_usleep  /* could conflict with ncurses for static build */
+
+void
+hrt_usleep(unsigned long usec)
+{
+    long msec;
+    msec = usec / 1000;
+    Sleep (msec);
+}
+#endif
+
+
+#if !defined(HAS_UALARM) && defined(HAS_SETITIMER)
+#define HAS_UALARM
+#define ualarm hrt_ualarm  /* could conflict with ncurses for static build */
+
+int
+hrt_ualarm(int usec, int interval)
+{
+   struct itimerval itv;
+   itv.it_value.tv_sec = usec / 1000000;
+   itv.it_value.tv_usec = usec % 1000000;
+   itv.it_interval.tv_sec = interval / 1000000;
+   itv.it_interval.tv_usec = interval % 1000000;
+   return setitimer(ITIMER_REAL, &itv, 0);
+}
+#endif
+
+#ifdef HAS_GETTIMEOFDAY
+
+static void
+myU2time(UV *ret)
+{
+  struct timeval Tp;
+  int status;
+  status = gettimeofday (&Tp, NULL);
+  ret[0] = Tp.tv_sec;
+  ret[1] = Tp.tv_usec;
+}
+
+static double
+myNVtime()
+{
+  struct timeval Tp;
+  int status;
+  status = gettimeofday (&Tp, NULL);
+  return Tp.tv_sec + (Tp.tv_usec / 1000000.);
+}
+
+#endif
+
+MODULE = Time::HiRes            PACKAGE = Time::HiRes
+
+PROTOTYPES: ENABLE
+
+BOOT:
+#ifdef ATLEASTFIVEOHOHFIVE
+#ifdef HAS_GETTIMEOFDAY
+  hv_store(PL_modglobal, "Time::NVtime", 12, newSViv((IV) myNVtime), 0);
+  hv_store(PL_modglobal, "Time::U2time", 12, newSViv((IV) myU2time), 0);
+#endif
+#endif
+
+#ifdef HAS_USLEEP
+
+void
+usleep(useconds)
+        int useconds 
+
+void
+sleep(fseconds)
+        double fseconds 
+	CODE:
+	int useconds = fseconds * 1000000;
+	usleep (useconds);
+
+#endif
+
+#ifdef HAS_UALARM
+
+int
+ualarm(useconds,interval=0)
+	int useconds
+	int interval
+
+int
+alarm(fseconds,finterval=0)
+	double fseconds
+	double finterval
+	PREINIT:
+	int useconds, uinterval;
+	CODE:
+	useconds = fseconds * 1000000;
+	uinterval = finterval * 1000000;
+	RETVAL = ualarm (useconds, uinterval);
+
+#endif
+
+#ifdef HAS_GETTIMEOFDAY
+
+void
+gettimeofday()
+        PREINIT:
+        struct timeval Tp;
+        PPCODE:
+	int status;
+        status = gettimeofday (&Tp, NULL);
+        if (GIMME == G_ARRAY) {
+	     EXTEND(sp, 2);
+             PUSHs(sv_2mortal(newSViv(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))));
+        }
+
+double
+time()
+        PREINIT:
+        struct timeval Tp;
+        CODE:
+	int status;
+        status = gettimeofday (&Tp, NULL);
+        RETVAL = Tp.tv_sec + (Tp.tv_usec / 1000000.);
+	OUTPUT:
+	RETVAL
+
+#endif
+
+# $Id: HiRes.xs,v 1.11 1999/03/16 02:27:38 wegscd Exp wegscd $
+
+# $Log: HiRes.xs,v $
+# Revision 1.11  1999/03/16 02:27:38  wegscd
+# Add U2time, NVtime. Fix symbols for static link.
+#
+# Revision 1.10  1998/09/30 02:36:25  wegscd
+# Add VMS changes.
+#
+# Revision 1.9  1998/07/07 02:42:06  wegscd
+# Win32 usleep()
+#
+# Revision 1.8  1998/07/02 01:47:26  wegscd
+# Add Win32 code for gettimeofday.
+#
+# Revision 1.7  1997/11/13 02:08:12  wegscd
+# Add missing EXTEND in gettimeofday() scalar code.
+#
+# Revision 1.6  1997/11/11 02:32:35  wegscd
+# Do something useful when calling gettimeofday() in a scalar context.
+# The patch is courtesy of Gisle Aas.
+#
+# Revision 1.5  1997/11/06 03:10:47  wegscd
+# Fake ualarm() if we have setitimer.
+#
+# Revision 1.4  1997/11/05 05:41:23  wegscd
+# Turn prototypes ON (suggested by Gisle Aas)
+#
+# Revision 1.3  1997/10/13 20:56:15  wegscd
+# Add PROTOTYPES: DISABLE
+#
+# Revision 1.2  1997/05/23 01:01:38  wegscd
+# Conditional compilation, depending on what the OS gives us.
+#
+# Revision 1.1  1996/09/03 18:26:35  wegscd
+# Initial revision
+#
+#
diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL
new file mode 100644
index 0000000000..6560420d73
--- /dev/null
+++ b/ext/Time/HiRes/Makefile.PL
@@ -0,0 +1,12 @@
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+#
+
+use strict;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    'NAME'	   => 'Time::HiRes',
+    'VERSION_FROM' => 'HiRes.pm',
+);
+