160 |
|
|
161 |
(or (fboundp 'defsubst) |
(or (fboundp 'defsubst) |
162 |
;; This really ought to be loaded already! |
;; This really ought to be loaded already! |
163 |
(load-library "byte-run")) |
(load "byte-run")) |
164 |
|
|
165 |
;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation |
;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation |
166 |
;; errors; however that file also wants to do (require 'bytecomp) for the |
;; errors; however that file also wants to do (require 'bytecomp) for the |
362 |
(const callargs) (const redefine) |
(const callargs) (const redefine) |
363 |
(const obsolete) (const noruntime) (const cl-functions)))) |
(const obsolete) (const noruntime) (const cl-functions)))) |
364 |
|
|
365 |
|
(defvar byte-compile-not-obsolete-var nil |
366 |
|
"If non-nil, this is a variable that shouldn't be reported as obsolete.") |
367 |
|
|
368 |
(defcustom byte-compile-generate-call-tree nil |
(defcustom byte-compile-generate-call-tree nil |
369 |
"*Non-nil means collect call-graph information when compiling. |
"*Non-nil means collect call-graph information when compiling. |
370 |
This records functions were called and from where. |
This records functions were called and from where. |
418 |
(defvar byte-compile-bound-variables nil |
(defvar byte-compile-bound-variables nil |
419 |
"List of variables bound in the context of the current form. |
"List of variables bound in the context of the current form. |
420 |
This list lives partly on the stack.") |
This list lives partly on the stack.") |
421 |
|
(defvar byte-compile-const-variables nil |
422 |
|
"List of variables declared as constants during compilation of this file.") |
423 |
(defvar byte-compile-free-references) |
(defvar byte-compile-free-references) |
424 |
(defvar byte-compile-free-assignments) |
(defvar byte-compile-free-assignments) |
425 |
|
|
438 |
(cons 'progn body) |
(cons 'progn body) |
439 |
byte-compile-initial-macro-environment)))))) |
byte-compile-initial-macro-environment)))))) |
440 |
(eval-and-compile . (lambda (&rest body) |
(eval-and-compile . (lambda (&rest body) |
441 |
(byte-compile-eval-before-compile (cons 'progn body)) |
(byte-compile-eval-before-compile |
442 |
|
(macroexpand-all |
443 |
|
(cons 'progn body) |
444 |
|
byte-compile-initial-macro-environment)) |
445 |
(cons 'progn body)))) |
(cons 'progn body)))) |
446 |
"The default macro-environment passed to macroexpand by the compiler. |
"The default macro-environment passed to macroexpand by the compiler. |
447 |
Placing a macro here will cause a macro to have different semantics when |
Placing a macro here will cause a macro to have different semantics when |
876 |
(unless (memq s old-autoloads) |
(unless (memq s old-autoloads) |
877 |
(put s 'byte-compile-noruntime t))) |
(put s 'byte-compile-noruntime t))) |
878 |
((and (consp s) (eq t (car s))) |
((and (consp s) (eq t (car s))) |
879 |
(push s old-autoloads)) |
(push (cdr s) old-autoloads)) |
880 |
((and (consp s) (eq 'autoload (car s))) |
((and (consp s) (eq 'autoload (car s))) |
881 |
(put (cdr s) 'byte-compile-noruntime t))))))) |
(put (cdr s) 'byte-compile-noruntime t))))))) |
882 |
;; Go through current-load-list for the locally defined funs. |
;; Go through current-load-list for the locally defined funs. |
886 |
(when (and (symbolp s) (not (memq s old-autoloads))) |
(when (and (symbolp s) (not (memq s old-autoloads))) |
887 |
(put s 'byte-compile-noruntime t)) |
(put s 'byte-compile-noruntime t)) |
888 |
(when (and (consp s) (eq t (car s))) |
(when (and (consp s) (eq t (car s))) |
889 |
(push s old-autoloads)))))))))) |
(push (cdr s) old-autoloads)))))))))) |
890 |
|
|
891 |
(defun byte-compile-eval-before-compile (form) |
(defun byte-compile-eval-before-compile (form) |
892 |
"Evaluate FORM for `eval-and-compile'." |
"Evaluate FORM for `eval-and-compile'." |
1009 |
(when (or (and byte-compile-current-file |
(when (or (and byte-compile-current-file |
1010 |
(not (equal byte-compile-current-file |
(not (equal byte-compile-current-file |
1011 |
byte-compile-last-logged-file))) |
byte-compile-last-logged-file))) |
1012 |
(and byte-compile-last-warned-form |
(and byte-compile-current-form |
1013 |
(not (eq byte-compile-current-form |
(not (eq byte-compile-current-form |
1014 |
byte-compile-last-warned-form)))) |
byte-compile-last-warned-form)))) |
1015 |
(insert (format "\nIn %s:\n" form))) |
(insert (format "\nIn %s:\n" form))) |
1032 |
(and (not (equal byte-compile-current-file byte-compile-last-logged-file)) |
(and (not (equal byte-compile-current-file byte-compile-last-logged-file)) |
1033 |
(not noninteractive) |
(not noninteractive) |
1034 |
(save-excursion |
(save-excursion |
1035 |
(byte-goto-log-buffer) |
(set-buffer (get-buffer-create "*Compile-Log*")) |
1036 |
(goto-char (point-max)) |
(goto-char (point-max)) |
1037 |
(let* ((dir (and byte-compile-current-file |
(let* ((dir (and byte-compile-current-file |
1038 |
(file-name-directory byte-compile-current-file))) |
(file-name-directory byte-compile-current-file))) |
1055 |
(setq default-directory dir) |
(setq default-directory dir) |
1056 |
(unless was-same |
(unless was-same |
1057 |
(insert (format "Entering directory `%s'\n" default-directory)))) |
(insert (format "Entering directory `%s'\n" default-directory)))) |
1058 |
(setq byte-compile-last-logged-file byte-compile-current-file) |
(setq byte-compile-last-logged-file byte-compile-current-file |
1059 |
|
byte-compile-last-warned-form nil) |
1060 |
|
;; Do this after setting default-directory. |
1061 |
|
(unless (eq major-mode 'compilation-mode) |
1062 |
|
(compilation-mode)) |
1063 |
pt)))) |
pt)))) |
1064 |
|
|
1065 |
;; Log a message STRING in *Compile-Log*. |
;; Log a message STRING in *Compile-Log*. |
1066 |
;; Also log the current function and file if not already done. |
;; Also log the current function and file if not already done. |
1067 |
(defun byte-compile-log-warning (string &optional fill level) |
(defun byte-compile-log-warning (string &optional fill level) |
1068 |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
(let ((warning-prefix-function 'byte-compile-warning-prefix) |
1069 |
(warning-group-format "") |
(warning-type-format "") |
1070 |
(warning-fill-prefix (if fill " "))) |
(warning-fill-prefix (if fill " "))) |
1071 |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
(display-warning 'bytecomp string level "*Compile-Log*"))) |
1072 |
|
|
1348 |
;; These would sometimes be warned about |
;; These would sometimes be warned about |
1349 |
;; but such warnings are never useful, |
;; but such warnings are never useful, |
1350 |
;; so don't warn about them. |
;; so don't warn about them. |
1351 |
macroexpand cl-macroexpand-all cl-compiling-file)))) |
macroexpand cl-macroexpand-all |
1352 |
|
cl-compiling-file))) |
1353 |
|
;; Avoid warnings for things which are safe because they |
1354 |
|
;; have suitable compiler macros, but those aren't |
1355 |
|
;; expanded at this stage. There should probably be more |
1356 |
|
;; here than caaar and friends. |
1357 |
|
(not (and (eq (get func 'byte-compile) |
1358 |
|
'cl-byte-compile-compiler-macro) |
1359 |
|
(string-match "\\`c[ad]+r\\'" (symbol-name func))))) |
1360 |
(byte-compile-warn "Function `%s' from cl package called at runtime" |
(byte-compile-warn "Function `%s' from cl package called at runtime" |
1361 |
func))) |
func))) |
1362 |
form) |
form) |
1410 |
nil) |
nil) |
1411 |
|
|
1412 |
|
|
1413 |
(defsubst byte-compile-const-symbol-p (symbol) |
(defsubst byte-compile-const-symbol-p (symbol &optional any-value) |
1414 |
|
"Non-nil if SYMBOL is constant. |
1415 |
|
If ANY-VALUE is nil, only return non-nil if the value of the symbol is the |
1416 |
|
symbol itself." |
1417 |
(or (memq symbol '(nil t)) |
(or (memq symbol '(nil t)) |
1418 |
(keywordp symbol))) |
(keywordp symbol) |
1419 |
|
(if any-value (memq symbol byte-compile-const-variables)))) |
1420 |
|
|
1421 |
(defmacro byte-compile-constp (form) |
(defmacro byte-compile-constp (form) |
1422 |
"Return non-nil if FORM is a constant." |
"Return non-nil if FORM is a constant." |
1436 |
(copy-alist byte-compile-initial-macro-environment)) |
(copy-alist byte-compile-initial-macro-environment)) |
1437 |
(byte-compile-function-environment nil) |
(byte-compile-function-environment nil) |
1438 |
(byte-compile-bound-variables nil) |
(byte-compile-bound-variables nil) |
1439 |
|
(byte-compile-const-variables nil) |
1440 |
(byte-compile-free-references nil) |
(byte-compile-free-references nil) |
1441 |
(byte-compile-free-assignments nil) |
(byte-compile-free-assignments nil) |
1442 |
;; |
;; |
1519 |
(save-some-buffers) |
(save-some-buffers) |
1520 |
(force-mode-line-update)) |
(force-mode-line-update)) |
1521 |
(save-current-buffer |
(save-current-buffer |
1522 |
(byte-goto-log-buffer) |
(set-buffer (get-buffer-create "*Compile-Log*")) |
1523 |
(setq default-directory directory) |
(setq default-directory (expand-file-name directory)) |
1524 |
|
;; compilation-mode copies value of default-directory. |
1525 |
|
(unless (eq major-mode 'compilation-mode) |
1526 |
|
(compilation-mode)) |
1527 |
(let ((directories (list (expand-file-name directory))) |
(let ((directories (list (expand-file-name directory))) |
1528 |
(default-directory default-directory) |
(default-directory default-directory) |
1529 |
(skip-count 0) |
(skip-count 0) |
1637 |
;; unless the file itself forces unibyte with -*-coding: raw-text;-*- |
;; unless the file itself forces unibyte with -*-coding: raw-text;-*- |
1638 |
(set-buffer-multibyte t) |
(set-buffer-multibyte t) |
1639 |
(insert-file-contents filename) |
(insert-file-contents filename) |
1640 |
;; Mimic the way after-insert-file-set-buffer-file-coding-system |
;; Mimic the way after-insert-file-set-coding can make the |
1641 |
;; can make the buffer unibyte when visiting this file. |
;; buffer unibyte when visiting this file. |
1642 |
(when (or (eq last-coding-system-used 'no-conversion) |
(when (or (eq last-coding-system-used 'no-conversion) |
1643 |
(eq (coding-system-type last-coding-system-used) 5)) |
(eq (coding-system-type last-coding-system-used) 5)) |
1644 |
;; For coding systems no-conversion and raw-text..., |
;; For coding systems no-conversion and raw-text..., |
1825 |
(byte-compile-file-form form))) |
(byte-compile-file-form form))) |
1826 |
;; Compile pending forms at end of file. |
;; Compile pending forms at end of file. |
1827 |
(byte-compile-flush-pending) |
(byte-compile-flush-pending) |
1828 |
|
;; Make warnings about unresolved functions |
1829 |
|
;; give the end of the file as their position. |
1830 |
|
(setq byte-compile-last-position (point-max)) |
1831 |
(byte-compile-warn-about-unresolved-functions) |
(byte-compile-warn-about-unresolved-functions) |
1832 |
;; Should we always do this? When calling multiple files, it |
;; Should we always do this? When calling multiple files, it |
1833 |
;; would be useful to delay this warning until all have |
;; would be useful to delay this warning until all have |
1839 |
outbuffer)) |
outbuffer)) |
1840 |
|
|
1841 |
(defun byte-compile-fix-header (filename inbuffer outbuffer) |
(defun byte-compile-fix-header (filename inbuffer outbuffer) |
1842 |
(save-excursion |
(with-current-buffer outbuffer |
|
(set-buffer outbuffer) |
|
1843 |
;; See if the buffer has any multibyte characters. |
;; See if the buffer has any multibyte characters. |
1844 |
(when (< (point-max) (position-bytes (point-max))) |
(when (< (point-max) (position-bytes (point-max))) |
1845 |
(when (byte-compile-version-cond byte-compile-compatibility) |
(when (byte-compile-version-cond byte-compile-compatibility) |
1983 |
(prin1 form outbuffer) |
(prin1 form outbuffer) |
1984 |
nil))) |
nil))) |
1985 |
|
|
1986 |
|
(defvar print-gensym-alist) ;Used before print-circle existed. |
1987 |
|
|
1988 |
(defun byte-compile-output-docform (preface name info form specindex quoted) |
(defun byte-compile-output-docform (preface name info form specindex quoted) |
1989 |
"Print a form with a doc string. INFO is (prefix doc-index postfix). |
"Print a form with a doc string. INFO is (prefix doc-index postfix). |
1990 |
If PREFACE and NAME are non-nil, print them too, |
If PREFACE and NAME are non-nil, print them too, |
2035 |
;; print-gensym-alist not to be cleared |
;; print-gensym-alist not to be cleared |
2036 |
;; between calls to print functions. |
;; between calls to print functions. |
2037 |
(print-gensym '(t)) |
(print-gensym '(t)) |
2038 |
;; print-gensym-alist was used before print-circle existed. |
print-gensym-alist ; was used before print-circle existed. |
|
print-gensym-alist |
|
2039 |
(print-continuous-numbering t) |
(print-continuous-numbering t) |
2040 |
print-number-table |
print-number-table |
2041 |
(index 0)) |
(index 0)) |
2127 |
|
|
2128 |
(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst) |
(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst) |
2129 |
(defun byte-compile-file-form-defsubst (form) |
(defun byte-compile-file-form-defsubst (form) |
2130 |
(cond ((assq (nth 1 form) byte-compile-unresolved-functions) |
(when (assq (nth 1 form) byte-compile-unresolved-functions) |
2131 |
(setq byte-compile-current-form (nth 1 form)) |
(setq byte-compile-current-form (nth 1 form)) |
2132 |
(byte-compile-warn "defsubst %s was used before it was defined" |
(byte-compile-warn "defsubst %s was used before it was defined" |
2133 |
(nth 1 form)))) |
(nth 1 form))) |
2134 |
(byte-compile-file-form form) |
(byte-compile-file-form form) |
2135 |
;; Return nil so the form is not output twice. |
;; Return nil so the form is not output twice. |
2136 |
nil) |
nil) |
2162 |
;; Since there is no doc string, we can compile this as a normal form, |
;; Since there is no doc string, we can compile this as a normal form, |
2163 |
;; and not do a file-boundary. |
;; and not do a file-boundary. |
2164 |
(byte-compile-keep-pending form) |
(byte-compile-keep-pending form) |
2165 |
(if (memq 'free-vars byte-compile-warnings) |
(when (memq 'free-vars byte-compile-warnings) |
2166 |
(setq byte-compile-bound-variables |
(push (nth 1 form) byte-compile-bound-variables) |
2167 |
(cons (nth 1 form) byte-compile-bound-variables))) |
(if (eq (car form) 'defconst) |
2168 |
|
(push (nth 1 form) byte-compile-const-variables))) |
2169 |
(cond ((consp (nth 2 form)) |
(cond ((consp (nth 2 form)) |
2170 |
(setq form (copy-sequence form)) |
(setq form (copy-sequence form)) |
2171 |
(setcar (cdr (cdr form)) |
(setcar (cdr (cdr form)) |
2175 |
(put 'custom-declare-variable 'byte-hunk-handler |
(put 'custom-declare-variable 'byte-hunk-handler |
2176 |
'byte-compile-file-form-custom-declare-variable) |
'byte-compile-file-form-custom-declare-variable) |
2177 |
(defun byte-compile-file-form-custom-declare-variable (form) |
(defun byte-compile-file-form-custom-declare-variable (form) |
2178 |
(if (memq 'free-vars byte-compile-warnings) |
(when (memq 'free-vars byte-compile-warnings) |
2179 |
(setq byte-compile-bound-variables |
(push (nth 1 (nth 1 form)) byte-compile-bound-variables)) |
|
(cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) |
|
2180 |
(let ((tail (nthcdr 4 form))) |
(let ((tail (nthcdr 4 form))) |
2181 |
(while tail |
(while tail |
2182 |
;; If there are any (function (lambda ...)) expressions, compile |
;; If there are any (function (lambda ...)) expressions, compile |
2488 |
(when (symbolp arg) |
(when (symbolp arg) |
2489 |
(byte-compile-set-symbol-position arg)) |
(byte-compile-set-symbol-position arg)) |
2490 |
(cond ((or (not (symbolp arg)) |
(cond ((or (not (symbolp arg)) |
2491 |
(keywordp arg) |
(byte-compile-const-symbol-p arg t)) |
|
(memq arg '(t nil))) |
|
2492 |
(error "Invalid lambda variable %s" arg)) |
(error "Invalid lambda variable %s" arg)) |
2493 |
((eq arg '&rest) |
((eq arg '&rest) |
2494 |
(unless (cdr list) |
(unless (cdr list) |
2528 |
(if (cdr body) |
(if (cdr body) |
2529 |
(setq body (cdr body)))))) |
(setq body (cdr body)))))) |
2530 |
(int (assq 'interactive body))) |
(int (assq 'interactive body))) |
2531 |
(cond (int |
;; Process the interactive spec. |
2532 |
(byte-compile-set-symbol-position 'interactive) |
(when int |
2533 |
;; Skip (interactive) if it is in front (the most usual location). |
(byte-compile-set-symbol-position 'interactive) |
2534 |
(if (eq int (car body)) |
;; Skip (interactive) if it is in front (the most usual location). |
2535 |
(setq body (cdr body))) |
(if (eq int (car body)) |
2536 |
(cond ((consp (cdr int)) |
(setq body (cdr body))) |
2537 |
(if (cdr (cdr int)) |
(cond ((consp (cdr int)) |
2538 |
(byte-compile-warn "malformed interactive spec: %s" |
(if (cdr (cdr int)) |
2539 |
(prin1-to-string int))) |
(byte-compile-warn "malformed interactive spec: %s" |
2540 |
;; If the interactive spec is a call to `list', |
(prin1-to-string int))) |
2541 |
;; don't compile it, because `call-interactively' |
;; If the interactive spec is a call to `list', |
2542 |
;; looks at the args of `list'. |
;; don't compile it, because `call-interactively' |
2543 |
(let ((form (nth 1 int))) |
;; looks at the args of `list'. |
2544 |
(while (memq (car-safe form) '(let let* progn save-excursion)) |
(let ((form (nth 1 int))) |
2545 |
(while (consp (cdr form)) |
(while (memq (car-safe form) '(let let* progn save-excursion)) |
2546 |
(setq form (cdr form))) |
(while (consp (cdr form)) |
2547 |
(setq form (car form))) |
(setq form (cdr form))) |
2548 |
(or (eq (car-safe form) 'list) |
(setq form (car form))) |
2549 |
(setq int (list 'interactive |
(or (eq (car-safe form) 'list) |
2550 |
(byte-compile-top-level (nth 1 int))))))) |
(setq int (list 'interactive |
2551 |
((cdr int) |
(byte-compile-top-level (nth 1 int))))))) |
2552 |
(byte-compile-warn "malformed interactive spec: %s" |
((cdr int) |
2553 |
(prin1-to-string int)))))) |
(byte-compile-warn "malformed interactive spec: %s" |
2554 |
|
(prin1-to-string int))))) |
2555 |
|
;; Process the body. |
2556 |
(let* ((byte-compile-lexical-environment |
(let* ((byte-compile-lexical-environment |
2557 |
;; If doing lexical binding, push a new lexical environment |
;; If doing lexical binding, push a new lexical environment |
2558 |
;; containing the args and any closed-over variables. |
;; containing the args and any closed-over variables. |
2571 |
(byte-compile-current-num-closures 0) |
(byte-compile-current-num-closures 0) |
2572 |
(compiled |
(compiled |
2573 |
(byte-compile-top-level (cons 'progn body) nil 'lambda))) |
(byte-compile-top-level (cons 'progn body) nil 'lambda))) |
2574 |
|
;; Build the actual byte-coded function. |
2575 |
(if (and (eq 'byte-code (car-safe compiled)) |
(if (and (eq 'byte-code (car-safe compiled)) |
2576 |
(not (byte-compile-version-cond |
(not (byte-compile-version-cond |
2577 |
byte-compile-compatibility))) |
byte-compile-compatibility))) |
2858 |
(if (symbolp var) "constant" "nonvariable") |
(if (symbolp var) "constant" "nonvariable") |
2859 |
(prin1-to-string var))) |
(prin1-to-string var))) |
2860 |
((and (get var 'byte-obsolete-variable) |
((and (get var 'byte-obsolete-variable) |
2861 |
(memq 'obsolete byte-compile-warnings)) |
(memq 'obsolete byte-compile-warnings) |
2862 |
|
(not (eq var byte-compile-not-obsolete-var))) |
2863 |
(let* ((ob (get var 'byte-obsolete-variable)) |
(let* ((ob (get var 'byte-obsolete-variable)) |
2864 |
(when (cdr ob))) |
(when (cdr ob))) |
2865 |
(byte-compile-warn "%s is an obsolete variable%s; %s" var |
(byte-compile-warn "%s is an obsolete variable%s; %s" var |
2870 |
|
|
2871 |
(defsubst byte-compile-dynamic-variable-op (base-op var) |
(defsubst byte-compile-dynamic-variable-op (base-op var) |
2872 |
(let ((tmp (assq var byte-compile-variables))) |
(let ((tmp (assq var byte-compile-variables))) |
2873 |
(or tmp |
(unless tmp |
2874 |
(setq tmp (list var) |
(setq tmp (list var)) |
2875 |
byte-compile-variables (cons tmp byte-compile-variables))) |
(push tmp byte-compile-variables)) |
2876 |
(byte-compile-out base-op tmp))) |
(byte-compile-out base-op tmp))) |
2877 |
|
|
2878 |
(defun byte-compile-dynamic-variable-bind (var) |
(defun byte-compile-dynamic-variable-bind (var) |
2993 |
;; If function is a symbol, then the variable "byte-SYMBOL" must name |
;; If function is a symbol, then the variable "byte-SYMBOL" must name |
2994 |
;; the opcode to be used. If function is a list, the first element |
;; the opcode to be used. If function is a list, the first element |
2995 |
;; is the function and the second element is the bytecode-symbol. |
;; is the function and the second element is the bytecode-symbol. |
2996 |
|
;; The second element may be nil, meaning there is no opcode. |
2997 |
;; COMPILE-HANDLER is the function to use to compile this byte-op, or |
;; COMPILE-HANDLER is the function to use to compile this byte-op, or |
2998 |
;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2. |
;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2. |
2999 |
;; If it is nil, then the handler is "byte-compile-SYMBOL." |
;; If it is nil, then the handler is "byte-compile-SYMBOL." |
3255 |
(setq args (cdr args)) |
(setq args (cdr args)) |
3256 |
(or args (setq args '(0) |
(or args (setq args '(0) |
3257 |
opcode (get '+ 'byte-opcode))) |
opcode (get '+ 'byte-opcode))) |
3258 |
(while args |
(dolist (arg args) |
3259 |
(byte-compile-form (car args)) |
(byte-compile-form arg) |
3260 |
(byte-compile-out opcode 0) |
(byte-compile-out opcode 0))) |
|
(setq args (cdr args)))) |
|
3261 |
(byte-compile-constant (eval form)))) |
(byte-compile-constant (eval form)))) |
3262 |
|
|
3263 |
|
|
3458 |
(byte-defop-compiler-1 or) |
(byte-defop-compiler-1 or) |
3459 |
(byte-defop-compiler-1 while) |
(byte-defop-compiler-1 while) |
3460 |
(byte-defop-compiler-1 funcall) |
(byte-defop-compiler-1 funcall) |
|
(byte-defop-compiler-1 apply byte-compile-funarg) |
|
|
(byte-defop-compiler-1 mapcar byte-compile-funarg) |
|
|
(byte-defop-compiler-1 mapatoms byte-compile-funarg) |
|
|
(byte-defop-compiler-1 mapconcat byte-compile-funarg) |
|
|
(byte-defop-compiler-1 mapc byte-compile-funarg) |
|
|
(byte-defop-compiler-1 maphash byte-compile-funarg) |
|
|
(byte-defop-compiler-1 map-char-table byte-compile-funarg) |
|
|
(byte-defop-compiler-1 sort byte-compile-funarg-2) |
|
3461 |
(byte-defop-compiler-1 let) |
(byte-defop-compiler-1 let) |
3462 |
(byte-defop-compiler-1 let*) |
(byte-defop-compiler-1 let*) |
3463 |
|
|
3767 |
|
|
3768 |
(defun byte-compile-track-mouse (form) |
(defun byte-compile-track-mouse (form) |
3769 |
(byte-compile-form |
(byte-compile-form |
3770 |
(list |
`(funcall '(lambda nil |
3771 |
'funcall |
(track-mouse ,@(byte-compile-top-level-body (cdr form))))))) |
|
(list 'quote |
|
|
(list 'lambda nil |
|
|
(cons 'track-mouse |
|
|
(byte-compile-top-level-body (cdr form)))))))) |
|
3772 |
|
|
3773 |
(defun byte-compile-condition-case (form) |
(defun byte-compile-condition-case (form) |
3774 |
(let* ((var (nth 1 form)) |
(let* ((var (nth 1 form)) |
3840 |
(byte-compile-out 'byte-temp-output-buffer-setup 0) |
(byte-compile-out 'byte-temp-output-buffer-setup 0) |
3841 |
(byte-compile-body (cdr (cdr form))) |
(byte-compile-body (cdr (cdr form))) |
3842 |
(byte-compile-out 'byte-temp-output-buffer-show 0)) |
(byte-compile-out 'byte-temp-output-buffer-show 0)) |
|
|
|
3843 |
|
|
3844 |
;;; top-level forms elsewhere |
;;; top-level forms elsewhere |
3845 |
|
|
3858 |
(byte-compile-set-symbol-position 'defun) |
(byte-compile-set-symbol-position 'defun) |
3859 |
(error "defun name must be a symbol, not %s" (car form))) |
(error "defun name must be a symbol, not %s" (car form))) |
3860 |
(let ((for-effect nil)) |
(let ((for-effect nil)) |
3861 |
|
(byte-compile-push-constant 'defalias) |
3862 |
(byte-compile-push-constant (nth 1 form)) |
(byte-compile-push-constant (nth 1 form)) |
3863 |
(byte-compile-closure (cons 'lambda (cdr (cdr form)))) |
(byte-compile-closure (cons 'lambda (cdr (cdr form))))) |
3864 |
(byte-compile-out 'byte-fset) |
(byte-compile-out 'byte-call 2)) |
|
(byte-compile-discard)) |
|
|
(byte-compile-constant (nth 1 form))) |
|
3865 |
|
|
3866 |
(defun byte-compile-defmacro (form) |
(defun byte-compile-defmacro (form) |
3867 |
;; This is not used for file-level defmacros with doc strings. |
;; This is not used for file-level defmacros with doc strings. |
3885 |
(value (nth 2 form)) |
(value (nth 2 form)) |
3886 |
(string (nth 3 form))) |
(string (nth 3 form))) |
3887 |
(byte-compile-set-symbol-position fun) |
(byte-compile-set-symbol-position fun) |
3888 |
(when (> (length form) 4) |
(when (or (> (length form) 4) |
3889 |
(byte-compile-warn |
(and (eq fun 'defconst) (null (cddr form)))) |
3890 |
"%s %s called with %d arguments, but accepts only %s" |
(let ((ncall (length (cdr form)))) |
3891 |
fun var (length (cdr form)) 3)) |
(byte-compile-warn |
3892 |
|
"%s called with %d argument%s, but %s %s" |
3893 |
|
fun ncall |
3894 |
|
(if (= 1 ncall) "" "s") |
3895 |
|
(if (< ncall 2) "requires" "accepts only") |
3896 |
|
"2-3"))) |
3897 |
(when (memq 'free-vars byte-compile-warnings) |
(when (memq 'free-vars byte-compile-warnings) |
3898 |
(setq byte-compile-bound-variables |
(push var byte-compile-bound-variables) |
3899 |
(cons var byte-compile-bound-variables))) |
(if (eq fun 'defconst) |
3900 |
|
(push var byte-compile-const-variables))) |
3901 |
(byte-compile-body-do-effect |
(byte-compile-body-do-effect |
3902 |
(list |
(list |
3903 |
;; Put the defined variable in this library's load-history entry |
;; Put the defined variable in this library's load-history entry |
3910 |
fun var string)) |
fun var string)) |
3911 |
`(put ',var 'variable-documentation ,string)) |
`(put ',var 'variable-documentation ,string)) |
3912 |
(if (cddr form) ; `value' provided |
(if (cddr form) ; `value' provided |
3913 |
(if (eq fun 'defconst) |
(let ((byte-compile-not-obsolete-var var)) |
3914 |
;; `defconst' sets `var' unconditionally. |
(if (eq fun 'defconst) |
3915 |
(let ((tmp (make-symbol "defconst-tmp-var"))) |
;; `defconst' sets `var' unconditionally. |
3916 |
`(let ((,tmp ,value)) |
(let ((tmp (make-symbol "defconst-tmp-var"))) |
3917 |
(eval '(defconst ,var ,tmp)))) |
`(funcall '(lambda (,tmp) (defconst ,var ,tmp)) |
3918 |
;; `defvar' sets `var' only when unbound. |
,value)) |
3919 |
`(if (not (boundp ',var)) (setq ,var ,value)))) |
;; `defvar' sets `var' only when unbound. |
3920 |
|
`(if (not (default-boundp ',var)) (setq-default ,var ,value)))) |
3921 |
|
(when (eq fun 'defconst) |
3922 |
|
;; This will signal an appropriate error at runtime. |
3923 |
|
`(eval ',form))) |
3924 |
`',var)))) |
`',var)))) |
3925 |
|
|
3926 |
(defun byte-compile-autoload (form) |
(defun byte-compile-autoload (form) |
3953 |
(consp (cdr (nth 2 form))) |
(consp (cdr (nth 2 form))) |
3954 |
(symbolp (nth 1 (nth 2 form)))) |
(symbolp (nth 1 (nth 2 form)))) |
3955 |
(progn |
(progn |
3956 |
(byte-compile-defalias-warn (nth 1 (nth 1 form)) |
(byte-compile-defalias-warn (nth 1 (nth 1 form))) |
|
(nth 1 (nth 2 form))) |
|
3957 |
(setq byte-compile-function-environment |
(setq byte-compile-function-environment |
3958 |
(cons (cons (nth 1 (nth 1 form)) |
(cons (cons (nth 1 (nth 1 form)) |
3959 |
(nth 1 (nth 2 form))) |
(nth 1 (nth 2 form))) |
3963 |
;; Turn off warnings about prior calls to the function being defalias'd. |
;; Turn off warnings about prior calls to the function being defalias'd. |
3964 |
;; This could be smarter and compare those calls with |
;; This could be smarter and compare those calls with |
3965 |
;; the function it is being aliased to. |
;; the function it is being aliased to. |
3966 |
(defun byte-compile-defalias-warn (new alias) |
(defun byte-compile-defalias-warn (new) |
3967 |
(let ((calls (assq new byte-compile-unresolved-functions))) |
(let ((calls (assq new byte-compile-unresolved-functions))) |
3968 |
(if calls |
(if calls |
3969 |
(setq byte-compile-unresolved-functions |
(setq byte-compile-unresolved-functions |
3970 |
(delq calls byte-compile-unresolved-functions))))) |
(delq calls byte-compile-unresolved-functions))))) |
3971 |
|
|
3972 |
|
(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings) |
3973 |
|
(defun byte-compile-no-warnings (form) |
3974 |
|
(let (byte-compile-warnings) |
3975 |
|
(byte-compile-form (cadr form)))) |
3976 |
|
|
3977 |
;;; tags |
;;; tags |
3978 |
|
|
3995 |
(setcdr (cdr tag) byte-compile-depth))) |
(setcdr (cdr tag) byte-compile-depth))) |
3996 |
|
|
3997 |
(defun byte-compile-goto (opcode tag) |
(defun byte-compile-goto (opcode tag) |
3998 |
(setq byte-compile-output (cons (cons opcode tag) byte-compile-output)) |
(push (cons opcode tag) byte-compile-output) |
3999 |
(setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops) |
(setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops) |
4000 |
(1- byte-compile-depth) |
(1- byte-compile-depth) |
4001 |
byte-compile-depth)) |
byte-compile-depth)) |
4338 |
|
|
4339 |
;;; report metering (see the hacks in bytecode.c) |
;;; report metering (see the hacks in bytecode.c) |
4340 |
|
|
4341 |
|
(defvar byte-code-meter) |
4342 |
(defun byte-compile-report-ops () |
(defun byte-compile-report-ops () |
|
(defvar byte-code-meter) |
|
4343 |
(with-output-to-temp-buffer "*Meter*" |
(with-output-to-temp-buffer "*Meter*" |
4344 |
(set-buffer "*Meter*") |
(set-buffer "*Meter*") |
4345 |
(let ((i 0) n op off) |
(let ((i 0) n op off) |
4388 |
|
|
4389 |
(run-hooks 'bytecomp-load-hook) |
(run-hooks 'bytecomp-load-hook) |
4390 |
|
|
4391 |
|
;;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a |
4392 |
;;; bytecomp.el ends here |
;;; bytecomp.el ends here |