From: Juho Snellman Date: Tue, 6 Feb 2007 05:06:37 +0000 (+0000) Subject: 1.0.2.13: Use an sset for LAMBDA-CALLS-OR-CLOSES X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=1840d888d2ef13fe0ea5aaa06f1fef3300da682b;p=sbcl.git 1.0.2.13: Use an sset for LAMBDA-CALLS-OR-CLOSES * Used to be an unsorted list (often long) and PUSHNEW / NUNION --- diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index 763d929..28c53e3 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -290,7 +290,7 @@ (declare (type entry entry)) (let ((entry-home (node-home-lambda entry))) (scavenge-possibly-deleted-lambda entry-home)))) - (dolist (cc (lambda-calls-or-closes clambda)) + (do-sset-elements (cc (lambda-calls-or-closes clambda)) (etypecase cc (clambda (scavenge-call cc)) (lambda-var (scavenge-closure-var cc)) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 3ec3798..978284f 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -129,6 +129,9 @@ (defvar *big-compiler-lock* (sb!thread:make-mutex :name "big compiler lock")) +(declaim (type fixnum *compiler-sset-counter*)) +(defvar *compiler-sset-counter* 0) + ;;; unique ID for the next object created (to let us track object ;;; identity even across GC, useful for understanding weird compiler ;;; bugs where something is supposed to be unique but is instead diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 72bcd18..a1437e1 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -126,7 +126,7 @@ extent of the block." (link-node-to-previous-ctran exit value-ctran) (let ((home-lambda (ctran-home-lambda-or-null start))) (when home-lambda - (push entry (lambda-calls-or-closes home-lambda)))) + (sset-adjoin entry (lambda-calls-or-closes home-lambda)))) (use-continuation exit exit-ctran (third found)))) ;;; Return a list of the segments of a TAGBODY. Each segment looks @@ -221,7 +221,7 @@ constrained to be used only within the dynamic extent of the TAGBODY." (link-node-to-previous-ctran exit start) (let ((home-lambda (ctran-home-lambda-or-null start))) (when home-lambda - (push entry (lambda-calls-or-closes home-lambda)))) + (sset-adjoin entry (lambda-calls-or-closes home-lambda)))) (use-ctran exit (second found)))) ;;;; translators for compiler-magic special forms @@ -869,7 +869,7 @@ other." (when (lambda-var-p leaf) (let ((home-lambda (ctran-home-lambda-or-null start))) (when home-lambda - (pushnew leaf (lambda-calls-or-closes home-lambda)))) + (sset-adjoin leaf (lambda-calls-or-closes home-lambda)))) (when (lambda-var-ignorep leaf) ;; ANSI's definition of "Declaration IGNORE, IGNORABLE" ;; requires that this be a STYLE-WARNING, not a full warning. diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index d876191..511142a 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -594,7 +594,7 @@ (when (lambda-var-p var) (let ((home (ctran-home-lambda-or-null start))) (when home - (pushnew var (lambda-calls-or-closes home)))) + (sset-adjoin var (lambda-calls-or-closes home)))) (when (lambda-var-ignorep var) ;; (ANSI's specification for the IGNORE declaration requires ;; that this be a STYLE-WARNING, not a full WARNING.) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index e2af18d..ee3b1e3 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -131,7 +131,7 @@ (dolist (arg (basic-combination-args call)) (when arg (flush-lvar-externally-checkable-type arg)))) - (pushnew fun (lambda-calls-or-closes (node-home-lambda call))) + (sset-adjoin fun (lambda-calls-or-closes (node-home-lambda call))) (recognize-dynamic-extent-lvars call fun) (merge-tail-sets call fun) (change-ref-leaf ref fun) @@ -496,7 +496,7 @@ (aver (= (optional-dispatch-min-args fun) 0)) (aver (not (functional-entry-fun fun))) (setf (basic-combination-kind call) :local) - (pushnew ep (lambda-calls-or-closes (node-home-lambda call))) + (sset-adjoin ep (lambda-calls-or-closes (node-home-lambda call))) (merge-tail-sets call ep) (change-ref-leaf ref ep) @@ -859,10 +859,9 @@ ;; HOME no longer calls CLAMBDA, and owns all of CLAMBDA's old ;; DFO dependencies. - (setf (lambda-calls-or-closes home) - (delete clambda - (nunion (lambda-calls-or-closes clambda) - (lambda-calls-or-closes home)))) + (sset-union (lambda-calls-or-closes home) + (lambda-calls-or-closes clambda)) + (sset-delete clambda (lambda-calls-or-closes home)) ;; CLAMBDA no longer has an independent existence as an entity ;; which calls things or has DFO dependencies. (setf (lambda-calls-or-closes clambda) nil) @@ -912,7 +911,7 @@ ;;; the RETURN-RESULT, because the return might have been deleted (if ;;; all calls were TR.) (defun unconvert-tail-calls (fun call next-block) - (dolist (called (lambda-calls-or-closes fun)) + (do-sset-elements (called (lambda-calls-or-closes fun)) (when (lambda-p called) (dolist (ref (leaf-refs called)) (let ((this-call (node-dest ref))) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index d13e07d..c1bed35 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1016,6 +1016,7 @@ :policy *policy* :handled-conditions *handled-conditions* :disabled-package-locks *disabled-package-locks*)) + (*compiler-sset-counter* 0) (fun (make-functional-from-toplevel-lambda lambda-expression :name name :path path))) @@ -1498,6 +1499,7 @@ ;; and it's not obvious whether the rebinding to itself is ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*. (*info-environment* *info-environment*) + (*compiler-sset-counter* 0) (*gensym-counter* 0)) (handler-case (handler-bind (((satisfies handle-condition-p) #'handle-condition-handler)) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index 3467f60..5e9bd54 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -86,6 +86,7 @@ (format stream "~D" (cont-num x)))) (def!struct (node (:constructor nil) + (:include sset-element (number (incf *compiler-sset-counter*))) (:copier nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) @@ -248,7 +249,10 @@ ;; some kind of info used by the back end (info nil) ;; what macroexpansions happened "in" this block, used for xref - (macroexpands nil :type list)) + (macroexpands nil :type list) + ;; Cache the physenv of a block during lifetime analysis. :NONE if + ;; no cached value has been stored yet. + (physenv-cache :none :type (or null physenv (member :none)))) (def!method print-object ((cblock cblock) stream) (print-unreadable-object (cblock stream :type t :identity t) (format stream "~W :START c~W" @@ -391,7 +395,9 @@ ;; this is filled by physical environment analysis (dx-lvars nil :type list) ;; The default LOOP in the component. - (outer-loop (missing-arg) :type cloop)) + (outer-loop (missing-arg) :type cloop) + ;; The current sset index + (sset-number 0 :type fixnum)) (defprinter (component :identity t) name #!+sb-show id @@ -585,6 +591,7 @@ ;;; allows us to easily substitute one for the other without actually ;;; hacking the flow graph. (def!struct (leaf (:make-load-form-fun ignore-it) + (:include sset-element (number (incf *compiler-sset-counter*))) (:constructor nil)) ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) @@ -932,7 +939,7 @@ ;; objects (closed-over LAMBDA-VARs and XEPs) which this lambda ;; depends on in such a way that DFO shouldn't put them in separate ;; components. - (calls-or-closes nil :type list) + (calls-or-closes (make-sset) :type (or null sset)) ;; the TAIL-SET that this LAMBDA is in. This is null during creation. ;; ;; In CMU CL, and old SBCL, this was also NILed out when LET diff --git a/version.lisp-expr b/version.lisp-expr index 4ad1fe9..61b5f90 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.2.12" +"1.0.2.13"