X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fobjects.lisp;h=cdd3882296bdf1b9bd86269a2af63980a20ec838;hb=bbe3653207a655c6fc596474e75092fd0affd0bd;hp=1510d246ccb5a6a139bd6361dbd8e59ad1570afe;hpb=66f5a25945b334732c2420fbe73b389e89de1669;p=uffi.git diff --git a/src/objects.lisp b/src/objects.lisp index 1510d24..cdd3882 100644 --- a/src/objects.lisp +++ b/src/objects.lisp @@ -18,21 +18,21 @@ (in-package #:uffi) -(defun size-of-foreign-type (type) - #+lispworks (fli:size-of type) - #+allegro (ff:sizeof-fobject type) - #+(or cmu scl) (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes - #+sbcl (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes - #+clisp (values (ffi:size-of type)) - #+(and mcl (not openmcl)) - (let ((mcl-type (ccl:find-mactype type nil t))) - (if mcl-type - (ccl::mactype-record-size mcl-type) - (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record - #+openmcl (ccl::%foreign-type-or-record-size type :bytes) - ) - - +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun size-of-foreign-type (type) + #+lispworks (fli:size-of type) + #+allegro (ff:sizeof-fobject type) + #+(or cmu scl) (ash (eval `(alien:alien-size ,type)) -3) ;; convert from bits to bytes + #+sbcl (ash (eval `(sb-alien:alien-size ,type)) -3) ;; convert from bits to bytes + #+clisp (values (ffi:size-of type)) + #+(and mcl (not openmcl)) + (let ((mcl-type (ccl:find-mactype type nil t))) + (if mcl-type + (ccl::mactype-record-size mcl-type) + (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record + #+openmcl (ccl::%foreign-type-or-record-size type :bytes) + )) + (defmacro allocate-foreign-object (type &optional (size :unspecified)) "Allocates an instance of TYPE. If size is specified, then allocate an array of TYPE with size SIZE. The TYPE parameter is evaluated." @@ -138,7 +138,10 @@ an array of TYPE with size SIZE. The TYPE parameter is evaluated." (defmacro ensure-char-integer (obj) #+(or (and mcl (not openmcl))) `(char-code ,obj) #+(or allegro cmu sbcl scl openmcl) obj - `(if (characterp ,obj) (char-code ,obj) ,obj)) + #+lispworks + ;; lispworks varies whether deref'ing array vs. slot access of a char + #+lispworks + `(if (integerp ,obj) ,obj (char-code ,obj))) (defmacro ensure-char-storable (obj) #+(or lispworks (and mcl (not openmcl))) obj