Changeset 11865


Ignore:
Timestamp:
05/15/09 09:20:17 (12 years ago)
Author:
ehuelsmann
Message:

Create new closure arrays when creating new closures.
This prevents the parent from clobbering closures
which it already created, when changing its own closure
array.

Variable saving and restoring is no longer necessary:
all the closure array copying does the same thing (better).

File:
1 edited

Legend:

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

    r11864 r11865  
    29922992  (emit-move-from-stack target))
    29932993
    2994 (defun save-variables (variables)
    2995   (let ((saved-vars '()))
    2996     (dolist (variable variables)
    2997       (when (variable-closure-index variable)
    2998         (let ((register (allocate-register)))
    2999           (aload (compiland-closure-register *current-compiland*))
    3000           (emit-push-constant-int (variable-closure-index variable))
    3001           (emit 'aaload)
    3002           (astore register)
    3003           (push (cons variable register) saved-vars))))
    3004     saved-vars))
    3005 
    3006 (defun restore-variables (saved-vars)
    3007   (dolist (saved-var saved-vars)
    3008     (let ((variable (car saved-var))
    3009           (register (cdr saved-var)))
    3010       (aload (compiland-closure-register *current-compiland*))
    3011       (emit-push-constant-int (variable-closure-index variable))
    3012       (aload register)
    3013       (emit 'aastore))))
    30142994
    30152995(defun duplicate-closure-array (compiland)
     
    30263006    (emit-invokestatic "java/lang/System" "arraycopy"
    30273007                       (list "Ljava/lang/Object;" "I"
    3028                              "Ljava/lang/Object;" "I" "I") "V")
     3008                             "Ljava/lang/Object;" "I" "I") nil)
    30293009    (aload register))) ;; reload dest value
    30303010
     
    30413021         (args (cdr form))
    30423022         (local-function (find-local-function op))
    3043          (*register* *register*)
    3044          (saved-vars '())
    3045          (label-START (gensym))
    3046          (label-END (gensym))
    3047          (label-EXIT (gensym)))
     3023         (*register* *register*))
    30483024    (cond ((local-function-variable local-function)
    30493025           ;; LABELS
    30503026           (dformat t "compile-local-function-call LABELS case variable = ~S~%"
    30513027                   (variable-name (local-function-variable local-function)))
    3052            (unless (null (compiland-parent compiland))
    3053              (setf saved-vars
    3054                    (save-variables (intersection
    3055                                     (compiland-arg-vars (local-function-compiland local-function))
    3056                                     *visible-variables*))))
    3057 ;;            (emit 'var-ref (local-function-variable local-function) 'stack)
    3058            (when saved-vars
    3059              (label label-START))
    30603028           (compile-var-ref (make-var-ref (local-function-variable local-function)) 'stack nil))
    30613029          (t
     
    30673035             (when *closure-variables*
    30683036               (emit 'checkcast +lisp-ctf-class+)
    3069                (aload (compiland-closure-register compiland))
     3037               (duplicate-closure-array compiland)
    30703038               (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    30713039                                  (list +lisp-object+ +closure-binding-array+)
     
    30743042    (emit-call-execute (length args))
    30753043    (fix-boxing representation nil)
    3076     (emit-move-from-stack target representation)
    3077     (when saved-vars
    3078       (emit 'goto label-EXIT)
    3079       (label label-END)
    3080       (restore-variables saved-vars)
    3081       (emit 'athrow)
    3082       (label label-EXIT)
    3083       (restore-variables saved-vars)
    3084       (push (make-handler :from label-START
    3085                           :to label-END
    3086                           :code label-END
    3087                           :catch-type 0) *handlers*)))
     3044    (emit-move-from-stack target representation))
    30883045  t)
    30893046
     
    48994856         (compiland-closure-register parent))
    49004857      (emit 'checkcast +lisp-ctf-class+)
    4901       (aload (compiland-closure-register parent))
     4858      (duplicate-closure-array parent)
    49024859      (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    49034860       (list +lisp-object+ +closure-binding-array+)
     
    50475004    (cond ((null *closure-variables*)) ; Nothing to do.
    50485005          ((compiland-closure-register *current-compiland*)
    5049            (aload (compiland-closure-register *current-compiland*))
     5006           (duplicate-closure-array *current-compiland*)
    50505007           (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    50515008                              (list +lisp-object+ +closure-binding-array+)
     
    50795036                           (when (compiland-closure-register *current-compiland*)
    50805037                             (emit 'checkcast +lisp-ctf-class+)
    5081                              (aload (compiland-closure-register *current-compiland*))
     5038                             (duplicate-closure-array *current-compiland*)
    50825039                             (emit-invokestatic +lisp-class+ "makeCompiledClosure"
    50835040                                                (list +lisp-object+ +closure-binding-array+)
Note: See TracChangeset for help on using the changeset viewer.