Convert B to use ExtUtils::Constant::ProxySubs for its constants.

Previously it was using a Perl script to generate C code with pairs of
 newCONSTSUB(stash,"Foo_BAR",newSViv(Foo_BAR));
 av_push(export_ok,newSVpvn("Foo_BAR",7));
for each constant it exported from C to Perl.

Now it uses a loop to process a table. Object code is size reduced by about 42K
on this system (almost 20%)

diff --git a/MANIFEST b/MANIFEST
index b07c12b..95fff9f 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -3072,7 +3072,6 @@ ext/B/B/Showlex.pm        Compiler Showlex backend
 ext/B/B/Terse.pm       Compiler Terse backend
 ext/B/B/Xref.pm                Compiler Xref backend
 ext/B/B.xs             Compiler backend external subroutines
-ext/B/defsubs_h.PL     Generator for constant subroutines
 ext/B/hints/darwin.pl  Hints for named architecture
 ext/B/hints/openbsd.pl Hints for named architecture
 ext/B/Makefile.PL      Compiler backend makefile writer

diff --git a/ext/B/B.xs b/ext/B/B.xs
index e0cda16..004b5eb 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -589,8 +589,12 @@ typedef HE      *B__HE;
 typedef struct refcounted_he   *B__RHE;
 #endif
 
+#include "const-c.inc"
+
 MODULE = B     PACKAGE = B     PREFIX = B_
 
+INCLUDE: const-xs.inc
+
 PROTOTYPES: DISABLE
 
 BOOT:
@@ -608,7 +612,6 @@ BOOT:
 #if PERL_VERSION <= 8
 #  define OPpPAD_STATE 0
 #endif
-#include "defsubs.h"
 }
 
 #define B_main_cv()    PL_main_cv

diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL
index 594e71e..d026a71 100644 (file)
--- a/ext/B/Makefile.PL
+++ b/ext/B/Makefile.PL
@@ -1,42 +1,76 @@
 use ExtUtils::MakeMaker;
+use ExtUtils::Constant 0.23 'WriteConstants';
 use File::Spec;
+use strict;
+use warnings;
+
 my $core = grep { $_ eq 'PERL_CORE=1' } @ARGV;
 
 WriteMakefile(
     NAME           => "B",
     VERSION_FROM    => "B.pm",
-    PL_FILES       => { 'defsubs_h.PL' => 'defsubs.h' },
-    clean          => {
-       FILES       => "defsubs.h"
-    }
+    realclean      => {FILES=> 'const-c.inc const-xs.inc'},
 );
 
-package MY;
-sub headerpath {
-    if ($core) {
-       return File::Spec->catdir(File::Spec->updir,
-                                  File::Spec->updir);
-    } else {
+my $headerpath;
+if ($core) {
+    $headerpath = File::Spec->catdir(File::Spec->updir, File::Spec->updir);
+} else {
        require Config;
-       return File::Spec->catdir($Config::Config{archlibexp}, "CORE");
-    }
+    $headerpath = File::Spec->catdir($Config::Config{archlibexp}, "CORE");
 }
 
-sub MY::postamble {
-    my $headerpath = headerpath();
-    my @headers = map { File::Spec->catfile($headerpath, $_) } qw(op.h cop.h);
+my @names = qw(CVf_ANON CVf_CLONE CVf_CLONED CVf_CONST CVf_LVALUE CVf_METHOD
+              CVf_NODEBUG CVf_UNIQUE CVf_WEAKOUTSIDE
+              GVf_IMPORTED_AV GVf_IMPORTED_CV GVf_IMPORTED_HV GVf_IMPORTED_SV
+              HEf_SVKEY
+              SVTYPEMASK SVt_PVGV SVt_PVHV
+              SVf_FAKE SVf_IOK SVf_IVisUV SVf_NOK SVf_POK SVf_READONLY
+              SVf_ROK SVp_IOK SVp_NOK SVp_POK SVpad_OUR SVs_RMG SVs_SMG
+              PAD_FAKELEX_ANON PAD_FAKELEX_MULTI);
 
-"
-B\$(OBJ_EXT) : defsubs.h
+if ($] >= 5.009) {
+    push @names, 'CVf_ISXSUB';
+} else {
+    # Constant not present after 5.8.x
+    push @names, 'AVf_REAL';
+    # This is only present in 5.10, but it's useful to B::Deparse to be able
+    # to import a dummy value from B
+    push @names, 'OPpPAD_STATE';
+}  
 
-defsubs.h :: @headers defsubs_h.PL
-       \$(PERL) -I\$(INST_ARCHLIB) -I\$(INST_LIB) -I\$(PERL_ARCHLIB) -I\$(PERL_LIB) defsubs_h.PL defsubs.h $headerpath
-"
+if ($] < 5.011) {
+    # Constant not present after 5.10.x
+    push @names, 'CVf_LOCKED';
 }
 
