[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 a file? */
    if (GvFILE(thing)) {
      if (check_new(tracking_hash, GvFILE(thing))) {
	total_size += strlen(GvFILE(thing));
      }
    }
    /* Is there something hanging off the glob? */
    if (GvGP(thing)) {
      if (check_new(tracking_hash, GvGP(thing))) {
	total_size += sizeof(GP);
      }
    }
    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:
	  /* Run through all the pieces and push the ones with bits */
	  if (GvSV(thing)) {
	    av_push(pending_array, (SV *)GvSV(thing));
	  }
	  if (GvFORM(thing)) {
	    av_push(pending_array, (SV *)GvFORM(thing));
	  }
	  if (GvAV(thing)) {
	    av_push(pending_array, (SV *)GvAV(thing));
	  }
	  if (GvHV(thing)) {
	    av_push(pending_array, (SV *)GvHV(thing));
	  }
	  if (GvCV(thing)) {
	    av_push(pending_array, (SV *)GvCV(thing));
	  }
	  break;
	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);
0bff12d8	175	/* Is there a file? */
	176	if (GvFILE(thing)) {
	177	if (check_new(tracking_hash, GvFILE(thing))) {
	178	total_size += strlen(GvFILE(thing));
	179	}
	180	}
5c2e1b12	181	/* Is there something hanging off the glob? */
	182	if (GvGP(thing)) {
	183	if (check_new(tracking_hash, GvGP(thing))) {
	184	total_size += sizeof(GP);
	185	}
	186	}
e98cedbf	187	break;
e98cedbf	188	case SVt_PVFM:
6a9ad7ec	189	total_size += sizeof(XPVFM);
6a9ad7ec	190	carp("FM isn't complete");
e98cedbf	191	break;
e98cedbf	192	case SVt_PVIO:
6a9ad7ec	193	total_size += sizeof(XPVIO);
6a9ad7ec	194	carp("IO isn't complete");
e98cedbf	195	break;
	196	default:
	197	croak("Unknown variable type");
	198	}
	199	return total_size;
	200	}
	201
	202
	203	MODULE = Devel::Size PACKAGE = Devel::Size
	204
a6ea0805	205	IV
	206	size(orig_thing)
	207	SV *orig_thing
e98cedbf	208	CODE:
e98cedbf	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();
	237
	238	/* Size starts at zero */
	239	RETVAL = 0;
	240
	241	/* If they passed us a reference then dereference it. This is the
	242	only way we can check the sizes of arrays and hashes */
	243	if (SvOK(thing) && SvROK(thing)) {
	244	thing = SvRV(thing);
	245	}
	246
	247	/* Put it on the pending array */
	248	av_push(pending_array, thing);
	249
	250	/* Now just yank things off the end of the array until it's done */
e96acca9	251	while (av_len(pending_array) >= 0) {
e96acca9	252	thing = av_pop(pending_array);
6a9ad7ec	253	/* Process it if we've not seen it */
6a9ad7ec	254	if (check_new(tracking_hash, thing)) {
e96acca9	255	/* Is it valid? */
e96acca9	256	if (thing) {
6a9ad7ec	257	/* Yes, it is. So let's check the type */
6a9ad7ec	258	switch (SvTYPE(thing)) {
	259	case SVt_RV:
	260	av_push(pending_array, SvRV(thing));
	261	break;
	262
	263	case SVt_PVAV:
	264	{
	265	/* Quick alias to cut down on casting */
	266	AV tempAV = (AV )thing;
	267	SV **tempSV;
	268
	269	/* Any elements? */
	270	if (av_len(tempAV) != -1) {
	271	IV index;
	272	/* Run through them all */
	273	for (index = 0; index <= av_len(tempAV); index++) {
	274	/* Did we get something? */
	275	if (tempSV = av_fetch(tempAV, index, 0)) {
	276	/* Was it undef? */
	277	if (*tempSV != &PL_sv_undef) {
	278	/* Apparently not. Save it for later */
	279	av_push(pending_array, *tempSV);
	280	}
	281	}
	282	}
	283	}
	284	}
	285	break;
	286
	287	case SVt_PVHV:
e96acca9	288	/* Is there anything in here? */
e96acca9	289	if (hv_iterinit((HV *)thing)) {
5c2e1b12	290	HE *temp_he;
	291	while (temp_he = hv_iternext((HV *)thing)) {
	292	av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9	293	}
e96acca9	294	}
6a9ad7ec	295	break;
6a9ad7ec	296
5c2e1b12	297	case SVt_PVGV:
0bff12d8	298	/* Run through all the pieces and push the ones with bits */
	299	if (GvSV(thing)) {
	300	av_push(pending_array, (SV *)GvSV(thing));
	301	}
	302	if (GvFORM(thing)) {
	303	av_push(pending_array, (SV *)GvFORM(thing));
	304	}
	305	if (GvAV(thing)) {
	306	av_push(pending_array, (SV *)GvAV(thing));
	307	}
	308	if (GvHV(thing)) {
	309	av_push(pending_array, (SV *)GvHV(thing));
	310	}
	311	if (GvCV(thing)) {
	312	av_push(pending_array, (SV *)GvCV(thing));
	313	}
	314	break;
6a9ad7ec	315	default:
e96acca9	316	break;
6a9ad7ec	317	}
	318	}
	319
	320	RETVAL += thing_size(thing, tracking_hash);
	321	}
	322	}
	323
	324	/* Clean up after ourselves */
	325	SvREFCNT_dec(tracking_hash);
	326	SvREFCNT_dec(pending_array);
e98cedbf	327	}
	328	OUTPUT:
	329	RETVAL
6a9ad7ec	330