(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))
(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
(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
(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))))
\f
;;;; translators for compiler-magic special forms
(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.
(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.)
(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)
(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)
;; 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)
;;; 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)))
: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)))
;; 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))
(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)
;; 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"
;; 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
;;; 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)
;; 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
;;; 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"
projects / sbcl.git / commitdiff