[p5sagit/Devel-Size.git] / Size.xs

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#define carp puts

#if !defined(NV)
#define NV double
#endif

/* Checks to see if thing is in the hash. Returns true or false, and
   notes thing in the hash.

   This code does one Evil Thing. Since we're tracking pointers, we
   tell perl that the string key is the address in the pointer. We do this by
   passing in the address of the address, along with the size of a
   pointer as the length. Perl then uses the four (or eight, on
   64-bit machines) bytes of the address as the string we're using as
   the key */
IV check_new(HV *tracking_hash, void *thing) {
  if (hv_exists(tracking_hash, (char *)&thing, sizeof(void *))) {
    return FALSE;
  }
  hv_store(tracking_hash, (char *)&thing, sizeof(void *), &PL_sv_undef, 0);
  return TRUE;

}

/* Figure out how much magic is attached to the SV and return the
   size */
IV magic_size(SV *thing, HV *tracking_hash) {
  IV total_size = 0;
  MAGIC *magic_pointer;

  /* Is there any? */
  if (!SvMAGIC(thing)) {
    /* No, bail */
    return 0;
  }

  /* Get the base magic pointer */
  magic_pointer = SvMAGIC(thing);

  /* Have we seen the magic pointer? */
  while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
    total_size += sizeof(MAGIC);

    /* Have we seen the magic vtable? */
    if (magic_pointer->mg_virtual &&
	check_new(tracking_hash, magic_pointer->mg_virtual)) {
      total_size += sizeof(MGVTBL);
    }

    /* Get the next in the chain */
    magic_pointer = magic_pointer->mg_moremagic;
  }

  return total_size;
}


UV thing_size(SV *orig_thing, HV *tracking_hash) {
  SV *thing = orig_thing;
  UV total_size = sizeof(SV);
  
  switch (SvTYPE(thing)) {
    /* Is it undef? */
  case SVt_NULL:
    break;
    /* Just a plain integer. This will be differently sized depending
       on whether purify's been compiled in */
  case SVt_IV:
#ifdef PURIFY
    total_size += sizeof(sizeof(XPVIV));
#else
    total_size += sizeof(IV);
#endif
    break;
    /* Is it a float? Like the int, it depends on purify */
  case SVt_NV:
#ifdef PURIFY
    total_size += sizeof(sizeof(XPVNV));
#else
    total_size += sizeof(NV);
#endif
    break;
    /* Is it a reference? */
  case SVt_RV:
    total_size += sizeof(XRV);
    break;
    /* How about a plain string? In which case we need to add in how
       much has been allocated */
  case SVt_PV:
    total_size += sizeof(XPV);
    total_size += SvLEN(thing);
    break;
    /* A string with an integer part? */
  case SVt_PVIV:
    total_size += sizeof(XPVIV);
    total_size += SvLEN(thing);
    break;
    /* A string with a float part? */
  case SVt_PVNV:
    total_size += sizeof(XPVNV);
    total_size += SvLEN(thing);
    break;
  case SVt_PVMG:
    total_size += sizeof(XPVMG);
    total_size += SvLEN(thing);
    total_size += magic_size(thing, tracking_hash);
    break;
  case SVt_PVBM:
    total_size += sizeof(XPVBM);
    total_size += SvLEN(thing);
    total_size += magic_size(thing, tracking_hash);
    break;
  case SVt_PVLV:
    total_size += sizeof(XPVLV);
    total_size += SvLEN(thing);
    total_size += magic_size(thing, tracking_hash);
    break;
    /* How much space is dedicated to the array? Not counting the
       elements in the array, mind, just the array itself */
  case SVt_PVAV:
    total_size += sizeof(XPVAV);
    /* Is there anything in the array? */
    if (AvMAX(thing) != -1) {
      total_size += sizeof(SV *) * AvMAX(thing);
    }
    /* Add in the bits on the other side of the beginning */
    total_size += (sizeof(SV *) * (AvARRAY(thing) - AvALLOC(thing)));
    /* Is there something hanging off the arylen element? */
    if (AvARYLEN(thing)) {
      if (check_new(tracking_hash, AvARYLEN(thing))) {
	total_size += thing_size(AvARYLEN(thing), tracking_hash);
      }
    }
    total_size += magic_size(thing, tracking_hash);
    break;
  case SVt_PVHV:
    /* First the base struct */
    total_size += sizeof(XPVHV);
    /* Now the array of buckets */
    total_size += (sizeof(HE *) * (HvMAX(thing) + 1));
    /* Now walk the bucket chain */
    if (HvARRAY(thing)) {
      HE *cur_entry;
      IV cur_bucket = 0;
      for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
	cur_entry = *(HvARRAY(thing) + cur_bucket);
	while (cur_entry) {
	  total_size += sizeof(HE);
	  if (cur_entry->hent_hek) {
	    /* Hash keys can be shared. Have we seen this before? */
	    if (check_new(tracking_hash, cur_entry->hent_hek)) {
	      total_size += sizeof(HEK);
	      total_size += cur_entry->hent_hek->hek_len - 1;
	    }
	  }
	  cur_entry = cur_entry->hent_next;
	}
      }
    }
    total_size += magic_size(thing, tracking_hash);
    break;
  case SVt_PVCV:
    total_size += sizeof(XPVCV);
    carp("CV isn't complete");
    break;
  case SVt_PVGV:
    total_size += sizeof(XPVGV);
    carp("GC isn't complete");
    break;
  case SVt_PVFM:
    total_size += sizeof(XPVFM);
    carp("FM isn't complete");
    break;
  case SVt_PVIO:
    total_size += sizeof(XPVIO);
    carp("IO isn't complete");
    break;
  default:
    croak("Unknown variable type");
  }
  return total_size;
}


