diff --git a/src/cmp/cmpc-wt.lsp b/src/cmp/cmpc-wt.lsp index 6e9f346bb..fef692d2c 100644 --- a/src/cmp/cmpc-wt.lsp +++ b/src/cmp/cmpc-wt.lsp @@ -90,6 +90,10 @@ (wt1 #\})) (baboon :format-control "Mismatch in C blocks"))) +(defmacro with-indentation (&body body) + `(let ((*opened-c-braces* (1+ *opened-c-braces*))) + ,@body)) + ;;; ;;; LABELS AND JUMPS ;;; diff --git a/src/cmp/cmpcatch.lsp b/src/cmp/cmpcatch.lsp index b3f9cbf3e..1c45cc6c7 100644 --- a/src/cmp/cmpcatch.lsp +++ b/src/cmp/cmpcatch.lsp @@ -22,29 +22,31 @@ (defun c2catch (c1form tag body) (declare (ignore c1form)) - (let* ((new-destination (tmp-destination *destination*))) - (let* ((*destination* 'VALUE0)) + (let* ((new-destination (tmp-destination *destination*)) + (code (incf *last-label*))) + (let ((*destination* 'VALUE0)) (c2expr* tag)) (let* ((*destination* new-destination) - (code (incf *last-label*)) - (*exit* (next-label)) - (*unwind-exit* (list* *exit* 'FRAME *unwind-exit*))) + (*unwind-exit* (cons 'FRAME *unwind-exit*))) (if (member new-destination '(TRASH VALUES)) (progn (wt-nl "if (ecl_frs_push(cl_env_copy," 'VALUE0 ")==0) {") (wt-comment "BEGIN CATCH ~A" code) - (c2expr body) - (wt-nl "}")) + (with-indentation + (c2expr* body))) (progn (wt-nl "if (ecl_frs_push(cl_env_copy," 'VALUE0 ")) {") (wt-comment "BEGIN CATCH ~A" code) - (unwind-exit 'VALUES t) - (wt-nl "}") - (c2expr body))) - (wt-label *exit*) - (wt-nl "ecl_frs_pop(cl_env_copy);") - (wt-comment "END CATCH ~A" code) - ) + (with-indentation + (with-exit-label (label) + (let ((*exit* label)) + (unwind-exit 'VALUES)))) + (wt-nl "} else {") + (with-indentation + (c2expr* body))))) + (wt-nl "}") + (wt-nl "ecl_frs_pop(cl_env_copy);") + (wt-comment "END CATCH ~A" code) (unwind-exit new-destination))) (defun c1unwind-protect (args)