| blob | 2c9dc8e3314fd94812fa4accf82beb17d66147ca |
1 ;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler
3 ;; Copyright (C) 1991, 1994, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
6 ;; Author: Jamie Zawinski <jwz@lucid.com>
7 ;; Hallvard Furuseth <hbf@ulrik.uio.no>
8 ;; Maintainer: FSF
9 ;; Keywords: internal
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 2, or (at your option)
16 ;; 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; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
26 ;; Boston, MA 02110-1301, USA.
28 ;;; Commentary:
30 ;; ========================================================================
31 ;; "No matter how hard you try, you can't make a racehorse out of a pig.
32 ;; You can, however, make a faster pig."
33 ;;
34 ;; Or, to put it another way, the emacs byte compiler is a VW Bug. This code
35 ;; makes it be a VW Bug with fuel injection and a turbocharger... You're
36 ;; still not going to make it go faster than 70 mph, but it might be easier
37 ;; to get it there.
38 ;;
40 ;; TO DO:
41 ;;
42 ;; (apply (lambda (x &rest y) ...) 1 (foo))
43 ;;
44 ;; maintain a list of functions known not to access any global variables
45 ;; (actually, give them a 'dynamically-safe property) and then
46 ;; (let ( v1 v2 ... vM vN ) <...dynamically-safe...> ) ==>
47 ;; (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
48 ;; by recursing on this, we might be able to eliminate the entire let.
49 ;; However certain variables should never have their bindings optimized
50 ;; away, because they affect everything.
51 ;; (put 'debug-on-error 'binding-is-magic t)
52 ;; (put 'debug-on-abort 'binding-is-magic t)
53 ;; (put 'debug-on-next-call 'binding-is-magic t)
54 ;; (put 'inhibit-quit 'binding-is-magic t)
55 ;; (put 'quit-flag 'binding-is-magic t)
56 ;; (put 't 'binding-is-magic t)
57 ;; (put 'nil 'binding-is-magic t)
58 ;; possibly also
59 ;; (put 'gc-cons-threshold 'binding-is-magic t)
60 ;; (put 'track-mouse 'binding-is-magic t)
61 ;; others?
62 ;;
63 ;; Simple defsubsts often produce forms like
64 ;; (let ((v1 (f1)) (v2 (f2)) ...)
65 ;; (FN v1 v2 ...))
66 ;; It would be nice if we could optimize this to
67 ;; (FN (f1) (f2) ...)
68 ;; but we can't unless FN is dynamically-safe (it might be dynamically
69 ;; referring to the bindings that the lambda arglist established.)
70 ;; One of the uncountable lossages introduced by dynamic scope...
71 ;;
72 ;; Maybe there should be a control-structure that says "turn on
73 ;; fast-and-loose type-assumptive optimizations here." Then when
74 ;; we see a form like (car foo) we can from then on assume that
75 ;; the variable foo is of type cons, and optimize based on that.
76 ;; But, this won't win much because of (you guessed it) dynamic
77 ;; scope. Anything down the stack could change the value.
78 ;; (Another reason it doesn't work is that it is perfectly valid
79 ;; to call car with a null argument.) A better approach might
80 ;; be to allow type-specification of the form
81 ;; (put 'foo 'arg-types '(float (list integer) dynamic))
82 ;; (put 'foo 'result-type 'bool)
83 ;; It should be possible to have these types checked to a certain
84 ;; degree.
85 ;;
86 ;; collapse common subexpressions
87 ;;
88 ;; It would be nice if redundant sequences could be factored out as well,
89 ;; when they are known to have no side-effects:
90 ;; (list (+ a b c) (+ a b c)) --> a b add c add dup list-2
91 ;; but beware of traps like
92 ;; (cons (list x y) (list x y))
93 ;;
94 ;; Tail-recursion elimination is not really possible in Emacs Lisp.
95 ;; Tail-recursion elimination is almost always impossible when all variables
96 ;; have dynamic scope, but given that the "return" byteop requires the
97 ;; binding stack to be empty (rather than emptying it itself), there can be
98 ;; no truly tail-recursive Emacs Lisp functions that take any arguments or
99 ;; make any bindings.
100 ;;
101 ;; Here is an example of an Emacs Lisp function which could safely be
102 ;; byte-compiled tail-recursively:
103 ;;
104 ;; (defun tail-map (fn list)
105 ;; (cond (list
106 ;; (funcall fn (car list))
107 ;; (tail-map fn (cdr list)))))
108 ;;
109 ;; However, if there was even a single let-binding around the COND,
110 ;; it could not be byte-compiled, because there would be an "unbind"
111 ;; byte-op between the final "call" and "return." Adding a
112 ;; Bunbind_all byteop would fix this.
113 ;;
114 ;; (defun foo (x y z) ... (foo a b c))
115 ;; ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
116 ;; ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
117 ;; ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
118 ;;
119 ;; this also can be considered tail recursion:
120 ;;
121 ;; ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
122 ;; could generalize this by doing the optimization
123 ;; (goto X) ... X: (return) --> (return)
124 ;;
125 ;; But this doesn't solve all of the problems: although by doing tail-
126 ;; recursion elimination in this way, the call-stack does not grow, the
127 ;; binding-stack would grow with each recursive step, and would eventually
128 ;; overflow. I don't believe there is any way around this without lexical
129 ;; scope.
130 ;;
131 ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
132 ;;
133 ;; Idea: the form (lexical-scope) in a file means that the file may be
134 ;; compiled lexically. This proclamation is file-local. Then, within
135 ;; that file, "let" would establish lexical bindings, and "let-dynamic"
136 ;; would do things the old way. (Or we could use CL "declare" forms.)
137 ;; We'd have to notice defvars and defconsts, since those variables should
138 ;; always be dynamic, and attempting to do a lexical binding of them
139 ;; should simply do a dynamic binding instead.
140 ;; But! We need to know about variables that were not necessarily defvarred
141 ;; in the file being compiled (doing a boundp check isn't good enough.)
142 ;; Fdefvar() would have to be modified to add something to the plist.
143 ;;
144 ;; A major disadvantage of this scheme is that the interpreter and compiler
145 ;; would have different semantics for files compiled with (dynamic-scope).
146 ;; Since this would be a file-local optimization, there would be no way to
147 ;; modify the interpreter to obey this (unless the loader was hacked
148 ;; in some grody way, but that's a really bad idea.)
150 ;; Other things to consider:
152 ;; ;; Associative math should recognize subcalls to identical function:
153 ;; (disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
154 ;; ;; This should generate the same as (1+ x) and (1- x)
156 ;; (disassemble (lambda (x) (cons (+ x 1) (- x 1))))
157 ;; ;; An awful lot of functions always return a non-nil value. If they're
158 ;; ;; error free also they may act as true-constants.
160 ;; (disassemble (lambda (x) (and (point) (foo))))
161 ;; ;; When
162 ;; ;; - all but one arguments to a function are constant
163 ;; ;; - the non-constant argument is an if-expression (cond-expression?)
164 ;; ;; then the outer function can be distributed. If the guarding
165 ;; ;; condition is side-effect-free [assignment-free] then the other
166 ;; ;; arguments may be any expressions. Since, however, the code size
167 ;; ;; can increase this way they should be "simple". Compare:
169 ;; (disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
170 ;; (disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
172 ;; ;; (car (cons A B)) -> (prog1 A B)
173 ;; (disassemble (lambda (x) (car (cons (foo) 42))))
175 ;; ;; (cdr (cons A B)) -> (progn A B)
176 ;; (disassemble (lambda (x) (cdr (cons 42 (foo)))))
178 ;; ;; (car (list A B ...)) -> (prog1 A B ...)
179 ;; (disassemble (lambda (x) (car (list (foo) 42 (bar)))))
181 ;; ;; (cdr (list A B ...)) -> (progn A (list B ...))
182 ;; (disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
185 ;;; Code:
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
284 ;; Give up on inlining.
285 form))))))
287 ;; ((lambda ...) ...)
298 optionalp restp
299 bindings)
306 ;; ok, I'll let this slide because funcall_lambda() does...
307 ;; (if optionalp (error "multiple &optional keywords in %s" name))
313 ;; ...but it is by no stretch of the imagination a reasonable
314 ;; thing that funcall_lambda() allows (&rest x y) and
315 ;; (&rest x &optional y) in arglists.
324 bindings)
325 values nil))
331 bindings)
339 form)
341 ;; The following leads to infinite recursion when loading a
342 ;; file containing `(defsubst f () (f))', and then trying to
343 ;; byte-compile that file.
344 ;(setq body (mapcar 'byte-optimize-form body)))
351 newform)))))
353 \f
354 ;;; implementing source-level optimizers
357 ;;
358 ;; For normal function calls, We can just mapcar the optimizer the cdr. But
359 ;; we need to have special knowledge of the syntax of the special forms
360 ;; like let and defun (that's why they're special forms :-). (Actually,
361 ;; the important aspect is that they are subrs that don't evaluate all of
362 ;; their args.)
363 ;;
365 tmp)
371 form))
376 ;; map (quote nil) to nil to simplify optimizer logic.
377 ;; map quoted constants to nil if for-effect (just because).
380 form))
385 ;; recursively enter the optimizer for the bindings and body
386 ;; of a let or let*. This for depth-firstness: forms that
387 ;; are more deeply nested are optimized first.
392 binding
409 clause))
412 ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
431 ;; those subrs which have an implicit progn; it's not quite good
432 ;; enough to treat these like normal function calls.
433 ;; This can turn (save-excursion ...) into (save-excursion) which
434 ;; will be optimized away in the lap-optimize pass.
438 ;; this is just like the above, except for the first argument.
454 ;; take forms off the back until we can't any more.
455 ;; In the future it could conceivably be a problem that the
456 ;; subexpressions of these forms are optimized in the reverse
457 ;; order, but it's ok for now.
463 for-effect))))
475 nil)
478 condition-case save-window-excursion))
479 ;; These forms are compiled as constants or by breaking out
480 ;; all the subexpressions and compiling them separately.
481 form)
484 ;; the "protected" part of an unwind-protect is compiled (and thus
485 ;; optimized) as a top-level form, so don't do it here. But the
486 ;; non-protected part has the same for-effect status as the
487 ;; unwind-protect itself. (The protected part is always for effect,
488 ;; but that isn't handled properly yet.)
494 ;; the body of a catch is compiled (and thus optimized) as a
495 ;; top-level form, so don't do it here. The tag is never
496 ;; for-effect. The body should have the same for-effect status
497 ;; as the catch form itself, but that isn't handled properly yet.
503 ;; Don't treat the args to `ignore' as being
504 ;; computed for effect. We want to avoid the warnings
505 ;; that might occur if they were treated that way.
506 ;; However, don't actually bother calling `ignore'.
509 ;; If optimization is on, this is the only place that macros are
510 ;; expanded. If optimization is off, then macroexpansion happens
511 ;; in byte-compile-form. Otherwise, the macros are already expanded
512 ;; by the time that is reached.
515 byte-compile-macro-environment))))
518 ;; Support compiler macros as in cl.el.
530 form)
535 ;; Detect the expansion of (pop foo).
536 ;; There is no need to compile the call to `car' there.
550 nil)))
552 ;; appending a nil here might not be necessary, but it can't hurt.
557 ;; Otherwise, no args can be considered to be for-effect,
558 ;; even if the called function is for-effect, because we
559 ;; don't know anything about that function.
567 "Non-nil iff all elements of LIST satisfy `byte-compile-constp'."
573 constant))
576 "The source-level pass of the optimizer."
577 ;;
578 ;; First, optimize all sub-forms of this one.
580 ;;
581 ;; after optimizing all subforms, optimize this form until it doesn't
582 ;; optimize any further. This means that some forms will be passed through
583 ;; the optimizer many times, but that's necessary to make the for-effect
584 ;; processing do as much as possible.
585 ;;
590 ;; we don't have any of these yet, but we might.
595 ;; (if (equal form new) (error "bogus optimizer -- %s" opt))
598 new)
599 form)))
603 ;; optimize the cdr of a progn or implicit progn; all forms is a list of
604 ;; forms, all but the last of which are optimized with the assumption that
605 ;; they are being called for effect. the last is for-effect as well if
606 ;; all-for-effect is true. returns a new list of forms.
609 fe new)
618 \f
619 ;; some source-level optimizers
620 ;;
621 ;; when writing optimizers, be VERY careful that the optimizer returns
622 ;; something not EQ to its argument if and ONLY if it has made a change.
623 ;; This implies that you cannot simply destructively modify the list;
624 ;; you must return something not EQ to it if you make an optimization.
625 ;;
626 ;; It is now safe to optimize code such that it introduces new bindings.
628 ;; I'd like this to be a defsubst, but let's not be self-referential...
630 ;; Returns non-nil if FORM is a non-nil constant.
636 ;; If the function is being called with constant numeric args,
637 ;; evaluate as much as possible at compile-time. This optimizer
638 ;; assumes that the function is associative, like + or *.
656 form)))
658 ;; If the function is being called with constant numeric args,
659 ;; evaluate as much as possible at compile-time. This optimizer
660 ;; assumes that the function satisfies
661 ;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
662 ;; like - and /.
666 form
674 constant))))
676 ;;(defun byte-optimize-associative-two-args-math (form)
677 ;; (setq form (byte-optimize-associative-math form))
678 ;; (if (consp form)
679 ;; (byte-optimize-two-args-left form)
680 ;; form))
682 ;;(defun byte-optimize-nonassociative-two-args-math (form)
683 ;; (setq form (byte-optimize-nonassociative-math form))
684 ;; (if (consp form)
685 ;; (byte-optimize-two-args-right form)
686 ;; form))
691 ;; Collect all the constants from FORM, after the STARTth arg,
692 ;; and apply FUN to them to make one argument at the end.
693 ;; For functions that can handle floats, that optimization
694 ;; can be incorrect because reordering can cause an overflow
695 ;; that would otherwise be avoided by encountering an arg that is a float.
696 ;; We avoid this problem by (1) not moving float constants and
697 ;; (2) not moving anything if it would cause an overflow.
699 ;; Merge all FORM's constants from number START, call FUN on them
700 ;; and put the result at the end.
703 ;; t means we must check for overflow.
714 ;; If necessary, check now for overflow
715 ;; that might be caused by reordering.
717 ;; We have overflow if the result of doing the arithmetic
718 ;; on floats is not even close to the result
719 ;; of doing it on integers.
726 form))
731 ;;(setq form (byte-optimize-associative-two-args-math form))
736 ;;; It is not safe to delete the function entirely
737 ;;; (actually, it would be safe if we know the sole arg
738 ;;; is not a marker).
739 ;;; ((null (cdr (cdr form))) (nth 1 form))
743 form))
747 ;; Optimize (+ x 1) into (1+ x) and (+ x -1) into (1- x).
757 other)))
761 ;; Put constants at the end, except the last constant.
763 ;; Now only first and last element can be a number.
766 ;; (- x y ... 0) --> (- x y ...)
773 ;; If form is (- CONST foo... CONST), merge first and last.
778 ;;; It is not safe to delete the function entirely
779 ;;; (actually, it would be safe if we know the sole arg
780 ;;; is not a marker).
781 ;;; (if (eq (nth 2 form) 0)
782 ;;; (nth 1 form) ; (- x 0) --> x
787 form))
788 ;;; )
789 )
793 ;; If there is a constant in FORM, it is now the last element.
795 ;;; It is not safe to delete the function entirely
796 ;;; (actually, it would be safe if we know the sole arg
797 ;;; is not a marker or if it appears in other arithmetic).
798 ;;; ((null (cdr (cdr form))) (nth 1 form))
830 last nil))))
832 ;;; ((null (cdr (cdr form)))
833 ;;; (nth 1 form))
861 ;; This can enable some lapcode optimizations.
863 form))
875 form)))
883 form))
927 ;; I'm not convinced that this is necessary. Doesn't the optimizer loop
928 ;; take care of this? - Jamie
929 ;; I think this may some times be necessary to reduce ie (quote 5) to 5,
930 ;; so arithmetic optimizers recognize the numeric constant. - Hallvard
936 form
949 ;; Simplify if less than 2 args.
950 ;; if there is a literal nil in the args to `and', throw it and following
951 ;; forms away, and surround the `and' with (progn ... nil).
960 nil))
966 ;; Throw away nil's, and simplify if less than 2 args.
967 ;; If there is a literal non-nil constant in the args to `or', throw away all
968 ;; following forms.
981 ;; if any clauses have a literal nil as their test, throw them away.
982 ;; if any clause has a literal non-nil constant as its test, throw
983 ;; away all following clauses.
985 ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
1004 ;;
1005 ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
1013 form))
1014 form))
1017 ;; (if <true-constant> <then> <else...>) ==> <then>
1018 ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
1019 ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
1020 ;; (if <test> <then> nil) ==> (if <test> <then>)
1031 form))
1034 ;; Don't make a double negative;
1035 ;; instead, take away the one that is there.
1050 form))
1058 ;; byte-compile-negation-optimizer lives in bytecomp.el
1065 ;; (funcall (lambda ...) ...) ==> ((lambda ...) ...)
1066 ;; (funcall foo ...) ==> (foo ...)
1070 form)))
1073 ;; If the last arg is a literal constant, turn this into a funcall.
1074 ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
1084 "last arg to apply can't be a literal atom: `%s'"
1086 nil))
1087 form)))
1097 ;; No bindings
1100 form)
1101 ;; The body is nil
1118 form))
1128 form)
1130 form))
1132 ;; Fixme: delete-char -> delete-region (byte-coded)
1133 ;; optimize string-as-unibyte, string-as-multibyte, string-make-unibyte,
1134 ;; string-make-multibyte for constant args.
1138 ;; Emacs-21's byte-code doesn't run under XEmacs anyway, so we can
1139 ;; safely optimize away this test.
1141 nil
1142 form))
1155 \f
1156 ;; enumerating those functions which need not be called if the returned
1157 ;; value is not used. That is, something like
1158 ;; (progn (list (something-with-side-effects) (yow))
1159 ;; (foo))
1160 ;; may safely be turned into
1161 ;; (progn (progn (something-with-side-effects) (yow))
1162 ;; (foo))
1163 ;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
1165 ;; Some of these functions have the side effect of allocating memory
1166 ;; and it would be incorrect to replace two calls with one.
1167 ;; But we don't try to do those kinds of optimizations,
1168 ;; so it is safe to list such functions here.
1169 ;; Some of these functions return values that depend on environment
1170 ;; state, so that constant folding them would be wrong,
1171 ;; but we don't do constant folding based on this list.
1173 ;; However, at present the only optimization we normally do
1174 ;; is delete calls that need not occur, and we only do that
1175 ;; with the error-free functions.
1177 ;; I wonder if I missed any :-\)
1180 assoc assq
1181 boundp buffer-file-name buffer-local-variables buffer-modified-p
1182 buffer-substring byte-code-function-p
1183 capitalize car-less-than-car car cdr ceiling char-after char-before
1184 char-equal char-to-string char-width
1185 compare-strings concat coordinates-in-window-p
1186 copy-alist copy-sequence copy-marker cos count-lines
1187 decode-time default-boundp default-value documentation downcase
1188 elt exp expt encode-time error-message-string
1189 fboundp fceiling featurep ffloor
1190 file-directory-p file-exists-p file-locked-p file-name-absolute-p
1191 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
1192 float float-time floor format format-time-string frame-visible-p
1193 fround ftruncate
1194 get gethash get-buffer get-buffer-window getenv get-file-buffer
1195 hash-table-count
1196 int-to-string intern-soft
1197 keymap-parent
1198 length local-variable-if-set-p local-variable-p log log10 logand
1199 logb logior lognot logxor lsh
1200 make-list make-string make-symbol
1201 marker-buffer max member memq min mod multibyte-char-to-unibyte
1202 next-window nth nthcdr number-to-string
1203 parse-colon-path plist-get plist-member
1204 prefix-numeric-value previous-window prin1-to-string propertize
1205 radians-to-degrees rassq rassoc read-from-string regexp-quote
1206 region-beginning region-end reverse round
1208 string-to-int string-to-number substring sxhash symbol-function
1209 symbol-name symbol-plist symbol-value string-make-unibyte
1210 string-make-multibyte string-as-multibyte string-as-unibyte
1211 tan truncate
1212 unibyte-char-to-multibyte upcase user-full-name
1213 user-login-name user-original-login-name user-variable-p
1214 vconcat
1215 window-buffer window-dedicated-p window-edges window-height
1216 window-hscroll window-minibuffer-p window-width
1217 zerop))
1220 bobp bolp bool-vector-p
1221 buffer-end buffer-list buffer-size buffer-string bufferp
1222 car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
1223 current-buffer current-global-map current-indentation
1224 current-local-map current-minor-mode-maps current-time
1225 current-time-string current-time-zone
1226 eobp eolp eq equal eventp
1227 floatp following-char framep
1228 get-largest-window get-lru-window
1229 hash-table-p
1230 identity ignore integerp integer-or-marker-p interactive-p
1231 invocation-directory invocation-name
1232 keymapp
1233 line-beginning-position line-end-position list listp
1234 make-marker mark mark-marker markerp memory-limit minibuffer-window
1235 mouse-movement-p
1236 natnump nlistp not null number-or-marker-p numberp
1237 one-window-p overlayp
1238 point point-marker point-min point-max preceding-char processp
1239 recent-keys recursion-depth
1240 safe-length selected-frame selected-window sequencep
1241 standard-case-table standard-syntax-table stringp subrp symbolp
1242 syntax-table syntax-table-p
1243 this-command-keys this-command-keys-vector this-single-command-keys
1244 this-single-command-raw-keys
1245 user-real-login-name user-real-uid user-uid
1246 vector vectorp visible-frame-list
1247 wholenump window-configuration-p window-live-p windowp)))
1254 nil)
1256 \f
1257 ;; pure functions are side-effect free functions whose values depend
1258 ;; only on their arguments. For these functions, calls with constant
1259 ;; arguments can be evaluated at compile time. This may shift run time
1260 ;; errors to compile time.
1267 nil)
1270 ;; form is (byte-code "..." [...] n)
1276 byte-compile-maxdepth))
1281 \f
1285 ;; This function extracts the bitfields from variable-length opcodes.
1286 ;; Originally defined in disass.el (which no longer uses it.)
1289 "Don't call this!"
1290 ;; fetch and return the offset for the current opcode.
1291 ;; return nil if this opcode has no offset
1292 ;; OP, PTR and BYTES are used and set dynamically
1323 ;; This de-compiler is used for inline expansion of compiled functions,
1324 ;; and by the disassembler.
1325 ;;
1326 ;; This list contains numbers, which are pc values,
1327 ;; before each instruction.
1329 "Turns BYTECODE into lapcode, referring to CONSTVEC."
1335 ;; As byte-decompile-bytecode, but updates
1336 ;; byte-compile-{constants, variables, tag-number}.
1337 ;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
1338 ;; with `goto's destined for the end of the code.
1339 ;; That is for use by the compiler.
1340 ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
1341 ;; In that case, we put a pc value into the list
1342 ;; before each insn (or its label).
1346 lap tmp
1347 endtag)
1352 optr ptr
1356 ;; it's a pc
1362 tags)))))))
1373 byte-compile-variables)))))))
1380 ;; lap = ( [ (pc . (op . arg)) ]* )
1382 lap))
1384 ;; take off the dummy nil op that we replaced a trailing "return" with.
1389 ;; this addr is jumped to
1400 ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
1403 elt
1407 \f
1408 ;;; peephole optimizer
1414 byte-goto-if-not-nil-else-pop))
1418 byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
1419 byte-eq byte-not
1420 byte-cons byte-list1 byte-list2 ; byte-list3 byte-list4
1421 byte-interactive-p)
1422 ;; How about other side-effect-free-ops? Is it safe to move an
1423 ;; error invocation (such as from nth) out of an unwind-protect?
1424 ;; No, it is not, because the unwind-protect forms can alter
1425 ;; the inside of the object to which nth would apply.
1426 ;; For the same reason, byte-equal was deleted from this list.
1431 byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
1432 byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
1433 byte-point-min byte-following-char byte-preceding-char
1434 byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
1435 byte-current-buffer byte-interactive-p))
1440 byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
1441 byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
1442 byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
1444 byte-member byte-assq byte-quo byte-rem)
1445 byte-compile-side-effect-and-error-free-ops))
1447 ;; This crock is because of the way DEFVAR_BOOL variables work.
1448 ;; Consider the code
1449 ;;
1450 ;; (defun foo (flag)
1451 ;; (let ((old-pop-ups pop-up-windows)
1452 ;; (pop-up-windows flag))
1453 ;; (cond ((not (eq pop-up-windows old-pop-ups))
1454 ;; (setq old-pop-ups pop-up-windows)
1455 ;; ...))))
1456 ;;
1457 ;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
1458 ;; something else. But if we optimize
1459 ;;
1460 ;; varref flag
1461 ;; varbind pop-up-windows
1462 ;; varref pop-up-windows
1463 ;; not
1464 ;; to
1465 ;; varref flag
1466 ;; dup
1467 ;; varbind pop-up-windows
1468 ;; not
1469 ;;
1470 ;; we break the program, because it will appear that pop-up-windows and
1471 ;; old-pop-ups are not EQ when really they are. So we have to know what
1472 ;; the BOOL variables are, and not perform this optimization on them.
1474 ;; The variable `byte-boolean-vars' is now primitive and updated
1475 ;; automatically by DEFVAR_BOOL.
1478 "Simple peephole optimizer. LAP is both modified and returned.
1479 If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
1481 lap1
1482 lap2
1485 rest tmp tmp2 tmp3
1487 byte-compile-side-effect-free-ops
1488 byte-compile-side-effect-and-error-free-ops)))
1493 keep-going nil)
1499 ;; You may notice that sequences like "dup varset discard" are
1500 ;; optimized but sequences like "dup varset TAG1: discard" are not.
1501 ;; You may be tempted to change this; resist that temptation.
1503 ;; <side-effect-free> pop --> <deleted>
1504 ;; ...including:
1505 ;; const-X pop --> <deleted>
1506 ;; varref-X pop --> <deleted>
1507 ;; dup pop --> <deleted>
1508 ;;
1528 ;;
1529 ;; goto*-X X: --> X:
1530 ;;
1545 ;;
1546 ;; varset-X varref-X --> dup varset-X
1547 ;; varbind-X varref-X --> dup varbind-X
1548 ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
1549 ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
1550 ;; The latter two can enable other optimizations.
1551 ;;
1557 nil
1567 lap0 lap1 lap2 lap0 lap1
1575 ;; The stack depth gets locally increased, so we will
1576 ;; increase maxdepth in case depth = maxdepth here.
1577 ;; This can cause the third argument to byte-code to
1578 ;; be larger than necessary.
1580 ;;
1581 ;; dup varset-X discard --> varset-X
1582 ;; dup varbind-X discard --> varbind-X
1583 ;; (the varbind variant can emerge from other optimizations)
1584 ;;
1592 ;;
1593 ;; not goto-X-if-nil --> goto-X-if-non-nil
1594 ;; not goto-X-if-non-nil --> goto-X-if-nil
1595 ;;
1596 ;; it is wrong to do the same thing for the -else-pop variants.
1597 ;;
1602 lap1
1605 'byte-goto-if-not-nil
1609 'byte-goto-if-not-nil
1613 ;;
1614 ;; goto-X-if-nil goto-Y X: --> goto-Y-if-non-nil X:
1615 ;; goto-X-if-non-nil goto-Y X: --> goto-Y-if-nil X:
1616 ;;
1617 ;; it is wrong to do the same thing for the -else-pop variants.
1618 ;;
1626 lap0 lap1 lap2
1631 ;;
1632 ;; const goto-if-* --> whatever
1633 ;;
1641 lap0 lap1)
1654 ;;
1655 ;; varref-X varref-X --> varref-X dup
1656 ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup
1657 ;; We don't optimize the const-X variations on this here,
1658 ;; because that would inhibit some goto optimizations; we
1659 ;; optimize the const-X case after all other optimizations.
1660 ;;
1666 t)
1676 lap0 str lap0 lap0 str)))
1681 ;;
1682 ;; TAG1: TAG2: --> TAG1: <deleted>
1683 ;; (and other references to TAG2 are replaced with TAG1)
1684 ;;
1695 keep-going t))
1696 ;;
1697 ;; unused-TAG: --> <deleted>
1698 ;;
1704 keep-going t))
1705 ;;
1706 ;; goto ... --> goto <delete until TAG or end>
1707 ;; return ... --> return <delete until TAG or end>
1708 ;;
1714 str deleted)
1729 lap0
1735 tagstr lap0 tagstr))))
1738 ;;
1739 ;; <safe-op> unbind --> unbind <safe-op>
1740 ;; (this may enable other optimizations.)
1741 ;;
1748 ;;
1749 ;; varbind-X unbind-N --> discard unbind-(N-1)
1750 ;; save-excursion unbind-N --> unbind-(N-1)
1751 ;; save-restriction unbind-N --> unbind-(N-1)
1752 ;;
1755 byte-save-restriction))
1772 ;;
1773 ;; goto*-X ... X: goto-Y --> goto*-Y
1774 ;; goto-X ... X: return --> return
1775 ;;
1788 ;;
1789 ;; goto-*-else-pop X ... X: goto-if-* --> whatever
1790 ;; goto-*-else-pop X ... X: discard --> whatever
1791 ;;
1793 byte-goto-if-not-nil-else-pop))
1800 byte-goto-if-nil)
1802 byte-goto-if-not-nil))))
1808 ;; Get rid of the -else-pop's and jump one step further.
1817 ;;
1818 ;; const goto-X ... X: goto-if-* --> whatever
1819 ;; const goto-X ... X: discard --> whatever
1820 ;;
1832 byte-goto-if-not-nil-else-pop)))
1834 lap0 tmp2 lap0 tmp2)
1837 ;; Let next step fix the (const,goto-if*) sequence.
1840 ;; Jump one step further
1843 lap0 tmp2)
1850 ;;
1851 ;; X: varref-Y ... varset-Y goto-X -->
1852 ;; X: varref-Y Z: ... dup varset-Y goto-Z
1853 ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
1854 ;; (This is so usual for while loops that it is worth handling).
1855 ;;
1863 ;;(byte-compile-log-lap " Pulled %s to end of loop" (car tmp))
1868 lap1 lap2
1872 )
1877 ;;
1878 ;; goto-X Y: ... X: goto-if*-Y --> goto-if-not-*-X+1 Y:
1879 ;; (This can pull the loop test to the end of the loop)
1880 ;;
1887 byte-goto-if-nil-else-pop)))
1888 ;; (byte-compile-log-lap " %s %s, %s %s --> moved conditional"
1889 ;; lap0 lap1 (cdr lap0) (car tmp))
1898 byte-goto-if-not-nil-else-pop)
1900 byte-goto-if-nil-else-pop))))
1901 newtag)
1904 )
1907 ;; We can handle this case but not the -if-not-nil case,
1908 ;; because we won't know which non-nil constant to push.
1914 byte-goto-if-not-nil
1915 byte-goto-if-nil
1916 byte-goto-if-not-nil
1917 byte-goto byte-goto))))
1918 )
1920 )
1922 )
1923 ;; Cleanup stage:
1924 ;; Rebuild byte-compile-constants / byte-compile-variables.
1925 ;; Simple optimizations that would inhibit other optimizations if they
1926 ;; were done in the optimizing loop, and optimizations which there is no
1927 ;; need to do more than once.
1929 byte-compile-variables nil)
1939 byte-compile-constants)))
1942 byte-compile-variables)))))
1944 ;; const-C varset-X const-C --> const-C dup varset-X
1945 ;; const-C varbind-X const-C --> const-C dup varbind-X
1946 ;;
1952 lap0 lap1 lap0 lap0 lap1)
1956 ;;
1957 ;; const-X [dup/const-X ...] --> const-X [dup ...] dup
1958 ;; varref-X [dup/varref-X ...] --> varref-X [dup ...] dup
1959 ;;
1962 tmp2 nil)
1972 ;;
1973 ;; unbind-N unbind-M --> unbind-(N+M)
1974 ;;
1983 )
1986 lap)
1990 \f
1991 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
1992 ;; itself, compile some of its most used recursive functions (at load time).
1993 ;;
2004 byte-optimize-body
2005 byte-optimize-predicate
2006 byte-optimize-binary-predicate
2007 ;; Inserted some more than necessary, to speed it up.
2008 byte-optimize-form-code-walker
2009 byte-optimize-lapcode))))
2010 nil)
2012 ;; arch-tag: 0f14076b-737e-4bef-aae6-908826ec1ff1
2013 ;;; byte-opt.el ends here