X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fprimitives.lisp;h=81110254a4596e94a3c9c7a0f06c88ce422d063f;hb=6ab554f2441048c9c726104d4f3c6a6acccaf383;hp=5522f5a73e55e79f4baea4a7d0e844d46357d53b;hpb=13635ed2b774e454b90823e085d84aa968da9eb4;p=uffi.git

diff --git a/src/primitives.lisp b/src/primitives.lisp
index 5522f5a..8111025 100644
--- a/src/primitives.lisp
+++ b/src/primitives.lisp
@@ -9,19 +9,16 @@
 ;;;;
 ;;;; $Id$
 ;;;;
-;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg
 ;;;;
-;;;; UFFI users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 (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)
@@ -39,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)))
 
@@ -53,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
@@ -71,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))  
@@ -97,8 +94,10 @@ supports takes advantage of this optimization."
       (:unsigned-short . (alien:unsigned 16))
       (:int . (alien:signed 32))
       (:unsigned-int . (alien:unsigned 32))
-      (:long . (alien:signed 32))
-      (:unsigned-long . (alien:unsigned 32))
+      #-x86-64 (:long . (alien:signed 32))
+      #-x86-64 (:unsigned-long . (alien:unsigned 32))
+      #+x86-64 (:long . (alien:signed 64))
+      #+x86-64 (:unsigned-long . (alien:unsigned 64))
       (:float . alien:single-float)
       (:double . alien:double-float)
       (:void . t)
@@ -195,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)
@@ -235,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"
@@ -256,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)))
@@ -265,16 +264,20 @@ 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)
 	 )
-	(t
-	 (cons (%convert-from-uffi-type (first type) context) 
-	       (%convert-from-uffi-type (rest type) context)))))))
+       (: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) 
+	      (%convert-from-uffi-type (rest type) context)))))))
 
 (defun convert-from-uffi-type (type context)
   (let ((result (%convert-from-uffi-type type context)))
@@ -285,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))))