summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-07-26 19:36:03 +0200
committerLudovic Courtès <ludo@gnu.org>2010-07-26 19:38:52 +0200
commit17fc9efecbc9cb0c7e32664dbd0e2c863194cd7f (patch)
treee03ebbd3ab93aa697aec9abc72444f20edae0a1b
parentd4149a510e4a87915b625255f4de3301510d810c (diff)
downloadguile-17fc9efecbc9cb0c7e32664dbd0e2c863194cd7f.tar.gz
Add `dereference-pointer' to `(system foreign)'.
* libguile/foreign.c (scm_dereference_pointer): New function. * libguile/foreign.h (scm_dereference_pointer): New declaration. * module/system/foreign.scm (dereference-pointer): Likewise. * test-suite/tests/foreign.test ("foreign<->bytevector")["dereference-pointer"]: New test.
-rw-r--r--libguile/foreign.c13
-rw-r--r--libguile/foreign.h1
-rw-r--r--module/system/foreign.scm1
-rw-r--r--test-suite/tests/foreign.test10
4 files changed, 25 insertions, 0 deletions
diff --git a/libguile/foreign.c b/libguile/foreign.c
index dc9367614..dd77a823c 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -162,6 +162,19 @@ SCM_DEFINE (scm_foreign_address, "foreign-address", 1, 0, 0,
}
#undef FUNC_NAME
+SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
+ (SCM foreign),
+ "Return the a foreign object representing the pointer "
+ "pointed to by @var{foreign}.")
+#define FUNC_NAME s_scm_dereference_pointer
+{
+ SCM_VALIDATE_FOREIGN (1, foreign);
+
+ return scm_take_foreign_pointer (* (void **) SCM_FOREIGN_POINTER (foreign),
+ NULL);
+}
+#undef FUNC_NAME
+
SCM_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 2, 2, 0,
(SCM foreign, SCM len, SCM offset, SCM uvec_type),
"Return a bytevector aliasing the memory pointed to by\n"
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 4712d761a..af7f1c90d 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -69,6 +69,7 @@ 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 SCM scm_make_pointer (SCM address, SCM finalizer);
+SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
SCM_INTERNAL void scm_i_foreign_print (SCM foreign, SCM port,
scm_print_state *pstate);
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 9966c640b..6aa2fe357 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -32,6 +32,7 @@
null-pointer?
make-pointer
foreign-address
+ dereference-pointer
foreign->bytevector bytevector->foreign
foreign-set-finalizer!
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 7ff14ccff..7da4deb31 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -66,4 +66,14 @@
(fold-right (lambda (byte address)
(+ byte (* 256 address)))
0
+ bytes))))
+
+ (pass-if "dereference-pointer"
+ (let* ((bytes (iota (sizeof '*)))
+ (bv (u8-list->bytevector bytes)))
+ (= (foreign-address
+ (dereference-pointer (bytevector->foreign bv)))
+ (fold-right (lambda (byte address)
+ (+ byte (* 256 address)))
+ 0
bytes)))))