If nothing else, long-lived rw hash tables are gencgc poison - but I did do some benchmarks and didn't see any notable regressions.... But I'm sure Martin will make noise if his build suffers. :)

Sent from my phone - apologies for substandard spelling and formatting.

On Oct 3, 2012 9:23 AM, "Nikodemus Siivola" <demoss@users.sourceforge.net> wrote:
The branch "master" has been updated in SBCL:
       via  746c4003dd76ea67647c87176e4c818f512d59b7 (commit)
      from  e49315bdf16727acef105d8632d9dcc2c4365395 (commit)

- Log -----------------------------------------------------------------
commit 746c4003dd76ea67647c87176e4c818f512d59b7
Author: Nikodemus Siivola <nikodemus@random-state.net>
Date:   Tue Sep 25 13:52:23 2012 +0300

    bind and clear *SEEN-FUNS* and *SEEN-BLOCKS* in CHECK-IR1-CONSISTENCY
---
 src/compiler/debug.lisp |  139 ++++++++++++++++++++++++-----------------------
 src/compiler/main.lisp  |    4 +-
 2 files changed, 71 insertions(+), 72 deletions(-)

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 2997e90..d38b355 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -56,8 +56,8 @@
 ;;; reached by recursing on top level functions.
 ;;; FIXME: Is it really only LAMBDAs, not e.g. FUNCTIONALs? Then
 ;;; shouldn't it be *SEEN-LAMBDAS*?
