This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
better comment what regen/mg_vtable.pl does
authorDavid Mitchell <davem@iabyn.com>
Sun, 30 Aug 2020 10:03:33 +0000 (11:03 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sun, 30 Aug 2020 10:04:51 +0000 (11:04 +0100)
This automates the generating of a lot of perl magic tables and macros,
but it was very opaque as to how it did it.

perl.h
regen/mg_vtable.pl

diff --git a/perl.h b/perl.h
index 52f69e4..ec94327 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5543,8 +5543,14 @@ EXTCONST runops_proc_t PL_runops_dbg
 #define PERL_MAGIC_READONLY_ACCEPTABLE 0x40
 #define PERL_MAGIC_VALUE_MAGIC 0x80
 #define PERL_MAGIC_VTABLE_MASK 0x3F
+
+/* can this type of magic be attached to a readonly SV? */
 #define PERL_MAGIC_TYPE_READONLY_ACCEPTABLE(t) \
     (PL_magic_data[(U8)(t)] & PERL_MAGIC_READONLY_ACCEPTABLE)
+
+/* Is this type of magic container magic (%ENV, $1 etc),
+ * or value magic (pos, taint etc)?
+ */
 #define PERL_MAGIC_TYPE_IS_VALUE_MAGIC(t) \
     (PL_magic_data[(U8)(t)] & PERL_MAGIC_VALUE_MAGIC)
 
index 04dde48..0ebac6c 100644 (file)
 # Accepts the standard regen_lib -q and -v args.
 #
 # This script is normally invoked from regen.pl.
+#
+# Its output files contain:
+#
+# mg_names.inc
+#    included by dump.c - the textual representation for each magic type.
+#    Contains a list of
+#
+#         { PERL_MAGIC_foo, "foo(f)" }
+#
+#    pairs.
+#
+#
+# mg_raw.h
+#    processed by generate_uudmap.c into mg_data.h which eventually
+#    populates PL_magic_vtables[].
+#
+#    Contains a list of:
+#
+#         { 'f', "want_vtbl_foo | FLAGS", "description for comments" }
+#
+#    triplets. FLAGS can be:
+#         PERL_MAGIC_READONLY_ACCEPTABLE
+#               ok set this type of magic on an SvREADONLY() SV
+#         PERL_MAGIC_VALUE_MAGIC
+#               this is value magic (pos, taint etc)
+#               rather than container magic (%ENV, $1 etc)
+#
+#
+# mg_vtable.h
+#     This contains five kinds of entries:
+#
+#     #define PERL_MAGIC_arylen         '#'
+#     ....
+#
+#     enum { /* pass one of these to get_vtbl */
+#          want_vtbl_arylen,
+#          ...
+#     }
+#
+#     PL_magic_vtable_names[] = {
+#         "arylen",
+#         ...
+#     }
+#
+#     PL_magic_vtables[] = {
+#         /* per-magic sets of vtable function pointers */
+#         { get, set, len, clear, free, copy, dup, local },
+#     }
+#
+#     define PL_vtbl_arylen PL_magic_vtables[want_vtbl_arylen]
+#     ....
+#
+#
+#
+# pod/perlguts.pod
+#     updates the list of magic types between
+#     =for mg_vtable.pl begin
+#     ...
+#     =for mg_vtable.pl end
+
 
 use strict;
 require 5.004;
@@ -23,6 +83,41 @@ BEGIN {
     require './regen/regen_lib.pl';
 }
 
+# =====================================================================
+#
+# START OF CONFIGURATION DATA
+
+
+# %mg
+#
+# This hash is mainly concerned with populating all the other stuff
+# ancillary to the vtable.
+#
+# The key is the name, e.g. 'regdata' for PERL_MAGIC_regdata
+#
+# The keys of the value hash are:
+#    char
+#       the magic's char identifier
+#
+#    desc
+#       a description which appears in code comments in generated files
+#
+#    readonly_acceptable
+#       If true, set PERL_MAGIC_READONLY_ACCEPTABLE flag;
+#       SvREADONLY() svs are allowed to have this magic added to them
+#
+#    unknown_to_sv_magic
+#       if true, this isn't one of the standard magic types which
+#       Perl_sv_magic() knows how to deal with
+#
+#    value_magic
+#       If true, set PERL_MAGIC_VALUE_MAGIC flag;
+#       this kind of magic is value (pos, taint etc) rather than
+#       container magic (%ENV, $1 etc)
+#
+#    vtable
+#        name of the vtable lookup enum, e.g. 'foo' creates want_vtbl_foo
+
 my %mg =
     (
      sv => { char => "\0", vtable => 'sv', readonly_acceptable => 1,
@@ -116,7 +211,41 @@ my %mg =
                  desc => "Lvalue reference constructor" },
 );
 
+
+# %sig
+#
+# This hash is mainly concerned with populating the vtable.
+# (despite the name it has nothing to do with signals!)
+#
 # These have a subtly different "namespace" from the magic types.
+#
+# The key is the name, e.g. 'regdata' for PERL_MAGIC_regdata
+# The keys of the value hash are:
+#
+#    alias
+#       for each entry in the anon array, add
+#       add "#define want_vtbl_$_ want_vtbl_$name"
+#
+#    cond
+#       prefix the vtable with the specified entry (e.g. '#ifdef FOO')
+#       and suffix it with '#else { 0, 0, 0, 0, 0, 0, 0, 0 } #endif'
+#
+#    const
+#       special-case cast a 'get' function whose signature expects
+#       a pointer to constant magic, so that it can be added to a vtable
+#       which expects pointers to functions without the 'const'.
+#
+#    get
+#    set
+#    len
+#    clear
+#    free
+#    copy
+#    dup
+#    local
+#       For each specified method, add a vtable function pointer
+#       of the form "Perl_magic_$sig{foo}{get}" etc
+
 my %sig =
     (
      'sv' => {get => 'get', set => 'set'},
@@ -155,6 +284,13 @@ my %sig =
      'lvref' => {set => 'setlvref'},
 );
 
+
+# END OF CONFIGURATION DATA
+#
+# =====================================================================
+
+
+
 my ($vt, $raw, $names) = map {
     open_new($_, '>',
             { by => 'regen/mg_vtable.pl', file => $_, style => '*' });
@@ -179,6 +315,8 @@ EOH
 # simplify the C code by assuming that the last element of the array is
 # predictable)
 
+# Process %mg
+
 {
     my $longest = 0;
     foreach (keys %mg) {
@@ -199,6 +337,7 @@ EOH
        }
        $mg_order{(uc $byte) . $byte} = $name;
     }
+
     my @rows;
     my @names;
     foreach (sort keys %mg_order) {
@@ -206,6 +345,9 @@ EOH
         push @names, $name;
        my $data = $mg{$name};
        my $i = ord $data->{char};
+
+        # add entry to mg_raw.h
+
        unless ($data->{unknown_to_sv_magic}) {
            my $value = $data->{vtable}
                ? "want_vtbl_$data->{vtable}" : 'magic_vtable_max';
@@ -218,21 +360,30 @@ EOH
            print $raw qq{    { '$data->{c_char}', "$value",\n      "$comment" },\n};
        }
 
+        # add #define PERL_MAGIC_foo entry to vt_table.h
+
        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->{c_char}, $comment;
 
+        # add entry to mg_names.inc
+
        my $char = $data->{r_char};
        $char =~ s/([\\"])/\\$1/g;
        printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n],
            "$name,", $name, $char;
 
+        # construct perlguts.pod entry
+
        push @rows, [(sprintf "%-2s PERL_MAGIC_%s", $data->{r_char},$name),
                     $data->{vtable} ? "vtbl_$data->{vtable}" : '(none)',
                     $data->{desc}];
     }
+
+    # output @rows to perlguts.pod
+
     select +(select($guts), do {
        my @header = ('(old-style char and macro)', 'MGVTBL', 'Type of magic');
        my @widths = (0, 0);
@@ -286,6 +437,9 @@ EOH
     })[0];
 }
 
+
+# Process %sig - everything goes to mg_vtable.h
+
 my @names = sort keys %sig;
 {
     my $want = join ",\n    ", (map {"want_vtbl_$_"} @names), 'magic_vtable_max';