diff options
author | Ludovic Courtès <ludo@gnu.org> | 2010-07-27 14:54:53 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2010-07-28 12:24:25 +0200 |
commit | 5b46a8c2c8f41581dd5576c8dcc06e8bde8cd849 (patch) | |
tree | 27af561d2cf6cd08dee3ff78c19d281ecce626e4 | |
parent | 9defb64118774c8f1a1f6af05d6f1705e7a40619 (diff) | |
download | guile-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.c | 4 | ||||
-rw-r--r-- | libguile/dynl.c | 10 | ||||
-rw-r--r-- | libguile/evalext.c | 2 | ||||
-rw-r--r-- | libguile/foreign.c | 127 | ||||
-rw-r--r-- | libguile/foreign.h | 34 | ||||
-rw-r--r-- | libguile/gc.c | 2 | ||||
-rw-r--r-- | libguile/goops.c | 2 | ||||
-rw-r--r-- | libguile/gsubr.c | 5 | ||||
-rw-r--r-- | libguile/gsubr.h | 4 | ||||
-rw-r--r-- | libguile/print.c | 4 | ||||
-rw-r--r-- | libguile/snarf.h | 6 | ||||
-rw-r--r-- | libguile/tags.h | 2 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 7 | ||||
-rw-r--r-- | module/system/foreign.scm | 14 | ||||
-rwxr-xr-x | test-suite/standalone/test-ffi | 10 | ||||
-rw-r--r-- | test-suite/tests/foreign.test | 18 |
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 |