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