[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_yes, 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("Devel::Size: Calculated sizes for CVs are incomplete");
    }
    break;
  case SVt_PVGV:
    total_size += magic_size(thing, tracking_hash);
    total_size += sizeof(XPVGV);
    total_size += GvNAMELEN(thing);
#ifdef GvFILE
    /* Is there a file? */
    if (GvFILE(thing)) {
      if (check_new(tracking_hash, GvFILE(thing))) {
	total_size += strlen(GvFILE(thing));
      }
    }
#endif
    /* Is there something hanging off the glob? */
    if (GvGP(thing)) {
      if (check_new(tracking_hash, GvGP(thing))) {
	total_size += sizeof(GP);
	{
	  SV *generic_thing;
	  if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	  if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	  if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	  if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	  if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	  if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
	    total_size += thing_size(generic_thing, tracking_hash);
	  }
	}
      }
    }
    break;
  case SVt_PVFM:
    total_size += sizeof(XPVFM);
    if (go_yell) {
      carp("Devel::Size: Calculated sizes for FMs are incomplete");
    }
    break;
  case SVt_PVIO:
    total_size += sizeof(XPVIO);
    total_size += magic_size(thing, tracking_hash);
    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
      total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
    }
    /* Some embedded char pointers */
    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
      total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
    }
    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
      total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
    }
    if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
      total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
    }
    /* Throw the GVs on the list to be walked if they're not-null */
    if (((XPVIO *) SvANY(thing))->xio_top_gv) {
      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_top_gv, 
			       tracking_hash);
    }
    if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_bottom_gv, 
			       tracking_hash);
    }
    if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
      total_size += thing_size((SV *)((XPVIO *) SvANY(thing))->xio_fmt_gv, 
			       tracking_hash);
    }

    /* Only go trotting through the IO structures if they're really
       trottable. If USE_PERLIO is defined we can do this. If
       not... we can't, so we don't even try */
#ifdef USE_PERLIO
    /* Dig into xio_ifp and xio_ofp here */
    croak("Devel::Size: Can't size up perlio layers yet");
#endif
    break;
  default:
    croak("Devel::Size: 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 = perl_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 = perl_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	}
78dfb4e7	26	hv_store(tracking_hash, (char )&thing, sizeof(void ), &PL_sv_yes, 0);
6a9ad7ec	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) {
5073b933	171	carp("Devel::Size: Calculated sizes for CVs are incomplete");
ebb2c5b9	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);
78dfb4e7	178	#ifdef GvFILE
0bff12d8	179	/* Is there a file? */
	180	if (GvFILE(thing)) {
	181	if (check_new(tracking_hash, GvFILE(thing))) {
	182	total_size += strlen(GvFILE(thing));
	183	}
	184	}
