X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=av.c;h=df35b1a8390494130e6db98581e08ad0e94ccd27;hb=0bcc34c2b0b0cb62c0df3d5e562b779fb96595ba;hp=e5cbe2f4834901b0715cd6ad5aeb31a6e156a736;hpb=83bf042f79af6208af0620b081ee65543ecfed9f;p=p5sagit%2Fp5-mst-13.2.git diff --git a/av.c b/av.c index e5cbe2f..df35b1a 100644 --- a/av.c +++ b/av.c @@ -60,8 +60,8 @@ extended. void Perl_av_extend(pTHX_ AV *av, I32 key) { - MAGIC *mg; - if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) { + MAGIC * const mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied); + if (mg) { dSP; ENTER; SAVETMPS; @@ -92,7 +92,6 @@ Perl_av_extend(pTHX_ AV *av, I32 key) while (tmp) ary[--tmp] = &PL_sv_undef; } - if (key > AvMAX(av) - 10) { newmax = key + AvMAX(av); goto resize; @@ -132,7 +131,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) assert(itmp > newmax); newmax = itmp - 1; assert(newmax >= AvMAX(av)); - New(2,ary, newmax+1, SV*); + Newx(ary, newmax+1, SV*); Copy(AvALLOC(av), ary, AvMAX(av)+1, SV*); if (AvMAX(av) > 64) offer_nice_chunk(AvALLOC(av), (AvMAX(av)+1) * sizeof(SV*)); @@ -154,7 +153,7 @@ Perl_av_extend(pTHX_ AV *av, I32 key) else { newmax = key < 3 ? 3 : key; MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend); - New(2,AvALLOC(av), newmax+1, SV*); + Newx(AvALLOC(av), newmax+1, SV*); ary = AvALLOC(av) + 1; tmp = newmax; AvALLOC(av)[0] = &PL_sv_undef; /* For the stacks */ @@ -198,7 +197,7 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval) if (tied_magic && key < 0) { /* Handle negative array indices 20020222 MJD */ - SV **negative_indices_glob = + SV * const * const negative_indices_glob = hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))), NEGATIVE_INDICES_VAR, 16, 0); @@ -285,7 +284,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val) /* Handle negative array indices 20020222 MJD */ if (key < 0) { unsigned adjust_index = 1; - SV **negative_indices_glob = + SV * const * const negative_indices_glob = hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))), NEGATIVE_INDICES_VAR, 16, 0); @@ -354,11 +353,10 @@ Creates a new AV. The reference count is set to 1. AV * Perl_newAV(pTHX) { - register AV *av; + register AV * const av = (AV*)NEWSV(3,0); - av = (AV*)NEWSV(3,0); sv_upgrade((SV *)av, SVt_PVAV); - AvREAL_on(av); + /* sv_upgrade does AvREAL_only() */ AvALLOC(av) = 0; SvPV_set(av, (char*)0); AvMAX(av) = AvFILLp(av) = -1; @@ -378,15 +376,14 @@ will have a reference count of 1. AV * Perl_av_make(pTHX_ register I32 size, register SV **strp) { - register AV *av; + register AV * const av = (AV*)NEWSV(8,0); - av = (AV*)NEWSV(8,0); sv_upgrade((SV *) av,SVt_PVAV); - AvREAL_only(av); + /* sv_upgrade does AvREAL_only() */ if (size) { /* "defined" was returning undef for size==0 anyway. */ register SV** ary; register I32 i; - New(4,ary,size,SV*); + Newx(ary,size,SV*); AvALLOC(av) = ary; SvPV_set(av, (char*)ary); AvFILLp(av) = size - 1; @@ -401,29 +398,6 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp) return av; } -AV * -Perl_av_fake(pTHX_ register I32 size, register SV **strp) -{ - register AV *av; - register SV** ary; - - av = (AV*)NEWSV(9,0); - sv_upgrade((SV *)av, SVt_PVAV); - New(4,ary,size+1,SV*); - AvALLOC(av) = ary; - Copy(strp,ary,size,SV*); - AvREIFY_only(av); - SvPV_set(av, (char*)ary); - AvFILLp(av) = size - 1; - AvMAX(av) = size - 1; - while (size--) { - assert (*strp); - SvTEMP_off(*strp); - strp++; - } - return av; -} - /* =for apidoc av_clear @@ -445,7 +419,6 @@ Perl_av_clear(pTHX_ register AV *av) #endif if (!av) return; - /*SUPPRESS 560*/ if (SvREADONLY(av)) Perl_croak(aTHX_ PL_no_modify); @@ -458,10 +431,10 @@ Perl_av_clear(pTHX_ register AV *av) return; if (AvREAL(av)) { - SV** ary = AvARRAY(av); + SV** const ary = AvARRAY(av); key = AvFILLp(av) + 1; while (key) { - SV * sv = ary[--key]; + SV * const sv = ary[--key]; /* undef the slot before freeing the value, because a * destructor might try to modify this arrray */ ary[key] = &PL_sv_undef; @@ -489,7 +462,6 @@ Perl_av_undef(pTHX_ register AV *av) { if (!av) return; - /*SUPPRESS 560*/ /* Give any tie a chance to cleanup first */ if (SvTIED_mg((SV*)av, PERL_MAGIC_tied)) @@ -504,8 +476,6 @@ Perl_av_undef(pTHX_ register AV *av) AvALLOC(av) = 0; SvPV_set(av, (char*)0); AvMAX(av) = AvFILLp(av) = -1; - /* It's in magic - it must already be gone. */ - assert (!AvARYLEN(av)); } /* @@ -721,7 +691,7 @@ empty. */ I32 -Perl_av_len(pTHX_ const register AV *av) +Perl_av_len(pTHX_ register const AV *av) { return AvFILL(av); } @@ -809,7 +779,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags) if (key < 0) { unsigned adjust_index = 1; if (tied_magic) { - SV **negative_indices_glob = + SV * const * const negative_indices_glob = hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))), NEGATIVE_INDICES_VAR, 16, 0); @@ -894,7 +864,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key) if (key < 0) { unsigned adjust_index = 1; if (tied_magic) { - SV **negative_indices_glob = + SV * const * const negative_indices_glob = hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, tied_magic))), NEGATIVE_INDICES_VAR, 16, 0); @@ -940,21 +910,14 @@ Perl_av_arylen_p(pTHX_ AV *av) { 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); + mg = sv_magicext((SV*)av, 0, PERL_MAGIC_arylen_p, &PL_vtbl_arylen_p, + 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; - - /* This is very naughty, but we don't want SvRMAGICAL() set on the - hash, because it slows down all accesses. If we pass in a vtable - to sv_magicext then it is (correctly) set for us. However, the only - entry in our vtable is for free, and mg_free always calls the free - vtable entry irrespective of the flags, so it doesn't actually - matter that the R flag is off. */ - mg->mg_virtual = &PL_vtbl_arylen_p; } return &(mg->mg_obj); }