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

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Fri Aug 12 12:43:37 2011
New Revision: 13470

Log:
Explicitly record the children of a compiland for later use,
instead of counting them, even though we only needed a HAS-CHILDREN boolean.

Modified:
   trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp
   trunk/abcl/src/org/armedbear/lisp/compiler-pass2.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	Fri Aug 12 12:12:24 2011	(r13469)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass1.lisp	Fri Aug 12 12:43:37 2011	(r13470)
@@ -726,16 +726,16 @@
     (form local-functions-var lambda-list-var name-var body-var body1 body2)
   `(let ((*visible-variables* *visible-variables*)
          (*local-functions* *local-functions*)
-         (*current-compiland* *current-compiland*)
+         (parent-compiland *current-compiland*)
          (,local-functions-var '()))
-     (incf (compiland-children *current-compiland*) (length (cadr ,form)))
      (dolist (definition (cadr ,form))
        (let ((,name-var (car definition))
              (,lambda-list-var (cadr definition)))
          (validate-function-name ,name-var)
          (let* ((,body-var (cddr definition))
                 (compiland (make-compiland :name ,name-var
-                                           :parent *current-compiland*)))
+                                           :parent parent-compiland)))
+           (push compiland (compiland-children parent-compiland))
            , at body1)))
      (setf ,local-functions-var (nreverse ,local-functions-var))
      ;; Make the local functions visible.
@@ -1021,8 +1021,7 @@
                                                        name (gensym "ANONYMOUS-LAMBDA-"))
                                              :lambda-expression lambda-form
                                              :parent *current-compiland*)))
-             (when *current-compiland*
-               (incf (compiland-children *current-compiland*)))
+             (push compiland (compiland-children *current-compiland*))
              (multiple-value-bind (body decls)
                  (parse-body body)
                (setf (compiland-lambda-expression compiland)

Modified: trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Aug 12 12:12:24 2011	(r13469)
+++ trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp	Fri Aug 12 12:43:37 2011	(r13470)
@@ -7088,7 +7088,7 @@
     (when (and register
                (not (variable-special-p variable))
                (not (variable-used-non-locally-p variable))
-               (zerop (compiland-children *current-compiland*)))
+               (null (compiland-children *current-compiland*)))
       (when (memq (type-representation (variable-declared-type variable))
                   '(:int :long))
         (emit-push-variable variable)

Modified: trunk/abcl/src/org/armedbear/lisp/jvm.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Fri Aug 12 12:12:24 2011	(r13469)
+++ trunk/abcl/src/org/armedbear/lisp/jvm.lisp	Fri Aug 12 12:43:37 2011	(r13470)
@@ -199,8 +199,8 @@
   arity             ; number of args, or NIL if the number of args can vary.
   p1-result         ; the parse tree as created in pass 1
   parent            ; the parent for compilands which defined within another
-  (children 0       ; Number of local functions
-            :type fixnum) ; defined with FLET, LABELS or LAMBDA
+  children          ; List of local compilands
+                    ; defined with FLET, LABELS or LAMBDA
   blocks            ; TAGBODY, PROGV, BLOCK, etc. blocks
   argument-register
   closure-register