Changeset 11705


Ignore:
Timestamp:
03/14/09 20:18:57 (14 years ago)
Author:
ehuelsmann
Message:

Make MULTIPLE-VALUE-BIND restore its specials environment upon unexpected exit conditions
(eg Java exceptions); related to ticket #52.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/compiler-pass2.lisp

    r11704 r11705  
    40894089         (vars (second form))
    40904090         (bind-special-p nil)
    4091          (variables (block-vars block)))
     4091         (variables (block-vars block))
     4092         (label-START (gensym))
     4093         (label-END (gensym))
     4094         (label-EXIT (gensym)))
    40924095    (dolist (variable variables)
    40934096      (let ((special-p (variable-special-p variable)))
     
    41044107      (emit-push-current-thread)
    41054108      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+)
    4106       (astore (block-environment-register block)))
     4109      (astore (block-environment-register block))
     4110      (label label-START))
    41074111    ;; Make sure there are no leftover values from previous calls.
    41084112    (emit-clear-values)
     
    41614165    (compile-progn-body (cdddr form) target)
    41624166    (when bind-special-p
    4163       ;; Restore dynamic environment.
     4167      (emit 'goto label-EXIT)
     4168      (label label-END)
    41644169      (aload *thread*)
    41654170      (aload (block-environment-register block))
    4166       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+))))
     4171      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
     4172            +lisp-special-binding+)
     4173      (emit 'athrow)
     4174
     4175      ;; Restore dynamic environment.
     4176      (label label-EXIT)
     4177      (aload *thread*)
     4178      (aload (block-environment-register block))
     4179      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+)
     4180      (push (make-handler :from label-START
     4181                          :to label-END
     4182                          :code label-END
     4183                          :catch-type 0) *handlers*))))
    41674184
    41684185(defun propagate-vars (block)
Note: See TracChangeset for help on using the changeset viewer.