[armedbear-cvs] r14441 - trunk/abcl/src/org/armedbear/lisp

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Mar 22 13:09:41 2013
New Revision: 14441

Log:
Stop modifying form structure in pass1.

Note: it's bad style to modify borrowed data. Also, we can't know
 for sure there's no structure sharing somewhere.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Thu Mar 21 12:33:22 2013	(r14440)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Fri Mar 22 13:09:41 2013	(r14441)
@@ -444,19 +444,13 @@
 (declaim (ftype (function (t) t) p1-body))
 (defun p1-body (body)
   (declare (optimize speed))
-  (let ((tail body))
-    (loop
-      (when (endp tail)
-        (return))
-      (setf (car tail) (p1 (%car tail)))
-      (setf tail (%cdr tail))))
-  body)
+  (loop for form in body
+     collect (p1 form)))
 
 (defknown p1-default (t) t)
 (declaim (inline p1-default))
 (defun p1-default (form)
-  (setf (cdr form) (p1-body (cdr form)))
-  form)
+  (cons (car form) (p1-body (cdr form))))
 
 (defmacro p1-let/let*-vars
     (block varlist variables-var var body1 body2)
@@ -605,8 +599,8 @@
 (defun p1-block (form)
   (let* ((block (make-block-node (cadr form)))
          (*block* block)
-         (*blocks* (cons block *blocks*)))
-    (setf (cddr form) (p1-body (cddr form)))
+         (*blocks* (cons block *blocks*))
+         (form (list* (car form) (cadr form) (p1-body (cddr form)))))
     (setf (block-form block) form)
     (when (block-non-local-return-p block)
       ;; Add a closure variable for RETURN-FROM to use