From 2a8e1b5251b9a1a530adfaa219e5761c4d9f0338 Mon Sep 17 00:00:00 2001 From: Timo Sirainen Date: Mon, 23 Dec 2002 06:16:30 +0000 Subject: Added /SET perl_memory_check_level which works with only GC enabled. 0 doesn't do any checks, 1 checks for memory to be valid (default) at the time, 2 runs GC and then checks if memory valid (slower, but detects errors much better). git-svn-id: http://svn.irssi.org/repos/irssi/trunk@3064 dbcabf3a-b0e7-0310-adc4-f8d773084564 --- src/perl/perl-common.c | 19 +++++++++++++++++-- 1 file changed, 17 insertions(+), 2 deletions(-) diff --git a/src/perl/perl-common.c b/src/perl/perl-common.c index f6c56552..adb27cea 100644 --- a/src/perl/perl-common.c +++ b/src/perl/perl-common.c @@ -58,6 +58,7 @@ 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) @@ -166,8 +167,12 @@ void *irssi_ref_object(SV *o) croak("variable is damaged"); p = GINT_TO_POINTER(SvIV(*sv)); #ifdef HAVE_GC - if (GC_base(p) == NULL) - croak("variable is already free'd"); + 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; } @@ -637,6 +642,11 @@ 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[] = { @@ -651,6 +661,9 @@ 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, @@ -662,6 +675,7 @@ 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) @@ -680,4 +694,5 @@ 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); } -- cgit v1.2.3