Ignore:
Timestamp:
05/14/09 20:52:15 (13 years ago)
Author:
ehuelsmann
Message:

Initialize the closure slots with a binding, so that
we won't need to check for that condition when
we want to set it later on.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/closure-fixes/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11862 r11863  
    81118111      (dformat t "~S moving arguments to closure array~%"
    81128112               (compiland-name compiland))
    8113       (cond (*child-p*
    8114              (aver (eql (compiland-closure-register compiland) 1))
    8115              (aload (compiland-closure-register compiland)))
    8116             (t ;; if we're the ultimate parent: create the closure array
    8117              (emit-push-constant-int (length *closure-variables*))
    8118              (dformat t "p2-compiland ~S anewarray 1~%"
    8119                       (compiland-name compiland))
    8120              (emit 'anewarray "org/armedbear/lisp/ClosureBinding")))
    8121       (dolist (variable closure-args)
    8122         (dformat t "moving variable ~S~%" (variable-name variable))
    8123         (cond ((variable-register variable)
     8113      (if *child-p*
     8114          (aload (compiland-closure-register compiland))
     8115          (progn
     8116            ;; if we're the ultimate parent: create the closure array
     8117            (emit-push-constant-int (length *closure-variables*))
     8118            (emit 'anewarray "org/armedbear/lisp/ClosureBinding")))
     8119      (dotimes (i (length *closure-variables*))
     8120        ;; Loop over all slots, setting their value
     8121        ;;  unconditionally if we're the parent creating it (using null
     8122        ;;  values if no real value is available)
     8123        ;; or selectively if we're a child binding certain slots.
     8124        (let ((variable (find i closure-args
     8125                              :key #'variable-closure-index
     8126                              :test #'eql)))
     8127          (when (or (not *child-p*) variable)
     8128            ;; we're the parent, or we have a variable to set.
     8129            (emit 'dup) ; array
     8130            (emit-push-constant-int i)
     8131            (emit 'new "org/armedbear/lisp/ClosureBinding")
     8132            (emit 'dup)
     8133            (cond
     8134              ((null variable)
     8135               (assert (not *child-p*))
     8136               (emit 'aconst_null))
     8137              ((variable-register variable)
    81248138               (assert (not (eql (variable-register variable)
    81258139                                 (compiland-closure-register compiland))))
    8126                (emit 'dup) ; array
    8127                (emit-push-constant-int (variable-closure-index variable))
    8128                (emit 'new "org/armedbear/lisp/ClosureBinding")
    8129                (emit 'dup)
    81308140               (aload (variable-register variable))
    8131                (emit-invokespecial-init "org/armedbear/lisp/ClosureBinding"
    8132                                        (list +lisp-object+))
    8133                (emit 'aastore)
    81348141               (setf (variable-register variable) nil))
    81358142              ((variable-index variable)
    8136                (emit 'dup) ; array
    8137                (emit-push-constant-int (variable-closure-index variable))
    8138                (emit 'new "org/armedbear/lisp/ClosureBinding")
    8139                (emit 'dup)
    81408143               (aload (compiland-argument-register compiland))
    81418144               (emit-push-constant-int (variable-index variable))
    81428145               (emit 'aaload)
    8143                (emit-invokespecial-init "org/armedbear/lisp/ClosureBinding"
    8144                                        (list +lisp-object+))
    8145                (emit 'aastore)
    8146                (setf (variable-index variable) nil))))
     8146               (setf (variable-index variable) nil))
     8147              (t
     8148               (assert (not "Can't happen!!"))))
     8149            (emit-invokespecial-init "org/armedbear/lisp/ClosureBinding"
     8150                                     (list +lisp-object+))
     8151            (emit 'aastore))))
    81478152
    81488153      (aver (not (null (compiland-closure-register compiland))))
Note: See TracChangeset for help on using the changeset viewer.