diff options
Diffstat (limited to 'libguile/foreign.c')
-rw-r--r-- | libguile/foreign.c | 26 |
1 files changed, 12 insertions, 14 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c index 355934962..072b4b62b 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, @@ -199,7 +196,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; @@ -271,8 +268,8 @@ SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0, blen = scm_to_size_t (len); ret = scm_c_take_typed_bytevector ((signed char *) ptr + boffset, - blen, btype); - register_weak_reference (ret, pointer); + blen, btype, pointer); + return ret; } #undef FUNC_NAME @@ -324,9 +321,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); } @@ -539,13 +536,14 @@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0, 0, (SCM type), { /* a struct */ size_t off = 0; + size_t align = scm_to_size_t (scm_alignof(type)); while (scm_is_pair (type)) { off = ROUND_UP (off, scm_to_size_t (scm_alignof (scm_car (type)))); off += scm_to_size_t (scm_sizeof (scm_car (type))); type = scm_cdr (type); } - return scm_from_size_t (off); + return scm_from_size_t (ROUND_UP(off, align)); } else scm_wrong_type_arg (FUNC_NAME, 1, type); @@ -1118,7 +1116,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)); @@ -1149,7 +1147,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) { @@ -1295,7 +1293,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); } /* |