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 41c3e7e..47077f7 100644 (file)
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -96,7 +96,7 @@ register_weak_reference (SCM from, SCM to)
 }
 
 static void
-pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
+pointer_finalizer_trampoline (void *ptr, void *data)
 {
   scm_t_pointer_finalizer finalizer = data;
   finalizer (SCM_POINTER_VALUE (SCM_PACK_POINTER (ptr)));
@@ -136,6 +136,15 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+void *
+scm_to_pointer (SCM pointer)
+#define FUNC_NAME "scm_to_pointer"
+{
+  SCM_VALIDATE_POINTER (1, pointer);
+  return SCM_POINTER_VALUE (pointer);
+}
+#undef FUNC_NAME
+
 SCM
 scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
 {
@@ -148,16 +157,8 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
       ret = scm_cell (scm_tc7_pointer, (scm_t_bits) ptr);
 
       if (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),
-                                         pointer_finalizer_trampoline,
-                                         finalizer,
-                                         &prev_finalizer,
-                                         &prev_finalizer_data);
-       }
+        scm_i_set_finalizer (SCM2PTR (ret), pointer_finalizer_trampoline,
+                             finalizer);
     }
 
   return ret;
@@ -307,20 +308,11 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0,
             "Scheme. If you need a Scheme finalizer, use guardians.")
 #define FUNC_NAME s_scm_set_pointer_finalizer_x
 {
-  void *c_finalizer;
-  GC_finalization_proc prev_finalizer;
-  GC_PTR prev_finalizer_data;
-
   SCM_VALIDATE_POINTER (1, pointer);
   SCM_VALIDATE_POINTER (2, finalizer);
 
-  c_finalizer = SCM_POINTER_VALUE (finalizer);
-
-  GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer),
-                                  pointer_finalizer_trampoline,
-                                  c_finalizer,
-                                  &prev_finalizer,
-                                  &prev_finalizer_data);
+  scm_i_add_finalizer (SCM2PTR (pointer), pointer_finalizer_trampoline,
+                       SCM_POINTER_VALUE (finalizer));
 
   return SCM_UNSPECIFIED;
 }
@@ -380,7 +372,7 @@ SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 1, 0,
 
       ret = scm_from_pointer
         (scm_to_stringn (string, NULL, enc,
-                         scm_i_get_conversion_strategy (SCM_BOOL_F)),
+                         scm_i_default_port_conversion_handler ()),
          free);
 
       scm_dynwind_end ();
@@ -425,7 +417,7 @@ SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 2, 0,
       scm_dynwind_free (enc);
 
       ret = scm_from_stringn (SCM_POINTER_VALUE (pointer), len, enc,
-                              scm_i_get_conversion_strategy (SCM_BOOL_F));
+                              scm_i_default_port_conversion_handler ());
 
       scm_dynwind_end ();
 
@@ -544,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);
@@ -1138,11 +1131,11 @@ invoke_closure (ffi_cif *cif, void *ret, void **args, void *data)
 
 SCM_DEFINE (scm_procedure_to_pointer, "procedure->pointer", 3, 0, 0,
            (SCM return_type, SCM proc, SCM arg_types),
-           "Return a pointer to a C function of type @var{return-type}\n"
-           "taking arguments of types @var{arg-types} (a list) and\n"
+           "Return a pointer to a C function of type @var{return_type}\n"
+           "taking arguments of types @var{arg_types} (a list) and\n"
            "behaving as a proxy to procedure @var{proc}.  Thus\n"
            "@var{proc}'s arity, supported argument types, and return\n"
-           "type should match @var{return-type} and @var{arg-types}.\n")
+           "type should match @var{return_type} and @var{arg_types}.\n")
 #define FUNC_NAME s_scm_procedure_to_pointer
 {
   SCM cif_pointer, pointer;