/*
 * This file was generated automatically by ExtUtils::ParseXS version 2.18 from the
 * contents of LeakTrace.xs. Do not edit this file, edit LeakTrace.xs instead.
 *
 *	ANY CHANGES MADE HERE WILL BE LOST! 
 *
 */

#line 1 "lib/Devel/LeakTrace.xs"
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include <glib.h>


typedef struct {
    char *file;
    int line;
} when;

/* a few globals, never mind the mess for now */
GHashTable *used = NULL;
GHashTable *new_used = NULL;

/* cargo from Devel::Leak - wander the arena, see what SVs live */
typedef long used_proc _((void *,SV *,long));

static
long int
sv_apply_to_used(void *p, used_proc *proc, long n) {
    SV *sva;
    for (sva = PL_sv_arenaroot; sva; sva = (SV *) SvANY(sva)) {
        SV *sv = sva + 1;
        SV *svend = &sva[SvREFCNT(sva)];

        while (sv < svend) {
            if (SvTYPE(sv) != SVTYPEMASK) {
                n = (*proc) (p, sv, n);
            }
            ++sv;
        }
    }
    return n;
}
/* end Devel::Leak cargo */


static
long
note_used(void *p, SV* sv, long n) {
    when *old = NULL;

    if (used && (old = g_hash_table_lookup( used, sv ))) {
	g_hash_table_insert(new_used, sv, old);
	return n;
    }
    g_hash_table_insert(new_used, sv, p);
    return 1;
}

static
void
print_me(gpointer key, gpointer value, gpointer user_data) {
    when *w = value;
    char *type;

    switch SvTYPE((SV*)key) {
    case SVt_PVAV: type = "AV"; break;
    case SVt_PVHV: type = "HV"; break;
    case SVt_PVCV: type = "CV"; break;
    case SVt_RV:   type = "RV"; break;
    case SVt_PVGV: type = "GV"; break;
    default: type = "SV";
    }

    if (w->file) {
        fprintf(stderr, "leaked %s(0x%x) from %s line %d\n", 
		type, key, w->file, w->line);
    }
}

static
int
note_changes( char *file, int line ) {
    static when *w = NULL;
    int ret;

    if (!w) w = malloc(sizeof(when));
    w->line = line;
    w->file = file;
    new_used = g_hash_table_new( NULL, NULL );
    if (sv_apply_to_used( w, note_used, 0 )) w = NULL;
    if (used) g_hash_table_destroy( used );
    used = new_used;
    return ret;
}

/* Now this bit of cargo is a derived from Devel::Caller */

static
int
runops_leakcheck(pTHX) {
    char *lastfile = 0;
    int lastline = 0;
    IV last_count = 0;

    while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX))) {
        PERL_ASYNC_CHECK();

        if (PL_op->op_type == OP_NEXTSTATE) {
            if (PL_sv_count != last_count) {
                note_changes( lastfile, lastline );
                last_count = PL_sv_count;
            }
            lastfile = CopFILE(cCOP);
            lastline = CopLINE(cCOP);
        }
    }

    note_changes( lastfile, lastline );

    TAINT_NOT;
    return 0;
}

#ifndef PERL_UNUSED_VAR
#  define PERL_UNUSED_VAR(var) if (0) var = var
#endif

#line 132 "lib/Devel/LeakTrace.c"

XS(XS_Devel__LeakTrace_hook_runops); /* prototype to pass -Wmissing-prototypes */
XS(XS_Devel__LeakTrace_hook_runops)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 0)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Devel::LeakTrace::hook_runops", "");
    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
#line 125 "lib/Devel/LeakTrace.xs"
{
    note_changes(NULL, 0);
    PL_runops = runops_leakcheck;
}
#line 153 "lib/Devel/LeakTrace.c"
	PUTBACK;
	return;
    }
}


XS(XS_Devel__LeakTrace_reset_counters); /* prototype to pass -Wmissing-prototypes */
XS(XS_Devel__LeakTrace_reset_counters)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 0)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Devel::LeakTrace::reset_counters", "");
    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(ax); /* -Wall */
    SP -= items;
    {
#line 133 "lib/Devel/LeakTrace.xs"
{
    if (used) g_hash_table_destroy( used );
    used = NULL;
    note_changes(NULL, 0);
}
#line 180 "lib/Devel/LeakTrace.c"
	PUTBACK;
	return;
    }
}


XS(XS_Devel__LeakTrace_show_used); /* prototype to pass -Wmissing-prototypes */
XS(XS_Devel__LeakTrace_show_used)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    if (items != 0)
       Perl_croak(aTHX_ "Usage: %s(%s)", "Devel::LeakTrace::show_used", "");
    PERL_UNUSED_VAR(cv); /* -W */
    {
#line 142 "lib/Devel/LeakTrace.xs"
{
    if (used) g_hash_table_foreach( used, print_me, NULL );
}
#line 203 "lib/Devel/LeakTrace.c"
    }
    XSRETURN_EMPTY;
}

#ifdef __cplusplus
extern "C"
#endif
XS(boot_Devel__LeakTrace); /* prototype to pass -Wmissing-prototypes */
XS(boot_Devel__LeakTrace)
{
#ifdef dVAR
    dVAR; dXSARGS;
#else
    dXSARGS;
#endif
    char* file = __FILE__;

    PERL_UNUSED_VAR(cv); /* -W */
    PERL_UNUSED_VAR(items); /* -W */
    XS_VERSION_BOOTCHECK ;

        newXSproto("Devel::LeakTrace::hook_runops", XS_Devel__LeakTrace_hook_runops, file, "");
        newXSproto("Devel::LeakTrace::reset_counters", XS_Devel__LeakTrace_reset_counters, file, "");
        newXSproto("Devel::LeakTrace::show_used", XS_Devel__LeakTrace_show_used, file, "");
    XSRETURN_YES;
}



syntax highlighted by Code2HTML, v. 0.9.1