[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, wip-ffi, updated. release_1-9-7-28-g34
From: |
Andy Wingo |
Subject: |
[Guile-commits] GNU Guile branch, wip-ffi, updated. release_1-9-7-28-g3435f3c |
Date: |
Wed, 27 Jan 2010 21:12:57 +0000 |
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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, wip-ffi, updated. release_1-9-7-28-g3435f3c,
Andy Wingo <=