Commit | Line | Data |
e98cedbf |
1 | #include "EXTERN.h" |
2 | #include "perl.h" |
3 | #include "XSUB.h" |
4 | |
6a9ad7ec |
5 | #define carp puts |
6 | |
a6ea0805 |
7 | #if !defined(NV) |
8 | #define NV double |
9 | #endif |
10 | |
ebb2c5b9 |
11 | static int go_yell = 1; |
12 | |
6a9ad7ec |
13 | /* Checks to see if thing is in the hash. Returns true or false, and |
14 | notes thing in the hash. |
15 | |
16 | This code does one Evil Thing. Since we're tracking pointers, we |
17 | tell perl that the string key is the address in the pointer. We do this by |
18 | passing in the address of the address, along with the size of a |
19 | pointer as the length. Perl then uses the four (or eight, on |
20 | 64-bit machines) bytes of the address as the string we're using as |
21 | the key */ |
22 | IV check_new(HV *tracking_hash, void *thing) { |
23 | if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { |
24 | return FALSE; |
25 | } |
78dfb4e7 |
26 | hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_yes, 0); |
6a9ad7ec |
27 | return TRUE; |
28 | |
29 | } |
30 | |
31 | /* Figure out how much magic is attached to the SV and return the |
32 | size */ |
33 | IV magic_size(SV *thing, HV *tracking_hash) { |
34 | IV total_size = 0; |
35 | MAGIC *magic_pointer; |
36 | |
37 | /* Is there any? */ |
38 | if (!SvMAGIC(thing)) { |
39 | /* No, bail */ |
40 | return 0; |
41 | } |
42 | |
43 | /* Get the base magic pointer */ |
44 | magic_pointer = SvMAGIC(thing); |
45 | |
46 | /* Have we seen the magic pointer? */ |
47 | while (magic_pointer && check_new(tracking_hash, magic_pointer)) { |
48 | total_size += sizeof(MAGIC); |
49 | |
50 | /* Have we seen the magic vtable? */ |
51 | if (magic_pointer->mg_virtual && |
52 | check_new(tracking_hash, magic_pointer->mg_virtual)) { |
53 | total_size += sizeof(MGVTBL); |
54 | } |
55 | |
56 | /* Get the next in the chain */ |
57 | magic_pointer = magic_pointer->mg_moremagic; |
58 | } |
59 | |
60 | return total_size; |
61 | } |
62 | |
63 | |
64 | UV thing_size(SV *orig_thing, HV *tracking_hash) { |
e98cedbf |
65 | SV *thing = orig_thing; |
66 | UV total_size = sizeof(SV); |
67 | |
e98cedbf |
68 | switch (SvTYPE(thing)) { |
69 | /* Is it undef? */ |
70 | case SVt_NULL: |
71 | break; |
72 | /* Just a plain integer. This will be differently sized depending |
73 | on whether purify's been compiled in */ |
74 | case SVt_IV: |
75 | #ifdef PURIFY |
76 | total_size += sizeof(sizeof(XPVIV)); |
77 | #else |
78 | total_size += sizeof(IV); |
79 | #endif |
80 | break; |
81 | /* Is it a float? Like the int, it depends on purify */ |
82 | case SVt_NV: |
83 | #ifdef PURIFY |
84 | total_size += sizeof(sizeof(XPVNV)); |
85 | #else |
86 | total_size += sizeof(NV); |
87 | #endif |
88 | break; |
89 | /* Is it a reference? */ |
90 | case SVt_RV: |
91 | total_size += sizeof(XRV); |
92 | break; |
93 | /* How about a plain string? In which case we need to add in how |
94 | much has been allocated */ |
95 | case SVt_PV: |
96 | total_size += sizeof(XPV); |
97 | total_size += SvLEN(thing); |
98 | break; |
99 | /* A string with an integer part? */ |
100 | case SVt_PVIV: |
101 | total_size += sizeof(XPVIV); |
102 | total_size += SvLEN(thing); |
103 | break; |
104 | /* A string with a float part? */ |
105 | case SVt_PVNV: |
106 | total_size += sizeof(XPVNV); |
107 | total_size += SvLEN(thing); |
108 | break; |
109 | case SVt_PVMG: |
4ab42718 |
110 | total_size += sizeof(XPVMG); |
111 | total_size += SvLEN(thing); |
6a9ad7ec |
112 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
113 | break; |
114 | case SVt_PVBM: |
6a9ad7ec |
115 | total_size += sizeof(XPVBM); |
116 | total_size += SvLEN(thing); |
117 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
118 | break; |
119 | case SVt_PVLV: |
6a9ad7ec |
120 | total_size += sizeof(XPVLV); |
121 | total_size += SvLEN(thing); |
122 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
123 | break; |
124 | /* How much space is dedicated to the array? Not counting the |
125 | elements in the array, mind, just the array itself */ |
126 | case SVt_PVAV: |
127 | total_size += sizeof(XPVAV); |
128 | /* Is there anything in the array? */ |
129 | if (AvMAX(thing) != -1) { |
130 | total_size += sizeof(SV *) * AvMAX(thing); |
131 | } |
132 | /* Add in the bits on the other side of the beginning */ |
133 | total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); |
134 | /* Is there something hanging off the arylen element? */ |
135 | if (AvARYLEN(thing)) { |
6a9ad7ec |
136 | if (check_new(tracking_hash, AvARYLEN(thing))) { |
137 | total_size += thing_size(AvARYLEN(thing), tracking_hash); |
138 | } |
e98cedbf |
139 | } |
6a9ad7ec |
140 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
141 | break; |
142 | case SVt_PVHV: |
a6ea0805 |
143 | /* First the base struct */ |
144 | total_size += sizeof(XPVHV); |
145 | /* Now the array of buckets */ |
146 | total_size += (sizeof(HE *) * (HvMAX(thing) + 1)); |
147 | /* Now walk the bucket chain */ |
6a9ad7ec |
148 | if (HvARRAY(thing)) { |
a6ea0805 |
149 | HE *cur_entry; |
150 | IV cur_bucket = 0; |
a6ea0805 |
151 | for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) { |
152 | cur_entry = *(HvARRAY(thing) + cur_bucket); |
153 | while (cur_entry) { |
154 | total_size += sizeof(HE); |
155 | if (cur_entry->hent_hek) { |
6a9ad7ec |
156 | /* Hash keys can be shared. Have we seen this before? */ |
157 | if (check_new(tracking_hash, cur_entry->hent_hek)) { |
b98fcdb9 |
158 | total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2; |
6a9ad7ec |
159 | } |
a6ea0805 |
160 | } |
161 | cur_entry = cur_entry->hent_next; |
162 | } |
163 | } |
164 | } |
6a9ad7ec |
165 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
166 | break; |
167 | case SVt_PVCV: |
6a9ad7ec |
168 | total_size += sizeof(XPVCV); |
5c2e1b12 |
169 | total_size += magic_size(thing, tracking_hash); |
ebb2c5b9 |
170 | if (go_yell) { |
5073b933 |
171 | carp("Devel::Size: Calculated sizes for CVs are incomplete"); |
ebb2c5b9 |
172 | } |
e98cedbf |
173 | break; |
174 | case SVt_PVGV: |
5c2e1b12 |
175 | total_size += magic_size(thing, tracking_hash); |
6a9ad7ec |
176 | total_size += sizeof(XPVGV); |
5c2e1b12 |
177 | total_size += GvNAMELEN(thing); |
78dfb4e7 |
178 | #ifdef GvFILE |
0bff12d8 |
179 | /* Is there a file? */ |
180 | if (GvFILE(thing)) { |
181 | if (check_new(tracking_hash, GvFILE(thing))) { |
182 | total_size += strlen(GvFILE(thing)); |
183 | } |
184 | } |
78dfb4e7 |
185 | #endif |
5c2e1b12 |
186 | /* Is there something hanging off the glob? */ |
187 | if (GvGP(thing)) { |
188 | if (check_new(tracking_hash, GvGP(thing))) { |
189 | total_size += sizeof(GP); |
5073b933 |
190 | { |
191 | SV *generic_thing; |
192 | if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) { |
193 | total_size += thing_size(generic_thing, tracking_hash); |
194 | } |
195 | if (generic_thing = (SV *)(GvGP(thing)->gp_form)) { |
196 | total_size += thing_size(generic_thing, tracking_hash); |
197 | } |
198 | if (generic_thing = (SV *)(GvGP(thing)->gp_av)) { |
199 | total_size += thing_size(generic_thing, tracking_hash); |
200 | } |
201 | if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) { |
202 | total_size += thing_size(generic_thing, tracking_hash); |
203 | } |
204 | if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) { |
205 | total_size += thing_size(generic_thing, tracking_hash); |
206 | } |
207 | if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) { |
208 | total_size += thing_size(generic_thing, tracking_hash); |
209 | } |
210 | } |
5c2e1b12 |
211 | } |
212 | } |
e98cedbf |
213 | break; |
214 | case SVt_PVFM: |
6a9ad7ec |
215 | total_size += sizeof(XPVFM); |
ebb2c5b9 |
216 | if (go_yell) { |
5073b933 |
217 | carp("Devel::Size: Calculated sizes for FMs are incomplete"); |
ebb2c5b9 |
218 | } |
e98cedbf |
219 | break; |
220 | case SVt_PVIO: |
6a9ad7ec |
221 | total_size += sizeof(XPVIO); |
5073b933 |
222 | total_size += magic_size(thing, tracking_hash); |
223 | if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) { |
224 | total_size += ((XPVIO *) SvANY(thing))->xpv_cur; |
ebb2c5b9 |
225 | } |
5073b933 |
226 | /* Some embedded char pointers */ |
227 | if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) { |
228 | total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name); |
229 | } |
230 | if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) { |
231 | total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name); |
232 | } |
233 | if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) { |
234 | total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name); |
235 | } |
236 | /* Throw the GVs on the list to be walked if they're not-null */ |
237 | if (((XPVIO *) SvANY(thing))->xio_top_gv) { |
238 | total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv, |
239 | tracking_hash); |
240 | } |
241 | if (((XPVIO *) SvANY(thing))->xio_bottom_gv) { |
242 | total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, |
243 | tracking_hash); |
244 | } |
245 | if (((XPVIO *) SvANY(thing))->xio_fmt_gv) { |
246 | total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, |
247 | tracking_hash); |
248 | } |
249 | |
250 | /* Only go trotting through the IO structures if they're really |
251 | trottable. If USE_PERLIO is defined we can do this. If |
252 | not... we can't, so we don't even try */ |
253 | #ifdef USE_PERLIO |
254 | /* Dig into xio_ifp and xio_ofp here */ |
255 | croak("Devel::Size: Can't size up perlio layers yet"); |
256 | #endif |
e98cedbf |
257 | break; |
258 | default: |
5073b933 |
259 | croak("Devel::Size: Unknown variable type"); |
e98cedbf |
260 | } |
261 | return total_size; |
262 | } |
263 | |
e98cedbf |
264 | MODULE = Devel::Size PACKAGE = Devel::Size |
265 | |
fea63ffa |
266 | PROTOTYPES: DISABLE |
267 | |
a6ea0805 |
268 | IV |
269 | size(orig_thing) |
270 | SV *orig_thing |
e98cedbf |
271 | CODE: |
272 | { |
6a9ad7ec |
273 | SV *thing = orig_thing; |
274 | /* Hash to track our seen pointers */ |
275 | HV *tracking_hash = newHV(); |
ebb2c5b9 |
276 | SV *warn_flag; |
277 | |
278 | /* Check warning status */ |
279 | go_yell = 0; |
280 | |
78dfb4e7 |
281 | if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { |
ebb2c5b9 |
282 | go_yell = SvIV(warn_flag); |
283 | } |
284 | |
6a9ad7ec |
285 | |
286 | /* If they passed us a reference then dereference it. This is the |
287 | only way we can check the sizes of arrays and hashes */ |
288 | if (SvOK(thing) && SvROK(thing)) { |
289 | thing = SvRV(thing); |
290 | } |
291 | |
292 | RETVAL = thing_size(thing, tracking_hash); |
293 | /* Clean up after ourselves */ |
294 | SvREFCNT_dec(tracking_hash); |
295 | } |
296 | OUTPUT: |
297 | RETVAL |
298 | |
299 | |
300 | IV |
301 | total_size(orig_thing) |
302 | SV *orig_thing |
303 | CODE: |
304 | { |
305 | SV *thing = orig_thing; |
306 | /* Hash to track our seen pointers */ |
307 | HV *tracking_hash = newHV(); |
308 | AV *pending_array = newAV(); |
b98fcdb9 |
309 | IV size = 0; |
ebb2c5b9 |
310 | SV *warn_flag; |
b98fcdb9 |
311 | |
312 | IV count = 0; |
6a9ad7ec |
313 | |
314 | /* Size starts at zero */ |
315 | RETVAL = 0; |
316 | |
ebb2c5b9 |
317 | /* Check warning status */ |
318 | go_yell = 0; |
319 | |
78dfb4e7 |
320 | if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) { |
ebb2c5b9 |
321 | go_yell = SvIV(warn_flag); |
322 | } |
323 | |
324 | |
6a9ad7ec |
325 | /* If they passed us a reference then dereference it. This is the |
326 | only way we can check the sizes of arrays and hashes */ |
327 | if (SvOK(thing) && SvROK(thing)) { |
328 | thing = SvRV(thing); |
329 | } |
330 | |
331 | /* Put it on the pending array */ |
332 | av_push(pending_array, thing); |
333 | |
334 | /* Now just yank things off the end of the array until it's done */ |
e96acca9 |
335 | while (av_len(pending_array) >= 0) { |
336 | thing = av_pop(pending_array); |
6a9ad7ec |
337 | /* Process it if we've not seen it */ |
338 | if (check_new(tracking_hash, thing)) { |
e96acca9 |
339 | /* Is it valid? */ |
340 | if (thing) { |
6a9ad7ec |
341 | /* Yes, it is. So let's check the type */ |
6a9ad7ec |
342 | switch (SvTYPE(thing)) { |
343 | case SVt_RV: |
344 | av_push(pending_array, SvRV(thing)); |
345 | break; |
346 | |
347 | case SVt_PVAV: |
348 | { |
349 | /* Quick alias to cut down on casting */ |
350 | AV *tempAV = (AV *)thing; |
351 | SV **tempSV; |
352 | |
353 | /* Any elements? */ |
354 | if (av_len(tempAV) != -1) { |
355 | IV index; |
356 | /* Run through them all */ |
357 | for (index = 0; index <= av_len(tempAV); index++) { |
358 | /* Did we get something? */ |
359 | if (tempSV = av_fetch(tempAV, index, 0)) { |
360 | /* Was it undef? */ |
361 | if (*tempSV != &PL_sv_undef) { |
362 | /* Apparently not. Save it for later */ |
363 | av_push(pending_array, *tempSV); |
364 | } |
365 | } |
366 | } |
367 | } |
368 | } |
369 | break; |
370 | |
371 | case SVt_PVHV: |
e96acca9 |
372 | /* Is there anything in here? */ |
373 | if (hv_iterinit((HV *)thing)) { |
5c2e1b12 |
374 | HE *temp_he; |
375 | while (temp_he = hv_iternext((HV *)thing)) { |
376 | av_push(pending_array, hv_iterval((HV *)thing, temp_he)); |
e96acca9 |
377 | } |
378 | } |
6a9ad7ec |
379 | break; |
380 | |
5c2e1b12 |
381 | case SVt_PVGV: |
0bff12d8 |
382 | /* Run through all the pieces and push the ones with bits */ |
383 | if (GvSV(thing)) { |
384 | av_push(pending_array, (SV *)GvSV(thing)); |
385 | } |
386 | if (GvFORM(thing)) { |
387 | av_push(pending_array, (SV *)GvFORM(thing)); |
388 | } |
389 | if (GvAV(thing)) { |
390 | av_push(pending_array, (SV *)GvAV(thing)); |
391 | } |
392 | if (GvHV(thing)) { |
393 | av_push(pending_array, (SV *)GvHV(thing)); |
394 | } |
395 | if (GvCV(thing)) { |
396 | av_push(pending_array, (SV *)GvCV(thing)); |
397 | } |
398 | break; |
6a9ad7ec |
399 | default: |
e96acca9 |
400 | break; |
6a9ad7ec |
401 | } |
402 | } |
403 | |
b98fcdb9 |
404 | |
405 | size = thing_size(thing, tracking_hash); |
406 | RETVAL += size; |
6a9ad7ec |
407 | } |
408 | } |
409 | |
410 | /* Clean up after ourselves */ |
411 | SvREFCNT_dec(tracking_hash); |
412 | SvREFCNT_dec(pending_array); |
e98cedbf |
413 | } |
414 | OUTPUT: |
415 | RETVAL |
6a9ad7ec |
416 | |