From ef36cf53e0bcf9872c5f7b31dca36a134fef1153 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Sun, 19 Nov 2023 15:24:41 +0100 Subject: [PATCH] cmp: abstract away STACK emitter with a macro We also get rid of (STACK ) exit in favor of an explicit frame. This was used only by UNWIND-PROTECT for no apparent reason. --- src/cmp/cmpbackend-cxx/cmpc-util.lsp | 11 +++++++++++ src/cmp/cmpbackend-cxx/cmppass2-call.lsp | 12 ++++-------- src/cmp/cmpbackend-cxx/cmppass2-cont.lsp | 13 ++++--------- src/cmp/cmpbackend-cxx/cmppass2-eval.lsp | 13 ++++--------- src/cmp/cmpbackend-cxx/cmppass2-exit.lsp | 6 ++---- src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp | 20 ++++++++++---------- 6 files changed, 35 insertions(+), 40 deletions(-) diff --git a/src/cmp/cmpbackend-cxx/cmpc-util.lsp b/src/cmp/cmpbackend-cxx/cmpc-util.lsp index 4859f081c..94e744007 100644 --- a/src/cmp/cmpbackend-cxx/cmpc-util.lsp +++ b/src/cmp/cmpbackend-cxx/cmpc-util.lsp @@ -188,3 +188,14 @@ (wt-nl "}") (wt-nl-close-brace))) +(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)))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp index a95dfa30f..dc0238668 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-call.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-call.lsp @@ -131,18 +131,14 @@ (declare (ignore c1form)) (let* ((*temp* *temp*) (loc (maybe-save-value form args))) - (wt-nl-open-brace) - (wt-nl "struct ecl_stack_frame _ecl_inner_frame_aux;") - (wt-nl *volatile* "cl_object _ecl_inner_frame = ecl_stack_frame_open(cl_env_copy,(cl_object)&_ecl_inner_frame_aux,0);") - (let ((*unwind-exit* `((STACK "_ecl_inner_frame") ,@*unwind-exit*))) + (with-stack-frame (frame) (let ((*destination* (if values-p 'VALUEZ 'LEAVE))) (dolist (arg args) (c2expr* arg) (if values-p - (wt-nl "ecl_stack_frame_push_values(_ecl_inner_frame);") - (wt-nl "ecl_stack_frame_push(_ecl_inner_frame,value0);")))) - (unwind-exit (call-stack-loc nil loc))) - (wt-nl-close-brace))) + (wt-nl "ecl_stack_frame_push_values(" frame ");") + (wt-nl "ecl_stack_frame_push(" frame ",value0);")))) + (unwind-exit (call-stack-loc nil loc))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; diff --git a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp index c9171e5dc..22839ad54 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-cont.lsp @@ -142,11 +142,7 @@ (defun c2unwind-protect (c1form form body) (declare (ignore c1form)) - (let* ((sp (make-lcl-var :rep-type :cl-index)) - (nargs (make-lcl-var :rep-type :cl-index)) - (*unwind-exit* `((STACK ,sp) ,@*unwind-exit*))) - (wt-nl-open-brace) - (wt-nl "cl_index " sp "=ECL_STACK_INDEX(cl_env_copy)," nargs ";") + (with-stack-frame (frame) ;; Here we compile the form which is protected. When this form is aborted, ;; it continues with unwinding=TRUE. We call ecl_frs_pop() manually because ;; we use C2EXPR* in the body. @@ -160,13 +156,12 @@ ;; Here we save the values of the form which might have been ;; aborted, and execute some cleanup code. This code may also ;; be aborted by some control structure, but is not protected. - (wt-nl nargs "=ecl_stack_push_values(cl_env_copy);") + (wt-nl "ecl_stack_frame_push_values(" frame ");") (let ((*destination* 'TRASH)) (c2expr* body)) - (wt-nl "ecl_stack_pop_values(cl_env_copy," nargs ");") + (wt-nl "ecl_stack_frame_pop_values(" frame ");") ;; Finally, if the protected form was aborted, jump to the ;; next catch point... (wt-nl "if (unwinding) ecl_unwind(cl_env_copy,next_fr);") ;; ... or simply return the values of the protected form. - (unwind-exit 'VALUEZ) - (wt-nl-close-brace))) + (unwind-exit 'VALUEZ))) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp index fe8e3aa13..8bae8f54c 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-eval.lsp @@ -144,19 +144,14 @@ (defun c2mv-prog1 (c1form form body) (declare (ignore c1form)) - (wt-nl-open-brace) - (wt-nl "struct ecl_stack_frame _ecl_inner_frame_aux;") - (wt-nl *volatile* "cl_object _ecl_inner_frame = ecl_stack_frame_open(cl_env_copy,(cl_object)&_ecl_inner_frame_aux,0);") - (let ((*unwind-exit* `((STACK "_ecl_inner_frame") ,@*unwind-exit*))) + (with-stack-frame (frame) (let ((*destination* 'VALUEZ)) (c2expr* form)) - (wt-nl "ecl_stack_frame_push_values(_ecl_inner_frame);") + (wt-nl "ecl_stack_frame_push_values(" frame ");") (let ((*destination* 'TRASH)) (mapc #'c2expr* body)) - (wt-nl "ecl_stack_frame_pop_values(_ecl_inner_frame);")) - (wt-nl "ecl_stack_frame_close(_ecl_inner_frame);") - (wt-nl-close-brace) - (unwind-exit 'VALUEZ)) + (wt-nl "ecl_stack_frame_pop_values(" frame ");") + (unwind-exit 'VALUEZ))) (defun c2values (c1form forms) (declare (ignore c1form)) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp index 04945cee4..241f051af 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-exit.lsp @@ -65,7 +65,7 @@ ;;; UNWIND-EXIT TAGS PURPOSE ;;; ;;; FRAME -> ecl_frs_push() -;;; (STACK n) -> n elements pushed in stack +;;; (STACK frame) -> ecl_stack_frame_open(env, frame, initial_size) ;;; IHS -> ihs push ;;; IHS-ENV -> ihs push ;;; BDS-BIND -> binding of 1 special variable @@ -79,9 +79,7 @@ (when (plusp frs-bind) (wt-nl "ecl_frs_pop_n(cl_env_copy, " frs-bind ");")) (when stack-frame - (if (stringp stack-frame) - (wt-nl "ecl_stack_frame_close(" stack-frame ");") - (wt-nl "ECL_STACK_SET_INDEX(cl_env_copy," stack-frame ");"))) + (wt-nl "ecl_stack_frame_close(" stack-frame ");")) (when bds-lcl (wt-nl "ecl_bds_unwind(cl_env_copy," bds-lcl ");")) (if (< bds-bind 4) diff --git a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp index 144636513..a19d60186 100644 --- a/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp +++ b/src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp @@ -93,16 +93,16 @@ (wt-nl return-type-name " output;")) (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") (wt-nl "cl_object aux;") - (wt-nl "ECL_BUILD_STACK_FRAME(cl_env_copy, frame, helper)") - (loop for n from 0 - and type in arg-types - and ct in arg-type-constants - do (wt-nl "ecl_stack_frame_push(" - "frame,ecl_foreign_data_ref_elt(" "&var" n "," ct ")" - ");")) - (wt-nl "aux = ecl_apply_from_stack_frame(frame," - "ecl_fdefinition(" c-name-constant "));") - (wt-nl "ecl_stack_frame_close(frame);") + (with-stack-frame (frame) + (loop for n from 0 + and type in arg-types + and ct in arg-type-constants + do (wt-nl "ecl_stack_frame_push(" frame "," + "ecl_foreign_data_ref_elt(" "&var" n "," 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 (wt-nl "ecl_foreign_data_set_elt(&output," return-type-code ",aux);") (wt-nl "return output;"))