0.6.8.18:
authorWilliam Harold Newman <william.newman@airmail.net>
Wed, 15 Nov 2000 02:29:38 +0000 (02:29 +0000)
committerWilliam Harold Newman <william.newman@airmail.net>
Wed, 15 Nov 2000 02:29:38 +0000 (02:29 +0000)
removed MNA "which patch is this?" comments
removed undocumented "MNA: locally patch" patch

src/code/debug.lisp
src/code/late-type.lisp
src/code/package.lisp
src/compiler/ir1tran.lisp
src/compiler/ir1util.lisp
src/compiler/main.lisp
src/compiler/node.lisp
src/compiler/srctran.lisp
src/compiler/target-disassem.lisp
src/pcl/boot.lisp
version.lisp-expr

index e89d012..16f9176 100644 (file)
@@ -486,10 +486,10 @@ Function and macro commands:
                                             s)))))
   string)
 
-;;; Print frame with verbosity level 1. If we hit a rest-arg, then
+;;; Print frame with verbosity level 1. If we hit a &REST arg, then
 ;;; print as many of the values as possible, punting the loop over
 ;;; lambda-list variables since any other arguments will be in the
-;;; rest-arg's list of values.
+;;; &REST arg's list of values.
 (defun print-frame-call-1 (frame)
   (let* ((d-fun (sb!di:frame-debug-function frame))
         (loc (sb!di:frame-code-location frame))
@@ -515,6 +515,19 @@ Function and macro commands:
       (sb!di:lambda-list-unavailable
        ()
        (push (make-unprintable-object "lambda list unavailable") results)))
+    ;; FIXME: For some reason this sometimes prints as
+    ;;    (FOO-BAR-LONG-THING
+    ;;     X
+    ;;     Y
+    ;;     Z)
+    ;; (OK) and sometimes prints as
+    ;;    (FOO-BAR-LONG-THING X
+    ;;                        Y
+    ;;                        Z)
+    ;; even when this second style causes confusingly long weird lines
+    ;; (bad). Handle printing explicitly inside our own
+    ;; PPRINT-LOGICAL-BLOCK, and force the preferred style for long
+    ;; lines.
     (prin1 (mapcar #'ensure-printable-object (nreverse results)))
     (when (sb!di:debug-function-kind d-fun)
       (write-char #\[)
@@ -536,8 +549,8 @@ Function and macro commands:
     (sb!di:debug-var-value var frame)
     (make-unprintable-object "unavailable arg")))
 
-;;; Prints a representation of the function call causing frame to
-;;; exist. Verbosity indicates the level of information to output;
+;;; Prints a representation of the function call causing FRAME to
+;;; exist. VERBOSITY indicates the level of information to output;
 ;;; zero indicates just printing the debug-function's name, and one
 ;;; indicates displaying call-like, one-liner format with argument
 ;;; values.
@@ -845,8 +858,9 @@ reset to ~S."
                   (:set
                    `(setf (sb!di:debug-var-value (car vars) *current-frame*)
                           ,value-var))))
-              ;; If there weren't any exact matches, flame about ambiguity
-              ;; unless all the variables have the same name.
+              ;; If there weren't any exact matches, flame about
+              ;; ambiguity unless all the variables have the same
+              ;; name.
               ((and (not exact)
                     (find-if-not
                      #'(lambda (v)
@@ -858,8 +872,8 @@ reset to ~S."
                               (delete-duplicates
                                vars :test #'string=
                                :key #'sb!di:debug-var-symbol-name))))
-              ;; All names are the same, so see whether the user ID'ed one of
-              ;; them.
+              ;; All names are the same, so see whether the user
+              ;; ID'ed one of them.
               (id-supplied
                (let ((v (find id vars :key #'sb!di:debug-var-id)))
                  (unless v
@@ -901,11 +915,11 @@ reset to ~S."
 (defun (setf var) (value name &optional (id 0 id-supplied))
   (define-var-operation :set value))
 
-;;; This returns the COUNT'th arg as the user sees it from args, the result of
-;;; SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a potential
-;;; DEBUG-VAR from the lambda-list, then the second value is T. If this
-;;; returns a keyword symbol or a value from a rest arg, then the second value
-;;; is NIL.
+;;; This returns the COUNT'th arg as the user sees it from args, the
+;;; result of SB!DI:DEBUG-FUNCTION-LAMBDA-LIST. If this returns a
+;;; potential DEBUG-VAR from the lambda-list, then the second value is
+;;; T. If this returns a keyword symbol or a value from a rest arg,
+;;; then the second value is NIL.
 (declaim (ftype (function (index list)) nth-arg))
 (defun nth-arg (count args)
   (let ((n count))
@@ -922,7 +936,7 @@ reset to ~S."
        :rest ((let ((var (second ele)))
                 (lambda-var-dispatch var (sb!di:frame-code-location
                                           *current-frame*)
-                  (error "unused REST-arg before n'th argument")
+                  (error "unused &REST arg before n'th argument")
                   (dolist (value
                            (sb!di:debug-var-value var *current-frame*)
                            (error
@@ -931,7 +945,7 @@ reset to ~S."
                     (if (zerop n)
                         (return-from nth-arg (values value nil))
                         (decf n)))
-                  (error "invalid REST-arg before n'th argument")))))
+                  (error "invalid &REST arg before n'th argument")))))
       (decf n))))
 
 (defun arg (n)
index 68ba00d..576c771 100644 (file)
 ;;;; We provide a few special operations that can be meaningfully used
 ;;;; on VALUES types (as well as on any other type).
 
-;;; Return the type of the first value indicated by Type. This is used
-;;; by people who don't want to have to deal with values types.
-
-;;; MNA: fix-instance-typep-call patch
+;;; Return the type of the first value indicated by TYPE. This is used
+;;; by people who don't want to have to deal with VALUES types.
 #!-sb-fluid (declaim (freeze-type values-type))
 ; (inline single-value-type))
 (defun single-value-type (type)
   (cond ((values-type-p type)
         (or (car (args-type-required type))
              (if (args-type-optional type)
-                 (type-union (car (args-type-optional type)) (specifier-type 'null)))
+                 (type-union (car (args-type-optional type))
+                            (specifier-type 'null)))
             (args-type-rest type)
              (specifier-type 'null)))
        ((eq type *wild-type*)
            (values fixed (+ fixed (length (args-type-optional type))))))
       (values nil nil)))
 
-;;; Determine if Type corresponds to a definite number of values. The
-;;; first value is a list of the types for each value, and the second
-;;; value is the number of values. If the number of values is not
-;;; fixed, then return NIL and :Unknown.
+;;; Determine whether TYPE corresponds to a definite number of values.
+;;; The first value is a list of the types for each value, and the
+;;; second value is the number of values. If the number of values is
+;;; not fixed, then return NIL and :UNKNOWN.
 (defun values-types (type)
   (declare (type ctype type))
   (cond ((eq type *wild-type*)
           (values (mapcar #'single-value-type req) (length req))))))
 
 ;;; Return two values:
-;;; MNA: fix-instance-typep-call patch
 ;;; 1. A list of all the positional (fixed and optional) types.
 ;;; 2. The &REST type (if any). If keywords allowed, *UNIVERSAL-TYPE*.
 ;;;    If no keywords or &REST, then the DEFAULT-TYPE.
          (cond ((args-type-keyp type) *universal-type*)
                ((args-type-rest type))
                (t
-                  ;; MNA: fix-instance-typep-call patch
-                  default-type))))
+                default-type))))
 
 ;;; Return a list of OPERATION applied to the types in TYPES1 and
 ;;; TYPES2, padding with REST2 as needed. TYPES1 must not be shorter
 ;;; OPERATION returned true as its second value each time we called
 ;;; it. Since we approximate the intersection of VALUES types, the
 ;;; second value being true doesn't mean the result is exact.
-;;; MNA: fix-instance-typep-call patch
 (defun args-type-op (type1 type2 operation nreq default-type)
-  ;;; MNA: fix-instance-typep-call patch
   (declare (type ctype type1 type2 default-type)
           (type function operation nreq))
   (if (or (values-type-p type1) (values-type-p type2))
       (let ((type1 (coerce-to-values type1))
            (type2 (coerce-to-values type2)))
        (multiple-value-bind (types1 rest1)
-            ;;; MNA: fix-instance-typep-call patch
             (values-type-types type1 default-type)
          (multiple-value-bind (types2 rest2)
-              ;;; MNA: fix-instance-typep-call patch
               (values-type-types type2 default-type)
            (multiple-value-bind (rest rest-exact)
                (funcall operation rest1 rest2)
                               :optional (if opt-last
                                             (subseq opt 0 (1+ opt-last))
                                             ())
-                               ;; MNA fix-instance-typep-call patch
                               :rest (if (eq rest default-type) nil rest))
                              (and rest-exact res-exact)))))))))
       (funcall operation type1 type2)))
        ((eq type1 *empty-type*) type2)
        ((eq type2 *empty-type*) type1)
        (t
-          ;;; MNA: fix-instance-typep-call patch
         (values (args-type-op type1 type2 #'type-union #'min *empty-type*)))))
-;;;
 (defun-cached (values-type-intersection :hash-function type-cache-hash
                                        :hash-bits 8
                                        :values 2
   (cond ((eq type1 *wild-type*) (values type2 t))
        ((eq type2 *wild-type*) (values type1 t))
        (t
-        (args-type-op type1 type2 #'type-intersection #'max (specifier-type 'null)))))
+        (args-type-op type1 type2
+                      #'type-intersection
+                      #'max
+                      (specifier-type 'null)))))
 
 ;;; This is like TYPES-INTERSECT, except that it sort of works on
 ;;; VALUES types. Note that due to the semantics of
index 7a64d3a..fa1c1da 100644 (file)
                     ,@(when (member :internal ',ordered-types)
                         `((:internal
                            (setf ,',counter
-                                 (position-if #',',real-symbol-p ,',hash-vector
+                                 (position-if #',',real-symbol-p
+                                              ,',hash-vector
                                               :start (if ,',counter
                                                          (1+ ,',counter)
                                                          0)))
                     ,@(when (member :external ',ordered-types)
                         `((:external
                            (setf ,',counter
-                                 (position-if #',',real-symbol-p ,',hash-vector
+                                 (position-if #',',real-symbol-p
+                                              ,',hash-vector
                                               :start (if ,',counter
                                                          (1+ ,',counter)
                                                          0)))
index 06aa22b..692712b 100644 (file)
                             (string= (symbol-name what) "CLASS"))) ; pcl hack
                   (or (info :type :kind what)
                       (and (consp what) (info :type :translator (car what)))))
-;;; MNA - abbreviated declaration bug
-;;               (unless (policy nil (= brevity 3))
-               ;; FIXME: Is it ANSI to warn about this? I think not.
-;;             (compiler-note "abbreviated type declaration: ~S." spec))
              (process-type-declaration spec res vars))
             ((info :declaration :recognized what)
              res)
                       (let ((n-supplied (gensym "N-SUPPLIED-")))
                         (temps n-supplied)
                         (arg-vals n-value n-supplied)
-                         ;; MNA: non-self-eval-keyword patch
                         (tests `((eq ,n-key ',keyword)
                                  (setq ,n-supplied t)
                                  (setq ,n-value ,n-value-temp)))))
                      (t
                       (arg-vals n-value)
-                        ;; MNA: non-self-eval-keyword patch
                       (tests `((eq ,n-key ',keyword)
                                (setq ,n-value ,n-value-temp)))))))
 
     (prev-link entry start)
     (use-continuation entry dummy)
     
-    ;; MNA - Re: two obscure bugs in CMU CL
     (let* ((env-entry (list entry cont))
-           (*lexenv*
-            (make-lexenv :blocks (list (cons name env-entry))
-                                :cleanup cleanup)))
+           (*lexenv* (make-lexenv :blocks (list (cons name env-entry))
+                                 :cleanup cleanup)))
       (push env-entry (continuation-lexenv-uses cont))
       (ir1-convert-progn-body dummy cont forms))))
 
              (conts))
       (starts dummy)
       (dolist (segment (rest segments))
-       ;; MNA - Re: two obscure bugs
        (let* ((tag-cont (make-continuation))
                (tag (list (car segment) entry tag-cont)))          
          (conts tag-cont)
          (starts tag-cont)
          (continuation-starts-block tag-cont)
           (tags tag)
-          (push (cdr tag) (continuation-lexenv-uses tag-cont))
-          ))
+          (push (cdr tag) (continuation-lexenv-uses tag-cont))))
       (conts cont)
 
       (let ((*lexenv* (make-lexenv :cleanup cleanup :tags (tags))))
   the Forms are also processed as top-level forms."
   (multiple-value-bind (forms decls) (sb!sys:parse-body body nil)
     (let ((*lexenv* (process-decls decls nil nil cont)))
-      ;;; MNA: locally patch - #'ir1-convert-progn-body gets called anyway!
-      (ir1-convert-progn-body start cont forms))))
+      (ir1-convert-aux-bindings start cont forms nil nil nil))))
 \f
 ;;;; FLET and LABELS
 
       (ir1-convert start cont `(%%define-compiler-macro ',name ,fun ,doc)))
 
     (when sb!xc:*compile-print*
-      ;; MNA compiler message patch
       (compiler-mumble "~&; converted ~S~%" name))))
 \f
 ;;;; defining global functions
                       ,@(when save-expansion `(',save-expansion)))))
 
        (when sb!xc:*compile-print*
-          ;; MNA compiler message patch
          (compiler-mumble "~&; converted ~S~%" name))))))
index 971eaef..c846a07 100644 (file)
     (setf (continuation-dest new) dest))
   (values))
 
-;;; Replace all uses of Old with uses of New, where New has an arbitary
-;;; number of uses. If New will end up with more than one use, then we must
-;;; arrange for it to start a block if it doesn't already.
+;;; Replace all uses of OLD with uses of NEW, where NEW has an
+;;; arbitary number of uses. If NEW will end up with more than one
+;;; use, then we must arrange for it to start a block if it doesn't
+;;; already.
 (defun substitute-continuation-uses (new old)
   (declare (type continuation old new))
   (unless (and (eq (continuation-kind new) :unused)
   (do-uses (node old)
     (delete-continuation-use node)
     (add-continuation-use node new))
-  ;; MNA: Re: two obscure bugs in CMU CL
   (dolist (lexenv-use (continuation-lexenv-uses old))
     (setf (cadr lexenv-use) new))
 
 \f
 ;;;; block starting/creation
 
-;;; Return the block that Continuation is the start of, making a block if
-;;; necessary. This function is called by IR1 translators which may cause a
-;;; continuation to be used more than once. Every continuation which may be
-;;; used more than once must start a block by the time that anyone does a
-;;; Use-Continuation on it.
+;;; Return the block that CONT is the start of, making a block if
+;;; necessary. This function is called by IR1 translators which may
+;;; cause a continuation to be used more than once. Every continuation
+;;; which may be used more than once must start a block by the time
+;;; that anyone does a USE-CONTINUATION on it.
 ;;;
 ;;; We also throw the block into the next/prev list for the
-;;; *current-component* so that we keep track of which blocks we have made.
+;;; *CURRENT-COMPONENT* so that we keep track of which blocks we have
+;;; made.
 (defun continuation-starts-block (cont)
   (declare (type continuation cont))
   (ecase (continuation-kind cont)
               (values '(unable to locate source)
                       '((some strange place)))))))))
 
-;;; Convert a source form to a string, formatted suitably for use in
+;;; Convert a source form to a string, suitably formatted for use in
 ;;; compiler warnings.
 (defun stringify-form (form &optional (pretty t))
   (let ((*print-level* *compiler-error-print-level*)
        (*print-lines* *compiler-error-print-lines*)
        (*print-pretty* pretty))
     (if pretty
-      ;;; MNA: compiler message patch
-      ;;; (format nil "  ~S~%" form)
-      (format nil "~<~@;  ~S~:>" (list form))
+       (format nil "~<~@;  ~S~:>" (list form))
        (prin1-to-string form))))
 
-;;; Return a COMPILER-ERROR-CONTEXT structure describing the current error
-;;; context, or NIL if we can't figure anything out. ARGS is a list of things
-;;; that are going to be printed out in the error message, and can thus be
-;;; blown off when they appear in the source context.
+;;; Return a COMPILER-ERROR-CONTEXT structure describing the current
+;;; error context, or NIL if we can't figure anything out. ARGS is a
+;;; list of things that are going to be printed out in the error
+;;; message, and can thus be blown off when they appear in the source
+;;; context.
 (defun find-error-context (args)
   (let ((context *compiler-error-context*))
     (if (compiler-error-context-p context)
 \f
 ;;;; printing error messages
 
-;;; We save the context information that we printed out most recently so that
-;;; we don't print it out redundantly.
+;;; We save the context information that we printed out most recently
+;;; so that we don't print it out redundantly.
 
 ;;; The last COMPILER-ERROR-CONTEXT that we printed.
 (defvar *last-error-context* nil)
 (declaim (type (or string null) *last-format-string*))
 (declaim (type list *last-format-args*))
 
-;;; The number of times that the last error message has been emitted, so that
-;;; we can compress duplicate error messages.
+;;; The number of times that the last error message has been emitted,
+;;; so that we can compress duplicate error messages.
 (defvar *last-message-count* 0)
 (declaim (type index *last-message-count*))
 
   (cond ((= *last-message-count* 1)
         (when terpri (terpri *error-output*)))
        ((> *last-message-count* 1)
-          ;; MNA: compiler message patch
-          (format *error-output* "~&; [Last message occurs ~D times]~2%"
+          (format *error-output* "~&; [Last message occurs ~D times.]~2%"
                 *last-message-count*)))
   (setq *last-message-count* 0))
 
-;;; Print out the message, with appropriate context if we can find it. If
-;;; If the context is different from the context of the last message we
-;;; printed, then we print the context. If the original source is different
-;;; from the source we are working on, then we print the current source in
-;;; addition to the original source.
+;;; Print out the message, with appropriate context if we can find it.
+;;; If If the context is different from the context of the last
+;;; message we printed, then we print the context. If the original
+;;; source is different from the source we are working on, then we
+;;; print the current source in addition to the original source.
 ;;;
-;;; We suppress printing of messages identical to the previous, but record
-;;; the number of times that the message is repeated.
+;;; We suppress printing of messages identical to the previous, but
+;;; record the number of times that the message is repeated.
 (defun print-compiler-message (format-string format-args)
 
   (declare (type simple-string format-string))
          (when (pathnamep file)
            (note-message-repeats)
            (setq last nil)
-            ;; MNA: compiler message patch
             (format stream "~2&; file: ~A~%" (namestring file))))
 
        (unless (and last
                     (equal in (compiler-error-context-context last)))
          (note-message-repeats)
          (setq last nil)
-          ;; MNA: compiler message patch
           (format stream "~&")
           (pprint-logical-block (stream nil :per-line-prefix "; ")
             (format stream "in:~{~<~%    ~4:;~{ ~S~}~>~^ =>~}" in))
                              (compiler-error-context-original-source last)))
          (note-message-repeats)
          (setq last nil)
-          ;; MNA: compiler message patch
           (format stream "~&")
           (pprint-logical-block (stream nil :per-line-prefix "; ")
             (format stream "  ~A" form))
          (when enclosing
            (note-message-repeats)
            (setq last nil)
-            ;; MNA: compiler message patch
            (format stream "~&; --> ~{~<~%; --> ~1:;~A~> ~}~%" enclosing)))
 
        (unless (and last
          (when source
            (note-message-repeats)
            (dolist (src source)
-              ;; MNA: compiler message patch
               (format stream "~&")
               (write-string "; ==>" stream)
               (format stream "~&")
       (let ((*print-level*  *compiler-error-print-level*)
            (*print-length* *compiler-error-print-length*)
            (*print-lines*  *compiler-error-print-lines*))
-        ;; MNA: compiler message patch
         (format stream "~&")
         (pprint-logical-block (stream nil :per-line-prefix "; ")
           (format stream "~&~?" format-string format-args))
index 55dde29..e3a1b9b 100644 (file)
 ;;; Mumble conditional on *COMPILE-PROGRESS*.
 (defun maybe-mumble (&rest foo)
   (when *compile-progress*
-    ;; MNA: compiler message patch
     (compiler-mumble "~&")
     (pprint-logical-block (*error-output* nil :per-line-prefix "; ")
        (apply #'compiler-mumble foo))))
                   (zerop *compiler-warning-count*)
                   (zerop *compiler-style-warning-count*)
                   (zerop *compiler-note-count*)))
-    ;; MNA: compiler message patch
     (format *error-output* "~&")
     (pprint-logical-block (*error-output* nil :per-line-prefix "; ")
     (compiler-mumble
                 (return nil)))))))
 
     (when sb!xc:*compile-print*
-      ;; MNA: compiler message patch
       (compiler-mumble "~&; ~:[~;byte ~]compiling ~A: "
                       *byte-compiling*
                       (component-name component)))
         (*top-level-lambdas* ())
         (*pending-top-level-lambdas* ())
         (*compiler-error-bailout*
-         #'(lambda ()
-             (compiler-mumble
-               ;; MNA: compiler message patch
-              "~2&; fatal error, aborting compilation~%")
-             (return-from sub-compile-file (values nil t t))))
+         (lambda ()
+           (compiler-mumble "~2&; fatal error, aborting compilation~%")
+           (return-from sub-compile-file (values nil t t))))
         (*current-path* nil)
         (*last-source-context* nil)
         (*last-original-source* nil)
 (defun start-error-output (source-info)
   (declare (type source-info source-info))
   (dolist (x (source-info-files source-info))
-    ;; MNA: compiler message patch
     (compiler-mumble "~&; compiling file ~S (written ~A):~%"
                     (namestring (file-info-name x))
                     (sb!int:format-universal-time nil
 
 (defun finish-error-output (source-info won)
   (declare (type source-info source-info))
-  ;; MNA: compiler message patch
   (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
                   won
                   (elapsed-time-to-string
        (close-fasl-file fasl-file (not compile-won))
        (setq output-file-name (pathname (fasl-file-stream fasl-file)))
        (when (and compile-won sb!xc:*compile-verbose*)
-          ;; MNA: compiler message patch
          (compiler-mumble "~2&; ~A written~%" (namestring output-file-name))))
 
       (when sb!xc:*compile-verbose*
index 90be478..0c4b05c 100644 (file)
   ;; An indication of the way that this continuation is currently used:
   ;;
   ;; :UNUSED
-  ;;   A continuation for which all control-related slots have the default
-  ;;   values. A continuation is unused during IR1 conversion until it is
-  ;;   assigned a block, and may be also be temporarily unused during
-  ;;   later manipulations of IR1. In a consistent state there should
-  ;;   never be any mention of :UNUSED continuations. Next can have a
-  ;;   non-null value if the next node has already been determined.
+  ;;   A continuation for which all control-related slots have the
+  ;;   default values. A continuation is unused during IR1 conversion
+  ;;   until it is assigned a block, and may be also be temporarily
+  ;;   unused during later manipulations of IR1. In a consistent
+  ;;   state there should never be any mention of :UNUSED
+  ;;   continuations. Next can have a non-null value if the next node
+  ;;   has already been determined.
   ;;
   ;; :DELETED
   ;;   A continuation that has been deleted from IR1. Any pointers into
   ;;   START-USES is a list of all the uses.
   ;;
   ;; :DELETED-BLOCK-START
-  ;;   Like :BLOCK-START, but BLOCK has been deleted. A block starting
-  ;;   continuation is made into a deleted block start when the block is
-  ;;   deleted, but the continuation still may have value semantics.
-  ;;   Since there isn't any code left, next is null.
+  ;;   Like :BLOCK-START, but BLOCK has been deleted. A block
+  ;;   starting continuation is made into a deleted block start when
+  ;;   the block is deleted, but the continuation still may have
+  ;;   value semantics. Since there isn't any code left, next is
+  ;;   null.
   ;;
   ;; :INSIDE-BLOCK
   ;;   A continuation that is the CONT of some node in BLOCK.
   ;; this is null even though the node that receives this continuation may not
   ;; yet be deleted.
   (dest nil :type (or node null))
-  ;; If this is a NODE, then it is the node which is to be evaluated next.
-  ;; This is always null in :DELETED and :UNUSED continuations, and will be
-  ;; null in a :INSIDE-BLOCK continuation when this is the CONT of the LAST.
+  ;; If this is a NODE, then it is the node which is to be evaluated
+  ;; next. This is always null in :DELETED and :UNUSED continuations,
+  ;; and will be null in a :INSIDE-BLOCK continuation when this is the
+  ;; CONT of the LAST.
   (next nil :type (or node null))
-  ;; An assertion on the type of this continuation's value.
+  ;; an assertion on the type of this continuation's value
   (asserted-type *wild-type* :type ctype)
-  ;; Cached type of this continuation's value. If NIL, then this must be
-  ;; recomputed: see CONTINUATION-DERIVED-TYPE.
+  ;; cached type of this continuation's value. If NIL, then this must
+  ;; be recomputed: see CONTINUATION-DERIVED-TYPE.
   (%derived-type nil :type (or ctype null))
-  ;; Node where this continuation is used, if unique. This is always null in
-  ;; :DELETED and :UNUSED continuations, and is never null in :INSIDE-BLOCK
-  ;; continuations. In a :BLOCK-START continuation, the Block's START-USES
-  ;; indicate whether NIL means no uses or more than one use.
+  ;; Node where this continuation is used, if unique. This is always
+  ;; null in :DELETED and :UNUSED continuations, and is never null in
+  ;; :INSIDE-BLOCK continuations. In a :BLOCK-START continuation, the
+  ;; Block's START-USES indicate whether NIL means no uses or more
+  ;; than one use.
   (use nil :type (or node null))
-  ;; Basic block this continuation is in. This is null only in :DELETED and
-  ;; :UNUSED continuations. Note that blocks that are unreachable but still in
-  ;; the DFO may receive deleted continuations, so it isn't o.k. to assume that
-  ;; any continuation that you pick up out of its DEST node has a BLOCK.
+  ;; the basic block this continuation is in. This is null only in
+  ;; :DELETED and :UNUSED continuations. Note that blocks that are
+  ;; unreachable but still in the DFO may receive deleted
+  ;; continuations, so it isn't o.k. to assume that any continuation
+  ;; that you pick up out of its DEST node has a BLOCK.
   (block nil :type (or cblock null))
-  ;; Set to true when something about this continuation's value has changed.
-  ;; See REOPTIMIZE-CONTINUATION. This provides a way for IR1 optimize to
-  ;; determine which operands to a node have changed. If the optimizer for
-  ;; this node type doesn't care, it can elect not to clear this flag.
+  ;; set to true when something about this continuation's value has
+  ;; changed. See REOPTIMIZE-CONTINUATION. This provides a way for IR1
+  ;; optimize to determine which operands to a node have changed. If
+  ;; the optimizer for this node type doesn't care, it can elect not
+  ;; to clear this flag.
   (reoptimize t :type boolean)
-  ;; An indication of what we have proven about how this contination's type
-  ;; assertion is satisfied:
+  ;; an indication of what we have proven about how this contination's
+  ;; type assertion is satisfied:
   ;;
   ;; NIL
   ;;    No type check is necessary (proven type is a subtype of the assertion.)
   ;;    A type check is needed.
   ;;
   ;; :DELETED
-  ;;    Don't do a type check, but believe (intersect) the assertion. A T
-  ;;    check can be changed to :DELETED if we somehow prove the check is
-  ;;    unnecessary, or if we eliminate it through a policy decision.
+  ;;    Don't do a type check, but believe (intersect) the assertion.
+  ;;    A T check can be changed to :DELETED if we somehow prove the
+  ;;    check is unnecessary, or if we eliminate it through a policy
+  ;;    decision.
   ;;
   ;; :NO-CHECK
-  ;;    Type check generation sets the slot to this if a check is called for,
-  ;;    but it believes it has proven that the check won't be done for
-  ;;    policy reasons or because a safe implementation will be used. In the
-  ;;    latter case, LTN must ensure that a safe implementation *is* be used.
+  ;;    Type check generation sets the slot to this if a check is
+  ;;    called for, but it believes it has proven that the check won't
+  ;;    be done for policy reasons or because a safe implementation
+  ;;    will be used. In the latter case, LTN must ensure that a safe
+  ;;    implementation *is* be used.
   ;;
   ;; :ERROR
-  ;;    There is a compile-time type error in some use of this continuation. A
-  ;;    type check should still be generated, but be careful.
+  ;;    There is a compile-time type error in some use of this
+  ;;    continuation. A type check should still be generated, but be
+  ;;    careful.
   ;;
   ;; This is computed lazily by CONTINUATION-DERIVED-TYPE, so use
   ;; CONTINUATION-TYPE-CHECK instead of the %'ed slot accessor.
   (%type-check t :type (member t nil :deleted :no-check :error))
-  ;; Something or other that the back end annotates this continuation with.
-  
-  ;; MNA: Re: two obscure bugs in CMU CL
+  ;; something or other that the back end annotates this continuation with
   (info nil)
-  ;;
-  ;; Uses of this continuation in the lexical environment.  They are recorded
-  ;; so that when one continuation is substituted for another the environment
-  ;; may be updated properly. 
-  ;; MNAFIX
-  (lexenv-uses nil :type list)
-)
+  ;; uses of this continuation in the lexical environment. They are
+  ;; recorded so that when one continuation is substituted for another
+  ;; the environment may be updated properly.
+  (lexenv-uses nil :type list))
 
 (def!method print-object ((x continuation) stream)
   (print-unreadable-object (x stream :type t :identity t)))
 
 (defstruct (node (:constructor nil))
-  ;; The bottom-up derived type for this node. This does not take into
+  ;; the bottom-up derived type for this node. This does not take into
   ;; consideration output type assertions on this node (actually on its CONT).
   (derived-type *wild-type* :type ctype)
-  ;; True if this node needs to be optimized. This is set to true whenever
-  ;; something changes about the value of a continuation whose DEST is this
-  ;; node.
+  ;; True if this node needs to be optimized. This is set to true
+  ;; whenever something changes about the value of a continuation
+  ;; whose DEST is this node.
   (reoptimize t :type boolean)
-  ;; The continuation which receives the value of this node. This also
-  ;; indicates what we do controlwise after evaluating this node. This may be
-  ;; null during IR1 conversion.
+  ;; the continuation which receives the value of this node. This also
+  ;; indicates what we do controlwise after evaluating this node. This
+  ;; may be null during IR1 conversion.
   (cont nil :type (or continuation null))
-  ;; The continuation that this node is the next of. This is null during
-  ;; IR1 conversion when we haven't linked the node in yet or in nodes that
-  ;; have been deleted from the IR1 by UNLINK-NODE.
+  ;; the continuation that this node is the next of. This is null
+  ;; during IR1 conversion when we haven't linked the node in yet or
+  ;; in nodes that have been deleted from the IR1 by UNLINK-NODE.
   (prev nil :type (or continuation null))
-  ;; The lexical environment this node was converted in.
+  ;; the lexical environment this node was converted in
   (lexenv *lexenv* :type lexenv)
-  ;; A representation of the source code responsible for generating this node.
+  ;; a representation of the source code responsible for generating
+  ;; this node
   ;;
-  ;; For a form introduced by compilation (does not appear in the original
-  ;; source), the path begins with a list of all the enclosing introduced
-  ;; forms. This list is from the inside out, with the form immediately
-  ;; responsible for this node at the head of the list.
+  ;; For a form introduced by compilation (does not appear in the
+  ;; original source), the path begins with a list of all the
+  ;; enclosing introduced forms. This list is from the inside out,
+  ;; with the form immediately responsible for this node at the head
+  ;; of the list.
   ;;
-  ;; Following the introduced forms is a representation of the location of the
-  ;; enclosing original source form. This transition is indicated by the magic
-  ;; ORIGINAL-SOURCE-START marker. The first element of the orignal source is
-  ;; the "form number", which is the ordinal number of this form in a
-  ;; depth-first, left-to-right walk of the truly top-level form in which this
-  ;; appears.
+  ;; Following the introduced forms is a representation of the
+  ;; location of the enclosing original source form. This transition
+  ;; is indicated by the magic ORIGINAL-SOURCE-START marker. The first
+  ;; element of the orignal source is the "form number", which is the
+  ;; ordinal number of this form in a depth-first, left-to-right walk
+  ;; of the truly top-level form in which this appears.
   ;;
-  ;; Following is a list of integers describing the path taken through the
-  ;; source to get to this point:
+  ;; Following is a list of integers describing the path taken through
+  ;; the source to get to this point:
   ;;     (K L M ...) => (NTH K (NTH L (NTH M ...)))
   ;;
-  ;; The last element in the list is the top-level form number, which is the
-  ;; ordinal number (in this call to the compiler) of the truly top-level form
-  ;; containing the orignal source.
+  ;; The last element in the list is the top-level form number, which
+  ;; is the ordinal number (in this call to the compiler) of the truly
+  ;; top-level form containing the orignal source.
   (source-path *current-path* :type list)
-  ;; If this node is in a tail-recursive position, then this is set to T. At
-  ;; the end of IR1 (in environment analysis) this is computed for all nodes
-  ;; (after cleanup code has been emitted). Before then, a non-null value
-  ;; indicates that IR1 optimization has converted a tail local call to a
-  ;; direct transfer.
+  ;; If this node is in a tail-recursive position, then this is set to
+  ;; T. At the end of IR1 (in environment analysis) this is computed
+  ;; for all nodes (after cleanup code has been emitted). Before then,
+  ;; a non-null value indicates that IR1 optimization has converted a
+  ;; tail local call to a direct transfer.
   ;;
-  ;; If the back-end breaks tail-recursion for some reason, then it can null
-  ;; out this slot.
+  ;; If the back-end breaks tail-recursion for some reason, then it
+  ;; can null out this slot.
   (tail-p nil :type boolean))
 
-;;; Flags that are used to indicate various things about a block, such as what
-;;; optimizations need to be done on it:
+;;; 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
 ;;;    value-driven (forward) IR1 optimizations should be done on this block.
 ;;;     - have no successors, or
 ;;;     - receive :DELETED continuations.
 ;;; -- TYPE-ASSERTED, TEST-MODIFIED
-;;;    These flags are used to indicate that something in this block might be
-;;;    of interest to constraint propagation. TYPE-ASSERTED is set when a
-;;;    continuation type assertion is strengthened. TEST-MODIFIED is set
-;;;    whenever the test for the ending IF has changed (may be true when there
-;;;    is no IF.)
+;;;    These flags are used to indicate that something in this block
+;;;    might be of interest to constraint propagation. TYPE-ASSERTED
+;;;    is set when a continuation type assertion is strengthened.
+;;;    TEST-MODIFIED is set whenever the test for the ending IF has
+;;;    changed (may be true when there is no IF.)
 (def-boolean-attribute block
   reoptimize flush-p type-check delete-p type-asserted test-modified)
 
   (frob type-asserted)
   (frob test-modified))
 
-;;; The CBLOCK structure represents a basic block. We include SSET-ELEMENT so
-;;; that we can have sets of blocks. Initially the SSET-ELEMENT-NUMBER is
-;;; null, DFO analysis numbers in reverse DFO. During IR2 conversion, IR1
-;;; blocks are re-numbered in forward emit order. This latter numbering also
-;;; forms the basis of the block numbering in the debug-info (though that is
-;;; relative to the start of the function.)
+;;; The CBLOCK structure represents a basic block. We include
+;;; SSET-ELEMENT so that we can have sets of blocks. Initially the
+;;; SSET-ELEMENT-NUMBER is null, DFO analysis numbers in reverse DFO.
+;;; During IR2 conversion, IR1 blocks are re-numbered in forward emit
+;;; order. This latter numbering also forms the basis of the block
+;;; numbering in the debug-info (though that is relative to the start
+;;; of the function.)
 (defstruct (cblock (:include sset-element)
                   (:constructor make-block (start))
                   (:constructor make-block-key)
                   (:conc-name block-)
                   (:predicate block-p)
                   (:copier copy-block))
-  ;; A list of all the blocks that are predecessors/successors of this block.
-  ;; In well-formed IR1, most blocks will have one successor. The only
-  ;; exceptions are:
+  ;; a list of all the blocks that are predecessors/successors of this
+  ;; block. In well-formed IR1, most blocks will have one successor.
+  ;; The only exceptions are:
   ;;  1. component head blocks (any number)
   ;;  2. blocks ending in an IF (1 or 2)
   ;;  3. blocks with DELETE-P set (zero)
   (pred nil :type list)
   (succ nil :type list)
-  ;; The continuation which heads this block (either a :Block-Start or
-  ;; :Deleted-Block-Start.)  Null when we haven't made the start continuation
-  ;; yet (and in the dummy component head and tail blocks.)
+  ;; the continuation which heads this block (either a :BLOCK-START or
+  ;; :DELETED-BLOCK-START), or NIL when we haven't made the start
+  ;; continuation yet (and in the dummy component head and tail
+  ;; blocks)
   (start nil :type (or continuation null))
-  ;; A list of all the nodes that have Start as their Cont.
+  ;; a list of all the nodes that have START as their CONT
   (start-uses nil :type list)
-  ;; The last node in this block. This is null when we are in the process of
-  ;; building a block (and in the dummy component head and tail blocks.)
+  ;; the last node in this block. This is NIL when we are in the
+  ;; process of building a block (and in the dummy component head and
+  ;; tail blocks.)
   (last nil :type (or node null))
-  ;; The forward and backward links in the depth-first ordering of the blocks.
-  ;; These slots are null at beginning/end.
+  ;; the forward and backward links in the depth-first ordering of the
+  ;; blocks. These slots are NIL at beginning/end.
   (next nil :type (or null cblock))
   (prev nil :type (or null cblock))
   ;; This block's attributes: see above.
   (gen nil)
   (in nil)
   (out nil)
-  ;; The component this block is in. Null temporarily during IR1 conversion
-  ;; and in deleted blocks.
+  ;; the component this block is in, or NIL temporarily during IR1
+  ;; conversion and in deleted blocks
   (component *current-component* :type (or component null))
-  ;; A flag used by various graph-walking code to determine whether this block
-  ;; has been processed already or what. We make this initially NIL so that
-  ;; Find-Initial-DFO doesn't have to scan the entire initial component just to
-  ;; clear the flags.
+  ;; a flag used by various graph-walking code to determine whether
+  ;; this block has been processed already or what. We make this
+  ;; initially NIL so that FIND-INITIAL-DFO doesn't have to scan the
+  ;; entire initial component just to clear the flags.
   (flag nil)
   ;; Some kind of info used by the back end.
   (info nil)
-  ;; If true, then constraints that hold in this block and its successors by
-  ;; merit of being tested by its IF predecessor.
+  ;; If true, then constraints that hold in this block and its
+  ;; successors by merit of being tested by its IF predecessor.
   (test-constraint nil :type (or sset null)))
 (def!method print-object ((cblock cblock) stream)
   (print-unreadable-object (cblock stream :type t :identity t)
     (format stream ":START c~D" (cont-num (block-start cblock)))))
 
-;;; The Block-Annotation structure is shared (via :include) by different
-;;; block-info annotation structures so that code (specifically control
-;;; analysis) can be shared.
+;;; The Block-Annotation structure is shared (via :INCLUDE) by
+;;; different block-info annotation structures so that code
+;;; (specifically control analysis) can be shared.
 (defstruct (block-annotation (:constructor nil))
-  ;; The IR1 block that this block is in the Info for.
+  ;; The IR1 block that this block is in the INFO for.
   (block (required-argument) :type cblock)
-  ;; The next and previous block in emission order (not DFO). This determines
-  ;; which block we drop though to, and also used to chain together overflow
-  ;; blocks that result from splitting of IR2 blocks in lifetime analysis.
+  ;; the next and previous block in emission order (not DFO). This
+  ;; determines which block we drop though to, and also used to chain
+  ;; together overflow blocks that result from splitting of IR2 blocks
+  ;; in lifetime analysis.
   (next nil :type (or block-annotation null))
   (prev nil :type (or block-annotation null)))
 
-;;; The Component structure provides a handle on a connected piece of the flow
-;;; graph. Most of the passes in the compiler operate on components rather
-;;; than on the entire flow graph.
+;;; The Component structure provides a handle on a connected piece of
+;;; the flow graph. Most of the passes in the compiler operate on
+;;; components rather than on the entire flow graph.
 (defstruct component
   ;; The kind of component:
   ;;
   ;;     A component containing both top-level and run-time code.
   ;;
   ;; :Initial
-  ;;     The result of initial IR1 conversion, on which component analysis has
-  ;;     not been done.
+  ;;     The result of initial IR1 conversion, on which component
+  ;;     analysis has not been done.
   ;;
   ;; :Deleted
   ;;     Debris left over from component analysis.
   mess-up
   (nlx-info :test nlx-info))
 
-;;; The Environment structure represents the result of Environment analysis.
+;;; The ENVIRONMENT structure represents the result of environment analysis.
 (defstruct environment
-  ;; The function that allocates this environment.
+  ;; the function that allocates this environment
   (function (required-argument) :type clambda)
-  ;; A list of all the Lambdas that allocate variables in this environment.
+  ;; a list of all the lambdas that allocate variables in this environment
   (lambdas nil :type list)
-  ;; A list of all the lambda-vars and NLX-Infos needed from enclosing
-  ;; environments by code in this environment.
+  ;; a list of all the lambda-vars and NLX-Infos needed from enclosing
+  ;; environments by code in this environment
   (closure nil :type list)
-  ;; A list of NLX-Info structures describing all the non-local exits into this
-  ;; environment.
+  ;; a list of NLX-Info structures describing all the non-local exits
+  ;; into this environment
   (nlx-info nil :type list)
-  ;; Some kind of info used by the back end.
+  ;; some kind of info used by the back end
   (info nil))
 (defprinter (environment)
   function
   (closure :test closure)
   (nlx-info :test nlx-info))
 
-;;; The Tail-Set structure is used to accmumlate information about
-;;; tail-recursive local calls. The "tail set" is effectively the transitive
-;;; closure of the "is called tail-recursively by" relation.
+;;; The TAIL-SET structure is used to accumulate information about
+;;; tail-recursive local calls. The "tail set" is effectively the
+;;; transitive closure of the "is called tail-recursively by"
+;;; relation.
 ;;;
-;;; All functions in the same tail set share the same Tail-Set structure.
-;;; Initially each function has its own Tail-Set, but when IR1-OPTIMIZE-RETURN
-;;; notices a tail local call, it joins the tail sets of the called function
-;;; and the calling function.
+;;; All functions in the same tail set share the same TAIL-SET
+;;; structure. Initially each function has its own TAIL-SET, but when
+;;; IR1-OPTIMIZE-RETURN notices a tail local call, it joins the tail
+;;; sets of the called function and the calling function.
 ;;;
-;;; The tail set is somewhat approximate, because it is too early to be sure
-;;; which calls will be TR. Any call that *might* end up TR causes tail-set
-;;; merging.
+;;; The tail set is somewhat approximate, because it is too early to
+;;; be sure which calls will be TR. Any call that *might* end up TR
+;;; causes tail-set merging.
 (defstruct tail-set
-  ;; A list of all the lambdas in this tail set.
+  ;; a list of all the lambdas in this tail set
   (functions nil :type list)
-  ;; Our current best guess of the type returned by these functions. This is
-  ;; the union across all the functions of the return node's Result-Type.
-  ;; excluding local calls.
+  ;; our current best guess of the type returned by these functions.
+  ;; This is the union across all the functions of the return node's
+  ;; RESULT-TYPE. excluding local calls.
   (type *wild-type* :type ctype)
-  ;; Some info used by the back end.
+  ;; some info used by the back end
   (info nil))
 (defprinter (tail-set)
   functions
   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 Continuation,
-;;; although it is accessed by searching in the Environment-Nlx-Info.
+;;; The 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
+;;; ENVIRONMENT-NLX-INFO.
 (def!struct (nlx-info (:make-load-form-fun ignore-it))
-  ;; The cleanup associated with this exit. In a catch or unwind-protect, this
-  ;; is the :Catch or :Unwind-Protect cleanup, and not the cleanup for the
-  ;; escape block. The Cleanup-Kind of this thus provides a good indication of
-  ;; what kind of exit is being done.
+  ;; the cleanup associated with this exit. In a catch or
+  ;; unwind-protect, this is the :CATCH or :UNWIND-PROTECT cleanup,
+  ;; and not the cleanup for the escape block. The CLEANUP-KIND of
+  ;; this thus provides a good indication of what kind of exit is
+  ;; being done.
   (cleanup (required-argument) :type cleanup)
-  ;; The continuation exited to (the CONT of the EXIT nodes.)  If this exit is
-  ;; from an escape function (CATCH or UNWIND-PROTECT), then environment
-  ;; analysis deletes the escape function and instead has the %NLX-ENTRY use
-  ;; this continuation.
+  ;; the continuation exited to (the CONT of the EXIT nodes). If this
+  ;; exit is from an escape function (CATCH or UNWIND-PROTECT), then
+  ;; environment analysis deletes the escape function and instead has
+  ;; the %NLX-ENTRY use this continuation.
   ;;
-  ;; 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, since exits to different places
-  ;; may deliver their result to the same continuation.
+  ;; 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,
+  ;; since exits to different places may deliver their result to the
+  ;; same continuation.
   (continuation (required-argument) :type continuation)
-  ;; The entry stub inserted by environment analysis. This is a block
-  ;; containing a call to the %NLX-Entry funny function that has the original
-  ;; exit destination as its successor. Null only temporarily.
+  ;; the entry stub inserted by environment analysis. This is 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))
-  ;; Some kind of info used by the back end.
+  ;; some kind of info used by the back end
   info)
 (defprinter (nlx-info)
   continuation
 ;;; hacking the flow graph.
 (def!struct (leaf (:make-load-form-fun ignore-it)
                  (:constructor nil))
-  ;; Some name for this leaf. The exact significance of the name
-  ;; depends on what kind of leaf it is. In a Lambda-Var or
-  ;; Global-Var, this is the symbol name of the variable. In a
+  ;; some name for this leaf. The exact significance of the name
+  ;; depends on what kind of leaf it is. In a LAMBDA-VAR or
+  ;; GLOBAL-VAR, this is the symbol name of the variable. In a
   ;; functional that is from a DEFUN, this is the defined name. In
   ;; other functionals, this is a descriptive string.
   (name nil :type t)
-  ;; The type which values of this leaf must have.
+  ;; the type which values of this leaf must have
   (type *universal-type* :type ctype)
-  ;; Where the Type information came from:
+  ;; where the TYPE information came from:
   ;;  :DECLARED, from a declaration.
   ;;  :ASSUMED, from uses of the object.
   ;;  :DEFINED, from examination of the definition.
   ;; FIXME: This should be a named type. (LEAF-WHERE-FROM?)
   (where-from :assumed :type (member :declared :assumed :defined))
-  ;; List of the Ref nodes for this leaf.
+  ;; list of the REF nodes for this leaf
   (refs () :type list)
-  ;; True if there was ever a Ref or Set node for this leaf. This may
-  ;; be true when Refs and Sets are null, since code can be deleted.
+  ;; true if there was ever a REF or SET node for this leaf. This may
+  ;; be true when REFS and SETS are null, since code can be deleted.
   (ever-used nil :type boolean)
-  ;; Some kind of info used by the back end.
+  ;; some kind of info used by the back end
   (info nil))
 
-;;; The Constant structure is used to represent known constant values.
-;;; If Name is not null, then it is the name of the named constant
+;;; The CONSTANT structure is used to represent known constant values.
+;;; If NAME is not null, then it is the name of the named constant
 ;;; which this leaf corresponds to, otherwise this is an anonymous
 ;;; constant.
 (def!struct (constant (:include leaf))
-  ;; The value of the constant.
+  ;; the value of the constant
   (value nil :type t))
 (defprinter (constant)
   (name :test name)
   value)
 
-;;; The Basic-Var structure represents information common to all
+;;; The BASIC-VAR structure represents information common to all
 ;;; variables which don't correspond to known local functions.
 (def!struct (basic-var (:include leaf) (:constructor nil))
   ;; Lists of the set nodes for this variable.
   (sets () :type list))
 
-;;; The Global-Var structure represents a value hung off of the symbol
-;;; Name. We use a :Constant Var when we know that the thing is a
+;;; The GLOBAL-VAR structure represents a value hung off of the symbol
+;;; NAME. We use a :CONSTANT VAR when we know that the thing is a
 ;;; constant, but don't know what the value is at compile time.
 (def!struct (global-var (:include basic-var))
-  ;; Kind of variable described.
+  ;; kind of variable described
   (kind (required-argument)
        :type (member :special :global-function :constant :global)))
 (defprinter (global-var)
   (where-from :test (not (eq where-from :assumed)))
   kind)
 
-;;; The Slot-Accessor structure represents slot accessor functions. It
-;;; is a subtype of Global-Var to make it look more like a normal
+;;; The SLOT-ACCESSOR structure represents slot accessor functions. It
+;;; is a subtype of GLOBAL-VAR to make it look more like a normal
 ;;; function.
 (def!struct (slot-accessor (:include global-var
                                     (where-from :defined)
   for
   slot)
 
-;;; The Defined-Function structure represents functions that are
+;;; The DEFINED-FUNCTION structure represents functions that are
 ;;; defined in the same compilation block, or that have inline
 ;;; expansions, or have a non-NIL INLINEP value. Whenever we change
 ;;; the INLINEP state (i.e. an inline proclamation) we copy the
   ;; Some information about how this function is used. These values are
   ;; meaningful:
   ;;
-  ;;    Nil
-  ;;   An ordinary function, callable using local call.
+  ;;    NIL
+  ;;   an ordinary function, callable using local call
   ;;
-  ;;    :Let
-  ;;   A lambda that is used in only one local call, and has in effect
-  ;;   been substituted directly inline. The return node is deleted, and
-  ;;   the result is computed with the actual result continuation for the
-  ;;   call.
+  ;;    :LET
+  ;;   a lambda that is used in only one local call, and has in
+  ;;   effect been substituted directly inline. The return node is
+  ;;   deleted, and the result is computed with the actual result
+  ;;   continuation for the call.
   ;;
-  ;;    :MV-Let
-  ;;   Similar to :Let, but the call is an MV-Call.
+  ;;    :MV-LET
+  ;;   Similar to :LET, 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.
+  ;;    :ASSIGNMENT
+  ;;   similar to a LET, 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. 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 Optional-Dispatch
-  ;;   is in the LAMDBA-OPTIONAL-DISPATCH.
+  ;;    :OPTIONAL
+  ;;   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
+  ;;   Optional-Dispatch is in the LAMDBA-OPTIONAL-DISPATCH.
   ;;
-  ;;    :External
-  ;;   An external entry point lambda. The function it is an entry for is
-  ;;   in the Entry-Function.
+  ;;    :EXTERNAL
+  ;;   an external entry point lambda. The function it is an entry
+  ;;   for is in the Entry-Function.
   ;;
-  ;;    :Top-Level
-  ;;   A top-level lambda, holding a compiled top-level form. Compiled
-  ;;   very much like NIL, but provides an indication of top-level
-  ;;   context. A top-level lambda should have *no* references. Its
-  ;;   Entry-Function is a self-pointer.
+  ;;    :TOP-LEVEL
+  ;;   a top-level lambda, holding a compiled top-level form.
+  ;;   Compiled very much like NIL, but provides an indication of
+  ;;   top-level context. A top-level lambda should have *no*
+  ;;   references. Its Entry-Function is a self-pointer.
   ;;
-  ;;    :Top-Level-XEP
+  ;;    :TOP-LEVEL-XEP
   ;;   After a component is compiled, we clobber any top-level code
-  ;;   references to its non-closure XEPs with dummy FUNCTIONAL structures
-  ;;   having this kind. This prevents the retained top-level code from
-  ;;   holding onto the IR for the code it references.
+  ;;   references to its non-closure XEPs with dummy FUNCTIONAL
+  ;;   structures having this kind. This prevents the retained
+  ;;   top-level code from holding onto the IR for the code it
+  ;;   references.
   ;;
-  ;;    :Escape
-  ;;    :Cleanup
-  ;;   Special functions used internally by Catch and Unwind-Protect.
-  ;;   These are pretty much like a normal function (NIL), but are treated
-  ;;   specially by local call analysis and stuff. Neither kind should
-  ;;   ever be given an XEP even though they appear as args to funny
-  ;;   functions. An :Escape function is never actually called, and thus
-  ;;   doesn't need to have code generated for it.
+  ;;    :ESCAPE
+  ;;    :CLEANUP
+  ;;   special functions used internally by CATCH and UNWIND-PROTECT.
+  ;;   These are pretty much like a normal function (NIL), but are
+  ;;   treated specially by local call analysis and stuff. Neither
+  ;;   kind should ever be given an XEP even though they appear as
+  ;;   args to funny functions. An :ESCAPE function is never actually
+  ;;   called, and thus doesn't need to have code generated for it.
   ;;
-  ;;    :Deleted
+  ;;    :DELETED
   ;;   This function has been found to be uncallable, and has been
   ;;   marked for deletion.
   (kind nil :type (member nil :optional :deleted :external :top-level :escape
   ;;
   ;; With all other kinds, this is null.
   (entry-function 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
   (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 INLINEP will
-  ;; always be NIL as well.)
+  ;; 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
+  ;; 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.
+  ;; the original function or macro lambda list, or :UNSPECIFIED if
+  ;; this is a compiler created function
   (arg-documentation nil :type (or list (member :unspecified)))
-  ;; Various rare miscellaneous info that drives code generation & stuff.
+  ;; various rare miscellaneous info that drives code generation & stuff
   (plist () :type list))
 (defprinter (functional)
   name)
 
-;;; The Lambda only deals with required lexical arguments. Special,
+;;; The CLAMBDA only deals with required lexical arguments. Special,
 ;;; optional, keyword and rest arguments are handled by transforming
 ;;; into simpler stuff.
 (def!struct (clambda (:include functional)
   (where-from :test (not (eq where-from :assumed)))
   (vars :prin1 (mapcar #'leaf-name vars)))
 
-;;; The Optional-Dispatch leaf is used to represent hairy lambdas. It
-;;; is a Functional, like Lambda. Each legal number of arguments has a
+;;; The OPTIONAL-DISPATCH leaf is used to represent hairy lambdas. It
+;;; is a FUNCTIONAL, like LAMBDA. Each legal number of arguments has a
 ;;; function which is called when that number of arguments is passed.
 ;;; The function is called with all the arguments actually passed. If
-;;; additional arguments are legal, then the LEXPR style More-Entry
+;;; additional arguments are legal, then the LEXPR style MORE-ENTRY
 ;;; handles them. The value returned by the function is the value
-;;; which results from calling the Optional-Dispatch.
+;;; which results from calling the OPTIONAL-DISPATCH.
 ;;;
 ;;; The theory is that each entry-point function calls the next entry
 ;;; point tail-recursively, passing all the arguments passed in and
 ;;; function, so functions that are compiled together can avoid doing
 ;;; the dispatch.
 (def!struct (optional-dispatch (:include functional))
-  ;; The original parsed argument list, for anyone who cares.
+  ;; the original parsed argument list, for anyone who cares
   (arglist nil :type list)
-  ;; True if &ALLOW-OTHER-KEYS was supplied.
+  ;; true if &ALLOW-OTHER-KEYS was supplied
   (allowp nil :type boolean)
-  ;; True if &KEY was specified. (Doesn't necessarily mean that there
+  ;; true if &KEY was specified (doesn't necessarily mean that there
   ;; are any keyword arguments...)
   (keyp nil :type boolean)
-  ;; The number of required arguments. This is the smallest legal
+  ;; the number of required arguments. This is the smallest legal
   ;; number of arguments.
   (min-args 0 :type unsigned-byte)
-  ;; The total number of required and optional arguments. Args at
-  ;; positions >= to this are rest, key or illegal args.
+  ;; the total number of required and optional arguments. Args at
+  ;; positions >= to this are &REST, &KEY or illegal args.
   (max-args 0 :type unsigned-byte)
-  ;; List of the Lambdas which are the entry points for non-rest,
-  ;; non-key calls. The entry for Min-Args is first, Min-Args+1
-  ;; second, ... Max-Args last. The last entry-point always calls the
+  ;; list of the LAMBDAs which are the entry points for non-rest,
+  ;; non-key calls. The entry for MIN-ARGS is first, MIN-ARGS+1
+  ;; second, ... MAX-ARGS last. The last entry-point always calls the
   ;; main entry; in simple cases it may be the main entry.
   (entry-points nil :type list)
-  ;; An entry point which takes Max-Args fixed arguments followed by
+  ;; An entry point which takes MAX-ARGS fixed arguments followed by
   ;; an argument context pointer and an argument count. This entry
   ;; point deals with listifying rest args and parsing keywords. This
   ;; is null when extra arguments aren't legal.
   (more-entry :test more-entry)
   main-entry)
 
-;;; The Arg-Info structure allows us to tack various information onto
-;;; Lambda-Vars during IR1 conversion. If we use one of these things,
+;;; The ARG-INFO structure allows us to tack various information onto
+;;; LAMBDA-VARs during IR1 conversion. If we use one of these things,
 ;;; then the var will have to be massaged a bit before it is simple
 ;;; and lexical.
 (def!struct arg-info
-  ;; True if this arg is to be specially bound.
+  ;; true if this arg is to be specially bound
   (specialp nil :type boolean)
-  ;; The kind of argument being described. Required args only have arg
+  ;; the kind of argument being described. Required args only have arg
   ;; info structures if they are special.
   (kind (required-argument) :type (member :required :optional :keyword :rest
                                          :more-context :more-count))
-  ;; If true, the Var for supplied-p variable of a keyword or optional
-  ;; arg. This is true for keywords with non-constant defaults even
-  ;; when there is no user-specified supplied-p var.
+  ;; If true, this is the VAR for SUPPLIED-P variable of a keyword or
+  ;; optional arg. This is true for keywords with non-constant
+  ;; defaults even when there is no user-specified supplied-p var.
   (supplied-p nil :type (or lambda-var null))
-  ;; The default for a keyword or optional, represented as the
+  ;; the default for a keyword or optional, represented as the
   ;; original Lisp code. This is set to NIL in keyword arguments that
-  ;; are defaulted using the supplied-p arg.
+  ;; are defaulted using the SUPPLIED-P arg.
   (default nil :type t)
-  ;; The actual keyword for a keyword argument.
+  ;; the actual keyword for a keyword argument
   (keyword nil :type (or keyword null)))
 (defprinter (arg-info)
   (specialp :test specialp)
   (default :test default)
   (keyword :test keyword))
 
-;;; The Lambda-Var structure represents a lexical lambda variable.
+;;; The LAMBDA-VAR structure represents a lexical lambda variable.
 ;;; This structure is also used during IR1 conversion to describe
 ;;; lambda arguments which may ultimately turn out not to be simple
 ;;; and lexical.
 ;;;
-;;; Lambda-Vars with no Refs are considered to be deleted; environment
+;;; LAMBDA-VARs with no REFs are considered to be deleted; environment
 ;;; analysis isn't done on these variables, so the back end must check
 ;;; for and ignore unreferenced variables. Note that a deleted
 ;;; lambda-var may have sets; in this case the back end is still
 ;;; responsible for propagating the Set-Value to the set's Cont.
 (def!struct (lambda-var (:include basic-var))
-  ;; True if this variable has been declared Ignore.
+  ;; true if this variable has been declared IGNORE
   (ignorep nil :type boolean)
-  ;; The Lambda that this var belongs to. This may be null when we are
+  ;; the CLAMBDA that this var belongs to. This may be null when we are
   ;; building a lambda during IR1 conversion.
   (home nil :type (or null clambda))
   ;; This is set by environment analysis if it chooses an indirect
   ;; The following two slots are only meaningful during IR1 conversion
   ;; of hairy lambda vars:
   ;;
-  ;; The Arg-Info structure which holds information obtained from
+  ;; The ARG-INFO structure which holds information obtained from
   ;; &keyword parsing.
   (arg-info nil :type (or arg-info null))
-  ;; If true, the Global-Var structure for the special variable which
-  ;; is to be bound to the value of this argument.
+  ;; if true, the GLOBAL-VAR structure for the special variable which
+  ;; is to be bound to the value of this argument
   (specvar nil :type (or global-var null))
   ;; Set of the CONSTRAINTs on this variable. Used by constraint
   ;; propagation. This is left null by the lambda pre-pass if it
 \f
 ;;;; basic node types
 
-;;; A Ref represents a reference to a leaf. Ref-Reoptimize is
-;;; initially (and forever) NIL, since Refs don't receive any values
+;;; A REF represents a reference to a LEAF. REF-REOPTIMIZE is
+;;; initially (and forever) NIL, since REFs don't receive any values
 ;;; and don't have any IR1 optimizer.
 (defstruct (ref (:include node (:reoptimize nil))
                (:constructor make-ref (derived-type leaf)))
   leaf)
 
 ;;; Naturally, the IF node always appears at the end of a block.
-;;; Node-Cont is a dummy continuation, and is there only to keep
+;;; NODE-CONT is a dummy continuation, and is there only to keep
 ;;; people happy.
 (defstruct (cif (:include node)
                (:conc-name if-)
                (:predicate if-p)
                (:constructor make-if)
                (:copier copy-if))
-  ;; Continuation for the predicate.
+  ;; CONTINUATION for the predicate
   (test (required-argument) :type continuation)
-  ;; The blocks that we execute next in true and false case,
-  ;; respectively (may be the same.)
+  ;; the blocks that we execute next in true and false case,
+  ;; respectively (may be the same)
   (consequent (required-argument) :type cblock)
   (alternative (required-argument) :type cblock))
 (defprinter (cif :conc-name if-)
                 (:predicate set-p)
                 (:constructor make-set)
                 (:copier copy-set))
-  ;; Descriptor for the variable set.
+  ;; descriptor for the variable set
   (var (required-argument) :type basic-var)
-  ;; Continuation for the value form.
+  ;; continuation for the value form
   (value (required-argument) :type continuation))
 (defprinter (cset :conc-name set-)
   var
   (value :prin1 (continuation-use value)))
 
-;;; The Basic-Combination structure is used to represent both normal
+;;; The BASIC-COMBINATION structure is used to represent both normal
 ;;; and multiple value combinations. In a local function call, this
 ;;; node appears at the end of its block and the body of the called
 ;;; function appears as the successor. The NODE-CONT remains the
 ;;; continuation which receives the value of the call.
 (defstruct (basic-combination (:include node)
                              (:constructor nil))
-  ;; Continuation for the function.
+  ;; continuation for the function
   (fun (required-argument) :type continuation)
-  ;; List of continuations for the args. In a local call, an argument
+  ;; list of CONTINUATIONs for the args. In a local call, an argument
   ;; continuation may be replaced with NIL to indicate that the
   ;; corresponding variable is unreferenced, and thus no argument
   ;; value need be passed.
   (args nil :type list)
-  ;; The kind of function call being made. :LOCAL means that this is a
+  ;; the kind of function call being made. :LOCAL means that this is a
   ;; local call to a function in the same component, and that argument
   ;; syntax checking has been done, etc. Calls to known global
   ;; functions are represented by storing the FUNCTION-INFO for the
   ;; that the call contains an error, and should not be reconsidered
   ;; for optimization.
   (kind :full :type (or (member :local :full :error) function-info))
-  ;; Some kind of information attached to this node by the back end.
+  ;; some kind of information attached to this node by the back end
   (info nil))
 
 ;;; The COMBINATION node represents all normal function calls,
 ;;; The Bind node marks the beginning of a lambda body and represents
 ;;; the creation and initialization of the variables.
 (defstruct (bind (:include node))
-  ;; The lambda we are binding variables for. Null when we are
-  ;; creating the Lambda during IR1 translation.
+  ;; the lambda we are binding variables for. Null when we are
+  ;; creating the LAMBDA during IR1 translation.
   (lambda nil :type (or clambda null)))
 (defprinter (bind)
   lambda)
                    (:predicate return-p)
                    (:constructor make-return)
                    (:copier copy-return))
-  ;; The lambda we are returning from. Null temporarily during
+  ;; the lambda we are returning from. Null temporarily during
   ;; ir1tran.
   (lambda nil :type (or clambda null))
-  ;; The continuation which yields the value of the lambda.
+  ;; the continuation which yields the value of the lambda
   (result (required-argument) :type continuation)
-  ;; The union of the node-derived-type of all uses of the result
+  ;; the union of the node-derived-type of all uses of the result
   ;; other than by a local call, intersected with the result's
   ;; asserted-type. If there are no non-call uses, this is
-  ;; *empty-type*.
+  ;; *EMPTY-TYPE*
   (result-type *wild-type* :type ctype))
 (defprinter (creturn :conc-name return-)
   lambda
 ;;;; In IR1, we insert special nodes to mark potentially non-local
 ;;;; lexical exits.
 
-;;; The Entry node serves to mark the start of the dynamic extent of a
+;;; 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
 ;;; cleanup.
 (defstruct (entry (:include node))
   ;; All of the Exit nodes for potential non-local exits to this point.
   (exits nil :type list)
-  ;; The cleanup for this entry. Null only temporarily.
+  ;; The cleanup for this entry. NULL only temporarily.
   (cleanup nil :type (or cleanup null)))
 (defprinter (entry))
 
-;;; The Exit node marks the place at which exit code would be emitted,
+;;; The EXIT node marks the place at which exit code would be emitted,
 ;;; if necessary. This is interposed between the uses of the exit
 ;;; continuation and the exit continuation's DEST. Instead of using
 ;;; the returned value being delivered directly to the exit
-;;; continuation, it is delivered to our Value continuation. The
+;;; continuation, it is delivered to our VALUE continuation. The
 ;;; original exit continuation is the exit node's CONT.
 (defstruct (exit (:include node))
   ;; The Entry node that this is an exit for. If null, this is a
index 16d6ceb..fc82d67 100644 (file)
   (frob logior)
   (frob logxor))
 
-;; MNA: defoptimizer for integer-length patch
 (defoptimizer (integer-length derive-type) ((x))
   (let ((x-type (continuation-type x)))
     (when (and (numeric-type-p x-type)
index b10ba0b..51b4bcb 100644 (file)
 
     (when (null plen)
       (setf plen location-column-width)
-      (set-location-printing-range dstate
-                                 (seg-virtual-location (dstate-segment dstate))
-                                 (seg-length (dstate-segment dstate))))
+      (let ((seg (dstate-segment dstate)))
+       (set-location-printing-range dstate
+                                    (seg-virtual-location seg)
+                                    (seg-length seg))))
     (when (eq (dstate-output-state dstate) :beginning)
       (setf plen location-column-width))
 
     (fresh-line stream)
 
-    ;; MNA: compiler message patch
     (setf location-column-width (+ 2 location-column-width))
     (princ "; " stream)
 
   (with-print-restrictions
     (dolist (note (dstate-notes dstate))
       (format stream "~Vt; " *disassem-note-column*)
-      ;; MNA: compiler message patch
       (pprint-logical-block (stream nil :per-line-prefix "; ")
       (etypecase note
        (string
index 4b29a2f..5ad7908 100644 (file)
@@ -1017,7 +1017,6 @@ bootstrapping.
                                               (cadar var))
                                       (values (sb-int:keywordicate (car var))
                                               (car var)))
-                                 ;; MNA: non-self-eval-keyword patch
                                 `((,key (get-key-arg1 ',keyword ,args-tail))
                                   (,variable (if (consp ,key)
                                                  (car ,key)
@@ -1029,7 +1028,6 @@ bootstrapping.
                                               (cadar var))
                                       (values (sb-int:keywordicate (car var))
                                               (car var)))
-                                 ;; MNA: non-self-eval-keyword patch
                                 `((,key (get-key-arg1 ',keyword ,args-tail))
                                   (,(caddr var) ,key)
                                   (,variable (if (consp ,key)
index dcfc879..8ac4a04 100644 (file)
@@ -15,4 +15,4 @@
 ;;; versions, and a string like "0.6.5.12" is used for versions which
 ;;; aren't released but correspond only to CVS tags or snapshots.
 
-"0.6.8.17"
+"0.6.8.18"