0.7.4.31:
[sbcl.git] / src / compiler / debug.lisp
index 9e543c2..56c5b61 100644 (file)
@@ -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)
         (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))
 
 (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)
        (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)
               ((:environment :debug-environment) (incf environment))
               (t (incf global)))
             (do ((conf (tn-global-conflicts tn)
-                       (global-conflicts-tn-next conf)))
+                       (global-conflicts-next-tnwise conf)))
                 ((null conf))
               (incf confs)))
            (t
                            (component-info component)))
          (barf "~S not in COMPONENT-TNs for ~S" tn component)))
        (conf
-       (do ((conf conf (global-conflicts-tn-next conf))
+       (do ((conf conf (global-conflicts-next-tnwise conf))
             (prev nil conf))
            ((null conf))
          (unless (eq (global-conflicts-tn conf) tn)
 (defun check-block-conflicts (component)
   (do-ir2-blocks (block component)
     (do ((conf (ir2-block-global-tns block)
-              (global-conflicts-next conf))
+              (global-conflicts-next-blockwise conf))
         (prev nil conf))
        ((null conf))
       (when prev
                   (tn-number (global-conflicts-tn prev)))
          (barf "~S and ~S out of order in ~S" prev conf block)))
 
-      (unless (find-in #'global-conflicts-tn-next
+      (unless (find-in #'global-conflicts-next-tnwise
                       conf
                       (tn-global-conflicts
                        (global-conflicts-tn conf)))
           (fp (ir2-physenv-old-fp 2env))
           (2block (block-info (lambda-block (physenv-lambda env)))))
       (do ((conf (ir2-block-global-tns 2block)
-                (global-conflicts-next conf)))
+                (global-conflicts-next-blockwise conf)))
          ((null conf))
        (let ((tn (global-conflicts-tn conf)))
          (unless (or (eq (global-conflicts-kind conf) :write)
 (defun add-always-live-tns (block tn)
   (declare (type ir2-block block) (type tn tn))
   (do ((conf (ir2-block-global-tns block)
-            (global-conflicts-next conf)))
+            (global-conflicts-next-blockwise conf)))
       ((null conf))
     (when (eq (global-conflicts-kind conf) :live)
       (let ((btn (global-conflicts-tn conf)))
   (let ((confs (tn-global-conflicts tn)))
     (cond (confs
           (clrhash *list-conflicts-table*)
-          (do ((conf confs (global-conflicts-tn-next conf)))
+          (do ((conf confs (global-conflicts-next-tnwise conf)))
               ((null conf))
             (let ((block (global-conflicts-block conf)))
               (add-always-live-tns block tn)
                                (not (tn-global-conflicts tn)))
                       (res tn)))))
               (do ((gtn (ir2-block-global-tns block)
-                        (global-conflicts-next gtn)))
+                        (global-conflicts-next-blockwise gtn)))
                   ((null gtn))
                 (when (or (eq (global-conflicts-kind gtn) :live)
                           (/= (sbit confs (global-conflicts-number gtn)) 0))