diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp index 94e744007..76d16f15e 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp @@ -147,6 +147,12 @@ (let ((code (incf *next-cfun*))) (format nil prefix code (lisp-to-c-name lisp-name)))) +(defmacro with-lexical-scope (() &body body) + `(progn + (wt-nl-open-brace) + ,@body + (wt-nl-close-brace))) + ;;; *LAST-LABEL* holds the label# of the last used label. This is used by the ;;; code generator to avoid duplicated labels in the same scope. @@ -177,25 +183,23 @@ ;;; RETURN-FROM to intercept the control and eval UNWIND-PROTECT cleanup forms. ;;; ecl_frs_pop is emited by the exit manager or the caller. -- jd 2023-11-19 (defmacro with-unwind-frame ((tag) handler-form &body body) - `(let ((*unwind-exit* (list* 'FRAME *unwind-exit*))) - (wt-nl-open-brace) - (wt-nl "ecl_frs_push(cl_env_copy," ,tag ");") - (wt-nl "if (__ecl_frs_push_result!=0) {") - ,handler-form - ,@(when body - `((wt-nl "} else {") - ,@body)) - (wt-nl "}") - (wt-nl-close-brace))) + `(with-lexical-scope () + (let ((*unwind-exit* (list* 'FRAME *unwind-exit*))) + (wt-nl "ecl_frs_push(cl_env_copy," ,tag ");") + (wt-nl "if (__ecl_frs_push_result!=0) {") + ,handler-form + ,@(when body + `((wt-nl "} else {") + ,@body)) + (wt-nl "}")))) (defmacro with-stack-frame ((var &optional loc) &body body) (ext:with-gensyms (hlp) - `(let* ((,var ,(or loc "_ecl_inner_frame")) - (,hlp "_ecl_inner_frame_aux") - (*unwind-exit* (list* (list 'STACK ,var) *unwind-exit*))) - (wt-nl-open-brace) - (wt-nl "struct ecl_stack_frame " ,hlp ";") - (wt-nl *volatile* "cl_object " ,var - "=ecl_stack_frame_open(cl_env_copy,(cl_object)&" ,hlp ",0);") - ,@body - (wt-nl-close-brace)))) + `(with-lexical-scope () + (let* ((,var ,(or loc "_ecl_inner_frame")) + (,hlp "_ecl_inner_frame_aux") + (*unwind-exit* (list* (list 'STACK ,var) *unwind-exit*))) + (wt-nl "struct ecl_stack_frame " ,hlp ";") + (wt-nl *volatile* "cl_object " ,var + "=ecl_stack_frame_open(cl_env_copy,(cl_object)&" ,hlp ",0);") + ,@body)))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp index 22839ad54..ecde25397 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp @@ -23,21 +23,20 @@ (let* ((blk-var (blk-var blk)) (*env-lvl* *env-lvl*)) (check-vref blk-var) - (wt-nl-open-brace) - (when (eq :object (var-kind blk-var)) - (setf (var-loc blk-var) (next-lcl)) - (wt-nl "cl_object " blk-var ";")) - (when (env-grows (var-ref-ccb blk-var)) - ;; var is referenced from a closure which may escape. - (let ((env-lvl *env-lvl*)) - (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";"))) - (bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var) - (with-unwind-frame (blk-var) - (unwind-exit 'VALUEZ) - (c2expr body)) - (when (var-ref-ccb blk-var) - (decf *env*)) - (wt-nl-close-brace)) + (with-lexical-scope () + (when (eq :object (var-kind blk-var)) + (setf (var-loc blk-var) (next-lcl)) + (wt-nl "cl_object " blk-var ";")) + (when (env-grows (var-ref-ccb blk-var)) + ;; var is referenced from a closure which may escape. + (let ((env-lvl *env-lvl*)) + (wt-nl "cl_object " *volatile* "env" (incf *env-lvl*) " = env" env-lvl ";"))) + (bind "ECL_NEW_FRAME_ID(cl_env_copy)" blk-var) + (with-unwind-frame (blk-var) + (unwind-exit 'VALUEZ) + (c2expr body)) + (when (var-ref-ccb blk-var) + (decf *env*)))) (c2expr body))) (defun c2return-from (c1form blk nonlocal val) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp index 7d6f511b7..92915b386 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp @@ -90,21 +90,20 @@ (setf comma ",")) (wt ")") (wt-h ");") - (wt-nl-open-brace) - (when return-p - (wt-nl return-type-name " output;")) - (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") - (wt-nl "cl_object aux;") - (with-stack-frame (frame) - (loop for var in vars - and type in arg-types - and ct in arg-type-constants - do (wt-nl "ecl_stack_frame_push(" frame "," `(ffi-data-ref ,var ,ct) ");")) - (wt-nl "aux = ecl_apply_from_stack_frame(" frame "," - "ecl_fdefinition(" c-name-constant "));") - ;; No UNWIND-EXIT, so we must close the frame manually. - (wt-nl "ecl_stack_frame_close(" frame ");")) - (when return-p - (set-loc `(ffi-data-ref "output" ,return-type-code) "aux") - (wt-nl "return output;")) - (wt-nl-close-brace))) + (with-lexical-scope () + (when return-p + (wt-nl return-type-name " output;")) + (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") + (wt-nl "cl_object aux;") + (with-stack-frame (frame) + (loop for var in vars + and type in arg-types + and ct in arg-type-constants + do (wt-nl "ecl_stack_frame_push(" frame "," `(ffi-data-ref ,var ,ct) ");")) + (wt-nl "aux = ecl_apply_from_stack_frame(" frame "," + "ecl_fdefinition(" c-name-constant "));") + ;; No UNWIND-EXIT, so we must close the frame manually. + (wt-nl "ecl_stack_frame_close(" frame ");")) + (when return-p + (set-loc `(ffi-data-ref "output" ,return-type-code) "aux") + (wt-nl "return output;"))))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp index eb775d617..8c084f5cd 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-fun.lsp @@ -212,27 +212,26 @@ ;; which is what we do here. (let ((va-arg-loc (if simple-varargs 'VA-ARG 'CL-VA-ARG))) ;; counter for optionals - (wt-nl-open-brace) - (wt-nl "int i = " nreq ";") - (do ((opt optionals (cdddr opt)) - (type-check optional-type-check-forms (cdr type-check))) - ((endp opt)) - (wt-nl "if (i >= narg) {") - (let ((*opened-c-braces* (1+ *opened-c-braces*))) - (bind-init (second opt) (first opt)) - (when (third opt) - (bind *vv-nil* (third opt)))) - (wt-nl "} else {") - (let ((*opened-c-braces* (1+ *opened-c-braces*)) - (*unwind-exit* *unwind-exit*)) - (wt-nl "i++;") - (bind va-arg-loc (first opt)) - (if (car type-check) - (c2expr* (car type-check))) - (when (third opt) - (bind *vv-t* (third opt)))) - (wt-nl "}")) - (wt-nl-close-brace))) + (with-lexical-scope () + (wt-nl "int i = " nreq ";") + (do ((opt optionals (cdddr opt)) + (type-check optional-type-check-forms (cdr type-check))) + ((endp opt)) + (wt-nl "if (i >= narg) {") + (let ((*opened-c-braces* (1+ *opened-c-braces*))) + (bind-init (second opt) (first opt)) + (when (third opt) + (bind *vv-nil* (third opt)))) + (wt-nl "} else {") + (let ((*opened-c-braces* (1+ *opened-c-braces*)) + (*unwind-exit* *unwind-exit*)) + (wt-nl "i++;") + (bind va-arg-loc (first opt)) + (if (car type-check) + (c2expr* (car type-check))) + (when (third opt) + (bind *vv-t* (third opt)))) + (wt-nl "}"))))) (when (or rest key-flag allow-other-keys) (cond ((not (or key-flag allow-other-keys)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp index cd9f81a26..78e00de5d 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-top.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-top.lsp @@ -192,11 +192,9 @@ (plusp *max-temp*) (plusp *max-env*) *ihs-used-p*) - (progn - (wt-nl-open-brace) + (with-lexical-scope () (wt-function-locals) - (write-sequence body *compiler-output1*) - (wt-nl-close-brace)) + (write-sequence body *compiler-output1*)) (write-sequence body *compiler-output1*))))) (defun t2compiler-let (c1form symbols values body) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp index 736c913e3..dd8c58fa7 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-var.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-var.lsp @@ -132,14 +132,14 @@ ;; Optionally register the variables with the IHS frame for debugging (if (policy-debug-variable-bindings) (let ((*unwind-exit* *unwind-exit*)) - (wt-nl-open-brace) - (let* ((env (build-debug-lexical-env vars))) - (when env (push 'IHS-ENV *unwind-exit*)) - (c2expr body) - (wt-nl-close-brace) - (when env (pop-debug-lexical-env)))) + (with-lexical-scope () + (ext:if-let ((env (build-debug-lexical-env vars))) + (progn + (push 'IHS-ENV *unwind-exit*) + (c2expr body) + (pop-debug-lexical-env)) + (c2expr body)))) (c2expr body)) - (close-inline-blocks)) (defun c2multiple-value-bind (c1form vars init-form body) @@ -209,14 +209,13 @@ (lcl (next-lcl)) (sym-loc (make-lcl-var)) (val-loc (make-lcl-var))) - (wt-nl-open-brace) - (wt-nl "cl_object " sym-loc ", " val-loc "; cl_index " lcl ";") - (let ((*destination* sym-loc)) (c2expr* symbols)) - (let ((*destination* val-loc)) (c2expr* values)) - (let ((*unwind-exit* (cons lcl *unwind-exit*))) - (wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");") - (c2expr body) - (wt-nl-close-brace)))) + (with-lexical-scope () + (wt-nl "cl_object " sym-loc ", " val-loc "; cl_index " lcl ";") + (let ((*destination* sym-loc)) (c2expr* symbols)) + (let ((*destination* val-loc)) (c2expr* values)) + (let ((*unwind-exit* (cons lcl *unwind-exit*))) + (wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");") + (c2expr body))))) (defun c2psetq (c1form vrefs forms &aux (*lcl* *lcl*) (saves nil) (braces *opened-c-braces*)) @@ -373,29 +372,28 @@ (let* ((*lcl* *lcl*) (useful-extra-vars (some #'useful-var-p (nthcdr min-values vars))) (nr (make-lcl-var :type :int))) - (wt-nl-open-brace) - (when useful-extra-vars - ;; Make a copy of env->nvalues before assigning to any variables - (wt-nl "const int " nr " = cl_env_copy->nvalues;")) + (with-lexical-scope () + (when useful-extra-vars + ;; Make a copy of env->nvalues before assigning to any variables + (wt-nl "const int " nr " = cl_env_copy->nvalues;")) - ;; We know that at least MIN-VALUES variables will get a value - (dotimes (i min-values) - (when vars - (let ((v (pop vars)) - (loc (values-loc-or-value0 i))) - (bind-or-set loc v use-bind)))) + ;; We know that at least MIN-VALUES variables will get a value + (dotimes (i min-values) + (when vars + (let ((v (pop vars)) + (loc (values-loc-or-value0 i))) + (bind-or-set loc v use-bind)))) - ;; Assign to other variables only when the form returns enough values - (when useful-extra-vars - (let ((tmp (make-lcl-var))) - (wt-nl "cl_object " tmp ";") - (loop for v in vars - for i from min-values - for loc = (values-loc-or-value0 i) - do (when (useful-var-p v) - (wt-nl tmp " = (" nr "<=" i ")? ECL_NIL : " loc ";") - (bind-or-set tmp v use-bind))))) - (wt-nl-close-brace)) + ;; Assign to other variables only when the form returns enough values + (when useful-extra-vars + (let ((tmp (make-lcl-var))) + (wt-nl "cl_object " tmp ";") + (loop for v in vars + for i from min-values + for loc = (values-loc-or-value0 i) + do (when (useful-var-p v) + (wt-nl tmp " = (" nr "<=" i ")? ECL_NIL : " loc ";") + (bind-or-set tmp v use-bind))))))) 'VALUE0)) (defun c2multiple-value-setq (c1form vars form)