aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2011-03-22 20:53:36 -0400
committerStefan Monnier2011-03-22 20:53:36 -0400
commit29a4dcb06d4bd78db96d6305f7434ce464aff8a4 (patch)
tree483a56b4db104ebab3874abf5b9017c43662d2f4
parentcafdcef32d55cbb44389d7e322e7f973cbb72dfd (diff)
downloademacs-29a4dcb06d4bd78db96d6305f7434ce464aff8a4.tar.gz
emacs-29a4dcb06d4bd78db96d6305f7434ce464aff8a4.zip
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.
-rw-r--r--lisp/ChangeLog27
-rw-r--r--lisp/emacs-lisp/byte-opt.el142
-rw-r--r--lisp/emacs-lisp/bytecomp.el278
-rw-r--r--lisp/emacs-lisp/cconv.el5
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 @@
12011-03-23 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble):
4 byte-compile-lambda now always returns a byte-code-function.
5 (byte-compile-byte-code-maker, byte-compile-byte-code-unmake)
6 (byte-compile-closure): Remove.
7 (byte-compile-lambda): Always return a byte-code-function.
8 (byte-compile-top-level): Don't handle `byte-code' forms specially.
9 (byte-compile-inline-lapcode): New function, taken from byte-opt.el.
10 (byte-compile-unfold-bcf): New function.
11 (byte-compile-form): Use it to optimize inline byte-code-functions.
12 (byte-compile-function-form, byte-compile-defun): Simplify.
13 (byte-compile-defmacro): Don't bother calling
14 byte-compile-byte-code-maker.
15 * emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el.
16 (byte-compile-inline-expand): Inline all bytecompiled functions.
17 Unify the inlining code of the lexbind and dynbind interpreted
18 functions.
19 (byte-compile-unfold-lambda): Don't handle byte-compiled functions
20 at all.
21 (byte-optimize-form-code-walker): Don't optimize byte-compiled inlined
22 functions here.
23 (byte-compile-splice-in-already-compiled-code): Remove.
24 (byte-code): Don't optimize it any more.
25 (byte-decompile-bytecode-1): Remove unused bytedecomp-bytes.
26 Leave `byte-return's even for `make-spliceable'.
27
12011-03-20 Christian Ohler <ohler@gnu.org> 282011-03-20 Christian Ohler <ohler@gnu.org>
2 29
3 * emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL 30 * 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 @@
244 sexp))) 244 sexp)))
245 (cdr form)))) 245 (cdr form))))
246 246
247
248;; Splice the given lap code into the current instruction stream.
249;; If it has any labels in it, you're responsible for making sure there
250;; are no collisions, and that byte-compile-tag-number is reasonable
251;; after this is spliced in. The provided list is destroyed.
252(defun byte-inline-lapcode (lap)
253 ;; "Replay" the operations: we used to just do
254 ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
255 ;; but that fails to update byte-compile-depth, so we had to assume
256 ;; that `lap' ends up adding exactly 1 element to the stack. This
257 ;; happens to be true for byte-code generated by bytecomp.el without
258 ;; lexical-binding, but it's not true in general, and it's not true for
259 ;; code output by bytecomp.el with lexical-binding.
260 (dolist (op lap)
261 (cond
262 ((eq (car op) 'TAG) (byte-compile-out-tag op))
263 ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
264 (t (byte-compile-out (car op) (cdr op))))))
265
266(defun byte-compile-inline-expand (form) 247(defun byte-compile-inline-expand (form)
267 (let* ((name (car form)) 248 (let* ((name (car form))
268 (localfn (cdr (assq name byte-compile-function-environment))) 249 (localfn (cdr (assq name byte-compile-function-environment)))
@@ -280,54 +261,42 @@
280 (error "File `%s' didn't define `%s'" (nth 1 fn) name)) 261 (error "File `%s' didn't define `%s'" (nth 1 fn) name))
281 ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias. 262 ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias.
282 (byte-compile-inline-expand (cons fn (cdr form)))) 263 (byte-compile-inline-expand (cons fn (cdr form))))
283 ((and (pred byte-code-function-p) 264 ((pred byte-code-function-p)
284 ;; FIXME: This only works to inline old-style-byte-codes into 265 ;; (message "Inlining byte-code for %S!" name)
285 ;; old-style-byte-codes. 266 ;; The byte-code will be really inlined in byte-compile-unfold-bcf.
286 (guard (not (or lexical-binding 267 `(,fn ,@(cdr form)))
287 (integerp (aref fn 0)))))) 268 ((or (and `(lambda ,args . ,body) (let env nil))
288 ;; (message "Inlining %S byte-code" name) 269 `(closure ,env ,args . ,body))
289 (fetch-bytecode fn) 270 (if (not (or (eq fn localfn) ;From the same file => same mode.
290 (let ((string (aref fn 1))) 271 (eq (not lexical-binding) (not env)))) ;Same mode.
291 (assert (not (multibyte-string-p string))) 272 ;; While byte-compile-unfold-bcf can inline dynbind byte-code into
292 ;; `byte-compile-splice-in-already-compiled-code' 273 ;; letbind byte-code (or any other combination for that matter), we
293 ;; takes care of inlining the body. 274 ;; can only inline dynbind source into dynbind source or letbind
294 (cons `(lambda ,(aref fn 0) 275 ;; source into letbind source.
295 (byte-code ,string ,(aref fn 2) ,(aref fn 3))) 276 ;; FIXME: we could of course byte-compile the inlined function
296 (cdr form)))) 277 ;; first, and then inline its byte-code.
297 ((and `(lambda . ,_) 278 form
298 ;; With lexical-binding we have several problems: 279 (let ((renv ()))
299 ;; - if `fn' comes from byte-compile-function-environment, we 280 ;; Turn the function's closed vars (if any) into local let bindings.
300 ;; need to preprocess `fn', so we handle it below. 281 (dolist (binding env)
301 ;; - else, it means that `fn' is dyn-bound (otherwise it would 282 (cond
302 ;; start with `closure') so copying the code here would cause 283 ((consp binding)
303 ;; it to be mis-interpreted. 284 ;; We check shadowing by the args, so that the `let' can be
304 (guard (not lexical-binding))) 285 ;; moved within the lambda, which can then be unfolded.
305 (macroexpand-all (cons fn (cdr form)) 286 ;; FIXME: Some of those bindings might be unused in `body'.
306 byte-compile-macro-environment)) 287 (unless (memq (car binding) args) ;Shadowed.
307 ((and (or (and `(lambda ,args . ,body) 288 (push `(,(car binding) ',(cdr binding)) renv)))
308 (let env nil) 289 ((eq binding t))
309 (guard (eq fn localfn))) 290 (t (push `(defvar ,binding) body))))
310 `(closure ,env ,args . ,body)) 291 (let ((newfn (byte-compile-preprocess
311 (guard lexical-binding)) 292 (if (null renv)
312 (let ((renv ())) 293 `(lambda ,args ,@body)
313 (dolist (binding env) 294 `(lambda ,args (let ,(nreverse renv) ,@body))))))
314 (cond 295 (if (eq (car-safe newfn) 'function)
315 ((consp binding) 296 (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
316 ;; We check shadowing by the args, so that the `let' can be 297 (byte-compile-log-warning
317 ;; moved within the lambda, which can then be unfolded. 298 (format "Inlining closure %S failed" name))
318 ;; FIXME: Some of those bindings might be unused in `body'. 299 form)))))
319 (unless (memq (car binding) args) ;Shadowed.
320 (push `(,(car binding) ',(cdr binding)) renv)))
321 ((eq binding t))
322 (t (push `(defvar ,binding) body))))
323 ;; (message "Inlining closure %S" (car form))
324 (let ((newfn (byte-compile-preprocess
325 `(lambda ,args (let ,(nreverse renv) ,@body)))))
326 (if (eq (car-safe newfn) 'function)
327 (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form)))
328 (byte-compile-log-warning
329 (format "Inlining closure %S failed" name))
330 form))))
331 300
332 (t ;; Give up on inlining. 301 (t ;; Give up on inlining.
333 form)))) 302 form))))
@@ -341,10 +310,6 @@
341 (or name (setq name "anonymous lambda")) 310 (or name (setq name "anonymous lambda"))
342 (let ((lambda (car form)) 311 (let ((lambda (car form))
343 (values (cdr form))) 312 (values (cdr form)))
344 (if (byte-code-function-p lambda)
345 (setq lambda (list 'lambda (aref lambda 0)
346 (list 'byte-code (aref lambda 1)
347 (aref lambda 2) (aref lambda 3)))))
348 (let ((arglist (nth 1 lambda)) 313 (let ((arglist (nth 1 lambda))
349 (body (cdr (cdr lambda))) 314 (body (cdr (cdr lambda)))
350 optionalp restp 315 optionalp restp
@@ -353,6 +318,7 @@
353 (setq body (cdr body))) 318 (setq body (cdr body)))
354 (if (and (consp (car body)) (eq 'interactive (car (car body)))) 319 (if (and (consp (car body)) (eq 'interactive (car (car body))))
355 (setq body (cdr body))) 320 (setq body (cdr body)))
321 ;; FIXME: The checks below do not belong in an optimization phase.
356 (while arglist 322 (while arglist
357 (cond ((eq (car arglist) '&optional) 323 (cond ((eq (car arglist) '&optional)
358 ;; ok, I'll let this slide because funcall_lambda() does... 324 ;; ok, I'll let this slide because funcall_lambda() does...
@@ -430,8 +396,7 @@
430 (and (nth 1 form) 396 (and (nth 1 form)
431 (not for-effect) 397 (not for-effect)
432 form)) 398 form))
433 ((or (byte-code-function-p fn) 399 ((eq 'lambda (car-safe fn))
434 (eq 'lambda (car-safe fn)))
435 (let ((newform (byte-compile-unfold-lambda form))) 400 (let ((newform (byte-compile-unfold-lambda form)))
436 (if (eq newform form) 401 (if (eq newform form)
437 ;; Some error occurred, avoid infinite recursion 402 ;; Some error occurred, avoid infinite recursion
@@ -564,7 +529,10 @@
564 529
565 ;; Neeeded as long as we run byte-optimize-form after cconv. 530 ;; Neeeded as long as we run byte-optimize-form after cconv.
566 ((eq fn 'internal-make-closure) form) 531 ((eq fn 'internal-make-closure) form)
567 532
533 ((byte-code-function-p fn)
534 (cons fn (mapcar #'byte-optimize-form (cdr form))))
535
568 ((not (symbolp fn)) 536 ((not (symbolp fn))
569 (debug) 537 (debug)
570 (byte-compile-warn "`%s' is a malformed function" 538 (byte-compile-warn "`%s' is a malformed function"
@@ -1328,16 +1296,6 @@
1328 (put (car pure-fns) 'pure t) 1296 (put (car pure-fns) 'pure t)
1329 (setq pure-fns (cdr pure-fns))) 1297 (setq pure-fns (cdr pure-fns)))
1330 nil) 1298 nil)
1331
1332(defun byte-compile-splice-in-already-compiled-code (form)
1333 ;; form is (byte-code "..." [...] n)
1334 (if (not (memq byte-optimize '(t lap)))
1335 (byte-compile-normal-call form)
1336 (byte-inline-lapcode
1337 (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t))))
1338
1339(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code)
1340
1341 1299
1342(defconst byte-constref-ops 1300(defconst byte-constref-ops
1343 '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) 1301 '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
@@ -1405,18 +1363,17 @@
1405;; In that case, we put a pc value into the list 1363;; In that case, we put a pc value into the list
1406;; before each insn (or its label). 1364;; before each insn (or its label).
1407(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) 1365(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
1408 (let ((bytedecomp-bytes bytes) 1366 (let ((length (length bytes))
1409 (length (length bytes))
1410 (bytedecomp-ptr 0) optr tags bytedecomp-op offset 1367 (bytedecomp-ptr 0) optr tags bytedecomp-op offset
1411 lap tmp 1368 lap tmp
1412 endtag) 1369 endtag)
1413 (while (not (= bytedecomp-ptr length)) 1370 (while (not (= bytedecomp-ptr length))
1414 (or make-spliceable 1371 (or make-spliceable
1415 (push bytedecomp-ptr lap)) 1372 (push bytedecomp-ptr lap))
1416 (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr) 1373 (setq bytedecomp-op (aref bytes bytedecomp-ptr)
1417 optr bytedecomp-ptr 1374 optr bytedecomp-ptr
1418 ;; This uses dynamic-scope magic. 1375 ;; This uses dynamic-scope magic.
1419 offset (disassemble-offset bytedecomp-bytes)) 1376 offset (disassemble-offset bytes))
1420 (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) 1377 (setq bytedecomp-op (aref byte-code-vector bytedecomp-op))
1421 (cond ((memq bytedecomp-op byte-goto-ops) 1378 (cond ((memq bytedecomp-op byte-goto-ops)
1422 ;; It's a pc. 1379 ;; It's a pc.
@@ -1437,12 +1394,6 @@
1437 (let ((new (list tmp))) 1394 (let ((new (list tmp)))
1438 (push new byte-compile-variables) 1395 (push new byte-compile-variables)
1439 new))))) 1396 new)))))
1440 ((and make-spliceable
1441 (eq bytedecomp-op 'byte-return))
1442 (if (= bytedecomp-ptr (1- length))
1443 (setq bytedecomp-op nil)
1444 (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
1445 bytedecomp-op 'byte-goto)))
1446 ((eq bytedecomp-op 'byte-stack-set2) 1397 ((eq bytedecomp-op 'byte-stack-set2)
1447 (setq bytedecomp-op 'byte-stack-set)) 1398 (setq bytedecomp-op 'byte-stack-set))
1448 ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80)) 1399 ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80))
@@ -1467,9 +1418,6 @@
1467 (setq rest (cdr rest)))) 1418 (setq rest (cdr rest))))
1468 (setq rest (cdr rest)))) 1419 (setq rest (cdr rest))))
1469 (if tags (error "optimizer error: missed tags %s" tags)) 1420 (if tags (error "optimizer error: missed tags %s" tags))
1470 ;; Take off the dummy nil op that we replaced a trailing "return" with.
1471 (if (null (car (cdr (car lap))))
1472 (setq lap (cdr lap)))
1473 (if endtag 1421 (if endtag
1474 (setq lap (cons (cons nil endtag) lap))) 1422 (setq lap (cons (cons nil endtag) lap)))
1475 ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) 1423 ;; 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."
2390 (not (assq (nth 1 form) 2390 (not (assq (nth 1 form)
2391 byte-compile-initial-macro-environment))) 2391 byte-compile-initial-macro-environment)))
2392 (byte-compile-warn 2392 (byte-compile-warn
2393 "`%s' defined multiple times, as both function and macro" 2393 "`%s' defined multiple times, as both function and macro"
2394 (nth 1 form))) 2394 (nth 1 form)))
2395 (setcdr that-one nil)) 2395 (setcdr that-one nil))
2396 (this-one 2396 (this-one
2397 (when (and (byte-compile-warning-enabled-p 'redefine) 2397 (when (and (byte-compile-warning-enabled-p 'redefine)
2398 ;; hack: don't warn when compiling the magic internal 2398 ;; hack: don't warn when compiling the magic internal
2399 ;; byte-compiler macros in byte-run.el... 2399 ;; byte-compiler macros in byte-run.el...
2400 (not (assq (nth 1 form) 2400 (not (assq (nth 1 form)
2401 byte-compile-initial-macro-environment))) 2401 byte-compile-initial-macro-environment)))
2402 (byte-compile-warn "%s `%s' defined multiple times in this file" 2402 (byte-compile-warn "%s `%s' defined multiple times in this file"
2403 (if macrop "macro" "function") 2403 (if macrop "macro" "function")
2404 (nth 1 form)))) 2404 (nth 1 form))))
@@ -2430,52 +2430,36 @@ by side-effects."
2430 (dolist (decl (byte-compile-defmacro-declaration form)) 2430 (dolist (decl (byte-compile-defmacro-declaration form))
2431 (prin1 decl byte-compile-outbuffer))) 2431 (prin1 decl byte-compile-outbuffer)))
2432 2432
2433 (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t)) 2433 (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
2434 (code (byte-compile-byte-code-maker new-one)))
2435 (if this-one 2434 (if this-one
2436 (setcdr this-one new-one) 2435 (setcdr this-one code)
2437 (set this-kind 2436 (set this-kind
2438 (cons (cons name new-one) 2437 (cons (cons name code)
2439 (symbol-value this-kind)))) 2438 (symbol-value this-kind))))
2440 (if (and (stringp (nth 3 form)) 2439 (byte-compile-flush-pending)
2441 (eq 'quote (car-safe code)) 2440 (if (not (stringp (nth 3 form)))
2442 (eq 'lambda (car-safe (nth 1 code)))) 2441 ;; No doc string. Provide -1 as the "doc string index"
2443 (cons (car form) 2442 ;; so that no element will be treated as a doc string.
2444 (cons name (cdr (nth 1 code)))) 2443 (byte-compile-output-docform
2445 (byte-compile-flush-pending) 2444 "\n(defalias '"
2446 (if (not (stringp (nth 3 form))) 2445 name
2447 ;; No doc string. Provide -1 as the "doc string index" 2446 (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
2448 ;; so that no element will be treated as a doc string. 2447 (append code nil) ; Turn byte-code-function-p into list.
2449 (byte-compile-output-docform 2448 (and (atom code) byte-compile-dynamic
2450 "\n(defalias '" 2449 1)
2451 name 2450 nil)
2452 (cond ((atom code) 2451 ;; Output the form by hand, that's much simpler than having
2453 (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) 2452 ;; b-c-output-file-form analyze the defalias.
2454 ((eq (car code) 'quote) 2453 (byte-compile-output-docform
2455 (setq code new-one) 2454 "\n(defalias '"
2456 (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) 2455 name
2457 ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) 2456 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
2458 (append code nil) 2457 (append code nil) ; Turn byte-code-function-p into list.
2459 (and (atom code) byte-compile-dynamic 2458 (and (atom code) byte-compile-dynamic
2460 1) 2459 1)
2461 nil) 2460 nil))
2462 ;; Output the form by hand, that's much simpler than having 2461 (princ ")" byte-compile-outbuffer)
2463 ;; b-c-output-file-form analyze the defalias. 2462 nil)))
2464 (byte-compile-output-docform
2465 "\n(defalias '"
2466 name
2467 (cond ((atom code)
2468 (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
2469 ((eq (car code) 'quote)
2470 (setq code new-one)
2471 (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
2472 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
2473 (append code nil)
2474 (and (atom code) byte-compile-dynamic
2475 1)
2476 nil))
2477 (princ ")" byte-compile-outbuffer)
2478 nil))))
2479 2463
2480;; Print Lisp object EXP in the output file, inside a comment, 2464;; Print Lisp object EXP in the output file, inside a comment,
2481;; and return the file position it will have. 2465;; 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."
2547 (byte-compile-close-variables 2531 (byte-compile-close-variables
2548 (byte-compile-top-level (byte-compile-preprocess sexp))))) 2532 (byte-compile-top-level (byte-compile-preprocess sexp)))))
2549 2533
2550;; Given a function made by byte-compile-lambda, make a form which produces it.
2551(defun byte-compile-byte-code-maker (fun)
2552 (cond
2553 ;; ## atom is faster than compiled-func-p.
2554 ((atom fun) ; compiled function.
2555 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
2556 ;; would have produced a lambda.
2557 fun)
2558 ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial
2559 ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off.
2560 ((let (tmp)
2561 ;; FIXME: can this happen?
2562 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
2563 (null (cdr (memq tmp fun))))
2564 ;; Generate a make-byte-code call.
2565 (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
2566 (nconc (list 'make-byte-code
2567 (list 'quote (nth 1 fun)) ;arglist
2568 (nth 1 tmp) ;bytes
2569 (nth 2 tmp) ;consts
2570 (nth 3 tmp)) ;depth
2571 (cond ((stringp (nth 2 fun))
2572 (list (nth 2 fun))) ;doc
2573 (interactive
2574 (list nil)))
2575 (cond (interactive
2576 (list (if (or (null (nth 1 interactive))
2577 (stringp (nth 1 interactive)))
2578 (nth 1 interactive)
2579 ;; Interactive spec is a list or a variable
2580 ;; (if it is correct).
2581 (list 'quote (nth 1 interactive))))))))
2582 ;; a non-compiled function (probably trivial)
2583 (list 'quote fun))))))
2584
2585;; Turn a function into an ordinary lambda. Needed for v18 files.
2586(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it?
2587 (if (consp function)
2588 function;;It already is a lambda.
2589 (setq function (append function nil)) ; turn it into a list
2590 (nconc (list 'lambda (nth 0 function))
2591 (and (nth 4 function) (list (nth 4 function)))
2592 (if (nthcdr 5 function)
2593 (list (cons 'interactive (if (nth 5 function)
2594 (nthcdr 5 function)))))
2595 (list (list 'byte-code
2596 (nth 1 function) (nth 2 function)
2597 (nth 3 function))))))
2598
2599
2600(defun byte-compile-check-lambda-list (list) 2534(defun byte-compile-check-lambda-list (list)
2601 "Check lambda-list LIST for errors." 2535 "Check lambda-list LIST for errors."
2602 (let (vars) 2536 (let (vars)
@@ -2745,20 +2679,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2745 ;; optionally, the interactive spec. 2679 ;; optionally, the interactive spec.
2746 (if int 2680 (if int
2747 (list (nth 1 int))))) 2681 (list (nth 1 int)))))
2748 (setq compiled 2682 (error "byte-compile-top-level did not return byte-code")))))
2749 (nconc (if int (list int))
2750 (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
2751 (compiled (list compiled)))))
2752 (nconc (list 'lambda arglist)
2753 (if (or doc (stringp (car compiled)))
2754 (cons doc (cond (compiled)
2755 (body (list nil))))
2756 compiled))))))
2757
2758(defun byte-compile-closure (form &optional add-lambda)
2759 (let ((code (byte-compile-lambda form add-lambda)))
2760 ;; A simple lambda is just a constant.
2761 (byte-compile-constant code)))
2762 2683
2763(defvar byte-compile-reserved-constants 0) 2684(defvar byte-compile-reserved-constants 0)
2764 2685
@@ -2818,23 +2739,18 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2818 (setq form (byte-optimize-form form byte-compile--for-effect))) 2739 (setq form (byte-optimize-form form byte-compile--for-effect)))
2819 (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form)))) 2740 (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
2820 (setq form (nth 1 form))) 2741 (setq form (nth 1 form)))
2821 (if (and (eq 'byte-code (car-safe form)) 2742 ;; Set up things for a lexically-bound function.
2822 (not (memq byte-optimize '(t byte))) 2743 (when (and lexical-binding (eq output-type 'lambda))
2823 (stringp (nth 1 form)) (vectorp (nth 2 form)) 2744 ;; See how many arguments there are, and set the current stack depth
2824 (natnump (nth 3 form))) 2745 ;; accordingly.
2825 form 2746 (setq byte-compile-depth (length byte-compile-lexical-environment))
2826 ;; Set up things for a lexically-bound function. 2747 ;; If there are args, output a tag to record the initial
2827 (when (and lexical-binding (eq output-type 'lambda)) 2748 ;; stack-depth for the optimizer.
2828 ;; See how many arguments there are, and set the current stack depth 2749 (when (> byte-compile-depth 0)
2829 ;; accordingly. 2750 (byte-compile-out-tag (byte-compile-make-tag))))
2830 (setq byte-compile-depth (length byte-compile-lexical-environment)) 2751 ;; Now compile FORM
2831 ;; If there are args, output a tag to record the initial 2752 (byte-compile-form form byte-compile--for-effect)
2832 ;; stack-depth for the optimizer. 2753 (byte-compile-out-toplevel byte-compile--for-effect output-type)))
2833 (when (> byte-compile-depth 0)
2834 (byte-compile-out-tag (byte-compile-make-tag))))
2835 ;; Now compile FORM
2836 (byte-compile-form form byte-compile--for-effect)
2837 (byte-compile-out-toplevel byte-compile--for-effect output-type))))
2838 2754
2839(defun byte-compile-out-toplevel (&optional for-effect output-type) 2755(defun byte-compile-out-toplevel (&optional for-effect output-type)
2840 (if for-effect 2756 (if for-effect
@@ -2873,7 +2789,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
2873 ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom) 2789 ;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
2874 ;; file -> as progn, but takes both quotes and atoms, and longer forms. 2790 ;; file -> as progn, but takes both quotes and atoms, and longer forms.
2875 (let (rest 2791 (let (rest
2876 (byte-compile--for-effect for-effect) 2792 (byte-compile--for-effect for-effect) ;FIXME: Probably unused!
2877 (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. 2793 (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
2878 tmp body) 2794 tmp body)
2879 (cond 2795 (cond
@@ -2999,8 +2915,10 @@ That command is designed for interactive use only" fn))
2999 (byte-compile-normal-call form)) 2915 (byte-compile-normal-call form))
3000 (if (byte-compile-warning-enabled-p 'cl-functions) 2916 (if (byte-compile-warning-enabled-p 'cl-functions)
3001 (byte-compile-cl-warn form)))) 2917 (byte-compile-cl-warn form))))
3002 ((and (or (byte-code-function-p (car form)) 2918 ((and (byte-code-function-p (car form))
3003 (eq (car-safe (car form)) 'lambda)) 2919 (memq byte-optimize '(t lap)))
2920 (byte-compile-unfold-bcf form))
2921 ((and (eq (car-safe (car form)) 'lambda)
3004 ;; if the form comes out the same way it went in, that's 2922 ;; if the form comes out the same way it went in, that's
3005 ;; because it was malformed, and we couldn't unfold it. 2923 ;; because it was malformed, and we couldn't unfold it.
3006 (not (eq form (setq form (byte-compile-unfold-lambda form))))) 2924 (not (eq form (setq form (byte-compile-unfold-lambda form)))))
@@ -3032,6 +2950,80 @@ That command is designed for interactive use only" fn))
3032 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. 2950 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
3033 (byte-compile-out 'byte-call (length (cdr form)))) 2951 (byte-compile-out 'byte-call (length (cdr form))))
3034 2952
2953
2954;; Splice the given lap code into the current instruction stream.
2955;; If it has any labels in it, you're responsible for making sure there
2956;; are no collisions, and that byte-compile-tag-number is reasonable
2957;; after this is spliced in. The provided list is destroyed.
2958(defun byte-compile-inline-lapcode (lap end-depth)
2959 ;; "Replay" the operations: we used to just do
2960 ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
2961 ;; but that fails to update byte-compile-depth, so we had to assume
2962 ;; that `lap' ends up adding exactly 1 element to the stack. This
2963 ;; happens to be true for byte-code generated by bytecomp.el without
2964 ;; lexical-binding, but it's not true in general, and it's not true for
2965 ;; code output by bytecomp.el with lexical-binding.
2966 (let ((endtag (byte-compile-make-tag)))
2967 (dolist (op lap)
2968 (cond
2969 ((eq (car op) 'TAG) (byte-compile-out-tag op))
2970 ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
2971 ((eq (car op) 'byte-return)
2972 (byte-compile-discard (- byte-compile-depth end-depth) t)
2973 (byte-compile-goto 'byte-goto endtag))
2974 (t (byte-compile-out (car op) (cdr op)))))
2975 (byte-compile-out-tag endtag)))
2976
2977(defun byte-compile-unfold-bcf (form)
2978 (let* ((byte-compile-bound-variables byte-compile-bound-variables)
2979 (fun (car form))
2980 (fargs (aref fun 0))
2981 (start-depth byte-compile-depth)
2982 (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest.
2983 ;; (fmin (if (numberp fargs) (logand fargs 127)))
2984 (alen (length (cdr form)))
2985 (dynbinds ()))
2986 (fetch-bytecode fun)
2987 (mapc 'byte-compile-form (cdr form))
2988 (unless fmax2
2989 ;; Old-style byte-code.
2990 (assert (listp fargs))
2991 (while fargs
2992 (case (car fargs)
2993 (&optional (setq fargs (cdr fargs)))
2994 (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
2995 (push (cadr fargs) dynbinds)
2996 (setq fargs nil))
2997 (t (push (pop fargs) dynbinds))))
2998 (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
2999 (cond
3000 ((<= (+ alen alen) fmax2)
3001 ;; Add missing &optional (or &rest) arguments.
3002 (dotimes (i (- (/ (1+ fmax2) 2) alen))
3003 (byte-compile-push-constant nil)))
3004 ((zerop (logand fmax2 1))
3005 (byte-compile-log-warning "Too many arguments for inlined function"
3006 nil :error)
3007 (byte-compile-discard (- alen (/ fmax2 2))))
3008 (t
3009 ;; Turn &rest args into a list.
3010 (let ((n (- alen (/ (1- fmax2) 2))))
3011 (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
3012 (if (< n 5)
3013 (byte-compile-out
3014 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
3015 0)
3016 (byte-compile-out 'byte-listN n)))))
3017 (mapc #'byte-compile-dynamic-variable-bind dynbinds)
3018 (byte-compile-inline-lapcode
3019 (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)
3020 (1+ start-depth))
3021 ;; Unbind dynamic variables.
3022 (when dynbinds
3023 (byte-compile-out 'byte-unbind (length dynbinds)))
3024 (assert (eq byte-compile-depth (1+ start-depth))
3025 nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
3026
3035(defun byte-compile-check-variable (var &optional binding) 3027(defun byte-compile-check-variable (var &optional binding)
3036 "Do various error checks before a use of the variable VAR. 3028 "Do various error checks before a use of the variable VAR.
3037If BINDING is non-nil, VAR is being bound." 3029If BINDING is non-nil, VAR is being bound."
@@ -3271,7 +3263,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
3271 (byte-compile-warn "`%s' called with %d arg%s, but requires %s" 3263 (byte-compile-warn "`%s' called with %d arg%s, but requires %s"
3272 (car form) (length (cdr form)) 3264 (car form) (length (cdr form))
3273 (if (= 1 (length (cdr form))) "" "s") n) 3265 (if (= 1 (length (cdr form))) "" "s") n)
3274 ;; get run-time wrong-number-of-args error. 3266 ;; Get run-time wrong-number-of-args error.
3275 (byte-compile-normal-call form)) 3267 (byte-compile-normal-call form))
3276 3268
3277(defun byte-compile-no-args (form) 3269(defun byte-compile-no-args (form)
@@ -3534,7 +3526,7 @@ discarding."
3534 (byte-compile-warn 3526 (byte-compile-warn
3535 "A quoted lambda form is the second argument of `fset'. This is probably 3527 "A quoted lambda form is the second argument of `fset'. This is probably
3536 not what you want, as that lambda cannot be compiled. Consider using 3528 not what you want, as that lambda cannot be compiled. Consider using
3537 the syntax (function (lambda (...) ...)) instead."))))) 3529 the syntax #'(lambda (...) ...) instead.")))))
3538 (byte-compile-two-args form)) 3530 (byte-compile-two-args form))
3539 3531
3540;; (function foo) must compile like 'foo, not like (symbol-function 'foo). 3532;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
@@ -3542,9 +3534,9 @@ discarding."
3542;; and (funcall (function foo)) will lose with autoloads. 3534;; and (funcall (function foo)) will lose with autoloads.
3543 3535
3544(defun byte-compile-function-form (form) 3536(defun byte-compile-function-form (form)
3545 (if (symbolp (nth 1 form)) 3537 (byte-compile-constant (if (symbolp (nth 1 form))
3546 (byte-compile-constant (nth 1 form)) 3538 (nth 1 form)
3547 (byte-compile-closure (nth 1 form)))) 3539 (byte-compile-lambda (nth 1 form)))))
3548 3540
3549(defun byte-compile-indent-to (form) 3541(defun byte-compile-indent-to (form)
3550 (let ((len (length form))) 3542 (let ((len (length form)))
@@ -4102,18 +4094,16 @@ binding slots have been popped."
4102 (byte-compile-set-symbol-position (car form)) 4094 (byte-compile-set-symbol-position (car form))
4103 (byte-compile-set-symbol-position 'defun) 4095 (byte-compile-set-symbol-position 'defun)
4104 (error "defun name must be a symbol, not %s" (car form))) 4096 (error "defun name must be a symbol, not %s" (car form)))
4105 (let ((byte-compile--for-effect nil)) 4097 (byte-compile-push-constant 'defalias)
4106 (byte-compile-push-constant 'defalias) 4098 (byte-compile-push-constant (nth 1 form))
4107 (byte-compile-push-constant (nth 1 form)) 4099 (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
4108 (byte-compile-closure (cdr (cdr form)) t))
4109 (byte-compile-out 'byte-call 2)) 4100 (byte-compile-out 'byte-call 2))
4110 4101
4111(defun byte-compile-defmacro (form) 4102(defun byte-compile-defmacro (form)
4112 ;; This is not used for file-level defmacros with doc strings. 4103 ;; This is not used for file-level defmacros with doc strings.
4113 (byte-compile-body-do-effect 4104 (byte-compile-body-do-effect
4114 (let ((decls (byte-compile-defmacro-declaration form)) 4105 (let ((decls (byte-compile-defmacro-declaration form))
4115 (code (byte-compile-byte-code-maker 4106 (code (byte-compile-lambda (cdr (cdr form)) t)))
4116 (byte-compile-lambda (cdr (cdr form)) t))))
4117 `((defalias ',(nth 1 form) 4107 `((defalias ',(nth 1 form)
4118 ,(if (eq (car-safe code) 'make-byte-code) 4108 ,(if (eq (car-safe code) 'make-byte-code)
4119 `(cons 'macro ,code) 4109 `(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 @@
66;;; Code: 66;;; Code:
67 67
68;; TODO: (not just for cconv but also for the lexbind changes in general) 68;; TODO: (not just for cconv but also for the lexbind changes in general)
69;; - inline lexical byte-code functions.
70;; - investigate some old v18 stuff in bytecomp.el.
71;; - optimize away unused cl-block-wrapper.
72;; - let (e)debug find the value of lexical variables from the stack. 69;; - let (e)debug find the value of lexical variables from the stack.
73;; - byte-optimize-form should be applied before cconv. 70;; - byte-optimize-form should be applied before cconv.
74;; OTOH, the warnings emitted by cconv-analyze need to come before optimize 71;; OTOH, the warnings emitted by cconv-analyze need to come before optimize
@@ -87,7 +84,7 @@
87;; - Since we know here when a variable is not mutated, we could pass that 84;; - Since we know here when a variable is not mutated, we could pass that
88;; info to the byte-compiler, e.g. by using a new `immutable-let'. 85;; info to the byte-compiler, e.g. by using a new `immutable-let'.
89;; - add tail-calls to bytecode.c and the byte compiler. 86;; - add tail-calls to bytecode.c and the byte compiler.
90;; - call known non-escaping functions with gotos rather than `call'. 87;; - call known non-escaping functions with `goto' rather than `call'.
91;; - optimize mapcar to a while loop. 88;; - optimize mapcar to a while loop.
92 89
93;; (defmacro dlet (binders &rest body) 90;; (defmacro dlet (binders &rest body)