Update to the COPY-FUNCTION type method

diff --git a/gffi/basic-types.lisp b/gffi/basic-types.lisp
index 5231aaf9bb0747b32fc4b00ec91c8946fa9c275c..d7f6b3c96145a753c9bc7158fca4c4485c363ca2 100644 (file)
--- a/gffi/basic-types.lisp
+++ b/gffi/basic-types.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
 ;; 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.12 2008-04-11 18:51:57 espen Exp $
+;; $Id: basic-types.lisp,v 1.13 2008-10-08 16:27:09 espen Exp $

 
 (in-package "GFFI")
 
 
 (in-package "GFFI")
 


@@ -110,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
 :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.")
 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")
 
 (define-type-generic unbound-value (type-spec)
   "Returns a value which should be interpreted as unbound for slots with virtual allocation")


@@ -1136,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))
       (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
 
 
 ;;; Static


@@ -1186,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))
       (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)))))