From: William Harold Newman Date: Thu, 7 Feb 2002 20:37:51 +0000 (+0000) Subject: (I didn't have convenient access to the Internet for almost a week, so X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;p=sbcl.git (I didn't have convenient access to the Internet for almost a week, so these versions just piled up on my computer and then I checked 'em into CVS all at once.) 0.7.1.5: made TRANSFORM-CALL provide more informative DEBUG-NAMEs factored out COMBINATION-FUN-SOURCE-NAME and used it to support this 0.7.1.6: tweaked comments (hunted fruitlessly for bug 147 fix) 0.7.1.7: (hunted fruitlessly for bug 148 fix) rewrote MAYBE-EXPAND to try to increase clarity 0.7.1.8: factored out FUNCTIONAL-SOMEWHAT-LETLIKE-P and FUNCTIONAL-LETLIKE-P fixed part of the misbehavior in the bug 148 test case (but not bug 148 itself, alas) by removing the assumption that non-null FUNCTIONAL-KIND implies FUNCTIONAL-SOMEWHAT-LETLIKE-P 0.7.1.9: still trying to fix bug 148... ...stopped MAYBE-REANALYZE-FUN from trying to reanalyze :DELETED functionals s/maybe-reanalyze-fun/maybe-reanalyze-functional/ s/reanalyze-funs/reanalyze-functionals/ s/new-funs/new-functionals/ 0.7.1.10: still trying to fix bug 148... ...IR2-CONVERT-CLOSURE shouldn't be called on :DELETED functionals! ...Given that the :DELETED functional is making it all the way to the IR2-CONVERT-CLOSURE stage, maybe the failure in MAYBE-REANALYZE-FUNCTIONAL that I made go away in 0.7.1.9 was a good thing. Reinstate it, though more clearly (as "shouldn't be reanalyzing :DELETED functional" rather than a type error when trying to find the COMPONENT of a LAMBDA) than before. ...stopped IR2-CONVERT-CLOSURE from trying to intensively check CLAMBDA-to-COMPONENT relationship invariants for :DELETED CLAMBDAs made INVALID-FREE-FUN-P return true for :DELETED FUNCTIONALs just on general principles 0.7.1.11: s/local-call-lossage/locall-already-let-converted/ various puttering and tidying trying to understand bug 148 specifically and code deletion generally 0.7.1.12: Having walked through the bug 148 problem more carefully, I can see that before KIDIFY1 is deleted, it's first LET converted. Ergo, a :DELETED value is consistent with LET conversion after all, so... ...relaxed the change in IR1-CONVERT-LOCAL-COMBINATION made in 0.7.1.8, so that now :DELETED is assumed to be due to LET conversion after all 0.7.1.13: made :ENCAPSULATE T the default for TRACE, since the breakpoint-based version still doesn't work reliably and since the ANSI description of TRACE is partial to tracing named things anyway --- diff --git a/BUGS b/BUGS index 37156e8..8ee4891 100644 --- a/BUGS +++ b/BUGS @@ -137,6 +137,8 @@ WORKAROUND: (defclass ccc () ()) (setf (find-class 'ccc1) (find-class 'ccc)) (defmethod zut ((c ccc1)) 123) + In sbcl-0.7.1.13, this gives an error, + There is no class named CCC1. DTC's recommended workaround from the mailing list 3 Mar 2000: (setf (pcl::find-class 'ccc1) (pcl::find-class 'ccc)) @@ -1248,7 +1250,7 @@ WORKAROUND: it with only one entry in LEAF-REFS. 148: - In sbcl-0.7.1.3 on x86, COMPILE-FILE on this file + In sbcl-0.7.1.3 on x86, COMPILE-FILE on the file (in-package :cl-user) (defvar *thing*) (defvar *zoom*) @@ -1269,8 +1271,20 @@ WORKAROUND: fails with debugger invoked on condition of type TYPE-ERROR: The value NIL is not of type SB-C::NODE. - in IR1-OPTIMIZE-BLOCK. - + The location of this failure has moved around as various related + issues were cleaned up. As of sbcl-0.7.1.9, it occurs in + NODE-BLOCK called by LAMBDA-COMPONENT called by IR2-CONVERT-CLOSURE. + +149: + (reported by Stig E Sandoe sbcl-devel 2002-02-02) + In sbcl-0.7.1.13, compiling a DEFCLASS FOO form isn't enough to make + the class known to the compiler for other forms compiled in the same + file, so bogus warnings "undefined type: FOO" are generated, e.g. + when compiling + (in-package :cl-user) + (defclass foo () ()) + (defun bar (x) + (typep x 'foo)) DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/NEWS b/NEWS index 411186e..d0b5a6f 100644 --- a/NEWS +++ b/NEWS @@ -1004,6 +1004,23 @@ changes in sbcl-0.7.1 relative to sbcl-0.7.0: needed now that the byte interpreter is gone) caused the fasl file format number to change again. +changes in sbcl-0.7.2 relative to sbcl-0.7.1: + ?? incompatible change: The compiler is now less aggressive about + tail call optimization, doing it only when (> SPACE DEBUG). (This + is an incompatible change because there are programs which depended + on the old CMU-CL-style behavior to optimize away their unbounded + recursion which will now die of stack overflow.) + * several changes related to debugging: + ?? suppression of tail recursion, as noted above + ** The default implementation of TRACE has changed. :ENCAPSULATE T + is now the default. (For some time encapsulation has been more + reliable than the breakpoint-based :ENCAPSULATE NIL + implementation, at least on X86 systems; and I just noticed that + encapsulation also seems closer to the spirit of the ANSI + specification.) + ?? TRACE :ENCAPSULATE T now attaches a more informative debug + name to its wrapper function objects than it used to + planned incompatible changes in 0.7.x: * When the profiling interface settles down, maybe in 0.7.x, maybe later, it might impact TRACE. They both encapsulate functions, and diff --git a/TODO b/TODO index 4ca9685..2f07eb5 100644 --- a/TODO +++ b/TODO @@ -19,6 +19,7 @@ for early 0.7.x: (so that slam.sh will run faster and also just because ideally everything would be in cold init) ** profiled and tweaked +* fixed (TRACE :REPORT PROFILE ...) interface to profiling * more EVAL/EVAL-WHEN/%COMPILE/DEFUN/DEFSTRUCT cleanup: ** made %COMPILE understand magicality of DEFUN FOO w.r.t. e.g. preexisting inlineness of FOO @@ -32,15 +33,11 @@ for early 0.7.x: are now implemented as closures (because they're structure slot accessors) won't be so nasty in the debugger - ** %SLOT-ACCESSOR/%SLOT-ACCESSOR stuff can probably go away, - since we inline expand all slot accessors into - %INSTANCE-REF and the optimizer knows all it needs - to know about that. * rewrote long-standing confusing error restarts for redefining DEFSTRUCTs * outstanding embarrassments ** cut-and-pasted DEF-BOOLEAN-ATTRIBUTE (maybe easier to fix - now that EVAL-WHEN does what it should..) + now that EVAL-WHEN works correctly..) ** incomplete manual ** :IGNORE-ERRORS-P cruft in stems-and-flags.lisp-expr. (It's reasonable to support this as a crutch when initially @@ -151,7 +148,7 @@ are still welcome!) until after 1.0: out of scope. (However, it still might be possible to determine that some or all of them are hopelessly stale and delete them.) -=============================================================================== +======================================================================= other known issues with no particular target date: bugs listed on the man page diff --git a/clean.sh b/clean.sh index 29af859..57c4fb9 100755 --- a/clean.sh +++ b/clean.sh @@ -23,16 +23,16 @@ rm -rf obj/* output/* doc/user-manual \ # standard clean.sh file.) # Ask some other directories to clean themselves up. -pwd=`pwd` +original_pwd=`pwd` for d in tools-for-build; do - cd $d + cd $d > /dev/null # I hope the -s option is standard. At least GNU make and BSD make # support it. It silences make, since otherwise the output from # this script is just the operations done by these make's, which # is misleading when this script does lotso other operations too. # -- WHN make -s clean - cd $pwd + cd $original_pwd > /dev/null done # Within all directories, remove things which don't look like source diff --git a/make-host-2.sh b/make-host-2.sh index 5e5c8e2..59afc86 100644 --- a/make-host-2.sh +++ b/make-host-2.sh @@ -29,7 +29,7 @@ rm -f output/after-xc.core # that we used to compile it: # (1) It reduces the chance that the cross-compilation process # inadvertently comes to depend on some weird compile-time -# side-effect. +# side effect. # (2) It reduces peak memory demand (because definitions wrapped in # (EVAL-WHEN (:COMPILE-TOPLEVEL :EXECUTE) ..) aren't defined # in the fresh image). diff --git a/make.sh b/make.sh index 756d173..73b3295 100755 --- a/make.sh +++ b/make.sh @@ -1,4 +1,4 @@ -#!/bin/sh +'#!/bin/sh # "When we build software, it's a good idea to have a reliable method # for getting an executable from it. We want any two reconstructions diff --git a/src/code/dyncount.lisp b/src/code/dyncount.lisp index 3761a48..76a0399 100644 --- a/src/code/dyncount.lisp +++ b/src/code/dyncount.lisp @@ -186,7 +186,7 @@ comments from CMU CL: #!+sb-doc "Return a hash-table mapping string VOP names to VOP-STATS structures describing the VOPs executed. If clear is true, then reset all counts to - zero as a side-effect." + zero as a side effect." (locally (declare (optimize (speed 3) (safety 0)) (inline sb!vm::map-allocated-objects)) diff --git a/src/code/loop.lisp b/src/code/loop.lisp index d003809..ed24692 100644 --- a/src/code/loop.lisp +++ b/src/code/loop.lisp @@ -326,7 +326,7 @@ code to be loaded. (setf (gethash (car x) ht) (cadr x)))) ht)))) -;;;; SETQ hackery +;;;; SETQ hackery, including destructuring ("DESETQ") (defun loop-make-psetq (frobs) (and frobs @@ -345,10 +345,10 @@ code to be loaded. (make-symbol "LOOP-DESETQ-TEMP")) (sb!int:defmacro-mundanely loop-really-desetq (&environment env - &rest var-val-pairs) + &rest var-val-pairs) (labels ((find-non-null (var) - ;; see whether there's any non-null thing here - ;; recurse if the list element is itself a list + ;; See whether there's any non-null thing here. Recurse + ;; if the list element is itself a list. (do ((tail var)) ((not (consp tail)) tail) (when (find-non-null (pop tail)) (return t)))) (loop-desetq-internal (var val &optional temp) @@ -356,10 +356,10 @@ code to be loaded. (typecase var (null (when (consp val) - ;; Don't lose possible side-effects. + ;; Don't lose possible side effects. (if (eq (car val) 'prog1) - ;; These can come from psetq or desetq below. - ;; Throw away the value, keep the side-effects. + ;; These can come from PSETQ or DESETQ below. + ;; Throw away the value, keep the side effects. ;; Special case is for handling an expanded POP. (mapcan (lambda (x) (and (consp x) @@ -390,7 +390,7 @@ code to be loaded. ,@body) `((let ((,temp ,val)) ,@body)))) - ;; no cdring to do + ;; no CDRing to do (loop-desetq-internal car `(car ,val) temp))))) (otherwise (unless (eq var val) diff --git a/src/code/ntrace.lisp b/src/code/ntrace.lisp index a5a4e44..6535280 100644 --- a/src/code/ntrace.lisp +++ b/src/code/ntrace.lisp @@ -29,7 +29,7 @@ "If the trace indentation exceeds this value, then indentation restarts at 0.") -(defvar *trace-encapsulate-default* :default +(defvar *trace-encapsulate-default* nil #+sb-doc "the default value for the :ENCAPSULATE option to TRACE") diff --git a/src/code/package.lisp b/src/code/package.lisp index b290abb..e71f345 100644 --- a/src/code/package.lisp +++ b/src/code/package.lisp @@ -56,8 +56,9 @@ ;;; KLUDGE: We use DEF!STRUCT to define this not because we need to ;;; manipulate target package objects on the cross-compilation host, ;;; but only because its MAKE-LOAD-FORM function needs to be hooked -;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system. The DEF!STRUCT -;;; side-effect of defining a new PACKAGE type on the +;;; into the pre-CLOS DEF!STRUCT MAKE-LOAD-FORM system so that we can +;;; compile things like IN-PACKAGE in warm init before CLOS is set up. +;;; The DEF!STRUCT side effect of defining a new PACKAGE type on the ;;; cross-compilation host is just a nuisance, and in order to avoid ;;; breaking the cross-compilation host, we need to work around it ;;; around by putting the new PACKAGE type (and the PACKAGEP predicate diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp index 2acd3cb..3807d6e 100644 --- a/src/compiler/alpha/call.lisp +++ b/src/compiler/alpha/call.lisp @@ -575,20 +575,20 @@ default-value-8 ;;; Named is true if the first argument is a symbol whose global ;;; function definition is to be called. ;;; -;;; Return is either :Fixed, :Unknown or :Tail: -;;; -- If :Fixed, then the call is for a fixed number of values, returned in -;;; the standard passing locations (passed as result operands). -;;; -- If :Unknown, then the result values are pushed on the stack, and the -;;; result values are specified by the Start and Count as in the +;;; Return is either :FIXED, :UNKNOWN or :TAIL: +;;; -- If :FIXED, then the call is for a fixed number of values, returned +;;; in the standard passing locations (passed as result operands). +;;; -- If :UNKNOWN, then the result values are pushed on the stack, and +;;; the result values are specified by the Start and Count as in the ;;; unknown-values continuation representation. -;;; -- If :Tail, then do a tail-recursive call. No values are returned. +;;; -- If :TAIL, then do a tail-recursive call. No values are returned. ;;; The Ocfp and Return-PC are passed as the second and third arguments. ;;; ;;; In non-tail calls, the pointer to the stack arguments is passed as ;;; the last fixed argument. If Variable is false, then the passing ;;; locations are passed as a more arg. Variable is true if there are ;;; a variable number of arguments passed on the stack. Variable -;;; cannot be specified with :Tail return. TR variable argument call +;;; cannot be specified with :TAIL return. TR variable argument call ;;; is implemented separately. ;;; ;;; In tail call with fixed arguments, the passing locations are diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp index 237906a..f7375d9 100644 --- a/src/compiler/checkgen.lisp +++ b/src/compiler/checkgen.lisp @@ -361,7 +361,7 @@ ;; said that somewhere in here we ;; Set the new block's start and end cleanups to the *start* ;; cleanup of PREV's block. This overrides the incorrect - ;; default from WITH-BELATED-IR1-ENVIRONMENT. + ;; default from WITH-IR1-ENVIRONMENT-FROM-NODE. ;; Unfortunately I can't find any code which corresponds to this. ;; Perhaps it was a stale comment? Or perhaps I just don't ;; understand.. -- WHN 19990521 diff --git a/src/compiler/control.lisp b/src/compiler/control.lisp index 9259a02..5df3e2f 100644 --- a/src/compiler/control.lisp +++ b/src/compiler/control.lisp @@ -163,7 +163,7 @@ block-info-constructor))))))) (values)) -;;; Do control analysis on Component, finding the emit order. Our only +;;; Do control analysis on COMPONENT, finding the emit order. Our only ;;; cleverness here is that we walk XEP's first to increase the ;;; probability that the tail call will be a drop-through. ;;; diff --git a/src/compiler/debug-dump.lisp b/src/compiler/debug-dump.lisp index a69a7fc..7d4d71c 100644 --- a/src/compiler/debug-dump.lisp +++ b/src/compiler/debug-dump.lisp @@ -240,7 +240,7 @@ ;;; Return a list of DEBUG-SOURCE structures containing information ;;; derived from INFO. Unless :BYTE-COMPILE T was specified, we always -;;; dump the Start-Positions, since it is too hard figure out whether +;;; dump the START-POSITIONS, since it is too hard figure out whether ;;; we need them or not. (defun debug-source-for-info (info) (declare (type source-info info)) diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp index 9e543c2..a500fa2 100644 --- a/src/compiler/debug.lisp +++ b/src/compiler/debug.lisp @@ -84,7 +84,8 @@ (dolist (c components) (let* ((head (component-head c)) (tail (component-tail c))) - (unless (and (null (block-pred head)) (null (block-succ tail))) + (unless (and (null (block-pred head)) + (null (block-succ tail))) (barf "~S is malformed." c)) (do ((prev nil block) @@ -178,7 +179,7 @@ (barf "The function for XEP ~S has kind." functional)) (unless (eq (functional-entry-fun fun) functional) (barf "bad back-pointer in function for XEP ~S" functional)))) - ((:let :mv-let :assignment) + ((:let :mv-let :assignment) ; i.e. SOMEWHAT-LETLIKE-P (check-fun-reached (lambda-home functional) functional) (when (functional-entry-fun functional) (barf "The LET ~S has entry function." functional)) @@ -245,7 +246,7 @@ (defun check-fun-consistency (components) (dolist (c components) - (dolist (new-fun (component-new-funs c)) + (dolist (new-fun (component-new-functionals c)) (observe-functional new-fun)) (dolist (fun (component-lambdas c)) (when (eq (functional-kind fun) :external) @@ -257,7 +258,7 @@ (observe-functional let)))) (dolist (c components) - (dolist (new-fun (component-new-funs c)) + (dolist (new-fun (component-new-functionals c)) (check-fun-stuff new-fun)) (dolist (fun (component-lambdas c)) (when (eq (functional-kind fun) :deleted) diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp index ca91eab..a22339d 100644 --- a/src/compiler/dfo.lisp +++ b/src/compiler/dfo.lisp @@ -69,9 +69,10 @@ (setf (component-lambdas new) (nconc (component-lambdas old) (component-lambdas new))) (setf (component-lambdas old) nil) - (setf (component-new-funs new) (nconc (component-new-funs old) - (component-new-funs new)) - (component-new-funs old) nil) + (setf (component-new-functionals new) + (nconc (component-new-functionals old) + (component-new-functionals new))) + (setf (component-new-functionals old) nil) (dolist (xp (block-pred old-tail)) (unlink-blocks xp old-tail) diff --git a/src/compiler/disassem.lisp b/src/compiler/disassem.lisp index 1477c4c..0e59665 100644 --- a/src/compiler/disassem.lisp +++ b/src/compiler/disassem.lisp @@ -1479,7 +1479,7 @@ (declare (ignorable #'local-filter #'local-extract) (inline (setf local-filtered-value) local-filter local-extract)) - ;; Use them for side-effects only. + ;; Use them for side effects only. (let* ,(make-arg-temp-bindings funstate) ,@(forms))))))))) diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index 3053069..acec941 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -12,7 +12,7 @@ (in-package "SB!C") -;;;; control special forms +;;;; special forms for control (def-ir1-translator progn ((&rest forms) start cont) #!+sb-doc @@ -84,7 +84,6 @@ (push env-entry (continuation-lexenv-uses cont)) (ir1-convert-progn-body dummy cont forms)))) - (def-ir1-translator return-from ((name &optional value) start cont) #!+sb-doc "Return-From Block-Name Value-Form diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 259bc77..822178a 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -233,11 +233,6 @@ ;;; and doing IR1 optimizations. We can ignore all blocks that don't ;;; have the REOPTIMIZE flag set. If COMPONENT-REOPTIMIZE is true when ;;; we are done, then another iteration would be beneficial. -;;; -;;; We delete blocks when there is either no predecessor or the block -;;; is in a lambda that has been deleted. These blocks would -;;; eventually be deleted by DFO recomputation, but doing it here -;;; immediately makes the effect available to IR1 optimization. (defun ir1-optimize (component) (declare (type component component)) (setf (component-reoptimize component) nil) @@ -270,48 +265,58 @@ (aver (not (block-delete-p block))) (ir1-optimize-block block)) + ;; We delete blocks when there is either no predecessor or the + ;; block is in a lambda that has been deleted. These blocks + ;; would eventually be deleted by DFO recomputation, but doing + ;; it here immediately makes the effect available to IR1 + ;; optimization. (when (and (block-flush-p block) (block-component block)) (aver (not (block-delete-p block))) (flush-dead-code block))))) (values)) -;;; Loop over the nodes in BLOCK, looking for stuff that needs to be -;;; optimized. We dispatch off of the type of each node with its -;;; reoptimize flag set: - -;;; -- With a COMBINATION, we call PROPAGATE-FUN-CHANGE whenever -;;; the function changes, and call IR1-OPTIMIZE-COMBINATION if any -;;; argument changes. -;;; -- With an EXIT, we derive the node's type from the VALUE's type. -;;; We don't propagate CONT's assertion to the VALUE, since if we -;;; did, this would move the checking of CONT's assertion to the -;;; exit. This wouldn't work with CATCH and UWP, where the EXIT -;;; node is just a placeholder for the actual unknown exit. +;;; Loop over the nodes in BLOCK, acting on (and clearing) REOPTIMIZE +;;; flags. ;;; -;;; Note that we clear the node & block reoptimize flags *before* -;;; doing the optimization. This ensures that the node or block will -;;; be reoptimized if necessary. We leave the NODE-OPTIMIZE flag set -;;; going into IR1-OPTIMIZE-RETURN, since IR1-OPTIMIZE-RETURN wants to -;;; clear the flag itself. +;;; Note that although they are cleared here, REOPTIMIZE flags might +;;; still be set upon return from this function, meaning that further +;;; optimization is wanted (as a consequence of optimizations we did). (defun ir1-optimize-block (block) (declare (type cblock block)) + ;; We clear the node and block REOPTIMIZE flags before doing the + ;; optimization, not after. This ensures that the node or block will + ;; be reoptimized if necessary. (setf (block-reoptimize block) nil) (do-nodes (node cont block :restart-p t) (when (node-reoptimize node) + ;; As above, we clear the node REOPTIMIZE flag before optimizing. (setf (node-reoptimize node) nil) (typecase node (ref) (combination + ;; With a COMBINATION, we call PROPAGATE-FUN-CHANGE whenever + ;; the function changes, and call IR1-OPTIMIZE-COMBINATION if + ;; any argument changes. (ir1-optimize-combination node)) (cif (ir1-optimize-if node)) (creturn + ;; KLUDGE: We leave the NODE-OPTIMIZE flag set going into + ;; IR1-OPTIMIZE-RETURN, since IR1-OPTIMIZE-RETURN wants to + ;; clear the flag itself. -- WHN 2002-02-02, quoting original + ;; CMU CL comments (setf (node-reoptimize node) t) (ir1-optimize-return node)) (mv-combination (ir1-optimize-mv-combination node)) (exit + ;; With an EXIT, we derive the node's type from the VALUE's + ;; type. We don't propagate CONT's assertion to the VALUE, + ;; since if we did, this would move the checking of CONT's + ;; assertion to the exit. This wouldn't work with CATCH and + ;; UWP, where the EXIT node is just a placeholder for the + ;; actual unknown exit. (let ((value (exit-value node))) (when value (derive-node-type node (continuation-derived-type value))))) @@ -321,21 +326,6 @@ ;;; Try to join with a successor block. If we succeed, we return true, ;;; otherwise false. -;;; -;;; We cannot combine with a successor block if: -;;; 1. The successor has more than one predecessor. -;;; 2. The last node's CONT is also used somewhere else. -;;; 3. The successor is the current block (infinite loop). -;;; 4. The next block has a different cleanup, and thus we may want -;;; to insert cleanup code between the two blocks at some point. -;;; 5. The next block has a different home lambda, and thus the -;;; control transfer is a non-local exit. -;;; -;;; Joining is easy when the successor's START continuation is the -;;; same from our LAST's CONT. If they differ, then we can still join -;;; when the last continuation has no next and the next continuation -;;; has no uses. In this case, we replace the next continuation with -;;; the last before joining the blocks. (defun join-successor-if-possible (block) (declare (type cblock block)) (let ((next (first (block-succ block)))) @@ -343,22 +333,39 @@ (let* ((last (block-last block)) (last-cont (node-cont last)) (next-cont (block-start next))) - (cond ((or (rest (block-pred next)) - (not (eq (continuation-use last-cont) last)) - (eq next block) - (not (eq (block-end-cleanup block) - (block-start-cleanup next))) - (not (eq (block-home-lambda block) - (block-home-lambda next)))) + (cond (;; We cannot combine with a successor block if: + (or + ;; The successor has more than one predecessor. + (rest (block-pred next)) + ;; The last node's CONT is also used somewhere else. + (not (eq (continuation-use last-cont) last)) + ;; The successor is the current block (infinite loop). + (eq next block) + ;; The next block has a different cleanup, and thus + ;; we may want to insert cleanup code between the + ;; two blocks at some point. + (not (eq (block-end-cleanup block) + (block-start-cleanup next))) + ;; The next block has a different home lambda, and + ;; thus the control transfer is a non-local exit. + (not (eq (block-home-lambda block) + (block-home-lambda next)))) nil) + ;; Joining is easy when the successor's START + ;; continuation is the same from our LAST's CONT. ((eq last-cont next-cont) (join-blocks block next) t) + ;; If they differ, then we can still join when the last + ;; continuation has no next and the next continuation + ;; has no uses. ((and (null (block-start-uses next)) (eq (continuation-kind last-cont) :inside-block)) + ;; In this case, we replace the next + ;; continuation with the last before joining the blocks. (let ((next-node (continuation-next next-cont))) ;; If NEXT-CONT does have a dest, it must be - ;; unreachable, since there are no uses. + ;; unreachable, since there are no USES. ;; DELETE-CONTINUATION will mark the dest block as ;; DELETE-P [and also this block, unless it is no ;; longer backward reachable from the dest block.] @@ -407,13 +414,9 @@ (values)) -;;; Delete any nodes in BLOCK whose value is unused and have no -;;; side-effects. We can delete sets of lexical variables when the set +;;; Delete any nodes in BLOCK whose value is unused and which have no +;;; side effects. We can delete sets of lexical variables when the set ;;; variable has no references. -;;; -;;; [### For now, don't delete potentially flushable calls when they -;;; have the CALL attribute. Someday we should look at the functional -;;; args to determine if they have any side-effects.] (defun flush-dead-code (block) (declare (type cblock block)) (do-nodes-backwards (node cont block) @@ -427,6 +430,11 @@ (when (fun-info-p info) (let ((attr (fun-info-attributes info))) (when (and (ir1-attributep attr flushable) + ;; ### For now, don't delete potentially + ;; flushable calls when they have the CALL + ;; attribute. Someday we should look at the + ;; functional args to determine if they have + ;; any side effects. (not (ir1-attributep attr call))) (flush-dest (combination-fun node)) (dolist (arg (combination-args node)) @@ -618,9 +626,9 @@ ;;; This function attempts to delete an exit node, returning true if ;;; it deletes the block as a consequence: -;;; -- If the exit is degenerate (has no Entry), then we don't do +;;; -- If the exit is degenerate (has no ENTRY), then we don't do ;;; anything, since there is nothing to be done. -;;; -- If the exit node and its Entry have the same home lambda then +;;; -- If the exit node and its ENTRY have the same home lambda then ;;; we know the exit is local, and can delete the exit. We change ;;; uses of the Exit-Value to be uses of the original continuation, ;;; then unlink the node. If the exit is to a TR context, then we @@ -699,9 +707,7 @@ ;; cross-compiler can't fold it because the ;; cross-compiler doesn't know how to evaluate it. #+sb-xc-host - (let* ((ref (continuation-use (combination-fun node))) - (fun-name (leaf-source-name (ref-leaf ref)))) - (fboundp fun-name))) + (fboundp (combination-fun-source-name node))) (constant-fold-call node) (return-from ir1-optimize-combination))) @@ -940,7 +946,8 @@ (transform-call call `(lambda ,dummies (,(leaf-source-name leaf) - ,@dummies))))))))))) + ,@dummies)) + (leaf-source-name leaf)))))))))) (values)) ;;;; known function optimization @@ -992,7 +999,9 @@ (valid-fun-use node type :strict-result t)) (multiple-value-bind (severity args) (catch 'give-up-ir1-transform - (transform-call node (funcall fun node)) + (transform-call node + (funcall fun node) + (combination-fun-source-name node)) (values :none nil)) (ecase severity (:none @@ -1088,21 +1097,31 @@ (setf (component-reoptimize (block-component block)) t))))))) reoptimize)) - ;;; Take the lambda-expression RES, IR1 convert it in the proper ;;; environment, and then install it as the function for the call ;;; NODE. We do local call analysis so that the new function is ;;; integrated into the control flow. -(defun transform-call (node res) +;;; +;;; We require the original function source name in order to generate +;;; a meaningful debug name for the lambda we set up. (It'd be +;;; possible to do this starting from debug names as well as source +;;; names, but as of sbcl-0.7.1.5, there was no need for this +;;; generality, since source names are always known to our callers.) +(defun transform-call (node res source-name) (declare (type combination node) (list res)) + (aver (and (legal-fun-name-p source-name) + (not (eql source-name '.anonymous.)))) (with-ir1-environment-from-node node (let ((new-fun (ir1-convert-inline-lambda res - :debug-name "something inlined in TRANSFORM-CALL")) - (ref (continuation-use (combination-fun node)))) - (change-ref-leaf ref new-fun) - (setf (combination-kind node) :full) - (locall-analyze-component *current-component*))) + :debug-name (debug-namify "LAMBDA-inlined ~A" + (as-debug-name + source-name + "")))) + (ref (continuation-use (combination-fun node)))) + (change-ref-leaf ref new-fun) + (setf (combination-kind node) :full) + (locall-analyze-component *current-component*))) (values)) ;;; Replace a call to a foldable function of constant arguments with @@ -1114,24 +1133,21 @@ ;;; call a :ERROR call. ;;; ;;; If there is more than one value, then we transform the call into a -;;; values form. +;;; VALUES form. (defun constant-fold-call (call) - (declare (type combination call)) - (let* ((args (mapcar #'continuation-value (combination-args call))) - (ref (continuation-use (combination-fun call))) - (fun-name (leaf-source-name (ref-leaf ref)))) - + (let ((args (mapcar #'continuation-value (combination-args call))) + (fun-name (combination-fun-source-name call))) (multiple-value-bind (values win) (careful-call fun-name args call "constant folding") (if (not win) - (setf (combination-kind call) :error) - (let ((dummies (make-gensym-list (length args)))) - (transform-call - call - `(lambda ,dummies - (declare (ignore ,@dummies)) - (values ,@(mapcar (lambda (x) `',x) values)))))))) - + (setf (combination-kind call) :error) + (let ((dummies (make-gensym-list (length args)))) + (transform-call + call + `(lambda ,dummies + (declare (ignore ,@dummies)) + (values ,@(mapcar (lambda (x) `',x) values))) + fun-name))))) (values)) ;;;; local call optimization @@ -1205,7 +1221,7 @@ ;;; -- the var's DEST has a different policy than the ARG's (think safety). ;;; ;;; 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 +;;; let it be flushed as dead code. A side effect of this substitution ;;; is to delete the variable. (defun substitute-single-use-continuation (arg var) (declare (type continuation arg) (type lambda-var var)) @@ -1239,15 +1255,15 @@ ;;; 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. -(defun delete-let (fun) - (declare (type clambda fun)) - (aver (member (functional-kind fun) '(:let :mv-let))) - (note-unreferenced-vars fun) - (let ((call (let-combination fun))) +(defun delete-let (clambda) + (declare (type clambda clambda)) + (aver (functional-letlike-p clambda)) + (note-unreferenced-vars clambda) + (let ((call (let-combination clambda))) (flush-dest (basic-combination-fun call)) (unlink-node call) - (unlink-node (lambda-bind fun)) - (setf (lambda-bind fun) nil)) + (unlink-node (lambda-bind clambda)) + (setf (lambda-bind clambda) nil)) (values)) ;;; This function is called when one of the arguments to a LET diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 77c5165..3151b25 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -81,7 +81,7 @@ ;;; predicate didn't exist. ;;; ;;; This predicate was added to fix bug 138 in SBCL. In some obscure -;;; circumstances, it was possible for a *FREE-FUNS* to contain a +;;; circumstances, it was possible for a *FREE-FUNS* entry to contain a ;;; DEFINED-FUN whose DEFINED-FUN-FUNCTIONAL object contained IR1 ;;; stuff (NODEs, BLOCKs...) referring to an already compiled (aka ;;; "dead") component. When this IR1 stuff was reused in a new @@ -96,24 +96,27 @@ ;; (sbcl-0.pre7.118) is this one: (and (defined-fun-p free-fun) (let ((functional (defined-fun-functional free-fun))) - (and (lambda-p functional) - (or - ;; (The main reason for this first test is to bail out - ;; early in cases where the LAMBDA-COMPONENT call in - ;; the second test would fail because links it needs - ;; are uninitialized or invalid.) - ;; - ;; If the BIND node for this LAMBDA is null, then - ;; according to the slot comments, the LAMBDA has been - ;; deleted or its call has been deleted. In that case, - ;; it seems rather questionable to reuse it, and - ;; certainly it shouldn't be necessary to reuse it, so - ;; we cheerfully declare it invalid. - (null (lambda-bind functional)) - ;; If this IR1 stuff belongs to a dead component, then - ;; we can't reuse it without getting into bizarre - ;; confusion. - (eql (component-info (lambda-component functional)) :dead)))))) + (or (and functional + (eql (functional-kind functional) :deleted)) + (and (lambda-p functional) + (or + ;; (The main reason for this first test is to bail + ;; out early in cases where the LAMBDA-COMPONENT + ;; call in the second test would fail because links + ;; it needs are uninitialized or invalid.) + ;; + ;; If the BIND node for this LAMBDA is null, then + ;; according to the slot comments, the LAMBDA has + ;; been deleted or its call has been deleted. In + ;; that case, it seems rather questionable to reuse + ;; it, and certainly it shouldn't be necessary to + ;; reuse it, so we cheerfully declare it invalid. + (null (lambda-bind functional)) + ;; If this IR1 stuff belongs to a dead component, + ;; then we can't reuse it without getting into + ;; bizarre confusion. + (eql (component-info (lambda-component functional)) + :dead))))))) ;;; If NAME already has a valid entry in *FREE-FUNS*, then return ;;; the value. Otherwise, make a new GLOBAL-VAR using information from @@ -503,26 +506,28 @@ (use-continuation res cont))) (values))) -;;; Add FUN to the COMPONENT-REANALYZE-FUNS, unless it's some trivial -;;; type for which reanalysis is a trivial no-op, or unless it doesn't -;;; belong in this component at all. +;;; Add FUNCTIONAL to the COMPONENT-REANALYZE-FUNCTIONALS, unless it's +;;; some trivial type for which reanalysis is a trivial no-op, or +;;; unless it doesn't belong in this component at all. ;;; -;;; FUN is returned. -(defun maybe-reanalyze-fun (fun) - (declare (type functional fun)) +;;; FUNCTIONAL is returned. +(defun maybe-reanalyze-functional (functional) + (aver (not (eql (functional-kind functional) :deleted))) ; bug 148 (aver-live-component *current-component*) - ;; When FUN is of a type for which reanalysis isn't a trivial no-op - (when (typep fun '(or optional-dispatch clambda)) + ;; When FUNCTIONAL is of a type for which reanalysis isn't a trivial + ;; no-op + (when (typep functional '(or optional-dispatch clambda)) - ;; When FUN knows its component - (when (lambda-p fun) - (aver (eql (lambda-component fun) *current-component*))) + ;; When FUNCTIONAL knows its component + (when (lambda-p functional) + (aver (eql (lambda-component functional) *current-component*))) - (pushnew fun (component-reanalyze-funs *current-component*))) + (pushnew functional + (component-reanalyze-functionals *current-component*))) - fun) + functional) ;;; Generate a REF node for LEAF, frobbing the LEAF structure as ;;; needed. If LEAF represents a defined function which has already @@ -533,9 +538,10 @@ (let* ((leaf (or (and (defined-fun-p leaf) (not (eq (defined-fun-inlinep leaf) :notinline)) - (let ((fun (defined-fun-functional leaf))) - (when (and fun (not (functional-kind fun))) - (maybe-reanalyze-fun fun)))) + (let ((functional (defined-fun-functional leaf))) + (when (and functional + (not (functional-kind functional))) + (maybe-reanalyze-functional functional)))) leaf)) (res (make-ref (or (lexenv-find leaf type-restrictions) (leaf-type leaf)) @@ -805,15 +811,40 @@ (setf (continuation-%type-check fun-cont) nil))) (values)) -;;; Convert a call to a local function. If the function has already -;;; been LET converted, then throw FUN to LOCAL-CALL-LOSSAGE. This -;;; should only happen when we are converting inline expansions for -;;; local functions during optimization. -(defun ir1-convert-local-combination (start cont form fun) - (if (functional-kind fun) - (throw 'local-call-lossage fun) - (ir1-convert-combination start cont form - (maybe-reanalyze-fun fun)))) +;;; Convert a call to a local function, or if the function has already +;;; been LET converted, then throw FUNCTIONAL to +;;; LOCALL-ALREADY-LET-CONVERTED. The THROW should only happen when we +;;; are converting inline expansions for local functions during +;;; optimization. +(defun ir1-convert-local-combination (start cont form functional) + + ;; The test here is for "when LET converted", as a translation of + ;; the old CMU CL comments into code. Unfortunately, the old CMU CL + ;; comments aren't specific enough to tell whether the correct + ;; translation is FUNCTIONAL-SOMEWHAT-LETLIKE-P or + ;; FUNCTIONAL-LETLIKE-P or what. The old CMU CL code assumed that + ;; any non-null FUNCTIONAL-KIND meant that the function "had been + ;; LET converted", which might even be right, but seems fragile, so + ;; we try to be pickier. + (when (or + ;; looks LET-converted + (functional-somewhat-letlike-p functional) + ;; It's possible for a LET-converted function to end up + ;; deleted later. In that case, for the purposes of this + ;; analysis, it is LET-converted: LET-converted functionals + ;; are too badly trashed to expand them inline, and deleted + ;; LET-converted functionals are even worse. + (eql (functional-kind functional) :deleted)) + (throw 'locall-already-let-converted functional)) + ;; Any other non-NIL KIND value is a case we haven't found a + ;; justification for, and at least some such values (e.g. :EXTERNAL + ;; and :TOPLEVEL) seem obviously wrong. + (aver (null (functional-kind functional))) + + (ir1-convert-combination start + cont + form + (maybe-reanalyze-functional functional))) ;;;; PROCESS-DECLS @@ -839,9 +870,9 @@ (setf found (cdr var))))) found)) -;;; Called by Process-Decls to deal with a variable type declaration. -;;; If a lambda-var being bound, we intersect the type with the vars -;;; type, otherwise we add a type-restriction on the var. If a symbol +;;; Called by PROCESS-DECLS to deal with a variable type declaration. +;;; If a LAMBDA-VAR being bound, we intersect the type with the var's +;;; type, otherwise we add a type restriction on the var. If a symbol ;;; macro, we just wrap a THE around the expansion. (defun process-type-decl (decl res vars) (declare (list decl vars) (type lexenv res)) @@ -1361,8 +1392,8 @@ ;;; Create a lambda node out of some code, returning the result. The ;;; bindings are specified by the list of VAR structures VARS. We deal ;;; with adding the names to the LEXENV-VARS for the conversion. The -;;; result is added to the NEW-FUNS in the *CURRENT-COMPONENT* and -;;; linked to the component head and tail. +;;; result is added to the NEW-FUNCTIONALS in the *CURRENT-COMPONENT* +;;; and linked to the component head and tail. ;;; ;;; We detect special bindings here, replacing the original VAR in the ;;; lambda list with a temporary variable. We then pass a list of the @@ -1449,7 +1480,7 @@ (link-blocks block (component-tail *current-component*)))))) (link-blocks (component-head *current-component*) (node-block bind)) - (push lambda (component-new-funs *current-component*)) + (push lambda (component-new-functionals *current-component*)) lambda)) @@ -1727,7 +1758,7 @@ :aux-vars (append (bind-vars) aux-vars) :aux-vals (append (bind-vals) aux-vals) :result cont - :debug-name (debug-namify "varargs entry point for ~A" + :debug-name (debug-namify "varargs entry for ~A" (as-debug-name source-name debug-name)))) (last-entry (convert-optional-entry main-entry default-vars @@ -1864,7 +1895,7 @@ :%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*)) + (push res (component-new-functionals *current-component*)) (ir1-convert-hairy-args res () () () () vars nil body aux-vars aux-vals cont source-name debug-name) (setf (optional-dispatch-min-args res) min) diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index fd32077..2e1d354 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -192,13 +192,13 @@ (let* ((head (component-head *current-component*)) (next (block-next head)) (new-block (make-block cont))) - (setf (block-next new-block) next) - (setf (block-prev new-block) head) - (setf (block-prev next) new-block) - (setf (block-next head) new-block) - (setf (continuation-block cont) new-block) - (setf (continuation-use cont) nil) - (setf (continuation-kind cont) :block-start) + (setf (block-next new-block) next + (block-prev new-block) head + (block-prev next) new-block + (block-next head) new-block + (continuation-block cont) new-block + (continuation-use cont) nil + (continuation-kind cont) :block-start) new-block)) (:block-start (continuation-block cont)))) @@ -488,7 +488,7 @@ (values)) ;;; Add BLOCK to the next/prev chain following AFTER. We also set the -;;; Component to be the same as for AFTER. +;;; COMPONENT to be the same as for AFTER. (defun add-to-dfo (block after) (declare (type cblock block after)) (let ((next (block-next after)) @@ -568,18 +568,14 @@ ;;;; deleting stuff -;;; Deal with deleting the last (read) reference to a LAMBDA-VAR. We -;;; iterate over all local calls flushing the corresponding argument, -;;; allowing the computation of the argument to be deleted. We also -;;; mark the let for reoptimization, since it may be that we have -;;; deleted the last variable. -;;; -;;; The LAMBDA-VAR may still have some SETs, but this doesn't cause -;;; too much difficulty, since we can efficiently implement write-only -;;; variables. We iterate over the sets, marking their blocks for dead -;;; code flushing, since we can delete sets whose value is unused. +;;; Deal with deleting the last (read) reference to a LAMBDA-VAR. (defun delete-lambda-var (leaf) (declare (type lambda-var leaf)) + + ;; Iterate over all local calls flushing the corresponding argument, + ;; allowing the computation of the argument to be deleted. We also + ;; mark the LET for reoptimization, since it may be that we have + ;; deleted its last variable. (let* ((fun (lambda-var-home leaf)) (n (position leaf (lambda-vars fun)))) (dolist (ref (leaf-refs fun)) @@ -594,17 +590,22 @@ (flush-dest arg) (setf (elt args n) nil)))))) + ;; The LAMBDA-VAR may still have some SETs, but this doesn't cause + ;; too much difficulty, since we can efficiently implement + ;; write-only variables. We iterate over the SETs, marking their + ;; blocks for dead code flushing, since we can delete SETs whose + ;; value is unused. (dolist (set (lambda-var-sets leaf)) (setf (block-flush-p (node-block set)) t)) (values)) -;;; Note that something interesting has happened to VAR. We only deal -;;; with LET variables, marking the corresponding initial value arg as -;;; needing to be reoptimized. +;;; Note that something interesting has happened to VAR. (defun reoptimize-lambda-var (var) (declare (type lambda-var var)) (let ((fun (lambda-var-home var))) + ;; We only deal with LET variables, marking the corresponding + ;; initial value arg as needing to be reoptimized. (when (and (eq (functional-kind fun) :let) (leaf-refs var)) (do ((args (basic-combination-args @@ -628,58 +629,60 @@ (clambda (delete-lambda fun))) (values)) -;;; Deal with deleting the last reference to a LAMBDA. Since there is -;;; only one way into a LAMBDA, deleting the last reference to a -;;; LAMBDA ensures that there is no way to reach any of the code in +;;; Deal with deleting the last reference to a CLAMBDA. Since there is +;;; only one way into a CLAMBDA, deleting the last reference to a +;;; CLAMBDA ensures that there is no way to reach any of the code in ;;; it. So we just set the FUNCTIONAL-KIND for FUN and its LETs to ;;; :DELETED, causing IR1 optimization to delete blocks in that -;;; lambda. -;;; -;;; If the function isn't a LET, we unlink the function head and tail -;;; from the component head and tail to indicate that the code is -;;; unreachable. We also delete the function from COMPONENT-LAMBDAS -;;; (it won't be there before local call analysis, but no matter.) If -;;; the lambda was never referenced, we give a note. -;;; -;;; If the lambda is an XEP, then we null out the ENTRY-FUN in its -;;; ENTRY-FUN so that people will know that it is not an entry point -;;; anymore. -(defun delete-lambda (leaf) - (declare (type clambda leaf)) - (let ((kind (functional-kind leaf)) - (bind (lambda-bind leaf))) - (aver (not (member kind '(:deleted :optional :toplevel)))) - (aver (not (functional-has-external-references-p leaf))) - (setf (functional-kind leaf) :deleted) - (setf (lambda-bind leaf) nil) - (dolist (let (lambda-lets leaf)) +;;; CLAMBDA. +(defun delete-lambda (clambda) + (declare (type clambda clambda)) + (let ((original-kind (functional-kind clambda)) + (bind (lambda-bind clambda))) + (aver (not (member original-kind '(:deleted :optional :toplevel)))) + (aver (not (functional-has-external-references-p clambda))) + (setf (functional-kind clambda) :deleted) + (setf (lambda-bind clambda) nil) + (dolist (let (lambda-lets clambda)) (setf (lambda-bind let) nil) (setf (functional-kind let) :deleted)) - (if (member kind '(:let :mv-let :assignment)) - (let ((home (lambda-home leaf))) - (setf (lambda-lets home) (delete leaf (lambda-lets home)))) + ;; (The IF test is (FUNCTIONAL-SOMEWHAT-LETLIKE-P CLAMBDA), except + ;; that we're using the old value of the KIND slot, not the + ;; current slot value, which has now been set to :DELETED.) + (if (member original-kind '(:let :mv-let :assignment)) + (let ((home (lambda-home clambda))) + (setf (lambda-lets home) (delete clambda (lambda-lets home)))) + ;; If the function isn't a LET, we unlink the function head + ;; and tail from the component head and tail to indicate that + ;; the code is unreachable. We also delete the function from + ;; COMPONENT-LAMBDAS (it won't be there before local call + ;; analysis, but no matter.) If the lambda was never + ;; referenced, we give a note. (let* ((bind-block (node-block bind)) (component (block-component bind-block)) - (return (lambda-return leaf))) - (aver (null (leaf-refs leaf))) - (unless (leaf-ever-used leaf) + (return (lambda-return clambda))) + (aver (null (leaf-refs clambda))) + (unless (leaf-ever-used clambda) (let ((*compiler-error-context* bind)) (compiler-note "deleting unused function~:[.~;~:*~% ~S~]" - (leaf-debug-name leaf)))) + (leaf-debug-name clambda)))) (unlink-blocks (component-head component) bind-block) (when return (unlink-blocks (node-block return) (component-tail component))) (setf (component-reanalyze component) t) - (let ((tails (lambda-tail-set leaf))) + (let ((tails (lambda-tail-set clambda))) (setf (tail-set-funs tails) - (delete leaf (tail-set-funs tails))) - (setf (lambda-tail-set leaf) nil)) + (delete clambda (tail-set-funs tails))) + (setf (lambda-tail-set clambda) nil)) (setf (component-lambdas component) - (delete leaf (component-lambdas component))))) + (delete clambda (component-lambdas component))))) - (when (eq kind :external) - (let ((fun (functional-entry-fun leaf))) + ;; If the lambda is an XEP, then we null out the ENTRY-FUN in its + ;; ENTRY-FUN so that people will know that it is not an entry + ;; point anymore. + (when (eq original-kind :external) + (let ((fun (functional-entry-fun clambda))) (setf (functional-entry-fun fun) nil) (when (optional-dispatch-p fun) (delete-optional-dispatch fun))))) @@ -699,11 +702,11 @@ ;;; entry-points, making them be normal lambdas, and then deleting the ;;; ones with no references. This deletes any e-p lambdas that were ;;; either never referenced, or couldn't be deleted when the last -;;; deference was deleted (due to their :OPTIONAL kind.) +;;; reference was deleted (due to their :OPTIONAL kind.) ;;; -;;; Note that the last optional ep may alias the main entry, so when -;;; we process the main entry, its kind may have been changed to NIL -;;; or even converted to a let. +;;; Note that the last optional entry point may alias the main entry, +;;; so when we process the main entry, its KIND may have been changed +;;; to NIL or even converted to a LETlike value. (defun delete-optional-dispatch (leaf) (declare (type optional-dispatch leaf)) (let ((entry (functional-entry-fun leaf))) @@ -750,7 +753,7 @@ (clambda (ecase (functional-kind leaf) ((nil :let :mv-let :assignment :escape :cleanup) - (aver (not (functional-entry-fun leaf))) + (aver (null (functional-entry-fun leaf))) (delete-lambda leaf)) (:external (delete-lambda leaf)) @@ -775,7 +778,7 @@ ;;; containing uses of CONT and set COMPONENT-REOPTIMIZE. If the PREV ;;; of the use is deleted, then we blow off reoptimization. ;;; -;;; If the continuation is :Deleted, then we don't do anything, since +;;; If the continuation is :DELETED, then we don't do anything, since ;;; all semantics have already been flushed. :DELETED-BLOCK-START ;;; start continuations are treated just like :BLOCK-START; it is ;;; possible that the continuation may be given a new dest (e.g. by @@ -892,9 +895,10 @@ ;; Guards COMBINATION-LAMBDA agains the REF being deleted. (continuation-use (basic-combination-fun node))) (let ((fun (combination-lambda node))) - ;; If our REF was the 2'nd to last ref, and has been deleted, then - ;; Fun may be a LET for some other combination. - (when (and (member (functional-kind fun) '(:let :mv-let)) + ;; If our REF was the second-to-last ref, and has been + ;; deleted, then FUN may be a LET for some other + ;; combination. + (when (and (functional-letlike-p fun) (eq (let-combination fun) node)) (delete-lambda fun)))) (flush-dest (basic-combination-fun node)) @@ -903,7 +907,7 @@ (bind (let ((lambda (bind-lambda node))) (unless (eq (functional-kind lambda) :deleted) - (aver (member (functional-kind lambda) '(:let :mv-let :assignment))) + (aver (functional-somewhat-letlike-p lambda)) (delete-lambda lambda)))) (exit (let ((value (exit-value node)) @@ -1114,7 +1118,7 @@ ;;; triggered by deletion. (defun delete-component (component) (declare (type component component)) - (aver (null (component-new-funs component))) + (aver (null (component-new-functionals component))) (setf (component-kind component) :deleted) (do-blocks (block component) (setf (block-delete-p block) t)) @@ -1287,10 +1291,16 @@ nil)) nil))) +;;; Return the source name of a combination. (This is an idiom +;;; which was used in CMU CL. I gather it always works. -- WHN) +(defun combination-fun-source-name (combination) + (let ((ref (continuation-use (combination-fun combination)))) + (leaf-source-name (ref-leaf ref)))) + ;;; Return the COMBINATION node that is the call to the LET FUN. (defun let-combination (fun) (declare (type clambda fun)) - (aver (member (functional-kind fun) '(:let :mv-let))) + (aver (functional-letlike-p fun)) (continuation-dest (node-cont (first (leaf-refs fun))))) ;;; Return the initial value continuation for a LET variable, or NIL diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp index 7f79467..7e42924 100644 --- a/src/compiler/ir2tran.lisp +++ b/src/compiler/ir2tran.lisp @@ -152,69 +152,71 @@ (move-continuation-result node block locs cont)) (values)) -;;; Emit code to load a function object implementing FUN into +;;; some sanity checks for a CLAMBDA passed to IR2-CONVERT-CLOSURE +(defun assertions-on-ir2-converted-clambda (clambda) + ;; This assertion was sort of an experiment. It would be nice and + ;; sane and easier to understand things if it were *always* true, + ;; but experimentally I observe that it's only *almost* always + ;; true. -- WHN 2001-01-02 + #+nil + (aver (eql (lambda-component clambda) + (block-component (ir2-block-block ir2-block)))) + ;; Check for some weirdness which came up in bug + ;; 138, 2002-01-02. + ;; + ;; The MAKE-LOAD-TIME-CONSTANT-TN call above puts an :ENTRY record + ;; into the IR2-COMPONENT-CONSTANTS table. The dump-a-COMPONENT + ;; code + ;; * treats every HANDLEless :ENTRY record into a + ;; patch, and + ;; * expects every patch to correspond to an + ;; IR2-COMPONENT-ENTRIES record. + ;; The IR2-COMPONENT-ENTRIES records are set by ENTRY-ANALYZE + ;; walking over COMPONENT-LAMBDAS. Bug 138b arose because there + ;; was a HANDLEless :ENTRY record which didn't correspond to an + ;; IR2-COMPONENT-ENTRIES record. That problem is hard to debug + ;; when it's caught at dump time, so this assertion tries to catch + ;; it here. + (aver (member clambda + (component-lambdas (lambda-component clambda)))) + ;; another bug-138-related issue: COMPONENT-NEW-FUNCTIONALS is + ;; used as a queue for stuff pending to do in IR1, and now that + ;; we're doing IR2 it should've been completely flushed (but + ;; wasn't). + (aver (null (component-new-functionals (lambda-component clambda)))) + (values)) + +;;; Emit code to load a function object implementing FUNCTIONAL into ;;; RES. This gets interesting when the referenced function is a ;;; closure: we must make the closure and move the closed-over values ;;; into it. ;;; -;;; FUN is either a :TOPLEVEL-XEP functional or the XEP lambda for the -;;; called function, since local call analysis converts all closure -;;; references. If a :TOPLEVEL-XEP, we know it is not a closure. +;;; FUNCTIONAL is either a :TOPLEVEL-XEP functional or the XEP lambda +;;; for the called function, since local call analysis converts all +;;; closure references. If a :TOPLEVEL-XEP, we know it is not a +;;; closure. ;;; ;;; If a closed-over LAMBDA-VAR has no refs (is deleted), then we ;;; don't initialize that slot. This can happen with closures over ;;; top level variables, where optimization of the closure deleted the ;;; variable. Since we committed to the closure format when we ;;; pre-analyzed the top level code, we just leave an empty slot. -(defun ir2-convert-closure (ref ir2-block fun res) - (declare (type ref ref) (type ir2-block ir2-block) - (type functional fun) (type tn res)) - - (unless (leaf-info fun) - (setf (leaf-info fun) - (make-entry-info :name (functional-debug-name fun)))) - (let ((entry (make-load-time-constant-tn :entry fun)) - (closure (etypecase fun +(defun ir2-convert-closure (ref ir2-block functional res) + (declare (type ref ref) + (type ir2-block ir2-block) + (type functional functional) + (type tn res)) + (aver (not (eql (functional-kind functional) :deleted))) + (unless (leaf-info functional) + (setf (leaf-info functional) + (make-entry-info :name (functional-debug-name functional)))) + (let ((entry (make-load-time-constant-tn :entry functional)) + (closure (etypecase functional (clambda - - ;; This assertion was sort of an experiment. It - ;; would be nice and sane and easier to understand - ;; things if it were *always* true, but - ;; experimentally I observe that it's only - ;; *almost* always true. -- WHN 2001-01-02 - #+nil - (aver (eql (lambda-component fun) - (block-component (ir2-block-block ir2-block)))) - - ;; Check for some weirdness which came up in bug - ;; 138, 2002-01-02. - ;; - ;; The MAKE-LOAD-TIME-CONSTANT-TN call above puts - ;; an :ENTRY record into the - ;; IR2-COMPONENT-CONSTANTS table. The - ;; dump-a-COMPONENT code - ;; * treats every HANDLEless :ENTRY record into a - ;; patch, and - ;; * expects every patch to correspond to an - ;; IR2-COMPONENT-ENTRIES record. - ;; The IR2-COMPONENT-ENTRIES records are set by - ;; ENTRY-ANALYZE walking over COMPONENT-LAMBDAS. - ;; Bug 138b arose because there was a HANDLEless - ;; :ENTRY record which didn't correspond to an - ;; IR2-COMPONENT-ENTRIES record. That problem is - ;; hard to debug when it's caught at dump time, so - ;; this assertion tries to catch it here. - (aver (member fun - (component-lambdas (lambda-component fun)))) - - ;; another bug-138-related issue: COMPONENT-NEW-FUNS - ;; is an IR1 temporary, and now that we're doing IR2 - ;; it should've been completely flushed (but wasn't). - (aver (null (component-new-funs (lambda-component fun)))) - - (physenv-closure (get-lambda-physenv fun))) + (assertions-on-ir2-converted-clambda functional) + (physenv-closure (get-lambda-physenv functional))) (functional - (aver (eq (functional-kind fun) :toplevel-xep)) + (aver (eq (functional-kind functional) :toplevel-xep)) nil)))) (cond (closure @@ -1195,7 +1197,7 @@ ;;;; multiple values -;;; This is almost identical to IR2-Convert-Let. Since LTN annotates +;;; This is almost identical to IR2-CONVERT-LET. Since LTN annotates ;;; the continuation for the correct number of values (with the ;;; continuation user responsible for defaulting), we can just pick ;;; them up from the continuation. @@ -1331,7 +1333,7 @@ ;;;; non-local exit -;;; Convert a non-local lexical exit. First find the NLX-Info in our +;;; Convert a non-local lexical exit. First find the NLX-INFO in our ;;; environment. Note that this is never called on the escape exits ;;; for CATCH and UNWIND-PROTECT, since the escape functions aren't ;;; IR2 converted. @@ -1377,7 +1379,7 @@ (move-continuation-result node block () (node-cont node)) (values)) -;;; Emit code to set up a non-local exit. INFO is the NLX-Info for the +;;; 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. diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index d80d299..ee94ecd 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -1,6 +1,6 @@ ;;;; This file contains stuff for maintaining a database of special ;;;; information about functions known to the compiler. This includes -;;;; semantic information such as side-effects and type inference +;;;; semantic information such as side effects and type inference ;;;; functions as well as transforms and IR2 translators. ;;;; This software is part of the SBCL system. See the README file for @@ -18,87 +18,93 @@ ;;; IR1 boolean function attributes ;;; -;;; There are a number of boolean attributes of known functions which we like -;;; to have in IR1. This information is mostly side effect information of a -;;; sort, but it is different from the kind of information we want in IR2. We -;;; aren't interested in a fine breakdown of side effects, since we do very -;;; little code motion on IR1. We are interested in some deeper semantic -;;; properties such as whether it is safe to pass stack closures to. +;;; There are a number of boolean attributes of known functions which +;;; we like to have in IR1. This information is mostly side effect +;;; information of a sort, but it is different from the kind of +;;; information we want in IR2. We aren't interested in a fine +;;; breakdown of side effects, since we do very little code motion on +;;; IR1. We are interested in some deeper semantic properties such as +;;; whether it is safe to pass stack closures to. (def-boolean-attribute ir1 - ;; May call functions that are passed as arguments. In order to determine - ;; what other effects are present, we must find the effects of all arguments - ;; that may be functions. + ;; may call functions that are passed as arguments. In order to + ;; determine what other effects are present, we must find the + ;; effects of all arguments that may be functions. call - ;; May incorporate function or number arguments into the result or somehow - ;; pass them upward. Note that this applies to any argument that *might* be - ;; a function or number, not just the arguments that always are. + ;; may incorporate function or number arguments into the result or + ;; somehow pass them upward. Note that this applies to any argument + ;; that *might* be a function or number, not just the arguments that + ;; always are. unsafe - ;; May fail to return during correct execution. Errors are O.K. + ;; may fail to return during correct execution. Errors are O.K. unwind - ;; The (default) worst case. Includes all the other bad things, plus any - ;; other possible bad thing. If this is present, the above bad attributes - ;; will be explicitly present as well. + ;; the (default) worst case. Includes all the other bad things, plus + ;; any other possible bad thing. If this is present, the above bad + ;; attributes will be explicitly present as well. any - ;; May be constant-folded. The function has no side effects, but may be - ;; affected by side effects on the arguments. e.g. SVREF, MAPC. Functions - ;; that side-effect their arguments are not considered to be foldable. - ;; Although it would be "legal" to constant fold them (since it "is an error" - ;; to modify a constant), we choose not to mark these functions as foldable - ;; in this database. + ;; may be constant-folded. The function has no side effects, but may + ;; be affected by side effects on the arguments. e.g. SVREF, MAPC. + ;; Functions that side-effect their arguments are not considered to + ;; be foldable. Although it would be "legal" to constant fold them + ;; (since it "is an error" to modify a constant), we choose not to + ;; mark these functions as foldable in this database. foldable - ;; May be eliminated if value is unused. The function has no side effects - ;; except possibly CONS. If a function is defined to signal errors, then it - ;; is not flushable even if it is movable or foldable. + ;; may be eliminated if value is unused. The function has no side + ;; effects except possibly CONS. If a function is defined to signal + ;; errors, then it is not flushable even if it is movable or + ;; foldable. flushable - ;; May be moved with impunity. Has no side effects except possibly CONS, and - ;; is affected only by its arguments. + ;; may be moved with impunity. Has no side effects except possibly + ;; consing, and is affected only by its arguments. movable - ;; Function is a true predicate likely to be open-coded. Convert any - ;; non-conditional uses into (IF T NIL). + ;; The function is a true predicate likely to be open-coded. Convert + ;; any non-conditional uses into (IF T NIL). predicate - ;; Inhibit any warning for compiling a recursive definition. (Normally the - ;; compiler warns when compiling a recursive definition for a known function, - ;; since it might be a botched interpreter stub.) + ;; Inhibit any warning for compiling a recursive definition. + ;; (Normally the compiler warns when compiling a recursive + ;; definition for a known function, since it might be a botched + ;; interpreter stub.) recursive - ;; Function does explicit argument type checking, so the declared type should - ;; not be asserted when a definition is compiled. + ;; The function does explicit argument type checking, so the + ;; declared type should not be asserted when a definition is + ;; compiled. explicit-check) (defstruct (fun-info #-sb-xc-host (:pure t)) - ;; Boolean attributes of this function. + ;; boolean attributes of this function. (attributes (missing-arg) :type attributes) - ;; A list of Transform structures describing transforms for this function. + ;; TRANSFORM structures describing transforms for this function (transforms () :type list) - ;; A function which computes the derived type for a call to this function by - ;; examining the arguments. This is null when there is no special method for - ;; this function. + ;; a function which computes the derived type for a call to this + ;; function by examining the arguments. This is null when there is + ;; no special method for this function. (derive-type nil :type (or function null)) - ;; A function that does various unspecified code transformations by directly - ;; hacking the IR. Returns true if further optimizations of the call - ;; shouldn't be attempted. + ;; a function that does various unspecified code transformations by + ;; directly hacking the IR. Returns true if further optimizations of + ;; the call shouldn't be attempted. ;; - ;; KLUDGE: This return convention (non-NIL if you shouldn't do further - ;; optimiz'ns) is backwards from the return convention for transforms. - ;; -- WHN 19990917 + ;; KLUDGE: This return convention (non-NIL if you shouldn't do + ;; further optimiz'ns) is backwards from the return convention for + ;; transforms. -- WHN 19990917 (optimizer nil :type (or function null)) - ;; If true, a special-case LTN annotation method that is used in place of the - ;; standard type/policy template selection. It may use arbitrary code to - ;; choose a template, decide to do a full call, or conspire with the - ;; IR2-Convert method to do almost anything. The Combination node is passed - ;; as the argument. + ;; If true, a special-case LTN annotation method that is used in + ;; place of the standard type/policy template selection. It may use + ;; arbitrary code to choose a template, decide to do a full call, or + ;; conspire with the IR2-Convert method to do almost anything. The + ;; Combination node is passed as the argument. (ltn-annotate nil :type (or function null)) - ;; If true, the special-case IR2 conversion method for this function. This - ;; deals with funny functions, and anything else that can't be handled using - ;; the template mechanism. The Combination node and the IR2-Block are passed - ;; as arguments. + ;; If true, the special-case IR2 conversion method for this + ;; function. This deals with funny functions, and anything else that + ;; can't be handled using the template mechanism. The Combination + ;; node and the IR2-Block are passed as arguments. (ir2-convert nil :type (or function null)) - ;; A list of all the templates that could be used to translate this function + ;; all the templates that could be used to translate this function ;; into IR2, sorted by increasing cost. (templates nil :type list) - ;; If non-null, then this function is a unary type predicate for this type. + ;; If non-null, then this function is a unary type predicate for + ;; this type. (predicate-type nil :type (or ctype null)) - ;; If non-null, use this function to annotate the known call for the byte - ;; compiler. If it returns NIL, then change the call to :full. + ;; If non-null, use this function to annotate the known call for the + ;; byte compiler. If it returns NIL, then change the call to :full. (byte-annotate nil :type (or function null))) (defprinter (fun-info) @@ -123,8 +129,8 @@ ;; sbcl-0.pre7.54 or so, that's inconsistent with being a ;; FUN-TYPE.) (type (missing-arg) :type ctype) - ;; the transformation function. Takes the COMBINATION node and returns a - ;; lambda, or throws out. + ;; the transformation function. Takes the COMBINATION node and + ;; returns a lambda expression, or throws out. (function (missing-arg) :type function) ;; string used in efficiency notes (note (missing-arg) :type string) @@ -227,17 +233,17 @@ (when cont (continuation-type cont)))) ;;; Derive the result type according to the float contagion rules, but -;;; always return a float. This is used for irrational functions that preserve -;;; realness of their arguments. +;;; always return a float. This is used for irrational functions that +;;; preserve realness of their arguments. (defun result-type-float-contagion (call) (declare (type combination call)) (reduce #'numeric-contagion (combination-args call) :key #'continuation-type :initial-value (specifier-type 'single-float))) -;;; Return a closure usable as a derive-type method for accessing the N'th -;;; argument. If arg is a list, result is a list. If arg is a vector, result -;;; is a vector with the same element type. +;;; Return a closure usable as a derive-type method for accessing the +;;; N'th argument. If arg is a list, result is a list. If arg is a +;;; vector, result is a vector with the same element type. (defun sequence-result-nth-arg (n) (lambda (call) (declare (type combination call)) diff --git a/src/compiler/late-macros.lisp b/src/compiler/late-macros.lisp index fa02b77..39b53c6 100644 --- a/src/compiler/late-macros.lisp +++ b/src/compiler/late-macros.lisp @@ -4,7 +4,7 @@ ;;;; this code can't appear in the build sequence until after ;;;; SB!XC:DEFMACRO has been defined, and so this stuff is separated ;;;; out of the main compiler/macros.lisp file (which has to appear -;;;; earlier) +;;;; earlier). ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. @@ -17,22 +17,22 @@ (in-package "SB!C") +;;; Def-Boolean-Attribute Name Attribute-Name* +;;; +;;; Define a new class of Boolean attributes, with the attributes +;;; having the specified ATTRIBUTE-NAMES. NAME is the name of the +;;; class, which is used to generate some macros to manipulate sets of +;;; the attributes: +;;; +;;; NAME-attributep attributes attribute-name* +;;; Return true if any of the named attributes are present, false +;;; otherwise. When set with SETF, updates the place Attributes +;;; setting or clearing the specified attributes. +;;; +;;; NAME-attributes attribute-name* +;;; Return a set of the named attributes. #+sb-xc-host (sb!xc:defmacro def-boolean-attribute (name &rest attribute-names) - #!+sb-doc - "Def-Boolean-Attribute Name Attribute-Name* - Define a new class of boolean attributes, with the attributes having the - specified Attribute-Names. Name is the name of the class, which is used to - generate some macros to manipulate sets of the attributes: - - NAME-attributep attributes attribute-name* - Return true if one of the named attributes is present, false otherwise. - When set with SETF, updates the place Attributes setting or clearing the - specified attributes. - - NAME-attributes attribute-name* - Return a set of the named attributes." - (let ((translations-name (symbolicate "*" name "-ATTRIBUTE-TRANSLATIONS*")) (test-name (symbolicate name "-ATTRIBUTEP"))) (collect ((alist)) @@ -47,16 +47,16 @@ (defparameter ,translations-name ',(alist))) (defmacro ,test-name (attributes &rest attribute-names) - "Automagically generated boolean attribute test function. See - Def-Boolean-Attribute." + "Automagically generated Boolean attribute test function. See + DEF-BOOLEAN-ATTRIBUTE." `(logtest ,(compute-attribute-mask attribute-names ,translations-name) (the attributes ,attributes))) (define-setf-expander ,test-name (place &rest attributes &environment env) - "Automagically generated boolean attribute setter. See - Def-Boolean-Attribute." + "Automagically generated Boolean attribute setter. See + DEF-BOOLEAN-ATTRIBUTE." (boolean-attribute-setter--target place attributes env @@ -67,8 +67,8 @@ ',test-name)) (defmacro ,(symbolicate name "-ATTRIBUTES") (&rest attribute-names) - "Automagically generated boolean attribute creation function. See - Def-Boolean-Attribute." + "Automagically generated Boolean attribute creation function. See + DEF-BOOLEAN-ATTRIBUTE." (compute-attribute-mask attribute-names ,translations-name)))))) ;;; a helper function for the cross-compilation target Lisp code which @@ -131,11 +131,10 @@ (,next ,n-current))))) (values))))) +;;; Push ITEM onto a list linked by the accessor function NEXT that is +;;; stored in PLACE. #+sb-xc-host (sb!xc:defmacro push-in (next item place &environment env) - #!+sb-doc - "Push Item onto a list linked by the accessor function Next that is stored in - Place." (multiple-value-bind (temps vals stores store access) (sb!xc:get-setf-expansion place env) (when (cdr stores) diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp index 31e881a..49e6f8b 100644 --- a/src/compiler/life.lisp +++ b/src/compiler/life.lisp @@ -94,7 +94,7 @@ ;;; reference to a TN, even when the TN is already known to be global. ;;; ;;; When we see reference to global TNs during the scan, we add the -;;; global-conflict as :Read-Only, since we don't know the correct kind until +;;; global-conflict as :READ-ONLY, since we don't know the correct kind until ;;; we are done scanning the block. (defun find-local-references (block) (declare (type ir2-block block)) @@ -132,20 +132,21 @@ (setf (ir2-block-local-tn-count block) ltn-num))) nil) -;;; Finish up the global conflicts for TNs referenced in Block according to -;;; the local Kill and Live sets. +;;; Finish up the global conflicts for TNs referenced in BLOCK +;;; according to the local Kill and Live sets. ;;; -;;; We set the kind for TNs already in the global-TNs. If not written at -;;; all, then is :Read-Only, the default. Must have been referenced somehow, -;;; or we wouldn't have conflicts for it. +;;; We set the kind for TNs already in the global-TNs. If not written +;;; at all, then is :READ-ONLY, the default. Must have been referenced +;;; somehow, or we wouldn't have conflicts for it. ;;; -;;; We also iterate over all the local TNs, looking for TNs local to this -;;; block that are still live at the block beginning, and thus must be global. -;;; This case is only important when a TN is read in a block but not written in -;;; any other, since otherwise the write would promote the TN to global. But -;;; this does happen with various passing-location TNs that are magically -;;; written. This also serves to propagate the lives of erroneously -;;; uninitialized TNs so that consistency checks can detect them. +;;; We also iterate over all the local TNs, looking for TNs local to +;;; this block that are still live at the block beginning, and thus +;;; must be global. This case is only important when a TN is read in a +;;; block but not written in any other, since otherwise the write +;;; would promote the TN to global. But this does happen with various +;;; passing-location TNs that are magically written. This also serves +;;; to propagate the lives of erroneously uninitialized TNs so that +;;; consistency checks can detect them. (defun init-global-conflict-kind (block) (declare (type ir2-block block)) (let ((live (ir2-block-live-out block))) @@ -213,7 +214,7 @@ ;;; causing the subsequent reanalysis to think that the TN has already been ;;; seen in that block. ;;; -;;; This function must not be called on blocks that have :More TNs. +;;; This function must not be called on blocks that have :MORE TNs. (defun clear-lifetime-info (block) (declare (type ir2-block block)) (setf (ir2-block-local-tn-count block) 0) @@ -247,29 +248,30 @@ (values)) -;;; This provides a panic mode for assigning LTN numbers when there is a VOP -;;; with so many more operands that they can't all be assigned distinct -;;; numbers. When this happens, we recover by assigning all the more operands -;;; the same LTN number. We can get away with this, since all more args (and -;;; results) are referenced simultaneously as far as conflict analysis is -;;; concerned. +;;; This provides a panic mode for assigning LTN numbers when there is +;;; a VOP with so many more operands that they can't all be assigned +;;; distinct numbers. When this happens, we recover by assigning all +;;; the &MORE operands the same LTN number. We can get away with this, +;;; since all &MORE args (and results) are referenced simultaneously +;;; as far as conflict analysis is concerned. ;;; -;;; Block is the IR2-Block that the more VOP is at the end of. Ops is the -;;; full argument or result TN-Ref list. Fixed is the types of the fixed -;;; operands (used only to skip those operands.) +;;; BLOCK is the IR2-Block that the more VOP is at the end of. Ops is +;;; the full argument or result TN-Ref list. Fixed is the types of the +;;; fixed operands (used only to skip those operands.) ;;; -;;; What we do is grab a LTN number, then make a :Read-Only global conflict -;;; for each more operand TN. We require that there be no existing global -;;; conflict in Block for any of the operands. Since conflicts must be cleared -;;; before the first call, this only prohibits the same TN being used both as a -;;; more operand and as any other operand to the same VOP. +;;; What we do is grab a LTN number, then make a :READ-ONLY global +;;; conflict for each more operand TN. We require that there be no +;;; existing global conflict in BLOCK for any of the operands. Since +;;; conflicts must be cleared before the first call, this only +;;; prohibits the same TN being used both as a more operand and as any +;;; other operand to the same VOP. ;;; -;;; We don't have to worry about getting the correct conflict kind, since -;;; Init-Global-Conflict-Kind will fix things up. Similarly, -;;; FIND-LOCAL-REFERENCES will set the local conflict bit corresponding to this -;;; call. +;;; We don't have to worry about getting the correct conflict kind, +;;; since INIT-GLOBAL-CONFLICT-KIND will fix things up. Similarly, +;;; FIND-LOCAL-REFERENCES will set the local conflict bit +;;; corresponding to this call. ;;; -;;; We also set the Local and Local-Number slots in each TN. It is +;;; We also set the LOCAL and LOCAL-NUMBER slots in each TN. It is ;;; possible that there are no operands in any given call to this function, but ;;; there had better be either some more args or more results. (defun coalesce-more-ltn-numbers (block ops fixed) @@ -307,26 +309,26 @@ (defevent coalesce-more-ltn-numbers "Coalesced LTN numbers for a more operand to meet Local-TN-Limit.") -;;; Loop over the blocks in Component, assigning LTN numbers and recording -;;; TN birth and death. The only interesting action is when we run out of -;;; local TN numbers while finding local references. +;;; Loop over the blocks in COMPONENT, assigning LTN numbers and +;;; recording TN birth and death. The only interesting action is when +;;; we run out of local TN numbers while finding local references. ;;; -;;; If we run out of LTN numbers while processing a VOP within the block, -;;; then we just split off the VOPs we have successfully processed into their -;;; own block. +;;; If we run out of LTN numbers while processing a VOP within the +;;; block, then we just split off the VOPs we have successfully +;;; processed into their own block. ;;; -;;; If we run out of LTN numbers while processing the our first VOP (the -;;; last in the block), then it must be the case that this VOP has large more -;;; operands. We split the VOP into its own block, and then call -;;; Coalesce-More-Ltn-Numbers to assign all the more args/results the same LTN -;;; number(s). +;;; If we run out of LTN numbers while processing the our first VOP +;;; (the last in the block), then it must be the case that this VOP +;;; has large more operands. We split the VOP into its own block, and +;;; then call COALESCE-MORE-LTN-NUMBERS to assign all the more +;;; args/results the same LTN number(s). ;;; -;;; In either case, we clear the lifetime information that we computed so -;;; far, recomputing it after taking corrective action. +;;; In either case, we clear the lifetime information that we computed +;;; so far, recomputing it after taking corrective action. ;;; -;;; Whenever we split a block, we finish the pre-pass on the split-off block -;;; by doing Find-Local-References and Init-Global-Conflict-Kind. This can't -;;; run out of LTN numbers. +;;; Whenever we split a block, we finish the pre-pass on the split-off +;;; block by doing FIND-LOCAL-REFERENCES and +;;; INIT-GLOBAL-CONFLICT-KIND. This can't run out of LTN numbers. (defun lifetime-pre-pass (component) (declare (type component component)) (let ((counter -1)) @@ -609,12 +611,13 @@ (values live-bits live-list)) -;;; Return as values, a LTN bit-vector and a list (threaded by TN-Next*) -;;; representing the TNs live at the end of Block (exclusive of :Live TNs). +;;; Return as values, a LTN bit-vector and a list (threaded by +;;; TN-Next*) representing the TNs live at the end of Block (exclusive +;;; of :LIVE TNs). ;;; -;;; We iterate over the TNs in the global conflicts that are live at the block -;;; end, setting up the TN-Local-Conflicts and TN-Local-Number, and adding the -;;; TN to the live list. +;;; We iterate over the TNs in the global conflicts that are live at +;;; the block end, setting up the TN-LOCAL-CONFLICTS and +;;; TN-LOCAL-NUMBER, and adding the TN to the live list. ;;; ;;; If a :MORE result is not live, we effectively fake a read to it. This is ;;; part of the action described in ENSURE-RESULTS-LIVE. diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp index 35def44..d796d01 100644 --- a/src/compiler/locall.lisp +++ b/src/compiler/locall.lisp @@ -177,7 +177,7 @@ ;;; discover an XEP after the initial local call analyze pass. (defun make-xep (fun) (declare (type functional fun)) - (aver (not (functional-entry-fun fun))) + (aver (null (functional-entry-fun 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 @@ -248,69 +248,59 @@ (values)) -;;; We examine all NEW-FUNS in COMPONENT, attempting to convert calls -;;; into local calls when it is legal. We also attempt to convert each -;;; LAMBDA to a LET. LET conversion is also triggered by deletion of a -;;; function reference, but functions that start out eligible for -;;; conversion must be noticed sometime. +;;; We examine all NEW-FUNCTIONALS in COMPONENT, attempting to convert +;;; calls into local calls when it is legal. We also attempt to +;;; convert each LAMBDA to a LET. LET conversion is also triggered by +;;; deletion of a function reference, but functions that start out +;;; eligible for conversion must be noticed sometime. ;;; ;;; Note that there is a lot of action going on behind the scenes ;;; here, triggered by reference deletion. In particular, the ;;; COMPONENT-LAMBDAS are being hacked to remove newly deleted and LET ;;; converted LAMBDAs, so it is important that the LAMBDA is added to -;;; the COMPONENT-LAMBDAS when it is. Also, the COMPONENT-NEW-FUNS may -;;; contain all sorts of drivel, since it is not updated when we -;;; delete functions, etc. Only COMPONENT-LAMBDAS is updated. +;;; the COMPONENT-LAMBDAS when it is. Also, the +;;; COMPONENT-NEW-FUNCTIONALS may contain all sorts of drivel, since +;;; it is not updated when we delete functions, etc. Only +;;; COMPONENT-LAMBDAS is updated. ;;; -;;; COMPONENT-REANALYZE-FUNS is treated similarly to -;;; NEW-FUNS, but we don't add lambdas to the LAMBDAS. +;;; COMPONENT-REANALYZE-FUNCTIONALS is treated similarly to +;;; COMPONENT-NEW-FUNCTIONALS, 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))))) - (unless fun (return)) - (let ((kind (functional-kind fun))) - (cond ((member kind '(:deleted :let :mv-let :assignment))) - ((and (null (leaf-refs fun)) (eq kind nil) - (not (functional-entry-fun fun))) - (delete-functional fun)) + (let* ((new-functional (pop (component-new-functionals component))) + (functional (or new-functional + (pop (component-reanalyze-functionals component))))) + (unless functional + (return)) + (let ((kind (functional-kind functional))) + (cond ((or (functional-somewhat-letlike-p functional) + (eql kind :deleted)) + (values)) ; nothing to do + ((and (null (leaf-refs functional)) (eq kind nil) + (not (functional-entry-fun functional))) + (delete-functional functional)) (t - ;; Fix/check FUN's relationship to COMPONENT-LAMDBAS. - (cond ((not (lambda-p fun)) - ;; Since FUN isn't a LAMBDA, this doesn't apply: no-op. + ;; Fix/check FUNCTIONAL's relationship to COMPONENT-LAMDBAS. + (cond ((not (lambda-p functional)) + ;; Since FUNCTIONAL isn't a LAMBDA, this doesn't + ;; apply: no-op. (values)) - (new-fun ; FUN came from NEW-FUNS, hence is new. - ;; FUN becomes part of COMPONENT-LAMBDAS now. - (aver (not (member fun (component-lambdas component)))) - (push fun (component-lambdas component))) - ;; FIXME: Maybe we don't need this clause? - ;; The only time I really thought I needed it - ;; was bug 138, and adding this clause didn't - ;; fix bug 138 but instead caused all sorts - ;; of other things to fail downstream... - #| - ((eql (lambda-inlinep fun) :inline) - ;; FUNs marked :INLINE are sometimes in - ;; COMPONENT-LAMBDAS and sometimes not. I (WHN - ;; 2002-01-01) haven't figured this one out yet, - ;; so don't assert anything. - ;; - ;; (One possibility: LAMBDAs to represent the - ;; inline expansions of things which are defined - ;; elsewhere might not be in COMPONENT-LAMBDAS, - ;; which LAMBDAs to represent the inline - ;; expansions of local functions might in - ;; COMPONENT-LAMBDAS?) - (values)) - |# - (t ; FUN is old. - ;; FUN should be in COMPONENT-LAMBDAS already. - (aver (member fun (component-lambdas component))))) - (locall-analyze-fun-1 fun) - (when (lambda-p fun) - (maybe-let-convert fun))))))) + (new-functional ; FUNCTIONAL came from + ; NEW-FUNCTIONALS, hence is new. + ;; FUNCTIONAL becomes part of COMPONENT-LAMBDAS now. + (aver (not (member functional + (component-lambdas component)))) + (push functional (component-lambdas component))) + (t ; FUNCTIONAL is old. + ;; FUNCTIONAL should be in COMPONENT-LAMBDAS already. + (aver (member functional (component-lambdas + component))))) + (locall-analyze-fun-1 functional) + (when (lambda-p functional) + (maybe-let-convert functional))))))) (values)) (defun locall-analyze-clambdas-until-done (clambdas) @@ -323,7 +313,7 @@ ;; COMPONENT is the only one here. Let's make that explicit. (aver (= 1 (length (functional-components clambda)))) (aver (eql component (first (functional-components clambda)))) - (when (component-new-funs component) + (when (component-new-functionals component) (setf did-something t) (locall-analyze-component component)))) (unless did-something @@ -334,32 +324,34 @@ ;;; to be in an infinite recursive loop, then change the reference to ;;; reference a fresh copy. We return whichever function we decide to ;;; reference. -(defun maybe-expand-local-inline (fun ref call) +(defun maybe-expand-local-inline (original-functional ref call) (if (and (policy call - (and (>= speed space) (>= speed compilation-speed))) + (and (>= speed space) + (>= speed compilation-speed))) (not (eq (functional-kind (node-home-lambda call)) :external)) (inline-expansion-ok call)) - (with-ir1-environment-from-node call - (let* ((*lexenv* (functional-lexenv fun)) - (won nil) - (res (catch 'local-call-lossage - (prog1 - (ir1-convert-lambda - (functional-inline-expansion fun) - :debug-name (debug-namify "local inline ~A" - (leaf-debug-name fun))) - (setq won t))))) - (cond (won - (change-ref-leaf ref res) - res) - (t - (let ((*compiler-error-context* call)) - (compiler-note "couldn't inline expand because expansion ~ - calls this LET-converted local function:~ - ~% ~S" - (leaf-debug-name res))) - fun)))) - fun)) + (multiple-value-bind (losing-local-functional converted-lambda) + (catch 'locall-already-let-converted + (with-ir1-environment-from-node call + (let ((*lexenv* (functional-lexenv original-functional))) + (values nil + (ir1-convert-lambda + (functional-inline-expansion original-functional) + :debug-name (debug-namify + "local inline ~A" + (leaf-debug-name + original-functional))))))) + (cond (losing-local-functional + (let ((*compiler-error-context* call)) + (compiler-note "couldn't inline expand because expansion ~ + calls this LET-converted local function:~ + ~% ~S" + (leaf-debug-name losing-local-functional))) + original-functional) + (t + (change-ref-leaf ref converted-lambda) + converted-lambda))) + original-functional)) ;;; Dispatch to the appropriate function to attempt to convert a call. ;;; REF must be a reference to a FUNCTIONAL. This is called in IR1 @@ -1061,10 +1053,11 @@ (link-blocks block (lambda-block fun)) (values t (maybe-convert-to-assignment fun)))))) -;;; This is called when we believe it might make sense to convert Fun -;;; to an assignment. All this function really does is determine when -;;; a function with more than one call can still be combined with the -;;; calling function's environment. We can convert when: +;;; This is called when we believe it might make sense to convert +;;; CLAMBDA to an assignment. All this function really does is +;;; determine when a function with more than one call can still be +;;; combined with the calling function's environment. We can convert +;;; when: ;;; -- The function is a normal, non-entry function, and ;;; -- Except for one call, all calls must be tail recursive calls ;;; in the called function (i.e. are self-recursive tail calls) @@ -1081,28 +1074,32 @@ ;;; calls as long as they all return to the same place (i.e. have the ;;; same conceptual continuation.) A special case of this would be ;;; when all of the outside calls are tail recursive. -(defun maybe-convert-to-assignment (fun) - (declare (type clambda fun)) - (when (and (not (functional-kind fun)) - (not (functional-entry-fun fun))) +(defun maybe-convert-to-assignment (clambda) + (declare (type clambda clambda)) + (when (and (not (functional-kind clambda)) + (not (functional-entry-fun clambda))) (let ((non-tail nil) (call-fun nil)) - (when (and (dolist (ref (leaf-refs fun) t) + (when (and (dolist (ref (leaf-refs clambda) t) (let ((dest (continuation-dest (node-cont ref)))) (when (or (not dest) (block-delete-p (node-block dest))) (return nil)) (let ((home (node-home-lambda ref))) - (unless (eq home fun) - (when call-fun (return nil)) + (unless (eq home clambda) + (when call-fun + (return nil)) (setq call-fun home)) (unless (node-tail-p dest) - (when (or non-tail (eq home fun)) (return nil)) + (when (or non-tail (eq home clambda)) + (return nil)) (setq non-tail dest))))) - (ok-initial-convert-p fun)) - (setf (functional-kind fun) :assignment) - (let-convert fun (or non-tail - (continuation-dest - (node-cont (first (leaf-refs fun)))))) - (when non-tail (reoptimize-call non-tail)) + (ok-initial-convert-p clambda)) + (setf (functional-kind clambda) :assignment) + (let-convert clambda + (or non-tail + (continuation-dest + (node-cont (first (leaf-refs clambda)))))) + (when non-tail + (reoptimize-call non-tail)) t)))) diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp index 83d6b80..780ee91 100644 --- a/src/compiler/main.lisp +++ b/src/compiler/main.lisp @@ -315,8 +315,8 @@ (declare (special *constraint-number* *delayed-ir1-transforms*)) (loop (ir1-optimize-until-done component) - (when (or (component-new-funs component) - (component-reanalyze-funs component)) + (when (or (component-new-functionals component) + (component-reanalyze-functionals component)) (maybe-mumble "locall ") (locall-analyze-component component)) (dfo-as-needed component) @@ -328,8 +328,8 @@ (flet ((want-reoptimization-p () (or (component-reoptimize component) (component-reanalyze component) - (component-new-funs component) - (component-reanalyze-funs component)))) + (component-new-functionals component) + (component-reanalyze-functionals component)))) (unless (and (want-reoptimization-p) ;; We delay the generation of type checks until ;; the type constraints have had time to @@ -593,7 +593,7 @@ ;;;; trace output -;;; Print out some useful info about Component to Stream. +;;; Print out some useful info about COMPONENT to STREAM. (defun describe-component (component *standard-output*) (declare (type component component)) (format t "~|~%;;;; component: ~S~2%" (component-name component)) @@ -622,7 +622,7 @@ ;;;; the error context and for recovering from errors. ;;;; ;;;; The interface we provide to this stuff is the stream-oid -;;;; Source-Info structure. The bookkeeping is done as a side-effect +;;;; SOURCE-INFO structure. The bookkeeping is done as a side effect ;;;; of getting the next source form. ;;; A FILE-INFO structure holds all the source information for a diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp index 9751d99..41bf2e0 100644 --- a/src/compiler/meta-vmdef.lisp +++ b/src/compiler/meta-vmdef.lisp @@ -87,34 +87,35 @@ ;;; small, non-negative integer that is used as an alias. The following ;;; keywords are defined: ;;; -;;; :Element-Size Size -;;; The size of objects in this SC in whatever units the SB uses. This -;;; defaults to 1. +;;; :ELEMENT-SIZE Size +;;; The size of objects in this SC in whatever units the SB uses. +;;; This defaults to 1. ;;; -;;; :Alignment Size -;;; The alignment restrictions for this SC. TNs will only be allocated at -;;; offsets that are an even multiple of this number. Defaults to 1. +;;; :ALIGNMENT Size +;;; The alignment restrictions for this SC. TNs will only be +;;; allocated at offsets that are an even multiple of this number. +;;; This defaults to 1. ;;; -;;; :Locations (Location*) -;;; If the SB is :Finite, then this is a list of the offsets within the SB -;;; that are in this SC. +;;; :LOCATIONS (Location*) +;;; If the SB is :FINITE, then this is a list of the offsets within +;;; the SB that are in this SC. ;;; -;;; :Reserve-Locations (Location*) +;;; :RESERVE-LOCATIONS (Location*) ;;; A subset of the Locations that the register allocator should try to ;;; reserve for operand loading (instead of to hold variable values.) ;;; -;;; :Save-P {T | NIL} +;;; :SAVE-P {T | NIL} ;;; If T, then values stored in this SC must be saved in one of the -;;; non-save-p :Alternate-SCs across calls. +;;; non-save-p :ALTERNATE-SCs across calls. ;;; -;;; :Alternate-SCs (SC*) +;;; :ALTERNATE-SCS (SC*) ;;; Indicates other SCs that can be used to hold values from this SC across ;;; calls or when storage in this SC is exhausted. The SCs should be ;;; specified in order of decreasing \"goodness\". There must be at least ;;; one SC in an unbounded SB, unless this SC is only used for restricted or ;;; wired TNs. ;;; -;;; :Constant-SCs (SC*) +;;; :CONSTANT-SCS (SC*) ;;; A list of the names of all the constant SCs that can be loaded into this ;;; SC by a move function. (defmacro define-storage-class (name number sb-name &key (element-size '1) @@ -319,15 +320,15 @@ (defparameter *primitive-type-slot-alist* '((:check . primitive-type-check))) +;;; Primitive-Type-VOP Vop (Kind*) Type* +;;; +;;; Annotate all the specified primitive Types with the named VOP +;;; under each of the specified kinds: +;;; +;;; :CHECK +;;; A one-argument one-result VOP that moves the argument to the +;;; result, checking that the value is of this type in the process. (defmacro primitive-type-vop (vop kinds &rest types) - #!+sb-doc - "Primitive-Type-VOP Vop (Kind*) Type* - Annotate all the specified primitive Types with the named VOP under each of - the specified kinds: - - :Check - A one argument one result VOP that moves the argument to the result, - checking that the value is of this type in the process." (let ((n-vop (gensym)) (n-type (gensym))) `(let ((,n-vop (template-or-lose ',vop))) @@ -344,8 +345,8 @@ types) nil))) -;;; Return true if SC is either one of Ptype's SC's, or one of those SC's -;;; alternate or constant SCs. +;;; Return true if SC is either one of PTYPE's SC's, or one of those +;;; SC's alternate or constant SCs. (defun meta-sc-allowed-by-primitive-type (sc ptype) (declare (type sc sc) (type primitive-type ptype)) (let ((scn (sc-number sc))) @@ -416,7 +417,7 @@ (effects '(any) :type list) (affected '(any) :type list) ;; a list of the names of functions this VOP is a translation of and - ;; the policy that allows this translation to be done. :Fast is a + ;; the policy that allows this translation to be done. :FAST is a ;; safe default, since it isn't a safe policy. (translate () :type list) (ltn-policy :fast :type ltn-policy) @@ -1496,8 +1497,8 @@ ;;; keyword indicating the interpretation of the other forms in the ;;; SPEC: ;;; -;;; :Args {(Name {Key Value}*)}* -;;; :Results {(Name {Key Value}*)}* +;;; :ARGS {(Name {Key Value}*)}* +;;; :RESULTS {(Name {Key Value}*)}* ;;; The Args and Results are specifications of the operand TNs passed ;;; to the VOP. If there is an inherited VOP, any unspecified options ;;; are defaulted from the inherited argument (or result) of the same @@ -1509,11 +1510,11 @@ ;;; necessary, guaranteeing that the operand is always one of the ;;; specified SCs. ;;; -;;; :Load-TN Load-Name -;;; Load-Name is bound to the load TN allocated for this operand, -;;; or to NIL if no load TN was allocated. +;;; :LOAD-TN Load-Name +;;; Load-Name is bound to the load TN allocated for this +;;; operand, or to NIL if no load TN was allocated. ;;; -;;; :Load-If EXPRESSION +;;; :LOAD-IF EXPRESSION ;;; Controls whether automatic operand loading is done. ;;; EXPRESSION is evaluated with the fixed operand TNs bound. ;;; If EXPRESSION is true,then loading is done and the variable @@ -1521,56 +1522,57 @@ ;;; loading is not done, and the variable is bound to the actual ;;; operand. ;;; -;;; :More T-or-NIL -;;; If specified, Name is bound to the TN-Ref for the first +;;; :MORE T-or-NIL +;;; If specified, NAME is bound to the TN-Ref for the first ;;; argument or result following the fixed arguments or results. ;;; A :MORE operand must appear last, and cannot be targeted or ;;; restricted. ;;; -;;; :Target Operand +;;; :TARGET Operand ;;; This operand is targeted to the named operand, indicating a ;;; desire to pack in the same location. Not legal for results. ;;; -;;; :From Time-Spec -;;; :To Time-Spec +;;; :FROM Time-Spec +;;; :TO Time-Spec ;;; Specify the beginning or end of the operand's lifetime. ;;; :FROM can only be used with results, and :TO only with ;;; arguments. The default for the N'th argument/result is ;;; (:ARGUMENT N)/(:RESULT N). These options are necessary ;;; primarily when operands are read or written out of order. ;;; -;;; :Conditional +;;; :CONDITIONAL ;;; This is used in place of :RESULTS with conditional branch VOPs. ;;; There are no result values: the result is a transfer of control. ;;; The target label is passed as the first :INFO arg. The second ;;; :INFO arg is true if the sense of the test should be negated. -;;; A side-effect is to set the PREDICATE attribute for functions +;;; A side effect is to set the PREDICATE attribute for functions ;;; in the :TRANSLATE option. ;;; -;;; :Temporary ({Key Value}*) Name* +;;; :TEMPORARY ({Key Value}*) Name* ;;; Allocate a temporary TN for each Name, binding that variable to ;;; the TN within the body of the generators. In addition to :TARGET ;;; (which is is the same as for operands), the following options are ;;; defined: ;;; ;;; :SC SC-Name -;;; :Offset SB-Offset -;;; Force the temporary to be allocated in the specified SC with the -;;; specified offset. Offset is evaluated at macroexpand time. If -;;; Offset is emitted, the register allocator chooses a free -;;; location in SC. If both SC and Offset are omitted, then the -;;; temporary is packed according to its primitive type. +;;; :OFFSET SB-Offset +;;; Force the temporary to be allocated in the specified SC +;;; with the specified offset. Offset is evaluated at +;;; macroexpand time. If Offset is emitted, the register +;;; allocator chooses a free location in SC. If both SC and +;;; Offset are omitted, then the temporary is packed according +;;; to its primitive type. ;;; -;;; :From Time-Spec -;;; :To Time-Spec -;;; Similar to the argument/result option, this specifies the start and -;;; end of the temporaries' lives. The defaults are :Load and :Save, -;;; i.e. the duration of the VOP. The other intervening phases are -;;; :Argument,:Eval and :Result. Non-zero sub-phases can be specified -;;; by a list, e.g. by default the second argument's life ends at -;;; (:Argument 1). +;;; :FROM Time-Spec +;;; :TO Time-Spec +;;; Similar to the argument/result option, this specifies the +;;; start and end of the temporaries' lives. The defaults are +;;; :LOAD and :SAVE, i.e. the duration of the VOP. The other +;;; intervening phases are :ARGUMENT,:EVAL and :RESULT. +;;; Non-zero sub-phases can be specified by a list, e.g. by +;;; default the second argument's life ends at (:ARGUMENT 1). ;;; -;;; :Generator Cost Form* +;;; :GENERATOR Cost Form* ;;; Specifies the translation into assembly code. Cost is the ;;; estimated cost of the code emitted by this generator. The body ;;; is arbitrary Lisp code that emits the assembly language @@ -1579,72 +1581,73 @@ ;;; During the evaluation of the body, the names of the operands ;;; and temporaries are bound to the actual TNs. ;;; -;;; :Effects Effect* -;;; :Affected Effect* +;;; :EFFECTS Effect* +;;; :AFFECTED Effect* ;;; Specifies the side effects that this VOP has and the side ;;; effects that effect its execution. If unspecified, these ;;; default to the worst case. ;;; -;;; :Info Name* +;;; :INFO Name* ;;; Define some magic arguments that are passed directly to the code ;;; generator. The corresponding trailing arguments to VOP or ;;; %PRIMITIVE are stored in the VOP structure. Within the body ;;; of the generators, the named variables are bound to these -;;; values. Except in the case of :Conditional VOPs, :Info arguments +;;; values. Except in the case of :CONDITIONAL VOPs, :INFO arguments ;;; cannot be specified for VOPS that are the direct translation -;;; for a function (specified by :Translate). +;;; for a function (specified by :TRANSLATE). ;;; -;;; :Ignore Name* +;;; :IGNORE Name* ;;; Causes the named variables to be declared IGNORE in the ;;; generator body. ;;; -;;; :Variant Thing* -;;; :Variant-Vars Name* +;;; :VARIANT Thing* +;;; :VARIANT-VARS Name* ;;; These options provide a way to parameterize families of VOPs -;;; that differ only trivially. :Variant makes the specified +;;; that differ only trivially. :VARIANT makes the specified ;;; evaluated Things be the "variant" associated with this VOP. ;;; :VARIANT-VARS causes the named variables to be bound to the ;;; corresponding Things within the body of the generator. ;;; -;;; :Variant-Cost Cost +;;; :VARIANT-COST Cost ;;; Specifies the cost of this VOP, overriding the cost of any ;;; inherited generator. ;;; -;;; :Note {String | NIL} +;;; :NOTE {String | NIL} ;;; A short noun-like phrase describing what this VOP "does", i.e. ;;; the implementation strategy. If supplied, efficiency notes will ;;; be generated when type uncertainty prevents :TRANSLATE from ;;; working. NIL inhibits any efficiency note. ;;; -;;; :Arg-Types {* | PType | (:OR PType*) | (:CONSTANT Type)}* -;;; :Result-Types {* | PType | (:OR PType*)}* -;;; Specify the template type restrictions used for automatic translation. -;;; If there is a :More operand, the last type is the more type. :CONSTANT -;;; specifies that the argument must be a compile-time constant of the -;;; specified Lisp type. The constant values of :CONSTANT arguments are -;;; passed as additional :INFO arguments rather than as :ARGS. +;;; :ARG-TYPES {* | PType | (:OR PType*) | (:CONSTANT Type)}* +;;; :RESULT-TYPES {* | PType | (:OR PType*)}* +;;; Specify the template type restrictions used for automatic +;;; translation. If there is a :MORE operand, the last type is the +;;; more type. :CONSTANT specifies that the argument must be a +;;; compile-time constant of the specified Lisp type. The constant +;;; values of :CONSTANT arguments are passed as additional :INFO +;;; arguments rather than as :ARGS. ;;; -;;; :Translate Name* +;;; :TRANSLATE Name* ;;; This option causes the VOP template to be entered as an IR2 ;;; translation for the named functions. ;;; -;;; :Policy {:Small | :Fast | :Safe | :Fast-Safe} +;;; :POLICY {:SMALL | :FAST | :SAFE | :FAST-SAFE} ;;; Specifies the policy under which this VOP is the best translation. ;;; -;;; :Guard Form -;;; Specifies a Form that is evaluated in the global environment. If -;;; form returns NIL, then emission of this VOP is prohibited even when -;;; all other restrictions are met. +;;; :GUARD Form +;;; Specifies a Form that is evaluated in the global environment. +;;; If form returns NIL, then emission of this VOP is prohibited +;;; even when all other restrictions are met. ;;; -;;; :VOP-Var Name -;;; :Node-Var Name +;;; :VOP-VAR Name +;;; :NODE-VAR Name ;;; In the generator, bind the specified variable to the VOP or ;;; the Node that generated this VOP. ;;; -;;; :Save-P {NIL | T | :Compute-Only | :Force-To-Stack} +;;; :SAVE-P {NIL | T | :COMPUTE-ONLY | :FORCE-TO-STACK} ;;; Indicates how a VOP wants live registers saved. ;;; -;;; :Move-Args {NIL | :Full-Call | :Local-Call | :Known-Return} +;;; :MOVE-ARGS {NIL | :FULL-CALL | :LOCAL-CALL | :KNOWN-RETURN} ;;; Indicates if and how the more args should be moved into a ;;; different frame. (def!macro define-vop ((name &optional inherits) &rest specs) @@ -1712,8 +1715,8 @@ ;;; Emit-Template Node Block Template Args Results [Info] ;;; -;;; Call the emit function for Template, linking the result in at the -;;; end of Block. +;;; Call the emit function for TEMPLATE, linking the result in at the +;;; end of BLOCK. (defmacro emit-template (node block template args results &optional info) (let ((n-first (gensym)) (n-last (gensym))) @@ -1728,18 +1731,18 @@ ;;; VOP Name Node Block Arg* Info* Result* ;;; -;;; Emit the VOP (or other template) Name at the end of the IR2-Block -;;; Block, using Node for the source context. The interpretation of +;;; Emit the VOP (or other template) NAME at the end of the IR2-BLOCK +;;; BLOCK, using NODE for the source context. The interpretation of ;;; the remaining arguments depends on the number of operands of ;;; various kinds that are declared in the template definition. VOP ;;; cannot be used for templates that have more-args or more-results, ;;; since the number of arguments and results is indeterminate for ;;; these templates. Use VOP* instead. ;;; -;;; Args and Results are the TNs that are to be referenced by the +;;; ARGS and RESULTS are the TNs that are to be referenced by the ;;; template as arguments and results. If the template has -;;; codegen-info arguments, then the appropriate number of Info forms -;;; following the Arguments are used for codegen info. +;;; codegen-info arguments, then the appropriate number of INFO forms +;;; following the arguments are used for codegen info. (defmacro vop (name node block &rest operands) (let* ((parse (vop-parse-or-lose name)) (arg-count (length (vop-parse-args parse))) @@ -1792,10 +1795,10 @@ ;;; arguments and results to the template. More-Args and More-Results ;;; are heads of TN-Ref lists that are added onto the end of the ;;; TN-Refs for the explicitly supplied operand TNs. The TN-Refs for -;;; the more operands must have the TN and Write-P slots correctly +;;; the more operands must have the TN and WRITE-P slots correctly ;;; initialized. ;;; -;;; As with VOP, the Info forms are evaluated and passed as codegen +;;; As with VOP, the INFO forms are evaluated and passed as codegen ;;; info arguments. (defmacro vop* (name node block args results &rest info) (declare (type cons args results)) @@ -1906,7 +1909,7 @@ (,n-bod ,tn-var)) (let ((,ltns (ir2-block-local-tns ,n-block))) - ;; Do TNs always-live in this block and live :More TNs. + ;; Do TNs always-live in this block and live :MORE TNs. (do ((,n-conf (ir2-block-global-tns ,n-block) (global-conflicts-next ,n-conf))) ((null ,n-conf)) diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp index d95ffc9..df3ddb4 100644 --- a/src/compiler/node.lisp +++ b/src/compiler/node.lisp @@ -200,7 +200,7 @@ ;;; Flags that are used to indicate various things about a block, such ;;; as what optimizations need to be done on it: ;;; -- REOPTIMIZE is set when something interesting happens the uses of a -;;; continuation whose Dest is in this block. This indicates that the +;;; continuation 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. @@ -386,8 +386,8 @@ ;; ;; Note that logical associations between CLAMBDAs and COMPONENTs ;; seem to exist for a while before this is initialized. See e.g. - ;; the NEW-FUNS slot. In particular, I got burned by writing some - ;; code to use this value to decide which components need + ;; the NEW-FUNCTIONALS slot. In particular, I got burned by writing + ;; some code to use this value to decide which components need ;; LOCALL-ANALYZE-COMPONENT, when it turns out that ;; LOCALL-ANALYZE-COMPONENT had a role in initializing this value ;; (and DFO stuff does too, maybe). Also, even after it's @@ -400,7 +400,7 @@ ;; (possibly as LETs, or implicitly as XEPs if an OPTIONAL-DISPATCH.) ;; Between runs of local call analysis there may be some debris of ;; converted or even deleted functions in this list. - (new-funs () :type list) + (new-functionals () :type list) ;; If this is true, then there is stuff in this component that could ;; benefit from further IR1 optimization. (reoptimize t :type boolean) @@ -414,7 +414,7 @@ ;; 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). + ;; LAMBDAs onto my NEW-FUNCTIONALS, 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 @@ -430,11 +430,11 @@ ;; arguments for the note, or the FUN-TYPE that would have ;; enabled the transformation but failed to match. (failed-optimizations (make-hash-table :test 'eq) :type hash-table) - ;; This is similar to NEW-FUNS, but is used when a function has - ;; already been analyzed, but new references have been added by - ;; inline expansion. Unlike NEW-FUNS, this is not disjoint from - ;; COMPONENT-LAMBDAS. - (reanalyze-funs nil :type list)) + ;; This is similar to NEW-FUNCTIONALS, but is used when a function + ;; has already been analyzed, but new references have been added by + ;; inline expansion. Unlike NEW-FUNCTIONALS, this is not disjoint + ;; from COMPONENT-LAMBDAS. + (reanalyze-functionals nil :type list)) (defprinter (component :identity t) name #!+sb-show id @@ -442,7 +442,7 @@ ;;; Check that COMPONENT is suitable for roles which involve adding ;;; new code. (gotta love imperative programming with lotso in-place -;;; side-effects...) +;;; 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 @@ -572,8 +572,8 @@ type (info :test info)) -;;; The NLX-Info structure is used to collect various information -;;; about non-local exits. This is effectively an annotation on the +;;; An NLX-INFO structure is used to collect various information about +;;; non-local exits. This is effectively an annotation on the ;;; CONTINUATION, although it is accessed by searching in the ;;; PHYSENV-NLX-INFO. (def!struct (nlx-info (:make-load-form-fun ignore-it)) @@ -590,13 +590,13 @@ ;; ;; This slot is primarily an indication of where this exit delivers ;; its values to (if any), but it is also used as a sort of name to - ;; allow us to find the NLX-Info that corresponds to a given exit. - ;; For this purpose, the Entry must also be used to disambiguate, + ;; allow us to find the NLX-INFO that corresponds to a given exit. + ;; For this purpose, the ENTRY must also be used to disambiguate, ;; since exits to different places may deliver their result to the ;; same continuation. (continuation (missing-arg) :type continuation) ;; the entry stub inserted by physical environment analysis. This is - ;; a block containing a call to the %NLX-Entry funny function that + ;; a block containing a call to the %NLX-ENTRY funny function that ;; has the original exit destination as its successor. Null only ;; temporarily. (target nil :type (or cblock null)) @@ -799,14 +799,16 @@ ;; continuation for the call. ;; ;; :MV-LET - ;; Similar to :LET, but the call is an MV-CALL. + ;; Similar to :LET (as per FUNCTIONAL-LETLIKE-P), but the call + ;; is an MV-CALL. ;; ;; :ASSIGNMENT - ;; similar to a LET, but can have other than one call as long as - ;; there is at most one non-tail call. + ;; similar to a LET (as per FUNCTIONAL-SOMEWHAT-LETLIKE-P), but + ;; can have other than one call as long as there is at most + ;; one non-tail call. ;; ;; :OPTIONAL - ;; a lambda that is an entry-point for an optional-dispatch. + ;; a lambda that is an entry point for an OPTIONAL-DISPATCH. ;; Similar to NIL, but requires greater caution, since local call ;; analysis may create new references to this function. Also, the ;; function cannot be deleted even if it has *no* references. The @@ -865,14 +867,15 @@ ;; ;; With all other kinds, this is null. (entry-fun nil :type (or functional null)) - ;; the value of any inline/notinline declaration for a local function + ;; the value of any inline/notinline declaration for a local + ;; function (or NIL in any case if no inline expansion is available) (inlinep nil :type inlinep) ;; If we have a lambda that can be used as in inline expansion for ;; this function, then this is it. If there is no source-level - ;; lambda corresponding to this function then this is Null (but then + ;; lambda corresponding to this function then this is null (but then ;; INLINEP will always be NIL as well.) (inline-expansion nil :type list) - ;; the lexical environment that the inline-expansion should be converted in + ;; the lexical environment that the INLINE-EXPANSION should be converted in (lexenv *lexenv* :type lexenv) ;; the original function or macro lambda list, or :UNSPECIFIED if ;; this is a compiler created function @@ -884,6 +887,21 @@ %debug-name #!+sb-show id) +;;; Is FUNCTIONAL LET-converted? (where we're indifferent to whether +;;; it returns one value or multiple values) +(defun functional-letlike-p (functional) + (member (functional-kind functional) + '(:let :mv-let))) + +;;; Is FUNCTIONAL sorta LET-converted? (where even an :ASSIGNMENT counts) +;;; +;;; FIXME: I (WHN) don't understand this one well enough to give a good +;;; definition or even a good function name, it's just a literal copy +;;; of a CMU CL idiom. Does anyone have a better name or explanation? +(defun functional-somewhat-letlike-p (functional) + (or (functional-letlike-p functional) + (eql (functional-kind functional) :assignment))) + ;;; FUNCTIONAL name operations (defun functional-debug-name (functional) ;; FUNCTIONAL-%DEBUG-NAME takes precedence over FUNCTIONAL-SOURCE-NAME @@ -1247,7 +1265,7 @@ ;;;; lexical exits. ;;; The ENTRY node serves to mark the start of the dynamic extent of a -;;; lexical exit. It is the mess-up node for the corresponding :Entry +;;; lexical exit. It is the mess-up node for the corresponding :ENTRY ;;; cleanup. (defstruct (entry (:include node) (:copier nil)) diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp index e67f0f9..e455425 100644 --- a/src/compiler/pack.lisp +++ b/src/compiler/pack.lisp @@ -125,7 +125,7 @@ (bit-ior (the local-tn-bit-vector (svref loc-confs num)) (tn-local-conflicts tn) t)))))))) -;;; Return the total number of IR2 blocks in Component. +;;; Return the total number of IR2-BLOCKs in COMPONENT. (defun ir2-block-count (component) (declare (type component component)) (do ((2block (block-info (block-next (component-head component))) @@ -135,7 +135,7 @@ (when (ir2-block-number 2block) (return (1+ (ir2-block-number 2block)))))) -;;; Ensure that the conflicts vectors for each :Finite SB are large +;;; Ensure that the conflicts vectors for each :FINITE SB are large ;;; enough for the number of blocks allocated. Also clear any old ;;; conflicts and reset the current size to the initial size. (defun init-sb-vectors (component) @@ -187,7 +187,7 @@ (setf (finite-sb-current-size sb) (sb-size sb)) (setf (finite-sb-last-offset sb) 0)))))) -;;; Expand the :Unbounded SB backing SC by either the initial size or +;;; Expand the :UNBOUNDED SB backing SC by either the initial size or ;;; the SC element size, whichever is larger. If NEEDED-SIZE is ;;; larger, then use that size. (defun grow-sc (sc &optional (needed-size 0)) @@ -323,11 +323,11 @@ (cond (ptype (aver (member (sc-number sc) (primitive-type-scs ptype))) - (error "SC ~S doesn't have any :Unbounded alternate SCs, but is~@ + (error "SC ~S doesn't have any :UNBOUNDED alternate SCs, but is~@ a SC for primitive-type ~S." (sc-name sc) (primitive-type-name ptype))) (t - (error "SC ~S doesn't have any :Unbounded alternate SCs." + (error "SC ~S doesn't have any :UNBOUNDED alternate SCs." (sc-name sc))))))))) ;;; Return a list of format arguments describing how TN is used in @@ -1387,7 +1387,7 @@ ;;; Pack a wired TN, checking that the offset is in bounds for the SB, ;;; and that the TN doesn't conflict with some other TN already packed ;;; in that location. If the TN is wired to a location beyond the end -;;; of a :Unbounded SB, then grow the SB enough to hold the TN. +;;; of a :UNBOUNDED SB, then grow the SB enough to hold the TN. ;;; ;;; ### Checking for conflicts is disabled for :SPECIFIED-SAVE TNs. ;;; This is kind of a hack to make specifying wired stack save diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index 531e080..ef0257f 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -30,10 +30,10 @@ (declare (type component component)) (aver (every (lambda (x) (eq (functional-kind x) :deleted)) - (component-new-funs component))) - (setf (component-new-funs component) ()) - (dolist (fun (component-lambdas component)) - (reinit-lambda-physenv fun)) + (component-new-functionals component))) + (setf (component-new-functionals component) ()) + (dolist (clambda (component-lambdas component)) + (reinit-lambda-physenv clambda)) (mapc #'add-lambda-vars-and-let-vars-to-closures (component-lambdas component)) @@ -240,7 +240,7 @@ ;;; ;;; If a CATCH or an UNWIND-protect, then we set the LEXENV for the ;;; last node in the cleanup code to be the enclosing environment, to -;;; represent the fact that the binding was undone as a side-effect of +;;; represent the fact that the binding was undone as a side effect of ;;; the exit. This will cause a lexical exit to be broken up if we are ;;; actually exiting the scope (i.e. a BLOCK), and will also do any ;;; other cleanups that may have to be done on the way. @@ -274,7 +274,7 @@ ;;; EXIT into ENV. This is called for each non-local exit node, of ;;; which there may be several per exit continuation. This is what we ;;; do: -;;; -- If there isn't any NLX-Info entry in the environment, make +;;; -- If there isn't any NLX-INFO entry in the environment, make ;;; an entry stub, otherwise just move the exit block link to ;;; the component tail. ;;; -- Close over the NLX-INFO in the exit environment. diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp index 6139039..e780e4b 100644 --- a/src/compiler/policy.lisp +++ b/src/compiler/policy.lisp @@ -90,7 +90,7 @@ ;;; FIXME: Doing this is slightly flaky (since we can't do it right ;;; without all the headaches of true code walking), and it shouldn't ;;; be necessary with modern Python anyway, as long as POLICY-QUALITY -;;; is properly DEFKNOWNed to have no side-effects so that it can be +;;; is properly DEFKNOWNed to have no side effects so that it can be ;;; optimized away if unused. So this should probably go away. (defun policy-qualities-used-by (expr) (let ((result nil)) diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp index 5e7a97b..6b4f154 100644 --- a/src/compiler/seqtran.lisp +++ b/src/compiler/seqtran.lisp @@ -388,9 +388,9 @@ ;; A form that returns the current value. This may be set with SETF to set ;; the current value. (current (error "Must specify CURRENT.")) - ;; In a :Normal iterator, a form that tests whether there is a current value. + ;; In a :NORMAL iterator, a form that tests whether there is a current value. (done nil) - ;; In a :Result iterator, a form that truncates the result at the current + ;; In a :RESULT iterator, a form that truncates the result at the current ;; position and returns it. (result nil) ;; A form that returns the initial total number of values. The result is diff --git a/src/compiler/stack.lisp b/src/compiler/stack.lisp index f04e92c..1f4d546 100644 --- a/src/compiler/stack.lisp +++ b/src/compiler/stack.lisp @@ -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 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. (defun find-pushed-continuations (block) (let* ((2block (block-info block)) (popped (ir2-block-popped 2block)) @@ -184,7 +184,7 @@ ;;;; 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 +;;; RECEIVERS. Exits are excluded, since they don't drop through to the ;;; receiver. (defun find-values-generators (receivers) (declare (list receivers)) @@ -196,15 +196,17 @@ (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 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. ;;; -;;; Do the backward graph walk, starting at each values receiver. We ignore -;;; receivers that already have a non-null Start-Stack. These are nested -;;; values receivers that have already been reached on another walk. We don't -;;; want to clobber that result with our null initial stack. +;;; Do the backward graph walk, starting at each values receiver. We +;;; ignore receivers that already have a non-null START-STACK. These +;;; are nested values receivers that have already been reached on +;;; another walk. We don't want to clobber that result with our null +;;; initial stack. (defun stack-analyze (component) (declare (type component component)) (let* ((2comp (component-info component)) diff --git a/src/compiler/tn.lisp b/src/compiler/tn.lisp index 2faa105..e0b6a26 100644 --- a/src/compiler/tn.lisp +++ b/src/compiler/tn.lisp @@ -16,10 +16,10 @@ ;;; in this component. (defvar *component-being-compiled*) +;;; Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form* +;;; +;;; Iterate over all packed TNs allocated in Component. (defmacro do-packed-tns ((tn component &optional result) &body body) - #!+sb-doc - "Do-Packed-TNs (TN-Var Component [Result]) Declaration* Form* - Iterate over all packed TNs allocated in Component." (let ((n-component (gensym))) `(let ((,n-component (component-info ,component))) (do ((,tn (ir2-component-normal-tns ,n-component) (tn-next ,tn))) @@ -33,10 +33,10 @@ ,result) ,@body)))) -;;; Remove all TNs with no references from the lists of unpacked TNs. We -;;; null out the Offset so that nobody will mistake deleted wired TNs for -;;; properly packed TNs. We mark non-deleted alias TNs so that aliased TNs -;;; aren't considered to be unreferenced. +;;; Remove all TNs with no references from the lists of unpacked TNs. +;;; We null out the Offset so that nobody will mistake deleted wired +;;; TNs for properly packed TNs. We mark non-deleted alias TNs so that +;;; aliased TNs aren't considered to be unreferenced. (defun delete-unreferenced-tns (component) (let* ((2comp (component-info component)) (aliases (make-array (1+ (ir2-component-global-tn-counter 2comp)) diff --git a/src/compiler/vmdef.lisp b/src/compiler/vmdef.lisp index fb6c554..5af6cd4 100644 --- a/src/compiler/vmdef.lisp +++ b/src/compiler/vmdef.lisp @@ -45,7 +45,7 @@ (defun meta-sc-number-or-lose (x) (the sc-number (sc-number (meta-sc-or-lose x)))) -;;;; side-effect classes +;;;; side effect classes (def-boolean-attribute vop any) diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp index 455a8b2..acf1993 100644 --- a/src/compiler/vop.lisp +++ b/src/compiler/vop.lisp @@ -60,13 +60,13 @@ ;;;; IR1 annotations used for IR2 conversion ;;; Block-Info -;;; Holds the IR2-Block structure. If there are overflow blocks, -;;; then this points to the first IR2-Block. The Block-Info of the +;;; Holds the IR2-BLOCK structure. If there are overflow blocks, +;;; then this points to the first IR2-BLOCK. The BLOCK-INFO of the ;;; dummy component head and tail are dummy IR2 blocks that begin ;;; and end the emission order thread. ;;; ;;; Component-Info -;;; Holds the IR2-Component structure. +;;; Holds the IR2-COMPONENT structure. ;;; ;;; Continuation-Info ;;; Holds the IR2-Continuation structure. Continuations whose @@ -146,7 +146,7 @@ ;; assign all the more args one LTN number, and all the more results ;; another LTN number. We can do this, since more operands are ;; referenced simultaneously as far as conflict analysis is - ;; concerned. Note that all these :More TNs will be global TNs. + ;; concerned. Note that all these :MORE TNs will be global TNs. (local-tns (make-array local-tn-limit) :type local-tn-vector) ;; Bit-vectors used during lifetime analysis to keep track of ;; references to local TNs. When indexed by the LTN number, the @@ -159,9 +159,8 @@ :type local-tn-bit-vector) ;; This is similar to the above, but is updated by lifetime flow ;; analysis to have a 1 for LTN numbers of TNs live at the end of - ;; the block. This takes into account all TNs that aren't :Live. - (live-in (make-array local-tn-limit :element-type 'bit - :initial-element 0) + ;; the block. This takes into account all TNs that aren't :LIVE. + (live-in (make-array local-tn-limit :element-type 'bit :initial-element 0) :type local-tn-bit-vector) ;; a thread running through the global-conflicts structures for this ;; block, sorted by TN number @@ -285,12 +284,12 @@ ;; overhead that is eventually stuffed in somehow. (constants (make-array 10 :fill-pointer 0 :adjustable t) :type vector) ;; some kind of info about the component's run-time representation. - ;; This is filled in by the VM supplied Select-Component-Format function. + ;; This is filled in by the VM supplied SELECT-COMPONENT-FORMAT function. format ;; a list of the ENTRY-INFO structures describing all of the entries ;; into this component. Filled in by entry analysis. (entries nil :type list) - ;; Head of the list of :ALIAS TNs in this component, threaded by TN-NEXT. + ;; head of the list of :ALIAS TNs in this component, threaded by TN-NEXT (alias-tns nil :type (or tn null)) ;; SPILLED-VOPS is a hashtable translating from "interesting" VOPs ;; to a list of the TNs spilled at that VOP. This is used when @@ -575,7 +574,7 @@ (def!struct (vop-info (:include template) (:make-load-form-fun ignore-it)) - ;; side-effects of this VOP and side-effects that affect the value + ;; side effects of this VOP and side effects that affect the value ;; of this VOP (effects (missing-arg) :type attributes) (affected (missing-arg) :type attributes) @@ -959,16 +958,16 @@ ;; :READ-ONLY ;; The TN is read, but never written. It starts the block live, ;; and is not killed by the block. Lifetime analysis will promote - ;; :Read-Only TNs to :Live if they are live at the block end. + ;; :READ-ONLY TNs to :LIVE if they are live at the block end. ;; ;; :LIVE ;; The TN is not referenced. It is live everywhere in the block. (kind :read-only :type (member :read :write :read-only :live)) ;; a local conflicts vector representing conflicts with TNs live in - ;; Block. The index for the local TN number of each TN we conflict - ;; with in this block is 1. To find the full conflict set, the :Live - ;; TNs for Block must also be included. This slot is not meaningful - ;; when Kind is :Live. + ;; BLOCK. The index for the local TN number of each TN we conflict + ;; with in this block is 1. To find the full conflict set, the :LIVE + ;; TNs for BLOCK must also be included. This slot is not meaningful + ;; when KIND is :LIVE. (conflicts (make-array local-tn-limit :element-type 'bit :initial-element 0) @@ -977,7 +976,7 @@ (tn (missing-arg) :type tn) ;; thread through all the Global-Conflicts for TN (tn-next nil :type (or global-conflicts null)) - ;; TN's local TN number in Block. :Live TNs don't have local numbers. + ;; TN's local TN number in BLOCK. :LIVE TNs don't have local numbers. (number nil :type (or local-tn-number null))) (defprinter (global-conflicts) tn diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index a6d4697..2af3702 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -707,7 +707,7 @@ ;;; the last fixed argument. If Variable is false, then the passing ;;; locations are passed as a more arg. Variable is true if there are ;;; a variable number of arguments passed on the stack. Variable -;;; cannot be specified with :Tail return. TR variable argument call +;;; cannot be specified with :TAIL return. TR variable argument call ;;; is implemented separately. ;;; ;;; In tail call with fixed arguments, the passing locations are diff --git a/src/pcl/low.lisp b/src/pcl/low.lisp index d59c7bb..7135e5f 100644 --- a/src/pcl/low.lisp +++ b/src/pcl/low.lisp @@ -180,10 +180,10 @@ ;;; SET-FUN-NAME-INTERN which takes a list spec for a function ;;; name and turns it into a symbol if need be. ;;; -;;; When given a funcallable instance, SET-FUN-NAME *must* -;;; side-effect that FIN to give it the name. When given any other -;;; kind of function SET-FUN-NAME is allowed to return a new -;;; function which is "the same" except that it has the name. +;;; When given a funcallable instance, SET-FUN-NAME *must* side-effect +;;; that FIN to give it the name. When given any other kind of +;;; function SET-FUN-NAME is allowed to return a new function which is +;;; "the same" except that it has the name. ;;; ;;; In all cases, SET-FUN-NAME must return the new (or same) ;;; function. (Unlike other functions to set stuff, it does not return diff --git a/tests/character.pure.lisp b/tests/character.pure.lisp index cc6f397..f9b08df 100644 --- a/tests/character.pure.lisp +++ b/tests/character.pure.lisp @@ -1,4 +1,4 @@ -;;;; various CHARACTER tests without side-effects +;;;; various CHARACTER tests without side effects ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. diff --git a/tests/clocc-ansi-test-known-bugs.lisp b/tests/clocc-ansi-test-known-bugs.lisp index 4756aa2..5ccf5ad 100644 --- a/tests/clocc-ansi-test-known-bugs.lisp +++ b/tests/clocc-ansi-test-known-bugs.lisp @@ -161,7 +161,7 @@ :IOFKTS-LEGACY-791 ;; (These aren't really separate bugs, but 804 depends on a - ;; side-effect of 791, then 812 depends on a side effect of + ;; side effect of 791, and then 812 depends on a side effect of ;; 804, so that as long as 791 is suppressed we need to ;; suppress these too.) :IOFKTS-LEGACY-804 diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp index 18df67c..4e5e80b 100644 --- a/tests/compiler-1.impure-cload.lisp +++ b/tests/compiler-1.impure-cload.lisp @@ -1,4 +1,4 @@ -;;;; miscellaneous compiler tests with side-effects (e.g. DEFUN +;;;; miscellaneous compiler tests with side effects (e.g. DEFUN ;;;; changing FDEFINITIONs and globaldb stuff) ;;;; This software is part of the SBCL system. See the README file for diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 41baa31..b911c4f 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -1,4 +1,4 @@ -;;;; various compiler tests without side-effects +;;;; various compiler tests without side effects ;;;; This software is part of the SBCL system. See the README file for ;;;; more information. diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp index 4c5bdfd..f7dfab9 100644 --- a/tests/debug.impure.lisp +++ b/tests/debug.impure.lisp @@ -1,5 +1,5 @@ ;;;; This file is for testing debugging functionality, using -;;;; test machinery which might have side-effects (e.g. +;;;; test machinery which might have side effects (e.g. ;;;; executing DEFUN). ;;;; This software is part of the SBCL system. See the README file for diff --git a/version.lisp-expr b/version.lisp-expr index 2e69dca..8d0c3cb 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.7.1.4" +"0.7.1.13"