From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Tue, 25 Sep 2012 11:01:31 +0000 (+0300)
Subject: bind and clear *LIST-CONFLICTS-TABLE* in LIST-CONFLICTS
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c4fcc5f12e17c67f4b591d2cc0586eb6b256ea04;p=sbcl.git

bind and clear *LIST-CONFLICTS-TABLE* in LIST-CONFLICTS
---

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index d38b355..9c39cfd 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -1198,7 +1198,6 @@
                (when k
                  (res k)))
              *list-conflicts-table*)
-    (clrhash *list-conflicts-table*)
     (res)))
 
 ;;; Return a list of a the TNs that conflict with TN. Sort of, kind
@@ -1207,24 +1206,26 @@
   (aver (member (tn-kind tn) '(:normal :environment :debug-environment)))
   (let ((confs (tn-global-conflicts tn)))
     (cond (confs
-           (clrhash *list-conflicts-table*)
-           (do ((conf confs (global-conflicts-next-tnwise conf)))
-               ((null conf))
-             (format t "~&#<block ~D kind ~S>~%"
-                     (block-number (ir2-block-block (global-conflicts-block
-                                                     conf)))
-                     (global-conflicts-kind conf))
-             (let ((block (global-conflicts-block conf)))
-               (add-always-live-tns block tn)
-               (if (eq (global-conflicts-kind conf) :live)
-                   (add-all-local-tns block)
-                   (let ((bconf (global-conflicts-conflicts conf))
-                         (ltns (ir2-block-local-tns block)))
-                     (dotimes (i (ir2-block-local-tn-count block))
-                       (when (/= (sbit bconf i) 0)
-                         (setf (gethash (svref ltns i) *list-conflicts-table*)
-                               t)))))))
-           (listify-conflicts-table))
+           (let ((*list-conflicts-table* (make-hash-table :test 'eq)))
+             (unwind-protect
+                  (do ((conf confs (global-conflicts-next-tnwise conf)))
+                      ((null conf)
+                       (listify-conflicts-table))
+                    (format t "~&#<block ~D kind ~S>~%"
+                            (block-number (ir2-block-block (global-conflicts-block
+                                                            conf)))
+                            (global-conflicts-kind conf))
+                    (let ((block (global-conflicts-block conf)))
+                      (add-always-live-tns block tn)
+                      (if (eq (global-conflicts-kind conf) :live)
+                          (add-all-local-tns block)
+                          (let ((bconf (global-conflicts-conflicts conf))
+                                (ltns (ir2-block-local-tns block)))
+                            (dotimes (i (ir2-block-local-tn-count block))
+                              (when (/= (sbit bconf i) 0)
+                                (setf (gethash (svref ltns i) *list-conflicts-table*)
+                                      t)))))))
+               (clrhash *list-conflicts-table*))))
           (t
            (let* ((block (tn-local tn))
                   (ltns (ir2-block-local-tns block))
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 9dbe9bc..77b3536 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -17,7 +17,6 @@
 (declaim (special *constants* *free-vars* *component-being-compiled*
                   *code-vector* *next-location* *result-fixups*
                   *free-funs* *source-paths*
-                  *list-conflicts-table*
                   *continuation-number* *continuation-numbers*
                   *number-continuations* *tn-id* *tn-ids* *id-tns*
                   *label-ids* *label-id* *id-labels*
@@ -745,9 +744,6 @@ Examples:
 ;;; actually in use, so that this function could go away.
 (defun clear-stuff (&optional (debug-too t))
 
-  ;; Clear debug counters and tables.
-  (clrhash *list-conflicts-table*)
-
   (when debug-too
     (clrhash *continuation-numbers*)
     (clrhash *number-continuations*)