| blob | 7214501362dc56bd23203dece5a21d6b955ff4b4 |
1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*-
3 ;; Copyright (C) 1991, 1994, 2000-2013 Free Software Foundation, Inc.
5 ;; Author: Jamie Zawinski <jwz@lucid.com>
6 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
7 ;; Maintainer: FSF
8 ;; Keywords: internal
9 ;; Package: emacs
11 ;; This file is part of GNU Emacs.
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.
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.
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/>.
26 ;;; Commentary:
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 ;;
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.)
148 ;; Other things to consider:
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)
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.
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:
167 ;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
168 ;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
170 ;; ;; (car (cons A B)) -> (prog1 A B)
171 ;; (disassemble (lambda (x) (car (cons (foo) 42))))
173 ;; ;; (cdr (cons A B)) -> (progn A B)
174 ;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
176 ;; ;; (car (list A B ...)) -> (prog1 A B ...)
177 ;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
179 ;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
180 ;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
183 ;;; Code:
190 ;; Newer byte codes for stack-ref make the slot 0 non-nil again.
191 ;; But the "old disassembler" is *really* ancient by now.
192 ;; (if (aref byte-code-vector 0)
193 ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
202 arg)
218 c
220 args)))))
226 \f
227 ;;; byte-compile optimizers to support inlining
232 "byte-optimize-handler for the `inline' special-form."
245 sexp)))
257 (`nil
259 name)
260 form)
266 ;; (message "Inlining byte-code for %S!" name)
267 ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
273 ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
274 ;; letbind byte-code (or any other combination for that matter), we
275 ;; can only inline dynbind source into dynbind source or letbind
276 ;; source into letbind source.
278 ;; We can of course byte-compile the inlined function
279 ;; first, and then inline its byte-code.
283 ;; If `fn' is from the same file, it has already
284 ;; been preprocessed!
290 ;; This can happen because of macroexp-warn-and-return &co.
293 form))))
296 form))))
298 ;; ((lambda ...) ...)
300 ;; In lexical-binding mode, let and functions don't bind vars in the same way
301 ;; (let obey special-variable-p, but functions don't). But luckily, this
302 ;; doesn't matter here, because function's behavior is underspecified so it
303 ;; can safely be turned into a `let', even though the reverse is not true.
309 optionalp restp
310 bindings)
315 ;; FIXME: The checks below do not belong in an optimization phase.
318 ;; ok, I'll let this slide because funcall_lambda() does...
319 ;; (if optionalp (error "multiple &optional keywords in %s" name))
325 ;; ...but it is by no stretch of the imagination a reasonable
326 ;; thing that funcall_lambda() allows (&rest x y) and
327 ;; (&rest x &optional y) in arglists.
336 bindings)
337 values nil))
343 bindings)
351 form)
353 ;; The following leads to infinite recursion when loading a
354 ;; file containing `(defsubst f () (f))', and then trying to
355 ;; byte-compile that file.
356 ;(setq body (mapcar 'byte-optimize-form body)))
363 newform)))))
365 \f
366 ;;; implementing source-level optimizers
369 ;;
370 ;; For normal function calls, We can just mapcar the optimizer the cdr. But
371 ;; we need to have special knowledge of the syntax of the special forms
372 ;; like let and defun (that's why they're special forms :-). (Actually,
373 ;; the important aspect is that they are subrs that don't evaluate all of
374 ;; their args.)
375 ;;
377 tmp)
383 form))
388 ;; map (quote nil) to nil to simplify optimizer logic.
389 ;; map quoted constants to nil if for-effect (just because).
392 form))
396 ;; Some error occurred, avoid infinite recursion
397 form
400 ;; recursively enter the optimizer for the bindings and body
401 ;; of a let or let*. This for depth-firstness: forms that
402 ;; are more deeply nested are optimized first.
407 binding
424 clause))
427 ;; As an extra added bonus, this simplifies (progn <x>) --> <x>.
444 ;; those subrs which have an implicit progn; it's not quite good
445 ;; enough to treat these like normal function calls.
446 ;; This can turn (save-excursion ...) into (save-excursion) which
447 ;; will be optimized away in the lap-optimize pass.
451 ;; this is just like the above, except for the first argument.
467 ;; Take forms off the back until we can't any more.
468 ;; In the future it could conceivably be a problem that the
469 ;; subexpressions of these forms are optimized in the reverse
470 ;; order, but it's ok for now.
476 for-effect))))
483 backwards)))))
489 nil)
492 ;; These forms are compiled as constants or by breaking out
493 ;; all the subexpressions and compiling them separately.
494 form)
497 ;; the "protected" part of an unwind-protect is compiled (and thus
498 ;; optimized) as a top-level form, so don't do it here. But the
499 ;; non-protected part has the same for-effect status as the
500 ;; unwind-protect itself. (The protected part is always for effect,
501 ;; but that isn't handled properly yet.)
507 ;; the body of a catch is compiled (and thus optimized) as a
508 ;; top-level form, so don't do it here. The tag is never
509 ;; for-effect. The body should have the same for-effect status
510 ;; as the catch form itself, but that isn't handled properly yet.
516 ;; Don't treat the args to `ignore' as being
517 ;; computed for effect. We want to avoid the warnings
518 ;; that might occur if they were treated that way.
519 ;; However, don't actually bother calling `ignore'.
522 ;; Needed as long as we run byte-optimize-form after cconv.
531 form)
536 ;; Detect the expansion of (pop foo).
537 ;; There is no need to compile the call to `car' there.
551 nil)))
553 ;; appending a nil here might not be necessary, but it can't hurt.
558 ;; Otherwise, no args can be considered to be for-effect,
559 ;; even if the called function is for-effect, because we
560 ;; don't know anything about that function.
568 "Non-nil if all elements of LIST satisfy `macroexp-const-p"
574 constant))
577 "The source-level pass of the optimizer."
578 ;;
579 ;; First, optimize all sub-forms of this one.
581 ;;
582 ;; after optimizing all subforms, optimize this form until it doesn't
583 ;; optimize any further. This means that some forms will be passed through
584 ;; the optimizer many times, but that's necessary to make the for-effect
585 ;; processing do as much as possible.
586 ;;
591 ;; ;; We don't have any of these yet, but we might.
592 ;; (setq opt (get (car form)
593 ;; 'byte-for-effect-optimizer)))
597 ;; (if (equal form new) (error "bogus optimizer -- %s" opt))
600 new)
601 form)))
605 ;; Optimize the cdr of a progn or implicit progn; all forms is a list of
606 ;; forms, all but the last of which are optimized with the assumption that
607 ;; they are being called for effect. the last is for-effect as well if
608 ;; all-for-effect is true. returns a new list of forms.
611 fe new)
620 \f
621 ;; some source-level optimizers
622 ;;
623 ;; when writing optimizers, be VERY careful that the optimizer returns
624 ;; something not EQ to its argument if and ONLY if it has made a change.
625 ;; This implies that you cannot simply destructively modify the list;
626 ;; you must return something not EQ to it if you make an optimization.
627 ;;
628 ;; It is now safe to optimize code such that it introduces new bindings.
631 "Return non-nil if FORM always evaluates to a non-nil value."
637 ;; Can't use recursion in a defsubst.
638 ;; (`progn (byte-compile-trueconstp (car (last (cdr form)))))
639 ))
645 "Return non-nil if FORM always evaluates to a nil value."
651 ;; Can't use recursion in a defsubst.
652 ;; (`progn (byte-compile-nilconstp (car (last (cdr form)))))
653 ))
657 ;; If the function is being called with constant numeric args,
658 ;; evaluate as much as possible at compile-time. This optimizer
659 ;; assumes that the function is associative, like + or *.
677 form)))
679 ;; If the function is being called with constant numeric args,
680 ;; evaluate as much as possible at compile-time. This optimizer
681 ;; assumes that the function satisfies
682 ;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
683 ;; like - and /.
687 form
695 constant))))
697 ;;(defun byte-optimize-associative-two-args-math (form)
698 ;; (setq form (byte-optimize-associative-math form))
699 ;; (if (consp form)
700 ;; (byte-optimize-two-args-left form)
701 ;; form))
703 ;;(defun byte-optimize-nonassociative-two-args-math (form)
704 ;; (setq form (byte-optimize-nonassociative-math form))
705 ;; (if (consp form)
706 ;; (byte-optimize-two-args-right form)
707 ;; form))
712 ;; Collect all the constants from FORM, after the STARTth arg,
713 ;; and apply FUN to them to make one argument at the end.
714 ;; For functions that can handle floats, that optimization
715 ;; can be incorrect because reordering can cause an overflow
716 ;; that would otherwise be avoided by encountering an arg that is a float.
717 ;; We avoid this problem by (1) not moving float constants and
718 ;; (2) not moving anything if it would cause an overflow.
720 ;; Merge all FORM's constants from number START, call FUN on them
721 ;; and put the result at the end.
724 ;; t means we must check for overflow.
735 ;; If necessary, check now for overflow
736 ;; that might be caused by reordering.
738 ;; We have overflow if the result of doing the arithmetic
739 ;; on floats is not even close to the result
740 ;; of doing it on integers.
747 form))
753 ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
754 ;;(setq form (byte-optimize-delay-constants-math form 1 '+))
756 ;; For (+ constants...), byte-optimize-predicate does the work.
759 ;; (+ x 1) --> (1+ x) and (+ x -1) --> (1- x).
769 ;; Here, we could also do
770 ;; (+ x y ... 1) --> (1+ (+ x y ...))
771 ;; (+ x y ... -1) --> (1- (+ x y ...))
772 ;; The resulting bytecode is smaller, but is it faster? -- cyd
773 ))
777 ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
778 ;;(setq form (byte-optimize-delay-constants-math form 2 '+))
779 ;; Remove zeros.
784 ;; After the above, we must turn (- x) back into (- x 0)
787 ;; For (- constants..), byte-optimize-predicate does the work.
790 ;; (- x 1) --> (1- x)
793 ;; (- x -1) --> (1+ x)
796 ;; (- 0 x) --> (- x)
800 ;; Here, we could also do
801 ;; (- x y ... 1) --> (1- (- x y ...))
802 ;; (- x y ... -1) --> (1+ (- x y ...))
803 ;; The resulting bytecode is smaller, but is it faster? -- cyd
804 ))
809 ;; For (* constants..), byte-optimize-predicate does the work.
811 ;; After `byte-optimize-predicate', if there is a INTEGER constant
812 ;; in FORM, it is in the last element.
815 ;; Would handling (* ... 0) here cause floating point errors?
816 ;; See bug#1334.
826 ;; After `byte-optimize-predicate', if there is a INTEGER constant
827 ;; in FORM, it is in the last element.
830 ;; Runtime error (leave it intact).
834 ;; No constants in expression
836 ;; For (* constants..), byte-optimize-predicate does the work.
838 ;; (/ x y.. 1) --> (/ x y..)
841 ;; (/ x -1), (/ x .. -1) --> (- x), (- (/ x ..))
867 ;; This can enable some lapcode optimizations.
869 form))
881 form)))
889 form))
933 ;; I'm not convinced that this is necessary. Doesn't the optimizer loop
934 ;; take care of this? - Jamie
935 ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
936 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard
942 form
955 ;; Simplify if less than 2 args.
956 ;; if there is a literal nil in the args to `and', throw it and following
957 ;; forms away, and surround the `and' with (progn ... nil).
966 nil))
972 ;; Throw away nil's, and simplify if less than 2 args.
973 ;; If there is a literal non-nil constant in the args to `or', throw away all
974 ;; following forms.
987 ;; if any clauses have a literal nil as their test, throw them away.
988 ;; if any clause has a literal non-nil constant as its test, throw
989 ;; away all following clauses.
991 ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
999 ;; This branch will always be taken: kill the subsequent ones.
1008 ;; This branch will never be taken: kill its body.
1010 ;;
1011 ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
1019 form))
1020 form))
1023 ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>))
1024 ;; (if <true-constant> <then> <else...>) ==> <then>
1025 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
1026 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
1027 ;; (if <test> <then> nil) ==> (if <test> <then>)
1030 ;; `clause' is a proper list.
1033 ;; A trivial `progn'.
1046 form))
1049 ;; Don't make a double negative;
1050 ;; instead, take away the one that is there.
1065 form))
1073 ;; byte-compile-negation-optimizer lives in bytecomp.el
1080 ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
1081 ;; (funcall foo ...) ==> (foo ...)
1085 form)))
1088 ;; If the last arg is a literal constant, turn this into a funcall.
1089 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
1099 "last arg to apply can't be a literal atom: `%s'"
1101 nil))
1102 form)))
1112 ;; No bindings
1115 form)
1116 ;; The body is nil
1133 form))
1143 form)
1145 form))
1147 ;; Fixme: delete-char -> delete-region (byte-coded)
1148 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
1149 ;; string-make-multibyte for constant args.
1162 \f
1163 ;; enumerating those functions which need not be called if the returned
1164 ;; value is not used. That is, something like
1165 ;; (progn (list (something-with-side-effects) (yow))
1166 ;; (foo))
1167 ;; may safely be turned into
1168 ;; (progn (progn (something-with-side-effects) (yow))
1169 ;; (foo))
1170 ;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
1172 ;; Some of these functions have the side effect of allocating memory
1173 ;; and it would be incorrect to replace two calls with one.
1174 ;; But we don't try to do those kinds of optimizations,
1175 ;; so it is safe to list such functions here.
1176 ;; Some of these functions return values that depend on environment
1177 ;; state, so that constant folding them would be wrong,
1178 ;; but we don't do constant folding based on this list.
1180 ;; However, at present the only optimization we normally do
1181 ;; is delete calls that need not occur, and we only do that
1182 ;; with the error-free functions.
1184 ;; I wonder if I missed any :-\)
1187 assoc assq
1188 boundp buffer-file-name buffer-local-variables buffer-modified-p
1189 buffer-substring byte-code-function-p
1190 capitalize car-less-than-car car cdr ceiling char-after char-before
1191 char-equal char-to-string char-width compare-strings
1192 compare-window-configurations concat coordinates-in-window-p
1193 copy-alist copy-sequence copy-marker cos count-lines
1194 decode-char
1195 decode-time default-boundp default-value documentation downcase
1196 elt encode-char exp expt encode-time error-message-string
1197 fboundp fceiling featurep ffloor
1198 file-directory-p file-exists-p file-locked-p file-name-absolute-p
1199 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
1200 float float-time floor format format-time-string frame-first-window
1201 frame-root-window frame-selected-window
1202 frame-visible-p fround ftruncate
1203 get gethash get-buffer get-buffer-window getenv get-file-buffer
1204 hash-table-count
1205 int-to-string intern-soft
1206 keymap-parent
1207 length local-variable-if-set-p local-variable-p log log10 logand
1208 logb logior lognot logxor lsh langinfo
1209 make-list make-string make-symbol marker-buffer max member memq min
1210 minibuffer-selected-window minibuffer-window
1211 mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
1212 parse-colon-path plist-get plist-member
1213 prefix-numeric-value previous-window prin1-to-string propertize
1214 degrees-to-radians
1215 radians-to-degrees rassq rassoc read-from-string regexp-quote
1216 region-beginning region-end reverse round
1218 string-to-int string-to-number substring sxhash symbol-function
1219 symbol-name symbol-plist symbol-value string-make-unibyte
1220 string-make-multibyte string-as-multibyte string-as-unibyte
1221 string-to-multibyte
1222 tan truncate
1223 unibyte-char-to-multibyte upcase user-full-name
1224 user-login-name user-original-login-name custom-variable-p
1225 vconcat
1226 window-absolute-pixel-edges window-at window-body-height
1227 window-body-width window-buffer window-dedicated-p window-display-table
1228 window-combination-limit window-edges window-frame window-fringes
1229 window-height window-hscroll window-inside-edges
1230 window-inside-absolute-pixel-edges window-inside-pixel-edges
1231 window-left-child window-left-column window-margins window-minibuffer-p
1232 window-next-buffers window-next-sibling window-new-normal
1233 window-new-total window-normal-size window-parameter window-parameters
1234 window-parent window-pixel-edges window-point window-prev-buffers
1235 window-prev-sibling window-redisplay-end-trigger window-scroll-bars
1236 window-start window-text-height window-top-child window-top-line
1237 window-total-height window-total-width window-use-time window-vscroll
1238 window-width zerop))
1241 bobp bolp bool-vector-p
1242 buffer-end buffer-list buffer-size buffer-string bufferp
1243 car-safe case-table-p cdr-safe char-or-string-p characterp
1244 charsetp commandp cons consp
1245 current-buffer current-global-map current-indentation
1246 current-local-map current-minor-mode-maps current-time
1247 current-time-string current-time-zone
1248 eobp eolp eq equal eventp
1249 floatp following-char framep
1250 get-largest-window get-lru-window
1251 hash-table-p
1252 identity ignore integerp integer-or-marker-p interactive-p
1253 invocation-directory invocation-name
1254 keymapp
1255 line-beginning-position line-end-position list listp
1256 make-marker mark mark-marker markerp max-char
1257 memory-limit minibuffer-window
1258 mouse-movement-p
1259 natnump nlistp not null number-or-marker-p numberp
1260 one-window-p overlayp
1261 point point-marker point-min point-max preceding-char primary-charset
1262 processp
1263 recent-keys recursion-depth
1264 safe-length selected-frame selected-window sequencep
1265 standard-case-table standard-syntax-table stringp subrp symbolp
1266 syntax-table syntax-table-p
1267 this-command-keys this-command-keys-vector this-single-command-keys
1268 this-single-command-raw-keys
1269 user-real-login-name user-real-uid user-uid
1270 vector vectorp visible-frame-list
1271 wholenump window-configuration-p window-live-p
1272 window-valid-p windowp)))
1279 nil)
1281 \f
1282 ;; pure functions are side-effect free functions whose values depend
1283 ;; only on their arguments. For these functions, calls with constant
1284 ;; arguments can be evaluated at compile time. This may shift run time
1285 ;; errors to compile time.
1292 nil)
1293 \f
1297 ;; Used and set dynamically in byte-decompile-bytecode-1.
1301 ;; This function extracts the bitfields from variable-length opcodes.
1302 ;; Originally defined in disass.el (which no longer uses it.)
1304 "Don't call this!"
1305 ;; Fetch and return the offset for the current opcode.
1306 ;; Return nil if this opcode has no offset.
1311 ;; Offset in next byte.
1315 ;; Offset in next 2 bytes.
1327 ;; Offset in next 2 bytes.
1339 ;; This de-compiler is used for inline expansion of compiled functions,
1340 ;; and by the disassembler.
1341 ;;
1342 ;; This list contains numbers, which are pc values,
1343 ;; before each instruction.
1345 "Turn BYTECODE into lapcode, referring to CONSTVEC."
1351 ;; As byte-decompile-bytecode, but updates
1352 ;; byte-compile-{constants, variables, tag-number}.
1353 ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
1354 ;; with `goto's destined for the end of the code.
1355 ;; That is for use by the compiler.
1356 ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
1357 ;; In that case, we put a pc value into the list
1358 ;; before each insn (or its label).
1362 lap tmp)
1367 optr bytedecomp-ptr
1368 ;; This uses dynamic-scope magic.
1374 ;; It's a pc.
1379 new)))))
1391 new)))))
1395 ;; The top bit of the operand for byte-discardN is a flag,
1396 ;; saying whether the top-of-stack is preserved. In
1397 ;; lapcode, we represent this by using a different opcode
1398 ;; (with the flag removed from the operand).
1401 ;; lap = ( [ (pc . (op . arg)) ]* )
1403 lap)
1409 ;; This addr is jumped to.
1416 ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
1419 elt
1423 \f
1424 ;;; peephole optimizer
1430 byte-goto-if-not-nil-else-pop))
1434 byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
1435 byte-eq byte-not
1436 byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
1437 byte-interactive-p)
1438 ;; How about other side-effect-free-ops? Is it safe to move an
1439 ;; error invocation (such as from nth) out of an unwind-protect?
1440 ;; No, it is not, because the unwind-protect forms can alter
1441 ;; the inside of the object to which nth would apply.
1442 ;; For the same reason, byte-equal was deleted from this list.
1447 byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
1448 byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
1449 byte-point-min byte-following-char byte-preceding-char
1450 byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
1451 byte-current-buffer byte-stack-ref))
1456 byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
1457 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
1458 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
1460 byte-member byte-assq byte-quo byte-rem)
1461 byte-compile-side-effect-and-error-free-ops))
1463 ;; This crock is because of the way DEFVAR_BOOL variables work.
1464 ;; Consider the code
1465 ;;
1466 ;; (defun foo (flag)
1467 ;; (let ((old-pop-ups pop-up-windows)
1468 ;; (pop-up-windows flag))
1469 ;; (cond ((not (eq pop-up-windows old-pop-ups))
1470 ;; (setq old-pop-ups pop-up-windows)
1471 ;; ...))))
1472 ;;
1473 ;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
1474 ;; something else. But if we optimize
1475 ;;
1476 ;; varref flag
1477 ;; varbind pop-up-windows
1478 ;; varref pop-up-windows
1479 ;; not
1480 ;; to
1481 ;; varref flag
1482 ;; dup
1483 ;; varbind pop-up-windows
1484 ;; not
1485 ;;
1486 ;; we break the program, because it will appear that pop-up-windows and
1487 ;; old-pop-ups are not EQ when really they are. So we have to know what
1488 ;; the BOOL variables are, and not perform this optimization on them.
1490 ;; The variable `byte-boolean-vars' is now primitive and updated
1491 ;; automatically by DEFVAR_BOOL.
1494 "Simple peephole optimizer. LAP is both modified and returned.
1495 If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
1497 lap1
1498 lap2
1501 rest tmp tmp2 tmp3
1503 byte-compile-side-effect-free-ops
1504 byte-compile-side-effect-and-error-free-ops)))
1509 keep-going nil)
1515 ;; You may notice that sequences like "dup varset discard" are
1516 ;; optimized but sequences like "dup varset TAG1: discard" are not.
1517 ;; You may be tempted to change this; resist that temptation.
1519 ;; <side-effect-free> pop --> <deleted>
1520 ;; ...including:
1521 ;; const-X pop --> <deleted>
1522 ;; varref-X pop --> <deleted>
1523 ;; dup pop --> <deleted>
1524 ;;
1544 ;;
1545 ;; goto*-X X: --> X:
1546 ;;
1561 ;;
1562 ;; varset-X varref-X --> dup varset-X
1563 ;; varbind-X varref-X --> dup varbind-X
1564 ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
1565 ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
1566 ;; The latter two can enable other optimizations.
1567 ;;
1568 ;; For lexical variables, we could do the same
1569 ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2
1570 ;; but this is a very minor gain, since dup is stack-ref-0,
1571 ;; i.e. it's only better if X>5, and even then it comes
1572 ;; at the cost of an extra stack slot. Let's not bother.
1578 nil
1588 lap0 lap1 lap2 lap0 lap1
1596 ;; The stack depth gets locally increased, so we will
1597 ;; increase maxdepth in case depth = maxdepth here.
1598 ;; This can cause the third argument to byte-code to
1599 ;; be larger than necessary.
1601 ;;
1602 ;; dup varset-X discard --> varset-X
1603 ;; dup varbind-X discard --> varbind-X
1604 ;; dup stack-set-X discard --> stack-set-X-1
1605 ;; (the varbind variant can emerge from other optimizations)
1606 ;;
1610 byte-stack-set)))
1616 ;;
1617 ;; not goto-X-if-nil --> goto-X-if-non-nil
1618 ;; not goto-X-if-non-nil --> goto-X-if-nil
1619 ;;
1620 ;; it is wrong to do the same thing for the -else-pop variants.
1621 ;;
1625 lap1
1628 'byte-goto-if-not-nil
1632 'byte-goto-if-not-nil
1636 ;;
1637 ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
1638 ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
1639 ;;
1640 ;; it is wrong to do the same thing for the -else-pop variants.
1641 ;;
1649 lap0 lap1 lap2
1654 ;;
1655 ;; const goto-if-* --> whatever
1656 ;;
1659 ;; If the `byte-constant's cdr is not a cons cell, it has
1660 ;; to be an index into the constant pool); even though
1661 ;; it'll be a constant, that constant is not known yet
1662 ;; (it's typically a free variable of a closure, so will
1663 ;; only be known when the closure will be built at
1664 ;; run-time).
1667 byte-goto-if-nil-else-pop))
1671 lap0 lap1)
1676 lap0 lap1
1682 ;;
1683 ;; varref-X varref-X --> varref-X dup
1684 ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
1685 ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup
1686 ;; We don't optimize the const-X variations on this here,
1687 ;; because that would inhibit some goto optimizations; we
1688 ;; optimize the const-X case after all other optimizations.
1689 ;;
1697 t)
1710 lap0 str lap0 lap0 str)))
1715 ;;
1716 ;; TAG1: TAG2: --> TAG1: <deleted>
1717 ;; (and other references to TAG2 are replaced with TAG1)
1718 ;;
1729 keep-going t))
1730 ;;
1731 ;; unused-TAG: --> <deleted>
1732 ;;
1738 keep-going t))
1739 ;;
1740 ;; goto ... --> goto <delete until TAG or end>
1741 ;; return ... --> return <delete until TAG or end>
1742 ;;
1748 str deleted)
1763 lap0
1769 tagstr lap0 tagstr))))
1772 ;;
1773 ;; <safe-op> unbind --> unbind <safe-op>
1774 ;; (this may enable other optimizations.)
1775 ;;
1782 ;;
1783 ;; varbind-X unbind-N --> discard unbind-(N-1)
1784 ;; save-excursion unbind-N --> unbind-(N-1)
1785 ;; save-restriction unbind-N --> unbind-(N-1)
1786 ;;
1789 byte-save-restriction))
1806 ;;
1807 ;; goto*-X ... X: goto-Y --> goto*-Y
1808 ;; goto-X ... X: return --> return
1809 ;;
1822 ;;
1823 ;; goto-*-else-pop X ... X: goto-if-* --> whatever
1824 ;; goto-*-else-pop X ... X: discard --> whatever
1825 ;;
1827 byte-goto-if-not-nil-else-pop))
1834 byte-goto-if-nil)
1836 byte-goto-if-not-nil))))
1842 ;; Get rid of the -else-pop's and jump one step further.
1851 ;;
1852 ;; const goto-X ... X: goto-if-* --> whatever
1853 ;; const goto-X ... X: discard --> whatever
1854 ;;
1867 byte-goto-if-not-nil-else-pop))))
1869 lap0 tmp2 lap0 tmp2)
1872 ;; Let next step fix the (const,goto-if*) sequence.
1877 ;; Jump one step further
1880 lap0 tmp2)
1887 ;;
1888 ;; X: varref-Y ... varset-Y goto-X -->
1889 ;; X: varref-Y Z: ... dup varset-Y goto-Z
1890 ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
1891 ;; (This is so usual for while loops that it is worth handling).
1892 ;;
1893 ;; Here again, we could do it for stack-ref/stack-set, but
1894 ;; that's replacing a stack-ref-Y with a stack-ref-0, which
1895 ;; is a very minor improvement (if any), at the cost of
1896 ;; more stack use and more byte-code. Let's not do it.
1897 ;;
1905 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
1910 lap1 lap2
1914 )
1919 ;;
1920 ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
1921 ;; (This can pull the loop test to the end of the loop)
1922 ;;
1929 byte-goto-if-nil-else-pop)))
1930 ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
1931 ;; lap0 lap1 (cdr lap0) (car tmp))
1940 byte-goto-if-not-nil-else-pop)
1942 byte-goto-if-nil-else-pop))))
1943 newtag)
1946 )
1949 ;; We can handle this case but not the -if-not-nil case,
1950 ;; because we won't know which non-nil constant to push.
1956 byte-goto-if-not-nil
1957 byte-goto-if-nil
1958 byte-goto-if-not-nil
1959 byte-goto byte-goto))))
1960 )
1962 )
1964 )
1965 ;; Cleanup stage:
1966 ;; Rebuild byte-compile-constants / byte-compile-variables.
1967 ;; Simple optimizations that would inhibit other optimizations if they
1968 ;; were done in the optimizing loop, and optimizations which there is no
1969 ;; need to do more than once.
1971 byte-compile-variables nil)
1981 byte-compile-constants)))
1984 byte-compile-variables)))))
1986 ;; const-C varset-X const-C --> const-C dup varset-X
1987 ;; const-C varbind-X const-C --> const-C dup varbind-X
1988 ;;
1994 lap0 lap1 lap0 lap0 lap1)
1998 ;;
1999 ;; const-X [dup/const-X ...] --> const-X [dup ...] dup
2000 ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup
2001 ;;
2004 tmp2 nil)
2014 ;;
2015 ;; unbind-N unbind-M --> unbind-(N+M)
2016 ;;
2025 ;;
2026 ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
2027 ;; stack-set-M [discard/discardN ...] --> discardN
2028 ;;
2032 ;; See if enough discard operations follow to expose or
2033 ;; destroy the value stored by the stack-set.
2040 1
2044 ;; Do the optimization.
2048 ;; The value stored is the new TOS, so pop one more
2049 ;; value (to get rid of the old value) using the
2050 ;; TOS-preserving discard operator.
2051 'byte-discardN-preserve-tos
2052 ;; Otherwise, the value stored is lost, so just use a
2053 ;; normal discard.
2058 lap0 lap1))
2060 ;;
2061 ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y -->
2062 ;; discardN-(X+Y)
2063 ;;
2066 byte-discardN-preserve-tos))
2071 lap0 lap1
2078 ;;
2079 ;; discardN-preserve-tos-X discardN-preserve-tos-Y -->
2080 ;; discardN-preserve-tos-(X+Y)
2081 ;;
2088 ;;
2089 ;; discardN-preserve-tos return --> return
2090 ;; dup return --> return
2091 ;; stack-set-N return --> return ; where N is TOS-1
2092 ;;
2097 ;; The byte-code interpreter will pop the stack for us, so
2098 ;; we can just leave stuff on it.
2101 )
2104 lap)
2108 \f
2109 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
2110 ;; itself, compile some of its most used recursive functions (at load time).
2111 ;;
2122 byte-optimize-body
2123 byte-optimize-predicate
2124 byte-optimize-binary-predicate
2125 ;; Inserted some more than necessary, to speed it up.
2126 byte-optimize-form-code-walker
2127 byte-optimize-lapcode))))
2128 nil)
2130 ;;; byte-opt.el ends here