;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
+;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; Maintainer: FSF
;; Keywords: lisp
+;; Package: emacs
;; This file is part of GNU Emacs.
;; ========================================================================
;; Entry points:
;; byte-recompile-directory, byte-compile-file,
+;; byte-recompile-file,
;; batch-byte-compile, batch-byte-recompile-directory,
;; byte-compile, compile-defun,
;; display-call-tree
;; + correct compilation of top-level uses of macros;
;; + the ability to generate a histogram of functions called.
-;; User customization variables:
-;;
-;; byte-compile-verbose Whether to report the function currently being
-;; compiled in the echo area;
-;; byte-optimize Whether to do optimizations; this may be
-;; t, nil, 'source, or 'byte;
-;; byte-optimize-log Whether to report (in excruciating detail)
-;; exactly which optimizations have been made.
-;; This may be t, nil, 'source, or 'byte;
-;; byte-compile-error-on-warn Whether to stop compilation when a warning is
-;; produced;
-;; byte-compile-delete-errors Whether the optimizer may delete calls or
-;; variable references that are side-effect-free
-;; except that they may return an error.
-;; byte-compile-generate-call-tree Whether to generate a histogram of
-;; function calls. This can be useful for
-;; finding unused functions, as well as simple
-;; performance metering.
-;; byte-compile-warnings List of warnings to issue, or t. May contain
-;; `free-vars' (references to variables not in the
-;; current lexical scope)
-;; `unresolved' (calls to unknown functions)
-;; `callargs' (lambda calls with args that don't
-;; match the lambda's definition)
-;; `redefine' (function cell redefined from
-;; a macro to a lambda or vice versa,
-;; or redefined to take other args)
-;; `obsolete' (obsolete variables and functions)
-;; `noruntime' (calls to functions only defined
-;; within `eval-when-compile')
-;; `cl-functions' (calls to CL functions)
-;; `interactive-only' (calls to commands that are
-;; not good to call from Lisp)
-;; `make-local' (dubious calls to
-;; `make-variable-buffer-local')
-;; `mapcar' (mapcar called for effect)
-;; byte-compile-compatibility Whether the compiler should
-;; generate .elc files which can be loaded into
-;; generic emacs 18.
-;; emacs-lisp-file-regexp Regexp for the extension of source-files;
-;; see also the function byte-compile-dest-file.
+;; User customization variables: M-x customize-group bytecomp
;; New Features:
;;
;; This really ought to be loaded already!
(load "byte-run"))
-;; 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)
-
-;; The crud you see scattered through this file of the form
-;; (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19"))
-;; is because the Epoch folks couldn't be bothered to follow the
-;; normal emacs version numbering convention.
-
-;; (if (byte-compile-version-cond
-;; (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19")))
-;; (progn
-;; ;; emacs-18 compatibility.
-;; (defvar baud-rate (baud-rate)) ;Define baud-rate if it's undefined
-;;
-;; (if (byte-compile-single-version)
-;; (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
-;; (defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
-;;
-;; (or (and (fboundp 'member)
-;; ;; avoid using someone else's possibly bogus definition of this.
-;; (subrp (symbol-function 'member)))
-;; (defun member (elt list)
-;; "like memq, but uses equal instead of eq. In v19, this is a subr."
-;; (while (and list (not (equal elt (car list))))
-;; (setq list (cdr list)))
-;; list))))
-
-
(defgroup bytecomp nil
"Emacs Lisp byte-compiler."
:group 'lisp)
:group 'bytecomp
:type 'boolean)
-(defcustom byte-compile-compatibility nil
- "Non-nil means generate output that can run in Emacs 18.
-This only means that it can run in principle, if it doesn't require
-facilities that have been added more recently."
- :group 'bytecomp
- :type 'boolean)
-
-;; (defvar byte-compile-generate-emacs19-bytecodes
-;; (not (or (and (boundp 'epoch::version) epoch::version)
-;; (string-lessp emacs-version "19")))
-;; "*If this is true, then the byte-compiler will generate bytecode which
-;; makes use of byte-ops which are present only in Emacs 19. Code generated
-;; this way can never be run in Emacs 18, and may even cause it to crash.")
-
(defcustom byte-optimize t
"Enable optimization in the byte compiler.
Possible values are:
:type 'boolean)
;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
+(defconst byte-compile-log-buffer "*Compile-Log*"
+ "Name of the byte-compiler's log buffer.")
+
(defcustom byte-optimize-log nil
- "If true, the byte-compiler will log its optimizations into *Compile-Log*.
+ "If non-nil, the byte-compiler will log its optimizations.
If this is 'source, then only source-level optimizations will be logged.
-If it is 'byte, then only byte-level optimizations will be logged."
+If it is 'byte, then only byte-level optimizations will be logged.
+The information is logged to `byte-compile-log-buffer'."
:group 'bytecomp
:type '(choice (const :tag "none" nil)
(const :tag "all" t)
(defconst byte-compile-warning-types
'(redefine callargs free-vars unresolved
obsolete noruntime cl-functions interactive-only
- make-local mapcar)
+ make-local mapcar constants suspicious lexical)
"The list of warning types used when `byte-compile-warnings' is t.")
(defcustom byte-compile-warnings t
"List of warnings that the byte-compiler should issue (t for all).
commands that normally shouldn't be called from Lisp code.
make-local calls to make-variable-buffer-local that may be incorrect.
mapcar mapcar called for effect.
+ constants let-binding of, or assignment to, constants/nonvariables.
+ suspicious constructs that usually don't do what the coder wanted.
If the list begins with `not', then the remaining elements specify warnings to
suppress. For example, (not mapcar) will suppress warnings about mapcar."
:group 'bytecomp
:type `(choice (const :tag "All" t)
(set :menu-tag "Some"
- (const free-vars) (const unresolved)
- (const callargs) (const redefine)
- (const obsolete) (const noruntime)
- (const cl-functions) (const interactive-only)
- (const make-local) (const mapcar))))
-;;;###autoload(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
+ ,@(mapcar (lambda (x) `(const ,x))
+ byte-compile-warning-types))))
;;;###autoload
-(defun byte-compile-warnings-safe-p (x)
- "Return non-nil if X is valid as a value of `byte-compile-warnings'."
- (or (booleanp x)
- (and (listp x)
- (if (eq (car x) 'not) (setq x (cdr x))
- t)
- (equal (mapcar
- (lambda (e)
- (when (memq e byte-compile-warning-types)
- e))
- x)
- x))))
+(put 'byte-compile-warnings 'safe-local-variable
+ (lambda (v)
+ (or (symbolp v)
+ (null (delq nil (mapcar (lambda (x) (not (symbolp x))) v))))))
(defun byte-compile-warning-enabled-p (warning)
"Return non-nil if WARNING is enabled, according to `byte-compile-warnings'."
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
insert-file insert-buffer insert-file-literally previous-line next-line
- goto-line comint-run)
+ goto-line comint-run delete-backward-char)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-vars nil
(const calls+callers) (const nil)))
(defvar byte-compile-debug nil)
-
-;; (defvar byte-compile-overwrite-file t
-;; "If nil, old .elc files are deleted before the new is saved, and .elc
-;; files will have the same modes as the corresponding .el file. Otherwise,
-;; existing .elc files will simply be overwritten, and the existing modes
-;; will not be changed. If this variable is nil, then an .elc file which
-;; is a symbolic link will be turned into a normal file, instead of the file
-;; which the link points to being overwritten.")
-
(defvar byte-compile-constants nil
"List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
- (with-current-buffer "*Compile-Log*"
+ (with-current-buffer byte-compile-log-buffer
(let ((inhibit-read-only t))
(goto-char (point-max))
(byte-compile-warning-prefix nil nil)
;; (compile-mode) will cause this to be loaded.
(declare-function compilation-forget-errors "compile" ())
-;; Log the start of a file in *Compile-Log*, and mark it as done.
+;; Log the start of a file in `byte-compile-log-buffer', and mark it as done.
;; Return the position of the start of the page in the log buffer.
;; But do nothing in batch mode.
(defun byte-compile-log-file ()
(and (not (equal byte-compile-current-file byte-compile-last-logged-file))
(not noninteractive)
- (with-current-buffer (get-buffer-create "*Compile-Log*")
+ (with-current-buffer (get-buffer-create byte-compile-log-buffer)
(goto-char (point-max))
(let* ((inhibit-read-only t)
(dir (and byte-compile-current-file
(compilation-forget-errors)
pt))))
-;; Log a message STRING in *Compile-Log*.
+;; Log a message STRING in `byte-compile-log-buffer'.
;; Also log the current function and file if not already done.
(defun byte-compile-log-warning (string &optional fill level)
(let ((warning-prefix-function 'byte-compile-warning-prefix)
(warning-type-format "")
(warning-fill-prefix (if fill " "))
(inhibit-read-only t))
- (display-warning 'bytecomp string level "*Compile-Log*")))
+ (display-warning 'bytecomp string level byte-compile-log-buffer)))
(defun byte-compile-warn (format &rest args)
"Issue a byte compiler warning; use (format FORMAT ARGS...) for message."
(funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler
'byte-compile-normal-call) form))
\f
-;; Compiler options
-
-;; (defvar byte-compiler-valid-options
-;; '((optimize byte-optimize (t nil source byte) val)
-;; (file-format byte-compile-compatibility (emacs18 emacs19)
-;; (eq val 'emacs18))
-;; ;; (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val)
-;; (delete-errors byte-compile-delete-errors (t nil) val)
-;; (verbose byte-compile-verbose (t nil) val)
-;; (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
-;; val)))
-
-;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
-;; than can't be changed because the running compiler doesn't support it.
-;; (cond
-;; ((byte-compile-single-version)
-;; (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
-;; (list (byte-compile-version-cond
-;; byte-compile-generate-emacs19-bytecodes)))
-;; (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options)))
-;; (if (byte-compile-version-cond byte-compile-compatibility)
-;; '(emacs18) '(emacs19)))))
-
-;; (defun byte-compiler-options-handler (&rest args)
-;; (let (key val desc choices)
-;; (while args
-;; (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
-;; (error "Malformed byte-compiler option `%s'" (car args)))
-;; (setq key (car (car args))
-;; val (car (cdr (car args)))
-;; desc (assq key byte-compiler-valid-options))
-;; (or desc
-;; (error "Unknown byte-compiler option `%s'" key))
-;; (setq choices (nth 2 desc))
-;; (if (consp (car choices))
-;; (let (this
-;; (handler 'cons)
-;; (ret (and (memq (car val) '(+ -))
-;; (copy-sequence (if (eq t (symbol-value (nth 1 desc)))
-;; choices
-;; (symbol-value (nth 1 desc)))))))
-;; (setq choices (car choices))
-;; (while val
-;; (setq this (car val))
-;; (cond ((memq this choices)
-;; (setq ret (funcall handler this ret)))
-;; ((eq this '+) (setq handler 'cons))
-;; ((eq this '-) (setq handler 'delq))
-;; ((error "`%s' only accepts %s" key choices)))
-;; (setq val (cdr val)))
-;; (set (nth 1 desc) ret))
-;; (or (memq val choices)
-;; (error "`%s' must be one of `%s'" key choices))
-;; (set (nth 1 desc) (eval (nth 3 desc))))
-;; (setq args (cdr args)))
-;; nil))
-\f
;;; sanity-checking arglists
-;; If a function has an entry saying (FUNCTION . t).
-;; that means we know it is defined but we don't know how.
-;; If a function has an entry saying (FUNCTION . nil),
-;; that means treat it as not defined.
(defun byte-compile-fdefinition (name macro-p)
+ ;; If a function has an entry saying (FUNCTION . t).
+ ;; that means we know it is defined but we don't know how.
+ ;; If a function has an entry saying (FUNCTION . nil),
+ ;; that means treat it as not defined.
(let* ((list (if macro-p
byte-compile-macro-environment
byte-compile-function-environment))
(and (not macro-p)
(byte-code-function-p (symbol-function fn)))))
(setq fn (symbol-function fn)))
- (if (and (not macro-p) (byte-code-function-p fn))
- fn
- (and (consp fn)
- (if (eq 'macro (car fn))
- (cdr fn)
- (if macro-p
- nil
- (if (eq 'autoload (car fn))
- nil
- fn)))))))))
+ (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
+ ;; Could be a subr.
+ (symbol-function fn)
+ fn)
+ advertised-signature-table t)))
+ (cond
+ ((listp advertised)
+ (if macro-p
+ `(macro lambda ,advertised)
+ `(lambda ,advertised)))
+ ((and (not macro-p) (byte-code-function-p fn)) fn)
+ ((not (consp fn)) nil)
+ ((eq 'macro (car fn)) (cdr fn))
+ (macro-p nil)
+ ((eq 'autoload (car fn)) nil)
+ (t fn)))))))
(defun byte-compile-arglist-signature (arglist)
(let ((args 0)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
(sig (if (and def (not (eq def t)))
- (byte-compile-arglist-signature
- (if (memq (car-safe def) '(declared lambda))
- (nth 1 def)
- (if (byte-code-function-p def)
- (aref def 0)
- '(&rest def))))
+ (progn
+ (and (eq (car-safe def) 'macro)
+ (eq (car-safe (cdr-safe def)) 'lambda)
+ (setq def (cdr def)))
+ (byte-compile-arglist-signature
+ (if (memq (car-safe def) '(declared lambda))
+ (nth 1 def)
+ (if (byte-code-function-p def)
+ (aref def 0)
+ '(&rest def)))))
(if (and (fboundp (car form))
(subrp (symbol-function (car form))))
(subr-arity (symbol-function (car form))))))
(defun byte-compile-arglist-warn (form macrop)
(let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
(if (and old (not (eq old t)))
- (let ((sig1 (byte-compile-arglist-signature
- (if (eq 'lambda (car-safe old))
- (nth 1 old)
- (if (byte-code-function-p old)
- (aref old 0)
- '(&rest def)))))
- (sig2 (byte-compile-arglist-signature (nth 2 form))))
- (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
- (byte-compile-set-symbol-position (nth 1 form))
- (byte-compile-warn
- "%s %s used to take %s %s, now takes %s"
- (if (eq (car form) 'defun) "function" "macro")
- (nth 1 form)
- (byte-compile-arglist-signature-string sig1)
- (if (equal sig1 '(1 . 1)) "argument" "arguments")
- (byte-compile-arglist-signature-string sig2))))
+ (progn
+ (and (eq 'macro (car-safe old))
+ (eq 'lambda (car-safe (cdr-safe old)))
+ (setq old (cdr old)))
+ (let ((sig1 (byte-compile-arglist-signature
+ (if (eq 'lambda (car-safe old))
+ (nth 1 old)
+ (if (byte-code-function-p old)
+ (aref old 0)
+ '(&rest def)))))
+ (sig2 (byte-compile-arglist-signature (nth 2 form))))
+ (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2)
+ (byte-compile-set-symbol-position (nth 1 form))
+ (byte-compile-warn
+ "%s %s used to take %s %s, now takes %s"
+ (if (eq (car form) 'defun) "function" "macro")
+ (nth 1 form)
+ (byte-compile-arglist-signature-string sig1)
+ (if (equal sig1 '(1 . 1)) "argument" "arguments")
+ (byte-compile-arglist-signature-string sig2)))))
;; This is the first definition. See if previous calls are compatible.
(let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
nums sig min max)
(not (and (eq (get func 'byte-compile)
'cl-byte-compile-compiler-macro)
(string-match "\\`c[ad]+r\\'" (symbol-name func)))))
- (byte-compile-warn "Function `%s' from cl package called at runtime"
+ (byte-compile-warn "function `%s' from cl package called at runtime"
func)))
form)
;;
(byte-compile-verbose byte-compile-verbose)
(byte-optimize byte-optimize)
- (byte-compile-compatibility byte-compile-compatibility)
(byte-compile-dynamic byte-compile-dynamic)
(byte-compile-dynamic-docstrings
byte-compile-dynamic-docstrings)
(warning-series-started
(and (markerp warning-series)
(eq (marker-buffer warning-series)
- (get-buffer "*Compile-Log*")))))
+ (get-buffer byte-compile-log-buffer)))))
(byte-compile-find-cl-functions)
(if (or (eq warning-series 'byte-compile-warning-series)
warning-series-started)
nil
(save-some-buffers)
(force-mode-line-update))
- (with-current-buffer (get-buffer-create "*Compile-Log*")
+ (with-current-buffer (get-buffer-create byte-compile-log-buffer)
(setq default-directory (expand-file-name bytecomp-directory))
;; compilation-mode copies value of default-directory.
(unless (eq major-mode 'compilation-mode)
(if (and (string-match emacs-lisp-file-regexp bytecomp-source)
(file-readable-p bytecomp-source)
(not (auto-save-file-name-p bytecomp-source))
- (setq bytecomp-dest
- (byte-compile-dest-file bytecomp-source))
- (if (file-exists-p bytecomp-dest)
- ;; File was already compiled.
- (or bytecomp-force
- (file-newer-than-file-p bytecomp-source
- bytecomp-dest))
- ;; No compiled file exists yet.
- (and bytecomp-arg
- (or (eq 0 bytecomp-arg)
- (y-or-n-p (concat "Compile "
- bytecomp-source "? "))))))
- (progn (if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." bytecomp-source))
- (let ((bytecomp-res (byte-compile-file
- 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)
;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
;;;###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.
+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
+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
+compile the file even if it has never been compiled before.
+A nonzero BYTECOMP-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)))
+ (list (read-file-name (if current-prefix-arg
+ "Byte compile file: "
+ "Byte recompile file: ")
+ bytecomp-file-dir bytecomp-file-name nil)
+ current-prefix-arg)))
+ (let ((bytecomp-dest
+ (byte-compile-dest-file bytecomp-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)
+ ;; 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)
+ (y-or-n-p (concat "Compile "
+ bytecomp-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))
+ '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.
(insert "\n") ; aaah, unix.
(if (file-writable-p target-file)
;; We must disable any code conversion here.
- (let ((coding-system-for-write 'no-conversion))
+ (let* ((coding-system-for-write 'no-conversion)
+ ;; Write to a tempfile so that if another Emacs
+ ;; process is trying to load target-file (eg in a
+ ;; parallel bootstrap), it does not risk getting a
+ ;; half-finished file. (Bug#4196)
+ (tempfile (make-temp-name target-file))
+ (kill-emacs-hook
+ (cons (lambda () (ignore-errors (delete-file tempfile)))
+ kill-emacs-hook)))
(if (memq system-type '(ms-dos 'windows-nt))
(setq buffer-file-type t))
- (when (file-exists-p target-file)
- ;; Remove the target before writing it, so that any
- ;; hard-links continue to point to the old file (this makes
- ;; it possible for installed files to share disk space with
- ;; the build tree, without causing problems when emacs-lisp
- ;; files in the build tree are recompiled).
- (delete-file target-file))
- (write-region (point-min) (point-max) target-file))
+ (write-region (point-min) (point-max) tempfile nil 1)
+ ;; This has the intentional side effect that any
+ ;; hard-links to target-file continue to
+ ;; point to the old file (this makes it possible
+ ;; for installed files to share disk space with
+ ;; the build tree, without causing problems when
+ ;; emacs-lisp files in the build tree are
+ ;; recompiled). Previously this was accomplished by
+ ;; deleting target-file before writing it.
+ (rename-file tempfile target-file t)
+ (message "Wrote %s" target-file))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
(load target-file))
t))))
-;;(defun byte-compile-and-load-file (&optional filename)
-;; "Compile a file of Lisp code named FILENAME into a file of byte code,
-;;and then load it. The output file's name is made by appending \"c\" to
-;;the end of FILENAME."
-;; (interactive)
-;; (if filename ; I don't get it, (interactive-p) doesn't always work
-;; (byte-compile-file filename t)
-;; (let ((current-prefix-arg '(4)))
-;; (call-interactively 'byte-compile-file))))
-
-;;(defun byte-compile-buffer (&optional buffer)
-;; "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
-;; (interactive "bByte compile buffer: ")
-;; (setq buffer (if buffer (get-buffer buffer) (current-buffer)))
-;; (message "Compiling %s..." (buffer-name buffer))
-;; (let* ((filename (or (buffer-file-name buffer)
-;; (concat "#<buffer " (buffer-name buffer) ">")))
-;; (byte-compile-current-file buffer))
-;; (byte-compile-from-buffer buffer nil))
-;; (message "Compiling %s...done" (buffer-name buffer))
-;; t)
-
;;; compiling a single function
;;;###autoload
(defun compile-defun (&optional arg)
(set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
- (setq case-fold-search nil)
- ;; This is a kludge. Some operating systems (OS/2, DOS) need to
- ;; write files containing binary information specially.
- ;; Under most circumstances, such files will be in binary
- ;; overwrite mode, so those OS's use that flag to guess how
- ;; they should write their data. Advise them that .elc files
- ;; need to be written carefully.
- (setq overwrite-mode 'overwrite-mode-binary))
+ (setq case-fold-search nil))
(displaying-byte-compile-warnings
- (and bytecomp-filename
- (byte-compile-insert-header bytecomp-filename bytecomp-inbuffer
- bytecomp-outbuffer))
(with-current-buffer bytecomp-inbuffer
+ (and bytecomp-filename
+ (byte-compile-insert-header bytecomp-filename bytecomp-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
;; Fix up the header at the front of the output
;; if the buffer contains multibyte characters.
(and bytecomp-filename
- (byte-compile-fix-header bytecomp-filename bytecomp-inbuffer
- bytecomp-outbuffer))))
+ (with-current-buffer bytecomp-outbuffer
+ (byte-compile-fix-header bytecomp-filename)))))
bytecomp-outbuffer))
-(defun byte-compile-fix-header (filename inbuffer outbuffer)
- (with-current-buffer outbuffer
- ;; See if the buffer has any multibyte characters.
- (when (< (point-max) (position-bytes (point-max)))
- (when (byte-compile-version-cond byte-compile-compatibility)
- (error "Version-18 compatibility not valid with multibyte characters"))
- (goto-char (point-min))
- ;; Find the comment that describes the version test.
- (search-forward "\n;;; This file")
- (beginning-of-line)
- (narrow-to-region (point) (point-max))
- ;; Find the line of ballast semicolons.
- (search-forward ";;;;;;;;;;")
- (beginning-of-line)
-
- (narrow-to-region (point-min) (point))
- (let ((old-header-end (point))
- delta)
- (goto-char (point-min))
- (delete-region (point) (progn (re-search-forward "^(")
- (beginning-of-line)
- (point)))
- (insert ";;; This file contains utf-8 non-ASCII characters\n"
- ";;; and therefore cannot be loaded into Emacs 22 or earlier.\n")
- ;; Replace "19" or "19.29" with "23", twice.
- (re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "23")
- (re-search-forward "19\\(\\.[0-9]+\\)")
- (replace-match "23")
- ;; Now compensate for the change in size,
- ;; to make sure all positions in the file remain valid.
- (setq delta (- (point-max) old-header-end))
- (goto-char (point-max))
- (widen)
- (delete-char delta)))))
-
-(defun byte-compile-insert-header (filename inbuffer outbuffer)
- (with-current-buffer inbuffer
- (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
- (dynamic byte-compile-dynamic))
- (set-buffer outbuffer)
+(defun byte-compile-fix-header (filename)
+ "If the current buffer has any multibyte characters, insert a version test."
+ (when (< (point-max) (position-bytes (point-max)))
+ (goto-char (point-min))
+ ;; Find the comment that describes the version condition.
+ (search-forward "\n;;; This file uses")
+ (narrow-to-region (line-beginning-position) (point-max))
+ ;; Find the first line of ballast semicolons.
+ (search-forward ";;;;;;;;;;")
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point))
+ (let ((old-header-end (point))
+ (minimum-version "23")
+ delta)
+ (delete-region (point-min) (point-max))
+ (insert
+ ";;; This file contains utf-8 non-ASCII characters,\n"
+ ";;; and so cannot be loaded into Emacs 22 or earlier.\n"
+ ;; Have to check if emacs-version is bound so that this works
+ ;; in files loaded early in loadup.el.
+ "(and (boundp 'emacs-version)\n"
+ ;; If there is a name at the end of emacs-version,
+ ;; don't try to check the version number.
+ " (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
+ (format " (string-lessp emacs-version \"%s\")\n" minimum-version)
+ " (error \"`"
+ ;; prin1-to-string is used to quote backslashes.
+ (substring (prin1-to-string (file-name-nondirectory filename))
+ 1 -1)
+ (format "' was compiled for Emacs %s or later\"))\n\n"
+ minimum-version))
+ ;; Now compensate for any change in size, to make sure all
+ ;; positions in the file remain valid.
+ (setq delta (- (point-max) old-header-end))
+ (goto-char (point-max))
+ (widen)
+ (delete-char delta))))
+
+(defun byte-compile-insert-header (filename outbuffer)
+ "Insert a header at the start of OUTBUFFER.
+Call from the source buffer."
+ (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
+ (dynamic byte-compile-dynamic)
+ (optimize byte-optimize))
+ (with-current-buffer outbuffer
(goto-char (point-min))
;; The magic number of .elc files is ";ELC", or 0x3B454C43. After
;; that is the file-format version number (18, 19, 20, or 23) as a
;; the file so that `diff' will simply say "Binary files differ"
;; instead of actually doing a diff of two .elc files. An extra
;; benefit is that you can add this to /etc/magic:
-
;; 0 string ;ELC GNU Emacs Lisp compiled file,
;; >4 byte x version %d
-
(insert
- ";ELC"
- (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
- "\000\000\000\n"
- )
- (insert ";;; Compiled by "
- (or (and (boundp 'user-mail-address) user-mail-address)
- (concat (user-login-name) "@" (system-name)))
- " on "
- (current-time-string) "\n;;; from file " filename "\n")
- (insert ";;; in Emacs version " emacs-version "\n")
- (insert ";;; "
- (cond
- ((eq byte-optimize 'source) "with source-level optimization only")
- ((eq byte-optimize 'byte) "with byte-level optimization only")
- (byte-optimize "with all optimizations")
- (t "without optimization"))
- (if (byte-compile-version-cond byte-compile-compatibility)
- "; compiled with Emacs 18 compatibility.\n"
- ".\n"))
- (if dynamic
- (insert ";;; Function definitions are lazy-loaded.\n"))
- (if (not (byte-compile-version-cond byte-compile-compatibility))
- (let (intro-string minimum-version)
- ;; Figure out which Emacs version to require,
- ;; and what comment to use to explain why.
- ;; Note that this fails to take account of whether
- ;; the buffer contains multibyte characters. We may have to
- ;; compensate at the end in byte-compile-fix-header.
- (if dynamic-docstrings
- (setq intro-string
- ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
- minimum-version "19.29")
- (setq intro-string
- ";;; This file uses opcodes which do not exist in Emacs 18.\n"
- minimum-version "19"))
- ;; Now insert the comment and the error check.
- (insert
- "\n"
- intro-string
- ;; Have to check if emacs-version is bound so that this works
- ;; in files loaded early in loadup.el.
- "(if (and (boundp 'emacs-version)\n"
- ;; If there is a name at the end of emacs-version,
- ;; don't try to check the version number.
- "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
- "\t (or (and (boundp 'epoch::version) epoch::version)\n"
- (format "\t (string-lessp emacs-version \"%s\")))\n"
- minimum-version)
- " (error \"`"
- ;; prin1-to-string is used to quote backslashes.
- (substring (prin1-to-string (file-name-nondirectory filename))
- 1 -1)
- (format "' was compiled for Emacs %s or later\"))\n\n"
- minimum-version)
- ;; Insert semicolons as ballast, so that byte-compile-fix-header
- ;; can delete them so as to keep the buffer positions
- ;; constant for the actual compiled code.
- ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
- ;; Here if we want Emacs 18 compatibility.
- (when dynamic-docstrings
- (error "Version-18 compatibility doesn't support dynamic doc strings"))
- (when byte-compile-dynamic
- (error "Version-18 compatibility doesn't support dynamic byte code"))
- (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
- "\n")))))
+ ";ELC" 23 "\000\000\000\n"
+ ";;; Compiled by "
+ (or (and (boundp 'user-mail-address) user-mail-address)
+ (concat (user-login-name) "@" (system-name)))
+ " on " (current-time-string) "\n"
+ ";;; from file " filename "\n"
+ ";;; in Emacs version " emacs-version "\n"
+ ";;; with"
+ (cond
+ ((eq optimize 'source) " source-level optimization only")
+ ((eq optimize 'byte) " byte-level optimization only")
+ (optimize " all optimizations")
+ (t "out optimization"))
+ ".\n"
+ (if dynamic ";;; Function definitions are lazy-loaded.\n"
+ "")
+ "\n;;; This file uses "
+ (if dynamic-docstrings
+ "dynamic docstrings, first added in Emacs 19.29"
+ "opcodes that do not exist in Emacs 18")
+ ".\n\n"
+ ;; Note that byte-compile-fix-header may change this.
+ ";;; This file does not contain utf-8 non-ASCII characters,\n"
+ ";;; and so can be loaded in Emacs versions earlier than 23.\n\n"
+ ;; Insert semicolons as ballast, so that byte-compile-fix-header
+ ;; can delete them so as to keep the buffer positions
+ ;; constant for the actual compiled code.
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n"
+ ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))))
;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defun byte-compile-output-file-form (form)
;; writes the given form to the output buffer, being careful of docstrings
- ;; in defun, defmacro, defvar, defconst, autoload and
+ ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and
;; custom-declare-variable because make-docfile is so amazingly stupid.
;; defalias calls are output directly by byte-compile-file-form-defmumble;
;; it does not pay to first build the defalias in defmumble and then parse
;; it here.
- (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload
+ (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload
custom-declare-variable))
(stringp (nth 3 form)))
(byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
(memq (car form)
- '(autoload custom-declare-variable)))
+ '(defvaralias autoload
+ custom-declare-variable)))
(let ((print-escape-newlines t)
(print-length nil)
(print-level nil)
\(the constants vector) together, for lazy loading.
QUOTED says that we have to put a quote before the
list that represents a doc string reference.
-`autoload' and `custom-declare-variable' need that."
+`defvaralias', `autoload' and `custom-declare-variable' need that."
;; 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))
;; Insert the doc string, and make it a comment with #@LENGTH.
(and (>= (nth 1 info) 0)
dynamic-docstrings
- (not byte-compile-compatibility)
(progn
;; Make the doc string start at beginning of line
;; for make-docfile's sake.
;; to objects already output
;; (for instance, gensyms in the arg list).
(let (non-nil)
- (dotimes (i (length print-number-table))
- (if (aref print-number-table i)
- (setq non-nil t)))
+ (when (hash-table-p print-number-table)
+ (maphash (lambda (k v) (if v (setq non-nil t)))
+ print-number-table))
(not non-nil)))
;; Output the byte code and constants specially
;; for lazy dynamic loading.
;; Since there is no doc string, we can compile this as a normal form,
;; and not do a file-boundary.
(byte-compile-keep-pending form)
- (when (byte-compile-warning-enabled-p 'free-vars)
- (push (nth 1 form) byte-compile-bound-variables)
- (if (eq (car form) 'defconst)
- (push (nth 1 form) byte-compile-const-variables)))
+ (when (and (symbolp (nth 1 form))
+ (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
+ (byte-compile-warning-enabled-p 'lexical))
+ (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
+ (nth 1 form)))
+ (push (nth 1 form) byte-compile-bound-variables)
+ (if (eq (car form) 'defconst)
+ (push (nth 1 form) byte-compile-const-variables))
(cond ((consp (nth 2 form))
(setq form (copy-sequence form))
(setcar (cdr (cdr form))
(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table)
(defun byte-compile-file-form-define-abbrev-table (form)
- (when (and (byte-compile-warning-enabled-p 'free-vars)
- (eq 'quote (car-safe (car-safe (cdr form)))))
- (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
+ (if (eq 'quote (car-safe (car-safe (cdr form))))
+ (push (car-safe (cdr (cadr form))) byte-compile-bound-variables))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
(defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (when (byte-compile-warning-enabled-p 'free-vars)
- (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
+ (push (nth 1 (nth 1 form)) byte-compile-bound-variables)
;; Don't compile the expression because it may be displayed to the user.
;; (when (eq (car-safe (nth 2 form)) 'quote)
;; ;; (nth 2 form) is meant to evaluate to an expression, so if we have the
;; 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
- (if (byte-compile-version-cond byte-compile-compatibility)
- "\n(fset '" "\n(defalias '")
+ "\n(defalias '"
bytecomp-name
(cond ((atom code)
(if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
;; Output the form by hand, that's much simpler than having
;; b-c-output-file-form analyze the defalias.
(byte-compile-output-docform
- (if (byte-compile-version-cond byte-compile-compatibility)
- "\n(fset '" "\n(defalias '")
+ "\n(defalias '"
bytecomp-name
(cond ((atom code)
(if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
;; Given a function made by byte-compile-lambda, make a form which produces it.
(defun byte-compile-byte-code-maker (fun)
(cond
- ((byte-compile-version-cond byte-compile-compatibility)
- ;; Return (quote (lambda ...)).
- (list 'quote (byte-compile-byte-code-unmake fun)))
;; ## atom is faster than compiled-func-p.
((atom fun) ; compiled function.
;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
(let ((compiled (byte-compile-top-level
(cons 'progn bytecomp-body) nil 'lambda)))
;; Build the actual byte-coded function.
- (if (and (eq 'byte-code (car-safe compiled))
- (not (byte-compile-version-cond
- byte-compile-compatibility)))
+ (if (eq 'byte-code (car-safe compiled))
(apply 'make-byte-code
(append (list bytecomp-arglist)
;; byte-string, constants-vector, stack depth
;; loaded, this function doesn't exist.
(or (not (memq bytecomp-handler
'(cl-byte-compile-compiler-macro)))
- (functionp bytecomp-handler))
- (not (and (byte-compile-version-cond
- byte-compile-compatibility)
- (get (get bytecomp-fn 'byte-opcode)
- 'emacs19-opcode))))
+ (functionp bytecomp-handler)))
(funcall bytecomp-handler form)
(byte-compile-normal-call form))
(if (byte-compile-warning-enabled-p 'cl-functions)
(if (or (not (symbolp bytecomp-var))
(byte-compile-const-symbol-p bytecomp-var
(not (eq base-op 'byte-varref))))
- (byte-compile-warn
- (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
- ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
- (t "variable reference to %s `%s'"))
- (if (symbolp bytecomp-var) "constant" "nonvariable")
- (prin1-to-string bytecomp-var))
+ (if (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
+ ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
+ (t "variable reference to %s `%s'"))
+ (if (symbolp bytecomp-var) "constant" "nonvariable")
+ (prin1-to-string bytecomp-var)))
(and (get bytecomp-var 'byte-obsolete-variable)
(not (memq bytecomp-var byte-compile-not-obsolete-vars))
(byte-compile-warn-obsolete bytecomp-var))
- (if (byte-compile-warning-enabled-p 'free-vars)
- (if (eq base-op 'byte-varbind)
- (push bytecomp-var byte-compile-bound-variables)
- (or (boundp bytecomp-var)
- (memq bytecomp-var byte-compile-bound-variables)
- (if (eq base-op 'byte-varset)
- (or (memq bytecomp-var byte-compile-free-assignments)
- (progn
- (byte-compile-warn "assignment to free variable `%s'"
- bytecomp-var)
- (push bytecomp-var byte-compile-free-assignments)))
- (or (memq bytecomp-var byte-compile-free-references)
- (progn
- (byte-compile-warn "reference to free variable `%s'"
- bytecomp-var)
- (push bytecomp-var byte-compile-free-references))))))))
+ (if (eq base-op 'byte-varbind)
+ (push bytecomp-var byte-compile-bound-variables)
+ (or (not (byte-compile-warning-enabled-p 'free-vars))
+ (boundp bytecomp-var)
+ (memq bytecomp-var byte-compile-bound-variables)
+ (if (eq base-op 'byte-varset)
+ (or (memq bytecomp-var byte-compile-free-assignments)
+ (progn
+ (byte-compile-warn "assignment to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-assignments)))
+ (or (memq bytecomp-var byte-compile-free-references)
+ (progn
+ (byte-compile-warn "reference to free variable `%s'"
+ bytecomp-var)
+ (push bytecomp-var byte-compile-free-references)))))))
(let ((tmp (assq bytecomp-var byte-compile-variables)))
(unless tmp
(setq tmp (list bytecomp-var))
;; which have special byte codes just for speed.
(defmacro byte-defop-compiler (function &optional compile-handler)
- ;; add a compiler-form for FUNCTION.
- ;; If function is a symbol, then the variable "byte-SYMBOL" must name
- ;; the opcode to be used. If function is a list, the first element
- ;; is the function and the second element is the bytecode-symbol.
- ;; The second element may be nil, meaning there is no opcode.
- ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
- ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
- ;; If it is nil, then the handler is "byte-compile-SYMBOL."
+ "Add a compiler-form for FUNCTION.
+If function is a symbol, then the variable \"byte-SYMBOL\" must name
+the opcode to be used. If function is a list, the first element
+is the function and the second element is the bytecode-symbol.
+The second element may be nil, meaning there is no opcode.
+COMPILE-HANDLER is the function to use to compile this byte-op, or
+may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
+If it is nil, then the handler is \"byte-compile-SYMBOL.\""
(let (opcode)
(if (symbolp function)
(setq opcode (intern (concat "byte-" (symbol-name function))))
''byte-opcode-invert (list 'quote function)))
fnform))))
-(defmacro byte-defop-compiler19 (function &optional compile-handler)
- ;; Just like byte-defop-compiler, but defines an opcode that will only
- ;; be used when byte-compile-compatibility is false.
- (if (and (byte-compile-single-version)
- byte-compile-compatibility)
- ;; #### instead of doing nothing, this should do some remprops,
- ;; #### to protect against the case where a single-version compiler
- ;; #### is loaded into a world that has contained a multi-version one.
- nil
- (list 'progn
- (list 'put
- (list 'quote
- (or (car (cdr-safe function))
- (intern (concat "byte-"
- (symbol-name (or (car-safe function) function))))))
- ''emacs19-opcode t)
- (list 'byte-defop-compiler function compile-handler))))
-
(defmacro byte-defop-compiler-1 (function &optional compile-handler)
(list 'byte-defop-compiler (list function nil) compile-handler))
(byte-defop-compiler current-buffer 0)
;;(byte-defop-compiler read-char 0) ;; obsolete
(byte-defop-compiler interactive-p 0)
-(byte-defop-compiler19 widen 0)
-(byte-defop-compiler19 end-of-line 0-1)
-(byte-defop-compiler19 forward-char 0-1)
-(byte-defop-compiler19 forward-line 0-1)
+(byte-defop-compiler widen 0)
+(byte-defop-compiler end-of-line 0-1)
+(byte-defop-compiler forward-char 0-1)
+(byte-defop-compiler forward-line 0-1)
(byte-defop-compiler symbolp 1)
(byte-defop-compiler consp 1)
(byte-defop-compiler stringp 1)
(byte-defop-compiler char-after 0-1)
(byte-defop-compiler set-buffer 1)
;;(byte-defop-compiler set-mark 1) ;; obsolete
-(byte-defop-compiler19 forward-word 0-1)
-(byte-defop-compiler19 char-syntax 1)
-(byte-defop-compiler19 nreverse 1)
-(byte-defop-compiler19 car-safe 1)
-(byte-defop-compiler19 cdr-safe 1)
-(byte-defop-compiler19 numberp 1)
-(byte-defop-compiler19 integerp 1)
-(byte-defop-compiler19 skip-chars-forward 1-2)
-(byte-defop-compiler19 skip-chars-backward 1-2)
+(byte-defop-compiler forward-word 0-1)
+(byte-defop-compiler char-syntax 1)
+(byte-defop-compiler nreverse 1)
+(byte-defop-compiler car-safe 1)
+(byte-defop-compiler cdr-safe 1)
+(byte-defop-compiler numberp 1)
+(byte-defop-compiler integerp 1)
+(byte-defop-compiler skip-chars-forward 1-2)
+(byte-defop-compiler skip-chars-backward 1-2)
(byte-defop-compiler eq 2)
(byte-defop-compiler memq 2)
(byte-defop-compiler cons 2)
(byte-defop-compiler get 2)
(byte-defop-compiler nth 2)
(byte-defop-compiler substring 2-3)
-(byte-defop-compiler19 (move-marker byte-set-marker) 2-3)
-(byte-defop-compiler19 set-marker 2-3)
-(byte-defop-compiler19 match-beginning 1)
-(byte-defop-compiler19 match-end 1)
-(byte-defop-compiler19 upcase 1)
-(byte-defop-compiler19 downcase 1)
-(byte-defop-compiler19 string= 2)
-(byte-defop-compiler19 string< 2)
-(byte-defop-compiler19 (string-equal byte-string=) 2)
-(byte-defop-compiler19 (string-lessp byte-string<) 2)
-(byte-defop-compiler19 equal 2)
-(byte-defop-compiler19 nthcdr 2)
-(byte-defop-compiler19 elt 2)
-(byte-defop-compiler19 member 2)
-(byte-defop-compiler19 assq 2)
-(byte-defop-compiler19 (rplaca byte-setcar) 2)
-(byte-defop-compiler19 (rplacd byte-setcdr) 2)
-(byte-defop-compiler19 setcar 2)
-(byte-defop-compiler19 setcdr 2)
-(byte-defop-compiler19 buffer-substring 2)
-(byte-defop-compiler19 delete-region 2)
-(byte-defop-compiler19 narrow-to-region 2)
-(byte-defop-compiler19 (% byte-rem) 2)
+(byte-defop-compiler (move-marker byte-set-marker) 2-3)
+(byte-defop-compiler set-marker 2-3)
+(byte-defop-compiler match-beginning 1)
+(byte-defop-compiler match-end 1)
+(byte-defop-compiler upcase 1)
+(byte-defop-compiler downcase 1)
+(byte-defop-compiler string= 2)
+(byte-defop-compiler string< 2)
+(byte-defop-compiler (string-equal byte-string=) 2)
+(byte-defop-compiler (string-lessp byte-string<) 2)
+(byte-defop-compiler equal 2)
+(byte-defop-compiler nthcdr 2)
+(byte-defop-compiler elt 2)
+(byte-defop-compiler member 2)
+(byte-defop-compiler assq 2)
+(byte-defop-compiler (rplaca byte-setcar) 2)
+(byte-defop-compiler (rplacd byte-setcdr) 2)
+(byte-defop-compiler setcar 2)
+(byte-defop-compiler setcdr 2)
+(byte-defop-compiler buffer-substring 2)
+(byte-defop-compiler delete-region 2)
+(byte-defop-compiler narrow-to-region 2)
+(byte-defop-compiler (% byte-rem) 2)
(byte-defop-compiler aset 3)
(byte-defop-compiler max byte-compile-associative)
(byte-defop-compiler min byte-compile-associative)
(byte-defop-compiler (+ byte-plus) byte-compile-associative)
-(byte-defop-compiler19 (* byte-mult) byte-compile-associative)
+(byte-defop-compiler (* byte-mult) byte-compile-associative)
-;;####(byte-defop-compiler19 move-to-column 1)
+;;####(byte-defop-compiler move-to-column 1)
(byte-defop-compiler-1 interactive byte-compile-noop)
\f
(byte-defop-compiler insert)
(byte-defop-compiler-1 function byte-compile-function-form)
(byte-defop-compiler-1 - byte-compile-minus)
-(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
-(byte-defop-compiler19 nconc)
+(byte-defop-compiler (/ byte-quo) byte-compile-quo)
+(byte-defop-compiler nconc)
(defun byte-compile-char-before (form)
(cond ((= 2 (length form))
(mapc 'byte-compile-form (cdr form))
(byte-compile-out
(aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
- ((and (< count 256) (not (byte-compile-version-cond
- byte-compile-compatibility)))
+ ((< count 256)
(mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-listN count))
(t (byte-compile-normal-call form)))))
;; Concat of one arg is not a no-op if arg is not a string.
((= count 0)
(byte-compile-form ""))
- ((and (< count 256) (not (byte-compile-version-cond
- byte-compile-compatibility)))
+ ((< count 256)
(mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-concatN count))
((byte-compile-normal-call form)))))
(byte-compile-constant
(cond ((symbolp (nth 1 form))
(nth 1 form))
- ;; If we're not allowed to use #[] syntax, then output a form like
- ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code.
- ;; In this situation, calling make-byte-code at run-time will usually
- ;; be less efficient than processing a call to byte-code.
- ((byte-compile-version-cond byte-compile-compatibility)
- (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form))))
((byte-compile-lambda (nth 1 form))))))
(defun byte-compile-indent-to (form)
(defun byte-compile-insert (form)
(cond ((null (cdr form))
(byte-compile-constant nil))
- ((and (not (byte-compile-version-cond
- byte-compile-compatibility))
- (<= (length form) 256))
+ ((<= (length form) 256)
(mapc 'byte-compile-form (cdr form))
(if (cdr (cdr form))
(byte-compile-out 'byte-insertN (length (cdr form)))
(setq for-effect nil)))
(defun byte-compile-setq-default (form)
- (let ((bytecomp-args (cdr form))
- setters)
- (while bytecomp-args
- (let ((var (car bytecomp-args)))
- (if (or (not (symbolp var))
- (byte-compile-const-symbol-p var t))
- (byte-compile-warn
- "variable assignment to %s `%s'"
- (if (symbolp var) "constant" "nonvariable")
- (prin1-to-string var)))
- (push (list 'set-default (list 'quote var) (car (cdr bytecomp-args)))
- setters))
- (setq bytecomp-args (cdr (cdr bytecomp-args))))
- (byte-compile-form (cons 'progn (nreverse setters)))))
+ (setq form (cdr form))
+ (if (> (length form) 2)
+ (let ((setters ()))
+ (while (consp form)
+ (push `(setq-default ,(pop form) ,(pop form)) setters))
+ (byte-compile-form (cons 'progn (nreverse setters))))
+ (let ((var (car form)))
+ (and (or (not (symbolp var))
+ (byte-compile-const-symbol-p var t))
+ (byte-compile-warning-enabled-p 'constants)
+ (byte-compile-warn
+ "variable assignment to %s `%s'"
+ (if (symbolp var) "constant" "nonvariable")
+ (prin1-to-string var)))
+ (byte-compile-normal-call `(set-default ',var ,@(cdr form))))))
+
+(byte-defop-compiler-1 set-default)
+(defun byte-compile-set-default (form)
+ (let ((varexp (car-safe (cdr-safe form))))
+ (if (eq (car-safe varexp) 'quote)
+ ;; If the varexp is constant, compile it as a setq-default
+ ;; so we get more warnings.
+ (byte-compile-setq-default `(setq-default ,(car-safe (cdr varexp))
+ ,@(cddr form)))
+ (byte-compile-normal-call form))))
(defun byte-compile-quote (form)
(byte-compile-constant (car (cdr 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-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)))
- (if (byte-compile-version-cond byte-compile-compatibility)
- (progn
- (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
- (list 'fset
- (list 'quote (nth 1 form))
- (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t))))
- (byte-compile-discard))
- ;; We prefer to generate a defalias form so it will record the function
- ;; definition just like interpreting a defun.
- (byte-compile-form
- (list 'defalias
- (list 'quote (nth 1 form))
- (byte-compile-byte-code-maker
- (byte-compile-lambda (cdr (cdr form)) t)))
- t))
+ ;; We prefer to generate a defalias form so it will record the function
+ ;; definition just like interpreting a defun.
+ (byte-compile-form
+ (list 'defalias
+ (list 'quote (nth 1 form))
+ (byte-compile-byte-code-maker
+ (byte-compile-lambda (cdr (cdr form)) t)))
+ t)
(byte-compile-constant (nth 1 form)))
(defun byte-compile-defmacro (form)
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
+ (when (and (symbolp (nth 1 form))
+ (not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
+ (byte-compile-warning-enabled-p 'lexical))
+ (byte-compile-warn "global/dynamic var `%s' lacks a prefix"
+ (nth 1 form)))
(let ((fun (nth 0 form))
(var (nth 1 form))
(value (nth 2 form))
(if (= 1 ncall) "" "s")
(if (< ncall 2) "requires" "accepts only")
"2-3")))
- (when (byte-compile-warning-enabled-p 'free-vars)
- (push var byte-compile-bound-variables)
- (if (eq fun 'defconst)
- (push var byte-compile-const-variables)))
+ (push var byte-compile-bound-variables)
+ (if (eq fun 'defconst)
+ (push var byte-compile-const-variables))
(byte-compile-body-do-effect
(list
;; Put the defined variable in this library's load-history entry
`(push ',var current-load-list))
(when (> (length form) 3)
(when (and string (not (stringp string)))
- (byte-compile-warn "third arg to `%s %s' is not a string: %s"
- fun var string))
+ (byte-compile-warn "third arg to `%s %s' is not a string: %s"
+ fun var string))
`(put ',var 'variable-documentation ,string))
(if (cddr form) ; `value' provided
(let ((byte-compile-not-obsolete-vars (list var)))
(message "Generating call tree...(finding uncalled functions...)")
(setq rest byte-compile-call-tree)
- (let ((uncalled nil))
+ (let (uncalled def)
(while rest
(or (nth 1 (car rest))
- (null (setq f (car (car rest))))
- (functionp (byte-compile-fdefinition f t))
- (commandp (byte-compile-fdefinition f nil))
+ (null (setq f (caar rest)))
+ (progn
+ (setq def (byte-compile-fdefinition f t))
+ (and (eq (car-safe def) 'macro)
+ (eq (car-safe (cdr-safe def)) 'lambda)
+ (setq def (cdr def)))
+ (functionp def))
+ (progn
+ (setq def (byte-compile-fdefinition f nil))
+ (and (eq (car-safe def) 'macro)
+ (eq (car-safe (cdr-safe def)) 'lambda)
+ (setq def (cdr def)))
+ (commandp def))
(setq uncalled (cons f uncalled)))
(setq rest (cdr rest)))
(if uncalled
(insert "Noninteractive functions not known to be called:\n ")
(setq p (point))
(insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
- (fill-region-as-paragraph p (point)))))
- )
- (message "Generating call tree...done.")
- ))
+ (fill-region-as-paragraph p (point))))))
+ (message "Generating call tree...done.")))
\f
;;;###autoload
(defvar byte-code-meter)
(defun byte-compile-report-ops ()
+ (or (boundp 'byte-metering-on)
+ (error "You must build Emacs with -DBYTE_CODE_METER to use this"))
(with-output-to-temp-buffer "*Meter*"
(set-buffer "*Meter*")
(let ((i 0) n op off)
(run-hooks 'bytecomp-load-hook)
-;; arch-tag: 9c97b0f0-8745-4571-bfc3-8dceb677292a
;;; bytecomp.el ends here
HCoop / bpt / emacs.git / blobdiff