[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

static int go_yell = 1;

/* 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);
    if (go_yell) {
      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);
    if (go_yell) {
      carp("FM isn't complete");
    }
    break;
  case SVt_PVIO:
    total_size += sizeof(XPVIO);
    if (go_yell) {
      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();
  SV *warn_flag;

  /* Check warning status */
  go_yell = 0;

  if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) {
    go_yell = SvIV(warn_flag);
  }
  

  /* 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;
  SV *warn_flag;

  IV count = 0;

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

  /* Check warning status */
  go_yell = 0;

  if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) {
    go_yell = SvIV(warn_flag);
  }
  

  /* 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
ebb2c5b9	11	static int go_yell = 1;
ebb2c5b9	12
6a9ad7ec	13	/* Checks to see if thing is in the hash. Returns true or false, and
	14	notes thing in the hash.
	15
	16	This code does one Evil Thing. Since we're tracking pointers, we
	17	tell perl that the string key is the address in the pointer. We do this by
	18	passing in the address of the address, along with the size of a
	19	pointer as the length. Perl then uses the four (or eight, on
	20	64-bit machines) bytes of the address as the string we're using as
	21	the key */
	22	IV check_new(HV tracking_hash, void thing) {
	23	if (hv_exists(tracking_hash, (char )&thing, sizeof(void ))) {
	24	return FALSE;
	25	}
	26	hv_store(tracking_hash, (char )&thing, sizeof(void ), &PL_sv_undef, 0);
	27	return TRUE;
	28
	29	}
	30
	31	/* Figure out how much magic is attached to the SV and return the
	32	size */
	33	IV magic_size(SV thing, HV tracking_hash) {
	34	IV total_size = 0;
	35	MAGIC *magic_pointer;
	36
	37	/* Is there any? */
	38	if (!SvMAGIC(thing)) {
	39	/* No, bail */
	40	return 0;
	41	}
	42
	43	/* Get the base magic pointer */
	44	magic_pointer = SvMAGIC(thing);
	45
	46	/* Have we seen the magic pointer? */
	47	while (magic_pointer && check_new(tracking_hash, magic_pointer)) {
	48	total_size += sizeof(MAGIC);
	49
	50	/* Have we seen the magic vtable? */
	51	if (magic_pointer->mg_virtual &&
	52	check_new(tracking_hash, magic_pointer->mg_virtual)) {
	53	total_size += sizeof(MGVTBL);
	54	}
	55
	56	/* Get the next in the chain */
	57	magic_pointer = magic_pointer->mg_moremagic;
	58	}
	59
	60	return total_size;
	61	}
	62
	63
	64	UV thing_size(SV orig_thing, HV tracking_hash) {
e98cedbf	65	SV *thing = orig_thing;
	66	UV total_size = sizeof(SV);
	67
e98cedbf	68	switch (SvTYPE(thing)) {
	69	/* Is it undef? */
	70	case SVt_NULL:
	71	break;
	72	/* Just a plain integer. This will be differently sized depending
	73	on whether purify's been compiled in */
	74	case SVt_IV:
	75	#ifdef PURIFY
	76	total_size += sizeof(sizeof(XPVIV));
	77	#else
	78	total_size += sizeof(IV);
	79	#endif
	80	break;
	81	/* Is it a float? Like the int, it depends on purify */
	82	case SVt_NV:
	83	#ifdef PURIFY
	84	total_size += sizeof(sizeof(XPVNV));
	85	#else
	86	total_size += sizeof(NV);
	87	#endif
	88	break;
	89	/* Is it a reference? */
	90	case SVt_RV:
	91	total_size += sizeof(XRV);
	92	break;
	93	/* How about a plain string? In which case we need to add in how
	94	much has been allocated */
	95	case SVt_PV:
	96	total_size += sizeof(XPV);
	97	total_size += SvLEN(thing);
	98	break;
	99	/* A string with an integer part? */
	100	case SVt_PVIV:
	101	total_size += sizeof(XPVIV);
	102	total_size += SvLEN(thing);
	103	break;
	104	/* A string with a float part? */
	105	case SVt_PVNV:
	106	total_size += sizeof(XPVNV);
	107	total_size += SvLEN(thing);
	108	break;
	109	case SVt_PVMG:
4ab42718	110	total_size += sizeof(XPVMG);
4ab42718	111	total_size += SvLEN(thing);
6a9ad7ec	112	total_size += magic_size(thing, tracking_hash);
e98cedbf	113	break;
e98cedbf	114	case SVt_PVBM:
6a9ad7ec	115	total_size += sizeof(XPVBM);
	116	total_size += SvLEN(thing);
	117	total_size += magic_size(thing, tracking_hash);
e98cedbf	118	break;
e98cedbf	119	case SVt_PVLV:
6a9ad7ec	120	total_size += sizeof(XPVLV);
	121	total_size += SvLEN(thing);
	122	total_size += magic_size(thing, tracking_hash);
e98cedbf	123	break;
	124	/* How much space is dedicated to the array? Not counting the
	125	elements in the array, mind, just the array itself */
	126	case SVt_PVAV:
	127	total_size += sizeof(XPVAV);
	128	/* Is there anything in the array? */
	129	if (AvMAX(thing) != -1) {
	130	total_size += sizeof(SV ) AvMAX(thing);
	131	}
	132	/* Add in the bits on the other side of the beginning */
	133	total_size += (sizeof(SV ) (AvARRAY(thing) - AvALLOC(thing)));
	134	/* Is there something hanging off the arylen element? */
	135	if (AvARYLEN(thing)) {
6a9ad7ec	136	if (check_new(tracking_hash, AvARYLEN(thing))) {
	137	total_size += thing_size(AvARYLEN(thing), tracking_hash);
	138	}
e98cedbf	139	}
6a9ad7ec	140	total_size += magic_size(thing, tracking_hash);
e98cedbf	141	break;
e98cedbf	142	case SVt_PVHV:
a6ea0805	143	/* First the base struct */
	144	total_size += sizeof(XPVHV);
	145	/* Now the array of buckets */
	146	total_size += (sizeof(HE ) (HvMAX(thing) + 1));
	147	/* Now walk the bucket chain */
6a9ad7ec	148	if (HvARRAY(thing)) {
a6ea0805	149	HE *cur_entry;
a6ea0805	150	IV cur_bucket = 0;
a6ea0805	151	for (cur_bucket = 0; cur_bucket <= HvMAX(thing); cur_bucket++) {
	152	cur_entry = *(HvARRAY(thing) + cur_bucket);
	153	while (cur_entry) {
	154	total_size += sizeof(HE);
	155	if (cur_entry->hent_hek) {
6a9ad7ec	156	/* Hash keys can be shared. Have we seen this before? */
6a9ad7ec	157	if (check_new(tracking_hash, cur_entry->hent_hek)) {
b98fcdb9	158	total_size += HEK_BASESIZE + cur_entry->hent_hek->hek_len + 2;
6a9ad7ec	159	}
a6ea0805	160	}
	161	cur_entry = cur_entry->hent_next;
	162	}
	163	}
	164	}
6a9ad7ec	165	total_size += magic_size(thing, tracking_hash);
e98cedbf	166	break;
e98cedbf	167	case SVt_PVCV:
6a9ad7ec	168	total_size += sizeof(XPVCV);
5c2e1b12	169	total_size += magic_size(thing, tracking_hash);
ebb2c5b9	170	if (go_yell) {
	171	carp("CV isn't complete");
	172	}
e98cedbf	173	break;
e98cedbf	174	case SVt_PVGV:
5c2e1b12	175	total_size += magic_size(thing, tracking_hash);
6a9ad7ec	176	total_size += sizeof(XPVGV);
5c2e1b12	177	total_size += GvNAMELEN(thing);
0bff12d8	178	/* Is there a file? */
	179	if (GvFILE(thing)) {
	180	if (check_new(tracking_hash, GvFILE(thing))) {
	181	total_size += strlen(GvFILE(thing));
	182	}
	183	}
5c2e1b12	184	/* Is there something hanging off the glob? */
	185	if (GvGP(thing)) {
	186	if (check_new(tracking_hash, GvGP(thing))) {
	187	total_size += sizeof(GP);
	188	}
	189	}
e98cedbf	190	break;
e98cedbf	191	case SVt_PVFM:
6a9ad7ec	192	total_size += sizeof(XPVFM);
ebb2c5b9	193	if (go_yell) {
	194	carp("FM isn't complete");
	195	}
e98cedbf	196	break;
e98cedbf	197	case SVt_PVIO:
6a9ad7ec	198	total_size += sizeof(XPVIO);
ebb2c5b9	199	if (go_yell) {
	200	carp("IO isn't complete");
	201	}
e98cedbf	202	break;
	203	default:
	204	croak("Unknown variable type");
	205	}
	206	return total_size;
	207	}
	208
