| blob | 80f3bedc0ef7d57e0386a80b0153b4c59910f41d |
1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
3 ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.
5 ;; Author: Jamie Zawinski <jwz@lucid.com>
6 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
7 ;; Keywords: internal
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
26 ;;; Commentary:
28 ;;; This file has been censored by the Communications Decency Act.
29 ;;; That law was passed under the guise of a ban on pornography, but
30 ;;; it bans far more than that. This file did not contain pornography,
31 ;;; but it was censored nonetheless.
33 ;;; For information on US government censorship of the Internet, and
34 ;;; what you can do to bring back freedom of the press, see the web
35 ;;; site http://www.vtw.org/
37 ;; ========================================================================
38 ;; "No matter how hard you try, you can't make a racehorse out of a pig.
39 ;; You can, however, make a faster pig."
40 ;;
41 ;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
42 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're
43 ;; still not going to make it go faster than 70 mph, but it might be easier
44 ;; to get it there.
45 ;;
47 ;; TO DO:
48 ;;
49 ;; (apply '(lambda (x &rest y) ...) 1 (foo))
50 ;;
51 ;; maintain a list of functions known not to access any global variables
52 ;; (actually, give them a 'dynamically-safe property) and then
53 ;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==>
54 ;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
55 ;; by recursing on this, we might be able to eliminate the entire let.
56 ;; However certain variables should never have their bindings optimized
57 ;; away, because they affect everything.
58 ;; (put 'debug-on-error 'binding-is-magic t)
59 ;; (put 'debug-on-abort 'binding-is-magic t)
60 ;; (put 'debug-on-next-call 'binding-is-magic t)
61 ;; (put 'mocklisp-arguments 'binding-is-magic t)
62 ;; (put 'inhibit-quit 'binding-is-magic t)
63 ;; (put 'quit-flag 'binding-is-magic t)
64 ;; (put 't 'binding-is-magic t)
65 ;; (put 'nil 'binding-is-magic t)
66 ;; possibly also
67 ;; (put 'gc-cons-threshold 'binding-is-magic t)
68 ;; (put 'track-mouse 'binding-is-magic t)
69 ;; others?
70 ;;
71 ;; Simple defsubsts often produce forms like
72 ;; (let ((v1 (f1)) (v2 (f2)) ...)
73 ;; (FN v1 v2 ...))
74 ;; It would be nice if we could optimize this to
75 ;; (FN (f1) (f2) ...)
76 ;; but we can't unless FN is dynamically-safe (it might be dynamically
77 ;; referring to the bindings that the lambda arglist established.)
78 ;; One of the uncountable lossages introduced by dynamic scope...
79 ;;
80 ;; Maybe there should be a control-structure that says "turn on
81 ;; fast-and-loose type-assumptive optimizations here." Then when
82 ;; we see a form like (car foo) we can from then on assume that
83 ;; the variable foo is of type cons, and optimize based on that.
84 ;; But, this won't win much because of (you guessed it) dynamic
85 ;; scope. Anything down the stack could change the value.
86 ;; (Another reason it doesn't work is that it is perfectly valid
87 ;; to call car with a null argument.) A better approach might
88 ;; be to allow type-specification of the form
89 ;; (put 'foo 'arg-types '(float (list integer) dynamic))
90 ;; (put 'foo 'result-type 'bool)
91 ;; It should be possible to have these types checked to a certain
92 ;; degree.
93 ;;
94 ;; collapse common subexpressions
95 ;;
96 ;; It would be nice if redundant sequences could be factored out as well,
97 ;; when they are known to have no side-effects:
98 ;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2
99 ;; but beware of traps like
100 ;; (cons (list x y) (list x y))
101 ;;
102 ;; Tail-recursion elimination is not really possible in Emacs Lisp.
103 ;; Tail-recursion elimination is almost always impossible when all variables
104 ;; have dynamic scope, but given that the "return" byteop requires the
105 ;; binding stack to be empty (rather than emptying it itself), there can be
106 ;; no truly tail-recursive Emacs Lisp functions that take any arguments or
107 ;; make any bindings.
108 ;;
109 ;; Here is an example of an Emacs Lisp function which could safely be
110 ;; byte-compiled tail-recursively:
111 ;;
112 ;; (defun tail-map (fn list)
113 ;; (cond (list
114 ;; (funcall fn (car list))
115 ;; (tail-map fn (cdr list)))))
116 ;;
117 ;; However, if there was even a single let-binding around the COND,
118 ;; it could not be byte-compiled, because there would be an "unbind"
119 ;; byte-op between the final "call" and "return." Adding a
120 ;; Bunbind_all byteop would fix this.
121 ;;
122 ;; (defun foo (x y z) ... (foo a b c))
123 ;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
124 ;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
125 ;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
126 ;;
127 ;; this also can be considered tail recursion:
128 ;;
129 ;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
130 ;; could generalize this by doing the optimization
131 ;; (goto X) ... X: (return) --> (return)
132 ;;
133 ;; But this doesn't solve all of the problems: although by doing tail-
134 ;; recursion elimination in this way, the call-stack does not grow, the
135 ;; binding-stack would grow with each recursive step, and would eventually
136 ;; overflow. I don't believe there is any way around this without lexical
137 ;; scope.
138 ;;
139 ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
140 ;;
141 ;; Idea: the form (lexical-scope) in a file means that the file may be
142 ;; compiled lexically. This proclamation is file-local. Then, within
143 ;; that file, "let" would establish lexical bindings, and "let-dynamic"
144 ;; would do things the old way. (Or we could use CL "declare" forms.)
145 ;; We'd have to notice defvars and defconsts, since those variables should
146 ;; always be dynamic, and attempting to do a lexical binding of them
147 ;; should simply do a dynamic binding instead.
148 ;; But! We need to know about variables that were not necessarily defvarred
149 ;; in the file being compiled (doing a boundp check isn't good enough.)
150 ;; Fdefvar() would have to be modified to add something to the plist.
151 ;;
152 ;; A major disadvantage of this scheme is that the interpreter and compiler
153 ;; would have different semantics for files compiled with (dynamic-scope).
154 ;; Since this would be a file-local optimization, there would be no way to
155 ;; modify the interpreter to obey this (unless the loader was hacked
156 ;; in some grody way, but that's a really bad idea.)
158 ;; Other things to consider:
160 ;;;;; Associative math should recognize subcalls to identical function:
161 ;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
162 ;;;;; This should generate the same as (1+ x) and (1- x)
164 ;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
165 ;;;;; An awful lot of functions always return a non-nil value. If they're
166 ;;;;; error free also they may act as true-constants.
168 ;;;(disassemble (lambda (x) (and (point) (foo))))
169 ;;;;; When
170 ;;;;; - all but one arguments to a function are constant
171 ;;;;; - the non-constant argument is an if-expression (cond-expression?)
172 ;;;;; then the outer function can be distributed. If the guarding
173 ;;;;; condition is side-effect-free [assignment-free] then the other
174 ;;;;; arguments may be any expressions. Since, however, the code size
175 ;;;;; can increase this way they should be "simple". Compare:
177 ;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
178 ;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
180 ;;;;; (car (cons A B)) -> (progn B A)
181 ;;;(disassemble (lambda (x) (car (cons (foo) 42))))
183 ;;;;; (cdr (cons A B)) -> (progn A B)
184 ;;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
186 ;;;;; (car (list A B ...)) -> (progn B ... A)
187 ;;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
189 ;;;;; (cdr (list A B ...)) -> (progn A (list B ...))
190 ;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
193 ;;; Code:
206 arg)
222 c
224 args)))))
232 \f
233 ;;; byte-compile optimizers to support inlining
238 "byte-optimize-handler for the `inline' special-form."
251 sexp)))
255 ;; Splice the given lap code into the current instruction stream.
256 ;; If it has any labels in it, you're responsible for making sure there
257 ;; are no collisions, and that byte-compile-tag-number is reasonable
258 ;; after this is spliced in. The provided list is destroyed.
270 form)
271 ;; else
287 ;;; ((lambda ...) ...)
288 ;;;
299 optionalp restp
300 bindings)
307 ;; ok, I'll let this slide because funcall_lambda() does...
308 ;; (if optionalp (error "multiple &optional keywords in %s" name))
314 ;; ...but it is by no stretch of the imagination a reasonable
315 ;; thing that funcall_lambda() allows (&rest x y) and
316 ;; (&rest x &optional y) in arglists.
325 bindings)
326 values nil))
332 bindings)
340 form)
347 newform)))))
349 \f
350 ;;; implementing source-level optimizers
353 ;;
354 ;; For normal function calls, We can just mapcar the optimizer the cdr. But
355 ;; we need to have special knowledge of the syntax of the special forms
356 ;; like let and defun (that's why they're special forms :-). (Actually,
357 ;; the important aspect is that they are subrs that don't evaluate all of
358 ;; their args.)
359 ;;
361 tmp)
367 form))
372 ;; map (quote nil) to nil to simplify optimizer logic.
373 ;; map quoted constants to nil if for-effect (just because).
376 form))
381 ;; recursively enter the optimizer for the bindings and body
382 ;; of a let or let*. This for depth-firstness: forms that
383 ;; are more deeply nested are optimized first.
388 binding
405 clause))
408 ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
427 ;; those subrs which have an implicit progn; it's not quite good
428 ;; enough to treat these like normal function calls.
429 ;; This can turn (save-excursion ...) into (save-excursion) which
430 ;; will be optimized away in the lap-optimize pass.
434 ;; this is just like the above, except for the first argument.
448 ;; take forms off the back until we can't any more.
449 ;; In the future it could conceivably be a problem that the
450 ;; subexpressions of these forms are optimized in the reverse
451 ;; order, but it's ok for now.
457 for-effect))))
469 nil)
472 condition-case save-window-excursion))
473 ;; These forms are compiled as constants or by breaking out
474 ;; all the subexpressions and compiling them separately.
475 form)
478 ;; the "protected" part of an unwind-protect is compiled (and thus
479 ;; optimized) as a top-level form, so don't do it here. But the
480 ;; non-protected part has the same for-effect status as the
481 ;; unwind-protect itself. (The protected part is always for effect,
482 ;; but that isn't handled properly yet.)
488 ;; the body of a catch is compiled (and thus optimized) as a
489 ;; top-level form, so don't do it here. The tag is never
490 ;; for-effect. The body should have the same for-effect status
491 ;; as the catch form itself, but that isn't handled properly yet.
496 ;; If optimization is on, this is the only place that macros are
497 ;; expanded. If optimization is off, then macroexpansion happens
498 ;; in byte-compile-form. Otherwise, the macros are already expanded
499 ;; by the time that is reached.
502 byte-compile-macro-environment))))
509 form)
517 nil)))
519 ;; appending a nil here might not be necessary, but it can't hurt.
524 ;; Otherwise, no args can be considered to be for-effect,
525 ;; even if the called function is for-effect, because we
526 ;; don't know anything about that function.
531 "The source-level pass of the optimizer."
532 ;;
533 ;; First, optimize all sub-forms of this one.
535 ;;
536 ;; after optimizing all subforms, optimize this form until it doesn't
537 ;; optimize any further. This means that some forms will be passed through
538 ;; the optimizer many times, but that's necessary to make the for-effect
539 ;; processing do as much as possible.
540 ;;
545 ;; we don't have any of these yet, but we might.
550 ;; (if (equal form new) (error "bogus optimizer -- %s" opt))
553 new)
554 form)))
558 ;; optimize the cdr of a progn or implicit progn; all forms is a list of
559 ;; forms, all but the last of which are optimized with the assumption that
560 ;; they are being called for effect. the last is for-effect as well if
561 ;; all-for-effect is true. returns a new list of forms.
564 fe new)
573 \f
574 ;;; some source-level optimizers
575 ;;;
576 ;;; when writing optimizers, be VERY careful that the optimizer returns
577 ;;; something not EQ to its argument if and ONLY if it has made a change.
578 ;;; This implies that you cannot simply destructively modify the list;
579 ;;; you must return something not EQ to it if you make an optimization.
580 ;;;
581 ;;; It is now safe to optimize code such that it introduces new bindings.
583 ;; I'd like this to be a defsubst, but let's not be self-referential...
585 ;; Returns non-nil if FORM is a non-nil constant.
590 ;; If the function is being called with constant numeric args,
591 ;; evaluate as much as possible at compile-time. This optimizer
592 ;; assumes that the function is associative, like + or *.
610 form)))
612 ;; If the function is being called with constant numeric args,
613 ;; evaluate as much as possible at compile-time. This optimizer
614 ;; assumes that the function satisfies
615 ;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
616 ;; like - and /.
620 form
628 constant))))
630 ;;(defun byte-optimize-associative-two-args-math (form)
631 ;; (setq form (byte-optimize-associative-math form))
632 ;; (if (consp form)
633 ;; (byte-optimize-two-args-left form)
634 ;; form))
636 ;;(defun byte-optimize-nonassociative-two-args-math (form)
637 ;; (setq form (byte-optimize-nonassociative-math form))
638 ;; (if (consp form)
639 ;; (byte-optimize-two-args-right form)
640 ;; form))
645 ;; Collect all the constants from FORM, after the STARTth arg,
646 ;; and apply FUN to them to make one argument at the end.
647 ;; For functions that can handle floats, that optimization
648 ;; can be incorrect because reordering can cause an overflow
649 ;; that would otherwise be avoided by encountering an arg that is a float.
650 ;; We avoid this problem by (1) not moving float constants and
651 ;; (2) not moving anything if it would cause an overflow.
653 ;; Merge all FORM's constants from number START, call FUN on them
654 ;; and put the result at the end.
657 ;; t means we must check for overflow.
668 ;; If necessary, check now for overflow
669 ;; that might be caused by reordering.
671 ;; We have overflow if the result of doing the arithmetic
672 ;; on floats is not even close to the result
673 ;; of doing it on integers.
680 form))
685 ;;(setq form (byte-optimize-associative-two-args-math form))
690 ;;; It is not safe to delete the function entirely
691 ;;; (actually, it would be safe if we know the sole arg
692 ;;; is not a marker).
693 ;; ((null (cdr (cdr form))) (nth 1 form))
697 ;; Put constants at the end, except the last constant.
699 ;; Now only first and last element can be a number.
702 ;; (- x y ... 0) --> (- x y ...)
705 ;; If form is (- CONST foo... CONST), merge first and last.
710 ;;; It is not safe to delete the function entirely
711 ;;; (actually, it would be safe if we know the sole arg
712 ;;; is not a marker).
713 ;;; (if (eq (nth 2 form) 0)
714 ;;; (nth 1 form) ; (- x 0) --> x
719 form))
720 ;;; )
721 )
725 ;; If there is a constant in FORM, it is now the last element.
727 ;;; It is not safe to delete the function entirely
728 ;;; (actually, it would be safe if we know the sole arg
729 ;;; is not a marker or if it appears in other arithmetic).
730 ;;; ((null (cdr (cdr form))) (nth 1 form))
762 last nil))))
764 ;;; ((null (cdr (cdr form)))
765 ;;; (nth 1 form))
793 ;; This can enable some lapcode optimizations.
795 form))
807 form)))
815 form))
860 ;; I'm not convinced that this is necessary. Doesn't the optimizer loop
861 ;; take care of this? - Jamie
862 ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
863 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard
869 form
882 ;; Simplify if less than 2 args.
883 ;; if there is a literal nil in the args to `and', throw it and following
884 ;; forms away, and surround the `and' with (progn ... nil).
893 nil))
899 ;; Throw away nil's, and simplify if less than 2 args.
900 ;; If there is a literal non-nil constant in the args to `or', throw away all
901 ;; following forms.
914 ;; if any clauses have a literal nil as their test, throw them away.
915 ;; if any clause has a literal non-nil constant as its test, throw
916 ;; away all following clauses.
918 ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
937 ;;
938 ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
946 form))
947 form))
950 ;; (if <true-constant> <then> <else...>) ==> <then>
951 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
952 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
953 ;; (if <test> <then> nil) ==> (if <test> <then>)
964 form))
967 ;; Don't make a double negative;
968 ;; instead, take away the one that is there.
981 form))
989 ;; byte-compile-negation-optimizer lives in bytecomp.el
996 ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...)
997 ;; (funcall 'foo ...) ==> (foo ...)
1001 form)))
1004 ;; If the last arg is a literal constant, turn this into a funcall.
1005 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
1015 "last arg to apply can't be a literal atom: %s"
1017 nil))
1018 form)))
1028 ;; No bindings
1031 form)
1032 ;; The body is nil
1057 form)))
1058 \f
1059 ;;; enumerating those functions which need not be called if the returned
1060 ;;; value is not used. That is, something like
1061 ;;; (progn (list (something-with-side-effects) (yow))
1062 ;;; (foo))
1063 ;;; may safely be turned into
1064 ;;; (progn (progn (something-with-side-effects) (yow))
1065 ;;; (foo))
1066 ;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
1068 ;;; I wonder if I missed any :-\)
1071 assoc assq
1072 boundp buffer-file-name buffer-local-variables buffer-modified-p
1073 buffer-substring
1074 capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p
1075 copy-marker cos count-lines
1076 default-boundp default-value documentation downcase
1077 elt exp expt fboundp featurep
1078 file-directory-p file-exists-p file-locked-p file-name-absolute-p
1079 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
1080 float floor format
1081 get get-buffer get-buffer-window getenv get-file-buffer
1082 int-to-string
1083 length log log10 logand logb logior lognot logxor lsh
1084 marker-buffer max member memq min mod
1085 next-window nth nthcdr number-to-string
1086 parse-colon-path previous-window
1087 radians-to-degrees rassq regexp-quote reverse round
1089 string-to-int string-to-number substring symbol-plist
1090 tan upcase user-variable-p vconcat
1091 window-buffer window-dedicated-p window-edges window-height
1092 window-hscroll window-minibuffer-p window-width
1093 zerop))
1096 bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
1097 car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
1098 current-buffer
1099 dot dot-marker eobp eolp eq eql equal eventp floatp framep
1100 get-largest-window get-lru-window
1101 identity ignore integerp integer-or-marker-p interactive-p
1102 invocation-directory invocation-name
1103 keymapp list listp
1104 make-marker mark mark-marker markerp memory-limit minibuffer-window
1105 mouse-movement-p
1106 natnump nlistp not null number-or-marker-p numberp
1107 one-window-p overlayp
1108 point point-marker point-min point-max processp
1109 selected-window sequencep stringp subrp symbolp syntax-table-p
1110 user-full-name user-login-name user-original-login-name
1111 user-real-login-name user-real-uid user-uid
1112 vector vectorp
1113 window-configuration-p window-live-p windowp)))
1120 nil)
1124 ;; form is (byte-code "..." [...] n)
1130 byte-compile-maxdepth))
1135 \f
1139 ;;; This function extracts the bitfields from variable-length opcodes.
1140 ;;; Originally defined in disass.el (which no longer uses it.)
1143 "Don't call this!"
1144 ;; fetch and return the offset for the current opcode.
1145 ;; return NIL if this opcode has no offset
1146 ;; OP, PTR and BYTES are used and set dynamically
1177 ;;; This de-compiler is used for inline expansion of compiled functions,
1178 ;;; and by the disassembler.
1179 ;;;
1180 ;;; This list contains numbers, which are pc values,
1181 ;;; before each instruction.
1183 "Turns BYTECODE into lapcode, referring to CONSTVEC."
1189 ;; As byte-decompile-bytecode, but updates
1190 ;; byte-compile-{constants, variables, tag-number}.
1191 ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
1192 ;; with `goto's destined for the end of the code.
1193 ;; That is for use by the compiler.
1194 ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
1195 ;; In that case, we put a pc value into the list
1196 ;; before each insn (or its label).
1200 lap tmp
1201 endtag
1207 optr ptr
1211 ;; it's a pc
1217 tags)))))))
1226 byte-compile-variables)))))))
1233 ;; lap = ( [ (pc . (op . arg)) ]* )
1235 lap))
1237 ;; take off the dummy nil op that we replaced a trailing "return" with.
1242 ;; this addr is jumped to
1253 ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
1256 elt
1260 \f
1261 ;;; peephole optimizer
1267 byte-goto-if-not-nil-else-pop))
1271 byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
1272 byte-eq byte-equal byte-not
1273 byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
1274 byte-interactive-p)
1275 ;; How about other side-effect-free-ops? Is it safe to move an
1276 ;; error invocation (such as from nth) out of an unwind-protect?
1281 byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
1282 byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
1283 byte-point-min byte-following-char byte-preceding-char
1284 byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
1285 byte-current-buffer byte-interactive-p))
1290 byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
1291 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
1292 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
1294 byte-member byte-assq byte-quo byte-rem)
1295 byte-compile-side-effect-and-error-free-ops))
1297 ;;; This crock is because of the way DEFVAR_BOOL variables work.
1298 ;;; Consider the code
1299 ;;;
1300 ;;; (defun foo (flag)
1301 ;;; (let ((old-pop-ups pop-up-windows)
1302 ;;; (pop-up-windows flag))
1303 ;;; (cond ((not (eq pop-up-windows old-pop-ups))
1304 ;;; (setq old-pop-ups pop-up-windows)
1305 ;;; ...))))
1306 ;;;
1307 ;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
1308 ;;; something else. But if we optimize
1309 ;;;
1310 ;;; varref flag
1311 ;;; varbind pop-up-windows
1312 ;;; varref pop-up-windows
1313 ;;; not
1314 ;;; to
1315 ;;; varref flag
1316 ;;; dup
1317 ;;; varbind pop-up-windows
1318 ;;; not
1319 ;;;
1320 ;;; we break the program, because it will appear that pop-up-windows and
1321 ;;; old-pop-ups are not EQ when really they are. So we have to know what
1322 ;;; the BOOL variables are, and not perform this optimization on them.
1323 ;;;
1326 cannot-suspend completion-auto-help completion-ignore-case
1327 cursor-in-echo-area debug-on-next-call debug-on-quit
1328 delete-exited-processes enable-recursive-minibuffers
1329 highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus
1330 insert-default-directory inverse-video load-force-doc-strings
1331 load-in-progress menu-prompting minibuffer-auto-raise
1332 mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive
1333 parse-sexp-ignore-comments pop-up-frames pop-up-windows
1334 print-escape-newlines system-uses-terminfo truncate-partial-width-windows
1335 visible-bell vms-stmlf-recfm words-include-escapes)
1336 "DEFVAR_BOOL variables. Giving these any non-nil value sets them to t.
1337 If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
1341 "Simple peephole optimizer. LAP is both modified and returned."
1343 lap1 off1
1344 lap2 off2
1347 rest tmp tmp2 tmp3
1349 byte-compile-side-effect-free-ops
1350 byte-compile-side-effect-and-error-free-ops)))
1355 keep-going nil)
1361 ;; You may notice that sequences like "dup varset discard" are
1362 ;; optimized but sequences like "dup varset TAG1: discard" are not.
1363 ;; You may be tempted to change this; resist that temptation.
1365 ;; <side-effect-free> pop --> <deleted>
1366 ;; ...including:
1367 ;; const-X pop --> <deleted>
1368 ;; varref-X pop --> <deleted>
1369 ;; dup pop --> <deleted>
1370 ;;
1390 ;;
1391 ;; goto*-X X: --> X:
1392 ;;
1407 ;;
1408 ;; varset-X varref-X --> dup varset-X
1409 ;; varbind-X varref-X --> dup varbind-X
1410 ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
1411 ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
1412 ;; The latter two can enable other optimizations.
1413 ;;
1419 nil
1428 lap0 lap1 lap2 lap0 lap1
1436 ;; The stack depth gets locally increased, so we will
1437 ;; increase maxdepth in case depth = maxdepth here.
1438 ;; This can cause the third argument to byte-code to
1439 ;; be larger than necessary.
1441 ;;
1442 ;; dup varset-X discard --> varset-X
1443 ;; dup varbind-X discard --> varbind-X
1444 ;; (the varbind variant can emerge from other optimizations)
1445 ;;
1453 ;;
1454 ;; not goto-X-if-nil --> goto-X-if-non-nil
1455 ;; not goto-X-if-non-nil --> goto-X-if-nil
1456 ;;
1457 ;; it is wrong to do the same thing for the -else-pop variants.
1458 ;;
1463 lap1
1466 'byte-goto-if-not-nil
1470 'byte-goto-if-not-nil
1474 ;;
1475 ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
1476 ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
1477 ;;
1478 ;; it is wrong to do the same thing for the -else-pop variants.
1479 ;;
1487 lap0 lap1 lap2
1492 ;;
1493 ;; const goto-if-* --> whatever
1494 ;;
1502 lap0 lap1)
1515 ;;
1516 ;; varref-X varref-X --> varref-X dup
1517 ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
1518 ;; We don't optimize the const-X variations on this here,
1519 ;; because that would inhibit some goto optimizations; we
1520 ;; optimize the const-X case after all other optimizations.
1521 ;;
1527 t)
1537 lap0 str lap0 lap0 str)))
1542 ;;
1543 ;; TAG1: TAG2: --> TAG1: <deleted>
1544 ;; (and other references to TAG2 are replaced with TAG1)
1545 ;;
1556 keep-going t))
1557 ;;
1558 ;; unused-TAG: --> <deleted>
1559 ;;
1565 keep-going t))
1566 ;;
1567 ;; goto ... --> goto <delete until TAG or end>
1568 ;; return ... --> return <delete until TAG or end>
1569 ;;
1575 str deleted)
1590 lap0
1596 tagstr lap0 tagstr))))
1599 ;;
1600 ;; <safe-op> unbind --> unbind <safe-op>
1601 ;; (this may enable other optimizations.)
1602 ;;
1609 ;;
1610 ;; varbind-X unbind-N --> discard unbind-(N-1)
1611 ;; save-excursion unbind-N --> unbind-(N-1)
1612 ;; save-restriction unbind-N --> unbind-(N-1)
1613 ;;
1616 byte-save-restriction))
1633 ;;
1634 ;; goto*-X ... X: goto-Y --> goto*-Y
1635 ;; goto-X ... X: return --> return
1636 ;;
1649 ;;
1650 ;; goto-*-else-pop X ... X: goto-if-* --> whatever
1651 ;; goto-*-else-pop X ... X: discard --> whatever
1652 ;;
1654 byte-goto-if-not-nil-else-pop))
1661 byte-goto-if-nil)
1663 byte-goto-if-not-nil))))
1669 ;; Get rid of the -else-pop's and jump one step further.
1678 ;;
1679 ;; const goto-X ... X: goto-if-* --> whatever
1680 ;; const goto-X ... X: discard --> whatever
1681 ;;
1693 byte-goto-if-not-nil-else-pop)))
1695 lap0 tmp2 lap0 tmp2)
1698 ;; Let next step fix the (const,goto-if*) sequence.
1701 ;; Jump one step further
1704 lap0 tmp2)
1711 ;;
1712 ;; X: varref-Y ... varset-Y goto-X -->
1713 ;; X: varref-Y Z: ... dup varset-Y goto-Z
1714 ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
1715 ;; (This is so usual for while loops that it is worth handling).
1716 ;;
1724 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
1729 lap1 lap2
1733 )
1738 ;;
1739 ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
1740 ;; (This can pull the loop test to the end of the loop)
1741 ;;
1748 byte-goto-if-nil-else-pop)))
1749 ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
1750 ;; lap0 lap1 (cdr lap0) (car tmp))
1759 byte-goto-if-not-nil-else-pop)
1761 byte-goto-if-nil-else-pop))))
1762 newtag)
1765 )
1768 ;; We can handle this case but not the -if-not-nil case,
1769 ;; because we won't know which non-nil constant to push.
1775 byte-goto-if-not-nil
1776 byte-goto-if-nil
1777 byte-goto-if-not-nil
1778 byte-goto byte-goto))))
1779 )
1781 )
1783 )
1784 ;; Cleanup stage:
1785 ;; Rebuild byte-compile-constants / byte-compile-variables.
1786 ;; Simple optimizations that would inhibit other optimizations if they
1787 ;; were done in the optimizing loop, and optimizations which there is no
1788 ;; need to do more than once.
1790 byte-compile-variables nil)
1799 byte-compile-variables)))
1802 byte-compile-constants)))))
1804 ;; const-C varset-X const-C --> const-C dup varset-X
1805 ;; const-C varbind-X const-C --> const-C dup varbind-X
1806 ;;
1812 lap0 lap1 lap0 lap0 lap1)
1816 ;;
1817 ;; const-X [dup/const-X ...] --> const-X [dup ...] dup
1818 ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup
1819 ;;
1822 tmp2 nil)
1832 ;;
1833 ;; unbind-N unbind-M --> unbind-(N+M)
1834 ;;
1843 )
1846 lap)
1850 \f
1851 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
1852 ;; itself, compile some of its most used recursive functions (at load time).
1853 ;;
1864 byte-optimize-body
1865 byte-optimize-predicate
1866 byte-optimize-binary-predicate
1867 ;; Inserted some more than necessary, to speed it up.
1868 byte-optimize-form-code-walker
1869 byte-optimize-lapcode))))
1870 nil)
1872 ;;; byte-opt.el ends here