import Devel-Size 0.61 from CPAN
[p5sagit/Devel-Size.git] / Size.xs
CommitLineData
e98cedbf 1#include "EXTERN.h"
2#include "perl.h"
3#include "XSUB.h"
4
6a9ad7ec 5#define carp puts
7ccc7d88 6UV thing_size(SV *, HV *);
7typedef enum {
8 OPc_NULL, /* 0 */
9 OPc_BASEOP, /* 1 */
10 OPc_UNOP, /* 2 */
11 OPc_BINOP, /* 3 */
12 OPc_LOGOP, /* 4 */
13 OPc_LISTOP, /* 5 */
14 OPc_PMOP, /* 6 */
15 OPc_SVOP, /* 7 */
16 OPc_PADOP, /* 8 */
17 OPc_PVOP, /* 9 */
18 OPc_CVOP, /* 10 */
19 OPc_LOOP, /* 11 */
20 OPc_COP /* 12 */
21} opclass;
22
23static opclass
24cc_opclass(OP *o)
25{
26 if (!o)
27 return OPc_NULL;
28
29 if (o->op_type == 0)
30 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
31
32 if (o->op_type == OP_SASSIGN)
33 return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
34
35#ifdef USE_ITHREADS
36 if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
37 return OPc_PADOP;
38#endif
39
40 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
41 case OA_BASEOP:
42 return OPc_BASEOP;
43
44 case OA_UNOP:
45 return OPc_UNOP;
46
47 case OA_BINOP:
48 return OPc_BINOP;
49
50 case OA_LOGOP:
51 return OPc_LOGOP;
52
53 case OA_LISTOP:
54 return OPc_LISTOP;
55
56 case OA_PMOP:
57 return OPc_PMOP;
58
59 case OA_SVOP:
60 return OPc_SVOP;
61
62 case OA_PADOP:
63 return OPc_PADOP;
64
65 case OA_PVOP_OR_SVOP:
66 /*
67 * Character translations (tr///) are usually a PVOP, keeping a
68 * pointer to a table of shorts used to look up translations.
69 * Under utf8, however, a simple table isn't practical; instead,
70 * the OP is an SVOP, and the SV is a reference to a swash
71 * (i.e., an RV pointing to an HV).
72 */
73 return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
74 ? OPc_SVOP : OPc_PVOP;
75
76 case OA_LOOP:
77 return OPc_LOOP;
78
79 case OA_COP:
80 return OPc_COP;
81
82 case OA_BASEOP_OR_UNOP:
83 /*
84 * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
85 * whether parens were seen. perly.y uses OPf_SPECIAL to
86 * signal whether a BASEOP had empty parens or none.
87 * Some other UNOPs are created later, though, so the best
88 * test is OPf_KIDS, which is set in newUNOP.
89 */
90 return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
91
92 case OA_FILESTATOP:
93 /*
94 * The file stat OPs are created via UNI(OP_foo) in toke.c but use
95 * the OPf_REF flag to distinguish between OP types instead of the
96 * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
97 * return OPc_UNOP so that walkoptree can find our children. If
98 * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
99 * (no argument to the operator) it's an OP; with OPf_REF set it's
100 * an SVOP (and op_sv is the GV for the filehandle argument).
101 */
102 return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
103#ifdef USE_ITHREADS
104 (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
105#else
106 (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
107#endif
108 case OA_LOOPEXOP:
109 /*
110 * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
111 * label was omitted (in which case it's a BASEOP) or else a term was
112 * seen. In this last case, all except goto are definitely PVOP but
113 * goto is either a PVOP (with an ordinary constant label), an UNOP
114 * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
115 * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
116 * get set.
117 */
118 if (o->op_flags & OPf_STACKED)
119 return OPc_UNOP;
120 else if (o->op_flags & OPf_SPECIAL)
121 return OPc_BASEOP;
122 else
123 return OPc_PVOP;
124 }
125 warn("can't determine class of operator %s, assuming BASEOP\n",
126 PL_op_name[o->op_type]);
127 return OPc_BASEOP;
128}
129
6a9ad7ec 130
a6ea0805 131#if !defined(NV)
132#define NV double
133#endif
134
ebb2c5b9 135static int go_yell = 1;
136
6a9ad7ec 137/* Checks to see if thing is in the hash. Returns true or false, and
138 notes thing in the hash.
139
140 This code does one Evil Thing. Since we're tracking pointers, we
141 tell perl that the string key is the address in the pointer. We do this by
142 passing in the address of the address, along with the size of a
143 pointer as the length. Perl then uses the four (or eight, on
144 64-bit machines) bytes of the address as the string we're using as
145 the key */
146IV check_new(HV *tracking_hash, void *thing) {
7ccc7d88 147 if (NULL == thing) {
148 return FALSE;
149 }
6a9ad7ec 150 if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
151 return FALSE;
152 }
78dfb4e7 153 hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0);
6a9ad7ec 154 return TRUE;
155
156}
157
158/* Figure out how much magic is attached to the SV and return the
159 size */
160IV magic_size(SV *thing, HV *tracking_hash) {
161 IV total_size = 0;
162 MAGIC *magic_pointer;
163
164 /* Is there any? */
165 if (!SvMAGIC(thing)) {
166 /* No, bail */
167 return 0;
168 }
169
170 /* Get the base magic pointer */
171 magic_pointer = SvMAGIC(thing);
172
173 /* Have we seen the magic pointer? */
174 while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
175 total_size += sizeof(MAGIC);
176
177 /* Have we seen the magic vtable? */
178 if (magic_pointer->mg_virtual &&
179 check_new(tracking_hash, magic_pointer->mg_virtual)) {
180 total_size += sizeof(MGVTBL);
181 }
182
183 /* Get the next in the chain */
184 magic_pointer = magic_pointer->mg_moremagic;
185 }
186
187 return total_size;
188}
189
7ccc7d88 190UV regex_size(REGEXP *baseregex, HV *tracking_hash) {
191 UV total_size = 0;
192
193 return total_size;
194}
195
196UV op_size(OP *baseop, HV *tracking_hash) {
197 UV total_size = 0;
198
199 if (check_new(tracking_hash, baseop->op_next)) {
200 total_size += op_size(baseop->op_next, tracking_hash);
201 }
202 if (check_new(tracking_hash, baseop->op_next)) {
203 total_size += op_size(baseop->op_next, tracking_hash);
204 }
205
206 switch (cc_opclass(baseop)) {
207 case OPc_BASEOP:
208 total_size += sizeof(struct op);
209 break;
210 case OPc_UNOP:
211 total_size += sizeof(struct unop);
212 if (check_new(tracking_hash, cUNOPx(baseop)->op_first)) {
213 total_size += op_size(cUNOPx(baseop)->op_first, tracking_hash);
214 }
215 break;
216 case OPc_BINOP:
217 total_size += sizeof(struct binop);
218 if (check_new(tracking_hash, cBINOPx(baseop)->op_first)) {
219 total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
220 }
221 if (check_new(tracking_hash, cBINOPx(baseop)->op_last)) {
222 total_size += op_size(cBINOPx(baseop)->op_last, tracking_hash);
223 }
224 break;
225 case OPc_LOGOP:
226 total_size += sizeof(struct logop);
227 if (check_new(tracking_hash, cLOGOPx(baseop)->op_first)) {
228 total_size += op_size(cBINOPx(baseop)->op_first, tracking_hash);
229 }
230 if (check_new(tracking_hash, cLOGOPx(baseop)->op_other)) {
231 total_size += op_size(cLOGOPx(baseop)->op_other, tracking_hash);
232 }
233 break;
234 case OPc_LISTOP:
235 total_size += sizeof(struct listop);
236 if (check_new(tracking_hash, cLISTOPx(baseop)->op_first)) {
237 total_size += op_size(cLISTOPx(baseop)->op_first, tracking_hash);
238 }
239 if (check_new(tracking_hash, cLISTOPx(baseop)->op_last)) {
240 total_size += op_size(cLISTOPx(baseop)->op_last, tracking_hash);
241 }
242 break;
243 case OPc_PMOP:
244 total_size += sizeof(struct pmop);
245 if (check_new(tracking_hash, cPMOPx(baseop)->op_first)) {
246 total_size += op_size(cPMOPx(baseop)->op_first, tracking_hash);
247 }
248 if (check_new(tracking_hash, cPMOPx(baseop)->op_last)) {
249 total_size += op_size(cPMOPx(baseop)->op_last, tracking_hash);
250 }
251 if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplroot)) {
252 total_size += op_size(cPMOPx(baseop)->op_pmreplroot, tracking_hash);
253 }
254 if (check_new(tracking_hash, cPMOPx(baseop)->op_pmreplstart)) {
255 total_size += op_size(cPMOPx(baseop)->op_pmreplstart, tracking_hash);
256 }
257 if (check_new(tracking_hash, cPMOPx(baseop)->op_pmnext)) {
258 total_size += op_size((OP *)cPMOPx(baseop)->op_pmnext, tracking_hash);
259 }
260 // if (check_new(tracking_hash, cPMOPx(baseop)->op_pmregexp)) {
261 // total_size += regex_size(cPMOPx(baseop)->op_pmregexp, tracking_hash);
262 //}
263 break;
264 case OPc_SVOP:
265 total_size += sizeof(struct pmop);
266 if (check_new(tracking_hash, cSVOPx(baseop)->op_sv)) {
267 total_size += thing_size(cSVOPx(baseop)->op_sv, tracking_hash);
268 }
269 break;
270 case OPc_PADOP:
271 total_size += sizeof(struct padop);
272 break;
273 case OPc_PVOP:
274 if (check_new(tracking_hash, cPVOPx(baseop)->op_pv)) {
275 total_size += strlen(cPVOPx(baseop)->op_pv);
276 }
277 case OPc_LOOP:
278 total_size += sizeof(struct loop);
279 if (check_new(tracking_hash, cLOOPx(baseop)->op_first)) {
280 total_size += op_size(cLOOPx(baseop)->op_first, tracking_hash);
281 }
282 if (check_new(tracking_hash, cLOOPx(baseop)->op_last)) {
283 total_size += op_size(cLOOPx(baseop)->op_last, tracking_hash);
284 }
285 if (check_new(tracking_hash, cLOOPx(baseop)->op_redoop)) {
286 total_size += op_size(cLOOPx(baseop)->op_redoop, tracking_hash);
287 }
288 if (check_new(tracking_hash, cLOOPx(baseop)->op_nextop)) {
289 total_size += op_size(cLOOPx(baseop)->op_nextop, tracking_hash);
290 }
a3ec2202 291// if (check_new(tracking_hash, cLOOPx(baseop)->op_lastop)) {
292// total_size += op_size(cLOOPx(baseop)->op_lastop, tracking_hash);
293// }
7ccc7d88 294 case OPc_COP:
295 {
296 COP *basecop;
297 basecop = (COP *)baseop;
298 total_size += sizeof(struct cop);
299
300 if (check_new(tracking_hash, basecop->cop_label)) {
301 total_size += strlen(basecop->cop_label);
302 }
303#ifdef USE_ITHREADS
304 if (check_new(tracking_hash, basecop->cop_file)) {
305 total_size += strlen(basecop->cop_file);
306 }
307 if (check_new(tracking_hash, basecop->cop_stashpv)) {
308 total_size += strlen(basecop->cop_stashpv);
309 }
310#else
311 if (check_new(tracking_hash, basecop->cop_stash)) {
312 total_size += thing_size((SV *)basecop->cop_stash, tracking_hash);
313 }
314 if (check_new(tracking_hash, basecop->cop_filegv)) {
315 total_size += thing_size((SV *)basecop->cop_filegv, tracking_hash);
316 }
317#endif
318
319 }
320 break;
321 default:
322 break;
323 }
324 return total_size;
325}
6a9ad7ec 326
327UV thing_size(SV *orig_thing, HV *tracking_hash) {
e98cedbf 328 SV *thing = orig_thing;
329 UV total_size = sizeof(SV);
330
e98cedbf 331 switch (SvTYPE(thing)) {
332 /* Is it undef? */
333 case SVt_NULL:
334 break;
335 /* Just a plain integer. This will be differently sized depending
336 on whether purify's been compiled in */
337 case SVt_IV:
338#ifdef PURIFY
339 total_size += sizeof(sizeof(XPVIV));
340#else
341 total_size += sizeof(IV);
342#endif
343 break;
344 /* Is it a float? Like the int, it depends on purify */
345 case SVt_NV:
346#ifdef PURIFY
347 total_size += sizeof(sizeof(XPVNV));
348#else
349 total_size += sizeof(NV);
350#endif
351 break;
352 /* Is it a reference? */
353 case SVt_RV:
354 total_size += sizeof(XRV);
355 break;
356 /* How about a plain string? In which case we need to add in how
357 much has been allocated */
358 case SVt_PV:
359 total_size += sizeof(XPV);
360 total_size += SvLEN(thing);
361 break;
362 /* A string with an integer part? */
363 case SVt_PVIV:
364 total_size += sizeof(XPVIV);
365 total_size += SvLEN(thing);
366 break;
367 /* A string with a float part? */
368 case SVt_PVNV:
369 total_size += sizeof(XPVNV);
370 total_size += SvLEN(thing);
371 break;
372 case SVt_PVMG:
4ab42718 373 total_size += sizeof(XPVMG);
374 total_size += SvLEN(thing);
6a9ad7ec 375 total_size += magic_size(thing, tracking_hash);
e98cedbf 376 break;
377 case SVt_PVBM:
6a9ad7ec 378 total_size += sizeof(XPVBM);
379 total_size += SvLEN(thing);
380 total_size += magic_size(thing, tracking_hash);
e98cedbf 381 break;
382 case SVt_PVLV:
6a9ad7ec 383 total_size += sizeof(XPVLV);
384 total_size += SvLEN(thing);
385 total_size += magic_size(thing, tracking_hash);
e98cedbf 386 break;
387 /* How much space is dedicated to the array? Not counting the
388 elements in the array, mind, just the array itself */
389 case SVt_PVAV:
390 total_size += sizeof(XPVAV);
391 /* Is there anything in the array? */
392 if (AvMAX(thing) != -1) {
393 total_size += sizeof(SV *) * AvMAX(thing);
394 }
395 /* Add in the bits on the other side of the beginning */
396 total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
397 /* Is there something hanging off the arylen element? */
398 if (AvARYLEN(thing)) {
6a9ad7ec 399 if (check_new(tracking_hash, AvARYLEN(thing))) {
400 total_size += thing_size(AvARYLEN(thing), tracking_hash);
401 }
e98cedbf 402 }
6a9ad7ec 403 total_size += magic_size(thing, tracking_hash);
e98cedbf 404 break;
405 case SVt_PVHV:
a6ea0805 406 /* First the base struct */
407 total_size += sizeof(XPVHV);
408 /* Now the array of buckets */
409 total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
410 /* Now walk the bucket chain */
6a9ad7ec 411 if (HvARRAY(thing)) {
a6ea0805 412 HE *cur_entry;
413 IV cur_bucket = 0;
a6ea0805 414 for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
415 cur_entry = *(HvARRAY(thing) + cur_bucket);
416 while (cur_entry) {
417 total_size += sizeof(HE);
418 if (cur_entry->hent_hek) {
6a9ad7ec 419 /* Hash keys can be shared. Have we seen this before? */
420 if (check_new(tracking_hash, cur_entry->hent_hek)) {
b98fcdb9 421 total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
6a9ad7ec 422 }
a6ea0805 423 }
424 cur_entry = cur_entry->hent_next;
425 }
426 }
427 }
6a9ad7ec 428 total_size += magic_size(thing, tracking_hash);
e98cedbf 429 break;
430 case SVt_PVCV:
6a9ad7ec 431 total_size += sizeof(XPVCV);
5c2e1b12 432 total_size += magic_size(thing, tracking_hash);
7ccc7d88 433
434 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
435 if (check_new(tracking_hash, CvSTASH(thing))) {
436 total_size += thing_size((SV *)CvSTASH(thing), tracking_hash);
437 }
438 if (check_new(tracking_hash, SvSTASH(thing))) {
439 total_size += thing_size((SV *)SvSTASH(thing), tracking_hash);
440 }
441 if (check_new(tracking_hash, CvGV(thing))) {
442 total_size += thing_size((SV *)CvGV(thing), tracking_hash);
ebb2c5b9 443 }
7ccc7d88 444 if (check_new(tracking_hash, CvPADLIST(thing))) {
445 total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
446 }
447 if (check_new(tracking_hash, CvOUTSIDE(thing))) {
448 total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
449 }
450
451 if (check_new(tracking_hash, CvSTART(thing))) {
452 total_size += op_size(CvSTART(thing), tracking_hash);
453 }
454 if (check_new(tracking_hash, CvROOT(thing))) {
455 total_size += op_size(CvROOT(thing), tracking_hash);
456 }
457
e98cedbf 458 break;
459 case SVt_PVGV:
5c2e1b12 460 total_size += magic_size(thing, tracking_hash);
6a9ad7ec 461 total_size += sizeof(XPVGV);
5c2e1b12 462 total_size += GvNAMELEN(thing);
78dfb4e7 463#ifdef GvFILE
0bff12d8 464 /* Is there a file? */
465 if (GvFILE(thing)) {
466 if (check_new(tracking_hash, GvFILE(thing))) {
467 total_size += strlen(GvFILE(thing));
468 }
469 }
78dfb4e7 470#endif
5c2e1b12 471 /* Is there something hanging off the glob? */
472 if (GvGP(thing)) {
473 if (check_new(tracking_hash, GvGP(thing))) {
474 total_size += sizeof(GP);
5073b933 475 {
476 SV *generic_thing;
477 if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
478 total_size += thing_size(generic_thing, tracking_hash);
479 }
480 if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
481 total_size += thing_size(generic_thing, tracking_hash);
482 }
483 if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
484 total_size += thing_size(generic_thing, tracking_hash);
485 }
486 if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
487 total_size += thing_size(generic_thing, tracking_hash);
488 }
489 if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
490 total_size += thing_size(generic_thing, tracking_hash);
491 }
492 if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
493 total_size += thing_size(generic_thing, tracking_hash);
494 }
495 }
5c2e1b12 496 }
497 }
e98cedbf 498 break;
499 case SVt_PVFM:
6a9ad7ec 500 total_size += sizeof(XPVFM);
7ccc7d88 501 total_size += magic_size(thing, tracking_hash);
502 total_size += ((XPVIO *) SvANY(thing))->xpv_len;
503 if (check_new(tracking_hash, CvPADLIST(thing))) {
504 total_size += thing_size((SV *)CvPADLIST(thing), tracking_hash);
505 }
506 if (check_new(tracking_hash, CvOUTSIDE(thing))) {
507 total_size += thing_size((SV *)CvOUTSIDE(thing), tracking_hash);
508 }
509
ebb2c5b9 510 if (go_yell) {
5073b933 511 carp("Devel::Size: Calculated sizes for FMs are incomplete");
ebb2c5b9 512 }
e98cedbf 513 break;
514 case SVt_PVIO:
6a9ad7ec 515 total_size += sizeof(XPVIO);
5073b933 516 total_size += magic_size(thing, tracking_hash);
517 if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
518 total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
ebb2c5b9 519 }
5073b933 520 /* Some embedded char pointers */
521 if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
522 total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
523 }
524 if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
525 total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
526 }
527 if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
528 total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
529 }
530 /* Throw the GVs on the list to be walked if they're not-null */
531 if (((XPVIO *) SvANY(thing))->xio_top_gv) {
532 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv,
533 tracking_hash);
534 }
535 if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
536 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv,
537 tracking_hash);
538 }
539 if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
540 total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv,
541 tracking_hash);
542 }
543
544 /* Only go trotting through the IO structures if they're really
545 trottable. If USE_PERLIO is defined we can do this. If
546 not... we can't, so we don't even try */
547#ifdef USE_PERLIO
548 /* Dig into xio_ifp and xio_ofp here */
549 croak("Devel::Size: Can't size up perlio layers yet");
550#endif
e98cedbf 551 break;
552 default:
5073b933 553 croak("Devel::Size: Unknown variable type");
e98cedbf 554 }
555 return total_size;
556}
557
e98cedbf 558MODULE = Devel::Size PACKAGE = Devel::Size
559
fea63ffa 560PROTOTYPES: DISABLE
561
a6ea0805 562IV
563size(orig_thing)
564 SV *orig_thing
e98cedbf 565CODE:
566{
6a9ad7ec 567 SV *thing = orig_thing;
568 /* Hash to track our seen pointers */
569 HV *tracking_hash = newHV();
ebb2c5b9 570 SV *warn_flag;
571
572 /* Check warning status */
573 go_yell = 0;
574
78dfb4e7 575 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
ebb2c5b9 576 go_yell = SvIV(warn_flag);
577 }
578
6a9ad7ec 579
580 /* If they passed us a reference then dereference it. This is the
581 only way we can check the sizes of arrays and hashes */
582 if (SvOK(thing) && SvROK(thing)) {
583 thing = SvRV(thing);
584 }
585
586 RETVAL = thing_size(thing, tracking_hash);
587 /* Clean up after ourselves */
588 SvREFCNT_dec(tracking_hash);
589}
590OUTPUT:
591 RETVAL
592
593
594IV
595total_size(orig_thing)
596 SV *orig_thing
597CODE:
598{
599 SV *thing = orig_thing;
600 /* Hash to track our seen pointers */
601 HV *tracking_hash = newHV();
602 AV *pending_array = newAV();
b98fcdb9 603 IV size = 0;
ebb2c5b9 604 SV *warn_flag;
b98fcdb9 605
606 IV count = 0;
6a9ad7ec 607
608 /* Size starts at zero */
609 RETVAL = 0;
610
ebb2c5b9 611 /* Check warning status */
612 go_yell = 0;
613
78dfb4e7 614 if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
ebb2c5b9 615 go_yell = SvIV(warn_flag);
616 }
617
618
6a9ad7ec 619 /* If they passed us a reference then dereference it. This is the
620 only way we can check the sizes of arrays and hashes */
621 if (SvOK(thing) && SvROK(thing)) {
622 thing = SvRV(thing);
623 }
624
625 /* Put it on the pending array */
626 av_push(pending_array, thing);
627
628 /* Now just yank things off the end of the array until it's done */
e96acca9 629 while (av_len(pending_array) >= 0) {
630 thing = av_pop(pending_array);
6a9ad7ec 631 /* Process it if we've not seen it */
632 if (check_new(tracking_hash, thing)) {
e96acca9 633 /* Is it valid? */
634 if (thing) {
6a9ad7ec 635 /* Yes, it is. So let's check the type */
6a9ad7ec 636 switch (SvTYPE(thing)) {
637 case SVt_RV:
638 av_push(pending_array, SvRV(thing));
639 break;
640
641 case SVt_PVAV:
642 {
643 /* Quick alias to cut down on casting */
644 AV *tempAV = (AV *)thing;
645 SV **tempSV;
646
647 /* Any elements? */
648 if (av_len(tempAV) != -1) {
649 IV index;
650 /* Run through them all */
651 for (index = 0; index <= av_len(tempAV); index++) {
652 /* Did we get something? */
653 if (tempSV = av_fetch(tempAV, index, 0)) {
654 /* Was it undef? */
655 if (*tempSV != &PL_sv_undef) {
656 /* Apparently not. Save it for later */
657 av_push(pending_array, *tempSV);
658 }
659 }
660 }
661 }
662 }
663 break;
664
665 case SVt_PVHV:
e96acca9 666 /* Is there anything in here? */
667 if (hv_iterinit((HV *)thing)) {
5c2e1b12 668 HE *temp_he;
669 while (temp_he = hv_iternext((HV *)thing)) {
670 av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9 671 }
672 }
6a9ad7ec 673 break;
674
5c2e1b12 675 case SVt_PVGV:
0bff12d8 676 /* Run through all the pieces and push the ones with bits */
677 if (GvSV(thing)) {
678 av_push(pending_array, (SV *)GvSV(thing));
679 }
680 if (GvFORM(thing)) {
681 av_push(pending_array, (SV *)GvFORM(thing));
682 }
683 if (GvAV(thing)) {
684 av_push(pending_array, (SV *)GvAV(thing));
685 }
686 if (GvHV(thing)) {
687 av_push(pending_array, (SV *)GvHV(thing));
688 }
689 if (GvCV(thing)) {
690 av_push(pending_array, (SV *)GvCV(thing));
691 }
692 break;
6a9ad7ec 693 default:
e96acca9 694 break;
6a9ad7ec 695 }
696 }
697
b98fcdb9 698
699 size = thing_size(thing, tracking_hash);
700 RETVAL += size;
6a9ad7ec 701 }
702 }
703
704 /* Clean up after ourselves */
705 SvREFCNT_dec(tracking_hash);
706 SvREFCNT_dec(pending_array);
e98cedbf 707}
708OUTPUT:
709 RETVAL
6a9ad7ec 710