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

[Erik Huelsmann]

Author: ehuelsmann
Date: Sun Oct  4 13:44:06 2009
New Revision: 12173

Log:
Fix incorrect block name created for SETF functions in LABELS.

The block used to be named (SETF FOO) instead of FOO; the former
 being illegal because BLOCK takes a SYMBOL identifier.

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	Sun Oct  4 13:44:06 2009
@@ -673,11 +673,12 @@
       ((let* ((variable (make-variable :name (gensym)))
 	      (local-function (make-local-function :name name
 						   :compiland compiland
-						   :variable variable)))
+						   :variable variable))
+              (block-name (fdefinition-block-name name)))
 	 (multiple-value-bind (body decls) (parse-body body)
 	   (setf (compiland-lambda-expression compiland)
                  (rewrite-lambda
-		 `(lambda ,lambda-list , at decls (block ,name , at body)))))
+		 `(lambda ,lambda-list , at decls (block ,block-name , at body)))))
 	 (push variable *all-variables*)
 	 (push local-function local-functions)))
       ((dolist (local-function local-functions)