From 272a4fad189dd96e57d3b3120c82217fdb5c5449 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Fri, 20 Dec 2013 04:34:17 +0400 Subject: [PATCH] Really restore clisp cross-compilation. Some more loop madness. Patch by Vasily Postnicov, lp#1261451. --- NEWS | 2 +- src/compiler/pack.lisp | 30 +++++++++++++++--------------- 2 files changed, 16 insertions(+), 16 deletions(-) diff --git a/NEWS b/NEWS index 38476e6..a46e058 100644 --- 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 --- 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)) -- 1.7.10.4