From 52f4950575a77c74948f90dd3e24ac66b684eb4a Mon Sep 17 00:00:00 2001 From: Nicholas Clark Date: Sun, 15 May 2011 16:25:34 +0100 Subject: [PATCH] Generate magic_names in dump.c using mg_vtable.pl. --- MANIFEST | 1 + dump.c | 44 +------------------------------------------- mg_names.c | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ regen/mg_vtable.pl | 16 ++++++++++------ t/porting/regen.t | 2 +- 5 files changed, 66 insertions(+), 50 deletions(-) create mode 100644 mg_names.c diff --git a/MANIFEST b/MANIFEST index d482674..5e042bc 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4125,6 +4125,7 @@ metaconfig.SH Control file for the metaconfig process META.yml Distribution meta-data in YAML mg.c Magic code mg.h Magic header +mg_names.c Generated magic names used by dump.c mg_raw.h Generated magic data used by generate_uudmap.c mg_vtable.h Generated magic vtable data minimod.pl Writes lib/ExtUtils/Miniperl.pm diff --git a/dump.c b/dump.c index 8165a7a..f9556c3 100644 --- a/dump.c +++ b/dump.c @@ -1233,49 +1233,7 @@ Perl_gv_dump(pTHX_ GV *gv) */ static const struct { const char type; const char *name; } magic_names[] = { - { PERL_MAGIC_sv, "sv(\\0)" }, - { PERL_MAGIC_arylen, "arylen(#)" }, - { PERL_MAGIC_rhash, "rhash(%)" }, - { PERL_MAGIC_pos, "pos(.)" }, - { PERL_MAGIC_symtab, "symtab(:)" }, - { PERL_MAGIC_backref, "backref(<)" }, - { PERL_MAGIC_arylen_p, "arylen_p(@)" }, - { PERL_MAGIC_overload, "overload(A)" }, - { PERL_MAGIC_bm, "bm(B)" }, - { PERL_MAGIC_regdata, "regdata(D)" }, - { PERL_MAGIC_env, "env(E)" }, - { PERL_MAGIC_hints, "hints(H)" }, - { PERL_MAGIC_isa, "isa(I)" }, - { PERL_MAGIC_dbfile, "dbfile(L)" }, - { PERL_MAGIC_shared, "shared(N)" }, - { PERL_MAGIC_tied, "tied(P)" }, - { PERL_MAGIC_sig, "sig(S)" }, - { PERL_MAGIC_uvar, "uvar(U)" }, - { PERL_MAGIC_checkcall, "checkcall(])" }, - { PERL_MAGIC_overload_elem, "overload_elem(a)" }, - { PERL_MAGIC_overload_table, "overload_table(c)" }, - { PERL_MAGIC_regdatum, "regdatum(d)" }, - { PERL_MAGIC_envelem, "envelem(e)" }, - { PERL_MAGIC_fm, "fm(f)" }, - { PERL_MAGIC_regex_global, "regex_global(g)" }, - { PERL_MAGIC_hintselem, "hintselem(h)" }, - { PERL_MAGIC_isaelem, "isaelem(i)" }, - { PERL_MAGIC_nkeys, "nkeys(k)" }, - { PERL_MAGIC_dbline, "dbline(l)" }, - { PERL_MAGIC_shared_scalar, "shared_scalar(n)" }, - { PERL_MAGIC_collxfrm, "collxfrm(o)" }, - { PERL_MAGIC_tiedelem, "tiedelem(p)" }, - { PERL_MAGIC_tiedscalar, "tiedscalar(q)" }, - { PERL_MAGIC_qr, "qr(r)" }, - { PERL_MAGIC_sigelem, "sigelem(s)" }, - { PERL_MAGIC_taint, "taint(t)" }, - { PERL_MAGIC_uvar_elem, "uvar_elem(u)" }, - { PERL_MAGIC_vec, "vec(v)" }, - { PERL_MAGIC_vstring, "vstring(V)" }, - { PERL_MAGIC_utf8, "utf8(w)" }, - { PERL_MAGIC_substr, "substr(x)" }, - { PERL_MAGIC_defelem, "defelem(y)" }, - { PERL_MAGIC_ext, "ext(~)" }, +#include "mg_names.c" /* this null string terminates the list */ { 0, NULL }, }; diff --git a/mg_names.c b/mg_names.c new file mode 100644 index 0000000..1287a00 --- /dev/null +++ b/mg_names.c @@ -0,0 +1,53 @@ +/* -*- buffer-read-only: t -*- + * + * mg_names.c + * !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + * This file is built by regen/mg_vtable.pl. + * Any changes made here will be lost! + */ + + { PERL_MAGIC_sv, "sv(\\0)" }, + { PERL_MAGIC_overload, "overload(A)" }, + { PERL_MAGIC_overload_elem, "overload_elem(a)" }, + { PERL_MAGIC_overload_table, "overload_table(c)" }, + { PERL_MAGIC_bm, "bm(B)" }, + { PERL_MAGIC_regdata, "regdata(D)" }, + { PERL_MAGIC_regdatum, "regdatum(d)" }, + { PERL_MAGIC_env, "env(E)" }, + { PERL_MAGIC_envelem, "envelem(e)" }, + { PERL_MAGIC_fm, "fm(f)" }, + { PERL_MAGIC_regex_global, "regex_global(g)" }, + { PERL_MAGIC_hints, "hints(H)" }, + { PERL_MAGIC_hintselem, "hintselem(h)" }, + { PERL_MAGIC_isa, "isa(I)" }, + { PERL_MAGIC_isaelem, "isaelem(i)" }, + { PERL_MAGIC_nkeys, "nkeys(k)" }, + { PERL_MAGIC_dbfile, "dbfile(L)" }, + { PERL_MAGIC_dbline, "dbline(l)" }, + { PERL_MAGIC_shared, "shared(N)" }, + { PERL_MAGIC_shared_scalar, "shared_scalar(n)" }, + { PERL_MAGIC_collxfrm, "collxfrm(o)" }, + { PERL_MAGIC_tied, "tied(P)" }, + { PERL_MAGIC_tiedelem, "tiedelem(p)" }, + { PERL_MAGIC_tiedscalar, "tiedscalar(q)" }, + { PERL_MAGIC_qr, "qr(r)" }, + { PERL_MAGIC_sig, "sig(S)" }, + { PERL_MAGIC_sigelem, "sigelem(s)" }, + { PERL_MAGIC_taint, "taint(t)" }, + { PERL_MAGIC_uvar, "uvar(U)" }, + { PERL_MAGIC_uvar_elem, "uvar_elem(u)" }, + { PERL_MAGIC_vec, "vec(v)" }, + { PERL_MAGIC_vstring, "vstring(V)" }, + { PERL_MAGIC_utf8, "utf8(w)" }, + { PERL_MAGIC_substr, "substr(x)" }, + { PERL_MAGIC_defelem, "defelem(y)" }, + { PERL_MAGIC_arylen, "arylen(#)" }, + { PERL_MAGIC_pos, "pos(.)" }, + { PERL_MAGIC_backref, "backref(<)" }, + { PERL_MAGIC_symtab, "symtab(:)" }, + { PERL_MAGIC_rhash, "rhash(%)" }, + { PERL_MAGIC_arylen_p, "arylen_p(@)" }, + { PERL_MAGIC_ext, "ext(~)" }, + { PERL_MAGIC_checkcall, "checkcall(])" }, + +/* ex: set ro: */ diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index c8b6852..dc3fb78 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -18,9 +18,6 @@ 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, @@ -144,10 +141,10 @@ my @sig = 'hints' => {clear => 'clearhints'}, ); -my ($vt, $raw) = map { +my ($vt, $raw, $names) = map { open_new($_, '>', { by => 'regen/mg_vtable.pl', file => $_, style => '*' }); -} 'mg_vtable.h', 'mg_raw.h'; +} 'mg_vtable.h', 'mg_raw.h', 'mg_names.c'; print $vt <<'EOH'; /* These constants should be used in preference to raw characters @@ -173,6 +170,8 @@ foreach (grep {!ref $_} @mg) { # predictable) { + my $longest_p1 = $longest + 1; + while (my ($name, $data) = splice @mg, 0, 2) { my $i = ord eval qq{"$data->{char}"}; unless ($data->{unknown_to_sv_magic}) { @@ -192,6 +191,11 @@ foreach (grep {!ref $_} @mg) { $comment =~ s/\n/\n$leader/s; printf $vt "#define PERL_MAGIC_%-${longest}s '%s' /* %s */\n", $name, $data->{char}, $comment; + + my $char = $data->{char}; + $char =~ s/([\\"])/\\$1/g; + printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n], + "$name,", $name, $char; } } @@ -283,4 +287,4 @@ print $vt "#define PL_vtbl_$_ PL_magic_vtables[want_vtbl_$_]\n" # 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; +read_only_bottom_close_and_rename($_) foreach $vt, $raw, $names; diff --git a/t/porting/regen.t b/t/porting/regen.t index b644d70..bbfb497 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -27,7 +27,7 @@ if ( $^O eq "VMS" ) { skip_all( "- regen.pl needs porting." ); } -my $in_regen_pl = 19; # I can't see a clean way to calculate this automatically. +my $in_regen_pl = 20; # I can't see a clean way to calculate this automatically. my @files = qw(perly.act perly.h perly.tab keywords.c keywords.h uconfig.h); my @progs = qw(Porting/makemeta regen/regcharclass.pl regen/mk_PL_charclass.pl); -- 2.7.4