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

[Frode Vatvedt Fjeld]

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

Modified Files:
	inspect.lisp 
Log Message:
shallow-copy had a bug wrt. vectors, because the elements were copied
by considering the original vector as a sequence, and therefore any
elements beyond the fill-pointer were not copied. Also, the new
copying strategy should be considerably faster.

Date: Fri Sep 24 11:33:16 2004
Author: ffjeld

Index: movitz/losp/muerte/inspect.lisp
diff -u movitz/losp/muerte/inspect.lisp:1.41 movitz/losp/muerte/inspect.lisp:1.42
--- movitz/losp/muerte/inspect.lisp:1.41	Thu Sep 23 11:32:15 2004
+++ movitz/losp/muerte/inspect.lisp	Fri Sep 24 11:33:16 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Fri Oct 24 09:50:41 2003
 ;;;;                
-;;;; $Id: inspect.lisp,v 1.41 2004/09/23 09:32:15 ffjeld Exp $
+;;;; $Id: inspect.lisp,v 1.42 2004/09/24 09:33:16 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -178,12 +178,24 @@
     (:cmpl :esi :edx)
     (:jne 'copy-loop)
     (:movl (:ebp -4) :esi)
-;;;    ;; Copy tag from EBX onto EAX
-;;;    (:movl :ebx :ecx)
-;;;    (:andl 7 :ecx)
-;;;    (:andl -8 :eax)
-;;;    (:orl :ecx :eax)
-    ;; Load word-count into ECX
+    (:movl :edx :ecx)))
+
+(defun %shallow-copy-non-pointer-object (object word-count)
+  "Copy any object with size word-count."
+  (check-type word-count (integer 2 *))
+  (with-non-pointer-allocation-assembly (word-count
+					 :object-register :eax
+					 :size-register :ecx)
+    (:load-lexical (:lexical-binding object) :ebx)
+    (:load-lexical (:lexical-binding word-count) :edx)
+    (:xorl :esi :esi)			; counter
+    copy-loop
+    (:movl (:ebx :esi #.movitz:+other-type-offset+) :ecx)
+    (:movl :ecx (:eax :esi #.movitz:+other-type-offset+))
+    (:addl 4 :esi)
+    (:cmpl :esi :edx)
+    (:jne 'copy-loop)
+    (:movl (:ebp -4) :esi)
     (:movl :edx :ecx)))
 
 (defun shallow-copy (old)
@@ -199,12 +211,7 @@
     (symbol
      (copy-symbol old t))
     (vector
-     (let ((new (make-array (array-dimension old 0)
-			    :element-type (array-element-type old)
-			    :initial-contents old)))
-       (when (array-has-fill-pointer-p old)
-	 (setf (fill-pointer new) (fill-pointer old)))
-       new))
+     (copy-vector old))
     (function
      (copy-funobj old))
     (structure-object