mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-11 22:31:12 +02:00
Add string->pointer' and
pointer->string' to the FFI.
* libguile/foreign.c (scm_string_to_pointer, scm_pointer_to_string): New functions. * libguile/foreign.h (scm_string_to_pointer, scm_pointer_to_string): New declarations. * module/system/foreign.scm: Export `string->pointer' and `pointer->string'. * test-suite/tests/foreign.test ("pointer<->string"): New test prefix. * doc/ref/api-foreign.texi (Void Pointers and Byte Access): Add `string->pointer' and `pointer->string'.
This commit is contained in:
parent
61d1d4a83a
commit
fa2a89a6d1
5 changed files with 85 additions and 16 deletions
|
@ -598,6 +598,22 @@ Assuming @var{pointer} points to a memory region that holds a pointer,
|
||||||
return this pointer.
|
return this pointer.
|
||||||
@end deffn
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} string->pointer string
|
||||||
|
Return a foreign pointer to a nul-terminated copy of @var{string} in the
|
||||||
|
current locale encoding. The C string is freed when the returned
|
||||||
|
foreign pointer becomes unreachable.
|
||||||
|
|
||||||
|
This is the Scheme equivalent of @code{scm_to_locale_string}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
|
@deffn {Scheme Procedure} pointer->string pointer
|
||||||
|
Return the string representing the C nul-terminated string
|
||||||
|
pointed to by @var{pointer}. The C string is assumed to be
|
||||||
|
in the current locale encoding.
|
||||||
|
|
||||||
|
This is the Scheme equivalent of @code{scm_from_locale_string}.
|
||||||
|
@end deffn
|
||||||
|
|
||||||
Going back to the @code{scm_numptob} example above, here is how we can
|
Going back to the @code{scm_numptob} example above, here is how we can
|
||||||
read its value as a C @code{long} integer:
|
read its value as a C @code{long} integer:
|
||||||
|
|
||||||
|
|
|
@ -162,18 +162,6 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
|
|
||||||
(SCM pointer),
|
|
||||||
"Assuming @var{pointer} points to a memory region that\n"
|
|
||||||
"holds a pointer, return this pointer.")
|
|
||||||
#define FUNC_NAME s_scm_dereference_pointer
|
|
||||||
{
|
|
||||||
SCM_VALIDATE_POINTER (1, pointer);
|
|
||||||
|
|
||||||
return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), NULL);
|
|
||||||
}
|
|
||||||
#undef FUNC_NAME
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
|
SCM_DEFINE (scm_pointer_to_bytevector, "pointer->bytevector", 2, 2, 0,
|
||||||
(SCM pointer, SCM len, SCM offset, SCM uvec_type),
|
(SCM pointer, SCM len, SCM offset, SCM uvec_type),
|
||||||
"Return a bytevector aliasing the @var{len} bytes pointed\n"
|
"Return a bytevector aliasing the @var{len} bytes pointed\n"
|
||||||
|
@ -299,8 +287,6 @@ SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
|
scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
|
||||||
{
|
{
|
||||||
|
@ -309,6 +295,55 @@ scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
|
||||||
scm_putc ('>', port);
|
scm_putc ('>', port);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
/* Non-primitive helpers functions. These procedures could be
|
||||||
|
implemented in terms of the primitives above but would be inefficient
|
||||||
|
(heap allocation overhead, Scheme/C round trips, etc.) */
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
|
||||||
|
(SCM pointer),
|
||||||
|
"Assuming @var{pointer} points to a memory region that\n"
|
||||||
|
"holds a pointer, return this pointer.")
|
||||||
|
#define FUNC_NAME s_scm_dereference_pointer
|
||||||
|
{
|
||||||
|
SCM_VALIDATE_POINTER (1, pointer);
|
||||||
|
|
||||||
|
return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), NULL);
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_string_to_pointer, "string->pointer", 1, 0, 0,
|
||||||
|
(SCM string),
|
||||||
|
"Return a foreign pointer to a nul-terminated copy of\n"
|
||||||
|
"@var{string} in the current locale encoding. The C\n"
|
||||||
|
"string is freed when the returned foreign pointer\n"
|
||||||
|
"becomes unreachable.\n\n"
|
||||||
|
"This is the Scheme equivalent of @code{scm_to_locale_string}.")
|
||||||
|
#define FUNC_NAME s_scm_string_to_pointer
|
||||||
|
{
|
||||||
|
SCM_VALIDATE_STRING (1, string);
|
||||||
|
|
||||||
|
/* XXX: Finalizers slow down libgc; they could be avoided if
|
||||||
|
`scm_to_string' & co. were able to use libgc-allocated memory. */
|
||||||
|
|
||||||
|
return scm_from_pointer (scm_to_locale_string (string), free);
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
SCM_DEFINE (scm_pointer_to_string, "pointer->string", 1, 0, 0,
|
||||||
|
(SCM pointer),
|
||||||
|
"Return the string representing the C nul-terminated string\n"
|
||||||
|
"pointed to by @var{pointer}. The C string is assumed to be\n"
|
||||||
|
"in the current locale encoding.\n\n"
|
||||||
|
"This is the Scheme equivalent of @code{scm_from_locale_string}.")
|
||||||
|
#define FUNC_NAME s_scm_pointer_to_string
|
||||||
|
{
|
||||||
|
SCM_VALIDATE_POINTER (1, pointer);
|
||||||
|
|
||||||
|
return scm_from_locale_string (SCM_POINTER_VALUE (pointer));
|
||||||
|
}
|
||||||
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
|
SCM_DEFINE (scm_alignof, "alignof", 1, 0, 0, (SCM type),
|
||||||
|
|
|
@ -69,10 +69,13 @@ SCM_API SCM scm_set_pointer_finalizer_x (SCM pointer, SCM finalizer);
|
||||||
SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset);
|
SCM_API SCM scm_bytevector_to_pointer (SCM bv, SCM offset);
|
||||||
|
|
||||||
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_pointer_print (SCM pointer, SCM port,
|
SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
|
||||||
scm_print_state *pstate);
|
scm_print_state *pstate);
|
||||||
|
|
||||||
|
SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
|
||||||
|
SCM_INTERNAL SCM scm_string_to_pointer (SCM string);
|
||||||
|
SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer);
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
/* Foreign functions */
|
/* Foreign functions */
|
||||||
|
|
|
@ -33,12 +33,15 @@
|
||||||
null-pointer?
|
null-pointer?
|
||||||
make-pointer
|
make-pointer
|
||||||
pointer-address
|
pointer-address
|
||||||
dereference-pointer
|
|
||||||
|
|
||||||
pointer->bytevector
|
pointer->bytevector
|
||||||
bytevector->pointer
|
bytevector->pointer
|
||||||
set-pointer-finalizer!
|
set-pointer-finalizer!
|
||||||
|
|
||||||
|
dereference-pointer
|
||||||
|
string->pointer
|
||||||
|
pointer->string
|
||||||
|
|
||||||
make-foreign-function
|
make-foreign-function
|
||||||
make-c-struct parse-c-struct))
|
make-c-struct parse-c-struct))
|
||||||
|
|
||||||
|
|
|
@ -78,6 +78,18 @@
|
||||||
0
|
0
|
||||||
bytes)))))
|
bytes)))))
|
||||||
|
|
||||||
|
|
||||||
|
(with-test-prefix "pointer<->string"
|
||||||
|
|
||||||
|
(pass-if "bijection"
|
||||||
|
(let ((s "hello, world"))
|
||||||
|
(string=? s (pointer->string (string->pointer s)))))
|
||||||
|
|
||||||
|
(pass-if "bijection [latin1]"
|
||||||
|
(with-latin1-locale
|
||||||
|
(let ((s "Szép jó napot!"))
|
||||||
|
(string=? s (pointer->string (string->pointer s)))))))
|
||||||
|
|
||||||
|
|
||||||
(with-test-prefix "structs"
|
(with-test-prefix "structs"
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue