From 85a2eb2c789e7f9c1afa838817b3e9ebecb49da4 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Fri, 10 Feb 2023 14:38:26 +0100 Subject: [PATCH] LAP peephole optimiser improvementsa MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Make the improvements: - Add the rule stack-ref(X) discardN-preserve-tos(Y) --> discard(Y) stack-ref(X-Y), X≥Y discard(X) discardN-preserve-tos(Y-X-1), X OP return where OP is a unary operation such as `not` or `car`. - Generalise a previous rule to NOEFFECT PRODUCER return --> PRODUCER return where PRODUCER is now any op that pushes a value without looking at the stack: const, varref, point etc. --- lisp/emacs-lisp/byte-opt.el | 101 ++++++++++++++++++++++++++++++++++-- 1 file changed, 97 insertions(+), 4 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 3eef8f385b5..833e88887f9 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2415,11 +2415,18 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq keep-going t)) ;; - ;; OP const return --> const return - ;; where OP is side-effect-free (or mere stack manipulation). + ;; NOEFFECT PRODUCER return --> PRODUCER return + ;; where NOEFFECT lacks effects beyond stack change, + ;; PRODUCER pushes a result without looking at the stack: + ;; const, varref, point etc. ;; - ((and (eq (car lap1) 'byte-constant) - (eq (car (nth 2 rest)) 'byte-return) + ((and (eq (car (nth 2 rest)) 'byte-return) + (memq (car lap1) '( byte-constant byte-varref + byte-point byte-point-max byte-point-min + byte-following-char byte-preceding-char + byte-current-column + byte-eolp byte-eobp byte-bolp byte-bobp + byte-current-buffer byte-widen)) (or (memq (car lap0) '( byte-discard byte-discardN byte-discardN-preserve-tos byte-stack-set)) @@ -2430,6 +2437,35 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (byte-compile-log-lap " %s %s %s\t-->\t%s %s" lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) + ;; + ;; discardN-preserve-tos OP return --> OP return + ;; dup OP return --> OP return + ;; where OP is 1->1 in stack use, like `not'. + ;; + ;; FIXME: ideally we should run this backwards, so that we could do + ;; discardN-preserve-tos OP1...OPn return -> OP1..OPn return + ;; but that would require a different approach. + ;; + ((and (eq (car (nth 2 rest)) 'byte-return) + (memq (car lap1) + '( byte-not + byte-symbolp byte-consp byte-stringp + byte-listp byte-integerp byte-numberp + byte-list1 + byte-car byte-cdr byte-car-safe byte-cdr-safe + byte-length + byte-add1 byte-sub1 byte-negate byte-nreverse + ;; There are more of these but the list is + ;; getting long and the gain is small. + )) + (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup)) + (and (eq (car lap0) 'byte-stack-set) + (eql (cdr lap0) 1)))) + (setq keep-going t) + (setcdr prev (cdr rest)) ; eat lap0 + (byte-compile-log-lap " %s %s %s\t-->\t%s %s" + lap0 lap1 (nth 2 rest) lap1 (nth 2 rest))) + ;; ;; goto-*-else-pop X ... X: goto-if-* --> whatever ;; goto-*-else-pop X ... X: discard --> whatever @@ -2659,6 +2695,63 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setcdr prev (cdr rest)) (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 lap1)) + ;; + ;; stack-ref(X) discardN-preserve-tos(Y) + ;; --> discard(Y) stack-ref(X-Y), X≥Y + ;; discard(X) discardN-preserve-tos(Y-X-1), X y 0)) + (cond + ((>= x y) ; --> discard(Y) stack-ref(X-Y) + (let ((new0 (if (= y 1) + (cons 'byte-discard nil) + (cons 'byte-discardN y))) + (new1 (if (= x y) + (cons 'byte-dup nil) + (cons 'byte-stack-ref (- x y))))) + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 new0 new1) + (setcar rest new0) + (setcar (cdr rest) new1))) + ((= x 0) ; --> discardN-preserve-tos(Y-1) + (setcdr prev (cdr rest)) ; eat lap0 + (if (> y 1) + (let ((new (cons 'byte-discardN-preserve-tos (- y 1)))) + (byte-compile-log-lap " %s %s\t-->\t%s" + lap0 lap1 new) + (setcar (cdr prev) new)) + (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) + (setcdr prev (cddr prev)))) ; eat lap1 + ((= y (+ x 1)) ; --> discard(X) + (setcdr prev (cdr rest)) ; eat lap0 + (let ((new (if (= x 1) + (cons 'byte-discard nil) + (cons 'byte-discardN x)))) + (byte-compile-log-lap " %s %s\t-->\t%s" lap0 lap1 new) + (setcar (cdr prev) new))) + (t ; --> discard(X) discardN-preserve-tos(Y-X-1) + (let ((new0 (if (= x 1) + (cons 'byte-discard nil) + (cons 'byte-discardN x))) + (new1 (cons 'byte-discardN-preserve-tos (- y x 1)))) + (byte-compile-log-lap " %s %s\t-->\t%s %s" + lap0 lap1 new0 new1) + (setcar rest new0) + (setcar (cdr rest) new1))))) + (setq keep-going t)) + ;; ;; goto-X ... X: discard ==> discard goto-Y ... X: discard Y: ;; -- 2.39.2