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

In the database of C1FORMs, store information about side effects and use the field C1FORM-SIDE-EFFECTS to speed up computation of those.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-11 16:04:28 +02:00
parent db84803241
commit 6c245096be
3 changed files with 40 additions and 44 deletions
Download patch file Download diff file Expand all files Collapse all files

6
src/cmp/cmpeval.lsp
View file

@ -86,7 +86,10 @@
(pop arg-types)
(pop args))))
(setq forms (nreverse fl))))
(make-c1form* 'CALL-LOCAL :sp-change t :type return-type
(make-c1form* 'CALL-LOCAL
:sp-change t ; conservative estimate
:side-effects t ; conservative estimate
:type return-type
:args fun forms)))))
(defun c1call-global (fname args)
@ -104,6 +107,7 @@
(return-type (propagate-types fname forms)))
(make-c1form* 'CALL-GLOBAL
:sp-change (function-may-change-sp fname)
:side-effects (function-may-have-side-effects fname)
:type return-type
:args fname forms
;; loc and type are filled by c2expr

65
src/cmp/cmpform.lsp
View file

@ -28,27 +28,27 @@
(defconstant +all-c1-forms+
'((LOCATION loc)
(VAR var)
(SETQ var value-c1form)
(PSETQ var-list value-c1form-list)
(SETQ var value-c1form :side-effects)
(PSETQ var-list value-c1form-list :side-effects)
(BLOCK blk-var progn-c1form)
(PROGN body)
(PROGV symbols values form)
(PROGV symbols values form :side-effects)
(TAGBODY tag-var tag-body)
(DECL-BODY declaration-list progn-c1form)
(RETURN-FROM blk-var return-type value)
(FUNCALL fun-value (arg-value*))
(CALL-LOCAL obj-fun (arg-value*))
(RETURN-FROM blk-var return-type value :side-effects)
(FUNCALL fun-value (arg-value*) :side-effects)
(CALL-LOCAL obj-fun (arg-value*) :side-effects)
(CALL-GLOBAL fun-name (arg-value*))
(CATCH catch-value body)
(UNWIND-PROTECT protected-c1form body)
(THROW catch-value output-value)
(GO tag-var return-type)
(CATCH catch-value body :side-effects)
(UNWIND-PROTECT protected-c1form body :side-effects)
(THROW catch-value output-value :side-effects)
(GO tag-var return-type :side-effects)
(C-INLINE (arg-c1form*)
(arg-type-symbol*)
output-rep-type
c-expression-string
side-effects-p
one-liner-p)
one-liner-p
:side-effects)
(LOCALS local-fun-list body labels-p)
(IF fmla-c1form true-c1form false-c1form)
(FMLA-NOT fmla-c1form)
@ -57,39 +57,37 @@
(LAMBDA lambda-list doc body-c1form)
(LET vars-list var-init-c1form-list decl-body-c1form)
(LET* vars-list var-init-c1form-list decl-body-c1form)
(FLET local-funs body-c1form let/labels)
(LABELS local-funs body-c1form let/labels)
(VALUES values-c1form-list)
(MULTIPLE-VALUE-SETQ vars-list values-c1form-list)
(MULTIPLE-VALUE-SETQ vars-list values-c1form-list :side-effects)
(MULTIPLE-VALUE-BIND vars-list init-c1form body)
(COMPILER-LET symbols values body)
(FUNCTION (GLOBAL/CLOSURE) lambda-form fun-object)
(C2PRINC object-string-or-char stream-var stream-c1form)
(RPLACA (dest-c1form value-c1form))
(RPLACD (dest-c1form value-c1form))
(C2PRINC object-string-or-char stream-var stream-c1form :side-effects)
(RPLACA (dest-c1form value-c1form) :side-effects)
(RPLACD (dest-c1form value-c1form) :side-effects)
(MEMBER!2 fun-symbol args-c1form-list)
(ASSOC!2 fun-symbol args-c1form-list)
(SI:STRUCTURE-REF struct-c1form type-name slot-index (:UNSAFE/NIL))
(SI:STRUCTURE-SET struct-c1form type-name slot-index value-c1form)
(SI:FSET fun-object fun-name macro-p pprint-p unoptimized-c1form)
(SI:STRUCTURE-SET struct-c1form type-name slot-index value-c1form :side-effects)
(WITH-STACK body)
(STACK-PUSH-VALUES value-c1form push-statement-c1form)
(WITH-STACK body :side-effects)
(STACK-PUSH-VALUES value-c1form push-statement-c1form :side-effects)
(ORDINARY c1form)
(LOAD-TIME-VALUE dest-loc value-c1form)
(FSET function-object vv-loc macro-p pprint-p lambda-form)
(MAKE-FORM vv-loc value-c1form)
(INIT-FORM vv-loc value-c1form))))
(SI:FSET function-object vv-loc macro-p pprint-p lambda-form
:side-effects)
(MAKE-FORM vv-loc value-c1form :side-effects)
(INIT-FORM vv-loc value-c1form :side-effects))))
(defconstant +c1-form-hash+
#.(loop with hash = (make-hash-table :size 128 :test #'eq)
for (name . rest) in +all-c1-forms+
for length = (if (member '* rest) nil (length rest))
for side-effects = (if (member :no-side-effects rest)
(progn (decf length) nil)
t)
for side-effects = (if (member :side-effects rest)
(progn (decf length) t)
nil)
do (setf (gethash name hash) (list length side-effects))
finally (return hash)))
@ -135,10 +133,13 @@
(labels ((add-info-loop (form dependents)
(loop for subform in dependents
when (c1form-p subform)
do (when (c1form-sp-change subform)
(setf (c1form-sp-change form) t
(c1form-side-effects form) t))
and do (setf (c1form-parent subform) form)
do (progn
(when (c1form-sp-change subform)
(setf (c1form-sp-change form) t
(c1form-side-effects form) t))
(when (c1form-side-effects subform)
(setf (c1form-side-effects form) t))
(setf (c1form-parent subform) form))
when (consp subform)
do (add-info-loop form subform))))
(let ((record (gethash (c1form-name form) +c1-form-hash+)))

13
src/cmp/cmpinline.lsp
View file

@ -306,21 +306,12 @@
(dotimes (i *inline-blocks*) (declare (fixnum i)) (wt #\})))
(defun form-causes-side-effect (form)
(case (c1form-name form)
((LOCATION VAR SYS:STRUCTURE-REF #+clos SYS:INSTANCE-REF)
nil)
(CALL-GLOBAL
(let ((fname (c1form-arg 0 form))
(args (c1form-arg 1 form)))
(or (function-may-have-side-effects fname)
(args-cause-side-effect args))))
(t t)))
(c1form-side-effects form))
(defun args-cause-side-effect (forms)
(some #'form-causes-side-effect forms))
(some #'c1form-side-effects forms))
(defun function-may-have-side-effects (fname)
(declare (si::c-local))
(not (get-sysprop fname 'no-side-effects)))
(defun function-may-change-sp (fname)