mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-18 07:12:26 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: abstract away STACK emitter with a macro

Browse source 
We also get rid of (STACK <int>) exit in favor of an explicit frame. This was
used only by UNWIND-PROTECT for no apparent reason.
This commit is contained in:
Daniel Kochmański 2023-11-19 15:24:41 +01:00
parent f72726a032
commit ef36cf53e0
6 changed files with 35 additions and 40 deletions
Download patch file Download diff file Expand all files Collapse all files

11
src/cmp/cmpbackend-cxx/cmpc-util.lsp
View file

@ -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))))

12
src/cmp/cmpbackend-cxx/cmppass2-call.lsp
View file

@ -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)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;

13
src/cmp/cmpbackend-cxx/cmppass2-cont.lsp
View file

@ -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)))

13
src/cmp/cmpbackend-cxx/cmppass2-eval.lsp
View file

@ -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))

6
src/cmp/cmpbackend-cxx/cmppass2-exit.lsp
View file

@ -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)

20
src/cmp/cmpbackend-cxx/cmppass2-ffi.lsp
View file

@ -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;"))