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

[Erik Huelsmann]

Author: ehuelsmann
Date: Fri May 15 15:32:01 2009
New Revision: 11873

Log:
Don't use local function variables for FLET,
not even in case of closures (reduces complexity
in the compiler).

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.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	Fri May 15 15:32:01 2009
@@ -591,7 +591,7 @@
   (with-local-functions-for-flet/labels
       form local-functions lambda-list name body
       ((let ((local-function (make-local-function :name name
-						 :compiland compiland)))
+                                                  :compiland compiland)))
 	 (multiple-value-bind (body decls) (parse-body body)
 	   (let* ((block-name (fdefinition-block-name name))
 		  (lambda-expression
@@ -604,10 +604,6 @@
 	     (setf (local-function-inline-expansion local-function)
 		   (generate-inline-expansion block-name lambda-list body))
 	     (p1-compiland compiland)))
-	 (when *closure-variables*
-	   (let ((variable (make-variable :name (gensym))))
-	     (setf (local-function-variable local-function) variable)
-	     (push variable *all-variables*)))
 	 (push local-function local-functions)))
       ((with-saved-compiler-policy
 	   (process-optimization-declarations (cddr form))

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	Fri May 15 15:32:01 2009
@@ -4846,7 +4846,7 @@
   (compile-and-write-to-file class-file compiland))
 
 
-(defun emit-make-compiled-closure-for-flet/labels 
+(defun emit-make-compiled-closure-for-flet/labels
     (local-function compiland declaration)
   (emit 'getstatic *this-class* declaration +lisp-object+)
   (let ((parent (compiland-parent compiland)))
@@ -4872,7 +4872,7 @@
   (let ((*load-truename* (pathname pathname)))
     (unless (ignore-errors (load-compiled-function pathname))
       (error "Unable to load ~S." pathname))))
-  
+
 (defknown p2-flet-process-compiland (t) t)
 (defun p2-flet-process-compiland (local-function)
   (let* ((compiland (local-function-compiland local-function))
@@ -4883,22 +4883,14 @@
                                                :lambda-list lambda-list)))
 	     (set-compiland-and-write-class-file class-file compiland)
 	     (verify-class-file-loadable pathname)
-             (setf (local-function-class-file local-function) class-file))
-           (when (local-function-variable local-function)
-             (let ((g (declare-local-function local-function)))
-	       (emit-make-compiled-closure-for-flet/labels 
-		local-function compiland g))))
+             (setf (local-function-class-file local-function) class-file)))
           (t
-	   (with-temp-class-file 
+	   (with-temp-class-file
 	       pathname class-file lambda-list
 	       (set-compiland-and-write-class-file class-file compiland)
 	       (setf (local-function-class-file local-function) class-file)
 	       (setf (local-function-function local-function)
-                     (load-compiled-function pathname))
-	       (when (local-function-variable local-function)
-		 (let ((g (declare-object (load-compiled-function pathname))))
-		   (emit-make-compiled-closure-for-flet/labels 
-		    local-function compiland g))))))))
+                     (load-compiled-function pathname)))))))
 
 (defknown p2-labels-process-compiland (t) t)
 (defun p2-labels-process-compiland (local-function)
@@ -4912,7 +4904,7 @@
 	     (verify-class-file-loadable pathname)
              (setf (local-function-class-file local-function) class-file)
              (let ((g (declare-local-function local-function)))
-	       (emit-make-compiled-closure-for-flet/labels 
+	       (emit-make-compiled-closure-for-flet/labels
 		local-function compiland g))))
           (t
 	   (with-temp-class-file
@@ -4920,7 +4912,7 @@
 	       (set-compiland-and-write-class-file class-file compiland)
 	       (setf (local-function-class-file local-function) class-file)
 	       (let ((g (declare-object (load-compiled-function pathname))))
-		 (emit-make-compiled-closure-for-flet/labels 
+		 (emit-make-compiled-closure-for-flet/labels
 		  local-function compiland g)))))))
 
 (defknown p2-flet (t t t) t)
@@ -4932,12 +4924,6 @@
         (local-functions (cadr form))
         (body (cddr form)))
     (dolist (local-function local-functions)
-      (let ((variable (local-function-variable local-function)))
-        (when variable
-          (aver (null (variable-register variable)))
-          (unless (variable-closure-index variable)
-            (setf (variable-register variable) (allocate-register))))))
-    (dolist (local-function local-functions)
       (p2-flet-process-compiland local-function))
     (dolist (local-function local-functions)
       (push local-function *local-functions*)