summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--acconfig.h1
-rw-r--r--configure.in2
-rw-r--r--src/fe-text/irssi.c8
-rw-r--r--src/perl/perl-common.c56
-rw-r--r--src/perl/ui/Formats.xs1
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 <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();
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 <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);
}
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;
}
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-21 14:13:41 +0000