| blob | 9ce3c2eb323299bf17eeb6887a223c2bda9b8289 |
1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
3 ;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
4 ;; 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
6 ;; Author: Jamie Zawinski <jwz@lucid.com>
7 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
8 ;; Maintainer: FSF
9 ;; Keywords: internal
10 ;; Package: emacs
12 ;; This file is part of GNU Emacs.
14 ;; GNU Emacs is free software: you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation, either version 3 of the License, or
17 ;; (at your option) any later version.
19 ;; GNU Emacs is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 ;; GNU General Public License for more details.
24 ;; You should have received a copy of the GNU General Public License
25 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
27 ;;; Commentary:
29 ;; ========================================================================
30 ;; "No matter how hard you try, you can't make a racehorse out of a pig.
31 ;; You can, however, make a faster pig."
32 ;;
33 ;; Or, to put it another way, the Emacs byte compiler is a VW Bug. This code
34 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're
35 ;; still not going to make it go faster than 70 mph, but it might be easier
36 ;; to get it there.
37 ;;
39 ;; TO DO:
40 ;;
41 ;; (apply (lambda (x &rest y) ...) 1 (foo))
42 ;;
43 ;; maintain a list of functions known not to access any global variables
44 ;; (actually, give them a 'dynamically-safe property) and then
45 ;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==>
46 ;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
47 ;; by recursing on this, we might be able to eliminate the entire let.
48 ;; However certain variables should never have their bindings optimized
49 ;; away, because they affect everything.
50 ;; (put 'debug-on-error 'binding-is-magic t)
51 ;; (put 'debug-on-abort 'binding-is-magic t)
52 ;; (put 'debug-on-next-call 'binding-is-magic t)
53 ;; (put 'inhibit-quit 'binding-is-magic t)
54 ;; (put 'quit-flag 'binding-is-magic t)
55 ;; (put 't 'binding-is-magic t)
56 ;; (put 'nil 'binding-is-magic t)
57 ;; possibly also
58 ;; (put 'gc-cons-threshold 'binding-is-magic t)
59 ;; (put 'track-mouse 'binding-is-magic t)
60 ;; others?
61 ;;
62 ;; Simple defsubsts often produce forms like
63 ;; (let ((v1 (f1)) (v2 (f2)) ...)
64 ;; (FN v1 v2 ...))
65 ;; It would be nice if we could optimize this to
66 ;; (FN (f1) (f2) ...)
67 ;; but we can't unless FN is dynamically-safe (it might be dynamically
68 ;; referring to the bindings that the lambda arglist established.)
69 ;; One of the uncountable lossages introduced by dynamic scope...
70 ;;
71 ;; Maybe there should be a control-structure that says "turn on
72 ;; fast-and-loose type-assumptive optimizations here." Then when
73 ;; we see a form like (car foo) we can from then on assume that
74 ;; the variable foo is of type cons, and optimize based on that.
75 ;; But, this won't win much because of (you guessed it) dynamic
76 ;; scope. Anything down the stack could change the value.
77 ;; (Another reason it doesn't work is that it is perfectly valid
78 ;; to call car with a null argument.) A better approach might
79 ;; be to allow type-specification of the form
80 ;; (put 'foo 'arg-types '(float (list integer) dynamic))
81 ;; (put 'foo 'result-type 'bool)
82 ;; It should be possible to have these types checked to a certain
83 ;; degree.
84 ;;
85 ;; collapse common subexpressions
86 ;;
87 ;; It would be nice if redundant sequences could be factored out as well,
88 ;; when they are known to have no side-effects:
89 ;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2
90 ;; but beware of traps like
91 ;; (cons (list x y) (list x y))
92 ;;
93 ;; Tail-recursion elimination is not really possible in Emacs Lisp.
94 ;; Tail-recursion elimination is almost always impossible when all variables
95 ;; have dynamic scope, but given that the "return" byteop requires the
96 ;; binding stack to be empty (rather than emptying it itself), there can be
97 ;; no truly tail-recursive Emacs Lisp functions that take any arguments or
98 ;; make any bindings.
99 ;;
100 ;; Here is an example of an Emacs Lisp function which could safely be
101 ;; byte-compiled tail-recursively:
102 ;;
103 ;; (defun tail-map (fn list)
104 ;; (cond (list
105 ;; (funcall fn (car list))
106 ;; (tail-map fn (cdr list)))))
107 ;;
108 ;; However, if there was even a single let-binding around the COND,
109 ;; it could not be byte-compiled, because there would be an "unbind"
110 ;; byte-op between the final "call" and "return." Adding a
111 ;; Bunbind_all byteop would fix this.
112 ;;
113 ;; (defun foo (x y z) ... (foo a b c))
114 ;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
115 ;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
116 ;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
117 ;;
118 ;; this also can be considered tail recursion:
119 ;;
120 ;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
121 ;; could generalize this by doing the optimization
122 ;; (goto X) ... X: (return) --> (return)
123 ;;
124 ;; But this doesn't solve all of the problems: although by doing tail-
125 ;; recursion elimination in this way, the call-stack does not grow, the
126 ;; binding-stack would grow with each recursive step, and would eventually
127 ;; overflow. I don't believe there is any way around this without lexical
128 ;; scope.
129 ;;
130 ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
131 ;;
132 ;; Idea: the form (lexical-scope) in a file means that the file may be
133 ;; compiled lexically. This proclamation is file-local. Then, within
134 ;; that file, "let" would establish lexical bindings, and "let-dynamic"
135 ;; would do things the old way. (Or we could use CL "declare" forms.)
136 ;; We'd have to notice defvars and defconsts, since those variables should
137 ;; always be dynamic, and attempting to do a lexical binding of them
138 ;; should simply do a dynamic binding instead.
139 ;; But! We need to know about variables that were not necessarily defvarred
140 ;; in the file being compiled (doing a boundp check isn't good enough.)
141 ;; Fdefvar() would have to be modified to add something to the plist.
142 ;;
143 ;; A major disadvantage of this scheme is that the interpreter and compiler
144 ;; would have different semantics for files compiled with (dynamic-scope).
145 ;; Since this would be a file-local optimization, there would be no way to
146 ;; modify the interpreter to obey this (unless the loader was hacked
147 ;; in some grody way, but that's a really bad idea.)
149 ;; Other things to consider:
151 ;; ;; Associative math should recognize subcalls to identical function:
152 ;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
153 ;; ;; This should generate the same as (1+ x) and (1- x)
155 ;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
156 ;; ;; An awful lot of functions always return a non-nil value. If they're
157 ;; ;; error free also they may act as true-constants.
159 ;; (disassemble (lambda (x) (and (point) (foo))))
160 ;; ;; When
161 ;; ;; - all but one arguments to a function are constant
162 ;; ;; - the non-constant argument is an if-expression (cond-expression?)
163 ;; ;; then the outer function can be distributed. If the guarding
164 ;; ;; condition is side-effect-free [assignment-free] then the other
165 ;; ;; arguments may be any expressions. Since, however, the code size
166 ;; ;; can increase this way they should be "simple". Compare:
168 ;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
169 ;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
171 ;; ;; (car (cons A B)) -> (prog1 A B)
172 ;; (disassemble (lambda (x) (car (cons (foo) 42))))
174 ;; ;; (cdr (cons A B)) -> (progn A B)
175 ;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
177 ;; ;; (car (list A B ...)) -> (prog1 A B ...)
178 ;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
180 ;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
181 ;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
184 ;;; Code:
190 ;; (if (aref byte-code-vector 0)
191 ;; (error "The old version of the disassembler is loaded. Reload new-bytecomp as well"))
200 arg)
216 c
218 args)))))
224 \f
225 ;;; byte-compile optimizers to support inlining
230 "byte-optimize-handler for the `inline' special-form."
243 sexp)))
247 ;; Splice the given lap code into the current instruction stream.
248 ;; If it has any labels in it, you're responsible for making sure there
249 ;; are no collisions, and that byte-compile-tag-number is reasonable
250 ;; after this is spliced in. The provided list is destroyed.
261 name)
262 form)
263 ;; else
276 ;; Isn't it an error for `string' not to be unibyte?? --stef
279 ;; `byte-compile-splice-in-already-compiled-code'
280 ;; takes care of inlining the body.
286 byte-compile-macro-environment)
287 ;; Give up on inlining.
288 form))))))
290 ;; ((lambda ...) ...)
301 optionalp restp
302 bindings)
309 ;; ok, I'll let this slide because funcall_lambda() does...
310 ;; (if optionalp (error "multiple &optional keywords in %s" name))
316 ;; ...but it is by no stretch of the imagination a reasonable
317 ;; thing that funcall_lambda() allows (&rest x y) and
318 ;; (&rest x &optional y) in arglists.
327 bindings)
328 values nil))
334 bindings)
342 form)
344 ;; The following leads to infinite recursion when loading a
345 ;; file containing `(defsubst f () (f))', and then trying to
346 ;; byte-compile that file.
347 ;(setq body (mapcar 'byte-optimize-form body)))
354 newform)))))
356 \f
357 ;;; implementing source-level optimizers
360 ;;
361 ;; For normal function calls, We can just mapcar the optimizer the cdr. But
362 ;; we need to have special knowledge of the syntax of the special forms
363 ;; like let and defun (that's why they're special forms :-). (Actually,
364 ;; the important aspect is that they are subrs that don't evaluate all of
365 ;; their args.)
366 ;;
368 tmp)
374 form))
379 ;; map (quote nil) to nil to simplify optimizer logic.
380 ;; map quoted constants to nil if for-effect (just because).
383 form))
388 for-effect))
390 ;; recursively enter the optimizer for the bindings and body
391 ;; of a let or let*. This for depth-firstness: forms that
392 ;; are more deeply nested are optimized first.
397 binding
414 clause))
417 ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
436 ;; those subrs which have an implicit progn; it's not quite good
437 ;; enough to treat these like normal function calls.
438 ;; This can turn (save-excursion ...) into (save-excursion) which
439 ;; will be optimized away in the lap-optimize pass.
443 ;; this is just like the above, except for the first argument.
459 ;; take forms off the back until we can't any more.
460 ;; In the future it could conceivably be a problem that the
461 ;; subexpressions of these forms are optimized in the reverse
462 ;; order, but it's ok for now.
468 for-effect))))
480 nil)
483 condition-case save-window-excursion))
484 ;; These forms are compiled as constants or by breaking out
485 ;; all the subexpressions and compiling them separately.
486 form)
489 ;; the "protected" part of an unwind-protect is compiled (and thus
490 ;; optimized) as a top-level form, so don't do it here. But the
491 ;; non-protected part has the same for-effect status as the
492 ;; unwind-protect itself. (The protected part is always for effect,
493 ;; but that isn't handled properly yet.)
499 ;; the body of a catch is compiled (and thus optimized) as a
500 ;; top-level form, so don't do it here. The tag is never
501 ;; for-effect. The body should have the same for-effect status
502 ;; as the catch form itself, but that isn't handled properly yet.
508 ;; Don't treat the args to `ignore' as being
509 ;; computed for effect. We want to avoid the warnings
510 ;; that might occur if they were treated that way.
511 ;; However, don't actually bother calling `ignore'.
514 ;; If optimization is on, this is the only place that macros are
515 ;; expanded. If optimization is off, then macroexpansion happens
516 ;; in byte-compile-form. Otherwise, the macros are already expanded
517 ;; by the time that is reached.
520 byte-compile-macro-environment))))
523 ;; Support compiler macros as in cl.el.
535 form)
540 ;; Detect the expansion of (pop foo).
541 ;; There is no need to compile the call to `car' there.
555 nil)))
557 ;; appending a nil here might not be necessary, but it can't hurt.
562 ;; Otherwise, no args can be considered to be for-effect,
563 ;; even if the called function is for-effect, because we
564 ;; don't know anything about that function.
572 "Non-nil if all elements of LIST satisfy `byte-compile-constp'."
578 constant))
581 "The source-level pass of the optimizer."
582 ;;
583 ;; First, optimize all sub-forms of this one.
585 ;;
586 ;; after optimizing all subforms, optimize this form until it doesn't
587 ;; optimize any further. This means that some forms will be passed through
588 ;; the optimizer many times, but that's necessary to make the for-effect
589 ;; processing do as much as possible.
590 ;;
595 ;; we don't have any of these yet, but we might.
600 ;; (if (equal form new) (error "bogus optimizer -- %s" opt))
603 new)
604 form)))
608 ;; optimize the cdr of a progn or implicit progn; all forms is a list of
609 ;; forms, all but the last of which are optimized with the assumption that
610 ;; they are being called for effect. the last is for-effect as well if
611 ;; all-for-effect is true. returns a new list of forms.
614 fe new)
623 \f
624 ;; some source-level optimizers
625 ;;
626 ;; when writing optimizers, be VERY careful that the optimizer returns
627 ;; something not EQ to its argument if and ONLY if it has made a change.
628 ;; This implies that you cannot simply destructively modify the list;
629 ;; you must return something not EQ to it if you make an optimization.
630 ;;
631 ;; It is now safe to optimize code such that it introduces new bindings.
634 "Return non-nil if FORM always evaluates to a non-nil value."
640 ;; Can't use recursion in a defsubst.
641 ;; (progn (byte-compile-trueconstp (car (last (cdr form)))))
642 ))
648 "Return non-nil if FORM always evaluates to a nil value."
654 ;; Can't use recursion in a defsubst.
655 ;; (progn (byte-compile-nilconstp (car (last (cdr form)))))
656 ))
660 ;; If the function is being called with constant numeric args,
661 ;; evaluate as much as possible at compile-time. This optimizer
662 ;; assumes that the function is associative, like + or *.
680 form)))
682 ;; If the function is being called with constant numeric args,
683 ;; evaluate as much as possible at compile-time. This optimizer
684 ;; assumes that the function satisfies
685 ;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
686 ;; like - and /.
690 form
698 constant))))
700 ;;(defun byte-optimize-associative-two-args-math (form)
701 ;; (setq form (byte-optimize-associative-math form))
702 ;; (if (consp form)
703 ;; (byte-optimize-two-args-left form)
704 ;; form))
706 ;;(defun byte-optimize-nonassociative-two-args-math (form)
707 ;; (setq form (byte-optimize-nonassociative-math form))
708 ;; (if (consp form)
709 ;; (byte-optimize-two-args-right form)
710 ;; form))
715 ;; Collect all the constants from FORM, after the STARTth arg,
716 ;; and apply FUN to them to make one argument at the end.
717 ;; For functions that can handle floats, that optimization
718 ;; can be incorrect because reordering can cause an overflow
719 ;; that would otherwise be avoided by encountering an arg that is a float.
720 ;; We avoid this problem by (1) not moving float constants and
721 ;; (2) not moving anything if it would cause an overflow.
723 ;; Merge all FORM's constants from number START, call FUN on them
724 ;; and put the result at the end.
727 ;; t means we must check for overflow.
738 ;; If necessary, check now for overflow
739 ;; that might be caused by reordering.
741 ;; We have overflow if the result of doing the arithmetic
742 ;; on floats is not even close to the result
743 ;; of doing it on integers.
750 form))
756 ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
757 ;;(setq form (byte-optimize-delay-constants-math form 1 '+))
759 ;; For (+ constants...), byte-optimize-predicate does the work.
762 ;; (+ x 1) --> (1+ x) and (+ x -1) --> (1- x).
772 ;; Here, we could also do
773 ;; (+ x y ... 1) --> (1+ (+ x y ...))
774 ;; (+ x y ... -1) --> (1- (+ x y ...))
775 ;; The resulting bytecode is smaller, but is it faster? -- cyd
776 ))
780 ;; Don't call `byte-optimize-delay-constants-math' (bug#1334).
781 ;;(setq form (byte-optimize-delay-constants-math form 2 '+))
782 ;; Remove zeros.
787 ;; After the above, we must turn (- x) back into (- x 0)
790 ;; For (- constants..), byte-optimize-predicate does the work.
793 ;; (- x 1) --> (1- x)
796 ;; (- x -1) --> (1+ x)
799 ;; (- 0 x) --> (- x)
803 ;; Here, we could also do
804 ;; (- x y ... 1) --> (1- (- x y ...))
805 ;; (- x y ... -1) --> (1+ (- x y ...))
806 ;; The resulting bytecode is smaller, but is it faster? -- cyd
807 ))
812 ;; For (* constants..), byte-optimize-predicate does the work.
814 ;; After `byte-optimize-predicate', if there is a INTEGER constant
815 ;; in FORM, it is in the last element.
818 ;; Would handling (* ... 0) here cause floating point errors?
819 ;; See bug#1334.
829 ;; After `byte-optimize-predicate', if there is a INTEGER constant
830 ;; in FORM, it is in the last element.
833 ;; Runtime error (leave it intact).
837 ;; No constants in expression
839 ;; For (* constants..), byte-optimize-predicate does the work.
841 ;; (/ x y.. 1) --> (/ x y..)
844 ;; (/ x -1), (/ x .. -1) --> (- x), (- (/ x ..))
870 ;; This can enable some lapcode optimizations.
872 form))
884 form)))
892 form))
936 ;; I'm not convinced that this is necessary. Doesn't the optimizer loop
937 ;; take care of this? - Jamie
938 ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
939 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard
945 form
958 ;; Simplify if less than 2 args.
959 ;; if there is a literal nil in the args to `and', throw it and following
960 ;; forms away, and surround the `and' with (progn ... nil).
969 nil))
975 ;; Throw away nil's, and simplify if less than 2 args.
976 ;; If there is a literal non-nil constant in the args to `or', throw away all
977 ;; following forms.
990 ;; if any clauses have a literal nil as their test, throw them away.
991 ;; if any clause has a literal non-nil constant as its test, throw
992 ;; away all following clauses.
994 ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
1002 ;; This branch will always be taken: kill the subsequent ones.
1011 ;; This branch will never be taken: kill its body.
1013 ;;
1014 ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
1022 form))
1023 form))
1026 ;; (if (progn <insts> <test>) <rest>) ==> (progn <insts> (if <test> <rest>))
1027 ;; (if <true-constant> <then> <else...>) ==> <then>
1028 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
1029 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
1030 ;; (if <test> <then> nil) ==> (if <test> <then>)
1033 ;; `clause' is a proper list.
1036 ;; A trivial `progn'.
1049 form))
1052 ;; Don't make a double negative;
1053 ;; instead, take away the one that is there.
1068 form))
1076 ;; byte-compile-negation-optimizer lives in bytecomp.el
1083 ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
1084 ;; (funcall foo ...) ==> (foo ...)
1088 form)))
1091 ;; If the last arg is a literal constant, turn this into a funcall.
1092 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
1102 "last arg to apply can't be a literal atom: `%s'"
1104 nil))
1105 form)))
1115 ;; No bindings
1118 form)
1119 ;; The body is nil
1136 form))
1146 form)
1148 form))
1150 ;; Fixme: delete-char -> delete-region (byte-coded)
1151 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
1152 ;; string-make-multibyte for constant args.
1156 ;; Emacs-21's byte-code doesn't run under XEmacs or SXEmacs anyway, so we
1157 ;; can safely optimize away this test.
1159 nil
1161 t
1162 form)))
1175 \f
1176 ;; enumerating those functions which need not be called if the returned
1177 ;; value is not used. That is, something like
1178 ;; (progn (list (something-with-side-effects) (yow))
1179 ;; (foo))
1180 ;; may safely be turned into
1181 ;; (progn (progn (something-with-side-effects) (yow))
1182 ;; (foo))
1183 ;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
1185 ;; Some of these functions have the side effect of allocating memory
1186 ;; and it would be incorrect to replace two calls with one.
1187 ;; But we don't try to do those kinds of optimizations,
1188 ;; so it is safe to list such functions here.
1189 ;; Some of these functions return values that depend on environment
1190 ;; state, so that constant folding them would be wrong,
1191 ;; but we don't do constant folding based on this list.
1193 ;; However, at present the only optimization we normally do
1194 ;; is delete calls that need not occur, and we only do that
1195 ;; with the error-free functions.
1197 ;; I wonder if I missed any :-\)
1200 assoc assq
1201 boundp buffer-file-name buffer-local-variables buffer-modified-p
1202 buffer-substring byte-code-function-p
1203 capitalize car-less-than-car car cdr ceiling char-after char-before
1204 char-equal char-to-string char-width
1205 compare-strings concat coordinates-in-window-p
1206 copy-alist copy-sequence copy-marker cos count-lines
1207 decode-char
1208 decode-time default-boundp default-value documentation downcase
1209 elt encode-char exp expt encode-time error-message-string
1210 fboundp fceiling featurep ffloor
1211 file-directory-p file-exists-p file-locked-p file-name-absolute-p
1212 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
1213 float float-time floor format format-time-string frame-visible-p
1214 fround ftruncate
1215 get gethash get-buffer get-buffer-window getenv get-file-buffer
1216 hash-table-count
1217 int-to-string intern-soft
1218 keymap-parent
1219 length local-variable-if-set-p local-variable-p log log10 logand
1220 logb logior lognot logxor lsh langinfo
1221 make-list make-string make-symbol
1222 marker-buffer max member memq min mod multibyte-char-to-unibyte
1223 next-window nth nthcdr number-to-string
1224 parse-colon-path plist-get plist-member
1225 prefix-numeric-value previous-window prin1-to-string propertize
1226 degrees-to-radians
1227 radians-to-degrees rassq rassoc read-from-string regexp-quote
1228 region-beginning region-end reverse round
1230 string-to-int string-to-number substring sxhash symbol-function
1231 symbol-name symbol-plist symbol-value string-make-unibyte
1232 string-make-multibyte string-as-multibyte string-as-unibyte
1233 string-to-multibyte
1234 tan truncate
1235 unibyte-char-to-multibyte upcase user-full-name
1236 user-login-name user-original-login-name user-variable-p
1237 vconcat
1238 window-buffer window-dedicated-p window-edges window-height
1239 window-hscroll window-minibuffer-p window-width
1240 zerop))
1243 bobp bolp bool-vector-p
1244 buffer-end buffer-list buffer-size buffer-string bufferp
1245 car-safe case-table-p cdr-safe char-or-string-p characterp
1246 charsetp commandp cons consp
1247 current-buffer current-global-map current-indentation
1248 current-local-map current-minor-mode-maps current-time
1249 current-time-string current-time-zone
1250 eobp eolp eq equal eventp
1251 floatp following-char framep
1252 get-largest-window get-lru-window
1253 hash-table-p
1254 identity ignore integerp integer-or-marker-p interactive-p
1255 invocation-directory invocation-name
1256 keymapp
1257 line-beginning-position line-end-position list listp
1258 make-marker mark mark-marker markerp max-char
1259 memory-limit minibuffer-window
1260 mouse-movement-p
1261 natnump nlistp not null number-or-marker-p numberp
1262 one-window-p overlayp
1263 point point-marker point-min point-max preceding-char primary-charset
1264 processp
1265 recent-keys recursion-depth
1266 safe-length selected-frame selected-window sequencep
1267 standard-case-table standard-syntax-table stringp subrp symbolp
1268 syntax-table syntax-table-p
1269 this-command-keys this-command-keys-vector this-single-command-keys
1270 this-single-command-raw-keys
1271 user-real-login-name user-real-uid user-uid
1272 vector vectorp visible-frame-list
1273 wholenump window-configuration-p window-live-p windowp)))
1280 nil)
1282 \f
1283 ;; pure functions are side-effect free functions whose values depend
1284 ;; only on their arguments. For these functions, calls with constant
1285 ;; arguments can be evaluated at compile time. This may shift run time
1286 ;; errors to compile time.
1293 nil)
1296 ;; form is (byte-code "..." [...] n)
1302 byte-compile-maxdepth))
1307 \f
1311 ;; This function extracts the bitfields from variable-length opcodes.
1312 ;; Originally defined in disass.el (which no longer uses it.)
1315 "Don't call this!"
1316 ;; fetch and return the offset for the current opcode.
1317 ;; return nil if this opcode has no offset
1318 ;; OP, PTR and BYTES are used and set dynamically
1350 ;; This de-compiler is used for inline expansion of compiled functions,
1351 ;; and by the disassembler.
1352 ;;
1353 ;; This list contains numbers, which are pc values,
1354 ;; before each instruction.
1356 "Turn BYTECODE into lapcode, referring to CONSTVEC."
1362 ;; As byte-decompile-bytecode, but updates
1363 ;; byte-compile-{constants, variables, tag-number}.
1364 ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
1365 ;; with `goto's destined for the end of the code.
1366 ;; That is for use by the compiler.
1367 ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
1368 ;; In that case, we put a pc value into the list
1369 ;; before each insn (or its label).
1373 lap tmp
1374 endtag)
1379 optr ptr
1383 ;; it's a pc
1389 tags)))))))
1400 byte-compile-variables)))))))
1410 ;; The top bit of the operand for byte-discardN is a flag,
1411 ;; saying whether the top-of-stack is preserved. In
1412 ;; lapcode, we represent this by using a different opcode
1413 ;; (with the flag removed from the operand).
1416 ;; lap = ( [ (pc . (op . arg)) ]* )
1418 lap))
1420 ;; take off the dummy nil op that we replaced a trailing "return" with.
1425 ;; this addr is jumped to
1436 ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
1439 elt
1443 \f
1444 ;;; peephole optimizer
1450 byte-goto-if-not-nil-else-pop))
1454 byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
1455 byte-eq byte-not
1456 byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
1457 byte-interactive-p)
1458 ;; How about other side-effect-free-ops? Is it safe to move an
1459 ;; error invocation (such as from nth) out of an unwind-protect?
1460 ;; No, it is not, because the unwind-protect forms can alter
1461 ;; the inside of the object to which nth would apply.
1462 ;; For the same reason, byte-equal was deleted from this list.
1467 byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
1468 byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
1469 byte-point-min byte-following-char byte-preceding-char
1470 byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
1471 byte-current-buffer byte-interactive-p byte-stack-ref))
1476 byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
1477 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
1478 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
1480 byte-member byte-assq byte-quo byte-rem byte-vec-ref)
1481 byte-compile-side-effect-and-error-free-ops))
1483 ;; This crock is because of the way DEFVAR_BOOL variables work.
1484 ;; Consider the code
1485 ;;
1486 ;; (defun foo (flag)
1487 ;; (let ((old-pop-ups pop-up-windows)
1488 ;; (pop-up-windows flag))
1489 ;; (cond ((not (eq pop-up-windows old-pop-ups))
1490 ;; (setq old-pop-ups pop-up-windows)
1491 ;; ...))))
1492 ;;
1493 ;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
1494 ;; something else. But if we optimize
1495 ;;
1496 ;; varref flag
1497 ;; varbind pop-up-windows
1498 ;; varref pop-up-windows
1499 ;; not
1500 ;; to
1501 ;; varref flag
1502 ;; dup
1503 ;; varbind pop-up-windows
1504 ;; not
1505 ;;
1506 ;; we break the program, because it will appear that pop-up-windows and
1507 ;; old-pop-ups are not EQ when really they are. So we have to know what
1508 ;; the BOOL variables are, and not perform this optimization on them.
1510 ;; The variable `byte-boolean-vars' is now primitive and updated
1511 ;; automatically by DEFVAR_BOOL.
1514 "...macro used by byte-optimize-lapcode..."
1518 ;; A tag can encode the expected stack depth.
1520 ;; First, check to see if our notion of the current stack
1521 ;; depth agrees with this tag. We don't check at the
1522 ;; beginning of the function, because the presence of
1523 ;; lexical arguments means the first tag will have a
1524 ;; non-zero offset.
1530 ;; Now set out current depth from this tag
1534 ;; These insns leave us in an unknown state
1537 ;; Not a no-op, set ,stack-adjust for lap0. ,stack-adjust will
1538 ;; be added to ,stack-depth at the end of the loop, so any code
1539 ;; that modifies the instruction sequence must adjust this too.
1543 ))
1546 "Simple peephole optimizer. LAP is both modified and returned.
1547 If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
1549 lap1
1550 lap2
1551 stack-adjust
1552 stack-depth
1559 rest tmp tmp2 tmp3
1561 byte-compile-side-effect-free-ops
1562 byte-compile-side-effect-and-error-free-ops)))
1567 stack-depth initial-stack-depth
1568 keep-going nil)
1576 ;; You may notice that sequences like "dup varset discard" are
1577 ;; optimized but sequences like "dup varset TAG1: discard" are not.
1578 ;; You may be tempted to change this; resist that temptation.
1580 ;; <side-effect-free> pop --> <deleted>
1581 ;; ...including:
1582 ;; const-X pop --> <deleted>
1583 ;; varref-X pop --> <deleted>
1584 ;; dup pop --> <deleted>
1585 ;;
1605 ;;
1606 ;; goto*-X X: --> X:
1607 ;;
1622 ;;
1623 ;; varset-X varref-X --> dup varset-X
1624 ;; varbind-X varref-X --> dup varbind-X
1625 ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
1626 ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
1627 ;; The latter two can enable other optimizations.
1628 ;;
1638 nil
1648 lap0 lap1 lap2 lap0 lap1
1656 ;; The stack depth gets locally increased, so we will
1657 ;; increase maxdepth in case depth = maxdepth here.
1658 ;; This can cause the third argument to byte-code to
1659 ;; be larger than necessary.
1661 ;;
1662 ;; dup varset-X discard --> varset-X
1663 ;; dup varbind-X discard --> varbind-X
1664 ;; (the varbind variant can emerge from other optimizations)
1665 ;;
1674 ;;
1675 ;; not goto-X-if-nil --> goto-X-if-non-nil
1676 ;; not goto-X-if-non-nil --> goto-X-if-nil
1677 ;;
1678 ;; it is wrong to do the same thing for the -else-pop variants.
1679 ;;
1684 lap1
1687 'byte-goto-if-not-nil
1691 'byte-goto-if-not-nil
1696 ;;
1697 ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
1698 ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
1699 ;;
1700 ;; it is wrong to do the same thing for the -else-pop variants.
1701 ;;
1709 lap0 lap1 lap2
1715 ;;
1716 ;; const goto-if-* --> whatever
1717 ;;
1725 lap0 lap1)
1730 lap0 lap1
1737 ;;
1738 ;; varref-X varref-X --> varref-X dup
1739 ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
1740 ;; We don't optimize the const-X variations on this here,
1741 ;; because that would inhibit some goto optimizations; we
1742 ;; optimize the const-X case after all other optimizations.
1743 ;;
1749 t)
1759 lap0 str lap0 lap0 str)))
1765 ;;
1766 ;; TAG1: TAG2: --> TAG1: <deleted>
1767 ;; (and other references to TAG2 are replaced with TAG1)
1768 ;;
1779 keep-going t))
1780 ;;
1781 ;; unused-TAG: --> <deleted>
1782 ;;
1788 keep-going t))
1789 ;;
1790 ;; goto ... --> goto <delete until TAG or end>
1791 ;; return ... --> return <delete until TAG or end>
1792 ;;
1798 str deleted)
1813 lap0
1819 tagstr lap0 tagstr))))
1822 ;;
1823 ;; <safe-op> unbind --> unbind <safe-op>
1824 ;; (this may enable other optimizations.)
1825 ;;
1833 ;;
1834 ;; varbind-X unbind-N --> discard unbind-(N-1)
1835 ;; save-excursion unbind-N --> unbind-(N-1)
1836 ;; save-restriction unbind-N --> unbind-(N-1)
1837 ;;
1840 byte-save-restriction))
1857 ;;
1858 ;; stack-ref-N --> dup ; where N is TOS
1859 ;;
1865 ;;
1866 ;; goto*-X ... X: goto-Y --> goto*-Y
1867 ;; goto-X ... X: return --> return
1868 ;;
1881 ;;
1882 ;; goto-*-else-pop X ... X: goto-if-* --> whatever
1883 ;; goto-*-else-pop X ... X: discard --> whatever
1884 ;;
1886 byte-goto-if-not-nil-else-pop))
1893 byte-goto-if-nil)
1895 byte-goto-if-not-nil))))
1901 ;; Get rid of the -else-pop's and jump one step further.
1910 ;;
1911 ;; const goto-X ... X: goto-if-* --> whatever
1912 ;; const goto-X ... X: discard --> whatever
1913 ;;
1925 byte-goto-if-not-nil-else-pop)))
1927 lap0 tmp2 lap0 tmp2)
1930 ;; Let next step fix the (const,goto-if*) sequence.
1933 ;; Jump one step further
1936 lap0 tmp2)
1944 ;;
1945 ;; X: varref-Y ... varset-Y goto-X -->
1946 ;; X: varref-Y Z: ... dup varset-Y goto-Z
1947 ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
1948 ;; (This is so usual for while loops that it is worth handling).
1949 ;;
1958 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
1963 lap1 lap2
1967 )
1972 ;;
1973 ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
1974 ;; (This can pull the loop test to the end of the loop)
1975 ;;
1982 byte-goto-if-nil-else-pop)))
1983 ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
1984 ;; lap0 lap1 (cdr lap0) (car tmp))
1993 byte-goto-if-not-nil-else-pop)
1995 byte-goto-if-nil-else-pop))))
1996 newtag)
1999 )
2002 ;; We can handle this case but not the -if-not-nil case,
2003 ;; because we won't know which non-nil constant to push.
2009 byte-goto-if-not-nil
2010 byte-goto-if-nil
2011 byte-goto-if-not-nil
2012 byte-goto byte-goto))))
2013 )
2016 )
2021 )
2023 ;; Cleanup stage:
2024 ;; Rebuild byte-compile-constants / byte-compile-variables.
2025 ;; Simple optimizations that would inhibit other optimizations if they
2026 ;; were done in the optimizing loop, and optimizations which there is no
2027 ;; need to do more than once.
2029 byte-compile-variables nil)
2031 stack-depth initial-stack-depth)
2042 byte-compile-constants)))
2045 byte-compile-variables)))))
2047 ;; const-C varset-X const-C --> const-C dup varset-X
2048 ;; const-C varbind-X const-C --> const-C dup varbind-X
2049 ;;
2055 lap0 lap1 lap0 lap0 lap1)
2059 ;;
2060 ;; const-X [dup/const-X ...] --> const-X [dup ...] dup
2061 ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup
2062 ;;
2065 tmp2 nil)
2075 ;;
2076 ;; unbind-N unbind-M --> unbind-(N+M)
2077 ;;
2086 ;;
2087 ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos
2088 ;; stack-set-M [discard/discardN ...] --> discardN
2089 ;;
2093 ;; See if enough discard operations follow to expose or
2094 ;; destroy the value stored by the stack-set.
2104 ;; Do the optimization
2107 ;; The value stored is the new TOS, so pop one more value
2108 ;; (to get rid of the old value) using the TOS-preserving
2109 ;; discard operator.
2113 ;; Otherwise, the value stored is lost, so just use a
2114 ;; normal discard.
2120 lap0 lap1))
2122 ;;
2123 ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y -->
2124 ;; discardN-(X+Y)
2125 ;;
2128 byte-discardN
2129 byte-discardN-preserve-tos))
2134 lap0 lap1
2142 ;;
2143 ;; discardN-preserve-tos-X discardN-preserve-tos-Y -->
2144 ;; discardN-preserve-tos-(X+Y)
2145 ;;
2153 ;;
2154 ;; discardN-preserve-tos return --> return
2155 ;; dup return --> return
2156 ;; stack-set-N return --> return ; where N is TOS-1
2157 ;;
2162 ;; the byte-code interpreter will pop the stack for us, so
2163 ;; we can just leave stuff on it
2168 ;;
2169 ;; dup stack-set-N return --> return ; where N is TOS
2170 ;;
2179 )
2186 lap)
2190 \f
2191 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
2192 ;; itself, compile some of its most used recursive functions (at load time).
2193 ;;
2204 byte-optimize-body
2205 byte-optimize-predicate
2206 byte-optimize-binary-predicate
2207 ;; Inserted some more than necessary, to speed it up.
2208 byte-optimize-form-code-walker
2209 byte-optimize-lapcode))))
2210 nil)
2212 ;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1
2213 ;;; byte-opt.el ends here