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

[Alessio Stalla]

Author: astalla
Date: Mon Jan 25 17:42:38 2010
New Revision: 12401

Log:
Added a flag to local functions that tracks whether they need an actual
function object to be created (i.e. they are capture with FUNCTION).


Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
   trunk/abcl/src/org/armedbear/lisp/jvm.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	Mon Jan 25 17:42:38 2010
@@ -840,6 +840,8 @@
              (list 'FUNCTION compiland)))
           ((setf local-function (find-local-function (cadr form)))
            (dformat t "p1-function local function ~S~%" (cadr form))
+	   ;;we found out that the function needs a reference
+	   (setf (local-function-references-needed-p local-function) t)
            (let ((variable (local-function-variable local-function)))
              (when variable
                  (dformat t "p1-function ~S used non-locally~%"

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	(original)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Mon Jan 25 17:42:38 2010
@@ -364,7 +364,11 @@
   environment ;; the environment in which the function is stored in
               ;; case of a function from an enclosing lexical environment
               ;; which itself isn't being compiled
-  (references-allowed-p t)
+  (references-allowed-p t) ;;whether a reference to the function CAN be captured
+  (references-needed-p nil) ;;whether a reference to the function NEEDS to be
+			    ;;captured, because the function name is used in a
+                            ;;(function ...) form. Obviously implies
+                            ;;references-allowed-p.
   )
 
 (defvar *local-functions* ())
@@ -464,10 +468,11 @@
     block))
 
 (defstruct (flet-node (:conc-name flet-)
-                      (:include binding-node)))
-(defknown make-let/let*-node () t)
-(defun make-let/let*-node ()
-  (let ((block (%make-let/let*-node)))
+                      (:include binding-node)
+		      (:constructor %make-flet-node ())))
+(defknown make-flet-node () t)
+(defun make-flet-node ()
+  (let ((block (%make-flet-node)))
     (push block (compiland-blocks *current-compiland*))
     block))