Commit ea3c0f45 authored by ram's avatar ram
Browse files

Another cut at the last fix for unwind-protect. Also, don't add uninteresting

BLOCK continuations to the consumes.
parent f68facf7
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.10 1993/05/15 14:45:41 ram Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.11 1993/05/15 18:26:12 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -548,25 +548,19 @@ ...@@ -548,25 +548,19 @@
(let ((nlx-info (continuation-value (let ((nlx-info (continuation-value
(first (basic-combination-args node))))) (first (basic-combination-args node)))))
(when (eq (cleanup-kind (nlx-info-cleanup nlx-info)) :block) (when (eq (cleanup-kind (nlx-info-cleanup nlx-info)) :block)
(push (nlx-info-continuation nlx-info) stack))) (let ((cont (nlx-info-continuation nlx-info)))
(when (interesting cont)
(push cont stack)))))
(setf nlx-entry-p t))) (setf nlx-entry-p t)))
(cif (cif
(consume (if-test node))) (consume (if-test node)))
(creturn (creturn
(consume (return-result node))) (consume (return-result node)))
(entry (entry
;;
;; If we hit the NLX ep for a unwind-protect, then we are unwinding,
;; and don't want to mess with the stack, so just say there's
;; nothing on it.
(let* ((cup (entry-cleanup node)) (let* ((cup (entry-cleanup node))
(nlx-info (cleanup-nlx-info cup))) (nlx-info (cleanup-nlx-info cup)))
(when nlx-info (when nlx-info
(push (list nlx-info (push (list nlx-info stack (reverse consumes))
(ecase (cleanup-kind cup)
((:catch :block :tagbody) stack)
(:unwind-protect ()))
(reverse consumes))
nlx-entries)))) nlx-entries))))
(exit (exit
(when (exit-value node) (when (exit-value node)
...@@ -602,13 +596,20 @@ ...@@ -602,13 +596,20 @@
;;; produced by this block before the ENTRY node. Stack is the globally ;;; produced by this block before the ENTRY node. Stack is the globally
;;; simulated stack at the start of this block. ;;; simulated stack at the start of this block.
;;; ;;;
;;; If we hit the NLX ep for a unwind-protect, then we are unwinding, and don't
;;; want to mess with the stack, so just say there's nothing on it.
;;;
(defun walk-nlx-entry (nlx-infos stack produce consume) (defun walk-nlx-entry (nlx-infos stack produce consume)
(dolist (cont consume) (dolist (cont consume)
(assert (eq (car stack) cont)) (assert (eq (car stack) cont))
(pop stack)) (pop stack))
(setf stack (append produce stack))
(dolist (nlx-info nlx-infos) (dolist (nlx-info nlx-infos)
(walk-block (nlx-info-target nlx-info) nil stack))) (walk-block (nlx-info-target nlx-info) nil
(ecase (cleanup-kind (nlx-info-cleanup nlx-info))
((:block :tagbody :catch)
(append produce stack))
(:unwind-protect ()))))
(undefined-value))
(defun walk-block (block pred stack) (defun walk-block (block pred stack)
;; Pop everything off of stack that isn't live. ;; Pop everything off of stack that isn't live.
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment