Really restore clisp cross-compilation.

Some more loop madness.

Patch by Vasily Postnicov, lp#1261451.

diff --git a/NEWS b/NEWS
index 38476e6..a46e058 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -18,7 +18,7 @@ changes relative to sbcl-1.1.14:
   * bug fix: modular arithmetic optimizations do not stumble on dead branches
     with bad constants. (reported by Douglas Katzman)
   * bug fix: CLISP can be used again as a cross-compilation host.
-    (Thanks to Vasily Postnicov)
+    (Thanks to Vasily Postnicov, lp#1261451)
 
 changes in sbcl-1.1.14 relative to sbcl-1.1.13:
   * optimization: complicated TYPEP tests are less opaque to the type

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index d95c5eb..7e61cf0 100644 (file)
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -47,17 +47,17 @@
         (kind (tn-kind tn))
         (sb-conflicts (finite-sb-conflicts sb))
         (sb-always-live (finite-sb-always-live sb)))
-    (macrolet ((do-offsets (&body body)
-                 `(loop repeat size
-                        for offset upfrom offset
+    (macrolet ((do-offsets ((var) &body body)
+                 `(loop for ,var upfrom offset
+                        repeat size
                         thereis (progn ,@body))))
       (cond
         ((eq kind :component)
-         (do-offsets
-             (let ((loc-live (svref sb-always-live offset)))
+         (do-offsets (offset-iter)
+             (let ((loc-live (svref sb-always-live offset-iter)))
                (dotimes (i (ir2-block-count *component-being-compiled*))
                  (when (/= (sbit loc-live i) 0)
-                   (return offset))))))
+                   (return offset-iter))))))
         (confs
          ;; TN is global, iterate over the blocks TN is live in.
          (do ((conf confs (global-conflicts-next-tnwise conf)))
@@ -66,23 +66,23 @@
            (let* ((block (global-conflicts-block conf))
                   (num (ir2-block-number block)))
              (if (eq (global-conflicts-kind conf) :live)
-                 (do-offsets
-                     (let ((loc-live (svref sb-always-live offset)))
+                 (do-offsets (offset-iter)
+                     (let ((loc-live (svref sb-always-live offset-iter)))
                        (when (/= (sbit loc-live num) 0)
-                         (return-from offset-conflicts-in-sb offset))))
-                 (do-offsets
-                     (let ((loc-confs (svref sb-conflicts offset)))
+                         (return-from offset-conflicts-in-sb offset-iter))))
+                 (do-offsets (offset-iter)
+                     (let ((loc-confs (svref sb-conflicts offset-iter)))
                        (when (/= (sbit (svref loc-confs num)
                                        (global-conflicts-number conf))
                                  0)
-                         (return-from offset-conflicts-in-sb offset))))))))
+                         (return-from offset-conflicts-in-sb offset-iter))))))))
         (t
-         (do-offsets
-             (and (/= (sbit (svref (svref sb-conflicts offset)
+         (do-offsets (offset-iter)
+             (and (/= (sbit (svref (svref sb-conflicts offset-iter)
                                    (ir2-block-number (tn-local tn)))
                             (tn-local-number tn))
                       0)
-                  offset)))))))
+                  offset-iter)))))))
 
 ;;; Return true if TN has a conflict in SC at the specified offset.
 (declaim (ftype (function (tn sc index) (values (or null index) &optional))