-sub MY::processPL {
-    my $text = shift->SUPER::processPL(@_);
-    # Append our extra parameter
-    $text =~ s/^\t.*defsubs_h\.PL.*/$& . ' ' . headerpath()/me;
-    $text;
+# First element in each tuple is the file; second is a regex snippet
+# giving the prefix to limit the names of symbols to define that come
+# from that file.  If none, all symbols will be defined whose values
+# match the pattern below.
+foreach my $tuple (['op_reg_common.h','(?:(?:RXf_)?PMf_)'],
+                  ['op.h'],
+                  ['cop.h'],
+                  ['regexp.h','RXf_']) {
+    my $file = $tuple->[0];
+    my $pfx = $tuple->[1] || '';
+    my $path = File::Spec->catfile($headerpath, $file);
+    open my $fh, '<', $path or die "Cannot open $path: $!";
+    while (<$fh>) {
+       push @names, $1 if (/ \#define \s+ ( $pfx \w+ ) \s+
+                             ( [()|\dx]+             # Parens, '|', digits, 'x'
+                             | \(? \d+ \s* << .*?    # digits left shifted by anything
+                             ) \s* (?: $| \/ \* )    # ending at comment or $
+                           /x);
+    }
+    close $fh;
 }
+
+# Currently only SVt_PVGV and SVt_PVHV aren't macros, but everything we name
+# should exist, so ensure that the C compile breaks if anything does not.
+WriteConstants(
+    PROXYSUBS => {push => 'EXPORT_OK'},
+    NAME => 'B',
+    NAMES => [map {{name=>$_, macro=>1}} @names],
+    XS_SUBNAME => undef,
+);

diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL
deleted file mode 100644 (file)
index b6d8aaa..0000000
--- a/ext/B/defsubs_h.PL
+++ /dev/null
@@ -1,105 +0,0 @@
-# Do not remove the following line; MakeMaker relies on it to identify
-# this file as a template for defsubs.h
-# Extracting defsubs.h (with variable substitutions)
-#!perl -w
-use File::Spec;
-my (undef, $headerpath) = @ARGV;
-my ($out) = __FILE__ =~ /(^.*)\.PL/i;
-$out =~ s/_h$/.h/;
-unlink $out if -l $out;
-open(OUT,">$out") || die "Cannot open $out:$!";
-print "Extracting $out...\n";
-print OUT <<"END";
-/*
- !!! Don't modify this file - it's autogenerated from $0 !!!
- */
-END
-
-foreach my $const (qw(
-                     CVf_ANON
-                     CVf_CLONE
-                     CVf_CLONED
-                     CVf_CONST
-                     CVf_LVALUE
-                     CVf_METHOD
-                     CVf_NODEBUG
-                     CVf_UNIQUE
-                     CVf_WEAKOUTSIDE
-                     GVf_IMPORTED_AV
-                     GVf_IMPORTED_CV
-                     GVf_IMPORTED_HV
-                     GVf_IMPORTED_SV
-                     HEf_SVKEY
-                     SVTYPEMASK
-                     SVf_FAKE
-                     SVf_IOK
-                     SVf_IVisUV
-                     SVf_NOK
-                     SVf_POK
-                     SVf_READONLY
-                     SVf_ROK
-                     SVp_IOK
-                     SVp_NOK
-                     SVp_POK
-                     SVpad_OUR
-                     SVs_RMG
-                     SVs_SMG
-                     SVt_PVGV
-                     SVt_PVHV
-                     PAD_FAKELEX_ANON
-                     PAD_FAKELEX_MULTI
-                     ))
- {
-  doconst($const);
- }
-
-if ($] < 5.009) {
-    # This is only present in 5.10, but it's useful to B::Deparse to be able
-    # to import a dummy value from B
-    doconst(OPpPAD_STATE);
-}
-
-if ($] >= 5.009) {
-    # Constant not present in 5.8.x
-    doconst(CVf_ISXSUB);
-} else {
-    # Constant not present after 5.8.x
-    doconst(AVf_REAL);
-}  
-
-if ($] < 5.011) {
-    # Constant not present after 5.10.x
-    doconst(CVf_LOCKED);
-}
-
-# First element in each tuple is the file; second is a regex snippet
-# giving the prefix to limit the names of symbols to define that come
-# from that file.  If none, all symbols will be defined whose values
-# match the pattern below.
-foreach my $tuple (['op_reg_common.h','(?:(?:RXf_)?PMf_)'],['op.h'],['cop.h'],['regexp.h','RXf_'])
- {
-  my $file = $tuple->[0];
-  my $pfx = $tuple->[1] || '';
-  my $path = File::Spec->catfile($headerpath, $file);
-  open(OPH,"$path") || die "Cannot open $path:$!";
-  while (<OPH>)
-   {  
-    doconst($1) if (/ \#define \s+ ( $pfx \w+ ) \s+
-                        ( [()|\dx]+             # Parens, '|', digits, 'x'
-                          | \(? \d+ \s* << .*?  # digits left shifted by anything
-                        ) \s* (?: $| \/ \* )    # ending at comment or $
-                   /x);
-   }  
-  close(OPH);
- }
-close(OUT);
-               
-sub doconst
-{
- my $sym = shift;
- my $l = length($sym);
- print OUT <<"END";
- newCONSTSUB(stash,"$sym",newSViv($sym)); 
- av_push(export_ok,newSVpvn("$sym",$l));
-END
-}