In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/4639bd9c727433ad8bfca2730f0999246f0f26d0?hp=0de1010603c15b1a365c5442011e03772e8806df>
- Log ----------------------------------------------------------------- commit 4639bd9c727433ad8bfca2730f0999246f0f26d0 Author: Nicholas Clark <[email protected]> Date: Fri Oct 22 14:03:09 2010 +0200 For PROXYSUBS, avoid calling get_missing_hash() if all symbols are present. For modules such as File::Glob and I18N::Langinfo, which always define all constants on all platforms, this saves about 1K of object code, plus 1 (empty) anonymous hash (per process or thread) in %ExtUtils::Constant::ProxySubs::Missing. M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm commit 214f57503715cacf026aa04ebe516ee76b63811c Author: Nicholas Clark <[email protected]> Date: Fri Oct 22 12:15:17 2010 +0200 For PROXYSUBS, give the notfound struct file scope. All others remain within the scope of the BOOT block. M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm commit 543340fb1f5a45921c194b482b7bb51f98c5722e Author: Nicholas Clark <[email protected]> Date: Fri Oct 22 10:36:44 2010 +0200 Minor refactor of ExtUtils::Constant::ProxySubs. Use a lexical in place of repeated lc()'s in WriteConstants. Require ExtUtils::Constant::ProxySubs early, to avoid leaving empty files if it fails for any reason. M cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm M cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm ----------------------------------------------------------------------- Summary of changes: cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm | 4 +- .../lib/ExtUtils/Constant/ProxySubs.pm | 145 ++++++++++---------- 2 files changed, 75 insertions(+), 74 deletions(-) diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm index 96e495b..0dc9258 100644 --- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm +++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant.pm @@ -494,6 +494,9 @@ sub WriteConstants { croak "Module name not specified" unless length $ARGS{NAME}; + # Do this before creating (empty) files, in case it fails: + require ExtUtils::Constant::ProxySubs if $ARGS{PROXYSUBS}; + my $c_fh = $ARGS{C_FH}; if (!$c_fh) { if ($] <= 5.008) { @@ -522,7 +525,6 @@ sub WriteConstants { # names. if ($ARGS{PROXYSUBS}) { - require ExtUtils::Constant::ProxySubs; $ARGS{C_FH} = $c_fh; $ARGS{XS_FH} = $xs_fh; ExtUtils::Constant::ProxySubs->WriteConstants(%ARGS); diff --git a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm index 1dcfd06..434af15 100644 --- a/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm +++ b/cpan/ExtUtils-Constant/lib/ExtUtils/Constant/ProxySubs.pm @@ -350,9 +350,6 @@ BOOT: dTHX; #endif HV *symbol_table = get_hv("$symbol_table", GV_ADD); -#ifndef SYMBIAN - HV *${c_subname}_missing; -#endif EOBOOT my %iterator; @@ -367,11 +364,17 @@ EOBOOT die "Can't find structure definition for type $type" unless defined $struct; - my $struct_type = $type ? lc($type) . '_s' : 'notfound_s'; + my $lc_type = $type ? lc($type) : 'notfound'; + my $struct_type = $lc_type . '_s'; + my $array_name = 'values_for_' . $lc_type; + $iterator{$type} = 'value_for_' . $lc_type; + # Give the notfound struct file scope. The others are scoped within the + # BOOT block + my $struct_fh = $type ? $xs_fh : $c_fh; + print $c_fh "struct $struct_type $struct;\n"; - my $array_name = 'values_for_' . ($type ? lc $type : 'notfound'); - print $xs_fh <<"EOBOOT"; + print $struct_fh <<"EOBOOT"; static const struct $struct_type $array_name\[] = { @@ -388,36 +391,28 @@ EOBOOT next; } if ($item->{invert_macro}) { - print $xs_fh $self->macro_to_ifndef($macro); - print $xs_fh + print $struct_fh $self->macro_to_ifndef($macro); + print $struct_fh " /* This is the default value: */\n" if $type; } else { - print $xs_fh $ifdef; + print $struct_fh $ifdef; } - print $xs_fh " { ", join (', ', "\"$name\"", $namelen, - &$type_to_value($value)), " },\n", + print $struct_fh " { ", join (', ', "\"$name\"", $namelen, + &$type_to_value($value)), + " },\n", $self->macro_to_endif($macro); } - # Terminate the list with a NULL - print $xs_fh " { NULL, 0", (", 0" x $number_of_args), " } };\n"; - - $iterator{$type} = "value_for_" . ($type ? lc $type : 'notfound'); + print $struct_fh " { NULL, 0", (", 0" x $number_of_args), " } };\n"; - print $xs_fh <<"EOBOOT"; + print $xs_fh <<"EOBOOT" if $type; const struct $struct_type *$iterator{$type} = $array_name; EOBOOT } delete $found->{''}; - print $xs_fh <<"EOBOOT"; -#ifndef SYMBIAN - ${c_subname}_missing = get_missing_hash(aTHX); -#endif -EOBOOT - my $add_symbol_subname = $c_subname . '_add_symbol'; foreach my $type (sort keys %$found) { print $xs_fh $self->boottime_iterator($type, $iterator{$type}, @@ -426,67 +421,71 @@ EOBOOT } print $xs_fh <<"EOBOOT"; - while (value_for_notfound->name) { + if (C_ARRAY_LENGTH(values_for_notfound) > 1) { +#ifndef SYMBIAN + HV *const ${c_subname}_missing = get_missing_hash(aTHX); +#endif + const struct notfound_s *value_for_notfound = values_for_notfound; + do { EOBOOT print $xs_fh $explosives ? <<"EXPLODE" : << "DONT"; - SV *tripwire = newSV(0); - - sv_magicext(tripwire, 0, PERL_MAGIC_ext, ¬_defined_vtbl, 0, 0); - SvPV_set(tripwire, (char *)value_for_notfound->name); - if(value_for_notfound->namelen >= 0) { - SvCUR_set(tripwire, value_for_notfound->namelen); - } else { - SvCUR_set(tripwire, -value_for_notfound->namelen); - SvUTF8_on(tripwire); - } - SvPOKp_on(tripwire); - SvREADONLY_on(tripwire); - assert(SvLEN(tripwire) == 0); - - $add_symbol_subname($athx symbol_table, value_for_notfound->name, - value_for_notfound->namelen, tripwire); + SV *tripwire = newSV(0); + + sv_magicext(tripwire, 0, PERL_MAGIC_ext, ¬_defined_vtbl, 0, 0); + SvPV_set(tripwire, (char *)value_for_notfound->name); + if(value_for_notfound->namelen >= 0) { + SvCUR_set(tripwire, value_for_notfound->namelen); + } else { + SvCUR_set(tripwire, -value_for_notfound->namelen); + SvUTF8_on(tripwire); + } + SvPOKp_on(tripwire); + SvREADONLY_on(tripwire); + assert(SvLEN(tripwire) == 0); + + $add_symbol_subname($athx symbol_table, value_for_notfound->name, + value_for_notfound->namelen, tripwire); EXPLODE - /* Need to add prototypes, else parsing will vary by platform. */ - SV **sv = hv_fetch(symbol_table, value_for_notfound->name, - value_for_notfound->namelen, TRUE); - if (!sv) { - Perl_croak($athx - "Couldn't add key '%s' to %%$package_sprintf_safe\::", - value_for_notfound->name); - } - if (!SvOK(*sv) && SvTYPE(*sv) != SVt_PVGV) { - /* Nothing was here before, so mark a prototype of "" */ - sv_setpvn(*sv, "", 0); - } else if (SvPOK(*sv) && SvCUR(*sv) == 0) { - /* There is already a prototype of "" - do nothing */ - } else { - /* Someone has been here before us - have to make a real - typeglob. */ - /* It turns out to be incredibly hard to deal with all the - corner cases of sub foo (); and reporting errors correctly, - so lets cheat a bit. Start with a constant subroutine */ - CV *cv = newCONSTSUB(symbol_table, - ${cast_CONSTSUB}value_for_notfound->name, - &PL_sv_yes); - /* and then turn it into a non constant declaration only. */ - SvREFCNT_dec(CvXSUBANY(cv).any_ptr); - CvCONST_off(cv); - CvXSUB(cv) = NULL; - CvXSUBANY(cv).any_ptr = NULL; - } + /* Need to add prototypes, else parsing will vary by platform. */ + SV **sv = hv_fetch(symbol_table, value_for_notfound->name, + value_for_notfound->namelen, TRUE); + if (!sv) { + Perl_croak($athx + "Couldn't add key '%s' to %%$package_sprintf_safe\::", + value_for_notfound->name); + } + if (!SvOK(*sv) && SvTYPE(*sv) != SVt_PVGV) { + /* Nothing was here before, so mark a prototype of "" */ + sv_setpvn(*sv, "", 0); + } else if (SvPOK(*sv) && SvCUR(*sv) == 0) { + /* There is already a prototype of "" - do nothing */ + } else { + /* Someone has been here before us - have to make a real + typeglob. */ + /* It turns out to be incredibly hard to deal with all the + corner cases of sub foo (); and reporting errors correctly, + so lets cheat a bit. Start with a constant subroutine */ + CV *cv = newCONSTSUB(symbol_table, + ${cast_CONSTSUB}value_for_notfound->name, + &PL_sv_yes); + /* and then turn it into a non constant declaration only. */ + SvREFCNT_dec(CvXSUBANY(cv).any_ptr); + CvCONST_off(cv); + CvXSUB(cv) = NULL; + CvXSUBANY(cv).any_ptr = NULL; + } #ifndef SYMBIAN - if (!hv_store(${c_subname}_missing, value_for_notfound->name, - value_for_notfound->namelen, &PL_sv_yes, 0)) - Perl_croak($athx "Couldn't add key '%s' to missing_hash", - value_for_notfound->name); + if (!hv_store(${c_subname}_missing, value_for_notfound->name, + value_for_notfound->namelen, &PL_sv_yes, 0)) + Perl_croak($athx "Couldn't add key '%s' to missing_hash", + value_for_notfound->name); #endif DONT print $xs_fh <<"EOBOOT"; - - ++value_for_notfound; + } while ((++value_for_notfound)->name); } EOBOOT -- Perl5 Master Repository
