summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-07-27 14:54:53 +0200
committerLudovic Courtès <ludo@gnu.org>2010-07-28 12:24:25 +0200
commit5b46a8c2c8f41581dd5576c8dcc06e8bde8cd849 (patch)
tree27af561d2cf6cd08dee3ff78c19d281ecce626e4
parent9defb64118774c8f1a1f6af05d6f1705e7a40619 (diff)
downloadguile-5b46a8c2c8f41581dd5576c8dcc06e8bde8cd849.tar.gz
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.
-rw-r--r--libguile/deprecated.c4
-rw-r--r--libguile/dynl.c10
-rw-r--r--libguile/evalext.c2
-rw-r--r--libguile/foreign.c127
-rw-r--r--libguile/foreign.h34
-rw-r--r--libguile/gc.c2
-rw-r--r--libguile/goops.c2
-rw-r--r--libguile/gsubr.c5
-rw-r--r--libguile/gsubr.h4
-rw-r--r--libguile/print.c4
-rw-r--r--libguile/snarf.h6
-rw-r--r--libguile/tags.h2
-rw-r--r--libguile/vm-i-system.c7
-rw-r--r--module/system/foreign.scm14
-rwxr-xr-xtest-suite/standalone/test-ffi10
-rw-r--r--test-suite/tests/foreign.test18
16 files changed, 126 insertions, 125 deletions
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index de5ac5b08..8405e888f 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 9ee4e2c4d..d26de0325 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -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 b397cbd05..ff2ff0ec0 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 dd77a823c..9810e90eb 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,
@@ -114,26 +114,26 @@ SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
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);
+ result = scm_from_pointer ((void *) c_address, c_finalizer);
return result;
}
#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);
+ word0 = scm_tc7_pointer | (finalizer ? (1 << 16UL) : 0UL);
ret = scm_cell (word0, (scm_t_bits) ptr);
if (finalizer)
@@ -142,7 +142,7 @@ scm_take_foreign_pointer (void *ptr, scm_t_foreign_finalizer finalizer)
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
GC_REGISTER_FINALIZER_NO_ORDER (SCM2PTR (ret),
- foreign_finalizer_trampoline,
+ pointer_finalizer_trampoline,
finalizer,
&prev_finalizer,
&prev_finalizer_data);
@@ -151,37 +151,36 @@ scm_take_foreign_pointer (void *ptr, scm_t_foreign_finalizer finalizer)
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),
+ "Return the a pointer object representing the pointer "
+ "pointed to by @var{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),
+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 memory pointed to by\n"
- "@var{foreign}.\n\n"
- "@var{foreign} must be a void pointer, a foreign whose type is\n"
+ "@var{pointer}.\n\n"
+ "@var{pointer} must be a void pointer, a pointer 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"
+ "all of the memory pointed to by @var{pointer}, from beginning\n"
"to end, treated as a @code{vu8} array.\n\n"
"The user may specify an alternate default interpretation for\n"
"the memory by passing the @var{uvec_type} argument, to indicate\n"
@@ -192,15 +191,15 @@ SCM_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 2, 2, 0,
"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
+#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,22 +243,22 @@ 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_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 2, 0,
(SCM bv, SCM offset, SCM len),
- "Return a foreign pointer aliasing the memory pointed to by\n"
+ "Return a pointer pointer aliasing the memory pointed to by\n"
"@var{bv}.\n\n"
- "The resulting foreign will be a void pointer, a foreign whose\n"
+ "The resulting pointer will be a void pointer, a pointer 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"
+ "Users may explicily specify that the pointer 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
+#define FUNC_NAME s_scm_bytevector_to_pointer
{
SCM ret;
scm_t_int8 *ptr;
@@ -280,33 +279,33 @@ SCM_DEFINE (scm_bytevector_to_foreign, "bytevector->foreign", 1, 2, 0,
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 +317,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 +562,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 +593,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 +749,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 +803,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 +845,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 +869,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 +981,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 +992,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 af7f1c90d..0b9ef10de 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 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_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 192dd5273..91250ba57 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 6fc073bdc..5e4b4964a 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 ed8febd7b..ef3ad232b 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 690725221..faa4bb0d4 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 e46927768..212b70d2b 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 9aa99d0ba..fcd017346 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 d11bf6864..9e0e3059d 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 8944c8415..9ba287d5a 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 6aa2fe357..617b6aa98 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -31,11 +31,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 +50,7 @@
;;;
(define (null-pointer? pointer)
- (= (foreign-address pointer) 0))
+ (= (pointer-address pointer) 0))
@@ -118,7 +120,7 @@
(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))
+ (read-c-struct (pointer->bytevector foreign) 0 types))
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 0466b2ff3..5918a73f9 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 7da4deb31..2cc1e2107 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,8 +71,8 @@
(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