X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=e588b67878fb650c454653b4da5005579caa0722;hb=638a265a89c75e2418ddc1c87a560bb8022ea667;hp=d538fdf68d022f5040350cdd5ab081e84a8bbc9c;hpb=177ebd37c766a3ff9b89f91a8215e91111c63c7b;p=p5sagit%2FDevel-Size.git diff --git a/Size.xs b/Size.xs index d538fdf..e588b67 100644 --- a/Size.xs +++ b/Size.xs @@ -1,3 +1,5 @@ +/* -*- mode: C -*- */ + #define PERL_NO_GET_CONTEXT #include "EXTERN.h" @@ -15,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 @@ -146,7 +159,7 @@ free_tracking_at(void **tv, int level) /* Nodes */ do { if (tv[i]) { - free_tracking_at(tv[i], level); + free_tracking_at((void **) tv[i], level); Safefree(tv[i]); } } while (i--); @@ -181,7 +194,7 @@ free_state(struct state *st) #define SOME_RECURSION 1 #define TOTAL_SIZE_RECURSION 2 -static bool sv_size(pTHX_ struct state *, const SV *const, const int recurse); +static void sv_size(pTHX_ struct state *, const SV *const, const int recurse); typedef enum { OPc_NULL, /* 0 */ @@ -523,6 +536,29 @@ op_size(pTHX_ const OP * const baseop, struct state *st) } } +static void +hek_size(pTHX_ struct state *st, HEK *hek, U32 shared) +{ + /* Hash keys can be shared. Have we seen this before? */ + if (!check_new(st, hek)) + return; + st->total_size += HEK_BASESIZE + hek->hek_len +#if PERL_VERSION < 8 + + 1 /* No hash key flags prior to 5.8.0 */ +#else + + 2 +#endif + ; + if (shared) { +#if PERL_VERSION < 10 + st->total_size += sizeof(struct he); +#else + st->total_size += STRUCT_OFFSET(struct shared_he, shared_he_hek); +#endif + } +} + + #if PERL_VERSION < 8 || PERL_SUBVERSION < 9 # define SVt_LAST 16 #endif @@ -624,19 +660,19 @@ const U8 body_sizes[SVt_LAST] = { #endif }; -static bool +static void sv_size(pTHX_ struct state *const st, const SV * const orig_thing, const int recurse) { const SV *thing = orig_thing; U32 type; if(!check_new(st, thing)) - return FALSE; + return; type = SvTYPE(thing); if (type > SVt_LAST) { warn("Devel::Size: Unknown variable type: %d encountered\n", type); - return TRUE; + return; } st->total_size += sizeof(SV) + body_sizes[type]; @@ -698,12 +734,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, cur_entry = *(HvARRAY(thing) + cur_bucket); while (cur_entry) { st->total_size += sizeof(HE); - if (cur_entry->hent_hek) { - /* Hash keys can be shared. Have we seen this before? */ - if (check_new(st, cur_entry->hent_hek)) { - st->total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2; - } - } + hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing)); if (recurse >= TOTAL_SIZE_RECURSION) sv_size(aTHX_ st, HeVAL(cur_entry), recurse); cur_entry = cur_entry->hent_next; @@ -763,8 +794,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(), @@ -800,6 +837,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); @@ -811,7 +850,7 @@ sv_size(pTHX_ struct state *const st, const SV * const orig_thing, TAG;break; } - return TRUE; + return; } static struct state * @@ -831,6 +870,9 @@ new_state(pTHX) check_new(st, &PL_sv_undef); check_new(st, &PL_sv_no); check_new(st, &PL_sv_yes); +#if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 0) + check_new(st, &PL_sv_placeholder); +#endif return st; }