Verified Commit 8d384458 authored by Vladimir Sedach's avatar Vladimir Sedach
Browse files

Optimize out clearing MV register for procedures that do not call other procedures

parent 762c048d
......@@ -289,6 +289,7 @@ form, FORM, returns the new value for *compilation-level*."
((eq :toplevel level) :inside-toplevel-form)))
(defvar compile-expression?)
(defvar clear-multiple-values? t)
(define-condition compile-expression-error (error)
((form :initarg :form :reader error-form))
......@@ -333,11 +334,13 @@ form, FORM, returns the new value for *compilation-level*."
(adjust-compilation-level form *compilation-level*)))
(if (special-form? form)
(compile-special-form form)
`(ps-js:funcall
,(if (symbolp (car form))
(maybe-rename-local-function (car form))
(compile-expression (car form)))
,@(mapcar #'compile-expression (cdr form))))))))))
(progn
(setq clear-multiple-values? t)
`(ps-js:funcall
,(if (symbolp (car form))
(maybe-rename-local-function (car form))
(compile-expression (car form)))
,@(mapcar #'compile-expression (cdr form)))))))))))
(defun compile-statement (form)
(let ((compile-expression? nil))
......
......@@ -164,6 +164,7 @@ of (declare ...) forms, and the remaining body."
(*vars-needing-to-be-declared* ())
(*used-up-names* ())
(returning-values? nil)
(clear-multiple-values? nil)
(*enclosing-function-arguments*
(append args *enclosing-function-arguments*))
(*enclosing-lexicals*
......
......@@ -229,14 +229,16 @@
((eql tag *current-block-tag*)
(compile-statement
`(progn
,@(unless returning-values? '((setf __PS_MV_REG '())))
,@(when (and (not returning-values?) clear-multiple-values?)
'((setf __PS_MV_REG '())))
,@(when value? (list value))
(break ,tag))))
((assoc tag *dynamic-return-tags*)
(setf (cdr it) t)
(ps-compile
`(progn
,@(unless returning-values? '((setf __PS_MV_REG '())))
,@(when (and (not returning-values?) clear-multiple-values?)
'((setf __PS_MV_REG '())))
(throw (create
:__ps_block_tag ',tag
:__ps_values (multiple-value-list ,value))))))
......@@ -245,11 +247,11 @@
(member tag *function-block-names*))
(warn "Returning from unknown block ~A" tag))
(let ((X (when value? (list (compile-expression value)))))
(if returning-values?
`(ps-js:return ,@X)
(if (and (not returning-values?) clear-multiple-values?)
`(ps-js:block
(ps-js:= __PS_MV_REG [])
(ps-js:return ,@X)))))))
(ps-js:return ,@X))
`(ps-js:return ,@X))))))
(defun try-expressionizing-if? (exp &optional (score 0)) ;; poor man's codewalker
"Heuristic that tries not to expressionize deeply nested if expressions."
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment