From 0e61b4c8296d554065d934a4a0c27bed8603d3de Mon Sep 17 00:00:00 2001 From: Timo Sirainen Date: Sat, 25 Jan 2003 03:19:40 +0000 Subject: [PATCH] Lets see if GC happens to work now without explicit free() calls. Perl objects now set the C pointer to NULL once they're done with it, so this might just work without leaking.. git-svn-id: http://svn.irssi.org/repos/irssi/trunk@3101 dbcabf3a-b0e7-0310-adc4-f8d773084564 --- acconfig.h | 1 + configure.in | 2 ++ src/fe-text/irssi.c | 8 +++--- src/perl/perl-common.c | 56 +++++++++++++++++++++--------------------- src/perl/ui/Formats.xs | 1 + 5 files changed, 37 insertions(+), 31 deletions(-) diff --git a/acconfig.h b/acconfig.h index 70bd9784..24806c2e 100644 --- a/acconfig.h +++ b/acconfig.h @@ -13,6 +13,7 @@ #undef HAVE_GC_H #undef HAVE_GC_GC_H #undef WANT_BIG5 +#undef USE_GC /* macros/curses checks */ #undef HAS_CURSES diff --git a/configure.in b/configure.in index 459c1466..c048c4a2 100644 --- a/configure.in +++ b/configure.in @@ -512,10 +512,12 @@ if test "x$want_gc" = xyes; then AC_CHECK_LIB(gc, GC_malloc, [ AC_CHECK_HEADER(gc/gc.h, [ AC_DEFINE(HAVE_GC_GC_H) + AC_DEFINE(USE_GC) LIBS="$LIBS -lgc" ], [ AC_CHECK_HEADER(gc.h, [ AC_DEFINE(HAVE_GC_H) + AC_DEFINE(USE_GC) LIBS="$LIBS -lgc" ], [ want_gc=no diff --git a/src/fe-text/irssi.c b/src/fe-text/irssi.c index b2a5e955..e397a511 100644 --- a/src/fe-text/irssi.c +++ b/src/fe-text/irssi.c @@ -309,12 +309,13 @@ static void winsock_init(void) } #endif -#if defined (HAVE_GC_H) || defined (HAVE_GC_GC_H) +#ifdef USE_GC #ifdef HAVE_GC_H # include #else # include #endif + GMemVTable gc_mem_table = { GC_malloc, GC_realloc, @@ -331,7 +332,7 @@ int main(int argc, char **argv) { NULL, '\0', 0, NULL } }; -#ifdef HAVE_GC +#ifdef USE_GC g_mem_set_vtable(&gc_mem_table); #endif @@ -377,7 +378,8 @@ int main(int argc, char **argv) /* Does the same as g_main_run(main_loop), except we can call our dirty-checker after each iteration */ while (!quitting) { - if (!dummy) term_refresh_freeze(); + GC_collect_a_little(); + if (!dummy) term_refresh_freeze(); g_main_iteration(TRUE); if (!dummy) term_refresh_thaw(); diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c index 924a7f7c..4c0426ae 100644 --- a/src/perl/perl-common.c +++ b/src/perl/perl-common.c @@ -43,12 +43,6 @@ #include "perl-core.h" #include "perl-common.h" -#ifdef HAVE_GC_H -# include -#elif defined (HAVE_GC_GC_H) -# include -#endif - typedef struct { char *stash; PERL_OBJECT_FUNC fill_func; @@ -60,7 +54,6 @@ STRLEN PL_na; static GHashTable *iobject_stashes, *plain_stashes; static GSList *use_protocols; -static int perl_memory_check_level; /* returns the package who called us */ const char *perl_get_package(void) @@ -102,6 +95,31 @@ SV *perl_func_sv_inc(SV *func, const char *package) return func; } +static int magic_free_object(pTHX_ SV *sv, MAGIC *mg) +{ + sv_setiv(sv, 0); + return 0; +} + +static MGVTBL vtbl_free_object = +{ + NULL, NULL, NULL, NULL, magic_free_object +}; + +static SV *create_sv_ptr(void *object) +{ + SV *sv; + + sv = newSViv((IV)object); + + sv_magic(sv, NULL, '~', NULL, 0); + + SvMAGIC(sv)->mg_private = 0x1551; /* HF */ + SvMAGIC(sv)->mg_virtual = &vtbl_free_object; + + return sv; +} + SV *irssi_bless_iobject(int type, int chat_type, void *object) { PERL_OBJECT_REC *rec; @@ -114,13 +132,13 @@ SV *irssi_bless_iobject(int type, int chat_type, void *object) GINT_TO_POINTER(type | (chat_type << 16))); if (rec == NULL) { /* unknown iobject */ - return newSViv((IV)object); + return create_sv_ptr(object); } stash = gv_stashpv(rec->stash, 1); hv = newHV(); - hv_store(hv, "_irssi", 6, newSViv((IV)object), 0); + hv_store(hv, "_irssi", 6, create_sv_ptr(object), 0); rec->fill_func(hv, object); return sv_bless(newRV_noinc((SV*)hv), stash); } @@ -133,7 +151,7 @@ SV *irssi_bless_plain(const char *stash, void *object) fill_func = g_hash_table_lookup(plain_stashes, stash); hv = newHV(); - hv_store(hv, "_irssi", 6, newSViv((IV)object), 0); + hv_store(hv, "_irssi", 6, create_sv_ptr(object), 0); if (fill_func != NULL) fill_func(hv, object); return sv_bless(newRV_noinc((SV*)hv), gv_stashpv((char *)stash, 1)); @@ -168,14 +186,6 @@ void *irssi_ref_object(SV *o) if (sv == NULL) croak("variable is damaged"); p = GINT_TO_POINTER(SvIV(*sv)); -#ifdef HAVE_GC - if (perl_memory_check_level > 0) { - if (perl_memory_check_level > 1) - GC_gcollect(); - if (GC_base(p) == NULL) - croak("variable is already free'd"); - } -#endif return p; } @@ -644,11 +654,6 @@ static void perl_unregister_protocol(CHAT_PROTOCOL_REC *rec) GINT_TO_POINTER(rec->id)); } -static void read_settings(void) -{ - perl_memory_check_level = settings_get_int("perl_memory_check_level"); -} - void perl_common_start(void) { static PLAIN_OBJECT_INIT_REC core_plains[] = { @@ -663,9 +668,6 @@ void perl_common_start(void) { NULL, NULL } }; - settings_add_int("perl", "perl_memory_check_level", 1); - read_settings(); - iobject_stashes = g_hash_table_new((GHashFunc) g_direct_hash, (GCompareFunc) g_direct_equal); plain_stashes = g_hash_table_new((GHashFunc) g_str_hash, @@ -677,7 +679,6 @@ void perl_common_start(void) signal_add("chat protocol created", (SIGNAL_FUNC) perl_register_protocol); signal_add("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol); - signal_add("setup changed", (SIGNAL_FUNC) read_settings); } void perl_common_stop(void) @@ -696,5 +697,4 @@ void perl_common_stop(void) signal_remove("chat protocol created", (SIGNAL_FUNC) perl_register_protocol); signal_remove("chat protocol destroyed", (SIGNAL_FUNC) perl_unregister_protocol); - signal_remove("setup changed", (SIGNAL_FUNC) read_settings); } diff --git a/src/perl/ui/Formats.xs b/src/perl/ui/Formats.xs index 11a2951c..8450c667 100644 --- a/src/perl/ui/Formats.xs +++ b/src/perl/ui/Formats.xs @@ -6,6 +6,7 @@ static int magic_free_text_dest(pTHX_ SV *sv, MAGIC *mg) g_free((char *) dest->target); g_free(dest); mg->mg_ptr = NULL; + sv_setiv(sv, 0); return 0; }