From: Alexey Dejneka Date: Tue, 16 Sep 2003 07:45:06 +0000 (+0000) Subject: 0.8.3.70: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=6053e7f804b430144bb09e2d107ad4ab3fb97db4;p=sbcl.git 0.8.3.70: * Update comments to the change of "continuation" representation; * fix bug reported by WHN: IR1-translator for TRULY-THE does nothing if its value is unused; * describe bug reported by Nikodemus Siivola on sbcl-devel 2003-09-15; * rewrite test of restoring floating point modes on Alpha: old version failed due to the absence of ABORT restart. --- diff --git a/BUGS b/BUGS index b9fb007..cb7b79b 100644 --- a/BUGS +++ b/BUGS @@ -1255,3 +1255,37 @@ WORKAROUND: denormalized float, in general, we mask out that bit when we restore the control word; however, this clobbers any change the user might have made. + +291: "bugs in deletion of embedded functions" + + Python fails to compile (simplified version of the problem reported + by Nikodemus Siivola) + + (defstruct (line) + (%chars "")) + + (defun update-window-imag (line) + (tagbody + TOP + (if (null line) + (go DONE) + (go TOP)) + DONE + (unless (eq current the-sentinel) + (let* ((cc (car current)) + (old-line (dis-line-line cc))) + (if (eq old-line line) + (do ((chars (line-%chars line) nil)) ; + (()) + (let* () + (multiple-value-call + #'(lambda (&optional g2740 g2741 &rest g2742) + (declare (ignore g2742)) + (catch 'foo ; + (values (setq string g2740) (setq underhang g2741)))) + (foo))) + (setf (dis-line-old-chars cc) chars))))))) + + Compiler deletes unreachable BIND node of , but its body, + including reference to the variable CHARS, remains reachable through + NLX from . diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 0e02ec2..ead1ca9 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -141,9 +141,9 @@ ;;; Switch to disable check complementing, for evaluation. (defvar *complement-type-checks* t) -;;; CONT is a continuation we are doing a type check on and TYPES is a -;;; list of types that we are checking its values against. If we have -;;; proven that CONT generates a fixed number of values, then for each +;;; LVAR is an lvar we are doing a type check on and TYPES is a list +;;; of types that we are checking its values against. If we have +;;; proven that LVAR generates a fixed number of values, then for each ;;; value, we check whether it is cheaper to then difference between ;;; the proven type and the corresponding type in TYPES. If so, we opt ;;; for a :HAIRY check with that test negated. Otherwise, we try to do @@ -184,7 +184,7 @@ (t (values :hairy res))))))) -;;; Determines whether CONT's assertion is: +;;; Determines whether CAST's assertion is: ;;; -- checkable by the back end (:SIMPLE), or ;;; -- not checkable by the back end, but checkable via an explicit ;;; test in type check conversion (:HAIRY), or @@ -200,10 +200,10 @@ ;;; We force a check to be hairy even when there are fixed values if ;;; we are in a context where we may be forced to use the unknown ;;; values convention anyway. This is because IR2tran can't generate -;;; type checks for unknown values continuations but people could -;;; still be depending on the check being done. We only care about -;;; EXIT and RETURN (not MV-COMBINATION) since these are the only -;;; contexts where the ultimate values receiver +;;; type checks for unknown values lvars but people could still be +;;; depending on the check being done. We only care about EXIT and +;;; RETURN (not MV-COMBINATION) since these are the only contexts +;;; where the ultimate values receiver ;;; ;;; In the :HAIRY case, the second value is a list of triples of ;;; the form: @@ -211,13 +211,13 @@ ;;; ;;; If true, the NOT-P flag indicates a test that the corresponding ;;; value is *not* of the specified TYPE. ORIGINAL-TYPE is the type -;;; asserted on this value in the continuation, for use in error +;;; asserted on this value in the lvar, for use in error ;;; messages. When NOT-P is true, this will be different from TYPE. ;;; -;;; This allows us to take what has been proven about CONT's type into -;;; consideration. If it is cheaper to test for the difference between -;;; the derived type and the asserted type, then we check for the -;;; negation of this type instead. +;;; This allows us to take what has been proven about CAST's argument +;;; type into consideration. If it is cheaper to test for the +;;; difference between the derived type and the asserted type, then we +;;; check for the negation of this type instead. (defun cast-check-types (cast force-hairy) (declare (type cast cast)) (let* ((ctype (coerce-to-values (cast-type-to-check cast))) @@ -301,14 +301,14 @@ (t t)))) -;;; Return true if CONT is a continuation whose type the back end is +;;; Return true if CAST's value is an lvar whose type the back end is ;;; likely to want to check. Since we don't know what template the ;;; back end is going to choose to implement the continuation's DEST, ;;; we use a heuristic. We always return T unless: ;;; -- nobody uses the value, or ;;; -- safety is totally unimportant, or -;;; -- the continuation is an argument to an unknown function, or -;;; -- the continuation is an argument to a known function that has +;;; -- the lvar is an argument to an unknown function, or +;;; -- the lvar is an argument to a known function that has ;;; no IR2-CONVERT method or :FAST-SAFE templates that are ;;; compatible with the call's type. (defun probable-type-check-p (cast) @@ -347,7 +347,7 @@ ;;; Return a lambda form that we can convert to do a hairy type check ;;; of the specified TYPES. TYPES is a list of the format returned by -;;; CONTINUATION-CHECK-TYPES in the :HAIRY case. +;;; LVAR-CHECK-TYPES in the :HAIRY case. ;;; ;;; Note that we don't attempt to check for required values being ;;; unsupplied. Such checking is impossible to efficiently do at the @@ -370,10 +370,9 @@ types) (values ,@temps)))) -;;; Splice in explicit type check code immediately before the node -;;; which is CONT's DEST. This code receives the value(s) that were -;;; being passed to CONT, checks the type(s) of the value(s), then -;;; passes them on to CONT. +;;; Splice in explicit type check code immediately before CAST. This +;;; code receives the value(s) that were being passed to CAST-VALUE, +;;; checks the type(s) of the value(s), then passes them further. (defun convert-type-check (cast types) (declare (type cast cast) (type list types)) (let ((value (cast-value cast)) @@ -433,18 +432,17 @@ (values)) ;;; Loop over all blocks in COMPONENT that have TYPE-CHECK set, -;;; looking for continuations with TYPE-CHECK T. We do two mostly -;;; unrelated things: detect compile-time type errors and determine if -;;; and how to do run-time type checks. +;;; looking for CASTs with TYPE-CHECK T. We do two mostly unrelated +;;; things: detect compile-time type errors and determine if and how +;;; to do run-time type checks. ;;; -;;; If there is a compile-time type error, then we mark the -;;; continuation and emit a warning if appropriate. This part loops -;;; over all the uses of the continuation, since after we convert the -;;; check, the :DELETED kind will inhibit warnings about the types of -;;; other uses. +;;; If there is a compile-time type error, then we mark the CAST and +;;; emit a warning if appropriate. This part loops over all the uses +;;; of the continuation, since after we convert the check, the +;;; :DELETED kind will inhibit warnings about the types of other uses. ;;; -;;; If a continuation is too complex to be checked by the back end, or -;;; is better checked with explicit code, then convert to an explicit +;;; If the cast is too complex to be checked by the back end, or is +;;; better checked with explicit code, then convert to an explicit ;;; test. Assertions that can checked by the back end are passed ;;; through. Assertions that can't be tested are flamed about and ;;; marked as not needing to be checked. diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index eb0f4e6..53f247c 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1344,7 +1344,7 @@ (defknown %type-check-error (t t) nil) ;; FIXME: This function does not return, but due to the implementation -;; of FILTER-CONTINUATION we cannot write it here. +;; of FILTER-LVAR we cannot write it here. (defknown %compile-time-type-error (t t t) *) (defknown %odd-key-args-error () nil) diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp index a5537f1..3d6c0c8 100644 --- a/src/compiler/gtn.lisp +++ b/src/compiler/gtn.lisp @@ -84,12 +84,11 @@ (values)) -;;; Return true if FUN's result continuation is used in a -;;; tail-recursive full call. We only consider explicit :FULL calls. -;;; It is assumed that known calls are never part of a tail-recursive -;;; loop, so we don't need to enforce tail-recursion. In any case, we -;;; don't know which known calls will actually be full calls until -;;; after LTN. +;;; Return true if FUN's result is used in a tail-recursive full +;;; call. We only consider explicit :FULL calls. It is assumed that +;;; known calls are never part of a tail-recursive loop, so we don't +;;; need to enforce tail-recursion. In any case, we don't know which +;;; known calls will actually be full calls until after LTN. (defun has-full-call-use (fun) (declare (type clambda fun)) (let ((return (lambda-return fun))) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index cae654d..7252c64 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -58,7 +58,7 @@ ;;;; node. ;;; Make a :ENTRY cleanup and emit an ENTRY node, then convert the -;;; body in the modified environment. We make CONT start a block now, +;;; body in the modified environment. We make NEXT start a block now, ;;; since if it was done later, the block would be in the wrong ;;; environment. (def-ir1-translator block ((name &rest forms) start next result) @@ -90,10 +90,10 @@ Evaluate the Value-Form, returning its values from the lexically enclosing BLOCK Block-Name. This is constrained to be used only within the dynamic extent of the BLOCK." - ;; CMU CL comment: - ;; We make CONT start a block just so that it will have a block - ;; assigned. People assume that when they pass a continuation into - ;; IR1-CONVERT as CONT, it will have a block when it is done. + ;; old comment: + ;; We make NEXT start a block just so that it will have a block + ;; assigned. People assume that when they pass a ctran into + ;; IR1-CONVERT as NEXT, it will have a block when it is done. ;; KLUDGE: Note that this block is basically fictitious. In the code ;; (BLOCK B (RETURN-FROM B) (SETQ X 3)) ;; it's the block which answers the question "which block is @@ -463,10 +463,10 @@ (if (and (consp function) (eq (car function) 'function)) (ir1-convert start next result `(,(fun-name-leaf (second function)) ,@args)) - (let ((fun-ctran (make-ctran)) + (let ((ctran (make-ctran)) (fun-lvar (make-lvar))) - (ir1-convert start fun-ctran fun-lvar `(the function ,function)) - (ir1-convert-combination-args fun-ctran fun-lvar next result args)))) + (ir1-convert start ctran fun-lvar `(the function ,function)) + (ir1-convert-combination-args fun-lvar ctran next result args)))) ;;; This source transform exists to reduce the amount of work for the ;;; compiler. If the called function is a FUNCTION form, then convert @@ -536,7 +536,7 @@ (multiple-value-bind (forms decls) (parse-body body :doc-string-allowed nil) (multiple-value-bind (vars values) (extract-let-vars bindings 'let) - (binding* ((fun-ctran (make-ctran)) + (binding* ((ctran (make-ctran)) (fun-lvar (make-lvar)) ((next result) (processing-decls (decls vars nil next result) @@ -544,9 +544,9 @@ forms vars :debug-name (debug-namify "LET ~S" bindings)))) - (reference-leaf start fun-ctran fun-lvar fun)) + (reference-leaf start ctran fun-lvar fun)) (values next result)))) - (ir1-convert-combination-args fun-ctran fun-lvar next result values)))))) + (ir1-convert-combination-args fun-lvar ctran next result values)))))) (def-ir1-translator let* ((bindings &body body) start next result) @@ -714,14 +714,14 @@ (def-ir1-translator truly-the ((type value) start next result) #!+sb-doc "" - (declare (inline member)) #-nil (let ((type (coerce-to-values (compiler-values-specifier-type type))) - (old (find-uses result))) + (old (when result (find-uses result)))) (ir1-convert start next result value) - (do-uses (use result) - (unless (memq use old) - (derive-node-type use type)))) + (when result + (do-uses (use result) + (unless (memq use old) + (derive-node-type use type))))) #+nil (the-in-policy type value '((type-check . 0)) start cont)) @@ -902,7 +902,7 @@ "MULTIPLE-VALUE-CALL Function Values-Form* Call FUNCTION, passing all the values of each VALUES-FORM as arguments, values from the first VALUES-FORM making up the first argument, etc." - (let* ((fun-ctran (make-ctran)) + (let* ((ctran (make-ctran)) (fun-lvar (make-lvar)) (node (if args ;; If there are arguments, MULTIPLE-VALUE-CALL @@ -915,13 +915,13 @@ ;; important for simplifying compilation of ;; MV-COMBINATIONS. (make-combination fun-lvar)))) - (ir1-convert start fun-ctran fun-lvar + (ir1-convert start ctran fun-lvar (if (and (consp fun) (eq (car fun) 'function)) fun `(%coerce-callable-to-fun ,fun))) (setf (lvar-dest fun-lvar) node) (collect ((arg-lvars)) - (let ((this-start fun-ctran)) + (let ((this-start ctran)) (dolist (arg args) (let ((this-ctran (make-ctran)) (this-lvar (make-lvar node))) @@ -932,31 +932,6 @@ (use-continuation node next result) (setf (basic-combination-args node) (arg-lvars)))))) -;;; MULTIPLE-VALUE-PROG1 is represented implicitly in IR1 by having a -;;; the result code use result continuation (CONT), but transfer -;;; control to the evaluation of the body. In other words, the result -;;; continuation isn't IMMEDIATELY-USED-P by the nodes that compute -;;; the result. -;;; -;;; In order to get the control flow right, we convert the result with -;;; a dummy result continuation, then convert all the uses of the -;;; dummy to be uses of CONT. If a use is an EXIT, then we also -;;; substitute CONT for the dummy in the corresponding ENTRY node so -;;; that they are consistent. Note that this doesn't amount to -;;; changing the exit target, since the control destination of an exit -;;; is determined by the block successor; we are just indicating the -;;; continuation that the result is delivered to. -;;; -;;; We then convert the body, using another dummy continuation in its -;;; own block as the result. After we are done converting the body, we -;;; move all predecessors of the dummy end block to CONT's block. -;;; -;;; Note that we both exploit and maintain the invariant that the CONT -;;; to an IR1 convert method either has no block or starts the block -;;; that control should transfer to after completion for the form. -;;; Nested MV-PROG1's work because during conversion of the result -;;; form, we use dummy continuation whose block is the true control -;;; destination. (def-ir1-translator multiple-value-prog1 ((values-form &rest forms) start next result) #!+sb-doc diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index c882a0f..cb198bd 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -18,15 +18,15 @@ ;;;; interface for obtaining results of constant folding -;;; Return true for a CONTINUATION whose sole use is a reference to a +;;; Return true for an LVAR whose sole use is a reference to a ;;; constant leaf. (defun constant-lvar-p (thing) (and (lvar-p thing) (let ((use (principal-lvar-use thing))) (and (ref-p use) (constant-p (ref-leaf use)))))) -;;; Return the constant value for a continuation whose only use is a -;;; constant node. +;;; Return the constant value for an LVAR whose only use is a constant +;;; node. (declaim (ftype (function (lvar) t) lvar-value)) (defun lvar-value (lvar) (let ((use (principal-lvar-use lvar))) @@ -34,23 +34,13 @@ ;;;; interface for obtaining results of type inference -;;; Our best guess for the type of this continuation's value. Note -;;; that this may be VALUES or FUNCTION type, which cannot be passed -;;; as an argument to the normal type operations. See -;;; CONTINUATION-TYPE. This may be called on deleted continuations, -;;; always returning *. +;;; Our best guess for the type of this lvar's value. Note that this +;;; may be VALUES or FUNCTION type, which cannot be passed as an +;;; argument to the normal type operations. See LVAR-TYPE. ;;; -;;; What we do is call CONTINUATION-PROVEN-TYPE and check whether the -;;; result is a subtype of the assertion. If so, return the proven -;;; type and set TYPE-CHECK to NIL. Otherwise, return the intersection -;;; of the asserted and proven types, and set TYPE-CHECK T. If -;;; TYPE-CHECK already has a non-null value, then preserve it. Only in -;;; the somewhat unusual circumstance of a newly discovered assertion -;;; will we change TYPE-CHECK from NIL to T. -;;; -;;; The result value is cached in the CONTINUATION-%DERIVED-TYPE slot. -;;; If the slot is true, just return that value, otherwise recompute -;;; and stash the value there. +;;; The result value is cached in the LVAR-%DERIVED-TYPE slot. If the +;;; slot is true, just return that value, otherwise recompute and +;;; stash the value there. #!-sb-fluid (declaim (inline lvar-derived-type)) (defun lvar-derived-type (lvar) (declare (type lvar lvar)) @@ -70,14 +60,14 @@ (t (node-derived-type (lvar-uses lvar)))))) -;;; Return the derived type for CONT's first value. This is guaranteed +;;; Return the derived type for LVAR's first value. This is guaranteed ;;; not to be a VALUES or FUNCTION type. (declaim (ftype (sfunction (lvar) ctype) lvar-type)) (defun lvar-type (lvar) (single-value-type (lvar-derived-type lvar))) -;;; If CONT is an argument of a function, return a type which the -;;; function checks CONT for. +;;; If LVAR is an argument of a function, return a type which the +;;; function checks LVAR for. #!-sb-fluid (declaim (inline lvar-externally-checkable-type)) (defun lvar-externally-checkable-type (lvar) (or (lvar-%externally-checkable-type lvar) @@ -483,9 +473,9 @@ ;;; ;;; When we are done, we check whether the new type is different from ;;; the old TAIL-SET-TYPE. If so, we set the type and also reoptimize -;;; all the continuations for references to functions in the tail set. -;;; This will cause IR1-OPTIMIZE-COMBINATION to derive the new type as -;;; the results of the calls. +;;; all the lvars for references to functions in the tail set. This +;;; will cause IR1-OPTIMIZE-COMBINATION to derive the new type as the +;;; results of the calls. (defun ir1-optimize-return (node) (declare (type creturn node)) (let* ((tails (lambda-tail-set (return-lambda node))) @@ -699,9 +689,7 @@ (values)) ;;; If NODE doesn't return (i.e. return type is NIL), then terminate -;;; the block there, and link it to the component tail. We also change -;;; the NODE's CONT to be a dummy continuation to prevent the use from -;;; confusing things. +;;; the block there, and link it to the component tail. ;;; ;;; Except when called during IR1 convertion, we delete the ;;; continuation if it has no other uses. (If it does have other uses, @@ -1265,7 +1253,7 @@ (info :function :info name))))))))) ;;; If we have a non-set LET var with a single use, then (if possible) -;;; replace the variable reference's CONT with the arg continuation. +;;; replace the variable reference's LVAR with the arg lvar. ;;; ;;; We change the REF to be a reference to NIL with unused value, and ;;; let it be flushed as dead code. A side effect of this substitution @@ -1313,7 +1301,7 @@ ;;; Delete a LET, removing the call and bind nodes, and warning about ;;; any unreferenced variables. Note that FLUSH-DEAD-CODE will come ;;; along right away and delete the REF and then the lambda, since we -;;; flush the FUN continuation. +;;; flush the FUN lvar. (defun delete-let (clambda) (declare (type clambda clambda)) (aver (functional-letlike-p clambda)) @@ -1481,8 +1469,7 @@ (:error)) (values)) -;;; Propagate derived type info from the values continuation to the -;;; vars. +;;; Propagate derived type info from the values lvar to the vars. (defun ir1-optimize-mv-bind (node) (declare (type mv-combination node)) (let* ((arg (first (basic-combination-args node))) @@ -1656,7 +1643,7 @@ (eq (lvar-fun-name (combination-fun use)) 'list)) - ;; FIXME: VALUES might not satisfy an assertion on NODE-CONT. + ;; FIXME: VALUES might not satisfy an assertion on NODE-LVAR. (change-ref-leaf (lvar-uses (combination-fun node)) (find-free-fun 'values "in a strange place")) (setf (combination-kind node) :full) @@ -1706,8 +1693,8 @@ `(%compile-time-type-error 'dummy ',(type-specifier atype) ',(type-specifier value-type))) - ;; KLUDGE: FILTER-CONTINUATION does not work for - ;; non-returning functions, so we declare the return type of + ;; KLUDGE: FILTER-LVAR does not work for non-returning + ;; functions, so we declare the return type of ;; %COMPILE-TIME-TYPE-ERROR to be * and derive the real type ;; here. (setq value (cast-value cast)) diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index 00b7720..6971a72 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -207,7 +207,7 @@ (list body aux-vars aux-vals)) (if (null aux-vars) (ir1-convert-progn-body start next result body) - (let ((fun-ctran (make-ctran)) + (let ((ctran (make-ctran)) (fun-lvar (make-lvar)) (fun (ir1-convert-lambda-body body (list (first aux-vars)) @@ -216,8 +216,8 @@ :debug-name (debug-namify "&AUX bindings ~S" aux-vars)))) - (reference-leaf start fun-ctran fun-lvar fun) - (ir1-convert-combination-args fun-ctran fun-lvar next result + (reference-leaf start ctran fun-lvar fun) + (ir1-convert-combination-args fun-lvar ctran next result (list (first aux-vals))))) (values)) @@ -227,11 +227,11 @@ ;;; the body, otherwise we do one special binding and recurse on the ;;; rest. ;;; -;;; We make a cleanup and introduce it into the lexical environment. -;;; If there are multiple special bindings, the cleanup for the blocks -;;; will end up being the innermost one. We force CONT to start a -;;; block outside of this cleanup, causing cleanup code to be emitted -;;; when the scope is exited. +;;; We make a cleanup and introduce it into the lexical +;;; environment. If there are multiple special bindings, the cleanup +;;; for the blocks will end up being the innermost one. We force NEXT +;;; to start a block outside of this cleanup, causing cleanup code to +;;; be emitted when the scope is exited. (defun ir1-convert-special-bindings (start next result body aux-vars aux-vals svars) (declare (type ctran start next) (type (or lvar null) result) diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 4b9543b..a1df32b 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -303,20 +303,17 @@ ;;;; some flow-graph hacking utilities ;;; This function sets up the back link between the node and the -;;; continuation which continues at it. +;;; ctran which continues at it. (defun link-node-to-previous-ctran (node ctran) (declare (type node node) (type ctran ctran)) (aver (not (ctran-next ctran))) (setf (ctran-next ctran) node) (setf (node-prev node) ctran)) -;;; This function is used to set the continuation for a node, and thus -;;; determine what receives the value and what is evaluated next. If -;;; the continuation has no block, then we make it be in the block -;;; that the node is in. If the continuation heads its block, we end -;;; our block and link it to that block. If the continuation is not -;;; currently used, then we set the DERIVED-TYPE for the continuation -;;; to that of the node, so that a little type propagation gets done. +;;; This function is used to set the ctran for a node, and thus +;;; determine what is evaluated next. If the ctran has no block, then +;;; we make it be in the block that the node is in. If the ctran heads +;;; its block, we end our block and link it to that block. #!-sb-fluid (declaim (inline use-ctran)) (defun use-ctran (node ctran) (declare (type node node) (type ctran ctran)) @@ -340,9 +337,10 @@ (setf (block-succ node-block) (list block)) (when (memq node-block (block-pred block)) (error "~S is already a predecessor of ~S." node-block block)) - (push node-block (block-pred block)) - #+nil(reoptimize-ctran ctran))) ; XXX + (push node-block (block-pred block)))) +;;; This function is used to set the ctran for a node, and thus +;;; determine what receives the value. (defun use-lvar (node lvar) (declare (type valued-node node) (type (or lvar null) lvar)) (aver (not (node-lvar node))) @@ -778,24 +776,24 @@ (declaim (ftype (sfunction (ctran ctran (or lvar null) list leaf) combination) ir1-convert-combination)) (defun ir1-convert-combination (start next result form fun) - (let ((fun-ctran (make-ctran)) + (let ((ctran (make-ctran)) (fun-lvar (make-lvar))) - (ir1-convert start fun-ctran fun-lvar `(the (or function symbol) ,fun)) - (ir1-convert-combination-args fun-ctran fun-lvar next result (cdr form)))) + (ir1-convert start ctran fun-lvar `(the (or function symbol) ,fun)) + (ir1-convert-combination-args fun-lvar ctran next result (cdr form)))) ;;; Convert the arguments to a call and make the COMBINATION -;;; node. FUN-CONT is the continuation which yields the function to -;;; call. ARGS is the list of arguments for the call, which defaults -;;; to the cdr of source. We return the COMBINATION node. -(defun ir1-convert-combination-args (fun-ctran fun-lvar next result args) - (declare (type ctran fun-ctran next) +;;; node. FUN-LVAR yields the function to call. ARGS is the list of +;;; arguments for the call, which defaults to the cdr of source. We +;;; return the COMBINATION node. +(defun ir1-convert-combination-args (fun-lvar start next result args) + (declare (type ctran start next) (type lvar fun-lvar) (type (or lvar null) result) (list args)) (let ((node (make-combination fun-lvar))) (setf (lvar-dest fun-lvar) node) (collect ((arg-lvars)) - (let ((this-start fun-ctran)) + (let ((this-start start)) (dolist (arg args) (let ((this-ctran (make-ctran)) (this-lvar (make-lvar node))) @@ -829,7 +827,7 @@ (ir1-convert start next result transformed))) (ir1-convert-maybe-predicate start next result form var)))))) -;;; If the function has the PREDICATE attribute, and the CONT's DEST +;;; If the function has the PREDICATE attribute, and the RESULT's DEST ;;; isn't an IF, then we convert (IF
T NIL), ensuring that a ;;; predicate always appears in a conditional context. ;;; @@ -858,9 +856,9 @@ ;;; call is legal. ;;; ;;; If the call is legal, we also propagate type assertions from the -;;; function type to the arg and result continuations. We do this now -;;; so that IR1 optimize doesn't have to redundantly do the check -;;; later so that it can do the type propagation. +;;; function type to the arg and result lvars. We do this now so that +;;; IR1 optimize doesn't have to redundantly do the check later so +;;; that it can do the type propagation. (defun ir1-convert-combination-checking-type (start next result form var) (declare (type ctran start next) (type (or lvar null) result) (list form) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index bca0627..e0477c2 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -52,7 +52,7 @@ (setf (node-next (block-last block)) nil) block)))) -;;;; continuation use hacking +;;;; lvar use hacking ;;; Return a list of all the nodes which use LVAR. (declaim (ftype (sfunction (lvar) list) find-uses)) @@ -68,14 +68,12 @@ (principal-lvar-use (cast-value use)) use))) -;;; Update continuation use information so that NODE is no longer a -;;; use of its CONT. If the old continuation doesn't start its block, -;;; then we don't update the BLOCK-START-USES, since it will be -;;; deleted when we are done. +;;; Update lvar use information so that NODE is no longer a use of its +;;; LVAR. ;;; ;;; Note: if you call this function, you may have to do a -;;; REOPTIMIZE-CONTINUATION to inform IR1 optimization that something -;;; has changed. +;;; REOPTIMIZE-LVAR to inform IR1 optimization that something has +;;; changed. (declaim (ftype (sfunction (node) (values)) delete-lvar-use %delete-lvar-use)) @@ -93,7 +91,8 @@ (setf (lvar-uses lvar) nil)) (setf (node-lvar node) nil))) (values)) -;;; Delete NODE from its LVAR uses. +;;; Delete NODE from its LVAR uses; if LVAR has no other uses, delete +;;; its DEST's block, which must be unreachable. (defun delete-lvar-use (node) (let ((lvar (node-lvar node))) (when lvar @@ -106,13 +105,11 @@ (reoptimize-lvar lvar)))) (values)) -;;; Update continuation use information so that NODE uses CONT. If -;;; CONT is :UNUSED, then we set its block to NODE's NODE-BLOCK (which -;;; must be set.) +;;; Update lvar use information so that NODE uses LVAR. ;;; ;;; Note: if you call this function, you may have to do a -;;; REOPTIMIZE-CONTINUATION to inform IR1 optimization that something -;;; has changed. +;;; REOPTIMIZE-LVAR to inform IR1 optimization that something has +;;; changed. (declaim (ftype (sfunction (node (or lvar null)) (values)) add-lvar-use)) (defun add-lvar-use (node lvar) (aver (not (node-lvar node))) @@ -141,7 +138,7 @@ (next-block (first (block-succ block)))) (block-start-node next-block))))))) -;;;; continuation substitution +;;;; lvar substitution ;;; In OLD's DEST, replace OLD with NEW. NEW's DEST must initially be ;;; NIL. We do not flush OLD's DEST. @@ -428,8 +425,8 @@ (first forms) (values (find-original-source path))))) -;;; Return NODE-SOURCE-FORM, T if continuation has a single use, -;;; otherwise NIL, NIL. +;;; Return NODE-SOURCE-FORM, T if lvar has a single use, otherwise +;;; NIL, NIL. (defun lvar-source (lvar) (let ((use (lvar-uses lvar))) (if (listp use) @@ -1250,7 +1247,7 @@ ;;; arguments. (defun extract-fun-args (lvar fun num-args) #!+sb-doc - "If CONT is a call to FUN with NUM-ARGS args, change those arguments + "If LVAR is a call to FUN with NUM-ARGS args, change those arguments to feed directly to the LVAR-DEST of LVAR, which must be a combination." (declare (type lvar lvar) @@ -1442,8 +1439,8 @@ (aver (functional-letlike-p fun)) (lvar-dest (node-lvar (first (leaf-refs fun))))) -;;; Return the initial value continuation for a LET variable, or NIL -;;; if there is none. +;;; Return the initial value lvar for a LET variable, or NIL if there +;;; is none. (defun let-var-initial-value (var) (declare (type lambda-var var)) (let ((fun (lambda-var-home var))) diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index bb3a23f..ad40031 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -233,10 +233,10 @@ (emit-move ref ir2-block entry res)))) (values)) -;;; Convert a SET node. If the NODE's CONT is annotated, then we also -;;; deliver the value to that continuation. If the var is a lexical -;;; variable with no refs, then we don't actually set anything, since -;;; the variable has been deleted. +;;; Convert a SET node. If the NODE's LVAR is annotated, then we also +;;; deliver the value to that lvar. If the var is a lexical variable +;;; with no refs, then we don't actually set anything, since the +;;; variable has been deleted. (defun ir2-convert-set (node block) (declare (type cset node) (type ir2-block block)) (let* ((lvar (node-lvar node)) @@ -265,17 +265,17 @@ ;;;; utilities for receiving fixed values -;;; Return a TN that can be referenced to get the value of CONT. CONT +;;; Return a TN that can be referenced to get the value of LVAR. LVAR ;;; must be LTN-ANNOTATED either as a delayed leaf ref or as a fixed, -;;; single-value continuation. If a type check is called for, do it. +;;; single-value lvar. ;;; ;;; The primitive-type of the result will always be the same as the -;;; IR2-CONTINUATION-PRIMITIVE-TYPE, ensuring that VOPs are always -;;; called with TNs that satisfy the operand primitive-type -;;; restriction. We may have to make a temporary of the desired type -;;; and move the actual continuation TN into it. This happens when we -;;; delete a type check in unsafe code or when we locally know -;;; something about the type of an argument variable. +;;; IR2-LVAR-PRIMITIVE-TYPE, ensuring that VOPs are always called with +;;; TNs that satisfy the operand primitive-type restriction. We may +;;; have to make a temporary of the desired type and move the actual +;;; lvar TN into it. This happens when we delete a type check in +;;; unsafe code or when we locally know something about the type of an +;;; argument variable. (defun lvar-tn (node block lvar) (declare (type node node) (type ir2-block block) (type lvar lvar)) (let* ((2lvar (lvar-info lvar)) @@ -295,13 +295,13 @@ (emit-move node block lvar-tn temp) temp))))) -;;; This is similar to CONTINUATION-TN, but hacks multiple values. We -;;; return continuations holding the values of CONT with PTYPES as -;;; their primitive types. CONT must be annotated for the same number -;;; of fixed values are there are PTYPES. +;;; This is similar to LVAR-TN, but hacks multiple values. We return +;;; TNs holding the values of LVAR with PTYPES as their primitive +;;; types. LVAR must be annotated for the same number of fixed values +;;; are there are PTYPES. ;;; -;;; If the continuation has a type check, check the values into temps -;;; and return the temps. When we have more values than assertions, we +;;; If the lvar has a type check, check the values into temps and +;;; return the temps. When we have more values than assertions, we ;;; move the extra values with no check. (defun lvar-tns (node block lvar ptypes) (declare (type node node) (type ir2-block block) @@ -319,24 +319,23 @@ locs ptypes))) -;;;; utilities for delivering values to continuations +;;;; utilities for delivering values to lvars ;;; Return a list of TNs with the specifier TYPES that can be used as -;;; result TNs to evaluate an expression into the continuation CONT. -;;; This is used together with MOVE-CONTINUATION-RESULT to deliver -;;; fixed values to a continuation. +;;; result TNs to evaluate an expression into LVAR. This is used +;;; together with MOVE-LVAR-RESULT to deliver fixed values to +;;; an lvar. ;;; -;;; If the continuation isn't annotated (meaning the values are -;;; discarded) or is unknown-values, the then we make temporaries for -;;; each supplied value, providing a place to compute the result in -;;; until we decide what to do with it (if anything.) +;;; If the lvar isn't annotated (meaning the values are discarded) or +;;; is unknown-values, the then we make temporaries for each supplied +;;; value, providing a place to compute the result in until we decide +;;; what to do with it (if anything.) ;;; -;;; If the continuation is fixed-values, and wants the same number of -;;; values as the user wants to deliver, then we just return the -;;; IR2-CONTINUATION-LOCS. Otherwise we make a new list padded as -;;; necessary by discarded TNs. We always return a TN of the specified -;;; type, using the continuation locs only when they are of the -;;; correct type. +;;; If the lvar is fixed-values, and wants the same number of values +;;; as the user wants to deliver, then we just return the +;;; IR2-LVAR-LOCS. Otherwise we make a new list padded as necessary by +;;; discarded TNs. We always return a TN of the specified type, using +;;; the lvar locs only when they are of the correct type. (defun lvar-result-tns (lvar types) (declare (type (or lvar null) lvar) (type list types)) (if (not lvar) @@ -378,13 +377,13 @@ ;;; Return a list of TNs wired to the standard value passing ;;; conventions that can be used to receive values according to the ;;; unknown-values convention. This is used with together -;;; MOVE-CONTINUATION-RESULT for delivering unknown values to a fixed -;;; values continuation. +;;; MOVE-LVAR-RESULT for delivering unknown values to a fixed values +;;; lvar. ;;; -;;; If the continuation isn't annotated, then we treat as 0-values, -;;; returning an empty list of temporaries. +;;; If the lvar isn't annotated, then we treat as 0-values, returning +;;; an empty list of temporaries. ;;; -;;; If the continuation is annotated, then it must be :FIXED. +;;; If the lvar is annotated, then it must be :FIXED. (defun standard-result-tns (lvar) (declare (type (or lvar null) lvar)) (if lvar @@ -433,15 +432,15 @@ (values)) ;;; If necessary, emit coercion code needed to deliver the RESULTS to -;;; the specified continuation. NODE and BLOCK provide context for -;;; emitting code. Although usually obtained from STANDARD-RESULT-TNs -;;; or CONTINUATION-RESULT-TNs, RESULTS my be a list of any type or +;;; the specified lvar. NODE and BLOCK provide context for emitting +;;; code. Although usually obtained from STANDARD-RESULT-TNs or +;;; LVAR-RESULT-TNs, RESULTS my be a list of any type or ;;; number of TNs. ;;; -;;; If the continuation is fixed values, then move the results into -;;; the continuation locations. If the continuation is unknown values, -;;; then do the moves into the standard value locations, and use -;;; PUSH-VALUES to put the values on the stack. +;;; If the lvar is fixed values, then move the results into the lvar +;;; locations. If the lvar is unknown values, then do the moves into +;;; the standard value locations, and use PUSH-VALUES to put the +;;; values on the stack. (defun move-lvar-result (node block results lvar) (declare (type node node) (type ir2-block block) (list results) (type (or lvar null) lvar)) @@ -495,10 +494,10 @@ ;;;; template conversion ;;; Build a TN-REFS list that represents access to the values of the -;;; specified list of continuations ARGS for TEMPLATE. Any :CONSTANT -;;; arguments are returned in the second value as a list rather than -;;; being accessed as a normal argument. NODE and BLOCK provide the -;;; context for emitting any necessary type-checking code. +;;; specified list of lvars ARGS for TEMPLATE. Any :CONSTANT arguments +;;; are returned in the second value as a list rather than being +;;; accessed as a normal argument. NODE and BLOCK provide the context +;;; for emitting any necessary type-checking code. (defun reference-args (node block args template) (declare (type node node) (type ir2-block block) (list args) (type template template)) @@ -552,7 +551,7 @@ test-ref () node t))) ;;; Return a list of primitive-types that we can pass to -;;; CONTINUATION-RESULT-TNS describing the result types we want for a +;;; LVAR-RESULT-TNS describing the result types we want for a ;;; template call. We duplicate here the determination of output type ;;; that was done in initially selecting the template, so we know that ;;; the types we find are allowed by the template output type @@ -579,10 +578,10 @@ types))))) ;;; Return a list of TNs usable in a CALL to TEMPLATE delivering -;;; values to CONT. As an efficiency hack, we pick off the common case -;;; where the continuation is fixed values and has locations that -;;; satisfy the result restrictions. This can fail when there is a -;;; type check or a values count mismatch. +;;; values to LVAR. As an efficiency hack, we pick off the common case +;;; where the LVAR is fixed values and has locations that satisfy the +;;; result restrictions. This can fail when there is a type check or a +;;; values count mismatch. (defun make-template-result-tns (call lvar template rtypes) (declare (type combination call) (type (or lvar null) lvar) (type template template) (list rtypes)) @@ -774,7 +773,7 @@ (values fp nfp temps (mapcar #'make-alias-tn locs))))) ;;; Handle a non-TR known-values local call. We emit the call, then -;;; move the results to the continuation's destination. +;;; move the results to the lvar's destination. (defun ir2-convert-local-known-call (node block fun returns lvar start) (declare (type node node) (type ir2-block block) (type clambda fun) (type return-info returns) (type (or lvar null) lvar) @@ -790,15 +789,15 @@ (values)) ;;; Handle a non-TR unknown-values local call. We do different things -;;; depending on what kind of values the continuation wants. +;;; depending on what kind of values the lvar wants. ;;; -;;; If CONT is :UNKNOWN, then we use the "multiple-" variant, directly -;;; specifying the continuation's LOCS as the VOP results so that we -;;; don't have to do anything after the call. +;;; If LVAR is :UNKNOWN, then we use the "multiple-" variant, directly +;;; specifying the lvar's LOCS as the VOP results so that we don't +;;; have to do anything after the call. ;;; ;;; Otherwise, we use STANDARD-RESULT-TNS to get wired result TNs, and -;;; then call MOVE-CONTINUATION-RESULT to do any necessary type checks -;;; or coercions. +;;; then call MOVE-LVAR-RESULT to do any necessary type checks or +;;; coercions. (defun ir2-convert-local-unknown-call (node block fun lvar start) (declare (type node node) (type ir2-block block) (type clambda fun) (type (or lvar null) lvar) (type label start)) @@ -849,13 +848,13 @@ ;;;; full call -;;; Given a function continuation FUN, return (VALUES TN-TO-CALL -;;; NAMED-P), where TN-TO-CALL is a TN holding the thing that we call -;;; NAMED-P is true if the thing is named (false if it is a function). +;;; Given a function lvar FUN, return (VALUES TN-TO-CALL NAMED-P), +;;; where TN-TO-CALL is a TN holding the thing that we call NAMED-P is +;;; true if the thing is named (false if it is a function). ;;; ;;; There are two interesting non-named cases: ;;; -- We know it's a function. No check needed: return the -;;; continuation LOC. +;;; lvar LOC. ;;; -- We don't know what it is. (defun fun-lvar-tn (node block lvar) (declare (type lvar lvar)) @@ -936,9 +935,8 @@ (values fp first (locs) nargs))))) ;;; Do full call when a fixed number of values are desired. We make -;;; STANDARD-RESULT-TNS for our continuation, then deliver the result -;;; using MOVE-CONTINUATION-RESULT. We do named or normal call, as -;;; appropriate. +;;; STANDARD-RESULT-TNS for our lvar, then deliver the result using +;;; MOVE-LVAR-RESULT. We do named or normal call, as appropriate. (defun ir2-convert-fixed-full-call (node block) (declare (type combination node) (type ir2-block block)) (multiple-value-bind (fp args arg-locs nargs) @@ -1217,9 +1215,9 @@ ;;;; multiple values ;;; This is almost identical to IR2-CONVERT-LET. Since LTN annotates -;;; the lvarinuation for the correct number of values (with the -;;; continuation user responsible for defaulting), we can just pick -;;; them up from the continuation. +;;; the lvarinuation for the correct number of values (with the lvar +;;; user responsible for defaulting), we can just pick them up from +;;; the lvar. (defun ir2-convert-mv-bind (node block) (declare (type mv-combination node) (type ir2-block block)) (let* ((lvar (first (basic-combination-args node))) @@ -1241,7 +1239,7 @@ ;;; Emit the appropriate fixed value, unknown value or tail variant of ;;; CALL-VARIABLE. Note that we only need to pass the values start for -;;; the first argument: all the other argument continuation TNs are +;;; the first argument: all the other argument lvar TNs are ;;; ignored. This is because we require all of the values globs to be ;;; contiguous and on stack top. (defun ir2-convert-mv-call (node block) @@ -1274,15 +1272,15 @@ (move-lvar-result node block locs lvar))))))) ;;; Reset the stack pointer to the start of the specified -;;; unknown-values continuation (discarding it and all values globs on -;;; top of it.) +;;; unknown-values lvar (discarding it and all values globs on top of +;;; it.) (defoptimizer (%pop-values ir2-convert) ((lvar) node block) (let ((2lvar (lvar-info (lvar-value lvar)))) (aver (eq (ir2-lvar-kind 2lvar) :unknown)) (vop reset-stack-pointer node block (first (ir2-lvar-locs 2lvar))))) -;;; Deliver the values TNs to CONT using MOVE-CONTINUATION-RESULT. +;;; Deliver the values TNs to LVAR using MOVE-LVAR-RESULT. (defoptimizer (values ir2-convert) ((&rest values) node block) (let ((tns (mapcar (lambda (x) (lvar-tn node block x)) @@ -1396,8 +1394,8 @@ (find-in-physenv (lvar-value info) (node-physenv node)) (emit-constant 0))) -;;; We have to do a spurious move of no values to the result -;;; continuation so that lifetime analysis won't get confused. +;;; We have to do a spurious move of no values to the result lvar so +;;; that lifetime analysis won't get confused. (defun ir2-convert-throw (node block) (declare (type mv-combination node) (type ir2-block block)) (let ((args (basic-combination-args node))) @@ -1412,9 +1410,9 @@ (values)) ;;; Emit code to set up a non-local exit. INFO is the NLX-INFO for the -;;; exit, and TAG is the continuation for the catch tag (if any.) We -;;; get at the target PC by passing in the label to the vop. The vop -;;; is responsible for building a return-PC object. +;;; exit, and TAG is the lvar for the catch tag (if any.) We get at +;;; the target PC by passing in the label to the vop. The vop is +;;; responsible for building a return-PC object. (defun emit-nlx-start (node block info tag) (declare (type node node) (type ir2-block block) (type nlx-info info) (type (or lvar null) tag)) @@ -1470,18 +1468,17 @@ ;;; Emit the entry code for a non-local exit. We receive values and ;;; restore dynamic state. ;;; -;;; In the case of a lexical exit or CATCH, we look at the exit -;;; continuation's kind to determine which flavor of entry VOP to -;;; emit. If unknown values, emit the xxx-MULTIPLE variant to the -;;; continuation locs. If fixed values, make the appropriate number of -;;; temps in the standard values locations and use the other variant, -;;; delivering the temps to the continuation using -;;; MOVE-CONTINUATION-RESULT. +;;; In the case of a lexical exit or CATCH, we look at the exit lvar's +;;; kind to determine which flavor of entry VOP to emit. If unknown +;;; values, emit the xxx-MULTIPLE variant to the lvar locs. If fixed +;;; values, make the appropriate number of temps in the standard +;;; values locations and use the other variant, delivering the temps +;;; to the lvar using MOVE-LVAR-RESULT. ;;; ;;; In the UNWIND-PROTECT case, we deliver the first register -;;; argument, the argument count and the argument pointer to our -;;; continuation as multiple values. These values are the block exited -;;; to and the values start and count. +;;; argument, the argument count and the argument pointer to our lvar +;;; as multiple values. These values are the block exited to and the +;;; values start and count. ;;; ;;; After receiving values, we restore dynamic state. Except in the ;;; UNWIND-PROTECT case, the values receiving restores the stack diff --git a/src/compiler/lexenv.lisp b/src/compiler/lexenv.lisp index 8ff2674..424eefa 100644 --- a/src/compiler/lexenv.lisp +++ b/src/compiler/lexenv.lisp @@ -47,15 +47,14 @@ (vars nil :type list) ;; BLOCKS and TAGS are alists from block and go-tag names to 2-lists ;; of the form ( ), where is the - ;; continuation to exit to, and is the corresponding ENTRY node. + ;; continuation to exit to, and is the corresponding ENTRY + ;; node. (blocks nil :type list) (tags nil :type list) ;; an alist (THING . CTYPE) which is used to keep track of ;; "pervasive" type declarations. When THING is a leaf, this is for ;; type declarations that pertain to the type in a syntactic extent - ;; which does not correspond to a binding of the affected name. When - ;; THING is a continuation, this is used to track the innermost THE - ;; type declaration. + ;; which does not correspond to a binding of the affected name. (type-restrictions nil :type list) ;; the lexically enclosing lambda, if any ;; diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index bf6507b..4a8ab19 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -948,11 +948,10 @@ (values)) ;;; Actually do LET conversion. We call subfunctions to do most of the -;;; work. We change the CALL's CONT to be the continuation heading the -;;; BIND block, and also do REOPTIMIZE-LVAR on the args and -;;; CONT so that LET-specific IR1 optimizations get a chance. We blow -;;; away any entry for the function in *FREE-FUNS* so that nobody -;;; will create new references to it. +;;; work. We do REOPTIMIZE-LVAR on the args and CALL's lvar so that +;;; LET-specific IR1 optimizations get a chance. We blow away any +;;; entry for the function in *FREE-FUNS* so that nobody will create +;;; new references to it. (defun let-convert (fun call) (declare (type clambda fun) (type basic-combination call)) (let ((next-block (if (node-tail-p call) diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp index 501aaf6..4e7ff47 100644 --- a/src/compiler/ltn.lisp +++ b/src/compiler/ltn.lisp @@ -58,7 +58,7 @@ ((:safe :fast-safe) t) ((:small :fast) nil))) -;;; an annotated continuation's primitive-type +;;; an annotated lvar's primitive-type #!-sb-fluid (declaim (inline lvar-ptype)) (defun lvar-ptype (lvar) (declare (type lvar lvar)) @@ -401,7 +401,7 @@ ;;; T restriction allows any operand type. This is also called by IR2 ;;; translation when it determines whether a result temporary needs to ;;; be made, and by representation selection when it is deciding which -;;; move VOP to use. CONT and TN are used to test for constant +;;; move VOP to use. LVAR and TN are used to test for constant ;;; arguments. (defun operand-restriction-ok (restr type &key lvar tn (t-ok t)) (declare (type (or (member *) cons) restr) @@ -492,7 +492,7 @@ ;;; destination of the value is an immediately following IF node. ;;; -- If either the template is safe or the policy is unsafe (i.e. we ;;; can believe output assertions), then we test against the -;;; intersection of the node derived type and the continuation +;;; intersection of the node derived type and the lvar ;;; asserted type. Otherwise, we just use the node type. If ;;; TYPE-CHECK is null, there is no point in doing the intersection, ;;; since the node type must be a subtype of the assertion. diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index fadd687..98ab8fc 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -41,10 +41,10 @@ ;;; compiler error happens if the syntax is invalid. ;;; ;;; Define a function that converts a special form or other magical -;;; thing into IR1. LAMBDA-LIST is a defmacro style lambda list. -;;; START-VAR and CONT-VAR are bound to the start and result -;;; continuations for the resulting IR1. KIND is the function kind to -;;; associate with NAME. +;;; thing into IR1. LAMBDA-LIST is a defmacro style lambda +;;; list. START-VAR, NEXT-VAR and RESULT-VAR are bound to the start and +;;; result continuations for the resulting IR1. KIND is the function +;;; kind to associate with NAME. (defmacro def-ir1-translator (name (lambda-list start-var next-var result-var &key (kind :special-form)) &body body) @@ -267,15 +267,16 @@ (eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute) ;;; Given a DEFTRANSFORM-style lambda-list, generate code that parses -;;; the arguments of a combination with respect to that lambda-list. -;;; BODY is the the list of forms which are to be evaluated within the -;;; bindings. ARGS is the variable that holds list of argument -;;; continuations. ERROR-FORM is a form which is evaluated when the -;;; syntax of the supplied arguments is incorrect or a non-constant -;;; argument keyword is supplied. Defaults and other gunk are ignored. -;;; The second value is a list of all the arguments bound. We make the -;;; variables IGNORABLE so that we don't have to manually declare them -;;; Ignore if their only purpose is to make the syntax work. +;;; the arguments of a combination with respect to that +;;; lambda-list. BODY is the the list of forms which are to be +;;; evaluated within the bindings. ARGS is the variable that holds +;;; list of argument lvars. ERROR-FORM is a form which is evaluated +;;; when the syntax of the supplied arguments is incorrect or a +;;; non-constant argument keyword is supplied. Defaults and other gunk +;;; are ignored. The second value is a list of all the arguments +;;; bound. We make the variables IGNORABLE so that we don't have to +;;; manually declare them Ignore if their only purpose is to make the +;;; syntax work. (defun parse-deftransform (lambda-list body args error-form) (multiple-value-bind (req opt restp rest keyp keys allowp) (parse-lambda-list lambda-list) @@ -347,11 +348,11 @@ ;;; LAMBDA-LIST for the resulting lambda. ;;; ;;; We parse the call and bind each of the lambda-list variables to -;;; the continuation which represents the value of the argument. When -;;; parsing the call, we ignore the defaults, and always bind the -;;; variables for unsupplied arguments to NIL. If a required argument -;;; is missing, an unknown keyword is supplied, or an argument keyword -;;; is not a constant, then the transform automatically passes. The +;;; the lvar which represents the value of the argument. When parsing +;;; the call, we ignore the defaults, and always bind the variables +;;; for unsupplied arguments to NIL. If a required argument is +;;; missing, an unknown keyword is supplied, or an argument keyword is +;;; not a constant, then the transform automatically passes. The ;;; DECLARATIONS apply to the bindings made by DEFTRANSFORM at ;;; transformation time, rather than to the variables of the resulting ;;; lambda. Bound-but-not-referenced warnings are suppressed for the @@ -378,7 +379,7 @@ ;;; then it is replaced with the new definition. ;;; ;;; These are the legal keyword options: -;;; :RESULT - A variable which is bound to the result continuation. +;;; :RESULT - A variable which is bound to the result lvar. ;;; :NODE - A variable which is bound to the combination node for the call. ;;; :POLICY - A form which is supplied to the POLICY macro to determine ;;; whether this transformation is appropriate. If the result @@ -562,7 +563,7 @@ ((eq ,block-var ,n-head) ,result) ,@body)))) -;;; Iterate over the uses of CONTINUATION, binding NODE to each one +;;; Iterate over the uses of LVAR, binding NODE to each one ;;; successively. ;;; ;;; XXX Could change it not to replicate the code someday perhaps... @@ -577,24 +578,23 @@ ,@body)))))) ;;; Iterate over the nodes in BLOCK, binding NODE-VAR to the each node -;;; and CONT-VAR to the node's CONT. The only keyword option is +;;; and LVAR-VAR to the node's LVAR. The only keyword option is ;;; RESTART-P, which causes iteration to be restarted when a node is ;;; deleted out from under us. (If not supplied, this is an error.) ;;; -;;; In the forward case, we terminate on LAST-CONT so that we don't -;;; have to worry about our termination condition being changed when -;;; new code is added during the iteration. In the backward case, we -;;; do NODE-PREV before evaluating the body so that we can keep going -;;; when the current node is deleted. +;;; In the forward case, we terminate when NODE does not have NEXT, so +;;; that we do not have to worry about our termination condition being +;;; changed when new code is added during the iteration. In the +;;; backward case, we do NODE-PREV before evaluating the body so that +;;; we can keep going when the current node is deleted. ;;; ;;; When RESTART-P is supplied to DO-NODES, we start iterating over -;;; again at the beginning of the block when we run into a -;;; continuation whose block differs from the one we are trying to -;;; iterate over, either because the block was split, or because a -;;; node was deleted out from under us (hence its block is NIL.) If -;;; the block start is deleted, we just punt. With RESTART-P, we are -;;; also more careful about termination, re-indirecting the BLOCK-LAST -;;; each time. +;;; again at the beginning of the block when we run into a ctran whose +;;; block differs from the one we are trying to iterate over, either +;;; because the block was split, or because a node was deleted out +;;; from under us (hence its block is NIL.) If the block start is +;;; deleted, we just punt. With RESTART-P, we are also more careful +;;; about termination, re-indirecting the BLOCK-LAST each time. (defmacro do-nodes ((node-var lvar-var block &key restart-p) &body body) (with-unique-names (n-block n-start) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index f62e112..6a2d2bf 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -1502,7 +1502,7 @@ (namestring input-pathname)))) (when trace-file (let* ((default-trace-file-pathname - (make-pathname :type "ntrace" :defaults input-pathname)) + (make-pathname :type "trace" :defaults input-pathname)) (trace-file-pathname (if (eql trace-file t) default-trace-file-pathname diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index b44d7a2..0025ca5 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -12,20 +12,15 @@ (in-package "SB!C") -;;; The front-end data structure (IR1) is composed of nodes and -;;; continuations. The general idea is that continuations contain -;;; top-down information and nodes contain bottom-up, derived -;;; information. A continuation represents a place in the code, while -;;; a node represents code that does something. -;;; -;;; This representation is more of a flow-graph than an augmented -;;; syntax tree. The evaluation order is explicitly represented in the -;;; linkage by continuations, rather than being implicit in the nodes -;;; which receive the the results of evaluation. This allows us to -;;; decouple the flow of results from the flow of control. A -;;; continuation represents both, but the continuation can represent -;;; the case of a discarded result by having no DEST. +;;; The front-end data structure (IR1) is composed of nodes, +;;; representing actual evaluations. Linear sequences of nodes in +;;; control-flow order are combined into blocks (but see +;;; JOIN-SUCCESSOR-IF-POSSIBLE for precise conditions); control +;;; transfers inside a block are represented with CTRANs and between +;;; blocks -- with BLOCK-SUCC/BLOCK-PRED lists; data transfers are +;;; represented with LVARs. +;;; "Lead-in" Control TRANsfer [to some node] (def!struct (ctran (:make-load-form-fun ignore-it) (:constructor make-ctran)) @@ -41,59 +36,50 @@ ;; has already been determined. ;; ;; :BLOCK-START - ;; The continuation that is the START of BLOCK. This is the only kind - ;; of continuation that can have more than one use. The BLOCK's - ;; START-USES is a list of all the uses. + ;; The continuation that is the START of BLOCK. ;; ;; :INSIDE-BLOCK ;; A continuation that is the NEXT of some node in BLOCK. (kind :unused :type (member :unused :inside-block :block-start)) - ;; If this is a NODE, then it is the node which is to be evaluated - ;; next. This is always null in :DELETED and :UNUSED continuations, - ;; and will be null in a :INSIDE-BLOCK continuation when this is the - ;; CONT of the LAST. + ;; A NODE which is to be evaluated next. Null only temporary. (next nil :type (or node null)) ;; the node where this CTRAN is used, if unique. This is always null - ;; in :DELETED, :UNUSED and :BLOCK-START CTRANs, and is never null - ;; in :INSIDE-BLOCK continuations. + ;; in :UNUSED and :BLOCK-START CTRANs, and is never null in + ;; :INSIDE-BLOCK continuations. (use nil :type (or node null)) ;; the basic block this continuation is in. This is null only in - ;; :DELETED and :UNUSED continuations. Note that blocks that are - ;; unreachable but still in the DFO may receive deleted - ;; continuations, so it isn't o.k. to assume that any continuation - ;; that you pick up out of its DEST node has a BLOCK. - (block nil :type (or cblock null)) - ;; something or other that the back end annotates this continuation with - (info nil)) + ;; :UNUSED continuations. + (block nil :type (or cblock null))) + +(def!method print-object ((x ctran) stream) + (print-unreadable-object (x stream :type t :identity t) + (format stream " #~D" (cont-num x)))) +;;; Linear VARiable. Multiple-value (possibly of unknown number) +;;; temporal storage. (def!struct (lvar (:make-load-form-fun ignore-it) (:constructor make-lvar (&optional dest))) ;; The node which receives this value. NIL only temporarily. (dest nil :type (or node null)) - ;; cached type of this continuation's value. If NIL, then this must - ;; be recomputed: see CONTINUATION-DERIVED-TYPE. + ;; cached type of this lvar's value. If NIL, then this must be + ;; recomputed: see LVAR-DERIVED-TYPE. (%derived-type nil :type (or ctype null)) - ;; the node where this continuation is used, if unique. This is always - ;; null in :DELETED and :UNUSED continuations, and is never null in - ;; :INSIDE-BLOCK continuations. In a :BLOCK-START continuation, the - ;; BLOCK's START-USES indicate whether NIL means no uses or more - ;; than one use. + ;; the node (if unique) or a list of nodes where this lvar is used. (uses nil :type (or node list)) - ;; set to true when something about this continuation's value has - ;; changed. See REOPTIMIZE-CONTINUATION. This provides a way for IR1 + ;; set to true when something about this lvar's value has + ;; changed. See REOPTIMIZE-LVAR. This provides a way for IR1 ;; optimize to determine which operands to a node have changed. If ;; the optimizer for this node type doesn't care, it can elect not ;; to clear this flag. (reoptimize t :type boolean) ;; Cached type which is checked by DEST. If NIL, then this must be - ;; recomputed: see CONTINUATION-EXTERNALLY-CHECKABLE-TYPE. + ;; recomputed: see LVAR-EXTERNALLY-CHECKABLE-TYPE. (%externally-checkable-type nil :type (or null ctype)) - ;; something or other that the back end annotates this continuation with + ;; something or other that the back end annotates this lvar with (info nil)) -#+nil -(def!method print-object ((x continuation) stream) +(def!method print-object ((x lvar) stream) (print-unreadable-object (x stream :type t :identity t) (format stream " #~D" (cont-num x)))) @@ -102,16 +88,15 @@ ;; unique ID for debugging #!+sb-show (id (new-object-id) :read-only t) ;; True if this node needs to be optimized. This is set to true - ;; whenever something changes about the value of a continuation - ;; whose DEST is this node. + ;; whenever something changes about the value of an lvar whose DEST + ;; is this node. (reoptimize t :type boolean) - ;; the continuation which receives the value of this node. This also - ;; indicates what we do controlwise after evaluating this node. This - ;; may be null during IR1 conversion. + ;; the ctran indicating what we do controlwise after evaluating this + ;; node. This is null if the node is the last in its block. (next nil :type (or ctran null)) - ;; the continuation that this node is the NEXT of. This is null - ;; during IR1 conversion when we haven't linked the node in yet or - ;; in nodes that have been deleted from the IR1 by UNLINK-NODE. + ;; the ctran that this node is the NEXT of. This is null during IR1 + ;; conversion when we haven't linked the node in yet or in nodes + ;; that have been deleted from the IR1 by UNLINK-NODE. (prev nil :type (or ctran null)) ;; the lexical environment this node was converted in (lexenv *lexenv* :type lexenv) @@ -155,7 +140,8 @@ (:copier nil)) ;; the bottom-up derived type for this node. (derived-type *wild-type* :type ctype) - ;; may be NIL if the value is unused. + ;; Lvar, receiving the values, produced by this node. May be NIL if + ;; the value is unused. (lvar nil :type (or lvar null))) ;;; Flags that are used to indicate various things about a block, such @@ -164,7 +150,7 @@ ;;; lvar whose DEST is in this block. This indicates that the ;;; value-driven (forward) IR1 optimizations should be done on this block. ;;; -- FLUSH-P is set when code in this block becomes potentially flushable, -;;; usually due to a continuation's DEST becoming null. +;;; usually due to an lvar's DEST becoming null. ;;; -- TYPE-CHECK is true when the type check phase should be run on this ;;; block. IR1 optimize can introduce new blocks after type check has ;;; already run. We need to check these blocks, but there is no point in @@ -174,12 +160,11 @@ ;;; phases should not attempt to examine or modify blocks with DELETE-P ;;; set, since they may: ;;; - be in the process of being deleted, or -;;; - have no successors, or -;;; - receive :DELETED continuations. +;;; - have no successors. ;;; -- TYPE-ASSERTED, TEST-MODIFIED ;;; These flags are used to indicate that something in this block ;;; might be of interest to constraint propagation. TYPE-ASSERTED -;;; is set when a continuation type assertion is strengthened. +;;; is set when an lvar type assertion is strengthened. ;;; TEST-MODIFIED is set whenever the test for the ending IF has ;;; changed (may be true when there is no IF.) (!def-boolean-attribute block @@ -217,10 +202,9 @@ ;; 3. blocks with DELETE-P set (zero) (pred nil :type list) (succ nil :type list) - ;; the ctran which heads this block (either a :BLOCK-START or - ;; :DELETED-BLOCK-START), or NIL when we haven't made the start - ;; ctran yet (and in the dummy component head and tail - ;; blocks) + ;; the ctran which heads this block (a :BLOCK-START), or NIL when we + ;; haven't made the start ctran yet (and in the dummy component head + ;; and tail blocks) (start nil :type (or ctran null)) ;; the last node in this block. This is NIL when we are in the ;; process of building a block (and in the dummy component head and @@ -431,8 +415,8 @@ ;;; The "mess-up" action is explicitly represented by a funny function ;;; call or ENTRY node. ;;; -;;; We guarantee that CLEANUPs only need to be done at block boundaries -;;; by requiring that the exit continuations initially head their +;;; We guarantee that CLEANUPs only need to be done at block +;;; boundaries by requiring that the exit ctrans initially head their ;;; blocks, and then by not merging blocks when there is a cleanup ;;; change. (defstruct (cleanup (:copier nil)) @@ -753,7 +737,7 @@ ;; a lambda that is used in only one local call, and has in ;; effect been substituted directly inline. The return node is ;; deleted, and the result is computed with the actual result - ;; continuation for the call. + ;; lvar for the call. ;; ;; :MV-LET ;; Similar to :LET (as per FUNCTIONAL-LETLIKE-P), but the call @@ -896,10 +880,10 @@ ;; bind (because there are no variables left), but have not yet ;; actually deleted the LAMBDA yet. (bind nil :type (or bind null)) - ;; the RETURN node for this LAMBDA, or NIL if it has been deleted. - ;; This marks the end of the lambda, receiving the result of the - ;; body. In a LET, the return node is deleted, and the body delivers - ;; the value to the actual continuation. The return may also be + ;; the RETURN node for this LAMBDA, or NIL if it has been + ;; deleted. This marks the end of the lambda, receiving the result + ;; of the body. In a LET, the return node is deleted, and the body + ;; delivers the value to the actual lvar. The return may also be ;; deleted if it is unreachable. (return nil :type (or creturn null)) ;; If this CLAMBDA is a LET, then this slot holds the LAMBDA whose @@ -1113,8 +1097,6 @@ leaf) ;;; Naturally, the IF node always appears at the end of a block. -;;; NODE-CONT is a dummy continuation, and is there only to keep -;;; people happy. (defstruct (cif (:include node) (:conc-name if-) (:predicate if-p) @@ -1149,8 +1131,7 @@ ;;; The BASIC-COMBINATION structure is used to represent both normal ;;; and multiple value combinations. In a let-like function call, this ;;; node appears at the end of its block and the body of the called -;;; function appears as the successor. The NODE-CONT remains the -;;; continuation which receives the value of the call. XXX +;;; function appears as the successor; the NODE-LVAR is null. (defstruct (basic-combination (:include valued-node) (:constructor nil) (:copier nil)) @@ -1283,8 +1264,8 @@ ;;; if necessary. This is interposed between the uses of the exit ;;; continuation and the exit continuation's DEST. Instead of using ;;; the returned value being delivered directly to the exit -;;; continuation, it is delivered to our VALUE continuation. The -;;; original exit continuation is the exit node's CONT. +;;; continuation, it is delivered to our VALUE lvar. The original exit +;;; lvar is the exit node's LVAR. (defstruct (exit (:include valued-node) (:copier nil)) ;; the ENTRY node that this is an exit for. If null, this is a diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 58b0327..b531b36 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -122,8 +122,8 @@ bare)))))))) ;;; Return a DO loop, mapping a function FUN to elements of -;;; sequences. SEQS is a list of continuations, SEQ-NAMES - list of -;;; variables, bound to sequences, INTO - a variable, which is used in +;;; sequences. SEQS is a list of lvars, SEQ-NAMES - list of variables, +;;; bound to sequences, INTO - a variable, which is used in ;;; MAP-INTO. RESULT and BODY are forms, which can use variables ;;; FUNCALL-RESULT, containing the result of application of FUN, and ;;; INDEX, containing the current position in sequences. @@ -376,7 +376,7 @@ ;;;; utilities -;;; Return true if CONT's only use is a non-NOTINLINE reference to a +;;; Return true if LVAR's only use is a non-NOTINLINE reference to a ;;; global function with one of the specified NAMES. (defun lvar-fun-is (lvar names) (declare (type lvar lvar) (list names)) @@ -388,9 +388,9 @@ (not (null (member (leaf-source-name leaf) names :test #'equal)))))))) -;;; If CONT is a constant continuation, the return the constant value. -;;; If it is null, then return default, otherwise quietly give up the -;;; IR1 transform. +;;; If LVAR is a constant lvar, the return the constant value. If it +;;; is null, then return default, otherwise quietly give up the IR1 +;;; transform. ;;; ;;; ### Probably should take an ARG and flame using the NAME. (defun constant-value-or-lose (lvar &optional default) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 43e8dbe..48eeb34 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -755,9 +755,9 @@ (flatten-helper (cdr x) r)))))) (flatten-helper x nil))) -;;; Take some type of continuation and massage it so that we get a -;;; list of the constituent types. If ARG is *EMPTY-TYPE*, return NIL -;;; to indicate failure. +;;; Take some type of lvar and massage it so that we get a list of the +;;; constituent types. If ARG is *EMPTY-TYPE*, return NIL to indicate +;;; failure. (defun prepare-arg-for-derive-type (arg) (flet ((listify (arg) (typecase arg @@ -976,11 +976,11 @@ ;;; This is used in defoptimizers for computing the resulting type of ;;; a function. ;;; -;;; Given the continuation ARG, derive the resulting type using the +;;; Given the lvar ARG, derive the resulting type using the ;;; DERIVE-FUN. DERIVE-FUN takes exactly one argument which is some -;;; "atomic" continuation type like numeric-type or member-type -;;; (containing just one element). It should return the resulting -;;; type, which can be a list of types. +;;; "atomic" lvar type like numeric-type or member-type (containing +;;; just one element). It should return the resulting type, which can +;;; be a list of types. ;;; ;;; For the case of member types, if a MEMBER-FUN is given it is ;;; called to compute the result otherwise the member type is first @@ -1029,9 +1029,9 @@ ;;; Same as ONE-ARG-DERIVE-TYPE, except we assume the function takes ;;; two arguments. DERIVE-FUN takes 3 args in this case: the two ;;; original args and a third which is T to indicate if the two args -;;; really represent the same continuation. This is useful for -;;; deriving the type of things like (* x x), which should always be -;;; positive. If we didn't do this, we wouldn't be able to tell. +;;; really represent the same lvar. This is useful for deriving the +;;; type of things like (* x x), which should always be positive. If +;;; we didn't do this, we wouldn't be able to tell. (defun two-arg-derive-type (arg1 arg2 derive-fun fun &optional (convert-type t)) (declare (type function derive-fun fun)) @@ -1079,8 +1079,8 @@ (when (and a1 a2) (let ((results nil)) (if same-arg - ;; Since the args are the same continuation, just run - ;; down the lists. + ;; Since the args are the same LVARs, just run down the + ;; lists. (dolist (x a1) (let ((result (deriver x x same-arg))) (if (listp result) @@ -2400,8 +2400,7 @@ ;;; ;;; and similar for other arguments. -;;; Try to recursively cut all uses of the continuation CONT to WIDTH -;;; bits. +;;; Try to recursively cut all uses of LVAR to WIDTH bits. ;;; ;;; For good functions, we just recursively cut arguments; their ;;; "goodness" means that the result will not increase (in the @@ -2641,8 +2640,8 @@ "convert (* x 0) to 0" 0) -;;; Return T if in an arithmetic op including continuations X and Y, -;;; the result type is not affected by the type of X. That is, Y is at +;;; Return T if in an arithmetic op including lvars X and Y, the +;;; result type is not affected by the type of X. That is, Y is at ;;; least as contagious as X. #+nil (defun not-more-contagious (x y) @@ -2798,7 +2797,7 @@ ;;;; equality predicate transforms -;;; Return true if X and Y are continuations whose only use is a +;;; Return true if X and Y are lvars whose only use is a ;;; reference to the same leaf, and the value of the leaf cannot ;;; change. (defun same-leaf-ref-p (x y) @@ -2896,7 +2895,7 @@ (give-up-ir1-transform "The operands might not be the same type.")))) -;;; If CONT's type is a numeric type, then return the type, otherwise +;;; If LVAR's type is a numeric type, then return the type, otherwise ;;; GIVE-UP-IR1-TRANSFORM. (defun numeric-type-or-lose (lvar) (declare (type lvar lvar)) @@ -3203,9 +3202,9 @@ ;;; "optimizer" (say, DEFOPTIMIZER CONSISTENCY-CHECK). ;;; ;;; FIXME II: In some cases, type information could be correlated; for -;;; instance, ~{ ... ~} requires a list argument, so if the -;;; continuation-type of a corresponding argument is known and does -;;; not intersect the list type, a warning could be signalled. +;;; instance, ~{ ... ~} requires a list argument, so if the lvar-type +;;; of a corresponding argument is known and does not intersect the +;;; list type, a warning could be signalled. (defun check-format-args (string args fun) (declare (type string string)) (unless (typep string 'simple-string) @@ -3572,15 +3571,15 @@ ;;; for debugging when transforms are behaving mysteriously, ;;; e.g. when debugging a problem with an ASH transform ;;; (defun foo (&optional s) -;;; (sb-c::/report-continuation s "S outside WHEN") +;;; (sb-c::/report-lvar s "S outside WHEN") ;;; (when (and (integerp s) (> s 3)) -;;; (sb-c::/report-continuation s "S inside WHEN") +;;; (sb-c::/report-lvar s "S inside WHEN") ;;; (let ((bound (ash 1 (1- s)))) -;;; (sb-c::/report-continuation bound "BOUND") +;;; (sb-c::/report-lvar bound "BOUND") ;;; (let ((x (- bound)) ;;; (y (1- bound))) -;;; (sb-c::/report-continuation x "X") -;;; (sb-c::/report-continuation x "Y")) +;;; (sb-c::/report-lvar x "X") +;;; (sb-c::/report-lvar x "Y")) ;;; `(integer ,(- bound) ,(1- bound))))) ;;; (The DEFTRANSFORM doesn't do anything but report at compile time, ;;; and the function doesn't do anything at all.) diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp index 894a8cb..b71a128 100644 --- a/src/compiler/stack.lisp +++ b/src/compiler/stack.lisp @@ -1,6 +1,6 @@ ;;;; This file implements the stack analysis phase in the compiler. We -;;;; do a graph walk to determine which unknown-values continuations -;;;; are on the stack at each point in the program, and then we insert +;;;; do a graph walk to determine which unknown-values lvars are on +;;;; the stack at each point in the program, and then we insert ;;;; cleanup code to pop off unused values. ;;;; This software is part of the SBCL system. See the README file for @@ -14,9 +14,9 @@ (in-package "SB!C") -;;; Scan through BLOCK looking for uses of :UNKNOWN continuations that -;;; have their DEST outside of the block. We do some checking to -;;; verify the invariant that all pushes come after the last pop. +;;; Scan through BLOCK looking for uses of :UNKNOWN lvars that have +;;; their DEST outside of the block. We do some checking to verify the +;;; invariant that all pushes come after the last pop. (defun find-pushed-lvars (block) (let* ((2block (block-info block)) (popped (ir2-block-popped 2block)) @@ -44,24 +44,23 @@ ;;;; annotation graph walk ;;; Do a backward walk in the flow graph simulating the run-time stack -;;; of unknown-values continuations and annotating the blocks with the -;;; result. +;;; of unknown-values lvars and annotating the blocks with the result. ;;; ;;; BLOCK is the block that is currently being walked and STACK is the -;;; stack of unknown-values continuations in effect immediately after +;;; stack of unknown-values lvars in effect immediately after ;;; block. We simulate the stack by popping off the unknown-values -;;; generated by this block (if any) and pushing the continuations for +;;; generated by this block (if any) and pushing the lvars for ;;; values received by this block. (The role of push and pop are ;;; interchanged because we are doing a backward walk.) ;;; -;;; If we run into a values generator whose continuation isn't on +;;; If we run into a values generator whose lvar isn't on ;;; stack top, then the receiver hasn't yet been reached on any walk ;;; to this use. In this case, we ignore the push for now, counting on ;;; Annotate-Dead-Values to clean it up if we discover that it isn't ;;; reachable at all. ;;; ;;; If our final stack isn't empty, then we walk all the predecessor -;;; blocks that don't have all the continuations that we have on our +;;; blocks that don't have all the lvars that we have on our ;;; START-STACK on their END-STACK. This is our termination condition ;;; for the graph walk. We put the test around the recursive call so ;;; that the initial call to this function will do something even @@ -113,19 +112,19 @@ (values)) ;;; Do stack annotation for any values generators in Block that were -;;; unreached by all walks (i.e. the continuation isn't live at the point that +;;; unreached by all walks (i.e. the lvar isn't live at the point that ;;; it is generated.) This will only happen when the values receiver cannot be ;;; reached from this particular generator (due to an unconditional control ;;; transfer.) ;;; -;;; What we do is push on the End-Stack all continuations in Pushed that +;;; What we do is push on the End-Stack all lvars in Pushed that ;;; aren't already present in the End-Stack. When we find any pushed -;;; continuation that isn't live, it must be the case that all continuations +;;; lvar that isn't live, it must be the case that all lvars ;;; pushed after (on top of) it aren't live. ;;; -;;; If we see a pushed continuation that is the CONT of a tail call, then we -;;; ignore it, since the tail call didn't actually push anything. The tail -;;; call must always the last in the block. +;;; If we see a pushed lvar that is the LVAR of a tail call, then we +;;; ignore it, since the tail call didn't actually push anything. The +;;; tail call must always the last in the block. (defun annotate-dead-values (block) (declare (type cblock block)) (let* ((2block (block-info block)) @@ -147,20 +146,20 @@ (values)) ;;; This is called when we discover that the stack-top unknown-values -;;; continuation at the end of BLOCK1 is different from that at the -;;; start of BLOCK2 (its successor). +;;; lvar at the end of BLOCK1 is different from that at the start of +;;; BLOCK2 (its successor). ;;; ;;; We insert a call to a funny function in a new cleanup block ;;; introduced between BLOCK1 and BLOCK2. Since control analysis and ;;; LTN have already run, we must do make an IR2 block, then do -;;; ADD-TO-EMIT-ORDER and LTN-ANALYZE-BELATED-BLOCK on the new block. -;;; The new block is inserted after BLOCK1 in the emit order. +;;; ADD-TO-EMIT-ORDER and LTN-ANALYZE-BELATED-BLOCK on the new +;;; block. The new block is inserted after BLOCK1 in the emit order. ;;; ;;; If the control transfer between BLOCK1 and BLOCK2 represents a -;;; tail-recursive return (:DELETED IR2-continuation) or a non-local -;;; exit, then the cleanup code will never actually be executed. It -;;; doesn't seem to be worth the risk of trying to optimize this, -;;; since this rarely happens and wastes only space. +;;; tail-recursive return or a non-local exit, then the cleanup code +;;; will never actually be executed. It doesn't seem to be worth the +;;; risk of trying to optimize this, since this rarely happens and +;;; wastes only space. (defun discard-unused-values (block1 block2) (declare (type cblock block1 block2)) (let* ((block1-stack (ir2-block-end-stack (block-info block1))) @@ -183,9 +182,9 @@ ;;;; stack analysis -;;; Return a list of all the blocks containing genuine uses of one of the -;;; RECEIVERS. Exits are excluded, since they don't drop through to the -;;; receiver. +;;; Return a list of all the blocks containing genuine uses of one of +;;; the RECEIVERS. Exits are excluded, since they don't drop through +;;; to the receiver. (defun find-values-generators (receivers) (declare (list receivers)) (collect ((res nil adjoin)) @@ -196,11 +195,11 @@ (res (node-block use)))))) (res))) -;;; Analyze the use of unknown-values continuations in COMPONENT, -;;; inserting cleanup code to discard values that are generated but -;;; never received. This phase doesn't need to be run when -;;; Values-Receivers is null, i.e. there are no unknown-values -;;; continuations used across block boundaries. +;;; Analyze the use of unknown-values lvars in COMPONENT, inserting +;;; cleanup code to discard values that are generated but never +;;; received. This phase doesn't need to be run when Values-Receivers +;;; is null, i.e. there are no unknown-values lvars used across block +;;; boundaries. ;;; ;;; Do the backward graph walk, starting at each values receiver. We ;;; ignore receivers that already have a non-null START-STACK. These diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index 09c0fb5..a1592a6 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -182,5 +182,10 @@ (min -7580 (max (logand a 31365125) d))))) +;;; compiler failure "NIL is not of type LVAR" +(defun #:foo (x) + (progn (truly-the integer x) + (1+ x))) + (sb-ext:quit :unix-status 104) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index c1cb8f6..dd8e2e3 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -587,7 +587,7 @@ ;;; Alpha floating point modes weren't being reset after an exception, ;;; leading to an exception on the second compile, below. (compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y))) -(handler-bind ((arithmetic-error #'abort)) +(handler-case (/ 1.0 0.0) ;; provoke an exception - (/ 1.0 0.0)) + (arithmetic-error ())) (compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y))) diff --git a/version.lisp-expr b/version.lisp-expr index d0e3fab..2cfb8ac 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".) -"0.8.3.69" +"0.8.3.70"