mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-15 15:21:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: codegen: add an instruction declare-c-fun

Browse source
This commit is contained in:
Daniel Kochmański 2023-12-04 20:20:07 +01:00
parent 6d28b5144e
commit 4c7645f923
2 changed files with 28 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -255,23 +255,7 @@
(defun call-exported-function-loc (fname args fun-c-name minarg maxarg in-core type)
(unless in-core
;; We only write declarations for functions which are not in lisp_external.h
(multiple-value-bind (val declared)
(gethash fun-c-name *compiler-declared-globals*)
(declare (ignore val))
(unless declared
(if (= maxarg minarg)
(progn
(wt-nl-h "extern cl_object " fun-c-name "(")
(dotimes (i maxarg)
(when (> i 0) (wt-h1 ","))
(wt-h1 "cl_object"))
(wt-h1 ");"))
(progn
(wt-nl-h "extern cl_object " fun-c-name "(cl_narg")
(dotimes (i (min minarg si:c-arguments-limit))
(wt-h1 ",cl_object"))
(wt-h1 ",...);")))
(setf (gethash fun-c-name *compiler-declared-globals*) 1))))
(push-instruction :declare-c-fun fun-c-name minarg maxarg))
(let ((fun (make-fun :name fname :global t :cfun fun-c-name :lambda 'NIL
:minarg minarg :maxarg maxarg)))
(call-loc fname fun args type)))

27
src/cmp/cmppass3-codegen.lsp
View file

@ -8,6 +8,9 @@
(,instruction instruction))
,@body))
;;; Data
(define-codegen (:cxx :move) (instruction)
(destructuring-bind (into from) (instruction-inputs instruction)
(set-loc into from)))
@ -40,6 +43,30 @@
(destructuring-bind (frame) (instruction-inputs instruction)
(wt-nl "ecl_stack_frame_pop_values(" frame ");")))
;;; Functions
(define-codegen (:cxx :declare-c-fun) (instruction)
(destructuring-bind (fun-c-name minarg maxarg)
(instruction-inputs instruction)
(multiple-value-bind (val declared)
(gethash fun-c-name *compiler-declared-globals*)
(declare (ignore val))
(unless declared
(if (= maxarg minarg)
(progn
(wt-nl-h "extern cl_object " fun-c-name "(")
(dotimes (i maxarg)
(when (> i 0) (wt-h1 ","))
(wt-h1 "cl_object"))
(wt-h1 ");"))
(progn
(wt-nl-h "extern cl_object " fun-c-name "(cl_narg")
(dotimes (i (min minarg si:c-arguments-limit))
(wt-h1 ",cl_object"))
(wt-h1 ",...);")))
(setf (gethash fun-c-name *compiler-declared-globals*) 1)))))
;;; Unwinding