summaryrefslogtreecommitdiff
path: root/regen
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2011-05-13 14:17:22 +0100
committerNicholas Clark <nick@ccl4.org>2011-06-11 10:12:17 +0200
commit8b09643d068d86543c3782211d4a527ee93fee77 (patch)
tree32056686eb6f479513c1c0d5c0a05fd94ec70674 /regen
parent4de01b548a201d0dc90101ced2980c754fbf0e00 (diff)
downloadperl-8b09643d068d86543c3782211d4a527ee93fee77.tar.gz
Generate the definitions for magic vtables from data in a regen script.
Previously perl.h contained a long section of MGVTBL_SET() macros declaring the core's various magic vtables. Convert the information into data structures in a new script regen/mg_table.pl, and use this to generate a new file mg_vtable.h, included by perl.h This is the first step in reducing the number of places that data relating to magic vtables is declared (and has to be kept in sync), and will allow more flexibility in parts of the core's implementation.
Diffstat (limited to 'regen')
-rw-r--r--regen/mg_vtable.pl102
1 files changed, 102 insertions, 0 deletions
diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl
new file mode 100644
index 0000000000..d3557ec43b
--- /dev/null
+++ b/regen/mg_vtable.pl
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+#
+# Regenerate (overwriting only if changed):
+#
+# mg_vtable.h
+#
+# from information stored in this file.
+#
+# Accepts the standard regen_lib -q and -v args.
+#
+# This script is normally invoked from regen.pl.
+
+use strict;
+require 5.004;
+
+BEGIN {
+ # Get function prototypes
+ require 'regen/regen_lib.pl';
+}
+
+my @sig =
+ (
+ 'sv' => {get => 'get', set => 'set', len => 'len'},
+ 'env' => {set => 'set_all_env', clear => 'clear_all_env'},
+ 'envelem' => {set => 'setenv', clear => 'clearenv'},
+ 'sigelem' => {get => 'getsig', set => 'setsig', clear => 'clearsig',
+ cond => '#ifndef PERL_MICRO'},
+ 'pack' => {len => 'sizepack', clear => 'wipepack'},
+ 'packelem' => {get => 'getpack', set => 'setpack', clear => 'clearpack'},
+ 'dbline' => {set => 'setdbline'},
+ 'isa' => {set => 'setisa', clear => 'clearisa'},
+ 'isaelem' => {set => 'setisa'},
+ 'arylen' => {get => 'getarylen', set => 'setarylen', const => 1},
+ 'arylen_p' => {free => 'freearylen_p'},
+ 'mglob' => {set => 'setmglob'},
+ 'nkeys' => {get => 'getnkeys', set => 'setnkeys'},
+ 'taint' => {get => 'gettaint', set => 'settaint'},
+ 'substr' => {get => 'getsubstr', set => 'setsubstr'},
+ 'vec' => {get => 'getvec', set => 'setvec'},
+ 'pos' => {get => 'getpos', set => 'setpos'},
+ 'bm' => {set => 'setregexp'},
+ 'fm' => {set => 'setregexp'},
+ 'uvar' => {get => 'getuvar', set => 'setuvar'},
+ 'defelem' => {get => 'getdefelem', set => 'setdefelem'},
+ 'regexp' => {set => 'setregexp'},
+ 'regdata' => {len => 'regdata_cnt'},
+ 'regdatum' => {get => 'regdatum_get', set => 'regdatum_set'},
+ 'amagic' => {set => 'setamagic', free => 'setamagic'},
+ 'amagicelem' => {set => 'setamagic', free => 'setamagic'},
+ 'backref' => {free => 'killbackrefs'},
+ 'ovrld' => {free => 'freeovrld'},
+ 'utf8' => {set => 'setutf8'},
+ 'collxfrm' => {set => 'setcollxfrm',
+ cond => '#ifdef USE_LOCALE_COLLATE'},
+ 'hintselem' => {set => 'sethint', clear => 'clearhint'},
+ 'hints' => {clear => 'clearhints'},
+);
+
+my $h = open_new('mg_vtable.h', '>',
+ { by => 'regen/mg_vtable.pl', file => 'mg_vtable.h',
+ style => '*' });
+
+print $h <<'EOH';
+/* These all need to be 0, not NULL, as NULL can be (void*)0, which is a
+ * pointer to data, whereas we're assigning pointers to functions, which are
+ * not the same beast. ANSI doesn't allow the assignment from one to the other.
+ * (although most, but not all, compilers are prepared to do it)
+ */
+
+/* args are:
+ vtable
+ get
+ set
+ len
+ clear
+ free
+ copy
+ dup
+ local
+*/
+
+EOH
+
+while (my ($name, $data) = splice @sig, 0, 2) {
+ my $funcs = join ",\n ", map {
+ $data->{$_} ? "Perl_magic_$data->{$_}" : 0;
+ } qw(get set len clear free copy dup local);
+
+ my $set_macro = $data->{const} ? 'MGVTBL_SET_CONST_MAGIC_GET' : 'MGVTBL_SET';
+
+ print $h "$data->{cond}\n" if $data->{cond};
+ print $h <<"EOT";
+$set_macro(
+ PL_vtbl_$name,
+ $funcs
+);
+EOT
+ print $h "#endif\n" if $data->{cond};
+ print $h "\n";
+}
+
+read_only_bottom_close_and_rename($h);