須藤です。
uim/iconv.cを見ていて気付いたのですが、SigSchemeはCのオブジェ
クト（ポインタ）をラップしたSchemeオブジェクトがGCでfreeされ
るときに、ついでにラップしたCのオブジェクトもfreeするフック
のようなものを指定できないように見えます。
そのため、(iconv-release iconv)というように明示的にCのオブジェ
クトをfreeしなければならなく、せっかくGCがあるのに少し寂しい
気がします。
ということで、CのオブジェクトをラップするSchemeオブジェクト
を作るときに、Cのオブジェクトをfreeする関数を登録できるよう
にするというのはどうでしょうか？
とりえあず、簡単に実験してみました。
（SigSchemeのことはよくわかっていないので、storage-fattyの方
だけです。）
まず、SigSchemeの方ですが、CのオブジェクトをラップするScheme
オブジェクトにScmFreeFuncを登録できるようにして、free_cell()
のときに登録されたScmFreeFunc呼び出します。
そして、uimの方で追加したSigScheme側の関数のバインディングを
作ってやると、このように書けるようになり、明示的に
(iconv-release iconv)
とfreeしなくてもGCのときに勝手に頑張ってくれるようになります。
Index: uim/iconv.c
===================================================================
--- uim/iconv.c (revision 5679)
+++ uim/iconv.c (working copy)
@@ -377,7 +377,7 @@
if (!ic)
return uim_scm_f();
- return MAKE_PTR(ic);
+ return MAKE_PTR_WITH_FREE_FUNC(ic, uim_iconv_release);
}
static uim_lisp
@@ -396,17 +396,9 @@
return outbuf_;
}
-static uim_lisp
-uim_ext_iconv_release(uim_lisp ic_)
-{
- uim_iconv_release(C_PTR(ic_));
- return uim_scm_t();
-}
-
void
uim_init_iconv_subrs(void)
{
uim_scm_init_proc2("iconv-open", uim_ext_iconv_open);
uim_scm_init_proc2("iconv-code-conv", uim_ext_iconv_code_conv);
- uim_scm_init_proc1("iconv-release", uim_ext_iconv_release);
}
--~--~---------~--~----~------------~-------~--~----~
Google Groups "uim-ja" group
uim-ja@googlegroups.com
http://groups.google.com/group/uim-ja/about
-~----------~----~----~----~------~----~------~--~---
Index: sigscheme/src/storage-fatty.h
===================================================================
--- sigscheme/src/storage-fatty.h (revision 5678)
+++ sigscheme/src/storage-fatty.h (working copy)
@@ -155,6 +155,7 @@
struct {
void *value;
+ ScmFreeFunc free_func;
} c_pointer;
struct {
@@ -431,11 +432,18 @@
#define SCM_SAL_C_POINTERP(o) (SCM_TYPE(o) == ScmCPointer)
#define SCM_SAL_C_POINTER_VALUE(o) \
(SCM_AS_C_POINTER(o)->obj.c_pointer.value)
+#define SCM_SAL_C_POINTER_FREE_FUNC(o) \
+ (SCM_AS_C_POINTER(o)->obj.c_pointer.free_func)
#define SCM_SAL_C_POINTER_SET_VALUE(o, ptr) \
(SCM_C_POINTER_VALUE(o) = (ptr))
-#define SCM_ISAL_C_POINTER_INIT(o, ptr) \
- (SCM_ENTYPE((o), ScmCPointer), \
- SCM_C_POINTER_SET_VALUE((o), (ptr)))
+#define SCM_SAL_C_POINTER_SET_FREE_FUNC(o, free_func) \
+ (SCM_SAL_C_POINTER_FREE_FUNC(o) = (free_func))
+#define SCM_ISAL_C_POINTER_INIT(o, ptr) \
+ SCM_ISAL_C_POINTER_INIT_WITH_FREE_FUNC(o, ptr, NULL)
+#define SCM_ISAL_C_POINTER_INIT_WITH_FREE_FUNC(o, ptr, free_func) \
+ (SCM_ENTYPE((o), ScmCPointer), \
+ SCM_C_POINTER_SET_VALUE((o), (ptr)), \
+ SCM_SAL_C_POINTER_SET_FREE_FUNC((o), (free_func)))
#define SCM_SAL_C_FUNCPOINTERP(o) (SCM_TYPE(o) == ScmCFuncPointer)
#define SCM_SAL_C_FUNCPOINTER_VALUE(o) \
(SCM_AS_C_FUNCPOINTER(o)->obj.c_func_pointer.value)
Index: sigscheme/src/storage.c
===================================================================
--- sigscheme/src/storage.c (revision 5678)
+++ sigscheme/src/storage.c (working copy)
@@ -161,6 +161,11 @@
SCM_TYPESAFE_MACRO_VOID(SCM_ISAL_C_POINTER_INIT, \
(ScmObj, void *), \
((obj), (ptr)))
+/* SCM_C_POINTER_INIT_WITH_FREE_FUNC(obj, void *ptr, ScmFreeFunc free_func) */
+#define SCM_C_POINTER_INIT_WITH_FREE_FUNC(obj, ptr, free_func) \
+ SCM_TYPESAFE_MACRO_VOID(SCM_ISAL_C_POINTER_INIT_WITH_FREE_FUNC, \
+ (ScmObj, void *, ScmFreeFunc free_func), \
+ ((obj), (ptr), (free_func)))
/* SCM_C_FUNCPOINTER_INIT(obj, ScmCFunc ptr) */
#define SCM_C_FUNCPOINTER_INIT(obj, ptr) \
SCM_TYPESAFE_MACRO_VOID(SCM_ISAL_C_FUNCPOINTER_INIT, \
@@ -537,10 +542,16 @@
SCM_EXPORT ScmObj
scm_make_cpointer(void *ptr)
{
+ return scm_make_cpointer_with_free_func(ptr, NULL);
+}
+
+SCM_EXPORT ScmObj
+scm_make_cpointer_with_free_func(void *ptr, ScmFreeFunc free_func)
+{
ScmObj obj;
obj = scm_alloc_cell();
- SCM_C_POINTER_INIT(obj, ptr);
+ SCM_C_POINTER_INIT_WITH_FREE_FUNC(obj, ptr, free_func);
return obj;
}
Index: sigscheme/src/storage-gc.c
===================================================================
--- sigscheme/src/storage-gc.c (revision 5678)
+++ sigscheme/src/storage-gc.c (working copy)
@@ -870,9 +870,21 @@
case ScmFarsymbol:
case ScmSubpat:
case ScmCFuncPointer:
- case ScmCPointer:
case ScmValuePacket:
break;
+ case ScmCPointer:
+#if SCM_USE_SSCM_EXTENSIONS
+ {
+ void *value;
+ ScmFreeFunc free_func;
+
+ value = SCM_SAL_C_POINTER_VALUE(cell);
+ free_func = SCM_SAL_C_POINTER_FREE_FUNC(cell);
+ if (value && free_func)
+ free_func(value);
+ }
+#endif
+ break;
#if SCM_DEBUG
case ScmRational:
case ScmReal:
Index: sigscheme/src/storage-common.h
===================================================================
--- sigscheme/src/storage-common.h (revision 5678)
+++ sigscheme/src/storage-common.h (working copy)
@@ -133,6 +133,7 @@
#if SCM_USE_SSCM_EXTENSIONS
#define SCM_SAL_MAKE_C_POINTER scm_make_cpointer
+#define SCM_SAL_MAKE_C_POINTER_WITH_FREE_FUNC scm_make_cpointer_with_free_func
#define SCM_SAL_MAKE_C_FUNCPOINTER scm_make_cfunc_pointer
#endif
@@ -188,6 +189,7 @@
#endif
#if SCM_USE_SSCM_EXTENSIONS
SCM_EXPORT ScmObj scm_make_cpointer(void *ptr);
+SCM_EXPORT ScmObj scm_make_cpointer_with_free_func(void *ptr, ScmFreeFunc
free_func);
SCM_EXPORT ScmObj scm_make_cfunc_pointer(ScmCFunc ptr);
#endif
#if SCM_USE_HYGIENIC_MACRO
Index: sigscheme/src/sigscheme.h
===================================================================
--- sigscheme/src/sigscheme.h (revision 5678)
+++ sigscheme/src/sigscheme.h (working copy)
@@ -448,8 +448,8 @@
typedef void (*ScmCFunc)(void);
typedef void *(*ScmGCGateFunc)(void *);
+typedef void (*ScmFreeFunc)(void *);
-
#if SCM_USE_HYGIENIC_MACRO
/* Environment for looking up a free variable inserted by a hygienic
* macro's template. References in syntax-rules are only looked up in
@@ -729,6 +729,12 @@
(void *), \
(ptr))
+#define SCM_MAKE_C_POINTER_WITH_FREE_FUNC(ptr, free_func) \
+ SCM_TYPESAFE_MACRO(SCM_SAL_MAKE_C_POINTER_WITH_FREE_FUNC, \
+ ScmObj, \
+ (void *, ScmFreeFunc), \
+ (ptr, free_func))
+
#define SCM_MAKE_C_FUNCPOINTER(ptr) \
SCM_TYPESAFE_MACRO(SCM_SAL_MAKE_C_FUNCPOINTER, \
ScmObj, \
Index: test/test-iconv.scm
===================================================================
--- test/test-iconv.scm (revision 5681)
+++ test/test-iconv.scm (working copy)
@@ -36,20 +36,16 @@
(select-module test.iconv)
(define (setup)
- (uim-test-setup)
- (uim-eval '(define iconv #f)))
+ (uim-test-setup))
(define (teardown)
- (uim-eval '(if iconv
- (iconv-release iconv)))
(uim-test-teardown))
(define (test-conv)
(assert-equal "あいうえお"
(uim-read-from-string
(ces-convert
- (uim-eval '(begin
- (set! iconv (iconv-open "eucJP" "utf-8"))
+ (uim-eval '(let ((iconv (iconv-open "eucJP" "utf-8")))
(iconv-code-conv iconv "あいうえお")))
"eucJP" "utf-8")))
#f)
Index: uim/iconv.c
===================================================================
--- uim/iconv.c (revision 5679)
+++ uim/iconv.c (working copy)
@@ -377,7 +377,7 @@
if (!ic)
return uim_scm_f();
- return MAKE_PTR(ic);
+ return MAKE_PTR_WITH_FREE_FUNC(ic, uim_iconv_release);
}
static uim_lisp
@@ -396,17 +396,9 @@
return outbuf_;
}
-static uim_lisp
-uim_ext_iconv_release(uim_lisp ic_)
-{
- uim_iconv_release(C_PTR(ic_));
- return uim_scm_t();
-}
-
void
uim_init_iconv_subrs(void)
{
uim_scm_init_proc2("iconv-open", uim_ext_iconv_open);
uim_scm_init_proc2("iconv-code-conv", uim_ext_iconv_code_conv);
- uim_scm_init_proc1("iconv-release", uim_ext_iconv_release);
}
Index: uim/uim-scm-sigscheme.c
===================================================================
--- uim/uim-scm-sigscheme.c (revision 5678)
+++ uim/uim-scm-sigscheme.c (working copy)
@@ -93,6 +93,11 @@
static void *uim_scm_make_str_directly_internal(char *str);
static void *uim_scm_make_symbol_internal(const char *name);
static void *uim_scm_make_ptr_internal(void *ptr);
+struct make_ptr_with_free_func_args {
+ void *ptr;
+ uim_free_func_ptr free_func;
+};
+static void *uim_scm_make_ptr_with_free_func_internal(struct
make_ptr_with_free_func_args *args);
static void *uim_scm_make_func_ptr_internal(uim_func_ptr func_ptr);
static void *uim_scm_symbol_value_internal(const char *symbol_str);
static void *uim_scm_symbol_value_int_internal(const char *symbol_str);
@@ -406,6 +411,25 @@
return (void *)SCM_MAKE_C_POINTER(ptr);
}
+uim_lisp
+uim_scm_make_ptr_with_free_func(void *ptr, uim_free_func_ptr free_func)
+{
+ struct make_ptr_with_free_func_args args;
+
+ assert(uim_scm_gc_any_contextp());
+
+ args.ptr = ptr;
+ args.free_func = free_func;
+ return
(uim_lisp)uim_scm_call_with_gc_ready_stack((uim_gc_gate_func_ptr)uim_scm_make_ptr_with_free_func_internal,
+ &args);
+}
+
+static void *
+uim_scm_make_ptr_with_free_func_internal(struct make_ptr_with_free_func_args
*args)
+{
+ return (void *)SCM_MAKE_C_POINTER_WITH_FREE_FUNC(args->ptr, args->free_func);
+}
+
uim_func_ptr
uim_scm_c_func_ptr(uim_lisp func_ptr)
{
Index: uim/uim-scm-abbrev.h
===================================================================
--- uim/uim-scm-abbrev.h (revision 5678)
+++ uim/uim-scm-abbrev.h (working copy)
@@ -62,6 +62,7 @@
#define MAKE_STR_DIRECTLY uim_scm_make_str_directly
#define MAKE_SYM uim_scm_make_symbol
#define MAKE_PTR uim_scm_make_ptr
+#define MAKE_PTR_WITH_FREE_FUNC uim_scm_make_ptr_with_free_func
#define MAKE_FPTR uim_scm_make_func_ptr
#define INTP uim_scm_intp
Index: uim/uim-scm.h
===================================================================
--- uim/uim-scm.h (revision 5678)
+++ uim/uim-scm.h (working copy)
@@ -89,6 +89,7 @@
typedef struct uim_opaque * uim_lisp;
typedef void (*uim_func_ptr)(void);
typedef void *(*uim_gc_gate_func_ptr)(void *);
+typedef void (*uim_free_func_ptr)(void *object);
/* subsystem interfaces */
@@ -161,6 +162,7 @@
void *uim_scm_c_ptr(uim_lisp ptr);
void uim_scm_nullify_c_ptr(uim_lisp ptr);
uim_lisp uim_scm_make_ptr(void *ptr);
+uim_lisp uim_scm_make_ptr_with_free_func(void *ptr, uim_free_func_ptr
free_func);
uim_func_ptr uim_scm_c_func_ptr(uim_lisp func_ptr);
uim_lisp uim_scm_make_func_ptr(uim_func_ptr func_ptr);
