Generate the PERL_MAGIC_* defines using mg_vtable.pl.
authorNicholas Clark <nick@ccl4.org>
Sun, 15 May 2011 14:53:08 +0000 (15:53 +0100)
committerNicholas Clark <nick@ccl4.org>
Sat, 11 Jun 2011 08:39:59 +0000 (10:39 +0200)
mg_vtable.h
perl.h
regen/mg_vtable.pl

index 516d2c9..45ee1ae 100644 (file)
@@ -6,6 +6,58 @@
  * Any changes made here will be lost!
  */
 
+/* These constants should be used in preference to raw characters
+ * when using magic. Note that some perl guts still assume
+ * certain character properties of these constants, namely that
+ * isUPPER() and toLOWER() may do useful mappings.
+ */
+
+#define PERL_MAGIC_sv             '\0' /* Special scalar variable */
+#define PERL_MAGIC_overload       'A' /* %OVERLOAD hash */
+#define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
+#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
+#define PERL_MAGIC_bm             'B' /* Boyer-Moore (fast string search) */
+#define PERL_MAGIC_regdata        'D' /* Regex match position data
+                                         (@+ and @- vars) */
+#define PERL_MAGIC_regdatum       'd' /* Regex match position data element */
+#define PERL_MAGIC_env            'E' /* %ENV hash */
+#define PERL_MAGIC_envelem        'e' /* %ENV hash element */
+#define PERL_MAGIC_fm             'f' /* Formline ('compiled' format) */
+#define PERL_MAGIC_regex_global   'g' /* m//g target / study()ed string */
+#define PERL_MAGIC_hints          'H' /* %^H hash */
+#define PERL_MAGIC_hintselem      'h' /* %^H hash element */
+#define PERL_MAGIC_isa            'I' /* @ISA array */
+#define PERL_MAGIC_isaelem        'i' /* @ISA array element */
+#define PERL_MAGIC_nkeys          'k' /* scalar(keys()) lvalue */
+#define PERL_MAGIC_dbfile         'L' /* Debugger %_<filename */
+#define PERL_MAGIC_dbline         'l' /* Debugger %_<filename element */
+#define PERL_MAGIC_shared         'N' /* Shared between threads */
+#define PERL_MAGIC_shared_scalar  'n' /* Shared between threads */
+#define PERL_MAGIC_collxfrm       'o' /* Locale transformation */
+#define PERL_MAGIC_tied           'P' /* Tied array or hash */
+#define PERL_MAGIC_tiedelem       'p' /* Tied array or hash element */
+#define PERL_MAGIC_tiedscalar     'q' /* Tied scalar or handle */
+#define PERL_MAGIC_qr             'r' /* precompiled qr// regex */
+#define PERL_MAGIC_sig            'S' /* %SIG hash */
+#define PERL_MAGIC_sigelem        's' /* %SIG hash element */
+#define PERL_MAGIC_taint          't' /* Taintedness */
+#define PERL_MAGIC_uvar           'U' /* Available for use by extensions */
+#define PERL_MAGIC_uvar_elem      'u' /* Reserved for use by extensions */
+#define PERL_MAGIC_vec            'v' /* vec() lvalue */
+#define PERL_MAGIC_vstring        'V' /* SV was vstring literal */
+#define PERL_MAGIC_utf8           'w' /* Cached UTF-8 information */
+#define PERL_MAGIC_substr         'x' /* substr() lvalue */
+#define PERL_MAGIC_defelem        'y' /* Shadow "foreach" iterator variable /
+                                         smart parameter vivification */
+#define PERL_MAGIC_arylen         '#' /* Array length ($#ary) */
+#define PERL_MAGIC_pos            '.' /* pos() lvalue */
+#define PERL_MAGIC_backref        '<' /* for weak ref data */
+#define PERL_MAGIC_symtab         ':' /* extra data for symbol tables */
+#define PERL_MAGIC_rhash          '%' /* extra data for restricted hashes */
+#define PERL_MAGIC_arylen_p       '@' /* to move arylen out of XPVAV */
+#define PERL_MAGIC_ext            '~' /* Available for use by extensions */
+#define PERL_MAGIC_checkcall      ']' /* inlining/mutation of call to this CV */
+
 enum {         /* pass one of these to get_vtbl */
     want_vtbl_sv,
     want_vtbl_env,
diff --git a/perl.h b/perl.h
index 9405788..8963f50 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3856,63 +3856,6 @@ Gid_t getegid (void);
                    where, (long)PL_scopestack_ix, (long)PL_savestack_ix, \
                    __FILE__, __LINE__));
 
