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

Reuse code for long function calls

Browse source
This commit is contained in:
jjgarcia 2008-06-28 18:14:00 +00:00
parent 07e49ba844
commit 1813aa8e6c
2 changed files with 10 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

11
src/cmp/cmpcall.lsp
View file

@ -21,14 +21,17 @@
(or (cmp-env-search-macro name)
(macro-function name)))
(defun unoptimized-long-call (fun arguments)
(let ((frame (gensym)))
(c1expr `(with-stack ,frame
,@(loop for i in arguments collect `(stack-push ,i))
(si::apply-from-stack-frame ,frame ,fim)))))
(defun unoptimized-funcall (fun arguments)
(let ((l (length arguments)))
(if (<= l si::c-arguments-limit)
(make-c1form* 'FUNCALL :args (c1expr fun) (c1args* arguments))
(let ((frame (gensym)))
(c1expr `(with-stack ,frame
,@(loop for i in arguments collect `(stack-push ,i))
(si::apply-from-stack-frame ,frame ,fim)))))))
(unoptimized-long-call fun arguments))))
(defun c1funcall (args)
(check-args-number 'FUNCALL args 1)

14
src/cmp/cmpeval.lsp
View file

@ -71,13 +71,8 @@
(defun c1call-local (fname args)
(let ((fun (local-function-ref fname)))
(when fun
(let ((l (length args)))
(when (> l si::c-arguments-limit)
(return-from c1call-local
(let ((frame (gensym)))
(c1expr `(with-stack ,frame
,@(loop for i in args collect `(stack-push ,i))
(si::apply-from-stack-frame ,frame #',fname)))))))
(when (> (length args) si::c-arguments-limit)
(return-from c1call-local (unoptimized-long-call `#',fname args)))
(let* ((forms (c1args* args))
(lambda-form (fun-lambda fun))
(return-type (or (get-local-return-type fun) 'T))
@ -100,10 +95,7 @@
(let ((l (length args))
forms)
(cond ((> l si::c-arguments-limit)
(c1expr (let ((frame (gensym)))
`(with-stack ,frame
,@(loop for i in args collect `(stack-push ,frame ,i))
(si::apply-from-stack-frame ,frame #',fname)))))
(unoptimized-long-call `#',fname args))
((maybe-optimize-structure-access fname args))
#+clos
((maybe-optimize-generic-function fname args))