mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

Add 'comp-type-check-optim' pass

Browse source 
* lisp/emacs-lisp/comp.el (comp-passes): Add 'comp--type-check-optim'.
(comp--type-check-optim-block, comp--type-check-optim): New functions.
This commit is contained in:
Andrea Corallo 2023-05-23 11:18:07 +02:00 • committed by Andrea Corallo
parent 8538a281f5
commit a1775552ce
1 changed files with 66 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

66
lisp/emacs-lisp/comp.el
View file

@ -164,6 +164,7 @@ Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.")
comp--ipa-pure comp--ipa-pure
comp--add-cstrs comp--add-cstrs
comp--fwprop comp--fwprop
comp--type-check-optim
comp--tco comp--tco
comp--fwprop comp--fwprop
comp--remove-type-hints comp--remove-type-hints
@ -2812,6 +2813,71 @@ Return t if something was changed."
(comp--log-func comp-func 3)))) (comp--log-func comp-func 3))))
(comp-ctxt-funcs-h comp-ctxt))) (comp-ctxt-funcs-h comp-ctxt)))
;;; Type check optimizer pass specific code.
;; This pass optimize-out unnecessary type checks, that is calls to
;; `type-of' and corresponding conditional branches.
;;
;; This is often advantageous in cases where a function manipulates an
;; object with several slot accesses like:
;;
;; (cl-defstruct foo a b c)
;; (defun bar (x)
;; (setf (foo-a x) 3)
;; (+ (foo-b x) (foo-c x)))
;;
;; After x is accessed and type checked once, it's proved to be of type
;; foo, and no other type checks are required.
;; At present running this pass over the whole Emacs codebase triggers
;; the optimization of 1972 type checks.
(defun comp--type-check-optim-block (block)
"Optimize conditional branches in BLOCK when possible."
(cl-loop
named in-the-basic-block
for insns-seq on (comp-block-insns block)
do (pcase insns-seq
(`((set ,(and (pred comp-mvar-p) mvar-tested-copy)
,(and (pred comp-mvar-p) mvar-tested))
(set ,(and (pred comp-mvar-p) mvar-1)
(call type-of ,(and (pred comp-mvar-p) mvar-tested-copy)))
(set ,(and (pred comp-mvar-p) mvar-2)
(call symbol-value ,(and (pred comp-cstr-cl-tag-p) mvar-tag)))
(set ,(and (pred comp-mvar-p) mvar-3)
(call memq ,(and (pred comp-mvar-p) mvar-1) ,(and (pred comp-mvar-p) mvar-2)))
(cond-jump ,(and (pred comp-mvar-p) mvar-3) ,(pred comp-mvar-p) ,_bb1 ,bb2))
(cl-assert (comp-cstr-imm-vld-p mvar-tag))
(when (and (length= (comp-mvar-typeset mvar-tested) 1)
(member
(car (comp-mvar-typeset mvar-tested))
(symbol-value (comp-cstr-imm mvar-tag))))
(comp-log (format "Optimizing conditional branch in function: %s"
(comp-func-name comp-func))
3)
(setf (car insns-seq) '(comment "optimized by comp--type-check-optim")
(cdr insns-seq) `((jump ,bb2))
;; Set the SSA status as dirty so
;; `comp--ssa-function' will remove the unreachable
;; branches later.
(comp-func-ssa-status comp-func) 'dirty))))))
(defun comp--type-check-optim (_)
"Optimize conditional branches when possible."
(cl-loop
for f being each hash-value of (comp-ctxt-funcs-h comp-ctxt)
for comp-func = f
when (>= (comp-func-speed f) 2)
do (cl-loop
for b being each hash-value of (comp-func-blocks f)
do (comp--type-check-optim-block b)
finally
(progn
(when (eq (comp-func-ssa-status f) 'dirty)
(comp--ssa-function f))
(comp--log-func comp-func 3)))))
;;; Call optimizer pass specific code. ;;; Call optimizer pass specific code.
;; This pass is responsible for the following optimizations: ;; This pass is responsible for the following optimizations: