Merge remote-tracking branch 'origin/stable-2.0'

[bpt/guile.git] / libguile / foreign.c

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 6c05d78..a734f2d 100644 (file)
--- 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);
 }
 
 \f
@@ -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);
 }
 
 /*