-
-
-
-/* These constants should be used in preference to raw characters
- * when using magic. Note that some perl guts still assume
- * certain character properties of these constants, namely that
- * isUPPER() and toLOWER() may do useful mappings.
- *
- * Update the magic_names table in dump.c when adding/amending these
- */
-
-#define PERL_MAGIC_sv            '\0' /* Special scalar variable */
-#define PERL_MAGIC_overload      'A' /* %OVERLOAD hash */
-#define PERL_MAGIC_overload_elem  'a' /* %OVERLOAD hash element */
-#define PERL_MAGIC_overload_table 'c' /* Holds overload table (AMT) on stash */
-#define PERL_MAGIC_bm            'B' /* Boyer-Moore (fast string search) */
-#define PERL_MAGIC_regdata       'D' /* Regex match position data
-                                       (@+ and @- vars) */
-#define PERL_MAGIC_regdatum      'd' /* Regex match position data element */
-#define PERL_MAGIC_env           'E' /* %ENV hash */
-#define PERL_MAGIC_envelem       'e' /* %ENV hash element */
-#define PERL_MAGIC_fm            'f' /* Formline ('compiled' format) */
-#define PERL_MAGIC_regex_global          'g' /* m//g target / study()ed string */
-#define PERL_MAGIC_hints         'H' /* %^H hash */
-#define PERL_MAGIC_hintselem     'h' /* %^H hash element */
-#define PERL_MAGIC_isa           'I' /* @ISA array */
-#define PERL_MAGIC_isaelem       'i' /* @ISA array element */
-#define PERL_MAGIC_nkeys         'k' /* scalar(keys()) lvalue */
-#define PERL_MAGIC_dbfile        'L' /* Debugger %_<filename */
-#define PERL_MAGIC_dbline        'l' /* Debugger %_<filename element */
-#define PERL_MAGIC_shared        'N' /* Shared between threads */
-#define PERL_MAGIC_shared_scalar  'n' /* Shared between threads */
-#define PERL_MAGIC_collxfrm      'o' /* Locale transformation */
-#define PERL_MAGIC_tied                  'P' /* Tied array or hash */
-#define PERL_MAGIC_tiedelem      'p' /* Tied array or hash element */
-#define PERL_MAGIC_tiedscalar    'q' /* Tied scalar or handle */
-#define PERL_MAGIC_qr            'r' /* precompiled qr// regex */
-#define PERL_MAGIC_sig           'S' /* %SIG hash */
-#define PERL_MAGIC_sigelem       's' /* %SIG hash element */
-#define PERL_MAGIC_taint         't' /* Taintedness */
-#define PERL_MAGIC_uvar                  'U' /* Available for use by extensions */
-#define PERL_MAGIC_uvar_elem     'u' /* Reserved for use by extensions */
-#define PERL_MAGIC_vec           'v' /* vec() lvalue */
-#define PERL_MAGIC_vstring       'V' /* SV was vstring literal */
-#define PERL_MAGIC_utf8                  'w' /* Cached UTF-8 information */
-#define PERL_MAGIC_substr        'x' /* substr() lvalue */
-#define PERL_MAGIC_defelem       'y' /* Shadow "foreach" iterator variable /
-                                       smart parameter vivification */
-#define PERL_MAGIC_arylen        '#' /* Array length ($#ary) */
-#define PERL_MAGIC_pos           '.' /* pos() lvalue */
-#define PERL_MAGIC_backref       '<' /* for weak ref data */
-#define PERL_MAGIC_symtab        ':' /* extra data for symbol tables */
-#define PERL_MAGIC_rhash         '%' /* extra data for restricted hashes */
-#define PERL_MAGIC_arylen_p      '@' /* to move arylen out of XPVAV */
-#define PERL_MAGIC_ext           '~' /* Available for use by extensions */
-#define PERL_MAGIC_checkcall     ']' /* inlining/mutation of call to this CV */
-
 #if defined(DEBUGGING) && defined(I_ASSERT)
 #  include <assert.h>
 #endif
