X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FDevel-Size.git;a=blobdiff_plain;f=Size.xs;h=109dd15fc0f802c16c02838339987696764c25e1;hp=5b8aba81d5ae2774982d0d56a19c6ba1affae996;hb=ad06a65004e9646ccce249df1783cc23f441f946;hpb=3d18ea100b25c1e19400763b0ce5a34aa8083af6 diff --git a/Size.xs b/Size.xs index 5b8aba8..109dd15 100644 --- a/Size.xs +++ b/Size.xs @@ -17,6 +17,17 @@ #ifndef SvOOK_offset # define SvOOK_offset(sv, len) STMT_START { len = SvIVX(sv); } STMT_END #endif +#ifndef SvIsCOW +# define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ + (SVf_FAKE | SVf_READONLY)) +#endif +#ifndef SvIsCOW_shared_hash +# define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0) +#endif +#ifndef SvSHARED_HEK_FROM_PV +# define SvSHARED_HEK_FROM_PV(pvx) \ + ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key))) +#endif #if PERL_VERSION < 6 # define PL_opargs opargs @@ -30,7 +41,7 @@ functionality on other platforms. */ # include # define TRY_TO_CATCH_SEGV __try -# define CAUGHT_EXCEPTION __except(EXCEPTION EXCEPTION_EXECUTE_HANDLER) +# define CAUGHT_EXCEPTION __except(EXCEPTION_EXECUTE_HANDLER) #else # define TRY_TO_CATCH_SEGV if(1) # define CAUGHT_EXCEPTION else @@ -507,9 +518,16 @@ op_size(pTHX_ const OP * const baseop, struct state *st) #endif #ifdef USE_ITHREADS check_new_and_strlen(st, basecop->cop_file); +#if PERL_VERSION < 17 || (PERL_VERSION == 17 && PERL_SUBVERSION == 0) + /* This pointer is owned by the COP, and freed with it. */ check_new_and_strlen(st, basecop->cop_stashpv); #else - sv_size(aTHX_ st, (SV *)basecop->cop_stash, SOME_RECURSION); + /* A per-interpreter pointer for this stash is allocated in + PL_stashpad. */ + if (check_new(st, PL_stashpad + basecop->cop_stashoff)) + st->total_size += sizeof(PL_stashpad[basecop->cop_stashoff]); +#endif +#else sv_size(aTHX_ st, (SV *)basecop->cop_filegv, SOME_RECURSION); #endif @@ -649,6 +667,30 @@ const U8 body_sizes[SVt_LAST] = { #endif }; +#ifdef PadlistNAMES +static void +padlist_size(pTHX_ struct state *const st, const PADLIST * const padl, + const int recurse) { + SSize_t i; + if (!check_new(st, padl)) + return; + /* This relies on PADNAMELIST and PAD being typedefed to AV. If that + ever changes, this code will need an update. */ + st->total_size += sizeof(PADLIST); + sv_size(aTHX_ st, (SV*)PadlistNAMES(padl), recurse); + i = PadlistMAX(padl) + 1; + st->total_size += sizeof(PAD*) * i; + while (--i) + sv_size(aTHX_ st, (SV*)PadlistARRAY(padl)[i], recurse); +} +#else +static void +padlist_size(pTHX_ struct state *const st, const AV * const padl, + const int recurse) { + sv_size(aTHX_ st, (SV*)padl, recurse); +} +#endif + static void sv_size(pTHX_ struct state *const st, const SV * const orig_thing, const int recurse) { @@ -665,7 +707,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, } st->total_size += sizeof(SV) + body_sizes[type]; - if (type >= SVt_PVMG) { + if (SvMAGICAL(thing)) { magic_size(aTHX_ thing, st); } @@ -730,11 +772,51 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, } } } +#ifdef HvAUX + if (SvOOK(thing)) { + /* This direct access is arguably "naughty": */ + struct mro_meta *meta = HvAUX(thing)->xhv_mro_meta; +#if PERL_VERSION > 13 || PERL_SUBVERSION > 8 + /* As is this: */ + I32 count = HvAUX(thing)->xhv_name_count; + + if (count) { + HEK **names = HvAUX(thing)->xhv_name_u.xhvnameu_names; + if (count < 0) + count = -count; + while (--count) + hek_size(aTHX_ st, names[count], 1); + } + else +#endif + { + hek_size(aTHX_ st, HvNAME_HEK(thing), 1); + } + + st->total_size += sizeof(struct xpvhv_aux); + if (meta) { + st->total_size += sizeof(struct mro_meta); + sv_size(aTHX_ st, (SV *)meta->mro_nextmethod, TOTAL_SIZE_RECURSION); +#if PERL_VERSION > 10 || (PERL_VERSION == 10 && PERL_SUBVERSION > 0) + sv_size(aTHX_ st, (SV *)meta->isa, TOTAL_SIZE_RECURSION); +#endif +#if PERL_VERSION > 10 + sv_size(aTHX_ st, (SV *)meta->mro_linear_all, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, meta->mro_linear_current, TOTAL_SIZE_RECURSION); +#else + sv_size(aTHX_ st, (SV *)meta->mro_linear_dfs, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, (SV *)meta->mro_linear_c3, TOTAL_SIZE_RECURSION); +#endif + } + } +#else + check_new_and_strlen(st, HvNAME_get(thing)); +#endif TAG;break; case SVt_PVFM: TAG; - sv_size(aTHX_ st, (SV *)CvPADLIST(thing), SOME_RECURSION); + padlist_size(aTHX_ st, CvPADLIST(thing), SOME_RECURSION); sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse); if (st->go_yell && !st->fm_whine) { @@ -747,11 +829,11 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, sv_size(aTHX_ st, (SV *)CvSTASH(thing), SOME_RECURSION); sv_size(aTHX_ st, (SV *)SvSTASH(thing), SOME_RECURSION); sv_size(aTHX_ st, (SV *)CvGV(thing), SOME_RECURSION); - sv_size(aTHX_ st, (SV *)CvPADLIST(thing), SOME_RECURSION); + padlist_size(aTHX_ st, CvPADLIST(thing), SOME_RECURSION); sv_size(aTHX_ st, (SV *)CvOUTSIDE(thing), recurse); if (CvISXSUB(thing)) { sv_size(aTHX_ st, cv_const_sv((CV *)thing), recurse); - } else { + } else if (CvROOT(thing)) { op_size(aTHX_ CvSTART(thing), st); op_size(aTHX_ CvROOT(thing), st); } @@ -783,8 +865,14 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, case SVt_PVGV: TAG; if(isGV_with_GP(thing)) { +#ifdef GvNAME_HEK + hek_size(aTHX_ st, GvNAME_HEK(thing), 1); +#else st->total_size += GvNAMELEN(thing); -#ifdef GvFILE +#endif +#ifdef GvFILE_HEK + hek_size(aTHX_ st, GvFILE_HEK(thing), 1); +#elif defined(GvFILE) # if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)) /* With itreads, before 5.8.9, this can end up pointing to freed memory if the GV was created in an eval, as GvFILE() points to CopFILE(), @@ -820,6 +908,8 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, freescalar: if(recurse && SvROK(thing)) sv_size(aTHX_ st, SvRV_const(thing), recurse); + else if (SvIsCOW_shared_hash(thing)) + hek_size(aTHX_ st, SvSHARED_HEK_FROM_PV(SvPVX(thing)), 1); else st->total_size += SvLEN(thing);