summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2010-09-06 22:24:44 +0200
committerLudovic Courtès <ludo@gnu.org>2010-09-06 22:24:44 +0200
commit2ee073587a28161dfb6b95f250be2d8a5df26cae (patch)
tree6e165113473328fdb90624301118652d60fbbba2
parent7884975a890a461fb62178eeb3dfbb8b30b28ba2 (diff)
downloadguile-2ee073587a28161dfb6b95f250be2d8a5df26cae.tar.gz
Rename `make-foreign-function' to `pointer->procedure'.
* libguile/foreign.c (scm_make_foreign_function): Rename to... (scm_pointer_to_procedure): ... this. * libguile/foreign.h: Adjust accordingly. * module/system/foreign.scm: Likewise. * test-suite/standalone/test-ffi: Likewise. * test-suite/tests/foreign.test: Likewise. * doc/ref/api-foreign.texi: Likewise.
-rw-r--r--doc/ref/api-foreign.texi28
-rw-r--r--libguile/foreign.c6
-rw-r--r--libguile/foreign.h4
-rw-r--r--module/system/foreign.scm2
-rwxr-xr-xtest-suite/standalone/test-ffi82
-rw-r--r--test-suite/tests/foreign.test13
6 files changed, 67 insertions, 68 deletions
diff --git a/doc/ref/api-foreign.texi b/doc/ref/api-foreign.texi
index 88408ada9..4f38711aa 100644
--- a/doc/ref/api-foreign.texi
+++ b/doc/ref/api-foreign.texi
@@ -493,7 +493,7 @@ numeric types. For example, @code{long} may be @code{equal?} to
@defvr {Scheme Variable} void
The @code{void} type. It can be used as the first argument to
-@code{make-foreign-function} to wrap a C function that returns nothing.
+@code{pointer->procedure} to wrap a C function that returns nothing.
@end defvr
@node Foreign Variables
@@ -703,8 +703,8 @@ tightly packed structs and unions by hand. See the code for
Of course, the land of C is not all nouns and no verbs: there are
functions too, and Guile allows you to call them.
-@deffn {Scheme Procedure} make-foreign-function return_type func_ptr arg_types
-@deffnx {C Procedure} scm_make_foreign_function return_type func_ptr arg_types
+@deffn {Scheme Procedure} pointer->procedure return_type func_ptr arg_types
+@deffnx {C Procedure} scm_pointer_to_procedure return_type func_ptr arg_types
Make a foreign function.
Given the foreign void pointer @var{func_ptr}, its argument and
@@ -727,9 +727,9 @@ Here is a better definition of @code{(math bessel)}:
(define libm (dynamic-link "libm"))
(define j0
- (make-foreign-function double
- (dynamic-func "j0" libm)
- (list double)))
+ (pointer->procedure double
+ (dynamic-func "j0" libm)
+ (list double)))
@end example
That's it! No C at all.
@@ -747,9 +747,9 @@ code makes @code{memcpy} available to Scheme:
@example
(define memcpy
(let ((this (dynamic-link)))
- (make-foreign-function '*
- (dynamic-func "memcpy" this)
- (list '* '* size_t))))
+ (pointer->procedure '*
+ (dynamic-func "memcpy" this)
+ (list '* '* size_t))))
@end example
To invoke @code{memcpy}, one must pass it foreign pointers:
@@ -785,7 +785,7 @@ by the foreign pointer is mutated in place.
;; assuming fields are of type "long"
(define gettimeofday
- (let ((f (make-foreign-function
+ (let ((f (pointer->procedure
int
(dynamic-func "gettimeofday" (dynamic-link))
(list '* '*)))
@@ -826,10 +826,10 @@ function can be made accessible to Scheme (@pxref{Array Sort Function,
@example
(define qsort!
- (let ((qsort (make-foreign-function void
- (dynamic-func "qsort"
- (dynamic-link))
- (list '* size_t size_t '*))))
+ (let ((qsort (pointer->procedure void
+ (dynamic-func "qsort"
+ (dynamic-link))
+ (list '* size_t size_t '*))))
(lambda (bv compare)
;; Sort bytevector BV in-place according to comparison
;; procedure COMPARE.
diff --git a/libguile/foreign.c b/libguile/foreign.c
index c36972b54..1e91661ad 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -530,7 +530,7 @@ fill_ffi_type (SCM type, ffi_type *ftype, ffi_type ***type_ptrs,
*ftype = ffi_type_void;
return;
default:
- scm_wrong_type_arg_msg ("make-foreign-function", 0, type,
+ scm_wrong_type_arg_msg ("pointer->procedure", 0, type,
"foreign type");
}
}
@@ -641,7 +641,7 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
}
#undef FUNC_NAME
-SCM_DEFINE (scm_make_foreign_function, "make-foreign-function", 3, 0, 0,
+SCM_DEFINE (scm_pointer_to_procedure, "pointer->procedure", 3, 0, 0,
(SCM return_type, SCM func_ptr, SCM arg_types),
"Make a foreign function.\n\n"
"Given the foreign void pointer @var{func_ptr}, its argument and\n"
@@ -650,7 +650,7 @@ SCM_DEFINE (scm_make_foreign_function, "make-foreign-function", 3, 0, 0,
"and return appropriate values.\n\n"
"@var{arg_types} should be a list of foreign types.\n"
"@code{return_type} should be a foreign type.")
-#define FUNC_NAME s_scm_make_foreign_function
+#define FUNC_NAME s_scm_pointer_to_procedure
{
ffi_cif *cif;
diff --git a/libguile/foreign.h b/libguile/foreign.h
index 1c576211f..e534d48cb 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -93,8 +93,8 @@ SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer);
arguments.
*/
-SCM_API SCM scm_make_foreign_function (SCM return_type, SCM func_ptr,
- SCM arg_types);
+SCM_API SCM scm_pointer_to_procedure (SCM return_type, SCM func_ptr,
+ SCM arg_types);
SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
SCM arg_types);
SCM_INTERNAL SCM scm_i_foreign_call (SCM foreign, const SCM *argv);
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 0ca7fbf4c..84d1a0351 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -42,7 +42,7 @@
string->pointer
pointer->string
- make-foreign-function
+ pointer->procedure
;; procedure->pointer (see below)
make-c-struct parse-c-struct))
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 960c9d154..ad686603e 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -45,78 +45,78 @@ exec guile -q -s "$0" "$@"
;;; No args
;;;
(define f-v-
- (make-foreign-function void (dynamic-func "test_ffi_v_" lib) '()))
+ (pointer->procedure void (dynamic-func "test_ffi_v_" lib) '()))
(test (f-v-) *unspecified*)
(define f-s8-
- (make-foreign-function int8 (dynamic-func "test_ffi_s8_" lib) '()))
+ (pointer->procedure int8 (dynamic-func "test_ffi_s8_" lib) '()))
(test (f-s8-) -100)
(define f-u8-
- (make-foreign-function uint8 (dynamic-func "test_ffi_u8_" lib) '()))
+ (pointer->procedure uint8 (dynamic-func "test_ffi_u8_" lib) '()))
(test (f-u8-) 200)
(define f-s16-
- (make-foreign-function int16 (dynamic-func "test_ffi_s16_" lib) '()))
+ (pointer->procedure int16 (dynamic-func "test_ffi_s16_" lib) '()))
(test (f-s16-) -20000)
(define f-u16-
- (make-foreign-function uint16 (dynamic-func "test_ffi_u16_" lib) '()))
+ (pointer->procedure uint16 (dynamic-func "test_ffi_u16_" lib) '()))
(test (f-u16-) 40000)
(define f-s32-
- (make-foreign-function int32 (dynamic-func "test_ffi_s32_" lib) '()))
+ (pointer->procedure int32 (dynamic-func "test_ffi_s32_" lib) '()))
(test (f-s32-) -2000000000)
(define f-u32-
- (make-foreign-function uint32 (dynamic-func "test_ffi_u32_" lib) '()))
+ (pointer->procedure uint32 (dynamic-func "test_ffi_u32_" lib) '()))
(test (f-u32-) 4000000000)
(define f-s64-
- (make-foreign-function int64 (dynamic-func "test_ffi_s64_" lib) '()))
+ (pointer->procedure int64 (dynamic-func "test_ffi_s64_" lib) '()))
(test (f-s64-) -2000000000)
(define f-u64-
- (make-foreign-function uint64 (dynamic-func "test_ffi_u64_" lib) '()))
+ (pointer->procedure uint64 (dynamic-func "test_ffi_u64_" lib) '()))
(test (f-u64-) 4000000000)
;;;
;;; One u8 arg
;;;
(define f-v-u8
- (make-foreign-function void (dynamic-func "test_ffi_v_u8" lib) (list uint8)))
+ (pointer->procedure void (dynamic-func "test_ffi_v_u8" lib) (list uint8)))
(test (f-v-u8 10) *unspecified*)
(define f-s8-u8
- (make-foreign-function int8 (dynamic-func "test_ffi_s8_u8" lib) (list uint8)))
+ (pointer->procedure int8 (dynamic-func "test_ffi_s8_u8" lib) (list uint8)))
(test (f-s8-u8 10) -90)
(define f-u8-u8
- (make-foreign-function uint8 (dynamic-func "test_ffi_u8_u8" lib) (list uint8)))
+ (pointer->procedure uint8 (dynamic-func "test_ffi_u8_u8" lib) (list uint8)))
(test (f-u8-u8 10) 210)
(define f-s16-u8
- (make-foreign-function int16 (dynamic-func "test_ffi_s16_u8" lib) (list uint8)))
+ (pointer->procedure int16 (dynamic-func "test_ffi_s16_u8" lib) (list uint8)))
(test (f-s16-u8 10) -19990)
(define f-u16-u8
- (make-foreign-function uint16 (dynamic-func "test_ffi_u16_u8" lib) (list uint8)))
+ (pointer->procedure uint16 (dynamic-func "test_ffi_u16_u8" lib) (list uint8)))
(test (f-u16-u8 10) 40010)
(define f-s32-u8
- (make-foreign-function int32 (dynamic-func "test_ffi_s32_u8" lib) (list uint8)))
+ (pointer->procedure int32 (dynamic-func "test_ffi_s32_u8" lib) (list uint8)))
(test (f-s32-u8 10) -1999999990)
(define f-u32-u8
- (make-foreign-function uint32 (dynamic-func "test_ffi_u32_u8" lib) (list uint8)))
+ (pointer->procedure uint32 (dynamic-func "test_ffi_u32_u8" lib) (list uint8)))
(test (f-u32-u8 10) 4000000010)
(define f-s64-u8
- (make-foreign-function int64 (dynamic-func "test_ffi_s64_u8" lib) (list uint8)))
+ (pointer->procedure int64 (dynamic-func "test_ffi_s64_u8" lib) (list uint8)))
(test (f-s64-u8 10) -1999999990)
(define f-u64-u8
- (make-foreign-function uint64 (dynamic-func "test_ffi_u64_u8" lib) (list uint8)))
+ (pointer->procedure uint64 (dynamic-func "test_ffi_u64_u8" lib) (list uint8)))
(test (f-u64-u8 10) 4000000010)
@@ -124,39 +124,39 @@ exec guile -q -s "$0" "$@"
;;; One s64 arg
;;;
(define f-v-s64
- (make-foreign-function void (dynamic-func "test_ffi_v_s64" lib) (list int64)))
+ (pointer->procedure void (dynamic-func "test_ffi_v_s64" lib) (list int64)))
(test (f-v-s64 10) *unspecified*)
(define f-s8-s64
- (make-foreign-function int8 (dynamic-func "test_ffi_s8_s64" lib) (list int64)))
+ (pointer->procedure int8 (dynamic-func "test_ffi_s8_s64" lib) (list int64)))
(test (f-s8-s64 10) -90)
(define f-u8-s64
- (make-foreign-function uint8 (dynamic-func "test_ffi_u8_s64" lib) (list int64)))
+ (pointer->procedure uint8 (dynamic-func "test_ffi_u8_s64" lib) (list int64)))
(test (f-u8-s64 10) 210)
(define f-s16-s64
- (make-foreign-function int16 (dynamic-func "test_ffi_s16_s64" lib) (list int64)))
+ (pointer->procedure int16 (dynamic-func "test_ffi_s16_s64" lib) (list int64)))
(test (f-s16-s64 10) -19990)
(define f-u16-s64
- (make-foreign-function uint16 (dynamic-func "test_ffi_u16_s64" lib) (list int64)))
+ (pointer->procedure uint16 (dynamic-func "test_ffi_u16_s64" lib) (list int64)))
(test (f-u16-s64 10) 40010)
(define f-s32-s64
- (make-foreign-function int32 (dynamic-func "test_ffi_s32_s64" lib) (list int64)))
+ (pointer->procedure int32 (dynamic-func "test_ffi_s32_s64" lib) (list int64)))
(test (f-s32-s64 10) -1999999990)
(define f-u32-s64
- (make-foreign-function uint32 (dynamic-func "test_ffi_u32_s64" lib) (list int64)))
+ (pointer->procedure uint32 (dynamic-func "test_ffi_u32_s64" lib) (list int64)))
(test (f-u32-s64 10) 4000000010)
(define f-s64-s64
- (make-foreign-function int64 (dynamic-func "test_ffi_s64_s64" lib) (list int64)))
+ (pointer->procedure int64 (dynamic-func "test_ffi_s64_s64" lib) (list int64)))
(test (f-s64-s64 10) -1999999990)
(define f-u64-s64
- (make-foreign-function uint64 (dynamic-func "test_ffi_u64_s64" lib) (list int64)))
+ (pointer->procedure uint64 (dynamic-func "test_ffi_u64_s64" lib) (list int64)))
(test (f-u64-s64 10) 4000000010)
@@ -164,8 +164,8 @@ exec guile -q -s "$0" "$@"
;; Multiple int args of differing types
;;
(define f-sum
- (make-foreign-function int64 (dynamic-func "test_ffi_sum" lib)
- (list int8 int16 int32 int64)))
+ (pointer->procedure int64 (dynamic-func "test_ffi_sum" lib)
+ (list int8 int16 int32 int64)))
(test (f-sum -1 2000 -30000 40000000000)
(+ -1 2000 -30000 40000000000))
@@ -173,8 +173,8 @@ exec guile -q -s "$0" "$@"
;; Structs
;;
(define f-sum-struct
- (make-foreign-function int64 (dynamic-func "test_ffi_sum_struct" lib)
- (list (list int8 int16 int32 int64))))
+ (pointer->procedure int64 (dynamic-func "test_ffi_sum_struct" lib)
+ (list (list int8 int16 int32 int64))))
(test (f-sum-struct (make-c-struct (list int8 int16 int32 int64)
(list -1 2000 -30000 40000000000)))
(+ -1 2000 -30000 40000000000))
@@ -182,8 +182,8 @@ exec guile -q -s "$0" "$@"
;; Structs
;;
(define f-memcpy
- (make-foreign-function '* (dynamic-func "test_ffi_memcpy" lib)
- (list '* '* int32)))
+ (pointer->procedure '* (dynamic-func "test_ffi_memcpy" lib)
+ (list '* '* int32)))
(let* ((src* '(0 1 2 3 4 5 6 7))
(src (bytevector->pointer (u8-list->bytevector src*)))
(dest (bytevector->pointer (make-bytevector 16 0)))
@@ -199,8 +199,8 @@ exec guile -q -s "$0" "$@"
;;
(define f-callback-1
- (make-foreign-function int (dynamic-func "test_ffi_callback_1" lib)
- (list '* int)))
+ (pointer->procedure int (dynamic-func "test_ffi_callback_1" lib)
+ (list '* int)))
(if (defined? 'procedure->pointer)
(let* ((calls 0)
@@ -220,8 +220,8 @@ exec guile -q -s "$0" "$@"
(error "incorrect result" result))))))
(define f-callback-2
- (make-foreign-function double (dynamic-func "test_ffi_callback_2" lib)
- (list '* float int double)))
+ (pointer->procedure double (dynamic-func "test_ffi_callback_2" lib)
+ (list '* float int double)))
(if (defined? 'procedure->pointer)
(let* ((proc (lambda (x y z)
@@ -251,12 +251,12 @@ exec guile -q -s "$0" "$@"
(define global (dynamic-link))
(define strerror
- (make-foreign-function '* (dynamic-func "strerror" global)
- (list int)))
+ (pointer->procedure '* (dynamic-func "strerror" global)
+ (list int)))
(define strlen
- (make-foreign-function size_t (dynamic-func "strlen" global)
- (list '*)))
+ (pointer->procedure size_t (dynamic-func "strlen" global)
+ (list '*)))
(let* ((ptr (strerror ENOENT))
(len (strlen ptr))
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index a791602e5..274a06d8c 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -96,9 +96,9 @@
(define qsort
;; Bindings for libc's `qsort' function.
- (make-foreign-function void
- (dynamic-func "qsort" (dynamic-link))
- (list '* size_t size_t '*)))
+ (pointer->procedure void
+ (dynamic-func "qsort" (dynamic-link))
+ (list '* size_t size_t '*)))
(define (dereference-pointer-to-byte ptr)
(let ((b (pointer->bytevector ptr 1)))
@@ -153,10 +153,9 @@
(+ x y z 0.0)))
(ret double)
(args (list float int16 double))
- (proc* (make-foreign-function
- ret
- (procedure->pointer ret proc args)
- args))
+ (proc* (pointer->procedure ret
+ (procedure->pointer ret proc args)
+ args))
(arg1 (map (cut / <> 2.0) (iota 123)))
(arg2 (iota 123 32000))
(arg3 (map (cut / <> 4.0) (iota 123 100 4))))