Changeset 11842


Ignore:
Timestamp:
05/08/09 19:31:12 (13 years ago)
Author:
ehuelsmann
Message:

Re-order p2-block-node, to make more clear
what the COND was actually doing.

File:
1 edited

Legend:

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

    r11840 r11842  
    46214621  (let* ((*blocks* (cons block *blocks*))
    46224622         (*register* *register*))
    4623     (cond ((block-return-p block)
    4624            (setf (block-target block) target)
    4625            (dformat t "p2-block-node lastSpecialBinding~%")
    4626            (dformat t "*all-variables* = ~S~%"
    4627                     (mapcar #'variable-name *all-variables*))
    4628            (when (block-needs-environment-restoration block)
    4629              ;; Save the current dynamic environment.
    4630              (setf (block-environment-register block) (allocate-register))
    4631              (save-dynamic-environment (block-environment-register block)))
    4632            (setf (block-catch-tag block) (gensym))
    4633            (let* ((*register* *register*)
    4634                   (BEGIN-BLOCK (gensym))
    4635                   (END-BLOCK (gensym))
    4636                   (BLOCK-EXIT (block-exit block)))
    4637              (label BEGIN-BLOCK) ; Start of protected range.
    4638              ;; Implicit PROGN.
    4639              (compile-progn-body (cddr (block-form block)) target)
    4640              (label END-BLOCK) ; End of protected range.
    4641              (emit 'goto BLOCK-EXIT) ; Jump over handler (if any).
    4642              (when (block-non-local-return-p block)
    4643                ; We need a handler to catch non-local RETURNs.
    4644                (let ((HANDLER (gensym))
    4645                      (RETHROW (gensym)))
    4646                  (label HANDLER)
    4647                  ;; The Return object is on the runtime stack. Stack depth is 1.
    4648                  (emit 'dup) ; Stack depth is 2.
    4649                  (emit 'getfield +lisp-return-class+ "tag" +lisp-object+) ; Still 2.
    4650                  (compile-form `',(block-catch-tag block) 'stack nil) ; Tag. Stack depth is 3.
    4651                  ;; If it's not the tag we're looking for...
    4652                  (emit 'if_acmpne RETHROW) ; Stack depth is 1.
    4653                  (emit 'getfield +lisp-return-class+ "result" +lisp-object+)
    4654                  (emit-move-from-stack target) ; Stack depth is 0.
    4655                  (emit 'goto BLOCK-EXIT)
    4656                  (label RETHROW)
    4657                  ;; Not the tag we're looking for.
    4658                  (emit 'athrow)
    4659                  ;; Finally...
    4660                  (push (make-handler :from BEGIN-BLOCK
    4661                                      :to END-BLOCK
    4662                                      :code HANDLER
    4663                                      :catch-type (pool-class +lisp-return-class+))
    4664                        *handlers*)))
    4665              (label BLOCK-EXIT))
    4666            (when (block-environment-register block)
    4667              ;; We saved the dynamic environment above. Restore it now.
    4668        (restore-dynamic-environment (block-environment-register block)))
    4669            (fix-boxing representation nil)
    4670            )
    4671           (t
    4672            ;; No explicit returns.
    4673            (compile-progn-body (cddr (block-form block)) target representation)))))
     4623    (if (null (block-return-p block))
     4624        ;; No explicit returns
     4625        (compile-progn-body (cddr (block-form block)) target representation)
     4626        (progn
     4627          (setf (block-target block) target)
     4628          (dformat t "p2-block-node lastSpecialBinding~%")
     4629          (dformat t "*all-variables* = ~S~%"
     4630                   (mapcar #'variable-name *all-variables*))
     4631          (when (block-needs-environment-restoration block)
     4632            ;; Save the current dynamic environment.
     4633            (setf (block-environment-register block) (allocate-register))
     4634            (save-dynamic-environment (block-environment-register block)))
     4635          (setf (block-catch-tag block) (gensym))
     4636          (let* ((*register* *register*)
     4637                 (BEGIN-BLOCK (gensym))
     4638                 (END-BLOCK (gensym))
     4639                 (BLOCK-EXIT (block-exit block)))
     4640            (label BEGIN-BLOCK) ; Start of protected range.
     4641            ;; Implicit PROGN.
     4642            (compile-progn-body (cddr (block-form block)) target)
     4643            (label END-BLOCK) ; End of protected range.
     4644            (emit 'goto BLOCK-EXIT) ; Jump over handler (if any).
     4645            (when (block-non-local-return-p block)
     4646              ;; We need a handler to catch non-local RETURNs.
     4647              (let ((HANDLER (gensym))
     4648                    (RETHROW (gensym)))
     4649                (label HANDLER)
     4650                ;; The Return object is on the runtime stack. Stack depth is 1.
     4651                (emit 'dup) ; Stack depth is 2.
     4652                (emit 'getfield +lisp-return-class+ "tag" +lisp-object+) ; Still 2.
     4653                (compile-form `',(block-catch-tag block) 'stack nil) ; Tag. Stack depth is 3.
     4654                ;; If it's not the tag we're looking for...
     4655                (emit 'if_acmpne RETHROW) ; Stack depth is 1.
     4656                (emit 'getfield +lisp-return-class+ "result" +lisp-object+)
     4657                (emit-move-from-stack target) ; Stack depth is 0.
     4658                (emit 'goto BLOCK-EXIT)
     4659                (label RETHROW)
     4660                ;; Not the tag we're looking for.
     4661                (emit 'athrow)
     4662                ;; Finally...
     4663                (push (make-handler :from BEGIN-BLOCK
     4664                                    :to END-BLOCK
     4665                                    :code HANDLER
     4666                                    :catch-type (pool-class +lisp-return-class+))
     4667                      *handlers*)))
     4668            (label BLOCK-EXIT))
     4669          (when (block-environment-register block)
     4670            ;; We saved the dynamic environment above. Restore it now.
     4671            (restore-dynamic-environment (block-environment-register block)))
     4672          (fix-boxing representation nil)))))
    46744673
    46754674(defknown p2-return-from (t t t) t)
Note: See TracChangeset for help on using the changeset viewer.