From 354967b17728c48f961189218bded56166578581 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 21 Oct 2004 02:31:08 +0000 Subject: [PATCH] Fix loop initialization bug reported by Bruno Haible, cmucl-imp, 2004-08-20. Use boot-2004-10-2.lisp to bootstrap. o We were not putting the loop prologue code after the initializations for with, for, and as. o The step form for for-as-equals was getting optimized into the body, instead of leaving one in the prologue for other initializations. o The for-across clause was putting the length computation into the prologue, but should belong in the initialization part before the body. See comments for more info. --- bootfiles/19a/boot-2004-10-2.lisp | 8 +++++ code/loop.lisp | 50 ++++++++++++++++++++++++++++--- 2 files changed, 54 insertions(+), 4 deletions(-) create mode 100644 bootfiles/19a/boot-2004-10-2.lisp diff --git a/bootfiles/19a/boot-2004-10-2.lisp b/bootfiles/19a/boot-2004-10-2.lisp new file mode 100644 index 000000000..85d6e48b8 --- /dev/null +++ b/bootfiles/19a/boot-2004-10-2.lisp @@ -0,0 +1,8 @@ +;;; Bootfile to bootstrap the fixes to loop to handle loop intializers +;;; correctly. (See cmucl-imp, 2004-08-20.) Might be something +;;; simpler, but this is easy. + +(setf lisp::*enable-package-locked-errors* nil) +(load "target:code/loop.lisp") + + diff --git a/code/loop.lisp b/code/loop.lisp index 4f717b4c6..c1b4af37c 100644 --- a/code/loop.lisp +++ b/code/loop.lisp @@ -49,7 +49,7 @@ #+cmu (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.26 2004/10/19 18:13:16 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.27 2004/10/21 02:31:08 rtoy Exp $") ;;;; LOOP Iteration Macro @@ -781,7 +781,11 @@ a LET-like macro, and a SETQ-like macro, which perform LOOP-style destructuring. (pify (l) (if (null (cdr l)) (car l) `(progn ,@l))) (makebody () (let ((form `(tagbody - ,@(psimp (append prologue (nreverse rbefore))) + ;; ANSI CL 6.1.7.2 says that initially clauses are + ;; evaluated in the loop prologue, which precedes + ;; all loop code except for the initial settings + ;; provided by with, for, or as. + ,@(psimp (append (nreverse rbefore) prologue)) next-loop ,@(psimp (append main-body (nreconc rafter `((go next-loop))))) end-loop @@ -1635,7 +1639,35 @@ collected result will be returned as the value of the LOOP." `(() (,var ,(loop-get-form)) () () () (,var ,val) () ())) (t ;;We are the same as "FOR x = y". - `(() (,var ,val) () ())))) + ;; Let me document here what this is returning. Look at + ;; loop-hack-iteration for more info. But anyway, we return a list of + ;; 8 items, in this order: PRE-STEP-TESTS, STEPS, POST-STEP-TESTS, + ;; PSEUDO-STEPS, PRE-LOOP-PRE-STEP-TESTS, PRE-LOOP-STEPS, + ;; PRE-LOOP-POST-STEP-TESTS, PRE-LOOP-PSEUDO-STEPS. (We should add + ;; something to make it easier to figure out what these args are!) + ;; + ;; For a "FOR x = y" clause without the THEN, we want the STEPS item to + ;; step the variable VAR with the value VAL. This gets placed in the + ;; body of the loop. The original code just did that. It seems that + ;; the STEPS form is placed in *loop-before-loop* and in + ;; *loop-after-loop*. Loop optimization would then see the same form + ;; in both, and move them into the beginning of body. This is ok, + ;; except that if there are :initially forms that were placed into the + ;; loop prologue, the :initially forms might refer to incorrectly + ;; initialized variables, because the optimizer moved STEPS from from + ;; *loop-before-loop* into the body. + ;; + ;; To solve this, we add a PRE-LOOP-PSEUDO-STEP form that is identical + ;; to the STEPS form. This gets placed in *loop-before-loop*. But + ;; this won't match any *loop-after-loop* form, so it won't get moved, + ;; and we maintain the proper sequencing such that the + ;; PRE-LOOP-PSEUDO-STEP form is in *loop-before-loop*, before any + ;; :initially clauses that might refer to this. So all is well. Whew. + ;; + ;; I hope this doesn't break anything else. + `(() (,var ,val) () () + () () () (,var ,val)) + ))) (defun loop-for-across (var val data-type) @@ -1654,7 +1686,17 @@ collected result will be returned as the value of the LOOP." (let* ((length 0) (length-form (cond ((not constantp) (let ((v (loop-gentemp 'loop-across-limit-))) - (push `(setq ,v (length ,vector-var)) *loop-prologue*) + ;; This used to just push the length + ;; computation into the prologue code. I + ;; (rtoy) don't think that's right, + ;; especially since the prologue is supposed + ;; to happen AFTER other initializations. + ;; So, this puts the computation in + ;; *loop-before-body*. We need a matching + ;; entry for *loop-after-body*, so stuff a + ;; NIL there. + (push `(setq ,v (length ,vector-var)) *loop-before-loop*) + (push nil *loop-after-body*) (loop-make-variable v 0 'fixnum))) (t (setq length (length vector-value))))) (first-test `(>= ,index-var ,length-form)) -- GitLab