Changeset 11864


Ignore:
Timestamp:
05/15/09 07:36:38 (12 years ago)
Author:
ehuelsmann
Message:

Duplicate closure arrays if the compiland defines
bindings of itself: that allows storing a new binding
without clobbering other closure arrays.

File:
1 edited

Legend:

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

    r11863 r11864  
    207207(defconstant +lisp-object-array+ "[Lorg/armedbear/lisp/LispObject;")
    208208(defconstant +closure-binding-array+ "[Lorg/armedbear/lisp/ClosureBinding;")
     209(defconstant +closure-binding+ "Lorg/armedbear/lisp/ClosureBinding;")
     210(defconstant +closure-binding-class+ "org/armedbear/lisp/ClosureBinding")
    209211(defconstant +lisp-symbol-class+ "org/armedbear/lisp/Symbol")
    210212(defconstant +lisp-symbol+ "Lorg/armedbear/lisp/Symbol;")
     
    30103012      (aload register)
    30113013      (emit 'aastore))))
     3014
     3015(defun duplicate-closure-array (compiland)
     3016  (let* ((*register* *register*)
     3017         (register (allocate-register)))
     3018    (aload (compiland-closure-register compiland))        ;; src
     3019    (emit-push-constant-int 0)                            ;; srcPos
     3020    (emit-push-constant-int (length *closure-variables*))
     3021    (emit 'anewarray "org/armedbear/lisp/ClosureBinding")     ;; dest
     3022    (emit 'dup)
     3023    (astore register)  ;; save dest value
     3024    (emit-push-constant-int 0)                            ;; destPos
     3025    (emit-push-constant-int (length *closure-variables*)) ;; length
     3026    (emit-invokestatic "java/lang/System" "arraycopy"
     3027                       (list "Ljava/lang/Object;" "I"
     3028                             "Ljava/lang/Object;" "I" "I") "V")
     3029    (aload register))) ;; reload dest value
     3030
     3031
    30123032
    30133033(defknown compile-local-function-call (t t t) t)
     
    80458065         (closure-args (intersection *closure-variables*
    80468066                                     (compiland-arg-vars compiland)))
     8067         (local-closure-vars
     8068          (find compiland *closure-variables* :key #'variable-compiland))
    80478069         (body (cddr p1-result))
    80488070         (*using-arg-array* nil)
     
    81068128                (compiland-closure-register compiland)))
    81078129
     8130    (when *closure-variables*
     8131      (cond
     8132        ((not *child-p*)
     8133         ;; if we're the ultimate parent: create the closure array
     8134         (emit-push-constant-int (length *closure-variables*))
     8135         (emit 'anewarray "org/armedbear/lisp/ClosureBinding"))
     8136        (local-closure-vars
     8137         (duplicate-closure-array compiland))))
     8138
    81088139    ;; Move args from their original registers to the closure variables array
    81098140    (when (or closure-args
     
    81118142      (dformat t "~S moving arguments to closure array~%"
    81128143               (compiland-name compiland))
    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")))
    81198144      (dotimes (i (length *closure-variables*))
    81208145        ;; Loop over all slots, setting their value
     
    81498174            (emit-invokespecial-init "org/armedbear/lisp/ClosureBinding"
    81508175                                     (list +lisp-object+))
    8151             (emit 'aastore))))
    8152 
     8176            (emit 'aastore)))))
     8177
     8178    (when (or local-closure-vars (and *closure-variables* (not *child-p*)))
    81538179      (aver (not (null (compiland-closure-register compiland))))
    8154       (cond (*child-p*
    8155              (emit 'pop))
    8156             (t
    8157              (astore (compiland-closure-register compiland))))
     8180      (astore (compiland-closure-register compiland))
    81588181      (dformat t "~S done moving arguments to closure array~%"
    81598182               (compiland-name compiland)))
Note: See TracChangeset for help on using the changeset viewer.