Changeset 11708


Ignore:
Timestamp:
03/14/09 22:59:14 (13 years ago)
Author:
ehuelsmann
Message:

Save/Restore? dynamic environment for functions which take a special variable an argument.

See ticket #52.

Location:
trunk/abcl/src/org/armedbear/lisp
Files:
2 edited

Legend:

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

    r11707 r11708  
    83458345         (*thread* nil)
    83468346         (*initialize-thread-var* nil)
    8347          (super nil))
     8347         (super nil)
     8348         (label-START (gensym))
     8349         (label-END (gensym))
     8350         (label-EXIT (gensym)))
    83488351
    83498352    (unless *child-p*
     
    85258528
    85268529    ;; Establish dynamic bindings for any variables declared special.
     8530    (when (some #'variable-special-p parameters)
     8531      ;; Save the dynamic environment
     8532      (setf (compiland-environment-register compiland)
     8533            (allocate-register))
     8534      (emit-push-current-thread)
     8535      (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
     8536            +lisp-special-binding+)
     8537      (astore (compiland-environment-register compiland))
     8538      (label label-START))
    85278539    (dolist (variable parameters)
    85288540      (when (variable-special-p variable)
     
    85468558    (compile-progn-body body 'stack)
    85478559
     8560    (when (compiland-environment-register compiland)
     8561      (emit 'goto label-EXIT)
     8562      (label label-END)
     8563      (emit-push-current-thread)
     8564      (aload (compiland-environment-register compiland))
     8565      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
     8566            +lisp-special-binding+)
     8567      (emit 'athrow)
     8568
     8569      ;; Restore dynamic environment
     8570      (label label-EXIT)
     8571      (emit-push-current-thread)
     8572      (aload (compiland-environment-register compiland))
     8573      (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
     8574            +lisp-special-binding+)
     8575
     8576      (push (make-handler :from label-START
     8577                          :to label-END
     8578                          :code label-END
     8579                          :catch-type 0) *handlers*))
     8580
    85488581    (unless *code*
    85498582      (emit-push-nil))
    8550 
    85518583    (emit 'areturn)
    85528584
  • trunk/abcl/src/org/armedbear/lisp/jvm.lisp

    r11698 r11708  
    163163  argument-register
    164164  closure-register
     165  environment-register
    165166  class-file ; class-file object
    166167  (%single-valued-p t))
Note: See TracChangeset for help on using the changeset viewer.