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

When inlining, set the environment to that of the inlined form, to properly capture things like speed / safety optimizations.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-14 16:08:03 +02:00
parent 744818d8e9
commit 0389fe11be
3 changed files with 43 additions and 37 deletions
Download patch file Download diff file Expand all files Collapse all files

23
src/cmp/cmpeval.lsp
View file

@ -115,20 +115,15 @@
))))))
(defun c2expr (form)
(let* ((*compile-file-truename* (c1form-file form))
(*compile-file-position* (c1form-file-position form))
(*current-toplevel-form* (c1form-toplevel-form form))
(*current-form* (c1form-form form))
(*current-c2form* form)
(*cmp-env* (c1form-env form))
(name (c1form-name form))
(args (c1form-args form))
(dispatch (get-sysprop name 'C2)))
(if (or (eq name 'LET) (eq name 'LET*))
(let ((*volatile* (c1form-volatile* form)))
(declare (special *volatile*))
(apply dispatch args))
(apply dispatch args))))
(with-c1form-env (form form)
(let* ((name (c1form-name form))
(args (c1form-args form))
(dispatch (get-sysprop name 'C2)))
(if (or (eq name 'LET) (eq name 'LET*))
(let ((*volatile* (c1form-volatile* form)))
(declare (special *volatile*))
(apply dispatch args))
(apply dispatch args)))))
(defun c2expr* (form)
(let* ((*exit* (next-label))

9
src/cmp/cmpform.lsp
View file

@ -256,3 +256,12 @@
(or (fourth (gethash (c1form-name form) +c1-form-hash+))
(<= (nth-value 1 (c1form-values-number form)) 1)))
(defmacro with-c1form-env ((form value) &rest body)
`(let* ((,form ,value)
(*compile-file-truename* (c1form-file ,form))
(*compile-file-position* (c1form-file-position ,form))
(*current-toplevel-form* (c1form-toplevel-form ,form))
(*current-form* (c1form-form ,form))
(*current-c2form* ,form)
(*cmp-env* (c1form-env ,form)))
,@body))

48
src/cmp/cmpinline.lsp
View file

@ -63,7 +63,8 @@
(let* ((fname (c1form-arg 0 form))
(args (c1form-arg 1 form))
(return-type (c1form-primary-type form))
(loc (call-global-loc fname nil args return-type expected-type))
(fun (find fname *global-funs* :key #'fun-name :test #'same-fname-p))
(loc (call-global-loc fname fun args return-type expected-type))
(type (loc-type loc))
(temp (make-inline-temp-var expected-type type
(loc-representation-type loc)))
@ -115,28 +116,29 @@
#+nil (c1form-arg 2 form))))))
(defun emit-inline-form (form expected-type forms)
(case (c1form-name form)
(LOCATION
(list (c1form-primary-type form) (c1form-arg 0 form)))
(VAR
(emit-inlined-variable form expected-type forms))
(CALL-GLOBAL
(emit-inlined-call-global form expected-type))
(SYS:STRUCTURE-REF
(emit-inlined-structure-ref form expected-type forms))
#+clos
(SYS:INSTANCE-REF
(emit-inlined-instance-ref form expected-type forms))
(SETQ
(emit-inlined-setq form expected-type forms))
(PROGN
(emit-inlined-progn form expected-type forms))
(VALUES
(emit-inlined-values form expected-type forms))
(t (let* ((type (c1form-primary-type form))
(temp (make-inline-temp-var expected-type type)))
(let ((*destination* temp)) (c2expr* form))
(list type temp)))))
(with-c1form-env (form form)
(case (c1form-name form)
(LOCATION
(list (c1form-primary-type form) (c1form-arg 0 form)))
(VAR
(emit-inlined-variable form expected-type forms))
(CALL-GLOBAL
(emit-inlined-call-global form expected-type))
(SYS:STRUCTURE-REF
(emit-inlined-structure-ref form expected-type forms))
#+clos
(SYS:INSTANCE-REF
(emit-inlined-instance-ref form expected-type forms))
(SETQ
(emit-inlined-setq form expected-type forms))
(PROGN
(emit-inlined-progn form expected-type forms))
(VALUES
(emit-inlined-values form expected-type forms))
(t (let* ((type (c1form-primary-type form))
(temp (make-inline-temp-var expected-type type)))
(let ((*destination* temp)) (c2expr* form))
(list type temp))))))
;;;
;;; inline-args: