mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-03-15 11:21:19 -07:00
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.
This commit is contained in:
Stefan Monnier
parent
cafdcef32d
commit
29a4dcb06d
4 changed files with 207 additions and 245 deletions
|
|
@ -1,3 +1,30 @@
|
|||
2011-03-23 Stefan Monnier <monnier@iro.umontreal.ca>
|
||||
|
||||
* 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 <ohler@gnu.org>
|
||||
|
||||
* emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL
|
||||
|
|
|
|||
|
|
@ -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) ]* )
|
||||
|
|
|
|||
|
|
@ -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 <<same-as-eval>> or (progn <<same-as-eval>> 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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue