From 29a4dcb06d4bd78db96d6305f7434ce464aff8a4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 22 Mar 2011 20:53:36 -0400 Subject: [PATCH] Clean up left over Emacs-18/19 code, inline byte-code-functions. * lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el. (byte-compile-inline-expand): Inline all bytecompiled functions. Unify the inlining code of the lexbind and dynbind interpreted functions. (byte-compile-unfold-lambda): Don't handle byte-compiled functions at all. (byte-optimize-form-code-walker): Don't optimize byte-compiled inlined functions here. (byte-compile-splice-in-already-compiled-code): Remove. (byte-code): Don't optimize it any more. (byte-decompile-bytecode-1): Remove unused bytedecomp-bytes. Leave `byte-return's even for `make-spliceable'. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): byte-compile-lambda now always returns a byte-code-function. (byte-compile-byte-code-maker, byte-compile-byte-code-unmake) (byte-compile-closure): Remove. (byte-compile-lambda): Always return a byte-code-function. (byte-compile-top-level): Don't handle `byte-code' forms specially. (byte-compile-inline-lapcode): New function, taken from byte-opt.el. (byte-compile-unfold-bcf): New function. (byte-compile-form): Use it to optimize inline byte-code-functions. (byte-compile-function-form, byte-compile-defun): Simplify. (byte-compile-defmacro): Don't bother calling byte-compile-byte-code-maker. --- lisp/ChangeLog | 27 +++++ lisp/emacs-lisp/byte-opt.el | 142 +++++++--------------- lisp/emacs-lisp/bytecomp.el | 278 +++++++++++++++++++++----------------------- lisp/emacs-lisp/cconv.el | 5 +- 4 files changed, 207 insertions(+), 245 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ea512d99559..d9c1e5a34da 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,30 @@ +2011-03-23 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): + byte-compile-lambda now always returns a byte-code-function. + (byte-compile-byte-code-maker, byte-compile-byte-code-unmake) + (byte-compile-closure): Remove. + (byte-compile-lambda): Always return a byte-code-function. + (byte-compile-top-level): Don't handle `byte-code' forms specially. + (byte-compile-inline-lapcode): New function, taken from byte-opt.el. + (byte-compile-unfold-bcf): New function. + (byte-compile-form): Use it to optimize inline byte-code-functions. + (byte-compile-function-form, byte-compile-defun): Simplify. + (byte-compile-defmacro): Don't bother calling + byte-compile-byte-code-maker. + * emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el. + (byte-compile-inline-expand): Inline all bytecompiled functions. + Unify the inlining code of the lexbind and dynbind interpreted + functions. + (byte-compile-unfold-lambda): Don't handle byte-compiled functions + at all. + (byte-optimize-form-code-walker): Don't optimize byte-compiled inlined + functions here. + (byte-compile-splice-in-already-compiled-code): Remove. + (byte-code): Don't optimize it any more. + (byte-decompile-bytecode-1): Remove unused bytedecomp-bytes. + Leave `byte-return's even for `make-spliceable'. + 2011-03-20 Christian Ohler * emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 6a04dfb2507..35c9a5ddf45 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -244,25 +244,6 @@ sexp))) (cdr form)))) - -;; Splice the given lap code into the current instruction stream. -;; If it has any labels in it, you're responsible for making sure there -;; 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) - ;; "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)) (localfn (cdr (assq name byte-compile-function-environment))) @@ -280,54 +261,42 @@ (error "File `%s' didn't define `%s'" (nth 1 fn) name)) ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias. (byte-compile-inline-expand (cons fn (cdr form)))) - ((and (pred byte-code-function-p) - ;; FIXME: This only works to inline old-style-byte-codes into - ;; old-style-byte-codes. - (guard (not (or lexical-binding - (integerp (aref fn 0)))))) - ;; (message "Inlining %S byte-code" name) - (fetch-bytecode fn) - (let ((string (aref fn 1))) - (assert (not (multibyte-string-p 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)))) - ((and `(lambda . ,_) - ;; With lexical-binding we have several problems: - ;; - if `fn' comes from byte-compile-function-environment, we - ;; need to preprocess `fn', so we handle it below. - ;; - else, it means that `fn' is dyn-bound (otherwise it would - ;; start with `closure') so copying the code here would cause - ;; it to be mis-interpreted. - (guard (not lexical-binding))) - (macroexpand-all (cons fn (cdr form)) - byte-compile-macro-environment)) - ((and (or (and `(lambda ,args . ,body) - (let env nil) - (guard (eq fn localfn))) - `(closure ,env ,args . ,body)) - (guard lexical-binding)) - (let ((renv ())) - (dolist (binding env) - (cond - ((consp binding) - ;; We check shadowing by the args, so that the `let' can be - ;; moved within the lambda, which can then be unfolded. - ;; FIXME: Some of those bindings might be unused in `body'. - (unless (memq (car binding) args) ;Shadowed. - (push `(,(car binding) ',(cdr binding)) renv))) - ((eq binding t)) - (t (push `(defvar ,binding) body)))) - ;; (message "Inlining closure %S" (car form)) - (let ((newfn (byte-compile-preprocess - `(lambda ,args (let ,(nreverse renv) ,@body))))) - (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) - (byte-compile-log-warning - (format "Inlining closure %S failed" name)) - form)))) + ((pred byte-code-function-p) + ;; (message "Inlining byte-code for %S!" name) + ;; The byte-code will be really inlined in byte-compile-unfold-bcf. + `(,fn ,@(cdr form))) + ((or (and `(lambda ,args . ,body) (let env nil)) + `(closure ,env ,args . ,body)) + (if (not (or (eq fn localfn) ;From the same file => same mode. + (eq (not lexical-binding) (not env)))) ;Same mode. + ;; While byte-compile-unfold-bcf can inline dynbind byte-code into + ;; letbind byte-code (or any other combination for that matter), we + ;; can only inline dynbind source into dynbind source or letbind + ;; source into letbind source. + ;; FIXME: we could of course byte-compile the inlined function + ;; first, and then inline its byte-code. + form + (let ((renv ())) + ;; Turn the function's closed vars (if any) into local let bindings. + (dolist (binding env) + (cond + ((consp binding) + ;; We check shadowing by the args, so that the `let' can be + ;; moved within the lambda, which can then be unfolded. + ;; FIXME: Some of those bindings might be unused in `body'. + (unless (memq (car binding) args) ;Shadowed. + (push `(,(car binding) ',(cdr binding)) renv))) + ((eq binding t)) + (t (push `(defvar ,binding) body)))) + (let ((newfn (byte-compile-preprocess + (if (null renv) + `(lambda ,args ,@body) + `(lambda ,args (let ,(nreverse renv) ,@body)))))) + (if (eq (car-safe newfn) 'function) + (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (byte-compile-log-warning + (format "Inlining closure %S failed" name)) + form))))) (t ;; Give up on inlining. form)))) @@ -341,10 +310,6 @@ (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) - (if (byte-code-function-p lambda) - (setq lambda (list 'lambda (aref lambda 0) - (list 'byte-code (aref lambda 1) - (aref lambda 2) (aref lambda 3))))) (let ((arglist (nth 1 lambda)) (body (cdr (cdr lambda))) optionalp restp @@ -353,6 +318,7 @@ (setq body (cdr body))) (if (and (consp (car body)) (eq 'interactive (car (car body)))) (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. (while arglist (cond ((eq (car arglist) '&optional) ;; ok, I'll let this slide because funcall_lambda() does... @@ -430,8 +396,7 @@ (and (nth 1 form) (not for-effect) form)) - ((or (byte-code-function-p fn) - (eq 'lambda (car-safe fn))) + ((eq 'lambda (car-safe fn)) (let ((newform (byte-compile-unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion @@ -564,7 +529,10 @@ ;; Neeeded as long as we run byte-optimize-form after cconv. ((eq fn 'internal-make-closure) form) - + + ((byte-code-function-p fn) + (cons fn (mapcar #'byte-optimize-form (cdr form)))) + ((not (symbolp fn)) (debug) (byte-compile-warn "`%s' is a malformed function" @@ -1328,16 +1296,6 @@ (put (car pure-fns) 'pure t) (setq pure-fns (cdr pure-fns))) nil) - -(defun byte-compile-splice-in-already-compiled-code (form) - ;; form is (byte-code "..." [...] n) - (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)))) - -(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) - (defconst byte-constref-ops '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) @@ -1405,18 +1363,17 @@ ;; In that case, we put a pc value into the list ;; before each insn (or its label). (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) - (let ((bytedecomp-bytes bytes) - (length (length bytes)) + (let ((length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset lap tmp endtag) (while (not (= bytedecomp-ptr length)) (or make-spliceable (push bytedecomp-ptr lap)) - (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr) + (setq bytedecomp-op (aref bytes bytedecomp-ptr) optr bytedecomp-ptr ;; This uses dynamic-scope magic. - offset (disassemble-offset bytedecomp-bytes)) + offset (disassemble-offset bytes)) (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) (cond ((memq bytedecomp-op byte-goto-ops) ;; It's a pc. @@ -1437,12 +1394,6 @@ (let ((new (list tmp))) (push new byte-compile-variables) new))))) - ((and make-spliceable - (eq bytedecomp-op 'byte-return)) - (if (= bytedecomp-ptr (1- length)) - (setq bytedecomp-op nil) - (setq offset (or endtag (setq endtag (byte-compile-make-tag))) - bytedecomp-op 'byte-goto))) ((eq bytedecomp-op 'byte-stack-set2) (setq bytedecomp-op 'byte-stack-set)) ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80)) @@ -1467,9 +1418,6 @@ (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) - ;; Take off the dummy nil op that we replaced a trailing "return" with. - (if (null (car (cdr (car lap)))) - (setq lap (cdr lap))) (if endtag (setq lap (cons (cons nil endtag) lap))) ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5a87f590020..5e671d7e694 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2390,15 +2390,15 @@ by side-effects." (not (assq (nth 1 form) byte-compile-initial-macro-environment))) (byte-compile-warn - "`%s' defined multiple times, as both function and macro" - (nth 1 form))) + "`%s' defined multiple times, as both function and macro" + (nth 1 form))) (setcdr that-one nil)) (this-one (when (and (byte-compile-warning-enabled-p 'redefine) - ;; hack: don't warn when compiling the magic internal - ;; byte-compiler macros in byte-run.el... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) + ;; hack: don't warn when compiling the magic internal + ;; byte-compiler macros in byte-run.el... + (not (assq (nth 1 form) + byte-compile-initial-macro-environment))) (byte-compile-warn "%s `%s' defined multiple times in this file" (if macrop "macro" "function") (nth 1 form)))) @@ -2430,52 +2430,36 @@ by side-effects." (dolist (decl (byte-compile-defmacro-declaration form)) (prin1 decl byte-compile-outbuffer))) - (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t)) - (code (byte-compile-byte-code-maker new-one))) + (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) (if this-one - (setcdr this-one new-one) + (setcdr this-one code) (set this-kind - (cons (cons name new-one) + (cons (cons name code) (symbol-value this-kind)))) - (if (and (stringp (nth 3 form)) - (eq 'quote (car-safe code)) - (eq 'lambda (car-safe (nth 1 code)))) - (cons (car form) - (cons name (cdr (nth 1 code)))) - (byte-compile-flush-pending) - (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) - ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) - (append code nil) - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) - ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) - (append code nil) - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile-outbuffer) - nil)))) + (byte-compile-flush-pending) + (if (not (stringp (nth 3 form))) + ;; No doc string. Provide -1 as the "doc string index" + ;; so that no element will be treated as a doc string. + (byte-compile-output-docform + "\n(defalias '" + name + (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil) + ;; Output the form by hand, that's much simpler than having + ;; b-c-output-file-form analyze the defalias. + (byte-compile-output-docform + "\n(defalias '" + name + (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil)) + (princ ")" byte-compile-outbuffer) + nil))) ;; Print Lisp object EXP in the output file, inside a comment, ;; and return the file position it will have. @@ -2547,56 +2531,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-close-variables (byte-compile-top-level (byte-compile-preprocess sexp))))) -;; Given a function made by byte-compile-lambda, make a form which produces it. -(defun byte-compile-byte-code-maker (fun) - (cond - ;; ## atom is faster than compiled-func-p. - ((atom fun) ; compiled function. - ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda - ;; would have produced a lambda. - fun) - ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial - ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. - ((let (tmp) - ;; FIXME: can this happen? - (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) - (null (cdr (memq tmp fun)))) - ;; Generate a make-byte-code call. - (let* ((interactive (assq 'interactive (cdr (cdr fun))))) - (nconc (list 'make-byte-code - (list 'quote (nth 1 fun)) ;arglist - (nth 1 tmp) ;bytes - (nth 2 tmp) ;consts - (nth 3 tmp)) ;depth - (cond ((stringp (nth 2 fun)) - (list (nth 2 fun))) ;doc - (interactive - (list nil))) - (cond (interactive - (list (if (or (null (nth 1 interactive)) - (stringp (nth 1 interactive))) - (nth 1 interactive) - ;; Interactive spec is a list or a variable - ;; (if it is correct). - (list 'quote (nth 1 interactive)))))))) - ;; a non-compiled function (probably trivial) - (list 'quote fun)))))) - -;; Turn a function into an ordinary lambda. Needed for v18 files. -(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it? - (if (consp function) - function;;It already is a lambda. - (setq function (append function nil)) ; turn it into a list - (nconc (list 'lambda (nth 0 function)) - (and (nth 4 function) (list (nth 4 function))) - (if (nthcdr 5 function) - (list (cons 'interactive (if (nth 5 function) - (nthcdr 5 function))))) - (list (list 'byte-code - (nth 1 function) (nth 2 function) - (nth 3 function)))))) - - (defun byte-compile-check-lambda-list (list) "Check lambda-list LIST for errors." (let (vars) @@ -2745,20 +2679,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; optionally, the interactive spec. (if int (list (nth 1 int))))) - (setq compiled - (nconc (if int (list int)) - (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) - (compiled (list compiled))))) - (nconc (list 'lambda arglist) - (if (or doc (stringp (car compiled))) - (cons doc (cond (compiled) - (body (list nil)))) - compiled)))))) - -(defun byte-compile-closure (form &optional add-lambda) - (let ((code (byte-compile-lambda form add-lambda))) - ;; A simple lambda is just a constant. - (byte-compile-constant code))) + (error "byte-compile-top-level did not return byte-code"))))) (defvar byte-compile-reserved-constants 0) @@ -2818,23 +2739,18 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq form (byte-optimize-form form byte-compile--for-effect))) (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) (setq form (nth 1 form))) - (if (and (eq 'byte-code (car-safe form)) - (not (memq byte-optimize '(t byte))) - (stringp (nth 1 form)) (vectorp (nth 2 form)) - (natnump (nth 3 form))) - form - ;; Set up things for a lexically-bound function. - (when (and lexical-binding (eq output-type 'lambda)) - ;; See how many arguments there are, and set the current stack depth - ;; accordingly. - (setq byte-compile-depth (length byte-compile-lexical-environment)) - ;; If there are args, output a tag to record the initial - ;; stack-depth for the optimizer. - (when (> byte-compile-depth 0) - (byte-compile-out-tag (byte-compile-make-tag)))) - ;; Now compile FORM - (byte-compile-form form byte-compile--for-effect) - (byte-compile-out-toplevel byte-compile--for-effect output-type)))) + ;; Set up things for a lexically-bound function. + (when (and lexical-binding (eq output-type 'lambda)) + ;; See how many arguments there are, and set the current stack depth + ;; accordingly. + (setq byte-compile-depth (length byte-compile-lexical-environment)) + ;; If there are args, output a tag to record the initial + ;; stack-depth for the optimizer. + (when (> byte-compile-depth 0) + (byte-compile-out-tag (byte-compile-make-tag)))) + ;; Now compile FORM + (byte-compile-form form byte-compile--for-effect) + (byte-compile-out-toplevel byte-compile--for-effect output-type))) (defun byte-compile-out-toplevel (&optional for-effect output-type) (if for-effect @@ -2873,7 +2789,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest - (byte-compile--for-effect for-effect) + (byte-compile--for-effect for-effect) ;FIXME: Probably unused! (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2999,8 +2915,10 @@ That command is designed for interactive use only" fn)) (byte-compile-normal-call form)) (if (byte-compile-warning-enabled-p 'cl-functions) (byte-compile-cl-warn form)))) - ((and (or (byte-code-function-p (car form)) - (eq (car-safe (car form)) 'lambda)) + ((and (byte-code-function-p (car form)) + (memq byte-optimize '(t lap))) + (byte-compile-unfold-bcf form)) + ((and (eq (car-safe (car form)) 'lambda) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. (not (eq form (setq form (byte-compile-unfold-lambda form))))) @@ -3032,6 +2950,80 @@ That command is designed for interactive use only" fn)) (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. (byte-compile-out 'byte-call (length (cdr form)))) + +;; Splice the given lap code into the current instruction stream. +;; If it has any labels in it, you're responsible for making sure there +;; are no collisions, and that byte-compile-tag-number is reasonable +;; after this is spliced in. The provided list is destroyed. +(defun byte-compile-inline-lapcode (lap end-depth) + ;; "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. + (let ((endtag (byte-compile-make-tag))) + (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))) + ((eq (car op) 'byte-return) + (byte-compile-discard (- byte-compile-depth end-depth) t) + (byte-compile-goto 'byte-goto endtag)) + (t (byte-compile-out (car op) (cdr op))))) + (byte-compile-out-tag endtag))) + +(defun byte-compile-unfold-bcf (form) + (let* ((byte-compile-bound-variables byte-compile-bound-variables) + (fun (car form)) + (fargs (aref fun 0)) + (start-depth byte-compile-depth) + (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. + ;; (fmin (if (numberp fargs) (logand fargs 127))) + (alen (length (cdr form))) + (dynbinds ())) + (fetch-bytecode fun) + (mapc 'byte-compile-form (cdr form)) + (unless fmax2 + ;; Old-style byte-code. + (assert (listp fargs)) + (while fargs + (case (car fargs) + (&optional (setq fargs (cdr fargs))) + (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (push (cadr fargs) dynbinds) + (setq fargs nil)) + (t (push (pop fargs) dynbinds)))) + (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) + (cond + ((<= (+ alen alen) fmax2) + ;; Add missing &optional (or &rest) arguments. + (dotimes (i (- (/ (1+ fmax2) 2) alen)) + (byte-compile-push-constant nil))) + ((zerop (logand fmax2 1)) + (byte-compile-log-warning "Too many arguments for inlined function" + nil :error) + (byte-compile-discard (- alen (/ fmax2 2)))) + (t + ;; Turn &rest args into a list. + (let ((n (- alen (/ (1- fmax2) 2)))) + (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (if (< n 5) + (byte-compile-out + (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) + 0) + (byte-compile-out 'byte-listN n))))) + (mapc #'byte-compile-dynamic-variable-bind dynbinds) + (byte-compile-inline-lapcode + (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t) + (1+ start-depth)) + ;; Unbind dynamic variables. + (when dynbinds + (byte-compile-out 'byte-unbind (length dynbinds))) + (assert (eq byte-compile-depth (1+ start-depth)) + nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) + (defun byte-compile-check-variable (var &optional binding) "Do various error checks before a use of the variable VAR. If BINDING is non-nil, VAR is being bound." @@ -3271,7 +3263,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-compile-warn "`%s' called with %d arg%s, but requires %s" (car form) (length (cdr form)) (if (= 1 (length (cdr form))) "" "s") n) - ;; get run-time wrong-number-of-args error. + ;; Get run-time wrong-number-of-args error. (byte-compile-normal-call form)) (defun byte-compile-no-args (form) @@ -3534,7 +3526,7 @@ discarding." (byte-compile-warn "A quoted lambda form is the second argument of `fset'. This is probably not what you want, as that lambda cannot be compiled. Consider using - the syntax (function (lambda (...) ...)) instead."))))) + the syntax #'(lambda (...) ...) instead."))))) (byte-compile-two-args form)) ;; (function foo) must compile like 'foo, not like (symbol-function 'foo). @@ -3542,9 +3534,9 @@ discarding." ;; and (funcall (function foo)) will lose with autoloads. (defun byte-compile-function-form (form) - (if (symbolp (nth 1 form)) - (byte-compile-constant (nth 1 form)) - (byte-compile-closure (nth 1 form)))) + (byte-compile-constant (if (symbolp (nth 1 form)) + (nth 1 form) + (byte-compile-lambda (nth 1 form))))) (defun byte-compile-indent-to (form) (let ((len (length form))) @@ -4102,18 +4094,16 @@ binding slots have been popped." (byte-compile-set-symbol-position (car form)) (byte-compile-set-symbol-position 'defun) (error "defun name must be a symbol, not %s" (car form))) - (let ((byte-compile--for-effect nil)) - (byte-compile-push-constant 'defalias) - (byte-compile-push-constant (nth 1 form)) - (byte-compile-closure (cdr (cdr form)) t)) + (byte-compile-push-constant 'defalias) + (byte-compile-push-constant (nth 1 form)) + (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t)) (byte-compile-out 'byte-call 2)) (defun byte-compile-defmacro (form) ;; This is not used for file-level defmacros with doc strings. (byte-compile-body-do-effect (let ((decls (byte-compile-defmacro-declaration form)) - (code (byte-compile-byte-code-maker - (byte-compile-lambda (cdr (cdr form)) t)))) + (code (byte-compile-lambda (cdr (cdr form)) t))) `((defalias ',(nth 1 form) ,(if (eq (car-safe code) 'make-byte-code) `(cons 'macro ,code) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 5d19bf969e6..fe5d7230fb8 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -66,9 +66,6 @@ ;;; Code: ;; TODO: (not just for cconv but also for the lexbind changes in general) -;; - inline lexical byte-code functions. -;; - investigate some old v18 stuff in bytecomp.el. -;; - optimize away unused cl-block-wrapper. ;; - let (e)debug find the value of lexical variables from the stack. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize @@ -87,7 +84,7 @@ ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - add tail-calls to bytecode.c and the byte compiler. -;; - call known non-escaping functions with gotos rather than `call'. +;; - call known non-escaping functions with `goto' rather than `call'. ;; - optimize mapcar to a while loop. ;; (defmacro dlet (binders &rest body) -- 2.11.4.GIT