#define NPtype_MAGIC 0x04
#define NPtype_OP 0x05
+/* XXX these should probably be generalizes into flag bits */
#define NPattr_LEAFSIZE 0x00
#define NPattr_NAME 0x01
#define NPattr_PADFAKE 0x02
#define NPattr_PADNAME 0x03
#define NPattr_PADTMP 0x04
#define NPattr_NOTE 0x05
+#define NPattr_PRE_ATTR 0x06
+
+#define _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, np) (st->add_attr_cb && st->add_attr_cb(st, np, attr_type, attr_name, attr_value))
+#define ADD_ATTR(st, attr_type, attr_name, attr_value) _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP-1)
+#define ADD_PRE_ATTR(st, attr_type, attr_name, attr_value) (assert(!attr_type), _ADD_ATTR_NP(st, NPattr_PRE_ATTR, attr_name, attr_value, NP-1))
#define _NPathLink(np, nid, ntype) (((np)->id=nid), ((np)->type=ntype), ((np)->seqn=0))
#define NPathLink(nid) (_NPathLink(NP, nid, NPtype_LINK), NP)
#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))
#else
dNPathNodes(1, NPathArg);
MAGIC *magic_pointer = SvMAGIC(thing);
+ if (!magic_pointer)
+ return;
+
+ if (!SvMAGICAL(thing)) {
+ if (0) {
+ warn("Ignoring suspect magic on this SV\n");
+ sv_dump((SV*)thing);
+ }
+ return;
+ }
+
/* push a dummy node for NPathSetNode to update inside the while loop */
NPathPushNode("dummy", NPtype_NAME);
TRY_TO_CATCH_SEGV {
+ /* XXX only chase mg_obj if mg->mg_flags & MGf_REFCOUNTED ? */
sv_size(aTHX_ st, NPathLink("mg_obj"), magic_pointer->mg_obj, TOTAL_SIZE_RECURSION);
if (magic_pointer->mg_len == HEf_SVKEY) {
sv_size(aTHX_ st, NPathLink("mg_ptr"), (SV *)magic_pointer->mg_ptr, TOTAL_SIZE_RECURSION);
}
}
#endif
+ /* XXX also handle mg->mg_type == PERL_MAGIC_utf8 ? */
else if (magic_pointer->mg_len > 0) {
+ if(0)do_magic_dump(0, Perl_debug_log, magic_pointer, 0, 0, FALSE, 0);
if (check_new(st, magic_pointer->mg_ptr)) {
ADD_SIZE(st, "mg_len", magic_pointer->mg_len);
}
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
SV **pname;
I32 ix;
- if (!padlist) {
+ if (!padlist)
return;
- }
+ if( 0 && !check_new(st, padlist))
+ return;
+
pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
pname = AvARRAY(pad_name);
namesv = NULL;
}
if (namesv) {
+ /* SvFAKE: On a pad name SV, that slot in the frame AV is a REFCNT'ed reference to a lexical from "outside" */
if (SvFAKE(namesv))
ADD_ATTR(st, NPattr_PADFAKE, SvPVX_const(namesv), ix);
else
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? */
#else
case SVt_IV: TAG;
#endif
- if(recurse && SvROK(thing))
- sv_size(aTHX_ st, NPathLink("RV"), SvRV_const(thing), recurse);
+ if(recurse && SvROK(thing)) /* XXX maybe don't follow weakrefs */
+ sv_size(aTHX_ st, (SvWEAKREF(thing) ? NPathLink("weakRV") : NPathLink("RV")), SvRV_const(thing), recurse);
TAG;break;
case SVt_PVAV: TAG;
if (recurse >= st->min_recurse_threshold) {
SSize_t i = AvFILLp(thing) + 1;
- while (i--)
+ while (i--) {
+ ADD_PRE_ATTR(st, 0, "index", i);
sv_size(aTHX_ st, NPathLink("AVelem"), AvARRAY(thing)[i], recurse);
+ }
}
}
/* Add in the bits on the other side of the beginning */
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)));
for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
cur_entry = *(HvARRAY(thing) + cur_bucket);
while (cur_entry) {
+/* XXX a HE should probably be a node so the keys and values are seen as pairs */
ADD_SIZE(st, "he", sizeof(HE));
hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing), NPathLink("hent_hek"));
if (recurse >= st->min_recurse_threshold) {
*/
if (PTR2UV(HeVAL(cur_entry)) > 0xFFF)
sv_size(aTHX_ st, NPathLink("HeVAL"), HeVAL(cur_entry), recurse);
+else warn("skipped suspect HeVAL %p", HeVAL(cur_entry));
}
cur_entry = cur_entry->hent_next;
}
case SVt_PVFM: TAG;
- padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), SOME_RECURSION);
- sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), recurse);
+ padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), recurse);
+ sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), SOME_RECURSION);
if (st->go_yell && !st->fm_whine) {
carp("Devel::Size: Calculated sizes for FMs are incomplete");
case SVt_PVCV: TAG;
/* not CvSTASH, per https://rt.cpan.org/Ticket/Display.html?id=79366 */
+ ADD_ATTR(st, NPattr_NAME, CvGV(thing) ? GvNAME(CvGV(thing)) : "UNDEFINED", 0);
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);
- sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), recurse);
+ padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), recurse);
+ sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), SOME_RECURSION);
if (CvISXSUB(thing)) {
sv_size(aTHX_ st, NPathLink("cv_const_sv"), cv_const_sv((CV *)thing), recurse);
} else {
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;
TAG;break;
}
+
+ if (type >= SVt_PVMG) {
+ magic_size(aTHX_ thing, st, NPathLink("MG"));
+ }
+
return;
}
check_new(st, &PL_sv_placeholder);
#endif
#ifdef PATH_TRACKING
- if (getenv("MEMNODES") && *getenv("MEMNODES")) { /* XXX quick hack */
- st->node_stream_name = getenv("MEMNODES");
+ if (getenv("MEMVIEW") && *getenv("MEMVIEW")) { /* XXX quick hack */
+ st->node_stream_name = getenv("MEMVIEW");
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));
+ setlinebuf(st->node_stream_fh); /* XXX temporary for debugging */
st->add_attr_cb = np_stream_node_path_info;
}
else
SV* sv;
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) != (svtype)SVTYPEMASK && SvREFCNT(sv)) {
- sv_size(aTHX_ st, NPathLink(""), sv, TOTAL_SIZE_RECURSION);
+ 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");
projects / p5sagit/Devel-Size.git / blobdiff