[movitz-cvs] CVS update: movitz/losp/muerte/arrays.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv16781

Modified Files:
	arrays.lisp 
Log Message:
Rename copy-vector to shallow-copy-vector, and have it understand
indirect-vectors. Should fix a GC issue.

Date: Sat Jun 11 02:01:56 2005
Author: ffjeld

Index: movitz/losp/muerte/arrays.lisp
diff -u movitz/losp/muerte/arrays.lisp:1.52 movitz/losp/muerte/arrays.lisp:1.53
--- movitz/losp/muerte/arrays.lisp:1.52	Sat Jun 11 01:08:16 2005
+++ movitz/losp/muerte/arrays.lisp	Sat Jun 11 02:01:56 2005
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Sun Feb 11 23:14:04 2001
 ;;;;                
-;;;; $Id: arrays.lisp,v 1.52 2005/06/10 23:08:16 ffjeld Exp $
+;;;; $Id: arrays.lisp,v 1.53 2005/06/11 00:01:56 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -176,23 +176,25 @@
        "Vector has no fill-pointer.")
      (%basic-vector-fill-pointer vector))))
 
-(defun copy-vector (vector)
-  (check-type vector vector)
+(defun shallow-copy-vector (vector)
+  (check-type vector (simple-array * 1))
   (let ((length (the fixnum
 		  (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'num-elements)))))
-    (ecase (vector-element-type-code vector)
-      (#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)
-	 (%shallow-copy-object vector (+ 2 length)))
-      (#.(bt:enum-value 'movitz::movitz-vector-element-type :u32)
-	 (%shallow-copy-non-pointer-object vector (+ 2 length)))
+    (ecase (memref vector (movitz-type-slot-offset 'movitz-basic-vector 'element-type)
+		   :type :unsigned-byte8)
+      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :any-t)
+	#.(bt:enum-value 'movitz::movitz-vector-element-type :indirects))
+       (%shallow-copy-object vector (+ 2 length)))
+      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u32))
+       (%shallow-copy-non-pointer-object vector (+ 2 length)))
       ((#.(bt:enum-value 'movitz::movitz-vector-element-type :character)
 	#.(bt:enum-value 'movitz::movitz-vector-element-type :u8)
 	#.(bt:enum-value 'movitz::movitz-vector-element-type :code))
        (%shallow-copy-non-pointer-object vector	(+ 2 (truncate (+ 3 length) 4))))
-      (#.(bt:enum-value 'movitz::movitz-vector-element-type :u16)
-	 (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2))))
-      (#.(bt:enum-value 'movitz::movitz-vector-element-type :bit)
-	 (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 31 length) 32)))))))
+      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :u16))
+       (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 1 length) 2))))
+      ((#.(bt:enum-value 'movitz::movitz-vector-element-type :bit))
+       (%shallow-copy-non-pointer-object vector (+ 2 (truncate (+ 31 length) 32)))))))
 
 (defun (setf fill-pointer) (new-fill-pointer vector)
   (etypecase vector