On Mon, Jan 5, 2009 at 3:48 AM, John Fremlin <j...@msi.co.jp> wrote:
> On Mon, 5 Jan 2009 03:14:13 +0000, "Luís Oliveira" <luis...@gmail.com> wrote:
>> I'm asking these questions because I suspect both changes break with
>> older versions of Allegro but I can't test it since the express
>> edition 7.0 is no longer available. It's probably not a big deal but
>> I'd like to at least try to maintain compatibility.
>
> There is no :foreign-address type in Allegro 8.1?
The page
<http://www.franz.com/support/documentation/8.1/doc/foreign-functions.htm>
documents the :FOREIGN-ADDRESS type.
Can you confirm that the patch I've attached works? Thanks.
--
Luís Oliveira
http://student.dei.uc.pt/~lmoliv/
diff -rN -u old-cffi/src/cffi-allegro.lisp new-cffi/src/cffi-allegro.lisp
--- old-cffi/src/cffi-allegro.lisp 2009-01-08 22:44:21.000000000 +0000
+++ new-cffi/src/cffi-allegro.lisp 2009-01-08 22:44:21.000000000 +0000
@@ -171,7 +171,7 @@
;;;# Dereferencing
-(defun convert-foreign-type (type-keyword &optional (context :normal))
+(defun convert-foreign-type (type-keyword)
"Convert a CFFI type keyword to an Allegro type."
(ecase type-keyword
(:char :char)
@@ -184,9 +184,7 @@
(:unsigned-long :unsigned-long)
(:float :float)
(:double :double)
- (:pointer (ecase context
- (:normal '(* :void))
- (:funcall :foreign-address)))
+ (:pointer :unsigned-nat)
(:void :void)))
(defun %mem-ref (ptr type &optional (offset 0))
@@ -243,36 +241,24 @@
"Returns a list of types, list of args and return type."
(let ((return-type :void))
(loop for (type arg) on args by #'cddr
- if arg collect (convert-foreign-type type :funcall) into types
+ if arg collect type into types
and collect arg into fargs
- else do (setf return-type (convert-foreign-type type :funcall))
+ else do (setf return-type type)
finally (return (values types fargs return-type)))))
(defun convert-to-lisp-type (type)
- (if (equal '(* :void) type)
- 'integer
- (ecase type
- (:char 'signed-byte)
- (:unsigned-char 'integer) ;'unsigned-byte)
- ((:short
- :unsigned-short
- :int
- :unsigned-int
- :long
- :unsigned-long) 'integer)
- (:float 'single-float)
- (:double 'double-float)
- (:foreign-address :foreign-address)
- (:void 'null))))
-
-(defun foreign-allegro-type (type)
- (if (eq type :foreign-address)
- nil
- type))
-
-(defun allegro-type-pair (type)
- (list (foreign-allegro-type type)
- (convert-to-lisp-type type)))
+ (ecase type
+ ((:char :short :int :long)
+ `(signed-byte ,(* 8 (ff:sizeof-fobject type))))
+ ((:unsigned-char :unsigned-short :unsigned-int :unsigned-long :unsigned-nat)
+ `(unsigned-byte ,(* 8 (ff:sizeof-fobject type))))
+ (:float 'single-float)
+ (:double 'double-float)
+ (:void 'null)))
+
+(defun allegro-type-pair (cffi-type)
+ (let ((ftype (convert-foreign-type cffi-type)))
+ (list ftype (convert-to-lisp-type ftype))))
#+ignore
(defun note-named-foreign-function (symbol name types rettype)
@@ -283,11 +269,9 @@
t ; callback
:c ; convention
;; return type '(:c-type lisp-type)
- ',(allegro-type-pair (convert-foreign-type rettype :funcall))
+ ',(allegro-type-pair rettype)
;; arg types '({(:c-type lisp-type)}*)
- '(,@(loop for type in types
- collect (allegro-type-pair
- (convert-foreign-type type :funcall))))
+ '(,@(mapcar #'allegro-type-pair types))
nil ; arg-checking
ff::ep-flag-never-release))))
@@ -313,19 +297,15 @@
(declare (ignore options))
(let ((ff-name (intern (format nil "%cffi-foreign-function/~A" lisp-name))))
(values
- `(ff:def-foreign-call (,ff-name ,name)
- ,(mapcar (lambda (ty)
- (let ((allegro-type (convert-foreign-type ty)))
- (list (gensym) allegro-type
- (convert-to-lisp-type allegro-type))))
- types)
- :returning ,(allegro-type-pair
- (convert-foreign-type rettype :funcall))
- ;; Don't use call-direct when there are no arguments.
- ,@(unless (null args) '(:call-direct t))
- :arg-checking nil
- :strings-convert nil)
- `(,ff-name ,@args))))
+ `(ff:def-foreign-call (,ff-name ,name)
+ ,(loop for type in types
+ collect (list* (gensym) (allegro-type-pair type)))
+ :returning ,(allegro-type-pair rettype)
+ ;; Don't use call-direct when there are no arguments.
+ ,@(unless (null args) '(:call-direct t))
+ :arg-checking nil
+ :strings-convert nil)
+ `(,ff-name ,@args))))
;;; See doc/allegro-internals.txt for a clue about entry-vec.
(defmacro %foreign-funcall-pointer (ptr args &key calling-convention)
_______________________________________________
cffi-devel mailing list
cffi-devel@common-lisp.net
http://common-lisp.net/cgi-bin/mailman/listinfo/cffi-devel
