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

[Erik Huelsmann]

Author: ehuelsmann
Date: Tue May  5 02:36:02 2009
New Revision: 11831

Log:
P2: Parse and publicize free specials in FLET/LABELS bodies
Precompile: Make sure declarations in trimmed FLET/LABELS bodies don't get ignored

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

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Tue May  5 02:36:02 2009
@@ -5020,6 +5020,9 @@
       (let ((variable (local-function-variable local-function)))
         (when variable
           (push variable *visible-variables*))))
+    (dolist (special (process-special-declarations body))
+      (push (make-variable :name special :special-p t)
+            *visible-variables*))
     (do ((forms body (cdr forms)))
         ((null forms))
       (compile-form (car forms) (if (cdr forms) nil target) nil))))
@@ -5040,6 +5043,9 @@
           (setf (variable-register variable) (allocate-register)))))
     (dolist (local-function local-functions)
       (p2-labels-process-compiland local-function))
+    (dolist (special (process-special-declarations body))
+      (push (make-variable :name special :special-p t)
+            *visible-variables*))
     (do ((forms body (cdr forms)))
         ((null forms))
       (compile-form (car forms) (if (cdr forms) nil 'stack) nil))

Modified: trunk/abcl/src/org/armedbear/lisp/precompiler.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/precompiler.lisp	Tue May  5 02:36:02 2009
@@ -789,7 +789,7 @@
                  (new-form
                   (if new-locals
                       (list* operator new-locals body)
-                      (list* 'PROGN body))))
+                      (list* 'LOCALLY body))))
             (return-from precompile-flet/labels (precompile1 new-form))))))
     (list* (car form)
            (precompile-local-functions locals)