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.

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"

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);
 

module/system/foreign.scm

@@ -32,6 +32,7 @@
             null-pointer?
             make-pointer
             foreign-address
+            dereference-pointer
 
             foreign->bytevector bytevector->foreign
             foreign-set-finalizer!

test-suite/tests/foreign.test

@@ -63,6 +63,16 @@
       (= (foreign-address
           (make-pointer (bytevector-uint-ref bv 0 (native-endianness)
                                              (sizeof '*))))
+         (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