[movitz-cvs] CVS movitz/losp/muerte

[ffjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory clnet:/tmp/cvs-serv8362

Modified Files:
	symbols.lisp 
Log Message:
Fix buggy copy-symbol.


--- /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp	2007/04/07 08:02:35	1.29
+++ /project/movitz/cvsroot/movitz/losp/muerte/symbols.lisp	2008/04/09 18:02:31	1.30
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Sep  4 23:55:41 2001
 ;;;;                
-;;;; $Id: symbols.lisp,v 1.29 2007/04/07 08:02:35 ffjeld Exp $
+;;;; $Id: symbols.lisp,v 1.30 2008/04/09 18:02:31 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -139,10 +139,10 @@
 	   (load-global-constant movitz::unbound-function))))
 
 (defun %create-symbol (name &optional (package nil)
-				      (plist nil)
-				      (value (load-global-constant new-unbound-value))
-				      (function (load-global-constant movitz::unbound-function))
-				      (flags 0))
+		       (value (load-global-constant new-unbound-value))
+		       (flags 0)
+		       (plist nil)
+		       (function (load-global-constant movitz::unbound-function)))
   (eval-when (:compile-toplevel)
     (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other)))))
   (let ((sxhash (sxhash name)))
@@ -179,31 +179,29 @@
   "copy-symbol returns a fresh, uninterned symbol, the name of which
   is string= to and possibly the same as the name of the given
   symbol."
-  (if (or (eq nil symbol)
-	  (not copy-properties))
-      (%create-symbol (symbol-name symbol))
-    (with-non-header-allocation-assembly
-	(6 :object-register :eax :fixed-size-p t)
-      (:addl 1 :eax)
-      (:load-lexical (:lexical-binding symbol) :ebx)
-      ;; 0
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 0) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 0))
-      ;; 1
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 4) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 4))
-      ;; 2
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 8) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 8))
-      ;; 3
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 12) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 12))
-      ;; 4
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 16) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 16))
-      ;; 5
-      (:movl (:ebx #.(cl:- (movitz:tag :symbol)) 20) :ecx)
-      (:movl :ecx (:eax #.(cl:- (movitz:tag :symbol)) 20)))))
+  (cond
+    ((not copy-properties)
+     (%create-symbol (symbol-name symbol)))
+    ((eq symbol nil)
+     (%create-symbol (symbol-name symbol)
+		     nil
+		     nil
+		     (symbol-flags nil)))
+    (t (with-non-header-allocation-assembly
+	   (6 :object-register :eax :fixed-size-p t)
+	 (:addl 1 :eax)
+	 (:load-lexical (:lexical-binding symbol) :ebx)
+	 (:movl (:ebx (:offset movitz-symbol function-value)) :ecx)
+	 (:movl :ecx (:eax (:offset movitz-symbol function-value) 0))
+	 (:movl (:ebx (:offset movitz-symbol value)) :ecx)
+	 (:movl :ecx (:eax (:offset movitz-symbol value)))
+	 (:movl (:ebx (:offset movitz-symbol plist)) :ecx)
+	 (:movl :ecx (:eax (:offset movitz-symbol plist)))
+	 (:movl (:ebx (:offset movitz-symbol name)) :ecx)
+	 (:movl :ecx (:eax (:offset movitz-symbol name)))
+	 (:movl :edi (:eax (:offset movitz-symbol package))) ; no package
+	 (:movl (:ebx (:offset movitz-symbol flags)) :ecx)
+	 (:movl :ecx (:eax (:offset movitz-symbol flags)))))))
 
 (defun symbol-flags (symbol)
   (etypecase symbol