#+sbcl
`(sb-alien:slot ,obj ,slot)
#+mcl
- `(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
+ `(ccl:pref ,obj ,(intern (concatenate 'string (symbol-name type) "." (symbol-name slot))
+ :keyword))
)
#+mcl
(defmacro deref-array (obj type i)
"Returns a field from a row"
- #+(or lispworks scl) (declare (ignore type))
- #+(or cmu scl) `(alien:deref (the (alien:alien ,(convert-from-uffi-type type :declare)) ,obj) ,i)
- #+sbcl `(sb-alien:deref (the (sb-alien:alien ,(convert-from-uffi-type type :declare)) ,obj) ,i)
+ #+(or lispworks cmu sbcl scl) (declare (ignore type))
+ #+(or cmu scl) `(alien:deref ,obj ,i)
+ #+sbcl `(sb-alien:deref ,obj ,i)
#+lispworks `(fli:dereference ,obj :index ,i :copy-foreign-object nil)
#+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
#+openmcl
`(ccl::def-foreign-type nil
(:union ,name ,@(process-struct-fields name fields)))
)
+
+
+#-(or sbcl cmu)
+(defun convert-from-foreign-usb8 (s len)
+ (declare (optimize (speed 3) (space 0) (safety 0) (compilation-speed 0))
+ (fixnum len))
+ (let ((a (make-array len :element-type '(unsigned-byte 8))))
+ (dotimes (i len a)
+ (declare (fixnum i))
+ (setf (aref a i) (uffi:deref-array s '(:array :unsigned-byte) i)))))
+
+#+sbcl
+(defun convert-from-foreign-usb8 (sap len)
+ (declare (type sb-sys:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((result (make-array len :element-type '(unsigned-byte 8))))
+ (sb-kernel:copy-from-system-area sap 0
+ result (* sb-vm:vector-data-offset
+ sb-vm:n-word-bits)
+ (* len sb-vm:n-byte-bits))
+ result)))
+
+#+cmu
+(defun convert-from-foreign-usb8 (sap len)
+ (declare (type system:system-area-pointer sap))
+ (locally
+ (declare (optimize (speed 3) (safety 0)))
+ (let ((result (make-array len :element-type '(unsigned-byte 8))))
+ (kernel:copy-from-system-area sap 0
+ result (* vm:vector-data-offset
+ vm:word-bits)
+ (* len vm:byte-bits))
+ result)))