e98cedbf	209	MODULE = Devel::Size PACKAGE = Devel::Size
e98cedbf	210
fea63ffa	211	PROTOTYPES: DISABLE
fea63ffa	212
a6ea0805	213	IV
	214	size(orig_thing)
	215	SV *orig_thing
e98cedbf	216	CODE:
e98cedbf	217	{
6a9ad7ec	218	SV *thing = orig_thing;
	219	/* Hash to track our seen pointers */
	220	HV *tracking_hash = newHV();
ebb2c5b9	221	SV *warn_flag;
	222
	223	/* Check warning status */
	224	go_yell = 0;
	225
	226	if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) {
	227	go_yell = SvIV(warn_flag);
	228	}
	229
6a9ad7ec	230
	231	/* If they passed us a reference then dereference it. This is the
	232	only way we can check the sizes of arrays and hashes */
	233	if (SvOK(thing) && SvROK(thing)) {
	234	thing = SvRV(thing);
	235	}
	236
	237	RETVAL = thing_size(thing, tracking_hash);
	238	/* Clean up after ourselves */
	239	SvREFCNT_dec(tracking_hash);
	240	}
	241	OUTPUT:
	242	RETVAL
	243
	244
	245	IV
	246	total_size(orig_thing)
	247	SV *orig_thing
	248	CODE:
	249	{
	250	SV *thing = orig_thing;
	251	/* Hash to track our seen pointers */
	252	HV *tracking_hash = newHV();
	253	AV *pending_array = newAV();
b98fcdb9	254	IV size = 0;
ebb2c5b9	255	SV *warn_flag;
b98fcdb9	256
b98fcdb9	257	IV count = 0;
6a9ad7ec	258
	259	/* Size starts at zero */
	260	RETVAL = 0;
	261
ebb2c5b9	262	/* Check warning status */
	263	go_yell = 0;
	264
	265	if (NULL != (warn_flag = get_sv("Devel::Size::warn", FALSE))) {
	266	go_yell = SvIV(warn_flag);
	267	}
	268
	269
6a9ad7ec	270	/* If they passed us a reference then dereference it. This is the
	271	only way we can check the sizes of arrays and hashes */
	272	if (SvOK(thing) && SvROK(thing)) {
	273	thing = SvRV(thing);
	274	}
	275
	276	/* Put it on the pending array */
	277	av_push(pending_array, thing);
	278
	279	/* Now just yank things off the end of the array until it's done */
e96acca9	280	while (av_len(pending_array) >= 0) {
e96acca9	281	thing = av_pop(pending_array);
6a9ad7ec	282	/* Process it if we've not seen it */
6a9ad7ec	283	if (check_new(tracking_hash, thing)) {
e96acca9	284	/* Is it valid? */
e96acca9	285	if (thing) {
6a9ad7ec	286	/* Yes, it is. So let's check the type */
6a9ad7ec	287	switch (SvTYPE(thing)) {
	288	case SVt_RV:
	289	av_push(pending_array, SvRV(thing));
	290	break;
	291
	292	case SVt_PVAV:
	293	{
	294	/* Quick alias to cut down on casting */
	295	AV tempAV = (AV )thing;
	296	SV **tempSV;
	297
	298	/* Any elements? */
	299	if (av_len(tempAV) != -1) {
	300	IV index;
	301	/* Run through them all */
	302	for (index = 0; index <= av_len(tempAV); index++) {
	303	/* Did we get something? */
	304	if (tempSV = av_fetch(tempAV, index, 0)) {
	305	/* Was it undef? */
	306	if (*tempSV != &PL_sv_undef) {
	307	/* Apparently not. Save it for later */
	308	av_push(pending_array, *tempSV);
	309	}
	310	}
	311	}
	312	}
	313	}
	314	break;
	315
	316	case SVt_PVHV:
e96acca9	317	/* Is there anything in here? */
e96acca9	318	if (hv_iterinit((HV *)thing)) {
5c2e1b12	319	HE *temp_he;
	320	while (temp_he = hv_iternext((HV *)thing)) {
	321	av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9	322	}
e96acca9	323	}
6a9ad7ec	324	break;
6a9ad7ec	325
5c2e1b12	326	case SVt_PVGV:
0bff12d8	327	/* Run through all the pieces and push the ones with bits */
	328	if (GvSV(thing)) {
	329	av_push(pending_array, (SV *)GvSV(thing));
	330	}
	331	if (GvFORM(thing)) {
	332	av_push(pending_array, (SV *)GvFORM(thing));
	333	}
	334	if (GvAV(thing)) {
	335	av_push(pending_array, (SV *)GvAV(thing));
	336	}
	337	if (GvHV(thing)) {
	338	av_push(pending_array, (SV *)GvHV(thing));
	339	}
	340	if (GvCV(thing)) {
	341	av_push(pending_array, (SV *)GvCV(thing));
	342	}
	343	break;
6a9ad7ec	344	default:
e96acca9	345	break;
6a9ad7ec	346	}
	347	}
	348
b98fcdb9	349
	350	size = thing_size(thing, tracking_hash);
	351	RETVAL += size;
6a9ad7ec	352	}
	353	}
	354
	355	/* Clean up after ourselves */
	356	SvREFCNT_dec(tracking_hash);
	357	SvREFCNT_dec(pending_array);
e98cedbf	358	}
	359	OUTPUT:
	360	RETVAL
6a9ad7ec	361