Upgrade to Time::HiRes 1.42.

p4raw-id: //depot/perl@18484

7 files changed, 430 insertions, 133 deletions

diff --git a/MANIFEST b/MANIFEST
index 44a53a7680..e8c8e66735 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -710,6 +710,8 @@ ext/threads/threads.pm		ithreads
 ext/threads/threads.xs		ithreads
 ext/threads/typemap		ithreads
 ext/Time/HiRes/Changes		Time::HiRes extension
+ext/Time/HiRes/fallback/const-c.inc	Time::HiRes extension
+ext/Time/HiRes/fallback/const-xs.inc	Time::HiRes extension
 ext/Time/HiRes/hints/dynixptx.pl	Hint for Time::HiRes for named architecture
 ext/Time/HiRes/hints/sco.pl	Hints for Time::HiRes for named architecture
 ext/Time/HiRes/HiRes.pm		Time::HiRes extension
diff --git a/ext/Time/HiRes/Changes b/ext/Time/HiRes/Changes
index 2340fb558a..971e7012e3 100644
--- a/ext/Time/HiRes/Changes
+++ b/ext/Time/HiRes/Changes
@@ -1,5 +1,26 @@
 Revision history for Perl extension Time::HiRes.
 
+1.42
+	- modernize the constants code (from Nicholas Clark)
+
+1.41
+	- At some point the ability to figure our the correct incdir
+	  for EXTERN.h (either a core perl build, or an installed perl)
+	  had broken (which lead into all test compiles failing with
+	  a core perl build, but thanks to the robustness of Makefile.PL
+	  nothing of was visible).  The brokenness seemed to be caused
+	  by $ENV{PERL_CORE} not being on for core builds?  Now stole
+	  a trick from the Encode that sets $ENV{PERL_CORE} right, and
+	  both styles of build should work again.
+
+1.40
+	- Nicholas Clark noticed that the my_catdir() emulation function
+	  was broken (which means that we didn't really work for Perls
+	  5.002 and 5.003)
+	- inspired by fixing the above made the whole Makefile.PL -w
+	  and strict clean
+	- tightened up the Makefile.PL output, less whitespace
+
 1.39
 	- fix from Craig Berry for better building in VMS with PERL_CORE
 
diff --git a/ext/Time/HiRes/HiRes.pm b/ext/Time/HiRes/HiRes.pm
index 532484e414..ffa010b2a5 100644
--- a/ext/Time/HiRes/HiRes.pm
+++ b/ext/Time/HiRes/HiRes.pm
@@ -15,18 +15,16 @@ require DynaLoader;
 		 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
 		 d_nanosleep);
 	