-(defvar *seen-blocks* (make-hash-table :test 'eq))
-(defvar *seen-funs* (make-hash-table :test 'eq))
+(defvar *seen-blocks*)
+(defvar *seen-funs*)

 ;;; Barf if NODE is in a block which wasn't reached during the graph
 ;;; walk.
@@ -79,78 +79,79 @@
 ;;; hashtables, looking for lossage.
 (declaim (ftype (function (list) (values)) check-ir1-consistency))
 (defun check-ir1-consistency (components)
-  (clrhash *seen-blocks*)
-  (clrhash *seen-funs*)
-  (dolist (c components)
-    (let* ((head (component-head c))
-           (tail (component-tail c)))
-      (unless (and (null (block-pred head))
-                   (null (block-succ tail)))
-        (barf "~S is malformed." c))
+  (let ((*seen-blocks* (make-hash-table :test 'eq))
+        (*seen-funs* (make-hash-table :test 'eq)))
+    (unwind-protect
+         (progn
+           (dolist (c components)
+             (let* ((head (component-head c))
+                    (tail (component-tail c)))
+               (unless (and (null (block-pred head))
+                            (null (block-succ tail)))
+                 (barf "~S is malformed." c))

-      (do ((prev nil block)
-           (block head (block-next block)))
-          ((null block)
-           (unless (eq prev tail)
-             (barf "wrong TAIL for DFO, ~S in ~S" prev c)))
-        (setf (gethash block *seen-blocks*) t)
-        (unless (eq (block-prev block) prev)
-          (barf "bad PREV for ~S, should be ~S" block prev))
-        (unless (or (eq block tail)
-                    (eq (block-component block) c))
-          (barf "~S is not in ~S." block c)))
-#|
-      (when (or (loop-blocks c) (loop-inferiors c))
-        (do-blocks (block c :both)
-          (setf (block-flag block) nil))
-        (check-loop-consistency c nil)
-        (do-blocks (block c :both)
-          (unless (block-flag block)
-            (barf "~S was not in any loop." block))))
-|#
-    ))
+               (do ((prev nil block)
+                    (block head (block-next block)))
+                   ((null block)
+                    (unless (eq prev tail)
+                      (barf "wrong TAIL for DFO, ~S in ~S" prev c)))
+                 (setf (gethash block *seen-blocks*) t)
+                 (unless (eq (block-prev block) prev)
+                   (barf "bad PREV for ~S, should be ~S" block prev))
+                 (unless (or (eq block tail)
+                             (eq (block-component block) c))
+                   (barf "~S is not in ~S." block c)))
+               #|
+               (when (or (loop-blocks c) (loop-inferiors c))
+               (do-blocks (block c :both)
+               (setf (block-flag block) nil))
+               (check-loop-consistency c nil)
+               (do-blocks (block c :both)
+               (unless (block-flag block)
+               (barf "~S was not in any loop." block))))
+               |#
+               ))
+           (check-fun-consistency components)

-  (check-fun-consistency components)
+           (dolist (c components)
+             (do ((block (block-next (component-head c)) (block-next block)))
+                 ((null (block-next block)))
+               (check-block-consistency block)))

-  (dolist (c components)
-    (do ((block (block-next (component-head c)) (block-next block)))
-        ((null (block-next block)))
-      (check-block-consistency block)))
+           (maphash (lambda (k v)
+                      (declare (ignore k))
+                      (unless (or (constant-p v)
+                                  (and (global-var-p v)
+                                       (member (global-var-kind v)
+                                               '(:global :special :unknown))))
+                        (barf "strange *FREE-VARS* entry: ~S" v))
+                      (dolist (n (leaf-refs v))
+                        (check-node-reached n))
+                      (when (basic-var-p v)
+                        (dolist (n (basic-var-sets v))
+                          (check-node-reached n))))
+                    *free-vars*)

-  (maphash (lambda (k v)
-             (declare (ignore k))
-             (unless (or (constant-p v)
-                         (and (global-var-p v)
-                              (member (global-var-kind v)
-                                      '(:global :special :unknown))))
-               (barf "strange *FREE-VARS* entry: ~S" v))
-             (dolist (n (leaf-refs v))
-               (check-node-reached n))
-             (when (basic-var-p v)
-               (dolist (n (basic-var-sets v))
-                 (check-node-reached n))))
-           *free-vars*)
+           (maphash (lambda (k v)
+                      (declare (ignore k))
+                      (unless (constant-p v)
+                        (barf "strange *CONSTANTS* entry: ~S" v))
+                      (dolist (n (leaf-refs v))
+                        (check-node-reached n)))
+                    *constants*)

-  (maphash (lambda (k v)
-             (declare (ignore k))
-             (unless (constant-p v)
-               (barf "strange *CONSTANTS* entry: ~S" v))
-             (dolist (n (leaf-refs v))
-               (check-node-reached n)))
-           *constants*)
-
-  (maphash (lambda (k v)
-             (declare (ignore k))
-             (unless (or (functional-p v)
-                         (and (global-var-p v)
-                              (eq (global-var-kind v) :global-function)))
-               (barf "strange *FREE-FUNS* entry: ~S" v))
-             (dolist (n (leaf-refs v))
-               (check-node-reached n)))
-           *free-funs*)
-  (clrhash *seen-funs*)
-  (clrhash *seen-blocks*)
-  (values))
+           (maphash (lambda (k v)
+                      (declare (ignore k))
+                      (unless (or (functional-p v)
+                                  (and (global-var-p v)
+                                       (eq (global-var-kind v) :global-function)))
+                        (barf "strange *FREE-FUNS* entry: ~S" v))
+                      (dolist (n (leaf-refs v))
+                        (check-node-reached n)))
+                    *free-funs*))
+      (clrhash *seen-blocks*)
+      (clrhash *seen-funs*))
+    (values)))

 ;;;; function consistency checking

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 4190d37..9dbe9bc 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -17,7 +17,7 @@
 (declaim (special *constants* *free-vars* *component-being-compiled*
                   *code-vector* *next-location* *result-fixups*
                   *free-funs* *source-paths*
-                  *seen-blocks* *seen-funs* *list-conflicts-table*
+                  *list-conflicts-table*
                   *continuation-number* *continuation-numbers*
                   *number-continuations* *tn-id* *tn-ids* *id-tns*
                   *label-ids* *label-id* *id-labels*
@@ -746,8 +746,6 @@ Examples:
 (defun clear-stuff (&optional (debug-too t))

   ;; Clear debug counters and tables.
-  (clrhash *seen-blocks*)
-  (clrhash *seen-funs*)
   (clrhash *list-conflicts-table*)

   (when debug-too

-----------------------------------------------------------------------


hooks/post-receive
--
SBCL

------------------------------------------------------------------------------
Don't let slow site performance ruin your business. Deploy New Relic APM
Deploy New Relic app performance management and know exactly
what is happening inside your Ruby, Python, PHP, Java, and .NET app
Try New Relic at no cost today and get our sweet Data Nerd shirt too!
http://p.sf.net/sfu/newrelic-dev2dev
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits