;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: aggregates.cl
+;;;; Name: aggregates.lisp
;;;; Purpose: UFFI source to handle aggregate types
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aggregates.lisp,v 1.5 2002/11/23 19:07:11 kevin Exp $
+;;;; $Id$
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
;;;; *************************************************************************
-(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0)))
-(in-package :uffi)
+(in-package #:uffi)
(defmacro def-enum (enum-name args &key (separator-string "#"))
"Creates a constants for a C type enum list, symbols are created
#+(or cmu scl) `((* (alien:struct ,name)))
#+sbcl `((* (sb-alien:struct ,name)))
#+mcl `((:* (:struct ,name)))
- #-(or cmu sbcl scl mcl) `((* ,name))
+ #+lispworks `((:pointer ,name))
+ #-(or cmu sbcl scl mcl lispworks) `((* ,name))
`(,(convert-from-uffi-type type :struct))))))
(if variant
(push (list def) processed)
(defmacro deref-array (obj type i)
"Returns a field from a row"
- #+(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)
- #+allegro `(ff:fslot-value-typed (quote (convert-from-uffi-type ,type :type)) :c ,obj ,i)
- #+mcl
+ #+(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)
+ #+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
(let* ((array-type (array-type type))
(local-type (convert-from-uffi-type array-type :allocation))
- (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
- `(,accessor
+ (element-size-in-bits (ccl::%foreign-type-or-record-size local-type :bits)))
+ (ccl::%foreign-access-form
+ obj
+ (ccl::%foreign-type-or-record local-type)
+ `(* ,i ,element-size-in-bits)
+ nil))
+ #+(and mcl (not openmcl))
+ (let* ((array-type (array-type type))
+ (local-type (convert-from-uffi-type array-type :allocation))
+ (accessor (first (macroexpand `(ccl:pref obj ,local-type)))))
+ `(,accessor
,obj
(* (the fixnum ,i) ,(size-of-foreign-type local-type))))
)
; this expands to the %set-xx functions which has different params than %put-xx
-#+mcl
+#+(and mcl (not openmcl))
(defmacro deref-array-set (obj type i value)
(let* ((array-type (array-type type))
(local-type (convert-from-uffi-type array-type :allocation))
(* (the fixnum ,i) ,(size-of-foreign-type local-type))
,value)))
-#+mcl
+#+(and mcl (not openmcl))
(defsetf deref-array deref-array-set)
(defmacro def-union (name &rest fields)