[Guile-commits] GNU Guile branch, wip-ffi, updated. release_1-9-7-28-g3435f3c

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=3435f3c07c27c62fcd0a6112243a27ea4ae7b462

The branch, wip-ffi has been updated
       via  3435f3c07c27c62fcd0a6112243a27ea4ae7b462 (commit)
      from  663212bbc66b616cca9ba55d9992e2fb339d8250 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 3435f3c07c27c62fcd0a6112243a27ea4ae7b462
Author: Andy Wingo <address@hidden>
Date:   Wed Jan 27 22:12:58 2010 +0100

    add simple foreign finalization, and pointer support
    
    * libguile/foreign.h:
    * libguile/foreign.c (scm_foreign_set_finalizer_x): New function, for a
      limited form of finalization (like `free').
      (scm_alignof, scm_sizeof, parse_ffi_type, fill_ffi_type): For the
      purposes of make-foreign-function, treat '* (the asterisk symbol) as a
      pointer.
    
    * module/system/foreign.scm: Export foreign-set-finalizer!.

-----------------------------------------------------------------------

Summary of changes:
 libguile/foreign.c        |   50 +++++++++++++++++++++++++++++++++++++++++++++
 libguile/foreign.h        |    1 +
 module/system/foreign.scm |    1 +
 3 files changed, 52 insertions(+), 0 deletions(-)

diff --git a/libguile/foreign.c b/libguile/foreign.c
index 9931377..b754fad 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -43,6 +43,10 @@ SCM_SYMBOL (sym_int32, "int32");
 SCM_SYMBOL (sym_uint64, "uint64");
 SCM_SYMBOL (sym_int64, "int64");
 
+/* that's for pointers, you know. */
+SCM_SYMBOL (sym_asterisk, "*");
+
+
 static SCM cif_to_procedure (SCM cif, SCM func_ptr);
 
 
@@ -324,6 +328,37 @@ SCM_DEFINE (scm_bytevector_to_foreign, 
"bytevector->foreign", 1, 2, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_foreign_set_finalizer_x, "foreign-set-finalizer!", 2, 0, 0,
+            (SCM foreign, SCM finalizer),
+            "Arrange for the C procedure wrapped by @var{finalizer} to be\n"
+            "called on the pointer wrapped by @var{foreign} when 
@var{foreign}\n"
+            "becomes unreachable. Note: the C procedure should not call into\n"
+            "Scheme. If you need a Scheme finalizer, use guardians.")
+#define FUNC_NAME s_scm_foreign_set_finalizer_x
+{
+  void *c_finalizer;
+  GC_finalization_proc prev_finalizer;
+  GC_PTR prev_finalizer_data;
+
+  SCM_VALIDATE_FOREIGN_TYPED (1, foreign, VOID);
+  SCM_VALIDATE_FOREIGN_TYPED (2, finalizer, VOID);
+  
+  c_finalizer = SCM_FOREIGN_POINTER (finalizer, void);
+
+  SCM_SET_CELL_WORD_0 (foreign, SCM_CELL_WORD_0 (foreign) | (1<<16));
+
+  GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (foreign),
+                                  foreign_finalizer_trampoline,
+                                  c_finalizer,
+                                  &prev_finalizer,
+                                  &prev_finalizer_data);
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
+
+
 void
 scm_i_foreign_print (SCM foreign, SCM port, scm_print_state *pstate)
 {
@@ -406,6 +441,9 @@ SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type), "")
           scm_wrong_type_arg (FUNC_NAME, 1, type);
         }
     }
+  else if (scm_is_eq (type, sym_asterisk))
+    /* a pointer */
+    return scm_from_size_t (alignof (void*));
   else if (scm_is_pair (type))
     /* a struct, yo */
     return scm_alignof (scm_car (type));
@@ -445,6 +483,9 @@ SCM_DEFINE (scm_sizeof, "sizeof", 1, 0, 0, (SCM type), "")
           scm_wrong_type_arg (FUNC_NAME, 1, type);
         }
     }
+  else if (scm_is_eq (type, sym_asterisk))
+    /* a pointer */
+    return scm_from_size_t (sizeof (void*));
   else if (scm_is_pair (type))
     {
       /* a struct */
@@ -477,6 +518,9 @@ parse_ffi_type (SCM type, int return_p, long *n_structs, 
long *n_struct_elts)
       else
         return 1;
     }
+  else if (scm_is_eq (type, sym_asterisk))
+    /* a pointer */
+    return 1;
   else
     {
       long len;
@@ -542,6 +586,12 @@ fill_ffi_type (SCM type, ffi_type *ftype, ffi_type 
***type_ptrs,
                                   "foreign type");
         }
     }
+  else if (scm_is_eq (type, sym_asterisk))
+    /* a pointer */
+    {
+      *ftype = ffi_type_pointer;
+      return;
+    }
   else
     {
       long i, len;
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 9fbc067..b29025d 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -96,6 +96,7 @@ SCM_API SCM scm_foreign_ref (SCM foreign);
 SCM_API SCM scm_foreign_set_x (SCM foreign, SCM val);
 SCM_API SCM scm_foreign_to_bytevector (SCM foreign, SCM type,
                                        SCM offset, SCM len);
+SCM_API SCM scm_foreign_set_finalizer_x (SCM foreign, SCM finalizer);
 SCM_API SCM scm_bytevector_to_foreign (SCM bv, SCM offset, SCM len);
 
 SCM_INTERNAL void scm_i_foreign_print (SCM foreign, SCM port,
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 0a3f7cb..2a74332 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -29,6 +29,7 @@
 
             foreign-ref foreign-set!
             foreign->bytevector bytevector->foreign
+            foreign-set-finalizer!
             make-foreign-function
             make-c-struct parse-c-struct))
 


hooks/post-receive
-- 
GNU Guile