X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=Size.xs;h=9d0df0550061e002521f19c8261693f136712d8e;hb=49beddc6a78d03c878be8ab5613e528d6a5695f6;hp=64bb92df73b1e1f108a8d128983f75e3123374a1;hpb=e8f4c50603f32973f72728a5e5c18a3c465d9753;p=p5sagit%2FDevel-Size.git diff --git a/Size.xs b/Size.xs index 64bb92d..9d0df05 100644 --- a/Size.xs +++ b/Size.xs @@ -94,13 +94,15 @@ struct state { start with 0 bits, hence the start of this array will be hot, and the end unused. So put the flags next to the hot end. */ void *tracking[256]; + int min_recurse_threshold; /* callback hooks and data */ int (*add_attr_cb)(struct state *st, npath_node_t *npath_node, UV attr_type, const char *name, UV value); - void (*free_state_cb)(struct state *st); + void (*free_state_cb)(pTHX_ struct state *st); UV seqn; void *state_cb_data; /* free'd by free_state() after free_state_cb() call */ /* this stuff wil be moved to state_cb_data later */ - FILE *node_stream; + FILE *node_stream_fh; + char *node_stream_name; }; #define ADD_SIZE(st, leafname, bytes) (NPathAddSizeCb(st, leafname, bytes) (st)->total_size += (bytes)) @@ -110,24 +112,24 @@ struct state { #define pPATH npath_node_t *NPathArg -/* A subtle point here is that dNPathNodes and NPathPushNode leaves NP pointing +/* A subtle point here is that dNPathNodes and NPathPushNode leave NP pointing * to the next unused slot (though with prev already filled in) * whereas NPathLink leaves NP unchanged, it just fills in the slot NP points * to and passes that NP value to the function being called. + * seqn==0 indicates the node is new (hasn't been output yet) */ #define dNPathNodes(nodes, prev_np) \ npath_node_t name_path_nodes[nodes+1]; /* +1 for NPathLink */ \ npath_node_t *NP = &name_path_nodes[0]; \ - NP->seqn = 0; \ - NP->type = 0; \ - NP->id = "?0?"; /* DEBUG */ \ + NP->seqn = NP->type = 0; NP->id = Nullch; /* safety/debug */ \ NP->prev = prev_np #define NPathPushNode(nodeid, nodetype) \ NP->id = nodeid; \ NP->type = nodetype; \ + NP->seqn = 0; \ if(0)fprintf(stderr,"NPathPushNode (%p <-) %p <- [%d %s]\n", NP->prev, NP, nodetype,(char*)nodeid);\ NP++; \ - NP->id="?+?"; /* DEBUG */ \ + NP->id = Nullch; /* safety/debug */ \ NP->seqn = 0; \ NP->prev = (NP-1) #define NPathSetNode(nodeid, nodetype) \ @@ -135,6 +137,8 @@ struct state { (NP-1)->type = nodetype; \ if(0)fprintf(stderr,"NPathSetNode (%p <-) %p <- [%d %s]\n", (NP-1)->prev, (NP-1), nodetype,(char*)nodeid);\ (NP-1)->seqn = 0; +#define NPathPopNode \ + --NP /* dNPathUseParent points NP directly the the parents' name_path_nodes array * So the function can only safely call ADD_*() but not NPathLink, unless the @@ -153,8 +157,12 @@ struct state { #define NPattr_PADFAKE 0x02 #define NPattr_PADNAME 0x03 #define NPattr_PADTMP 0x04 +#define NPattr_NOTE 0x05 -#define NPathLink(nodeid) ((NP->id = nodeid), (NP->type = NPtype_LINK), (NP->seqn = 0), NP) +#define _NPathLink(np, nid, ntype) (((np)->id=nid), ((np)->type=ntype), ((np)->seqn=0)) +#define NPathLink(nid) (_NPathLink(NP, nid, NPtype_LINK), NP) +/* add a link and a name node to the path - a special case for op_size */ +#define NPathLinkAndNode(nid, nid2) (_NPathLink(NP, nid, NPtype_LINK), _NPathLink(NP+1, nid2, NPtype_NAME), ((NP+1)->prev=NP), (NP+1)) #define NPathOpLink (NPathArg) #define NPathAddSizeCb(st, name, bytes) (st->add_attr_cb && st->add_attr_cb(st, NP-1, NPattr_LEAFSIZE, (name), (bytes))), #define ADD_ATTR(st, attr_type, attr_name, attr_value) (st->add_attr_cb && st->add_attr_cb(st, NP-1, attr_type, attr_name, attr_value)) @@ -218,7 +226,7 @@ np_print_node_name(FILE *fp, npath_node_t *npath_node) break; } case NPtype_LINK: - fprintf(fp, "%s->", npath_node->id); + fprintf(fp, "%s", npath_node->id); break; case NPtype_NAME: fprintf(fp, "%s", npath_node->id); @@ -273,6 +281,8 @@ np_dump_formatted_node(struct state *st, npath_node_t *npath_node, npath_node_t return 1; np_dump_indent(npath_node->depth); np_print_node_name(stderr, npath_node); + if (npath_node->type == NPtype_LINK) + fprintf(stderr, "->"); /* cosmetic */ fprintf(stderr, "\t\t[#%ld @%u] ", npath_node->seqn, npath_node->depth); fprintf(stderr, "\n"); return 0; @@ -281,17 +291,28 @@ np_dump_formatted_node(struct state *st, npath_node_t *npath_node, npath_node_t int np_dump_node_path_info(struct state *st, npath_node_t *npath_node, UV attr_type, const char *attr_name, UV attr_value) { - if (!attr_type && !attr_value) + if (attr_type == NPattr_LEAFSIZE && !attr_value) return 0; /* ignore zero sized leaf items */ np_walk_new_nodes(st, npath_node, NULL, np_dump_formatted_node); np_dump_indent(npath_node->depth+1); - if (attr_type) { + switch (attr_type) { + case NPattr_LEAFSIZE: + fprintf(stderr, "+%ld %s =%ld", attr_value, attr_name, attr_value+st->total_size); + break; + case NPattr_NAME: fprintf(stderr, "~NAMED('%s') %lu", attr_name, attr_value); - } - else { - fprintf(stderr, "+%ld ", attr_value); - fprintf(stderr, "%s ", attr_name); - fprintf(stderr, "=%ld ", attr_value+st->total_size); + break; + case NPattr_NOTE: + fprintf(stderr, "~note %s %lu", attr_name, attr_value); + break; + case NPattr_PADTMP: + case NPattr_PADNAME: + case NPattr_PADFAKE: + fprintf(stderr, "~pad%lu %s %lu", attr_type, attr_name, attr_value); + break; + default: + fprintf(stderr, "~??? %s %lu", attr_name, attr_value); + break; } fprintf(stderr, "\n"); return 0; @@ -299,11 +320,11 @@ np_dump_node_path_info(struct state *st, npath_node_t *npath_node, UV attr_type, int np_stream_formatted_node(struct state *st, npath_node_t *npath_node, npath_node_t *npath_node_deeper) { - fprintf(st->node_stream, "N %lu %u ", npath_node->seqn, - (unsigned)npath_node->depth + fprintf(st->node_stream_fh, "-%u %lu %u ", + npath_node->type, npath_node->seqn, (unsigned)npath_node->depth ); - np_print_node_name(st->node_stream, npath_node); - fprintf(st->node_stream, "\n"); + np_print_node_name(st->node_stream_fh, npath_node); + fprintf(st->node_stream_fh, "\n"); return 0; } @@ -314,15 +335,16 @@ np_stream_node_path_info(struct state *st, npath_node_t *npath_node, UV attr_typ return 0; /* ignore zero sized leaf items */ np_walk_new_nodes(st, npath_node, NULL, np_stream_formatted_node); if (attr_type) { /* Attribute type, name and value */ - fprintf(st->node_stream, "%lu %lu ", attr_type, npath_node->seqn); + fprintf(st->node_stream_fh, "%lu %lu ", attr_type, npath_node->seqn); } else { /* Leaf name and memory size */ - fprintf(st->node_stream, "L %lu ", npath_node->seqn); + fprintf(st->node_stream_fh, "L %lu ", npath_node->seqn); } - fprintf(st->node_stream, "%lu %s\n", attr_value, attr_name); + fprintf(st->node_stream_fh, "%lu %s\n", attr_value, attr_name); return 0; } + #endif /* PATH_TRACKING */ @@ -675,9 +697,10 @@ regex_size(const REGEXP * const baseregex, struct state *st, pPATH) { static void op_size(pTHX_ const OP * const baseop, struct state *st, pPATH) { - /* op_size recurses to follow the chain of opcodes. - * For the 'path' we don't want the chain to be 'nested' in the path so we - * use ->prev in dNPathNodes. + /* op_size recurses to follow the chain of opcodes. For the node path we + * don't want the chain to be 'nested' in the path so we use dNPathUseParent(). + * Also, to avoid a link-to-a-link the caller should use NPathLinkAndNode() + * instead of NPathLink(). */ dNPathUseParent(NPathArg); @@ -785,7 +808,8 @@ op_size(pTHX_ const OP * const baseop, struct state *st, pPATH) check_new_and_strlen(st, basecop->cop_file, NPathLink("cop_file")); check_new_and_strlen(st, basecop->cop_stashpv, NPathLink("cop_stashpv")); #else - sv_size(aTHX_ st, NPathLink("cop_stash"), (SV *)basecop->cop_stash, SOME_RECURSION); + if (SvREFCNT(basecop->cop_stash) == 1) /* XXX hack? */ + sv_size(aTHX_ st, NPathLink("cop_stash"), (SV *)basecop->cop_stash, SOME_RECURSION); sv_size(aTHX_ st, NPathLink("cop_filegv"), (SV *)basecop->cop_filegv, SOME_RECURSION); #endif @@ -929,12 +953,12 @@ const U8 body_sizes[SVt_LAST] = { }; +/* based on Perl_do_dump_pad() - wraps sv_size and adds ADD_ATTR calls for the pad names */ static void padlist_size(pTHX_ struct state *const st, pPATH, PADLIST *padlist, const int recurse) { dNPathUseParent(NPathArg); - /* based on Perl_do_dump_pad() */ const AV *pad_name; SV **pname; I32 ix; @@ -983,10 +1007,6 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing, NPathPushNode(thing, NPtype_SV); ADD_SIZE(st, "sv", sizeof(SV) + body_sizes[type]); - if (type >= SVt_PVMG) { - magic_size(aTHX_ thing, st, NPathLink("MG")); - } - switch (type) { #if (PERL_VERSION < 11) /* Is it a reference? */ @@ -1005,7 +1025,7 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing, ADD_SIZE(st, "av_max", sizeof(SV *) * (AvMAX(thing) + 1)); dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", st->total_size, AvMAX(thing), av_len((AV*)thing))); - if (recurse >= TOTAL_SIZE_RECURSION) { + if (recurse >= st->min_recurse_threshold) { SSize_t i = AvFILLp(thing) + 1; while (i--) @@ -1030,6 +1050,7 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing, sv_size(aTHX_ st, NPathLink("ARYLEN"), AvARYLEN(thing), recurse); #endif TAG;break; + case SVt_PVHV: TAG; /* Now the array of buckets */ ADD_SIZE(st, "hv_max", (sizeof(HE *) * (HvMAX(thing) + 1))); @@ -1045,7 +1066,7 @@ sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing, while (cur_entry) { ADD_SIZE(st, "he", sizeof(HE)); hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing), NPathLink("hent_hek")); - if (recurse >= TOTAL_SIZE_RECURSION) { + if (recurse >= st->min_recurse_threshold) { /* I've seen a PL_strtab HeVAL == 0xC and 0x40C etc * just running perl -Mblib -Mstrict -MDevel::Size=:all -MCarp -e 'warn perl_size()' * but it seemed like a corruption - it would change come and go with irrelevant code changes. @@ -1112,7 +1133,7 @@ if (PTR2UV(HeVAL(cur_entry)) > 0xFFF) goto freescalar; case SVt_PVCV: TAG; - sv_size(aTHX_ st, NPathLink("CvSTASH"), (SV *)CvSTASH(thing), SOME_RECURSION); + /* not CvSTASH, per https://rt.cpan.org/Ticket/Display.html?id=79366 */ sv_size(aTHX_ st, NPathLink("SvSTASH"), (SV *)SvSTASH(thing), SOME_RECURSION); sv_size(aTHX_ st, NPathLink("CvGV"), (SV *)CvGV(thing), SOME_RECURSION); padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), SOME_RECURSION); @@ -1120,8 +1141,8 @@ if (PTR2UV(HeVAL(cur_entry)) > 0xFFF) if (CvISXSUB(thing)) { sv_size(aTHX_ st, NPathLink("cv_const_sv"), cv_const_sv((CV *)thing), recurse); } else { - op_size(aTHX_ CvSTART(thing), st, NPathLink("CvSTART")); - op_size(aTHX_ CvROOT(thing), st, NPathLink("CvROOT")); + if(1)op_size(aTHX_ CvSTART(thing), st, NPathLinkAndNode("CvSTART", "OPs")); /* XXX ? */ + op_size(aTHX_ CvROOT(thing), st, NPathLinkAndNode("CvROOT", "OPs")); } goto freescalar; @@ -1175,11 +1196,11 @@ if (PTR2UV(HeVAL(cur_entry)) > 0xFFF) if (check_new(st, GvGP(thing))) { ADD_SIZE(st, "GP", sizeof(GP)); sv_size(aTHX_ st, NPathLink("gp_sv"), (SV *)(GvGP(thing)->gp_sv), recurse); - sv_size(aTHX_ st, NPathLink("gp_form"), (SV *)(GvGP(thing)->gp_form), recurse); sv_size(aTHX_ st, NPathLink("gp_av"), (SV *)(GvGP(thing)->gp_av), recurse); sv_size(aTHX_ st, NPathLink("gp_hv"), (SV *)(GvGP(thing)->gp_hv), recurse); - sv_size(aTHX_ st, NPathLink("gp_egv"), (SV *)(GvGP(thing)->gp_egv), recurse); sv_size(aTHX_ st, NPathLink("gp_cv"), (SV *)(GvGP(thing)->gp_cv), recurse); + sv_size(aTHX_ st, NPathLink("gp_egv"), (SV *)(GvGP(thing)->gp_egv), recurse); + sv_size(aTHX_ st, NPathLink("gp_form"), (SV *)(GvGP(thing)->gp_form), recurse); } #if (PERL_VERSION >= 9) TAG; break; @@ -1208,9 +1229,29 @@ if (PTR2UV(HeVAL(cur_entry)) > 0xFFF) TAG;break; } + + if (type >= SVt_PVMG) { + magic_size(aTHX_ thing, st, NPathLink("MG")); + } + return; } +static void +free_memnode_state(pTHX_ struct state *st) +{ + if (st->node_stream_fh && st->node_stream_name) { + if (*st->node_stream_name == '|') { + if (pclose(st->node_stream_fh)) + warn("%s exited with an error status\n", st->node_stream_name); + } + else { + if (fclose(st->node_stream_fh)) + warn("Error closing %s: %s\n", st->node_stream_name, strerror(errno)); + } + } +} + static struct state * new_state(pTHX) { @@ -1219,6 +1260,7 @@ new_state(pTHX) Newxz(st, 1, struct state); st->go_yell = TRUE; + st->min_recurse_threshold = TOTAL_SIZE_RECURSION; if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { st->dangle_whine = st->go_yell = SvIV(warn_flag) ? TRUE : FALSE; } @@ -1232,16 +1274,55 @@ new_state(pTHX) check_new(st, &PL_sv_placeholder); #endif #ifdef PATH_TRACKING -if (getenv("M")) -st->node_stream = stdout; - if (st->node_stream) + if (getenv("MEMNODES") && *getenv("MEMNODES")) { /* XXX quick hack */ + st->node_stream_name = getenv("MEMNODES"); + if (*st->node_stream_name == '|') + st->node_stream_fh = popen(st->node_stream_name+1, "w"); + else + st->node_stream_fh = fopen(st->node_stream_name, "wb"); + if (!st->node_stream_fh) + croak("Can't open '%s' for writing: %s", st->node_stream_name, strerror(errno)); st->add_attr_cb = np_stream_node_path_info; - else + } + else st->add_attr_cb = np_dump_node_path_info; + st->free_state_cb = free_memnode_state; #endif return st; } +/* XXX based on S_visit() in sv.c */ +static void +unseen_sv_size(pTHX_ struct state *st, pPATH) +{ + dVAR; + SV* sva; + I32 visited = 0; + dNPathNodes(1, NPathArg); + + NPathPushNode("unseen", NPtype_NAME); + + /* by this point we should have visited all the SVs + * so now we'll run through all the SVs via the arenas + * in order to find any thet we've missed for some reason. + * Once the rest of the code is finding all the SVs then any + * found here will be leaks. + */ + for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) { + const SV * const svend = &sva[SvREFCNT(sva)]; + SV* sv; + for (sv = sva + 1; sv < svend; ++sv) { + if (SvTYPE(sv) != (svtype)SVTYPEMASK && SvREFCNT(sv)) { + sv_size(aTHX_ st, NPathLink("arena"), sv, TOTAL_SIZE_RECURSION); + } + else if (check_new(st, sv)) { /* sanity check */ + warn("unseen_sv_size encountered freed SV unexpectedly"); + sv_dump(sv); + } + } + } +} + MODULE = Devel::Size PACKAGE = Devel::Size PROTOTYPES: DISABLE @@ -1273,13 +1354,13 @@ UV perl_size() CODE: { - dNPathNodes(2, NULL); struct state *st = new_state(aTHX); + dNPathNodes(3, NULL); + + st->min_recurse_threshold = NO_RECURSION; /* so always recurse */ + NPathPushNode("perl_size", NPtype_NAME); /* provide a root node */ - - /* start with PL_defstash to get everything reachable from \%main:: - * this seems to include PL_defgv, PL_incgv etc but I've listed them anyway - */ + /* start with PL_defstash to get everything reachable from \%main:: */ sv_size(aTHX_ st, NPathLink("PL_defstash"), (SV*)PL_defstash, TOTAL_SIZE_RECURSION); NPathPushNode("others", NPtype_NAME); /* group these (typically much smaller) items */ @@ -1296,18 +1377,59 @@ CODE: #ifdef USE_ITHREADS sv_size(aTHX_ st, NPathLink("PL_regex_padav"), (SV*)PL_regex_padav, TOTAL_SIZE_RECURSION); #endif + sv_size(aTHX_ st, NPathLink("PL_warnhook"), (SV*)PL_warnhook, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_diehook"), (SV*)PL_diehook, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_endav"), (SV*)PL_endav, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_main_cv"), (SV*)PL_main_cv, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_main_root"), (SV*)PL_main_root, TOTAL_SIZE_RECURSION); + sv_size(aTHX_ st, NPathLink("PL_main_start"), (SV*)PL_main_start, TOTAL_SIZE_RECURSION); /* TODO PL_pidstatus */ /* TODO PL_stashpad */ - - /* in theory we shouldn't have any elements in PL_strtab that haven't been seen yet */ - sv_size(aTHX_ st, NPathLink("PL_strtab"), (SV*)PL_strtab, TOTAL_SIZE_RECURSION); + /* TODO PL_compiling? COP */ /* TODO stacks: cur, main, tmps, mark, scope, save */ - /* TODO unused space in arenas */ - /* TODO unused space in malloc, for whichever mallocs support it */ + /* TODO PL_exitlist */ + /* TODO PL_reentrant_buffers etc */ + /* TODO environ */ + /* TODO PerlIO? PL_known_layers PL_def_layerlist PL_perlio_fd_refcnt etc */ /* TODO threads? */ /* TODO anything missed? */ + /* --- by this point we should have seen all reachable SVs --- */ + + /* in theory we shouldn't have any elements in PL_strtab that haven't been seen yet */ + sv_size(aTHX_ st, NPathLink("PL_strtab"), (SV*)PL_strtab, TOTAL_SIZE_RECURSION); + + /* unused space in sv head arenas */ + if (PL_sv_root) { + SV *p = PL_sv_root; + UV free_heads = 1; +# define SvARENA_CHAIN(sv) SvANY(sv) /* XXX */ + while ((p = MUTABLE_SV(SvARENA_CHAIN(p)))) { + if (!check_new(st, p)) /* sanity check */ + warn("Free'd SV head unexpectedly already seen"); + ++free_heads; + } + NPathPushNode("unused_sv_heads", NPtype_NAME); + ADD_SIZE(st, "sv", free_heads * sizeof(SV)); + NPathPopNode; + } + /* XXX iterate over bodies_by_type and crawl the free chains for each */ + + /* iterate over all SVs to find any we've not accounted for yet */ + /* once the code above is visiting all SVs, any found here have been leaked */ + unseen_sv_size(aTHX_ st, NPathLink("unaccounted")); + + if (1) { + struct mstats ms = mstats(); + NPathSetNode("unused malloc space", NPtype_NAME); + ADD_SIZE(st, "bytes_free", ms.bytes_free); + ADD_ATTR(st, NPattr_NOTE, "bytes_total", ms.bytes_total); + ADD_ATTR(st, NPattr_NOTE, "bytes_used", ms.bytes_used); + ADD_ATTR(st, NPattr_NOTE, "chunks_used", ms.chunks_used); + ADD_ATTR(st, NPattr_NOTE, "chunks_free", ms.chunks_free); + } + RETVAL = st->total_size; free_state(st); }