[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		

PROTOTYPES: DISABLE

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
e98cedbf	202	MODULE = Devel::Size PACKAGE = Devel::Size
e98cedbf	203
fea63ffa	204	PROTOTYPES: DISABLE
fea63ffa	205
a6ea0805	206	IV
	207	size(orig_thing)
	208	SV *orig_thing
e98cedbf	209	CODE:
e98cedbf	210	{
6a9ad7ec	211	SV *thing = orig_thing;
	212	/* Hash to track our seen pointers */
	213	HV *tracking_hash = newHV();
	214
	215	/* If they passed us a reference then dereference it. This is the
	216	only way we can check the sizes of arrays and hashes */
	217	if (SvOK(thing) && SvROK(thing)) {
	218	thing = SvRV(thing);
	219	}
	220
	221	RETVAL = thing_size(thing, tracking_hash);
	222	/* Clean up after ourselves */
	223	SvREFCNT_dec(tracking_hash);
	224	}
	225	OUTPUT:
	226	RETVAL
	227
	228
	229	IV
	230	total_size(orig_thing)
	231	SV *orig_thing
	232	CODE:
	233	{
	234	SV *thing = orig_thing;
	235	/* Hash to track our seen pointers */
	236	HV *tracking_hash = newHV();
	237	AV *pending_array = newAV();
	238
	239	/* Size starts at zero */
	240	RETVAL = 0;
	241
	242	/* If they passed us a reference then dereference it. This is the
	243	only way we can check the sizes of arrays and hashes */
	244	if (SvOK(thing) && SvROK(thing)) {
	245	thing = SvRV(thing);
	246	}
	247
	248	/* Put it on the pending array */
	249	av_push(pending_array, thing);
	250
	251	/* Now just yank things off the end of the array until it's done */
e96acca9	252	while (av_len(pending_array) >= 0) {
e96acca9	253	thing = av_pop(pending_array);
6a9ad7ec	254	/* Process it if we've not seen it */
6a9ad7ec	255	if (check_new(tracking_hash, thing)) {
e96acca9	256	/* Is it valid? */
e96acca9	257	if (thing) {
6a9ad7ec	258	/* Yes, it is. So let's check the type */
6a9ad7ec	259	switch (SvTYPE(thing)) {
	260	case SVt_RV:
	261	av_push(pending_array, SvRV(thing));
	262	break;
	263
	264	case SVt_PVAV:
	265	{
	266	/* Quick alias to cut down on casting */
	267	AV tempAV = (AV )thing;
	268	SV **tempSV;
	269
	270	/* Any elements? */
	271	if (av_len(tempAV) != -1) {
	272	IV index;
	273	/* Run through them all */
	274	for (index = 0; index <= av_len(tempAV); index++) {
	275	/* Did we get something? */
	276	if (tempSV = av_fetch(tempAV, index, 0)) {
	277	/* Was it undef? */
	278	if (*tempSV != &PL_sv_undef) {
	279	/* Apparently not. Save it for later */
	280	av_push(pending_array, *tempSV);
	281	}
	282	}
	283	}
	284	}
	285	}
	286	break;
	287
	288	case SVt_PVHV:
e96acca9	289	/* Is there anything in here? */
e96acca9	290	if (hv_iterinit((HV *)thing)) {
5c2e1b12	291	HE *temp_he;
	292	while (temp_he = hv_iternext((HV *)thing)) {
	293	av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9	294	}
e96acca9	295	}
6a9ad7ec	296	break;
6a9ad7ec	297
5c2e1b12	298	case SVt_PVGV:
0bff12d8	299	/* Run through all the pieces and push the ones with bits */
	300	if (GvSV(thing)) {
	301	av_push(pending_array, (SV *)GvSV(thing));
	302	}
	303	if (GvFORM(thing)) {
	304	av_push(pending_array, (SV *)GvFORM(thing));
	305	}
	306	if (GvAV(thing)) {
	307	av_push(pending_array, (SV *)GvAV(thing));
	308	}
	309	if (GvHV(thing)) {
	310	av_push(pending_array, (SV *)GvHV(thing));
	311	}
	312	if (GvCV(thing)) {
	313	av_push(pending_array, (SV *)GvCV(thing));
	314	}
	315	break;
6a9ad7ec	316	default:
e96acca9	317	break;
6a9ad7ec	318	}
	319	}
	320
	321	RETVAL += thing_size(thing, tracking_hash);
	322	}
	323	}
	324
	325	/* Clean up after ourselves */
	326	SvREFCNT_dec(tracking_hash);
	327	SvREFCNT_dec(pending_array);
e98cedbf	328	}
	329	OUTPUT:
	330	RETVAL
6a9ad7ec	331