Changeset 13021


Ignore:
Timestamp:
11/11/10 12:40:40 (11 years ago)
Author:
ehuelsmann
Message:

Reduce the number of ATHROW instructions executed while running
the Maxima test suite by ~60%.

Note: because we don't generate stack dumps on our ControlTransfer?
exception derivatives, we only save 2% execution time.

[Note from the future: this commit requires a FASL version
number update which got committed at r13064.]

File:
1 edited

Legend:

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

    r13020 r13021  
    29982998      (compile-progn-body (cdddr form) target))
    29992999    (when bind-special-p
    3000       (restore-environment-and-make-handler (m-v-b-environment-register block)
    3001               label-START))))
     3000      (restore-dynamic-environment (m-v-b-environment-register block)))))
    30023001
    30033002(defun propagate-vars (block)
     
    33563355        (compile-progn-body (cddr form) target representation)))
    33573356    (when specialp
    3358       (restore-environment-and-make-handler (let-environment-register block)
    3359               label-START))))
     3357      (restore-dynamic-environment (let-environment-register block)))))
    33603358
    33613359(defknown p2-locally-node (t t t) t)
     
    33803378         (RETHROW (gensym))
    33813379         (EXIT (gensym))
    3382          (must-clear-values nil))
     3380         (must-clear-values nil)
     3381         (specials-register (when (tagbody-non-local-go-p block)
     3382                              (allocate-register))))
    33833383    ;; Scan for tags.
    33843384    (dolist (tag (tagbody-tags block))
     
    33923392      (emit-invokespecial-init +lisp-object+ '())
    33933393      (emit-new-closure-binding (tagbody-id-variable block)))
     3394    (when (tagbody-non-local-go-p block)
     3395      (save-dynamic-environment specials-register))
    33943396    (label BEGIN-BLOCK)
    33953397    (do* ((rest body (cdr rest))
     
    34283430        (emit-getfield +lisp-go+ "tag" +lisp-object+) ; Stack depth is still 1.
    34293431        (astore tag-register)
     3432        (restore-dynamic-environment specials-register)
    34303433        ;; Don't actually generate comparisons for tags
    34313434        ;; to which there is no non-local GO instruction
     
    35733576         (BEGIN-BLOCK (gensym))
    35743577         (END-BLOCK (gensym))
    3575          (BLOCK-EXIT (block-exit block)))
     3578         (BLOCK-EXIT (block-exit block))
     3579         (specials-register (when (block-non-local-return-p block)
     3580                              (allocate-register))))
    35763581    (setf (block-target block) target)
    35773582    (when (block-id-variable block)
     
    35843589    (dformat t "*all-variables* = ~S~%"
    35853590             (mapcar #'variable-name *all-variables*))
     3591    (when (block-non-local-return-p block)
     3592      (save-dynamic-environment specials-register))
    35863593    (label BEGIN-BLOCK) ; Start of protected range, for non-local returns
    35873594    ;; Implicit PROGN.
     
    36113618        (emit 'athrow)
    36123619        (label THIS-BLOCK)
     3620        (restore-dynamic-environment specials-register)
    36133621        (emit-getfield +lisp-return+ "result" +lisp-object+)
    36143622        (emit-move-from-stack target) ; Stack depth is 0.
     
    37323740    (let ((*blocks* (cons block *blocks*)))
    37333741      (compile-progn-body (cdddr form) target representation))
    3734     (restore-environment-and-make-handler environment-register label-START)))
     3742    (restore-dynamic-environment environment-register)))
    37353743
    37363744(defun p2-quote (form target representation)
     
    64496457           (RETHROW (gensym))
    64506458           (DEFAULT-HANDLER (gensym))
    6451            (EXIT (gensym)))
     6459           (EXIT (gensym))
     6460           (specials-register (allocate-register)))
    64526461      (compile-form (second form) tag-register nil) ; Tag.
    64536462      (emit-push-current-thread)
     
    64576466      (let ((*blocks* (cons block *blocks*)))
    64586467        ; Stack depth is 0.
     6468        (save-dynamic-environment specials-register)
    64596469        (label BEGIN-PROTECTED-RANGE) ; Start of protected range.
    64606470        (compile-progn-body (cddr form) target) ; Implicit PROGN.
     
    64696479      ;; catch-all handler, which will do a re-throw.
    64706480      (emit 'if_acmpne RETHROW) ; Stack depth is 1.
     6481      (restore-dynamic-environment specials-register)
    64716482      (emit-push-current-thread)
    64726483      (emit-invokevirtual +lisp-throw+ "getResult"
     
    65346545           (result-register (allocate-register))
    65356546           (values-register (allocate-register))
     6547           (specials-register (allocate-register))
    65366548           (BEGIN-PROTECTED-RANGE (gensym))
    65376549           (END-PROTECTED-RANGE (gensym))
     
    65426554
    65436555      (let* ((*blocks* (cons block *blocks*)))
     6556        (save-dynamic-environment specials-register)
    65446557        (label BEGIN-PROTECTED-RANGE)
    65456558        (compile-form protected-form result-register nil)
     
    65616574      (emit-getfield +lisp-thread+ "_values" +lisp-object-array+)
    65626575      (astore values-register)
     6576      (restore-dynamic-environment specials-register)
    65636577      (let ((*register* *register*))
    65646578        (compile-progn-body cleanup-forms nil nil))
     
    69086922
    69096923    (when (compiland-environment-register compiland)
    6910       (restore-environment-and-make-handler
    6911        (compiland-environment-register compiland) label-START))
     6924      (restore-dynamic-environment (compiland-environment-register compiland)))
    69126925
    69136926    (unless *code*
Note: See TracChangeset for help on using the changeset viewer.