From 5bb2f28fd07a4d9b7fd88c774186e612517e5ebb Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Tue, 25 Sep 2012 14:16:16 +0300 Subject: [PATCH] bind and clear *CONTINUATION-NUMBERS* &co in WITH-COMPILATION-VALUES This leaves CLEAR-STUFF empty, so delete it. \o/ --- src/compiler/debug.lisp | 10 ++----- src/compiler/main.lisp | 65 +++++++++++++++-------------------------- src/compiler/target-main.lisp | 1 - 3 files changed, 27 insertions(+), 49 deletions(-) diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index 9c39cfd..6707533 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -877,15 +877,11 @@ ;;; ;;; FIXME: ;;; * Perhaps this machinery should be #!+SB-SHOW. -;;; * Probably the hash tables should either be weak hash tables, -;;; or only allocated within a single compilation unit. Otherwise -;;; there will be a tendency for them to grow without bound and -;;; keep garbage from being collected. (macrolet ((def (counter vto vfrom fto ffrom) `(progn (declaim (type hash-table ,vto ,vfrom)) - (defvar ,vto (make-hash-table :test 'eq)) - (defvar ,vfrom (make-hash-table :test 'eql)) + (defvar ,vto) + (defvar ,vfrom) (declaim (type fixnum ,counter)) (defvar ,counter 0) @@ -900,7 +896,7 @@ (def *continuation-number* *continuation-numbers* *number-continuations* cont-num num-cont) (def *tn-id* *tn-ids* *id-tns* tn-id id-tn) - (def *label-id* *id-labels* *label-ids* label-id id-label)) + (def *label-id* *label-ids* *id-labels* label-id id-label)) ;;; Print a terse one-line description of LEAF. (defun print-leaf (leaf &optional (stream *standard-output*)) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 77b3536..ece2cc8 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -372,12 +372,28 @@ Examples: ;;; WARNINGS-P and FAILURE-P are as in CL:COMPILE or CL:COMPILE-FILE. ;;; This also wraps up WITH-IR1-NAMESPACE functionality. (defmacro with-compilation-values (&body body) - `(with-ir1-namespace - (let ((*warnings-p* nil) - (*failure-p* nil)) - (values (progn ,@body) - *warnings-p* - *failure-p*)))) + `(let ((*continuation-number* 0) + (*continuation-numbers* (make-hash-table :test 'eq)) + (*number-continuations* (make-hash-table :test 'eql)) + (*tn-id* 0) + (*tn-ids* (make-hash-table :test 'eq)) + (*id-tns* (make-hash-table :test 'eql)) + (*label-id* 0) + (*label-ids* (make-hash-table :test 'eq)) + (*id-labels* (make-hash-table :test 'eql))) + (unwind-protect + (with-ir1-namespace + (let ((*warnings-p* nil) + (*failure-p* nil)) + (values (progn ,@body) + *warnings-p* + *failure-p*))) + (clrhash *tn-ids*) + (clrhash *id-tns*) + (clrhash *continuation-numbers*) + (clrhash *number-continuations*) + (clrhash *label-ids*) + (clrhash *id-labels*)))) ;;;; component compilation @@ -735,36 +751,6 @@ Examples: (blast *free-funs*) (blast *constants*)) (values)) - -;;; Clear global variables used by the compiler. -;;; -;;; FIXME: It seems kinda nasty and unmaintainable to have to do this, -;;; and it adds overhead even when people aren't using the compiler. -;;; Perhaps we could make these global vars unbound except when -;;; actually in use, so that this function could go away. -(defun clear-stuff (&optional (debug-too t)) - - (when debug-too - (clrhash *continuation-numbers*) - (clrhash *number-continuations*) - (setq *continuation-number* 0) - (clrhash *tn-ids*) - (clrhash *id-tns*) - (setq *tn-id* 0) - (clrhash *label-ids*) - (clrhash *id-labels*) - (setq *label-id* 0)) - - ;; (Note: The CMU CL code used to set CL::*GENSYM-COUNTER* to zero here. - ;; Superficially, this seemed harmful -- the user could reasonably be - ;; surprised if *GENSYM-COUNTER* turned back to zero when something was - ;; compiled. A closer inspection showed that this actually turned out to be - ;; harmless in practice, because CLEAR-STUFF was only called from within - ;; forms which bound CL::*GENSYM-COUNTER* to zero. However, this means that - ;; even though zeroing CL::*GENSYM-COUNTER* here turned out to be harmless in - ;; practice, it was also useless in practice. So we don't do it any more.) - - (values)) ;;;; trace output @@ -1233,8 +1219,7 @@ Examples: (when (core-object-p *compile-object*) (fix-core-source-info *source-info* *compile-object* result)) - (mapc #'clear-ir1-info components-from-dfo) - (clear-stuff))))))) + (mapc #'clear-ir1-info components-from-dfo))))))) (defun process-toplevel-cold-fset (name lambda-expression path) (unless (producing-fasl-file) @@ -1566,8 +1551,7 @@ Examples: (compile-load-time-value-lambda lambdas) (compile-toplevel-lambdas lambdas)) - (mapc #'clear-ir1-info components) - (clear-stuff))) + (mapc #'clear-ir1-info components))) (values)) ;;; Actually compile any stuff that has been queued up for block @@ -1663,7 +1647,6 @@ Examples: (with-compilation-values (sb!xc:with-compilation-unit () (with-world-lock () - (clear-stuff) (sub-sub-compile-file info) (unless (zerop (hash-table-count *code-coverage-records*)) ;; Dump the code coverage records into the fasl. diff --git a/src/compiler/target-main.lisp b/src/compiler/target-main.lisp index 4307d78..b621b02 100644 --- a/src/compiler/target-main.lisp +++ b/src/compiler/target-main.lisp @@ -95,7 +95,6 @@ (oops nil)) (with-world-lock () (handler-bind (((satisfies handle-condition-p) #'handle-condition-handler)) - (clear-stuff) (unless source-paths (find-source-paths form tlf)) (let ((*compiler-error-bailout* -- 1.7.10.4