MODULE = Devel::Size		PACKAGE = Devel::Size		

IV
size(orig_thing)
     SV *orig_thing
CODE:
{
  SV *thing = orig_thing;
  /* Hash to track our seen pointers */
  HV *tracking_hash = newHV();

  /* If they passed us a reference then dereference it. This is the
     only way we can check the sizes of arrays and hashes */
  if (SvOK(thing) && SvROK(thing)) {
    thing = SvRV(thing);
  }
  
  RETVAL = thing_size(thing, tracking_hash);
  /* Clean up after ourselves */
  SvREFCNT_dec(tracking_hash);
}
OUTPUT:
  RETVAL


IV
total_size(orig_thing)
       SV *orig_thing
CODE:
{
  SV *thing = orig_thing;
  /* Hash to track our seen pointers */
  HV *tracking_hash = newHV();
  AV *pending_array = newAV();

  /* Size starts at zero */
  RETVAL = 0;

  /* If they passed us a reference then dereference it. This is the
     only way we can check the sizes of arrays and hashes */
  if (SvOK(thing) && SvROK(thing)) {
    thing = SvRV(thing);
  }

  /* Put it on the pending array */
  av_push(pending_array, thing);

  /* Now just yank things off the end of the array until it's done */
  while (&PL_sv_undef != (thing = av_pop(pending_array))) {
    /* Process it if we've not seen it */
    if (check_new(tracking_hash, thing)) {
      /* First, is it pointing to or contraining something else? */
      if (SvOK(thing)) {
	/* Yes, it is. So let's check the type */

	switch (SvTYPE(thing)) {
	case SVt_RV:
	  av_push(pending_array, SvRV(thing));
	  break;

	case SVt_PVAV:
	  {
	    /* Quick alias to cut down on casting */
	    AV *tempAV = (AV *)thing;
	    SV **tempSV;
	    
	    /* Any elements? */
	    if (av_len(tempAV) != -1) {
	      IV index;
	      /* Run through them all */
	      for (index = 0; index <= av_len(tempAV); index++) {
		/* Did we get something? */
		if (tempSV = av_fetch(tempAV, index, 0)) {
		  /* Was it undef? */
		  if (*tempSV != &PL_sv_undef) {
		    /* Apparently not. Save it for later */
		    av_push(pending_array, *tempSV);
		  }
		}
	      }
	    }
	  }
	  break;

	case SVt_PVHV:
	  break;
	 
	default:
	  puts("Dunno");
	}
      }

      RETVAL += thing_size(thing, tracking_hash);
    }
  }
  
  /* Clean up after ourselves */
  SvREFCNT_dec(tracking_hash);
  SvREFCNT_dec(pending_array);
}
OUTPUT:
  RETVAL
Commit	Line	Data
e98cedbf	1	#include "EXTERN.h"
	2	#include "perl.h"
	3	#include "XSUB.h"
	4
6a9ad7ec	5	#define carp puts
6a9ad7ec	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);
4ab42718	109	total_size += SvLEN(thing);
6a9ad7ec	110	total_size += magic_size(thing, tracking_hash);
e98cedbf	111	break;
e98cedbf	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;
e98cedbf	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;
e98cedbf	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;
a6ea0805	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)) {
	156	total_size += sizeof(HEK);
	157	total_size += cur_entry->hent_hek->hek_len - 1;
	158	}
a6ea0805	159	}
	160	cur_entry = cur_entry->hent_next;
	161	}
	162	}
	163	}
6a9ad7ec	164	total_size += magic_size(thing, tracking_hash);
e98cedbf	165	break;
e98cedbf	166	case SVt_PVCV:
6a9ad7ec	167	total_size += sizeof(XPVCV);
6a9ad7ec	168	carp("CV isn't complete");
e98cedbf	169	break;
e98cedbf	170	case SVt_PVGV:
6a9ad7ec	171	total_size += sizeof(XPVGV);
6a9ad7ec	172	carp("GC isn't complete");
e98cedbf	173	break;
e98cedbf	174	case SVt_PVFM:
6a9ad7ec	175	total_size += sizeof(XPVFM);
6a9ad7ec	176	carp("FM isn't complete");
e98cedbf	177	break;
e98cedbf	178	case SVt_PVIO:
6a9ad7ec	179	total_size += sizeof(XPVIO);
6a9ad7ec	180	carp("IO isn't complete");
e98cedbf	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
a6ea0805	191	IV
	192	size(orig_thing)
	193	SV *orig_thing
e98cedbf	194	CODE:
e98cedbf	195	{
6a9ad7ec	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);
e98cedbf	288	}
	289	OUTPUT:
	290	RETVAL
6a9ad7ec	291