[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-232-g7
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-232-g7387c23 |
|
Date: |
Wed, 28 Jul 2010 10:27:28 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=7387c231ee382a36a13a04c9f3b247b1667f0397
The branch, master has been updated
via 7387c231ee382a36a13a04c9f3b247b1667f0397 (commit)
via 183a2a224b555a29ab311ffcb6abd529a0bdffc1 (commit)
via 22697acbc9bae9db44f5f2abcf8d39617d338ad2 (commit)
via 854aa906b45b09c0f5bb8b179851e68f878b3aa0 (commit)
via 5b46a8c2c8f41581dd5576c8dcc06e8bde8cd849 (commit)
from 9defb64118774c8f1a1f6af05d6f1705e7a40619 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 7387c231ee382a36a13a04c9f3b247b1667f0397
Author: Ludovic Courtès <address@hidden>
Date: Wed Jul 28 12:02:50 2010 +0200
Fix `parse-c-struct'.
* module/system/foreign.scm (parse-c-struct): Update use of
`pointer->bytevector' to the new API.
* test-suite/tests/foreign.test ("structs"): New test prefix.
commit 183a2a224b555a29ab311ffcb6abd529a0bdffc1
Author: Ludovic Courtès <address@hidden>
Date: Wed Jul 28 12:01:54 2010 +0200
Update the FFI doc.
* doc/ref/api-foreign.texi (Foreign Types): Remove bits about typed
foreign pointers. Add `void'.
(Foreign Variables): Update the doc of `dynamic-pointer' and the
`numptob' example. Remove `foreign-set!' and `foreign-ref'. Add
`pointer-address', `make-pointer', `%null-pointer', and
`null-pointer?'
(Void Pointers and Byte Access): Make it clear that wrapped pointers
are untyped. Remove `void' from here. Replace `foreign->bytevector'
and `bytevector->foreign' by `pointer->bytevector' and
`bytevector->pointer'. Add `dereference-pointer' and the rest of the
`numptob' example.
(Dynamic FFI): Update examples. Remove `%null-pointer' from here.
* libguile/dynl.c (scm_dynamic_pointer): Update docstring.
* libguile/foreign.c (scm_dereference_pointer,
scm_pointer_to_bytevector): Likewise.
* module/system/foreign.scm (null-pointer?): Add docstring.
commit 22697acbc9bae9db44f5f2abcf8d39617d338ad2
Author: Ludovic Courtès <address@hidden>
Date: Tue Jul 27 18:46:23 2010 +0200
Remove unused parameter from `bytevector->pointer'.
* libguile/foreign.c (scm_bytevector_to_pointer): Remove unused LEN
parameter. Update docstring.
commit 854aa906b45b09c0f5bb8b179851e68f878b3aa0
Author: Ludovic Courtès <address@hidden>
Date: Tue Jul 27 18:44:45 2010 +0200
Always return `%null-pointer' when creating a NULL pointer with no
finalizer.
* libguile/foreign.c (scm_make_pointer): Always call out to
`scm_from_pointer'.
(scm_from_pointer): Return NULL_POINTER when PTR and FINALIZER are
NULL.
commit 5b46a8c2c8f41581dd5576c8dcc06e8bde8cd849
Author: Ludovic Courtès <address@hidden>
Date: Tue Jul 27 14:54:53 2010 +0200
Use "pointer" instead of "foreign" when dealing with wrapped pointers.
* libguile/foreign.h (scm_t_foreign_finalizer): Rename to...
(scm_t_pointer_finalizer): ... this.
(SCM_FOREIGN_P): Rename to...
(SCM_POINTER_P): this.
(SCM_VALIDATE_FOREIGN): Rename to...
(SCM_VALIDATE_POINTER): ... this.
(SCM_FOREIGN_HAS_FINALIZER): Rename to...
(SCM_POINTER_HAS_FINALIZER): ... this.
(scm_take_foreign_pointer): Rename to...
(scm_from_pointer): ... this.
(scm_foreign_address): Rename to...
(scm_pointer_address): ... this.
(scm_foreign_to_bytevector): Rename to...
(scm_pointer_to_bytevector): ... this.
(scm_foreign_set_finalizer_x): Rename to...
(scm_set_pointer_finalizer_x): ... this.
(scm_bytevector_to_foreign): Rename to...
(scm_bytevector_to_pointer): ... this.
(scm_i_foreign_print): Rename to...
(scm_i_pointer_print): ... this.
* libguile/foreign.c: Update accordingly.
* libguile/tags.h (scm_tc7_foreign): Rename to...
(scm_tc7_pointer): ... this.
* libguile/foreign.c, libguile/deprecated.c, libguile/dynl.c,
libguile/evalext.c, libguile/gc.c, libguile/goops.c, libguile/gsubr.c,
libguile/gsubr.h, libguile/print.c, libguile/snarf.h,
libguile/vm-i-system.c, module/system/foreign.scm,
test-suite/standalone/test-ffi, test-suite/tests/foreign.test: Update
accordingly.
-----------------------------------------------------------------------
Summary of changes:
doc/ref/api-foreign.texi | 191 +++++++++++++++++----------------------
libguile/deprecated.c | 4 +-
libguile/dynl.c | 16 ++--
libguile/evalext.c | 2 +-
libguile/foreign.c | 186 ++++++++++++++++++---------------------
libguile/foreign.h | 34 ++++----
libguile/gc.c | 2 +-
libguile/goops.c | 2 +-
libguile/gsubr.c | 5 +-
libguile/gsubr.h | 4 +-
libguile/print.c | 4 +-
libguile/snarf.h | 6 +-
libguile/tags.h | 2 +-
libguile/vm-i-system.c | 7 +-
module/system/foreign.scm | 20 +++--
test-suite/standalone/test-ffi | 10 +-
test-suite/tests/foreign.test | 28 ++++--
17 files changed, 250 insertions(+), 273 deletions(-)
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index 728c786..0fb06d7 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -443,7 +443,7 @@ next discusses C functions.
@menu
* Foreign Types:: Expressing C types in Scheme.
-* Foreign Variables:: Typed pointers.
+* Foreign Variables:: Pointers to C symbols.
* Void Pointers and Byte Access:: Pointers into the ether.
* Foreign Structs:: Packing and unpacking structs.
@end menu
@@ -455,9 +455,9 @@ The first impedance mismatch that one sees between C and
Scheme is that
in C, the storage locations (variables) are typed, but in Scheme types
are associated with values, not variables. @xref{Values and Variables}.
-So when accessing a C value through a Scheme pointer, we must give the
-type of the pointed-to value explicitly, as a parameter to any Scheme
-procedure that accesses the value.
+So when describing a C function or a C structure so that it can be
+accessed from Scheme, the data types of the parameters or fields must be
+passed explicitly.
These ``C type values'' may be constructed using the constants and
procedures from the @code{(system foreign)} module, which may be loaded
@@ -480,8 +480,8 @@ C types:
@defvrx {Scheme Variable} int64
@defvrx {Scheme Variable} float
@defvrx {Scheme Variable} double
-Values exported by the @code{(system foreign)} module, representing C
-numeric types of the specified sizes and signednesses.
+These values represent the C numeric types of the specified sizes and
+signednesses.
@end defvr
In addition there are some convenience bindings for indicating types of
@@ -497,17 +497,22 @@ numeric types. For example, @code{long} may be
@code{equal?} to
@code{int64} on a 64-bit platform.
@end defvr
address@hidden {Scheme Variable} void
+The @code{void} type. It can be used as the first argument to
address@hidden to wrap a C function that returns nothing.
address@hidden defvr
+
@node Foreign Variables
@subsubsection Foreign Variables
Given the types defined in the previous section, C pointers may be
looked up dynamically using @code{dynamic-pointer}.
address@hidden {Scheme Procedure} dynamic-pointer name type dobj [len]
address@hidden {C Function} scm_dynamic_pointer (name, type, dobj, len)
-Return a ``handle'' for the pointer @var{name} in the shared object referred to
-by @var{dobj}. The handle aliases a C value, and is declared to be of type
address@hidden Valid types are defined in the @code{(system foreign)} module.
address@hidden {Scheme Procedure} dynamic-pointer name dobj
address@hidden {C Function} scm_dynamic_pointer (name, dobj)
+Return a ``wrapped pointer'' for the symbol @var{name} in the shared
+object referred to by @var{dobj}. The returned pointer points to a C
+object.
This facility works by asking the dynamic linker for the address of a symbol,
then assuming that it aliases a value of a given type. Obviously, the user must
@@ -525,98 +530,56 @@ pointing to that foreign value, we do:
@example
(use-modules (system foreign))
-(define numptob (dynamic-pointer "scm_numptob" long (dynamic-link)))
+(define numptob (dynamic-pointer "scm_numptob" (dynamic-link)))
numptob
address@hidden #<foreign int32 8>
address@hidden #<pointer 139984413364296>
@end example
A value returned by @code{dynamic-pointer} is a Scheme wrapper for a C
-pointer, with additional type information. A foreign pointer prints
-according to its type. This example showed that a @code{long} on this
-platform is an @code{int32}, and that the value pointed to by
address@hidden is 8.
-
-Typed pointers may be referenced using the @code{foreign-ref} and
address@hidden functions.
-
address@hidden {Scheme Procedure} foreign-ref foreign
address@hidden {C Function} scm_foreign_ref foreign
-Reference the foreign value pointed to by @var{foreign}.
+pointer.
-The value will be referenced according to its type.
address@hidden {Scheme Procedure} pointer-address pointer
address@hidden {C Function} scm_pointer_address pointer
+Return the numerical value of @var{pointer}.
@example
-(foreign-ref numptob) @result{} 8 ; YMMV
+(pointer-address numptob)
address@hidden 139984413364296 ; YMMV
@end example
@end deffn
address@hidden {Scheme Procedure} foreign-set! foreign val
address@hidden {C Function} scm_foreign_set_x foreign val
-Set the foreign value pointed to by @var{foreign}.
address@hidden {Scheme Procedure} make-pointer address [finalizer]
+Return a foreign pointer object pointing to @var{address}. If
address@hidden is passed, it should be a pointer to a one-argument C
+function that will be called when the pointer object becomes
+unreachable.
address@hidden deffn
-The value will be set according to its type.
address@hidden {Scheme Variable} %null-pointer
+A foreign pointer whose value is 0.
address@hidden defvr
address@hidden
-(foreign-set! numptob 120) ; Don't try this at home!
address@hidden example
address@hidden {Scheme Procedure} null-pointer? pointer
+Return @code{#t} if @var{pointer} is the null pointer, @code{#f} otherwise.
@end deffn
-If we wanted to corrupt Guile's internal state, we could set
address@hidden to another value; but we shouldn't, because that
-variable is not meant to be set. Indeed this point applies more widely:
-the C API is a dangerous place to be. Not only might setting a value
-crash your program, simply referencing a value with a wrong-sized type
-can prove equally disastrous.
-
@node Void Pointers and Byte Access
@subsubsection Void Pointers and Byte Access
-As a special case, a dynamic pointer may be declared to point to type
address@hidden, in which case it is treated as a void pointer. A void
-pointer prints its value as a pointer, without dereferencing the
-pointer.
-
-It's important at this point to conceptually separate foreign values
-from foreign pointers. @code{dynamic-pointer} gives you a foreign
-pointer. A foreign value is the semantic meaning of the bytes pointed to
-by a pointer. Only foreign pointers may be wrapped in Scheme. One may
-make a pointer to a foreign value, and wrap that as a Scheme object, but
-a bare foreign value may not be wrapped.
-
-When you call @code{dynamic-pointer}, the @var{type} argument indicates
-the type to which the given symbol points, but sometimes you don't know
-that type. Sometimes you have a pointer, and you don't know what kind of
-object it references. It's simply a pointer out into the ether, into the
address@hidden
-
-Guile can wrap such a pointer, by declaring that it points to
address@hidden
+Wrapped pointers are untyped, so they are essentially equivalent to C
address@hidden pointers. As in C, the memory region pointed to by a
+pointer can be accessed at the byte level. This is achieved using
address@hidden (@pxref{Bytevectors}). The @code{(rnrs bytevector)}
+module contains procedures that can be used to convert byte sequences to
+Scheme objects such as strings, floating pointer numbers, or integers.
address@hidden {Scheme Variable} void
-A foreign type value representing nothing.
-
address@hidden has two uses: for a foreign pointer, declaring it to be of
-type @code{void} is like having a @code{void*} in C. For a function, a
-return type of @code{void} indicates that the function returns no
-values. A function argument type of @code{void} is invalid.
address@hidden defvr
-
-As an example, @code{(dynamic-pointer "foo" void bar-lib)} links in the
address@hidden symbol in the @var{bar-lib} library as a pointer to
address@hidden: a @code{void*}.
-
-Void pointers may be accessed as bytevectors.
+Pointers may be accessed as bytevectors.
address@hidden {Scheme Procedure} foreign->bytevector foreign [uvec_type
[offset [len]]]
address@hidden {C Function} scm_foreign_to_bytevector foreign uvec_type offset
len
-Return a bytevector aliasing the memory pointed to by
address@hidden
-
address@hidden must be a void pointer, a foreign whose type is
address@hidden By default, the resulting bytevector will alias
-all of the memory pointed to by @var{foreign}, from beginning
-to end, treated as a @code{vu8} array.
address@hidden {Scheme Procedure} pointer->bytevector pointer len [offset
[uvec_type]]
address@hidden {C Function} scm_foreign_to_bytevector pointer len offset
uvec_type
+Return a bytevector aliasing the @var{len} bytes pointed to by
address@hidden
The user may specify an alternate default interpretation for
the memory by passing the @var{uvec_type} argument, to indicate
@@ -625,28 +588,45 @@ that the memory is an array of elements of that type.
@code{uniform-vector-element-type} would return, like @code{f32}
or @code{s16}.
-Users may also specify that the bytevector should only alias a
-subset of the memory, by specifying @var{offset} and @var{len}
-arguments.
+When @var{offset} is passed, it specifies the offset in bytes relative
+to @var{pointer} of the memory region aliased by the returned
+bytevector.
Mutating the returned bytevector mutates the memory pointed to by
address@hidden, so buckle your seatbelts.
address@hidden, so buckle your seatbelts.
@end deffn
address@hidden {Scheme Procedure} bytevector->foreign bv [offset [len]]
address@hidden {C Function} scm_bytevector_to_foreign bv offset len
-Return a foreign pointer aliasing the memory pointed to by
address@hidden
address@hidden {Scheme Procedure} bytevector->pointer bv [offset]
address@hidden {C Function} scm_bytevector_to_pointer bv offset
+Return a pointer pointer aliasing the memory pointed to by @var{bv} or
address@hidden bytes after @var{bv} when @var{offset} is passed.
address@hidden deffn
-The resulting foreign will be a void pointer, a foreign whose
-type is @code{void}. By default it will alias all of the
-memory pointed to by @var{bv}, from beginning to end.
+In addition to these primitives, convenience procedures are available:
-Users may explicily specify that the foreign should only alias a
-subset of the memory, by specifying @var{offset} and @var{len}
-arguments.
address@hidden {Scheme Procedure} dereference-pointer pointer
+Assuming @var{pointer} points to a memory region that holds a pointer,
+return this pointer.
@end deffn
+Going back to the @code{scm_numptob} example above, here is how we can
+read its value as a C @code{long} integer:
+
address@hidden
+(use-modules (rnrs bytevectors))
+
+(bytevector-uint-ref (pointer->bytevector numptob (sizeof long))
+ 0 (native-endianness)
+ (sizeof long))
address@hidden 8
address@hidden example
+
+If we wanted to corrupt Guile's internal state, we could set
address@hidden to another value; but we shouldn't, because that
+variable is not meant to be set. Indeed this point applies more widely:
+the C API is a dangerous place to be. Not only might setting a value
+crash your program, simply accessing the data pointed to by a dangling
+pointer or similar can prove equally disastrous.
@node Foreign Structs
@subsubsection Foreign Structs
@@ -772,14 +752,16 @@ To invoke @code{memcpy}, one must pass it foreign
pointers:
@example
(use-modules (rnrs bytevectors))
+(define src-bits
+ (u8-list->bytevector '(0 1 2 3 4 5 6 7)))
(define src
- (bytevector->foreign (u8-list->bytevector '(0 1 2 3 4 5 6 7))))
+ (bytevector->pointer src-bits))
(define dest
- (bytevector->foreign (make-bytevector 16 0)))
+ (bytevector->pointer (make-bytevector 16 0)))
-(memcpy dest src (bytevector-length (foreign->bytevector src)))))
+(memcpy dest src (bytevector-length src-bits))
-(bytevector->u8-list (foreign->bytevector dest))
+(bytevector->u8-list (pointer->bytevector dest 16))
@result{} (0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0)
@end example
@@ -815,13 +797,6 @@ by the foreign pointer is mutated in place.
@result{} 499553
@end example
-This example also shows use of @code{%null-pointer}, which is a null
-foreign pointer, exported by @code{(system foreign)}.
-
address@hidden {Scheme Variable} %null-pointer
-A foreign pointer whose value is 0.
address@hidden defvr
-
As you can see, this interface to foreign functions is at a very low,
somewhat dangerous level. A contribution to Guile in the form of a
high-level FFI would be most welcome.
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index de5ac5b..8405e88 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1900,9 +1900,9 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call",
3, 0, 0,
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
+ SCM_VALIDATE_POINTER (SCM_ARG1, func);
- fptr = SCM_FOREIGN_POINTER (func);
+ fptr = SCM_POINTER_VALUE (func);
argv = scm_i_allocate_string_pointers (args);
for (argc = 0; argv[argc]; argc++)
diff --git a/libguile/dynl.c b/libguile/dynl.c
index 9ee4e2c..2b1d656 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -237,9 +237,9 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0,
(SCM name, SCM dobj),
- "Return a ``handle'' for the pointer @var{name} in the\n"
- "shared object referred to by @var{dobj}. The handle\n"
- "aliases a C object.\n\n"
+ "Return a ``wrapped pointer'' to the symbol @var{name}\n"
+ "in the shared object referred to by @var{dobj}. The returned\n"
+ "pointer points to a C object.\n\n"
"This facility works by asking the dynamic linker for\n"
"the address of a symbol, then assuming that it aliases a\n"
"value of a given type. Obviously, the user must be very\n"
@@ -268,7 +268,7 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0,
val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME);
scm_dynwind_end ();
- return scm_take_foreign_pointer (val, NULL);
+ return scm_from_pointer (val, NULL);
}
}
#undef FUNC_NAME
@@ -311,13 +311,13 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
"and its return value is ignored.")
#define FUNC_NAME s_scm_dynamic_call
{
- void (*fptr) ();
-
+ void (*fptr) (void);
+
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
+ SCM_VALIDATE_POINTER (SCM_ARG1, func);
- fptr = SCM_FOREIGN_POINTER (func);
+ fptr = SCM_POINTER_VALUE (func);
fptr ();
return SCM_UNSPECIFIED;
}
diff --git a/libguile/evalext.c b/libguile/evalext.c
index b397cbd..ff2ff0e 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -77,7 +77,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0,
0,
{
case scm_tc7_vector:
case scm_tc7_wvect:
- case scm_tc7_foreign:
+ case scm_tc7_pointer:
case scm_tc7_hashtable:
case scm_tc7_fluid:
case scm_tc7_dynamic_state:
diff --git a/libguile/foreign.c b/libguile/foreign.c
index dd77a82..5d5c7b4 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -1,5 +1,5 @@
/* Copyright (C) 2010 Free Software Foundation, Inc.
- *
+ *
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
* as published by the Free Software Foundation; either version 3 of
@@ -82,19 +82,19 @@ null_pointer_error (const char *func_name)
static SCM cif_to_procedure (SCM cif, SCM func_ptr);
-static SCM foreign_weak_refs = SCM_BOOL_F;
+static SCM pointer_weak_refs = SCM_BOOL_F;
static void
register_weak_reference (SCM from, SCM to)
{
- scm_hashq_set_x (foreign_weak_refs, from, to);
+ scm_hashq_set_x (pointer_weak_refs, from, to);
}
static void
-foreign_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
+pointer_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
{
- scm_t_foreign_finalizer finalizer = data;
- finalizer (SCM_FOREIGN_POINTER (PTR2SCM (ptr)));
+ scm_t_pointer_finalizer finalizer = data;
+ finalizer (SCM_POINTER_VALUE (PTR2SCM (ptr)));
}
SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
@@ -107,100 +107,95 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
{
void *c_finalizer;
scm_t_uintptr c_address;
- SCM result;
c_address = scm_to_uintptr (address);
if (SCM_UNBNDP (finalizer))
c_finalizer = NULL;
else
{
- SCM_VALIDATE_FOREIGN (2, finalizer);
- c_finalizer = SCM_FOREIGN_POINTER (finalizer);
+ SCM_VALIDATE_POINTER (2, finalizer);
+ c_finalizer = SCM_POINTER_VALUE (finalizer);
}
- if (c_address == 0 && c_finalizer == NULL)
- result = null_pointer;
- else
- result = scm_take_foreign_pointer ((void *) c_address, c_finalizer);
-
- return result;
+ return scm_from_pointer ((void *) c_address, c_finalizer);
}
#undef FUNC_NAME
SCM
-scm_take_foreign_pointer (void *ptr, scm_t_foreign_finalizer finalizer)
+scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
{
SCM ret;
- scm_t_bits word0;
- word0 = scm_tc7_foreign | (finalizer ? (1 << 16UL) : 0UL);
-
- ret = scm_cell (word0, (scm_t_bits) ptr);
- if (finalizer)
+ if (ptr == NULL && finalizer == NULL)
+ ret = null_pointer;
+ else
{
- /* Register a finalizer for the newly created instance. */
- GC_finalization_proc prev_finalizer;
- GC_PTR prev_finalizer_data;
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
- foreign_finalizer_trampoline,
- finalizer,
- &prev_finalizer,
- &prev_finalizer_data);
+ scm_t_bits type;
+
+ type = scm_tc7_pointer | (finalizer ? (1 << 16UL) : 0UL);
+ ret = scm_cell (type, (scm_t_bits) ptr);
+
+ if (finalizer)
+ {
+ /* Register a finalizer for the newly created instance. */
+ GC_finalization_proc prev_finalizer;
+ GC_PTR prev_finalizer_data;
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
+ pointer_finalizer_trampoline,
+ finalizer,
+ &prev_finalizer,
+ &prev_finalizer_data);
+ }
}
return ret;
}
-SCM_DEFINE (scm_foreign_address, "foreign-address", 1, 0, 0,
- (SCM foreign),
- "Return the numerical value of @var{foreign}.")
-#define FUNC_NAME s_scm_foreign_address
+SCM_DEFINE (scm_pointer_address, "pointer-address", 1, 0, 0,
+ (SCM pointer),
+ "Return the numerical value of @var{pointer}.")
+#define FUNC_NAME s_scm_pointer_address
{
- SCM_VALIDATE_FOREIGN (1, foreign);
+ SCM_VALIDATE_POINTER (1, pointer);
- return scm_from_uintptr ((scm_t_uintptr) SCM_FOREIGN_POINTER (foreign));
+ return scm_from_uintptr ((scm_t_uintptr) SCM_POINTER_VALUE (pointer));
}
#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}.")
+ (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_FOREIGN (1, foreign);
+ SCM_VALIDATE_POINTER (1, pointer);
- return scm_take_foreign_pointer (* (void **) SCM_FOREIGN_POINTER (foreign),
- NULL);
+ return scm_from_pointer (* (void **) SCM_POINTER_VALUE (pointer), 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"
- "@var{foreign}.\n\n"
- "@var{foreign} must be a void pointer, a foreign whose type is\n"
- "@var{void}. By default, the resulting bytevector will alias\n"
- "all of the memory pointed to by @var{foreign}, from beginning\n"
- "to end, treated as a @code{vu8} array.\n\n"
+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"
+ "to by @var{pointer}.\n\n"
"The user may specify an alternate default interpretation for\n"
"the memory by passing the @var{uvec_type} argument, to indicate\n"
"that the memory is an array of elements of that type.\n"
"@var{uvec_type} should be something that\n"
"@code{uniform-vector-element-type} would return, like
@code{f32}\n"
"or @code{s16}.\n\n"
- "Users may also specify that the bytevector should only alias a\n"
- "subset of the memory, by specifying @var{offset} and @var{len}\n"
- "arguments.")
-#define FUNC_NAME s_scm_foreign_to_bytevector
+ "When @var{offset} is passed, it specifies the offset in bytes\n"
+ "relative to @var{pointer} of the memory region aliased by the\n"
+ "returned bytevector.")
+#define FUNC_NAME s_scm_pointer_to_bytevector
{
SCM ret;
scm_t_int8 *ptr;
size_t boffset, blen;
scm_t_array_element_type btype;
- SCM_VALIDATE_FOREIGN (1, foreign);
- ptr = SCM_FOREIGN_POINTER (foreign);
+ SCM_VALIDATE_POINTER (1, pointer);
+ ptr = SCM_POINTER_VALUE (pointer);
if (SCM_UNLIKELY (ptr == NULL))
null_pointer_error (FUNC_NAME);
@@ -244,69 +239,58 @@ SCM_DEFINE (scm_foreign_to_bytevector,
"foreign->bytevector", 2, 2, 0,
blen = scm_to_size_t (len);
ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype);
- register_weak_reference (ret, foreign);
+ register_weak_reference (ret, pointer);
return ret;
}
#undef FUNC_NAME
-SCM_DEFINE (scm_bytevector_to_foreign, "bytevector->foreign", 1, 2, 0,
- (SCM bv, SCM offset, SCM len),
- "Return a foreign pointer aliasing the memory pointed to by\n"
- "@var{bv}.\n\n"
- "The resulting foreign will be a void pointer, a foreign whose\n"
- "type is @code{void}. By default it will alias all of the\n"
- "memory pointed to by @var{bv}, from beginning to end.\n\n"
- "Users may explicily specify that the foreign should only alias
a\n"
- "subset of the memory, by specifying @var{offset} and @var{len}\n"
- "arguments.")
-#define FUNC_NAME s_scm_bytevector_to_foreign
+SCM_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 1, 0,
+ (SCM bv, SCM offset),
+ "Return a pointer pointer aliasing the memory pointed to by\n"
+ "@var{bv} or @var{offset} bytes after @var{bv} when @var{offset}\n"
+ "is passed.")
+#define FUNC_NAME s_scm_bytevector_to_pointer
{
SCM ret;
scm_t_int8 *ptr;
- size_t boffset, blen;
+ size_t boffset;
SCM_VALIDATE_BYTEVECTOR (1, bv);
ptr = SCM_BYTEVECTOR_CONTENTS (bv);
-
+
if (SCM_UNBNDP (offset))
boffset = 0;
else
boffset = scm_to_unsigned_integer (offset, 0,
SCM_BYTEVECTOR_LENGTH (bv) - 1);
- if (SCM_UNBNDP (len))
- blen = SCM_BYTEVECTOR_LENGTH (bv) - boffset;
- else
- blen = scm_to_unsigned_integer (len, 0,
- SCM_BYTEVECTOR_LENGTH (bv) - boffset);
-
- ret = scm_take_foreign_pointer (ptr + boffset, NULL);
+ ret = scm_from_pointer (ptr + boffset, NULL);
register_weak_reference (ret, bv);
return ret;
}
#undef FUNC_NAME
-SCM_DEFINE (scm_foreign_set_finalizer_x, "foreign-set-finalizer!", 2, 0, 0,
- (SCM foreign, SCM finalizer),
+SCM_DEFINE (scm_set_pointer_finalizer_x, "set-pointer-finalizer!", 2, 0, 0,
+ (SCM pointer, SCM finalizer),
"Arrange for the C procedure wrapped by @var{finalizer} to be\n"
- "called on the pointer wrapped by @var{foreign} when
@var{foreign}\n"
+ "called on the pointer wrapped by @var{pointer} when
@var{pointer}\n"
"becomes unreachable. Note: the C procedure should not call into\n"
"Scheme. If you need a Scheme finalizer, use guardians.")
-#define FUNC_NAME s_scm_foreign_set_finalizer_x
+#define FUNC_NAME s_scm_set_pointer_finalizer_x
{
void *c_finalizer;
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- SCM_VALIDATE_FOREIGN (1, foreign);
- SCM_VALIDATE_FOREIGN (2, finalizer);
+ SCM_VALIDATE_POINTER (1, pointer);
+ SCM_VALIDATE_POINTER (2, finalizer);
- c_finalizer = SCM_FOREIGN_POINTER (finalizer);
+ c_finalizer = SCM_POINTER_VALUE (finalizer);
- SCM_SET_CELL_WORD_0 (foreign, SCM_CELL_WORD_0 (foreign) | (1<<16));
+ SCM_SET_CELL_WORD_0 (pointer, SCM_CELL_WORD_0 (pointer) | (1 << 16UL));
- GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (foreign),
- foreign_finalizer_trampoline,
+ GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (pointer),
+ pointer_finalizer_trampoline,
c_finalizer,
&prev_finalizer,
&prev_finalizer_data);
@@ -318,10 +302,10 @@ SCM_DEFINE (scm_foreign_set_finalizer_x,
"foreign-set-finalizer!", 2, 0, 0,
void
-scm_i_foreign_print (SCM foreign, SCM port, scm_print_state *pstate)
+scm_i_pointer_print (SCM pointer, SCM port, scm_print_state *pstate)
{
- scm_puts ("#<foreign ", port);
- scm_display (scm_foreign_address (foreign), port);
+ scm_puts ("#<pointer ", port);
+ scm_display (scm_pointer_address (pointer), port);
scm_putc ('>', port);
}
@@ -563,8 +547,8 @@ SCM_DEFINE (scm_make_foreign_function,
"make-foreign-function", 3, 0, 0,
ffi_cif *cif;
ffi_type **type_ptrs;
ffi_type *types;
-
- SCM_VALIDATE_FOREIGN (2, func_ptr);
+
+ SCM_VALIDATE_POINTER (2, func_ptr);
nargs = scm_ilength (arg_types);
SCM_ASSERT (nargs >= 0, arg_types, 3, FUNC_NAME);
@@ -594,7 +578,7 @@ SCM_DEFINE (scm_make_foreign_function,
"make-foreign-function", 3, 0, 0,
+ (nargs + n_struct_elts + 1)*sizeof(ffi_type));
mem = scm_gc_malloc_pointerless (cif_len, "foreign");
- scm_cif = scm_take_foreign_pointer (mem, NULL);
+ scm_cif = scm_from_pointer (mem, NULL);
cif = (ffi_cif *) mem;
/* reuse cif_len to walk through the mem */
@@ -750,7 +734,7 @@ cif_to_procedure (SCM cif, SCM func_ptr)
unsigned int nargs;
SCM objcode, table, ret;
- c_cif = (ffi_cif *) SCM_FOREIGN_POINTER (cif);
+ c_cif = (ffi_cif *) SCM_POINTER_VALUE (cif);
nargs = c_cif->nargs;
if (nargs < 10)
@@ -804,10 +788,10 @@ unpack (const ffi_type *type, void *loc, SCM x)
*(scm_t_int64 *) loc = scm_to_int64 (x);
break;
case FFI_TYPE_STRUCT:
- memcpy (loc, SCM_FOREIGN_POINTER (x), type->size);
+ memcpy (loc, SCM_POINTER_VALUE (x), type->size);
break;
case FFI_TYPE_POINTER:
- *(void **) loc = SCM_FOREIGN_POINTER (x);
+ *(void **) loc = SCM_POINTER_VALUE (x);
break;
default:
abort ();
@@ -846,10 +830,10 @@ pack (const ffi_type * type, const void *loc)
{
void *mem = scm_gc_malloc_pointerless (type->size, "foreign");
memcpy (mem, loc, type->size);
- return scm_take_foreign_pointer (mem, NULL);
+ return scm_from_pointer (mem, NULL);
}
case FFI_TYPE_POINTER:
- return scm_take_foreign_pointer (*(void **) loc, NULL);
+ return scm_from_pointer (*(void **) loc, NULL);
default:
abort ();
}
@@ -870,8 +854,8 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
size_t arg_size;
scm_t_ptrdiff off;
- cif = SCM_FOREIGN_POINTER (SCM_CAR (foreign));
- func = SCM_FOREIGN_POINTER (SCM_CDR (foreign));
+ cif = SCM_POINTER_VALUE (SCM_CAR (foreign));
+ func = SCM_POINTER_VALUE (SCM_CDR (foreign));
/* Argument pointers. */
args = alloca (sizeof (void *) * cif->nargs);
@@ -982,7 +966,7 @@ scm_init_foreign (void)
#endif
);
- null_pointer = scm_cell (scm_tc7_foreign, 0);
+ null_pointer = scm_cell (scm_tc7_pointer, 0);
scm_define (sym_null, null_pointer);
}
@@ -993,7 +977,7 @@ scm_register_foreign (void)
"scm_init_foreign",
(scm_t_extension_init_func)scm_init_foreign,
NULL);
- foreign_weak_refs = scm_make_weak_key_hash_table (SCM_UNDEFINED);
+ pointer_weak_refs = scm_make_weak_key_hash_table (SCM_UNDEFINED);
}
/*
diff --git a/libguile/foreign.h b/libguile/foreign.h
index af7f1c9..cdd3b3c 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -21,10 +21,10 @@
#include "libguile/__scm.h"
-/* A foreign value is some value that exists outside of Guile. It is
represented
- by a cell whose second word is a pointer. The first word has the
- scm_tc7_foreign typecode and type of the aliased (pointed-to) value in its
- lower 16 bits.
+/* A "foreign pointer" is a wrapped C pointer. It is represented by a
+ cell whose second word is a pointer. The first word has the
+ `scm_tc7_pointer' type code and a bit saying whether it has an
+ associated finalizer or not.
The basic idea is that we can help the programmer to avoid cutting herself,
but we won't take away her knives. */
@@ -47,30 +47,30 @@ enum scm_t_foreign_type
typedef enum scm_t_foreign_type scm_t_foreign_type;
-typedef void (*scm_t_foreign_finalizer) (void *);
+typedef void (*scm_t_pointer_finalizer) (void *);
-#define SCM_FOREIGN_P(x) \
- (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_foreign)
-#define SCM_VALIDATE_FOREIGN(pos, x) \
- SCM_MAKE_VALIDATE (pos, x, FOREIGN_P)
-#define SCM_FOREIGN_POINTER(x) \
+#define SCM_POINTER_P(x) \
+ (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_pointer)
+#define SCM_VALIDATE_POINTER(pos, x) \
+ SCM_MAKE_VALIDATE (pos, x, POINTER_P)
+#define SCM_POINTER_VALUE(x) \
((void *) SCM_CELL_WORD_1 (x))
-#define SCM_FOREIGN_HAS_FINALIZER(x) \
+#define SCM_POINTER_HAS_FINALIZER(x) \
((SCM_CELL_WORD_0 (x) >> 16) & 0x1)
-SCM_API SCM scm_take_foreign_pointer (void *, scm_t_foreign_finalizer);
+SCM_API SCM scm_from_pointer (void *, scm_t_pointer_finalizer);
SCM_API SCM scm_alignof (SCM type);
SCM_API SCM scm_sizeof (SCM type);
-SCM_API SCM scm_foreign_address (SCM foreign);
-SCM_API SCM scm_foreign_to_bytevector (SCM foreign, SCM type,
+SCM_API SCM scm_pointer_address (SCM pointer);
+SCM_API SCM scm_pointer_to_bytevector (SCM pointer, SCM type,
SCM offset, SCM len);
-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_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_foreign_print (SCM foreign, SCM port,
+SCM_INTERNAL void scm_i_pointer_print (SCM pointer, SCM port,
scm_print_state *pstate);
diff --git a/libguile/gc.c b/libguile/gc.c
index 192dd52..91250ba 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -746,7 +746,7 @@ scm_i_tag_name (scm_t_bits tag)
return "cons (immediate car)";
case scm_tcs_cons_nimcar:
return "cons (non-immediate car)";
- case scm_tc7_foreign:
+ case scm_tc7_pointer:
return "foreign";
case scm_tc7_hashtable:
return "hashtable";
diff --git a/libguile/goops.c b/libguile/goops.c
index 6fc073b..5e4b496 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -221,7 +221,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
case scm_tc7_vector:
case scm_tc7_wvect:
return scm_class_vector;
- case scm_tc7_foreign:
+ case scm_tc7_pointer:
return class_foreign;
case scm_tc7_hashtable:
return class_hashtable;
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index ed8febd..ef3ad23 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -793,12 +793,11 @@ create_gsubr (int define, const char *name,
/* make objtable */
sname = scm_from_locale_symbol (name);
table = scm_c_make_vector (generic_loc ? 3 : 2, SCM_UNDEFINED);
- SCM_SIMPLE_VECTOR_SET (table, 0,
- scm_take_foreign_pointer (fcn, NULL));
+ SCM_SIMPLE_VECTOR_SET (table, 0, scm_from_pointer (fcn, NULL));
SCM_SIMPLE_VECTOR_SET (table, 1, sname);
if (generic_loc)
SCM_SIMPLE_VECTOR_SET (table, 2,
- scm_take_foreign_pointer (generic_loc, NULL));
+ scm_from_pointer (generic_loc, NULL));
/* make program */
ret = scm_make_program (scm_subr_objcode_trampoline (nreq, nopt, rest),
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index 6907252..faa4bb0 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -46,13 +46,13 @@ SCM_API SCM scm_subr_objcode_trampoline (unsigned int nreq,
#define SCM_SUBRF(x) \
((SCM (*) (void)) \
- SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 0)))
+ SCM_POINTER_VALUE (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 0)))
#define SCM_SUBR_NAME(x) (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 1))
#define SCM_SUBR_GENERIC(x) \
((SCM *) \
- SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 2)))
+ SCM_POINTER_VALUE (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 2)))
#define SCM_SET_SUBR_GENERIC(x, g) \
(*SCM_SUBR_GENERIC (x) = (g))
diff --git a/libguile/print.c b/libguile/print.c
index e469277..212b70d 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -751,8 +751,8 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
case scm_tc7_program:
scm_i_program_print (exp, port, pstate);
break;
- case scm_tc7_foreign:
- scm_i_foreign_print (exp, port, pstate);
+ case scm_tc7_pointer:
+ scm_i_pointer_print (exp, port, pstate);
break;
case scm_tc7_hashtable:
scm_i_hashtable_print (exp, port, pstate);
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 9aa99d0..fcd0173 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -105,7 +105,7 @@ SCM_SYMBOL (scm_i_paste (FNAME, __name), PRIMNAME);
\
SCM_SNARF_HERE(
\
static const char scm_i_paste (s_, FNAME) [] = PRIMNAME; \
SCM_API SCM FNAME ARGLIST; \
- SCM_IMMUTABLE_FOREIGN (scm_i_paste (FNAME, __subr_foreign), \
+ SCM_IMMUTABLE_POINTER (scm_i_paste (FNAME, __subr_foreign), \
(scm_t_bits) &FNAME); /* the subr */ \
SCM_STATIC_SUBR_OBJVECT (scm_i_paste (FNAME, __raw_objtable), \
/* FIXME: directly be the foreign */ \
@@ -361,8 +361,8 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req),
(opt), (rest));)
(scm_t_bits) 0, \
(scm_t_bits) sizeof (contents) - 1)
-#define SCM_IMMUTABLE_FOREIGN(c_name, ptr) \
- SCM_IMMUTABLE_CELL (c_name, scm_tc7_foreign, ptr)
+#define SCM_IMMUTABLE_POINTER(c_name, ptr) \
+ SCM_IMMUTABLE_CELL (c_name, scm_tc7_pointer, ptr)
/* for primitive-generics, add a foreign to the end */
#define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \
diff --git a/libguile/tags.h b/libguile/tags.h
index d11bf68..9e0e305 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -411,7 +411,7 @@ typedef scm_t_uintptr scm_t_bits;
#define scm_tc7_stringbuf 39
#define scm_tc7_bytevector 77
-#define scm_tc7_foreign 31
+#define scm_tc7_pointer 31
#define scm_tc7_hashtable 29
#define scm_tc7_fluid 37
#define scm_tc7_dynamic_state 45
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 8944c84..9ba287d 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -840,12 +840,13 @@ VM_DEFINE_INSTRUCTION (55, tail_call, "tail-call", 1, -1,
1)
VM_DEFINE_INSTRUCTION (56, subr_call, "subr-call", 1, -1, -1)
{
- SCM foreign, ret;
+ SCM pointer, ret;
SCM (*subr)();
+
nargs = FETCH ();
- POP (foreign);
+ POP (pointer);
- subr = SCM_FOREIGN_POINTER (foreign);
+ subr = SCM_POINTER_VALUE (pointer);
VM_HANDLE_INTERRUPTS;
SYNC_REGISTER ();
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 6aa2fe3..121db60 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -18,6 +18,7 @@
(define-module (system foreign)
#:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
#:export (void
float double
int unsigned-int long unsigned-long size_t
@@ -31,11 +32,13 @@
%null-pointer
null-pointer?
make-pointer
- foreign-address
+ pointer-address
dereference-pointer
- foreign->bytevector bytevector->foreign
- foreign-set-finalizer!
+ pointer->bytevector
+ bytevector->pointer
+ set-pointer-finalizer!
+
make-foreign-function
make-c-struct parse-c-struct))
@@ -48,7 +51,8 @@
;;;
(define (null-pointer? pointer)
- (= (foreign-address pointer) 0))
+ "Return true if POINTER is the null pointer."
+ (= (pointer-address pointer) 0))
@@ -118,7 +122,11 @@
(define (make-c-struct types vals)
(let ((bv (make-bytevector (sizeof types) 0)))
(write-c-struct bv 0 types vals)
- (bytevector->foreign bv)))
+ (bytevector->pointer bv)))
(define (parse-c-struct foreign types)
- (read-c-struct (foreign->bytevector foreign) 0 types))
+ (let ((size (fold (lambda (type total)
+ (+ (sizeof type) total))
+ 0
+ types)))
+ (read-c-struct (pointer->bytevector foreign size) 0 types)))
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 0466b2f..5918a73 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -166,12 +166,12 @@ exec guile -q -s "$0" "$@"
(make-foreign-function '* (dynamic-func "test_ffi_memcpy" lib)
(list '* '* int32)))
(let* ((src* '(0 1 2 3 4 5 6 7))
- (src (bytevector->foreign (u8-list->bytevector src*)))
- (dest (bytevector->foreign (make-bytevector 16 0)))
+ (src (bytevector->pointer (u8-list->bytevector src*)))
+ (dest (bytevector->pointer (make-bytevector 16 0)))
(res (f-memcpy dest src (length src*))))
- (or (= (foreign-address dest) (foreign-address res))
+ (or (= (pointer-address dest) (pointer-address res))
(error "memcpy res not equal to dest"))
- (or (equal? (bytevector->u8-list (foreign->bytevector dest 16))
+ (or (equal? (bytevector->u8-list (pointer->bytevector dest 16))
'(0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0))
(error "unexpected dest")))
@@ -197,7 +197,7 @@ exec guile -q -s "$0" "$@"
(let* ((ptr (strerror ENOENT))
(len (strlen ptr))
- (bv (foreign->bytevector ptr len 0 'u8))
+ (bv (pointer->bytevector ptr len 0 'u8))
(str (utf8->string bv)))
(test #t (not (not (string-contains str "file")))))
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 7da4deb..eb12360 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -30,7 +30,7 @@
(with-test-prefix "null pointer"
(pass-if "zero"
- (= 0 (foreign-address %null-pointer)))
+ (= 0 (pointer-address %null-pointer)))
(pass-if "null pointer identity"
(eq? %null-pointer (make-pointer 0)))
@@ -38,29 +38,29 @@
(pass-if "null-pointer? %null-pointer"
(null-pointer? %null-pointer))
- (pass-if-exception "foreign->bytevector %null-pointer"
+ (pass-if-exception "pointer->bytevector %null-pointer"
exception:null-pointer-error
- (foreign->bytevector %null-pointer 7)))
+ (pointer->bytevector %null-pointer 7)))
(with-test-prefix "make-pointer"
(pass-if "address preserved"
- (= 123 (foreign-address (make-pointer 123)))))
+ (= 123 (pointer-address (make-pointer 123)))))
-(with-test-prefix "foreign<->bytevector"
+(with-test-prefix "pointer<->bytevector"
(pass-if "bijection"
(let ((bv #vu8(0 1 2 3 4 5 6 7)))
- (equal? (foreign->bytevector (bytevector->foreign bv)
+ (equal? (pointer->bytevector (bytevector->pointer bv)
(bytevector-length bv))
bv)))
(pass-if "pointer from bits"
(let* ((bytes (iota (sizeof '*)))
(bv (u8-list->bytevector bytes)))
- (= (foreign-address
+ (= (pointer-address
(make-pointer (bytevector-uint-ref bv 0 (native-endianness)
(sizeof '*))))
(fold-right (lambda (byte address)
@@ -71,9 +71,19 @@
(pass-if "dereference-pointer"
(let* ((bytes (iota (sizeof '*)))
(bv (u8-list->bytevector bytes)))
- (= (foreign-address
- (dereference-pointer (bytevector->foreign bv)))
+ (= (pointer-address
+ (dereference-pointer (bytevector->pointer bv)))
(fold-right (lambda (byte address)
(+ byte (* 256 address)))
0
bytes)))))
+
+
+(with-test-prefix "structs"
+
+ (pass-if "parse-c-struct"
+ (let ((layout (list int64 uint8))
+ (data (list -300 43)))
+ (equal? (parse-c-struct (make-c-struct layout data)
+ layout)
+ data))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-232-g7387c23,
Ludovic Courtès <=