Permalink
Browse files

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

  • Loading branch information...
1 parent 746c400 commit c4fcc5f12e17c67f4b591d2cc0586eb6b256ea04 @nikodemus nikodemus committed Sep 25, 2012
Showing with 20 additions and 23 deletions.
  1. +20 −19 src/compiler/debug.lisp
  2. +0 −4 src/compiler/main.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))
@@ -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*)

0 comments on commit c4fcc5f

Please sign in to comment.