Changeset 11832


Ignore:
Timestamp:
05/05/09 17:22:31 (13 years ago)
Author:
vvoutilainen
Message:

Cleanup for saving/restoring dynamic environment.

File:
1 edited

Legend:

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

    r11831 r11832  
    39533953  t)
    39543954
     3955(defun restore-dynamic-environment (register)
     3956  (emit-push-current-thread)
     3957  (aload register)
     3958  (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
     3959  +lisp-special-binding+))
     3960
     3961(defun save-dynamic-environment (register)
     3962  (emit-push-current-thread)
     3963  (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
     3964  +lisp-special-binding+)
     3965  (astore register))
     3966
    39553967(defun p2-m-v-b-node (block target)
    39563968  (let* ((*blocks* (cons block *blocks*))
     
    39763988      ;; Save current dynamic environment.
    39773989      (setf (block-environment-register block) (allocate-register))
    3978       (emit-push-current-thread)
    3979       (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    3980             +lisp-special-binding+)
    3981       (astore (block-environment-register block))
     3990      (save-dynamic-environment (block-environment-register block))
    39823991      (label label-START))
    39833992    ;; Make sure there are no leftover values from previous calls.
     
    40414050      (emit 'goto label-EXIT)
    40424051      (label label-END)
    4043       (aload *thread*)
    4044       (aload (block-environment-register block))
    4045       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4046             +lisp-special-binding+)
     4052      (restore-dynamic-environment (block-environment-register block))
    40474053      (emit 'athrow)
    40484054
    40494055      ;; Restore dynamic environment.
    40504056      (label label-EXIT)
    4051       (aload *thread*)
    4052       (aload (block-environment-register block))
    4053       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4054             +lisp-special-binding+)
     4057      (restore-dynamic-environment (block-environment-register block))
    40554058      (push (make-handler :from label-START
    40564059                          :to label-END
     
    43814384      ;; We need to save current dynamic environment.
    43824385      (setf (block-environment-register block) (allocate-register))
    4383       (emit-push-current-thread)
    4384       (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    4385             +lisp-special-binding+)
    4386       (astore (block-environment-register block))
     4386      (save-dynamic-environment (block-environment-register block))
    43874387      (label label-START))
    43884388    (propagate-vars block)
     
    44034403      (label label-END)
    44044404      ;; Restore dynamic environment.
    4405       (aload *thread*)
    4406       (aload (block-environment-register block))
    4407       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4408             +lisp-special-binding+)
     4405      (restore-dynamic-environment (block-environment-register block))
    44094406      (emit 'athrow)
    44104407
    44114408      (label label-EXIT)
    4412       (aload *thread*)
    4413       (aload (block-environment-register block))
    4414       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4415             +lisp-special-binding+)
    4416 
     4409      (restore-dynamic-environment (block-environment-register block))
    44174410      (push (make-handler :from label-START
    44184411                          :to label-END
     
    44594452      ;; Non-local transfers of control restore the environment
    44604453      ;; themselves (in the finally of LET/LET*, etc.
    4461       (emit-push-current-thread)
    4462       (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    4463             +lisp-special-binding+)
    4464       (astore environment-register))
     4454      (save-dynamic-environment environment-register))
    44654455    (label BEGIN-BLOCK)
    44664456    (do* ((rest body (cdr rest))
     
    45434533      (when (block-environment-register tag-block)
    45444534        ;; If there's a dynamic environment to restore, do it.
    4545         (aload *thread*)
    4546         (aload (block-environment-register tag-block))
    4547         (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4548               +lisp-special-binding+))
     4535  (restore-dynamic-environment (block-environment-register tag-block)))
    45494536      (maybe-generate-interrupt-check)
    45504537      (emit 'goto (tag-label tag))
     
    46534640                  ;; Save the current dynamic environment.
    46544641                  (setf (block-environment-register block) (allocate-register))
    4655                   (emit-push-current-thread)
    4656                   (emit 'getfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+)
    4657                   (astore (block-environment-register block)))
     4642      (save-dynamic-environment (block-environment-register block)))
    46584643                 (t
    46594644                  (dformat t "no specials~%")))
     
    46944679           (when (block-environment-register block)
    46954680             ;; We saved the dynamic environment above. Restore it now.
    4696              (aload *thread*)
    4697              (aload (block-environment-register block))
    4698              (emit 'putfield +lisp-thread-class+ "lastSpecialBinding" +lisp-special-binding+))
     4681       (restore-dynamic-environment (block-environment-register block)))
    46994682           (fix-boxing representation nil)
    47004683           )
     
    48164799                 (single-valued-p values-form))
    48174800      (emit-clear-values))
    4818     (emit-push-current-thread)
    4819     (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    4820           +lisp-special-binding+)
    4821     (astore environment-register)
     4801    (save-dynamic-environment environment-register)
    48224802    (label label-START)
    48234803    ;; Compile call to Lisp.progvBindVars().
    4824     (aload *thread*)
     4804    (emit-push-current-thread)
    48254805    (emit-invokestatic +lisp-class+ "progvBindVars"
    48264806                       (list +lisp-object+ +lisp-object+ +lisp-thread+) nil)
     
    48294809    (emit 'goto label-EXIT)
    48304810    (label label-END)
    4831     (aload *thread*)
    4832     (aload environment-register)
    4833     (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4834           +lisp-special-binding+)
     4811    (restore-dynamic-environment environment-register)
    48354812    (emit 'athrow)
    48364813
    48374814    ;; Restore dynamic environment.
    48384815    (label label-EXIT)
    4839     (aload *thread*)
    4840     (aload environment-register)
    4841     (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    4842           +lisp-special-binding+)
     4816    (restore-dynamic-environment environment-register)
    48434817    (fix-boxing representation nil)
    48444818    (push (make-handler :from label-START
     
    78197793      ;; catch-all handler, which will do a re-throw.
    78207794      (emit 'if_acmpne DEFAULT-HANDLER) ; Stack depth is 1.
    7821       (aload *thread*)
     7795      (emit-push-current-thread)
    78227796      (emit-invokevirtual +lisp-throw-class+ "getResult"
    78237797                          (list +lisp-thread+) +lisp-object+)
     
    78267800      (label DEFAULT-HANDLER) ; Start of handler for all other Throwables.
    78277801      ;; A Throwable object is on the runtime stack here. Stack depth is 1.
    7828       (aload *thread*)
     7802      (emit-push-current-thread)
    78297803      (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
    78307804      (emit 'athrow) ; Re-throw.
    78317805      (label EXIT)
    78327806      ;; Finally...
    7833       (aload *thread*)
     7807      (emit-push-current-thread)
    78347808      (emit-invokevirtual +lisp-thread-class+ "popCatchTag" nil nil)
    78357809      (let ((handler1 (make-handler :from BEGIN-PROTECTED-RANGE
     
    83118285      (setf (compiland-environment-register compiland)
    83128286            (allocate-register))
    8313       (emit-push-current-thread)
    8314       (emit 'getfield +lisp-thread-class+ "lastSpecialBinding"
    8315             +lisp-special-binding+)
    8316       (astore (compiland-environment-register compiland))
     8287      (save-dynamic-environment (compiland-environment-register compiland))
    83178288      (label label-START)
    83188289      (dolist (variable (compiland-arg-vars compiland))
     
    83408311      (emit 'goto label-EXIT)
    83418312      (label label-END)
    8342       (emit-push-current-thread)
    8343       (aload (compiland-environment-register compiland))
    8344       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    8345             +lisp-special-binding+)
     8313      (restore-dynamic-environment (compiland-environment-register compiland))
    83468314      (emit 'athrow)
    83478315
    83488316      ;; Restore dynamic environment
    83498317      (label label-EXIT)
    8350       (emit-push-current-thread)
    8351       (aload (compiland-environment-register compiland))
    8352       (emit 'putfield +lisp-thread-class+ "lastSpecialBinding"
    8353             +lisp-special-binding+)
    8354 
     8318      (restore-dynamic-environment (compiland-environment-register compiland))
    83558319      (push (make-handler :from label-START
    83568320                          :to label-END
     
    83798343               (ensure-thread-var-initialized)
    83808344               (maybe-initialize-thread-var)
    8381                (aload *thread*)
     8345         (emit-push-current-thread)
    83828346               (emit-invokevirtual *this-class* "processArgs"
    83838347                                   (list +lisp-object-array+ +lisp-thread+)
Note: See TracChangeset for help on using the changeset viewer.