projects / p5sagit/Devel-Size.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | history | HEAD
Polish sizeme_graph.pl
[p5sagit/Devel-Size.git] / SizeMe.xs
CommitLineData
fd495cc6 1/* -*- mode: C -*- */
2
df9491fe 3/* TODO
4 *
5 * Refactor this to split out D:M code from Devel::Size code.
df9491fe 6 * Start migrating Devel::Size's Size.xs towards the new code.
7 *
df9491fe 8 */
9
c07e8ef8 10#undef NDEBUG /* XXX */
11#include <assert.h>
12
265a0548 13#define PERL_NO_GET_CONTEXT
14
e98cedbf 15#include "EXTERN.h"
16#include "perl.h"
17#include "XSUB.h"
2eb93d08 18#include "ppport.h"
e98cedbf 19
d4f77653 20#include "refcounted_he.h"
21
87372f42 22/* Not yet in ppport.h */
23#ifndef CvISXSUB
24# define CvISXSUB(cv) (CvXSUB(cv) ? TRUE : FALSE)
25#endif
0e1f978f 26#ifndef SvRV_const
27# define SvRV_const(rv) SvRV(rv)
28#endif
95dc1714 29#ifndef SvOOK_offset
30# define SvOOK_offset(sv, len) STMT_START { len = SvIVX(sv); } STMT_END
31#endif
924d9c4e 32#ifndef SvIsCOW
33# define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
34 (SVf_FAKE | SVf_READONLY))
35#endif
36#ifndef SvIsCOW_shared_hash
37# define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0)
38#endif
39#ifndef SvSHARED_HEK_FROM_PV
40# define SvSHARED_HEK_FROM_PV(pvx) \
41 ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key)))
42#endif
87372f42 43
177ebd37 44#if PERL_VERSION < 6
45# define PL_opargs opargs
46# define PL_op_name op_name
47#endif
48
9fc9ab86 49#ifdef _MSC_VER
1a36ac09 50/* "structured exception" handling is a Microsoft extension to C and C++.
51 It's *not* C++ exception handling - C++ exception handling can't capture
52 SEGVs and suchlike, whereas this can. There's no known analagous
53 functionality on other platforms. */
54# include <excpt.h>
55# define TRY_TO_CATCH_SEGV __try
1c35d132 56# define CAUGHT_EXCEPTION __except(EXCEPTION_EXECUTE_HANDLER)
9fc9ab86 57#else
1a36ac09 58# define TRY_TO_CATCH_SEGV if(1)
59# define CAUGHT_EXCEPTION else
9fc9ab86 60#endif
61
62#ifdef __GNUC__
63# define __attribute__(x)
64#endif
65
b7621729 66#if 0 && defined(DEBUGGING)
67#define dbg_printf(x) printf x
68#else
69#define dbg_printf(x)
70#endif
98ecbbc6 71
0964064b 72#define TAG /* printf( "# %s(%d)\n", __FILE__, __LINE__ ) */
6a9ad7ec 73#define carp puts
9fc9ab86 74
30fe4f47 75/* The idea is to have a tree structure to store 1 bit per possible pointer
76 address. The lowest 16 bits are stored in a block of 8092 bytes.
77 The blocks are in a 256-way tree, indexed by the reset of the pointer.
78 This can cope with 32 and 64 bit pointers, and any address space layout,
79 without excessive memory needs. The assumption is that your CPU cache
80 works :-) (And that we're not going to bust it) */
81
30fe4f47 82#define BYTE_BITS 3
83#define LEAF_BITS (16 - BYTE_BITS)
84#define LEAF_MASK 0x1FFF
9fc9ab86 85
c07e8ef8 86typedef struct npath_node_st npath_node_t;
87struct npath_node_st {
88 npath_node_t *prev;
89 const void *id;
90 U8 type;
91 U8 flags;
92 UV seqn;
93 U16 depth;
94};
95
65db36c0 96struct state {
eee00145 97 UV total_size;
65db36c0 98 bool regex_whine;
99 bool fm_whine;
100 bool dangle_whine;
101 bool go_yell;
102 /* My hunch (not measured) is that for most architectures pointers will
103 start with 0 bits, hence the start of this array will be hot, and the
104 end unused. So put the flags next to the hot end. */
105 void *tracking[256];
5e2e22f3 106 NV start_time_nv;
05f432c0 107 int min_recurse_threshold;
c07e8ef8 108 /* callback hooks and data */
e9c43be8 109 void (*add_attr_cb)(pTHX_ struct state *st, npath_node_t *npath_node, UV attr_type, const char *name, UV value);
1abba8e9 110 void (*free_state_cb)(pTHX_ struct state *st);
c07e8ef8 111 void *state_cb_data; /* free'd by free_state() after free_state_cb() call */
5e486cae 112 /* this stuff wil be moved to state_cb_data later */
db644d73 113 UV seqn;
1abba8e9 114 FILE *node_stream_fh;
115 char *node_stream_name;
65db36c0 116};
117
e9c43be8 118#define ADD_SIZE(st, leafname, bytes) \
119 STMT_START { \
120 NPathAddSizeCb(st, leafname, bytes); \
121 (st)->total_size += (bytes); \
122 } STMT_END
123
c07e8ef8 124
125#define PATH_TRACKING
126#ifdef PATH_TRACKING
127
c07e8ef8 128#define pPATH npath_node_t *NPathArg
129
84cd88b0 130/* A subtle point here is that dNPathNodes and NPathPushNode leave NP pointing
012b5f33 131 * to the next unused slot (though with prev already filled in)
c07e8ef8 132 * whereas NPathLink leaves NP unchanged, it just fills in the slot NP points
133 * to and passes that NP value to the function being called.
84cd88b0 134 * seqn==0 indicates the node is new (hasn't been output yet)
c07e8ef8 135 */
136#define dNPathNodes(nodes, prev_np) \
137 npath_node_t name_path_nodes[nodes+1]; /* +1 for NPathLink */ \
138 npath_node_t *NP = &name_path_nodes[0]; \
84cd88b0 139 NP->seqn = NP->type = 0; NP->id = Nullch; /* safety/debug */ \
c07e8ef8 140 NP->prev = prev_np
012b5f33 141#define NPathPushNode(nodeid, nodetype) \
c07e8ef8 142 NP->id = nodeid; \
143 NP->type = nodetype; \
84cd88b0 144 NP->seqn = 0; \
012b5f33 145 if(0)fprintf(stderr,"NPathPushNode (%p <-) %p <- [%d %s]\n", NP->prev, NP, nodetype,(char*)nodeid);\
c07e8ef8 146 NP++; \
84cd88b0 147 NP->id = Nullch; /* safety/debug */ \
c07e8ef8 148 NP->seqn = 0; \
149 NP->prev = (NP-1)
012b5f33 150#define NPathSetNode(nodeid, nodetype) \
151 (NP-1)->id = nodeid; \
152 (NP-1)->type = nodetype; \
153 if(0)fprintf(stderr,"NPathSetNode (%p <-) %p <- [%d %s]\n", (NP-1)->prev, (NP-1), nodetype,(char*)nodeid);\
154 (NP-1)->seqn = 0;
1abba8e9 155#define NPathPopNode \
156 --NP
c07e8ef8 157
158/* dNPathUseParent points NP directly the the parents' name_path_nodes array
159 * So the function can only safely call ADD_*() but not NPathLink, unless the
160 * caller has spare nodes in its name_path_nodes.
161 */
162#define dNPathUseParent(prev_np) npath_node_t *NP = (((prev_np+1)->prev = prev_np), prev_np+1)
163
164#define NPtype_NAME 0x01
165#define NPtype_LINK 0x02
166#define NPtype_SV 0x03
167#define NPtype_MAGIC 0x04
168#define NPtype_OP 0x05
169
957d176b 170/* XXX these should probably be generalized into flag bits */
e8f4c506 171#define NPattr_LEAFSIZE 0x00
172#define NPattr_NAME 0x01
173#define NPattr_PADFAKE 0x02
174#define NPattr_PADNAME 0x03
175#define NPattr_PADTMP 0x04
1abba8e9 176#define NPattr_NOTE 0x05
93a78808 177
e9c43be8 178#define _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, np) \
179 STMT_START { \
180 if (st->add_attr_cb) { \
181 st->add_attr_cb(aTHX_ st, np, attr_type, attr_name, attr_value); \
182 } \
183 } STMT_END
184
957d176b 185#define ADD_ATTR(st, attr_type, attr_name, attr_value) \
186 _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP-1)
187
322b968f 188#define ADD_LINK_ATTR(st, attr_type, attr_name, attr_value) \
189 STMT_START { \
01f5c6f5 190 if (st->add_attr_cb) assert(NP->seqn); \
322b968f 191 _ADD_ATTR_NP(st, attr_type, attr_name, attr_value, NP); \
192 } STMT_END;
e8f4c506 193
ce5aa2b7 194#define _NPathLink(np, nid, ntype) (((np)->id=nid), ((np)->type=ntype), ((np)->seqn=0))
195#define NPathLink(nid) (_NPathLink(NP, nid, NPtype_LINK), NP)
196/* add a link and a name node to the path - a special case for op_size */
197#define NPathLinkAndNode(nid, nid2) (_NPathLink(NP, nid, NPtype_LINK), _NPathLink(NP+1, nid2, NPtype_NAME), ((NP+1)->prev=NP), (NP+1))
c07e8ef8 198#define NPathOpLink (NPathArg)
e9c43be8 199#define NPathAddSizeCb(st, name, bytes) \
200 STMT_START { \
201 if (st->add_attr_cb) { \
202 st->add_attr_cb(aTHX_ st, NP-1, NPattr_LEAFSIZE, (name), (bytes)); \
203 } \
204 } STMT_END
c07e8ef8 205
206#else
207
208#define NPathAddSizeCb(st, name, bytes)
209#define pPATH void *npath_dummy /* XXX ideally remove */
210#define dNPathNodes(nodes, prev_np) dNOOP
211#define NPathLink(nodeid, nodetype) NULL
212#define NPathOpLink NULL
213#define ADD_ATTR(st, attr_type, attr_name, attr_value) NOOP
214
215#endif /* PATH_TRACKING */
216
217
218
219
220#ifdef PATH_TRACKING
221
222static const char *svtypenames[SVt_LAST] = {
223#if PERL_VERSION < 9
224 "NULL", "IV", "NV", "RV", "PV", "PVIV", "PVNV", "PVMG", "PVBM", "PVLV", "PVAV", "PVHV", "PVCV", "PVGV", "PVFM", "PVIO",
225#elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
226 "NULL", "BIND", "IV", "NV", "RV", "PV", "PVIV", "PVNV", "PVMG", "PVGV", "PVLV", "PVAV", "PVHV", "PVCV", "PVFM", "PVIO",
227#elif PERL_VERSION == 10 && PERL_SUBVERSION == 1
228 "NULL", "BIND", "IV", "NV", "RV", "PV", "PVIV", "PVNV", "PVMG", "PVGV", "PVLV", "PVAV", "PVHV", "PVCV", "PVFM", "PVIO",
229#elif PERL_VERSION < 13
230 "NULL", "BIND", "IV", "NV", "PV", "PVIV", "PVNV", "PVMG", "REGEXP", "PVGV", "PVLV", "PVAV", "PVHV", "PVCV", "PVFM", "PVIO",
231#else
232 "NULL", "BIND", "IV", "NV", "PV", "PVIV", "PVNV", "PVMG", "REGEXP", "PVGV", "PVLV", "PVAV", "PVHV", "PVCV", "PVFM", "PVIO",
233#endif
234};
235
5e2e22f3 236static NV
237gettimeofday_nv(void)
238{
239#ifdef HAS_GETTIMEOFDAY
240 struct timeval when;
241 gettimeofday(&when, (struct timezone *) 0);
242 return when.tv_sec + (when.tv_usec / 1000000.0);
243#else
244 if (u2time) {
245 UV time_of_day[2];
246 (*u2time)(aTHX_ &time_of_day);
247 return time_of_day[0] + (time_of_day[1] / 1000000.0);
248 }
249 return (NV)time();
250#endif
251}
252
253
c07e8ef8 254int
60dacf5f 255np_print_node_name(pTHX_ FILE *fp, npath_node_t *npath_node)
c07e8ef8 256{
c07e8ef8 257 switch (npath_node->type) {
258 case NPtype_SV: { /* id is pointer to the SV sv_size was called on */
259 const SV *sv = (SV*)npath_node->id;
260 int type = SvTYPE(sv);
e9c43be8 261 const char *typename = (type == SVt_IV && SvROK(sv)) ? "RV" : svtypenames[type];
5e486cae 262 fprintf(fp, "SV(%s)", typename);
c07e8ef8 263 switch(type) { /* add some useful details */
5e486cae 264 case SVt_PVAV: fprintf(fp, " fill=%d/%ld", av_len((AV*)sv), AvMAX((AV*)sv)); break;
265 case SVt_PVHV: fprintf(fp, " fill=%ld/%ld", HvFILL((HV*)sv), HvMAX((HV*)sv)); break;
c07e8ef8 266 }
267 break;
268 }
269 case NPtype_OP: { /* id is pointer to the OP op_size was called on */
270 const OP *op = (OP*)npath_node->id;
5e486cae 271 fprintf(fp, "OP(%s)", OP_NAME(op));
c07e8ef8 272 break;
273 }
274 case NPtype_MAGIC: { /* id is pointer to the MAGIC struct */
275 MAGIC *magic_pointer = (MAGIC*)npath_node->id;
276 /* XXX it would be nice if we could reuse mg_names.c [sigh] */
5e486cae 277 fprintf(fp, "MAGIC(%c)", magic_pointer->mg_type ? magic_pointer->mg_type : '0');
c07e8ef8 278 break;
279 }
280 case NPtype_LINK:
e9c43be8 281 fprintf(fp, "%s", (const char *)npath_node->id);
c07e8ef8 282 break;
283 case NPtype_NAME:
e9c43be8 284 fprintf(fp, "%s", (const char *)npath_node->id);
c07e8ef8 285 break;
286 default: /* assume id is a string pointer */
5e486cae 287 fprintf(fp, "UNKNOWN(%d,%p)", npath_node->type, npath_node->id);
c07e8ef8 288 break;
289 }
290 return 0;
291}
292
293void
5e486cae 294np_dump_indent(int depth) {
c07e8ef8 295 while (depth-- > 0)
296 fprintf(stderr, ": ");
297}
298
299int
60dacf5f 300np_walk_new_nodes(pTHX_ struct state *st,
fc6614ee 301 npath_node_t *npath_node,
302 npath_node_t *npath_node_deeper,
60dacf5f 303 int (*cb)(pTHX_ struct state *st, npath_node_t *npath_node, npath_node_t *npath_node_deeper))
c07e8ef8 304{
305 if (npath_node->seqn) /* node already output */
fc6614ee 306 return 0;
c07e8ef8 307
308 if (npath_node->prev) {
60dacf5f 309 np_walk_new_nodes(aTHX_ st, npath_node->prev, npath_node, cb); /* recurse */
c07e8ef8 310 npath_node->depth = npath_node->prev->depth + 1;
311 }
312 else npath_node->depth = 0;
313 npath_node->seqn = ++st->seqn;
314
fc6614ee 315 if (cb) {
60dacf5f 316 if (cb(aTHX_ st, npath_node, npath_node_deeper)) {
fc6614ee 317 /* ignore this node */
318 assert(npath_node->prev);
319 assert(npath_node->depth);
320 assert(npath_node_deeper);
321 npath_node->depth--;
322 npath_node->seqn = --st->seqn;
323 npath_node_deeper->prev = npath_node->prev;
324 }
325 }
c07e8ef8 326
fc6614ee 327 return 0;
328}
329
330int
60dacf5f 331np_dump_formatted_node(pTHX_ struct state *st, npath_node_t *npath_node, npath_node_t *npath_node_deeper) {
e9c43be8 332 PERL_UNUSED_ARG(st);
333 PERL_UNUSED_ARG(npath_node_deeper);
fc6614ee 334 if (0 && npath_node->type == NPtype_LINK)
335 return 1;
336 np_dump_indent(npath_node->depth);
60dacf5f 337 np_print_node_name(aTHX_ stderr, npath_node);
1abba8e9 338 if (npath_node->type == NPtype_LINK)
339 fprintf(stderr, "->"); /* cosmetic */
fc6614ee 340 fprintf(stderr, "\t\t[#%ld @%u] ", npath_node->seqn, npath_node->depth);
341 fprintf(stderr, "\n");
342 return 0;
c07e8ef8 343}
344
e9c43be8 345void
60dacf5f 346np_dump_node_path_info(pTHX_ struct state *st, npath_node_t *npath_node, UV attr_type, const char *attr_name, UV attr_value)
c07e8ef8 347{
1abba8e9 348 if (attr_type == NPattr_LEAFSIZE && !attr_value)
e9c43be8 349 return; /* ignore zero sized leaf items */
60dacf5f 350 np_walk_new_nodes(aTHX_ st, npath_node, NULL, np_dump_formatted_node);
5e486cae 351 np_dump_indent(npath_node->depth+1);
1abba8e9 352 switch (attr_type) {
353 case NPattr_LEAFSIZE:
354 fprintf(stderr, "+%ld %s =%ld", attr_value, attr_name, attr_value+st->total_size);
355 break;
356 case NPattr_NAME:
c07e8ef8 357 fprintf(stderr, "~NAMED('%s') %lu", attr_name, attr_value);
1abba8e9 358 break;
359 case NPattr_NOTE:
360 fprintf(stderr, "~note %s %lu", attr_name, attr_value);
361 break;
362 case NPattr_PADTMP:
363 case NPattr_PADNAME:
364 case NPattr_PADFAKE:
365 fprintf(stderr, "~pad%lu %s %lu", attr_type, attr_name, attr_value);
366 break;
367 default:
368 fprintf(stderr, "~??? %s %lu", attr_name, attr_value);
369 break;
c07e8ef8 370 }
371 fprintf(stderr, "\n");
c07e8ef8 372}
373
5e486cae 374int
60dacf5f 375np_stream_formatted_node(pTHX_ struct state *st, npath_node_t *npath_node, npath_node_t *npath_node_deeper) {
e9c43be8 376 PERL_UNUSED_ARG(npath_node_deeper);
1abba8e9 377 fprintf(st->node_stream_fh, "-%u %lu %u ",
ee2793c1 378 npath_node->type, npath_node->seqn, (unsigned)npath_node->depth
5e486cae 379 );
60dacf5f 380 np_print_node_name(aTHX_ st->node_stream_fh, npath_node);
1abba8e9 381 fprintf(st->node_stream_fh, "\n");
5e486cae 382 return 0;
383}
384
e9c43be8 385void
60dacf5f 386np_stream_node_path_info(pTHX_ struct state *st, npath_node_t *npath_node, UV attr_type, const char *attr_name, UV attr_value)
5e486cae 387{
388 if (!attr_type && !attr_value)
e9c43be8 389 return; /* ignore zero sized leaf items */
60dacf5f 390 np_walk_new_nodes(aTHX_ st, npath_node, NULL, np_stream_formatted_node);
e8f4c506 391 if (attr_type) { /* Attribute type, name and value */
1abba8e9 392 fprintf(st->node_stream_fh, "%lu %lu ", attr_type, npath_node->seqn);
5e486cae 393 }
e8f4c506 394 else { /* Leaf name and memory size */
1abba8e9 395 fprintf(st->node_stream_fh, "L %lu ", npath_node->seqn);
5e486cae 396 }
1abba8e9 397 fprintf(st->node_stream_fh, "%lu %s\n", attr_value, attr_name);
5e486cae 398}
399
1abba8e9 400
c07e8ef8 401#endif /* PATH_TRACKING */
402
403
9fc9ab86 404/*
405 Checks to see if thing is in the bitstring.
406 Returns true or false, and
407 notes thing in the segmented bitstring.
408 */
2eb93d08 409static bool
a4efdff3 410check_new(struct state *st, const void *const p) {
30fe4f47 411 unsigned int bits = 8 * sizeof(void*);
412 const size_t raw_p = PTR2nat(p);
413 /* This effectively rotates the value right by the number of low always-0
414 bits in an aligned pointer. The assmption is that most (if not all)
415 pointers are aligned, and these will be in the same chain of nodes
416 (and hence hot in the cache) but we can still deal with any unaligned
417 pointers. */
418 const size_t cooked_p
f404ed48 419 = (raw_p >> ALIGN_BITS) | (raw_p << (bits - ALIGN_BITS));
30fe4f47 420 const U8 this_bit = 1 << (cooked_p & 0x7);
421 U8 **leaf_p;
422 U8 *leaf;
423 unsigned int i;
302077b6 424 void **tv_p = (void **) (st->tracking);
30fe4f47 425
302077b6 426 if (NULL == p) return FALSE;
1a36ac09 427 TRY_TO_CATCH_SEGV {
2eb93d08 428 const char c = *(const char *)p;
e9c43be8 429 PERL_UNUSED_VAR(c);
9fc9ab86 430 }
1a36ac09 431 CAUGHT_EXCEPTION {
a4efdff3 432 if (st->dangle_whine)
9fc9ab86 433 warn( "Devel::Size: Encountered invalid pointer: %p\n", p );
434 return FALSE;
435 }
9fc9ab86 436 TAG;
30fe4f47 437
438 bits -= 8;
439 /* bits now 24 (32 bit pointers) or 56 (64 bit pointers) */
440
441 /* First level is always present. */
442 do {
443 i = (unsigned int)((cooked_p >> bits) & 0xFF);
444 if (!tv_p[i])
445 Newxz(tv_p[i], 256, void *);
446 tv_p = (void **)(tv_p[i]);
447 bits -= 8;
448 } while (bits > LEAF_BITS + BYTE_BITS);
449 /* bits now 16 always */
5f04c81d 450#if !defined(MULTIPLICITY) || PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8)
451 /* 5.8.8 and early have an assert() macro that uses Perl_croak, hence needs
452 a my_perl under multiplicity */
30fe4f47 453 assert(bits == 16);
5f04c81d 454#endif
30fe4f47 455 leaf_p = (U8 **)tv_p;
456 i = (unsigned int)((cooked_p >> bits) & 0xFF);
457 if (!leaf_p[i])
458 Newxz(leaf_p[i], 1 << LEAF_BITS, U8);
459 leaf = leaf_p[i];
460
9fc9ab86 461 TAG;
30fe4f47 462
463 i = (unsigned int)((cooked_p >> BYTE_BITS) & LEAF_MASK);
464
465 if(leaf[i] & this_bit)
466 return FALSE;
467
468 leaf[i] |= this_bit;
9fc9ab86 469 return TRUE;
470}
471
e9716740 472static void
30fe4f47 473free_tracking_at(void **tv, int level)
474{
475 int i = 255;
476
477 if (--level) {
478 /* Nodes */
479 do {
480 if (tv[i]) {
384ebd3f 481 free_tracking_at((void **) tv[i], level);
30fe4f47 482 Safefree(tv[i]);
483 }
484 } while (i--);
485 } else {
486 /* Leaves */
487 do {
488 if (tv[i])
489 Safefree(tv[i]);
490 } while (i--);
491 }
492}
493
494static void
60dacf5f 495free_state(pTHX_ struct state *st)
e9716740 496{
30fe4f47 497 const int top_level = (sizeof(void *) * 8 - LEAF_BITS - BYTE_BITS) / 8;
c07e8ef8 498 if (st->free_state_cb)
60dacf5f 499 st->free_state_cb(aTHX_ st);
c07e8ef8 500 if (st->state_cb_data)
501 Safefree(st->state_cb_data);
a4efdff3 502 free_tracking_at((void **)st->tracking, top_level);
503 Safefree(st);
e9716740 504}
505
f3cf7e20 506/* For now, this is somewhat a compatibility bodge until the plan comes
507 together for fine grained recursion control. total_size() would recurse into
508 hash and array members, whereas sv_size() would not. However, sv_size() is
509 called with CvSTASH() of a CV, which means that if it (also) starts to
510 recurse fully, then the size of any CV now becomes the size of the entire
511 symbol table reachable from it, and potentially the entire symbol table, if
512 any subroutine makes a reference to a global (such as %SIG). The historical
513 implementation of total_size() didn't report "everything", and changing the
514 only available size to "everything" doesn't feel at all useful. */
515
516#define NO_RECURSION 0
517#define SOME_RECURSION 1
518#define TOTAL_SIZE_RECURSION 2
519
e386ab55 520static bool sv_size(pTHX_ struct state *, pPATH, const SV *const, const int recurse);
db519f11 521
7ccc7d88 522typedef enum {
9fc9ab86 523 OPc_NULL, /* 0 */
524 OPc_BASEOP, /* 1 */
525 OPc_UNOP, /* 2 */
526 OPc_BINOP, /* 3 */
527 OPc_LOGOP, /* 4 */
528 OPc_LISTOP, /* 5 */
529 OPc_PMOP, /* 6 */
530 OPc_SVOP, /* 7 */
531 OPc_PADOP, /* 8 */
532 OPc_PVOP, /* 9 */
533 OPc_LOOP, /* 10 */
534 OPc_COP /* 11 */
177ebd37 535#ifdef OA_CONDOP
536 , OPc_CONDOP /* 12 */
537#endif
538#ifdef OA_GVOP
539 , OPc_GVOP /* 13 */
540#endif
541
7ccc7d88 542} opclass;
543
544static opclass
9fc9ab86 545cc_opclass(const OP * const o)
7ccc7d88 546{
547 if (!o)
9fc9ab86 548 return OPc_NULL;
1a36ac09 549 TRY_TO_CATCH_SEGV {
9fc9ab86 550 if (o->op_type == 0)
551 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
7ccc7d88 552
9fc9ab86 553 if (o->op_type == OP_SASSIGN)
554 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
7ccc7d88 555
9fc9ab86 556 #ifdef USE_ITHREADS
557 if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
558 return OPc_PADOP;
559 #endif
7ccc7d88 560
9fc9ab86 561 if ((o->op_type == OP_TRANS)) {
562 return OPc_BASEOP;
563 }
7ccc7d88 564
9fc9ab86 565 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
566 case OA_BASEOP: TAG;
567 return OPc_BASEOP;
568
569 case OA_UNOP: TAG;
570 return OPc_UNOP;
571
572 case OA_BINOP: TAG;
573 return OPc_BINOP;
62691e7c 574
9fc9ab86 575 case OA_LOGOP: TAG;
576 return OPc_LOGOP;
7ccc7d88 577
9fc9ab86 578 case OA_LISTOP: TAG;
579 return OPc_LISTOP;
7ccc7d88 580
9fc9ab86 581 case OA_PMOP: TAG;
582 return OPc_PMOP;
7ccc7d88 583
9fc9ab86 584 case OA_SVOP: TAG;
585 return OPc_SVOP;
7ccc7d88 586
177ebd37 587#ifdef OA_PADOP
9fc9ab86 588 case OA_PADOP: TAG;
589 return OPc_PADOP;
177ebd37 590#endif
591
592#ifdef OA_GVOP
593 case OA_GVOP: TAG;
594 return OPc_GVOP;
595#endif
7ccc7d88 596
177ebd37 597#ifdef OA_PVOP_OR_SVOP
9fc9ab86 598 case OA_PVOP_OR_SVOP: TAG;
599 /*
600 * Character translations (tr///) are usually a PVOP, keeping a
601 * pointer to a table of shorts used to look up translations.
602 * Under utf8, however, a simple table isn't practical; instead,
603 * the OP is an SVOP, and the SV is a reference to a swash
604 * (i.e., an RV pointing to an HV).
605 */
606 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
607 ? OPc_SVOP : OPc_PVOP;
177ebd37 608#endif
7ccc7d88 609
9fc9ab86 610 case OA_LOOP: TAG;
611 return OPc_LOOP;
7ccc7d88 612
9fc9ab86 613 case OA_COP: TAG;
614 return OPc_COP;
7ccc7d88 615
9fc9ab86 616 case OA_BASEOP_OR_UNOP: TAG;
7ccc7d88 617 /*
9fc9ab86 618 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
619 * whether parens were seen. perly.y uses OPf_SPECIAL to
620 * signal whether a BASEOP had empty parens or none.
621 * Some other UNOPs are created later, though, so the best
622 * test is OPf_KIDS, which is set in newUNOP.
7ccc7d88 623 */
9fc9ab86 624 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
625
626 case OA_FILESTATOP: TAG;
627 /*
628 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
629 * the OPf_REF flag to distinguish between OP types instead of the
630 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
631 * return OPc_UNOP so that walkoptree can find our children. If
632 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
633 * (no argument to the operator) it's an OP; with OPf_REF set it's
634 * an SVOP (and op_sv is the GV for the filehandle argument).
635 */
636 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
637 #ifdef USE_ITHREADS
638 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
639 #else
640 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
641 #endif
642 case OA_LOOPEXOP: TAG;
643 /*
644 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
645 * label was omitted (in which case it's a BASEOP) or else a term was
646 * seen. In this last case, all except goto are definitely PVOP but
647 * goto is either a PVOP (with an ordinary constant label), an UNOP
648 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
649 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
650 * get set.
651 */
652 if (o->op_flags & OPf_STACKED)
653 return OPc_UNOP;
654 else if (o->op_flags & OPf_SPECIAL)
655 return OPc_BASEOP;
656 else
657 return OPc_PVOP;
177ebd37 658
659#ifdef OA_CONDOP
660 case OA_CONDOP: TAG;
661 return OPc_CONDOP;
662#endif
9fc9ab86 663 }
664 warn("Devel::Size: Can't determine class of operator %s, assuming BASEOP\n",
665 PL_op_name[o->op_type]);
666 }
1a36ac09 667 CAUGHT_EXCEPTION { }
7ccc7d88 668 return OPc_BASEOP;
669}
670
6a9ad7ec 671/* Figure out how much magic is attached to the SV and return the
672 size */
eee00145 673static void
c07e8ef8 674magic_size(pTHX_ const SV * const thing, struct state *st, pPATH) {
675 dNPathNodes(1, NPathArg);
7b782333 676 MAGIC *magic_pointer = SvMAGIC(thing); /* caller ensures thing is SvMAGICAL */
6ae4d038 677
012b5f33 678 /* push a dummy node for NPathSetNode to update inside the while loop */
679 NPathPushNode("dummy", NPtype_NAME);
680
980c6576 681 /* Have we seen the magic pointer? (NULL has always been seen before) */
e5c69bdd 682 while (check_new(st, magic_pointer)) {
c07e8ef8 683
012b5f33 684 NPathSetNode(magic_pointer, NPtype_MAGIC);
c07e8ef8 685
686 ADD_SIZE(st, "mg", sizeof(MAGIC));
9847261d 687 /* magic vtables aren't freed when magic is freed, so don't count them.
688 (They are static structures. Anything that assumes otherwise is buggy.)
689 */
690
6a9ad7ec 691
1a36ac09 692 TRY_TO_CATCH_SEGV {
6ae4d038 693 /* XXX only chase mg_obj if mg->mg_flags & MGf_REFCOUNTED ? */
fc6614ee 694 sv_size(aTHX_ st, NPathLink("mg_obj"), magic_pointer->mg_obj, TOTAL_SIZE_RECURSION);
d1888d0b 695 if (magic_pointer->mg_len == HEf_SVKEY) {
fc6614ee 696 sv_size(aTHX_ st, NPathLink("mg_ptr"), (SV *)magic_pointer->mg_ptr, TOTAL_SIZE_RECURSION);
d1888d0b 697 }
698#if defined(PERL_MAGIC_utf8) && defined (PERL_MAGIC_UTF8_CACHESIZE)
699 else if (magic_pointer->mg_type == PERL_MAGIC_utf8) {
700 if (check_new(st, magic_pointer->mg_ptr)) {
c07e8ef8 701 ADD_SIZE(st, "PERL_MAGIC_utf8", PERL_MAGIC_UTF8_CACHESIZE * 2 * sizeof(STRLEN));
d1888d0b 702 }
703 }
704#endif
6ae4d038 705 /* XXX also handle mg->mg_type == PERL_MAGIC_utf8 ? */
d1888d0b 706 else if (magic_pointer->mg_len > 0) {
6ae4d038 707 if(0)do_magic_dump(0, Perl_debug_log, magic_pointer, 0, 0, FALSE, 0);
d1888d0b 708 if (check_new(st, magic_pointer->mg_ptr)) {
c07e8ef8 709 ADD_SIZE(st, "mg_len", magic_pointer->mg_len);
d1888d0b 710 }
711 }
6a9ad7ec 712
0964064b 713 /* Get the next in the chain */
9fc9ab86 714 magic_pointer = magic_pointer->mg_moremagic;
715 }
1a36ac09 716 CAUGHT_EXCEPTION {
a4efdff3 717 if (st->dangle_whine)
9fc9ab86 718 warn( "Devel::Size: Encountered bad magic at: %p\n", magic_pointer );
719 }
6a9ad7ec 720 }
6a9ad7ec 721}
722
60dacf5f 723#define check_new_and_strlen(st, p, ppath) S_check_new_and_strlen(aTHX_ st, p, ppath)
eee00145 724static void
60dacf5f 725S_check_new_and_strlen(pTHX_ struct state *st, const char *const p, pPATH) {
c07e8ef8 726 dNPathNodes(1, NPathArg->prev);
727 if(check_new(st, p)) {
012b5f33 728 NPathPushNode(NPathArg->id, NPtype_NAME);
c07e8ef8 729 ADD_SIZE(st, NPathArg->id, 1 + strlen(p));
730 }
99684fd4 731}
732
733static void
60dacf5f 734regex_size(pTHX_ const REGEXP * const baseregex, struct state *st, pPATH) {
c07e8ef8 735 dNPathNodes(1, NPathArg);
c1bfd7da 736 if(!check_new(st, baseregex))
737 return;
012b5f33 738 NPathPushNode("regex_size", NPtype_NAME);
c07e8ef8 739 ADD_SIZE(st, "REGEXP", sizeof(REGEXP));
9fc9ab86 740#if (PERL_VERSION < 11)
6ea94d90 741 /* Note the size of the paren offset thing */
c07e8ef8 742 ADD_SIZE(st, "nparens", sizeof(I32) * baseregex->nparens * 2);
743 ADD_SIZE(st, "precomp", strlen(baseregex->precomp));
6ea94d90 744#else
c07e8ef8 745 ADD_SIZE(st, "regexp", sizeof(struct regexp));
746 ADD_SIZE(st, "nparens", sizeof(I32) * SvANY(baseregex)->nparens * 2);
747 /*ADD_SIZE(st, strlen(SvANY(baseregex)->subbeg));*/
6ea94d90 748#endif
a4efdff3 749 if (st->go_yell && !st->regex_whine) {
6ea94d90 750 carp("Devel::Size: Calculated sizes for compiled regexes are incompatible, and probably always will be");
a4efdff3 751 st->regex_whine = 1;
98ecbbc6 752 }
7ccc7d88 753}
754
957d176b 755static int
d4f77653 756hek_size(pTHX_ struct state *st, HEK *hek, U32 shared, pPATH)
757{
758 dNPathNodes(1, NPathArg);
759
760 /* Hash keys can be shared. Have we seen this before? */
761 if (!check_new(st, hek))
957d176b 762 return 0;
d4f77653 763 NPathPushNode("hek", NPtype_NAME);
764 ADD_SIZE(st, "hek_len", HEK_BASESIZE + hek->hek_len
765#if PERL_VERSION < 8
766 + 1 /* No hash key flags prior to 5.8.0 */
767#else
768 + 2
769#endif
770 );
771 if (shared) {
772#if PERL_VERSION < 10
773 ADD_SIZE(st, "he", sizeof(struct he));
774#else
775 ADD_SIZE(st, "shared_he", STRUCT_OFFSET(struct shared_he, shared_he_hek));
776#endif
777 }
957d176b 778 return 1;
d4f77653 779}
780
781static void
782refcounted_he_size(pTHX_ struct state *st, struct refcounted_he *he, pPATH)
783{
784 dNPathNodes(1, NPathArg);
785 if (!check_new(st, he))
786 return;
787 NPathPushNode("refcounted_he_size", NPtype_NAME);
788 ADD_SIZE(st, "refcounted_he", sizeof(struct refcounted_he));
789
790#ifdef USE_ITHREADS
791 ADD_SIZE(st, "refcounted_he_data", NPtype_NAME);
792#else
793 hek_size(aTHX_ st, he->refcounted_he_hek, 0, NPathLink("refcounted_he_hek"));
794#endif
795
796 if (he->refcounted_he_next)
797 refcounted_he_size(aTHX_ st, he->refcounted_he_next, NPathLink("refcounted_he_next"));
798}
799
c4e79872 800static void op_size_class(pTHX_ const OP * const baseop, opclass op_class, bool skip_op_struct, struct state *st, pPATH);
2bc82b43 801
d4f77653 802static void
c07e8ef8 803op_size(pTHX_ const OP * const baseop, struct state *st, pPATH)
1e5a8ad2 804{
c4e79872 805 op_size_class(aTHX_ baseop, cc_opclass(baseop), 0, st, NPathArg);
2bc82b43 806}
807
808static void
c4e79872 809op_size_class(pTHX_ const OP * const baseop, opclass op_class, bool skip_op_struct, struct state *st, pPATH)
2bc82b43 810{
ce5aa2b7 811 /* op_size recurses to follow the chain of opcodes. For the node path we
812 * don't want the chain to be 'nested' in the path so we use dNPathUseParent().
813 * Also, to avoid a link-to-a-link the caller should use NPathLinkAndNode()
814 * instead of NPathLink().
c07e8ef8 815 */
816 dNPathUseParent(NPathArg);
817
1e5a8ad2 818 TRY_TO_CATCH_SEGV {
819 TAG;
820 if(!check_new(st, baseop))
821 return;
822 TAG;
c07e8ef8 823 op_size(aTHX_ baseop->op_next, st, NPathOpLink);
66a76d3b 824#ifdef PELR_MAD
825 madprop_size(aTHX_ st, NPathOpLink, baseop->op_madprop);
826#endif
1e5a8ad2 827 TAG;
2bc82b43 828 switch (op_class) {
1e5a8ad2 829 case OPc_BASEOP: TAG;
c4e79872 830 if (!skip_op_struct)
831 ADD_SIZE(st, "op", sizeof(struct op));
1e5a8ad2 832 TAG;break;
833 case OPc_UNOP: TAG;
c4e79872 834 if (!skip_op_struct)
835 ADD_SIZE(st, "unop", sizeof(struct unop));
c07e8ef8 836 op_size(aTHX_ ((UNOP *)baseop)->op_first, st, NPathOpLink);
1e5a8ad2 837 TAG;break;
838 case OPc_BINOP: TAG;
c4e79872 839 if (!skip_op_struct)
840 ADD_SIZE(st, "binop", sizeof(struct binop));
c07e8ef8 841 op_size(aTHX_ ((BINOP *)baseop)->op_first, st, NPathOpLink);
842 op_size(aTHX_ ((BINOP *)baseop)->op_last, st, NPathOpLink);
1e5a8ad2 843 TAG;break;
844 case OPc_LOGOP: TAG;
c4e79872 845 if (!skip_op_struct)
846 ADD_SIZE(st, "logop", sizeof(struct logop));
c07e8ef8 847 op_size(aTHX_ ((BINOP *)baseop)->op_first, st, NPathOpLink);
848 op_size(aTHX_ ((LOGOP *)baseop)->op_other, st, NPathOpLink);
1e5a8ad2 849 TAG;break;
177ebd37 850#ifdef OA_CONDOP
851 case OPc_CONDOP: TAG;
c4e79872 852 if (!skip_op_struct)
853 ADD_SIZE(st, "condop", sizeof(struct condop));
c07e8ef8 854 op_size(aTHX_ ((BINOP *)baseop)->op_first, st, NPathOpLink);
855 op_size(aTHX_ ((CONDOP *)baseop)->op_true, st, NPathOpLink);
856 op_size(aTHX_ ((CONDOP *)baseop)->op_false, st, NPathOpLink);
177ebd37 857 TAG;break;
858#endif
1e5a8ad2 859 case OPc_LISTOP: TAG;
c4e79872 860 if (!skip_op_struct)
861 ADD_SIZE(st, "listop", sizeof(struct listop));
c07e8ef8 862 op_size(aTHX_ ((LISTOP *)baseop)->op_first, st, NPathOpLink);
863 op_size(aTHX_ ((LISTOP *)baseop)->op_last, st, NPathOpLink);
1e5a8ad2 864 TAG;break;
865 case OPc_PMOP: TAG;
c4e79872 866 if (!skip_op_struct)
867 ADD_SIZE(st, "pmop", sizeof(struct pmop));
c07e8ef8 868 op_size(aTHX_ ((PMOP *)baseop)->op_first, st, NPathOpLink);
869 op_size(aTHX_ ((PMOP *)baseop)->op_last, st, NPathOpLink);
5a83b7cf 870#if PERL_VERSION < 9 || (PERL_VERSION == 9 && PERL_SUBVERSION < 5)
c07e8ef8 871 op_size(aTHX_ ((PMOP *)baseop)->op_pmreplroot, st, NPathOpLink);
872 op_size(aTHX_ ((PMOP *)baseop)->op_pmreplstart, st, NPathOpLink);
5a83b7cf 873#endif
c1bfd7da 874 /* This is defined away in perl 5.8.x, but it is in there for
875 5.6.x */
98ecbbc6 876#ifdef PM_GETRE
60dacf5f 877 regex_size(aTHX_ PM_GETRE((PMOP *)baseop), st, NPathLink("PM_GETRE"));
98ecbbc6 878#else
60dacf5f 879 regex_size(aTHX_ ((PMOP *)baseop)->op_pmregexp, st, NPathLink("op_pmregexp"));
98ecbbc6 880#endif
c1bfd7da 881 TAG;break;
81f1c018 882 case OPc_SVOP: TAG;
c4e79872 883 if (!skip_op_struct)
884 ADD_SIZE(st, "svop", sizeof(struct svop));
574d9fd9 885 if (!(baseop->op_type == OP_AELEMFAST
886 && baseop->op_flags & OPf_SPECIAL)) {
887 /* not an OP_PADAV replacement */
fc6614ee 888 sv_size(aTHX_ st, NPathLink("SVOP"), ((SVOP *)baseop)->op_sv, SOME_RECURSION);
574d9fd9 889 }
81f1c018 890 TAG;break;
177ebd37 891#ifdef OA_PADOP
c4e79872 892 case OPc_PADOP: TAG;
893 if (!skip_op_struct)
894 ADD_SIZE(st, "padop", sizeof(struct padop));
895 TAG;break;
177ebd37 896#endif
897#ifdef OA_GVOP
c4e79872 898 case OPc_GVOP: TAG;
899 if (!skip_op_struct)
900 ADD_SIZE(st, "gvop", sizeof(struct gvop));
901 sv_size(aTHX_ st, NPathLink("GVOP"), ((GVOP *)baseop)->op_gv, SOME_RECURSION);
902 TAG;break;
177ebd37 903#endif
99684fd4 904 case OPc_PVOP: TAG;
fc6614ee 905 check_new_and_strlen(st, ((PVOP *)baseop)->op_pv, NPathLink("op_pv"));
219b7d34 906 TAG;break;
1e5a8ad2 907 case OPc_LOOP: TAG;
c4e79872 908 if (!skip_op_struct)
909 ADD_SIZE(st, "loop", sizeof(struct loop));
c07e8ef8 910 op_size(aTHX_ ((LOOP *)baseop)->op_first, st, NPathOpLink);
911 op_size(aTHX_ ((LOOP *)baseop)->op_last, st, NPathOpLink);
912 op_size(aTHX_ ((LOOP *)baseop)->op_redoop, st, NPathOpLink);
913 op_size(aTHX_ ((LOOP *)baseop)->op_nextop, st, NPathOpLink);
914 op_size(aTHX_ ((LOOP *)baseop)->op_lastop, st, NPathOpLink);
1e5a8ad2 915 TAG;break;
916 case OPc_COP: TAG;
9fc9ab86 917 {
918 COP *basecop;
b5b3464a 919 COPHH *hh;
9fc9ab86 920 basecop = (COP *)baseop;
c4e79872 921 if (!skip_op_struct)
922 ADD_SIZE(st, "cop", sizeof(struct cop));
9fc9ab86 923
924 /* Change 33656 by nicholas@mouse-mill on 2008/04/07 11:29:51
925 Eliminate cop_label from struct cop by storing a label as the first
926 entry in the hints hash. Most statements don't have labels, so this
927 will save memory. Not sure how much.
928 The check below will be incorrect fail on bleadperls
929 before 5.11 @33656, but later than 5.10, producing slightly too
930 small memory sizes on these Perls. */
b7621729 931#if (PERL_VERSION < 11)
fc6614ee 932 check_new_and_strlen(st, basecop->cop_label, NPathLink("cop_label"));
b7621729 933#endif
7ccc7d88 934#ifdef USE_ITHREADS
fc6614ee 935 check_new_and_strlen(st, basecop->cop_file, NPathLink("cop_file"));
936 check_new_and_strlen(st, basecop->cop_stashpv, NPathLink("cop_stashpv"));
7ccc7d88 937#else
49beddc6 938 if (SvREFCNT(basecop->cop_stash) == 1) /* XXX hack? */
939 sv_size(aTHX_ st, NPathLink("cop_stash"), (SV *)basecop->cop_stash, SOME_RECURSION);
fc6614ee 940 sv_size(aTHX_ st, NPathLink("cop_filegv"), (SV *)basecop->cop_filegv, SOME_RECURSION);
7ccc7d88 941#endif
942
b5b3464a 943 hh = CopHINTHASH_get(basecop);
944 refcounted_he_size(aTHX_ st, hh, NPathLink("cop_hints_hash"));
9fc9ab86 945 }
946 TAG;break;
947 default:
948 TAG;break;
949 }
950 }
1a36ac09 951 CAUGHT_EXCEPTION {
a4efdff3 952 if (st->dangle_whine)
9fc9ab86 953 warn( "Devel::Size: Encountered dangling pointer in opcode at: %p\n", baseop );
7ccc7d88 954 }
7ccc7d88 955}
6a9ad7ec 956
24638fb4 957#if PERL_VERSION < 8 || PERL_SUBVERSION < 9 /* XXX plain || seems like a bug */
b6558d1d 958# define SVt_LAST 16
24d37977 959#endif
960
f73dcfce 961#ifdef PURIFY
962# define MAYBE_PURIFY(normal, pure) (pure)
963# define MAYBE_OFFSET(struct_name, member) 0
964#else
965# define MAYBE_PURIFY(normal, pure) (normal)
966# define MAYBE_OFFSET(struct_name, member) STRUCT_OFFSET(struct_name, member)
967#endif
968
b6558d1d 969const U8 body_sizes[SVt_LAST] = {
970#if PERL_VERSION < 9
f73dcfce 971 0, /* SVt_NULL */
972 MAYBE_PURIFY(sizeof(IV), sizeof(XPVIV)), /* SVt_IV */
973 MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)), /* SVt_NV */
974 sizeof(XRV), /* SVt_RV */
975 sizeof(XPV), /* SVt_PV */
976 sizeof(XPVIV), /* SVt_PVIV */
977 sizeof(XPVNV), /* SVt_PVNV */
978 sizeof(XPVMG), /* SVt_PVMG */
979 sizeof(XPVBM), /* SVt_PVBM */
980 sizeof(XPVLV), /* SVt_PVLV */
981 sizeof(XPVAV), /* SVt_PVAV */
982 sizeof(XPVHV), /* SVt_PVHV */
983 sizeof(XPVCV), /* SVt_PVCV */
984 sizeof(XPVGV), /* SVt_PVGV */
985 sizeof(XPVFM), /* SVt_PVFM */
986 sizeof(XPVIO) /* SVt_PVIO */
b6558d1d 987#elif PERL_VERSION == 10 && PERL_SUBVERSION == 0
f73dcfce 988 0, /* SVt_NULL */
989 0, /* SVt_BIND */
990 0, /* SVt_IV */
991 MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)), /* SVt_NV */
992 0, /* SVt_RV */
993 MAYBE_PURIFY(sizeof(xpv_allocated), sizeof(XPV)), /* SVt_PV */
994 MAYBE_PURIFY(sizeof(xpviv_allocated), sizeof(XPVIV)),/* SVt_PVIV */
995 sizeof(XPVNV), /* SVt_PVNV */
996 sizeof(XPVMG), /* SVt_PVMG */
997 sizeof(XPVGV), /* SVt_PVGV */
998 sizeof(XPVLV), /* SVt_PVLV */
999 MAYBE_PURIFY(sizeof(xpvav_allocated), sizeof(XPVAV)),/* SVt_PVAV */
1000 MAYBE_PURIFY(sizeof(xpvhv_allocated), sizeof(XPVHV)),/* SVt_PVHV */
1001 MAYBE_PURIFY(sizeof(xpvcv_allocated), sizeof(XPVCV)),/* SVt_PVCV */
1002 MAYBE_PURIFY(sizeof(xpvfm_allocated), sizeof(XPVFM)),/* SVt_PVFM */
1003 sizeof(XPVIO), /* SVt_PVIO */
b6558d1d 1004#elif PERL_VERSION == 10 && PERL_SUBVERSION == 1
f73dcfce 1005 0, /* SVt_NULL */
1006 0, /* SVt_BIND */
1007 0, /* SVt_IV */
1008 MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)), /* SVt_NV */
1009 0, /* SVt_RV */
1010 sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PV */
1011 sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PVIV */
1012 sizeof(XPVNV), /* SVt_PVNV */
1013 sizeof(XPVMG), /* SVt_PVMG */
1014 sizeof(XPVGV), /* SVt_PVGV */
1015 sizeof(XPVLV), /* SVt_PVLV */
1016 sizeof(XPVAV) - MAYBE_OFFSET(XPVAV, xav_fill), /* SVt_PVAV */
1017 sizeof(XPVHV) - MAYBE_OFFSET(XPVHV, xhv_fill), /* SVt_PVHV */
1018 sizeof(XPVCV) - MAYBE_OFFSET(XPVCV, xpv_cur), /* SVt_PVCV */
1019 sizeof(XPVFM) - MAYBE_OFFSET(XPVFM, xpv_cur), /* SVt_PVFM */
1020 sizeof(XPVIO) /* SVt_PVIO */
b6558d1d 1021#elif PERL_VERSION < 13
f73dcfce 1022 0, /* SVt_NULL */
1023 0, /* SVt_BIND */
1024 0, /* SVt_IV */
1025 MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)), /* SVt_NV */
1026 sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PV */
1027 sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PVIV */
1028 sizeof(XPVNV), /* SVt_PVNV */
1029 sizeof(XPVMG), /* SVt_PVMG */
1030 sizeof(regexp) - MAYBE_OFFSET(regexp, xpv_cur), /* SVt_REGEXP */
1031 sizeof(XPVGV), /* SVt_PVGV */
1032 sizeof(XPVLV), /* SVt_PVLV */
1033 sizeof(XPVAV) - MAYBE_OFFSET(XPVAV, xav_fill), /* SVt_PVAV */
1034 sizeof(XPVHV) - MAYBE_OFFSET(XPVHV, xhv_fill), /* SVt_PVHV */
1035 sizeof(XPVCV) - MAYBE_OFFSET(XPVCV, xpv_cur), /* SVt_PVCV */
1036 sizeof(XPVFM) - MAYBE_OFFSET(XPVFM, xpv_cur), /* SVt_PVFM */
1037 sizeof(XPVIO) /* SVt_PVIO */
b6558d1d 1038#else
f73dcfce 1039 0, /* SVt_NULL */
1040 0, /* SVt_BIND */
1041 0, /* SVt_IV */
1042 MAYBE_PURIFY(sizeof(NV), sizeof(XPVNV)), /* SVt_NV */
1043 sizeof(XPV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PV */
1044 sizeof(XPVIV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PVIV */
1045 sizeof(XPVNV) - MAYBE_OFFSET(XPV, xpv_cur), /* SVt_PVNV */
1046 sizeof(XPVMG), /* SVt_PVMG */
1047 sizeof(regexp), /* SVt_REGEXP */
1048 sizeof(XPVGV), /* SVt_PVGV */
1049 sizeof(XPVLV), /* SVt_PVLV */
1050 sizeof(XPVAV), /* SVt_PVAV */
1051 sizeof(XPVHV), /* SVt_PVHV */
1052 sizeof(XPVCV), /* SVt_PVCV */
1053 sizeof(XPVFM), /* SVt_PVFM */
1054 sizeof(XPVIO) /* SVt_PVIO */
b6558d1d 1055#endif
1056};
1057
c07e8ef8 1058
8a087ef5 1059/* based on Perl_do_dump_pad() - wraps sv_size and adds ADD_ATTR calls for the pad names */
c07e8ef8 1060static void
1061padlist_size(pTHX_ struct state *const st, pPATH, PADLIST *padlist,
1062 const int recurse)
1063{
1064 dNPathUseParent(NPathArg);
c07e8ef8 1065 const AV *pad_name;
1066 SV **pname;
1067 I32 ix;
1068
d2181def 1069 if (!padlist)
1070 return;
1071 if( 0 && !check_new(st, padlist))
c07e8ef8 1072 return;
1869f459 1073
c07e8ef8 1074 pad_name = MUTABLE_AV(*av_fetch(MUTABLE_AV(padlist), 0, FALSE));
1075 pname = AvARRAY(pad_name);
1076
1077 for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
1078 const SV *namesv = pname[ix];
1079 if (namesv && namesv == &PL_sv_undef) {
1080 namesv = NULL;
1081 }
1082 if (namesv) {
d2181def 1083 /* SvFAKE: On a pad name SV, that slot in the frame AV is a REFCNT'ed reference to a lexical from "outside" */
c07e8ef8 1084 if (SvFAKE(namesv))
e8f4c506 1085 ADD_ATTR(st, NPattr_PADFAKE, SvPVX_const(namesv), ix);
c07e8ef8 1086 else
e8f4c506 1087 ADD_ATTR(st, NPattr_PADNAME, SvPVX_const(namesv), ix);
c07e8ef8 1088 }
1089 else {
e8f4c506 1090 ADD_ATTR(st, NPattr_PADTMP, "SVs_PADTMP", ix);
c07e8ef8 1091 }
1092
1093 }
1094 sv_size(aTHX_ st, NPathArg, (SV*)padlist, recurse);
1095}
1096
1097
e386ab55 1098static bool
c07e8ef8 1099sv_size(pTHX_ struct state *const st, pPATH, const SV * const orig_thing,
f3cf7e20 1100 const int recurse) {
9fc9ab86 1101 const SV *thing = orig_thing;
c07e8ef8 1102 dNPathNodes(3, NPathArg);
b6558d1d 1103 U32 type;
eee00145 1104
c07e8ef8 1105 if(!check_new(st, orig_thing))
e386ab55 1106 return 0;
81f1c018 1107
b6558d1d 1108 type = SvTYPE(thing);
1109 if (type > SVt_LAST) {
1110 warn("Devel::Size: Unknown variable type: %d encountered\n", type);
01f5c6f5 1111 return 0;
b6558d1d 1112 }
012b5f33 1113 NPathPushNode(thing, NPtype_SV);
df9491fe 1114 ADD_SIZE(st, "sv_head", sizeof(SV));
1115 ADD_SIZE(st, "sv_body", body_sizes[type]);
b1e5ad85 1116
b6558d1d 1117 switch (type) {
1118#if (PERL_VERSION < 11)
e98cedbf 1119 /* Is it a reference? */
9fc9ab86 1120 case SVt_RV: TAG;
b6558d1d 1121#else
1122 case SVt_IV: TAG;
24d37977 1123#endif
d2181def 1124 if(recurse && SvROK(thing)) /* XXX maybe don't follow weakrefs */
1125 sv_size(aTHX_ st, (SvWEAKREF(thing) ? NPathLink("weakRV") : NPathLink("RV")), SvRV_const(thing), recurse);
9fc9ab86 1126 TAG;break;
267703fd 1127
9fc9ab86 1128 case SVt_PVAV: TAG;
e98cedbf 1129 /* Is there anything in the array? */
1130 if (AvMAX(thing) != -1) {
c8db37d3 1131 /* an array with 10 slots has AvMax() set to 9 - te 2007-04-22 */
c07e8ef8 1132 ADD_SIZE(st, "av_max", sizeof(SV *) * (AvMAX(thing) + 1));
12ae883b 1133 ADD_ATTR(st, NPattr_NOTE, "av_len", av_len((AV*)thing));
eee00145 1134 dbg_printf(("total_size: %li AvMAX: %li av_len: $i\n", st->total_size, AvMAX(thing), av_len((AV*)thing)));
6c5ddc0d 1135
05f432c0 1136 if (recurse >= st->min_recurse_threshold) {
6c5ddc0d 1137 SSize_t i = AvFILLp(thing) + 1;
1138
93a78808 1139 while (i--) {
09c6d3bb 1140 if (sv_size(aTHX_ st, NPathLink("AVelem"), AvARRAY(thing)[i], recurse))
1141 ADD_LINK_ATTR(st, NPattr_NOTE, "i", i);
93a78808 1142 }
6c5ddc0d 1143 }
e98cedbf 1144 }
1145 /* Add in the bits on the other side of the beginning */
0430b7f7 1146
b7621729 1147 dbg_printf(("total_size %li, sizeof(SV *) %li, AvARRAY(thing) %li, AvALLOC(thing)%li , sizeof(ptr) %li \n",
c07e8ef8 1148 st->total_size, sizeof(SV*), AvARRAY(thing), AvALLOC(thing), sizeof( thing )));
0430b7f7 1149
1150 /* under Perl 5.8.8 64bit threading, AvARRAY(thing) was a pointer while AvALLOC was 0,
b1e5ad85 1151 resulting in grossly overstated sized for arrays. Technically, this shouldn't happen... */
0430b7f7 1152 if (AvALLOC(thing) != 0) {
c07e8ef8 1153 ADD_SIZE(st, "AvALLOC", (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))));
0430b7f7 1154 }
795fc84c 1155#if (PERL_VERSION < 9)
1156 /* Is there something hanging off the arylen element?
1157 Post 5.9.something this is stored in magic, so will be found there,
1158 and Perl_av_arylen_p() takes a non-const AV*, hence compilers rightly
1159 complain about AvARYLEN() passing thing to it. */
fc6614ee 1160 sv_size(aTHX_ st, NPathLink("ARYLEN"), AvARYLEN(thing), recurse);
795fc84c 1161#endif
9fc9ab86 1162 TAG;break;
49beddc6 1163
9fc9ab86 1164 case SVt_PVHV: TAG;
a6ea0805 1165 /* Now the array of buckets */
c07e8ef8 1166 if (HvENAME(thing)) {
e8f4c506 1167 ADD_ATTR(st, NPattr_NAME, HvENAME(thing), 0);
c07e8ef8 1168 }
c1829d33 1169 ADD_SIZE(st, "hv_max", (sizeof(HE *) * (HvMAX(thing) + 1)));
a6ea0805 1170 /* Now walk the bucket chain */
6a9ad7ec 1171 if (HvARRAY(thing)) {
a6ea0805 1172 HE *cur_entry;
9fc9ab86 1173 UV cur_bucket = 0;
c1829d33 1174
a6ea0805 1175 for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
9fc9ab86 1176 cur_entry = *(HvARRAY(thing) + cur_bucket);
1177 while (cur_entry) {
c1829d33 1178 NPathPushNode("he", NPtype_LINK);
1179 NPathPushNode("he+hek", NPtype_NAME);
c07e8ef8 1180 ADD_SIZE(st, "he", sizeof(HE));
fc6614ee 1181 hek_size(aTHX_ st, cur_entry->hent_hek, HvSHAREKEYS(thing), NPathLink("hent_hek"));
05f432c0 1182 if (recurse >= st->min_recurse_threshold) {
d3b8a135 1183 if (orig_thing == (SV*)PL_strtab) {
df9491fe 1184 /* For PL_strtab the HeVAL is used as a refcnt */
1185 ADD_SIZE(st, "shared_hek", HeKLEN(cur_entry));
1186 }
1187 else {
2c631ee0 1188/* I've seen a PL_strtab HeVAL == 0xC and 0x40C etc
5e486cae 1189 * just running perl -Mblib -Mstrict -MDevel::Size=:all -MCarp -e 'warn perl_size()'
1190 * but it seemed like a corruption - it would change come and go with irrelevant code changes.
1191 * so we protect against that here, but I'd like to know the cause.
1192 */
2c631ee0 1193if (PTR2UV(HeVAL(cur_entry)) > 0xFFF)
fc6614ee 1194 sv_size(aTHX_ st, NPathLink("HeVAL"), HeVAL(cur_entry), recurse);
b6ec3c3a 1195else warn("skipped suspect HeVAL %p", HeVAL(cur_entry));
df9491fe 1196 }
5e486cae 1197 }
9fc9ab86 1198 cur_entry = cur_entry->hent_next;
c1829d33 1199 NPathPopNode;
1200 NPathPopNode;
9fc9ab86 1201 }
c1829d33 1202 } /* bucket chain */
a6ea0805 1203 }
c1829d33 1204
78037efb 1205#ifdef HvAUX
1206 if (SvOOK(thing)) {
1207 /* This direct access is arguably "naughty": */
1208 struct mro_meta *meta = HvAUX(thing)->xhv_mro_meta;
24638fb4 1209#if PERL_VERSION > 13 || PERL_SUBVERSION > 8 /* XXX plain || seems like a bug */
b3a37f1a 1210 /* As is this: */
1211 I32 count = HvAUX(thing)->xhv_name_count;
1212
1213 if (count) {
1214 HEK **names = HvAUX(thing)->xhv_name_u.xhvnameu_names;
1215 if (count < 0)
1216 count = -count;
1217 while (--count)
fc6614ee 1218 hek_size(aTHX_ st, names[count], 1, NPathLink("HvAUXelem"));
b3a37f1a 1219 }
1220 else
1221#endif
1222 {
fc6614ee 1223 hek_size(aTHX_ st, HvNAME_HEK(thing), 1, NPathLink("HvNAME_HEK"));
b3a37f1a 1224 }
1225
c07e8ef8 1226 ADD_SIZE(st, "xpvhv_aux", sizeof(struct xpvhv_aux));
78037efb 1227 if (meta) {
c07e8ef8 1228 ADD_SIZE(st, "mro_meta", sizeof(struct mro_meta));
fc6614ee 1229 sv_size(aTHX_ st, NPathLink("mro_nextmethod"), (SV *)meta->mro_nextmethod, TOTAL_SIZE_RECURSION);
78037efb 1230#if PERL_VERSION > 10 || (PERL_VERSION == 10 && PERL_SUBVERSION > 0)
fc6614ee 1231 sv_size(aTHX_ st, NPathLink("isa"), (SV *)meta->isa, TOTAL_SIZE_RECURSION);
78037efb 1232#endif
1233#if PERL_VERSION > 10
fc6614ee 1234 sv_size(aTHX_ st, NPathLink("mro_linear_all"), (SV *)meta->mro_linear_all, TOTAL_SIZE_RECURSION);
1235 sv_size(aTHX_ st, NPathLink("mro_linear_current"), meta->mro_linear_current, TOTAL_SIZE_RECURSION);
78037efb 1236#else
fc6614ee 1237 sv_size(aTHX_ st, NPathLink("mro_linear_dfs"), (SV *)meta->mro_linear_dfs, TOTAL_SIZE_RECURSION);
1238 sv_size(aTHX_ st, NPathLink("mro_linear_c3"), (SV *)meta->mro_linear_c3, TOTAL_SIZE_RECURSION);
78037efb 1239#endif
1240 }
1241 }
1242#else
fc6614ee 1243 check_new_and_strlen(st, HvNAME_get(thing), NPathLink("HvNAME"));
78037efb 1244#endif
9fc9ab86 1245 TAG;break;
267703fd 1246
1247
1248 case SVt_PVFM: TAG;
eb73dc89 1249 padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), recurse);
36a03132 1250 sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), SOME_RECURSION);
267703fd 1251
1252 if (st->go_yell && !st->fm_whine) {
1253 carp("Devel::Size: Calculated sizes for FMs are incomplete");
1254 st->fm_whine = 1;
1255 }
1256 goto freescalar;
1257
9fc9ab86 1258 case SVt_PVCV: TAG;
336fdadd 1259 /* not CvSTASH, per https://rt.cpan.org/Ticket/Display.html?id=79366 */
93a78808 1260 ADD_ATTR(st, NPattr_NAME, CvGV(thing) ? GvNAME(CvGV(thing)) : "UNDEFINED", 0);
fc6614ee 1261 sv_size(aTHX_ st, NPathLink("CvGV"), (SV *)CvGV(thing), SOME_RECURSION);
eb73dc89 1262 padlist_size(aTHX_ st, NPathLink("CvPADLIST"), CvPADLIST(thing), recurse);
36a03132 1263 sv_size(aTHX_ st, NPathLink("CvOUTSIDE"), (SV *)CvOUTSIDE(thing), SOME_RECURSION);
66f50dda 1264 if (CvISXSUB(thing)) {
fc6614ee 1265 sv_size(aTHX_ st, NPathLink("cv_const_sv"), cv_const_sv((CV *)thing), recurse);
66f50dda 1266 } else {
ce5aa2b7 1267 if(1)op_size(aTHX_ CvSTART(thing), st, NPathLinkAndNode("CvSTART", "OPs")); /* XXX ? */
1268 op_size(aTHX_ CvROOT(thing), st, NPathLinkAndNode("CvROOT", "OPs"));
7ccc7d88 1269 }
267703fd 1270 goto freescalar;
1271
1272 case SVt_PVIO: TAG;
267703fd 1273 /* Some embedded char pointers */
fc6614ee 1274 check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_top_name, NPathLink("xio_top_name"));
1275 check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_fmt_name, NPathLink("xio_fmt_name"));
1276 check_new_and_strlen(st, ((XPVIO *) SvANY(thing))->xio_bottom_name, NPathLink("xio_bottom_name"));
267703fd 1277 /* Throw the GVs on the list to be walked if they're not-null */
fc6614ee 1278 sv_size(aTHX_ st, NPathLink("xio_top_gv"), (SV *)((XPVIO *) SvANY(thing))->xio_top_gv, recurse);
1279 sv_size(aTHX_ st, NPathLink("xio_bottom_gv"), (SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, recurse);
1280 sv_size(aTHX_ st, NPathLink("xio_fmt_gv"), (SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, recurse);
267703fd 1281
1282 /* Only go trotting through the IO structures if they're really
1283 trottable. If USE_PERLIO is defined we can do this. If
1284 not... we can't, so we don't even try */
1285#ifdef USE_PERLIO
1286 /* Dig into xio_ifp and xio_ofp here */
1287 warn("Devel::Size: Can't size up perlio layers yet\n");
1288#endif
1289 goto freescalar;
1290
267703fd 1291 case SVt_PVLV: TAG;
267703fd 1292#if (PERL_VERSION < 9)
1293 goto freescalar;
267703fd 1294#endif
7ccc7d88 1295
9fc9ab86 1296 case SVt_PVGV: TAG;
4a3d023d 1297 if(isGV_with_GP(thing)) {
638a265a 1298#ifdef GvNAME_HEK
fc6614ee 1299 hek_size(aTHX_ st, GvNAME_HEK(thing), 1, NPathLink("GvNAME_HEK"));
638a265a 1300#else
c07e8ef8 1301 ADD_SIZE(st, "GvNAMELEN", GvNAMELEN(thing));
638a265a 1302#endif
e8f4c506 1303 ADD_ATTR(st, NPattr_NAME, GvNAME_get(thing), 0);
15588e9c 1304#ifdef GvFILE_HEK
fc6614ee 1305 hek_size(aTHX_ st, GvFILE_HEK(thing), 1, NPathLink("GvFILE_HEK"));
15588e9c 1306#elif defined(GvFILE)
2b217e71 1307# if !defined(USE_ITHREADS) || (PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 8))
1308 /* With itreads, before 5.8.9, this can end up pointing to freed memory
1309 if the GV was created in an eval, as GvFILE() points to CopFILE(),
1310 and the relevant COP has been freed on scope cleanup after the eval.
1311 5.8.9 adds a binary compatible fudge that catches the vast majority
1312 of cases. 5.9.something added a proper fix, by converting the GP to
1313 use a shared hash key (porperly reference counted), instead of a
1314 char * (owned by who knows? possibly no-one now) */
fc6614ee 1315 check_new_and_strlen(st, GvFILE(thing), NPathLink("GvFILE"));
2b217e71 1316# endif
78dfb4e7 1317#endif
4a3d023d 1318 /* Is there something hanging off the glob? */
1319 if (check_new(st, GvGP(thing))) {
c07e8ef8 1320 ADD_SIZE(st, "GP", sizeof(GP));
fc6614ee 1321 sv_size(aTHX_ st, NPathLink("gp_sv"), (SV *)(GvGP(thing)->gp_sv), recurse);
fc6614ee 1322 sv_size(aTHX_ st, NPathLink("gp_av"), (SV *)(GvGP(thing)->gp_av), recurse);
1323 sv_size(aTHX_ st, NPathLink("gp_hv"), (SV *)(GvGP(thing)->gp_hv), recurse);
fc6614ee 1324 sv_size(aTHX_ st, NPathLink("gp_cv"), (SV *)(GvGP(thing)->gp_cv), recurse);
49beddc6 1325 sv_size(aTHX_ st, NPathLink("gp_egv"), (SV *)(GvGP(thing)->gp_egv), recurse);
1326 sv_size(aTHX_ st, NPathLink("gp_form"), (SV *)(GvGP(thing)->gp_form), recurse);
4a3d023d 1327 }
267703fd 1328#if (PERL_VERSION >= 9)
1329 TAG; break;
1330#endif
5c2e1b12 1331 }
b6558d1d 1332#if PERL_VERSION <= 8
1333 case SVt_PVBM: TAG;
1334#endif
267703fd 1335 case SVt_PVMG: TAG;
267703fd 1336 case SVt_PVNV: TAG;
267703fd 1337 case SVt_PVIV: TAG;
267703fd 1338 case SVt_PV: TAG;
267703fd 1339 freescalar:
1340 if(recurse && SvROK(thing))
fc6614ee 1341 sv_size(aTHX_ st, NPathLink("RV"), SvRV_const(thing), recurse);
924d9c4e 1342 else if (SvIsCOW_shared_hash(thing))
fc6614ee 1343 hek_size(aTHX_ st, SvSHARED_HEK_FROM_PV(SvPVX(thing)), 1, NPathLink("SvSHARED_HEK_FROM_PV"));
267703fd 1344 else
c07e8ef8 1345 ADD_SIZE(st, "SvLEN", SvLEN(thing));
267703fd 1346
1347 if(SvOOK(thing)) {
95dc1714 1348 STRLEN len;
1349 SvOOK_offset(thing, len);
c07e8ef8 1350 ADD_SIZE(st, "SvOOK", len);
ebb2c5b9 1351 }
9fc9ab86 1352 TAG;break;
5073b933 1353
e98cedbf 1354 }
49beddc6 1355
1356 if (type >= SVt_PVMG) {
7b782333 1357 if (SvMAGICAL(thing))
49beddc6 1358 magic_size(aTHX_ thing, st, NPathLink("MG"));
c922539f 1359 if (SvPAD_OUR(thing) && SvOURSTASH(thing))
1360 sv_size(aTHX_ st, NPathLink("SvOURSTASH"), (SV *)SvOURSTASH(thing), SOME_RECURSION);
7c8a009a 1361 if (SvSTASH(thing))
1362 sv_size(aTHX_ st, NPathLink("SvSTASH"), (SV *)SvSTASH(thing), SOME_RECURSION);
49beddc6 1363 }
1364
e386ab55 1365 return 1;
e98cedbf 1366}
1367
1abba8e9 1368static void
1369free_memnode_state(pTHX_ struct state *st)
1370{
322b968f 1371 /* PERL_UNUSED_ARG(aTHX); fails for non-threaded perl */
d3b8a135 1372 if (st->node_stream_fh && st->node_stream_name && *st->node_stream_name) {
09c6d3bb 1373 fprintf(st->node_stream_fh, "E %d %f %s\n",
5e2e22f3 1374 getpid(), gettimeofday_nv()-st->start_time_nv, "unnamed");
1abba8e9 1375 if (*st->node_stream_name == '|') {
1376 if (pclose(st->node_stream_fh))
1377 warn("%s exited with an error status\n", st->node_stream_name);
1378 }
1379 else {
1380 if (fclose(st->node_stream_fh))
1381 warn("Error closing %s: %s\n", st->node_stream_name, strerror(errno));
1382 }
1383 }
1384}
1385
a4efdff3 1386static struct state *
1387new_state(pTHX)
65db36c0 1388{
1389 SV *warn_flag;
a4efdff3 1390 struct state *st;
d9b022a1 1391
a4efdff3 1392 Newxz(st, 1, struct state);
1393 st->go_yell = TRUE;
05f432c0 1394 st->min_recurse_threshold = TOTAL_SIZE_RECURSION;
65db36c0 1395 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
a4efdff3 1396 st->dangle_whine = st->go_yell = SvIV(warn_flag) ? TRUE : FALSE;
65db36c0 1397 }
1398 if (NULL != (warn_flag = perl_get_sv("Devel::Size::dangle", FALSE))) {
a4efdff3 1399 st->dangle_whine = SvIV(warn_flag) ? TRUE : FALSE;
65db36c0 1400 }
5e2e22f3 1401 st->start_time_nv = gettimeofday_nv();
a52ceccd 1402 check_new(st, &PL_sv_undef);
1403 check_new(st, &PL_sv_no);
1404 check_new(st, &PL_sv_yes);
6389ea67 1405#if PERL_VERSION > 8 || (PERL_VERSION == 8 && PERL_SUBVERSION > 0)
1406 check_new(st, &PL_sv_placeholder);
1407#endif
d3b8a135 1408
33f2f60c 1409#ifdef PATH_TRACKING
d3b8a135 1410 /* XXX quick hack */
0e977dbc 1411 st->node_stream_name = getenv("SIZEME");
d3b8a135 1412 if (st->node_stream_name) {
1413 if (*st->node_stream_name) {
1414 if (*st->node_stream_name == '|')
1415 st->node_stream_fh = popen(st->node_stream_name+1, "w");
1416 else
1417 st->node_stream_fh = fopen(st->node_stream_name, "wb");
1418 if (!st->node_stream_fh)
1419 croak("Can't open '%s' for writing: %s", st->node_stream_name, strerror(errno));
5e2e22f3 1420 if(0)setlinebuf(st->node_stream_fh); /* XXX temporary for debugging */
d3b8a135 1421 st->add_attr_cb = np_stream_node_path_info;
09c6d3bb 1422 fprintf(st->node_stream_fh, "S %d %f %s\n",
5e2e22f3 1423 getpid(), st->start_time_nv, "unnamed");
d3b8a135 1424 }
1425 else
1426 st->add_attr_cb = np_dump_node_path_info;
1abba8e9 1427 }
1abba8e9 1428 st->free_state_cb = free_memnode_state;
33f2f60c 1429#endif
d3b8a135 1430
a4efdff3 1431 return st;
65db36c0 1432}
1433
1abba8e9 1434/* XXX based on S_visit() in sv.c */
1435static void
1436unseen_sv_size(pTHX_ struct state *st, pPATH)
1437{
1438 dVAR;
1439 SV* sva;
1abba8e9 1440 dNPathNodes(1, NPathArg);
1441
1442 NPathPushNode("unseen", NPtype_NAME);
1443
1444 /* by this point we should have visited all the SVs
1445 * so now we'll run through all the SVs via the arenas
21058011 1446 * in order to find any that we've missed for some reason.
1447 * Once the rest of the code is finding ALL the SVs then any
1abba8e9 1448 * found here will be leaks.
1449 */
1450 for (sva = PL_sv_arenaroot; sva; sva = MUTABLE_SV(SvANY(sva))) {
1451 const SV * const svend = &sva[SvREFCNT(sva)];
1452 SV* sv;
1453 for (sv = sva + 1; sv < svend; ++sv) {
1454 if (SvTYPE(sv) != (svtype)SVTYPEMASK && SvREFCNT(sv)) {
49beddc6 1455 sv_size(aTHX_ st, NPathLink("arena"), sv, TOTAL_SIZE_RECURSION);
1abba8e9 1456 }
1457 else if (check_new(st, sv)) { /* sanity check */
1abba8e9 1458 sv_dump(sv);
df9491fe 1459 warn("unseen_sv_size encountered freed SV unexpectedly"); /* XXX warn uses an SV, I think */
1abba8e9 1460 }
1461 }
1462 }
1463}
1464
66a76d3b 1465#ifdef PERL_MAD
1466static void
1467madprop_size(pTHX_ struct state *const st, pPath, MADPROP *prop)
1468{
1469 dPathNodes(2, NPathArg);
1470 if (!check_new(st, prop))
1471 return;
1472 NPathPushNode("madprop_size", NPtype_NAME);
1473 ADD_SIZE(st, "MADPROP", sizeof(MADPROP));
1474
1475 NPathPushNode("val");
1476 ADD_SIZE(st, "val", prop->mad_val);
1477 if (prop->mad_next)
1478 madprop_size(aTHX_ st, NPathLink("mad_next"), prop->mad_next);
1479}
1480#endif
1481
1482static void
1483parser_size(pTHX_ struct state *const st, pPATH, yy_parser *parser)
1484{
1485 dNPathNodes(2, NPathArg);
66a76d3b 1486 if (!check_new(st, parser))
1487 return;
1488 NPathPushNode("parser_size", NPtype_NAME);
1489 ADD_SIZE(st, "yy_parser", sizeof(yy_parser));
1490
1491 NPathPushNode("stack", NPtype_NAME);
1492 yy_stack_frame *ps;
1493 //warn("total: %u", parser->stack_size);
1494 //warn("foo: %u", parser->ps - parser->stack);
b42bdc95 1495 ADD_SIZE(st, "stack_frames", parser->stack_size * sizeof(yy_stack_frame));
66a76d3b 1496 for (ps = parser->stack; ps <= parser->ps; ps++) {
21058011 1497 if (sv_size(aTHX_ st, NPathLink("compcv"), (SV*)ps->compcv, TOTAL_SIZE_RECURSION))
1498 ADD_LINK_ATTR(st, NPattr_NOTE, "i", ps - parser->ps);
66a76d3b 1499 }
1500 NPathPopNode;
1501
1502 sv_size(aTHX_ st, NPathLink("lex_repl"), (SV*)parser->lex_repl, TOTAL_SIZE_RECURSION);
1503 sv_size(aTHX_ st, NPathLink("lex_stuff"), (SV*)parser->lex_stuff, TOTAL_SIZE_RECURSION);
1504 sv_size(aTHX_ st, NPathLink("linestr"), (SV*)parser->linestr, TOTAL_SIZE_RECURSION);
1505 sv_size(aTHX_ st, NPathLink("in_my_stash"), (SV*)parser->in_my_stash, TOTAL_SIZE_RECURSION);
e9c43be8 1506 //sv_size(aTHX_ st, NPathLink("rsfp"), parser->rsfp, TOTAL_SIZE_RECURSION);
1507 sv_size(aTHX_ st, NPathLink("rsfp_filters"), (SV*)parser->rsfp_filters, TOTAL_SIZE_RECURSION);
66a76d3b 1508#ifdef PERL_MAD
1509 sv_size(aTHX_ st, NPathLink("endwhite"), parser->endwhite, TOTAL_SIZE_RECURSION);
1510 sv_size(aTHX_ st, NPathLink("nextwhite"), parser->nextwhite, TOTAL_SIZE_RECURSION);
1511 sv_size(aTHX_ st, NPathLink("skipwhite"), parser->skipwhite, TOTAL_SIZE_RECURSION);
1512 sv_size(aTHX_ st, NPathLink("thisclose"), parser->thisclose, TOTAL_SIZE_RECURSION);
1513 madprop_size(aTHX_ st, NPathLink("thismad"), parser->thismad);
1514 sv_size(aTHX_ st, NPathLink("thisopen"), parser->thisopen, TOTAL_SIZE_RECURSION);
1515 sv_size(aTHX_ st, NPathLink("thisstuff"), parser->thisstuff, TOTAL_SIZE_RECURSION);
1516 sv_size(aTHX_ st, NPathLink("thistoken"), parser->thistoken, TOTAL_SIZE_RECURSION);
1517 sv_size(aTHX_ st, NPathLink("thiswhite"), parser->thiswhite, TOTAL_SIZE_RECURSION);
1518#endif
1519 op_size_class(aTHX_ (OP*)parser->saved_curcop, OPc_COP, 0,
1520 st, NPathLink("saved_curcop"));
1521
1522 if (parser->old_parser)
1523 parser_size(aTHX_ st, NPathLink("old_parser"), parser->old_parser);
1524}
1525
df9491fe 1526static void
1527perl_size(pTHX_ struct state *const st, pPATH)
33f2f60c 1528{
df9491fe 1529 dNPathNodes(3, NPathArg);
05f432c0 1530
df9491fe 1531 /* if(!check_new(st, interp)) return; */
1532 NPathPushNode("perl", NPtype_NAME);
e162a822 1533#if defined(MULTIPLICITY)
1534 ADD_SIZE(st, "PerlInterpreter", sizeof(PerlInterpreter));
1535#endif
df9491fe 1536/*
1537 * perl
1538 * PL_defstash
1539 * others
1540 * unknown <== = O/S Heap size - perl - free_malloc_space
1541 */
1abba8e9 1542 /* start with PL_defstash to get everything reachable from \%main:: */
fc6614ee 1543 sv_size(aTHX_ st, NPathLink("PL_defstash"), (SV*)PL_defstash, TOTAL_SIZE_RECURSION);
e8f4c506 1544
1545 NPathPushNode("others", NPtype_NAME); /* group these (typically much smaller) items */
fc6614ee 1546 sv_size(aTHX_ st, NPathLink("PL_defgv"), (SV*)PL_defgv, TOTAL_SIZE_RECURSION);
1547 sv_size(aTHX_ st, NPathLink("PL_incgv"), (SV*)PL_incgv, TOTAL_SIZE_RECURSION);
1548 sv_size(aTHX_ st, NPathLink("PL_rs"), (SV*)PL_rs, TOTAL_SIZE_RECURSION);
1549 sv_size(aTHX_ st, NPathLink("PL_fdpid"), (SV*)PL_fdpid, TOTAL_SIZE_RECURSION);
1550 sv_size(aTHX_ st, NPathLink("PL_modglobal"), (SV*)PL_modglobal, TOTAL_SIZE_RECURSION);
1551 sv_size(aTHX_ st, NPathLink("PL_errors"), (SV*)PL_errors, TOTAL_SIZE_RECURSION);
1552 sv_size(aTHX_ st, NPathLink("PL_stashcache"), (SV*)PL_stashcache, TOTAL_SIZE_RECURSION);
1553 sv_size(aTHX_ st, NPathLink("PL_patchlevel"), (SV*)PL_patchlevel, TOTAL_SIZE_RECURSION);
1554 sv_size(aTHX_ st, NPathLink("PL_apiversion"), (SV*)PL_apiversion, TOTAL_SIZE_RECURSION);
1555 sv_size(aTHX_ st, NPathLink("PL_registered_mros"), (SV*)PL_registered_mros, TOTAL_SIZE_RECURSION);
33f2f60c 1556#ifdef USE_ITHREADS
fc6614ee 1557 sv_size(aTHX_ st, NPathLink("PL_regex_padav"), (SV*)PL_regex_padav, TOTAL_SIZE_RECURSION);
33f2f60c 1558#endif
8a087ef5 1559 sv_size(aTHX_ st, NPathLink("PL_warnhook"), (SV*)PL_warnhook, TOTAL_SIZE_RECURSION);
1560 sv_size(aTHX_ st, NPathLink("PL_diehook"), (SV*)PL_diehook, TOTAL_SIZE_RECURSION);
1561 sv_size(aTHX_ st, NPathLink("PL_endav"), (SV*)PL_endav, TOTAL_SIZE_RECURSION);
1562 sv_size(aTHX_ st, NPathLink("PL_main_cv"), (SV*)PL_main_cv, TOTAL_SIZE_RECURSION);
1563 sv_size(aTHX_ st, NPathLink("PL_main_root"), (SV*)PL_main_root, TOTAL_SIZE_RECURSION);
1564 sv_size(aTHX_ st, NPathLink("PL_main_start"), (SV*)PL_main_start, TOTAL_SIZE_RECURSION);
b7cb716a 1565 sv_size(aTHX_ st, NPathLink("PL_envgv"), (SV*)PL_envgv, TOTAL_SIZE_RECURSION);
1566 sv_size(aTHX_ st, NPathLink("PL_hintgv"), (SV*)PL_hintgv, TOTAL_SIZE_RECURSION);
1567 sv_size(aTHX_ st, NPathLink("PL_e_script"), (SV*)PL_e_script, TOTAL_SIZE_RECURSION);
1568 sv_size(aTHX_ st, NPathLink("PL_encoding"), (SV*)PL_encoding, TOTAL_SIZE_RECURSION);
1569 sv_size(aTHX_ st, NPathLink("PL_ofsgv"), (SV*)PL_ofsgv, TOTAL_SIZE_RECURSION);
1570 sv_size(aTHX_ st, NPathLink("PL_argvout_stack"), (SV*)PL_argvout_stack, TOTAL_SIZE_RECURSION);
1571 sv_size(aTHX_ st, NPathLink("PL_beginav"), (SV*)PL_beginav, TOTAL_SIZE_RECURSION);
1572 sv_size(aTHX_ st, NPathLink("PL_beginav_save"), (SV*)PL_beginav_save, TOTAL_SIZE_RECURSION);
1573 sv_size(aTHX_ st, NPathLink("PL_checkav_save"), (SV*)PL_checkav_save, TOTAL_SIZE_RECURSION);
1574 sv_size(aTHX_ st, NPathLink("PL_unitcheckav"), (SV*)PL_unitcheckav, TOTAL_SIZE_RECURSION);
1575 sv_size(aTHX_ st, NPathLink("PL_unitcheckav_save"), (SV*)PL_unitcheckav_save, TOTAL_SIZE_RECURSION);
1576 sv_size(aTHX_ st, NPathLink("PL_endav"), (SV*)PL_endav, TOTAL_SIZE_RECURSION);
1577 sv_size(aTHX_ st, NPathLink("PL_checkav"), (SV*)PL_checkav, TOTAL_SIZE_RECURSION);
1578 sv_size(aTHX_ st, NPathLink("PL_initav"), (SV*)PL_initav, TOTAL_SIZE_RECURSION);
1579 sv_size(aTHX_ st, NPathLink("PL_isarev"), (SV*)PL_isarev, TOTAL_SIZE_RECURSION);
1580 sv_size(aTHX_ st, NPathLink("PL_fdpid"), (SV*)PL_fdpid, TOTAL_SIZE_RECURSION);
d2f828cb 1581 sv_size(aTHX_ st, NPathLink("PL_preambleav"), (SV*)PL_preambleav, TOTAL_SIZE_RECURSION);
1582 sv_size(aTHX_ st, NPathLink("PL_ors_sv"), (SV*)PL_ors_sv, TOTAL_SIZE_RECURSION);
1583 sv_size(aTHX_ st, NPathLink("PL_modglobal"), (SV*)PL_modglobal, TOTAL_SIZE_RECURSION);
1584 sv_size(aTHX_ st, NPathLink("PL_custom_op_names"), (SV*)PL_custom_op_names, TOTAL_SIZE_RECURSION);
1585 sv_size(aTHX_ st, NPathLink("PL_custom_op_descs"), (SV*)PL_custom_op_descs, TOTAL_SIZE_RECURSION);
1586 sv_size(aTHX_ st, NPathLink("PL_custom_ops"), (SV*)PL_custom_ops, TOTAL_SIZE_RECURSION);
1587 sv_size(aTHX_ st, NPathLink("PL_compcv"), (SV*)PL_compcv, TOTAL_SIZE_RECURSION);
1588 sv_size(aTHX_ st, NPathLink("PL_DBcv"), (SV*)PL_DBcv, TOTAL_SIZE_RECURSION);
1589#ifdef PERL_USES_PL_PIDSTATUS
1590 sv_size(aTHX_ st, NPathLink("PL_pidstatus"), (SV*)PL_pidstatus, TOTAL_SIZE_RECURSION);
1591#endif
66a76d3b 1592 sv_size(aTHX_ st, NPathLink("PL_subname"), (SV*)PL_subname, TOTAL_SIZE_RECURSION);
1593#ifdef USE_LOCALE_NUMERIC
1594 sv_size(aTHX_ st, NPathLink("PL_numeric_radix_sv"), (SV*)PL_numeric_radix_sv, TOTAL_SIZE_RECURSION);
1595 check_new_and_strlen(st, PL_numeric_name, NPathLink("PL_numeric_name"));
1596#endif
1597#ifdef USE_LOCALE_COLLATE
1598 check_new_and_strlen(st, PL_collation_name, NPathLink("PL_collation_name"));
1599#endif
b7cb716a 1600 check_new_and_strlen(st, PL_origfilename, NPathLink("PL_origfilename"));
1601 check_new_and_strlen(st, PL_inplace, NPathLink("PL_inplace"));
d2f828cb 1602 check_new_and_strlen(st, PL_osname, NPathLink("PL_osname"));
1603 if (PL_op_mask && check_new(st, PL_op_mask))
1604 ADD_SIZE(st, "PL_op_mask", PL_maxo);
1605 if (PL_exitlistlen && check_new(st, PL_exitlist))
1606 ADD_SIZE(st, "PL_exitlist", (PL_exitlistlen * sizeof(PerlExitListEntry *))
1607 + (PL_exitlistlen * sizeof(PerlExitListEntry)));
322b968f 1608#ifdef PERL_IMPLICIT_CONTEXT
d2f828cb 1609 if (PL_my_cxt_size && check_new(st, PL_my_cxt_list)) {
1610 ADD_SIZE(st, "PL_my_cxt_list", (PL_my_cxt_size * sizeof(void *)));
1611#ifdef PERL_GLOBAL_STRUCT_PRIVATE
1612 ADD_SIZE(st, "PL_my_cxt_keys", (PL_my_cxt_size * sizeof(char *)));
1613#endif
1614 }
322b968f 1615#endif
33f2f60c 1616 /* TODO PL_stashpad */
e9c43be8 1617 op_size_class(aTHX_ (OP*)&PL_compiling, OPc_COP, 1, st, NPathLink("PL_compiling"));
1618 op_size_class(aTHX_ (OP*)PL_curcopdb, OPc_COP, 0, st, NPathLink("PL_curcopdb"));
33f2f60c 1619
66a76d3b 1620 parser_size(aTHX_ st, NPathLink("PL_parser"), PL_parser);
33f2f60c 1621 /* TODO stacks: cur, main, tmps, mark, scope, save */
8a087ef5 1622 /* TODO PL_exitlist */
1abba8e9 1623 /* TODO PL_reentrant_buffers etc */
8a087ef5 1624 /* TODO environ */
1625 /* TODO PerlIO? PL_known_layers PL_def_layerlist PL_perlio_fd_refcnt etc */
5e486cae 1626 /* TODO threads? */
33f2f60c 1627 /* TODO anything missed? */
1628
1abba8e9 1629 /* --- by this point we should have seen all reachable SVs --- */
1630
1631 /* in theory we shouldn't have any elements in PL_strtab that haven't been seen yet */
df9491fe 1632 sv_size(aTHX_ st, NPathLink("PL_strtab-unseen"), (SV*)PL_strtab, TOTAL_SIZE_RECURSION);
1abba8e9 1633
1634 /* unused space in sv head arenas */
1635 if (PL_sv_root) {
1636 SV *p = PL_sv_root;
1637 UV free_heads = 1;
df9491fe 1638# define SvARENA_CHAIN(sv) SvANY(sv) /* XXX breaks encapsulation*/
1abba8e9 1639 while ((p = MUTABLE_SV(SvARENA_CHAIN(p)))) {
1640 if (!check_new(st, p)) /* sanity check */
1641 warn("Free'd SV head unexpectedly already seen");
1642 ++free_heads;
1643 }
1644 NPathPushNode("unused_sv_heads", NPtype_NAME);
1645 ADD_SIZE(st, "sv", free_heads * sizeof(SV));
1646 NPathPopNode;
1647 }
1648 /* XXX iterate over bodies_by_type and crawl the free chains for each */
1649
1650 /* iterate over all SVs to find any we've not accounted for yet */
1651 /* once the code above is visiting all SVs, any found here have been leaked */
1652 unseen_sv_size(aTHX_ st, NPathLink("unaccounted"));
df9491fe 1653}
1654
1655
eda23e24 1656MODULE = Devel::SizeMe PACKAGE = Devel::SizeMe
df9491fe 1657
1658PROTOTYPES: DISABLE
1abba8e9 1659
df9491fe 1660UV
1661size(orig_thing)
1662 SV *orig_thing
1663ALIAS:
1664 total_size = TOTAL_SIZE_RECURSION
1665CODE:
1666{
1667 SV *thing = orig_thing;
1668 struct state *st = new_state(aTHX);
1669
1670 /* If they passed us a reference then dereference it. This is the
1671 only way we can check the sizes of arrays and hashes */
1672 if (SvROK(thing)) {
1673 thing = SvRV(thing);
1abba8e9 1674 }
1675
df9491fe 1676 sv_size(aTHX_ st, NULL, thing, ix);
1677 RETVAL = st->total_size;
60dacf5f 1678 free_state(aTHX_ st);
df9491fe 1679}
1680OUTPUT:
1681 RETVAL
1682
1683UV
1684perl_size()
1685CODE:
1686{
1687 /* just the current perl interpreter */
1688 struct state *st = new_state(aTHX);
1689 st->min_recurse_threshold = NO_RECURSION; /* so always recurse */
1690 perl_size(aTHX_ st, NULL);
1691 RETVAL = st->total_size;
60dacf5f 1692 free_state(aTHX_ st);
df9491fe 1693}
1694OUTPUT:
1695 RETVAL
1696
1697UV
1698heap_size()
1699CODE:
1700{
1701 /* the current perl interpreter plus malloc, in the context of total heap size */
6a9ab1d2 1702# ifdef _MALLOC_MALLOC_H_ /* OSX. Now sure where else mstats is available */
1703# define HAS_MSTATS
1704# endif
1705# ifdef HAS_MSTATS
1706 /* some systems have the SVID2/XPG mallinfo structure and function */
df9491fe 1707 struct mstats ms = mstats(); /* mstats() first */
6a9ab1d2 1708# endif
df9491fe 1709 struct state *st = new_state(aTHX);
1710 dNPathNodes(1, NULL);
1711 NPathPushNode("heap", NPtype_NAME);
1712
1713 st->min_recurse_threshold = NO_RECURSION; /* so always recurse */
1714
1715 perl_size(aTHX_ st, NPathLink("perl_interp"));
21920e7f 1716# ifdef HAS_MSTATS
df9491fe 1717 NPathSetNode("free_malloc_space", NPtype_NAME);
1718 ADD_SIZE(st, "bytes_free", ms.bytes_free);
1719 ADD_ATTR(st, NPattr_NOTE, "bytes_total", ms.bytes_total);
1720 ADD_ATTR(st, NPattr_NOTE, "bytes_used", ms.bytes_used);
1721 ADD_ATTR(st, NPattr_NOTE, "chunks_used", ms.chunks_used);
1722 ADD_ATTR(st, NPattr_NOTE, "chunks_free", ms.chunks_free);
df9491fe 1723 /* TODO get heap size from OS and add a node: unknown = heapsize - perl - ms.bytes_free */
1724 /* for now we use bytes_total as an approximation */
1725 NPathSetNode("unknown", NPtype_NAME);
1726 ADD_SIZE(st, "unknown", ms.bytes_total - st->total_size);
6a9ab1d2 1727# else
1728 /* XXX ? */
1729# endif
df9491fe 1730
33f2f60c 1731 RETVAL = st->total_size;
60dacf5f 1732 free_state(aTHX_ st);
33f2f60c 1733}
1734OUTPUT:
1735 RETVAL
Unnamed repository; edit this file 'description' to name the repository.