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

@@ -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

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

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 <gc.h>
 #else
 #  include <gc/gc.h>
 #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();
 

src/perl/perl-common.c

@@ -43,12 +43,6 @@
 #include "perl-core.h"
 #include "perl-common.h"
 
-#ifdef HAVE_GC_H
-#  include <gc.h>
-#elif defined (HAVE_GC_GC_H)
-#  include <gc/gc.h>
-#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);
 }

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