mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

Add string->pointer' and pointer->string' to the FFI.

Browse source 
* 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:
Ludovic Courtès 2010-08-15 16:42:33 +02:00
parent 61d1d4a83a
commit fa2a89a6d1
5 changed files with 85 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

63
libguile/foreign.c
View file

@ -162,18 +162,6 @@ SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
}
#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 pointer, SCM len, SCM offset, SCM uvec_type),
"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
void
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);
}
/* 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),

5
libguile/foreign.h
View file

@ -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_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_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 */