mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

Rename make-foreign-function' to pointer->procedure'.

Browse source 
* 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.
This commit is contained in:
Ludovic Courtès 2010-09-06 22:24:44 +02:00
parent 7884975a89
commit 2ee073587a
6 changed files with 67 additions and 68 deletions
Download patch file Download diff file Expand all files Collapse all files

28
doc/ref/api-foreign.texi
View file

@ -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.

6
libguile/foreign.c
View file

@ -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;

4
libguile/foreign.h
View file

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

2
module/system/foreign.scm
View file

@ -42,7 +42,7 @@
string->pointer
pointer->string
make-foreign-function
pointer->procedure
;; procedure->pointer (see below)
make-c-struct parse-c-struct))

82
test-suite/standalone/test-ffi
View file

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

13
test-suite/tests/foreign.test
View file

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