diff --git a/code/reader.lisp b/code/reader.lisp
index cab4a3446728c543599f1e1316f681655b7ab266..3d925c7544eb4b821e4f9a6a294c50389c691091 100644
--- a/code/reader.lisp
+++ b/code/reader.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.61 2006/06/30 18:41:22 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/reader.lisp,v 1.62 2007/06/22 21:45:25 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -563,12 +563,40 @@
 (defvar *ignore-extra-close-parentheses* t
   "If true, only warn when there is an extra close paren, otherwise error.")
 
-;; Alist for #=. Used to keep track of objects with labels assigned that have
-;; been completly read.  Entry is (integer-tag gensym-tag value).
-;;
-(defvar *sharp-equal-alist* ())
-
 (declaim (special *standard-input*))
+
+;;; The SHARP-EQUAL function introduces a label for an object, and the
+;;; SHARP-SHARP function allows us to refer to this label.  This is slightly
+;;; tricky because the object we are labelling can contain labels to itself in
+;;; order to create circular structures, e.g., #1=(cons 'hello #1#).
+;;;
+;;; The SHARP-EQUAL function is called when we are reading a stream and
+;;; encounter text of the form #<LABEL>=<OBJ>, where <LABEL> should be a number
+;;; and <OBJ> ought to be readable as an object.  Our first step is to use
+;;; gensym to create a new <TAG> for this label; we temporarily bind <LABEL> to
+;;; <TAG> and then read in <OBJ> using our <TAG> as a temporary binding for
+;;; <LABEL>.  Finally, we fix the <OBJ> by replacing any occurrences of <TAG>
+;;; with a pointer to <OBJ> itself, creating the circular structures.
+;;;
+;;; We now do this with a couple of data structures.
+;;;
+;;; 1.  *SHARP-EQUAL-FINAL-TABLE* is a hash table where "finished" associations
+;;;     are stored.  That is, it is a hash table from labels to objects, where
+;;;     the objects have already been patched and are tag-free.
+;;;
+;;; 2.  *SHARP-EQUAL-TEMP-TABLE* is a hash table where "unfinished"
+;;;     associations are stored.  That is, it is a hash table from labels to
+;;;     tags.
+;;;
+;;; 3.  *SHARP-EQUAL-REPL-TABLE* is a hash table that associates tags with
+;;;     their corrective pointers.  That is, this is the table we use to
+;;;     "patch" the objects.
+
+(defvar *sharp-equal-final-table*)
+(defvar *sharp-equal-temp-table*)
+(defvar *sharp-equal-repl-table*)
+
+
  
 ;;; READ-PRESERVING-WHITESPACE behaves just like read only it makes sure
 ;;; to leave terminating whitespace in the stream.
@@ -601,7 +629,9 @@
 					nil
 					(car result))))))))))
     (t
-     (let ((*sharp-equal-alist* nil))
+     (let ((*sharp-equal-final-table* nil)
+	   (*sharp-equal-temp-table* nil)
+	   (*sharp-equal-repl-table* nil))
        (read-preserving-whitespace-internal stream eof-errorp eof-value t)))))
 
 
diff --git a/code/sharpm.lisp b/code/sharpm.lisp
index f6098330b53dc1a352270d096299dce36ef33dfc..2d37b87a7d07741f24cae000717d577f0bb16879 100644
--- a/code/sharpm.lisp
+++ b/code/sharpm.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.26 2005/11/08 17:12:29 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sharpm.lisp,v 1.27 2007/06/22 21:45:25 rtoy Rel $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -243,11 +243,14 @@
 ;; substitutes in arrays and structures as well as lists.  The first arg is an
 ;; alist of the things to be replaced assoc'd with the things to replace them.
 ;;
