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