X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/c14ae73fe96207365114c847cf5220ec41114cc2..19406f20ddb51fdcf94bf9a91c12c53717bad724:/gffi/vectors.lisp

diff --git a/gffi/vectors.lisp b/gffi/vectors.lisp
index ff16950..a671d1d 100644
--- a/gffi/vectors.lisp
+++ b/gffi/vectors.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.
 
-;; $Id: vectors.lisp,v 1.1 2006/04/25 20:40:57 espen Exp $
+;; $Id: vectors.lisp,v 1.3 2007/06/01 06:15:37 espen Exp $
 
 
 (in-package "GFFI")
@@ -110,6 +110,15 @@ (define-type-method size-of ((type vector) &key inlined)
 	  (* (size-of element-type) length)))
     (size-of 'pointer)))
 
+(define-type-method type-alignment ((type vector) &key inlined)
+  (if inlined
+      (destructuring-bind (element-type &optional (length '*)) 
+	  (rest (type-expand-to 'vector type))
+	(if (eq length '*)
+	    (error "Can't inline vector with variable size: ~A" type)
+	  (* (type-alignment element-type) length)))
+    (type-alignment 'pointer)))
+
 (define-type-method alien-arg-wrapper ((type vector) var vector style form &optional copy-in-p)
   (destructuring-bind (element-type &optional (length '*)) 
       (rest (type-expand-to 'vector type))
@@ -308,6 +317,10 @@ (define-type-method size-of ((type vector0) &key inlined)
   (assert-not-inlined type inlined)
   (size-of 'pointer))
 
+(define-type-method type-alignment ((type vector0) &key inlined)
+  (assert-not-inlined type inlined)
+  (type-alignment 'pointer))
+
 (define-type-method alien-arg-wrapper ((type vector0) var vector style form &optional copy-in-p)
   (destructuring-bind (element-type) (rest (type-expand-to 'vector0 type))
     (cond
@@ -398,9 +411,9 @@ (define-type-method copy-function ((type vector0) &key inlined)
 		     for element by element-size
 		     until (memory-clear-p from-vector element-size element)
 		     finally (return length)))
-		   (to-vector (setf 
-			       (ref-pointer to offset)		  
-			       (allocate-memory (* length element-size)))))
+		   (to-vector 
+		    (setf (ref-pointer to offset)		  
+		     (allocate-memory (* (1+ length) element-size)))))
 	      (loop
 	       repeat length
 	       for element by element-size
@@ -453,6 +466,10 @@ (define-type-method size-of ((type counted-vector) &key inlined)
   (assert-not-inlined type inlined)
   (size-of 'pointer))
 
+(define-type-method type-alignment ((type counted-vector) &key inlined)
+  (assert-not-inlined type inlined)
+  (type-alignment 'pointer))
+
 (define-type-method alien-arg-wrapper ((type counted-vector) var vector style form &optional copy-in-p)
   (destructuring-bind (element-type &optional (counter-type 'unsigned-int))
       (rest (type-expand-to 'counted-vector type))