diff options
Diffstat (limited to 'libguile/foreign.c')
-rw-r--r-- | libguile/foreign.c | 27 |
1 files changed, 12 insertions, 15 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 6c05d7800..a734f2d1e 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -87,22 +87,19 @@ static SCM cif_to_procedure (SCM cif, SCM func_ptr); static SCM pointer_weak_refs = SCM_BOOL_F; -static scm_i_pthread_mutex_t weak_refs_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER; static void register_weak_reference (SCM from, SCM to) { - scm_i_pthread_mutex_lock (&weak_refs_lock); - scm_hashq_set_x (pointer_weak_refs, from, to); - scm_i_pthread_mutex_unlock (&weak_refs_lock); + scm_weak_table_putq_x (pointer_weak_refs, from, to); } static void pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data) { scm_t_pointer_finalizer finalizer = data; - finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr))); + finalizer (SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr))); } SCM_DEFINE (scm_pointer_p, "pointer?", 1, 0, 0, @@ -155,7 +152,7 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer) /* Register a finalizer for the newly created instance. */ GC_finalization_proc prev_finalizer; GC_PTR prev_finalizer_data; - GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret), + GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (ret), pointer_finalizer_trampoline, finalizer, &prev_finalizer, @@ -198,7 +195,7 @@ SCM_DEFINE (scm_scm_to_pointer, "scm->pointer", 1, 0, 0, SCM ret; ret = scm_from_pointer ((void*) SCM_UNPACK (scm), NULL); - if (SCM_NIMP (ret)) + if (SCM_HEAP_OBJECT_P (ret)) register_weak_reference (ret, scm); return ret; @@ -269,8 +266,8 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0, blen = scm_to_size_t (len); - ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype); - register_weak_reference (ret, pointer); + ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype, pointer); + return ret; } #undef FUNC_NAME @@ -320,7 +317,7 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0, SCM_SET_CELL_WORD_0 (pointer, SCM_CELL_WORD_0 (pointer) | (1 << 16UL)); - GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer), + GC_REGISTER_FINALIZER_NO_ORDER (SCM_HEAP_OBJECT_BASE (pointer), pointer_finalizer_trampoline, c_finalizer, &prev_finalizer, @@ -333,9 +330,9 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0, void scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate) { - scm_puts ("#<pointer 0x", port); + scm_puts_unlocked ("#<pointer 0x", port); scm_uintprint (scm_to_uintptr (scm_pointer_address (pointer)), 16, port); - scm_putc ('>', port); + scm_putc_unlocked ('>', port); } @@ -1127,7 +1124,7 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, void *data) size_t i; SCM proc, *argv, result; - proc = PTR2SCM (data); + proc = SCM_PACK_POINTER (data); argv = alloca (cif->nargs * sizeof (*argv)); @@ -1158,7 +1155,7 @@ SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0, closure = ffi_closure_alloc (sizeof (ffi_closure), &executable); err = ffi_prep_closure_loc ((ffi_closure *) closure, cif, - invoke_closure, SCM2PTR (proc), + invoke_closure, SCM_UNPACK_POINTER (proc), executable); if (err != FFI_OK) { @@ -1304,7 +1301,7 @@ scm_register_foreign (void) "scm_init_foreign", (scm_t_extension_init_func)scm_init_foreign, NULL); - pointer_weak_refs = scm_make_weak_key_hash_table (SCM_UNDEFINED); + pointer_weak_refs = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); } /* |