diff options
Diffstat (limited to 'lisp/emacs-lisp/byte-opt.el')
| -rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 63 |
1 files changed, 39 insertions, 24 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 71960ad54dc..12df3251267 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -248,7 +248,18 @@ ;; are no collisions, and that byte-compile-tag-number is reasonable ;; after this is spliced in. The provided list is destroyed. (defun byte-inline-lapcode (lap) - (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))) + ;; "Replay" the operations: we used to just do + ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)) + ;; but that fails to update byte-compile-depth, so we had to assume + ;; that `lap' ends up adding exactly 1 element to the stack. This + ;; happens to be true for byte-code generated by bytecomp.el without + ;; lexical-binding, but it's not true in general, and it's not true for + ;; code output by bytecomp.el with lexical-binding. + (dolist (op lap) + (cond + ((eq (car op) 'TAG) (byte-compile-out-tag op)) + ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) + (t (byte-compile-out (car op) (cdr op)))))) (defun byte-compile-inline-expand (form) (let* ((name (car form)) @@ -266,25 +277,32 @@ (cdr (assq name byte-compile-function-environment))))) (if (and (consp fn) (eq (car fn) 'autoload)) (error "File `%s' didn't define `%s'" (nth 1 fn) name)) - (if (and (symbolp fn) (not (eq fn t))) - (byte-compile-inline-expand (cons fn (cdr form))) - (if (byte-code-function-p fn) - (let (string) - (fetch-bytecode fn) - (setq string (aref fn 1)) - ;; Isn't it an error for `string' not to be unibyte?? --stef - (if (fboundp 'string-as-unibyte) - (setq string (string-as-unibyte string))) - ;; `byte-compile-splice-in-already-compiled-code' - ;; takes care of inlining the body. - (cons `(lambda ,(aref fn 0) - (byte-code ,string ,(aref fn 2) ,(aref fn 3))) - (cdr form))) - (if (eq (car-safe fn) 'lambda) - (macroexpand-all (cons fn (cdr form)) - byte-compile-macro-environment) - ;; Give up on inlining. - form)))))) + (cond + ((and (symbolp fn) (not (eq fn t))) ;A function alias. + (byte-compile-inline-expand (cons fn (cdr form)))) + ((and (byte-code-function-p fn) + ;; FIXME: This works to inline old-style-byte-codes into + ;; old-style-byte-codes, but not mixed cases (not sure + ;; about new-style into new-style). + (not lexical-binding) + (not (and (>= (length fn) 7) + (aref fn 6)))) ;6 = COMPILED_PUSH_ARGS + ;; (message "Inlining %S byte-code" name) + (fetch-bytecode fn) + (let ((string (aref fn 1))) + ;; Isn't it an error for `string' not to be unibyte?? --stef + (if (fboundp 'string-as-unibyte) + (setq string (string-as-unibyte string))) + ;; `byte-compile-splice-in-already-compiled-code' + ;; takes care of inlining the body. + (cons `(lambda ,(aref fn 0) + (byte-code ,string ,(aref fn 2) ,(aref fn 3))) + (cdr form)))) + ((eq (car-safe fn) 'lambda) + (macroexpand-all (cons fn (cdr form)) + byte-compile-macro-environment)) + (t ;; Give up on inlining. + form))))) ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) @@ -1298,10 +1316,7 @@ (if (not (memq byte-optimize '(t lap))) (byte-compile-normal-call form) (byte-inline-lapcode - (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)) - (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form)) - byte-compile-maxdepth)) - (setq byte-compile-depth (1+ byte-compile-depth)))) + (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)))) (put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) |