[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 += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
	    }
	  }
	  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();
  IV size = 0;

  IV count = 0;

  /* 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;
	}
      }

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