78dfb4e7	185	#endif
5c2e1b12	186	/* Is there something hanging off the glob? */
	187	if (GvGP(thing)) {
	188	if (check_new(tracking_hash, GvGP(thing))) {
	189	total_size += sizeof(GP);
5073b933	190	{
	191	SV *generic_thing;
	192	if (generic_thing = (SV *)(GvGP(thing)->gp_sv)) {
	193	total_size += thing_size(generic_thing, tracking_hash);
	194	}
	195	if (generic_thing = (SV *)(GvGP(thing)->gp_form)) {
	196	total_size += thing_size(generic_thing, tracking_hash);
	197	}
	198	if (generic_thing = (SV *)(GvGP(thing)->gp_av)) {
	199	total_size += thing_size(generic_thing, tracking_hash);
	200	}
	201	if (generic_thing = (SV *)(GvGP(thing)->gp_hv)) {
	202	total_size += thing_size(generic_thing, tracking_hash);
	203	}
	204	if (generic_thing = (SV *)(GvGP(thing)->gp_egv)) {
	205	total_size += thing_size(generic_thing, tracking_hash);
	206	}
	207	if (generic_thing = (SV *)(GvGP(thing)->gp_cv)) {
	208	total_size += thing_size(generic_thing, tracking_hash);
	209	}
	210	}
5c2e1b12	211	}
5c2e1b12	212	}
e98cedbf	213	break;
e98cedbf	214	case SVt_PVFM:
6a9ad7ec	215	total_size += sizeof(XPVFM);
ebb2c5b9	216	if (go_yell) {
5073b933	217	carp("Devel::Size: Calculated sizes for FMs are incomplete");
ebb2c5b9	218	}
e98cedbf	219	break;
e98cedbf	220	case SVt_PVIO:
6a9ad7ec	221	total_size += sizeof(XPVIO);
5073b933	222	total_size += magic_size(thing, tracking_hash);
	223	if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xpv_pv)) {
	224	total_size += ((XPVIO *) SvANY(thing))->xpv_cur;
ebb2c5b9	225	}
5073b933	226	/* Some embedded char pointers */
	227	if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_top_name)) {
	228	total_size += strlen(((XPVIO *) SvANY(thing))->xio_top_name);
	229	}
	230	if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_fmt_name)) {
	231	total_size += strlen(((XPVIO *) SvANY(thing))->xio_fmt_name);
	232	}
	233	if (check_new(tracking_hash, ((XPVIO *) SvANY(thing))->xio_bottom_name)) {
	234	total_size += strlen(((XPVIO *) SvANY(thing))->xio_bottom_name);
	235	}
	236	/* Throw the GVs on the list to be walked if they're not-null */
	237	if (((XPVIO *) SvANY(thing))->xio_top_gv) {
	238	total_size += thing_size((SV )((XPVIO ) SvANY(thing))->xio_top_gv,
	239	tracking_hash);
	240	}
	241	if (((XPVIO *) SvANY(thing))->xio_bottom_gv) {
	242	total_size += thing_size((SV )((XPVIO ) SvANY(thing))->xio_bottom_gv,
	243	tracking_hash);
	244	}
	245	if (((XPVIO *) SvANY(thing))->xio_fmt_gv) {
	246	total_size += thing_size((SV )((XPVIO ) SvANY(thing))->xio_fmt_gv,
	247	tracking_hash);
	248	}
	249
	250	/* Only go trotting through the IO structures if they're really
	251	trottable. If USE_PERLIO is defined we can do this. If
	252	not... we can't, so we don't even try */
	253	#ifdef USE_PERLIO
	254	/* Dig into xio_ifp and xio_ofp here */
	255	croak("Devel::Size: Can't size up perlio layers yet");
	256	#endif
e98cedbf	257	break;
e98cedbf	258	default:
5073b933	259	croak("Devel::Size: Unknown variable type");
e98cedbf	260	}
	261	return total_size;
	262	}
	263
e98cedbf	264	MODULE = Devel::Size PACKAGE = Devel::Size
e98cedbf	265
fea63ffa	266	PROTOTYPES: DISABLE
fea63ffa	267
a6ea0805	268	IV
	269	size(orig_thing)
	270	SV *orig_thing
e98cedbf	271	CODE:
e98cedbf	272	{
6a9ad7ec	273	SV *thing = orig_thing;
	274	/* Hash to track our seen pointers */
	275	HV *tracking_hash = newHV();
ebb2c5b9	276	SV *warn_flag;
	277
	278	/* Check warning status */
	279	go_yell = 0;
	280
78dfb4e7	281	if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
ebb2c5b9	282	go_yell = SvIV(warn_flag);
	283	}
	284
