From a0e89f991d9bb20341ea9a944c8fe2acf7f96b21 Mon Sep 17 00:00:00 2001 From: William Harold Newman Date: Sun, 6 Jan 2002 15:41:06 +0000 Subject: [PATCH] 0.pre7.115: minor tweak in the new names: "SB-INT:&MORE processor for FOO" is unnecessarily cryptic, and maybe "varargs entry point for FOO" is better bug 138, continued: It seems bad for WITH-BELATED-IR1-ENVIRONMENT to be binding *CURRENT-COMPONENT* to something which has already had COMPILE-COMPONENT called on it once and for all. I added checks to stop this... ...made COMPILE-COMPONENT set (COMPONENT-INFO C)=:DEAD (instead of just NILing it out) ...added some assertions that key operations aren't applied to dead components s/with-belated-ir1-environment/with-ir1-environment-from-node/ --- BUGS | 8 ++++++++ src/code/ntrace.lisp | 11 ++++++----- src/compiler/checkgen.lisp | 2 +- src/compiler/ir1-translators.lisp | 2 +- src/compiler/ir1opt.lisp | 12 ++++++------ src/compiler/ir1tran.lisp | 13 ++++++++++--- src/compiler/ir1util.lisp | 4 ++-- src/compiler/locall.lisp | 9 +++++---- src/compiler/macros.lisp | 29 +++++++++++++++++------------ src/compiler/main.lisp | 8 +++++--- src/compiler/node.lisp | 30 ++++++++++++++++++++++++------ version.lisp-expr | 2 +- 12 files changed, 86 insertions(+), 44 deletions(-) diff --git a/BUGS b/BUGS index 2e4eab5..83c5c89 100644 --- a/BUGS +++ b/BUGS @@ -1359,6 +1359,14 @@ Error in function C::GET-LAMBDA-TO-COMPILE: wrong? Something later on is dropping the ball and neglecting to look at all the components it should? Something else? + Tracing more things like IR1-PHASES and COMPILE-COMPONENT, it + looks as though the problem is that WITH-BELATED-IR1-ENVIRONMENT + is binding *CURRENT-COMPONENT* (i.e., where new code will be inserted) + to a COMPONENT which has already been passed to COMPILE-COMPONENT + (once and for all, so it'll never pass that way again). It seems + as though there's a broken invariant there: *CURRENT-COMPONENT* + should never be something which has already been COMPILE-COMPONENTed. + 139: In sbcl-0.pre7.107, (DIRECTORY "*.*") is broken, as reported by Nathan Froyd sbcl-devel 2001-12-28. diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index bebb448..bade4f9 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -145,10 +145,10 @@ (trace-1 fname info new-value))))) (push #'trace-redefined-update *setf-fdefinition-hook*) -;;; Annotate some forms to evaluate with pre-converted functions. Each -;;; form is really a cons (exp . function). Loc is the code location -;;; to use for the lexical environment. If Loc is NIL, evaluate in the -;;; null environment. If Form is NIL, just return NIL. +;;; Annotate a FORM to evaluate with pre-converted functions. FORM is +;;; really a cons (EXP . FUNCTION). LOC is the code location to use +;;; for the lexical environment. If LOC is NIL, evaluate in the null +;;; environment. If FORM is NIL, just return NIL. (defun coerce-form (form loc) (when form (let ((exp (car form))) @@ -172,6 +172,7 @@ (declare (ignore frame)) (let ((*current-frame* nil)) (funcall fun))))))))) + (defun coerce-form-list (forms loc) (mapcar #'(lambda (x) (coerce-form x loc)) forms)) @@ -234,6 +235,7 @@ (defun trace-start-breakpoint-fun (info) (let (conditionp) (values + #'(lambda (frame bpt) (declare (ignore bpt)) (discard-invalid-entries frame) @@ -245,7 +247,6 @@ (funcall (cdr condition) frame)) (or (not wherein) (trace-wherein-p frame wherein))))) - (when conditionp (let ((sb-kernel:*current-level* 0) (*standard-output* *trace-output*) diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 3234820..3d1dae3 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -319,7 +319,7 @@ ;;; passes them on to CONT. (defun convert-type-check (cont types) (declare (type continuation cont) (type list types)) - (with-belated-ir1-environment (continuation-dest cont) + (with-ir1-environment-from-node (continuation-dest cont) ;; Ensuring that CONT starts a block lets us freely manipulate its uses. (ensure-block-start cont) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 412eb93..cdc1fcb 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -412,7 +412,7 @@ #!+sb-doc "FUNCTION Name Return the lexically apparent definition of the function Name. Name may also - be a lambda." + be a lambda expression." (if (consp thing) (case (car thing) ((lambda) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index c9188e3..8ab30ae 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -568,7 +568,7 @@ ;;; become unreachable, resulting in a spurious note. (defun convert-if-if (use node) (declare (type node use) (type cif node)) - (with-belated-ir1-environment node + (with-ir1-environment-from-node node (let* ((block (node-block node)) (test (if-test node)) (cblock (if-consequent node)) @@ -818,7 +818,7 @@ (change-ref-leaf ref res)))) (if ir1-p (frob) - (with-belated-ir1-environment call + (with-ir1-environment-from-node call (frob) (locall-analyze-component *current-component*)))) @@ -1083,10 +1083,10 @@ ;;; integrated into the control flow. (defun transform-call (node res) (declare (type combination node) (list res)) - (with-belated-ir1-environment node + (with-ir1-environment-from-node node (let ((new-fun (ir1-convert-inline-lambda res - :debug-name "")) + :debug-name "something inlined in TRANSFORM-CALL")) (ref (continuation-use (combination-fun node)))) (change-ref-leaf ref new-fun) (setf (combination-kind node) :full) @@ -1481,7 +1481,7 @@ min) (t nil)))) (when count - (with-belated-ir1-environment node + (with-ir1-environment-from-node node (let* ((dums (make-gensym-list count)) (ignore (gensym)) (fun (ir1-convert-lambda @@ -1525,7 +1525,7 @@ (mapc #'flush-dest (subseq vals nvars)) (setq vals (subseq vals 0 nvars))) ((< nvals nvars) - (with-belated-ir1-environment use + (with-ir1-environment-from-node use (let ((node-prev (node-prev use))) (setf (node-prev use) nil) (setf (continuation-next node-prev) nil) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 00e8a19..2d47628 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -33,7 +33,7 @@ ;;; FIXME: It's confusing having one variable named *CURRENT-COMPONENT* ;;; and another named *COMPONENT-BEING-COMPILED*. (In CMU CL they ;;; were called *CURRENT-COMPONENT* and *COMPILE-COMPONENT* respectively, -;;; which also confusing.) +;;; which was also confusing.) (declaim (type (or component null) *current-component*)) (defvar *current-component*) @@ -488,6 +488,7 @@ ;;; Add FUN to the COMPONENT-REANALYZE-FUNS. FUN is returned. (defun maybe-reanalyze-fun (fun) (declare (type functional fun)) + (aver-live-component *current-component*) (when (typep fun '(or optional-dispatch clambda)) (pushnew fun (component-reanalyze-funs *current-component*))) fun) @@ -1354,6 +1355,10 @@ debug-name) (declare (list body vars aux-vars aux-vals) (type (or continuation null) result)) + + ;; We're about to try to put new blocks into *CURRENT-COMPONENT*. + (aver-live-component *current-component*) + (let* ((bind (make-bind)) (lambda (make-lambda :vars vars :bind bind @@ -1415,6 +1420,7 @@ (link-blocks (component-head *current-component*) (node-block bind)) (push lambda (component-new-funs *current-component*)) + lambda)) ;;; Create the actual entry-point function for an optional entry @@ -1691,8 +1697,7 @@ :aux-vars (append (bind-vars) aux-vars) :aux-vals (append (bind-vals) aux-vals) :result cont - :debug-name (debug-namify "~S processor for ~A" - '&more + :debug-name (debug-namify "varargs entry point for ~A" (as-debug-name source-name debug-name)))) (last-entry (convert-optional-entry main-entry default-vars @@ -1828,6 +1833,7 @@ :%source-name source-name :%debug-name debug-name)) (min (or (position-if #'lambda-var-arg-info vars) (length vars)))) + (aver-live-component *current-component*) (push res (component-new-funs *current-component*)) (ir1-convert-hairy-args res () () () () vars nil body aux-vars aux-vals cont source-name debug-name) @@ -1848,6 +1854,7 @@ ;;; Convert a LAMBDA form into a LAMBDA leaf or an OPTIONAL-DISPATCH leaf. (defun ir1-convert-lambda (form &key (source-name '.anonymous.) debug-name) + (unless (consp form) (compiler-error "A ~S was found when expecting a lambda expression:~% ~S" (type-of form) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 79ca83e..8a5a7df 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -36,7 +36,7 @@ (declare (type cblock block1 block2) (type node node) (type (or cleanup null) cleanup)) (setf (component-reanalyze (block-component block1)) t) - (with-belated-ir1-environment node + (with-ir1-environment-from-node node (let* ((start (make-continuation)) (block (continuation-starts-block start)) (cont (make-continuation)) @@ -1072,7 +1072,7 @@ (aver (and succ (null (cdr succ)))) (cond ((member block succ) - (with-belated-ir1-environment node + (with-ir1-environment-from-node node (let ((exit (make-exit)) (dummy (make-continuation))) (setf (continuation-next prev) nil) diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 4e45c0b..8867f28 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -178,7 +178,7 @@ (defun make-xep (fun) (declare (type functional fun)) (aver (not (functional-entry-fun fun))) - (with-belated-ir1-environment (lambda-bind (main-entry fun)) + (with-ir1-environment-from-node (lambda-bind (main-entry fun)) (let ((res (ir1-convert-lambda (make-xep-lambda-expression fun) :debug-name (debug-namify "XEP for ~A" @@ -265,6 +265,7 @@ ;;; NEW-FUNS, but we don't add lambdas to the LAMBDAS. (defun locall-analyze-component (component) (declare (type component component)) + (aver-live-component component) (loop (let* ((new-fun (pop (component-new-funs component))) (fun (or new-fun (pop (component-reanalyze-funs component))))) @@ -330,7 +331,7 @@ (and (>= speed space) (>= speed compilation-speed))) (not (eq (functional-kind (node-home-lambda call)) :external)) (inline-expansion-ok call)) - (with-belated-ir1-environment call + (with-ir1-environment-from-node call (let* ((*lexenv* (functional-lexenv fun)) (won nil) (res (catch 'local-call-lossage @@ -523,7 +524,7 @@ (declare (list vars ignores args) (type ref ref) (type combination call) (type clambda entry)) (let ((new-fun - (with-belated-ir1-environment call + (with-ir1-environment-from-node call (ir1-convert-lambda `(lambda ,vars (declare (ignorable . ,ignores)) @@ -681,11 +682,11 @@ (let* ((call-block (node-block call)) (bind-block (node-block (lambda-bind clambda))) (component (block-component call-block))) + (aver-live-component component) (let ((clambda-component (block-component bind-block))) (unless (eq clambda-component component) (aver (eq (component-kind component) :initial)) (join-components component clambda-component))) - (let ((*current-component* component)) (node-ends-block call)) ;; FIXME: Use PROPER-LIST-OF-LENGTH-P here, and look for other diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index 51a4a5b..c91b3f0 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -657,7 +657,7 @@ `(eq ,node-var (block-last ,n-block)) `(eq ,cont-var ,n-last-cont)) (return nil)))))) -;;; like Do-Nodes, only iterating in reverse order +;;; like DO-NODES, only iterating in reverse order (defmacro do-nodes-backwards ((node-var cont-var block) &body body) (let ((n-block (gensym)) (n-start (gensym)) @@ -674,17 +674,22 @@ (when (eq ,n-next ,n-start) (return nil)))))) -;;; Bind the IR1 context variables so that IR1 conversion can be done -;;; after the main conversion pass has finished. -;;; -;;; The lexical environment is presumably already null... -(defmacro with-belated-ir1-environment (node &rest forms) - (let ((n-node (gensym))) - `(let* ((,n-node ,node) - (*current-component* (block-component (node-block ,n-node))) - (*lexenv* (node-lexenv ,n-node)) - (*current-path* (node-source-path ,n-node))) - ,@forms))) +;;; Bind the IR1 context variables to the values associated with NODE, +;;; so that new, extra IR1 conversion related to NODE can be done +;;; after the original conversion pass has finished. +(defmacro with-ir1-environment-from-node (node &rest forms) + `(flet ((closure-needing-ir1-environment-from-node () + ,@forms)) + (%with-ir1-environment-from-node + ,node + #'closure-needing-ir1-environment-from-node))) +(defun %with-ir1-environment-from-node (node fun) + (declare (type node node) (type function fun)) + (let ((*current-component* (block-component (node-block node))) + (*lexenv* (node-lexenv node)) + (*current-path* (node-source-path node))) + (aver-live-component *current-component*) + (funcall fun))) ;;; Bind the hashtables used for keeping track of global variables, ;;; functions, etc. Also establish condition handlers. diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 17a2539..266f30b 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -310,6 +310,7 @@ ;;; Do all the IR1 phases for a non-top-level component. (defun ir1-phases (component) (declare (type component component)) + (aver-live-component component) (let ((*constraint-number* 0) (loop-count 1) (*delayed-ir1-transforms* nil)) @@ -440,7 +441,7 @@ (null)))))) ;; We're done, so don't bother keeping anything around. - (setf (component-info component) nil) + (setf (component-info component) :dead) (values)) @@ -462,6 +463,7 @@ (return)))))) (defun compile-component (component) + (aver-live-component component) (let* ((*component-being-compiled* component)) (when sb!xc:*compile-print* (compiler-mumble "~&; compiling ~A: " (component-name component))) @@ -1124,8 +1126,8 @@ (let ((lambda (compile-load-time-stuff `(progn ,@forms) name nil))) (fasl-dump-toplevel-lambda-call lambda *compile-object*))) -;;; Does the actual work of COMPILE-LOAD-TIME-VALUE or -;;; COMPILE-MAKE-LOAD-FORM- INIT-FORMS. +;;; Do the actual work of COMPILE-LOAD-TIME-VALUE or +;;; COMPILE-MAKE-LOAD-FORM-INIT-FORMS. (defun compile-load-time-stuff (form name for-value) (with-ir1-namespace (let* ((*lexenv* (make-null-lexenv)) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index e2635d2..f2b9678 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -291,7 +291,10 @@ (out nil) ;; the component this block is in, or NIL temporarily during IR1 ;; conversion and in deleted blocks - (component *current-component* :type (or component null)) + (component (progn + (aver-live-component *current-component*) + *current-component*) + :type (or component null)) ;; a flag used by various graph-walking code to determine whether ;; this block has been processed already or what. We make this ;; initially NIL so that FIND-INITIAL-DFO doesn't have to scan the @@ -314,9 +317,9 @@ ;; The IR1 block that this block is in the INFO for. (block (missing-arg) :type cblock) ;; the next and previous block in emission order (not DFO). This - ;; determines which block we drop though to, and also used to chain - ;; together overflow blocks that result from splitting of IR2 blocks - ;; in lifetime analysis. + ;; determines which block we drop though to, and is also used to + ;; chain together overflow blocks that result from splitting of IR2 + ;; blocks in lifetime analysis. (next nil :type (or block-annotation null)) (prev nil :type (or block-annotation null))) @@ -400,8 +403,13 @@ (reanalyze nil :type boolean) ;; some sort of name for the code in this component (name "" :type simple-string) - ;; some kind of info used by the back end - (info nil) + ;; When I am a child, this is :NO-IR2-YET. + ;; In my adulthood, IR2 stores notes to itself here. + ;; After I have left the great wheel and am staring into the GC, this + ;; is set to :DEAD to indicate that it's a gruesome error to operate + ;; on me (e.g. by using me as *CURRENT-COMPONENT*, or by pushing + ;; LAMBDAs onto my NEW-FUNS, as in sbcl-0.pre7.115). + (info :no-ir2-yet :type (or ir2-component (member :no-ir2-yet :dead))) ;; the SOURCE-INFO structure describing where this component was ;; compiled from (source-info *source-info* :type source-info) @@ -425,6 +433,16 @@ name (reanalyze :test reanalyze)) +;;; Check that COMPONENT is suitable for roles which involve adding +;;; new code. (gotta love imperative programming with lotso in-place +;;; side-effects...) +(defun aver-live-component (component) + ;; FIXME: As of sbcl-0.pre7.115, we're asserting that + ;; COMPILE-COMPONENT hasn't happened yet. Might it be even better + ;; (certainly stricter, possibly also correct...) to assert that + ;; IR1-FINALIZE hasn't happened yet? + (aver (not (eql (component-info component) :dead)))) + ;;; Before sbcl-0.7.0, there were :TOPLEVEL things which were magical ;;; in multiple ways. That's since been refactored into the orthogonal ;;; properties "optimized for locall with no arguments" and "externally diff --git a/version.lisp-expr b/version.lisp-expr index aa2c67e..6caba00 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; for internal versions, especially for internal versions off the ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.pre7.114" +"0.pre7.115" -- 1.7.10.4