gffi/basic-types.lisp: clisp already defines a `byte' type'.

[clg] / gffi / basic-types.lisp

diff --git a/gffi/basic-types.lisp b/gffi/basic-types.lisp
index 14cf78a7fc3059aae0733c701b3e7916c242da14..056d6dd1591b4b41dcc07fc9e0e2f9c84c2d023d 100644 (file)
--- a/gffi/basic-types.lisp
+++ b/gffi/basic-types.lisp
@@ -20,12 +20,12 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: basic-types.lisp,v 1.10 2007-09-07 07:28:42 espen Exp $
+;; $Id: basic-types.lisp,v 1.13 2008-10-08 16:27:09 espen Exp $
 
 (in-package "GFFI")
 
 
-(deftype byte () '(unsigned-byte 8))
+#-clisp (deftype byte () '(unsigned-byte 8))
 (deftype int ()
   '(signed-byte #+sbcl #.(sb-sizeof-bits 'sb-alien:int)
                #+clisp #.(ffi:bitsizeof 'ffi:int)
@@ -93,6 +93,8 @@ (define-type-generic to-alien-function (type &optional copy-p)
   "Returns a function of one argument which will translate objects of the given type to alien repesentation. An optional function, taking the origional object and the alien representation as arguments, to clean up after the alien value is not needed any more may be returned as a second argument.")
 (define-type-generic from-alien-function (type &key ref)
   "Returns a function of one argument which will translate alien objects of the given type to lisp representation. REF should be :FREE, :COPY, :STATIC or :TEMP")
+(define-type-generic alien-typep-form (type alien)
+  "Returns a form evaluating to T if ALIEN is an alien representation of TYPE.")
 (define-type-generic callback-wrapper (type var arg form)
   "Creates a wrapper around FORM which binds the lisp translation of
 ARG to VAR during a C callback.")
@@ -108,11 +110,16 @@ (define-type-generic reader-function (type &key ref inlined)
 :PEEK or :GET")
 (define-type-generic destroy-function (type &key temp inlined)
   "Returns a function taking an address and optional offset which when
-called will destroy the reference at the given location. This may
+called will destroy the object at the given location. This may
 involve freeing the foreign object being referenced or decreasing it's
 ref. count. If TEMP is non NIL then the reference is expected to
 have been written as temporal.")
-(define-type-generic copy-function (type &key inlined))
+(define-type-generic copy-function (type &key inlined)
+  "Returns a function taking source/destination addresses and optional
+common offset, which will copy the object at the source location to
+the destination. If INLINED is non NIL, the object is assumed to be
+inlined at the source location and will be inlined at the
+destination.")
 
 (define-type-generic unbound-value (type-spec)
   "Returns a value which should be interpreted as unbound for slots with virtual allocation")
@@ -906,16 +913,16 @@ (define-type-method argument-type ((type or))
 
 (define-type-method size-of ((type or) &key (inlined nil inlined-p))
   (loop
-   for subtype in (type-expand-to 'or type)
+   for subtype in (cdr (type-expand-to 'or type))
    maximize (if inlined-p
-               (size-of subtype inlined)
+               (size-of subtype :inlined inlined)
              (size-of subtype))))
 
 (define-type-method type-alignment ((type or) &key (inlined nil inlined-p))
   (loop
-   for subtype in (type-expand-to 'or type)
+   for subtype in (cdr (type-expand-to 'or type))
    maximize (if inlined-p
-               (type-alignment subtype inlined)
+               (type-alignment subtype :inlined inlined)
              (type-alignment subtype))))
 
 (define-type-method alien-arg-wrapper ((type or) var value style form &optional copy-in-p)
@@ -959,6 +966,20 @@ (define-type-method to-alien-form ((type or) form &optional copy-p)
              `(,type ,(to-alien-form type 'value copy-p)))
          (rest (type-expand-to 'or type))))))
 
+(define-type-method from-alien-form ((type or) form &key ref)
+  (declare (ignore ref))
+  `(let ((alien ,form))
+     (cond
+      ,@(loop
+        for (type . rest) on (rest (type-expand-to 'or type)) 
+        collect
+        `(,(if (endp rest)
+               t
+             (alien-typep-form type 'alien))
+          ,(from-alien-form type 'alien))))))
+      
+
+
 (define-type-method to-alien-function ((type or) &optional copy-p)
   (let* ((expanded-type (type-expand-to 'or type))
         (functions (loop
@@ -1019,6 +1040,9 @@ (define-type-method reader-function ((type pointer) &key ref (inlined t))
   #'ref-pointer)
 
 
+
+;;; Null Pointer
+
 (define-type-method alien-type ((type null))
   (declare (ignore type))
   (alien-type 'pointer))
@@ -1027,6 +1051,14 @@ (define-type-method size-of ((type null) &key (inlined t))
   (assert-inlined type inlined)
   (size-of 'pointer))
 
+(define-type-method alien-typep-form ((type null) null)
+  (declare (ignore type)) 
+  `(null-pointer-p ,null))
+
+(define-type-method from-alien-form ((type null) null &key ref)
+  (declare (ignore type null ref))
+  nil)
+
 (define-type-method to-alien-form ((type null) null &optional copy-p)
   (declare (ignore type copy-p))
   `(progn ,null (make-pointer 0)))
@@ -1109,12 +1141,9 @@ (define-type-method destroy-function ((type copy-of) &key temp inlined)
       (declare (ignore location offset))))
 
 (define-type-method copy-function ((type copy-of) &key (inlined nil inlined-p))
-  (let ((size (if inlined-p 
-                 (size-of type :inlined inlined)
-               (size-of type))))
-    #'(lambda (from to &optional (offset 0))
-       (copy-memory (pointer+ from offset) size (pointer+ to offset)))))
-
+  (if inlined-p
+      (copy-function (second (type-expand-to 'copy-of type)) :inlined inlined)
+    (copy-function (second (type-expand-to 'copy-of type)))))
 
 
 ;;; Static
@@ -1159,11 +1188,9 @@ (define-type-method destroy-function ((type static) &key temp inlined)
       (declare (ignore location offset))))
 
 (define-type-method copy-function ((type static) &key (inlined nil inlined-p))
-  (let ((size (if inlined-p 
-                 (size-of type :inlined inlined)
-               (size-of type))))
-    #'(lambda (from to &optional (offset 0))
-       (copy-memory (pointer+ from offset) size (pointer+ to offset)))))
+  (if inlined-p
+      (copy-function (second (type-expand-to 'copy-of type)) :inlined inlined)
+    (copy-function (second (type-expand-to 'copy-of type)))))