From: Nicholas Clark Date: Sun, 29 May 2005 19:35:38 +0000 (+0000) Subject: Goodbye xav_arylen. You won't be missed that much. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3874608cd3bf4e33ccd66b8bb03b2aeda20af14;p=p5sagit%2Fp5-mst-13.2.git Goodbye xav_arylen. You won't be missed that much. So now there's a buy 5 get one free offer on PVAV bodies. p4raw-id: //depot/perl@24619 --- diff --git a/av.c b/av.c index 12b2ee3..7201893 100644 --- a/av.c +++ b/av.c @@ -936,6 +936,23 @@ Perl_av_exists(pTHX_ AV *av, I32 key) return FALSE; } +SV ** +Perl_av_arylen_p(pTHX_ AV *av) { + dVAR; + MAGIC *mg = mg_find((SV*)av, PERL_MAGIC_arylen_p); + + if (!mg) { + mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, 0, 0, 0); + + if (!mg) { + Perl_die(aTHX_ "panic: av_arylen_p"); + } + /* sv_magicext won't set this for us because we pass in a NULL obj */ + mg->mg_flags |= MGf_REFCOUNTED; + } + return &(mg->mg_obj); +} + /* * Local variables: * c-indentation-style: bsd diff --git a/av.h b/av.h index f8dffc9..9ed171d 100644 --- a/av.h +++ b/av.h @@ -19,7 +19,6 @@ struct xpvav { } xiv_u; MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ - SV* xav_arylen; }; #if !defined(PERL_EXPERIMENTAL_LAYOUT) @@ -35,7 +34,6 @@ typedef struct { } xiv_u; MAGIC* xmg_magic; /* magic for scalar array */ HV* xmg_stash; /* class package */ - SV* xav_arylen; } xpvav_allocated; #endif @@ -81,7 +79,7 @@ Same as C. Deprecated, use C instead. #define AvALLOC(av) (*((SV***)&((XPVAV*) SvANY(av))->xav_alloc)) #define AvMAX(av) ((XPVAV*) SvANY(av))->xav_max #define AvFILLp(av) ((XPVAV*) SvANY(av))->xav_fill -#define AvARYLEN(av) (*((SV**)&((XPVAV*) SvANY(av))->xav_arylen)) +#define AvARYLEN(av) (*Perl_av_arylen_p(aTHX_ (AV*)av)) #define AvREAL(av) (SvFLAGS(av) & SVpav_REAL) #define AvREAL_on(av) (SvFLAGS(av) |= SVpav_REAL) diff --git a/dump.c b/dump.c index c820687..caf2f8c 100644 --- a/dump.c +++ b/dump.c @@ -895,6 +895,7 @@ static const struct { const char type; const char *name; } magic_names[] = { { 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)" }, @@ -1349,7 +1350,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PerlIO_putc(file, '\n'); Perl_dump_indent(aTHX_ level, file, " FILL = %"IVdf"\n", (IV)AvFILLp(sv)); Perl_dump_indent(aTHX_ level, file, " MAX = %"IVdf"\n", (IV)AvMAX(sv)); - Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", PTR2UV(AvARYLEN(sv))); + Perl_dump_indent(aTHX_ level, file, " ARYLEN = 0x%"UVxf"\n", SvMAGIC(sv) ? PTR2UV(AvARYLEN(sv)) : 0); sv_setpvn(d, "", 0); if (AvREAL(sv)) sv_catpv(d, ",REAL"); if (AvREIFY(sv)) sv_catpv(d, ",REIFY"); diff --git a/embed.fnc b/embed.fnc index 625e5e1..56232cd 100644 --- a/embed.fnc +++ b/embed.fnc @@ -106,6 +106,7 @@ ApdR |SV* |av_shift |AV* ar Apd |SV** |av_store |AV* ar|I32 key|SV* val Apd |void |av_undef |AV* ar Apd |void |av_unshift |AV* ar|I32 num +Apo |SV** |av_arylen_p |AV* av pR |OP* |bind_match |I32 type|NN OP* left|NN OP* pat pR |OP* |block_end |I32 floor|OP* seq ApR |I32 |block_gimme diff --git a/global.sym b/global.sym index 903eb77..dcff9d8 100644 --- a/global.sym +++ b/global.sym @@ -49,6 +49,7 @@ Perl_av_shift Perl_av_store Perl_av_undef Perl_av_unshift +Perl_av_arylen_p Perl_block_gimme Perl_call_list Perl_cast_ulong diff --git a/perl.h b/perl.h index 7688d96..3c17674 100644 --- a/perl.h +++ b/perl.h @@ -3185,6 +3185,7 @@ Gid_t getegid (void); #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 */ diff --git a/pp.c b/pp.c index f63b372..97a5cfb 100644 --- a/pp.c +++ b/pp.c @@ -295,13 +295,13 @@ PP(pp_av2arylen) { dSP; AV *av = (AV*)TOPs; - SV *sv = AvARYLEN(av); - if (!sv) { - AvARYLEN(av) = sv = NEWSV(0,0); - sv_upgrade(sv, SVt_IV); - sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); + SV **sv = Perl_av_arylen_p(aTHX_ (AV*)av); + if (!*sv) { + *sv = NEWSV(0,0); + sv_upgrade(*sv, SVt_PVMG); + sv_magic(*sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0); } - SETs(sv); + SETs(*sv); RETURN; } diff --git a/proto.h b/proto.h index 1a656e8..b2436b1 100644 --- a/proto.h +++ b/proto.h @@ -111,6 +111,7 @@ PERL_CALLCONV SV* Perl_av_shift(pTHX_ AV* ar) PERL_CALLCONV SV** Perl_av_store(pTHX_ AV* ar, I32 key, SV* val); PERL_CALLCONV void Perl_av_undef(pTHX_ AV* ar); PERL_CALLCONV void Perl_av_unshift(pTHX_ AV* ar, I32 num); +PERL_CALLCONV SV** Perl_av_arylen_p(pTHX_ AV* av); PERL_CALLCONV OP* Perl_bind_match(pTHX_ I32 type, OP* left, OP* pat) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_2) diff --git a/sv.c b/sv.c index e8c47f5..df40915 100644 --- a/sv.c +++ b/sv.c @@ -1879,7 +1879,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt) AvMAX(sv) = -1; AvFILLp(sv) = -1; AvALLOC(sv) = 0; - AvARYLEN(sv)= 0; AvREAL_only(sv); } /* to here. */ @@ -5454,6 +5453,7 @@ Perl_sv_magic(pTHX_ register SV *sv, SV *obj, int how, const char *name, I32 nam case PERL_MAGIC_vec: vtable = &PL_vtbl_vec; break; + case PERL_MAGIC_arylen_p: case PERL_MAGIC_rhash: case PERL_MAGIC_symtab: case PERL_MAGIC_vstring: @@ -10886,7 +10886,6 @@ Perl_sv_dup(pTHX_ SV *sstr, CLONE_PARAMS* param) SvLEN_set(dstr, SvLEN(sstr)); SvMAGIC_set(dstr, mg_dup(SvMAGIC(sstr), param)); SvSTASH_set(dstr, hv_dup_inc(SvSTASH(sstr), param)); - AvARYLEN((AV*)dstr) = sv_dup_inc(AvARYLEN((AV*)sstr), param); if (AvARRAY((AV*)sstr)) { SV **dst_ary, **src_ary; SSize_t items = AvFILLp((AV*)sstr) + 1;