- (ccl::mactype-record-size mcl-type)
- (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
+ (ccl::mactype-record-size mcl-type)
+ (ccl::record-descriptor-length (ccl:find-record-descriptor type t t)))) ;error if not a record
- #+(or cmu scl)
- `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
- #+sbcl
- `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
- #+lispworks
- `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
- #+allegro
- `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
- #+(or openmcl digitool)
- `(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
- )
+ #+(or cmu scl)
+ `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
+ #+sbcl
+ `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation))
+ #+lispworks
+ `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate))
+ #+allegro
+ `(ff:allocate-fobject ',(convert-from-uffi-type type :allocate) :c)
+ #+(or openmcl digitool)
+ `(new-ptr ,(size-of-foreign-type (convert-from-uffi-type type :allocation)))
+ )
- #+(or cmu scl)
- `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
- #+sbcl
- `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
- #+lispworks
- `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
- #+allegro
- `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
- #+(or openmcl digitool)
- `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
- )))
+ #+(or cmu scl)
+ `(alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
+ #+sbcl
+ `(sb-alien:make-alien ,(convert-from-uffi-type (eval type) :allocation) ,size)
+ #+lispworks
+ `(fli:allocate-foreign-object :type ',(convert-from-uffi-type type :allocate) :nelems ,size)
+ #+allegro
+ `(ff:allocate-fobject (list :array (quote ,(convert-from-uffi-type type :allocate)) ,size) :c)
+ #+(or openmcl digitool)
+ `(new-ptr (* ,size ,(size-of-foreign-type (convert-from-uffi-type type :allocation))))
+ )))
#+(or cmu scl) `(alien:cast ,obj (* (alien:unsigned 8)))
#+sbcl `(sb-alien:cast ,obj (* (sb-alien:unsigned 8)))
#+lispworks `(fli:make-pointer :type '(:unsigned :char)
#+(or cmu scl) `(alien:cast ,obj (* (alien:unsigned 8)))
#+sbcl `(sb-alien:cast ,obj (* (sb-alien:unsigned 8)))
#+lispworks `(fli:make-pointer :type '(:unsigned :char)
`(if (integerp ,obj) ,obj (char-code ,obj)))
(defmacro ensure-char-storable (obj)
`(if (integerp ,obj) ,obj (char-code ,obj)))
(defmacro ensure-char-storable (obj)
- #+(or digitool (and lispworks (not lispworks5))) obj
- #+(or allegro cmu lispworks5 openmcl sbcl scl)
+ #+(or digitool (and lispworks (not lispworks5) (not lispworks6))) obj
+ #+(or allegro cmu lispworks5 lispworks6 openmcl sbcl scl)
#-(or cmu sbcl lispworks scl) ; default version
`(let ((,var (allocate-foreign-object ,type)))
(unwind-protect
#-(or cmu sbcl lispworks scl) ; default version
`(let ((,var (allocate-foreign-object ,type)))
(unwind-protect
- `(alien:with-alien ((,obj ,ctype))
- (let* ((,var ,obj))
- ,@body))
- `(alien:with-alien ((,obj ,ctype))
- (let* ((,var (alien:addr ,obj)))
- ,@body))))
+ `(alien:with-alien ((,obj ,ctype))
+ (let* ((,var ,obj))
+ ,@body))
+ `(alien:with-alien ((,obj ,ctype))
+ (let* ((,var (alien:addr ,obj)))
+ ,@body))))
- `(sb-alien:with-alien ((,obj ,ctype))
- (let* ((,var ,obj))
- ,@body))
- `(sb-alien:with-alien ((,obj ,ctype))
- (let* ((,var (sb-alien:addr ,obj)))
- ,@body))))
+ `(sb-alien:with-alien ((,obj ,ctype))
+ (let* ((,var ,obj))
+ ,@body))
+ `(sb-alien:with-alien ((,obj ,ctype))
+ (let* ((,var (sb-alien:addr ,obj)))
+ ,@body))))
(defmacro with-foreign-objects (bindings &rest body)
(if bindings
`(with-foreign-object ,(car bindings)
(defmacro with-foreign-objects (bindings &rest body)
(if bindings
`(with-foreign-object ,(car bindings)
-;; unchanged from main primitives.lisp
-(defun make-lisp-name (name)
- (let ((converted (substitute #\- #\_ name)))
- (intern
- #+uffi-case-sensitive converted
- #+(and (not uffi-lowercase-reader) (not uffi-case-sensitive)) (string-upcase converted)
- #+(and uffi-lowercase-reader (not uffi-case-sensitive)) (string-downcase converted))))
-
(defmacro def-foreign-var (names type module)
#-lispworks (declare (ignore module))
(let ((foreign-name (if (atom names) names (first names)))
(lisp-name (if (atom names) (make-lisp-name names) (second names)))
#-allegro
(defmacro def-foreign-var (names type module)
#-lispworks (declare (ignore module))
(let ((foreign-name (if (atom names) names (first names)))
(lisp-name (if (atom names) (make-lisp-name names) (second names)))
#-allegro
#+(or cmu scl)
`(alien:def-alien-variable (,foreign-name ,lisp-name) ,var-type)
#+sbcl
#+(or cmu scl)
`(alien:def-alien-variable (,foreign-name ,lisp-name) ,var-type)
#+sbcl