-$VERSION = '1.39';
+$VERSION = '1.42';
 $XS_VERSION = $VERSION;
 $VERSION = eval $VERSION;
 
 sub AUTOLOAD {
     my $constname;
-    ($constname= $AUTOLOAD) =~ s/.*:://;
-    my $val = constant($constname, @_ ? $_[0] : 0);
-    if ($!) {
-	my ($pack,$file,$line) = caller;
-	die "Your vendor has not defined Time::HiRes macro $constname, used at $file line $line.\n";
-    }
+    ($constname = $AUTOLOAD) =~ s/.*:://;
+    die "&Time::HiRes::constant not defined" if $constname eq 'constant';
+    my ($error, $val) = constant($constname);
+    if ($error) { die $error; }
     {
 	no strict 'refs';
 	*$AUTOLOAD = sub { $val };
diff --git a/ext/Time/HiRes/HiRes.xs b/ext/Time/HiRes/HiRes.xs
index 5da54c6d19..560cb3db48 100644
--- a/ext/Time/HiRes/HiRes.xs
+++ b/ext/Time/HiRes/HiRes.xs
@@ -98,77 +98,14 @@ sv_2pv_nolen(pTHX_ register SV *sv)
 #   undef ITIMER_REALPROF
 #endif
 
-static IV
-constant(char *name, int arg)
-{
-    errno = 0;
-    switch (*name) {
-    case 'd':
-      if (strEQ(name, "d_getitimer"))
-#ifdef HAS_GETITIMER
-	return 1;
-#else
-	return 0;
-#endif
-      if (strEQ(name, "d_nanosleep"))
-#ifdef HAS_NANOSLEEP
-	return 1;
-#else
-	return 0;
-#endif
-      if (strEQ(name, "d_setitimer"))
-#ifdef HAS_SETITIMER
-	return 1;
-#else
-	return 0;
-#endif
-      if (strEQ(name, "d_ualarm"))
-#ifdef HAS_UALARM
-	return 1;
-#else
-	return 0;
-#endif
-      if (strEQ(name, "d_usleep"))
-#ifdef HAS_USLEEP
-	return 1;
-#else
-	return 0;
+/* 5.004 doesn't define PL_sv_undef */
+#ifndef ATLEASTFIVEOHOHFIVE
+#ifndef PL_sv_undef
+#define PL_sv_undef sv_undef
 #endif
-      break;
-    case 'I':
-      if (strEQ(name, "ITIMER_REAL"))
-#ifdef ITIMER_REAL
-	return ITIMER_REAL;
-#else
-	goto not_there;
-#endif
-      if (strEQ(name, "ITIMER_REALPROF"))
-#ifdef ITIMER_REALPROF
-	return ITIMER_REALPROF;
-#else
-	goto not_there;
 #endif
-      if (strEQ(name, "ITIMER_VIRTUAL"))
-#ifdef ITIMER_VIRTUAL
-	return ITIMER_VIRTUAL;
-#else
-	goto not_there;
-#endif
-      if (strEQ(name, "ITIMER_PROF"))
-#ifdef ITIMER_PROF
-	return ITIMER_PROF;
-#else
-	goto not_there;
-#endif
-      break;
-    }
-    errno = EINVAL;
-    return 0;
 
-not_there:
-    errno = ENOENT;
-    return 0;
-}
+#include "const-c.inc"
 
 #if !defined(HAS_GETTIMEOFDAY) && defined(WIN32)
 #define HAS_GETTIMEOFDAY
@@ -699,10 +636,7 @@ BOOT:
 #endif
 #endif
 
-IV
-constant(name, arg)
-	char *		name
-	int		arg
+INCLUDE: const-xs.inc
 
 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 
diff --git a/ext/Time/HiRes/Makefile.PL b/ext/Time/HiRes/Makefile.PL
index 586823984f..50b98bafe9 100644
--- a/ext/Time/HiRes/Makefile.PL
+++ b/ext/Time/HiRes/Makefile.PL
@@ -7,10 +7,18 @@ require 5.002;
 
 use Config;
 use ExtUtils::MakeMaker;
-
-# Perls 5.002 and 5.003 did not have File::Spec, fake what we need.
+use strict;
 
 my $VERBOSE = $ENV{VERBOSE};
+my $DEFINE;
+my $LIBS;
+my $XSOPT;
+
+unless($ENV{PERL_CORE}) { # This trick from Encode/Makefile.PL.
+    $ENV{PERL_CORE} = 1 if ($^X =~ m{\bminiperl[^/\\\]>:]*$}o);
+}
+
+# Perls 5.002 and 5.003 did not have File::Spec, fake what we need.
 
 sub my_dirsep {
     $^O eq 'VMS' ? '.' :
@@ -22,7 +30,14 @@ sub my_dirsep {
 sub my_catdir {
     shift;
     my $catdir = join(my_dirsep, @_);
-    $^O eq 'VMS' ? "[$dirsep]" : $dirsep;
+    $^O eq 'VMS' ? "[$catdir]" : $catdir;
+}
+
+sub my_catfile {
+    shift;
+    return join(my_dirsep, @_) unless $^O eq 'VMS';
+    my $file = pop;
+    return my_catdir (undef, @_) . $file;
 }
 
 sub my_updir {
@@ -35,9 +50,15 @@ BEGIN {
     if ($@) {
 	*File::Spec::catdir = \&my_catdir;
 	*File::Spec::updir  = \&my_updir;
+	*File::Spec::catfile = \&my_catfile;
     }
 }
 
+# Avoid 'used only once' warnings.
+my $nop1 = *File::Spec::catdir;
+my $nop2 = *File::Spec::updir;
+my $nop3 = *File::Spec::catfile;
+
 # if you have 5.004_03 (and some slightly older versions?), xsubpp
 # tries to generate line numbers in the C code generated from the .xs.
 # unfortunately, it is a little buggy around #ifdef'd code.
@@ -50,8 +71,7 @@ sub TMPDIR {
     my $TMPDIR =
 	(grep(defined $_ && -d $_ && -w _,
 	      ((defined $ENV{'TMPDIR'} ? $ENV{'TMPDIR'} : undef),
-	       qw(/var/tmp /usr/tmp /tmp))))[0]
-		   unless defined $TMPDIR;
+	       qw(/var/tmp /usr/tmp /tmp))))[0];
     $TMPDIR || die "Cannot find writable temporary directory.\n";
 }
 
@@ -59,7 +79,7 @@ sub try_compile_and_link {
     my ($c, %args) = @_;
 
     my ($ok) = 0;
-    my ($tmp) = (($^O eq 'VMS') ? "sys\$scratch:tmp$$" : TMPDIR . '/' . "tmp$$");
+    my ($tmp) = (($^O eq 'VMS') ? "sys\$scratch:tmp$$" : TMPDIR() . '/' . "tmp$$");
     local(*TMPC);
 
     my $obj_ext = $Config{obj_ext} || ".o";
@@ -69,18 +89,21 @@ sub try_compile_and_link {
 	print TMPC $c;
 	close(TMPC);
 
-	$cccmd = $args{cccmd};
+	my $cccmd = $args{cccmd};
 
 	my $errornull;
 
 	my $COREincdir;
+
 	if ($ENV{PERL_CORE}) {
 	    my $updir = File::Spec->updir;
 	    $COREincdir = File::Spec->catdir(($updir) x 3);
 	} else {
 	    $COREincdir = File::Spec->catdir($Config{'archlibexp'}, 'CORE');
 	}
+
 	my $ccflags = $Config{'ccflags'} . ' ' . "-I$COREincdir";
+
 	if ($^O eq 'VMS') {
 	    if ($ENV{PERL_CORE}) {
 		# Fragile if the extensions change hierachy within
@@ -89,7 +112,7 @@ sub try_compile_and_link {
 	    } else {
 		my $perl_core = $Config{'installarchlib'};
 		$perl_core =~ s/\]$/.CORE]/;
-                $cccmd = "$Config{'cc'} /include=(perl_root:[000000],$perl_core) $tmp.c"; 
+                $cccmd = "$Config{'cc'} /include=(perl_root:[000000],$perl_core) $tmp.c";
 	    }
         }
 
@@ -99,18 +122,19 @@ sub try_compile_and_link {
 	    $errornull = '';
 	}
 
-	$cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull"
+        $cccmd = "$Config{'cc'} -o $tmp $ccflags $tmp.c @$LIBS $errornull"
 	    unless defined $cccmd;
+
 	if ($^O eq 'VMS') {
 	    open( CMDFILE, ">$tmp.com" );
 	    print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n";
 	    print CMDFILE "\$ $cccmd\n";
-	    print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n";  # escalate
+	    print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate
 	    close CMDFILE;
 	    system("\@ $tmp.com");
 	    $ok = $?==0;
 	    for ("$tmp.c", "$tmp$obj_ext", "$tmp.com", "$tmp$Config{exe_ext}") { 
-		1 while unlink $_; 
+		1 while unlink $_;
 	    }
         }
         else
@@ -128,7 +152,7 @@ sub try_compile_and_link {
 sub has_gettimeofday {
     # confusing but true (if condition true ==> -DHAS_GETTIMEOFDAY already)
     return 0 if $Config{'d_gettimeod'} eq 'define';
-    return 1 if try_compile_and_link(<<EOM); 
+    return 1 if try_compile_and_link(<<EOM);
 #include "EXTERN.h" 
 #include "perl.h" 
 #include "XSUB.h" 
@@ -157,7 +181,7 @@ EOM
 }
 
 sub has_x {
-    my ($x, %args) = @_; 
+    my ($x, %args) = @_;
 
     return 1 if
     try_compile_and_link(<<EOM, %args);
@@ -206,24 +230,27 @@ sub unixinit {
 
     my @goodlibs;
 
-    select(STDOUT); $| = 1;
+    select(STDOUT);
+    $| = 1;
 
     print "Checking for libraries...\n";
     my $lib;
     for $lib (@$LIBS) {
-	print "Checking for $lib...\n";
+	print "Checking for $lib... ";
 	$LIBS = [ $lib ];
 	if ($Config{libs} =~ /\b$lib\b/ || has_x("time(0)")) {
 	    push @goodlibs, $lib;
+	    print "found.\n";
+	} else {
+	    print "NOT found.\n";
 	}
     }
-    @$LIBS = @goodlibs;
+    $LIBS = [ @goodlibs ];
     print @$LIBS ?
 	  "You have extra libraries: @$LIBS.\n" :
           "You have no applicable extra libraries.\n";
-    print "\n";
 
-    print "Looking for gettimeofday()...\n";
+    print "Looking for gettimeofday()... ";
     my $has_gettimeofday;
     if ($Config{'d_gettimeod'}) {
 	$has_gettimeofday++;
@@ -233,7 +260,7 @@ sub unixinit {
     }
 
     if ($has_gettimeofday) {
-	print "You have gettimeofday().\n\n";
+	print "found.\n";
     } else {
 	die <<EOD
 Your operating system does not seem to have the gettimeofday() function.
@@ -248,7 +275,7 @@ Aborting configuration.
 EOD
     }
 
-    print "Looking for setitimer()...\n";
+    print "Looking for setitimer()... ";
     my $has_setitimer;
     if ($Config{d_setitimer}) {
         $has_setitimer++;
@@ -258,12 +285,12 @@ EOD
     }
 
     if ($has_setitimer) {
-        print "You have setitimer().\n\n";
+        print "found.\n";
     } else {
-	print "No setitimer().\n\n";
+	print "NOT found.\n";
     }
 
-    print "Looking for getitimer()...\n";
+    print "Looking for getitimer()... ";
     my $has_getitimer;
     if ($Config{d_getitimer}) {
         $has_getitimer++;
@@ -273,19 +300,19 @@ EOD
     }
 
     if ($has_getitimer) {
-        print "You have getitimer().\n\n";
+        print "found.\n";
     } else {
-	print "No getitimer().\n\n";
+	print "NOT found.\n";
     }
 
     if ($has_setitimer && $has_getitimer) {
-	print "You have interval timers (both setitimer and setitimer).\n\n";
+	print "You have interval timers (both setitimer and setitimer).\n";
     } else {
-	print "You do not have interval timers.\n\n";
+	print "You do not have interval timers.\n";
     }
 
-    print "Looking for ualarm()...\n";
-    my $has_ualarm; 
+    print "Looking for ualarm()... ";
+    my $has_ualarm;
     if ($Config{d_ualarm}) {
         $has_ualarm++;
     } elsif (has_x ("ualarm (0, 0)")) {
@@ -294,17 +321,16 @@ EOD
     }
 
     if ($has_ualarm) {
-        print "You have ualarm().\n\n";
+        print "found.\n";
     } else {
-	print "Whoops! No ualarm()!\n";
-	if ($setitimer) {
-	    print "You have setitimer(); we can make a Time::HiRes::ualarm()\n\n";
-	} else {
-	     print "We'll manage.\n\n";
+	print "NOT found.\n";
+	if ($has_setitimer) {
+	    print "But you have setitimer().\n";
+	    print "We can make a Time::HiRes::ualarm().\n";
 	}
     }
 
-    print "Looking for usleep()...\n";
+    print "Looking for usleep()... ";
     my $has_usleep;
     if ($Config{d_usleep}) {
 	$has_usleep++;
@@ -314,17 +340,20 @@ EOD
     }
 
     if ($has_usleep) {
-	print "You have usleep().\n\n";
+	print "found.\n";
     } else {
-	print "Whoops! No usleep()! Let's see if you have select().\n";
+	print "NOT found.\n";
+        print "Let's see if you have select()... ";
         if ($Config{'d_select'} eq 'define') {
-	    print "You have select(); we can make a Time::HiRes::usleep()\n\n";
+	    print "found.\n";
+	    print "We can make a Time::HiRes::usleep().\n";
 	} else {
-	    print "No select(); you won't have a Time::HiRes::usleep()\n\n";
+	    print "NOT found.\n";
+	    print "You won't have a Time::HiRes::usleep().\n";
 	}
     }
 
-    print "Looking for nanosleep()...\n";
+    print "Looking for nanosleep()... ";
     my $has_nanosleep;
     if ($Config{d_nanosleep}) {
 	$has_nanosleep++;
@@ -334,9 +363,11 @@ EOD
     }
 
     if ($has_nanosleep) {
-	print "You have nanosleep().  You can mix subsecond sleeps with signals.\n\n";
+	print "found.\n";
+        print "You can mix subsecond sleeps with signals.\n";
     } else {
-	print "Whoops! No nanosleep()!  You cannot mix subsecond sleeps with signals.\n";
+	print "NOT found.\n";
+        print "You cannot mix subsecond sleeps with signals.\n";
     }
 
     if ($DEFINE) {
@@ -349,7 +380,7 @@ EOD
 }
 
 sub doMakefile {
-    @makefileopts = ();
+    my @makefileopts = ();
 
     if ($] >= 5.005) {
 	push (@makefileopts,
@@ -374,17 +405,42 @@ sub doMakefile {
 	    'SUFFIX'   => 'gz',
 	},
         clean => { FILES => "xdefine" },
+        realclean => {FILES=> 'const-c.inc const-xs.inc'},
     );
 
     WriteMakefile(@makefileopts);
 }
 
-sub main {
-    print <<EOM;
-
-Configuring Time::HiRes...
+sub doConstants {
+    if (eval {require ExtUtils::Constant; 1}) {
+	my @names = (qw(ITIMER_REAL ITIMER_VIRTUAL ITIMER_PROF
+			ITIMER_REALPROF));
+	foreach (qw (d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
+		     d_nanosleep)) {
+	    my $macro = $_;
+	    $macro =~ s/d_(.*)/HAS_\U$1/;
+	    push @names, {name => $_, macro => $macro, value => 1,
+			  default => ["IV", "0"]};
+	}
+	ExtUtils::Constant::WriteConstants(
+					   NAME => 'Time::HiRes',
+					   NAMES => \@names,
+					  );
+    } else {
+	foreach my $file ('const-c.inc', 'const-xs.inc') {
+	    my $fallback = File::Spec->catfile('fallback', $file);
+	    local $/;
+	    open IN, "<$fallback" or die "Can't open $fallback: $!";
+	    open OUT, ">$file" or die "Can't open $file: $!";
+	    print OUT <IN> or die $!;
+	    close OUT or die "Can't close $file: $!";
+	    close IN or die "Can't close $fallback: $!";
+	}
+    }
+}
 
-EOM
+sub main {
+    print "Configuring Time::HiRes...\n";
 
     if ($^O =~ /Win32/i) {
       $DEFINE = '-DSELECT_IS_BROKEN';
@@ -392,16 +448,12 @@ EOM
     } else {
       unixinit();
     }
-    configure;
     doMakefile;
+    doConstants;
     my $make = $Config{'make'} || "make";
     unless ($ENV{PERL_CORE}) {
 	print  <<EOM;
-
-Done configuring.
-
 Now you may issue '$make'.  Do not forget also '$make test'.
-
 EOM
     }
 }
diff --git a/ext/Time/HiRes/fallback/const-c.inc b/ext/Time/HiRes/fallback/const-c.inc
new file mode 100644
index 0000000000..77b137f632
--- /dev/null
+++ b/ext/Time/HiRes/fallback/const-c.inc
@@ -0,0 +1,202 @@
+#define PERL_constant_NOTFOUND	1
+#define PERL_constant_NOTDEF	2
+#define PERL_constant_ISIV	3
+#define PERL_constant_ISNO	4
+#define PERL_constant_ISNV	5
+#define PERL_constant_ISPV	6
+#define PERL_constant_ISPVN	7
+#define PERL_constant_ISSV	8
+#define PERL_constant_ISUNDEF	9
+#define PERL_constant_ISUV	10
+#define PERL_constant_ISYES	11
+
+#ifndef NVTYPE
+typedef double NV; /* 5.6 and later define NVTYPE, and typedef NV to it.  */
+#endif
+#ifndef aTHX_
+#define aTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+#ifndef pTHX_
+#define pTHX_ /* 5.6 or later define this for threading support.  */
+#endif
+
+static int
+constant_11 (pTHX_ const char *name, IV *iv_return) {
+  /* When generated this function returned values for the list of names given
+     here.  However, subsequent manual editing may have added or removed some.
+     ITIMER_PROF ITIMER_REAL d_getitimer d_nanosleep d_setitimer */
+  /* Offset 7 gives the best switch position.  */
+  switch (name[7]) {
+  case 'P':
+    if (memEQ(name, "ITIMER_PROF", 11)) {
+    /*                      ^          */
+#ifdef ITIMER_PROF
+      *iv_return = ITIMER_PROF;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'R':
+    if (memEQ(name, "ITIMER_REAL", 11)) {
+    /*                      ^          */
+#ifdef ITIMER_REAL
+      *iv_return = ITIMER_REAL;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  case 'i':
+    if (memEQ(name, "d_getitimer", 11)) {
+    /*                      ^          */
+#ifdef HAS_GETITIMER
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    if (memEQ(name, "d_setitimer", 11)) {
+    /*                      ^          */
+#ifdef HAS_SETITIMER
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  case 'l':
+    if (memEQ(name, "d_nanosleep", 11)) {
+    /*                      ^          */
+#ifdef HAS_NANOSLEEP
+      *iv_return = 1;
+      return PERL_constant_ISIV;
+#else
+      *iv_return = 0;
+      return PERL_constant_ISIV;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
+static int
+constant (pTHX_ const char *name, STRLEN len, IV *iv_return) {
+  /* Initially switch on the length of the name.  */
+  /* When generated this function returned values for the list of names given
+     in this section of perl code.  Rather than manually editing these functions
+     to add or remove constants, which would result in this comment and section
+     of code becoming inaccurate, we recommend that you edit this section of
+     code, and use it to regenerate a new set of constant functions which you
+     then use to replace the originals.
+
+     Regenerate these constant functions by feeding this entire source file to
+     perl -x
+
+#!/usr/local/bin/perl5.8.0 -w
+use ExtUtils::Constant qw (constant_types C_constant XS_constant);
+
+my $types = {map {($_, 1)} qw(IV)};
+my @names = (qw(ITIMER_PROF ITIMER_REAL ITIMER_REALPROF ITIMER_VIRTUAL),
+            {name=>"d_getitimer", type=>"IV", macro=>"HAS_GETITIMER", value=>"1", default=>["IV", "0"]},
+            {name=>"d_gettimeofday", type=>"IV", macro=>"HAS_GETTIMEOFDAY", value=>"1", default=>["IV", "0"]},
+            {name=>"d_nanosleep", type=>"IV", macro=>"HAS_NANOSLEEP", value=>"1", default=>["IV", "0"]},
+            {name=>"d_setitimer", type=>"IV", macro=>"HAS_SETITIMER", value=>"1", default=>["IV", "0"]},
+            {name=>"d_ualarm", type=>"IV", macro=>"HAS_UALARM", value=>"1", default=>["IV", "0"]},
+            {name=>"d_usleep", type=>"IV", macro=>"HAS_USLEEP", value=>"1", default=>["IV", "0"]});
+
+print constant_types(); # macro defs
+foreach (C_constant ("Time::HiRes", 'constant', 'IV', $types, undef, 3, @names) ) {
+    print $_, "\n"; # C constant subs
+}
+print "#### XS Section:\n";
+print XS_constant ("Time::HiRes", $types);
+__END__
+   */
+
+  switch (len) {
+  case 8:
+    /* Names all of length 8.  */
+    /* d_ualarm d_usleep */
+    /* Offset 7 gives the best switch position.  */
+    switch (name[7]) {
+    case 'm':
+      if (memEQ(name, "d_ualarm", 8)) {
+      /*                      ^      */
+#ifdef HAS_UALARM
+        *iv_return = 1;
+        return PERL_constant_ISIV;
+#else
+        *iv_return = 0;
+        return PERL_constant_ISIV;
+#endif
+      }
+      break;
+    case 'p':
+      if (memEQ(name, "d_usleep", 8)) {
+      /*                      ^      */
+#ifdef HAS_USLEEP
+        *iv_return = 1;
+        return PERL_constant_ISIV;
+#else
+        *iv_return = 0;
+        return PERL_constant_ISIV;
+#endif
+      }
+      break;
+    }
+    break;
+  case 11:
+    return constant_11 (aTHX_ name, iv_return);
+    break;
+  case 14:
+    /* Names all of length 14.  */
+    /* ITIMER_VIRTUAL d_gettimeofday */
+    /* Offset 6 gives the best switch position.  */
+    switch (name[6]) {
+    case '_':
+      if (memEQ(name, "ITIMER_VIRTUAL", 14)) {
+      /*                     ^              */
+#ifdef ITIMER_VIRTUAL
+        *iv_return = ITIMER_VIRTUAL;
+        return PERL_constant_ISIV;
+#else
+        return PERL_constant_NOTDEF;
+#endif
+      }
+      break;
+    case 'i':
+      if (memEQ(name, "d_gettimeofday", 14)) {
+      /*                     ^              */
+#ifdef HAS_GETTIMEOFDAY
+        *iv_return = 1;
+        return PERL_constant_ISIV;
+#else
+        *iv_return = 0;
+        return PERL_constant_ISIV;
+#endif
+      }
+      break;
+    }
+    break;
+  case 15:
+    if (memEQ(name, "ITIMER_REALPROF", 15)) {
+#ifdef ITIMER_REALPROF
+      *iv_return = ITIMER_REALPROF;
+      return PERL_constant_ISIV;
+#else
+      return PERL_constant_NOTDEF;
+#endif
+    }
+    break;
+  }
+  return PERL_constant_NOTFOUND;
+}
+
diff --git a/ext/Time/HiRes/fallback/const-xs.inc b/ext/Time/HiRes/fallback/const-xs.inc
new file mode 100644
index 0000000000..c84dd051dd
--- /dev/null
+++ b/ext/Time/HiRes/fallback/const-xs.inc
@@ -0,0 +1,88 @@
+void
+constant(sv)
+    PREINIT:
+#ifdef dXSTARG
+	dXSTARG; /* Faster if we have it.  */
+#else
+	dTARGET;
+#endif
+	STRLEN		len;
+        int		type;
+	IV		iv;
+	/* NV		nv;	Uncomment this if you need to return NVs */
+	/* const char	*pv;	Uncomment this if you need to return PVs */
+    INPUT:
+	SV *		sv;
+        const char *	s = SvPV(sv, len);
+    PPCODE:
+        /* Change this to constant(aTHX_ s, len, &iv, &nv);
+           if you need to return both NVs and IVs */
+	type = constant(aTHX_ s, len, &iv);
+      /* Return 1 or 2 items. First is error message, or undef if no error.
+           Second, if present, is found value */
+        switch (type) {
+        case PERL_constant_NOTFOUND:
+          sv = sv_2mortal(newSVpvf("%s is not a valid Time::HiRes macro", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_NOTDEF:
+          sv = sv_2mortal(newSVpvf(
+	    "Your vendor has not defined Time::HiRes macro %s, used", s));
+          PUSHs(sv);
+          break;
+        case PERL_constant_ISIV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHi(iv);
+          break;
+	/* Uncomment this if you need to return NOs
+        case PERL_constant_ISNO:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_no);
+          break; */
+	/* Uncomment this if you need to return NVs
+        case PERL_constant_ISNV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHn(nv);
+          break; */
+	/* Uncomment this if you need to return PVs
+        case PERL_constant_ISPV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, strlen(pv));
+          break; */
+	/* Uncomment this if you need to return PVNs
+        case PERL_constant_ISPVN:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHp(pv, iv);
+          break; */
+	/* Uncomment this if you need to return SVs
+        case PERL_constant_ISSV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(sv);
+          break; */
+	/* Uncomment this if you need to return UNDEFs
+        case PERL_constant_ISUNDEF:
+          break; */
+	/* Uncomment this if you need to return UVs
+        case PERL_constant_ISUV:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHu((UV)iv);
+          break; */
+	/* Uncomment this if you need to return YESs
+        case PERL_constant_ISYES:
+          EXTEND(SP, 1);
+          PUSHs(&PL_sv_undef);
+          PUSHs(&PL_sv_yes);
+          break; */
+        default:
+          sv = sv_2mortal(newSVpvf(
+	    "Unexpected return type %d while processing Time::HiRes macro %s, used",
+               type, s));
+          PUSHs(sv);
+        }