Lines Matching defs:byte
1 ;;; bytecomp.el --- compilation of Lisp code into byte code
30 ;; The Emacs Lisp byte compiler. This crunches lisp source into a sort
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
46 ;; This version of the byte compiler has the following improvements:
73 ;; byte-compile-verbose Whether to report the function currently being
75 ;; byte-optimize Whether to do optimizations; this may be
76 ;; t, nil, 'source, or 'byte;
77 ;; byte-optimize-log Whether to report (in excruciating detail)
79 ;; This may be t, nil, 'source, or 'byte;
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
104 ;; byte-compile-compatibility Whether the compiler should
108 ;; see also the function byte-compile-dest-file.
133 ;; byte-compiler has been modified to remember function definitions in
150 ;; o If you run byte-compile-file on a filename which is visited in a
154 ;; o byte-compiled files now start with the string `;ELC'.
161 (load "byte-run"))
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)
182 ;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
183 ;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
196 "Emacs Lisp byte-compiler."
203 You may want to redefine the function `byte-compile-dest-file'
211 (defun byte-compiler-base-file-name (filename)
213 'byte-compiler-base-file-name)))
215 (funcall handler 'byte-compiler-base-file-name filename)
218 (or (fboundp 'byte-compile-dest-file)
221 (defun byte-compile-dest-file (filename)
225 (setq filename (byte-compiler-base-file-name filename))
233 ;; This can be the 'byte-compile property of any symbol.
234 (autoload 'byte-compile-inline-expand "byte-opt")
237 (autoload 'byte-optimize-form "byte-opt")
239 (autoload 'byte-optimize-lapcode "byte-opt")
240 (autoload 'byte-compile-unfold-lambda "byte-opt")
243 ;; disassembler. The disassembler just requires 'byte-compile, but
246 (autoload 'byte-decompile-bytecode "byte-opt")
248 (defcustom byte-compile-verbose
250 "*Non-nil means print messages describing progress of byte-compiler."
254 (defcustom byte-compile-compatibility nil
261 ;; (defvar byte-compile-generate-emacs19-bytecodes
264 ;; "*If this is true, then the byte-compiler will generate bytecode which
265 ;; makes use of byte-ops which are present only in Emacs 19. Code generated
268 (defcustom byte-optimize t
269 "*Enable optimization in the byte compiler.
274 `byte' - code-level optimizations only"
279 (const :tag "byte-level" byte)))
281 (defcustom byte-compile-delete-errors nil
287 (defvar byte-compile-dynamic nil
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
302 "If non-nil, disable `print-circle' on printing a byte-compiled code.")
303 ;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
305 (defcustom byte-compile-dynamic-docstrings t
316 -*-byte-compile-dynamic-docstrings:nil;-*-
322 ;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
324 (defcustom byte-optimize-log nil
325 "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
327 If it is 'byte, then only byte-level optimizations will be logged."
332 (const :tag "byte-level" byte)))
334 (defcustom byte-compile-error-on-warn nil
335 "*If true, the byte-compiler reports warnings with `error'."
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
344 "*List of warnings that the byte-compiler should issue (t for all).
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
398 which the byte-code interpreter knows about directly (eq, cons, etc.) are
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)
447 (defvar byte-compiler-error-flag)
449 (defconst byte-compile-initial-macro-environment
451 ;; (byte-compiler-options . (lambda (&rest forms)
452 ;; (apply 'byte-compiler-options-handler forms)))
455 (byte-compile-eval (byte-compile-top-level
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
489 "Alist describing contents to put in byte code string.
491 (defvar byte-compile-depth 0 "Current depth of execution stack.")
492 (defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
496 ;;; The byte codes; this information is duplicated in bytecomp.c
498 (defvar byte-code-vector nil
499 "An array containing byte-code names indexed by byte-code values.")
501 (defvar byte-stack+-info nil
502 "An array with the stack adjustment for each byte-code.")
504 (defmacro byte-defop (opcode stack-adjust opname &optional docstring)
505 ;; This is a speed-hack for building the byte-code-vector at compile-time.
507 ;; to byte-defop, we write the vector out as a constant instead of writing
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
524 (defmacro byte-extrude-byte-code-vectors ()
525 (prog1 (list 'setq 'byte-code-vector
526 (get 'byte-code-vector 'tmp-compile-time-value)
527 'byte-stack+-info
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)))
538 (byte-defop 8 1 byte-varref "for variable reference")
539 (byte-defop 16 -1 byte-varset "for setting a variable")
540 (byte-defop 24 -1 byte-varbind "for binding a variable")
541 (byte-defop 32 0 byte-call "for calling a function")
542 (byte-defop 40 0 byte-unbind "for unbinding special bindings")
547 (byte-defop 56 -1 byte-nth)
548 (byte-defop 57 0 byte-symbolp)
549 (byte-defop 58 0 byte-consp)
550 (byte-defop 59 0 byte-stringp)
551 (byte-defop 60 0 byte-listp)
552 (byte-defop 61 -1 byte-eq)
553 (byte-defop 62 -1 byte-memq)
554 (byte-defop 63 0 byte-not)
555 (byte-defop 64 0 byte-car)
556 (byte-defop 65 0 byte-cdr)
557 (byte-defop 66 -1 byte-cons)
558 (byte-defop 67 0 byte-list1)
559 (byte-defop 68 -1 byte-list2)
560 (byte-defop 69 -2 byte-list3)
561 (byte-defop 70 -3 byte-list4)
562 (byte-defop 71 0 byte-length)
563 (byte-defop 72 -1 byte-aref)
564 (byte-defop 73 -2 byte-aset)
565 (byte-defop 74 0 byte-symbol-value)
566 (byte-defop 75 0 byte-symbol-function) ; this was commented out
567 (byte-defop 76 -1 byte-set)
568 (byte-defop 77 -1 byte-fset) ; this was commented out
569 (byte-defop 78 -1 byte-get)
570 (byte-defop 79 -2 byte-substring)
571 (byte-defop 80 -1 byte-concat2)
572 (byte-defop 81 -2 byte-concat3)
573 (byte-defop 82 -3 byte-concat4)
574 (byte-defop 83 0 byte-sub1)
575 (byte-defop 84 0 byte-add1)
576 (byte-defop 85 -1 byte-eqlsign)
577 (byte-defop 86 -1 byte-gtr)
578 (byte-defop 87 -1 byte-lss)
579 (byte-defop 88 -1 byte-leq)
580 (byte-defop 89 -1 byte-geq)
581 (byte-defop 90 -1 byte-diff)
582 (byte-defop 91 0 byte-negate)
583 (byte-defop 92 -1 byte-plus)
584 (byte-defop 93 -1 byte-max)
585 (byte-defop 94 -1 byte-min)
586 (byte-defop 95 -1 byte-mult) ; v19 only
587 (byte-defop 96 1 byte-point)
588 (byte-defop 98 0 byte-goto-char)
589 (byte-defop 99 0 byte-insert)
590 (byte-defop 100 1 byte-point-max)
591 (byte-defop 101 1 byte-point-min)
592 (byte-defop 102 0 byte-char-after)
593 (byte-defop 103 1 byte-following-char)
594 (byte-defop 104 1 byte-preceding-char)
595 (byte-defop 105 1 byte-current-column)
596 (byte-defop 106 0 byte-indent-to)
597 (byte-defop 107 0 byte-scan-buffer-OBSOLETE) ; no longer generated as of v18
598 (byte-defop 108 1 byte-eolp)
599 (byte-defop 109 1 byte-eobp)
600 (byte-defop 110 1 byte-bolp)
601 (byte-defop 111 1 byte-bobp)
602 (byte-defop 112 1 byte-current-buffer)
603 (byte-defop 113 0 byte-set-buffer)
604 (byte-defop 114 0 byte-save-current-buffer
606 (byte-defop 115 0 byte-set-mark-OBSOLETE)
607 (byte-defop 116 1 byte-interactive-p)
610 (byte-defop 117 0 byte-forward-char)
611 (byte-defop 118 0 byte-forward-word)
612 (byte-defop 119 -1 byte-skip-chars-forward)
613 (byte-defop 120 -1 byte-skip-chars-backward)
614 (byte-defop 121 0 byte-forward-line)
615 (byte-defop 122 0 byte-char-syntax)
616 (byte-defop 123 -1 byte-buffer-substring)
617 (byte-defop 124 -1 byte-delete-region)
618 (byte-defop 125 -1 byte-narrow-to-region)
619 (byte-defop 126 1 byte-widen)
620 (byte-defop 127 0 byte-end-of-line)
625 (byte-defop 129 1 byte-constant2
626 "for reference to a constant with vector index >= byte-constant-limit")
627 (byte-defop 130 0 byte-goto "for unconditional jump")
628 (byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
629 (byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
630 (byte-defop 133 -1 byte-goto-if-nil-else-pop
633 (byte-defop 134 -1 byte-goto-if-not-nil-else-pop
637 (byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
638 (byte-defop 136 -1 byte-discard "to discard one value from stack")
639 (byte-defop 137 1 byte-dup "to duplicate the top of the stack")
641 (byte-defop 138 0 byte-save-excursion
643 (byte-defop 139 0 byte-save-window-excursion
645 (byte-defop 140 0 byte-save-restriction
647 (byte-defop 141 -1 byte-catch
649 (byte-defop 142 -1 byte-unwind-protect
654 (byte-defop 143 -2 byte-condition-case)
660 (byte-defop 144 0 byte-temp-output-buffer-setup)
666 (byte-defop 145 -1 byte-temp-output-buffer-show)
672 (byte-defop 146 0 byte-unbind-all)
675 (byte-defop 147 -2 byte-set-marker)
676 (byte-defop 148 0 byte-match-beginning)
677 (byte-defop 149 0 byte-match-end)
678 (byte-defop 150 0 byte-upcase)
679 (byte-defop 151 0 byte-downcase)
680 (byte-defop 152 -1 byte-string=)
681 (byte-defop 153 -1 byte-string<)
682 (byte-defop 154 -1 byte-equal)
683 (byte-defop 155 -1 byte-nthcdr)
684 (byte-defop 156 -1 byte-elt)
685 (byte-defop 157 -1 byte-member)
686 (byte-defop 158 -1 byte-assq)
687 (byte-defop 159 0 byte-nreverse)
688 (byte-defop 160 -1 byte-setcar)
689 (byte-defop 161 -1 byte-setcdr)
690 (byte-defop 162 0 byte-car-safe)
691 (byte-defop 163 0 byte-cdr-safe)
692 (byte-defop 164 -1 byte-nconc)
693 (byte-defop 165 -1 byte-quo)
694 (byte-defop 166 -1 byte-rem)
695 (byte-defop 167 0 byte-numberp)
696 (byte-defop 168 0 byte-integerp)
699 (byte-defop 175 nil byte-listN)
700 (byte-defop 176 nil byte-concatN)
701 (byte-defop 177 nil byte-insertN)
705 (byte-defop 192 1 byte-constant "for reference to a constant")
706 ;; codes 193-255 are consumed by byte-constant.
707 (defconst byte-constant-limit 64
708 "Exclusive maximum index usable in the `byte-constant' opcode.")
710 (defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
711 byte-goto-if-nil-else-pop
712 byte-goto-if-not-nil-else-pop)
713 "List of byte-codes whose offset is a pc.")
715 (defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
717 (byte-extrude-byte-code-vectors)
722 ;; the byte-compiler now does source -> lapcode -> bytecode instead of
727 ;; where instruction is a symbol naming a byte-code instruction,
744 ;; compacted byte-code.
751 (defun byte-compile-lapcode (lap)
766 ((memq op byte-goto-ops)
777 (eq op 'byte-constant)))
778 (cond ((< off byte-constant-limit)
780 (cons (+ byte-constant off) bytes))
785 (cons byte-constant2 bytes))))))
786 ((<= byte-listN (symbol-value op))
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)
874 (setq byte-compile-warnings
875 (remq 'cl-functions byte-compile-warnings)))
879 ;;; byte compiler messages
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)
889 byte-optimize
890 (memq byte-optimize-log '(t source))
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'
941 ;; byte compiler itself; because rather than just fail looking up the
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)
1057 "Issue a byte compiler warning; use (format FORMAT ARGS...) for message."
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)
1065 (setq byte-compiler-error-flag t)
1066 (byte-compile-log-warning
1071 (defun byte-compile-obsolete (form)
1072 (let* ((new (get (car form) 'byte-obsolete-info))
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)))
1087 ;; (defvar byte-compiler-valid-options
1088 ;; '((optimize byte-optimize (t nil source byte) val)
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)
1102 ;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
1103 ;; (list (byte-compile-version-cond
1104 ;; byte-compile-generate-emacs19-bytecodes)))
1105 ;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options)))
1106 ;; (if (byte-compile-version-cond byte-compile-compatibility)
1109 ;; (defun byte-compiler-options-handler (&rest args)
1113 ;; (error "Malformed byte-compiler option `%s'" (car args)))
1116 ;; desc (assq key byte-compiler-valid-options))
1118 ;; (error "Unknown byte-compiler option `%s'" key))
1150 (defun byte-compile-fdefinition (name macro-p)
1152 byte-compile-macro-environment
1153 byte-compile-function-environment))
1162 (byte-code-function-p (symbol-function fn)))))
1164 (if (and (not macro-p) (byte-code-function-p fn))
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
1219 (if (byte-code-function-p def)
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
1310 (if (byte-code-function-p old)
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)
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)
1476 ;; Close over these variables so that `byte-compiler-options'
1479 (byte-compile-verbose byte-compile-verbose)
1480 (byte-optimize byte-optimize)
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))))))))
1526 (defun byte-force-recompile (directory)
1530 (byte-recompile-directory directory nil t))
1533 (defun byte-recompile-directory (directory &optional arg force)
1568 (displaying-byte-compile-warnings
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
1621 "Non-nil to prevent byte-compiling of emacs-lisp code.
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)
1629 "Compile a file of Lisp code named FILENAME into a file of byte code.
1631 `byte-compile-dest-file' function (which see).
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)
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))
1710 'no-byte-compile)
1711 (when byte-compile-verbose
1713 (setq byte-compiler-error-flag nil)
1716 ;; within byte-compile-from-buffer lingers in that buffer.
1719 (byte-compile-from-buffer input-buffer filename)))
1720 (if byte-compiler-error-flag
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)
1760 ;; "Compile a file of Lisp code named FILENAME into a file of byte code,
1765 ;; (byte-compile-file filename t)
1767 ;; (call-interactively 'byte-compile-file))))
1769 ;;(defun byte-compile-buffer (&optional buffer)
1776 ;; (byte-compile-current-file buffer))
1777 ;; (byte-compile-from-buffer buffer nil))
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)
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))
1929 ;; byte, followed by some nulls. The primary motivation for doing
1936 ;; >4 byte x version %d
1940 (if (byte-compile-version-cond byte-compile-compatibility) 18 20)
1951 ((eq byte-optimize 'source) "with source-level optimization only")
1952 ((eq byte-optimize 'byte) "with byte-level optimization only")
1953 (byte-optimize "with all optimizations")
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
2001 (error "Version-18 compatibility doesn't support dynamic byte code"))
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))
2101 ;; Output the byte code and constants specially
2104 (byte-compile-output-as-comment
2126 (defun byte-compile-keep-pending (form &optional handler)
2127 (if (memq byte-optimize '(t source))
2128 (setq form (byte-optimize-form form t)))
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))
2162 (setq handler (get (car form) 'byte-hunk-handler)))
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)))))
2173 ;; as byte-code.
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))
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)
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))))
2223 (put 'custom-declare-variable 'byte-hunk-handler
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))
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))
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)
2305 ;; don't warn when compiling the stubs in byte-run...
2307 byte-compile-initial-macro-environment)))
2308 (byte-compile-warn
2313 (when (and (memq 'redefine byte-compile-warnings)
2315 ;; byte-compiler macros in byte-run.el...
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
2488 (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
2490 ;; Generate a make-byte-code call.
2492 (nconc (list 'make-byte-code
2512 (defun byte-compile-byte-code-unmake (function)
2521 (list (list 'byte-code
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))
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'
2557 ;; for symbols generated by the byte compiler itself.
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"
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)))
2606 ;; Build the actual byte-coded function.
2607 (if (and (eq 'byte-code (car-safe compiled))
2608 (not (byte-compile-version-cond
2609 byte-compile-compatibility)))
2610 (apply 'make-byte-code
2612 ;; byte-string, constants-vector, stack depth
2630 (defun byte-compile-constants-vector ()
2633 ;; To keep the byte-codes to look up the vector as short as possible:
2634 ;; First 6 elements are vars, as there are one-byte varref codes for those.
2635 ;; Next up to byte-constant-limit are constants, still with one-byte codes.
2636 ;; Next variables again, to get 2-byte codes for variable lookup.
2637 ;; The rest of the constants and variables need 3-byte byte-codes.
2639 (rest (nreverse byte-compile-variables)) ; nreverse because the first
2640 (other (nreverse byte-compile-constants)) ; vars often are used most.
2642 (limits '(5 ; Use the 1-byte varref codes,
2643 63 ; 1-constlim ; 1-byte byte-constant codes,
2644 255 ; 2-byte varref codes,
2645 65535)) ; 3-byte codes for the rest.
2660 ;; Given an expression FORM, compile it and return an equivalent byte-code
2661 ;; expression (a call to the function 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))
2674 (if (memq byte-optimize '(t source))
2675 (setq form (byte-optimize-form form for-effect)))
2678 (if (and (eq 'byte-code (car-safe form))
2679 (not (memq byte-optimize '(t byte)))
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)
2688 ;; The stack is empty. Push a value to be returned from (byte-code ..).
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))
2704 (if (memq byte-optimize '(t byte))
2705 (setq byte-compile-output
2706 (byte-optimize-lapcode byte-compile-output for-effect)))
2711 ;; are still quicker than (byte-code "..." [foo "hi"] 2).
2713 ;; interpreter, so quote should be compiled into byte-code in some contexts.
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)))))
2735 ((memq (car (car rest)) '(byte-varref byte-constant))
2737 (if (if (eq (car (car rest)) 'byte-constant)
2740 (not (byte-compile-const-symbol-p tmp)))))
2747 (setq tmp (get (car (car rest)) 'byte-opcode-invert))
2751 (eq (car (nth 1 rest)) 'byte-discard)
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)))
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)
2821 (get (get fn 'byte-opcode) 'emacs19-opcode))))
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))))
2830 ((and (or (byte-code-function-p (car 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
2854 (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
2855 ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
2859 (if (and (get var 'byte-obsolete-variable)
2860 (memq 'obsolete byte-compile-warnings)
2861 (not (eq var byte-compile-not-obsolete-var)))
2862 (let* ((ob (get var 'byte-obsolete-variable))
2864 (byte-compile-warn "`%s' is an obsolete variable%s; %s" var
2869 (if (memq 'free-vars byte-compile-warnings)
2870 (if (eq base-op 'byte-varbind)
2871 (push var byte-compile-bound-variables)
2873 (memq var byte-compile-bound-variables)
2874 (if (eq base-op 'byte-varset)
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))))
2918 ;; which have special byte codes just for speed.
2920 (defmacro byte-defop-compiler (function &optional compile-handler)
2922 ;; If function is a symbol, then the variable "byte-SYMBOL" must name
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."
2931 (setq opcode (intern (concat "byte-" (symbol-name function))))
2935 (list 'put (list 'quote function) ''byte-compile
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)
2947 (intern (concat "byte-compile-"
2952 ''byte-opcode (list 'quote opcode))
2954 ''byte-opcode-invert (list 'quote function)))
2957 (defmacro byte-defop-compiler19 (function &optional compile-handler)
2958 ;; Just like byte-defop-compiler, but defines an opcode that will only
2959 ;; be used when byte-compile-compatibility is false.
2960 (if (and (byte-compile-single-version)
2961 byte-compile-compatibility)
2970 (intern (concat "byte-"
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))
2980 (put 'byte-call 'byte-opcode-invert 'funcall)
2981 (put 'byte-list1 'byte-opcode-invert 'list)
2982 (put 'byte-list2 'byte-opcode-invert 'list)
2983 (put 'byte-list3 'byte-opcode-invert 'list)
2984 (put 'byte-list4 'byte-opcode-invert 'list)
2985 (put 'byte-listN 'byte-opcode-invert 'list)
2986 (put 'byte-concat2 'byte-opcode-invert 'concat)
2987 (put 'byte-concat3 'byte-opcode-invert 'concat)
2988 (put 'byte-concat4 'byte-opcode-invert 'concat)
2989 (put 'byte-concatN 'byte-opcode-invert 'concat)
2990 (put 'byte-insertN 'byte-opcode-invert 'insert)
2992 (byte-defop-compiler point 0)
2993 ;;(byte-defop-compiler mark 0) ;; obsolete
2994 (byte-defop-compiler point-max 0)
2995 (byte-defop-compiler point-min 0)
2996 (byte-defop-compiler following-char 0)
2997 (byte-defop-compiler preceding-char 0)
2998 (byte-defop-compiler current-column 0)
2999 (byte-defop-compiler eolp 0)
3000 (byte-defop-compiler eobp 0)
3001 (byte-defop-compiler bolp 0)
3002 (byte-defop-compiler bobp 0)
3003 (byte-defop-compiler current-buffer 0)
3004 ;;(byte-defop-compiler read-char 0) ;; obsolete
3005 (byte-defop-compiler interactive-p 0)
3006 (byte-defop-compiler19 widen 0)
3007 (byte-defop-compiler19 end-of-line 0-1)
3008 (byte-defop-compiler19 forward-char 0-1)
3009 (byte-defop-compiler19 forward-line 0-1)
3010 (byte-defop-compiler symbolp 1)
3011 (byte-defop-compiler consp 1)
3012 (byte-defop-compiler stringp 1)
3013 (byte-defop-compiler listp 1)
3014 (byte-defop-compiler not 1)
3015 (byte-defop-compiler (null byte-not) 1)
3016 (byte-defop-compiler car 1)
3017 (byte-defop-compiler cdr 1)
3018 (byte-defop-compiler length 1)
3019 (byte-defop-compiler symbol-value 1)
3020 (byte-defop-compiler symbol-function 1)
3021 (byte-defop-compiler (1+ byte-add1) 1)
3022 (byte-defop-compiler (1- byte-sub1) 1)
3023 (byte-defop-compiler goto-char 1)
3024 (byte-defop-compiler char-after 0-1)
3025 (byte-defop-compiler set-buffer 1)
3026 ;;(byte-defop-compiler set-mark 1) ;; obsolete
3027 (byte-defop-compiler19 forward-word 0-1)
3028 (byte-defop-compiler19 char-syntax 1)
3029 (byte-defop-compiler19 nreverse 1)
3030 (byte-defop-compiler19 car-safe 1)
3031 (byte-defop-compiler19 cdr-safe 1)
3032 (byte-defop-compiler19 numberp 1)
3033 (byte-defop-compiler19 integerp 1)
3034 (byte-defop-compiler19 skip-chars-forward 1-2)
3035 (byte-defop-compiler19 skip-chars-backward 1-2)
3036 (byte-defop-compiler eq 2)
3037 (byte-defop-compiler memq 2)
3038 (byte-defop-compiler cons 2)
3039 (byte-defop-compiler aref 2)
3040 (byte-defop-compiler set 2)
3041 (byte-defop-compiler (= byte-eqlsign) 2)
3042 (byte-defop-compiler (< byte-lss) 2)
3043 (byte-defop-compiler (> byte-gtr) 2)
3044 (byte-defop-compiler (<= byte-leq) 2)
3045 (byte-defop-compiler (>= byte-geq) 2)
3046 (byte-defop-compiler get 2)
3047 (byte-defop-compiler nth 2)
3048 (byte-defop-compiler substring 2-3)
3049 (byte-defop-compiler19 (move-marker byte-set-marker) 2-3)
3050 (byte-defop-compiler19 set-marker 2-3)
3051 (byte-defop-compiler19 match-beginning 1)
3052 (byte-defop-compiler19 match-end 1)
3053 (byte-defop-compiler19 upcase 1)
3054 (byte-defop-compiler19 downcase 1)
3055 (byte-defop-compiler19 string= 2)
3056 (byte-defop-compiler19 string< 2)
3057 (byte-defop-compiler19 (string-equal byte-string=) 2)
3058 (byte-defop-compiler19 (string-lessp byte-string<) 2)
3059 (byte-defop-compiler19 equal 2)
3060 (byte-defop-compiler19 nthcdr 2)
3061 (byte-defop-compiler19 elt 2)
3062 (byte-defop-compiler19 member 2)
3063 (byte-defop-compiler19 assq 2)
3064 (byte-defop-compiler19 (rplaca byte-setcar) 2)
3065 (byte-defop-compiler19 (rplacd byte-setcdr) 2)
3066 (byte-defop-compiler19 setcar 2)
3067 (byte-defop-compiler19 setcdr 2)
3068 (byte-defop-compiler19 buffer-substring 2)
3069 (byte-defop-compiler19 delete-region 2)
3070 (byte-defop-compiler19 narrow-to-region 2)
3071 (byte-defop-compiler19 (% byte-rem) 2)
3072 (byte-defop-compiler aset 3)
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)
3079 ;;####(byte-defop-compiler19 move-to-column 1)
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)
3150 (let ((opcode (get (car form) 'byte-opcode))
3152 (byte-compile-form (car args))
3155 opcode (get '+ 'byte-opcode)))
3157 (byte-compile-form arg)
3158 (byte-compile-out opcode 0)))
3159 (byte-compile-constant (eval form))))
3165 (byte-defop-compiler char-before)
3166 (byte-defop-compiler backward-char)
3167 (byte-defop-compiler backward-word)
3168 (byte-defop-compiler list)
3169 (byte-defop-compiler concat)
3170 (byte-defop-compiler fset)
3171 (byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
3172 (byte-defop-compiler indent-to)
3173 (byte-defop-compiler insert)
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)
3177 (byte-defop-compiler19 nconc)
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
3214 (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
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
3226 (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
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)
3282 (not (eq 'byte-code (car (car body)))))
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
3318 (defun byte-compile-function-form (form)
3319 (byte-compile-constant
3323 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code.
3324 ;; In this situation, calling make-byte-code at run-time will usually
3325 ;; be less efficient than processing a call to byte-code.
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))))))
3363 (byte-defop-compiler-1 setq)
3364 (byte-defop-compiler-1 setq-default)
3365 (byte-defop-compiler-1 quote)
3366 (byte-defop-compiler-1 quote-form)
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)
3416 (byte-defop-compiler-1 progn)
3417 (byte-defop-compiler-1 prog1)
3418 (byte-defop-compiler-1 prog2)
3419 (byte-defop-compiler-1 if)
3420 (byte-defop-compiler-1 cond)
3421 (byte-defop-compiler-1 and)
3422 (byte-defop-compiler-1 or)
3423 (byte-defop-compiler-1 while)
3424 (byte-defop-compiler-1 funcall)
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)
3433 (byte-defop-compiler-1 let)
3434 (byte-defop-compiler-1 let*)
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
3451 (if ,discard 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
3452 (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
3455 (defmacro byte-compile-maybe-guarded (condition &rest body)
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"
3658 (byte-defop-compiler-1 catch)
3659 (byte-defop-compiler-1 unwind-protect)
3660 (byte-defop-compiler-1 condition-case)
3661 (byte-defop-compiler-1 save-excursion)
3662 (byte-defop-compiler-1 save-current-buffer)
3663 (byte-defop-compiler-1 save-restriction)
3664 (byte-defop-compiler-1 save-window-excursion)
3665 (byte-defop-compiler-1 with-output-to-temp-buffer)
3666 (byte-defop-compiler-1 track-mouse)
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))
3760 (byte-defop-compiler-1 defun)
3761 (byte-defop-compiler-1 defmacro)
3762 (byte-defop-compiler-1 defvar)
3763 (byte-defop-compiler-1 defconst byte-compile-defvar)
3764 (byte-defop-compiler-1 autoload)
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))))
3797 (if (eq (car-safe code) 'make-byte-code)
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)
3884 ;; So instead we now do the same as what other byte-hunk-handlers do,
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
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)
3942 (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
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)
3950 (cond ((eq opcode 'byte-call)
3951 (setq byte-compile-depth (- byte-compile-depth offset)))
3952 ((eq opcode 'byte-return)
3954 ;; no more opcodes behind byte-return.
3955 (setq byte-compile-depth nil))
3957 (setq byte-compile-depth (+ byte-compile-depth
3958 (or (aref byte-stack+-info
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.
4001 primitives that the byte-code interpreter knows about directly \(eq,
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)
4059 ((byte-code-function-p f)
4064 (if (or (byte-code-function-p (cdr f))
4065 (assq 'byte-code (cdr (cdr (cdr f)))))
4068 ((assq 'byte-code (cdr (cdr f)))
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)))
4198 (defun batch-byte-recompile-directory (&optional arg)
4199 "Run `byte-recompile-directory' on the dirs remaining on the command line.
4201 For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
4209 (error "batch-byte-recompile-directory is to be used only with -batch"))
4213 (byte-recompile-directory (car command-line-args-left) arg)
4217 (provide 'byte-compile)
4224 (defvar byte-code-meter)
4225 (defun byte-compile-report-ops ()
4230 (setq n (aref (aref byte-code-meter 0) i)
4236 (cond ((< op byte-nth)
4239 ((>= op byte-constant)
4240 (setq off (- op byte-constant)
4241 op byte-constant)))
4242 (setq op (aref byte-code-vector op))
4255 (or (byte-code-function-p (symbol-function 'byte-compile-form))
4256 (assq 'byte-code (symbol-function 'byte-compile-form))
4257 (let ((byte-optimize nil) ; do it fast
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))))