From 14befaf4eaa6e79d87aacb106e0b701e925483ee Mon Sep 17 00:00:00 2001 From: Dave Mitchell Date: Sat, 19 May 2001 21:12:56 +0100 Subject: [PATCH] [LARGE!] symbolic magic Message-Id: <200105191912.UAA23925@gizmo.fdgroup.co.uk> p4raw-id: //depot/perl@10168 --- av.c | 35 ++++++++------ cc_runtime.h | 2 +- doop.c | 4 +- dump.c | 63 ++++++++++++++++++++++-- gv.c | 38 ++++++++------- hv.c | 48 ++++++++++--------- mg.c | 25 +++++----- op.c | 4 +- perl.c | 7 +-- perl.h | 48 ++++++++++++++++++- perlio.c | 4 +- pod/perlguts.pod | 144 ++++++++++++++++++++++++++++++------------------------- pp.c | 31 ++++++------ pp_ctl.c | 10 ++-- pp_hot.c | 25 +++++----- pp_sys.c | 40 +++++++++------- regexec.c | 15 +++--- scope.c | 7 +-- sv.c | 128 +++++++++++++++++++++++++++---------------------- t/lib/peek.t | 4 +- taint.c | 4 +- util.c | 10 ++-- xsutils.c | 2 +- 23 files changed, 427 insertions(+), 271 deletions(-) diff --git a/av.c b/av.c index 273fed9..086c75e 100644 --- a/av.c +++ b/av.c @@ -25,7 +25,7 @@ Perl_av_reify(pTHX_ AV *av) if (AvREAL(av)) return; #ifdef DEBUGGING - if (SvTIED_mg((SV*)av, 'P') && ckWARN_d(WARN_DEBUGGING)) + if (SvTIED_mg((SV*)av, PERL_MAGIC_tied) && ckWARN_d(WARN_DEBUGGING)) Perl_warner(aTHX_ WARN_DEBUGGING, "av_reify called on tied array"); #endif key = AvMAX(av) + 1; @@ -57,7 +57,7 @@ void Perl_av_extend(pTHX_ AV *av, I32 key) { MAGIC *mg; - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; ENTER; SAVETMPS; @@ -185,7 +185,9 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) } if (SvRMAGICAL(av)) { - if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { + if (mg_find((SV*)av, PERL_MAGIC_tied) || + mg_find((SV*)av, PERL_MAGIC_regdata)) + { sv = sv_newmortal(); mg_copy((SV*)av, sv, 0, key); PL_av_fetch_sv = sv; @@ -253,7 +255,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) Perl_croak(aTHX_ PL_no_modify); if (SvRMAGICAL(av)) { - if (mg_find((SV*)av,'P')) { + if (mg_find((SV*)av, PERL_MAGIC_tied)) { if (val != &PL_sv_undef) { mg_copy((SV*)av, val, 0, key); } @@ -438,7 +440,7 @@ Perl_av_undef(pTHX_ register AV *av) /*SUPPRESS 560*/ /* Give any tie a chance to cleanup first */ - if (SvTIED_mg((SV*)av, 'P')) + if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) av_fill(av, -1); /* mg_clear() ? */ if (AvREAL(av)) { @@ -474,7 +476,7 @@ Perl_av_push(pTHX_ register AV *av, SV *val) if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -510,7 +512,7 @@ Perl_av_pop(pTHX_ register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -556,7 +558,7 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -622,7 +624,7 @@ Perl_av_shift(pTHX_ register AV *av) return &PL_sv_undef; if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); @@ -680,7 +682,7 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill) Perl_croak(aTHX_ "panic: null array"); if (fill < 0) fill = -1; - if ((mg = SvTIED_mg((SV*)av, 'P'))) { + if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { dSP; ENTER; SAVETMPS; @@ -743,13 +745,14 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) } if (SvRMAGICAL(av)) { SV **svp; - if ((mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) + if ((mg_find((SV*)av, PERL_MAGIC_tied) || + mg_find((SV*)av, PERL_MAGIC_regdata)) && (svp = av_fetch(av, key, TRUE))) { sv = *svp; mg_clear(sv); - if (mg_find(sv, 'p')) { - sv_unmagic(sv, 'p'); /* No longer an element */ + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */ return sv; } return Nullsv; /* element cannot be deleted */ @@ -797,12 +800,14 @@ Perl_av_exists(pTHX_ AV *av, I32 key) return FALSE; } if (SvRMAGICAL(av)) { - if (mg_find((SV*)av,'P') || mg_find((SV*)av,'D')) { + if (mg_find((SV*)av, PERL_MAGIC_tied) || + mg_find((SV*)av, PERL_MAGIC_regdata)) + { SV *sv = sv_newmortal(); MAGIC *mg; mg_copy((SV*)av, sv, 0, key); - mg = mg_find(sv, 'p'); + mg = mg_find(sv, PERL_MAGIC_tiedelem); if (mg) { magic_existspack(sv, mg); return SvTRUE(sv); diff --git a/cc_runtime.h b/cc_runtime.h index dbc7475..799bf46 100644 --- a/cc_runtime.h +++ b/cc_runtime.h @@ -14,7 +14,7 @@ #define MAYBE_TAINT_SASSIGN_SRC(sv) \ if (PL_tainting && PL_tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) || \ - !((mg=mg_find(left, 't')) && mg->mg_len & 1)))\ + !((mg=mg_find(left, PERL_MAGIC_taint)) && mg->mg_len & 1)))\ TAINT_NOT #define PP_PREINC(sv) do { \ diff --git a/doop.c b/doop.c index 9550b3e..2b504a1 100644 --- a/doop.c +++ b/doop.c @@ -1291,7 +1291,7 @@ Perl_do_kv(pTHX) if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'k', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_nkeys, Nullch, 0); } LvTYPE(TARG) = 'k'; if (LvTARG(TARG) != (SV*)keys) { @@ -1303,7 +1303,7 @@ Perl_do_kv(pTHX) RETURN; } - if (! SvTIED_mg((SV*)keys, 'P')) + if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied)) i = HvKEYS(keys); else { i = 0; diff --git a/dump.c b/dump.c index 1b51b49..0e11589 100644 --- a/dump.c +++ b/dump.c @@ -706,6 +706,49 @@ Perl_gv_dump(pTHX_ GV *gv) Perl_dump_indent(aTHX_ 0, Perl_debug_log, "}\n"); } + +/* map magic types to the symbolic name + * (with the PERL_MAGIC_ prefixed stripped) + */ + +static struct { char type; char *name; } magic_names[] = { + PERL_MAGIC_sv, "sv(\\0)", + PERL_MAGIC_arylen, "arylen(#)", + PERL_MAGIC_glob, "glob(*)", + PERL_MAGIC_pos, "pos(.)", + PERL_MAGIC_backref, "backref(<)", + PERL_MAGIC_overload, "overload(A)", + PERL_MAGIC_bm, "bm(B)", + PERL_MAGIC_regdata, "regdata(D)", + PERL_MAGIC_env, "env(E)", + PERL_MAGIC_isa, "isa(I)", + PERL_MAGIC_dbfile, "dbfile(L)", + PERL_MAGIC_tied, "tied(P)", + PERL_MAGIC_sig, "sig(S)", + PERL_MAGIC_uvar, "uvar(U)", + 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_isaelem, "isaelem(i)", + PERL_MAGIC_nkeys, "nkeys(k)", + PERL_MAGIC_dbline, "dbline(l)", + PERL_MAGIC_mutex, "mutex(m)", + 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_vec, "vec(v)", + PERL_MAGIC_substr, "substr(x)", + PERL_MAGIC_defelem, "defelem(y)", + PERL_MAGIC_ext, "ext(~)", + 0, 0 /* this null string terminates the list */ +}; + void Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim) { @@ -753,10 +796,22 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, MAGIC *mg, I32 nest, I32 maxne if (mg->mg_private) Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private); - if (isPRINT(mg->mg_type)) - Perl_dump_indent(aTHX_ level, file, " MG_TYPE = '%c'\n", mg->mg_type); - else - Perl_dump_indent(aTHX_ level, file, " MG_TYPE = '\\%o'\n", mg->mg_type); + { + int n; + char *name = 0; + for (n=0; magic_names[n].name; n++) { + if (mg->mg_type == magic_names[n].type) { + name = magic_names[n].name; + break; + } + } + if (name) + Perl_dump_indent(aTHX_ level, file, + " MG_TYPE = PERL_MAGIC_%s\n", name); + else + Perl_dump_indent(aTHX_ level, file, + " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type); + } if (mg->mg_flags) { Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags); diff --git a/gv.c b/gv.c index 462002c..2f31585 100644 --- a/gv.c +++ b/gv.c @@ -80,7 +80,7 @@ Perl_gv_fetchfile(pTHX_ const char *name) gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); sv_setpv(GvSV(gv), name); if (PERLDB_LINE) - hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, 'L'); + hv_magic(GvHVn(gv_AVadd(gv)), Nullgv, PERL_MAGIC_dbfile); } if (tmpbuf != smallbuf) Safefree(tmpbuf); @@ -110,7 +110,7 @@ Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi) GvFILE(gv) = CopFILE(PL_curcop) ? CopFILE(PL_curcop) : ""; GvCVGEN(gv) = 0; GvEGV(gv) = gv; - sv_magic((SV*)gv, (SV*)gv, '*', Nullch, 0); + sv_magic((SV*)gv, (SV*)gv, PERL_MAGIC_glob, Nullch, 0); GvSTASH(gv) = (HV*)SvREFCNT_inc(stash); GvNAME(gv) = savepvn(name, len); GvNAMELEN(gv) = len; @@ -752,7 +752,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "ISA")) { AV* av = GvAVn(gv); GvMULTI_on(gv); - sv_magic((SV*)av, (SV*)gv, 'I', Nullch, 0); + sv_magic((SV*)av, (SV*)gv, PERL_MAGIC_isa, Nullch, 0); /* NOTE: No support for tied ISA */ if ((add & GV_ADDMULTI) && strEQ(nambeg,"AnyDBM_File::ISA") && AvFILLp(av) == -1) @@ -775,7 +775,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) if (strEQ(name, "OVERLOAD")) { HV* hv = GvHVn(gv); GvMULTI_on(gv); - hv_magic(hv, Nullgv, 'A'); + hv_magic(hv, Nullgv, PERL_MAGIC_overload); } break; case 'S': @@ -789,7 +789,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) } GvMULTI_on(gv); hv = GvHVn(gv); - hv_magic(hv, Nullgv, 'S'); + hv_magic(hv, Nullgv, PERL_MAGIC_sig); for (i = 1; i < SIG_SIZE; i++) { SV ** init; init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); @@ -848,7 +848,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) now (rather than going to magicalize) */ - sv_magic(GvSV(gv), (SV*)gv, 0, name, len); + sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); if (sv_type == SVt_PVHV) require_errno(gv); @@ -859,7 +859,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) break; else { AV* av = GvAVn(gv); - sv_magic((SV*)av, Nullsv, 'D', Nullch, 0); + sv_magic((SV*)av, Nullsv, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); } goto magicalize; @@ -917,7 +917,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) break; else { AV* av = GvAVn(gv); - sv_magic((SV*)av, (SV*)av, 'D', Nullch, 0); + sv_magic((SV*)av, (SV*)av, PERL_MAGIC_regdata, Nullch, 0); SvREADONLY_on(av); } /* FALL THROUGH */ @@ -933,7 +933,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) ro_magicalize: SvREADONLY_on(GvSV(gv)); magicalize: - sv_magic(GvSV(gv), (SV*)gv, 0, name, len); + sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, len); break; case '\014': /* $^L */ @@ -1218,7 +1218,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) { GV* gv; CV* cv; - MAGIC* mg=mg_find((SV*)stash,'c'); + MAGIC* mg=mg_find((SV*)stash, PERL_MAGIC_overload_table); AMT *amtp = (mg) ? (AMT*)mg->mg_ptr: (AMT *) NULL; AMT amt; STRLEN n_a; @@ -1226,7 +1226,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) if (mg && amtp->was_ok_am == PL_amagic_generation && amtp->was_ok_sub == PL_sub_generation) return AMT_OVERLOADED(amtp); - sv_unmagic((SV*)stash, 'c'); + sv_unmagic((SV*)stash, PERL_MAGIC_overload_table); DEBUG_o( Perl_deb(aTHX_ "Recalcing overload magic in package %s\n",HvNAME(stash)) ); @@ -1305,14 +1305,16 @@ Perl_Gv_AMupdate(pTHX_ HV *stash) AMT_AMAGIC_on(&amt); if (have_ovl) AMT_OVERLOADED_on(&amt); - sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMT)); + sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table, + (char*)&amt, sizeof(AMT)); return have_ovl; } } /* Here we have no table: */ /* no_table: */ AMT_AMAGIC_off(&amt); - sv_magic((SV*)stash, 0, 'c', (char*)&amt, sizeof(AMTS)); + sv_magic((SV*)stash, 0, PERL_MAGIC_overload_table, + (char*)&amt, sizeof(AMTS)); return FALSE; } @@ -1325,11 +1327,11 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) if (!stash) return Nullcv; - mg = mg_find((SV*)stash,'c'); + mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); if (!mg) { do_update: Gv_AMupdate(stash); - mg = mg_find((SV*)stash,'c'); + mg = mg_find((SV*)stash, PERL_MAGIC_overload_table); } amtp = (AMT*)mg->mg_ptr; if ( amtp->was_ok_am != PL_amagic_generation @@ -1352,7 +1354,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) int postpr = 0, force_cpy = 0, assignshift = assign ? 1 : 0; HV* stash; if (!(AMGf_noleft & flags) && SvAMAGIC(left) - && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))),'c')) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(left))), + PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) @@ -1465,7 +1468,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } if (!cv) goto not_found; } else if (!(AMGf_noright & flags) && SvAMAGIC(right) - && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))),'c')) + && (mg = mg_find((SV*)(stash=SvSTASH(SvRV(right))), + PERL_MAGIC_overload_table)) && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) ? (amtp = (AMT*)mg->mg_ptr)->table : (CV **) NULL)) diff --git a/hv.c b/hv.c index 5df4dd8..7058116 100644 --- a/hv.c +++ b/hv.c @@ -163,14 +163,14 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen, I32 lval) } if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); PL_hv_fetch_sv = sv; return &PL_hv_fetch_sv; } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { U32 i; for (i = 0; i < klen; ++i) if (isLOWER(key[i])) { @@ -283,7 +283,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) return 0; if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -297,7 +297,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) return &PL_hv_fetch_ent_mh; } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { U32 i; key = SvPV(keysv, klen); for (i = 0; i < klen; ++i) @@ -379,8 +379,8 @@ S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store) if (isUPPER(mg->mg_type)) { *needs_copy = TRUE; switch (mg->mg_type) { - case 'P': - case 'S': + case PERL_MAGIC_tied: + case PERL_MAGIC_sig: *needs_store = FALSE; } } @@ -434,7 +434,7 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen, SV *val, register U32 has if (!xhv->xhv_array && !needs_store) return 0; #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = savepvn(key,klen); key = strupr(key); hash = 0; @@ -545,7 +545,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash) if (!xhv->xhv_array && !needs_store) return Nullhe; #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = SvPV(keysv, klen); keysv = sv_2mortal(newSVpvn(key,klen)); (void)strupr(SvPVX(keysv)); @@ -647,14 +647,15 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) sv = *svp; mg_clear(sv); if (!needs_store) { - if (mg_find(sv, 'p')) { - sv_unmagic(sv, 'p'); /* No longer an element */ + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + /* No longer an element */ + sv_unmagic(sv, PERL_MAGIC_tiedelem); return sv; } return Nullsv; /* element cannot be deleted */ } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { sv = sv_2mortal(newSVpvn(key,klen)); key = strupr(SvPVX(sv)); } @@ -744,14 +745,15 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) sv = HeVAL(entry); mg_clear(sv); if (!needs_store) { - if (mg_find(sv, 'p')) { - sv_unmagic(sv, 'p'); /* No longer an element */ + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + /* No longer an element */ + sv_unmagic(sv, PERL_MAGIC_tiedelem); return sv; } return Nullsv; /* element cannot be deleted */ } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = SvPV(keysv, klen); keysv = sv_2mortal(newSVpvn(key,klen)); (void)strupr(SvPVX(keysv)); @@ -836,14 +838,14 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) } if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { sv = sv_newmortal(); mg_copy((SV*)hv, sv, key, klen); - magic_existspack(sv, mg_find(sv, 'p')); + magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem)); return SvTRUE(sv); } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { sv = sv_2mortal(newSVpvn(key,klen)); key = strupr(SvPVX(sv)); } @@ -926,16 +928,16 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) return 0; if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv,'P') || SvGMAGICAL((SV*)hv)) { + if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { SV* svret = sv_newmortal(); sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); - magic_existspack(svret, mg_find(sv, 'p')); + magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem)); return SvTRUE(svret); } #ifdef ENV_IS_CASELESS - else if (mg_find((SV*)hv,'E')) { + else if (mg_find((SV*)hv, PERL_MAGIC_env)) { key = SvPV(keysv, klen); keysv = sv_2mortal(newSVpvn(key,klen)); (void)strupr(SvPVX(keysv)); @@ -1175,7 +1177,7 @@ Perl_newHVhv(pTHX_ HV *ohv) return hv; #if 0 - if (! SvTIED_mg((SV*)ohv, 'P')) { + if (! SvTIED_mg((SV*)ohv, PERL_MAGIC_tied)) { /* Quick way ???*/ } else @@ -1381,7 +1383,7 @@ Perl_hv_iternext(pTHX_ HV *hv) xhv = (XPVHV*)SvANY(hv); oldentry = entry = xhv->xhv_eiter; - if ((mg = SvTIED_mg((SV*)hv, 'P'))) { + if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) { SV *key = sv_newmortal(); if (entry) { sv_setsv(key, HeSVKEY_force(entry)); @@ -1497,7 +1499,7 @@ SV * Perl_hv_iterval(pTHX_ HV *hv, register HE *entry) { if (SvRMAGICAL(hv)) { - if (mg_find((SV*)hv,'P')) { + if (mg_find((SV*)hv, PERL_MAGIC_tied)) { SV* sv = sv_newmortal(); if (HeKLEN(entry) == HEf_SVKEY) mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY); diff --git a/mg.c b/mg.c index de687c4..b68a52e 100644 --- a/mg.c +++ b/mg.c @@ -286,8 +286,9 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { if (isUPPER(mg->mg_type)) { sv_magic(nsv, - mg->mg_type == 'P' ? SvTIED_obj(sv, mg) : - (mg->mg_type == 'D' && mg->mg_obj) ? sv : mg->mg_obj, + mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) : + (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj) + ? sv : mg->mg_obj, toLOWER(mg->mg_type), key, klen); count++; } @@ -313,7 +314,7 @@ Perl_mg_free(pTHX_ SV *sv) moremagic = mg->mg_moremagic; if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); - if (mg->mg_ptr && mg->mg_type != 'g') { + if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { if (mg->mg_len >= 0) Safefree(mg->mg_ptr); else if (mg->mg_len == HEf_SVKEY) @@ -1130,7 +1131,7 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) if (hv) { (void) hv_iterinit(hv); - if (! SvTIED_mg((SV*)hv, 'P')) + if (! SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) i = HvKEYS(hv); else { /*SUPPRESS 560*/ @@ -1169,7 +1170,7 @@ S_magic_methcall(pTHX_ SV *sv, MAGIC *mg, char *meth, I32 flags, int n, SV *val) else if (mg->mg_len == HEf_SVKEY) PUSHs((SV*)mg->mg_ptr); } - else if (mg->mg_type == 'p') { + else if (mg->mg_type == PERL_MAGIC_tiedelem) { PUSHs(sv_2mortal(newSViv(mg->mg_len))); } } @@ -1332,7 +1333,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) SV* lsv = LvTARG(sv); if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) { - mg = mg_find(lsv, 'g'); + mg = mg_find(lsv, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { I32 i = mg->mg_len; if (DO_UTF8(lsv)) @@ -1356,12 +1357,12 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) mg = 0; if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) - mg = mg_find(lsv, 'g'); + mg = mg_find(lsv, PERL_MAGIC_regex_global); if (!mg) { if (!SvOK(sv)) return 0; - sv_magic(lsv, (SV*)0, 'g', Nullch, 0); - mg = mg_find(lsv, 'g'); + sv_magic(lsv, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0); + mg = mg_find(lsv, PERL_MAGIC_regex_global); } else if (!SvOK(sv)) { mg->mg_len = -1; @@ -1581,7 +1582,7 @@ Perl_vivify_defelem(pTHX_ SV *sv) MAGIC *mg; SV *value = Nullsv; - if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y'))) + if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem))) return; if (mg->mg_obj) { SV *ahv = LvTARG(sv); @@ -1650,7 +1651,7 @@ Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg) { - sv_unmagic(sv, 'B'); + sv_unmagic(sv, PERL_MAGIC_bm); SvVALID_off(sv); return 0; } @@ -1658,7 +1659,7 @@ Perl_magic_setbm(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_setfm(pTHX_ SV *sv, MAGIC *mg) { - sv_unmagic(sv, 'f'); + sv_unmagic(sv, PERL_MAGIC_fm); SvCOMPILED_off(sv); return 0; } diff --git a/op.c b/op.c index 5a51f9b..61f4850 100644 --- a/op.c +++ b/op.c @@ -643,7 +643,7 @@ Perl_find_threadsv(pTHX_ const char *name) break; case ';': sv_setpv(sv, "\034"); - sv_magic(sv, 0, 0, name, 1); + sv_magic(sv, 0, PERL_MAGIC_sv, name, 1); break; case '&': case '`': @@ -667,7 +667,7 @@ Perl_find_threadsv(pTHX_ const char *name) /* case '!': */ default: - sv_magic(sv, 0, 0, name, 1); + sv_magic(sv, 0, PERL_MAGIC_sv, name, 1); } DEBUG_S(PerlIO_printf(Perl_error_log, "find_threadsv: new SV %p for $%s%c\n", diff --git a/perl.c b/perl.c index 64aa4c9..2e39794 100644 --- a/perl.c +++ b/perl.c @@ -788,7 +788,8 @@ perl_destruct(pTHXx) MAGIC* moremagic; for (mg = SvMAGIC(PL_mess_sv); mg; mg = moremagic) { moremagic = mg->mg_moremagic; - if (mg->mg_ptr && mg->mg_type != 'g' && mg->mg_len >= 0) + if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global + && mg->mg_len >= 0) Safefree(mg->mg_ptr); Safefree(mg); } @@ -2013,7 +2014,7 @@ Perl_magicname(pTHX_ char *sym, char *name, I32 namlen) register GV *gv; if ((gv = gv_fetchpv(sym,TRUE, SVt_PV))) - sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen); + sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen); } STATIC void @@ -3377,7 +3378,7 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register HV *hv; GvMULTI_on(PL_envgv); hv = GvHVn(PL_envgv); - hv_magic(hv, Nullgv, 'E'); + hv_magic(hv, Nullgv, PERL_MAGIC_env); #ifdef USE_ENVIRON_ARRAY /* Note that if the supplied env parameter is actually a copy of the global environ then it may now point to free'd memory diff --git a/perl.h b/perl.h index 9f135b1..f14f897 100644 --- a/perl.h +++ b/perl.h @@ -2300,6 +2300,52 @@ Gid_t getegid (void); #endif /* DEBUGGING */ +/* These constants should be used in preference to 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_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 %_ might have been included somehow */ @@ -2317,7 +2363,7 @@ struct ufuncs { IV uf_index; }; -/* In pre-5.7-Perls the 'U' magic didn't get the thread context. +/* In pre-5.7-Perls the PERL_MAGIC_uvar magic didn't get the thread context. * XS code wanting to be backward compatible can do something * like the following: diff --git a/perlio.c b/perlio.c index ba932f3..bf628b2 100644 --- a/perlio.c +++ b/perlio.c @@ -451,9 +451,9 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) MAGIC *mg; int count = 0; int i; - sv_magic(sv, (SV *)av, '~', NULL, 0); + sv_magic(sv, (SV *)av, PERL_MAGIC_ext, NULL, 0); SvRMAGICAL_off(sv); - mg = mg_find(sv,'~'); + mg = mg_find(sv, PERL_MAGIC_ext); mg->mg_virtual = &perlio_vtab; mg_magical(sv); Perl_warn(aTHX_ "attrib %"SVf,sv); diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 3b10af9..4a06489 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -810,13 +810,17 @@ copy of the name is stored in C field. The sv_magic function uses C to determine which, if any, predefined "Magic Virtual Table" should be assigned to the C field. See the "Magic Virtual Table" section below. The C argument is also -stored in the C field. +stored in the C field. The value of C should be chosen +from the set of macros C found perl.h. Note that before +these macros were added, perl internals used to directly use character +literals, so you may occasionally come across old code or documentation +referrring to 'U' magic rather than C for example. The C argument is stored in the C field of the C structure. If it is not the same as the C argument, the reference count of the C object is incremented. If it is the same, or if -the C argument is "#", or if it is a NULL pointer, then C is -merely stored, without the reference count being incremented. +the C argument is C", or if it is a NULL pointer, +then C is merely stored, without the reference count being incremented. There is also a function to add magic to an C: @@ -860,67 +864,76 @@ actions depending on which function is being called. svt_free Free any extra storage associated with the SV. For instance, the MGVTBL structure called C (which corresponds -to an C of '\0') contains: +to an C of C) contains: { magic_get, magic_set, magic_len, 0, 0 } -Thus, when an SV is determined to be magical and of type '\0', if a get -operation is being performed, the routine C is called. All -the various routines for the various magical types begin with C. -NOTE: the magic routines are not considered part of the Perl API, and may -not be exported by the Perl library. +Thus, when an SV is determined to be magical and of type C, +if a get operation is being performed, the routine C is +called. All the various routines for the various magical types begin +with C. NOTE: the magic routines are not considered part of +the Perl API, and may not be exported by the Perl library. The current kinds of Magic Virtual Tables are: - mg_type MGVTBL Type of magic - ------- ------ ---------------------------- - \0 vtbl_sv Special scalar variable - A vtbl_amagic %OVERLOAD hash - a vtbl_amagicelem %OVERLOAD hash element - c (none) Holds overload table (AMT) on stash - B vtbl_bm Boyer-Moore (fast string search) - D vtbl_regdata Regex match position data (@+ and @- vars) - d vtbl_regdatum Regex match position data element - E vtbl_env %ENV hash - e vtbl_envelem %ENV hash element - f vtbl_fm Formline ('compiled' format) - g vtbl_mglob m//g target / study()ed string - I vtbl_isa @ISA array - i vtbl_isaelem @ISA array element - k vtbl_nkeys scalar(keys()) lvalue - L (none) Debugger %_'s +that composite type. Some internals code makes use of this case +relationship. + +The C and C magic types are defined +specifically for use by extensions and will not be used by perl itself. +Extensions can use C magic to 'attach' private information +to variables (typically objects). This is especially useful because +there is no way for normal perl code to corrupt this private information +(unlike using extra elements of a hash object). + +Similarly, C magic can be used much like tie() to call a +C function any time a scalar's value is used or changed. The C's C field points to a C structure: struct ufuncs { @@ -930,8 +943,8 @@ C field points to a C structure: }; When the SV is read from or written to, the C or C -function will be called with C as the first arg and a -pointer to the SV as the second. A simple example of how to add 'U' +function will be called with C as the first arg and a pointer to +the SV as the second. A simple example of how to add C magic is shown below. Note that the ufuncs structure is copied by sv_magic, so you can safely allocate it on the stack. @@ -944,14 +957,14 @@ sv_magic, so you can safely allocate it on the stack. uf.uf_val = &my_get_fn; uf.uf_set = &my_set_fn; uf.uf_index = 0; - sv_magic(sv, 0, 'U', (char*)&uf, sizeof(uf)); + sv_magic(sv, 0, PERL_MAGIC_uvar, (char*)&uf, sizeof(uf)); -Note that because multiple extensions may be using '~' or 'U' magic, -it is important for extensions to take extra care to avoid conflict. -Typically only using the magic on objects blessed into the same class -as the extension is sufficient. For '~' magic, it may also be -appropriate to add an I32 'signature' at the top of the private data -area and check that. +Note that because multiple extensions may be using C +or C magic, it is important for extensions to take +extra care to avoid conflict. Typically only using the magic on +objects blessed into the same class as the extension is sufficient. +For C magic, it may also be appropriate to add an I32 +'signature' at the top of the private data area and check that. Also note that the C and C functions described earlier do B invoke 'set' magic on their targets. This must @@ -981,7 +994,8 @@ the mg_type field is changed to be the lowercase letter. =head2 Understanding the Magic of Tied Hashes and Arrays -Tied hashes and arrays are magical beasts of the 'P' magic type. +Tied hashes and arrays are magical beasts of the C +magic type. WARNING: As of the 5.004 release, proper usage of the array and hash access functions requires understanding a few caveats. Some @@ -1012,7 +1026,7 @@ to do this. tie = newRV_noinc((SV*)newHV()); stash = gv_stashpv("MyTie", TRUE); sv_bless(tie, stash); - hv_magic(hash, tie, 'P'); + hv_magic(hash, tie, PERL_MAGIC_tied); RETVAL = newRV_noinc(hash); OUTPUT: RETVAL diff --git a/pp.c b/pp.c index d68b689..c265e95 100644 --- a/pp.c +++ b/pp.c @@ -341,7 +341,7 @@ PP(pp_av2arylen) if (!sv) { AvARYLEN(av) = sv = NEWSV(0,0); sv_upgrade(sv, SVt_IV); - sv_magic(sv, (SV*)av, '#', Nullch, 0); + sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); } SETs(sv); RETURN; @@ -354,7 +354,7 @@ PP(pp_pos) if (PL_op->op_flags & OPf_MOD || LVRET) { if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, '.', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0); } LvTYPE(TARG) = '.'; @@ -370,7 +370,7 @@ PP(pp_pos) MAGIC* mg; if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - mg = mg_find(sv, 'g'); + mg = mg_find(sv, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { I32 i = mg->mg_len; if (DO_UTF8(sv)) @@ -715,7 +715,8 @@ PP(pp_study) } SvSCREAM_on(sv); - sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */ + /* piggyback on m//g magic */ + sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0); RETPUSHYES; } @@ -783,11 +784,13 @@ PP(pp_defined) RETPUSHNO; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) + || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) RETPUSHYES; break; case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P'))) + if (HvARRAY(sv) || SvGMAGICAL(sv) + || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) RETPUSHYES; break; case SVt_PVCV: @@ -2809,7 +2812,7 @@ PP(pp_substr) tmps += pos; sv_setpvn(TARG, tmps, rem); #ifdef USE_LOCALE_COLLATE - sv_unmagic(TARG, 'o'); + sv_unmagic(TARG, PERL_MAGIC_collxfrm); #endif if (utf8_curlen) SvUTF8_on(TARG); @@ -2845,7 +2848,7 @@ PP(pp_substr) if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'x', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0); } LvTYPE(TARG) = 'x'; @@ -2875,7 +2878,7 @@ PP(pp_vec) if (lvalue) { /* it's an lvalue! */ if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); - sv_magic(TARG, Nullsv, 'v', Nullch, 0); + sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0); } LvTYPE(TARG) = 'v'; if (LvTARG(TARG) != src) { @@ -3710,7 +3713,7 @@ PP(pp_splice) SV **tmparyval = 0; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -3904,7 +3907,7 @@ PP(pp_push) register SV *sv = &PL_sv_undef; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -3960,7 +3963,7 @@ PP(pp_unshift) register I32 i = 0; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { *MARK-- = SvTIED_obj((SV*)ary, mg); PUSHMARK(MARK); PUTBACK; @@ -5843,7 +5846,7 @@ PP(pp_split) av_extend(ary,0); av_clear(ary); SPAGAIN; - if ((mg = SvTIED_mg((SV*)ary, 'P'))) { + if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)ary, mg)); } @@ -6090,7 +6093,7 @@ PP(pp_split) void Perl_unlock_condpair(pTHX_ void *svv) { - MAGIC *mg = mg_find((SV*)svv, 'm'); + MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex); if (!mg) Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex"); diff --git a/pp_ctl.c b/pp_ctl.c index 166d1da..8e12e2b 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -91,7 +91,7 @@ PP(pp_regcomp) if (SvROK(tmpstr)) { SV *sv = SvRV(tmpstr); if(SvMAGICAL(sv)) - mg = mg_find(sv, 'r'); + mg = mg_find(sv, PERL_MAGIC_qr); } if (mg) { regexp *re = (regexp *)mg->mg_obj; @@ -227,9 +227,9 @@ PP(pp_substcont) I32 i; if (SvTYPE(sv) < SVt_PVMG) (void)SvUPGRADE(sv, SVt_PVMG); - if (!(mg = mg_find(sv, 'g'))) { - sv_magic(sv, Nullsv, 'g', Nullch, 0); - mg = mg_find(sv, 'g'); + if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) { + sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0); + mg = mg_find(sv, PERL_MAGIC_regex_global); } i = m - orig; if (DO_UTF8(sv)) @@ -3779,7 +3779,7 @@ S_doparseform(pTHX_ SV *sv) } Copy(fops, s, arg, U16); Safefree(fops); - sv_magic(sv, Nullsv, 'f', Nullch, 0); + sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0); SvCOMPILED_on(sv); } diff --git a/pp_hot.c b/pp_hot.c index 9e484fc..1c0c417 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -553,7 +553,7 @@ PP(pp_print) gv = (GV*)*++MARK; else gv = PL_defoutgv; - if ((mg = SvTIED_mg((SV*)gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { had_magic: if (MARK == ORIGMARK) { /* If using default handle then we need to make space to @@ -577,7 +577,8 @@ PP(pp_print) RETURN; } if (!(io = GvIO(gv))) { - if ((GvEGV(gv)) && (mg = SvTIED_mg((SV*)GvEGV(gv),'q'))) + if ((GvEGV(gv)) + && (mg = SvTIED_mg((SV*)GvEGV(gv), PERL_MAGIC_tiedscalar))) goto had_magic; if (ckWARN2(WARN_UNOPENED,WARN_CLOSED)) report_evil_fh(gv, io, PL_op->op_type); @@ -1184,7 +1185,7 @@ PP(pp_qr) register PMOP *pm = cPMOP; SV *rv = sv_newmortal(); SV *sv = newSVrv(rv, "Regexp"); - sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp),'r',0,0); + sv_magic(sv,(SV*)ReREFCNT_inc(pm->op_pmregexp), PERL_MAGIC_qr,0,0); RETURNX(PUSHs(rv)); } @@ -1242,7 +1243,7 @@ PP(pp_match) if ((global = pm->op_pmflags & PMf_GLOBAL)) { rx->startp[0] = -1; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { - MAGIC* mg = mg_find(TARG, 'g'); + MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg && mg->mg_len >= 0) { if (!(rx->reganch & ROPT_GPOS_SEEN)) rx->endp[0] = rx->startp[0] = mg->mg_len; @@ -1342,10 +1343,10 @@ play_it_again: if (global) { MAGIC* mg = 0; if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) - mg = mg_find(TARG, 'g'); + mg = mg_find(TARG, PERL_MAGIC_regex_global); if (!mg) { - sv_magic(TARG, (SV*)0, 'g', Nullch, 0); - mg = mg_find(TARG, 'g'); + sv_magic(TARG, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0); + mg = mg_find(TARG, PERL_MAGIC_regex_global); } if (rx->startp[0] != -1) { mg->mg_len = rx->endp[0]; @@ -1404,7 +1405,7 @@ nope: ret_no: if (global && !(pm->op_pmflags & PMf_CONTINUE)) { if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) { - MAGIC* mg = mg_find(TARG, 'g'); + MAGIC* mg = mg_find(TARG, PERL_MAGIC_regex_global); if (mg) mg->mg_len = -1; } @@ -1428,7 +1429,7 @@ Perl_do_readline(pTHX) I32 gimme = GIMME_V; MAGIC *mg; - if ((mg = SvTIED_mg((SV*)PL_last_in_gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)PL_last_in_gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)PL_last_in_gv, mg)); PUTBACK; @@ -1649,7 +1650,7 @@ PP(pp_helem) lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, key2 = newSVsv(keysv), 'y', Nullch, 0); + sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, Nullch, 0); SvREFCNT_dec(key2); /* sv_magic() increments refcount */ LvTARG(lv) = SvREFCNT_inc(hv); LvTARGLEN(lv) = 1; @@ -1838,7 +1839,7 @@ PP(pp_iter) lv = cx->blk_loop.iterlval = NEWSV(26, 0); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, Nullsv, 'y', Nullch, 0); + sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0); } LvTARG(lv) = SvREFCNT_inc(av); LvTARGOFF(lv) = cx->blk_loop.iterix; @@ -2899,7 +2900,7 @@ PP(pp_aelem) lv = sv_newmortal(); sv_upgrade(lv, SVt_PVLV); LvTYPE(lv) = 'y'; - sv_magic(lv, Nullsv, 'y', Nullch, 0); + sv_magic(lv, Nullsv, PERL_MAGIC_defelem, Nullch, 0); LvTARG(lv) = SvREFCNT_inc(av); LvTARGOFF(lv) = elem; LvTARGLEN(lv) = 1; diff --git a/pp_sys.c b/pp_sys.c index 826a588..ed59638 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -510,7 +510,7 @@ PP(pp_open) if (GvIOp(gv)) IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; - if ((mg = SvTIED_mg((SV*)gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { /* Method's args are same as ours ... */ /* ... except handle is replaced by the object */ *MARK-- = SvTIED_obj((SV*)gv, mg); @@ -553,7 +553,7 @@ PP(pp_close) else gv = (GV*)POPs; - if ((mg = SvTIED_mg((SV*)gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); PUTBACK; @@ -635,7 +635,7 @@ PP(pp_fileno) RETPUSHUNDEF; gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); PUTBACK; @@ -703,7 +703,7 @@ PP(pp_binmode) gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); if (discp) @@ -744,7 +744,7 @@ PP(pp_tie) SV *sv; I32 markoff = MARK - PL_stack_base; char *methname; - int how = 'P'; + int how = PERL_MAGIC_tied; U32 items; STRLEN n_a; @@ -763,11 +763,11 @@ PP(pp_tie) } #endif methname = "TIEHANDLE"; - how = 'q'; + how = PERL_MAGIC_tiedscalar; break; default: methname = "TIESCALAR"; - how = 'q'; + how = PERL_MAGIC_tiedscalar; break; } items = SP - MARK++; @@ -823,7 +823,8 @@ PP(pp_untie) { dSP; SV *sv = POPs; - char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q'; + char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; MAGIC * mg ; if ((mg = SvTIED_mg(sv, how))) { @@ -856,7 +857,8 @@ PP(pp_tied) { dSP; SV *sv = POPs; - char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q'; + char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) + ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; MAGIC *mg; if ((mg = SvTIED_mg(sv, how))) { @@ -919,8 +921,8 @@ PP(pp_dbmopen) } if (sv_isobject(TOPs)) { - sv_unmagic((SV *) hv, 'P'); - sv_magic((SV*)hv, TOPs, 'P', Nullch, 0); + sv_unmagic((SV *) hv, PERL_MAGIC_tied); + sv_magic((SV*)hv, TOPs, PERL_MAGIC_tied, Nullch, 0); } LEAVE; RETURN; @@ -1127,7 +1129,7 @@ PP(pp_getc) else gv = (GV*)POPs; - if ((mg = SvTIED_mg((SV*)gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { I32 gimme = GIMME_V; PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); @@ -1384,7 +1386,7 @@ PP(pp_prtf) else gv = PL_defoutgv; - if ((mg = SvTIED_mg((SV*)gv, 'q'))) { + if ((mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { if (MARK == ORIGMARK) { MEXTEND(SP, 1); ++MARK; @@ -1503,7 +1505,7 @@ PP(pp_sysread) gv = (GV*)*++MARK; if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) && - (mg = SvTIED_mg((SV*)gv, 'q'))) + (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { SV *sv; @@ -1729,7 +1731,9 @@ PP(pp_send) MAGIC *mg; gv = (GV*)*++MARK; - if (PL_op->op_type == OP_SYSWRITE && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (PL_op->op_type == OP_SYSWRITE + && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) + { SV *sv; PUSHMARK(MARK-1); @@ -1874,7 +1878,7 @@ PP(pp_eof) else gv = PL_last_in_gv = (GV*)POPs; /* eof(FH) */ - if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); PUTBACK; @@ -1900,7 +1904,7 @@ PP(pp_tell) else gv = PL_last_in_gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); PUTBACK; @@ -1938,7 +1942,7 @@ PP(pp_sysseek) gv = PL_last_in_gv = (GV*)POPs; - if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) { + if (gv && (mg = SvTIED_mg((SV*)gv, PERL_MAGIC_tiedscalar))) { PUSHMARK(SP); XPUSHs(SvTIED_obj((SV*)gv, mg)); #if LSEEKSIZE > IVSIZE diff --git a/regexec.c b/regexec.c index d60e7c7..9ba61d7 100644 --- a/regexec.c +++ b/regexec.c @@ -1474,7 +1474,8 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * PL_reg_ganch = startpos; else if (sv && SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) - && (mg = mg_find(sv, 'g')) && mg->mg_len >= 0) { + && (mg = mg_find(sv, PERL_MAGIC_regex_global)) + && mg->mg_len >= 0) { PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */ if (prog->reganch & ROPT_ANCH_GPOS) { if (s > PL_reg_ganch) @@ -1825,10 +1826,11 @@ S_regtry(pTHX_ regexp *prog, char *startpos) } if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv) - && (mg = mg_find(PL_reg_sv, 'g')))) { + && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) { /* prepare for quick setting of pos */ - sv_magic(PL_reg_sv, (SV*)0, 'g', Nullch, 0); - mg = mg_find(PL_reg_sv, 'g'); + sv_magic(PL_reg_sv, (SV*)0, + PERL_MAGIC_regex_global, Nullch, 0); + mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global); mg->mg_len = -1; } PL_reg_magic = mg; @@ -2502,7 +2504,7 @@ S_regmatch(pTHX_ regnode *prog) SV *sv = SvROK(ret) ? SvRV(ret) : ret; if(SvMAGICAL(sv)) - mg = mg_find(sv, 'r'); + mg = mg_find(sv, PERL_MAGIC_qr); } if (mg) { re = (regexp *)mg->mg_obj; @@ -2520,7 +2522,8 @@ S_regmatch(pTHX_ regnode *prog) re = CALLREGCOMP(aTHX_ t, t + len, &pm); if (!(SvFLAGS(ret) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY))) - sv_magic(ret,(SV*)ReREFCNT_inc(re),'r',0,0); + sv_magic(ret,(SV*)ReREFCNT_inc(re), + PERL_MAGIC_qr,0,0); PL_regprecomp = oprecomp; PL_regsize = osize; PL_regnpar = onpar; diff --git a/scope.c b/scope.c index 31c6f01..d9e1ecf 100644 --- a/scope.c +++ b/scope.c @@ -197,7 +197,8 @@ S_save_scalar_at(pTHX_ SV **sptr) MAGIC* mg; bool oldtainted = PL_tainted; mg_get(osv); /* note, can croak! */ - if (PL_tainting && PL_tainted && (mg = mg_find(osv, 't'))) { + if (PL_tainting && PL_tainted && + (mg = mg_find(osv, PERL_MAGIC_taint))) { SAVESPTR(mg->mg_obj); mg->mg_obj = osv; } @@ -901,7 +902,7 @@ Perl_leave_scope(pTHX_ I32 base) if (ptr) { sv = *(SV**)ptr; if (sv && sv != &PL_sv_undef) { - if (SvTIED_mg((SV*)av, 'P')) + if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) (void)SvREFCNT_inc(sv); SvREFCNT_dec(av); goto restore_sv; @@ -919,7 +920,7 @@ Perl_leave_scope(pTHX_ I32 base) SV *oval = HeVAL((HE*)ptr); if (oval && oval != &PL_sv_undef) { ptr = &HeVAL((HE*)ptr); - if (SvTIED_mg((SV*)hv, 'P')) + if (SvTIED_mg((SV*)hv, PERL_MAGIC_tied)) (void)SvREFCNT_inc(*(SV**)ptr); SvREFCNT_dec(hv); SvREFCNT_dec(sv); diff --git a/sv.c b/sv.c index 65a3279..a448938 100644 --- a/sv.c +++ b/sv.c @@ -2699,7 +2699,7 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG)) == (SVs_OBJECT|SVs_RMG)) && strEQ(s=HvNAME(SvSTASH(sv)), "Regexp") - && (mg = mg_find(sv, 'r'))) { + && (mg = mg_find(sv, PERL_MAGIC_qr))) { regexp *re = (regexp *)mg->mg_obj; if (!mg->mg_ptr) { @@ -3270,7 +3270,7 @@ Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) char *name = GvNAME(sstr); STRLEN len = GvNAMELEN(sstr); sv_upgrade(dstr, SVt_PVGV); - sv_magic(dstr, dstr, '*', Nullch, 0); + sv_magic(dstr, dstr, PERL_MAGIC_glob, Nullch, 0); GvSTASH(dstr) = (HV*)SvREFCNT_inc(GvSTASH(sstr)); GvNAME(dstr) = savepvn(name, len); GvNAMELEN(dstr) = len; @@ -3995,12 +3995,23 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam MAGIC* mg; if (SvREADONLY(sv)) { - if (PL_curcop != &PL_compiling && !strchr("gBf", how)) + if (PL_curcop != &PL_compiling + /* XXX this used to be !strchr("gBf", how), which seems to + * implicity be equal to !strchr("gBf\0", how), ie \0 matches + * too. I find this suprising, but have hadded PERL_MAGIC_sv + * to the list of things to check - DAPM 19-May-01 */ + && how != PERL_MAGIC_regex_global + && how != PERL_MAGIC_bm + && how != PERL_MAGIC_fm + && how != PERL_MAGIC_sv + ) + { Perl_croak(aTHX_ PL_no_modify); + } } - if (SvMAGICAL(sv) || (how == 't' && SvTYPE(sv) >= SVt_PVMG)) { + if (SvMAGICAL(sv) || (how == PERL_MAGIC_taint && SvTYPE(sv) >= SVt_PVMG)) { if (SvMAGIC(sv) && (mg = mg_find(sv, how))) { - if (how == 't') + if (how == PERL_MAGIC_taint) mg->mg_len |= 1; return; } @@ -4016,7 +4027,9 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam each other. To prevent a avoid a reference loop that would prevent such objects being freed, we look for such loops and if we find one we avoid incrementing the object refcount. */ - if (!obj || obj == sv || how == '#' || how == 'r' || + if (!obj || obj == sv || + how == PERL_MAGIC_arylen || + how == PERL_MAGIC_qr || (SvTYPE(obj) == SVt_PVGV && (GvSV(obj) == sv || GvHV(obj) == (HV*)sv || GvAV(obj) == (AV*)sv || GvCV(obj) == (CV*)sv || GvIOp(obj) == (IO*)sv || @@ -4038,117 +4051,118 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam } switch (how) { - case 0: + case PERL_MAGIC_sv: mg->mg_virtual = &PL_vtbl_sv; break; - case 'A': + case PERL_MAGIC_overload: mg->mg_virtual = &PL_vtbl_amagic; break; - case 'a': + case PERL_MAGIC_overload_elem: mg->mg_virtual = &PL_vtbl_amagicelem; break; - case 'c': + case PERL_MAGIC_overload_table: mg->mg_virtual = &PL_vtbl_ovrld; break; - case 'B': + case PERL_MAGIC_bm: mg->mg_virtual = &PL_vtbl_bm; break; - case 'D': + case PERL_MAGIC_regdata: mg->mg_virtual = &PL_vtbl_regdata; break; - case 'd': + case PERL_MAGIC_regdatum: mg->mg_virtual = &PL_vtbl_regdatum; break; - case 'E': + case PERL_MAGIC_env: mg->mg_virtual = &PL_vtbl_env; break; - case 'f': + case PERL_MAGIC_fm: mg->mg_virtual = &PL_vtbl_fm; break; - case 'e': + case PERL_MAGIC_envelem: mg->mg_virtual = &PL_vtbl_envelem; break; - case 'g': + case PERL_MAGIC_regex_global: mg->mg_virtual = &PL_vtbl_mglob; break; - case 'I': + case PERL_MAGIC_isa: mg->mg_virtual = &PL_vtbl_isa; break; - case 'i': + case PERL_MAGIC_isaelem: mg->mg_virtual = &PL_vtbl_isaelem; break; - case 'k': + case PERL_MAGIC_nkeys: mg->mg_virtual = &PL_vtbl_nkeys; break; - case 'L': + case PERL_MAGIC_dbfile: SvRMAGICAL_on(sv); mg->mg_virtual = 0; break; - case 'l': + case PERL_MAGIC_dbline: mg->mg_virtual = &PL_vtbl_dbline; break; #ifdef USE_THREADS - case 'm': + case PERL_MAGIC_mutex: mg->mg_virtual = &PL_vtbl_mutex; break; #endif /* USE_THREADS */ #ifdef USE_LOCALE_COLLATE - case 'o': + case PERL_MAGIC_collxfrm: mg->mg_virtual = &PL_vtbl_collxfrm; break; #endif /* USE_LOCALE_COLLATE */ - case 'P': + case PERL_MAGIC_tied: mg->mg_virtual = &PL_vtbl_pack; break; - case 'p': - case 'q': + case PERL_MAGIC_tiedelem: + case PERL_MAGIC_tiedscalar: mg->mg_virtual = &PL_vtbl_packelem; break; - case 'r': + case PERL_MAGIC_qr: mg->mg_virtual = &PL_vtbl_regexp; break; - case 'S': + case PERL_MAGIC_sig: mg->mg_virtual = &PL_vtbl_sig; break; - case 's': + case PERL_MAGIC_sigelem: mg->mg_virtual = &PL_vtbl_sigelem; break; - case 't': + case PERL_MAGIC_taint: mg->mg_virtual = &PL_vtbl_taint; mg->mg_len = 1; break; - case 'U': + case PERL_MAGIC_uvar: mg->mg_virtual = &PL_vtbl_uvar; break; - case 'v': + case PERL_MAGIC_vec: mg->mg_virtual = &PL_vtbl_vec; break; - case 'x': + case PERL_MAGIC_substr: mg->mg_virtual = &PL_vtbl_substr; break; - case 'y': + case PERL_MAGIC_defelem: mg->mg_virtual = &PL_vtbl_defelem; break; - case '*': + case PERL_MAGIC_glob: mg->mg_virtual = &PL_vtbl_glob; break; - case '#': + case PERL_MAGIC_arylen: mg->mg_virtual = &PL_vtbl_arylen; break; - case '.': + case PERL_MAGIC_pos: mg->mg_virtual = &PL_vtbl_pos; break; - case '<': + case PERL_MAGIC_backref: mg->mg_virtual = &PL_vtbl_backref; break; - case '~': /* Reserved for use by extensions not perl internals. */ + case PERL_MAGIC_ext: + /* Reserved for use by extensions not perl internals. */ /* Useful for attaching extension internal data to perl vars. */ /* Note that multiple extensions may clash if magical scalars */ /* etc holding private data from one are passed to another. */ SvRMAGICAL_on(sv); break; default: - Perl_croak(aTHX_ "Don't know how to handle magic of type '%c'", how); + Perl_croak(aTHX_ "Don't know how to handle magic of type \\%o", how); } mg_magical(sv); if (SvGMAGICAL(sv)) @@ -4177,7 +4191,7 @@ Perl_sv_unmagic(pTHX_ SV *sv, int type) *mgp = mg->mg_moremagic; if (vtbl && vtbl->svt_free) CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); - if (mg->mg_ptr && mg->mg_type != 'g') { + if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { if (mg->mg_len >= 0) Safefree(mg->mg_ptr); else if (mg->mg_len == HEf_SVKEY) @@ -4231,11 +4245,11 @@ S_sv_add_backref(pTHX_ SV *tsv, SV *sv) { AV *av; MAGIC *mg; - if (SvMAGICAL(tsv) && (mg = mg_find(tsv, '<'))) + if (SvMAGICAL(tsv) && (mg = mg_find(tsv, PERL_MAGIC_backref))) av = (AV*)mg->mg_obj; else { av = newAV(); - sv_magic(tsv, (SV*)av, '<', NULL, 0); + sv_magic(tsv, (SV*)av, PERL_MAGIC_backref, NULL, 0); SvREFCNT_dec(av); /* for sv_magic */ } av_push(av,sv); @@ -4249,7 +4263,7 @@ S_sv_del_backref(pTHX_ SV *sv) I32 i; SV *tsv = SvRV(sv); MAGIC *mg; - if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, '<'))) + if (!SvMAGICAL(tsv) || !(mg = mg_find(tsv, PERL_MAGIC_backref))) Perl_croak(aTHX_ "panic: del_backref"); av = (AV *)mg->mg_obj; svp = AvARRAY(av); @@ -4954,7 +4968,7 @@ Perl_sv_cmp_locale(pTHX_ register SV *sv1, register SV *sv2) #ifdef USE_LOCALE_COLLATE /* - * Any scalar variable may carry an 'o' magic that contains the + * Any scalar variable may carry PERL_MAGIC_collxfrm magic that contains the * scalar data of the variable transformed to such a format that * a normal memory comparison can be used to compare the data * according to the locale settings. @@ -4964,7 +4978,7 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp) { MAGIC *mg; - mg = SvMAGICAL(sv) ? mg_find(sv, 'o') : (MAGIC *) NULL; + mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_collxfrm) : (MAGIC *) NULL; if (!mg || !mg->mg_ptr || *(U32*)mg->mg_ptr != PL_collation_ix) { char *s, *xf; STRLEN len, xlen; @@ -4979,8 +4993,8 @@ Perl_sv_collxfrm(pTHX_ SV *sv, STRLEN *nxp) return xf + sizeof(PL_collation_ix); } if (! mg) { - sv_magic(sv, 0, 'o', 0, 0); - mg = mg_find(sv, 'o'); + sv_magic(sv, 0, PERL_MAGIC_collxfrm, 0, 0); + mg = mg_find(sv, PERL_MAGIC_collxfrm); assert(mg); } mg->mg_ptr = xf; @@ -6544,7 +6558,7 @@ S_sv_unglob(pTHX_ SV *sv) SvREFCNT_dec(GvSTASH(sv)); GvSTASH(sv) = Nullhv; } - sv_unmagic(sv, '*'); + sv_unmagic(sv, PERL_MAGIC_glob); Safefree(GvNAME(sv)); GvMULTI_off(sv); @@ -6611,14 +6625,14 @@ Perl_sv_unref(pTHX_ SV *sv) void Perl_sv_taint(pTHX_ SV *sv) { - sv_magic((sv), Nullsv, 't', Nullch, 0); + sv_magic((sv), Nullsv, PERL_MAGIC_taint, Nullch, 0); } void Perl_sv_untaint(pTHX_ SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - MAGIC *mg = mg_find(sv, 't'); + MAGIC *mg = mg_find(sv, PERL_MAGIC_taint); if (mg) mg->mg_len &= ~1; } @@ -6628,7 +6642,7 @@ bool Perl_sv_tainted(pTHX_ SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - MAGIC *mg = mg_find(sv, 't'); + MAGIC *mg = mg_find(sv, PERL_MAGIC_taint); if (mg && ((mg->mg_len & 1) || ((mg->mg_len & 2) && mg->mg_obj == sv))) return TRUE; } @@ -7705,7 +7719,7 @@ Perl_mg_dup(pTHX_ MAGIC *mg) nmg->mg_private = mg->mg_private; nmg->mg_type = mg->mg_type; nmg->mg_flags = mg->mg_flags; - if (mg->mg_type == 'r') { + if (mg->mg_type == PERL_MAGIC_qr) { nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj); } else { @@ -7715,10 +7729,12 @@ Perl_mg_dup(pTHX_ MAGIC *mg) } nmg->mg_len = mg->mg_len; nmg->mg_ptr = mg->mg_ptr; /* XXX random ptr? */ - if (mg->mg_ptr && mg->mg_type != 'g') { + if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) { if (mg->mg_len >= 0) { nmg->mg_ptr = SAVEPVN(mg->mg_ptr, mg->mg_len); - if (mg->mg_type == 'c' && AMT_AMAGIC((AMT*)mg->mg_ptr)) { + if (mg->mg_type == PERL_MAGIC_overload_table && + AMT_AMAGIC((AMT*)mg->mg_ptr)) + { AMT *amtp = (AMT*)mg->mg_ptr; AMT *namtp = (AMT*)nmg->mg_ptr; I32 i; diff --git a/t/lib/peek.t b/t/lib/peek.t index 96e24a2..c14dc9b 100644 --- a/t/lib/peek.t +++ b/t/lib/peek.t @@ -251,7 +251,7 @@ do_test(15, PV = 0 MAGIC = $ADDR MG_VIRTUAL = $ADDR - MG_TYPE = \'r\' + MG_TYPE = PERL_MAGIC_qr\(r\) MG_OBJ = $ADDR STASH = $ADDR\\t"Regexp"'); @@ -283,7 +283,7 @@ do_test(17, NV = 0 MAGIC = $ADDR MG_VIRTUAL = &PL_vtbl_glob - MG_TYPE = \'\\*\' + MG_TYPE = PERL_MAGIC_glob\(\*\) MG_OBJ = $ADDR NAME = "a" NAMELEN = 1 diff --git a/taint.c b/taint.c index 7a8baac..ab0b697 100644 --- a/taint.c +++ b/taint.c @@ -66,7 +66,7 @@ Perl_taint_env(pTHX) TAINT; taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); } @@ -81,7 +81,7 @@ Perl_taint_env(pTHX) TAINT; taint_proper("Insecure %s%s", "$ENV{PATH}"); } - if ((mg = mg_find(*svp, 'e')) && MgTAINTEDDIR(mg)) { + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { TAINT; taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); } diff --git a/util.c b/util.c index 12c5f0d..f91c86a 100644 --- a/util.c +++ b/util.c @@ -1033,7 +1033,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) s--, i++; } } - sv_magic(sv, Nullsv, 'B', Nullch, 0); /* deep magic */ + sv_magic(sv, Nullsv, PERL_MAGIC_bm, Nullch, 0); /* deep magic */ SvVALID_on(sv); s = (unsigned char*)(SvPVX(sv)); /* deeper magic */ @@ -3597,7 +3597,7 @@ Perl_condpair_magic(pTHX_ SV *sv) MAGIC *mg; SvUPGRADE(sv, SVt_PVMG); - mg = mg_find(sv, 'm'); + mg = mg_find(sv, PERL_MAGIC_mutex); if (!mg) { condpair_t *cp; @@ -3607,7 +3607,7 @@ Perl_condpair_magic(pTHX_ SV *sv) COND_INIT(&cp->cond); cp->owner = 0; LOCK_CRED_MUTEX; /* XXX need separate mutex? */ - mg = mg_find(sv, 'm'); + mg = mg_find(sv, PERL_MAGIC_mutex); if (mg) { /* someone else beat us to initialising it */ UNLOCK_CRED_MUTEX; /* XXX need separate mutex? */ @@ -3617,7 +3617,7 @@ Perl_condpair_magic(pTHX_ SV *sv) Safefree(cp); } else { - sv_magic(sv, Nullsv, 'm', 0, 0); + sv_magic(sv, Nullsv, PERL_MAGIC_mutex, 0, 0); mg = SvMAGIC(sv); mg->mg_ptr = (char *)cp; mg->mg_len = sizeof(cp); @@ -3761,7 +3761,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) if (*svp && *svp != &PL_sv_undef) { SV *sv = newSVsv(*svp); av_store(thr->threadsv, i, sv); - sv_magic(sv, 0, 0, &PL_threadsv_names[i], 1); + sv_magic(sv, 0, PERL_MAGIC_sv, &PL_threadsv_names[i], 1); DEBUG_S(PerlIO_printf(Perl_debug_log, "new_struct_thread: copied threadsv %"IVdf" %p->%p\n", (IV)i, t, thr)); diff --git a/xsutils.c b/xsutils.c index 187d9f7..3493565 100644 --- a/xsutils.c +++ b/xsutils.c @@ -235,7 +235,7 @@ usage: stash = CvSTASH(sv); break; case SVt_PVMG: - if (!(SvFAKE(sv) && SvTIED_mg(sv, '*'))) + if (!(SvFAKE(sv) && SvTIED_mg(sv, PERL_MAGIC_glob))) break; /*FALLTHROUGH*/ case SVt_PVGV: -- 2.7.4