import Devel-Size 0.50 from CPAN
[p5sagit/Devel-Size.git] / Size.xs
1 #include "EXTERN.h"
2 #include "perl.h"
3 #include "XSUB.h"
4
5 #define carp puts
6
7 #if !defined(NV)
8 #define NV double
9 #endif
10
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) {
63   SV *thing = orig_thing;
64   UV total_size = sizeof(SV);
65   
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:
108     total_size += sizeof(XPVMG);
109     total_size += SvLEN(thing);
110     total_size += magic_size(thing, tracking_hash);
111     break;
112   case SVt_PVBM:
113     total_size += sizeof(XPVBM);
114     total_size += SvLEN(thing);
115     total_size += magic_size(thing, tracking_hash);
116     break;
117   case SVt_PVLV:
118     total_size += sizeof(XPVLV);
119     total_size += SvLEN(thing);
120     total_size += magic_size(thing, tracking_hash);
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)) {
134       if (check_new(tracking_hash, AvARYLEN(thing))) {
135         total_size += thing_size(AvARYLEN(thing), tracking_hash);
136       }
137     }
138     total_size += magic_size(thing, tracking_hash);
139     break;
140   case SVt_PVHV:
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 */
146     if (HvARRAY(thing)) {
147       HE *cur_entry;
148       IV cur_bucket = 0;
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) {
154             /* Hash keys can be shared. Have we seen this before? */
155             if (check_new(tracking_hash, cur_entry->hent_hek)) {
156               total_size += sizeof(HEK);
157               total_size += cur_entry->hent_hek->hek_len - 1;
158             }
159           }
160           cur_entry = cur_entry->hent_next;
161         }
162       }
163     }
164     total_size += magic_size(thing, tracking_hash);
165     break;
166   case SVt_PVCV:
167     total_size += sizeof(XPVCV);
168     carp("CV isn't complete");
169     break;
170   case SVt_PVGV:
171     total_size += sizeof(XPVGV);
172     carp("GC isn't complete");
173     break;
174   case SVt_PVFM:
175     total_size += sizeof(XPVFM);
176     carp("FM isn't complete");
177     break;
178   case SVt_PVIO:
179     total_size += sizeof(XPVIO);
180     carp("IO isn't complete");
181     break;
182   default:
183     croak("Unknown variable type");
184   }
185   return total_size;
186 }
187
188
189 MODULE = Devel::Size            PACKAGE = Devel::Size           
190
191 IV
192 size(orig_thing)
193      SV *orig_thing
194 CODE:
195 {
196   SV *thing = orig_thing;
197   /* Hash to track our seen pointers */
198   HV *tracking_hash = newHV();
199
200   /* If they passed us a reference then dereference it. This is the
201      only way we can check the sizes of arrays and hashes */
202   if (SvOK(thing) && SvROK(thing)) {
203     thing = SvRV(thing);
204   }
205   
206   RETVAL = thing_size(thing, tracking_hash);
207   /* Clean up after ourselves */
208   SvREFCNT_dec(tracking_hash);
209 }
210 OUTPUT:
211   RETVAL
212
213
214 IV
215 total_size(orig_thing)
216        SV *orig_thing
217 CODE:
218 {
219   SV *thing = orig_thing;
220   /* Hash to track our seen pointers */
221   HV *tracking_hash = newHV();
222   AV *pending_array = newAV();
223
224   /* Size starts at zero */
225   RETVAL = 0;
226
227   /* If they passed us a reference then dereference it. This is the
228      only way we can check the sizes of arrays and hashes */
229   if (SvOK(thing) && SvROK(thing)) {
230     thing = SvRV(thing);
231   }
232
233   /* Put it on the pending array */
234   av_push(pending_array, thing);
235
236   /* Now just yank things off the end of the array until it's done */
237   while (&PL_sv_undef != (thing = av_pop(pending_array))) {
238     /* Process it if we've not seen it */
239     if (check_new(tracking_hash, thing)) {
240       /* First, is it pointing to or contraining something else? */
241       if (SvOK(thing)) {
242         /* Yes, it is. So let's check the type */
243
244         switch (SvTYPE(thing)) {
245         case SVt_RV:
246           av_push(pending_array, SvRV(thing));
247           break;
248
249         case SVt_PVAV:
250           {
251             /* Quick alias to cut down on casting */
252             AV *tempAV = (AV *)thing;
253             SV **tempSV;
254             
255             /* Any elements? */
256             if (av_len(tempAV) != -1) {
257               IV index;
258               /* Run through them all */
259               for (index = 0; index <= av_len(tempAV); index++) {
260                 /* Did we get something? */
261                 if (tempSV = av_fetch(tempAV, index, 0)) {
262                   /* Was it undef? */
263                   if (*tempSV != &PL_sv_undef) {
264                     /* Apparently not. Save it for later */
265                     av_push(pending_array, *tempSV);
266                   }
267                 }
268               }
269             }
270           }
271           break;
272
273         case SVt_PVHV:
274           break;
275          
276         default:
277           puts("Dunno");
278         }
279       }
280
281       RETVAL += thing_size(thing, tracking_hash);
282     }
283   }
284   
285   /* Clean up after ourselves */
286   SvREFCNT_dec(tracking_hash);
287   SvREFCNT_dec(pending_array);
288 }
289 OUTPUT:
290   RETVAL
291