;;; Code:
-;; FIXME: get rid of the atrocious "bytecomp-" variable prefix.
-
;; ========================================================================
;; Entry points:
;; byte-recompile-directory, byte-compile-file,
;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
-(defmacro byte-compile-single-version () nil)
-(defmacro byte-compile-version-cond (cond) cond)
-
-
(defgroup bytecomp nil
"Emacs Lisp byte-compiler."
:group 'lisp)
:type '(choice (const name) (const callers) (const calls)
(const calls+callers) (const nil)))
-(defvar byte-compile-debug t)
-(setq debug-on-error t)
-
+(defvar byte-compile-debug nil)
(defvar byte-compile-constants nil
"List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
but won't necessarily be defined when the compiled file is loaded.")
;; Variables for lexical binding
-(defvar byte-compile-lexical-environment nil
+(defvar byte-compile--lexical-environment nil
"The current lexical environment.")
(defvar byte-compile-tag-number 0)
(byte-defop 114 0 byte-save-current-buffer
"To make a binding to record the current buffer")
(byte-defop 115 0 byte-set-mark-OBSOLETE)
+(byte-defop 116 1 byte-interactive-p-OBSOLETE)
;; These ops are new to v19
(byte-defop 117 0 byte-forward-char)
(byte-defop 138 0 byte-save-excursion
"to make a binding to record the buffer, point and mark")
+(byte-defop 139 0 byte-save-window-excursion-OBSOLETE
+ "to make a binding to record entire window configuration")
(byte-defop 140 0 byte-save-restriction
"to make a binding to record the current buffer clipping restrictions")
(byte-defop 141 -1 byte-catch
;; an expression for the body, and a list of clauses.
(byte-defop 143 -2 byte-condition-case)
-;; For entry to with-output-to-temp-buffer.
-;; Takes, on stack, the buffer name.
-;; Binds standard-output and does some other things.
-;; Returns with temp buffer on the stack in place of buffer name.
-;; (byte-defop 144 0 byte-temp-output-buffer-setup)
-
-;; For exit from with-output-to-temp-buffer.
-;; Expects the temp buffer on the stack underneath value to return.
-;; Pops them both, then pushes the value back on.
-;; Unbinds standard-output and makes the temp buffer visible.
-;; (byte-defop 145 -1 byte-temp-output-buffer-show)
+(byte-defop 144 0 byte-temp-output-buffer-setup-OBSOLETE)
+(byte-defop 145 -1 byte-temp-output-buffer-show-OBSOLETE)
;; these ops are new to v19
(byte-defop 168 0 byte-integerp)
;; unused: 169-174
-
(byte-defop 175 nil byte-listN)
(byte-defop 176 nil byte-concatN)
(byte-defop 177 nil byte-insertN)
-(byte-defop 178 -1 byte-stack-set) ; stack offset in following one byte
-(byte-defop 179 -1 byte-stack-set2) ; stack offset in following two bytes
+(byte-defop 178 -1 byte-stack-set) ; Stack offset in following one byte.
+(byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes.
-;; if (following one byte & 0x80) == 0
+;; If (following one byte & 0x80) == 0
;; discard (following one byte & 0x7F) stack entries
;; else
;; discard (following one byte & 0x7F) stack entries _underneath_ TOS
(error "Non-symbolic opcode `%s'" op))
((eq op 'TAG)
(setcar off pc))
- ((null op)
- ;; a no-op added by `byte-compile-delay-out'
- (unless (zerop off)
- (error
- "Placeholder added by `byte-compile-delay-out' not filled in.")
- ))
(t
(setq opcode
(if (eq op 'byte-discardN-preserve-tos)
(cond ((memq op byte-goto-ops)
;; goto
(byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
- (push bytes patchlist))
+ (push bytes patchlist))
((or (and (consp off)
;; Variable or constant reference
(progn
(setq off (cdr off))
(eq op 'byte-constant)))
- (and (eq op 'byte-constant) ;; 'byte-closed-var
+ (and (eq op 'byte-constant)
(integerp off)))
;; constant ref
(if (< off byte-constant-limit)
bytes pc))))))
;;(if (not (= pc (length bytes)))
;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
-
- ;; Patch tag PCs into absolute jumps
+ ;; Patch tag PCs into absolute jumps.
(dolist (bytes-tail patchlist)
- (setq pc (caar bytes-tail)) ; Pick PC from goto's tag
+ (setq pc (caar bytes-tail)) ; Pick PC from goto's tag.
(setcar (cdr bytes-tail) (logand pc 255))
(setcar bytes-tail (lsh pc -8))
;; FIXME: Replace this by some workaround.
;; number of arguments.
(defun byte-compile-arglist-warn (form macrop)
(let* ((name (nth 1 form))
- (old (byte-compile-fdefinition name macrop)))
+ (old (byte-compile-fdefinition name macrop))
+ (initial (and macrop
+ (cdr (assq name
+ byte-compile-initial-macro-environment)))))
+ ;; Assumes an element of b-c-i-macro-env that is a symbol points
+ ;; to a defined function. (Bug#8646)
+ (and initial (symbolp initial)
+ (setq old (byte-compile-fdefinition initial nil)))
(if (and old (not (eq old t)))
(progn
(and (eq 'macro (car-safe old))
(let ((sig1 (byte-compile-arglist-signature
(pcase old
(`(lambda ,args . ,_) args)
- (`(closure ,_ ,_ ,args . ,_) args)
+ (`(closure ,_ ,args . ,_) args)
((pred byte-code-function-p) (aref old 0))
(t '(&rest def)))))
(sig2 (byte-compile-arglist-signature (nth 2 form))))
(interactive "DByte force recompile (directory): ")
(byte-recompile-directory directory nil t))
-;; The `bytecomp-' prefix is applied to all local variables with
-;; otherwise common names in this and similar functions for the sake
-;; of the boundp test in byte-compile-variable-ref.
-;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html
-;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html
-;; Note that similar considerations apply to command-line-1 in startup.el.
;;;###autoload
-(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg
- bytecomp-force)
- "Recompile every `.el' file in BYTECOMP-DIRECTORY that needs recompilation.
+(defun byte-recompile-directory (directory &optional arg force)
+ "Recompile every `.el' file in DIRECTORY that needs recompilation.
This happens when a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of BYTECOMP-DIRECTORY are processed also.
+Files in subdirectories of DIRECTORY are processed also.
If the `.elc' file does not exist, normally this function *does not*
compile the corresponding `.el' file. However, if the prefix argument
-BYTECOMP-ARG is 0, that means do compile all those files. A nonzero
-BYTECOMP-ARG means ask the user, for each such `.el' file, whether to
-compile it. A nonzero BYTECOMP-ARG also means ask about each subdirectory
+ARG is 0, that means do compile all those files. A nonzero
+ARG means ask the user, for each such `.el' file, whether to
+compile it. A nonzero ARG also means ask about each subdirectory
before scanning it.
-If the third argument BYTECOMP-FORCE is non-nil, recompile every `.el' file
+If the third argument FORCE is non-nil, recompile every `.el' file
that already has a `.elc' file."
(interactive "DByte recompile directory: \nP")
- (if bytecomp-arg
- (setq bytecomp-arg (prefix-numeric-value bytecomp-arg)))
+ (if arg (setq arg (prefix-numeric-value arg)))
(if noninteractive
nil
(save-some-buffers)
(force-mode-line-update))
(with-current-buffer (get-buffer-create byte-compile-log-buffer)
- (setq default-directory (expand-file-name bytecomp-directory))
+ (setq default-directory (expand-file-name directory))
;; compilation-mode copies value of default-directory.
(unless (eq major-mode 'compilation-mode)
(compilation-mode))
- (let ((bytecomp-directories (list default-directory))
+ (let ((directories (list default-directory))
(default-directory default-directory)
(skip-count 0)
(fail-count 0)
(dir-count 0)
last-dir)
(displaying-byte-compile-warnings
- (while bytecomp-directories
- (setq bytecomp-directory (car bytecomp-directories))
- (message "Checking %s..." bytecomp-directory)
- (let ((bytecomp-files (directory-files bytecomp-directory))
- bytecomp-source)
- (dolist (bytecomp-file bytecomp-files)
- (setq bytecomp-source
- (expand-file-name bytecomp-file bytecomp-directory))
- (if (and (not (member bytecomp-file '("RCS" "CVS")))
- (not (eq ?\. (aref bytecomp-file 0)))
- (file-directory-p bytecomp-source)
- (not (file-symlink-p bytecomp-source)))
- ;; This file is a subdirectory. Handle them differently.
- (when (or (null bytecomp-arg)
- (eq 0 bytecomp-arg)
- (y-or-n-p (concat "Check " bytecomp-source "? ")))
- (setq bytecomp-directories
- (nconc bytecomp-directories (list bytecomp-source))))
- ;; It is an ordinary file. Decide whether to compile it.
- (if (and (string-match emacs-lisp-file-regexp bytecomp-source)
- (file-readable-p bytecomp-source)
- (not (auto-save-file-name-p bytecomp-source))
- (not (string-equal dir-locals-file
- (file-name-nondirectory
- bytecomp-source))))
- (progn (let ((bytecomp-res (byte-recompile-file
- bytecomp-source
- bytecomp-force bytecomp-arg)))
- (cond ((eq bytecomp-res 'no-byte-compile)
- (setq skip-count (1+ skip-count)))
- ((eq bytecomp-res t)
- (setq file-count (1+ file-count)))
- ((eq bytecomp-res nil)
- (setq fail-count (1+ fail-count)))))
- (or noninteractive
- (message "Checking %s..." bytecomp-directory))
- (if (not (eq last-dir bytecomp-directory))
- (setq last-dir bytecomp-directory
- dir-count (1+ dir-count)))
- )))))
- (setq bytecomp-directories (cdr bytecomp-directories))))
+ (while directories
+ (setq directory (car directories))
+ (message "Checking %s..." directory)
+ (dolist (file (directory-files directory))
+ (let ((source (expand-file-name file directory)))
+ (if (and (not (member file '("RCS" "CVS")))
+ (not (eq ?\. (aref file 0)))
+ (file-directory-p source)
+ (not (file-symlink-p source)))
+ ;; This file is a subdirectory. Handle them differently.
+ (when (or (null arg) (eq 0 arg)
+ (y-or-n-p (concat "Check " source "? ")))
+ (setq directories (nconc directories (list source))))
+ ;; It is an ordinary file. Decide whether to compile it.
+ (if (and (string-match emacs-lisp-file-regexp source)
+ (file-readable-p source)
+ (not (auto-save-file-name-p source))
+ (not (string-equal dir-locals-file
+ (file-name-nondirectory source))))
+ (progn (case (byte-recompile-file source force arg)
+ (no-byte-compile (setq skip-count (1+ skip-count)))
+ ((t) (setq file-count (1+ file-count)))
+ ((nil) (setq fail-count (1+ fail-count))))
+ (or noninteractive
+ (message "Checking %s..." directory))
+ (if (not (eq last-dir directory))
+ (setq last-dir directory
+ dir-count (1+ dir-count)))
+ )))))
+ (setq directories (cdr directories))))
(message "Done (Total of %d file%s compiled%s%s%s)"
file-count (if (= file-count 1) "" "s")
(if (> fail-count 0) (format ", %d failed" fail-count) "")
\;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;Backslash for compile-main.
;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
-(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load)
- "Recompile BYTECOMP-FILENAME file if it needs recompilation.
+(defun byte-recompile-file (filename &optional force arg load)
+ "Recompile FILENAME file if it needs recompilation.
This happens when its `.elc' file is older than itself.
If the `.elc' file exists and is up-to-date, normally this
-function *does not* compile BYTECOMP-FILENAME. However, if the
-prefix argument BYTECOMP-FORCE is set, that means do compile
-BYTECOMP-FILENAME even if the destination already exists and is
+function *does not* compile FILENAME. However, if the
+prefix argument FORCE is set, that means do compile
+FILENAME even if the destination already exists and is
up-to-date.
If the `.elc' file does not exist, normally this function *does
-not* compile BYTECOMP-FILENAME. If BYTECOMP-ARG is 0, that means
+not* compile FILENAME. If ARG is 0, that means
compile the file even if it has never been compiled before.
-A nonzero BYTECOMP-ARG means ask the user.
+A nonzero ARG means ask the user.
If LOAD is set, `load' the file after compiling.
The value returned is the value returned by `byte-compile-file',
or 'no-byte-compile if the file did not need recompilation."
(interactive
- (let ((bytecomp-file buffer-file-name)
- (bytecomp-file-name nil)
- (bytecomp-file-dir nil))
- (and bytecomp-file
- (eq (cdr (assq 'major-mode (buffer-local-variables)))
- 'emacs-lisp-mode)
- (setq bytecomp-file-name (file-name-nondirectory bytecomp-file)
- bytecomp-file-dir (file-name-directory bytecomp-file)))
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
+ (derived-mode-p 'emacs-lisp-mode)
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
(list (read-file-name (if current-prefix-arg
"Byte compile file: "
"Byte recompile file: ")
- bytecomp-file-dir bytecomp-file-name nil)
+ file-dir file-name nil)
current-prefix-arg)))
- (let ((bytecomp-dest
- (byte-compile-dest-file bytecomp-filename))
+ (let ((dest (byte-compile-dest-file filename))
;; Expand now so we get the current buffer's defaults
- (bytecomp-filename (expand-file-name bytecomp-filename)))
- (if (if (file-exists-p bytecomp-dest)
+ (filename (expand-file-name filename)))
+ (if (if (file-exists-p dest)
;; File was already compiled
;; Compile if forced to, or filename newer
- (or bytecomp-force
- (file-newer-than-file-p bytecomp-filename
- bytecomp-dest))
- (and bytecomp-arg
- (or (eq 0 bytecomp-arg)
+ (or force
+ (file-newer-than-file-p filename dest))
+ (and arg
+ (or (eq 0 arg)
(y-or-n-p (concat "Compile "
- bytecomp-filename "? ")))))
+ filename "? ")))))
(progn
(if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." bytecomp-filename))
- (byte-compile-file bytecomp-filename load))
- (when load (load bytecomp-filename))
+ (message "Compiling %s..." filename))
+ (byte-compile-file filename load))
+ (when load (load filename))
'no-byte-compile)))
;;;###autoload
-(defun byte-compile-file (bytecomp-filename &optional load)
- "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code.
-The output file's name is generated by passing BYTECOMP-FILENAME to the
+(defun byte-compile-file (filename &optional load)
+ "Compile a file of Lisp code named FILENAME into a file of byte code.
+The output file's name is generated by passing FILENAME to the
function `byte-compile-dest-file' (which see).
With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling.
The value is non-nil if there were no errors, nil if errors."
;; (interactive "fByte compile file: \nP")
(interactive
- (let ((bytecomp-file buffer-file-name)
- (bytecomp-file-name nil)
- (bytecomp-file-dir nil))
- (and bytecomp-file
+ (let ((file buffer-file-name)
+ (file-name nil)
+ (file-dir nil))
+ (and file
(derived-mode-p 'emacs-lisp-mode)
- (setq bytecomp-file-name (file-name-nondirectory bytecomp-file)
- bytecomp-file-dir (file-name-directory bytecomp-file)))
+ (setq file-name (file-name-nondirectory file)
+ file-dir (file-name-directory file)))
(list (read-file-name (if current-prefix-arg
"Byte compile and load file: "
"Byte compile file: ")
- bytecomp-file-dir bytecomp-file-name nil)
+ file-dir file-name nil)
current-prefix-arg)))
;; Expand now so we get the current buffer's defaults
- (setq bytecomp-filename (expand-file-name bytecomp-filename))
+ (setq filename (expand-file-name filename))
;; If we're compiling a file that's in a buffer and is modified, offer
;; to save it first.
(or noninteractive
- (let ((b (get-file-buffer (expand-file-name bytecomp-filename))))
+ (let ((b (get-file-buffer (expand-file-name filename))))
(if (and b (buffer-modified-p b)
(y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(with-current-buffer b (save-buffer)))))
;; Force logging of the file name for each file compiled.
(setq byte-compile-last-logged-file nil)
- (let ((byte-compile-current-file bytecomp-filename)
+ (let ((byte-compile-current-file filename)
(byte-compile-current-group nil)
(set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
- (setq target-file (byte-compile-dest-file bytecomp-filename))
+ (setq target-file (byte-compile-dest-file filename))
(setq byte-compile-dest-file target-file)
(with-current-buffer
(setq input-buffer (get-buffer-create " *Compiler Input*"))
;; Always compile an Emacs Lisp file as multibyte
;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
(set-buffer-multibyte t)
- (insert-file-contents bytecomp-filename)
+ (insert-file-contents filename)
;; Mimic the way after-insert-file-set-coding can make the
;; buffer unibyte when visiting this file.
(when (or (eq last-coding-system-used 'no-conversion)
(set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
- (letf ((buffer-file-name bytecomp-filename)
+ (letf ((buffer-file-name filename)
((default-value 'major-mode) 'emacs-lisp-mode)
;; Ignore unsafe local variables.
;; We only care about a few of them for our purposes.
(enable-local-eval nil))
;; Arg of t means don't alter enable-local-variables.
(normal-mode t)
- (setq bytecomp-filename buffer-file-name))
+ (setq filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
- (setq default-directory (file-name-directory bytecomp-filename)))
+ (setq default-directory (file-name-directory filename)))
;; Check if the file's local variables explicitly specify not to
;; compile this file.
(if (with-current-buffer input-buffer no-byte-compile)
(progn
;; (message "%s not compiled because of `no-byte-compile: %s'"
- ;; (file-relative-name bytecomp-filename)
+ ;; (file-relative-name filename)
;; (with-current-buffer input-buffer no-byte-compile))
(when (file-exists-p target-file)
(message "%s deleted because of `no-byte-compile: %s'"
;; We successfully didn't compile this file.
'no-byte-compile)
(when byte-compile-verbose
- (message "Compiling %s..." bytecomp-filename))
+ (message "Compiling %s..." filename))
(setq byte-compiler-error-flag nil)
;; It is important that input-buffer not be current at this call,
;; so that the value of point set in input-buffer
(if byte-compiler-error-flag
nil
(when byte-compile-verbose
- (message "Compiling %s...done" bytecomp-filename))
+ (message "Compiling %s...done" filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
(if (and byte-compile-generate-call-tree
(or (eq t byte-compile-generate-call-tree)
(y-or-n-p (format "Report call tree for %s? "
- bytecomp-filename))))
+ filename))))
(save-excursion
- (display-call-tree bytecomp-filename)))
+ (display-call-tree filename)))
(if load
(load target-file))
t))))
;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
-(defvar bytecomp-outbuffer)
+(defvar byte-compile--outbuffer)
-(defun byte-compile-from-buffer (bytecomp-inbuffer)
- (let (bytecomp-outbuffer
- (byte-compile-current-buffer bytecomp-inbuffer)
+(defun byte-compile-from-buffer (inbuffer)
+ (let (byte-compile--outbuffer
+ (byte-compile-current-buffer inbuffer)
(byte-compile-read-position nil)
(byte-compile-last-position nil)
;; Prevent truncation of flonums and lists as we read and print them
(byte-compile-output nil)
;; This allows us to get the positions of symbols read; it's
;; new in Emacs 22.1.
- (read-with-symbol-positions bytecomp-inbuffer)
+ (read-with-symbol-positions inbuffer)
(read-symbol-positions-list nil)
;; #### This is bound in b-c-close-variables.
;; (byte-compile-warnings byte-compile-warnings)
)
(byte-compile-close-variables
(with-current-buffer
- (setq bytecomp-outbuffer (get-buffer-create " *Compiler Output*"))
+ (setq byte-compile--outbuffer
+ (get-buffer-create " *Compiler Output*"))
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
(setq case-fold-search nil))
(displaying-byte-compile-warnings
- (with-current-buffer bytecomp-inbuffer
+ (with-current-buffer inbuffer
(and byte-compile-current-file
(byte-compile-insert-header byte-compile-current-file
- bytecomp-outbuffer))
+ byte-compile--outbuffer))
(goto-char (point-min))
;; Should we always do this? When calling multiple files, it
;; would be useful to delay this warning until all have been
(setq byte-compile-read-position (point)
byte-compile-last-position byte-compile-read-position)
(let* ((old-style-backquotes nil)
- (form (read bytecomp-inbuffer)))
+ (form (read inbuffer)))
;; Warn about the use of old-style backquotes.
(when old-style-backquotes
(byte-compile-warn "!! The file uses old-style backquotes !!
;; Fix up the header at the front of the output
;; if the buffer contains multibyte characters.
(and byte-compile-current-file
- (with-current-buffer bytecomp-outbuffer
+ (with-current-buffer byte-compile--outbuffer
(byte-compile-fix-header byte-compile-current-file)))))
- bytecomp-outbuffer))
+ byte-compile--outbuffer))
(defun byte-compile-fix-header (filename)
"If the current buffer has any multibyte characters, insert a version test."
(print-gensym t)
(print-circle ; handle circular data structures
(not byte-compile-disable-print-circle)))
- (princ "\n" bytecomp-outbuffer)
- (prin1 form bytecomp-outbuffer)
+ (princ "\n" byte-compile--outbuffer)
+ (prin1 form byte-compile--outbuffer)
nil)))
(defvar print-gensym-alist) ;Used before print-circle existed.
;; We need to examine byte-compile-dynamic-docstrings
;; in the input buffer (now current), not in the output buffer.
(let ((dynamic-docstrings byte-compile-dynamic-docstrings))
- (with-current-buffer bytecomp-outbuffer
+ (with-current-buffer byte-compile--outbuffer
(let (position)
;; Insert the doc string, and make it a comment with #@LENGTH.
(if preface
(progn
(insert preface)
- (prin1 name bytecomp-outbuffer)))
+ (prin1 name byte-compile--outbuffer)))
(insert (car info))
(let ((print-escape-newlines t)
(print-quoted t)
(print-continuous-numbering t)
print-number-table
(index 0))
- (prin1 (car form) bytecomp-outbuffer)
+ (prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
(insert " ")
(setq position (- (position-bytes position)
(point-min) -1))
(princ (format "(#$ . %d) nil" position)
- bytecomp-outbuffer)
+ byte-compile--outbuffer)
(setq form (cdr form))
(setq index (1+ index))))
((= index (nth 1 info))
(if position
(princ (format (if quoted "'(#$ . %d)" "(#$ . %d)")
position)
- bytecomp-outbuffer)
+ byte-compile--outbuffer)
(let ((print-escape-newlines nil))
(goto-char (prog1 (1+ (point))
- (prin1 (car form) bytecomp-outbuffer)))
+ (prin1 (car form)
+ byte-compile--outbuffer)))
(insert "\\\n")
(goto-char (point-max)))))
(t
- (prin1 (car form) bytecomp-outbuffer)))))
+ (prin1 (car form) byte-compile--outbuffer)))))
(insert (nth 2 info)))))
nil)
-(defun byte-compile-keep-pending (form &optional bytecomp-handler)
+(defun byte-compile-keep-pending (form &optional handler)
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form t)))
- (if bytecomp-handler
+ (if handler
(let ((byte-compile--for-effect t))
;; To avoid consing up monstrously large forms at load time, we split
;; the output regularly.
(and (memq (car-safe form) '(fset defalias))
(nthcdr 300 byte-compile-output)
(byte-compile-flush-pending))
- (funcall bytecomp-handler form)
+ (funcall handler form)
(if byte-compile--for-effect
(byte-compile-discard)))
(byte-compile-form form t))
;; byte-hunk-handlers can call this.
(defun byte-compile-file-form (form)
- (let (bytecomp-handler)
+ (let (handler)
(cond ((and (consp form)
(symbolp (car form))
- (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
- (cond ((setq form (funcall bytecomp-handler form))
+ (setq handler (get (car form) 'byte-hunk-handler)))
+ (cond ((setq form (funcall handler form))
(byte-compile-flush-pending)
(byte-compile-output-file-form form))))
(t
res))
(defun byte-compile-file-form-defmumble (form macrop)
- (let* ((bytecomp-name (car (cdr form)))
- (bytecomp-this-kind (if macrop 'byte-compile-macro-environment
+ (let* ((name (car (cdr form)))
+ (this-kind (if macrop 'byte-compile-macro-environment
'byte-compile-function-environment))
- (bytecomp-that-kind (if macrop 'byte-compile-function-environment
+ (that-kind (if macrop 'byte-compile-function-environment
'byte-compile-macro-environment))
- (bytecomp-this-one (assq bytecomp-name
- (symbol-value bytecomp-this-kind)))
- (bytecomp-that-one (assq bytecomp-name
- (symbol-value bytecomp-that-kind)))
+ (this-one (assq name (symbol-value this-kind)))
+ (that-one (assq name (symbol-value that-kind)))
(byte-compile-free-references nil)
(byte-compile-free-assignments nil))
- (byte-compile-set-symbol-position bytecomp-name)
+ (byte-compile-set-symbol-position name)
;; When a function or macro is defined, add it to the call tree so that
;; we can tell when functions are not used.
(if byte-compile-generate-call-tree
- (or (assq bytecomp-name byte-compile-call-tree)
+ (or (assq name byte-compile-call-tree)
(setq byte-compile-call-tree
- (cons (list bytecomp-name nil nil) byte-compile-call-tree))))
+ (cons (list name nil nil) byte-compile-call-tree))))
- (setq byte-compile-current-form bytecomp-name) ; for warnings
+ (setq byte-compile-current-form name) ; for warnings
(if (byte-compile-warning-enabled-p 'redefine)
(byte-compile-arglist-warn form macrop))
(if byte-compile-verbose
(message "Compiling %s... (%s)"
(or byte-compile-current-file "") (nth 1 form)))
- (cond (bytecomp-that-one
+ (cond (that-one
(if (and (byte-compile-warning-enabled-p 'redefine)
;; don't warn when compiling the stubs in byte-run...
(not (assq (nth 1 form)
byte-compile-initial-macro-environment)))
(byte-compile-warn
- "`%s' defined multiple times, as both function and macro"
- (nth 1 form)))
- (setcdr bytecomp-that-one nil))
- (bytecomp-this-one
+ "`%s' defined multiple times, as both function and macro"
+ (nth 1 form)))
+ (setcdr that-one nil))
+ (this-one
(when (and (byte-compile-warning-enabled-p 'redefine)
- ;; hack: don't warn when compiling the magic internal
- ;; byte-compiler macros in byte-run.el...
- (not (assq (nth 1 form)
- byte-compile-initial-macro-environment)))
+ ;; hack: don't warn when compiling the magic internal
+ ;; byte-compiler macros in byte-run.el...
+ (not (assq (nth 1 form)
+ byte-compile-initial-macro-environment)))
(byte-compile-warn "%s `%s' defined multiple times in this file"
(if macrop "macro" "function")
(nth 1 form))))
- ((and (fboundp bytecomp-name)
- (eq (car-safe (symbol-function bytecomp-name))
+ ((and (fboundp name)
+ (eq (car-safe (symbol-function name))
(if macrop 'lambda 'macro)))
(when (byte-compile-warning-enabled-p 'redefine)
(byte-compile-warn "%s `%s' being redefined as a %s"
(nth 1 form)
(if macrop "macro" "function")))
;; shadow existing definition
- (set bytecomp-this-kind
- (cons (cons bytecomp-name nil)
- (symbol-value bytecomp-this-kind))))
+ (set this-kind
+ (cons (cons name nil)
+ (symbol-value this-kind))))
)
(let ((body (nthcdr 3 form)))
(when (and (stringp (car body))
;; Remove declarations from the body of the macro definition.
(when macrop
(dolist (decl (byte-compile-defmacro-declaration form))
- (prin1 decl bytecomp-outbuffer)))
-
- (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
- (code (byte-compile-byte-code-maker new-one)))
- (if bytecomp-this-one
- (setcdr bytecomp-this-one new-one)
- (set bytecomp-this-kind
- (cons (cons bytecomp-name new-one)
- (symbol-value bytecomp-this-kind))))
- (if (and (stringp (nth 3 form))
- (eq 'quote (car-safe code))
- (eq 'lambda (car-safe (nth 1 code))))
- (cons (car form)
- (cons bytecomp-name (cdr (nth 1 code))))
- (byte-compile-flush-pending)
- (if (not (stringp (nth 3 form)))
- ;; No doc string. Provide -1 as the "doc string index"
- ;; so that no element will be treated as a doc string.
- (byte-compile-output-docform
- "\n(defalias '"
- bytecomp-name
- (cond ((atom code)
- (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
- ((eq (car code) 'quote)
- (setq code new-one)
- (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")")))
- ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")"))))
- (append code nil)
- (and (atom code) byte-compile-dynamic
- 1)
- nil)
- ;; Output the form by hand, that's much simpler than having
- ;; b-c-output-file-form analyze the defalias.
- (byte-compile-output-docform
- "\n(defalias '"
- bytecomp-name
- (cond ((atom code)
- (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
- ((eq (car code) 'quote)
- (setq code new-one)
- (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
- ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
- (append code nil)
- (and (atom code) byte-compile-dynamic
- 1)
- nil))
- (princ ")" bytecomp-outbuffer)
- nil))))
+ (prin1 decl byte-compile--outbuffer)))
+
+ (let* ((code (byte-compile-lambda (nthcdr 2 form) t)))
+ (if this-one
+ ;; A definition in b-c-initial-m-e should always take precedence
+ ;; during compilation, so don't let it be redefined. (Bug#8647)
+ (or (and macrop
+ (assq name byte-compile-initial-macro-environment))
+ (setcdr this-one code))
+ (set this-kind
+ (cons (cons name code)
+ (symbol-value this-kind))))
+ (byte-compile-flush-pending)
+ (if (not (stringp (nth 3 form)))
+ ;; No doc string. Provide -1 as the "doc string index"
+ ;; so that no element will be treated as a doc string.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))
+ (append code nil) ; Turn byte-code-function-p into list.
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil)
+ ;; Output the form by hand, that's much simpler than having
+ ;; b-c-output-file-form analyze the defalias.
+ (byte-compile-output-docform
+ "\n(defalias '"
+ name
+ (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))
+ (append code nil) ; Turn byte-code-function-p into list.
+ (and (atom code) byte-compile-dynamic
+ 1)
+ nil))
+ (princ ")" byte-compile--outbuffer)
+ nil)))
;; Print Lisp object EXP in the output file, inside a comment,
;; and return the file position it will have.
;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
(defun byte-compile-output-as-comment (exp quoted)
(let ((position (point)))
- (with-current-buffer bytecomp-outbuffer
+ (with-current-buffer byte-compile--outbuffer
;; Insert EXP, and make it a comment with #@LENGTH.
(insert " ")
(if quoted
- (prin1 exp bytecomp-outbuffer)
- (princ exp bytecomp-outbuffer))
+ (prin1 exp byte-compile--outbuffer)
+ (princ exp byte-compile--outbuffer))
(goto-char position)
;; Quote certain special characters as needed.
;; get_doc_string in doc.c does the unquoting.
(byte-compile-close-variables
(byte-compile-top-level (byte-compile-preprocess sexp)))))
-;; Given a function made by byte-compile-lambda, make a form which produces it.
-(defun byte-compile-byte-code-maker (fun)
- (cond
- ;; ## atom is faster than compiled-func-p.
- ((atom fun) ; compiled function.
- ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
- ;; would have produced a lambda.
- fun)
- ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial
- ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off.
- ((let (tmp)
- ;; FIXME: can this happen?
- (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
- (null (cdr (memq tmp fun))))
- ;; Generate a make-byte-code call.
- (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
- (nconc (list 'make-byte-code
- (list 'quote (nth 1 fun)) ;arglist
- (nth 1 tmp) ;bytes
- (nth 2 tmp) ;consts
- (nth 3 tmp)) ;depth
- (cond ((stringp (nth 2 fun))
- (list (nth 2 fun))) ;doc
- (interactive
- (list nil)))
- (cond (interactive
- (list (if (or (null (nth 1 interactive))
- (stringp (nth 1 interactive)))
- (nth 1 interactive)
- ;; Interactive spec is a list or a variable
- ;; (if it is correct).
- (list 'quote (nth 1 interactive))))))))
- ;; a non-compiled function (probably trivial)
- (list 'quote fun))))))
-
-;; Turn a function into an ordinary lambda. Needed for v18 files.
-(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it?
- (if (consp function)
- function;;It already is a lambda.
- (setq function (append function nil)) ; turn it into a list
- (nconc (list 'lambda (nth 0 function))
- (and (nth 4 function) (list (nth 4 function)))
- (if (nthcdr 5 function)
- (list (cons 'interactive (if (nth 5 function)
- (nthcdr 5 function)))))
- (list (list 'byte-code
- (nth 1 function) (nth 2 function)
- (nth 3 function))))))
-
-
(defun byte-compile-check-lambda-list (list)
"Check lambda-list LIST for errors."
(let (vars)
;; of the list FUN and `byte-compile-set-symbol-position' is not called.
;; Use this feature to avoid calling `byte-compile-set-symbol-position'
;; for symbols generated by the byte compiler itself.
-(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts)
+(defun byte-compile-lambda (fun &optional add-lambda reserved-csts)
(if add-lambda
- (setq bytecomp-fun (cons 'lambda bytecomp-fun))
- (unless (eq 'lambda (car-safe bytecomp-fun))
- (error "Not a lambda list: %S" bytecomp-fun))
+ (setq fun (cons 'lambda fun))
+ (unless (eq 'lambda (car-safe fun))
+ (error "Not a lambda list: %S" fun))
(byte-compile-set-symbol-position 'lambda))
- (byte-compile-check-lambda-list (nth 1 bytecomp-fun))
- (let* ((bytecomp-arglist (nth 1 bytecomp-fun))
+ (byte-compile-check-lambda-list (nth 1 fun))
+ (let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(append (and (not lexical-binding)
- (byte-compile-arglist-vars bytecomp-arglist))
+ (byte-compile-arglist-vars arglist))
byte-compile-bound-variables))
- (bytecomp-body (cdr (cdr bytecomp-fun)))
- (bytecomp-doc (if (stringp (car bytecomp-body))
- (prog1 (car bytecomp-body)
- ;; Discard the doc string
- ;; unless it is the last element of the body.
- (if (cdr bytecomp-body)
- (setq bytecomp-body (cdr bytecomp-body))))))
- (bytecomp-int (assq 'interactive bytecomp-body)))
+ (body (cdr (cdr fun)))
+ (doc (if (stringp (car body))
+ (prog1 (car body)
+ ;; Discard the doc string
+ ;; unless it is the last element of the body.
+ (if (cdr body)
+ (setq body (cdr body))))))
+ (int (assq 'interactive body)))
;; Process the interactive spec.
- (when bytecomp-int
+ (when int
(byte-compile-set-symbol-position 'interactive)
;; Skip (interactive) if it is in front (the most usual location).
- (if (eq bytecomp-int (car bytecomp-body))
- (setq bytecomp-body (cdr bytecomp-body)))
- (cond ((consp (cdr bytecomp-int))
- (if (cdr (cdr bytecomp-int))
+ (if (eq int (car body))
+ (setq body (cdr body)))
+ (cond ((consp (cdr int))
+ (if (cdr (cdr int))
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string bytecomp-int)))
+ (prin1-to-string int)))
;; If the interactive spec is a call to `list', don't
;; compile it, because `call-interactively' looks at the
;; args of `list'. Actually, compile it to get warnings,
;; but don't use the result.
- (let* ((form (nth 1 bytecomp-int))
+ (let* ((form (nth 1 int))
(newform (byte-compile-top-level form)))
(while (memq (car-safe form) '(let let* progn save-excursion))
(while (consp (cdr form))
;; it won't be eval'd in the right mode.
(not lexical-binding))
nil
- (setq bytecomp-int `(interactive ,newform)))))
- ((cdr bytecomp-int)
+ (setq int `(interactive ,newform)))))
+ ((cdr int)
(byte-compile-warn "malformed interactive spec: %s"
- (prin1-to-string bytecomp-int)))))
+ (prin1-to-string int)))))
;; Process the body.
(let ((compiled
- (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda
+ (byte-compile-top-level (cons 'progn body) nil 'lambda
;; If doing lexical binding, push a new
;; lexical environment containing just the
;; args (since lambda expressions should be
;; closed by now).
(and lexical-binding
- (byte-compile-make-lambda-lexenv
- bytecomp-fun))
+ (byte-compile-make-lambda-lexenv fun))
reserved-csts)))
;; Build the actual byte-coded function.
(if (eq 'byte-code (car-safe compiled))
(apply 'make-byte-code
(if lexical-binding
- (byte-compile-make-args-desc bytecomp-arglist)
- bytecomp-arglist)
+ (byte-compile-make-args-desc arglist)
+ arglist)
(append
;; byte-string, constants-vector, stack depth
(cdr compiled)
;; optionally, the doc string.
(cond (lexical-binding
(require 'help-fns)
- (list (help-add-fundoc-usage
- bytecomp-doc bytecomp-arglist)))
- ((or bytecomp-doc bytecomp-int)
- (list bytecomp-doc)))
+ (list (help-add-fundoc-usage doc arglist)))
+ ((or doc int)
+ (list doc)))
;; optionally, the interactive spec.
- (if bytecomp-int
- (list (nth 1 bytecomp-int)))))
- (setq compiled
- (nconc (if bytecomp-int (list bytecomp-int))
- (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
- (compiled (list compiled)))))
- (nconc (list 'lambda bytecomp-arglist)
- (if (or bytecomp-doc (stringp (car compiled)))
- (cons bytecomp-doc (cond (compiled)
- (bytecomp-body (list nil))))
- compiled))))))
-
-(defun byte-compile-closure (form &optional add-lambda)
- (let ((code (byte-compile-lambda form add-lambda)))
- ;; A simple lambda is just a constant.
- (byte-compile-constant code)))
+ (if int
+ (list (nth 1 int)))))
+ (error "byte-compile-top-level did not return byte-code")))))
(defvar byte-compile-reserved-constants 0)
(byte-compile-tag-number 0)
(byte-compile-depth 0)
(byte-compile-maxdepth 0)
- (byte-compile-lexical-environment lexenv)
+ (byte-compile--lexical-environment lexenv)
(byte-compile-reserved-constants (or reserved-csts 0))
(byte-compile-output nil))
(if (memq byte-optimize '(t source))
(setq form (byte-optimize-form form byte-compile--for-effect)))
(while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
(setq form (nth 1 form)))
- (if (and (eq 'byte-code (car-safe form))
- (not (memq byte-optimize '(t byte)))
- (stringp (nth 1 form)) (vectorp (nth 2 form))
- (natnump (nth 3 form)))
- form
- ;; Set up things for a lexically-bound function.
- (when (and lexical-binding (eq output-type 'lambda))
- ;; See how many arguments there are, and set the current stack depth
- ;; accordingly.
- (setq byte-compile-depth (length byte-compile-lexical-environment))
- ;; If there are args, output a tag to record the initial
- ;; stack-depth for the optimizer.
- (when (> byte-compile-depth 0)
- (byte-compile-out-tag (byte-compile-make-tag))))
- ;; Now compile FORM
- (byte-compile-form form byte-compile--for-effect)
- (byte-compile-out-toplevel byte-compile--for-effect output-type))))
+ ;; Set up things for a lexically-bound function.
+ (when (and lexical-binding (eq output-type 'lambda))
+ ;; See how many arguments there are, and set the current stack depth
+ ;; accordingly.
+ (setq byte-compile-depth (length byte-compile--lexical-environment))
+ ;; If there are args, output a tag to record the initial
+ ;; stack-depth for the optimizer.
+ (when (> byte-compile-depth 0)
+ (byte-compile-out-tag (byte-compile-make-tag))))
+ ;; Now compile FORM
+ (byte-compile-form form byte-compile--for-effect)
+ (byte-compile-out-toplevel byte-compile--for-effect output-type)))
(defun byte-compile-out-toplevel (&optional for-effect output-type)
(if for-effect
;; progn -> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
;; file -> as progn, but takes both quotes and atoms, and longer forms.
(let (rest
- (byte-compile--for-effect for-effect)
(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
tmp body)
(cond
((cdr body) (cons 'progn (nreverse body)))
((car body)))))
-;; Given BYTECOMP-BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (bytecomp-body &optional for-effect)
- (setq bytecomp-body
- (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t))
- (cond ((eq (car-safe bytecomp-body) 'progn)
- (cdr bytecomp-body))
- (bytecomp-body
- (list bytecomp-body))))
+;; Given BODY, compile it and return a new body.
+(defun byte-compile-top-level-body (body &optional for-effect)
+ (setq body
+ (byte-compile-top-level (cons 'progn body) for-effect t))
+ (cond ((eq (car-safe body) 'progn)
+ (cdr body))
+ (body
+ (list body))))
;; Special macro-expander used during byte-compilation.
(defun byte-compile-macroexpand-declare-function (fn file &rest args)
(t
(byte-compile-variable-ref form))))
((symbolp (car form))
- (let* ((bytecomp-fn (car form))
- (bytecomp-handler (get bytecomp-fn 'byte-compile)))
- (when (byte-compile-const-symbol-p bytecomp-fn)
- (byte-compile-warn "`%s' called as a function" bytecomp-fn))
+ (let* ((fn (car form))
+ (handler (get fn 'byte-compile)))
+ (when (byte-compile-const-symbol-p fn)
+ (byte-compile-warn "`%s' called as a function" fn))
(and (byte-compile-warning-enabled-p 'interactive-only)
- (memq bytecomp-fn byte-compile-interactive-only-functions)
+ (memq fn byte-compile-interactive-only-functions)
(byte-compile-warn "`%s' used from Lisp code\n\
-That command is designed for interactive use only" bytecomp-fn))
+That command is designed for interactive use only" fn))
(if (and (fboundp (car form))
(eq (car-safe (symbol-function (car form))) 'macro))
(byte-compile-report-error
(format "Forgot to expand macro %s" (car form))))
- (if (and bytecomp-handler
+ (if (and handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
;; `cl-byte-compile-compiler-macro' but if CL isn't
;; loaded, this function doesn't exist.
- (and (not (eq bytecomp-handler
+ (and (not (eq handler
;; Already handled by macroexpand-all.
'cl-byte-compile-compiler-macro))
- (functionp bytecomp-handler)))
- (funcall bytecomp-handler form)
+ (functionp handler)))
+ (funcall handler form)
(byte-compile-normal-call form))
(if (byte-compile-warning-enabled-p 'cl-functions)
(byte-compile-cl-warn form))))
- ((and (or (byte-code-function-p (car form))
- (eq (car-safe (car form)) 'lambda))
+ ((and (byte-code-function-p (car form))
+ (memq byte-optimize '(t lap)))
+ (byte-compile-unfold-bcf form))
+ ((and (eq (car-safe (car form)) 'lambda)
;; if the form comes out the same way it went in, that's
;; because it was malformed, and we couldn't unfold it.
(not (eq form (setq form (byte-compile-unfold-lambda form)))))
(when (and (byte-compile-warning-enabled-p 'callargs)
(symbolp (car form)))
(if (memq (car form)
- '(custom-declare-group
- ;; custom-declare-variable custom-declare-face
- ))
+ '(custom-declare-group custom-declare-variable
+ custom-declare-face))
(byte-compile-nogroup-warn form))
(when (get (car form) 'byte-obsolete-info)
(byte-compile-warn-obsolete (car form)))
(mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
+
+;; Splice the given lap code into the current instruction stream.
+;; If it has any labels in it, you're responsible for making sure there
+;; are no collisions, and that byte-compile-tag-number is reasonable
+;; after this is spliced in. The provided list is destroyed.
+(defun byte-compile-inline-lapcode (lap end-depth)
+ ;; "Replay" the operations: we used to just do
+ ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))
+ ;; but that fails to update byte-compile-depth, so we had to assume
+ ;; that `lap' ends up adding exactly 1 element to the stack. This
+ ;; happens to be true for byte-code generated by bytecomp.el without
+ ;; lexical-binding, but it's not true in general, and it's not true for
+ ;; code output by bytecomp.el with lexical-binding.
+ (let ((endtag (byte-compile-make-tag)))
+ (dolist (op lap)
+ (cond
+ ((eq (car op) 'TAG) (byte-compile-out-tag op))
+ ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op)))
+ ((eq (car op) 'byte-return)
+ (byte-compile-discard (- byte-compile-depth end-depth) t)
+ (byte-compile-goto 'byte-goto endtag))
+ (t (byte-compile-out (car op) (cdr op)))))
+ (byte-compile-out-tag endtag)))
+
+(defun byte-compile-unfold-bcf (form)
+ "Inline call to byte-code-functions."
+ (let* ((byte-compile-bound-variables byte-compile-bound-variables)
+ (fun (car form))
+ (fargs (aref fun 0))
+ (start-depth byte-compile-depth)
+ (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest.
+ ;; (fmin (if (numberp fargs) (logand fargs 127)))
+ (alen (length (cdr form)))
+ (dynbinds ()))
+ (fetch-bytecode fun)
+ (mapc 'byte-compile-form (cdr form))
+ (unless fmax2
+ ;; Old-style byte-code.
+ (assert (listp fargs))
+ (while fargs
+ (case (car fargs)
+ (&optional (setq fargs (cdr fargs)))
+ (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1))
+ (push (cadr fargs) dynbinds)
+ (setq fargs nil))
+ (t (push (pop fargs) dynbinds))))
+ (unless fmax2 (setq fmax2 (* 2 (length dynbinds)))))
+ (cond
+ ((<= (+ alen alen) fmax2)
+ ;; Add missing &optional (or &rest) arguments.
+ (dotimes (i (- (/ (1+ fmax2) 2) alen))
+ (byte-compile-push-constant nil)))
+ ((zerop (logand fmax2 1))
+ (byte-compile-log-warning "Too many arguments for inlined function"
+ nil :error)
+ (byte-compile-discard (- alen (/ fmax2 2))))
+ (t
+ ;; Turn &rest args into a list.
+ (let ((n (- alen (/ (1- fmax2) 2))))
+ (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n)
+ (if (< n 5)
+ (byte-compile-out
+ (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n))
+ 0)
+ (byte-compile-out 'byte-listN n)))))
+ (mapc #'byte-compile-dynamic-variable-bind dynbinds)
+ (byte-compile-inline-lapcode
+ (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)
+ (1+ start-depth))
+ ;; Unbind dynamic variables.
+ (when dynbinds
+ (byte-compile-out 'byte-unbind (length dynbinds)))
+ (assert (eq byte-compile-depth (1+ start-depth))
+ nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
+
(defun byte-compile-check-variable (var &optional binding)
"Do various error checks before a use of the variable VAR.
If BINDING is non-nil, VAR is being bound."
(defun byte-compile-variable-ref (var)
"Generate code to push the value of the variable VAR on the stack."
(byte-compile-check-variable var)
- (let ((lex-binding (assq var byte-compile-lexical-environment)))
+ (let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
(byte-compile-stack-ref (cdr lex-binding))
(defun byte-compile-variable-set (var)
"Generate code to set the variable VAR from the top-of-stack value."
(byte-compile-check-variable var)
- (let ((lex-binding (assq var byte-compile-lexical-environment)))
+ (let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
(byte-compile-stack-set (cdr lex-binding))
(byte-defop-compiler bobp 0)
(byte-defop-compiler current-buffer 0)
;;(byte-defop-compiler read-char 0) ;; obsolete
+;; (byte-defop-compiler interactive-p 0) ;; Obsolete.
(byte-defop-compiler widen 0)
(byte-defop-compiler end-of-line 0-1)
(byte-defop-compiler forward-char 0-1)
(byte-compile-warn "`%s' called with %d arg%s, but requires %s"
(car form) (length (cdr form))
(if (= 1 (length (cdr form))) "" "s") n)
- ;; get run-time wrong-number-of-args error.
+ ;; Get run-time wrong-number-of-args error.
(byte-compile-normal-call form))
(defun byte-compile-no-args (form)
(byte-defop-compiler-1 internal-make-closure byte-compile-make-closure)
(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var)
-(defconst byte-compile--env-var (make-symbol "env"))
-
(defun byte-compile-make-closure (form)
+ "Byte-compile the special `internal-make-closure' form."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(let* ((vars (nth 1 form))
(env (nth 2 form))
',(aref fun 0) ',(aref fun 1)
(vconcat (vector . ,env) ',(aref fun 2))
,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
-
(defun byte-compile-get-closed-var (form)
+ "Byte-compile the special `internal-get-closed-var' form."
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
- (byte-compile-out 'byte-constant ;; byte-closed-var
- (nth 1 form))))
+ (byte-compile-out 'byte-constant (nth 1 form))))
;; Compile a function that accepts one or more args and is right-associative.
;; We do it by left-associativity so that the operations
(byte-compile-warn
"A quoted lambda form is the second argument of `fset'. This is probably
not what you want, as that lambda cannot be compiled. Consider using
- the syntax (function (lambda (...) ...)) instead.")))))
+ the syntax #'(lambda (...) ...) instead.")))))
(byte-compile-two-args form))
;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
;; and (funcall (function foo)) will lose with autoloads.
(defun byte-compile-function-form (form)
- (if (symbolp (nth 1 form))
- (byte-compile-constant (nth 1 form))
- (byte-compile-closure (nth 1 form))))
+ (byte-compile-constant (if (symbolp (nth 1 form))
+ (nth 1 form)
+ (byte-compile-lambda (nth 1 form)))))
(defun byte-compile-indent-to (form)
(let ((len (length form)))
(byte-defop-compiler-1 quote)
(defun byte-compile-setq (form)
- (let ((bytecomp-args (cdr form)))
- (if bytecomp-args
- (while bytecomp-args
- (byte-compile-form (car (cdr bytecomp-args)))
- (or byte-compile--for-effect (cdr (cdr bytecomp-args))
+ (let ((args (cdr form)))
+ (if args
+ (while args
+ (byte-compile-form (car (cdr args)))
+ (or byte-compile--for-effect (cdr (cdr args))
(byte-compile-out 'byte-dup 0))
- (byte-compile-variable-set (car bytecomp-args))
- (setq bytecomp-args (cdr (cdr bytecomp-args))))
+ (byte-compile-variable-set (car args))
+ (setq args (cdr (cdr args))))
;; (setq), with no arguments.
(byte-compile-form nil byte-compile--for-effect))
(setq byte-compile--for-effect nil)))
\f
;;; control structures
-(defun byte-compile-body (bytecomp-body &optional for-effect)
- (while (cdr bytecomp-body)
- (byte-compile-form (car bytecomp-body) t)
- (setq bytecomp-body (cdr bytecomp-body)))
- (byte-compile-form (car bytecomp-body) for-effect))
+(defun byte-compile-body (body &optional for-effect)
+ (while (cdr body)
+ (byte-compile-form (car body) t)
+ (setq body (cdr body)))
+ (byte-compile-form (car body) for-effect))
-(defsubst byte-compile-body-do-effect (bytecomp-body)
- (byte-compile-body bytecomp-body byte-compile--for-effect)
+(defsubst byte-compile-body-do-effect (body)
+ (byte-compile-body body byte-compile--for-effect)
(setq byte-compile--for-effect nil))
(defsubst byte-compile-form-do-effect (form)
(defun byte-compile-and (form)
(let ((failtag (byte-compile-make-tag))
- (bytecomp-args (cdr form)))
- (if (null bytecomp-args)
+ (args (cdr form)))
+ (if (null args)
(byte-compile-form-do-effect t)
- (byte-compile-and-recursion bytecomp-args failtag))))
+ (byte-compile-and-recursion args failtag))))
;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-or (form)
(let ((wintag (byte-compile-make-tag))
- (bytecomp-args (cdr form)))
- (if (null bytecomp-args)
+ (args (cdr form)))
+ (if (null args)
(byte-compile-form-do-effect nil)
- (byte-compile-or-recursion bytecomp-args wintag))))
+ (byte-compile-or-recursion args wintag))))
;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(keywordp var)))
(defun byte-compile-bind (var init-lexenv)
- "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
+ "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'.
INIT-LEXENV should be a lexical-environment alist describing the
positions of the init value that have been pushed on the stack.
Return non-nil if the TOS value was popped."
(cond ((not (byte-compile-not-lexical-var-p var))
;; VAR is a simple stack-allocated lexical variable
(push (assq var init-lexenv)
- byte-compile-lexical-environment)
+ byte-compile--lexical-environment)
nil)
((eq var (caar init-lexenv))
;; VAR is dynamic and is on the top of the
(let ((num-dynamic-bindings 0))
(dolist (clause clauses)
(unless (assq (if (consp clause) (car clause) clause)
- byte-compile-lexical-environment)
+ byte-compile--lexical-environment)
(setq num-dynamic-bindings (1+ num-dynamic-bindings))))
(unless (zerop num-dynamic-bindings)
(byte-compile-out 'byte-unbind num-dynamic-bindings)))
(push (byte-compile-push-binding-init var) init-lexenv)))
;; New scope.
(let ((byte-compile-bound-variables byte-compile-bound-variables)
- (byte-compile-lexical-environment byte-compile-lexical-environment))
+ (byte-compile--lexical-environment
+ byte-compile--lexical-environment))
;; Bind the variables.
;; For `let', do it in reverse order, because it makes no
;; semantic difference, but it is a lot more efficient since the
"Compiler error: `%s' has no `byte-compile-negated-op' property"
(car form)))
(cdr form))))
-
\f
;;; other tricky macro-like special-forms
(byte-defop-compiler-1 save-excursion)
(byte-defop-compiler-1 save-current-buffer)
(byte-defop-compiler-1 save-restriction)
+;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro.
+;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
(byte-defop-compiler-1 track-mouse)
(defun byte-compile-catch (form)
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
(byte-compile-warning-enabled-p 'suspicious))
- (byte-compile-warn "`save-excursion' defeated by `set-buffer'"))
+ (byte-compile-warn
+ "Use `with-current-buffer' rather than save-excursion+set-buffer"))
(byte-compile-out 'byte-save-excursion 0)
(byte-compile-body-do-effect (cdr form))
(byte-compile-out 'byte-unbind 1))
(byte-compile-set-symbol-position (car form))
(byte-compile-set-symbol-position 'defun)
(error "defun name must be a symbol, not %s" (car form)))
- (let ((byte-compile--for-effect nil))
- (byte-compile-push-constant 'defalias)
- (byte-compile-push-constant (nth 1 form))
- (byte-compile-closure (cdr (cdr form)) t))
+ (byte-compile-push-constant 'defalias)
+ (byte-compile-push-constant (nth 1 form))
+ (byte-compile-push-constant (byte-compile-lambda (cdr (cdr form)) t))
(byte-compile-out 'byte-call 2))
(defun byte-compile-defmacro (form)
;; This is not used for file-level defmacros with doc strings.
(byte-compile-body-do-effect
(let ((decls (byte-compile-defmacro-declaration form))
- (code (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t))))
+ (code (byte-compile-lambda (cdr (cdr form)) t)))
`((defalias ',(nth 1 form)
,(if (eq (car-safe code) 'make-byte-code)
`(cons 'macro ,code)
,@decls
',(nth 1 form)))))
+;; If foo.el declares `toto' as obsolete, it is likely that foo.el will
+;; actually use `toto' in order for this obsolete variable to still work
+;; correctly, so paradoxically, while byte-compiling foo.el, the presence
+;; of a make-obsolete-variable call for `toto' is an indication that `toto'
+;; should not trigger obsolete-warnings in foo.el.
+(byte-defop-compiler-1 make-obsolete-variable)
+(defun byte-compile-make-obsolete-variable (form)
+ (when (eq 'quote (car-safe (nth 1 form)))
+ (push (nth 1 (nth 1 form)) byte-compile-not-obsolete-vars))
+ (byte-compile-normal-call form))
+
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
(when (and (symbolp (nth 1 form))
;; Compile normally, but deal with warnings for the function being defined.
(put 'defalias 'byte-hunk-handler 'byte-compile-file-form-defalias)
+;; Used for eieio--defalias as well.
(defun byte-compile-file-form-defalias (form)
(if (and (consp (cdr form)) (consp (nth 1 form))
(eq (car (nth 1 form)) 'quote)
;; that take OPERAND values off the stack and push a result, for
;; a total of 1 - OPERAND
(- 1 operand))))
-
+
(defun byte-compile-out (op &optional operand)
(push (cons op operand) byte-compile-output)
(if (eq op 'byte-return)
(setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
))
-
-(defun byte-compile-delay-out (&optional stack-used stack-adjust)
- "Add a placeholder to the output, which can be used to later add byte-codes.
-Return a position tag that can be passed to `byte-compile-delayed-out'
-to add the delayed byte-codes. STACK-USED is the maximum amount of
-stack-spaced used by the delayed byte-codes (defaulting to 0), and
-STACK-ADJUST is the amount by which the later-added code will adjust the
-stack (defaulting to 0); the byte-codes added later _must_ adjust the
-stack by this amount! If STACK-ADJUST is 0, then it's not necessary to
-actually add anything later; the effect as if nothing was added at all."
- ;; We just add a no-op to `byte-compile-output', and return a pointer to
- ;; the tail of the list; `byte-compile-delayed-out' uses list surgery
- ;; to add the byte-codes.
- (when stack-used
- (setq byte-compile-maxdepth
- (max byte-compile-depth (+ byte-compile-depth (or stack-used 0)))))
- (when stack-adjust
- (setq byte-compile-depth
- (+ byte-compile-depth stack-adjust)))
- (push (cons nil (or stack-adjust 0)) byte-compile-output))
-
-(defun byte-compile-delayed-out (position op &optional operand)
- "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND.
-POSITION should a position returned by `byte-compile-delay-out'.
-Return a new position, which can be used to add further operations."
- (unless (null (caar position))
- (error "Bad POSITION arg to `byte-compile-delayed-out'"))
- ;; This is kind of like `byte-compile-out', but we splice into the list
- ;; where POSITION is. We don't bother updating `byte-compile-maxdepth'
- ;; because that was already done by `byte-compile-delay-out', but we do
- ;; update the relative operand stored in the no-op marker currently at
- ;; POSITION; since we insert before that marker, this means that if the
- ;; caller doesn't insert a sequence of byte-codes that matches the expected
- ;; operand passed to `byte-compile-delay-out', then the nop will still have
- ;; a non-zero operand when `byte-compile-lapcode' is called, which will
- ;; cause an error to be signaled.
-
- ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op
- (setcdr (car position)
- (- (cdar position) (byte-compile-stack-adjustment op operand)))
- ;; Add the new operation onto the list tail at POSITION
- (setcdr position (cons (cons op operand) (cdr position)))
- position)
-
\f
;;; call tree stuff
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(error "`batch-byte-compile' is to be used only with -batch"))
- (let ((bytecomp-error nil))
+ (let ((error nil))
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
;; Directory as argument.
- (let ((bytecomp-files (directory-files (car command-line-args-left)))
- bytecomp-source bytecomp-dest)
- (dolist (bytecomp-file bytecomp-files)
- (if (and (string-match emacs-lisp-file-regexp bytecomp-file)
- (not (auto-save-file-name-p bytecomp-file))
- (setq bytecomp-source
- (expand-file-name bytecomp-file
+ (let (source dest)
+ (dolist (file (directory-files (car command-line-args-left)))
+ (if (and (string-match emacs-lisp-file-regexp file)
+ (not (auto-save-file-name-p file))
+ (setq source
+ (expand-file-name file
(car command-line-args-left)))
- (setq bytecomp-dest (byte-compile-dest-file
- bytecomp-source))
- (file-exists-p bytecomp-dest)
- (file-newer-than-file-p bytecomp-source bytecomp-dest))
- (if (null (batch-byte-compile-file bytecomp-source))
- (setq bytecomp-error t)))))
+ (setq dest (byte-compile-dest-file source))
+ (file-exists-p dest)
+ (file-newer-than-file-p source dest))
+ (if (null (batch-byte-compile-file source))
+ (setq error t)))))
;; Specific file argument
(if (or (not noforce)
- (let* ((bytecomp-source (car command-line-args-left))
- (bytecomp-dest (byte-compile-dest-file
- bytecomp-source)))
- (or (not (file-exists-p bytecomp-dest))
- (file-newer-than-file-p bytecomp-source bytecomp-dest))))
+ (let* ((source (car command-line-args-left))
+ (dest (byte-compile-dest-file source)))
+ (or (not (file-exists-p dest))
+ (file-newer-than-file-p source dest))))
(if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq bytecomp-error t))))
+ (setq error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (kill-emacs (if bytecomp-error 1 0))))
+ (kill-emacs (if error 1 0))))
-(defun batch-byte-compile-file (bytecomp-file)
+(defun batch-byte-compile-file (file)
(if debug-on-error
- (byte-compile-file bytecomp-file)
+ (byte-compile-file file)
(condition-case err
- (byte-compile-file bytecomp-file)
+ (byte-compile-file file)
(file-error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- bytecomp-file
+ file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
- (let ((bytecomp-destfile (byte-compile-dest-file bytecomp-file)))
- (if (file-exists-p bytecomp-destfile)
- (delete-file bytecomp-destfile)))
+ (let ((destfile (byte-compile-dest-file file)))
+ (if (file-exists-p destfile)
+ (delete-file destfile)))
nil)
(error
(message (if (cdr err)
">>Error occurred processing %s: %s (%s)"
">>Error occurred processing %s: %s")
- bytecomp-file
+ file
(get (car err) 'error-message)
(prin1-to-string (cdr err)))
nil))))