diff options
| -rw-r--r-- | mg_names.c | 18 | ||||
| -rw-r--r-- | mg_raw.h | 36 | ||||
| -rw-r--r-- | mg_vtable.h | 146 | ||||
| -rw-r--r-- | regen/mg_vtable.pl | 25 |
4 files changed, 117 insertions, 108 deletions
diff --git a/mg_names.c b/mg_names.c index 1287a00212..ff73b9e38e 100644 --- a/mg_names.c +++ b/mg_names.c @@ -7,10 +7,16 @@ */ { 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_overload_elem, "overload_elem(a)" }, - { PERL_MAGIC_overload_table, "overload_table(c)" }, { PERL_MAGIC_bm, "bm(B)" }, + { PERL_MAGIC_overload_table, "overload_table(c)" }, { PERL_MAGIC_regdata, "regdata(D)" }, { PERL_MAGIC_regdatum, "regdatum(d)" }, { PERL_MAGIC_env, "env(E)" }, @@ -36,18 +42,12 @@ { 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_vec, "vec(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(])" }, + { PERL_MAGIC_ext, "ext(~)" }, /* ex: set ro: */ @@ -8,14 +8,26 @@ { '\0', "want_vtbl_sv | PERL_MAGIC_READONLY_ACCEPTABLE", "/* sv '\\0' Special scalar variable */" }, + { '#', "want_vtbl_arylen | PERL_MAGIC_VALUE_MAGIC", + "/* arylen '#' Array length ($#ary) */" }, + { '%', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", + "/* rhash '%' extra data for restricted hashes */" }, + { '.', "want_vtbl_pos | PERL_MAGIC_VALUE_MAGIC", + "/* pos '.' pos() lvalue */" }, + { ':', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", + "/* symtab ':' extra data for symbol tables */" }, + { '<', "want_vtbl_backref | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", + "/* backref '<' for weak ref data */" }, + { '@', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", + "/* arylen_p '@' to move arylen out of XPVAV */" }, { 'A', "want_vtbl_amagic", "/* overload 'A' %OVERLOAD hash */" }, { 'a', "want_vtbl_amagicelem", "/* overload_elem 'a' %OVERLOAD hash element */" }, - { 'c', "want_vtbl_ovrld", - "/* overload_table 'c' Holds overload table (AMT) on stash */" }, { 'B', "want_vtbl_regexp | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", "/* bm 'B' Boyer-Moore (fast string search) */" }, + { 'c', "want_vtbl_ovrld", + "/* overload_table 'c' Holds overload table (AMT) on stash */" }, { 'D', "want_vtbl_regdata", "/* regdata 'D' Regex match position data (@+ and @- vars) */" }, { 'd', "want_vtbl_regdatum", @@ -60,31 +72,19 @@ "/* taint 't' Taintedness */" }, { 'U', "want_vtbl_uvar", "/* uvar 'U' Available for use by extensions */" }, - { 'v', "want_vtbl_vec | PERL_MAGIC_VALUE_MAGIC", - "/* vec 'v' vec() lvalue */" }, { 'V', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", "/* vstring 'V' SV was vstring literal */" }, + { 'v', "want_vtbl_vec | PERL_MAGIC_VALUE_MAGIC", + "/* vec 'v' vec() lvalue */" }, { 'w', "want_vtbl_utf8 | PERL_MAGIC_VALUE_MAGIC", "/* utf8 'w' Cached UTF-8 information */" }, { 'x', "want_vtbl_substr | PERL_MAGIC_VALUE_MAGIC", "/* substr 'x' substr() lvalue */" }, { 'y', "want_vtbl_defelem | PERL_MAGIC_VALUE_MAGIC", "/* defelem 'y' Shadow \"foreach\" iterator variable / smart parameter vivification */" }, - { '#', "want_vtbl_arylen | PERL_MAGIC_VALUE_MAGIC", - "/* arylen '#' Array length ($#ary) */" }, - { '.', "want_vtbl_pos | PERL_MAGIC_VALUE_MAGIC", - "/* pos '.' pos() lvalue */" }, - { '<', "want_vtbl_backref | PERL_MAGIC_READONLY_ACCEPTABLE | PERL_MAGIC_VALUE_MAGIC", - "/* backref '<' for weak ref data */" }, - { ':', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", - "/* symtab ':' extra data for symbol tables */" }, - { '%', "magic_vtable_max | PERL_MAGIC_VALUE_MAGIC", - "/* rhash '%' extra data for restricted hashes */" }, - { '@', "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 | PERL_MAGIC_VALUE_MAGIC", "/* checkcall ']' inlining/mutation of call to this CV */" }, + { '~', "magic_vtable_max", + "/* ext '~' Available for use by extensions */" }, /* ex: set ro: */ diff --git a/mg_vtable.h b/mg_vtable.h index 45ee1ae389..8846262ebe 100644 --- a/mg_vtable.h +++ b/mg_vtable.h @@ -13,10 +13,16 @@ */ #define PERL_MAGIC_sv '\0' /* Special scalar variable */ +#define PERL_MAGIC_arylen '#' /* Array length ($#ary) */ +#define PERL_MAGIC_rhash '%' /* extra data for restricted hashes */ +#define PERL_MAGIC_pos '.' /* pos() lvalue */ +#define PERL_MAGIC_symtab ':' /* extra data for symbol tables */ +#define PERL_MAGIC_backref '<' /* for weak ref data */ +#define PERL_MAGIC_arylen_p '@' /* to move arylen out of XPVAV */ #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_overload_table 'c' /* Holds overload table (AMT) on stash */ #define PERL_MAGIC_regdata 'D' /* Regex match position data (@+ and @- vars) */ #define PERL_MAGIC_regdatum 'd' /* Regex match position data element */ @@ -43,87 +49,81 @@ #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_vec 'v' /* vec() lvalue */ #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 */ +#define PERL_MAGIC_ext '~' /* Available for use by extensions */ enum { /* pass one of these to get_vtbl */ - want_vtbl_sv, + want_vtbl_amagic, + want_vtbl_amagicelem, + want_vtbl_arylen, + want_vtbl_arylen_p, + want_vtbl_backref, + want_vtbl_collxfrm, + want_vtbl_dbline, + want_vtbl_defelem, want_vtbl_env, want_vtbl_envelem, - want_vtbl_sigelem, - want_vtbl_pack, - want_vtbl_packelem, - want_vtbl_dbline, + want_vtbl_hints, + want_vtbl_hintselem, want_vtbl_isa, want_vtbl_isaelem, - want_vtbl_arylen, - want_vtbl_arylen_p, want_vtbl_mglob, want_vtbl_nkeys, - want_vtbl_taint, - want_vtbl_substr, - want_vtbl_vec, + want_vtbl_ovrld, + want_vtbl_pack, + want_vtbl_packelem, want_vtbl_pos, - want_vtbl_uvar, - want_vtbl_defelem, - want_vtbl_regexp, want_vtbl_regdata, want_vtbl_regdatum, - want_vtbl_amagic, - want_vtbl_amagicelem, - want_vtbl_backref, - want_vtbl_ovrld, + want_vtbl_regexp, + want_vtbl_sigelem, + want_vtbl_substr, + want_vtbl_sv, + want_vtbl_taint, want_vtbl_utf8, - want_vtbl_collxfrm, - want_vtbl_hintselem, - want_vtbl_hints, + want_vtbl_uvar, + want_vtbl_vec, magic_vtable_max }; #ifdef DOINIT EXTCONST char *PL_magic_vtable_names[magic_vtable_max] = { - "sv", + "amagic", + "amagicelem", + "arylen", + "arylen_p", + "backref", + "collxfrm", + "dbline", + "defelem", "env", "envelem", - "sigelem", - "pack", - "packelem", - "dbline", + "hints", + "hintselem", "isa", "isaelem", - "arylen", - "arylen_p", "mglob", "nkeys", - "taint", - "substr", - "vec", + "ovrld", + "pack", + "packelem", "pos", - "uvar", - "defelem", - "regexp", "regdata", "regdatum", - "amagic", - "amagicelem", - "backref", - "ovrld", + "regexp", + "sigelem", + "substr", + "sv", + "taint", "utf8", - "collxfrm", - "hintselem", - "hints" + "uvar", + "vec" }; #else EXTCONST char *PL_magic_vtable_names[magic_vtable_max]; @@ -148,44 +148,44 @@ EXTCONST char *PL_magic_vtable_names[magic_vtable_max]; #ifdef DOINIT EXT_MGVTBL PL_magic_vtables[magic_vtable_max] = { - { Perl_magic_get, Perl_magic_set, Perl_magic_len, 0, 0, 0, 0, 0 }, - { 0, Perl_magic_set_all_env, 0, Perl_magic_clear_all_env, 0, 0, 0, 0 }, - { 0, Perl_magic_setenv, 0, Perl_magic_clearenv, 0, 0, 0, 0 }, -#ifndef PERL_MICRO - { Perl_magic_getsig, Perl_magic_setsig, 0, Perl_magic_clearsig, 0, 0, 0, 0 }, + { 0, Perl_magic_setamagic, 0, 0, Perl_magic_setamagic, 0, 0, 0 }, + { 0, Perl_magic_setamagic, 0, 0, Perl_magic_setamagic, 0, 0, 0 }, + { (int (*)(pTHX_ SV *, MAGIC *))Perl_magic_getarylen, Perl_magic_setarylen, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, Perl_magic_freearylen_p, 0, 0, 0 }, + { 0, 0, 0, 0, Perl_magic_killbackrefs, 0, 0, 0 }, +#ifdef USE_LOCALE_COLLATE + { 0, Perl_magic_setcollxfrm, 0, 0, 0, 0, 0, 0 }, #else { 0, 0, 0, 0, 0, 0, 0, 0 }, #endif - { 0, 0, Perl_magic_sizepack, Perl_magic_wipepack, 0, 0, 0, 0 }, - { Perl_magic_getpack, Perl_magic_setpack, 0, Perl_magic_clearpack, 0, 0, 0, 0 }, { 0, Perl_magic_setdbline, 0, 0, 0, 0, 0, 0 }, + { Perl_magic_getdefelem, Perl_magic_setdefelem, 0, 0, 0, 0, 0, 0 }, + { 0, Perl_magic_set_all_env, 0, Perl_magic_clear_all_env, 0, 0, 0, 0 }, + { 0, Perl_magic_setenv, 0, Perl_magic_clearenv, 0, 0, 0, 0 }, + { 0, 0, 0, Perl_magic_clearhints, 0, 0, 0, 0 }, + { 0, Perl_magic_sethint, 0, Perl_magic_clearhint, 0, 0, 0, 0 }, { 0, Perl_magic_setisa, 0, Perl_magic_clearisa, 0, 0, 0, 0 }, { 0, Perl_magic_setisa, 0, 0, 0, 0, 0, 0 }, - { (int (*)(pTHX_ SV *, MAGIC *))Perl_magic_getarylen, Perl_magic_setarylen, 0, 0, 0, 0, 0, 0 }, - { 0, 0, 0, 0, Perl_magic_freearylen_p, 0, 0, 0 }, { 0, Perl_magic_setmglob, 0, 0, 0, 0, 0, 0 }, { Perl_magic_getnkeys, Perl_magic_setnkeys, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_getsubstr, Perl_magic_setsubstr, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 }, + { 0, 0, Perl_magic_sizepack, Perl_magic_wipepack, 0, 0, 0, 0 }, + { Perl_magic_getpack, Perl_magic_setpack, 0, Perl_magic_clearpack, 0, 0, 0, 0 }, { Perl_magic_getpos, Perl_magic_setpos, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 }, - { Perl_magic_getdefelem, Perl_magic_setdefelem, 0, 0, 0, 0, 0, 0 }, - { 0, Perl_magic_setregexp, 0, 0, 0, 0, 0, 0 }, { 0, 0, Perl_magic_regdata_cnt, 0, 0, 0, 0, 0 }, { Perl_magic_regdatum_get, Perl_magic_regdatum_set, 0, 0, 0, 0, 0, 0 }, - { 0, Perl_magic_setamagic, 0, 0, Perl_magic_setamagic, 0, 0, 0 }, - { 0, Perl_magic_setamagic, 0, 0, Perl_magic_setamagic, 0, 0, 0 }, - { 0, 0, 0, 0, Perl_magic_killbackrefs, 0, 0, 0 }, - { 0, 0, 0, 0, Perl_magic_freeovrld, 0, 0, 0 }, - { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 }, -#ifdef USE_LOCALE_COLLATE - { 0, Perl_magic_setcollxfrm, 0, 0, 0, 0, 0, 0 }, + { 0, Perl_magic_setregexp, 0, 0, 0, 0, 0, 0 }, +#ifndef PERL_MICRO + { Perl_magic_getsig, Perl_magic_setsig, 0, Perl_magic_clearsig, 0, 0, 0, 0 }, #else { 0, 0, 0, 0, 0, 0, 0, 0 }, #endif - { 0, Perl_magic_sethint, 0, Perl_magic_clearhint, 0, 0, 0, 0 }, - { 0, 0, 0, Perl_magic_clearhints, 0, 0, 0, 0 } + { Perl_magic_getsubstr, Perl_magic_setsubstr, 0, 0, 0, 0, 0, 0 }, + { Perl_magic_get, Perl_magic_set, Perl_magic_len, 0, 0, 0, 0, 0 }, + { Perl_magic_gettaint, Perl_magic_settaint, 0, 0, 0, 0, 0, 0 }, + { 0, Perl_magic_setutf8, 0, 0, 0, 0, 0, 0 }, + { Perl_magic_getuvar, Perl_magic_setuvar, 0, 0, 0, 0, 0, 0 }, + { Perl_magic_getvec, Perl_magic_setvec, 0, 0, 0, 0, 0, 0 } }; #else EXT_MGVTBL PL_magic_vtables[magic_vtable_max]; diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index dc3fb78331..3d242116a9 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -18,7 +18,7 @@ BEGIN { require 'regen/regen_lib.pl'; } -my @mg = +my %mg = ( sv => { char => '\0', vtable => 'sv', readonly_acceptable => 1, desc => 'Special scalar variable' }, @@ -105,7 +105,7 @@ my @mg = ); # These have a subtly different "namespace" from the magic types. -my @sig = +my %sig = ( 'sv' => {get => 'get', set => 'set', len => 'len'}, 'env' => {set => 'set_all_env', clear => 'clear_all_env'}, @@ -156,7 +156,7 @@ print $vt <<'EOH'; EOH my $longest = 0; -foreach (grep {!ref $_} @mg) { +foreach (keys %mg) { $longest = length $_ if length $_ > $longest; } @@ -172,8 +172,16 @@ foreach (grep {!ref $_} @mg) { { my $longest_p1 = $longest + 1; - while (my ($name, $data) = splice @mg, 0, 2) { - my $i = ord eval qq{"$data->{char}"}; + my %mg_order; + while (my ($name, $data) = each %mg) { + my $byte = eval qq{"$data->{char}"}; + $data->{byte} = $byte; + $mg_order{(uc $byte) . $byte} = $name; + } + foreach (sort keys %mg_order) { + my $name = $mg_order{$_}; + my $data = $mg{$name}; + my $i = ord $data->{byte}; unless ($data->{unknown_to_sv_magic}) { my $value = $data->{vtable} ? "want_vtbl_$data->{vtable}" : 'magic_vtable_max'; @@ -199,8 +207,8 @@ foreach (grep {!ref $_} @mg) { } } +my @names = sort keys %sig; { - my @names = grep {!ref $_} @sig; my $want = join ",\n ", (map {"want_vtbl_$_"} @names), 'magic_vtable_max'; my $names = join qq{",\n "}, @names; @@ -246,7 +254,8 @@ EOH my @vtable_names; my @aliases; -while (my ($name, $data) = splice @sig, 0, 2) { +while (my $name = shift @names) { + my $data = $sig{$name}; push @vtable_names, $name; my @funcs = map { $data->{$_} ? "Perl_magic_$data->{$_}" : 0; @@ -256,7 +265,7 @@ while (my ($name, $data) = splice @sig, 0, 2) { my $funcs = join ", ", @funcs; # Because we can't have a , after the last {...} - my $comma = @sig ? ',' : ''; + my $comma = @names ? ',' : ''; print $vt "$data->{cond}\n" if $data->{cond}; print $vt " { $funcs }$comma\n"; |