diff options
| -rw-r--r-- | mg.c | 41 | ||||
| -rw-r--r-- | mg_raw.h | 40 | ||||
| -rw-r--r-- | perl.h | 5 | ||||
| -rw-r--r-- | regen/mg_vtable.pl | 60 | ||||
| -rw-r--r-- | sv.c | 3 |
5 files changed, 68 insertions, 81 deletions
@@ -164,42 +164,6 @@ Perl_mg_magical(pTHX_ SV *sv) } } - -/* is this container magic (%ENV, $1 etc), or value magic (pos, taint etc)? */ - -STATIC bool -S_is_container_magic(const MAGIC *mg) -{ - assert(mg); - switch (mg->mg_type) { - case PERL_MAGIC_bm: - case PERL_MAGIC_fm: - case PERL_MAGIC_regex_global: - case PERL_MAGIC_nkeys: -#ifdef USE_LOCALE_COLLATE - case PERL_MAGIC_collxfrm: -#endif - case PERL_MAGIC_qr: - case PERL_MAGIC_taint: - case PERL_MAGIC_vec: - case PERL_MAGIC_vstring: - case PERL_MAGIC_utf8: - case PERL_MAGIC_substr: - case PERL_MAGIC_defelem: - case PERL_MAGIC_arylen: - case PERL_MAGIC_pos: - case PERL_MAGIC_backref: - case PERL_MAGIC_arylen_p: - case PERL_MAGIC_rhash: - case PERL_MAGIC_symtab: - case PERL_MAGIC_tied: /* treat as value, so 'local @tied' isn't tied */ - case PERL_MAGIC_checkcall: - return 0; - default: - return 1; - } -} - /* =for apidoc mg_get @@ -296,7 +260,8 @@ Perl_mg_set(pTHX_ SV *sv) mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ (SSPTR(mgs_ix, MGS*))->mgs_magical = 0; } - if (PL_localizing == 2 && (!S_is_container_magic(mg) || sv == DEFSV)) + if (PL_localizing == 2 + && (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type) || sv == DEFSV)) continue; if (vtbl && vtbl->svt_set) vtbl->svt_set(aTHX_ sv, mg); @@ -526,7 +491,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; - if (!S_is_container_magic(mg)) + if (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) continue; if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local) @@ -14,7 +14,7 @@ "/* overload_elem 'a' %OVERLOAD hash element */" }, { 'c', "want_vtbl_ovrld", "/* overload_table 'c' Holds overload table (AMT) on stash */" }, - { 'B', "want_vtbl_regexp", + { 'B', "want_vtbl_regexp | PERL_MAGIC_VALUE_MAGIC", "/* bm 'B' Boyer-Moore (fast string search) */" }, { 'D', "want_vtbl_regdata", "/* regdata 'D' Regex match position data (@+ and @- vars) */" }, @@ -24,9 +24,9 @@ "/* env 'E' %ENV hash */" }, { 'e', "want_vtbl_envelem", "/* envelem 'e' %ENV hash element */" }, - { 'f', "want_vtbl_regdata", + { 'f', "want_vtbl_regdata | PERL_MAGIC_VALUE_MAGIC", "/* fm 'f' Formline ('compiled' format) */" }, - { 'g', "want_vtbl_mglob", + { 'g', "want_vtbl_mglob | PERL_MAGIC_VALUE_MAGIC", "/* regex_global 'g' m//g target / study()ed string */" }, { 'H', "want_vtbl_hints", "/* hints 'H' %^H hash */" }, @@ -36,55 +36,55 @@ "/* isa 'I' @ISA array */" }, { 'i', "want_vtbl_isaelem", "/* isaelem 'i' @ISA array element */" }, - { 'k', "want_vtbl_nkeys", + { 'k', "want_vtbl_nkeys | PERL_MAGIC_VALUE_MAGIC", "/* nkeys 'k' scalar(keys()) lvalue */" }, { 'L', "want_vtbl_dbline", "/* dbfile 'L' Debugger %_<filename */" }, { 'l', "magic_vtable_max", "/* dbline 'l' Debugger %_<filename element */" }, - { 'o', "want_vtbl_collxfrm", + { 'o', "want_vtbl_collxfrm | PERL_MAGIC_VALUE_MAGIC", "/* collxfrm 'o' Locale transformation */" }, - { 'P', "want_vtbl_pack", + { 'P', "want_vtbl_pack | PERL_MAGIC_VALUE_MAGIC", "/* tied 'P' Tied array or hash */" }, { 'p', "want_vtbl_packelem", "/* tiedelem 'p' Tied array or hash element */" }, { 'q', "want_vtbl_packelem", "/* tiedscalar 'q' Tied scalar or handle */" }, - { 'r', "want_vtbl_regexp", + { 'r', "want_vtbl_regexp | PERL_MAGIC_VALUE_MAGIC", "/* qr 'r' precompiled qr// regex */" }, { 'S', "magic_vtable_max", "/* sig 'S' %SIG hash */" }, { 's', "want_vtbl_sigelem", "/* sigelem 's' %SIG hash element */" }, - { 't', "want_vtbl_taint", + { 't', "want_vtbl_taint | PERL_MAGIC_VALUE_MAGIC", "/* taint 't' Taintedness */" }, { 'U', "want_vtbl_uvar", "/* uvar 'U' Available for use by extensions */" }, - { 'v', "want_vtbl_vec", + { 'v', "want_vtbl_vec | PERL_MAGIC_VALUE_MAGIC", "/* vec 'v' vec() lvalue */" }, - { 'V', "magic_vtable_max", + { 'V', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* vstring 'V' SV was vstring literal */" }, - { 'w', "want_vtbl_utf8", + { 'w', "want_vtbl_utf8 | PERL_MAGIC_VALUE_MAGIC", "/* utf8 'w' Cached UTF-8 information */" }, - { 'x', "want_vtbl_substr", + { 'x', "want_vtbl_substr | PERL_MAGIC_VALUE_MAGIC", "/* substr 'x' substr() lvalue */" }, - { 'y', "want_vtbl_defelem", + { 'y', "want_vtbl_defelem | PERL_MAGIC_VALUE_MAGIC", "/* defelem 'y' Shadow \"foreach\" iterator variable / smart parameter vivification */" }, - { '#', "want_vtbl_arylen", + { '#', "want_vtbl_arylen | PERL_MAGIC_VALUE_MAGIC", "/* arylen '#' Array length ($#ary) */" }, - { '.', "want_vtbl_pos", + { '.', "want_vtbl_pos | PERL_MAGIC_VALUE_MAGIC", "/* pos '.' pos() lvalue */" }, - { '<', "want_vtbl_backref", + { '<', "want_vtbl_backref | PERL_MAGIC_VALUE_MAGIC", "/* backref '<' for weak ref data */" }, - { ':', "magic_vtable_max", + { ':', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* symtab ':' extra data for symbol tables */" }, - { '%', "magic_vtable_max", + { '%', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* rhash '%' extra data for restricted hashes */" }, - { '@', "magic_vtable_max", + { '@', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* arylen_p '@' to move arylen out of XPVAV */" }, { '~', "magic_vtable_max", "/* ext '~' Available for use by extensions */" }, - { ']', "magic_vtable_max", + { ']', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* checkcall ']' inlining/mutation of call to this CV */" }, /* ex: set ro: */ @@ -5071,6 +5071,11 @@ START_EXTERN_C # define EXT_MGVTBL EXT MGVTBL #endif +#define PERL_MAGIC_VALUE_MAGIC 0x80 +#define PERL_MAGIC_VTABLE_MASK 0x3F +#define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \ + (PL_magic_data[(U8)(t)] & PERL_MAGIC_VALUE_MAGIC) + #include "mg_vtable.h" #ifdef DOINIT diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index 121a9b4d52..371ac98bc0 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -26,7 +26,7 @@ my @mg = desc => '%OVERLOAD hash element' }, overload_table => { char => 'c', vtable => 'ovrld', desc => 'Holds overload table (AMT) on stash' }, - bm => { char => 'B', vtable => 'regexp', + bm => { char => 'B', vtable => 'regexp', value_magic => 1, desc => 'Boyer-Moore (fast string search)' }, regdata => { char => 'D', vtable => 'regdata', desc => 'Regex match position data (@+ and @- vars)' }, @@ -35,9 +35,9 @@ my @mg = env => { char => 'E', vtable => 'env', desc => '%ENV hash' }, envelem => { char => 'e', vtable => 'envelem', desc => '%ENV hash element' }, - fm => { char => 'f', vtable => 'regdata', + fm => { char => 'f', vtable => 'regdata', value_magic => 1, desc => "Formline ('compiled' format)" }, - regex_global => { char => 'g', vtable => 'mglob', + regex_global => { char => 'g', vtable => 'mglob', value_magic => 1, desc => 'm//g target / study()ed string' }, hints => { char => 'H', vtable => 'hints', desc => '%^H hash' }, hintselem => { char => 'h', vtable => 'hintselem', @@ -45,7 +45,7 @@ my @mg = isa => { char => 'I', vtable => 'isa', desc => '@ISA array' }, isaelem => { char => 'i', vtable => 'isaelem', desc => '@ISA array element' }, - nkeys => { char => 'k', vtable => 'nkeys', + nkeys => { char => 'k', vtable => 'nkeys', value_magic => 1, desc => 'scalar(keys()) lvalue' }, dbfile => { char => 'L', vtable => 'dbline', desc => 'Debugger %_<filename' }, @@ -54,39 +54,51 @@ my @mg = unknown_to_sv_magic => 1 }, shared_scalar => { char => 'n', desc => 'Shared between threads', unknown_to_sv_magic => 1 }, - collxfrm => { char => 'o', vtable => 'collxfrm', + collxfrm => { char => 'o', vtable => 'collxfrm', value_magic => 1, desc => 'Locale transformation' }, - tied => { char => 'P', vtable => 'pack', desc => 'Tied array or hash' }, + tied => { char => 'P', vtable => 'pack', + value_magic => 1, # treat as value, so 'local @tied' isn't tied + desc => 'Tied array or hash' }, tiedelem => { char => 'p', vtable => 'packelem', desc => 'Tied array or hash element' }, tiedscalar => { char => 'q', vtable => 'packelem', desc => 'Tied scalar or handle' }, - qr => { char => 'r', vtable => 'regexp', desc => 'precompiled qr// regex' }, + qr => { char => 'r', vtable => 'regexp', value_magic => 1, + desc => 'precompiled qr// regex' }, sig => { char => 'S', desc => '%SIG hash' }, sigelem => { char => 's', vtable => 'sigelem', desc => '%SIG hash element' }, - taint => { char => 't', vtable => 'taint', desc => 'Taintedness' }, + taint => { char => 't', vtable => 'taint', value_magic => 1, + desc => 'Taintedness' }, uvar => { char => 'U', vtable => 'uvar', desc => 'Available for use by extensions' }, uvar_elem => { char => 'u', desc => 'Reserved for use by extensions', unknown_to_sv_magic => 1 }, - vec => { char => 'v', vtable => 'vec', desc => 'vec() lvalue' }, - vstring => { char => 'V', desc => 'SV was vstring literal' }, - utf8 => { char => 'w', vtable => 'utf8', + vec => { char => 'v', vtable => 'vec', value_magic => 1, + desc => 'vec() lvalue' }, + vstring => { char => 'V', value_magic => 1, + desc => 'SV was vstring literal' }, + utf8 => { char => 'w', vtable => 'utf8', value_magic => 1, desc => 'Cached UTF-8 information' }, - substr => { char => 'x', vtable => 'substr', desc => 'substr() lvalue' }, - defelem => { char => 'y', vtable => 'defelem', + substr => { char => 'x', vtable => 'substr', value_magic => 1, + desc => 'substr() lvalue' }, + defelem => { char => 'y', vtable => 'defelem', value_magic => 1, desc => 'Shadow "foreach" iterator variable / smart parameter vivification' }, - arylen => { char => '#', vtable => 'arylen', + arylen => { char => '#', vtable => 'arylen', value_magic => 1, desc => 'Array length ($#ary)' }, - pos => { char => '.', vtable => 'pos', desc => 'pos() lvalue' }, - backref => { char => '<', vtable => 'backref', + pos => { char => '.', vtable => 'pos', value_magic => 1, + desc => 'pos() lvalue' }, + backref => { char => '<', vtable => 'backref', value_magic => 1, desc => 'for weak ref data' }, - symtab => { char => ':', desc => 'extra data for symbol tables' }, - rhash => { char => '%', desc => 'extra data for restricted hashes' }, - arylen_p => { char => '@', desc => 'to move arylen out of XPVAV' }, + symtab => { char => ':', value_magic => 1, + desc => 'extra data for symbol tables' }, + rhash => { char => '%', value_magic => 1, + desc => 'extra data for restricted hashes' }, + arylen_p => { char => '@', value_magic => 1, + desc => 'to move arylen out of XPVAV' }, ext => { char => '~', desc => 'Available for use by extensions' }, - checkcall => { char => ']', desc => 'inlining/mutation of call to this CV'}, + checkcall => { char => ']', value_magic => 1, + desc => 'inlining/mutation of call to this CV'}, ); # These have a subtly different "namespace" from the magic types. @@ -144,11 +156,12 @@ my ($vt, $raw) = map { while (my ($name, $data) = splice @mg, 0, 2) { my $i = ord eval qq{"$data->{char}"}; unless ($data->{unknown_to_sv_magic}) { - my $vtable = $data->{vtable} + my $value = $data->{vtable} ? "want_vtbl_$data->{vtable}" : 'magic_vtable_max'; + $value .= ' | PERL_MAGIC_VALUE_MAGIC' if $data->{value_magic}; my $comment = "/* $name '$data->{char}' $data->{desc} */"; $comment =~ s/([\\"])/\\$1/g; - print $raw qq{ { '$data->{char}', "$vtable",\n "$comment" },\n}; + print $raw qq{ { '$data->{char}', "$value",\n "$comment" },\n}; } } } @@ -237,4 +250,7 @@ print $vt (sort @aliases), "\n"; print $vt "#define PL_vtbl_$_ PL_magic_vtables[want_vtbl_$_]\n" foreach sort @vtable_names; +# 63, not 64, As we rely on the last possible value to mean "NULL vtable" +die "Too many vtable names" if @vtable_names > 63; + read_only_bottom_close_and_rename($_) foreach $vt, $raw; @@ -5281,7 +5281,8 @@ Perl_sv_magic(pTHX_ register SV *const sv, SV *const obj, const int how, } if (how < 0 || how > C_ARRAY_LENGTH(PL_magic_data) - || (vtable_index = PL_magic_data[how]) > magic_vtable_max) + || ((vtable_index = PL_magic_data[how] & PERL_MAGIC_VTABLE_MASK) + > magic_vtable_max)) Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how); /* PERL_MAGIC_ext is reserved for use by extensions not perl internals. |