1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00

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.
This commit is contained in:
Ludovic Courtès 2010-07-26 19:36:03 +02:00
parent d4149a510e
commit 17fc9efecb
4 changed files with 25 additions and 0 deletions

View file

@ -162,6 +162,19 @@ SCM_DEFINE (scm_foreign_address, "foreign-address", 1, 0, 0,
} }
#undef FUNC_NAME #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_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 2, 2, 0,
(SCM foreign, SCM len, SCM offset, SCM uvec_type), (SCM foreign, SCM len, SCM offset, SCM uvec_type),
"Return a bytevector aliasing the memory pointed to by\n" "Return a bytevector aliasing the memory pointed to by\n"

View file

@ -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_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_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_INTERNAL void scm_i_foreign_print (SCM foreign, SCM port,
scm_print_state *pstate); scm_print_state *pstate);

View file

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

View file

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