0.pre7.86.flaky7.14:
authorWilliam Harold Newman <william.newman@airmail.net>
Thu, 29 Nov 2001 17:12:46 +0000 (17:12 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Thu, 29 Nov 2001 17:12:46 +0000 (17:12 +0000)
trivial changes made while hunting for the regression test bug

BUGS
TODO
src/code/target-package.lisp
src/compiler/debug.lisp
src/compiler/dfo.lisp
src/compiler/ir1-translators.lisp
src/compiler/ir1util.lisp
src/compiler/pack.lisp
src/compiler/physenvanal.lisp
version.lisp-expr

diff --git a/BUGS b/BUGS
index c7c5c47..e905d42 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -1286,6 +1286,20 @@ Error in function C::GET-LAMBDA-TO-COMPILE:
   arguments in FLET/LABELS: it might be an old Python bug which is 
   only exercised by the new arrangement of the SBCL compiler.)
 
+132:
+  Trying to compile 
+    (DEFUN FOO () (CATCH 0 (PRINT 1331)))
+  gives an error
+    #<SB-C:TN '0!1> is not valid as the second argument to VOP:
+      SB-C:MAKE-CATCH-BLOCK,
+    since the TN's primitive type SB-VM::POSITIVE-FIXNUM doesn't allow
+    any of the SCs allowed by the operand restriction:
+     (SB-VM::DESCRIPTOR-REG)
+  The (CATCH 0 ...) construct is bad style (because of unportability
+  of EQ testing of numbers) but it is legal, and shouldn't cause an
+  internal compiler error. (This error occurs in sbcl-0.6.13 and in
+  0.pre7.86.flaky7.14.)
+
 KNOWN BUGS RELATED TO THE IR1 INTERPRETER
 
 (Now that the IR1 interpreter has gone away, these should be 
diff --git a/TODO b/TODO
index 07a0194..a06c409 100644 (file)
--- a/TODO
+++ b/TODO
@@ -8,6 +8,7 @@ for 0.7.0:
        ** made %COMPILE set up debugging data more like the way the
                debugger expects (and maybe even completely
                correctly:-)
+               *** made (DISASSEMBLE 'PRINT) work
 * incompatible changes listed in NEWS:
        ** changed debugger prompt to "5]", "5[2]", "5[3]", etc.
        ** changed default output representation of *PRINT-ESCAPE*-ed
index 6e64443..035da80 100644 (file)
 
 (defun unuse-package (packages-to-unuse &optional (package (sane-package)))
   #!+sb-doc
-  "Remove Packages-To-Unuse from the use list for Package."
+  "Remove PACKAGES-TO-UNUSE from the USE list for PACKAGE."
   (let ((package (find-undeleted-package-or-lose package)))
     (dolist (p (package-listify packages-to-unuse))
       (setf (package-%use-list package)
index defa9ab..a9c1694 100644 (file)
   (unless (gethash fun *seen-functions*)
     (barf "unseen function ~S in ~S" fun where)))
 
-;;; In a lambda, check that the associated nodes are in seen blocks. In an
-;;; optional dispatch, check that the entry points were seen. If the function
-;;; is deleted, ignore it.
+;;; In a CLAMBDA, check that the associated nodes are in seen blocks.
+;;; In an OPTIONAL-DISPATCH, check that the entry points were seen. If
+;;; the function is deleted, ignore it.
 (defun check-function-stuff (functional)
   (ecase (functional-kind functional)
     (:external
index 1c24056..f509480 100644 (file)
     ;; between them. Any code that is left in an initial component
     ;; must be unreachable, so we can delete it. Stray links to the
     ;; initial component tail (due NIL function terminated blocks)
-    ;; are moved to the appropriate newc component tail.
+    ;; are moved to the appropriate new component tail.
     (dolist (toplevel-lambda toplevel-lambdas)
       (let* ((block (lambda-block toplevel-lambda))
             (old-component (block-component block))
index b8f657c..5f12ea2 100644 (file)
               `(multiple-value-call #'%throw ,tag ,result)))
 
 ;;; This is a special special form used to instantiate a cleanup as
-;;; the current cleanup within the body. KIND is a the kind of cleanup
+;;; the current cleanup within the body. KIND is the kind of cleanup
 ;;; to make, and MESS-UP is a form that does the mess-up action. We
 ;;; make the MESS-UP be the USE of the MESS-UP form's continuation,
 ;;; and introduce the cleanup into the lexical environment. We
            (%catch (%escape-function ,exit-block) ,tag)
          ,@body)))))
 
-;;; UNWIND-PROTECT is similar to CATCH, but more hairy. We make the
+;;; UNWIND-PROTECT is similar to CATCH, but hairier. We make the
 ;;; cleanup forms into a local function so that they can be referenced
 ;;; both in the case where we are unwound and in any local exits. We
 ;;; use %CLEANUP-FUNCTION on this to indicate that reference by
-;;; %UNWIND-PROTECT ISN'T "real", and thus doesn't cause creation of
+;;; %UNWIND-PROTECT isn't "real", and thus doesn't cause creation of
 ;;; an XEP.
 (def-ir1-translator unwind-protect ((protected &body cleanup) start cont)
   #!+sb-doc
index 26a25a6..4f2eb6e 100644 (file)
 
     (cond ((null refs)
           (typecase leaf
-            (lambda-var (delete-lambda-var leaf))
+            (lambda-var
+             (delete-lambda-var leaf))
             (clambda
              (ecase (functional-kind leaf)
                ((nil :let :mv-let :assignment :escape :cleanup)
index b0a9467..d7ae1ac 100644 (file)
 \f
 ;;;; conflict determination
 
-;;; Return true if the element at the specified offset in SB has a conflict
-;;; with TN:
-;;; -- If an component-live TN (:component kind), then iterate over all the
-;;;    blocks. If the element at Offset is used anywhere in any of the
-;;;    component's blocks (always-live /= 0), then there is a conflict.
-;;; -- If TN is global (Confs true), then iterate over the blocks TN is live in
-;;;    (using TN-Global-Conflicts). If the TN is live everywhere in the block
-;;;    (:Live), then there is a conflict if the element at offset is used
-;;;    anywhere in the block (Always-Live /= 0). Otherwise, we use the local
-;;;    TN number for TN in block to find whether TN has a conflict at Offset in
+;;; Return true if the element at the specified offset in SB has a
+;;; conflict with TN:
+;;; -- If a component-live TN (:component kind), then iterate over
+;;;    all the blocks. If the element at Offset is used anywhere in
+;;;    any of the component's blocks (always-live /= 0), then there
+;;;    is a conflict.
+;;; -- If TN is global (Confs true), then iterate over the blocks TN
+;;;    is live in (using TN-Global-Conflicts). If the TN is live
+;;;    everywhere in the block (:LIVE), then there is a conflict
+;;;    if the element at offset is used anywhere in the block
+;;;    (Always-Live /= 0). Otherwise, we use the local TN number for
+;;;    TN in block to find whether TN has a conflict at Offset in
 ;;;    that block.
-;;; -- If TN is local, then we just check for a conflict in the block it is
-;;;    local to.
+;;; -- If TN is local, then we just check for a conflict in the block
+;;;    it is local to.
 (defun offset-conflicts-in-sb (tn sb offset)
   (declare (type tn tn) (type finite-sb sb) (type index offset))
   (let ((confs (tn-global-conflicts tn))
       (when (offset-conflicts-in-sb tn sb (+ offset i))
        (return t)))))
 
-;;; Add TN's conflicts into the conflicts for the location at Offset in SC.
-;;; We iterate over each location in TN, adding to the conflicts for that
-;;; location:
-;;; -- If TN is a :Component TN, then iterate over all the blocks, setting
-;;;    all of the local conflict bits and the always-live bit. This records a
-;;;    conflict with any TN that has a LTN number in the block, as well as with
-;;;    :Always-Live and :Environment TNs.
+;;; Add TN's conflicts into the conflicts for the location at OFFSET
+;;; in SC. We iterate over each location in TN, adding to the
+;;; conflicts for that location:
+;;; -- If TN is a :COMPONENT TN, then iterate over all the blocks,
+;;;    setting all of the local conflict bits and the always-live bit.
+;;;    This records a conflict with any TN that has a LTN number in
+;;;    the block, as well as with :ALWAYS-LIVE and :ENVIRONMENT TNs.
 ;;; -- If TN is global, then iterate over the blocks TN is live in. In
-;;;    addition to setting the always-live bit to represent the conflict with
-;;;    TNs live throughout the block, we also set bits in the local conflicts.
-;;;    If TN is :Always-Live in the block, we set all the bits, otherwise we or
-;;;    in the local conflict bits.
-;;; -- If the TN is local, then we just do the block it is local to, setting
-;;;    always-live and OR'ing in the local conflicts.
+;;;    addition to setting the always-live bit to represent the conflict
+;;;    with TNs live throughout the block, we also set bits in the
+;;;    local conflicts. If TN is :ALWAYS-LIVE in the block, we set all
+;;;    the bits, otherwise we OR in the local conflict bits.
+;;; -- If the TN is local, then we just do the block it is local to,
+;;;    setting always-live and OR'ing in the local conflicts.
 (defun add-location-conflicts (tn sc offset)
   (declare (type tn tn) (type sc sc) (type index offset))
   (let ((confs (tn-global-conflicts tn))
          (setf (finite-sb-last-offset sb) 0))))))
 
 ;;; Expand the :Unbounded SB backing SC by either the initial size or
-;;; the SC element size, whichever is larger. If Needed-Size is
+;;; the SC element size, whichever is larger. If NEEDED-SIZE is
 ;;; larger, then use that size.
 (defun grow-sc (sc &optional (needed-size 0))
   (declare (type sc sc) (type index needed-size))
                (make-array size
                            :initial-element
                            #-sb-xc #*
-                           ;; The cross-compiler isn't very good at dumping
-                           ;; specialized arrays, so we delay construction of
-                           ;; this SIMPLE-BIT-VECTOR until runtime.
+                           ;; The cross-compiler isn't very good at
+                           ;; dumping specialized arrays, so we delay
+                           ;; construction of this SIMPLE-BIT-VECTOR
+                           ;; until runtime.
                            #+sb-xc (make-array 0 :element-type 'bit)))
 
          (fill nil (finite-sb-conflicts sb))
 \f
 ;;;; internal errors
 
-;;; Give someone a hard time because there isn't any load function defined
-;;; to move from Src to Dest.
+;;; Give someone a hard time because there isn't any load function
+;;; defined to move from SRC to DEST.
 (defun no-load-function-error (src dest)
   (let* ((src-sc (tn-sc src))
         (src-name (sc-name src-sc))
       (pushnew tn (gethash vop (ir2-component-spilled-vops 2comp)))))
   (values))
 
-;;; Make a save TN for TN, pack it, and return it. We copy various conflict
-;;; information from the TN so that pack does the right thing.
+;;; Make a save TN for TN, pack it, and return it. We copy various
+;;; conflict information from the TN so that pack does the right
+;;; thing.
 (defun pack-save-tn (tn)
   (declare (type tn tn))
   (let ((res (make-tn 0 :save nil nil)))
                           vop))
     (emit-operand-load node block save tn next)))
 
-;;; Return a VOP after which is an o.k. place to save the value of TN.
+;;; Return a VOP after which is an OK place to save the value of TN.
 ;;; For correctness, it is only required that this location be after
 ;;; any possible write and before any possible restore location.
 ;;;
           (save-complex-writer-tn tn vop))))
   (values))
 
-;;; Scan over the VOPs in Block, emiting saving code for TNs noted in the
-;;; codegen info that are packed into saved SCs.
+;;; Scan over the VOPs in BLOCK, emiting saving code for TNs noted in
+;;; the codegen info that are packed into saved SCs.
 (defun emit-saves (block)
   (declare (type ir2-block block))
   (do ((vop (ir2-block-start-vop block) (vop-next vop)))
index e319ef8..bfe514f 100644 (file)
 ;;; -- 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.
-;;; -- If the exit is from an :Escape function, then substitute a
+;;; -- Close over the NLX-INFO in the exit environment.
+;;; -- If the exit is from an :ESCAPE function, then substitute a
 ;;;    constant reference to NLX-Info structure for the escape
 ;;;    function reference. This will cause the escape function to
 ;;;    be deleted (although not removed from the DFO.)  The escape
   (let ((entry (exit-entry exit))
        (cont (node-cont exit))
        (exit-fun (node-home-lambda exit)))
-
     (if (find-nlx-info entry cont)
        (let ((block (node-block exit)))
          (aver (= (length (block-succ block)) 1))
          (unlink-blocks block (first (block-succ block)))
          (link-blocks block (component-tail (block-component block))))
        (insert-nlx-entry-stub exit env))
-
     (let ((info (find-nlx-info entry cont)))
       (aver info)
       (close-over info (node-physenv exit) env)
        (let ((node (block-last (nlx-info-target info))))
          (delete-continuation-use node)
          (add-continuation-use node (nlx-info-continuation info))))))
-
   (values))
 
 ;;; Iterate over the EXITs in COMPONENT, calling NOTE-NON-LOCAL-EXIT
   (dolist (lambda (component-lambdas component))
     (dolist (entry (lambda-entries lambda))
       (dolist (exit (entry-exits entry))
-       (let ((target-env (node-physenv entry)))
-         (if (eq (node-physenv exit) target-env)
+       (let ((target-physenv (node-physenv entry)))
+         (if (eq (node-physenv exit) target-physenv)
              (maybe-delete-exit exit)
-             (note-non-local-exit target-env exit))))))
-
+             (note-non-local-exit target-physenv exit))))))
   (values))
 \f
 ;;;; cleanup emission
 ;;; in an implicit MV-PROG1. We have to force local call analysis of
 ;;; new references to UNWIND-PROTECT cleanup functions. If we don't
 ;;; actually have to do anything, then we don't insert any cleanup
-;;; code.
+;;; code. (FIXME: There's some confusion here, left over from CMU CL
+;;; comments. CLEANUP1 isn't mentioned in the code of this function.
+;;; It is in code elsewhere, but if the comments for this function
+;;; mention it they should explain the relationship to the other code.)
 ;;;
 ;;; If we do insert cleanup code, we check that BLOCK1 doesn't end in
 ;;; a "tail" local call.
index f472814..f4a439e 100644 (file)
@@ -18,4 +18,4 @@
 ;;; for internal versions, especially for internal versions off the
 ;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.pre7.86.flaky7.13"
+"0.pre7.86.flaky7.14"