X-Git-Url: http://git.chise.org/gitweb/?p=chise%2Fxemacs-chise.git.1;a=blobdiff_plain;f=lisp%2Fbyte-optimize.el;h=8ae9d2418659a4ec09ea3c1e8bd796688a6b3e61;hp=b18664b37400c5ca3a2df2267d8c088df7b48baa;hb=d498337390c3a567aae4fa0e1c1f06064a808d21;hpb=59eec5f21669e81977b5b1fe9bf717cab49cf7fb diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el index b18664b..8ae9d24 100644 --- a/lisp/byte-optimize.el +++ b/lisp/byte-optimize.el @@ -2,8 +2,9 @@ ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc. -;; Author: Jamie Zawinski -;; Hallvard Furuseth +;; Authors: Jamie Zawinski +;; Hallvard Furuseth +;; Martin Buchholz ;; Keywords: internal ;; This file is part of XEmacs. @@ -23,7 +24,11 @@ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 20.7 except where marked. +;;; [[ Synched up with: FSF 20.7. ]] +;;; DO NOT PUT IN AN INVALID SYNC MESSAGE WHEN YOU DO A PARTIAL SYNC. --ben + +;; BEGIN SYNC WITH 20.7. ;;; Commentary: @@ -177,13 +182,13 @@ ;;(disassemble #'(lambda (x) (eq (if (point) 'a 'b) 'c))) ;;(disassemble #'(lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c)))) -;; (car (cons A B)) -> (progn B A) +;; (car (cons A B)) -> (prog1 A B) ;;(disassemble #'(lambda (x) (car (cons (foo) 42)))) ;; (cdr (cons A B)) -> (progn A B) ;;(disassemble #'(lambda (x) (cdr (cons 42 (foo))))) -;; (car (list A B ...)) -> (progn B ... A) +;; (car (list A B ...)) -> (prog1 A ... B) ;;(disassemble #'(lambda (x) (car (list (foo) 42 (bar))))) ;; (cdr (list A B ...)) -> (progn A (list B ...)) @@ -291,8 +296,10 @@ (compiled-function-constants fn) (compiled-function-stack-depth fn))) (cdr form))) - (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name)) - (cons fn (cdr form))))))) + (if (eq (car-safe fn) 'lambda) + (cons fn (cdr form)) + ;; Give up on inlining. + form)))))) ;;; ((lambda ...) ...) ;;; @@ -350,6 +357,9 @@ (byte-compile-warn "attempt to open-code %s with too many arguments" name)) form) + ;; This line, introduced in v1.10, can cause an infinite + ;; recursion when inlining recursive defsubst's +; (setq body (mapcar 'byte-optimize-form body)) (let ((newform (if bindings (cons 'let (cons (nreverse bindings) body)) @@ -472,12 +482,12 @@ (if (and (cdr form) (null backwards)) (byte-compile-log " all subforms of %s called for effect; deleted" form)) - (and backwards - ;; Now optimize the rest of the forms. We need the return - ;; values. We already did the car. - (setcdr backwards - (mapcar 'byte-optimize-form (cdr backwards))) - (cons fn (nreverse backwards)))) + (when backwards + ;; Now optimize the rest of the forms. We need the return + ;; values. We already did the car. + (setcdr backwards + (mapcar 'byte-optimize-form (cdr backwards)))) + (cons fn (nreverse backwards))) (cons fn (mapcar 'byte-optimize-form (cdr form))))) ((eq fn 'interactive) @@ -519,6 +529,14 @@ byte-compile-macro-environment)))) (byte-optimize-form form for-effect)) + ;; Support compiler macros as in cl.el. + ((and (fboundp 'compiler-macroexpand) + (symbolp (car-safe form)) + (get (car-safe form) 'cl-compiler-macro) + (not (eq form + (setq form (compiler-macroexpand form))))) + (byte-optimize-form form for-effect)) + ((not (symbolp fn)) (or (eq 'mocklisp (car-safe fn)) ; ha! (byte-compile-warn "%s is a malformed function" @@ -699,124 +717,72 @@ (list (apply fun (nreverse constants))))))))) form)) -(defun byte-optimize-plus (form) - (setq form (byte-optimize-delay-constants-math form 1 '+)) - (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) - ;;(setq form (byte-optimize-associative-two-args-math form)) - - (case (length (cdr form)) - ((0) ; (+) - (condition-case () - (eval form) - (error form))) - - ;; It is not safe to delete the function entirely - ;; (actually, it would be safe if we knew the sole arg - ;; is not a marker). - ;; ((1) - ;; (nth 1 form)) - - ((2) ; (+ x y) - (byte-optimize-predicate - (cond - ;; `add1' and `sub1' are a marginally fewer instructions - ;; than `plus' and `minus', so use them when possible. - ((eq (nth 1 form) 1) `(1+ ,(nth 2 form))) ; (+ 1 x) --> (1+ x) - ((eq (nth 2 form) 1) `(1+ ,(nth 1 form))) ; (+ x 1) --> (1+ x) - ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x) --> (1- x) - ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1) --> (1- x) - (t form)))) +;; END SYNC WITH 20.7. - (t (byte-optimize-predicate form)))) +;;; It is not safe to optimize calls to arithmetic ops with one arg +;;; away entirely (actually, it would be safe if we know the sole arg +;;; is not a marker or if it appears in other arithmetic). -(defun byte-optimize-minus (form) - ;; Put constants at the end, except the last constant. - (setq form (byte-optimize-delay-constants-math form 2 '+)) - ;; Now only first and last element can be an integer. - (let ((last (last (nthcdr 3 form)))) - (cond ((eq 0 last) - ;; (- x y ... 0) --> (- x y ...) - (setq form (copy-sequence form)) - (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form)))) - ;; If form is (- CONST foo... CONST), merge first and last. - ((and (numberp (nth 1 form)) - (numberp last)) - (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form)) - (delq last (copy-sequence (nthcdr 3 form)))))))) - - (case (length (cdr form)) - ((0) ; (-) - (condition-case () - (eval form) - (error form))) - - ;; It is not safe to delete the function entirely - ;; (actually, it would be safe if we knew the sole arg - ;; is not a marker). - ;; ((1) - ;; (nth 1 form) - - ((2) ; (+ x y) - (byte-optimize-predicate - (cond - ;; `add1' and `sub1' are a marginally fewer instructions than `plus' - ;; and `minus', so use them when possible. - ((eq (nth 2 form) 1) `(1- ,(nth 1 form))) ; (- x 1) --> (1- x) - ((eq (nth 2 form) -1) `(1+ ,(nth 1 form))) ; (- x -1) --> (1+ x) - ((eq (nth 1 form) 0) `(- ,(nth 2 form))) ; (- 0 x) --> (- x) - (t form)))) +;;; But this degree of paranoia is normally unjustified, so optimize unless +;;; the user has done (declaim (optimize (safety 3))). See bytecomp.el. - (t (byte-optimize-predicate form)))) +(defun byte-optimize-plus (form) + (byte-optimize-predicate (byte-optimize-delay-constants-math form 1 '+))) (defun byte-optimize-multiply (form) (setq form (byte-optimize-delay-constants-math form 1 '*)) ;; If there is a constant integer in FORM, it is now the last element. - (cond ((null (cdr form)) 1) -;;; It is not safe to delete the function entirely -;;; (actually, it would be safe if we know the sole arg -;;; is not a marker or if it appears in other arithmetic). -;;; ((null (cdr (cdr form))) (nth 1 form)) - ((let ((last (last form))) - (byte-optimize-predicate - (cond ((eq 0 last) (cons 'progn (cdr form))) - ((eq 1 last) (delq 1 (copy-sequence form))) - ((eq -1 last) (list '- (delq -1 (copy-sequence form)))) - ((and (eq 2 last) - (memq t (mapcar 'symbolp (cdr form)))) - (prog1 (setq form (delq 2 (copy-sequence form))) - (while (not (symbolp (car (setq form (cdr form)))))) - (setcar form (list '+ (car form) (car form))))) - (form))))))) + + (case (car (last form)) + ;; (* x y 0) --> (progn x y 0) + (0 (cons 'progn (cdr form))) + (t (byte-optimize-predicate form)))) + +(defun byte-optimize-minus (form) + ;; Put constants at the end, except the first arg. + (setq form (byte-optimize-delay-constants-math form 2 '+)) + ;; Now only the first and last args can be integers. + (let ((last (car (last (nthcdr 3 form))))) + (cond + ;; If form is (- CONST foo... CONST), merge first and last. + ((and (numberp (nth 1 form)) (numberp last)) + (decf (nth 1 form) last) + (butlast form)) + + ;; (- 0 ...) --> + ((eq 0 (nth 1 form)) + (case (length form) + ;; (- 0) --> 0 + (2 0) + ;; (- 0 x) --> (- x) + (3 `(- ,(nth 2 form))) + ;; (- 0 x y ...) --> (- (- x) y ...) + (t `(- (- ,(nth 2 form)) ,@(nthcdr 3 form))))) + + (t (byte-optimize-predicate form))))) (defun byte-optimize-divide (form) + ;; Put constants at the end, except the first arg. (setq form (byte-optimize-delay-constants-math form 2 '*)) - ;; If there is a constant integer in FORM, it is now the last element. - (let ((last (last (cdr (cdr form))))) - (if (numberp last) - (cond ((= (length form) 3) - (if (and (numberp (nth 1 form)) - (not (zerop last)) - (condition-case nil - (/ (nth 1 form) last) - (error nil))) - (setq form (list 'progn (/ (nth 1 form) last))))) - ((= last 1) - (setq form (butlast form))) - ((numberp (nth 1 form)) - (setq form (cons (car form) - (cons (/ (nth 1 form) last) - (butlast (cdr (cdr form))))) - last nil)))) + ;; Now only the first and last args can be integers. + (let ((last (car (last (nthcdr 3 form))))) (cond -;;; ((null (cdr (cdr form))) -;;; (nth 1 form)) + ;; If form is (/ CONST foo... CONST), merge first and last. + ((and (numberp (nth 1 form)) (numberp last)) + (condition-case nil + (cons (nth 0 form) + (cons (/ (nth 1 form) last) + (butlast (cdr (cdr form))))) + (error form))) + + ;; (/ 0 x y) --> (progn x y 0) ((eq (nth 1 form) 0) (append '(progn) (cdr (cdr form)) '(0))) - ((eq last -1) - (list '- (if (nthcdr 3 form) - (butlast form) - (nth 1 form)))) - (form)))) + + ;; We don't have to check for divide-by-zero because `/' does. + (t (byte-optimize-predicate form))))) + +;; BEGIN SYNC WITH 20.7. (defun byte-optimize-logmumble (form) (setq form (byte-optimize-delay-constants-math form 1 (car form))) @@ -848,9 +814,11 @@ (setq ok (byte-compile-constp (car rest)) rest (cdr rest))) (if ok - (condition-case () + (condition-case err (list 'quote (eval form)) - (error form)) + (error + (byte-compile-warn "evaluating %s: %s" form err) + form)) form))) (defun byte-optimize-identity (form) @@ -861,22 +829,61 @@ (if (= 1 (length (cdr form))) "" "s")) form)) +(defun byte-optimize-car (form) + (let ((arg (cadr form))) + (cond + ((and (byte-compile-trueconstp arg) + (not (and (consp arg) + (eq (car arg) 'quote) + (listp (cadr arg))))) + (byte-compile-warn + "taking car of a constant: %s" arg) + form) + ((and (eq (car-safe arg) 'cons) + (eq (length arg) 3)) + `(prog1 ,(nth 1 arg) ,(nth 2 arg))) + ((eq (car-safe arg) 'list) + `(prog1 ,@(cdr arg))) + (t + (byte-optimize-predicate form))))) + +(defun byte-optimize-cdr (form) + (let ((arg (cadr form))) + (cond + ((and (byte-compile-trueconstp arg) + (not (and (consp arg) + (eq (car arg) 'quote) + (listp (cadr arg))))) + (byte-compile-warn + "taking cdr of a constant: %s" arg) + form) + ((and (eq (car-safe arg) 'cons) + (eq (length arg) 3)) + `(progn ,(nth 1 arg) ,(nth 2 arg))) + ((eq (car-safe arg) 'list) + (if (> (length arg) 2) + `(progn ,(cadr arg) (list ,@(cddr arg))) + (cadr arg))) + (t + (byte-optimize-predicate form))))) + (put 'identity 'byte-optimizer 'byte-optimize-identity) (put '+ 'byte-optimizer 'byte-optimize-plus) (put '* 'byte-optimizer 'byte-optimize-multiply) (put '- 'byte-optimizer 'byte-optimize-minus) (put '/ 'byte-optimizer 'byte-optimize-divide) +(put '% 'byte-optimizer 'byte-optimize-predicate) (put 'max 'byte-optimizer 'byte-optimize-associative-math) (put 'min 'byte-optimizer 'byte-optimize-associative-math) -(put '= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eq 'byte-optimizer 'byte-optimize-binary-predicate) (put 'eql 'byte-optimizer 'byte-optimize-binary-predicate) (put 'equal 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate) (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate) +(put '= 'byte-optimizer 'byte-optimize-predicate) (put '< 'byte-optimizer 'byte-optimize-predicate) (put '> 'byte-optimizer 'byte-optimize-predicate) (put '<= 'byte-optimizer 'byte-optimize-predicate) @@ -899,8 +906,8 @@ (put 'logxor 'byte-optimizer 'byte-optimize-logmumble) (put 'lognot 'byte-optimizer 'byte-optimize-predicate) -(put 'car 'byte-optimizer 'byte-optimize-predicate) -(put 'cdr 'byte-optimizer 'byte-optimize-predicate) +(put 'car 'byte-optimizer 'byte-optimize-car) +(put 'cdr 'byte-optimizer 'byte-optimize-cdr) (put 'car-safe 'byte-optimizer 'byte-optimize-predicate) (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate) @@ -960,41 +967,27 @@ (byte-optimize-predicate form) (nth 1 form)))) +;; END SYNC WITH 20.7. + +;;; For the byte optimizer, `cond' is just overly sweet syntactic sugar. +;;; So we rewrite (cond ...) in terms of `if' and `or', +;;; which are easier to optimize. (defun byte-optimize-cond (form) - ;; if any clauses have a literal nil as their test, throw them away. - ;; if any clause has a literal non-nil constant as its test, throw - ;; away all following clauses. - (let (rest) - ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...) - (while (setq rest (assq nil (cdr form))) - (setq form (delq rest (copy-sequence form)))) - (if (memq nil (cdr form)) - (setq form (delq nil (copy-sequence form)))) - (setq rest form) - (while (setq rest (cdr rest)) - (cond ((byte-compile-trueconstp (car-safe (car rest))) - (cond ((eq rest (cdr form)) - (setq form - (if (cdr (car rest)) - (if (cdr (cdr (car rest))) - (cons 'progn (cdr (car rest))) - (nth 1 (car rest))) - (car (car rest))))) - ((cdr rest) - (setq form (copy-sequence form)) - (setcdr (memq (car rest) form) nil))) - (setq rest nil))))) - ;; - ;; Turn (cond (( )) ... ) into (or (cond ... )) - (if (eq 'cond (car-safe form)) - (let ((clauses (cdr form))) - (if (and (consp (car clauses)) - (null (cdr (car clauses)))) - (list 'or (car (car clauses)) - (byte-optimize-cond - (cons (car form) (cdr (cdr form))))) - form)) - form)) + (byte-optimize-cond-1 (cdr form))) + +(defun byte-optimize-cond-1 (clauses) + (cond + ((null clauses) nil) + ((consp (car clauses)) + (nconc + (case (length (car clauses)) + (1 `(or ,(nth 0 (car clauses)))) + (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses)))) + (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses)))))) + (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses)))))) + (t (error "malformed cond clause %s" (car clauses))))) + +;; BEGIN SYNC WITH 20.7. (defun byte-optimize-if (form) ;; (if ) ==> @@ -1036,18 +1029,72 @@ (put 'if 'byte-optimizer 'byte-optimize-if) (put 'while 'byte-optimizer 'byte-optimize-while) -;; Remove any reason for avoiding `char-before'. -(defun byte-optimize-char-before (form) - `(char-after (1- ,(or (nth 1 form) '(point))) ,@(cdr (cdr form)))) +;; The supply of bytecodes is small and constrained by backward compatibility. +;; Several functions have byte-coded versions and hence are very efficient. +;; Related functions which can be expressed in terms of the byte-coded +;; ones should be transformed into bytecoded calls for efficiency. +;; This is especially the case for functions with a backward- and +;; forward- version, but with a bytecode only for the forward one. + +;; Some programmers have hand-optimized calls like (backward-char) +;; into the call (forward-char -1). +;; But it's so much nicer for the byte-compiler to do this automatically! -(put 'char-before 'byte-optimizer 'byte-optimize-char-before) +;; (char-before) ==> (char-after (1- (point))) +(put 'char-before 'byte-optimizer 'byte-optimize-char-before) +(defun byte-optimize-char-before (form) + `(char-after + ,(cond + ((null (nth 1 form)) + '(1- (point))) + ((equal '(point) (nth 1 form)) + '(1- (point))) + (t `(1- (or ,(nth 1 form) (point))))) + ,@(cdr (cdr form)))) + +;; (backward-char n) ==> (forward-char (- n)) +(put 'backward-char 'byte-optimizer 'byte-optimize-backward-char) +(defun byte-optimize-backward-char (form) + `(forward-char + ,(typecase (nth 1 form) + (null -1) + (integer (- (nth 1 form))) + (t `(- (or ,(nth 1 form) 1)))) + ,@(cdr (cdr form)))) + +;; (backward-word n) ==> (forward-word (- n)) +(put 'backward-word 'byte-optimizer 'byte-optimize-backward-word) +(defun byte-optimize-backward-word (form) + `(forward-word + ,(typecase (nth 1 form) + (null -1) + (integer (- (nth 1 form))) + (t `(- (or ,(nth 1 form) 1)))) + ,@(cdr (cdr form)))) + +;; The following would be a valid optimization of the above kind, but +;; the gain in performance is very small, since the saved funcall is +;; counterbalanced by the necessity of adding a bytecode for (point). +;; +;; Also, users are more likely to have modified the behavior of +;; delete-char via advice or some similar mechanism. This is much +;; less of a problem for the previous functions because it wouldn't +;; make sense to modify the behaviour of `backward-char' without also +;; modifying `forward-char', for example. + +;; (delete-char n) ==> (delete-region (point) (+ (point) n)) +;; (put 'delete-char 'byte-optimizer 'byte-optimize-delete-char) +;; (defun byte-optimize-delete-char (form) +;; (case (length (cdr form)) +;; (0 `(delete-region (point) (1+ (point)))) +;; (1 `(delete-region (point) (+ (point) ,(nth 1 form)))) +;; (t form))) ;; byte-compile-negation-optimizer lives in bytecomp.el ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer) (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer) (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer) - (defun byte-optimize-funcall (form) ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...) ;; (funcall 'foo ...) ==> (foo ...) @@ -1111,6 +1158,18 @@ (while (>= (setq count (1- count)) 0) (setq form (list 'cdr form))) form))) + +(put 'concat 'byte-optimizer 'byte-optimize-concat) +(defun byte-optimize-concat (form) + (let ((args (cdr form)) + (constant t)) + (while (and args constant) + (or (byte-compile-constp (car args)) + (setq constant nil)) + (setq args (cdr args))) + (if constant + (eval form) + form))) ;;; enumerating those functions which need not be called if the returned ;;; value is not used. That is, something like @@ -1181,8 +1240,7 @@ hash-table-p identity ignore integerp integer-or-marker-p interactive-p invocation-directory invocation-name - ;; keymapp may autoload in XEmacs, so not on this list! - list listp + keymapp list listp make-marker mark mark-marker markerp memory-limit minibuffer-window ;; mouse-movement-p not in XEmacs natnump nlistp not null number-or-marker-p numberp @@ -1206,7 +1264,7 @@ (defun byte-compile-splice-in-already-compiled-code (form) ;; form is (byte-code "..." [...] n) - (if (not (memq byte-optimize '(t lap))) + (if (not (memq byte-optimize '(t byte))) (byte-compile-normal-call form) (byte-inline-lapcode (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)) @@ -1323,7 +1381,9 @@ tags))))))) ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t) ((memq op byte-constref-ops))) - (setq tmp (aref constvec offset) + (setq tmp (if (>= offset (length constvec)) + (list 'out-of-range offset) + (aref constvec offset)) offset (if (eq op 'byte-constant) (byte-compile-get-constant tmp) (or (assq tmp byte-compile-variables) @@ -1372,11 +1432,14 @@ (defconst byte-after-unbind-ops '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp - byte-eq byte-equal byte-not + byte-eq byte-not byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4 byte-interactive-p) ;; How about other side-effect-free-ops? Is it safe to move an ;; error invocation (such as from nth) out of an unwind-protect? + ;; No, it is not, because the unwind-protect forms can alter + ;; the inside of the object to which nth would apply. + ;; For the same reason, byte-equal was deleted from this list. "Byte-codes that can be moved past an unbind.") (defconst byte-compile-side-effect-and-error-free-ops @@ -1432,33 +1495,7 @@ ;;; variables. ;(defconst byte-boolean-vars -; '(abbrev-all-caps purify-flag find-file-compare-truenames -; find-file-use-truenames delete-auto-save-files byte-metering-on -; x-seppuku-on-epipe zmacs-regions zmacs-region-active-p -; zmacs-region-stays atomic-extent-goto-char-p -; suppress-early-error-handler-backtrace noninteractive -; inhibit-early-packages inhibit-autoloads debug-paths -; inhibit-site-lisp debug-on-quit debug-on-next-call -; modifier-keys-are-sticky x-allow-sendevents -; mswindows-dynamic-frame-resize focus-follows-mouse -; inhibit-input-event-recording enable-multibyte-characters -; disable-auto-save-when-buffer-shrinks -; allow-deletion-of-last-visible-frame indent-tabs-mode -; load-in-progress load-warn-when-source-newer -; load-warn-when-source-only load-ignore-elc-files -; load-force-doc-strings fail-on-bucky-bit-character-escapes -; popup-menu-titles menubar-show-keybindings completion-ignore-case -; canna-empty-info canna-through-info canna-underline -; canna-inhibit-hankakukana enable-multibyte-characters -; re-short-flag x-handle-non-fully-specified-fonts -; print-escape-newlines print-readably delete-exited-processes -; windowed-process-io visible-bell no-redraw-on-reenter -; cursor-in-echo-area inhibit-warning-display -; column-number-start-at-one parse-sexp-ignore-comments -; words-include-escapes scroll-on-clipped-lines) -; "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t. -;If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer -;may generate incorrect code.") +; ...) (defun byte-optimize-lapcode (lap &optional for-effect) "Simple peephole optimizer. LAP is both modified and returned." @@ -1919,14 +1956,16 @@ (while rest (setq lap0 (car rest) lap1 (nth 1 rest)) - (case (car lap0) - ((byte-varref byte-varset byte-varbind) - (incf (gethash (cdr lap0) variable-frequency 0)) - (unless (memq (cdr lap0) byte-compile-variables) - (push (cdr lap0) byte-compile-variables))) - ((byte-constant) - (unless (memq (cdr lap0) byte-compile-constants) - (push (cdr lap0) byte-compile-constants)))) + (if (memq (car lap0) byte-constref-ops) + (if (not (eq (car lap0) 'byte-constant)) + (progn + (incf (gethash (cdr lap0) variable-frequency 0)) + (or (memq (cdr lap0) byte-compile-variables) + (setq byte-compile-variables + (cons (cdr lap0) byte-compile-variables)))) + (or (memq (cdr lap0) byte-compile-constants) + (setq byte-compile-constants (cons (cdr lap0) + byte-compile-constants))))) (cond (;; ;; const-C varset-X const-C --> const-C dup varset-X ;; const-C varbind-X const-C --> const-C dup varbind-X @@ -2012,4 +2051,6 @@ byte-optimize-lapcode)))) nil) +;; END SYNC WITH 20.7. + ;;; byte-optimize.el ends here