index 8b587ff..c8b6852 100644 (file)
@@ -18,6 +18,9 @@ BEGIN {
     require 'regen/regen_lib.pl';
 }
 
+# Update the magic_names table in dump.c when adding/amending these
+# (effectively, that's a TODO)
+
 my @mg =
     (
      sv => { char => '\0', vtable => 'sv', readonly_acceptable => 1,
@@ -31,7 +34,7 @@ my @mg =
             readonly_acceptable => 1,
             desc => 'Boyer-Moore (fast string search)' },
      regdata => { char => 'D', vtable => 'regdata',
-                 desc => 'Regex match position data (@+ and @- vars)' },
+                 desc => "Regex match position data\n(\@+ and \@- vars)" },
      regdatum => { char => 'd', vtable => 'regdatum',
                   desc => 'Regex match position data element' },
      env => { char => 'E', vtable => 'env', desc => '%ENV hash' },
@@ -86,7 +89,7 @@ my @mg =
      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' },
+                 desc => "Shadow \"foreach\" iterator variable /\nsmart parameter vivification" },
      arylen => { char => '#', vtable => 'arylen', value_magic => 1,
                 desc => 'Array length ($#ary)' },
      pos => { char => '.', vtable => 'pos', value_magic => 1,
@@ -146,6 +149,20 @@ my ($vt, $raw) = map {
             { by => 'regen/mg_vtable.pl', file => $_, style => '*' });
 } 'mg_vtable.h', 'mg_raw.h';
 
+print $vt <<'EOH';
+/* These constants should be used in preference to raw characters
+ * when using magic. Note that some perl guts still assume
+ * certain character properties of these constants, namely that
+ * isUPPER() and toLOWER() may do useful mappings.
+ */
+
+EOH
+
+my $longest = 0;
+foreach (grep {!ref $_} @mg) {
+    $longest = length $_ if length $_ > $longest;
+}
+
 # Of course, it would be *much* easier if we could output this table directly
 # here and now. However, for our sins, we try to support EBCDIC, which wouldn't
 # be *so* bad, except that there are (at least) 3 EBCDIC charset variants, and
@@ -166,8 +183,15 @@ my ($vt, $raw) = map {
            $value .= ' | PERL_MAGIC_VALUE_MAGIC' if $data->{value_magic};
            my $comment = "/* $name '$data->{char}' $data->{desc} */";
            $comment =~ s/([\\"])/\\$1/g;
+           $comment =~ tr/\n/ /;
            print $raw qq{    { '$data->{char}', "$value",\n      "$comment" },\n};
        }
+
+       my $comment = $data->{desc};
+       my $leader = ' ' x ($longest + 27);
+       $comment =~ s/\n/\n$leader/s;
+       printf $vt "#define PERL_MAGIC_%-${longest}s '%s' /* %s */\n",
+           $name, $data->{char}, $comment;
     }
 }
 
@@ -177,6 +201,7 @@ my ($vt, $raw) = map {
     my $names = join qq{",\n    "}, @names;
 
     print $vt <<"EOH";
+
 enum {         /* pass one of these to get_vtbl */
     $want
 };