-(defun circle-subst (old-new-alist tree)
+(defun circle-subst (repl-table tree)
   (cond ((not (typep tree '(or cons (array t) structure-object
 			    standard-object)))
-	 (let ((entry (find tree old-new-alist :key #'second)))
-	   (if entry (third entry) tree)))
+	 (multiple-value-bind (value presentp)
+	     (gethash tree repl-table)
+	   (if presentp
+	       value
+	       tree)))
 	((null (gethash tree *sharp-equal-circle-table*))
 	 (setf (gethash tree *sharp-equal-circle-table*) t)
 	 (cond ((typep tree '(or structure-object standard-object))
@@ -255,7 +258,7 @@
 		     (end (%instance-length tree)))
 		    ((= i end))
 		  (let* ((old (%instance-ref tree i))
-			 (new (circle-subst old-new-alist old)))
+			 (new (circle-subst repl-table old)))
 		    (unless (eq old new)
 		      (setf (%instance-ref tree i) new)))))
 	       ((arrayp tree)
@@ -264,12 +267,12 @@
 		  (do ((i start (1+ i)))
 		      ((>= i end))
 		    (let* ((old (aref data i))
-			   (new (circle-subst old-new-alist old)))
+			   (new (circle-subst repl-table old)))
 		      (unless (eq old new)
 			(setf (aref data i) new))))))
 	       (t
-		(let ((a (circle-subst old-new-alist (car tree)))
-		      (d (circle-subst old-new-alist (cdr tree))))
+		(let ((a (circle-subst repl-table (car tree)))
+		      (d (circle-subst repl-table (cdr tree))))
 		  (unless (eq a (car tree))
 		    (rplaca tree a))
 		  (unless (eq d (cdr tree))
@@ -277,6 +280,17 @@
 	 tree)
 	(t tree)))
 
+(defun maybe-create-tables ()
+  (unless *sharp-equal-final-table*
+    (setf *sharp-equal-final-table*
+	  (make-hash-table :size 40 :rehash-size 4000 :rehash-threshold 0.8 :test 'eql)))
+  (unless *sharp-equal-temp-table*
+    (setf *sharp-equal-temp-table*
+	  (make-hash-table :size 40 :rehash-size 4000 :rehash-threshold 0.8 :test 'eql)))
+  (unless *sharp-equal-repl-table*
+    (setf *sharp-equal-repl-table*
+	  (make-hash-table :size 40 :rehash-size 4000 :rehash-threshold 0.8 :test 'eq))))
+
 ;;; Sharp-equal works as follows.  When a label is assigned (ie when #= is
 ;;; called) we GENSYM a symbol is which is used as an unforgeable tag.
 ;;; *SHARP-SHARP-ALIST* maps the integer tag to this gensym.
@@ -291,25 +305,27 @@
 ;;; for each entry in the *SHARP-SHARP-ALIST, the current object is searched
 ;;; and any uses of the gensysm token are replaced with the actual value.
 ;;;
-(defvar *sharp-sharp-alist* ())
+
 ;;;
 (defun sharp-equal (stream ignore label)
   (declare (ignore ignore))
   (when *read-suppress* (return-from sharp-equal (values)))
   (unless label
     (%reader-error stream "Missing label for #=." label))
-  (when (or (assoc label *sharp-sharp-alist*)
-	    (assoc label *sharp-equal-alist*))
+  (maybe-create-tables)
+  (when (or (nth-value 1 (gethash label *sharp-equal-final-table*))
+	    (nth-value 1 (gethash label *sharp-equal-temp-table*)))
     (%reader-error stream "Multiply defined label: #~D=" label))
-  (let* ((tag (gensym))
-	 (*sharp-sharp-alist* (acons label tag *sharp-sharp-alist*))
-	 (obj (read stream t nil t)))
-    (when (eq obj tag)
-      (%reader-error stream "Have to tag something more than just #~D#."
-		     label))
-    (push (list label tag obj) *sharp-equal-alist*)
-    (let ((*sharp-equal-circle-table* (make-hash-table :test #'eq :size 20)))
-      (circle-subst *sharp-equal-alist* obj))))
+  (let* ((tag (gensym)))
+    (setf (gethash label *sharp-equal-temp-table*) tag)
+    (let ((obj (read stream t nil t)))
+      (when (eq obj tag)
+	(%reader-error stream "Have to tag something more than just #~D#."
+		       label))
+      (setf (gethash tag *sharp-equal-repl-table*) obj)
+      (let ((*sharp-equal-circle-table* (make-hash-table :test #'eq :size 20)))
+	(circle-subst *sharp-equal-repl-table* obj))
+      (setf (gethash label *sharp-equal-final-table*) obj))))
 ;;;
 (defun sharp-sharp (stream ignore label)
   (declare (ignore ignore))
@@ -317,14 +333,19 @@
   (unless label
     (%reader-error stream "Missing label for ##." label))
 
-  (let ((entry (assoc label *sharp-equal-alist*)))
-    (if entry
-	(third entry)
-	(let ((pair (assoc label *sharp-sharp-alist*)))
-	  (unless pair
-	    (%reader-error stream "Object is not labelled #~S#" label))
-	  (cdr pair)))))
-
+  (maybe-create-tables)
+  ;; Don't read ANSI "2.4.8.15 Sharpsign Equal-Sign" and worry that it requires
+  ;; you to implement forward references, because forward references are
+  ;; disallowed in "2.4.8.16 Sharpsign Sharpsign".
+  (multiple-value-bind (finalized-object successp)
+      (gethash label *sharp-equal-final-table*)
+    (if successp
+	finalized-object
+	(multiple-value-bind (temporary-tag successp)
+	    (gethash label *sharp-equal-temp-table*)
+	  (if successp
+	      temporary-tag
+	      (%reader-error stream "reference to undefined label #~D#" label))))))
 
 ;;;; #+/-