projects
/
uffi.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r4191: Automatic commit for debian_version_1_2_9-1
[uffi.git]
/
src
/
aggregates.lisp
diff --git
a/src/aggregates.lisp
b/src/aggregates.lisp
index a1d8a67d69c1b74cbad780ae9fb2dd4ebbec1610..5080222aa0862c7b92bf708eca85370378746018 100644
(file)
--- a/
src/aggregates.lisp
+++ b/
src/aggregates.lisp
@@
-7,7
+7,7
@@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Feb 2002
;;;;
-;;;; $Id: aggregates.lisp,v 1.
1 2002/09/30 10:02:36
kevin Exp $
+;;;; $Id: aggregates.lisp,v 1.
6 2002/12/02 13:21:43
kevin Exp $
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;;
;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
@@
-44,7
+44,8
@@
of the enum-name name, separator-string, and field-name"
(setf cmds (append '(progn)
#+allegro `((ff:def-foreign-type ,enum-name :int))
#+lispworks `((fli:define-c-typedef ,enum-name :int))
(setf cmds (append '(progn)
#+allegro `((ff:def-foreign-type ,enum-name :int))
#+lispworks `((fli:define-c-typedef ,enum-name :int))
- #+cmu `((alien:def-alien-type ,enum-name alien:signed))
+ #+(or cmu scl) `((alien:def-alien-type ,enum-name alien:signed))
+ #+sbcl `((sb-alien:define-alien-type ,enum-name sb-alien:signed))
#+(and mcl (not openmcl)) `((def-mcl-type ,enum-name :integer))
#+openmcl `((ccl::def-foreign-type ,enum-name :int))
(nreverse constants)))
#+(and mcl (not openmcl)) `((def-mcl-type ,enum-name :integer))
#+openmcl `((ccl::def-foreign-type ,enum-name :int))
(nreverse constants)))
@@
-58,9
+59,12
@@
of the enum-name name, separator-string, and field-name"
#+lispworks
`(fli:define-c-typedef ,name-array
(:c-array ,(convert-from-uffi-type type :array)))
#+lispworks
`(fli:define-c-typedef ,name-array
(:c-array ,(convert-from-uffi-type type :array)))
- #+
cmu
+ #+
(or cmu scl)
`(alien:def-alien-type ,name-array
(* ,(convert-from-uffi-type type :array)))
`(alien:def-alien-type ,name-array
(* ,(convert-from-uffi-type type :array)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name-array
+ (* ,(convert-from-uffi-type type :array)))
#+(and mcl (not openmcl))
`(def-mcl-type ,name-array '(:array ,type))
#+openmcl
#+(and mcl (not openmcl))
`(def-mcl-type ,name-array '(:array ,type))
#+openmcl
@@
-74,9
+78,10
@@
of the enum-name name, separator-string, and field-name"
(type (cadr field))
(def (append (list field-name)
(if (eq type :pointer-self)
(type (cadr field))
(def (append (list field-name)
(if (eq type :pointer-self)
- #+cmu `((* (alien:struct ,name)))
+ #+(or cmu scl) `((* (alien:struct ,name)))
+ #+sbcl `((* (sb-alien:struct ,name)))
#+mcl `((:* (:struct ,name)))
#+mcl `((:* (:struct ,name)))
- #-(or cmu mcl) `((* ,name))
+ #-(or cmu
sbcl scl
mcl) `((* ,name))
`(,(convert-from-uffi-type type :struct))))))
(if variant
(push (list def) processed)
`(,(convert-from-uffi-type type :struct))))))
(if variant
(push (list def) processed)
@@
-85,8
+90,10
@@
of the enum-name name, separator-string, and field-name"
(defmacro def-struct (name &rest fields)
(defmacro def-struct (name &rest fields)
- #+
cmu
+ #+
(or cmu scl)
`(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields)))
`(alien:def-alien-type ,name (alien:struct ,name ,@(process-struct-fields name fields)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name (sb-alien:struct ,name ,@(process-struct-fields name fields)))
#+allegro
`(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
#+lispworks
#+allegro
`(ff:def-foreign-type ,name (:struct ,@(process-struct-fields name fields)))
#+lispworks
@@
-101,13
+108,15
@@
of the enum-name name, separator-string, and field-name"
(defmacro get-slot-value (obj type slot)
(defmacro get-slot-value (obj type slot)
- #+(or lispworks cmu) (declare (ignore type))
+ #+(or lispworks cmu
sbcl scl
) (declare (ignore type))
#+allegro
`(ff:fslot-value-typed ,type :c ,obj ,slot)
#+lispworks
`(fli:foreign-slot-value ,obj ,slot)
#+allegro
`(ff:fslot-value-typed ,type :c ,obj ,slot)
#+lispworks
`(fli:foreign-slot-value ,obj ,slot)
- #+
cmu
+ #+
(or cmu scl)
`(alien:slot ,obj ,slot)
`(alien:slot ,obj ,slot)
+ #+sbcl
+ `(sb-alien:slot ,obj ,slot)
#+mcl
`(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
)
#+mcl
`(ccl:pref ,obj ,(read-from-string (format nil ":~a.~a" (keyword type) (keyword slot))))
)
@@
-121,13
+130,15
@@
of the enum-name name, separator-string, and field-name"
(defmacro get-slot-pointer (obj type slot)
(defmacro get-slot-pointer (obj type slot)
- #+(or lispworks cmu) (declare (ignore type))
+ #+(or lispworks cmu
sbcl scl
) (declare (ignore type))
#+allegro
`(ff:fslot-value-typed ,type :c ,obj ,slot)
#+lispworks
`(fli:foreign-slot-pointer ,obj ,slot)
#+allegro
`(ff:fslot-value-typed ,type :c ,obj ,slot)
#+lispworks
`(fli:foreign-slot-pointer ,obj ,slot)
- #+
cmu
+ #+
(or cmu scl)
`(alien:slot ,obj ,slot)
`(alien:slot ,obj ,slot)
+ #+sbcl
+ `(sb-alien:slot ,obj ,slot)
#+(and mcl (not openmcl))
`(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot))))
#+openmcl
#+(and mcl (not openmcl))
`(ccl:%int-to-ptr (+ (ccl:%ptr-to-int ,obj) (the fixnum (ccl:field-info ,type ,slot))))
#+openmcl
@@
-148,8
+159,9
@@
of the enum-name name, separator-string, and field-name"
(defmacro deref-array (obj type i)
"Returns a field from a row"
(defmacro deref-array (obj type i)
"Returns a field from a row"
- #+(or lispworks cmu) (declare (ignore type))
- #+cmu `(alien:deref ,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)
#+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
#+mcl
#+lispworks `(fli:dereference ,obj :index ,i)
#+allegro `(ff:fslot-value-typed (quote ,(convert-from-uffi-type type :type)) :c ,obj ,i)
#+mcl
@@
-181,8
+193,10
@@
of the enum-name name, separator-string, and field-name"
`(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields)))
#+lispworks
`(fli:define-c-union ,name ,@(process-struct-fields name fields))
`(ff:def-foreign-type ,name (:union ,@(process-struct-fields name fields)))
#+lispworks
`(fli:define-c-union ,name ,@(process-struct-fields name fields))
- #+
cmu
+ #+
(or cmu scl)
`(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
`(alien:def-alien-type ,name (alien:union ,name ,@(process-struct-fields name fields)))
+ #+sbcl
+ `(sb-alien:define-alien-type ,name (sb-alien:union ,name ,@(process-struct-fields name fields)))
#+(and mcl (not openmcl))
`(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
#+openmcl
#+(and mcl (not openmcl))
`(ccl:defrecord ,name (:variant ,@(process-struct-fields name fields t)))
#+openmcl