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

[Frode Vatvedt Fjeld]

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

Modified Files:
	symbols.lisp 
Log Message:
Re-named create-symbol to %create-symbol, and avoided it checking the
name being a string (useful during GC migration).

Date: Sun Mar 28 20:57:48 2004
Author: ffjeld

Index: movitz/losp/muerte/symbols.lisp
diff -u movitz/losp/muerte/symbols.lisp:1.5 movitz/losp/muerte/symbols.lisp:1.6
--- movitz/losp/muerte/symbols.lisp:1.5	Sun Mar 28 12:33:46 2004
+++ movitz/losp/muerte/symbols.lisp	Sun Mar 28 20:57:48 2004
@@ -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.5 2004/03/28 17:33:46 ffjeld Exp $
+;;;; $Id: symbols.lisp,v 1.6 2004/03/29 01:57:48 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -137,7 +137,7 @@
      (not (eq (movitz-accessor symbol movitz-symbol function-value)
 	      (load-global-constant movitz::unbound-function))))))
 
-(defun create-symbol (name &optional (package nil)
+(defun %create-symbol (name &optional (package nil)
 				     (plist nil)
 				     (value (load-global-constant unbound-value))
 				     (function (load-global-constant movitz::unbound-function))
@@ -146,16 +146,17 @@
     (assert (= 1 (- (movitz:tag :symbol) (movitz:tag :other)))))
   (let ((symbol (%word-offset (malloc-clumps 3) 1)))
     (setf-movitz-accessor (symbol movitz-symbol package) package)
+    (setf-movitz-accessor (symbol movitz-symbol name) name)
     (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name))
     (setf (symbol-flags symbol) flags
 	  (symbol-plist symbol) plist
 	  (symbol-function symbol) function
-	  (symbol-name symbol) name
 	  (symbol-value symbol) value)
     symbol))
 
 (defun make-symbol (name)
-  (create-symbol name))
+  (check-type name string "a symbol name")
+  (%create-symbol name))
 
 (defun copy-symbol (symbol &optional copy-properties) 
   "copy-symbol returns a fresh, uninterned symbol, the name of which
@@ -163,13 +164,13 @@
   symbol."
   (if (or (eq nil symbol)
 	  (not copy-properties))
-      (create-symbol (symbol-name symbol))
-    (create-symbol (symbol-name symbol)
-		   nil
-		   (symbol-plist symbol)
-		   (%unbounded-symbol-value symbol)
-		   (%unbounded-symbol-function symbol)
-		   (symbol-flags symbol))))
+      (%create-symbol (symbol-name symbol))
+    (%create-symbol (symbol-name symbol)
+		    nil
+		    (symbol-plist symbol)
+		    (%unbounded-symbol-value symbol)
+		    (%unbounded-symbol-function symbol)
+		    (symbol-flags symbol))))
 
 (defun symbol-flags (symbol)
   (etypecase symbol