Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Declare DEFCALLBACK, DEFCFUN and DEFINE-FOREIGN-LIBRARY's keyword arg…

…s :CCONV and :CALLING-CONVENTION obsolete, use :CONVENTION instead.
  • Loading branch information...
commit ab579dbe46046a1cf0a462b229442b6f120ceef2 1 parent bea0cde
@sionescu sionescu authored
View
16 src/cffi-allegro.lisp
@@ -281,8 +281,8 @@ WITH-POINTER-TO-VECTOR-DATA."
nil ; arg-checking
ff::ep-flag-never-release))))
-(defmacro %foreign-funcall (name args &key calling-convention library)
- (declare (ignore calling-convention library))
+(defmacro %foreign-funcall (name args &key convention library)
+ (declare (ignore convention library))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
`(system::ff-funcall
@@ -314,8 +314,8 @@ WITH-POINTER-TO-VECTOR-DATA."
`(,ff-name ,@args))))
;;; See doc/allegro-internals.txt for a clue about entry-vec.
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
- (declare (ignore calling-convention))
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
+ (declare (ignore convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
(with-unique-names (entry-vec)
@@ -373,20 +373,20 @@ WITH-POINTER-TO-VECTOR-DATA."
(symbol-name name))
'#:cffi-callbacks))
-(defun convert-calling-convention (calling-convention)
- (ecase calling-convention
+(defun convert-calling-convention (convention)
+ (ecase convention
(:cdecl :c)
(:stdcall :stdcall)))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
+ &key convention)
(declare (ignore rettype))
(let ((cb-name (intern-callback name)))
`(progn
(ff:defun-foreign-callable ,cb-name
,(mapcar (lambda (sym type) (list sym (convert-foreign-type type)))
arg-names arg-types)
- (declare (:convention ,(convert-calling-convention calling-convention)))
+ (declare (:convention ,(convert-calling-convention convention)))
,body)
(register-callback ',name ',cb-name))))
View
24 src/cffi-clisp.lisp
@@ -250,17 +250,17 @@ values to pass to the function, and the CLISP FFI return type."
else do (setf return-type (convert-foreign-type type))
finally (return (values types fargs return-type)))))
-(defun convert-calling-convention (calling-convention)
- (ecase calling-convention
+(defun convert-calling-convention (convention)
+ (ecase convention
(:stdcall :stdc-stdcall)
(:cdecl :stdc)))
-(defun c-function-type (arg-types rettype calling-convention)
+(defun c-function-type (arg-types rettype convention)
"Generate the apropriate CLISP foreign type specification. Also
takes care of converting the calling convention names."
`(ffi:c-function (:arguments ,@arg-types)
(:return-type ,rettype)
- (:language ,(convert-calling-convention calling-convention))))
+ (:language ,(convert-calling-convention convention))))
;;; Quick hack around the fact that the CFFI package is not yet
;;; defined when this file is loaded. I suppose we could arrange for
@@ -298,7 +298,7 @@ takes care of converting the calling convention names."
nil
,type))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Invoke a foreign function called NAME, taking pairs of
foreign-type/value pairs from ARGS. If a single element is left
over at the end of ARGS, it specifies the foreign return type of
@@ -308,7 +308,7 @@ the function call."
(let* ((fn (%foreign-funcall-aux
name
`(ffi:parse-c-type
- ',(c-function-type types rettype calling-convention))
+ ',(c-function-type types rettype convention))
(if (eq library :default)
:default
(library-handle-form library))))
@@ -322,14 +322,14 @@ the function call."
`(or ,form (null-pointer))
form))))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Similar to %foreign-funcall but takes a pointer instead of a string."
(multiple-value-bind (types fargs rettype)
(parse-foreign-funcall-args args)
`(funcall (ffi:foreign-function
,ptr (load-time-value
(ffi:parse-c-type ',(c-function-type
- types rettype calling-convention))))
+ types rettype convention))))
,@fargs)))
;;;# Callbacks
@@ -344,14 +344,14 @@ the function call."
;;; Return a CLISP FFI function type for a CFFI callback function
;;; given a return type and list of argument names and types.
(eval-when (:compile-toplevel :load-toplevel :execute)
- (defun callback-type (rettype arg-names arg-types calling-convention)
+ (defun callback-type (rettype arg-names arg-types convention)
(ffi:parse-c-type
`(ffi:c-function
(:arguments ,@(mapcar (lambda (sym type)
(list sym (convert-foreign-type type)))
arg-names arg-types))
(:return-type ,(convert-foreign-type rettype))
- (:language ,(convert-calling-convention calling-convention))))))
+ (:language ,(convert-calling-convention convention))))))
;;; Register and create a callback function.
(defun register-callback (name function parsed-type)
@@ -381,7 +381,7 @@ the function call."
;;; translated according to RETTYPE. Obtain a pointer that can be
;;; passed to C code for this callback by calling %CALLBACK.
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
+ &key convention)
`(register-callback
',name
(lambda ,arg-names
@@ -392,7 +392,7 @@ the function call."
when (eq type :pointer)
collect `(,name (or ,name (null-pointer)))))
,body))
- ,(callback-type rettype arg-names arg-types calling-convention)))
+ ,(callback-type rettype arg-names arg-types convention)))
;;; Look up the name of a callback and return a pointer that can be
;;; passed to a C function. Signals an error if no callback is
View
12 src/cffi-cmucl.lisp
@@ -267,16 +267,16 @@ WITH-POINTER-TO-VECTOR-DATA."
(extern-alien ,name (function ,rettype ,@types))
,@fargs))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Perform a foreign function call, document it more later."
- (declare (ignore library calling-convention))
+ (declare (ignore library convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
`(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Funcall a pointer to a foreign function."
- (declare (ignore calling-convention))
+ (declare (ignore convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
(with-unique-names (function)
@@ -305,8 +305,8 @@ WITH-POINTER-TO-VECTOR-DATA."
'#:cffi-callbacks)))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
- (declare (ignore calling-convention))
+ &key convention)
+ (declare (ignore convention))
(let ((cb-name (intern-callback name)))
`(progn
(def-callback ,cb-name
View
12 src/cffi-ecl.lisp
@@ -261,16 +261,16 @@ WITH-POINTER-TO-VECTOR-DATA."
else do (setf return-type (cffi-type->ecl-type type))
finally (return (values types values return-type)))))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Call a foreign function."
- (declare (ignore library calling-convention))
+ (declare (ignore library convention))
(multiple-value-bind (types values return-type)
(foreign-funcall-parse-args args)
(produce-function-pointer-call name types values return-type)))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Funcall a pointer to a foreign function."
- (declare (ignore calling-convention))
+ (declare (ignore convention))
(multiple-value-bind (types values return-type)
(foreign-funcall-parse-args args)
(produce-function-pointer-call ptr types values return-type)))
@@ -315,8 +315,8 @@ WITH-POINTER-TO-VECTOR-DATA."
'#:cffi-callbacks)))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
- (declare (ignore calling-convention))
+ &key convention)
+ (declare (ignore convention))
(let ((cb-name (intern-callback name)))
`(progn
(ffi:defcallback (,cb-name :cdecl)
View
26 src/cffi-lispworks.lisp
@@ -284,7 +284,7 @@ signature.")
else do (setf return-type (convert-foreign-type type))
finally (return (values types fargs return-type)))))
-(defun create-foreign-funcallable (types rettype calling-convention)
+(defun create-foreign-funcallable (types rettype convention)
"Creates a foreign funcallable for the signature TYPES -> RETTYPE."
(format t "~&Creating foreign funcallable for signature ~S -> ~S~%"
types rettype)
@@ -299,38 +299,38 @@ signature.")
:result-type ,rettype
:language :ansi-c
;; avoid warning about cdecl not being supported on mac
- #-mac ,@(list :calling-convention calling-convention)))))
+ #-mac ,@(list :calling-convention convention)))))
internal-name))
-(defun get-foreign-funcallable (types rettype calling-convention)
+(defun get-foreign-funcallable (types rettype convention)
"Returns a foreign funcallable for the signature TYPES -> RETTYPE -
either from the cache or newly created."
(let ((signature (cons rettype types)))
(or (gethash signature *foreign-funcallable-cache*)
;; (SETF GETHASH) is supposed to be thread-safe
(setf (gethash signature *foreign-funcallable-cache*)
- (create-foreign-funcallable types rettype calling-convention)))))
+ (create-foreign-funcallable types rettype convention)))))
-(defmacro %%foreign-funcall (foreign-function args calling-convention)
+(defmacro %%foreign-funcall (foreign-function args convention)
"Does the actual work for %FOREIGN-FUNCALL-POINTER and %FOREIGN-FUNCALL.
Checks if a foreign funcallable which fits ARGS already exists and creates
and caches it if necessary. Finally calls it."
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
`(funcall (load-time-value
- (get-foreign-funcallable ',types ',rettype ',calling-convention))
+ (get-foreign-funcallable ',types ',rettype ',convention))
,foreign-function ,@fargs)))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Calls a foreign function named NAME passing arguments ARGS."
`(%%foreign-funcall
(fli:make-pointer :symbol-name ,name
:module ',(if (eq library :default) nil library))
- ,args ,calling-convention))
+ ,args ,convention))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Calls a foreign function pointed at by PTR passing arguments ARGS."
- `(%%foreign-funcall ,ptr ,args ,calling-convention))
+ `(%%foreign-funcall ,ptr ,args ,convention))
(defun defcfun-helper-forms (name lisp-name rettype args types options)
"Return 2 values for DEFCFUN. A prelude form and a caller form."
@@ -344,7 +344,7 @@ and caches it if necessary. Finally calls it."
:module ',(let ((lib (getf options :library)))
(if (eq lib :default) nil lib))
;; avoid warning about cdecl not being supported on mac platforms
- #-mac ,@(list :calling-convention (getf options :calling-convention)))
+ #-mac ,@(list :calling-convention (getf options :convention)))
`(,ff-name ,@args))))
;;;# Callbacks
@@ -369,13 +369,13 @@ and caches it if necessary. Finally calls it."
'#:cffi-callbacks)))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
+ &key convention)
(let ((cb-name (intern-callback name)))
`(progn
(fli:define-foreign-callable
(,cb-name :encode :lisp
:result-type ,(convert-foreign-type rettype)
- :calling-convention ,calling-convention
+ :calling-convention ,convention
:language :ansi-c
:no-check nil)
,(mapcar (lambda (sym type)
View
12 src/cffi-openmcl.lisp
@@ -236,15 +236,15 @@ WITH-POINTER-TO-VECTOR-DATA."
#+darwin (concatenate 'string "_" name)
#-darwin name)
-(defmacro %foreign-funcall (function-name args &key library calling-convention)
+(defmacro %foreign-funcall (function-name args &key library convention)
"Perform a foreign function call, document it more later."
- (declare (ignore library calling-convention))
+ (declare (ignore library convention))
`(external-call
,(convert-external-name function-name)
,@(convert-foreign-funcall-types args)))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
- (declare (ignore calling-convention))
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
+ (declare (ignore convention))
`(ff-call ,ptr ,@(convert-foreign-funcall-types args)))
;;;# Callbacks
@@ -272,11 +272,11 @@ WITH-POINTER-TO-VECTOR-DATA."
'#:cffi-callbacks))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
+ &key convention)
(let ((cb-name (intern-callback name)))
`(progn
(defcallback ,cb-name
- (,@(when (eq calling-convention :stdcall)
+ (,@(when (eq convention :stdcall)
'(:discard-stack-args))
,@(mapcan (lambda (sym type)
(list (convert-foreign-type type) sym))
View
12 src/cffi-sbcl.lisp
@@ -279,16 +279,16 @@ WITH-POINTER-TO-VECTOR-DATA."
(extern-alien ,name (function ,rettype ,@types))
,@fargs))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Perform a foreign function call, document it more later."
- (declare (ignore library calling-convention))
+ (declare (ignore library convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
`(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Funcall a pointer to a foreign function."
- (declare (ignore calling-convention))
+ (declare (ignore convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
(with-unique-names (function)
@@ -304,8 +304,8 @@ WITH-POINTER-TO-VECTOR-DATA."
(defvar *callbacks* (make-hash-table))
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
- (declare (ignore calling-convention))
+ &key convention)
+ (declare (ignore convention))
`(setf (gethash ',name *callbacks*)
(alien-sap
(sb-alien::alien-lambda ,(convert-foreign-type rettype)
View
11 src/cffi-scl.lisp
@@ -267,16 +267,16 @@
`(alien-funcall (extern-alien ,name (function ,rettype ,@types))
,@fargs))
-(defmacro %foreign-funcall (name args &key library calling-convention)
+(defmacro %foreign-funcall (name args &key library convention)
"Perform a foreign function call, document it more later."
- (declare (ignore library calling-convention))
+ (declare (ignore library convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
`(%%foreign-funcall ,name ,types ,fargs ,rettype)))
-(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
+(defmacro %foreign-funcall-pointer (ptr args &key convention)
"Funcall a pointer to a foreign function."
- (declare (ignore calling-convention))
+ (declare (ignore convention))
(multiple-value-bind (types fargs rettype)
(foreign-funcall-type-and-args args)
(with-unique-names (function)
@@ -286,7 +286,8 @@
;;; Callbacks
(defmacro %defcallback (name rettype arg-names arg-types body
- &key calling-convention)
+ &key convention)
+ (declare (ignore convention))
`(alien:defcallback ,name
(,(convert-foreign-type rettype)
,@(mapcar (lambda (sym type)
View
27 src/functions.lisp
@@ -64,15 +64,21 @@
;;; While the options passed directly to DEFCFUN/FOREIGN-FUNCALL have
;;; precedence, we also grab its library's options, if possible.
(defun parse-function-options (options &key pointer)
- (destructuring-bind (&key (library :default libraryp) calling-convention
- (cconv calling-convention))
+ (destructuring-bind (&key (library :default libraryp)
+ (cconv nil cconv-p)
+ (calling-convention cconv calling-convention-p)
+ (convention calling-convention))
options
- (list* :calling-convention
- (or cconv
+ (when cconv-p
+ (warn-obsolete-argument :cconv :convention))
+ (when calling-convention-p
+ (warn-obsolete-argument :calling-convention :convention))
+ (list* :convention
+ (or convention
(when libraryp
(let ((lib-options (foreign-library-options
(get-foreign-library library))))
- (getf lib-options :calling-convention)))
+ (getf lib-options :convention)))
:cdecl)
;; Don't pass the library option if we're dealing with
;; FOREIGN-FUNCALL-POINTER.
@@ -277,10 +283,15 @@ arguments and does type promotion for the variadic arguments."
,(expand-to-foreign call (parse-type rettype))))
(defun parse-defcallback-options (options)
- (destructuring-bind (&key (calling-convention :cdecl)
- (cconv calling-convention))
+ (destructuring-bind (&key (cconv :cdecl cconv-p)
+ (calling-convention cconv calling-convention-p)
+ (convention calling-convention))
options
- (list :calling-convention cconv)))
+ (when cconv-p
+ (warn-obsolete-argument :cconv :convention))
+ (when calling-convention-p
+ (warn-obsolete-argument :calling-convention :convention))
+ (list :convention convention)))
(defmacro defcallback (name-and-options return-type args &body body)
(multiple-value-bind (body declarations)
View
44 src/libraries.lisp
@@ -160,35 +160,51 @@ all libraries are returned."
(not (foreign-library-loaded-p lib)))))
libs)))
-;; :CALLING-CONVENTION and :CCONV are coalesced, the former taking priority
-;; then options with NULL values are removed
+;; :CONVENTION, :CALLING-CONVENTION and :CCONV are coalesced,
+;; the former taking priority
+;; options with NULL values are removed
(defun clean-spec-up (spec)
(mapcar (lambda (x)
(list* (first x) (second x)
(let* ((opts (cddr x))
(cconv (getf opts :cconv))
- (calling-convention (getf opts :calling-convention)))
- (remf opts :cconv)
- (setf (getf opts :calling-convention)
- (or calling-convention cconv))
+ (calling-convention (getf opts :calling-convention))
+ (convention (getf opts :convention)))
+ (remf opts :cconv) (remf opts :calling-convention)
+ (when cconv
+ (warn-obsolete-argument :cconv :convention))
+ (when calling-convention
+ (warn-obsolete-argument :calling-convention
+ :convention))
+ (setf (getf opts :convention)
+ (or convention calling-convention cconv))
(loop for (opt val) on opts by #'cddr
when val append (list opt val) into new-opts
finally (return new-opts)))))
spec))
-(defmethod initialize-instance :after ((lib foreign-library) &key
- cconv calling-convention search-path)
+(defmethod initialize-instance :after
+ ((lib foreign-library) &key search-path
+ (cconv :cdecl cconv-p)
+ (calling-convention cconv calling-convention-p)
+ (convention calling-convention))
(with-slots (type options spec) lib
- (setf spec (clean-spec-up (copy-tree spec)))
+ (check-type type (member :system :test :grovel-wrapper))
+ (setf spec (clean-spec-up spec))
(let ((all-options
(apply #'append options (mapcar #'cddr spec))))
- (check-type type (member :system :test :grovel-wrapper))
- (assert (subsetp (loop for (key . nil) on all-options by #'cddr collect key)
- '(:calling-convention :search-path)))
+ (assert (subsetp (loop for (key . nil) on all-options by #'cddr
+ collect key)
+ '(:convention :search-path)))
+ (when cconv-p
+ (warn-obsolete-argument :cconv :convention))
+ (when calling-convention-p
+ (warn-obsolete-argument :calling-convention :convention))
(flet ((set-option (key value)
(when value (setf (getf options key) value))))
- (set-option :calling-convention (or calling-convention cconv))
- (set-option :search-path (mapcar #'pathname (ensure-list search-path)))))))
+ (set-option :convention convention)
+ (set-option :search-path
+ (mapcar #'pathname (ensure-list search-path)))))))
;;; FIXME: re-evaluating DEFINE-FOREIGN-LIBRARY overwrites the current entry
;;; breaking FOREIGN-LIBRARY-LOADED-P if already loaded
View
11 src/utils.lisp
@@ -54,3 +54,14 @@ set twos-complement bit."
(warn "Defining a foreign type named ~S. This symbol belongs to the ~A ~
package and that may interfere with other code using CFFI."
name (package-name package)))))
+
+(define-condition obsolete-argument-warning (style-warning)
+ ((old-arg :initarg :old-arg :reader old-arg)
+ (new-arg :initarg :new-arg :reader new-arg))
+ (:report (lambda (c s)
+ (format s "Keyword ~S is obsolete, please use ~S"
+ (old-arg c) (new-arg c)))))
+
+(defun warn-obsolete-argument (old-arg new-arg)
+ (warn 'obsolete-argument-warning
+ :old-arg old-arg :new-arg new-arg))
View
2  tests/callbacks.lisp
@@ -509,7 +509,7 @@
#+(and x86 (not cffi-sys::no-stdcall))
(progn
- (defcallback (stdcall-cb :cconv :stdcall) :int
+ (defcallback (stdcall-cb :convention :stdcall) :int
((a :int) (b :int) (c :int))
(+ a b c))
View
2  tests/defcfun.lisp
@@ -396,7 +396,7 @@
#+(and x86 windows (not cffi-sys::no-stdcall))
(progn
- (defcfun ("stdcall_fun@12" stdcall-fun :cconv :stdcall) :int
+ (defcfun ("stdcall_fun@12" stdcall-fun :convention :stdcall) :int
(a :int)
(b :int)
(c :int))
View
2  tests/funcall.lisp
@@ -184,7 +184,7 @@
#+(and x86 windows (not cffi-sys::no-stdcall))
(deftest funcall.stdcall.1
(flet ((fun ()
- (foreign-funcall ("stdcall_fun@12" :cconv :stdcall)
+ (foreign-funcall ("stdcall_fun@12" :convention :stdcall)
:int 1 :int 2 :int 3 :int)))
(loop repeat 100 do (fun)
finally (return (fun))))
Please sign in to comment.
Something went wrong with that request. Please try again.