r10917: 2006-04-17 Kevin Rosenberg (kevin@rosenberg.net)

[uffi.git] / src / primitives.lisp

diff --git a/src/primitives.lisp b/src/primitives.lisp
index 6eafe7ffcd68a83b1c48641802f36fbc8bab0e33..81110254a4596e94a3c9c7a0f06c88ce422d063f 100644 (file)
--- a/src/primitives.lisp
+++ b/src/primitives.lisp
@@ -15,10 +15,10 @@
 
 (in-package #:uffi)
 
-#+mcl
+#+(or openmcl digitool)
 (defvar *keyword-package* (find-package "KEYWORD"))
 
-#+mcl
+#+(or openmcl digitool)
 ; MCL and OpenMCL expect a lot of FFI elements to be keywords (e.g. struct field names in OpenMCL)
 ; So this provides a function to convert any quoted symbols to keywords.
 (defun keyword (obj)
@@ -36,7 +36,7 @@
          obj)))
 
 ; Wrapper for unexported function we have to use
-#+(and mcl (not openmcl))
+#+digitool
 (defmacro def-mcl-type (name type)
   `(ccl::def-mactype ,(keyword name) (ccl:find-mactype ,type)))
 
@@ -50,8 +50,8 @@
 (defmacro def-type (name type)
   "Generates a (deftype) statement for CL. Currently, only CMUCL
 supports takes advantage of this optimization."
-  #+(or lispworks allegro mcl cormanlisp)  (declare (ignore type))
-  #+(or lispworks allegro mcl cormanlisp) `(deftype ,name () t)
+  #+(or lispworks allegro openmcl digitool cormanlisp)  (declare (ignore type))
+  #+(or lispworks allegro openmcl digitool cormanlisp) `(deftype ,name () t)
   #+(or cmu scl)
   `(deftype ,name () '(alien:alien ,(convert-from-uffi-type type :declare)))
   #+sbcl
@@ -68,11 +68,11 @@ supports takes advantage of this optimization."
   #+(or cmu scl) `(alien:def-alien-type ,name ,(convert-from-uffi-type type :type))
   #+sbcl `(sb-alien:define-alien-type ,name ,(convert-from-uffi-type type :type))
   #+cormanlisp `(ct:defctype ,name ,(convert-from-uffi-type type :type))
-  #+mcl
+  #+(or openmcl digitool)
   (let ((mcl-type (convert-from-uffi-type type :type)))
     (unless (or (keywordp mcl-type) (consp mcl-type))
       (setf mcl-type `(quote ,mcl-type)))
-    #+(and mcl (not openmcl))
+    #+digitool
     `(def-mcl-type ,(keyword name) ,mcl-type)
     #+openmcl
     `(ccl::def-foreign-type ,(keyword name) ,mcl-type))  
@@ -194,7 +194,7 @@ supports takes advantage of this optimization."
       (:float . :float) (:double . :double)
       (:array . :c-array)))
 
-#+(and mcl (not openmcl))
+#+digitool
 (setq *type-conversion-list*
      '((* . :pointer) (:void . :void)
        (:short . :short) (:unsigned-short . :unsigned-short)
@@ -234,8 +234,8 @@ supports takes advantage of this optimization."
   (let ((found-type (gethash type +type-conversion-hash+)))
     (if found-type
        found-type
-      #-mcl type
-      #+mcl (keyword type))))
+      #-(or openmcl digitool) type
+      #+(or openmcl digitool) (keyword type))))
 
 (defun %convert-from-uffi-type (type context)
   "Converts from a uffi type to an implementation specific type"
@@ -255,7 +255,7 @@ supports takes advantage of this optimization."
        ((and (eq context :return)
             (eq type :cstring))
        (basic-convert-from-uffi-type :cstring-returning))
-       #+(and mcl (not openmcl))
+       #+digitool
        ((and (eq type :void) (eq context :return)) nil)
        (t
        (basic-convert-from-uffi-type type)))
@@ -264,16 +264,16 @@ supports takes advantage of this optimization."
        (cl:quote
         (convert-from-uffi-type (cadr type) context))
        (:struct-pointer
-        #+mcl `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
-        #-mcl (%convert-from-uffi-type (list '* (cadr type)) :struct)
+        #+(or openmcl digitool) `(:* (:struct ,(%convert-from-uffi-type (cadr type) :struct)))
+        #-(or openmcl digitool) (%convert-from-uffi-type (list '* (cadr type)) :struct)
         )
        (:struct
-        #+mcl `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
-        #-mcl (%convert-from-uffi-type (cadr type) :struct)
+        #+(or openmcl digitool) `(:struct ,(%convert-from-uffi-type (cadr type) :struct))
+        #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :struct)
         )
        (:union
-       #+mcl `(:union ,(%convert-from-uffi-type (cadr type) :union))
-       #-mcl (%convert-from-uffi-type (cadr type) :union)
+       #+(or openmcl digitool) `(:union ,(%convert-from-uffi-type (cadr type) :union))
+       #-(or openmcl digitool) (%convert-from-uffi-type (cadr type) :union)
        )
        (t
        (cons (%convert-from-uffi-type (first type) context) 
@@ -288,7 +288,7 @@ supports takes advantage of this optimization."
       (if (eq context :struct)
          (append '(:*) (cdr result))
        :address))
-     #+(and mcl (not openmcl))
+     #+digitool
      ((and (eq (car result) :pointer) (eq context :allocation) :pointer))
      (t result))))