LCOV - code coverage report
Current view: top level - lisp/emacs-lisp - byte-opt.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 314 1066 29.5 %
Date: 2017-08-27 09:44:50 Functions: 18 49 36.7 %

          Line data    Source code
       1             : ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
       2             : 
       3             : ;; Copyright (C) 1991, 1994, 2000-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Jamie Zawinski <jwz@lucid.com>
       6             : ;;      Hallvard Furuseth <hbf@ulrik.uio.no>
       7             : ;; Maintainer: emacs-devel@gnu.org
       8             : ;; Keywords: internal
       9             : ;; Package: emacs
      10             : 
      11             : ;; This file is part of GNU Emacs.
      12             : 
      13             : ;; GNU Emacs is free software: you can redistribute it and/or modify
      14             : ;; it under the terms of the GNU General Public License as published by
      15             : ;; the Free Software Foundation, either version 3 of the License, or
      16             : ;; (at your option) any later version.
      17             : 
      18             : ;; GNU Emacs is distributed in the hope that it will be useful,
      19             : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
      20             : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      21             : ;; GNU General Public License for more details.
      22             : 
      23             : ;; You should have received a copy of the GNU General Public License
      24             : ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
      25             : 
      26             : ;;; Commentary:
      27             : 
      28             : ;; ========================================================================
      29             : ;; "No matter how hard you try, you can't make a racehorse out of a pig.
      30             : ;; You can, however, make a faster pig."
      31             : ;;
      32             : ;; Or, to put it another way, the Emacs byte compiler is a VW Bug.  This code
      33             : ;; makes it be a VW Bug with fuel injection and a turbocharger...  You're
      34             : ;; still not going to make it go faster than 70 mph, but it might be easier
      35             : ;; to get it there.
      36             : ;;
      37             : 
      38             : ;; TO DO:
      39             : ;;
      40             : ;; (apply (lambda (x &rest y) ...) 1 (foo))
      41             : ;;
      42             : ;; maintain a list of functions known not to access any global variables
      43             : ;; (actually, give them a 'dynamically-safe property) and then
      44             : ;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
      45             : ;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
      46             : ;; by recursing on this, we might be able to eliminate the entire let.
      47             : ;; However certain variables should never have their bindings optimized
      48             : ;; away, because they affect everything.
      49             : ;;   (put 'debug-on-error 'binding-is-magic t)
      50             : ;;   (put 'debug-on-abort 'binding-is-magic t)
      51             : ;;   (put 'debug-on-next-call 'binding-is-magic t)
      52             : ;;   (put 'inhibit-quit 'binding-is-magic t)
      53             : ;;   (put 'quit-flag 'binding-is-magic t)
      54             : ;;   (put 't 'binding-is-magic t)
      55             : ;;   (put 'nil 'binding-is-magic t)
      56             : ;; possibly also
      57             : ;;   (put 'gc-cons-threshold 'binding-is-magic t)
      58             : ;;   (put 'track-mouse 'binding-is-magic t)
      59             : ;; others?
      60             : ;;
      61             : ;; Simple defsubsts often produce forms like
      62             : ;;    (let ((v1 (f1)) (v2 (f2)) ...)
      63             : ;;       (FN v1 v2 ...))
      64             : ;; It would be nice if we could optimize this to
      65             : ;;    (FN (f1) (f2) ...)
      66             : ;; but we can't unless FN is dynamically-safe (it might be dynamically
      67             : ;; referring to the bindings that the lambda arglist established.)
      68             : ;; One of the uncountable lossages introduced by dynamic scope...
      69             : ;;
      70             : ;; Maybe there should be a control-structure that says "turn on
      71             : ;; fast-and-loose type-assumptive optimizations here."  Then when
      72             : ;; we see a form like (car foo) we can from then on assume that
      73             : ;; the variable foo is of type cons, and optimize based on that.
      74             : ;; But, this won't win much because of (you guessed it) dynamic
      75             : ;; scope.  Anything down the stack could change the value.
      76             : ;; (Another reason it doesn't work is that it is perfectly valid
      77             : ;; to call car with a null argument.)  A better approach might
      78             : ;; be to allow type-specification of the form
      79             : ;;   (put 'foo 'arg-types '(float (list integer) dynamic))
      80             : ;;   (put 'foo 'result-type 'bool)
      81             : ;; It should be possible to have these types checked to a certain
      82             : ;; degree.
      83             : ;;
      84             : ;; collapse common subexpressions
      85             : ;;
      86             : ;; It would be nice if redundant sequences could be factored out as well,
      87             : ;; when they are known to have no side-effects:
      88             : ;;   (list (+ a b c) (+ a b c))   -->  a b add c add dup list-2
      89             : ;; but beware of traps like
      90             : ;;   (cons (list x y) (list x y))
      91             : ;;
      92             : ;; Tail-recursion elimination is not really possible in Emacs Lisp.
      93             : ;; Tail-recursion elimination is almost always impossible when all variables
      94             : ;; have dynamic scope, but given that the "return" byteop requires the
      95             : ;; binding stack to be empty (rather than emptying it itself), there can be
      96             : ;; no truly tail-recursive Emacs Lisp functions that take any arguments or
      97             : ;; make any bindings.
      98             : ;;
      99             : ;; Here is an example of an Emacs Lisp function which could safely be
     100             : ;; byte-compiled tail-recursively:
     101             : ;;
     102             : ;;  (defun tail-map (fn list)
     103             : ;;    (cond (list
     104             : ;;           (funcall fn (car list))
     105             : ;;           (tail-map fn (cdr list)))))
     106             : ;;
     107             : ;; However, if there was even a single let-binding around the COND,
     108             : ;; it could not be byte-compiled, because there would be an "unbind"
     109             : ;; byte-op between the final "call" and "return."  Adding a
     110             : ;; Bunbind_all byteop would fix this.
     111             : ;;
     112             : ;;   (defun foo (x y z) ... (foo a b c))
     113             : ;;   ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
     114             : ;;   ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
     115             : ;;   ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
     116             : ;;
     117             : ;; this also can be considered tail recursion:
     118             : ;;
     119             : ;;   ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
     120             : ;; could generalize this by doing the optimization
     121             : ;;   (goto X) ... X: (return)  -->  (return)
     122             : ;;
     123             : ;; But this doesn't solve all of the problems: although by doing tail-
     124             : ;; recursion elimination in this way, the call-stack does not grow, the
     125             : ;; binding-stack would grow with each recursive step, and would eventually
     126             : ;; overflow.  I don't believe there is any way around this without lexical
     127             : ;; scope.
     128             : ;;
     129             : ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
     130             : ;;
     131             : ;; Idea: the form (lexical-scope) in a file means that the file may be
     132             : ;; compiled lexically.  This proclamation is file-local.  Then, within
     133             : ;; that file, "let" would establish lexical bindings, and "let-dynamic"
     134             : ;; would do things the old way.  (Or we could use CL "declare" forms.)
     135             : ;; We'd have to notice defvars and defconsts, since those variables should
     136             : ;; always be dynamic, and attempting to do a lexical binding of them
     137             : ;; should simply do a dynamic binding instead.
     138             : ;; But!  We need to know about variables that were not necessarily defvared
     139             : ;; in the file being compiled (doing a boundp check isn't good enough.)
     140             : ;; Fdefvar() would have to be modified to add something to the plist.
     141             : ;;
     142             : ;; A major disadvantage of this scheme is that the interpreter and compiler
     143             : ;; would have different semantics for files compiled with (dynamic-scope).
     144             : ;; Since this would be a file-local optimization, there would be no way to
     145             : ;; modify the interpreter to obey this (unless the loader was hacked
     146             : ;; in some grody way, but that's a really bad idea.)
     147             : 
     148             : ;; Other things to consider:
     149             : 
     150             : ;; ;; Associative math should recognize subcalls to identical function:
     151             : ;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
     152             : ;; ;; This should generate the same as (1+ x) and (1- x)
     153             : 
     154             : ;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
     155             : ;; ;; An awful lot of functions always return a non-nil value.  If they're
     156             : ;; ;; error free also they may act as true-constants.
     157             : 
     158             : ;; (disassemble (lambda (x) (and (point) (foo))))
     159             : ;; ;; When
     160             : ;; ;;   - all but one arguments to a function are constant
     161             : ;; ;;   - the non-constant argument is an if-expression (cond-expression?)
     162             : ;; ;; then the outer function can be distributed.  If the guarding
     163             : ;; ;; condition is side-effect-free [assignment-free] then the other
     164             : ;; ;; arguments may be any expressions.  Since, however, the code size
     165             : ;; ;; can increase this way they should be "simple".  Compare:
     166             : 
     167             : ;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
     168             : ;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
     169             : 
     170             : ;; ;; (car (cons A B)) -> (prog1 A B)
     171             : ;; (disassemble (lambda (x) (car (cons (foo) 42))))
     172             : 
     173             : ;; ;; (cdr (cons A B)) -> (progn A B)
     174             : ;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
     175             : 
     176             : ;; ;; (car (list A B ...)) -> (prog1 A B ...)
     177             : ;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
     178             : 
     179             : ;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
     180             : ;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
     181             : 
     182             : 
     183             : ;;; Code:
     184             : 
     185             : (require 'bytecomp)
     186             : (eval-when-compile (require 'cl-lib))
     187             : (require 'macroexp)
     188             : (eval-when-compile (require 'subr-x))
     189             : 
     190             : (defun byte-compile-log-lap-1 (format &rest args)
     191             :   ;; Newer byte codes for stack-ref make the slot 0 non-nil again.
     192             :   ;; But the "old disassembler" is *really* ancient by now.
     193             :   ;; (if (aref byte-code-vector 0)
     194             :   ;;     (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
     195           0 :   (byte-compile-log-1
     196           0 :    (apply #'format-message format
     197           0 :      (let (c a)
     198           0 :        (mapcar (lambda (arg)
     199           0 :                   (if (not (consp arg))
     200           0 :                       (if (and (symbolp arg)
     201           0 :                                (string-match "^byte-" (symbol-name arg)))
     202           0 :                           (intern (substring (symbol-name arg) 5))
     203           0 :                         arg)
     204           0 :                     (if (integerp (setq c (car arg)))
     205           0 :                         (error "non-symbolic byte-op %s" c))
     206           0 :                     (if (eq c 'TAG)
     207           0 :                         (setq c arg)
     208           0 :                       (setq a (cond ((memq c byte-goto-ops)
     209           0 :                                      (car (cdr (cdr arg))))
     210           0 :                                     ((memq c byte-constref-ops)
     211           0 :                                      (car (cdr arg)))
     212           0 :                                     (t (cdr arg))))
     213           0 :                       (setq c (symbol-name c))
     214           0 :                       (if (string-match "^byte-." c)
     215           0 :                           (setq c (intern (substring c 5)))))
     216           0 :                     (if (eq c 'constant) (setq c 'const))
     217           0 :                     (if (and (eq (cdr arg) 0)
     218           0 :                              (not (memq c '(unbind call const))))
     219           0 :                         c
     220           0 :                       (format "(%s %s)" c a))))
     221           0 :                args)))))
     222             : 
     223             : (defmacro byte-compile-log-lap (format-string &rest args)
     224          30 :   `(and (memq byte-optimize-log '(t byte))
     225          30 :         (byte-compile-log-lap-1 ,format-string ,@args)))
     226             : 
     227             : 
     228             : ;;; byte-compile optimizers to support inlining
     229             : 
     230             : (put 'inline 'byte-optimizer 'byte-optimize-inline-handler)
     231             : 
     232             : (defun byte-optimize-inline-handler (form)
     233             :   "byte-optimize-handler for the `inline' special-form."
     234           0 :   (cons 'progn
     235           0 :         (mapcar
     236             :          (lambda (sexp)
     237           0 :            (let ((f (car-safe sexp)))
     238           0 :              (if (and (symbolp f)
     239           0 :                       (or (cdr (assq f byte-compile-function-environment))
     240           0 :                           (not (or (not (fboundp f))
     241           0 :                                    (cdr (assq f byte-compile-macro-environment))
     242           0 :                                    (and (consp (setq f (symbol-function f)))
     243           0 :                                         (eq (car f) 'macro))
     244           0 :                                    (subrp f)))))
     245           0 :                  (byte-compile-inline-expand sexp)
     246           0 :                sexp)))
     247           0 :          (cdr form))))
     248             : 
     249             : (defun byte-compile-inline-expand (form)
     250          14 :   (let* ((name (car form))
     251          14 :          (localfn (cdr (assq name byte-compile-function-environment)))
     252          14 :          (fn (or localfn (symbol-function name))))
     253          14 :     (when (autoloadp fn)
     254           0 :       (autoload-do-load fn)
     255           0 :       (setq fn (or (symbol-function name)
     256          14 :                    (cdr (assq name byte-compile-function-environment)))))
     257          14 :     (pcase fn
     258             :       (`nil
     259           0 :        (byte-compile-warn "attempt to inline `%s' before it was defined"
     260           0 :                           name)
     261           0 :        form)
     262             :       (`(autoload . ,_)
     263           0 :        (error "File `%s' didn't define `%s'" (nth 1 fn) name))
     264           0 :       ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias.
     265           0 :        (byte-compile-inline-expand (cons fn (cdr form))))
     266             :       ((pred byte-code-function-p)
     267             :        ;; (message "Inlining byte-code for %S!" name)
     268             :        ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
     269           0 :        `(,fn ,@(cdr form)))
     270             :       ((or `(lambda . ,_) `(closure . ,_))
     271           0 :        (if (not (or (eq fn localfn)     ;From the same file => same mode.
     272           0 :                     (eq (car fn)        ;Same mode.
     273           0 :                         (if lexical-binding 'closure 'lambda))))
     274             :            ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
     275             :            ;; letbind byte-code (or any other combination for that matter), we
     276             :            ;; can only inline dynbind source into dynbind source or letbind
     277             :            ;; source into letbind source.
     278           0 :            (progn
     279             :              ;; We can of course byte-compile the inlined function
     280             :              ;; first, and then inline its byte-code.
     281           0 :              (byte-compile name)
     282           0 :              `(,(symbol-function name) ,@(cdr form)))
     283           0 :          (let ((newfn (if (eq fn localfn)
     284             :                           ;; If `fn' is from the same file, it has already
     285             :                           ;; been preprocessed!
     286           0 :                           `(function ,fn)
     287           0 :                         (byte-compile-preprocess
     288           0 :                          (byte-compile--reify-function fn)))))
     289           0 :            (if (eq (car-safe newfn) 'function)
     290           0 :                (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
     291             :              ;; This can happen because of macroexp-warn-and-return &co.
     292           0 :              (byte-compile-warn
     293           0 :               "Inlining closure %S failed" name)
     294           0 :              form))))
     295             : 
     296             :       (_ ;; Give up on inlining.
     297          14 :        form))))
     298             : 
     299             : ;; ((lambda ...) ...)
     300             : (defun byte-compile-unfold-lambda (form &optional name)
     301             :   ;; In lexical-binding mode, let and functions don't bind vars in the same way
     302             :   ;; (let obey special-variable-p, but functions don't).  But luckily, this
     303             :   ;; doesn't matter here, because function's behavior is underspecified so it
     304             :   ;; can safely be turned into a `let', even though the reverse is not true.
     305           0 :   (or name (setq name "anonymous lambda"))
     306           0 :   (let* ((lambda (car form))
     307           0 :          (values (cdr form))
     308           0 :          (arglist (nth 1 lambda))
     309           0 :          (body (cdr (cdr lambda)))
     310             :          optionalp restp
     311             :          bindings)
     312           0 :     (if (and (stringp (car body)) (cdr body))
     313           0 :         (setq body (cdr body)))
     314           0 :     (if (and (consp (car body)) (eq 'interactive (car (car body))))
     315           0 :         (setq body (cdr body)))
     316             :     ;; FIXME: The checks below do not belong in an optimization phase.
     317           0 :     (while arglist
     318           0 :       (cond ((eq (car arglist) '&optional)
     319             :              ;; ok, I'll let this slide because funcall_lambda() does...
     320             :              ;; (if optionalp (error "multiple &optional keywords in %s" name))
     321           0 :              (if restp (error "&optional found after &rest in %s" name))
     322           0 :              (if (null (cdr arglist))
     323           0 :                  (error "nothing after &optional in %s" name))
     324           0 :              (setq optionalp t))
     325           0 :             ((eq (car arglist) '&rest)
     326             :              ;; ...but it is by no stretch of the imagination a reasonable
     327             :              ;; thing that funcall_lambda() allows (&rest x y) and
     328             :              ;; (&rest x &optional y) in arglists.
     329           0 :              (if (null (cdr arglist))
     330           0 :                  (error "nothing after &rest in %s" name))
     331           0 :              (if (cdr (cdr arglist))
     332           0 :                  (error "multiple vars after &rest in %s" name))
     333           0 :              (setq restp t))
     334           0 :             (restp
     335           0 :              (setq bindings (cons (list (car arglist)
     336           0 :                                         (and values (cons 'list values)))
     337           0 :                                   bindings)
     338           0 :                    values nil))
     339           0 :             ((and (not optionalp) (null values))
     340           0 :              (byte-compile-warn "attempt to open-code `%s' with too few arguments" name)
     341           0 :              (setq arglist nil values 'too-few))
     342             :             (t
     343           0 :              (setq bindings (cons (list (car arglist) (car values))
     344           0 :                                   bindings)
     345           0 :                    values (cdr values))))
     346           0 :       (setq arglist (cdr arglist)))
     347           0 :     (if values
     348           0 :         (progn
     349           0 :           (or (eq values 'too-few)
     350           0 :               (byte-compile-warn
     351           0 :                "attempt to open-code `%s' with too many arguments" name))
     352           0 :           form)
     353             : 
     354             :                                         ;; The following leads to infinite recursion when loading a
     355             :                                         ;; file containing `(defsubst f () (f))', and then trying to
     356             :                                         ;; byte-compile that file.
     357             :                        ;(setq body (mapcar 'byte-optimize-form body)))
     358             : 
     359           0 :       (let ((newform
     360           0 :              (if bindings
     361           0 :                  (cons 'let (cons (nreverse bindings) body))
     362           0 :                (cons 'progn body))))
     363           0 :         (byte-compile-log "  %s\t==>\t%s" form newform)
     364           0 :         newform))))
     365             : 
     366             : 
     367             : ;;; implementing source-level optimizers
     368             : 
     369             : (defun byte-optimize-form-code-walker (form for-effect)
     370             :   ;;
     371             :   ;; For normal function calls, We can just mapcar the optimizer the cdr.  But
     372             :   ;; we need to have special knowledge of the syntax of the special forms
     373             :   ;; like let and defun (that's why they're special forms :-).  (Actually,
     374             :   ;; the important aspect is that they are subrs that don't evaluate all of
     375             :   ;; their args.)
     376             :   ;;
     377         603 :   (let ((fn (car-safe form))
     378             :         tmp)
     379         603 :     (cond ((not (consp form))
     380         249 :            (if (not (and for-effect
     381           0 :                          (or byte-compile-delete-errors
     382           0 :                              (not (symbolp form))
     383         249 :                              (eq form t))))
     384         249 :              form))
     385         354 :           ((eq fn 'quote)
     386          55 :            (if (cdr (cdr form))
     387           0 :                (byte-compile-warn "malformed quote form: `%s'"
     388          55 :                                   (prin1-to-string form)))
     389             :            ;; map (quote nil) to nil to simplify optimizer logic.
     390             :            ;; map quoted constants to nil if for-effect (just because).
     391          55 :            (and (nth 1 form)
     392          55 :                 (not for-effect)
     393          55 :                 form))
     394         299 :           ((eq (car-safe fn) 'lambda)
     395           0 :            (let ((newform (byte-compile-unfold-lambda form)))
     396           0 :              (if (eq newform form)
     397             :                  ;; Some error occurred, avoid infinite recursion
     398           0 :                  form
     399           0 :                (byte-optimize-form-code-walker newform for-effect))))
     400         299 :           ((eq (car-safe fn) 'closure) form)
     401         299 :           ((memq fn '(let let*))
     402             :            ;; recursively enter the optimizer for the bindings and body
     403             :            ;; of a let or let*.  This for depth-firstness: forms that
     404             :            ;; are more deeply nested are optimized first.
     405          30 :            (cons fn
     406          30 :              (cons
     407          30 :               (mapcar (lambda (binding)
     408          35 :                          (if (symbolp binding)
     409           0 :                              binding
     410          35 :                            (if (cdr (cdr binding))
     411           0 :                                (byte-compile-warn "malformed let binding: `%s'"
     412          35 :                                                   (prin1-to-string binding)))
     413          35 :                            (list (car binding)
     414          35 :                                  (byte-optimize-form (nth 1 binding) nil))))
     415          30 :                       (nth 1 form))
     416          30 :               (byte-optimize-body (cdr (cdr form)) for-effect))))
     417         269 :           ((eq fn 'cond)
     418           0 :            (cons fn
     419           0 :                  (mapcar (lambda (clause)
     420           0 :                             (if (consp clause)
     421           0 :                                 (cons
     422           0 :                                  (byte-optimize-form (car clause) nil)
     423           0 :                                  (byte-optimize-body (cdr clause) for-effect))
     424           0 :                               (byte-compile-warn "malformed cond form: `%s'"
     425           0 :                                                  (prin1-to-string clause))
     426           0 :                               clause))
     427           0 :                          (cdr form))))
     428         269 :           ((eq fn 'progn)
     429             :            ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
     430          25 :            (if (cdr (cdr form))
     431          10 :                (macroexp-progn (byte-optimize-body (cdr form) for-effect))
     432          25 :              (byte-optimize-form (nth 1 form) for-effect)))
     433         244 :           ((eq fn 'prog1)
     434           0 :            (if (cdr (cdr form))
     435           0 :                (cons 'prog1
     436           0 :                      (cons (byte-optimize-form (nth 1 form) for-effect)
     437           0 :                            (byte-optimize-body (cdr (cdr form)) t)))
     438           0 :              (byte-optimize-form (nth 1 form) for-effect)))
     439         244 :           ((eq fn 'prog2)
     440           0 :            (cons 'prog2
     441           0 :              (cons (byte-optimize-form (nth 1 form) t)
     442           0 :                (cons (byte-optimize-form (nth 2 form) for-effect)
     443           0 :                      (byte-optimize-body (cdr (cdr (cdr form))) t)))))
     444             : 
     445         244 :           ((memq fn '(save-excursion save-restriction save-current-buffer))
     446             :            ;; those subrs which have an implicit progn; it's not quite good
     447             :            ;; enough to treat these like normal function calls.
     448             :            ;; This can turn (save-excursion ...) into (save-excursion) which
     449             :            ;; will be optimized away in the lap-optimize pass.
     450           0 :            (cons fn (byte-optimize-body (cdr form) for-effect)))
     451             : 
     452         244 :           ((eq fn 'with-output-to-temp-buffer)
     453             :            ;; this is just like the above, except for the first argument.
     454           0 :            (cons fn
     455           0 :              (cons
     456           0 :               (byte-optimize-form (nth 1 form) nil)
     457           0 :               (byte-optimize-body (cdr (cdr form)) for-effect))))
     458             : 
     459         244 :           ((eq fn 'if)
     460          30 :            (when (< (length form) 3)
     461          30 :              (byte-compile-warn "too few arguments for `if'"))
     462          30 :            (cons fn
     463          30 :              (cons (byte-optimize-form (nth 1 form) nil)
     464          30 :                (cons
     465          30 :                 (byte-optimize-form (nth 2 form) for-effect)
     466          30 :                 (byte-optimize-body (nthcdr 3 form) for-effect)))))
     467             : 
     468         214 :           ((memq fn '(and or))  ; Remember, and/or are control structures.
     469             :            ;; Take forms off the back until we can't any more.
     470             :            ;; In the future it could conceivably be a problem that the
     471             :            ;; subexpressions of these forms are optimized in the reverse
     472             :            ;; order, but it's ok for now.
     473          24 :            (if for-effect
     474           0 :                (let ((backwards (reverse (cdr form))))
     475           0 :                  (while (and backwards
     476           0 :                              (null (setcar backwards
     477           0 :                                            (byte-optimize-form (car backwards)
     478           0 :                                                                for-effect))))
     479           0 :                    (setq backwards (cdr backwards)))
     480           0 :                  (if (and (cdr form) (null backwards))
     481           0 :                      (byte-compile-log
     482           0 :                       "  all subforms of %s called for effect; deleted" form))
     483           0 :                  (and backwards
     484           0 :                       (cons fn (nreverse (mapcar 'byte-optimize-form
     485           0 :                                                  backwards)))))
     486          24 :              (cons fn (mapcar 'byte-optimize-form (cdr form)))))
     487             : 
     488         190 :           ((eq fn 'interactive)
     489           0 :            (byte-compile-warn "misplaced interactive spec: `%s'"
     490           0 :                               (prin1-to-string form))
     491             :            nil)
     492             : 
     493         190 :           ((eq fn 'function)
     494             :            ;; This forms is compiled as constant or by breaking out
     495             :            ;; all the subexpressions and compiling them separately.
     496          10 :            form)
     497             : 
     498         180 :           ((eq fn 'condition-case)
     499           0 :            (if byte-compile--use-old-handlers
     500             :                ;; Will be optimized later.
     501           0 :                form
     502           0 :              `(condition-case ,(nth 1 form) ;Not evaluated.
     503           0 :                   ,(byte-optimize-form (nth 2 form) for-effect)
     504           0 :                 ,@(mapcar (lambda (clause)
     505           0 :                             `(,(car clause)
     506           0 :                               ,@(byte-optimize-body (cdr clause) for-effect)))
     507           0 :                           (nthcdr 3 form)))))
     508             : 
     509         180 :           ((eq fn 'unwind-protect)
     510             :            ;; the "protected" part of an unwind-protect is compiled (and thus
     511             :            ;; optimized) as a top-level form, so don't do it here.  But the
     512             :            ;; non-protected part has the same for-effect status as the
     513             :            ;; unwind-protect itself.  (The protected part is always for effect,
     514             :            ;; but that isn't handled properly yet.)
     515           0 :            (cons fn
     516           0 :                  (cons (byte-optimize-form (nth 1 form) for-effect)
     517           0 :                        (cdr (cdr form)))))
     518             : 
     519         180 :           ((eq fn 'catch)
     520           0 :            (cons fn
     521           0 :                  (cons (byte-optimize-form (nth 1 form) nil)
     522           0 :                        (if byte-compile--use-old-handlers
     523             :                            ;; The body of a catch is compiled (and thus
     524             :                            ;; optimized) as a top-level form, so don't do it
     525             :                            ;; here.
     526           0 :                            (cdr (cdr form))
     527           0 :                          (byte-optimize-body (cdr form) for-effect)))))
     528             : 
     529         180 :           ((eq fn 'ignore)
     530             :            ;; Don't treat the args to `ignore' as being
     531             :            ;; computed for effect.  We want to avoid the warnings
     532             :            ;; that might occur if they were treated that way.
     533             :            ;; However, don't actually bother calling `ignore'.
     534           0 :            `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form))))
     535             : 
     536             :           ;; Needed as long as we run byte-optimize-form after cconv.
     537         180 :           ((eq fn 'internal-make-closure) form)
     538             : 
     539         175 :           ((byte-code-function-p fn)
     540           0 :            (cons fn (mapcar #'byte-optimize-form (cdr form))))
     541             : 
     542         175 :           ((not (symbolp fn))
     543           0 :            (byte-compile-warn "`%s' is a malformed function"
     544           0 :                               (prin1-to-string fn))
     545           0 :            form)
     546             : 
     547         175 :           ((and for-effect (setq tmp (get fn 'side-effect-free))
     548           0 :                 (or byte-compile-delete-errors
     549           0 :                     (eq tmp 'error-free)
     550           0 :                     (progn
     551           0 :                       (byte-compile-warn "value returned from %s is unused"
     552           0 :                                          (prin1-to-string form))
     553         175 :                       nil)))
     554           0 :            (byte-compile-log "  %s called for effect; deleted" fn)
     555             :            ;; appending a nil here might not be necessary, but it can't hurt.
     556           0 :            (byte-optimize-form
     557           0 :             (cons 'progn (append (cdr form) '(nil))) t))
     558             : 
     559             :           (t
     560             :            ;; Otherwise, no args can be considered to be for-effect,
     561             :            ;; even if the called function is for-effect, because we
     562             :            ;; don't know anything about that function.
     563         175 :            (let ((args (mapcar #'byte-optimize-form (cdr form))))
     564         175 :              (if (and (get fn 'pure)
     565         175 :                       (byte-optimize-all-constp args))
     566           0 :                    (list 'quote (apply fn (mapcar #'eval args)))
     567         603 :                (cons fn args)))))))
     568             : 
     569             : (defun byte-optimize-all-constp (list)
     570             :   "Non-nil if all elements of LIST satisfy `macroexp-const-p'."
     571           0 :   (let ((constant t))
     572           0 :     (while (and list constant)
     573           0 :       (unless (macroexp-const-p (car list))
     574           0 :         (setq constant nil))
     575           0 :       (setq list (cdr list)))
     576           0 :     constant))
     577             : 
     578             : (defun byte-optimize-form (form &optional for-effect)
     579             :   "The source-level pass of the optimizer."
     580             :   ;;
     581             :   ;; First, optimize all sub-forms of this one.
     582         603 :   (setq form (byte-optimize-form-code-walker form for-effect))
     583             :   ;;
     584             :   ;; after optimizing all subforms, optimize this form until it doesn't
     585             :   ;; optimize any further.  This means that some forms will be passed through
     586             :   ;; the optimizer many times, but that's necessary to make the for-effect
     587             :   ;; processing do as much as possible.
     588             :   ;;
     589         603 :   (let (opt new)
     590         603 :     (if (and (consp form)
     591         354 :              (symbolp (car form))
     592         354 :              (or ;; (and for-effect
     593             :                  ;;      ;; We don't have any of these yet, but we might.
     594             :                  ;;      (setq opt (get (car form)
     595             :                  ;;                     'byte-for-effect-optimizer)))
     596         354 :                  (setq opt (function-get (car form) 'byte-optimizer)))
     597         603 :              (not (eq form (setq new (funcall opt form)))))
     598          26 :         (progn
     599             : ;;        (if (equal form new) (error "bogus optimizer -- %s" opt))
     600          26 :           (byte-compile-log "  %s\t==>\t%s" form new)
     601          26 :           (setq new (byte-optimize-form new for-effect))
     602          26 :           new)
     603         603 :       form)))
     604             : 
     605             : 
     606             : (defun byte-optimize-body (forms all-for-effect)
     607             :   ;; Optimize the cdr of a progn or implicit progn; all forms is a list of
     608             :   ;; forms, all but the last of which are optimized with the assumption that
     609             :   ;; they are being called for effect.  the last is for-effect as well if
     610             :   ;; all-for-effect is true.  returns a new list of forms.
     611          70 :   (let ((rest forms)
     612             :         (result nil)
     613             :         fe new)
     614         150 :     (while rest
     615          80 :       (setq fe (or all-for-effect (cdr rest)))
     616          80 :       (setq new (and (car rest) (byte-optimize-form (car rest) fe)))
     617          80 :       (if (or new (not fe))
     618          80 :           (setq result (cons new result)))
     619          80 :       (setq rest (cdr rest)))
     620          70 :     (nreverse result)))
     621             : 
     622             : 
     623             : ;; some source-level optimizers
     624             : ;;
     625             : ;; when writing optimizers, be VERY careful that the optimizer returns
     626             : ;; something not EQ to its argument if and ONLY if it has made a change.
     627             : ;; This implies that you cannot simply destructively modify the list;
     628             : ;; you must return something not EQ to it if you make an optimization.
     629             : ;;
     630             : ;; It is now safe to optimize code such that it introduces new bindings.
     631             : 
     632             : (defsubst byte-compile-trueconstp (form)
     633             :   "Return non-nil if FORM always evaluates to a non-nil value."
     634          48 :   (while (eq (car-safe form) 'progn)
     635          48 :     (setq form (car (last (cdr form)))))
     636          48 :   (cond ((consp form)
     637          18 :          (pcase (car form)
     638           0 :            (`quote (cadr form))
     639             :            ;; Can't use recursion in a defsubst.
     640             :            ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
     641          18 :            ))
     642          30 :         ((not (symbolp form)))
     643          30 :         ((eq form t))
     644          48 :         ((keywordp form))))
     645             : 
     646             : (defsubst byte-compile-nilconstp (form)
     647             :   "Return non-nil if FORM always evaluates to a nil value."
     648          30 :   (while (eq (car-safe form) 'progn)
     649          30 :     (setq form (car (last (cdr form)))))
     650          30 :   (cond ((consp form)
     651           0 :          (pcase (car form)
     652           0 :            (`quote (null (cadr form)))
     653             :            ;; Can't use recursion in a defsubst.
     654             :            ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
     655           0 :            ))
     656          30 :         ((not (symbolp form)) nil)
     657          30 :         ((null form))))
     658             : 
     659             : ;; If the function is being called with constant numeric args,
     660             : ;; evaluate as much as possible at compile-time.  This optimizer
     661             : ;; assumes that the function is associative, like + or *.
     662             : (defun byte-optimize-associative-math (form)
     663           0 :   (let ((args nil)
     664             :         (constants nil)
     665           0 :         (rest (cdr form)))
     666           0 :     (while rest
     667           0 :       (if (numberp (car rest))
     668           0 :           (setq constants (cons (car rest) constants))
     669           0 :           (setq args (cons (car rest) args)))
     670           0 :       (setq rest (cdr rest)))
     671           0 :     (if (cdr constants)
     672           0 :         (if args
     673           0 :             (list (car form)
     674           0 :                   (apply (car form) constants)
     675           0 :                   (if (cdr args)
     676           0 :                       (cons (car form) (nreverse args))
     677           0 :                       (car args)))
     678           0 :             (apply (car form) constants))
     679           0 :         form)))
     680             : 
     681             : ;; If the function is being called with constant numeric args,
     682             : ;; evaluate as much as possible at compile-time.  This optimizer
     683             : ;; assumes that the function satisfies
     684             : ;;   (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
     685             : ;; like - and /.
     686             : (defun byte-optimize-nonassociative-math (form)
     687           0 :   (if (or (not (numberp (car (cdr form))))
     688           0 :           (not (numberp (car (cdr (cdr form))))))
     689           0 :       form
     690           0 :     (let ((constant (car (cdr form)))
     691           0 :           (rest (cdr (cdr form))))
     692           0 :       (while (numberp (car rest))
     693           0 :         (setq constant (funcall (car form) constant (car rest))
     694           0 :               rest (cdr rest)))
     695           0 :       (if rest
     696           0 :           (cons (car form) (cons constant rest))
     697           0 :           constant))))
     698             : 
     699             : ;;(defun byte-optimize-associative-two-args-math (form)
     700             : ;;  (setq form (byte-optimize-associative-math form))
     701             : ;;  (if (consp form)
     702             : ;;      (byte-optimize-two-args-left form)
     703             : ;;      form))
     704             : 
     705             : ;;(defun byte-optimize-nonassociative-two-args-math (form)
     706             : ;;  (setq form (byte-optimize-nonassociative-math form))
     707             : ;;  (if (consp form)
     708             : ;;      (byte-optimize-two-args-right form)
     709             : ;;      form))
     710             : 
     711             : (defun byte-optimize-approx-equal (x y)
     712           0 :   (<= (* (abs (- x y)) 100) (abs (+ x y))))
     713             : 
     714             : ;; Collect all the constants from FORM, after the STARTth arg,
     715             : ;; and apply FUN to them to make one argument at the end.
     716             : ;; For functions that can handle floats, that optimization
     717             : ;; can be incorrect because reordering can cause an overflow
     718             : ;; that would otherwise be avoided by encountering an arg that is a float.
     719             : ;; We avoid this problem by (1) not moving float constants and
     720             : ;; (2) not moving anything if it would cause an overflow.
     721             : (defun byte-optimize-delay-constants-math (form start fun)
     722             :   ;; Merge all FORM's constants from number START, call FUN on them
     723             :   ;; and put the result at the end.
     724           0 :   (let ((rest (nthcdr (1- start) form))
     725           0 :         (orig form)
     726             :         ;; t means we must check for overflow.
     727           0 :         (overflow (memq fun '(+ *))))
     728           0 :     (while (cdr (setq rest (cdr rest)))
     729           0 :       (if (integerp (car rest))
     730           0 :           (let (constants)
     731           0 :             (setq form (copy-sequence form)
     732           0 :                   rest (nthcdr (1- start) form))
     733           0 :             (while (setq rest (cdr rest))
     734           0 :               (cond ((integerp (car rest))
     735           0 :                      (setq constants (cons (car rest) constants))
     736           0 :                      (setcar rest nil))))
     737             :             ;; If necessary, check now for overflow
     738             :             ;; that might be caused by reordering.
     739           0 :             (if (and overflow
     740             :                      ;; We have overflow if the result of doing the arithmetic
     741             :                      ;; on floats is not even close to the result
     742             :                      ;; of doing it on integers.
     743           0 :                      (not (byte-optimize-approx-equal
     744           0 :                             (apply fun (mapcar 'float constants))
     745           0 :                             (float (apply fun constants)))))
     746           0 :                 (setq form orig)
     747           0 :               (setq form (nconc (delq nil form)
     748           0 :                                 (list (apply fun (nreverse constants)))))))))
     749           0 :     form))
     750             : 
     751             : (defsubst byte-compile-butlast (form)
     752           0 :   (nreverse (cdr (reverse form))))
     753             : 
     754             : (defun byte-optimize-plus (form)
     755             :   ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
     756             :   ;;(setq form (byte-optimize-delay-constants-math form 1 '+))
     757           0 :   (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
     758             :   ;; For (+ constants...), byte-optimize-predicate does the work.
     759           0 :   (when (memq nil (mapcar 'numberp (cdr form)))
     760           0 :     (cond
     761             :      ;; (+ x 1) --> (1+ x) and (+ x -1) --> (1- x).
     762           0 :      ((and (= (length form) 3)
     763           0 :            (or (memq (nth 1 form) '(1 -1))
     764           0 :                (memq (nth 2 form) '(1 -1))))
     765           0 :       (let (integer other)
     766           0 :         (if (memq (nth 1 form) '(1 -1))
     767           0 :             (setq integer (nth 1 form) other (nth 2 form))
     768           0 :           (setq integer (nth 2 form) other (nth 1 form)))
     769           0 :         (setq form
     770           0 :               (list (if (eq integer 1) '1+ '1-) other))))
     771             :      ;; Here, we could also do
     772             :      ;;  (+ x y ... 1) --> (1+ (+ x y ...))
     773             :      ;;  (+ x y ... -1) --> (1- (+ x y ...))
     774             :      ;; The resulting bytecode is smaller, but is it faster? -- cyd
     775           0 :      ))
     776           0 :   (byte-optimize-predicate form))
     777             : 
     778             : (defun byte-optimize-minus (form)
     779             :   ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
     780             :   ;;(setq form (byte-optimize-delay-constants-math form 2 '+))
     781             :   ;; Remove zeros.
     782           0 :   (when (and (nthcdr 3 form)
     783           0 :              (memq 0 (cddr form)))
     784           0 :     (setq form (nconc (list (car form) (cadr form))
     785           0 :                       (delq 0 (copy-sequence (cddr form)))))
     786             :     ;; After the above, we must turn (- x) back into (- x 0)
     787           0 :     (or (cddr form)
     788           0 :         (setq form (nconc form (list 0)))))
     789             :   ;; For (- constants..), byte-optimize-predicate does the work.
     790           0 :   (when (memq nil (mapcar 'numberp (cdr form)))
     791           0 :     (cond
     792             :      ;; (- x 1) --> (1- x)
     793           0 :      ((equal (nthcdr 2 form) '(1))
     794           0 :       (setq form (list '1- (nth 1 form))))
     795             :      ;; (- x -1) --> (1+ x)
     796           0 :      ((equal (nthcdr 2 form) '(-1))
     797           0 :       (setq form (list '1+ (nth 1 form))))
     798             :      ;; (- 0 x) --> (- x)
     799           0 :      ((and (eq (nth 1 form) 0)
     800           0 :            (= (length form) 3))
     801           0 :       (setq form (list '- (nth 2 form))))
     802             :      ;; Here, we could also do
     803             :      ;;  (- x y ... 1) --> (1- (- x y ...))
     804             :      ;;  (- x y ... -1) --> (1+ (- x y ...))
     805             :      ;; The resulting bytecode is smaller, but is it faster? -- cyd
     806           0 :      ))
     807           0 :   (byte-optimize-predicate form))
     808             : 
     809             : (defun byte-optimize-multiply (form)
     810           0 :   (setq form (byte-optimize-delay-constants-math form 1 '*))
     811             :   ;; For (* constants..), byte-optimize-predicate does the work.
     812           0 :   (when (memq nil (mapcar 'numberp (cdr form)))
     813             :     ;; After `byte-optimize-predicate', if there is a INTEGER constant
     814             :     ;; in FORM, it is in the last element.
     815           0 :     (let ((last (car (reverse (cdr form)))))
     816           0 :       (cond
     817             :        ;; Would handling (* ... 0) here cause floating point errors?
     818             :        ;; See bug#1334.
     819           0 :        ((eq 1 last) (setq form (byte-compile-butlast form)))
     820           0 :        ((eq -1 last)
     821           0 :         (setq form (list '- (if (nthcdr 3 form)
     822           0 :                                 (byte-compile-butlast form)
     823           0 :                               (nth 1 form))))))))
     824           0 :   (byte-optimize-predicate form))
     825             : 
     826             : (defun byte-optimize-divide (form)
     827           0 :   (setq form (byte-optimize-delay-constants-math form 2 '*))
     828             :   ;; After `byte-optimize-predicate', if there is a INTEGER constant
     829             :   ;; in FORM, it is in the last element.
     830           0 :   (let ((last (car (reverse (cdr (cdr form))))))
     831           0 :     (cond
     832             :      ;; Runtime error (leave it intact).
     833           0 :      ((or (null last)
     834           0 :           (eq last 0)
     835           0 :           (memql 0.0 (cddr form))))
     836             :      ;; No constants in expression
     837           0 :      ((not (numberp last)))
     838             :      ;; For (* constants..), byte-optimize-predicate does the work.
     839           0 :      ((null (memq nil (mapcar 'numberp (cdr form)))))
     840             :      ;; (/ x y.. 1) --> (/ x y..)
     841           0 :      ((and (eq last 1) (nthcdr 3 form))
     842           0 :       (setq form (byte-compile-butlast form)))
     843             :      ;; (/ x -1), (/ x .. -1)  --> (- x), (- (/ x ..))
     844           0 :      ((eq last -1)
     845           0 :       (setq form (list '- (if (nthcdr 3 form)
     846           0 :                               (byte-compile-butlast form)
     847           0 :                             (nth 1 form)))))))
     848           0 :   (byte-optimize-predicate form))
     849             : 
     850             : (defun byte-optimize-logmumble (form)
     851           0 :   (setq form (byte-optimize-delay-constants-math form 1 (car form)))
     852           0 :   (byte-optimize-predicate
     853           0 :    (cond ((memq 0 form)
     854           0 :           (setq form (if (eq (car form) 'logand)
     855           0 :                          (cons 'progn (cdr form))
     856           0 :                        (delq 0 (copy-sequence form)))))
     857           0 :          ((and (eq (car-safe form) 'logior)
     858           0 :                (memq -1 form))
     859           0 :           (cons 'progn (cdr form)))
     860           0 :          (form))))
     861             : 
     862             : 
     863             : (defun byte-optimize-binary-predicate (form)
     864           0 :   (cond
     865           0 :    ((or (not (macroexp-const-p (nth 1 form)))
     866           0 :         (nthcdr 3 form)) ;; In case there are more than 2 args.
     867           0 :     form)
     868           0 :    ((macroexp-const-p (nth 2 form))
     869           0 :     (condition-case ()
     870           0 :         (list 'quote (eval form))
     871           0 :       (error form)))
     872             :    (t ;; This can enable some lapcode optimizations.
     873           0 :     (list (car form) (nth 2 form) (nth 1 form)))))
     874             : 
     875             : (defun byte-optimize-predicate (form)
     876          32 :   (let ((ok t)
     877          32 :         (rest (cdr form)))
     878          64 :     (while (and rest ok)
     879          32 :       (setq ok (macroexp-const-p (car rest))
     880          32 :             rest (cdr rest)))
     881          32 :     (if ok
     882           0 :         (condition-case ()
     883           0 :             (list 'quote (eval form))
     884           0 :           (error form))
     885          32 :         form)))
     886             : 
     887             : (defun byte-optimize-identity (form)
     888           0 :   (if (and (cdr form) (null (cdr (cdr form))))
     889           0 :       (nth 1 form)
     890           0 :     (byte-compile-warn "identity called with %d arg%s, but requires 1"
     891           0 :                        (length (cdr form))
     892           0 :                        (if (= 1 (length (cdr form))) "" "s"))
     893           0 :     form))
     894             : 
     895             : (put 'identity 'byte-optimizer 'byte-optimize-identity)
     896             : 
     897             : (put '+   'byte-optimizer 'byte-optimize-plus)
     898             : (put '*   'byte-optimizer 'byte-optimize-multiply)
     899             : (put '-   'byte-optimizer 'byte-optimize-minus)
     900             : (put '/   'byte-optimizer 'byte-optimize-divide)
     901             : (put 'max 'byte-optimizer 'byte-optimize-associative-math)
     902             : (put 'min 'byte-optimizer 'byte-optimize-associative-math)
     903             : 
     904             : (put '=   'byte-optimizer 'byte-optimize-binary-predicate)
     905             : (put 'eq  'byte-optimizer 'byte-optimize-binary-predicate)
     906             : (put 'equal   'byte-optimizer 'byte-optimize-binary-predicate)
     907             : (put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
     908             : (put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
     909             : 
     910             : (put '<   'byte-optimizer 'byte-optimize-predicate)
     911             : (put '>   'byte-optimizer 'byte-optimize-predicate)
     912             : (put '<=  'byte-optimizer 'byte-optimize-predicate)
     913             : (put '>=  'byte-optimizer 'byte-optimize-predicate)
     914             : (put '1+  'byte-optimizer 'byte-optimize-predicate)
     915             : (put '1-  'byte-optimizer 'byte-optimize-predicate)
     916             : (put 'not 'byte-optimizer 'byte-optimize-predicate)
     917             : (put 'null  'byte-optimizer 'byte-optimize-predicate)
     918             : (put 'memq  'byte-optimizer 'byte-optimize-predicate)
     919             : (put 'consp 'byte-optimizer 'byte-optimize-predicate)
     920             : (put 'listp 'byte-optimizer 'byte-optimize-predicate)
     921             : (put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
     922             : (put 'stringp 'byte-optimizer 'byte-optimize-predicate)
     923             : (put 'string< 'byte-optimizer 'byte-optimize-predicate)
     924             : (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
     925             : 
     926             : (put 'logand 'byte-optimizer 'byte-optimize-logmumble)
     927             : (put 'logior 'byte-optimizer 'byte-optimize-logmumble)
     928             : (put 'logxor 'byte-optimizer 'byte-optimize-logmumble)
     929             : (put 'lognot 'byte-optimizer 'byte-optimize-predicate)
     930             : 
     931             : (put 'car 'byte-optimizer 'byte-optimize-predicate)
     932             : (put 'cdr 'byte-optimizer 'byte-optimize-predicate)
     933             : (put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
     934             : (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
     935             : 
     936             : 
     937             : ;; I'm not convinced that this is necessary.  Doesn't the optimizer loop
     938             : ;; take care of this? - Jamie
     939             : ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
     940             : ;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
     941             : (put 'quote 'byte-optimizer 'byte-optimize-quote)
     942             : (defun byte-optimize-quote (form)
     943          55 :   (if (or (consp (nth 1 form))
     944          55 :           (and (symbolp (nth 1 form))
     945          55 :                (not (macroexp--const-symbol-p form))))
     946          38 :       form
     947          55 :     (nth 1 form)))
     948             : 
     949             : (defun byte-optimize-and (form)
     950             :   ;; Simplify if less than 2 args.
     951             :   ;; if there is a literal nil in the args to `and', throw it and following
     952             :   ;; forms away, and surround the `and' with (progn ... nil).
     953           6 :   (cond ((null (cdr form)))
     954           6 :         ((memq nil form)
     955           0 :          (list 'progn
     956           0 :                (byte-optimize-and
     957           0 :                 (prog1 (setq form (copy-sequence form))
     958           0 :                   (while (nth 1 form)
     959           0 :                     (setq form (cdr form)))
     960           0 :                   (setcdr form nil)))
     961           0 :                nil))
     962           6 :         ((null (cdr (cdr form)))
     963           0 :          (nth 1 form))
     964           6 :         ((byte-optimize-predicate form))))
     965             : 
     966             : (defun byte-optimize-or (form)
     967             :   ;; Throw away nil's, and simplify if less than 2 args.
     968             :   ;; If there is a literal non-nil constant in the args to `or', throw away all
     969             :   ;; following forms.
     970          18 :   (if (memq nil form)
     971          18 :       (setq form (delq nil (copy-sequence form))))
     972          18 :   (let ((rest form))
     973          36 :     (while (cdr (setq rest (cdr rest)))
     974          18 :       (if (byte-compile-trueconstp (car rest))
     975           0 :           (setq form (copy-sequence form)
     976          18 :                 rest (setcdr (memq (car rest) form) nil))))
     977          18 :     (if (cdr (cdr form))
     978          16 :         (byte-optimize-predicate form)
     979          18 :       (nth 1 form))))
     980             : 
     981             : (defun byte-optimize-cond (form)
     982             :   ;; if any clauses have a literal nil as their test, throw them away.
     983             :   ;; if any clause has a literal non-nil constant as its test, throw
     984             :   ;; away all following clauses.
     985           0 :   (let (rest)
     986             :     ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
     987           0 :     (while (setq rest (assq nil (cdr form)))
     988           0 :       (setq form (delq rest (copy-sequence form))))
     989           0 :     (if (memq nil (cdr form))
     990           0 :         (setq form (delq nil (copy-sequence form))))
     991           0 :     (setq rest form)
     992           0 :     (while (setq rest (cdr rest))
     993           0 :       (cond ((byte-compile-trueconstp (car-safe (car rest)))
     994             :              ;; This branch will always be taken: kill the subsequent ones.
     995           0 :              (cond ((eq rest (cdr form)) ;First branch of `cond'.
     996           0 :                     (setq form `(progn ,@(car rest))))
     997           0 :                    ((cdr rest)
     998           0 :                     (setq form (copy-sequence form))
     999           0 :                     (setcdr (memq (car rest) form) nil)))
    1000           0 :              (setq rest nil))
    1001           0 :             ((and (consp (car rest))
    1002           0 :                   (byte-compile-nilconstp (caar rest)))
    1003             :              ;; This branch will never be taken: kill its body.
    1004           0 :              (setcdr (car rest) nil)))))
    1005             :   ;;
    1006             :   ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
    1007           0 :   (if (eq 'cond (car-safe form))
    1008           0 :       (let ((clauses (cdr form)))
    1009           0 :         (if (and (consp (car clauses))
    1010           0 :                  (null (cdr (car clauses))))
    1011           0 :             (list 'or (car (car clauses))
    1012           0 :                   (byte-optimize-cond
    1013           0 :                    (cons (car form) (cdr (cdr form)))))
    1014           0 :           form))
    1015           0 :     form))
    1016             : 
    1017             : (defun byte-optimize-if (form)
    1018             :   ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>))
    1019             :   ;; (if <true-constant> <then> <else...>) ==> <then>
    1020             :   ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
    1021             :   ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
    1022             :   ;; (if <test> <then> nil) ==> (if <test> <then>)
    1023          30 :   (let ((clause (nth 1 form)))
    1024          30 :     (cond ((and (eq (car-safe clause) 'progn)
    1025             :                 ;; `clause' is a proper list.
    1026          30 :                 (null (cdr (last clause))))
    1027           0 :            (if (null (cddr clause))
    1028             :                ;; A trivial `progn'.
    1029           0 :                (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form)))
    1030           0 :              (nconc (butlast clause)
    1031           0 :                     (list
    1032           0 :                      (byte-optimize-if
    1033           0 :                       `(if ,(car (last clause)) ,@(nthcdr 2 form)))))))
    1034          30 :           ((byte-compile-trueconstp clause)
    1035           0 :            `(progn ,clause ,(nth 2 form)))
    1036          30 :           ((byte-compile-nilconstp clause)
    1037           0 :            `(progn ,clause ,@(nthcdr 3 form)))
    1038          30 :           ((nth 2 form)
    1039          30 :            (if (equal '(nil) (nthcdr 3 form))
    1040           0 :                (list 'if clause (nth 2 form))
    1041          30 :              form))
    1042           0 :           ((or (nth 3 form) (nthcdr 4 form))
    1043           0 :            (list 'if
    1044             :                  ;; Don't make a double negative;
    1045             :                  ;; instead, take away the one that is there.
    1046           0 :                  (if (and (consp clause) (memq (car clause) '(not null))
    1047           0 :                           (= (length clause) 2)) ; (not xxxx) or (not (xxxx))
    1048           0 :                      (nth 1 clause)
    1049           0 :                    (list 'not clause))
    1050           0 :                  (if (nthcdr 4 form)
    1051           0 :                      (cons 'progn (nthcdr 3 form))
    1052           0 :                    (nth 3 form))))
    1053             :           (t
    1054          30 :            (list 'progn clause nil)))))
    1055             : 
    1056             : (defun byte-optimize-while (form)
    1057           0 :   (when (< (length form) 2)
    1058           0 :     (byte-compile-warn "too few arguments for `while'"))
    1059           0 :   (if (nth 1 form)
    1060           0 :       form))
    1061             : 
    1062             : (put 'and   'byte-optimizer 'byte-optimize-and)
    1063             : (put 'or    'byte-optimizer 'byte-optimize-or)
    1064             : (put 'cond  'byte-optimizer 'byte-optimize-cond)
    1065             : (put 'if    'byte-optimizer 'byte-optimize-if)
    1066             : (put 'while 'byte-optimizer 'byte-optimize-while)
    1067             : 
    1068             : ;; byte-compile-negation-optimizer lives in bytecomp.el
    1069             : (put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
    1070             : (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
    1071             : (put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
    1072             : 
    1073             : 
    1074             : (defun byte-optimize-funcall (form)
    1075             :   ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
    1076             :   ;; (funcall foo ...) ==> (foo ...)
    1077          26 :   (let ((fn (nth 1 form)))
    1078          26 :     (if (memq (car-safe fn) '(quote function))
    1079           2 :         (cons (nth 1 fn) (cdr (cdr form)))
    1080          26 :       form)))
    1081             : 
    1082             : (defun byte-optimize-apply (form)
    1083             :   ;; If the last arg is a literal constant, turn this into a funcall.
    1084             :   ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
    1085          20 :   (let ((fn (nth 1 form))
    1086          20 :         (last (nth (1- (length form)) form))) ; I think this really is fastest
    1087          20 :     (or (if (or (null last)
    1088          20 :                 (eq (car-safe last) 'quote))
    1089           0 :             (if (listp (nth 1 last))
    1090           0 :                 (let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
    1091           0 :                   (nconc (list 'funcall fn) butlast
    1092           0 :                          (mapcar (lambda (x) (list 'quote x)) (nth 1 last))))
    1093           0 :               (byte-compile-warn
    1094             :                "last arg to apply can't be a literal atom: `%s'"
    1095           0 :                (prin1-to-string last))
    1096          20 :               nil))
    1097          20 :         form)))
    1098             : 
    1099             : (put 'funcall 'byte-optimizer 'byte-optimize-funcall)
    1100             : (put 'apply   'byte-optimizer 'byte-optimize-apply)
    1101             : 
    1102             : 
    1103             : (put 'let 'byte-optimizer 'byte-optimize-letX)
    1104             : (put 'let* 'byte-optimizer 'byte-optimize-letX)
    1105             : (defun byte-optimize-letX (form)
    1106          35 :   (cond ((null (nth 1 form))
    1107             :          ;; No bindings
    1108           5 :          (cons 'progn (cdr (cdr form))))
    1109          30 :         ((or (nth 2 form) (nthcdr 3 form))
    1110          30 :          form)
    1111             :          ;; The body is nil
    1112           0 :         ((eq (car form) 'let)
    1113           0 :          (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
    1114           0 :                  '(nil)))
    1115             :         (t
    1116           0 :          (let ((binds (reverse (nth 1 form))))
    1117          35 :            (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
    1118             : 
    1119             : 
    1120             : (put 'nth 'byte-optimizer 'byte-optimize-nth)
    1121             : (defun byte-optimize-nth (form)
    1122           0 :   (if (= (safe-length form) 3)
    1123           0 :       (if (memq (nth 1 form) '(0 1))
    1124           0 :           (list 'car (if (zerop (nth 1 form))
    1125           0 :                          (nth 2 form)
    1126           0 :                        (list 'cdr (nth 2 form))))
    1127           0 :         (byte-optimize-predicate form))
    1128           0 :     form))
    1129             : 
    1130             : (put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
    1131             : (defun byte-optimize-nthcdr (form)
    1132           0 :   (if (= (safe-length form) 3)
    1133           0 :       (if (memq (nth 1 form) '(0 1 2))
    1134           0 :           (let ((count (nth 1 form)))
    1135           0 :             (setq form (nth 2 form))
    1136           0 :             (while (>= (setq count (1- count)) 0)
    1137           0 :               (setq form (list 'cdr form)))
    1138           0 :             form)
    1139           0 :         (byte-optimize-predicate form))
    1140           0 :     form))
    1141             : 
    1142             : ;; Fixme: delete-char -> delete-region (byte-coded)
    1143             : ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
    1144             : ;; string-make-multibyte for constant args.
    1145             : 
    1146             : (put 'set 'byte-optimizer 'byte-optimize-set)
    1147             : (defun byte-optimize-set (form)
    1148           0 :   (let ((var (car-safe (cdr-safe form))))
    1149           0 :     (cond
    1150           0 :      ((and (eq (car-safe var) 'quote) (consp (cdr var)))
    1151           0 :       `(setq ,(cadr var) ,@(cddr form)))
    1152           0 :      ((and (eq (car-safe var) 'make-local-variable)
    1153           0 :            (eq (car-safe (setq var (car-safe (cdr var)))) 'quote)
    1154           0 :            (consp (cdr var)))
    1155           0 :       `(progn ,(cadr form) (setq ,(cadr var) ,@(cddr form))))
    1156           0 :      (t form))))
    1157             : 
    1158             : ;; enumerating those functions which need not be called if the returned
    1159             : ;; value is not used.  That is, something like
    1160             : ;;    (progn (list (something-with-side-effects) (yow))
    1161             : ;;           (foo))
    1162             : ;; may safely be turned into
    1163             : ;;    (progn (progn (something-with-side-effects) (yow))
    1164             : ;;           (foo))
    1165             : ;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
    1166             : 
    1167             : ;; Some of these functions have the side effect of allocating memory
    1168             : ;; and it would be incorrect to replace two calls with one.
    1169             : ;; But we don't try to do those kinds of optimizations,
    1170             : ;; so it is safe to list such functions here.
    1171             : ;; Some of these functions return values that depend on environment
    1172             : ;; state, so that constant folding them would be wrong,
    1173             : ;; but we don't do constant folding based on this list.
    1174             : 
    1175             : ;; However, at present the only optimization we normally do
    1176             : ;; is delete calls that need not occur, and we only do that
    1177             : ;; with the error-free functions.
    1178             : 
    1179             : ;; I wonder if I missed any :-\)
    1180             : (let ((side-effect-free-fns
    1181             :        '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
    1182             :          assoc assq
    1183             :          boundp buffer-file-name buffer-local-variables buffer-modified-p
    1184             :          buffer-substring byte-code-function-p
    1185             :          capitalize car-less-than-car car cdr ceiling char-after char-before
    1186             :          char-equal char-to-string char-width compare-strings
    1187             :          compare-window-configurations concat coordinates-in-window-p
    1188             :          copy-alist copy-sequence copy-marker cos count-lines
    1189             :          decode-char
    1190             :          decode-time default-boundp default-value documentation downcase
    1191             :          elt encode-char exp expt encode-time error-message-string
    1192             :          fboundp fceiling featurep ffloor
    1193             :          file-directory-p file-exists-p file-locked-p file-name-absolute-p
    1194             :          file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
    1195             :          float float-time floor format format-time-string frame-first-window
    1196             :          frame-root-window frame-selected-window
    1197             :          frame-visible-p fround ftruncate
    1198             :          get gethash get-buffer get-buffer-window getenv get-file-buffer
    1199             :          hash-table-count
    1200             :          int-to-string intern-soft
    1201             :          keymap-parent
    1202             :          length local-variable-if-set-p local-variable-p log log10 logand
    1203             :          logb logior lognot logxor lsh langinfo
    1204             :          make-list make-string make-symbol marker-buffer max member memq min
    1205             :          minibuffer-selected-window minibuffer-window
    1206             :          mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
    1207             :          parse-colon-path plist-get plist-member
    1208             :          prefix-numeric-value previous-window prin1-to-string propertize
    1209             :          degrees-to-radians
    1210             :          radians-to-degrees rassq rassoc read-from-string regexp-quote
    1211             :          region-beginning region-end reverse round
    1212             :          sin sqrt string string< string= string-equal string-lessp string-to-char
    1213             :          string-to-int string-to-number substring
    1214             :          sxhash sxhash-equal sxhash-eq sxhash-eql
    1215             :          symbol-function symbol-name symbol-plist symbol-value string-make-unibyte
    1216             :          string-make-multibyte string-as-multibyte string-as-unibyte
    1217             :          string-to-multibyte
    1218             :          tan truncate
    1219             :          unibyte-char-to-multibyte upcase user-full-name
    1220             :          user-login-name user-original-login-name custom-variable-p
    1221             :          vconcat
    1222             :          window-absolute-pixel-edges window-at window-body-height
    1223             :          window-body-width window-buffer window-dedicated-p window-display-table
    1224             :          window-combination-limit window-edges window-frame window-fringes
    1225             :          window-height window-hscroll window-inside-edges
    1226             :          window-inside-absolute-pixel-edges window-inside-pixel-edges
    1227             :          window-left-child window-left-column window-margins window-minibuffer-p
    1228             :          window-next-buffers window-next-sibling window-new-normal
    1229             :          window-new-total window-normal-size window-parameter window-parameters
    1230             :          window-parent window-pixel-edges window-point window-prev-buffers
    1231             :          window-prev-sibling window-redisplay-end-trigger window-scroll-bars
    1232             :          window-start window-text-height window-top-child window-top-line
    1233             :          window-total-height window-total-width window-use-time window-vscroll
    1234             :          window-width zerop))
    1235             :       (side-effect-and-error-free-fns
    1236             :        '(arrayp atom
    1237             :          bobp bolp bool-vector-p
    1238             :          buffer-end buffer-list buffer-size buffer-string bufferp
    1239             :          car-safe case-table-p cdr-safe char-or-string-p characterp
    1240             :          charsetp commandp cons consp
    1241             :          current-buffer current-global-map current-indentation
    1242             :          current-local-map current-minor-mode-maps current-time
    1243             :          current-time-string current-time-zone
    1244             :          eobp eolp eq equal eventp
    1245             :          floatp following-char framep
    1246             :          get-largest-window get-lru-window
    1247             :          hash-table-p
    1248             :          identity ignore integerp integer-or-marker-p interactive-p
    1249             :          invocation-directory invocation-name
    1250             :          keymapp keywordp
    1251             :          line-beginning-position line-end-position list listp
    1252             :          make-marker mark mark-marker markerp max-char
    1253             :          memory-limit minibuffer-window
    1254             :          mouse-movement-p
    1255             :          natnump nlistp not null number-or-marker-p numberp
    1256             :          one-window-p overlayp
    1257             :          point point-marker point-min point-max preceding-char primary-charset
    1258             :          processp
    1259             :          recent-keys recursion-depth
    1260             :          safe-length selected-frame selected-window sequencep
    1261             :          standard-case-table standard-syntax-table stringp subrp symbolp
    1262             :          syntax-table syntax-table-p
    1263             :          this-command-keys this-command-keys-vector this-single-command-keys
    1264             :          this-single-command-raw-keys
    1265             :          user-real-login-name user-real-uid user-uid
    1266             :          vector vectorp visible-frame-list
    1267             :          wholenump window-configuration-p window-live-p
    1268             :          window-valid-p windowp)))
    1269             :   (while side-effect-free-fns
    1270             :     (put (car side-effect-free-fns) 'side-effect-free t)
    1271             :     (setq side-effect-free-fns (cdr side-effect-free-fns)))
    1272             :   (while side-effect-and-error-free-fns
    1273             :     (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
    1274             :     (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
    1275             :   nil)
    1276             : 
    1277             : 
    1278             : ;; pure functions are side-effect free functions whose values depend
    1279             : ;; only on their arguments. For these functions, calls with constant
    1280             : ;; arguments can be evaluated at compile time. This may shift run time
    1281             : ;; errors to compile time.
    1282             : 
    1283             : (let ((pure-fns
    1284             :        '(concat symbol-name regexp-opt regexp-quote string-to-syntax)))
    1285             :   (while pure-fns
    1286             :     (put (car pure-fns) 'pure t)
    1287             :     (setq pure-fns (cdr pure-fns)))
    1288             :   nil)
    1289             : 
    1290             : (defconst byte-constref-ops
    1291             :   '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
    1292             : 
    1293             : ;; Used and set dynamically in byte-decompile-bytecode-1.
    1294             : (defvar bytedecomp-op)
    1295             : (defvar bytedecomp-ptr)
    1296             : 
    1297             : ;; This function extracts the bitfields from variable-length opcodes.
    1298             : ;; Originally defined in disass.el (which no longer uses it.)
    1299             : (defun disassemble-offset (bytes)
    1300             :   "Don't call this!"
    1301             :   ;; Fetch and return the offset for the current opcode.
    1302             :   ;; Return nil if this opcode has no offset.
    1303           0 :   (cond ((< bytedecomp-op byte-pophandler)
    1304           0 :          (let ((tem (logand bytedecomp-op 7)))
    1305           0 :            (setq bytedecomp-op (logand bytedecomp-op 248))
    1306           0 :            (cond ((eq tem 6)
    1307             :                   ;; Offset in next byte.
    1308           0 :                   (setq bytedecomp-ptr (1+ bytedecomp-ptr))
    1309           0 :                   (aref bytes bytedecomp-ptr))
    1310           0 :                  ((eq tem 7)
    1311             :                   ;; Offset in next 2 bytes.
    1312           0 :                   (setq bytedecomp-ptr (1+ bytedecomp-ptr))
    1313           0 :                   (+ (aref bytes bytedecomp-ptr)
    1314           0 :                      (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr))
    1315           0 :                             (lsh (aref bytes bytedecomp-ptr) 8))))
    1316           0 :                  (t tem))))             ;Offset was in opcode.
    1317           0 :         ((>= bytedecomp-op byte-constant)
    1318           0 :          (prog1 (- bytedecomp-op byte-constant) ;Offset in opcode.
    1319           0 :            (setq bytedecomp-op byte-constant)))
    1320           0 :         ((or (and (>= bytedecomp-op byte-constant2)
    1321           0 :                   (<= bytedecomp-op byte-goto-if-not-nil-else-pop))
    1322           0 :              (memq bytedecomp-op (eval-when-compile
    1323           1 :                                    (list byte-stack-set2 byte-pushcatch
    1324           1 :                                          byte-pushconditioncase))))
    1325             :          ;; Offset in next 2 bytes.
    1326           0 :          (setq bytedecomp-ptr (1+ bytedecomp-ptr))
    1327           0 :          (+ (aref bytes bytedecomp-ptr)
    1328           0 :             (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr))
    1329           0 :                    (lsh (aref bytes bytedecomp-ptr) 8))))
    1330           0 :         ((and (>= bytedecomp-op byte-listN)
    1331           0 :               (<= bytedecomp-op byte-discardN))
    1332           0 :          (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte.
    1333           0 :          (aref bytes bytedecomp-ptr))))
    1334             : 
    1335             : (defvar byte-compile-tag-number)
    1336             : 
    1337             : ;; This de-compiler is used for inline expansion of compiled functions,
    1338             : ;; and by the disassembler.
    1339             : ;;
    1340             : ;; This list contains numbers, which are pc values,
    1341             : ;; before each instruction.
    1342             : (defun byte-decompile-bytecode (bytes constvec)
    1343             :   "Turn BYTECODE into lapcode, referring to CONSTVEC."
    1344           0 :   (let ((byte-compile-constants nil)
    1345             :         (byte-compile-variables nil)
    1346             :         (byte-compile-tag-number 0))
    1347           0 :     (byte-decompile-bytecode-1 bytes constvec)))
    1348             : 
    1349             : ;; As byte-decompile-bytecode, but updates
    1350             : ;; byte-compile-{constants, variables, tag-number}.
    1351             : ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
    1352             : ;; with `goto's destined for the end of the code.
    1353             : ;; That is for use by the compiler.
    1354             : ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
    1355             : ;; In that case, we put a pc value into the list
    1356             : ;; before each insn (or its label).
    1357             : (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
    1358           0 :   (let ((length (length bytes))
    1359             :         (bytedecomp-ptr 0) optr tags bytedecomp-op offset
    1360             :         lap tmp last-constant)
    1361           0 :     (while (not (= bytedecomp-ptr length))
    1362           0 :       (or make-spliceable
    1363           0 :           (push bytedecomp-ptr lap))
    1364           0 :       (setq bytedecomp-op (aref bytes bytedecomp-ptr)
    1365           0 :             optr bytedecomp-ptr
    1366             :             ;; This uses dynamic-scope magic.
    1367           0 :             offset (disassemble-offset bytes))
    1368           0 :       (let ((opcode (aref byte-code-vector bytedecomp-op)))
    1369           0 :         (cl-assert opcode)
    1370           0 :         (setq bytedecomp-op opcode))
    1371           0 :       (cond ((memq bytedecomp-op byte-goto-ops)
    1372             :              ;; It's a pc.
    1373           0 :              (setq offset
    1374           0 :                    (cdr (or (assq offset tags)
    1375           0 :                             (let ((new (cons offset (byte-compile-make-tag))))
    1376           0 :                               (push new tags)
    1377           0 :                               new)))))
    1378           0 :             ((cond ((eq bytedecomp-op 'byte-constant2)
    1379           0 :                     (setq bytedecomp-op 'byte-constant) t)
    1380           0 :                    ((memq bytedecomp-op byte-constref-ops)))
    1381           0 :              (setq tmp (if (>= offset (length constvec))
    1382           0 :                            (list 'out-of-range offset)
    1383           0 :                          (aref constvec offset))
    1384           0 :                    offset (if (eq bytedecomp-op 'byte-constant)
    1385           0 :                               (byte-compile-get-constant tmp)
    1386           0 :                             (or (assq tmp byte-compile-variables)
    1387           0 :                                 (let ((new (list tmp)))
    1388           0 :                                   (push new byte-compile-variables)
    1389           0 :                                   new)))
    1390           0 :                    last-constant tmp))
    1391           0 :             ((eq bytedecomp-op 'byte-stack-set2)
    1392           0 :              (setq bytedecomp-op 'byte-stack-set))
    1393           0 :             ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80))
    1394             :              ;; The top bit of the operand for byte-discardN is a flag,
    1395             :              ;; saying whether the top-of-stack is preserved.  In
    1396             :              ;; lapcode, we represent this by using a different opcode
    1397             :              ;; (with the flag removed from the operand).
    1398           0 :              (setq bytedecomp-op 'byte-discardN-preserve-tos)
    1399           0 :              (setq offset (- offset #x80)))
    1400           0 :             ((eq bytedecomp-op 'byte-switch)
    1401           0 :              (cl-assert (hash-table-p last-constant) nil
    1402           0 :                         "byte-switch used without preceeding hash table")
    1403             :              ;; We cannot use the original hash table referenced in the op,
    1404             :              ;; so we create a copy of it, and replace the addresses with
    1405             :              ;; TAGs.
    1406           0 :              (let ((orig-table last-constant))
    1407           0 :                (cl-loop for e across constvec
    1408           0 :                         when (eq e last-constant)
    1409           0 :                         do (setq last-constant (copy-hash-table e))
    1410           0 :                         and return nil)
    1411             :                ;; Replace all addresses with TAGs.
    1412           0 :                (maphash #'(lambda (value tag)
    1413           0 :                             (let (newtag)
    1414           0 :                               (setq newtag (byte-compile-make-tag))
    1415           0 :                               (push (cons tag newtag) tags)
    1416           0 :                               (puthash value newtag last-constant)))
    1417           0 :                         last-constant)
    1418             :                ;; Replace the hash table referenced in the lapcode with our
    1419             :                ;; modified one.
    1420           0 :                (cl-loop for el in-ref lap
    1421           0 :                         when (and (listp el) ;; make sure we're at the correct op
    1422           0 :                                   (eq (nth 1 el) 'byte-constant)
    1423           0 :                                   (eq (nth 2 el) orig-table))
    1424             :                         ;; Jump tables are never reused, so do this exactly
    1425             :                         ;; once.
    1426           0 :                         do (setf (nth 2 el) last-constant) and return nil))))
    1427             :       ;; lap = ( [ (pc . (op . arg)) ]* )
    1428           0 :       (push (cons optr (cons bytedecomp-op (or offset 0)))
    1429           0 :             lap)
    1430           0 :       (setq bytedecomp-ptr (1+ bytedecomp-ptr)))
    1431           0 :     (let ((rest lap))
    1432           0 :       (while rest
    1433           0 :         (cond ((numberp (car rest)))
    1434           0 :               ((setq tmp (assq (car (car rest)) tags))
    1435             :                ;; This addr is jumped to.
    1436           0 :                (setcdr rest (cons (cons nil (cdr tmp))
    1437           0 :                                   (cdr rest)))
    1438           0 :                (setq tags (delq tmp tags))
    1439           0 :                (setq rest (cdr rest))))
    1440           0 :         (setq rest (cdr rest))))
    1441           0 :     (if tags (error "optimizer error: missed tags %s" tags))
    1442             :     ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
    1443           0 :     (mapcar (function (lambda (elt)
    1444           0 :                         (if (numberp elt)
    1445           0 :                             elt
    1446           0 :                           (cdr elt))))
    1447           0 :             (nreverse lap))))
    1448             : 
    1449             : 
    1450             : ;;; peephole optimizer
    1451             : 
    1452             : (defconst byte-tagref-ops (cons 'TAG byte-goto-ops))
    1453             : 
    1454             : (defconst byte-conditional-ops
    1455             :   '(byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop
    1456             :     byte-goto-if-not-nil-else-pop))
    1457             : 
    1458             : (defconst byte-after-unbind-ops
    1459             :    '(byte-constant byte-dup
    1460             :      byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
    1461             :      byte-eq byte-not
    1462             :      byte-cons byte-list1 byte-list2    ; byte-list3 byte-list4
    1463             :      byte-interactive-p)
    1464             :    ;; How about other side-effect-free-ops?  Is it safe to move an
    1465             :    ;; error invocation (such as from nth) out of an unwind-protect?
    1466             :    ;; No, it is not, because the unwind-protect forms can alter
    1467             :    ;; the inside of the object to which nth would apply.
    1468             :    ;; For the same reason, byte-equal was deleted from this list.
    1469             :    "Byte-codes that can be moved past an unbind.")
    1470             : 
    1471             : (defconst byte-compile-side-effect-and-error-free-ops
    1472             :   '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
    1473             :     byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
    1474             :     byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
    1475             :     byte-point-min byte-following-char byte-preceding-char
    1476             :     byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
    1477             :     byte-current-buffer byte-stack-ref))
    1478             : 
    1479             : (defconst byte-compile-side-effect-free-ops
    1480             :   (nconc
    1481             :    '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
    1482             :      byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
    1483             :      byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
    1484             :      byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
    1485             :      byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
    1486             :      byte-member byte-assq byte-quo byte-rem)
    1487             :    byte-compile-side-effect-and-error-free-ops))
    1488             : 
    1489             : ;; This crock is because of the way DEFVAR_BOOL variables work.
    1490             : ;; Consider the code
    1491             : ;;
    1492             : ;;      (defun foo (flag)
    1493             : ;;        (let ((old-pop-ups pop-up-windows)
    1494             : ;;              (pop-up-windows flag))
    1495             : ;;          (cond ((not (eq pop-up-windows old-pop-ups))
    1496             : ;;                 (setq old-pop-ups pop-up-windows)
    1497             : ;;                 ...))))
    1498             : ;;
    1499             : ;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
    1500             : ;; something else.  But if we optimize
    1501             : ;;
    1502             : ;;      varref flag
    1503             : ;;      varbind pop-up-windows
    1504             : ;;      varref pop-up-windows
    1505             : ;;      not
    1506             : ;; to
    1507             : ;;      varref flag
    1508             : ;;      dup
    1509             : ;;      varbind pop-up-windows
    1510             : ;;      not
    1511             : ;;
    1512             : ;; we break the program, because it will appear that pop-up-windows and
    1513             : ;; old-pop-ups are not EQ when really they are.  So we have to know what
    1514             : ;; the BOOL variables are, and not perform this optimization on them.
    1515             : 
    1516             : ;; The variable `byte-boolean-vars' is now primitive and updated
    1517             : ;; automatically by DEFVAR_BOOL.
    1518             : 
    1519             : (defun byte-optimize-lapcode (lap &optional _for-effect)
    1520             :   "Simple peephole optimizer.  LAP is both modified and returned.
    1521             : If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
    1522          15 :   (let (lap0
    1523             :         lap1
    1524             :         lap2
    1525             :         (keep-going 'first-time)
    1526             :         (add-depth 0)
    1527             :         rest tmp tmp2 tmp3
    1528          15 :         (side-effect-free (if byte-compile-delete-errors
    1529           0 :                               byte-compile-side-effect-free-ops
    1530          15 :                             byte-compile-side-effect-and-error-free-ops)))
    1531          40 :     (while keep-going
    1532          25 :       (or (eq keep-going 'first-time)
    1533          25 :           (byte-compile-log-lap "  ---- next pass"))
    1534          25 :       (setq rest lap
    1535          25 :             keep-going nil)
    1536         932 :       (while rest
    1537         907 :         (setq lap0 (car rest)
    1538         907 :               lap1 (nth 1 rest)
    1539         907 :               lap2 (nth 2 rest))
    1540             : 
    1541             :         ;; You may notice that sequences like "dup varset discard" are
    1542             :         ;; optimized but sequences like "dup varset TAG1: discard" are not.
    1543             :         ;; You may be tempted to change this; resist that temptation.
    1544         907 :         (cond ;;
    1545             :               ;; <side-effect-free> pop -->  <deleted>
    1546             :               ;;  ...including:
    1547             :               ;; const-X pop   -->  <deleted>
    1548             :               ;; varref-X pop  -->  <deleted>
    1549             :               ;; dup pop       -->  <deleted>
    1550             :               ;;
    1551         907 :               ((and (eq 'byte-discard (car lap1))
    1552         907 :                     (memq (car lap0) side-effect-free))
    1553           0 :                (setq keep-going t)
    1554           0 :                (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
    1555           0 :                (setq rest (cdr rest))
    1556           0 :                (cond ((= tmp 1)
    1557           0 :                       (byte-compile-log-lap
    1558           0 :                        "  %s discard\t-->\t<deleted>" lap0)
    1559           0 :                       (setq lap (delq lap0 (delq lap1 lap))))
    1560           0 :                      ((= tmp 0)
    1561           0 :                       (byte-compile-log-lap
    1562           0 :                        "  %s discard\t-->\t<deleted> discard" lap0)
    1563           0 :                       (setq lap (delq lap0 lap)))
    1564           0 :                      ((= tmp -1)
    1565           0 :                       (byte-compile-log-lap
    1566           0 :                        "  %s discard\t-->\tdiscard discard" lap0)
    1567           0 :                       (setcar lap0 'byte-discard)
    1568           0 :                       (setcdr lap0 0))
    1569           0 :                      ((error "Optimizer error: too much on the stack"))))
    1570             :               ;;
    1571             :               ;; goto*-X X:  -->  X:
    1572             :               ;;
    1573         907 :               ((and (memq (car lap0) byte-goto-ops)
    1574         907 :                     (eq (cdr lap0) lap1))
    1575           0 :                (cond ((eq (car lap0) 'byte-goto)
    1576           0 :                       (setq lap (delq lap0 lap))
    1577           0 :                       (setq tmp "<deleted>"))
    1578           0 :                      ((memq (car lap0) byte-goto-always-pop-ops)
    1579           0 :                       (setcar lap0 (setq tmp 'byte-discard))
    1580           0 :                       (setcdr lap0 0))
    1581           0 :                      ((error "Depth conflict at tag %d" (nth 2 lap0))))
    1582           0 :                (and (memq byte-optimize-log '(t byte))
    1583           0 :                     (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
    1584             :                                       (nth 1 lap1) (nth 1 lap1)
    1585           0 :                                       tmp (nth 1 lap1)))
    1586           0 :                (setq keep-going t))
    1587             :               ;;
    1588             :               ;; varset-X varref-X  -->  dup varset-X
    1589             :               ;; varbind-X varref-X  -->  dup varbind-X
    1590             :               ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
    1591             :               ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
    1592             :               ;; The latter two can enable other optimizations.
    1593             :               ;;
    1594             :               ;; For lexical variables, we could do the same
    1595             :               ;;   stack-set-X+1 stack-ref-X  -->  dup stack-set-X+2
    1596             :               ;; but this is a very minor gain, since dup is stack-ref-0,
    1597             :               ;; i.e. it's only better if X>5, and even then it comes
    1598             :               ;; at the cost of an extra stack slot.  Let's not bother.
    1599         907 :               ((and (eq 'byte-varref (car lap2))
    1600           4 :                     (eq (cdr lap1) (cdr lap2))
    1601         907 :                     (memq (car lap1) '(byte-varset byte-varbind)))
    1602           0 :                (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
    1603           0 :                         (not (eq (car lap0) 'byte-constant)))
    1604             :                    nil
    1605           0 :                  (setq keep-going t)
    1606           0 :                  (if (memq (car lap0) '(byte-constant byte-dup))
    1607           0 :                      (progn
    1608           0 :                        (setq tmp (if (or (not tmp)
    1609           0 :                                          (macroexp--const-symbol-p
    1610           0 :                                           (car (cdr lap0))))
    1611           0 :                                      (cdr lap0)
    1612           0 :                                    (byte-compile-get-constant t)))
    1613           0 :                        (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
    1614             :                                              lap0 lap1 lap2 lap0 lap1
    1615           0 :                                              (cons (car lap0) tmp))
    1616           0 :                        (setcar lap2 (car lap0))
    1617           0 :                        (setcdr lap2 tmp))
    1618           0 :                    (byte-compile-log-lap "  %s %s\t-->\tdup %s" lap1 lap2 lap1)
    1619           0 :                    (setcar lap2 (car lap1))
    1620           0 :                    (setcar lap1 'byte-dup)
    1621           0 :                    (setcdr lap1 0)
    1622             :                    ;; The stack depth gets locally increased, so we will
    1623             :                    ;; increase maxdepth in case depth = maxdepth here.
    1624             :                    ;; This can cause the third argument to byte-code to
    1625             :                    ;; be larger than necessary.
    1626           0 :                    (setq add-depth 1))))
    1627             :               ;;
    1628             :               ;; dup varset-X discard  -->  varset-X
    1629             :               ;; dup varbind-X discard  -->  varbind-X
    1630             :               ;; dup stack-set-X discard  -->  stack-set-X-1
    1631             :               ;; (the varbind variant can emerge from other optimizations)
    1632             :               ;;
    1633         907 :               ((and (eq 'byte-dup (car lap0))
    1634          10 :                     (eq 'byte-discard (car lap2))
    1635           0 :                     (memq (car lap1) '(byte-varset byte-varbind
    1636         907 :                                        byte-stack-set)))
    1637           0 :                (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
    1638           0 :                (setq keep-going t
    1639           0 :                      rest (cdr rest))
    1640           0 :                (if (eq 'byte-stack-set (car lap1)) (cl-decf (cdr lap1)))
    1641           0 :                (setq lap (delq lap0 (delq lap2 lap))))
    1642             :               ;;
    1643             :               ;; not goto-X-if-nil              -->  goto-X-if-non-nil
    1644             :               ;; not goto-X-if-non-nil          -->  goto-X-if-nil
    1645             :               ;;
    1646             :               ;; it is wrong to do the same thing for the -else-pop variants.
    1647             :               ;;
    1648         907 :               ((and (eq 'byte-not (car lap0))
    1649         907 :                     (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil)))
    1650           0 :                (byte-compile-log-lap "  not %s\t-->\t%s"
    1651             :                                      lap1
    1652             :                                      (cons
    1653             :                                       (if (eq (car lap1) 'byte-goto-if-nil)
    1654             :                                           'byte-goto-if-not-nil
    1655             :                                         'byte-goto-if-nil)
    1656           0 :                                       (cdr lap1)))
    1657           0 :                (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
    1658             :                                 'byte-goto-if-not-nil
    1659           0 :                                 'byte-goto-if-nil))
    1660           0 :                (setq lap (delq lap0 lap))
    1661           0 :                (setq keep-going t))
    1662             :               ;;
    1663             :               ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
    1664             :               ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
    1665             :               ;;
    1666             :               ;; it is wrong to do the same thing for the -else-pop variants.
    1667             :               ;;
    1668         907 :               ((and (memq (car lap0)
    1669         907 :                           '(byte-goto-if-nil byte-goto-if-not-nil))     ; gotoX
    1670          28 :                     (eq 'byte-goto (car lap1))                  ; gotoY
    1671         907 :                     (eq (cdr lap0) lap2))                       ; TAG X
    1672           0 :                (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
    1673           0 :                                   'byte-goto-if-not-nil 'byte-goto-if-nil)))
    1674           0 :                  (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
    1675             :                                        lap0 lap1 lap2
    1676           0 :                                        (cons inverse (cdr lap1)) lap2)
    1677           0 :                  (setq lap (delq lap0 lap))
    1678           0 :                  (setcar lap1 inverse)
    1679           0 :                  (setq keep-going t)))
    1680             :               ;;
    1681             :               ;; const goto-if-* --> whatever
    1682             :               ;;
    1683         907 :               ((and (eq 'byte-constant (car lap0))
    1684         317 :                     (memq (car lap1) byte-conditional-ops)
    1685             :                     ;; If the `byte-constant's cdr is not a cons cell, it has
    1686             :                     ;; to be an index into the constant pool); even though
    1687             :                     ;; it'll be a constant, that constant is not known yet
    1688             :                     ;; (it's typically a free variable of a closure, so will
    1689             :                     ;; only be known when the closure will be built at
    1690             :                     ;; run-time).
    1691         907 :                     (consp (cdr lap0)))
    1692           0 :                (cond ((if (memq (car lap1) '(byte-goto-if-nil
    1693           0 :                                              byte-goto-if-nil-else-pop))
    1694           0 :                           (car (cdr lap0))
    1695           0 :                         (not (car (cdr lap0))))
    1696           0 :                       (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
    1697           0 :                                             lap0 lap1)
    1698           0 :                       (setq rest (cdr rest)
    1699           0 :                             lap (delq lap0 (delq lap1 lap))))
    1700             :                      (t
    1701           0 :                       (byte-compile-log-lap "  %s %s\t-->\t%s"
    1702             :                                             lap0 lap1
    1703           0 :                                             (cons 'byte-goto (cdr lap1)))
    1704           0 :                       (when (memq (car lap1) byte-goto-always-pop-ops)
    1705           0 :                         (setq lap (delq lap0 lap)))
    1706           0 :                       (setcar lap1 'byte-goto)))
    1707           0 :                (setq keep-going t))
    1708             :               ;;
    1709             :               ;; varref-X varref-X  -->  varref-X dup
    1710             :               ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
    1711             :               ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
    1712             :               ;; We don't optimize the const-X variations on this here,
    1713             :               ;; because that would inhibit some goto optimizations; we
    1714             :               ;; optimize the const-X case after all other optimizations.
    1715             :               ;;
    1716         907 :               ((and (memq (car lap0) '(byte-varref byte-stack-ref))
    1717         182 :                     (progn
    1718         182 :                       (setq tmp (cdr rest))
    1719         182 :                       (setq tmp2 0)
    1720         182 :                       (while (eq (car (car tmp)) 'byte-dup)
    1721           0 :                         (setq tmp2 (1+ tmp2))
    1722         182 :                         (setq tmp (cdr tmp)))
    1723         182 :                       t)
    1724         182 :                     (eq (if (eq 'byte-stack-ref (car lap0))
    1725         178 :                             (+ tmp2 1 (cdr lap0))
    1726         182 :                           (cdr lap0))
    1727         182 :                         (cdr (car tmp)))
    1728         907 :                     (eq (car lap0) (car (car tmp))))
    1729           0 :                (if (memq byte-optimize-log '(t byte))
    1730           0 :                    (let ((str ""))
    1731           0 :                      (setq tmp2 (cdr rest))
    1732           0 :                      (while (not (eq tmp tmp2))
    1733           0 :                        (setq tmp2 (cdr tmp2)
    1734           0 :                              str (concat str " dup")))
    1735           0 :                      (byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
    1736           0 :                                            lap0 str lap0 lap0 str)))
    1737           0 :                (setq keep-going t)
    1738           0 :                (setcar (car tmp) 'byte-dup)
    1739           0 :                (setcdr (car tmp) 0)
    1740           0 :                (setq rest tmp))
    1741             :               ;;
    1742             :               ;; TAG1: TAG2: --> TAG1: <deleted>
    1743             :               ;; (and other references to TAG2 are replaced with TAG1)
    1744             :               ;;
    1745         907 :               ((and (eq (car lap0) 'TAG)
    1746         907 :                     (eq (car lap1) 'TAG))
    1747           3 :                (and (memq byte-optimize-log '(t byte))
    1748           0 :                     (byte-compile-log "  adjacent tags %d and %d merged"
    1749           3 :                                       (nth 1 lap1) (nth 1 lap0)))
    1750           3 :                (setq tmp3 lap)
    1751           6 :                (while (setq tmp2 (rassq lap0 tmp3))
    1752           3 :                  (setcdr tmp2 lap1)
    1753           3 :                  (setq tmp3 (cdr (memq tmp2 tmp3))))
    1754           3 :                (setq lap (delq lap0 lap)
    1755           3 :                      keep-going t)
    1756             :                ;; replace references to tag in jump tables, if any
    1757           3 :                (dolist (table byte-compile-jump-tables)
    1758           0 :                  (catch 'break
    1759           0 :                    (maphash #'(lambda (value tag)
    1760           0 :                                 (when (equal tag lap0)
    1761             :                                   ;; each tag occurs only once in the jump table
    1762           0 :                                   (puthash value lap1 table)
    1763           0 :                                   (throw 'break nil)))
    1764           3 :                             table))))
    1765             :               ;;
    1766             :               ;; unused-TAG: --> <deleted>
    1767             :               ;;
    1768         904 :               ((and (eq 'TAG (car lap0))
    1769          80 :                     (not (rassq lap0 lap))
    1770             :                     ;; make sure this tag isn't used in a jump-table
    1771          10 :                     (cl-loop for table in byte-compile-jump-tables
    1772           0 :                              when (member lap0 (hash-table-values table))
    1773         904 :                              return nil finally return t))
    1774          10 :                (and (memq byte-optimize-log '(t byte))
    1775          10 :                     (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
    1776          10 :                (setq lap (delq lap0 lap)
    1777          10 :                      keep-going t))
    1778             :               ;;
    1779             :               ;; goto   ... --> goto   <delete until TAG or end>
    1780             :               ;; return ... --> return <delete until TAG or end>
    1781             :               ;; (unless a jump-table is being used, where deleting may affect
    1782             :               ;; other valid case bodies)
    1783             :               ;;
    1784         894 :               ((and (memq (car lap0) '(byte-goto byte-return))
    1785          53 :                     (not (memq (car lap1) '(TAG nil)))
    1786             :                     ;; FIXME: Instead of deferring simply when jump-tables are
    1787             :                     ;; being used, keep a list of tags used for switch tags and
    1788             :                     ;; use them instead (see `byte-compile-inline-lapcode').
    1789         894 :                     (not byte-compile-jump-tables))
    1790           0 :                (setq tmp rest)
    1791           0 :                (let ((i 0)
    1792           0 :                      (opt-p (memq byte-optimize-log '(t lap)))
    1793             :                      str deleted)
    1794           0 :                  (while (and (setq tmp (cdr tmp))
    1795           0 :                              (not (eq 'TAG (car (car tmp)))))
    1796           0 :                    (if opt-p (setq deleted (cons (car tmp) deleted)
    1797           0 :                                    str (concat str " %s")
    1798           0 :                                    i (1+ i))))
    1799           0 :                  (if opt-p
    1800           0 :                      (let ((tagstr
    1801           0 :                             (if (eq 'TAG (car (car tmp)))
    1802           0 :                                 (format "%d:" (car (cdr (car tmp))))
    1803           0 :                               (or (car tmp) ""))))
    1804           0 :                        (if (< i 6)
    1805           0 :                            (apply 'byte-compile-log-lap-1
    1806           0 :                                   (concat "  %s" str
    1807           0 :                                           " %s\t-->\t%s <deleted> %s")
    1808           0 :                                   lap0
    1809           0 :                                   (nconc (nreverse deleted)
    1810           0 :                                          (list tagstr lap0 tagstr)))
    1811           0 :                          (byte-compile-log-lap
    1812             :                           "  %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
    1813             :                           lap0 i (if (= i 1) "" "s")
    1814           0 :                           tagstr lap0 tagstr))))
    1815           0 :                  (rplacd rest tmp))
    1816           0 :                (setq keep-going t))
    1817             :               ;;
    1818             :               ;; <safe-op> unbind --> unbind <safe-op>
    1819             :               ;; (this may enable other optimizations.)
    1820             :               ;;
    1821         894 :               ((and (eq 'byte-unbind (car lap1))
    1822         894 :                     (memq (car lap0) byte-after-unbind-ops))
    1823           0 :                (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
    1824           0 :                (setcar rest lap1)
    1825           0 :                (setcar (cdr rest) lap0)
    1826           0 :                (setq keep-going t))
    1827             :               ;;
    1828             :               ;; varbind-X unbind-N         -->  discard unbind-(N-1)
    1829             :               ;; save-excursion unbind-N    -->  unbind-(N-1)
    1830             :               ;; save-restriction unbind-N  -->  unbind-(N-1)
    1831             :               ;;
    1832         894 :               ((and (eq 'byte-unbind (car lap1))
    1833           0 :                     (memq (car lap0) '(byte-varbind byte-save-excursion
    1834           0 :                                        byte-save-restriction))
    1835         894 :                     (< 0 (cdr lap1)))
    1836           0 :                (if (zerop (setcdr lap1 (1- (cdr lap1))))
    1837           0 :                    (delq lap1 rest))
    1838           0 :                (if (eq (car lap0) 'byte-varbind)
    1839           0 :                    (setcar rest (cons 'byte-discard 0))
    1840           0 :                  (setq lap (delq lap0 lap)))
    1841           0 :                (byte-compile-log-lap "  %s %s\t-->\t%s %s"
    1842             :                  lap0 (cons (car lap1) (1+ (cdr lap1)))
    1843             :                  (if (eq (car lap0) 'byte-varbind)
    1844             :                      (car rest)
    1845             :                    (car (cdr rest)))
    1846             :                  (if (and (/= 0 (cdr lap1))
    1847             :                           (eq (car lap0) 'byte-varbind))
    1848             :                      (car (cdr rest))
    1849           0 :                    ""))
    1850           0 :                (setq keep-going t))
    1851             :               ;;
    1852             :               ;; goto*-X ... X: goto-Y  --> goto*-Y
    1853             :               ;; goto-X ...  X: return  --> return
    1854             :               ;;
    1855         894 :               ((and (memq (car lap0) byte-goto-ops)
    1856          78 :                     (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
    1857         894 :                           '(byte-goto byte-return)))
    1858           0 :                (cond ((and (not (eq tmp lap0))
    1859           0 :                            (or (eq (car lap0) 'byte-goto)
    1860           0 :                                (eq (car tmp) 'byte-goto)))
    1861           0 :                       (byte-compile-log-lap "  %s [%s]\t-->\t%s"
    1862           0 :                                             (car lap0) tmp tmp)
    1863           0 :                       (if (eq (car tmp) 'byte-return)
    1864           0 :                           (setcar lap0 'byte-return))
    1865           0 :                       (setcdr lap0 (cdr tmp))
    1866           0 :                       (setq keep-going t))))
    1867             :               ;;
    1868             :               ;; goto-*-else-pop X ... X: goto-if-* --> whatever
    1869             :               ;; goto-*-else-pop X ... X: discard --> whatever
    1870             :               ;;
    1871         894 :               ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
    1872         894 :                                        byte-goto-if-not-nil-else-pop))
    1873          22 :                     (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
    1874          22 :                           (eval-when-compile
    1875          22 :                            (cons 'byte-discard byte-conditional-ops)))
    1876         894 :                     (not (eq lap0 (car tmp))))
    1877           0 :                (setq tmp2 (car tmp))
    1878           0 :                (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
    1879             :                                               byte-goto-if-nil)
    1880             :                                              (byte-goto-if-not-nil-else-pop
    1881           0 :                                               byte-goto-if-not-nil))))
    1882           0 :                (if (memq (car tmp2) tmp3)
    1883           0 :                    (progn (setcar lap0 (car tmp2))
    1884           0 :                           (setcdr lap0 (cdr tmp2))
    1885           0 :                           (byte-compile-log-lap "  %s-else-pop [%s]\t-->\t%s"
    1886           0 :                                                 (car lap0) tmp2 lap0))
    1887             :                  ;; Get rid of the -else-pop's and jump one step further.
    1888           0 :                  (or (eq 'TAG (car (nth 1 tmp)))
    1889           0 :                      (setcdr tmp (cons (byte-compile-make-tag)
    1890           0 :                                        (cdr tmp))))
    1891           0 :                  (byte-compile-log-lap "  %s [%s]\t-->\t%s <skip>"
    1892           0 :                                        (car lap0) tmp2 (nth 1 tmp3))
    1893           0 :                  (setcar lap0 (nth 1 tmp3))
    1894           0 :                  (setcdr lap0 (nth 1 tmp)))
    1895           0 :                (setq keep-going t))
    1896             :               ;;
    1897             :               ;; const goto-X ... X: goto-if-* --> whatever
    1898             :               ;; const goto-X ... X: discard   --> whatever
    1899             :               ;;
    1900         894 :               ((and (eq (car lap0) 'byte-constant)
    1901         317 :                     (eq (car lap1) 'byte-goto)
    1902           0 :                     (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
    1903           0 :                           (eval-when-compile
    1904           1 :                             (cons 'byte-discard byte-conditional-ops)))
    1905         894 :                     (not (eq lap1 (car tmp))))
    1906           0 :                (setq tmp2 (car tmp))
    1907           0 :                (cond ((when (consp (cdr lap0))
    1908           0 :                         (memq (car tmp2)
    1909           0 :                               (if (null (car (cdr lap0)))
    1910             :                                   '(byte-goto-if-nil byte-goto-if-nil-else-pop)
    1911             :                                 '(byte-goto-if-not-nil
    1912           0 :                                   byte-goto-if-not-nil-else-pop))))
    1913           0 :                       (byte-compile-log-lap "  %s goto [%s]\t-->\t%s %s"
    1914           0 :                                             lap0 tmp2 lap0 tmp2)
    1915           0 :                       (setcar lap1 (car tmp2))
    1916           0 :                       (setcdr lap1 (cdr tmp2))
    1917             :                       ;; Let next step fix the (const,goto-if*) sequence.
    1918           0 :                       (setq rest (cons nil rest))
    1919           0 :                       (setq keep-going t))
    1920           0 :                      ((or (consp (cdr lap0))
    1921           0 :                           (eq (car tmp2) 'byte-discard))
    1922             :                       ;; Jump one step further
    1923           0 :                       (byte-compile-log-lap
    1924             :                        "  %s goto [%s]\t-->\t<deleted> goto <skip>"
    1925           0 :                        lap0 tmp2)
    1926           0 :                       (or (eq 'TAG (car (nth 1 tmp)))
    1927           0 :                           (setcdr tmp (cons (byte-compile-make-tag)
    1928           0 :                                             (cdr tmp))))
    1929           0 :                       (setcdr lap1 (car (cdr tmp)))
    1930           0 :                       (setq lap (delq lap0 lap))
    1931           0 :                       (setq keep-going t))))
    1932             :               ;;
    1933             :               ;; X: varref-Y    ...     varset-Y goto-X  -->
    1934             :               ;; X: varref-Y Z: ... dup varset-Y goto-Z
    1935             :               ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
    1936             :               ;; (This is so usual for while loops that it is worth handling).
    1937             :               ;;
    1938             :               ;; Here again, we could do it for stack-ref/stack-set, but
    1939             :               ;; that's replacing a stack-ref-Y with a stack-ref-0, which
    1940             :               ;; is a very minor improvement (if any), at the cost of
    1941             :               ;; more stack use and more byte-code.  Let's not do it.
    1942             :               ;;
    1943         894 :               ((and (eq (car lap1) 'byte-varset)
    1944           0 :                     (eq (car lap2) 'byte-goto)
    1945           0 :                     (not (memq (cdr lap2) rest)) ;Backwards jump
    1946           0 :                     (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
    1947           0 :                         'byte-varref)
    1948           0 :                     (eq (cdr (car tmp)) (cdr lap1))
    1949         894 :                     (not (memq (car (cdr lap1)) byte-boolean-vars)))
    1950             :                ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
    1951           0 :                (let ((newtag (byte-compile-make-tag)))
    1952           0 :                  (byte-compile-log-lap
    1953             :                   "  %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
    1954             :                   (nth 1 (cdr lap2)) (car tmp)
    1955             :                   lap1 lap2
    1956             :                   (nth 1 (cdr lap2)) (car tmp)
    1957             :                   (nth 1 newtag) 'byte-dup lap1
    1958             :                   (cons 'byte-goto newtag)
    1959           0 :                   )
    1960           0 :                  (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
    1961           0 :                  (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
    1962           0 :                (setq add-depth 1)
    1963           0 :                (setq keep-going t))
    1964             :               ;;
    1965             :               ;; goto-X Y: ... X: goto-if*-Y  -->  goto-if-not-*-X+1 Y:
    1966             :               ;; (This can pull the loop test to the end of the loop)
    1967             :               ;;
    1968         894 :               ((and (eq (car lap0) 'byte-goto)
    1969          28 :                     (eq (car lap1) 'TAG)
    1970          28 :                     (eq lap1
    1971          28 :                         (cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
    1972           0 :                     (memq (car (car tmp))
    1973             :                           '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
    1974         894 :                                       byte-goto-if-nil-else-pop)))
    1975             : ;;             (byte-compile-log-lap "  %s %s, %s %s  --> moved conditional"
    1976             : ;;                                   lap0 lap1 (cdr lap0) (car tmp))
    1977           0 :                (let ((newtag (byte-compile-make-tag)))
    1978           0 :                  (byte-compile-log-lap
    1979             :                   "%s %s: ... %s: %s\t-->\t%s ... %s:"
    1980             :                   lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
    1981             :                   (cons (cdr (assq (car (car tmp))
    1982             :                                    '((byte-goto-if-nil . byte-goto-if-not-nil)
    1983             :                                      (byte-goto-if-not-nil . byte-goto-if-nil)
    1984             :                                      (byte-goto-if-nil-else-pop .
    1985             :                                       byte-goto-if-not-nil-else-pop)
    1986             :                                      (byte-goto-if-not-nil-else-pop .
    1987             :                                       byte-goto-if-nil-else-pop))))
    1988             :                         newtag)
    1989             : 
    1990             :                   (nth 1 newtag)
    1991           0 :                   )
    1992           0 :                  (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
    1993           0 :                  (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
    1994             :                      ;; We can handle this case but not the -if-not-nil case,
    1995             :                      ;; because we won't know which non-nil constant to push.
    1996           0 :                    (setcdr rest (cons (cons 'byte-constant
    1997           0 :                                             (byte-compile-get-constant nil))
    1998           0 :                                       (cdr rest))))
    1999           0 :                (setcar lap0 (nth 1 (memq (car (car tmp))
    2000             :                                          '(byte-goto-if-nil-else-pop
    2001             :                                            byte-goto-if-not-nil
    2002             :                                            byte-goto-if-nil
    2003             :                                            byte-goto-if-not-nil
    2004           0 :                                            byte-goto byte-goto))))
    2005           0 :                )
    2006           0 :                (setq keep-going t))
    2007         907 :               )
    2008         907 :         (setq rest (cdr rest)))
    2009          15 :       )
    2010             :     ;; Cleanup stage:
    2011             :     ;; Rebuild byte-compile-constants / byte-compile-variables.
    2012             :     ;; Simple optimizations that would inhibit other optimizations if they
    2013             :     ;; were done in the optimizing loop, and optimizations which there is no
    2014             :     ;; need to do more than once.
    2015          15 :     (setq byte-compile-constants nil
    2016          15 :           byte-compile-variables nil)
    2017          15 :     (setq rest lap)
    2018          15 :     (byte-compile-log-lap "  ---- final pass")
    2019         467 :     (while rest
    2020         452 :       (setq lap0 (car rest)
    2021         452 :             lap1 (nth 1 rest))
    2022         452 :       (if (memq (car lap0) byte-constref-ops)
    2023         163 :           (if (memq (car lap0) '(byte-constant byte-constant2))
    2024         161 :               (unless (memq (cdr lap0) byte-compile-constants)
    2025         138 :                 (setq byte-compile-constants (cons (cdr lap0)
    2026         161 :                                                    byte-compile-constants)))
    2027           2 :             (unless (memq (cdr lap0) byte-compile-variables)
    2028           1 :               (setq byte-compile-variables (cons (cdr lap0)
    2029         452 :                                                  byte-compile-variables)))))
    2030         452 :       (cond (;;
    2031             :              ;; const-C varset-X const-C  -->  const-C dup varset-X
    2032             :              ;; const-C varbind-X const-C  -->  const-C dup varbind-X
    2033             :              ;;
    2034         452 :              (and (eq (car lap0) 'byte-constant)
    2035         161 :                   (eq (car (nth 2 rest)) 'byte-constant)
    2036          60 :                   (eq (cdr lap0) (cdr (nth 2 rest)))
    2037         452 :                   (memq (car lap1) '(byte-varbind byte-varset)))
    2038           0 :              (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
    2039           0 :                                    lap0 lap1 lap0 lap0 lap1)
    2040           0 :              (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1)))
    2041           0 :              (setcar (cdr rest) (cons 'byte-dup 0))
    2042           0 :              (setq add-depth 1))
    2043             :             ;;
    2044             :             ;; const-X  [dup/const-X ...]   -->  const-X  [dup ...] dup
    2045             :             ;; varref-X [dup/varref-X ...]  -->  varref-X [dup ...] dup
    2046             :             ;;
    2047         452 :             ((memq (car lap0) '(byte-constant byte-varref))
    2048         163 :              (setq tmp rest
    2049         163 :                    tmp2 nil)
    2050         163 :              (while (progn
    2051         163 :                       (while (eq 'byte-dup (car (car (setq tmp (cdr tmp))))))
    2052         163 :                       (and (eq (cdr lap0) (cdr (car tmp)))
    2053         163 :                            (eq (car lap0) (car (car tmp)))))
    2054           0 :                (setcar tmp (cons 'byte-dup 0))
    2055         163 :                (setq tmp2 t))
    2056         163 :              (if tmp2
    2057           0 :                  (byte-compile-log-lap
    2058         163 :                   "  %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0)))
    2059             :             ;;
    2060             :             ;; unbind-N unbind-M  -->  unbind-(N+M)
    2061             :             ;;
    2062         289 :             ((and (eq 'byte-unbind (car lap0))
    2063         289 :                   (eq 'byte-unbind (car lap1)))
    2064           0 :              (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
    2065             :                                    (cons 'byte-unbind
    2066           0 :                                          (+ (cdr lap0) (cdr lap1))))
    2067           0 :              (setq lap (delq lap0 lap))
    2068           0 :              (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
    2069             : 
    2070             :             ;;
    2071             :             ;; stack-set-M [discard/discardN ...]  -->  discardN-preserve-tos
    2072             :             ;; stack-set-M [discard/discardN ...]  -->  discardN
    2073             :             ;;
    2074         289 :             ((and (eq (car lap0) 'byte-stack-set)
    2075          15 :                   (memq (car lap1) '(byte-discard byte-discardN))
    2076           5 :                   (progn
    2077             :                     ;; See if enough discard operations follow to expose or
    2078             :                     ;; destroy the value stored by the stack-set.
    2079           5 :                     (setq tmp (cdr rest))
    2080           5 :                     (setq tmp2 (1- (cdr lap0)))
    2081           5 :                     (setq tmp3 0)
    2082          10 :                     (while (memq (car (car tmp)) '(byte-discard byte-discardN))
    2083           5 :                       (setq tmp3
    2084           5 :                             (+ tmp3 (if (eq (car (car tmp)) 'byte-discard)
    2085             :                                         1
    2086           5 :                                       (cdr (car tmp)))))
    2087           5 :                       (setq tmp (cdr tmp)))
    2088         289 :                     (>= tmp3 tmp2)))
    2089             :              ;; Do the optimization.
    2090           5 :              (setq lap (delq lap0 lap))
    2091           5 :              (setcar lap1
    2092           5 :                      (if (= tmp2 tmp3)
    2093             :                          ;; The value stored is the new TOS, so pop one more
    2094             :                          ;; value (to get rid of the old value) using the
    2095             :                          ;; TOS-preserving discard operator.
    2096             :                          'byte-discardN-preserve-tos
    2097             :                        ;; Otherwise, the value stored is lost, so just use a
    2098             :                        ;; normal discard.
    2099           5 :                        'byte-discardN))
    2100           5 :              (setcdr lap1 (1+ tmp3))
    2101           5 :              (setcdr (cdr rest) tmp)
    2102           5 :              (byte-compile-log-lap "  %s [discard/discardN]...\t-->\t%s"
    2103           5 :                                    lap0 lap1))
    2104             : 
    2105             :             ;;
    2106             :             ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y  -->
    2107             :             ;; discardN-(X+Y)
    2108             :             ;;
    2109         284 :             ((and (memq (car lap0)
    2110             :                         '(byte-discard byte-discardN
    2111         284 :                           byte-discardN-preserve-tos))
    2112         284 :                   (memq (car lap1) '(byte-discard byte-discardN)))
    2113           0 :              (setq lap (delq lap0 lap))
    2114           0 :              (byte-compile-log-lap
    2115             :               "  %s %s\t-->\t(discardN %s)"
    2116             :               lap0 lap1
    2117             :               (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
    2118           0 :                  (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
    2119           0 :              (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
    2120           0 :                              (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
    2121           0 :              (setcar lap1 'byte-discardN))
    2122             : 
    2123             :             ;;
    2124             :             ;; discardN-preserve-tos-X discardN-preserve-tos-Y  -->
    2125             :             ;; discardN-preserve-tos-(X+Y)
    2126             :             ;;
    2127         284 :             ((and (eq (car lap0) 'byte-discardN-preserve-tos)
    2128         284 :                   (eq (car lap1) 'byte-discardN-preserve-tos))
    2129           0 :              (setq lap (delq lap0 lap))
    2130           0 :              (setcdr lap1 (+ (cdr lap0) (cdr lap1)))
    2131           0 :              (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 (car rest)))
    2132             : 
    2133             :             ;;
    2134             :             ;; discardN-preserve-tos return  -->  return
    2135             :             ;; dup return  -->  return
    2136             :             ;; stack-set-N return  -->  return     ; where N is TOS-1
    2137             :             ;;
    2138         284 :             ((and (eq (car lap1) 'byte-return)
    2139          10 :                   (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
    2140          10 :                       (and (eq (car lap0) 'byte-stack-set)
    2141         284 :                            (= (cdr lap0) 1))))
    2142             :              ;; The byte-code interpreter will pop the stack for us, so
    2143             :              ;; we can just leave stuff on it.
    2144           5 :              (setq lap (delq lap0 lap))
    2145           5 :              (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 lap1))
    2146         452 :             )
    2147         452 :       (setq rest (cdr rest)))
    2148          15 :     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
    2149          15 :   lap)
    2150             : 
    2151             : (provide 'byte-opt)
    2152             : 
    2153             : 
    2154             : ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
    2155             : ;; itself, compile some of its most used recursive functions (at load time).
    2156             : ;;
    2157             : (eval-when-compile
    2158             :  (or (byte-code-function-p (symbol-function 'byte-optimize-form))
    2159             :      (assq 'byte-code (symbol-function 'byte-optimize-form))
    2160             :      (let ((byte-optimize nil)
    2161             :            (byte-compile-warnings nil))
    2162             :        (mapc (lambda (x)
    2163             :                (or noninteractive (message "compiling %s..." x))
    2164             :                (byte-compile x)
    2165             :                (or noninteractive (message "compiling %s...done" x)))
    2166             :              '(byte-optimize-form
    2167             :                byte-optimize-body
    2168             :                byte-optimize-predicate
    2169             :                byte-optimize-binary-predicate
    2170             :                ;; Inserted some more than necessary, to speed it up.
    2171             :                byte-optimize-form-code-walker
    2172             :                byte-optimize-lapcode))))
    2173             :  nil)
    2174             : 
    2175             : ;;; byte-opt.el ends here

Generated by: LCOV version 1.12