This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Store a flag for container/value magic in PL_magic_data.
authorNicholas Clark <nick@ccl4.org>
Sun, 15 May 2011 12:54:19 +0000 (13:54 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2011 08:39:59 +0000 (10:39 +0200)
Use this to replace S_is_container_magic() in mg.c with a direct lookup.

mg.c
mg_raw.h
perl.h
regen/mg_vtable.pl
sv.c

diff --git a/mg.c b/mg.c
index bdded26..86f1eb6 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -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)
index 363e189..aebd777 100644 (file)
--- a/mg_raw.h
+++ b/mg_raw.h
@@ -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 */" },
       "/* 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: */
diff --git a/perl.h b/perl.h
index 6b688b6..def6d1d 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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
index 121a9b4..371ac98 100644 (file)
@@ -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;
diff --git a/sv.c b/sv.c
index 779da64..67c07f8 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -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.