Commit 29a4dcb0 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

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.
parent cafdcef3
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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment