[Orca-checkins] rev 191 - in trunk/orca: . packages packages/Time-HiRes-1.42 packages/Time-HiRes-1.42/fallback

blair at orcaware.com blair at orcaware.com
Wed Jan 8 10:47:33 PST 2003


Author: blair
Date: 2003-01-08 10:47:19 -0800 (Wed, 08 Jan 2003)
New Revision: 191

Added:
   trunk/orca/packages/Time-HiRes-1.42/
   trunk/orca/packages/Time-HiRes-1.42/fallback/
   trunk/orca/packages/Time-HiRes-1.42/fallback/const-c.inc
   trunk/orca/packages/Time-HiRes-1.42/fallback/const-xs.inc
Removed:
   trunk/orca/packages/Time-HiRes-1.41/
Modified:
   trunk/orca/INSTALL
   trunk/orca/configure.in
   trunk/orca/packages/Time-HiRes-1.42/Changes
   trunk/orca/packages/Time-HiRes-1.42/HiRes.pm
   trunk/orca/packages/Time-HiRes-1.42/HiRes.xs
   trunk/orca/packages/Time-HiRes-1.42/MANIFEST
   trunk/orca/packages/Time-HiRes-1.42/Makefile.PL
Log:
Upgrade Time::HiRes from 1.41 to 1.42.

* configure.in:
  Bump Time::HiRes' version number to 1.42.

* INSTALL (Determine which Perl modules need compiling and installing):
  Add Time::HiRes to the table of Perl modules and add instructions on
  how to download and install it.

* packages/Time-HiRes-1.42:
  Renamed from packages/Time-HiRes-1.41.  Directory contents updated
  from Time-HiRes-1.42.tar.gz.


Modified: trunk/orca/configure.in
==============================================================================
--- trunk/orca/configure.in	(original)
+++ trunk/orca/configure.in	2003-01-08 10:47:32.000000000 -0800
@@ -41,8 +41,8 @@
 RRDTOOL_VER=1.000401
 STORABLE_DIR=Storable-2.06
 STORABLE_VER=2.06
-TIME_HIRES_DIR=Time-HiRes-1.41
-TIME_HIRES_VER=1.41
+TIME_HIRES_DIR=Time-HiRes-1.42
+TIME_HIRES_VER=1.42
 
 AC_SUBST(COMPRESS_ZLIB_DIR)
 AC_SUBST(DATA_DUMPER_DIR)

Modified: trunk/orca/INSTALL
==============================================================================
--- trunk/orca/INSTALL	(original)
+++ trunk/orca/INSTALL	2003-01-08 10:47:32.000000000 -0800
@@ -176,6 +176,7 @@
     Math::IntervalSearch    >= 1.05        >= 1.05      1.05
     RRDs                    >= 1.000401    >= 1.0.40    1.0.40
     Storable                >= 2.06        >= 2.06      2.06
+    Time::HiRes             No required by Orca         1.42
 
     All seven of these modules are included with the Orca distribution
     in the packages directory.  When you configure Orca in step 3),
@@ -274,6 +275,17 @@
       % make test
       % make install
 
+    Time::HiRes
+
+      http://www.perl.com/CPAN/authors/id/J/JH/JHI/Time-HiRes-1.42.tar.gz
+
+      % gunzip -c Time-HiRes-1.42.tar.gz | tar xvf -
+      % cd Time-HiRes-1.42
+      % perl Makefile.PL
+      % make
+      % make test
+      % make install
+
  5) Make Orca and any necessary Perl modules.
 
     To make Orca and these Perl modules run the following command:

Copied: Time-HiRes-1.42 (from rev 190, trunk/orca/packages/Time-HiRes-1.41)

Added: trunk/orca/packages/Time-HiRes-1.42/fallback/const-xs.inc
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/fallback/const-xs.inc	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/fallback/const-xs.inc	2003-01-08 10:47:32.000000000 -0800
@@ -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);
+        }

Added: trunk/orca/packages/Time-HiRes-1.42/fallback/const-c.inc
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/fallback/const-c.inc	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/fallback/const-c.inc	2003-01-08 10:47:32.000000000 -0800
@@ -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;
+}
+

Modified: trunk/orca/packages/Time-HiRes-1.42/HiRes.xs
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/HiRes.xs	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/HiRes.xs	2003-01-08 10:47:32.000000000 -0800
@@ -98,77 +98,14 @@
 #   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 @@
 #endif
 #endif
 
-IV
-constant(name, arg)
-	char *		name
-	int		arg
+INCLUDE: const-xs.inc
 
 #if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
 

Modified: trunk/orca/packages/Time-HiRes-1.42/HiRes.pm
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/HiRes.pm	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/HiRes.pm	2003-01-08 10:47:32.000000000 -0800
@@ -15,18 +15,16 @@
 		 d_usleep d_ualarm d_gettimeofday d_getitimer d_setitimer
 		 d_nanosleep);
 	
-$VERSION = '1.41';
+$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 };

Modified: trunk/orca/packages/Time-HiRes-1.42/MANIFEST
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/MANIFEST	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/MANIFEST	2003-01-08 10:47:32.000000000 -0800
@@ -1,4 +1,6 @@
 Changes			Time::HiRes extension
+fallback/const-c.inc	Fallback code for constants
+fallback/const-xs.inc	Fallback code for constants
 hints/dynixptx.pl	Hints for Time::HiRes for named architecture
 hints/sco.pl		Hints for Time::HiRes for named architecture
 HiRes.pm		Time::HiRes extension

Modified: trunk/orca/packages/Time-HiRes-1.42/Makefile.PL
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/Makefile.PL	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/Makefile.PL	2003-01-08 10:47:32.000000000 -0800
@@ -33,6 +33,13 @@
     $^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 {
     shift;
     $^O eq 'VMS' ? "-" : "..";
@@ -43,12 +50,14 @@
     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.
@@ -396,11 +405,40 @@
 	    'SUFFIX'   => 'gz',
 	},
         clean => { FILES => "xdefine" },
+        realclean => {FILES=> 'const-c.inc const-xs.inc'},
     );
 
     WriteMakefile(@makefileopts);
 }
 
+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: $!";
+	}
+    }
+}
+
 sub main {
     print "Configuring Time::HiRes...\n";
 
@@ -411,6 +449,7 @@
       unixinit();
     }
     doMakefile;
+    doConstants;
     my $make = $Config{'make'} || "make";
     unless ($ENV{PERL_CORE}) {
 	print  <<EOM;

Modified: trunk/orca/packages/Time-HiRes-1.42/Changes
==============================================================================
--- trunk/orca/packages/Time-HiRes-1.41/Changes	(original)
+++ trunk/orca/packages/Time-HiRes-1.42/Changes	2003-01-08 10:47:32.000000000 -0800
@@ -1,5 +1,8 @@
 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)
@@ -11,7 +14,7 @@
 	  both styles of build should work again.
 
 1.40
-	- Nick Clark noticed that the my_catdir() emulation function
+	- 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



More information about the Orca-checkins mailing list