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))))