X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.lisp;h=81110254a4596e94a3c9c7a0f06c88ce422d063f;hb=895cdddc64ad069c4d8173a21d0d5ce47b79e919;hp=6eafe7ffcd68a83b1c48641802f36fbc8bab0e33;hpb=3ade95bab16abe09642554e9cbf56f117f01e507;p=uffi.git

diff --git a/src/primitives.lisp b/src/primitives.lisp
index 6eafe7f..8111025 100644
--- 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))))