Lines Matching +defs:compile +defs:toplevel
33 ;; The user entry points are byte-compile-file and byte-recompile-directory.
39 ;; byte-recompile-directory, byte-compile-file,
40 ;; batch-byte-compile, batch-byte-recompile-directory,
41 ;; byte-compile, compile-defun,
43 ;; (byte-compile-buffer and byte-compile-and-load-file were turned off
51 ;; - compile-time evaluation of safe constant forms, such as (consp nil)
57 ;; + compile-time evaluation of arbitrary expressions;
58 ;; + compile-time warning messages for:
73 ;; byte-compile-verbose Whether to report the function currently being
80 ;; byte-compile-error-on-warn Whether to stop compilation when a warning is
82 ;; byte-compile-delete-errors Whether the optimizer may delete calls or
85 ;; byte-compile-generate-call-tree Whether to generate a histogram of
89 ;; byte-compile-warnings List of warnings to issue, or t. May contain
100 ;; within `eval-when-compile')
104 ;; byte-compile-compatibility Whether the compiler should
108 ;; see also the function byte-compile-dest-file.
139 ;; o The form `eval-when-compile' is like progn, except that the body
140 ;; is evaluated at compile-time. When it appears at top-level, this
141 ;; is analogous to the Common Lisp idiom (eval-when (compile) ...).
145 ;; o The form `eval-and-compile' is similar to eval-when-compile, but
146 ;; the whole form is evalled both at compile-time and at run-time.
148 ;; o The command compile-defun is analogous to eval-defun.
150 ;; o If you run byte-compile-file on a filename which is visited in a
164 ;; has been turned off because compile time options are a bad idea.
165 (defmacro byte-compile-single-version () nil)
166 (defmacro byte-compile-version-cond (cond) cond)
174 ;; (if (byte-compile-version-cond
181 ;; (if (byte-compile-single-version)
203 You may want to redefine the function `byte-compile-dest-file'
218 (or (fboundp 'byte-compile-dest-file)
221 (defun byte-compile-dest-file (filename)
233 ;; This can be the 'byte-compile property of any symbol.
234 (autoload 'byte-compile-inline-expand "byte-opt")
240 (autoload 'byte-compile-unfold-lambda "byte-opt")
243 ;; disassembler. The disassembler just requires 'byte-compile, but
248 (defcustom byte-compile-verbose
254 (defcustom byte-compile-compatibility nil
261 ;; (defvar byte-compile-generate-emacs19-bytecodes
281 (defcustom byte-compile-delete-errors nil
287 (defvar byte-compile-dynamic nil
288 "If non-nil, compile function bodies so they load lazily.
295 For example, add -*-byte-compile-dynamic: t;-*- on the first line.
299 ;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
301 (defvar byte-compile-disable-print-circle nil
303 ;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
305 (defcustom byte-compile-dynamic-docstrings t
306 "*If non-nil, compile doc strings for lazy access.
316 -*-byte-compile-dynamic-docstrings:nil;-*-
322 ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
334 (defcustom byte-compile-error-on-warn nil
339 (defconst byte-compile-warning-types
342 "The list of warning types used when `byte-compile-warnings' is t.")
343 (defcustom byte-compile-warnings t
355 defined only under `eval-when-compile').
367 (put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
369 (defun byte-compile-warnings-safe-p (x)
382 (defvar byte-compile-interactive-only-functions
387 (defvar byte-compile-not-obsolete-var nil
390 (defcustom byte-compile-generate-call-tree nil
408 (defvar byte-compile-call-tree nil "Alist of functions and their call tree.
417 (defcustom byte-compile-call-tree-sort 'name
425 (defvar byte-compile-debug nil)
427 ;; (defvar byte-compile-overwrite-file t
435 (defvar byte-compile-constants nil
437 (defvar byte-compile-variables nil
439 (defvar byte-compile-bound-variables nil
442 (defvar byte-compile-const-variables nil
444 (defvar byte-compile-free-references)
445 (defvar byte-compile-free-assignments)
449 (defconst byte-compile-initial-macro-environment
453 (eval-when-compile . (lambda (&rest body)
455 (byte-compile-eval (byte-compile-top-level
457 (eval-and-compile . (lambda (&rest body)
458 (byte-compile-eval-before-compile (cons 'progn body))
464 (defvar byte-compile-macro-environment byte-compile-initial-macro-environment
469 (defvar byte-compile-function-environment nil
477 (defvar byte-compile-unresolved-functions nil
482 (defvar byte-compile-noruntime-functions nil
487 (defvar byte-compile-tag-number 0)
488 (defvar byte-compile-output nil
491 (defvar byte-compile-depth 0 "Current depth of execution stack.")
492 (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
505 ;; This is a speed-hack for building the byte-code-vector at compile-time.
510 ;; it problematic to compile big changes to this compiler; we store the
512 (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
513 (put 'byte-code-vector 'tmp-compile-time-value
515 (v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
516 (put 'byte-stack+-info 'tmp-compile-time-value
526 (get 'byte-code-vector 'tmp-compile-time-value)
528 (get 'byte-stack+-info 'tmp-compile-time-value))
529 (put 'byte-code-vector 'tmp-compile-time-value nil)
530 (put 'byte-stack+-info 'tmp-compile-time-value nil)))
751 (defun byte-compile-lapcode (lap)
818 ;;; compile-time evaluation
820 (defun byte-compile-eval (form)
822 Each function's symbol gets added to `byte-compile-noruntime-functions'."
826 (when (memq 'noruntime byte-compile-warnings)
841 (push s byte-compile-noruntime-functions)))
845 (push (cdr s) byte-compile-noruntime-functions)))))))
851 (push s byte-compile-noruntime-functions))
854 (when (memq 'cl-functions byte-compile-warnings)
864 (byte-compile-find-cl-functions)))))))))
866 (defun byte-compile-eval-before-compile (form)
867 "Evaluate FORM for `eval-and-compile'."
870 ;; (eval-and-compile (require 'cl) turns off warnings for cl functions.
874 (setq byte-compile-warnings
875 (remq 'cl-functions byte-compile-warnings)))
881 (defvar byte-compile-current-form nil)
882 (defvar byte-compile-dest-file nil)
883 (defvar byte-compile-current-file nil)
884 (defvar byte-compile-current-buffer nil)
887 (defmacro byte-compile-log (format-string &rest args)
894 (byte-compile-log-1
902 (defun byte-compile-log-1 (string)
906 (byte-compile-warning-prefix nil nil)
912 (defvar byte-compile-read-position nil
914 (defvar byte-compile-last-position nil
918 (defsubst byte-compile-delete-first (elt list)
932 ;; `read-symbol-positions-list', and set `byte-compile-last-position'
943 ;; then `byte-compile-last-position' as advanced too far.
947 (defun byte-compile-set-symbol-position (sym &optional allow-previous)
948 (when byte-compile-read-position
951 (setq last byte-compile-last-position
954 (setq byte-compile-last-position
955 (+ byte-compile-read-position (cdr entry))
957 (byte-compile-delete-first
959 (or (and allow-previous (not (= last byte-compile-last-position)))
960 (> last byte-compile-last-position)))))))
962 (defvar byte-compile-last-warned-form nil)
963 (defvar byte-compile-last-logged-file nil)
967 (defun byte-compile-warning-prefix (level entry)
970 (file (cond ((stringp byte-compile-current-file)
971 (format "%s:" (file-relative-name byte-compile-current-file dir)))
972 ((bufferp byte-compile-current-file)
974 (buffer-name byte-compile-current-file)))
976 (pos (if (and byte-compile-current-file
977 (integerp byte-compile-read-position))
978 (with-current-buffer byte-compile-current-buffer
981 (goto-char byte-compile-last-position)
984 (goto-char byte-compile-last-position)
987 (form (if (eq byte-compile-current-form :end) "end of data"
988 (or byte-compile-current-form "toplevel form"))))
989 (when (or (and byte-compile-current-file
990 (not (equal byte-compile-current-file
991 byte-compile-last-logged-file)))
992 (and byte-compile-current-form
993 (not (eq byte-compile-current-form
994 byte-compile-last-warned-form))))
998 (setq byte-compile-last-logged-file byte-compile-current-file
999 byte-compile-last-warned-form byte-compile-current-form)
1003 ;; to tell inner calls to displaying-byte-compile-warnings
1005 (defun byte-compile-warning-series (&rest ignore)
1011 (defun byte-compile-log-file ()
1012 (and (not (equal byte-compile-current-file byte-compile-last-logged-file))
1018 (dir (and byte-compile-current-file
1019 (file-name-directory byte-compile-current-file)))
1028 (if byte-compile-current-file
1030 (if (stringp byte-compile-current-file)
1031 (concat "file " byte-compile-current-file)
1032 (concat "buffer " (buffer-name byte-compile-current-file)))
1039 (setq byte-compile-last-logged-file byte-compile-current-file
1040 byte-compile-last-warned-form nil)
1049 (defun byte-compile-log-warning (string &optional fill level)
1050 (let ((warning-prefix-function 'byte-compile-warning-prefix)
1056 (defun byte-compile-warn (format &rest args)
1059 (if byte-compile-error-on-warn
1060 (error "%s" format) ; byte-compile-file catches and logs it
1061 (byte-compile-log-warning format t :warning)))
1063 (defun byte-compile-report-error (error-info)
1066 (byte-compile-log-warning
1071 (defun byte-compile-obsolete (form)
1075 (byte-compile-set-symbol-position (car form))
1076 (if (memq 'obsolete byte-compile-warnings)
1077 (byte-compile-warn "`%s' is an obsolete function%s; %s" (car form)
1082 (funcall (or handler 'byte-compile-normal-call) form)))
1089 ;; (file-format byte-compile-compatibility (emacs18 emacs19)
1091 ;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val)
1092 ;; (delete-errors byte-compile-delete-errors (t nil) val)
1093 ;; (verbose byte-compile-verbose (t nil) val)
1094 ;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
1101 ;; ((byte-compile-single-version)
1103 ;; (list (byte-compile-version-cond
1104 ;; byte-compile-generate-emacs19-bytecodes)))
1106 ;; (if (byte-compile-version-cond byte-compile-compatibility)
1150 (defun byte-compile-fdefinition (name macro-p)
1152 byte-compile-macro-environment
1153 byte-compile-function-environment))
1175 (defun byte-compile-arglist-signature (arglist)
1194 (defun byte-compile-arglist-signatures-congruent-p (old new)
1203 (defun byte-compile-arglist-signature-string (signature)
1212 (defun byte-compile-callargs-warn (form)
1213 (let* ((def (or (byte-compile-fdefinition (car form) nil)
1214 (byte-compile-fdefinition (car form) t)))
1216 (byte-compile-arglist-signature
1233 (byte-compile-set-symbol-position (car form))
1234 (byte-compile-warn
1241 (byte-compile-arglist-signature-string sig))))
1242 (byte-compile-format-warn form)
1246 (not (memq (car form) byte-compile-noruntime-functions)))
1247 (eq (car form) byte-compile-current-form) ; ## this doesn't work
1251 (let ((cons (assq (car form) byte-compile-unresolved-functions))
1257 byte-compile-unresolved-functions))))))
1259 (defun byte-compile-format-warn (form)
1262 `byte-compile-format-like' and first arg is a constant string.
1267 (get (car form) 'byte-compile-format-like))
1278 (byte-compile-warn
1283 (put elt 'byte-compile-format-like t))
1286 (defun byte-compile-nogroup-warn (form)
1294 (byte-compile-warn
1304 (defun byte-compile-arglist-warn (form macrop)
1305 (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
1307 (let ((sig1 (byte-compile-arglist-signature
1313 (sig2 (byte-compile-arglist-signature (nth 2 form))))
1314 (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
1315 (byte-compile-set-symbol-position (nth 1 form))
1316 (byte-compile-warn
1320 (byte-compile-arglist-signature-string sig1)
1322 (byte-compile-arglist-signature-string sig2))))
1324 (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
1328 (setq sig (byte-compile-arglist-signature (nth 2 form))
1334 (byte-compile-set-symbol-position (nth 1 form))
1335 (byte-compile-warn
1338 (byte-compile-arglist-signature-string sig)
1340 (byte-compile-arglist-signature-string (cons min max))))
1342 (setq byte-compile-unresolved-functions
1343 (delq calls byte-compile-unresolved-functions)))))
1346 (defvar byte-compile-cl-functions nil
1349 (defun byte-compile-find-cl-functions ()
1350 (unless byte-compile-cl-functions
1354 (setq byte-compile-cl-functions
1355 (append byte-compile-cl-functions
1357 (let ((tail byte-compile-cl-functions))
1364 (defun byte-compile-cl-warn (form)
1367 (if (and byte-compile-cl-functions
1368 (memq func byte-compile-cl-functions)
1377 ;; that can't be called except at compile time
1389 (not (and (eq (get func 'byte-compile)
1390 'cl-byte-compile-compiler-macro)
1392 (byte-compile-warn "Function `%s' from cl package called at runtime"
1396 (defun byte-compile-print-syms (str1 strn syms)
1398 (byte-compile-set-symbol-position (car syms) t))
1410 (byte-compile-warn "%s" str)))
1412 (byte-compile-warn "%s %s"
1417 (byte-compile-warn str1 (car syms)))))
1421 ;; `unresolved' in the list `byte-compile-warnings' disables this.
1422 (defun byte-compile-warn-about-unresolved-functions ()
1423 (when (memq 'unresolved byte-compile-warnings)
1424 (let ((byte-compile-current-form :end)
1429 (dolist (f byte-compile-unresolved-functions)
1433 (byte-compile-print-syms
1438 (byte-compile-print-syms
1446 (defsubst byte-compile-const-symbol-p (symbol &optional any-value)
1452 (if any-value (memq symbol byte-compile-const-variables))))
1454 (defmacro byte-compile-constp (form)
1458 ((byte-compile-const-symbol-p ,form))))
1460 (defmacro byte-compile-close-variables (&rest body)
1466 (byte-compile-macro-environment
1469 (copy-alist byte-compile-initial-macro-environment))
1470 (byte-compile-function-environment nil)
1471 (byte-compile-bound-variables nil)
1472 (byte-compile-const-variables nil)
1473 (byte-compile-free-references nil)
1474 (byte-compile-free-assignments nil)
1479 (byte-compile-verbose byte-compile-verbose)
1481 (byte-compile-compatibility byte-compile-compatibility)
1482 (byte-compile-dynamic byte-compile-dynamic)
1483 (byte-compile-dynamic-docstrings
1484 byte-compile-dynamic-docstrings)
1485 ;; (byte-compile-generate-emacs19-bytecodes
1486 ;; byte-compile-generate-emacs19-bytecodes)
1487 (byte-compile-warnings (if (eq byte-compile-warnings t)
1488 byte-compile-warning-types
1489 byte-compile-warnings))
1493 (defmacro displaying-byte-compile-warnings (&rest body)
1494 `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body))
1499 (byte-compile-find-cl-functions)
1500 (if (or (eq warning-series 'byte-compile-warning-series)
1506 (setq tem (byte-compile-log-file))
1508 (setq warning-series (or tem 'byte-compile-warning-series)))
1509 (if byte-compile-debug
1510 (funcall --displaying-byte-compile-warnings-fn)
1512 (funcall --displaying-byte-compile-warnings-fn)
1513 (error (byte-compile-report-error error-info)))))
1517 (or (byte-compile-log-file) 'byte-compile-warning-series)))
1518 (if byte-compile-debug
1519 (funcall --displaying-byte-compile-warnings-fn)
1521 (funcall --displaying-byte-compile-warnings-fn)
1522 (error (byte-compile-report-error error-info))))))))
1539 compile the corresponding `.el' file. However,
1540 if ARG (the prefix argument) is 0, that means do compile all those files.
1542 whether to compile it.
1568 (displaying-byte-compile-warnings
1586 ;; It is an ordinary file. Decide whether to compile it.
1590 (setq dest (byte-compile-dest-file source))
1598 (progn (if (and noninteractive (not byte-compile-verbose))
1600 (let ((res (byte-compile-file source)))
1601 (cond ((eq res 'no-byte-compile)
1620 (defvar no-byte-compile nil
1624 ;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
1625 ;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
1628 (defun byte-compile-file (filename &optional load)
1631 `byte-compile-dest-file' function (which see).
1634 ;; (interactive "fByte compile file: \nP")
1645 "Byte compile and load file: "
1646 "Byte compile file: ")
1661 (setq byte-compile-last-logged-file nil)
1662 (let ((byte-compile-current-file filename)
1665 byte-compile-dest-file)
1666 (setq target-file (byte-compile-dest-file filename))
1667 (setq byte-compile-dest-file target-file)
1673 ;; Always compile an Emacs Lisp file as multibyte
1695 ;; Set the default directory, in case an eval-when-compile uses it.
1698 ;; compile this file.
1699 (if (with-current-buffer input-buffer no-byte-compile)
1701 ;; (message "%s not compiled because of `no-byte-compile: %s'"
1703 ;; (with-current-buffer input-buffer no-byte-compile))
1705 (message "%s deleted because of `no-byte-compile: %s'"
1707 (buffer-local-value 'no-byte-compile input-buffer))
1709 ;; We successfully didn't compile this file.
1710 'no-byte-compile)
1711 (when byte-compile-verbose
1716 ;; within byte-compile-from-buffer lingers in that buffer.
1719 (byte-compile-from-buffer input-buffer filename)))
1722 (when byte-compile-verbose
1750 (if (and byte-compile-generate-call-tree
1751 (or (eq t byte-compile-generate-call-tree)
1759 ;;(defun byte-compile-and-load-file (&optional filename)
1765 ;; (byte-compile-file filename t)
1767 ;; (call-interactively 'byte-compile-file))))
1769 ;;(defun byte-compile-buffer (&optional buffer)
1770 ;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
1771 ;; (interactive "bByte compile buffer: ")
1776 ;; (byte-compile-current-file buffer))
1777 ;; (byte-compile-from-buffer buffer nil))
1783 (defun compile-defun (&optional arg)
1791 (let* ((byte-compile-current-file nil)
1792 (byte-compile-current-buffer (current-buffer))
1793 (byte-compile-read-position (point))
1794 (byte-compile-last-position byte-compile-read-position)
1795 (byte-compile-last-warned-form 'nothing)
1799 (displaying-byte-compile-warnings
1800 (byte-compile-sexp (read (current-buffer))))))))
1808 (defun byte-compile-from-buffer (inbuffer &optional filename)
1811 (byte-compile-current-buffer inbuffer)
1812 (byte-compile-read-position nil)
1813 (byte-compile-last-position nil)
1819 ;; Prevent edebug from interfering when we compile
1823 ;; Simulate entry to byte-compile-top-level
1824 (byte-compile-constants nil)
1825 (byte-compile-variables nil)
1826 (byte-compile-tag-number 0)
1827 (byte-compile-depth 0)
1828 (byte-compile-maxdepth 0)
1829 (byte-compile-output nil)
1835 ;; (byte-compile-warnings (if (eq byte-compile-warnings t)
1836 ;; byte-compile-warning-types
1837 ;; byte-compile-warnings))
1839 (byte-compile-close-variables
1854 (displaying-byte-compile-warnings
1855 (and filename (byte-compile-insert-header filename inbuffer outbuffer))
1866 (setq byte-compile-read-position (point)
1867 byte-compile-last-position byte-compile-read-position)
1869 (byte-compile-file-form form)))
1871 (byte-compile-flush-pending)
1874 (setq byte-compile-last-position (point-max))
1875 (byte-compile-warn-about-unresolved-functions)
1879 (setq byte-compile-unresolved-functions nil))
1882 (and filename (byte-compile-fix-header filename inbuffer outbuffer))))
1885 (defun byte-compile-fix-header (filename inbuffer outbuffer)
1889 (when (byte-compile-version-cond byte-compile-compatibility)
1921 (defun byte-compile-insert-header (filename inbuffer outbuffer)
1923 (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
1924 (dynamic byte-compile-dynamic))
1940 (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
1955 (if (byte-compile-version-cond byte-compile-compatibility)
1960 (if (not (byte-compile-version-cond byte-compile-compatibility))
1966 ;; compensate at the end in byte-compile-fix-header.
1993 ;; Insert semicolons as ballast, so that byte-compile-fix-header
2000 (when byte-compile-dynamic
2005 (defun byte-compile-output-file-form (form)
2009 ;; defalias calls are output directly by byte-compile-file-form-defmumble;
2015 (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
2024 (not byte-compile-disable-print-circle)))
2031 (defun byte-compile-output-docform (preface name info form specindex quoted)
2042 ;; We need to examine byte-compile-dynamic-docstrings
2044 (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
2053 (not byte-compile-compatibility)
2059 (byte-compile-output-as-comment
2082 (not byte-compile-disable-print-circle))
2104 (byte-compile-output-as-comment
2126 (defun byte-compile-keep-pending (form &optional handler)
2134 (nthcdr 300 byte-compile-output)
2135 (byte-compile-flush-pending))
2138 (byte-compile-discard)))
2139 (byte-compile-form form t))
2142 (defun byte-compile-flush-pending ()
2143 (if byte-compile-output
2144 (let ((form (byte-compile-out-toplevel t 'file)))
2146 (mapc 'byte-compile-output-file-form (cdr form)))
2148 (byte-compile-output-file-form form)))
2149 (setq byte-compile-constants nil
2150 byte-compile-variables nil
2151 byte-compile-depth 0
2152 byte-compile-maxdepth 0
2153 byte-compile-output nil))))
2155 (defun byte-compile-file-form (form)
2156 (let ((byte-compile-current-form nil) ; close over this for warnings.
2160 (byte-compile-keep-pending form))
2164 (byte-compile-flush-pending)
2165 (byte-compile-output-file-form form))))
2166 ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
2167 (byte-compile-keep-pending form))
2169 (byte-compile-file-form form)))))
2175 (put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
2176 (defun byte-compile-file-form-defsubst (form)
2177 (when (assq (nth 1 form) byte-compile-unresolved-functions)
2178 (setq byte-compile-current-form (nth 1 form))
2179 (byte-compile-warn "defsubst `%s' was used before it was defined"
2181 (byte-compile-file-form
2182 (macroexpand form byte-compile-macro-environment))
2186 (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
2187 (defun byte-compile-file-form-autoload (form)
2189 (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
2200 byte-compile-function-environment))
2203 ;; No doc string, so we can compile this as a normal form.
2204 (byte-compile-keep-pending form 'byte-compile-normal-call)))
2206 (put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
2207 (put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
2208 (defun byte-compile-file-form-defvar (form)
2210 ;; Since there is no doc string, we can compile this as a normal form,
2212 (byte-compile-keep-pending form)
2213 (when (memq 'free-vars byte-compile-warnings)
2214 (push (nth 1 form) byte-compile-bound-variables)
2216 (push (nth 1 form) byte-compile-const-variables)))
2220 (byte-compile-top-level (nth 2 form) nil 'file))))
2224 'byte-compile-file-form-custom-declare-variable)
2225 (defun byte-compile-file-form-custom-declare-variable (form)
2226 (when (memq 'callargs byte-compile-warnings)
2227 (byte-compile-nogroup-warn form))
2228 (when (memq 'free-vars byte-compile-warnings)
2229 (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
2232 ;; If there are any (function (lambda ...)) expressions, compile
2237 (setcar tail (byte-compile-lambda (nth 1 (car tail))))
2241 (setcar tail (byte-compile-lambda (car tail)))))
2245 (put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
2246 (defun byte-compile-file-form-require (form)
2252 (setq byte-compile-warnings
2253 (remq 'cl-functions byte-compile-warnings))))
2254 (byte-compile-keep-pending form 'byte-compile-normal-call))
2256 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
2257 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
2258 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
2259 (defun byte-compile-file-form-progn (form)
2260 (mapc 'byte-compile-file-form (cdr form))
2264 ;; This handler is not necessary, but it makes the output from dont-compile
2266 (put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
2267 (defun byte-compile-file-form-eval (form)
2270 (byte-compile-keep-pending form)))
2272 (put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
2273 (defun byte-compile-file-form-defun (form)
2274 (byte-compile-file-form-defmumble form nil))
2276 (put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
2277 (defun byte-compile-file-form-defmacro (form)
2278 (byte-compile-file-form-defmumble form t))
2280 (defun byte-compile-file-form-defmumble (form macrop)
2282 (this-kind (if macrop 'byte-compile-macro-environment
2283 'byte-compile-function-environment))
2284 (that-kind (if macrop 'byte-compile-function-environment
2285 'byte-compile-macro-environment))
2288 (byte-compile-free-references nil)
2289 (byte-compile-free-assignments nil))
2290 (byte-compile-set-symbol-position name)
2293 (if byte-compile-generate-call-tree
2294 (or (assq name byte-compile-call-tree)
2295 (setq byte-compile-call-tree
2296 (cons (list name nil nil) byte-compile-call-tree))))
2298 (setq byte-compile-current-form name) ; for warnings
2299 (if (memq 'redefine byte-compile-warnings)
2300 (byte-compile-arglist-warn form macrop))
2301 (if byte-compile-verbose
2304 (if (and (memq 'redefine byte-compile-warnings)
2307 byte-compile-initial-macro-environment)))
2308 (byte-compile-warn
2313 (when (and (memq 'redefine byte-compile-warnings)
2317 byte-compile-initial-macro-environment)))
2318 (byte-compile-warn "%s `%s' defined multiple times in this file"
2324 (when (memq 'redefine byte-compile-warnings)
2325 (byte-compile-warn "%s `%s' being redefined as a %s"
2338 (byte-compile-set-symbol-position (nth 1 form))
2339 (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
2357 (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
2358 (code (byte-compile-byte-code-maker new-one)))
2368 (byte-compile-flush-pending)
2372 (byte-compile-output-docform
2373 (if (byte-compile-version-cond byte-compile-compatibility)
2383 (and (atom code) byte-compile-dynamic
2388 (byte-compile-output-docform
2389 (if (byte-compile-version-cond byte-compile-compatibility)
2399 (and (atom code) byte-compile-dynamic
2408 (defun byte-compile-output-as-comment (exp quoted)
2449 (defun byte-compile (form)
2450 "If FORM is a symbol, byte-compile its function definition.
2451 If FORM is a lambda or a macro, byte-compile it as a function."
2452 (displaying-byte-compile-warnings
2453 (byte-compile-close-variables
2462 (cons 'macro (byte-compile-lambda fun))
2463 (byte-compile-lambda fun)))
2468 (defun byte-compile-sexp (sexp)
2470 (displaying-byte-compile-warnings
2471 (byte-compile-close-variables
2472 (byte-compile-top-level sexp))))
2474 ;; Given a function made by byte-compile-lambda, make a form which produces it.
2475 (defun byte-compile-byte-code-maker (fun)
2477 ((byte-compile-version-cond byte-compile-compatibility)
2479 (list 'quote (byte-compile-byte-code-unmake fun)))
2482 ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
2512 (defun byte-compile-byte-code-unmake (function)
2526 (defun byte-compile-check-lambda-list (list)
2532 (byte-compile-set-symbol-position arg))
2534 (byte-compile-const-symbol-p arg t))
2545 (byte-compile-warn "repeated variable %s in lambda-list" arg))
2551 ;; Byte-compile a lambda-expression and return a valid function.
2555 ;; of the list FUN and `byte-compile-set-symbol-position' is not called.
2556 ;; Use this feature to avoid calling `byte-compile-set-symbol-position'
2558 (defun byte-compile-lambda (fun &optional add-lambda)
2563 (byte-compile-set-symbol-position 'lambda))
2564 (byte-compile-check-lambda-list (nth 1 fun))
2566 (byte-compile-bound-variables
2567 (nconc (and (memq 'free-vars byte-compile-warnings)
2569 byte-compile-bound-variables))
2580 (byte-compile-set-symbol-position 'interactive)
2586 (byte-compile-warn "malformed interactive spec: %s"
2589 ;; compile it, because `call-interactively' looks at the
2590 ;; args of `list'. Actually, compile it to get warnings,
2598 (byte-compile-top-level (nth 1 int))
2600 (byte-compile-top-level (nth 1 int)))))))
2602 (byte-compile-warn "malformed interactive spec: %s"
2605 (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
2608 (not (byte-compile-version-cond
2609 byte-compile-compatibility)))
2630 (defun byte-compile-constants-vector ()
2639 (rest (nreverse byte-compile-variables)) ; nreverse because the first
2640 (other (nreverse byte-compile-constants)) ; vars often are used most.
2660 ;; Given an expression FORM, compile it and return an equivalent byte-code
2662 (defun byte-compile-top-level (form &optional for-effect output-type)
2668 (let ((byte-compile-constants nil)
2669 (byte-compile-variables nil)
2670 (byte-compile-tag-number 0)
2671 (byte-compile-depth 0)
2672 (byte-compile-maxdepth 0)
2673 (byte-compile-output nil))
2683 (byte-compile-form form for-effect)
2684 (byte-compile-out-toplevel for-effect output-type))))
2686 (defun byte-compile-out-toplevel (&optional for-effect output-type)
2689 (if (eq (car (car byte-compile-output)) 'byte-discard)
2690 (setq byte-compile-output (cdr byte-compile-output))
2691 (byte-compile-push-constant
2696 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
2697 (let ((tmp (reverse byte-compile-constants)))
2702 (byte-compile-out 'byte-return 0)
2703 (setq byte-compile-output (nreverse byte-compile-output))
2705 (setq byte-compile-output
2706 (byte-optimize-lapcode byte-compile-output for-effect)))
2726 ;; #### This should be split out into byte-compile-nontrivial-function-p.
2728 (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
2729 (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
2730 (not (setq tmp (assq 'byte-return byte-compile-output)))
2733 (cdr (memq tmp (reverse byte-compile-output)))))
2740 (not (byte-compile-const-symbol-p tmp)))))
2764 (let ((byte-compile-vector (byte-compile-constants-vector)))
2765 (list 'byte-code (byte-compile-lapcode byte-compile-output)
2766 byte-compile-vector byte-compile-maxdepth)))
2771 ;; Given BODY, compile it and return a new body.
2772 (defun byte-compile-top-level-body (body &optional for-effect)
2773 (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
2782 ;; If for-effect is non-nil, byte-compile-form will output a byte-discard
2784 ;; A byte-compile handler may, when for-effect is non-nil, choose output code
2786 ;; (to prevent byte-compile-form from outputting the byte-discard).
2788 ;; byte-compile-form, or take extreme care to handle for-effect correctly.
2789 ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
2791 (defun byte-compile-form (form &optional for-effect)
2792 (setq form (macroexpand form byte-compile-macro-environment))
2794 (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
2796 (byte-compile-set-symbol-position form))
2797 (byte-compile-constant form))
2798 ((and for-effect byte-compile-delete-errors)
2800 (byte-compile-set-symbol-position form))
2802 (t (byte-compile-variable-ref 'byte-varref form))))
2805 (handler (get fn 'byte-compile)))
2806 (when (byte-compile-const-symbol-p fn)
2807 (byte-compile-warn "`%s' called as a function" fn))
2808 (and (memq 'interactive-only byte-compile-warnings)
2809 (memq fn byte-compile-interactive-only-functions)
2810 (byte-compile-warn "`%s' used from Lisp code\n\
2815 ;; `cl-byte-compile-compiler-macro' but if CL isn't
2817 (or (not (memq handler '(cl-byte-compile-compiler-macro)))
2819 (not (and (byte-compile-version-cond
2820 byte-compile-compatibility)
2823 (when (memq 'callargs byte-compile-warnings)
2825 (byte-compile-nogroup-warn form))
2826 (byte-compile-callargs-warn form))
2827 (byte-compile-normal-call form))
2828 (if (memq 'cl-functions byte-compile-warnings)
2829 (byte-compile-cl-warn form))))
2834 (not (eq form (setq form (byte-compile-unfold-lambda form)))))
2835 (byte-compile-form form for-effect)
2837 ((byte-compile-normal-call form)))
2839 (byte-compile-discard)))
2841 (defun byte-compile-normal-call (form)
2842 (if byte-compile-generate-call-tree
2843 (byte-compile-annotate-call-tree form))
2844 (byte-compile-push-constant (car form))
2845 (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
2846 (byte-compile-out 'byte-call (length (cdr form))))
2848 (defun byte-compile-variable-ref (base-op var)
2850 (byte-compile-set-symbol-position var))
2852 (byte-compile-const-symbol-p var (not (eq base-op 'byte-varref))))
2853 (byte-compile-warn
2860 (memq 'obsolete byte-compile-warnings)
2861 (not (eq var byte-compile-not-obsolete-var)))
2864 (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
2869 (if (memq 'free-vars byte-compile-warnings)
2871 (push var byte-compile-bound-variables)
2873 (memq var byte-compile-bound-variables)
2875 (or (memq var byte-compile-free-assignments)
2877 (byte-compile-warn "assignment to free variable `%s'" var)
2878 (push var byte-compile-free-assignments)))
2879 (or (memq var byte-compile-free-references)
2881 (byte-compile-warn "reference to free variable `%s'" var)
2882 (push var byte-compile-free-references))))))))
2883 (let ((tmp (assq var byte-compile-variables)))
2886 (push tmp byte-compile-variables))
2887 (byte-compile-out base-op tmp)))
2889 (defmacro byte-compile-get-constant (const)
2893 (dolist (elt byte-compile-constants)
2897 (assq ,const byte-compile-constants))
2898 (car (setq byte-compile-constants
2899 (cons (list ,const) byte-compile-constants)))))
2902 (defun byte-compile-constant (const)
2906 (byte-compile-set-symbol-position const))
2907 (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
2911 (defun byte-compile-push-constant (const)
2913 (inline (byte-compile-constant const))))
2920 (defmacro byte-defop-compiler (function &optional compile-handler)
2926 ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
2928 ;; If it is nil, then the handler is "byte-compile-SYMBOL."
2935 (list 'put (list 'quote function) ''byte-compile
2937 (or (cdr (assq compile-handler
2938 '((0 . byte-compile-no-args)
2939 (1 . byte-compile-one-arg)
2940 (2 . byte-compile-two-args)
2941 (3 . byte-compile-three-args)
2942 (0-1 . byte-compile-zero-or-one-arg)
2943 (1-2 . byte-compile-one-or-two-args)
2944 (2-3 . byte-compile-two-or-three-args)
2946 compile-handler
2947 (intern (concat "byte-compile-"
2957 (defmacro byte-defop-compiler19 (function &optional compile-handler)
2959 ;; be used when byte-compile-compatibility is false.
2960 (if (and (byte-compile-single-version)
2961 byte-compile-compatibility)
2973 (list 'byte-defop-compiler function compile-handler))))
2975 (defmacro byte-defop-compiler-1 (function &optional compile-handler)
2976 (list 'byte-defop-compiler (list function nil) compile-handler))
3074 (byte-defop-compiler max byte-compile-associative)
3075 (byte-defop-compiler min byte-compile-associative)
3076 (byte-defop-compiler (+ byte-plus) byte-compile-associative)
3077 (byte-defop-compiler19 (* byte-mult) byte-compile-associative)
3080 (byte-defop-compiler-1 interactive byte-compile-noop)
3084 (defun byte-compile-subr-wrong-args (form n)
3085 (byte-compile-set-symbol-position (car form))
3086 (byte-compile-warn "`%s' called with %d arg%s, but requires %s"
3090 (byte-compile-normal-call form))
3092 (defun byte-compile-no-args (form)
3094 (byte-compile-subr-wrong-args form "none")
3095 (byte-compile-out (get (car form) 'byte-opcode) 0)))
3097 (defun byte-compile-one-arg (form)
3099 (byte-compile-subr-wrong-args form 1)
3100 (byte-compile-form (car (cdr form))) ;; Push the argument
3101 (byte-compile-out (get (car form) 'byte-opcode) 0)))
3103 (defun byte-compile-two-args (form)
3105 (byte-compile-subr-wrong-args form 2)
3106 (byte-compile-form (car (cdr form))) ;; Push the arguments
3107 (byte-compile-form (nth 2 form))
3108 (byte-compile-out (get (car form) 'byte-opcode) 0)))
3110 (defun byte-compile-three-args (form)
3112 (byte-compile-subr-wrong-args form 3)
3113 (byte-compile-form (car (cdr form))) ;; Push the arguments
3114 (byte-compile-form (nth 2 form))
3115 (byte-compile-form (nth 3 form))
3116 (byte-compile-out (get (car form) 'byte-opcode) 0)))
3118 (defun byte-compile-zero-or-one-arg (form)
3120 (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
3121 ((= len 2) (byte-compile-one-arg form))
3122 (t (byte-compile-subr-wrong-args form "0-1")))))
3124 (defun byte-compile-one-or-two-args (form)
3126 (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
3127 ((= len 3) (byte-compile-two-args form))
3128 (t (byte-compile-subr-wrong-args form "1-2")))))
3130 (defun byte-compile-two-or-three-args (form)
3132 (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
3133 ((= len 4) (byte-compile-three-args form))
3134 (t (byte-compile-subr-wrong-args form "2-3")))))
3136 (defun byte-compile-noop (form)
3137 (byte-compile-constant nil))
3139 (defun byte-compile-discard ()
3140 (byte-compile-out 'byte-discard 0))
3148 (defun byte-compile-associative (form)
3152 (byte-compile-form (car args))
3157 (byte-compile-form arg)
3158 (byte-compile-out opcode 0)))
3159 (byte-compile-constant (eval form))))
3171 (byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
3174 (byte-defop-compiler-1 function byte-compile-function-form)
3175 (byte-defop-compiler-1 - byte-compile-minus)
3176 (byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
3179 (defun byte-compile-char-before (form)
3181 (byte-compile-form (list 'char-after (if (numberp (nth 1 form))
3185 (byte-compile-form '(char-after (1- (point)))))
3186 (t (byte-compile-subr-wrong-args form "0-1"))))
3189 (defun byte-compile-backward-char (form)
3191 (byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
3195 (byte-compile-form '(forward-char -1)))
3196 (t (byte-compile-subr-wrong-args form "0-1"))))
3198 (defun byte-compile-backward-word (form)
3200 (byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
3204 (byte-compile-form '(forward-word -1)))
3205 (t (byte-compile-subr-wrong-args form "0-1"))))
3207 (defun byte-compile-list (form)
3210 (byte-compile-constant nil))
3212 (mapc 'byte-compile-form (cdr form))
3213 (byte-compile-out
3215 ((and (< count 256) (not (byte-compile-version-cond
3216 byte-compile-compatibility)))
3217 (mapc 'byte-compile-form (cdr form))
3218 (byte-compile-out 'byte-listN count))
3219 (t (byte-compile-normal-call form)))))
3221 (defun byte-compile-concat (form)
3224 (mapc 'byte-compile-form (cdr form))
3225 (byte-compile-out
3230 (byte-compile-form ""))
3231 ((and (< count 256) (not (byte-compile-version-cond
3232 byte-compile-compatibility)))
3233 (mapc 'byte-compile-form (cdr form))
3234 (byte-compile-out 'byte-concatN count))
3235 ((byte-compile-normal-call form)))))
3237 (defun byte-compile-minus (form)
3239 (byte-compile-constant 0)
3240 (byte-compile-form (car form))
3243 (byte-compile-form (car form))
3244 (byte-compile-out 'byte-diff 0))
3245 (byte-compile-out 'byte-negate 0))))
3247 (defun byte-compile-quo (form)
3250 (byte-compile-subr-wrong-args form "2 or more"))
3252 (byte-compile-form (car (setq form (cdr form))))
3254 (byte-compile-form (car form))
3255 (byte-compile-out 'byte-quo 0))))))
3257 (defun byte-compile-nconc (form)
3260 (byte-compile-constant nil))
3263 (byte-compile-form (nth 1 form)))
3265 (byte-compile-form (car (setq form (cdr form))))
3267 (byte-compile-form (car form))
3268 (byte-compile-out 'byte-nconc 0))))))
3270 (defun byte-compile-fset (form)
3283 (byte-compile-warn
3287 (byte-compile-two-args form))
3289 (defun byte-compile-funarg (form)
3292 (byte-compile-normal-call
3301 (defun byte-compile-funarg-2 (form)
3304 (byte-compile-normal-call
3314 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
3318 (defun byte-compile-function-form (form)
3319 (byte-compile-constant
3326 ((byte-compile-version-cond byte-compile-compatibility)
3327 (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form))))
3328 ((byte-compile-lambda (nth 1 form))))))
3330 (defun byte-compile-indent-to (form)
3333 (byte-compile-form (car (cdr form)))
3334 (byte-compile-out 'byte-indent-to 0))
3337 (byte-compile-normal-call form))
3339 (byte-compile-subr-wrong-args form "1-2")))))
3341 (defun byte-compile-insert (form)
3343 (byte-compile-constant nil))
3344 ((and (not (byte-compile-version-cond
3345 byte-compile-compatibility))
3347 (mapc 'byte-compile-form (cdr form))
3349 (byte-compile-out 'byte-insertN (length (cdr form)))
3350 (byte-compile-out 'byte-insert 0)))
3352 (byte-compile-normal-call form))
3356 (byte-compile-form (car form))
3357 (byte-compile-out 'byte-insert 0)
3359 (byte-compile-discard))))))
3368 (defun byte-compile-setq (form)
3372 (byte-compile-form (car (cdr args)))
3374 (byte-compile-out 'byte-dup 0))
3375 (byte-compile-variable-ref 'byte-varset (car args))
3378 (byte-compile-form nil for-effect))
3381 (defun byte-compile-setq-default (form)
3389 (byte-compile-form (cons 'progn (nreverse setters)))))
3391 (defun byte-compile-quote (form)
3392 (byte-compile-constant (car (cdr form))))
3394 (defun byte-compile-quote-form (form)
3395 (byte-compile-constant (byte-compile-top-level (nth 1 form))))
3401 (defun byte-compile-body (body &optional for-effect)
3403 (byte-compile-form (car body) t)
3405 (byte-compile-form (car body) for-effect))
3407 (defsubst byte-compile-body-do-effect (body)
3408 (byte-compile-body body for-effect)
3411 (defsubst byte-compile-form-do-effect (form)
3412 (byte-compile-form form for-effect)
3415 (byte-defop-compiler-1 inline byte-compile-progn)
3425 (byte-defop-compiler-1 apply byte-compile-funarg)
3426 (byte-defop-compiler-1 mapcar byte-compile-funarg)
3427 (byte-defop-compiler-1 mapatoms byte-compile-funarg)
3428 (byte-defop-compiler-1 mapconcat byte-compile-funarg)
3429 (byte-defop-compiler-1 mapc byte-compile-funarg)
3430 (byte-defop-compiler-1 maphash byte-compile-funarg)
3431 (byte-defop-compiler-1 map-char-table byte-compile-funarg)
3432 (byte-defop-compiler-1 sort byte-compile-funarg-2)
3436 (defun byte-compile-progn (form)
3437 (byte-compile-body-do-effect (cdr form)))
3439 (defun byte-compile-prog1 (form)
3440 (byte-compile-form-do-effect (car (cdr form)))
3441 (byte-compile-body (cdr (cdr form)) t))
3443 (defun byte-compile-prog2 (form)
3444 (byte-compile-form (nth 1 form) t)
3445 (byte-compile-form-do-effect (nth 2 form))
3446 (byte-compile-body (cdr (cdr (cdr form))) t))
3448 (defmacro byte-compile-goto-if (cond discard tag)
3449 `(byte-compile-goto
3455 (defmacro byte-compile-maybe-guarded (condition &rest body)
3458 BODY is the code to compile first arm of the if or the body of the
3472 byte-compile-unresolved-functions))
3479 (byte-compile-bound-variables
3481 (cons bound byte-compile-bound-variables)
3482 byte-compile-bound-variables))
3484 (byte-compile-warnings
3487 nil byte-compile-warnings)))
3492 (setq byte-compile-unresolved-functions
3493 (delq (assq fbound byte-compile-unresolved-functions)
3494 byte-compile-unresolved-functions))))))
3496 (defun byte-compile-if (form)
3497 (byte-compile-form (car (cdr form)))
3501 (donetag (byte-compile-make-tag)))
3505 (byte-compile-goto-if nil for-effect donetag)
3506 (byte-compile-maybe-guarded clause
3507 (byte-compile-form (nth 2 form) for-effect))
3508 (byte-compile-out-tag donetag))
3509 (let ((elsetag (byte-compile-make-tag)))
3510 (byte-compile-goto 'byte-goto-if-nil elsetag)
3511 (byte-compile-maybe-guarded clause
3512 (byte-compile-form (nth 2 form) for-effect))
3513 (byte-compile-goto 'byte-goto donetag)
3514 (byte-compile-out-tag elsetag)
3515 (byte-compile-maybe-guarded (list 'not clause)
3516 (byte-compile-body (cdr (cdr (cdr form))) for-effect))
3517 (byte-compile-out-tag donetag))))
3520 (defun byte-compile-cond (clauses)
3521 (let ((donetag (byte-compile-make-tag))
3532 (byte-compile-form (car clause))
3535 (byte-compile-goto-if t for-effect donetag)
3536 (setq nexttag (byte-compile-make-tag))
3537 (byte-compile-goto 'byte-goto-if-nil nexttag)
3538 (byte-compile-maybe-guarded (car clause)
3539 (byte-compile-body (cdr clause) for-effect))
3540 (byte-compile-goto 'byte-goto donetag)
3541 (byte-compile-out-tag nexttag)))))
3545 (progn (byte-compile-form guard)
3546 (byte-compile-goto-if nil for-effect donetag)
3548 (byte-compile-maybe-guarded guard
3549 (byte-compile-body-do-effect clause)))
3550 (byte-compile-out-tag donetag)))
3552 (defun byte-compile-and (form)
3553 (let ((failtag (byte-compile-make-tag))
3556 (byte-compile-form-do-effect t)
3557 (byte-compile-and-recursion args failtag))))
3560 ;; We use tail recursion so we can use byte-compile-maybe-guarded.
3561 (defun byte-compile-and-recursion (rest failtag)
3564 (byte-compile-form (car rest))
3565 (byte-compile-goto-if nil for-effect failtag)
3566 (byte-compile-maybe-guarded (car rest)
3567 (byte-compile-and-recursion (cdr rest) failtag)))
3568 (byte-compile-form-do-effect (car rest))
3569 (byte-compile-out-tag failtag)))
3571 (defun byte-compile-or (form)
3572 (let ((wintag (byte-compile-make-tag))
3575 (byte-compile-form-do-effect nil)
3576 (byte-compile-or-recursion args wintag))))
3579 ;; We use tail recursion so we can use byte-compile-maybe-guarded.
3580 (defun byte-compile-or-recursion (rest wintag)
3583 (byte-compile-form (car rest))
3584 (byte-compile-goto-if t for-effect wintag)
3585 (byte-compile-maybe-guarded (list 'not (car rest))
3586 (byte-compile-or-recursion (cdr rest) wintag)))
3587 (byte-compile-form-do-effect (car rest))
3588 (byte-compile-out-tag wintag)))
3590 (defun byte-compile-while (form)
3591 (let ((endtag (byte-compile-make-tag))
3592 (looptag (byte-compile-make-tag)))
3593 (byte-compile-out-tag looptag)
3594 (byte-compile-form (car (cdr form)))
3595 (byte-compile-goto-if nil for-effect endtag)
3596 (byte-compile-body (cdr (cdr form)) t)
3597 (byte-compile-goto 'byte-goto looptag)
3598 (byte-compile-out-tag endtag)
3601 (defun byte-compile-funcall (form)
3602 (mapc 'byte-compile-form (cdr form))
3603 (byte-compile-out 'byte-call (length (cdr (cdr form)))))
3606 (defun byte-compile-let (form)
3611 (byte-compile-form (car (cdr var)))
3612 (byte-compile-push-constant nil))))
3613 (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
3616 (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
3617 (byte-compile-body-do-effect (cdr (cdr form)))
3618 (byte-compile-out 'byte-unbind (length (car (cdr form))))))
3620 (defun byte-compile-let* (form)
3621 (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
3625 (byte-compile-push-constant nil)
3626 (byte-compile-form (car (cdr var)))
3628 (byte-compile-variable-ref 'byte-varbind var))
3629 (byte-compile-body-do-effect (cdr (cdr form)))
3630 (byte-compile-out 'byte-unbind (length (car (cdr form))))))
3633 (byte-defop-compiler-1 /= byte-compile-negated)
3634 (byte-defop-compiler-1 atom byte-compile-negated)
3635 (byte-defop-compiler-1 nlistp byte-compile-negated)
3637 (put '/= 'byte-compile-negated-op '=)
3638 (put 'atom 'byte-compile-negated-op 'consp)
3639 (put 'nlistp 'byte-compile-negated-op 'listp)
3641 (defun byte-compile-negated (form)
3642 (byte-compile-form-do-effect (byte-compile-negation-optimizer form)))
3645 (defun byte-compile-negation-optimizer (form)
3647 (byte-compile-set-symbol-position (car form))
3649 (cons (or (get (car form) 'byte-compile-negated-op)
3651 "Compiler error: `%s' has no `byte-compile-negated-op' property"
3668 (defun byte-compile-catch (form)
3669 (byte-compile-form (car (cdr form)))
3670 (byte-compile-push-constant
3671 (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
3672 (byte-compile-out 'byte-catch 0))
3674 (defun byte-compile-unwind-protect (form)
3675 (byte-compile-push-constant
3676 (byte-compile-top-level-body (cdr (cdr form)) t))
3677 (byte-compile-out 'byte-unwind-protect 0)
3678 (byte-compile-form-do-effect (car (cdr form)))
3679 (byte-compile-out 'byte-unbind 1))
3681 (defun byte-compile-track-mouse (form)
3682 (byte-compile-form
3684 (track-mouse ,@(byte-compile-top-level-body (cdr form)))))))
3686 (defun byte-compile-condition-case (form)
3688 (byte-compile-bound-variables
3689 (if var (cons var byte-compile-bound-variables)
3690 byte-compile-bound-variables)))
3691 (byte-compile-set-symbol-position 'condition-case)
3693 (byte-compile-warn
3695 (byte-compile-push-constant var)
3696 (byte-compile-push-constant (byte-compile-top-level
3711 (byte-compile-warn
3717 ;; (byte-compile-warn
3723 (byte-compile-top-level-body
3727 (byte-compile-push-constant (nreverse compiled-clauses)))
3728 (byte-compile-out 'byte-condition-case 0)))
3731 (defun byte-compile-save-excursion (form)
3732 (byte-compile-out 'byte-save-excursion 0)
3733 (byte-compile-body-do-effect (cdr form))
3734 (byte-compile-out 'byte-unbind 1))
3736 (defun byte-compile-save-restriction (form)
3737 (byte-compile-out 'byte-save-restriction 0)
3738 (byte-compile-body-do-effect (cdr form))
3739 (byte-compile-out 'byte-unbind 1))
3741 (defun byte-compile-save-current-buffer (form)
3742 (byte-compile-out 'byte-save-current-buffer 0)
3743 (byte-compile-body-do-effect (cdr form))
3744 (byte-compile-out 'byte-unbind 1))
3746 (defun byte-compile-save-window-excursion (form)
3747 (byte-compile-push-constant
3748 (byte-compile-top-level-body (cdr form) for-effect))
3749 (byte-compile-out 'byte-save-window-excursion 0))
3751 (defun byte-compile-with-output-to-temp-buffer (form)
3752 (byte-compile-form (car (cdr form)))
3753 (byte-compile-out 'byte-temp-output-buffer-setup 0)
3754 (byte-compile-body (cdr (cdr form)))
3755 (byte-compile-out 'byte-temp-output-buffer-show 0))
3763 (byte-defop-compiler-1 defconst byte-compile-defvar)
3765 (byte-defop-compiler-1 lambda byte-compile-lambda-form)
3767 (defun byte-compile-defun (form)
3770 (byte-compile-set-symbol-position (car form))
3771 (byte-compile-set-symbol-position 'defun)
3773 (if (byte-compile-version-cond byte-compile-compatibility)
3775 (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
3778 (byte-compile-byte-code-maker
3779 (byte-compile-lambda (cdr (cdr form)) t))))
3780 (byte-compile-discard))
3783 (byte-compile-form
3786 (byte-compile-byte-code-maker
3787 (byte-compile-lambda (cdr (cdr form)) t)))
3789 (byte-compile-constant (nth 1 form)))
3791 (defun byte-compile-defmacro (form)
3793 (byte-compile-body-do-effect
3795 (let ((code (byte-compile-byte-code-maker
3796 (byte-compile-lambda (cdr (cdr form)) t))))
3802 (defun byte-compile-defvar (form)
3808 (byte-compile-set-symbol-position fun)
3812 (byte-compile-warn
3818 (when (memq 'free-vars byte-compile-warnings)
3819 (push var byte-compile-bound-variables)
3821 (push var byte-compile-const-variables)))
3822 (byte-compile-body-do-effect
3826 (when (and (cddr form) (null byte-compile-current-form))
3830 (byte-compile-warn "third arg to `%s %s' is not a string: %s"
3834 (let ((byte-compile-not-obsolete-var var))
3847 (defun byte-compile-autoload (form)
3848 (byte-compile-set-symbol-position 'autoload)
3849 (and (byte-compile-constp (nth 1 form))
3850 (byte-compile-constp (nth 5 form))
3853 (byte-compile-warn
3857 (byte-compile-normal-call form))
3861 (defun byte-compile-lambda-form (form)
3862 (byte-compile-set-symbol-position 'lambda)
3866 (put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
3867 (defun byte-compile-file-form-defalias (form)
3878 (byte-compile-defalias-warn (nth 1 (nth 1 form)))
3881 byte-compile-function-environment)))
3882 ;; We used to jus do: (byte-compile-normal-call form)
3885 ;; which is to call back byte-compile-file-form and then return nil.
3886 ;; Except that we can't just call byte-compile-file-form since it would
3888 (byte-compile-keep-pending form)
3895 (defun byte-compile-defalias-warn (new)
3896 (let ((calls (assq new byte-compile-unresolved-functions)))
3898 (setq byte-compile-unresolved-functions
3899 (delq calls byte-compile-unresolved-functions)))))
3901 (byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
3902 (defun byte-compile-no-warnings (form)
3903 (let (byte-compile-warnings)
3904 (byte-compile-form (cons 'progn (cdr form)))))
3907 (byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
3908 (defun byte-compile-make-variable-buffer-local (form)
3910 (byte-compile-warn
3911 "`make-variable-buffer-local' should be called at toplevel"))
3912 (byte-compile-normal-call form))
3914 'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
3915 (defun byte-compile-form-make-variable-buffer-local (form)
3916 (byte-compile-keep-pending form 'byte-compile-normal-call))
3925 (defun byte-compile-make-tag ()
3926 (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number))))
3929 (defun byte-compile-out-tag (tag)
3930 (setq byte-compile-output (cons tag byte-compile-output))
3934 (and byte-compile-depth
3935 (not (= (cdr (cdr tag)) byte-compile-depth))
3937 (setq byte-compile-depth (cdr (cdr tag))))
3938 (setcdr (cdr tag) byte-compile-depth)))
3940 (defun byte-compile-goto (opcode tag)
3941 (push (cons opcode tag) byte-compile-output)
3943 (1- byte-compile-depth)
3944 byte-compile-depth))
3945 (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
3946 (1- byte-compile-depth))))
3948 (defun byte-compile-out (opcode offset)
3949 (push (cons opcode offset) byte-compile-output)
3951 (setq byte-compile-depth (- byte-compile-depth offset)))
3955 (setq byte-compile-depth nil))
3957 (setq byte-compile-depth (+ byte-compile-depth
3961 byte-compile-maxdepth (max byte-compile-depth
3962 byte-compile-maxdepth))))
3963 ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
3970 (defun byte-compile-annotate-call-tree (form)
3973 (if (setq entry (assq (car form) byte-compile-call-tree))
3974 (or (memq byte-compile-current-form (nth 1 entry)) ;callers
3976 (cons byte-compile-current-form (nth 1 entry))))
3977 (setq byte-compile-call-tree
3978 (cons (list (car form) (list byte-compile-current-form) nil)
3979 byte-compile-call-tree)))
3981 (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
3985 (setq byte-compile-call-tree
3986 (cons (list byte-compile-current-form nil (list (car form)))
3987 byte-compile-call-tree)))
3990 ;; Renamed from byte-compile-report-call-tree
3991 ;; to avoid interfering with completion of byte-compile-file.
4013 byte-compile-call-tree-sort)
4015 (cond ((null byte-compile-current-file) (or filename "???"))
4016 ((stringp byte-compile-current-file)
4017 byte-compile-current-file)
4018 (t (buffer-name byte-compile-current-file)))
4020 (prin1-to-string byte-compile-call-tree-sort)
4022 (if byte-compile-call-tree-sort
4023 (setq byte-compile-call-tree
4024 (sort byte-compile-call-tree
4025 (cond ((eq byte-compile-call-tree-sort 'callers)
4028 ((eq byte-compile-call-tree-sort 'calls)
4031 ((eq byte-compile-call-tree-sort 'calls+callers)
4036 ((eq byte-compile-call-tree-sort 'name)
4039 (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
4040 byte-compile-call-tree-sort))))))
4042 (let ((rest byte-compile-call-tree)
4102 (setq rest byte-compile-call-tree)
4107 (functionp (byte-compile-fdefinition f t))
4108 (commandp (byte-compile-fdefinition f nil))
4124 (defun batch-byte-compile-if-not-done ()
4125 "Like `byte-compile-file' but doesn't recompile if already up to date.
4128 (batch-byte-compile t))
4133 (defun batch-byte-compile (&optional noforce)
4134 "Run `byte-compile-file' on the files remaining on the command line.
4138 For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
4144 (error "`batch-byte-compile' is to be used only with -batch"))
4156 (setq dest (byte-compile-dest-file source))
4159 (if (null (batch-byte-compile-file source))
4164 (dest (byte-compile-dest-file source)))
4167 (if (null (batch-byte-compile-file (car command-line-args-left)))
4172 (defun batch-byte-compile-file (file)
4174 (byte-compile-file file)
4176 (byte-compile-file file)
4184 (let ((destfile (byte-compile-dest-file file)))
4217 (provide 'byte-compile)
4225 (defun byte-compile-report-ops ()
4252 ;; itself, compile some of its most used recursive functions (at load time).
4254 (eval-when-compile
4255 (or (byte-code-function-p (symbol-function 'byte-compile-form))
4256 (assq 'byte-code (symbol-function 'byte-compile-form))
4258 (byte-compile-warnings nil))
4261 (byte-compile x)
4263 '(byte-compile-normal-call
4264 byte-compile-form
4265 byte-compile-body
4267 byte-compile-top-level
4268 byte-compile-out-toplevel
4269 byte-compile-constant
4270 byte-compile-variable-ref))))