mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +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

14
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 @defvr {Scheme Variable} void
The @code{void} type. It can be used as the first argument to 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 @end defvr
@node Foreign Variables @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 Of course, the land of C is not all nouns and no verbs: there are
functions too, and Guile allows you to call them. functions too, and Guile allows you to call them.
@deffn {Scheme Procedure} make-foreign-function return_type func_ptr arg_types @deffn {Scheme Procedure} pointer->procedure return_type func_ptr arg_types
@deffnx {C Procedure} scm_make_foreign_function return_type func_ptr arg_types @deffnx {C Procedure} scm_pointer_to_procedure return_type func_ptr arg_types
Make a foreign function. Make a foreign function.
Given the foreign void pointer @var{func_ptr}, its argument and Given the foreign void pointer @var{func_ptr}, its argument and
@ -727,7 +727,7 @@ Here is a better definition of @code{(math bessel)}:
(define libm (dynamic-link "libm")) (define libm (dynamic-link "libm"))
(define j0 (define j0
(make-foreign-function double (pointer->procedure double
(dynamic-func "j0" libm) (dynamic-func "j0" libm)
(list double))) (list double)))
@end example @end example
@ -747,7 +747,7 @@ code makes @code{memcpy} available to Scheme:
@example @example
(define memcpy (define memcpy
(let ((this (dynamic-link))) (let ((this (dynamic-link)))
(make-foreign-function '* (pointer->procedure '*
(dynamic-func "memcpy" this) (dynamic-func "memcpy" this)
(list '* '* size_t)))) (list '* '* size_t))))
@end example @end example
@ -785,7 +785,7 @@ by the foreign pointer is mutated in place.
;; assuming fields are of type "long" ;; assuming fields are of type "long"
(define gettimeofday (define gettimeofday
(let ((f (make-foreign-function (let ((f (pointer->procedure
int int
(dynamic-func "gettimeofday" (dynamic-link)) (dynamic-func "gettimeofday" (dynamic-link))
(list '* '*))) (list '* '*)))
@ -826,7 +826,7 @@ function can be made accessible to Scheme (@pxref{Array Sort Function,
@example @example
(define qsort! (define qsort!
(let ((qsort (make-foreign-function void (let ((qsort (pointer->procedure void
(dynamic-func "qsort" (dynamic-func "qsort"
(dynamic-link)) (dynamic-link))
(list '* size_t size_t '*)))) (list '* size_t size_t '*))))

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; *ftype = ffi_type_void;
return; return;
default: default:
scm_wrong_type_arg_msg ("make-foreign-function", 0, type, scm_wrong_type_arg_msg ("pointer->procedure", 0, type,
"foreign type"); "foreign type");
} }
} }
@ -641,7 +641,7 @@ make_cif (SCM return_type, SCM arg_types, const char *caller)
} }
#undef FUNC_NAME #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), (SCM return_type, SCM func_ptr, SCM arg_types),
"Make a foreign function.\n\n" "Make a foreign function.\n\n"
"Given the foreign void pointer @var{func_ptr}, its argument and\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" "and return appropriate values.\n\n"
"@var{arg_types} should be a list of foreign types.\n" "@var{arg_types} should be a list of foreign types.\n"
"@code{return_type} should be a foreign type.") "@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; ffi_cif *cif;

2
libguile/foreign.h
View file

@ -93,7 +93,7 @@ SCM_INTERNAL SCM scm_pointer_to_string (SCM pointer);
arguments. arguments.
*/ */
SCM_API SCM scm_make_foreign_function (SCM return_type, SCM func_ptr, SCM_API SCM scm_pointer_to_procedure (SCM return_type, SCM func_ptr,
SCM arg_types); SCM arg_types);
SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr, SCM_API SCM scm_procedure_to_pointer (SCM return_type, SCM func_ptr,
SCM arg_types); SCM arg_types);

2
module/system/foreign.scm
View file

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

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

@ -45,78 +45,78 @@ exec guile -q -s "$0" "$@"
;;; No args ;;; No args
;;; ;;;
(define f-v- (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*) (test (f-v-) *unspecified*)
(define f-s8- (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) (test (f-s8-) -100)
(define f-u8- (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) (test (f-u8-) 200)
(define f-s16- (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) (test (f-s16-) -20000)
(define f-u16- (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) (test (f-u16-) 40000)
(define f-s32- (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) (test (f-s32-) -2000000000)
(define f-u32- (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) (test (f-u32-) 4000000000)
(define f-s64- (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) (test (f-s64-) -2000000000)
(define f-u64- (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) (test (f-u64-) 4000000000)
;;; ;;;
;;; One u8 arg ;;; One u8 arg
;;; ;;;
(define f-v-u8 (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*) (test (f-v-u8 10) *unspecified*)
(define f-s8-u8 (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) (test (f-s8-u8 10) -90)
(define f-u8-u8 (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) (test (f-u8-u8 10) 210)
(define f-s16-u8 (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) (test (f-s16-u8 10) -19990)
(define f-u16-u8 (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) (test (f-u16-u8 10) 40010)
(define f-s32-u8 (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) (test (f-s32-u8 10) -1999999990)
(define f-u32-u8 (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) (test (f-u32-u8 10) 4000000010)
(define f-s64-u8 (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) (test (f-s64-u8 10) -1999999990)
(define f-u64-u8 (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) (test (f-u64-u8 10) 4000000010)
@ -124,39 +124,39 @@ exec guile -q -s "$0" "$@"
;;; One s64 arg ;;; One s64 arg
;;; ;;;
(define f-v-s64 (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*) (test (f-v-s64 10) *unspecified*)
(define f-s8-s64 (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) (test (f-s8-s64 10) -90)
(define f-u8-s64 (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) (test (f-u8-s64 10) 210)
(define f-s16-s64 (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) (test (f-s16-s64 10) -19990)
(define f-u16-s64 (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) (test (f-u16-s64 10) 40010)
(define f-s32-s64 (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) (test (f-s32-s64 10) -1999999990)
(define f-u32-s64 (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) (test (f-u32-s64 10) 4000000010)
(define f-s64-s64 (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) (test (f-s64-s64 10) -1999999990)
(define f-u64-s64 (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) (test (f-u64-s64 10) 4000000010)
@ -164,7 +164,7 @@ exec guile -q -s "$0" "$@"
;; Multiple int args of differing types ;; Multiple int args of differing types
;; ;;
(define f-sum (define f-sum
(make-foreign-function int64 (dynamic-func "test_ffi_sum" lib) (pointer->procedure int64 (dynamic-func "test_ffi_sum" lib)
(list int8 int16 int32 int64))) (list int8 int16 int32 int64)))
(test (f-sum -1 2000 -30000 40000000000) (test (f-sum -1 2000 -30000 40000000000)
(+ -1 2000 -30000 40000000000)) (+ -1 2000 -30000 40000000000))
@ -173,7 +173,7 @@ exec guile -q -s "$0" "$@"
;; Structs ;; Structs
;; ;;
(define f-sum-struct (define f-sum-struct
(make-foreign-function int64 (dynamic-func "test_ffi_sum_struct" lib) (pointer->procedure int64 (dynamic-func "test_ffi_sum_struct" lib)
(list (list int8 int16 int32 int64)))) (list (list int8 int16 int32 int64))))
(test (f-sum-struct (make-c-struct (list int8 int16 int32 int64) (test (f-sum-struct (make-c-struct (list int8 int16 int32 int64)
(list -1 2000 -30000 40000000000))) (list -1 2000 -30000 40000000000)))
@ -182,7 +182,7 @@ exec guile -q -s "$0" "$@"
;; Structs ;; Structs
;; ;;
(define f-memcpy (define f-memcpy
(make-foreign-function '* (dynamic-func "test_ffi_memcpy" lib) (pointer->procedure '* (dynamic-func "test_ffi_memcpy" lib)
(list '* '* int32))) (list '* '* int32)))
(let* ((src* '(0 1 2 3 4 5 6 7)) (let* ((src* '(0 1 2 3 4 5 6 7))
(src (bytevector->pointer (u8-list->bytevector src*))) (src (bytevector->pointer (u8-list->bytevector src*)))
@ -199,7 +199,7 @@ exec guile -q -s "$0" "$@"
;; ;;
(define f-callback-1 (define f-callback-1
(make-foreign-function int (dynamic-func "test_ffi_callback_1" lib) (pointer->procedure int (dynamic-func "test_ffi_callback_1" lib)
(list '* int))) (list '* int)))
(if (defined? 'procedure->pointer) (if (defined? 'procedure->pointer)
@ -220,7 +220,7 @@ exec guile -q -s "$0" "$@"
(error "incorrect result" result)))))) (error "incorrect result" result))))))
(define f-callback-2 (define f-callback-2
(make-foreign-function double (dynamic-func "test_ffi_callback_2" lib) (pointer->procedure double (dynamic-func "test_ffi_callback_2" lib)
(list '* float int double))) (list '* float int double)))
(if (defined? 'procedure->pointer) (if (defined? 'procedure->pointer)
@ -251,11 +251,11 @@ exec guile -q -s "$0" "$@"
(define global (dynamic-link)) (define global (dynamic-link))
(define strerror (define strerror
(make-foreign-function '* (dynamic-func "strerror" global) (pointer->procedure '* (dynamic-func "strerror" global)
(list int))) (list int)))
(define strlen (define strlen
(make-foreign-function size_t (dynamic-func "strlen" global) (pointer->procedure size_t (dynamic-func "strlen" global)
(list '*))) (list '*)))
(let* ((ptr (strerror ENOENT)) (let* ((ptr (strerror ENOENT))

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

@ -96,7 +96,7 @@
(define qsort (define qsort
;; Bindings for libc's `qsort' function. ;; Bindings for libc's `qsort' function.
(make-foreign-function void (pointer->procedure void
(dynamic-func "qsort" (dynamic-link)) (dynamic-func "qsort" (dynamic-link))
(list '* size_t size_t '*))) (list '* size_t size_t '*)))
@ -153,8 +153,7 @@
(+ x y z 0.0))) (+ x y z 0.0)))
(ret double) (ret double)
(args (list float int16 double)) (args (list float int16 double))
(proc* (make-foreign-function (proc* (pointer->procedure ret
ret
(procedure->pointer ret proc args) (procedure->pointer ret proc args)
args)) args))
(arg1 (map (cut / <> 2.0) (iota 123))) (arg1 (map (cut / <> 2.0) (iota 123)))