[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);
    total_size += magic_size(thing, tracking_hash);
    carp("CV isn't complete");
    break;
  case SVt_PVGV:
    total_size += magic_size(thing, tracking_hash);
    total_size += sizeof(XPVGV);
    total_size += GvNAMELEN(thing);
    /* Is there something hanging off the glob? */
    if (GvGP(thing)) {
      if (check_new(tracking_hash, GvGP(thing))) {
	total_size += sizeof(GP);
      }
    }
    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 (av_len(pending_array) >= 0) {
    thing = av_pop(pending_array);
    /* Process it if we've not seen it */
    if (check_new(tracking_hash, thing)) {
      /* Is it valid? */
      if (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:
	  /* Is there anything in here? */
	  if (hv_iterinit((HV *)thing)) {
	    HE *temp_he;
	    while (temp_he = hv_iternext((HV *)thing)) {
	      av_push(pending_array, hv_iterval((HV *)thing, temp_he));
	    }
	  }
	  break;
	 
	case SVt_PVGV:
	default:
	  break;
	}
      }

      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);
5c2e1b12	168	total_size += magic_size(thing, tracking_hash);
6a9ad7ec	169	carp("CV isn't complete");
e98cedbf	170	break;
e98cedbf	171	case SVt_PVGV:
5c2e1b12	172	total_size += magic_size(thing, tracking_hash);
6a9ad7ec	173	total_size += sizeof(XPVGV);
5c2e1b12	174	total_size += GvNAMELEN(thing);
	175	/* Is there something hanging off the glob? */
	176	if (GvGP(thing)) {
	177	if (check_new(tracking_hash, GvGP(thing))) {
	178	total_size += sizeof(GP);
	179	}
	180	}
6a9ad7ec	181	carp("GC isn't complete");
e98cedbf	182	break;
e98cedbf	183	case SVt_PVFM:
6a9ad7ec	184	total_size += sizeof(XPVFM);
6a9ad7ec	185	carp("FM isn't complete");
e98cedbf	186	break;
e98cedbf	187	case SVt_PVIO:
6a9ad7ec	188	total_size += sizeof(XPVIO);
6a9ad7ec	189	carp("IO isn't complete");
e98cedbf	190	break;
	191	default:
	192	croak("Unknown variable type");
	193	}
	194	return total_size;
	195	}
	196
	197
	198	MODULE = Devel::Size PACKAGE = Devel::Size
	199
a6ea0805	200	IV
	201	size(orig_thing)
	202	SV *orig_thing
e98cedbf	203	CODE:
e98cedbf	204	{
6a9ad7ec	205	SV *thing = orig_thing;
	206	/* Hash to track our seen pointers */
	207	HV *tracking_hash = newHV();
	208
	209	/* If they passed us a reference then dereference it. This is the
	210	only way we can check the sizes of arrays and hashes */
	211	if (SvOK(thing) && SvROK(thing)) {
	212	thing = SvRV(thing);
	213	}
	214
	215	RETVAL = thing_size(thing, tracking_hash);
	216	/* Clean up after ourselves */
	217	SvREFCNT_dec(tracking_hash);
	218	}
	219	OUTPUT:
	220	RETVAL
	221
	222
	223	IV
	224	total_size(orig_thing)
	225	SV *orig_thing
	226	CODE:
	227	{
	228	SV *thing = orig_thing;
	229	/* Hash to track our seen pointers */
	230	HV *tracking_hash = newHV();
	231	AV *pending_array = newAV();
	232
	233	/* Size starts at zero */
	234	RETVAL = 0;
	235
	236	/* If they passed us a reference then dereference it. This is the
	237	only way we can check the sizes of arrays and hashes */
	238	if (SvOK(thing) && SvROK(thing)) {
	239	thing = SvRV(thing);
	240	}
	241
	242	/* Put it on the pending array */
	243	av_push(pending_array, thing);
	244
	245	/* Now just yank things off the end of the array until it's done */
e96acca9	246	while (av_len(pending_array) >= 0) {
e96acca9	247	thing = av_pop(pending_array);
6a9ad7ec	248	/* Process it if we've not seen it */
6a9ad7ec	249	if (check_new(tracking_hash, thing)) {
e96acca9	250	/* Is it valid? */
e96acca9	251	if (thing) {
6a9ad7ec	252	/* Yes, it is. So let's check the type */
6a9ad7ec	253	switch (SvTYPE(thing)) {
	254	case SVt_RV:
	255	av_push(pending_array, SvRV(thing));
	256	break;
	257
	258	case SVt_PVAV:
	259	{
	260	/* Quick alias to cut down on casting */
	261	AV tempAV = (AV )thing;
	262	SV **tempSV;
	263
	264	/* Any elements? */
	265	if (av_len(tempAV) != -1) {
	266	IV index;
	267	/* Run through them all */
	268	for (index = 0; index <= av_len(tempAV); index++) {
	269	/* Did we get something? */
	270	if (tempSV = av_fetch(tempAV, index, 0)) {
	271	/* Was it undef? */
	272	if (*tempSV != &PL_sv_undef) {
	273	/* Apparently not. Save it for later */
	274	av_push(pending_array, *tempSV);
	275	}
	276	}
	277	}
	278	}
	279	}
	280	break;
	281
	282	case SVt_PVHV:
e96acca9	283	/* Is there anything in here? */
e96acca9	284	if (hv_iterinit((HV *)thing)) {
5c2e1b12	285	HE *temp_he;
	286	while (temp_he = hv_iternext((HV *)thing)) {
	287	av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9	288	}
e96acca9	289	}
6a9ad7ec	290	break;
6a9ad7ec	291
5c2e1b12	292	case SVt_PVGV:
6a9ad7ec	293	default:
e96acca9	294	break;
6a9ad7ec	295	}
	296	}
	297
	298	RETVAL += thing_size(thing, tracking_hash);
	299	}
	300	}
	301
	302	/* Clean up after ourselves */
	303	SvREFCNT_dec(tracking_hash);
	304	SvREFCNT_dec(pending_array);
e98cedbf	305	}
	306	OUTPUT:
	307	RETVAL
6a9ad7ec	308