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 | |
6a9ad7ec |
11 | /* Checks to see if thing is in the hash. Returns true or false, and |
12 | notes thing in the hash. |
13 | |
14 | This code does one Evil Thing. Since we're tracking pointers, we |
15 | tell perl that the string key is the address in the pointer. We do this by |
16 | passing in the address of the address, along with the size of a |
17 | pointer as the length. Perl then uses the four (or eight, on |
18 | 64-bit machines) bytes of the address as the string we're using as |
19 | the key */ |
20 | IV check_new(HV *tracking_hash, void *thing) { |
21 | if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) { |
22 | return FALSE; |
23 | } |
24 | hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_undef, 0); |
25 | return TRUE; |
26 | |
27 | } |
28 | |
29 | /* Figure out how much magic is attached to the SV and return the |
30 | size */ |
31 | IV magic_size(SV *thing, HV *tracking_hash) { |
32 | IV total_size = 0; |
33 | MAGIC *magic_pointer; |
34 | |
35 | /* Is there any? */ |
36 | if (!SvMAGIC(thing)) { |
37 | /* No, bail */ |
38 | return 0; |
39 | } |
40 | |
41 | /* Get the base magic pointer */ |
42 | magic_pointer = SvMAGIC(thing); |
43 | |
44 | /* Have we seen the magic pointer? */ |
45 | while (magic_pointer && check_new(tracking_hash, magic_pointer)) { |
46 | total_size += sizeof(MAGIC); |
47 | |
48 | /* Have we seen the magic vtable? */ |
49 | if (magic_pointer->mg_virtual && |
50 | check_new(tracking_hash, magic_pointer->mg_virtual)) { |
51 | total_size += sizeof(MGVTBL); |
52 | } |
53 | |
54 | /* Get the next in the chain */ |
55 | magic_pointer = magic_pointer->mg_moremagic; |
56 | } |
57 | |
58 | return total_size; |
59 | } |
60 | |
61 | |
62 | UV thing_size(SV *orig_thing, HV *tracking_hash) { |
e98cedbf |
63 | SV *thing = orig_thing; |
64 | UV total_size = sizeof(SV); |
65 | |
e98cedbf |
66 | switch (SvTYPE(thing)) { |
67 | /* Is it undef? */ |
68 | case SVt_NULL: |
69 | break; |
70 | /* Just a plain integer. This will be differently sized depending |
71 | on whether purify's been compiled in */ |
72 | case SVt_IV: |
73 | #ifdef PURIFY |
74 | total_size += sizeof(sizeof(XPVIV)); |
75 | #else |
76 | total_size += sizeof(IV); |
77 | #endif |
78 | break; |
79 | /* Is it a float? Like the int, it depends on purify */ |
80 | case SVt_NV: |
81 | #ifdef PURIFY |
82 | total_size += sizeof(sizeof(XPVNV)); |
83 | #else |
84 | total_size += sizeof(NV); |
85 | #endif |
86 | break; |
87 | /* Is it a reference? */ |
88 | case SVt_RV: |
89 | total_size += sizeof(XRV); |
90 | break; |
91 | /* How about a plain string? In which case we need to add in how |
92 | much has been allocated */ |
93 | case SVt_PV: |
94 | total_size += sizeof(XPV); |
95 | total_size += SvLEN(thing); |
96 | break; |
97 | /* A string with an integer part? */ |
98 | case SVt_PVIV: |
99 | total_size += sizeof(XPVIV); |
100 | total_size += SvLEN(thing); |
101 | break; |
102 | /* A string with a float part? */ |
103 | case SVt_PVNV: |
104 | total_size += sizeof(XPVNV); |
105 | total_size += SvLEN(thing); |
106 | break; |
107 | case SVt_PVMG: |
4ab42718 |
108 | total_size += sizeof(XPVMG); |
109 | total_size += SvLEN(thing); |
6a9ad7ec |
110 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
111 | break; |
112 | case SVt_PVBM: |
6a9ad7ec |
113 | total_size += sizeof(XPVBM); |
114 | total_size += SvLEN(thing); |
115 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
116 | break; |
117 | case SVt_PVLV: |
6a9ad7ec |
118 | total_size += sizeof(XPVLV); |
119 | total_size += SvLEN(thing); |
120 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
121 | break; |
122 | /* How much space is dedicated to the array? Not counting the |
123 | elements in the array, mind, just the array itself */ |
124 | case SVt_PVAV: |
125 | total_size += sizeof(XPVAV); |
126 | /* Is there anything in the array? */ |
127 | if (AvMAX(thing) != -1) { |
128 | total_size += sizeof(SV *) * AvMAX(thing); |
129 | } |
130 | /* Add in the bits on the other side of the beginning */ |
131 | total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing))); |
132 | /* Is there something hanging off the arylen element? */ |
133 | if (AvARYLEN(thing)) { |
6a9ad7ec |
134 | if (check_new(tracking_hash, AvARYLEN(thing))) { |
135 | total_size += thing_size(AvARYLEN(thing), tracking_hash); |
136 | } |
e98cedbf |
137 | } |
6a9ad7ec |
138 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
139 | break; |
140 | case SVt_PVHV: |
a6ea0805 |
141 | /* First the base struct */ |
142 | total_size += sizeof(XPVHV); |
143 | /* Now the array of buckets */ |
144 | total_size += (sizeof(HE *) * (HvMAX(thing) + 1)); |
145 | /* Now walk the bucket chain */ |
6a9ad7ec |
146 | if (HvARRAY(thing)) { |
a6ea0805 |
147 | HE *cur_entry; |
148 | IV cur_bucket = 0; |
a6ea0805 |
149 | for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) { |
150 | cur_entry = *(HvARRAY(thing) + cur_bucket); |
151 | while (cur_entry) { |
152 | total_size += sizeof(HE); |
153 | if (cur_entry->hent_hek) { |
6a9ad7ec |
154 | /* Hash keys can be shared. Have we seen this before? */ |
155 | if (check_new(tracking_hash, cur_entry->hent_hek)) { |
b98fcdb9 |
156 | total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2; |
6a9ad7ec |
157 | } |
a6ea0805 |
158 | } |
159 | cur_entry = cur_entry->hent_next; |
160 | } |
161 | } |
162 | } |
6a9ad7ec |
163 | total_size += magic_size(thing, tracking_hash); |
e98cedbf |
164 | break; |
165 | case SVt_PVCV: |
6a9ad7ec |
166 | total_size += sizeof(XPVCV); |
5c2e1b12 |
167 | total_size += magic_size(thing, tracking_hash); |
6a9ad7ec |
168 | carp("CV isn't complete"); |
e98cedbf |
169 | break; |
170 | case SVt_PVGV: |
5c2e1b12 |
171 | total_size += magic_size(thing, tracking_hash); |
6a9ad7ec |
172 | total_size += sizeof(XPVGV); |
5c2e1b12 |
173 | total_size += GvNAMELEN(thing); |
0bff12d8 |
174 | /* Is there a file? */ |
175 | if (GvFILE(thing)) { |
176 | if (check_new(tracking_hash, GvFILE(thing))) { |
177 | total_size += strlen(GvFILE(thing)); |
178 | } |
179 | } |
5c2e1b12 |
180 | /* Is there something hanging off the glob? */ |
181 | if (GvGP(thing)) { |
182 | if (check_new(tracking_hash, GvGP(thing))) { |
183 | total_size += sizeof(GP); |
184 | } |
185 | } |
e98cedbf |
186 | break; |
187 | case SVt_PVFM: |
6a9ad7ec |
188 | total_size += sizeof(XPVFM); |
189 | carp("FM isn't complete"); |
e98cedbf |
190 | break; |
191 | case SVt_PVIO: |
6a9ad7ec |
192 | total_size += sizeof(XPVIO); |
193 | carp("IO isn't complete"); |
e98cedbf |
194 | break; |
195 | default: |
196 | croak("Unknown variable type"); |
197 | } |
198 | return total_size; |
199 | } |
200 | |
e98cedbf |
201 | MODULE = Devel::Size PACKAGE = Devel::Size |
202 | |
fea63ffa |
203 | PROTOTYPES: DISABLE |
204 | |
a6ea0805 |
205 | IV |
206 | size(orig_thing) |
207 | SV *orig_thing |
e98cedbf |
208 | CODE: |
209 | { |
6a9ad7ec |
210 | SV *thing = orig_thing; |
211 | /* Hash to track our seen pointers */ |
212 | HV *tracking_hash = newHV(); |
213 | |
214 | /* If they passed us a reference then dereference it. This is the |
215 | only way we can check the sizes of arrays and hashes */ |
216 | if (SvOK(thing) && SvROK(thing)) { |
217 | thing = SvRV(thing); |
218 | } |
219 | |
220 | RETVAL = thing_size(thing, tracking_hash); |
221 | /* Clean up after ourselves */ |
222 | SvREFCNT_dec(tracking_hash); |
223 | } |
224 | OUTPUT: |
225 | RETVAL |
226 | |
227 | |
228 | IV |
229 | total_size(orig_thing) |
230 | SV *orig_thing |
231 | CODE: |
232 | { |
233 | SV *thing = orig_thing; |
234 | /* Hash to track our seen pointers */ |
235 | HV *tracking_hash = newHV(); |
236 | AV *pending_array = newAV(); |
b98fcdb9 |
237 | IV size = 0; |
238 | |
239 | IV count = 0; |
6a9ad7ec |
240 | |
241 | /* Size starts at zero */ |
242 | RETVAL = 0; |
243 | |
244 | /* If they passed us a reference then dereference it. This is the |
245 | only way we can check the sizes of arrays and hashes */ |
246 | if (SvOK(thing) && SvROK(thing)) { |
247 | thing = SvRV(thing); |
248 | } |
249 | |
250 | /* Put it on the pending array */ |
251 | av_push(pending_array, thing); |
252 | |
253 | /* Now just yank things off the end of the array until it's done */ |
e96acca9 |
254 | while (av_len(pending_array) >= 0) { |
255 | thing = av_pop(pending_array); |
6a9ad7ec |
256 | /* Process it if we've not seen it */ |
257 | if (check_new(tracking_hash, thing)) { |
e96acca9 |
258 | /* Is it valid? */ |
259 | if (thing) { |
6a9ad7ec |
260 | /* Yes, it is. So let's check the type */ |
6a9ad7ec |
261 | switch (SvTYPE(thing)) { |
262 | case SVt_RV: |
263 | av_push(pending_array, SvRV(thing)); |
264 | break; |
265 | |
266 | case SVt_PVAV: |
267 | { |
268 | /* Quick alias to cut down on casting */ |
269 | AV *tempAV = (AV *)thing; |
270 | SV **tempSV; |
271 | |
272 | /* Any elements? */ |
273 | if (av_len(tempAV) != -1) { |
274 | IV index; |
275 | /* Run through them all */ |
276 | for (index = 0; index <= av_len(tempAV); index++) { |
277 | /* Did we get something? */ |
278 | if (tempSV = av_fetch(tempAV, index, 0)) { |
279 | /* Was it undef? */ |
280 | if (*tempSV != &PL_sv_undef) { |
281 | /* Apparently not. Save it for later */ |
282 | av_push(pending_array, *tempSV); |
283 | } |
284 | } |
285 | } |
286 | } |
287 | } |
288 | break; |
289 | |
290 | case SVt_PVHV: |
e96acca9 |
291 | /* Is there anything in here? */ |
292 | if (hv_iterinit((HV *)thing)) { |
5c2e1b12 |
293 | HE *temp_he; |
294 | while (temp_he = hv_iternext((HV *)thing)) { |
295 | av_push(pending_array, hv_iterval((HV *)thing, temp_he)); |
e96acca9 |
296 | } |
297 | } |
6a9ad7ec |
298 | break; |
299 | |
5c2e1b12 |
300 | case SVt_PVGV: |
0bff12d8 |
301 | /* Run through all the pieces and push the ones with bits */ |
302 | if (GvSV(thing)) { |
303 | av_push(pending_array, (SV *)GvSV(thing)); |
304 | } |
305 | if (GvFORM(thing)) { |
306 | av_push(pending_array, (SV *)GvFORM(thing)); |
307 | } |
308 | if (GvAV(thing)) { |
309 | av_push(pending_array, (SV *)GvAV(thing)); |
310 | } |
311 | if (GvHV(thing)) { |
312 | av_push(pending_array, (SV *)GvHV(thing)); |
313 | } |
314 | if (GvCV(thing)) { |
315 | av_push(pending_array, (SV *)GvCV(thing)); |
316 | } |
317 | break; |
6a9ad7ec |
318 | default: |
e96acca9 |
319 | break; |
6a9ad7ec |
320 | } |
321 | } |
322 | |
b98fcdb9 |
323 | |
324 | size = thing_size(thing, tracking_hash); |
325 | RETVAL += size; |
326 | // printf("added thing of size %i, thing #%i\n", size, count++); |
6a9ad7ec |
327 | } |
328 | } |
329 | |
330 | /* Clean up after ourselves */ |
b98fcdb9 |
331 | // printf("For info, refcounts are %i, %i\n", SvREFCNT(tracking_hash), SvREFCNT(pending_array)); |
6a9ad7ec |
332 | SvREFCNT_dec(tracking_hash); |
333 | SvREFCNT_dec(pending_array); |
e98cedbf |
334 | } |
335 | OUTPUT: |
336 | RETVAL |
6a9ad7ec |
337 | |