diff options
| author | Father Chrysostomos <sprout@cpan.org> | 2014-08-31 20:13:21 -0700 |
|---|---|---|
| committer | Father Chrysostomos <sprout@cpan.org> | 2014-09-15 06:19:32 -0700 |
| commit | 2eaf799e74b14dc77b90d5484a3fd4ceac12b46a (patch) | |
| tree | d472277495cf7140a2aec82d0593edfa9ed3b0fb /universal.c | |
| parent | c831c5ee90b91c179042ccda588910ba60808970 (diff) | |
| download | perl-2eaf799e74b14dc77b90d5484a3fd4ceac12b46a.tar.gz | |
Avoid creating GVs when subs are declared
This patch changes ‘sub foo {...}’ declarations to store subroutine
references in the stash, to save memory.
Typeglobs still notionally exist. Accessing CvGV(cv) will reify them.
Hence, currently the savings are lost when a sub call is compiled.
$ ./miniperl -e 'sub foo{} BEGIN { warn $::{foo} } foo(); BEGIN { warn $::{foo} }'
CODE(0x7f8ef082ad98) at -e line 1.
*main::foo at -e line 1.
This optimisation is skipped if the subroutine declaration contains a
package separator.
Concerning the changes in caller.t, this code:
sub foo { print +(caller(0))[3],"\n" }
my $fooref = delete $::{foo};
$fooref -> ();
used to crash in 5.7.3 or thereabouts. It was fixed by 16658 (aka
07b8c804e8) to produce ‘(unknown)’ instead. Then in 5.13.3 it was
changed (by 803f274) to produce ‘main::__ANON__’ instead. So the
tests are really checking that we don’t get a crash. I think it is
acceptable that it has now changed to ‘main::foo’.
Diffstat (limited to 'universal.c')
| -rw-r--r-- | universal.c | 7 |
1 files changed, 5 insertions, 2 deletions
diff --git a/universal.c b/universal.c index 200ce875b9..825dff5c42 100644 --- a/universal.c +++ b/universal.c @@ -303,11 +303,11 @@ void Perl_croak_xs_usage(const CV *const cv, const char *const params) { /* Avoid CvGV as it requires aTHX. */ - const GV *const gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv; + const GV *gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv; PERL_ARGS_ASSERT_CROAK_XS_USAGE; - if (gv) { + if (gv) got_gv: { const HV *const stash = GvSTASH(gv); if (HvNAME_get(stash)) @@ -321,6 +321,9 @@ Perl_croak_xs_usage(const CV *const cv, const char *const params) Perl_croak_nocontext("Usage: %"HEKf"(%s)", HEKfARG(GvNAME_HEK(gv)), params); } else { + dTHX; + if ((gv = CvGV(cv))) goto got_gv; + /* Pants. I don't think that it should be possible to get here. */ /* diag_listed_as: SKIPME */ Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); |