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
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
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 };
# 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
#endif
#endif
-IV
-constant(name, arg)
- char * name
- int arg
+INCLUDE: const-xs.inc
#if defined(HAS_USLEEP) && defined(HAS_GETTIMEOFDAY)
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' ? '.' :
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 {
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.
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";
}
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";
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
} 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";
}
}
$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
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"
}
sub has_x {
- my ($x, %args) = @_;
+ my ($x, %args) = @_;
return 1 if
try_compile_and_link(<<EOM, %args);
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++;
}
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.
EOD
}
- print "Looking for setitimer()...\n";
+ print "Looking for setitimer()... ";
my $has_setitimer;
if ($Config{d_setitimer}) {
$has_setitimer++;
}
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++;
}
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)")) {
}
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++;
}
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++;
}
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) {
}
sub doMakefile {
- @makefileopts = ();
+ my @makefileopts = ();
if ($] >= 5.005) {
push (@makefileopts,
'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';
} 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
}
}
--- /dev/null
+#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;
+}
+
--- /dev/null
+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);
+ }
projects / p5sagit/p5-mst-13.2.git / commitdiff