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

cmp: implement foreign data locations

Browse source 
Instead of directly opencoding them in t3-defcallback we take a more organized
approach where we work with locations. This is part of larger refactor.
This commit is contained in:
Daniel Kochmański 2023-11-20 21:51:48 +01:00
parent ef36cf53e0
commit ef4ab04eda
3 changed files with 22 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -72,6 +72,8 @@
(when (eql return-type :void)
(setf return-p nil))
(let ((return-type-name (rep-type->c-name (ffi::%convert-to-arg-type return-type)))
(vars (loop for n from 0 below (length arg-types)
collect (format nil "var~d" n)))
(fmod (case call-type
((:cdecl :default) "")
(:stdcall "__stdcall ")
@ -80,11 +82,11 @@
(wt-nl-h "static " return-type-name " " fmod c-name "(")
(wt-nl1 "static " return-type-name " " fmod c-name "(")
(loop with comma = ""
for n from 0
for var in vars
for type in arg-types
for arg-type-name = (rep-type->c-name (ffi::%convert-to-arg-type type))
do (wt-h comma arg-type-name " var" n)
(wt comma arg-type-name " var" n)
do (wt-h comma arg-type-name " " var)
(wt comma arg-type-name " " var)
(setf comma ","))
(wt ")")
(wt-h ");")
@ -94,16 +96,16 @@
(wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();")
(wt-nl "cl_object aux;")
(with-stack-frame (frame)
(loop for n from 0
(loop for var in vars
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 ")" ");"))
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
(wt-nl "ecl_foreign_data_set_elt(&output," return-type-code ",aux);")
(let ((*destination* `(ffi-data-ref "output" ,return-type-code)))
(set-loc "aux"))
(wt-nl "return output;"))
(wt-nl-close-brace)))

10
src/cmp/cmpbackend-cxx/cmppass2-loc.lsp
View file

@ -441,3 +441,13 @@
(when (loc-with-side-effects-p loc)
(wt-nl loc ";")
t))
;;;
;;; Foreign data
;;;
(defun wt-ffi-data-ref (data ffi-tag)
(wt "ecl_foreign_data_ref_elt(&" data "," ffi-tag ")"))
(defun wt-ffi-data-set (value data ffi-tag)
(wt "ecl_foreign_data_set_elt(&" data "," ffi-tag "," value ");"))

4
src/cmp/cmptables.lsp
View file

@ -161,7 +161,8 @@
(leave . set-leave-loc)
(trash . set-trash-loc)
(jump-true . set-trash-loc)
(jump-false . set-trash-loc)))
(jump-false . set-trash-loc)
(ffi-data-ref . wt-ffi-data-set)))
(defconstant +wt-loc-dispatch-alist+
'((call-normal . wt-call-normal)
@ -180,6 +181,7 @@
(make-cclosure . wt-make-closure)
(si:structure-ref . wt-structure-ref)
(ffi-data-ref . wt-ffi-data-ref)
(leave . "value0")
(va-arg . "va_arg(args,cl_object)")