diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp index 486173092..c095244a9 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp @@ -161,20 +161,14 @@ (defun next-label (used-p) (make-label :id (incf *last-label*) :denv *unwind-exit* :used-p used-p)) -(defun maybe-next-label () - (if (labelp *exit*) - *exit* - (next-label nil))) - -(defmacro with-exit-label ((label) &body body) - `(let* ((,label (next-label nil)) - (*unwind-exit* (cons ,label *unwind-exit*))) - ,@body - (wt-label ,label))) - -(defmacro with-optional-exit-label ((label) &body body) - `(let* ((,label (maybe-next-label)) - (*unwind-exit* (adjoin ,label *unwind-exit*))) - ,@body - (unless (eq ,label *exit*) - (wt-label ,label)))) +;;; This macro binds VAR to a label where forms may exit or jump. +;;; LABEL may be supplied to reuse a label when it exists. +(defmacro with-exit-label ((var &optional exit) &body body) + (ext:with-gensyms (reuse label) + `(let* ((,label ,exit) + (,reuse (labelp ,label)) + (,var (if ,reuse ,label (next-label nil))) + (*unwind-exit* (adjoin ,var *unwind-exit*))) + ,@body + (unless ,reuse + (wt-label ,var))))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp index bc3eee14b..233b5b2c6 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp @@ -112,14 +112,11 @@ (c2expr this-form)) (t (let* ((next-form (second l)) - (*exit* (if (tag-p next-form) - (tag-jump next-form) - (next-label nil))) - (*unwind-exit* (cons *exit* *unwind-exit*)) - (*destination* 'TRASH)) - (c2expr this-form) - (unless (tag-p next-form) - (wt-label *exit*)))))))) + (maybe-tag (when (tag-p next-form) + (tag-jump next-form)))) + (with-exit-label (*exit* maybe-tag) + (let ((*destination* 'TRASH)) + (c2expr this-form))))))))) (defun c2go (c1form tag nonlocal) (declare (ignore c1form)) @@ -133,8 +130,10 @@ (case (c1form-name tag) ((VARIABLE LOCATION) (setq loc (c1form-arg 0 tag))) (t (setq loc (make-temp-var)) - (let ((*destination* loc)) (c2expr* tag)))) - (let ((*destination* 'VALUEZ)) (c2expr* val)) + (let ((*destination* loc)) + (c2expr* tag)))) + (let ((*destination* 'VALUEZ)) + (c2expr* val)) (wt-nl "cl_throw(" loc ");")) (defun c2catch (c1form tag body) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp index 99753b699..89288d4bb 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp @@ -51,7 +51,7 @@ (eq (c1form-name form2) 'LOCATION)) ;; Optimize (IF condition true-branch) or a situation in which ;; the false branch can be discarded. - (with-optional-exit-label (false-label) + (with-exit-label (false-label *exit*) (let ((*destination* `(JUMP-FALSE ,false-label))) (c2expr* fmla)) (c2expr form1))) @@ -59,7 +59,7 @@ (eq (c1form-name form1) 'LOCATION)) ;; Optimize (IF condition useless-value false-branch) when ;; the true branch can be discarded. - (with-optional-exit-label (true-label) + (with-exit-label (true-label *exit*) (let ((*destination* `(JUMP-TRUE ,true-label))) (c2expr* fmla)) (c2expr form2)))