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

[Alessio Stalla]

Author: astalla
Date: Tue Feb 23 18:35:17 2010
New Revision: 12505

Log:
Added missing copy-tree for the function body in one case of lambda inlining,
which didn't play well with compiler macros (self-modifying code).
Should fix the bug found by Alan Ruttenberg on 2010-02-16.


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	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Tue Feb 23 18:35:17 2010
@@ -203,7 +203,6 @@
 		(push-argument-binding (var rest) `(list , at arguments)
 				       temp-bindings rest-binding)
 		(setf bindings (append bindings rest-binding)))))
-
 	;;Aux parameters.
 	(when aux
 	  (setf bindings
@@ -211,7 +210,6 @@
 		  ,@(loop
 		       :for var-info :in aux
 		       :collect `(,(var var-info) ,(initform var-info))))))
-	
 	(values (append req-bindings temp-bindings bindings)
 		ignorables)))))
 
@@ -318,7 +316,8 @@
 			      (parse-lambda-list lambda-list))
 			     args)
 	`(let* ,bindings
-	   (declare (ignorable , at ignorables))
+	   ,@(when ignorables
+		   `((declare (ignorable , at ignorables))))
 	   , at body))
     (lambda-list-mismatch (x)
       (compiler-warn "Invalid function call: ~S (mismatch type: ~A)"
@@ -1248,7 +1247,7 @@
 	(args (cdr form)))
     (if (and (listp op)
 	     (eq (car op) 'lambda))
-	(expand-function-call-inline form (cadr op) (cddr op) args)
+	(expand-function-call-inline form (cadr op) (copy-tree (cddr op)) args)
 	(if (unsafe-p args)
 	    (let ((arg1 (car args)))
 	      (cond ((and (consp arg1) (eq (car arg1) 'GO))
@@ -1275,9 +1274,6 @@
 (defun p1-function-call (form)
   (let ((new-form (rewrite-function-call form)))
     (when (neq new-form form)
-;;       (let ((*print-structure* nil))
-;;         (format t "old form = ~S~%" form)
-;;         (format t "new form = ~S~%" new-form))
       (return-from p1-function-call (p1 new-form))))
   (let* ((op (car form))
          (local-function (find-local-function op)))
@@ -1463,4 +1459,4 @@
       (setf (compiland-p1-result compiland)
             (list* 'LAMBDA lambda-list (p1-body body))))))
 
-(provide "COMPILER-PASS1")
\ No newline at end of file
+(provide "COMPILER-PASS1")