6a9ad7ec	285
	286	/* If they passed us a reference then dereference it. This is the
	287	only way we can check the sizes of arrays and hashes */
	288	if (SvOK(thing) && SvROK(thing)) {
	289	thing = SvRV(thing);
	290	}
	291
	292	RETVAL = thing_size(thing, tracking_hash);
	293	/* Clean up after ourselves */
	294	SvREFCNT_dec(tracking_hash);
	295	}
	296	OUTPUT:
	297	RETVAL
	298
	299
	300	IV
	301	total_size(orig_thing)
	302	SV *orig_thing
	303	CODE:
	304	{
	305	SV *thing = orig_thing;
	306	/* Hash to track our seen pointers */
	307	HV *tracking_hash = newHV();
	308	AV *pending_array = newAV();
b98fcdb9	309	IV size = 0;
ebb2c5b9	310	SV *warn_flag;
b98fcdb9	311
b98fcdb9	312	IV count = 0;
6a9ad7ec	313
	314	/* Size starts at zero */
	315	RETVAL = 0;
	316
ebb2c5b9	317	/* Check warning status */
	318	go_yell = 0;
	319
78dfb4e7	320	if (NULL != (warn_flag = perl_get_sv("Devel::Size::warn", FALSE))) {
ebb2c5b9	321	go_yell = SvIV(warn_flag);
	322	}
	323
	324
6a9ad7ec	325	/* If they passed us a reference then dereference it. This is the
	326	only way we can check the sizes of arrays and hashes */
	327	if (SvOK(thing) && SvROK(thing)) {
	328	thing = SvRV(thing);
	329	}
	330
	331	/* Put it on the pending array */
	332	av_push(pending_array, thing);
	333
	334	/* Now just yank things off the end of the array until it's done */
e96acca9	335	while (av_len(pending_array) >= 0) {
e96acca9	336	thing = av_pop(pending_array);
6a9ad7ec	337	/* Process it if we've not seen it */
6a9ad7ec	338	if (check_new(tracking_hash, thing)) {
e96acca9	339	/* Is it valid? */
e96acca9	340	if (thing) {
6a9ad7ec	341	/* Yes, it is. So let's check the type */
6a9ad7ec	342	switch (SvTYPE(thing)) {
	343	case SVt_RV:
	344	av_push(pending_array, SvRV(thing));
	345	break;
	346
	347	case SVt_PVAV:
	348	{
	349	/* Quick alias to cut down on casting */
	350	AV tempAV = (AV )thing;
	351	SV **tempSV;
	352
	353	/* Any elements? */
	354	if (av_len(tempAV) != -1) {
	355	IV index;
	356	/* Run through them all */
	357	for (index = 0; index <= av_len(tempAV); index++) {
	358	/* Did we get something? */
	359	if (tempSV = av_fetch(tempAV, index, 0)) {
	360	/* Was it undef? */
	361	if (*tempSV != &PL_sv_undef) {
	362	/* Apparently not. Save it for later */
	363	av_push(pending_array, *tempSV);
	364	}
	365	}
	366	}
	367	}
	368	}
	369	break;
	370
	371	case SVt_PVHV:
e96acca9	372	/* Is there anything in here? */
e96acca9	373	if (hv_iterinit((HV *)thing)) {
5c2e1b12	374	HE *temp_he;
	375	while (temp_he = hv_iternext((HV *)thing)) {
	376	av_push(pending_array, hv_iterval((HV *)thing, temp_he));
e96acca9	377	}
e96acca9	378	}
6a9ad7ec	379	break;
6a9ad7ec	380
5c2e1b12	381	case SVt_PVGV:
0bff12d8	382	/* Run through all the pieces and push the ones with bits */
	383	if (GvSV(thing)) {
	384	av_push(pending_array, (SV *)GvSV(thing));
	385	}
	386	if (GvFORM(thing)) {
	387	av_push(pending_array, (SV *)GvFORM(thing));
	388	}
	389	if (GvAV(thing)) {
	390	av_push(pending_array, (SV *)GvAV(thing));
	391	}
	392	if (GvHV(thing)) {
	393	av_push(pending_array, (SV *)GvHV(thing));
	394	}
	395	if (GvCV(thing)) {
	396	av_push(pending_array, (SV *)GvCV(thing));
	397	}
	398	break;
6a9ad7ec	399	default:
e96acca9	400	break;
6a9ad7ec	401	}
	402	}
	403
b98fcdb9	404
	405	size = thing_size(thing, tracking_hash);
	406	RETVAL += size;
6a9ad7ec	407	}
	408	}
	409
	410	/* Clean up after ourselves */
	411	SvREFCNT_dec(tracking_hash);
	412	SvREFCNT_dec(pending_array);
e98cedbf	413	}
	414	OUTPUT:
	415	RETVAL
6a9ad7ec	416