-;;; bytecomp.el --- compilation of Lisp code into byte code.
+;;; bytecomp.el --- compilation of Lisp code into byte code
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001
+;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; Maintainer: FSF
;; Keywords: lisp
-;;; This version incorporates changes up to version 2.10 of the
+;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.44 $")
+(defconst byte-compile-version "$Revision: 2.93 $")
;; This file is part of GNU Emacs.
;;; Commentary:
;; The Emacs Lisp byte compiler. This crunches lisp source into a sort
-;; of p-code which takes up less space and can be interpreted faster.
+;; of p-code (`lapcode') which takes up less space and can be interpreted
+;; faster. [`LAP' == `Lisp Assembly Program'.]
;; The user entry points are byte-compile-file and byte-recompile-directory.
;;; Code:
;; - functions being redefined as macros, or vice-versa;
;; - functions or macros defined multiple times in the same file;
;; - functions being called with the incorrect number of arguments;
-;; - functions being called which are not defined globally, in the
+;; - functions being called which are not defined globally, in the
;; file, or as autoloads;
;; - assignment and reference of undeclared free variables;
;; - various syntax errors;
;;
;; byte-compile-verbose Whether to report the function currently being
;; compiled in the minibuffer;
-;; byte-optimize Whether to do optimizations; this may be
+;; byte-optimize Whether to do optimizations; this may be
;; t, nil, 'source, or 'byte;
-;; byte-optimize-log Whether to report (in excruciating detail)
+;; 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
;; 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
+;; 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
;; 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')
;; byte-compile-compatibility Whether the compiler should
;; generate .elc files which can be loaded into
;; generic emacs 18.
;;
;; (inline (foo 1 2 3)) ;; `foo' will be open-coded
;; or...
-;; (inline ;; `foo' and `baz' will be
+;; (inline ;; `foo' and `baz' will be
;; (foo 1 2 3 (bar 5)) ;; open-coded, but `bar' will not.
;; (baz 0))
;;
;;
;; o The command compile-defun is analogous to eval-defun.
;;
-;; o If you run byte-compile-file on a filename which is visited in a
+;; o If you run byte-compile-file on a filename which is visited in a
;; buffer, and that buffer is modified, you are asked whether you want
;; to save the buffer before compiling.
;;
;; This really ought to be loaded already!
(load-library "byte-run"))
-;;; The feature of compiling in a specific target Emacs version
-;;; has been turned off because compile time options are a bad idea.
+;; 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.
+;; 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)
;; (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)))
(setq filename (byte-compiler-base-file-name filename))
(setq filename (file-name-sans-versions filename))
(cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc")))))
+ (concat (substring filename 0 (string-match ";" filename)) "c"))
+ ((string-match emacs-lisp-file-regexp filename)
+ (concat (substring filename 0 (match-beginning 0)) ".elc"))
+ (t (concat filename ".elc")))))
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
;; (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
+;; "*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.")
(defvar byte-compile-dynamic nil
"If non-nil, compile function bodies so they load lazily.
-They are hidden comments in the compiled file, and brought into core when the
+They are hidden in comments in the compiled file,
+and each one is brought into core when the
function is called.
To enable this option, make it a file-local variable
:type 'boolean)
(defconst byte-compile-warning-types
- '(redefine callargs free-vars unresolved obsolete))
+ '(redefine callargs free-vars unresolved obsolete noruntime))
(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
Elements of the list may be be:
callargs lambda calls with args that don't match the definition.
redefine function cell redefined from a macro to a lambda or vice
versa, or redefined to take a different number of arguments.
- obsolete obsolete variables and functions.
-
-See also the macro `byte-compiler-options'."
+ obsolete obsolete variables and functions."
:group 'bytecomp
:type '(choice (const :tag "All" t)
(set :menu-tag "Some"
(const free-vars) (const unresolved)
(const callargs) (const redefined)
- (const obsolete))))
+ (const obsolete) (const noruntime))))
(defcustom byte-compile-generate-call-tree nil
"*Non-nil means collect call-graph information when compiling.
invoked interactively are excluded from this list."
:group 'bytecomp
:type '(choice (const :tag "Yes" t) (const :tag "No" nil)
- (const :tag "Ask" lambda)))
+ (other :tag "Ask" lambda)))
-(defconst byte-compile-call-tree nil "Alist of functions and their call tree.
+(defvar byte-compile-call-tree nil "Alist of functions and their call tree.
Each element looks like
\(FUNCTION CALLERS CALLS\)
;; "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
+;; 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")
+ "List of all constants encountered during compilation of this form.")
(defvar byte-compile-variables nil
- "list of all variables encountered during compilation of this form")
+ "List of all variables encountered during compilation of this form.")
(defvar byte-compile-bound-variables nil
- "list of variables bound in the context of the current form; this list
-lives partly on the stack.")
+ "List of variables bound in the context of the current form.
+This list lives partly on the stack.")
(defvar byte-compile-free-references)
(defvar byte-compile-free-assignments)
;; (byte-compiler-options . (lambda (&rest forms)
;; (apply 'byte-compiler-options-handler forms)))
(eval-when-compile . (lambda (&rest body)
- (list 'quote (eval (byte-compile-top-level
- (cons 'progn body))))))
+ (list 'quote
+ (byte-compile-eval (byte-compile-top-level
+ (cons 'progn body))))))
(eval-and-compile . (lambda (&rest body)
(eval (cons 'progn body))
(cons 'progn body))))
\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
(defvar byte-compile-unresolved-functions nil
- "Alist of undefined functions to which calls have been compiled (used for
-warnings when the function is later defined with incorrect args).")
+ "Alist of undefined functions to which calls have been compiled.
+Used for warnings when the function is not known to be defined or is later
+defined with incorrect args.")
(defvar byte-compile-tag-number 0)
(defvar byte-compile-output nil
\f
;;; The byte codes; this information is duplicated in bytecomp.c
-(defconst byte-code-vector nil
+(defvar byte-code-vector nil
"An array containing byte-code names indexed by byte-code values.")
-(defconst byte-stack+-info nil
+(defvar byte-stack+-info nil
"An array with the stack adjustment for each byte-code.")
(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
(get 'byte-code-vector 'tmp-compile-time-value)
'byte-stack+-info
(get 'byte-stack+-info 'tmp-compile-time-value))
- ;; emacs-18 has no REMPROP.
(put 'byte-code-vector 'tmp-compile-time-value nil)
(put 'byte-stack+-info 'tmp-compile-time-value nil)))
(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
(byte-defop 133 -1 byte-goto-if-nil-else-pop
- "to examine top-of-stack, jump and don't pop it if it's nil,
+ "to examine top-of-stack, jump and don't pop it if it's nil,
otherwise pop it")
(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
- "to examine top-of-stack, jump and don't pop it if it's non nil,
+ "to examine top-of-stack, jump and don't pop it if it's non nil,
otherwise pop it")
(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
(byte-defop 142 -1 byte-unwind-protect
"for unwind-protect. Takes, on stack, an expression for the unwind-action")
-;; For condition-case. Takes, on stack, the variable to bind,
+;; For condition-case. Takes, on stack, the variable to bind,
;; an expression for the body, and a list of clauses.
(byte-defop 143 -2 byte-condition-case)
(byte-extrude-byte-code-vectors)
\f
;;; lapcode generator
-;;;
-;;; the byte-compiler now does source -> lapcode -> bytecode instead of
-;;; source -> bytecode, because it's a lot easier to make optimizations
-;;; on lapcode than on bytecode.
-;;;
-;;
; Elements of the lapcode list are of the form (<instruction> . <parameter>)
-;;; where instruction is a symbol naming a byte-code instruction,
-;;; and parameter is an argument to that instruction, if any.
-;;;
-;;; The instruction can be the pseudo-op TAG, which means that this position
-;;; in the instruction stream is a target of a goto. (car PARAMETER) will be
-;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
-;;; parameter for some goto op.
-;;;
-;;; If the operation is varbind, varref, varset or push-constant, then the
-;;; parameter is (variable/constant . index_in_constant_vector).
-;;;
-;;; First, the source code is macroexpanded and optimized in various ways.
-;;; Then the resultant code is compiled into lapcode. Another set of
-;;; optimizations are then run over the lapcode. Then the variables and
-;;; constants referenced by the lapcode are collected and placed in the
-;;; constants-vector. (This happens now so that variables referenced by dead
-;;; code don't consume space.) And finally, the lapcode is transformed into
-;;; compacted byte-code.
-;;;
-;;; A distinction is made between variables and constants because the variable-
-;;; referencing instructions are more sensitive to the variables being near the
-;;; front of the constants-vector than the constant-referencing instructions.
-;;; Also, this lets us notice references to free variables.
+;;
+;; the byte-compiler now does source -> lapcode -> bytecode instead of
+;; source -> bytecode, because it's a lot easier to make optimizations
+;; on lapcode than on bytecode.
+;;
+;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
+;; where instruction is a symbol naming a byte-code instruction,
+;; and parameter is an argument to that instruction, if any.
+;;
+;; The instruction can be the pseudo-op TAG, which means that this position
+;; in the instruction stream is a target of a goto. (car PARAMETER) will be
+;; the PC for this location, and the whole instruction "(TAG pc)" will be the
+;; parameter for some goto op.
+;;
+;; If the operation is varbind, varref, varset or push-constant, then the
+;; parameter is (variable/constant . index_in_constant_vector).
+;;
+;; First, the source code is macroexpanded and optimized in various ways.
+;; Then the resultant code is compiled into lapcode. Another set of
+;; optimizations are then run over the lapcode. Then the variables and
+;; constants referenced by the lapcode are collected and placed in the
+;; constants-vector. (This happens now so that variables referenced by dead
+;; code don't consume space.) And finally, the lapcode is transformed into
+;; compacted byte-code.
+;;
+;; A distinction is made between variables and constants because the variable-
+;; referencing instructions are more sensitive to the variables being near the
+;; front of the constants-vector than the constant-referencing instructions.
+;; Also, this lets us notice references to free variables.
(defun byte-compile-lapcode (lap)
"Turns lapcode into bytecode. The lapcode is destroyed."
(concat (nreverse bytes))))
\f
+;;; compile-time evaluation
+
+(defun byte-compile-eval (form)
+ "Eval FORM and mark the functions defined therein.
+Each function's symbol gets marked with the `byte-compile-noruntime' property."
+ (let ((hist-orig load-history)
+ (hist-nil-orig current-load-list))
+ (prog1 (eval form)
+ (when (memq 'noruntime byte-compile-warnings)
+ (let ((hist-new load-history)
+ (hist-nil-new current-load-list))
+ ;; Go through load-history, look for newly loaded files
+ ;; and mark all the functions defined therein.
+ (while (and hist-new (not (eq hist-new hist-orig)))
+ (let ((xs (pop hist-new)))
+ ;; Make sure the file was not already loaded before.
+ (unless (assoc (car xs) hist-orig)
+ (dolist (s xs)
+ (cond
+ ((symbolp s) (put s 'byte-compile-noruntime t))
+ ((and (consp s) (eq 'autoload (car s)))
+ (put (cdr s) 'byte-compile-noruntime t)))))))
+ ;; Go through current-load-list for the locally defined funs.
+ (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
+ (let ((s (pop hist-nil-new)))
+ (when (symbolp s)
+ (put s 'byte-compile-noruntime t)))))))))
+
+\f
;;; byte compiler messages
(defvar byte-compile-current-form nil)
-(defvar byte-compile-current-file nil)
(defvar byte-compile-dest-file nil)
+(defvar byte-compile-current-file nil)
(defmacro byte-compile-log (format-string &rest args)
(list 'and
(cons 'format
(cons format-string
(mapcar
- '(lambda (x)
- (if (symbolp x) (list 'prin1-to-string x) x))
+ (lambda (x)
+ (if (symbolp x) (list 'prin1-to-string x) x))
args)))))))
-(defconst byte-compile-last-warned-form nil)
+(defvar byte-compile-last-warned-form nil)
+(defvar byte-compile-last-logged-file nil)
+
+(defvar byte-compile-last-line nil
+ "Last known line number in the input.")
+
+
+(defun byte-compile-display-log-head-p ()
+ (and (not (eq byte-compile-current-form :end))
+ (or (and byte-compile-current-file
+ (not (equal byte-compile-current-file
+ byte-compile-last-logged-file)))
+ (and byte-compile-last-warned-form
+ (not (eq byte-compile-current-form
+ byte-compile-last-warned-form))))))
+
+(defun byte-goto-log-buffer ()
+ (set-buffer (get-buffer-create "*Compile-Log*"))
+ (unless (eq major-mode 'compilation-mode)
+ (compilation-mode)))
;; Log a message STRING in *Compile-Log*.
;; Also log the current function and file if not already done.
(defun byte-compile-log-1 (string &optional fill)
- (cond (noninteractive
- (if (or byte-compile-current-file
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))
- (message "While compiling %s%s:"
- (or byte-compile-current-form "toplevel forms")
- (if byte-compile-current-file
- (if (stringp byte-compile-current-file)
- (concat " in file " byte-compile-current-file)
- (concat " in buffer "
- (buffer-name byte-compile-current-file)))
- "")))
- (message " %s" string))
- (t
- (save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
- (goto-char (point-max))
- (cond ((or byte-compile-current-file
- (and byte-compile-last-warned-form
- (not (eq byte-compile-current-form
- byte-compile-last-warned-form))))
- (if byte-compile-current-file
- (insert "\n\^L\n" (current-time-string) "\n"))
- (insert "While compiling "
- (if byte-compile-current-form
- (format "%s" byte-compile-current-form)
- "toplevel forms"))
- (if byte-compile-current-file
- (if (stringp byte-compile-current-file)
- (insert " in file " byte-compile-current-file)
- (insert " in buffer "
- (buffer-name byte-compile-current-file))))
- (insert ":\n")))
- (insert " " string "\n")
- (if (and fill (not (string-match "\n" string)))
- (let ((fill-prefix " ")
- (fill-column 78))
- (fill-paragraph nil)))
- )))
- (setq byte-compile-current-file nil
+ (let* ((file (cond ((stringp byte-compile-current-file)
+ (format "%s:" byte-compile-current-file))
+ ((bufferp byte-compile-current-file)
+ (format "Buffer %s:"
+ (buffer-name byte-compile-current-file)))
+ (t "")))
+ (pos (if (and byte-compile-current-file
+ (integerp byte-compile-last-line))
+ (format "%d:" byte-compile-last-line)
+ ""))
+ (form (or byte-compile-current-form "toplevel form")))
+ (cond (noninteractive
+ (when (byte-compile-display-log-head-p)
+ (message "%s In %s" file form))
+ (message "%s%s %s" file pos string))
+ (t
+ (save-excursion
+ (byte-goto-log-buffer)
+ (goto-char (point-max))
+ (when (byte-compile-display-log-head-p)
+ (insert (format "\nIn %s" form)))
+ (insert (format "\n%s%s\n%s\n" file pos string))
+ (when (and fill (not (string-match "\n" string)))
+ (let ((fill-prefix " ") (fill-column 78))
+ (fill-paragraph nil)))))))
+ (setq byte-compile-last-logged-file byte-compile-current-file
byte-compile-last-warned-form byte-compile-current-form))
;; Log the start of a file in *Compile-Log*, and mark it as done.
;; But do nothing in batch mode.
(defun byte-compile-log-file ()
- (and byte-compile-current-file (not noninteractive)
+ (and byte-compile-current-file
+ (not (equal byte-compile-current-file byte-compile-last-logged-file))
+ (not noninteractive)
(save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
+ (byte-goto-log-buffer)
(goto-char (point-max))
(insert "\n\^L\nCompiling "
(if (stringp byte-compile-current-file)
(concat "file " byte-compile-current-file)
(concat "buffer " (buffer-name byte-compile-current-file)))
" at " (current-time-string) "\n")
- (setq byte-compile-current-file nil))))
+ (setq byte-compile-last-logged-file byte-compile-current-file))))
(defun byte-compile-warn (format &rest args)
(setq format (apply 'format format args))
(if byte-compile-error-on-warn
(error "%s" format) ; byte-compile-file catches and logs it
- (byte-compile-log-1 (concat "** " format) t)
-;;; It is useless to flash warnings too fast to be read.
-;;; Besides, they will all be shown at the end.
-;;; (or noninteractive ; already written on stdout.
-;;; (message "Warning: %s" format))
+ (byte-compile-log-1 (concat "warning: " format) t)
+ ;; It is useless to flash warnings too fast to be read.
+ ;; Besides, they will all be shown at the end.
+ ;; (or noninteractive ; already written on stdout.
+ ;; (message "Warning: %s" format))
))
;;; This function should be used to report errors that have halted
(defun byte-compile-report-error (error-info)
(setq byte-compiler-error-flag t)
(byte-compile-log-1
- (concat "!! "
+ (concat "error: "
(format (if (cdr error-info) "%s (%s)" "%s")
- (get (car error-info) 'error-message)
+ (downcase (get (car error-info) 'error-message))
(prin1-to-string (cdr error-info))))))
;;; Used by make-obsolete.
(defun byte-compile-obsolete (form)
- (let ((new (get (car form) 'byte-obsolete-info)))
+ (let* ((new (get (car form) 'byte-obsolete-info))
+ (handler (nth 1 new))
+ (when (nth 2 new)))
(if (memq 'obsolete byte-compile-warnings)
- (byte-compile-warn "%s is an obsolete function; %s" (car form)
+ (byte-compile-warn "%s is an obsolete function%s; %s" (car form)
+ (if when (concat " since " when) "")
(if (stringp (car new))
(car new)
- (format "use %s instead." (car new)))))
- (funcall (or (cdr new) 'byte-compile-normal-call) form)))
+ (format "use %s instead." (car new)))))
+ (funcall (or handler 'byte-compile-normal-call) form)))
\f
;; Compiler options
;; val)))
;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something
+;; #### 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)
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
(byte-compile-fdefinition (car form) t)))
- (sig (and def (byte-compile-arglist-signature
- (if (eq 'lambda (car-safe def))
- (nth 1 def)
- (if (byte-code-function-p def)
- (aref def 0)
- '(&rest def))))))
+ (sig (if def
+ (byte-compile-arglist-signature
+ (if (eq 'lambda (car-safe def))
+ (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))))))
(ncall (length (cdr form))))
+ ;; Check many or unevalled from subr-arity.
+ (if (and (cdr-safe sig)
+ (not (numberp (cdr sig))))
+ (setcdr sig nil))
(if sig
(if (or (< ncall (car sig))
(and (cdr sig) (> ncall (cdr sig))))
"requires"
"accepts only")
(byte-compile-arglist-signature-string sig)))
- (or (fboundp (car form)) ; might be a subr or autoload.
- (eq (car form) byte-compile-current-form) ; ## this doesn't work with recursion.
- ;; It's a currently-undefined function. Remember number of args in call.
+ (or (and (fboundp (car form)) ; might be a subr or autoload.
+ (not (get (car form) 'byte-compile-noruntime)))
+ (eq (car form) byte-compile-current-form) ; ## this doesn't work
+ ; with recursion.
+ ;; It's a currently-undefined function.
+ ;; Remember number of args in call.
(let ((cons (assq (car form) byte-compile-unresolved-functions))
(n (length (cdr form))))
(if cons
(byte-compile-arglist-signature-string sig)
(if (equal sig '(1 . 1)) " arg" " args")
(byte-compile-arglist-signature-string (cons min max))))
-
+
(setq byte-compile-unresolved-functions
(delq calls byte-compile-unresolved-functions)))))
)))
-;; If we have compiled any calls to functions which are not known to be
+(defun byte-compile-print-syms (str1 strn syms)
+ (cond ((and (cdr syms) (not noninteractive))
+ (let* ((str strn)
+ (L (length str))
+ s)
+ (while syms
+ (setq s (symbol-name (pop syms))
+ L (+ L (length s) 2))
+ (if (< L (1- fill-column))
+ (setq str (concat str " " s (and syms ",")))
+ (setq str (concat str "\n " s (and syms ","))
+ L (+ (length s) 4))))
+ (byte-compile-warn "%s" str)))
+ ((cdr syms)
+ (byte-compile-warn "%s %s"
+ strn
+ (mapconcat #'symbol-name syms ", ")))
+
+ (syms
+ (byte-compile-warn str1 (car syms)))))
+
+;; If we have compiled any calls to functions which are not known to be
;; defined, issue a warning enumerating them.
;; `unresolved' in the list `byte-compile-warnings' disables this.
(defun byte-compile-warn-about-unresolved-functions ()
- (if (memq 'unresolved byte-compile-warnings)
- (let ((byte-compile-current-form "the end of the data"))
- (if (cdr byte-compile-unresolved-functions)
- (let* ((str "The following functions are not known to be defined:")
- (L (length str))
- (rest (reverse byte-compile-unresolved-functions))
- s)
- (while rest
- (setq s (symbol-name (car (car rest)))
- L (+ L (length s) 2)
- rest (cdr rest))
- (if (< L (1- fill-column))
- (setq str (concat str " " s (and rest ",")))
- (setq str (concat str "\n " s (and rest ","))
- L (+ (length s) 4))))
- (byte-compile-warn "%s" str))
- (if byte-compile-unresolved-functions
- (byte-compile-warn "the function %s is not known to be defined."
- (car (car byte-compile-unresolved-functions)))))))
+ (when (memq 'unresolved byte-compile-warnings)
+ (let ((byte-compile-current-form :end)
+ (noruntime nil)
+ (unresolved nil))
+ ;; Separate the functions that will not be available at runtime
+ ;; from the truly unresolved ones.
+ (dolist (f byte-compile-unresolved-functions)
+ (setq f (car f))
+ (if (fboundp f) (push f noruntime) (push f unresolved)))
+ ;; Complain about the no-run-time functions
+ (byte-compile-print-syms
+ "the function `%s' might not be defined at runtime."
+ "the following functions might not be defined at runtime:"
+ noruntime)
+ ;; Complain about the unresolved functions
+ (byte-compile-print-syms
+ "the function `%s' is not known to be defined."
+ "the following functions are not known to be defined:"
+ unresolved)))
nil)
\f
+(defsubst byte-compile-const-symbol-p (symbol)
+ (or (memq symbol '(nil t))
+ (keywordp symbol)))
+
(defmacro byte-compile-constp (form)
- ;; Returns non-nil if FORM is a constant.
- (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
- ((not (symbolp (, form))))
- ((memq (, form) '(nil t))))))
+ "Return non-nil if FORM is a constant."
+ `(cond ((consp ,form) (eq (car ,form) 'quote))
+ ((not (symbolp ,form)))
+ ((byte-compile-const-symbol-p ,form))))
(defmacro byte-compile-close-variables (&rest body)
(cons 'let
(defvar byte-compile-warnings-point-max nil)
(defmacro displaying-byte-compile-warnings (&rest body)
- (list 'let
- '((byte-compile-warnings-point-max byte-compile-warnings-point-max))
+ `(let ((byte-compile-warnings-point-max byte-compile-warnings-point-max))
;; Log the file name.
- '(byte-compile-log-file)
+ (byte-compile-log-file)
;; Record how much is logged now.
;; We will display the log buffer if anything more is logged
;; before the end of BODY.
- '(or byte-compile-warnings-point-max
- (save-excursion
- (set-buffer (get-buffer-create "*Compile-Log*"))
- (setq byte-compile-warnings-point-max (point-max))))
- (list 'unwind-protect
- (list 'condition-case 'error-info
- (cons 'progn body)
- '(error
- (byte-compile-report-error error-info)))
- '(save-excursion
- ;; If there were compilation warnings, display them.
- (set-buffer "*Compile-Log*")
- (if (= byte-compile-warnings-point-max (point-max))
- nil
- (select-window
- (prog1 (selected-window)
- (select-window (display-buffer (current-buffer)))
- (goto-char byte-compile-warnings-point-max)
- (beginning-of-line)
- (forward-line -1)
- (recenter 0))))))))
+ (unless byte-compile-warnings-point-max
+ (save-excursion
+ (byte-goto-log-buffer)
+ (setq byte-compile-warnings-point-max (point-max))))
+ (unwind-protect
+ (condition-case error-info
+ (progn ,@body)
+ (error (byte-compile-report-error error-info)))
+ (with-current-buffer "*Compile-Log*"
+ ;; If there were compilation warnings, display them.
+ (unless (= byte-compile-warnings-point-max (point-max))
+ (select-window
+ (prog1 (selected-window)
+ (select-window (display-buffer (current-buffer)))
+ (goto-char byte-compile-warnings-point-max)
+ (beginning-of-line)
+ (forward-line -1)
+ (recenter 0))))))))
\f
;;;###autoload
(save-some-buffers)
(force-mode-line-update))
(let ((directories (list (expand-file-name directory)))
+ (skip-count 0)
+ (fail-count 0)
(file-count 0)
(dir-count 0)
last-dir)
(displaying-byte-compile-warnings
(while directories
(setq directory (car directories))
- (or noninteractive (message "Checking %s..." directory))
+ (message "Checking %s..." directory)
(let ((files (directory-files directory))
source dest)
- (while files
- (setq source (expand-file-name (car files) directory))
- (if (and (not (member (car files) '("." ".." "RCS" "CVS")))
+ (dolist (file files)
+ (setq source (expand-file-name file directory))
+ (if (and (not (member file '("." ".." "RCS" "CVS")))
(file-directory-p source)
(not (file-symlink-p source)))
;; This file is a subdirectory. Handle them differently.
- (if (or (null arg)
- (eq 0 arg)
- (y-or-n-p (concat "Check " source "? ")))
- (setq directories
- (nconc directories (list source))))
+ (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))
(setq dest (byte-compile-dest-file source))
(if (file-exists-p dest)
(y-or-n-p (concat "Compile " source "? "))))))
(progn (if (and noninteractive (not byte-compile-verbose))
(message "Compiling %s..." source))
- (byte-compile-file source)
+ (let ((res (byte-compile-file source)))
+ (cond ((eq res 'no-byte-compile)
+ (setq skip-count (1+ skip-count)))
+ ((eq res t)
+ (setq file-count (1+ file-count)))
+ ((eq res nil)
+ (setq fail-count (1+ fail-count)))))
(or noninteractive
(message "Checking %s..." directory))
- (setq file-count (1+ file-count))
(if (not (eq last-dir directory))
(setq last-dir directory
dir-count (1+ dir-count)))
- )))
- (setq files (cdr files))))
+ )))))
(setq directories (cdr directories))))
- (message "Done (Total of %d file%s compiled%s)"
+ (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) "")
+ (if (> skip-count 0) (format ", %d skipped" skip-count) "")
(if (> dir-count 1) (format " in %d directories" dir-count) ""))))
+(defvar no-byte-compile nil
+ "Non-nil to prevent byte-compiling of emacs-lisp code.
+This is normally set in local file variables at the end of the elisp file:
+
+;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
+
;;;###autoload
(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 made by appending `c' to the end of FILENAME.
-With prefix arg (noninteractively: 2nd arg), load the file after compiling.
-The value is t if there were no errors, nil if errors."
+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 ((file buffer-file-name)
(or noninteractive
(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))))
+ (y-or-n-p (format "Save buffer %s first? " (buffer-name b))))
(save-excursion (set-buffer b) (save-buffer)))))
- (if byte-compile-verbose
- (message "Compiling %s..." filename))
(let ((byte-compile-current-file filename)
+ (byte-compile-last-logged-file nil)
+ (set-auto-coding-for-load t)
target-file input-buffer output-buffer
byte-compile-dest-file)
(setq target-file (byte-compile-dest-file filename))
(setq input-buffer (get-buffer-create " *Compiler Input*"))
(set-buffer input-buffer)
(erase-buffer)
+ (setq buffer-file-coding-system nil)
;; Always compile an Emacs Lisp file as multibyte
- ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-x
+ ;; unless the file itself forces unibyte with -*-coding: raw-text;-*-
(set-buffer-multibyte t)
(insert-file-contents filename)
+ ;; Mimic the way after-insert-file-set-buffer-file-coding-system
+ ;; can make the buffer unibyte when visiting this file.
+ (when (or (eq last-coding-system-used 'no-conversion)
+ (eq (coding-system-type last-coding-system-used) 5))
+ ;; For coding systems no-conversion and raw-text...,
+ ;; edit the buffer as unibyte.
+ (set-buffer-multibyte nil))
;; Run hooks including the uncompression hook.
;; If they change the file name, then change it for the output also.
(let ((buffer-file-name filename)
(setq filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
(setq default-directory (file-name-directory 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
- ;; within byte-compile-from-buffer lingers in that buffer.
- (setq output-buffer (byte-compile-from-buffer input-buffer filename))
- (if byte-compiler-error-flag
- nil
+ ;; 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 filename)
+ (with-current-buffer input-buffer no-byte-compile))
+ (if (file-exists-p target-file)
+ (condition-case nil (delete-file target-file) (error nil)))
+ ;; We successfully didn't compile this file.
+ 'no-byte-compile)
(if byte-compile-verbose
- (message "Compiling %s...done" filename))
- (kill-buffer input-buffer)
- (save-excursion
- (set-buffer output-buffer)
- (goto-char (point-max))
- (insert "\n") ; aaah, unix.
- (let ((vms-stmlf-recfm t))
- (if (file-writable-p target-file)
- ;; We must disable any code conversion here.
- (let ((coding-system-for-write 'no-conversion))
- (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
- (setq buffer-file-type t))
- (write-region 1 (point-max) target-file))
- ;; This is just to give a better error message than
- ;; write-region
- (signal 'file-error
- (list "Opening output file"
- (if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
- target-file))))
- (kill-buffer (current-buffer)))
- (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? " filename))))
- (save-excursion
- (display-call-tree filename)))
- (if load
- (load target-file))
- t)))
+ (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
+ ;; within byte-compile-from-buffer lingers in that buffer.
+ (setq output-buffer (byte-compile-from-buffer input-buffer filename))
+ (if byte-compiler-error-flag
+ nil
+ (if byte-compile-verbose
+ (message "Compiling %s...done" filename))
+ (kill-buffer input-buffer)
+ (with-current-buffer output-buffer
+ (goto-char (point-max))
+ (insert "\n") ; aaah, unix.
+ (let ((vms-stmlf-recfm t))
+ (if (file-writable-p target-file)
+ ;; We must disable any code conversion here.
+ (let ((coding-system-for-write 'no-conversion))
+ (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 1 (point-max) target-file))
+ ;; This is just to give a better error message than write-region
+ (signal 'file-error
+ (list "Opening output file"
+ (if (file-exists-p target-file)
+ "cannot overwrite file"
+ "directory not writable or nonexistent")
+ target-file))))
+ (kill-buffer (current-buffer)))
+ (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? " filename))))
+ (save-excursion
+ (display-call-tree filename)))
+ (if load
+ (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
+;;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
(save-excursion
(setq outbuffer
(set-buffer (get-buffer-create " *Compiler Output*")))
+ (set-buffer-multibyte t)
(erase-buffer)
;; (emacs-lisp-mode)
(setq case-fold-search nil)
(looking-at ";"))
(forward-line 1))
(not (eobp)))
- (byte-compile-file-form (read inbuffer)))
+ (let ((byte-compile-last-line (count-lines (point-min) (point))))
+ (byte-compile-file-form (read inbuffer))))
;; Compile pending forms at end of file.
(byte-compile-flush-pending)
(defun byte-compile-fix-header (filename inbuffer outbuffer)
(save-excursion
(set-buffer outbuffer)
- (goto-char (point-min))
;; See if the buffer has any multibyte characters.
- (skip-chars-forward "\0-\377")
- (when (not (eobp))
+ (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))
(insert (car info))
(let ((print-escape-newlines t)
(print-quoted t)
- ;; Use a cons cell to say that we want
+ ;; For compatibility with code before print-circle,
+ ;; use a cons cell to say that we want
;; print-gensym-alist not to be cleared
;; between calls to print functions.
(print-gensym '(t))
+ ;; print-gensym-alist was used before print-circle existed.
print-gensym-alist
+ (print-continuous-numbering t)
+ print-number-table
(index 0))
(prin1 (car form) outbuffer)
(while (setq form (cdr form))
(if byte-compile-output
(let ((form (byte-compile-out-toplevel t 'file)))
(cond ((eq (car-safe form) 'progn)
- (mapcar 'byte-compile-output-file-form (cdr form)))
+ (mapc 'byte-compile-output-file-form (cdr form)))
(form
(byte-compile-output-file-form form)))
(setq byte-compile-constants nil
(null form)) ;Constants only
(eval (nth 5 form)) ;Macro
(eval form)) ;Define the autoload.
+ ;; Avoid undefined function warnings for the autoload.
+ (if (and (consp (nth 1 form))
+ (eq (car (nth 1 form)) 'quote)
+ (consp (cdr (nth 1 form)))
+ (symbolp (nth 1 (nth 1 form))))
+ (add-to-list 'byte-compile-function-environment
+ (cons (nth 1 (nth 1 form))
+ (cons 'autoload (cdr (cdr form))))))
(if (stringp (nth 3 form))
form
;; No doc string, so we can compile this as a normal form.
(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
(defun byte-compile-file-form-progn (form)
- (mapcar 'byte-compile-file-form (cdr form))
+ (mapc 'byte-compile-file-form (cdr form))
;; Return nil so the forms are not output twice.
nil)
(symbolp (car-safe (cdr-safe body)))
(car-safe (cdr-safe body))
(stringp (car-safe (cdr-safe (cdr-safe body)))))
- (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
+ (byte-compile-warn "probable `\"' without `\\' in doc string of %s"
(nth 1 form))))
(let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
(code (byte-compile-byte-code-maker new-one)))
;; 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))
- total-bytes)
+ (let ((position (point)))
(set-buffer
(prog1 (current-buffer)
(set-buffer outbuffer)
(goto-char (point-max))
(insert "\037")
(goto-char position)
- (setq total-bytes 0)
- (while (not (eobp))
- (setq total-bytes (+ total-bytes (char-bytes (char-after (point)))))
- (forward-char 1))
- (goto-char position)
- (insert "#@" (format "%d" total-bytes))
+ (insert "#@" (format "%d" (- (position-bytes (point-max))
+ (position-bytes position))))
;; Save the file position of the object.
;; Note we should add 1 to skip the space
(nth 3 function))))))
+(defun byte-compile-check-lambda-list (list)
+ "Check lambda-list LIST for errors."
+ (let (vars)
+ (while list
+ (let ((arg (car list)))
+ (cond ((or (not (symbolp arg))
+ (keywordp arg)
+ (memq arg '(t nil)))
+ (error "Invalid lambda variable %s" arg))
+ ((eq arg '&rest)
+ (unless (cdr list)
+ (error "&rest without variable name"))
+ (when (cddr list)
+ (error "Garbage following &rest VAR in lambda-list")))
+ ((eq arg '&optional)
+ (unless (cdr list)
+ (error "Variable name missing after &optional")))
+ ((memq arg vars)
+ (byte-compile-warn "repeated variable %s in lambda-list" arg))
+ (t
+ (push arg vars))))
+ (setq list (cdr list)))))
+
+
;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
(defun byte-compile-lambda (fun)
+ (unless (eq 'lambda (car-safe fun))
+ (error "Not a lambda list: %S" fun))
+ (byte-compile-check-lambda-list (nth 1 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(nconc (and (memq 'free-vars byte-compile-warnings)
(prog1 (car body)
;; Discard the doc string
;; unless it is the last element of the body.
- (if (nthcdr 2 body)
+ (if (cdr body)
(setq body (cdr body))))))
(int (assq 'interactive body)))
(cond (int
(if (memq byte-optimize '(t byte))
(setq byte-compile-output
(byte-optimize-lapcode byte-compile-output for-effect)))
-
+
;; Decompile trivial functions:
;; only constants and variables, or a single funcall except in lambdas.
;; Except for Lisp_Compiled objects, forms like (foo "hi")
(if (if (eq (car (car rest)) 'byte-constant)
(or (consp tmp)
(and (symbolp tmp)
- (not (memq tmp '(nil t))))))
+ (not (byte-compile-const-symbol-p tmp)))))
(if maycall
(setq body (cons (list 'quote tmp) body)))
(setq body (cons tmp body))))
(body
(list body))))
\f
-;; This is the recursive entry point for compiling each subform of an
+;; This is the recursive entry point for compiling each subform of an
;; expression.
;; If for-effect is non-nil, byte-compile-form will output a byte-discard
;; before terminating (ie no value will be left on the stack).
(defun byte-compile-form (form &optional for-effect)
(setq form (macroexpand form byte-compile-macro-environment))
(cond ((not (consp form))
- (cond ((or (not (symbolp form)) (memq form '(nil t)))
+ (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
(byte-compile-constant form))
((and for-effect byte-compile-delete-errors)
(setq for-effect nil))
((symbolp (car form))
(let* ((fn (car form))
(handler (get fn 'byte-compile)))
- (if (memq fn '(t nil))
+ (if (byte-compile-const-symbol-p fn)
(byte-compile-warn "%s called as a function" fn))
(if (and handler
(or (not (byte-compile-version-cond
(if byte-compile-generate-call-tree
(byte-compile-annotate-call-tree form))
(byte-compile-push-constant (car form))
- (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster.
+ (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster.
(byte-compile-out 'byte-call (length (cdr form))))
(defun byte-compile-variable-ref (base-op var)
- (if (or (not (symbolp var)) (memq var '(nil t)))
+ (if (or (not (symbolp var)) (byte-compile-const-symbol-p var))
(byte-compile-warn (if (eq base-op 'byte-varbind)
- "Attempt to let-bind %s %s"
- "Variable reference to %s %s")
+ "attempt to let-bind %s %s"
+ "variable reference to %s %s")
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))
(if (and (get var 'byte-obsolete-variable)
(memq 'obsolete byte-compile-warnings))
- (let ((ob (get var 'byte-obsolete-variable)))
- (byte-compile-warn "%s is an obsolete variable; %s" var
- (if (stringp ob)
- ob
- (format "use %s instead." ob)))))
+ (let* ((ob (get var 'byte-obsolete-variable))
+ (when (cdr ob)))
+ (byte-compile-warn "%s is an obsolete variable%s; %s" var
+ (if when (concat " since " when) "")
+ (if (stringp (car ob))
+ (car ob)
+ (format "use %s instead." (car ob))))))
(if (memq 'free-vars byte-compile-warnings)
(if (eq base-op 'byte-varbind)
(setq byte-compile-bound-variables
(byte-compile-out base-op tmp)))
(defmacro byte-compile-get-constant (const)
- (` (or (if (stringp (, const))
- (assoc (, const) byte-compile-constants)
- (assq (, const) byte-compile-constants))
- (car (setq byte-compile-constants
- (cons (list (, const)) byte-compile-constants))))))
+ `(or (if (stringp ,const)
+ (assoc ,const byte-compile-constants)
+ (assq ,const byte-compile-constants))
+ (car (setq byte-compile-constants
+ (cons (list ,const) byte-compile-constants)))))
;; Use this when the value of a form is a constant. This obeys for-effect.
(defun byte-compile-constant (const)
(byte-defop-compiler-1 - byte-compile-minus)
(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
(byte-defop-compiler19 nconc)
-(byte-defop-compiler-1 beginning-of-line)
(defun byte-compile-list (form)
(let ((count (length (cdr form))))
(cond ((= count 0)
(byte-compile-constant nil))
((< count 5)
- (mapcar 'byte-compile-form (cdr 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)))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-listN count))
(t (byte-compile-normal-call form)))))
(defun byte-compile-concat (form)
(let ((count (length (cdr form))))
(cond ((and (< 1 count) (< count 5))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out
(aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
0))
(byte-compile-form ""))
((and (< count 256) (not (byte-compile-version-cond
byte-compile-compatibility)))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-concatN count))
((byte-compile-normal-call form)))))
((and (not (byte-compile-version-cond
byte-compile-compatibility))
(<= (length form) 256))
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(if (cdr (cdr form))
(byte-compile-out 'byte-insertN (length (cdr form)))
(byte-compile-out 'byte-insert 0)))
(if (cdr form)
(byte-compile-discard))))))
-(defun byte-compile-beginning-of-line (form)
- (if (not (byte-compile-constp (nth 1 form)))
- (byte-compile-normal-call form)
- (byte-compile-form
- (list 'forward-line
- (if (integerp (setq form (or (eval (nth 1 form)) 1)))
- (1- form)
- (byte-compile-warn "Non-numeric arg to beginning-of-line: %s"
- form)
- (list '1- (list 'quote form))))
- t)
- (byte-compile-constant nil)))
-
\f
(byte-defop-compiler-1 setq)
(byte-defop-compiler-1 setq-default)
(byte-defop-compiler-1 mapcar byte-compile-funarg)
(byte-defop-compiler-1 mapatoms byte-compile-funarg)
(byte-defop-compiler-1 mapconcat byte-compile-funarg)
+(byte-defop-compiler-1 mapc byte-compile-funarg)
(byte-defop-compiler-1 sort byte-compile-funarg-2)
(byte-defop-compiler-1 let)
(byte-defop-compiler-1 let*)
(byte-compile-body (cdr (cdr (cdr form))) t))
(defmacro byte-compile-goto-if (cond discard tag)
- (` (byte-compile-goto
- (if (, cond)
- (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
- (if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
- (, tag))))
+ `(byte-compile-goto
+ (if ,cond
+ (if ,discard 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
+ (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
+ ,tag))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
(setq for-effect nil)))
(defun byte-compile-funcall (form)
- (mapcar 'byte-compile-form (cdr form))
+ (mapc 'byte-compile-form (cdr form))
(byte-compile-out 'byte-call (length (cdr (cdr form)))))
;; (and (stringp (get condition 'error-message))
;; (consp (get condition 'error-conditions)))))
;; (byte-compile-warn
-;; "%s is not a known condition name (in condition-case)"
+;; "%s is not a known condition name (in condition-case)"
;; condition))
)
(setq compiled-clauses
(defun byte-compile-defun (form)
;; This is not used for file-level defuns with doc strings.
+ (unless (symbolp (car form))
+ (error "defun name must be a symbol, not %s" (car form)))
(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
(defun byte-compile-defvar (form)
;; This is not used for file-level defvar/consts with doc strings.
- (let ((var (nth 1 form))
+ (let ((fun (nth 0 form))
+ (var (nth 1 form))
(value (nth 2 form))
(string (nth 3 form)))
- (if (memq 'free-vars byte-compile-warnings)
- (setq byte-compile-bound-variables
- (cons var byte-compile-bound-variables)))
+ (when (> (length form) 4)
+ (byte-compile-warn
+ "%s %s called with %d arguments, but accepts only %s"
+ fun var (length (cdr form)) 3))
+ (when (memq 'free-vars byte-compile-warnings)
+ (setq byte-compile-bound-variables
+ (cons var byte-compile-bound-variables)))
(byte-compile-body-do-effect
- (list (if (cdr (cdr form))
- (if (eq (car form) 'defconst)
- (list 'setq var value)
- (list 'or (list 'boundp (list 'quote var))
- (list 'setq var value))))
- ;; Put the defined variable in this library's load-history entry
- ;; just as a real defvar would.
- (list 'setq 'current-load-list
- (list 'cons (list 'quote var)
- 'current-load-list))
- (if string
- (list 'put (list 'quote var) ''variable-documentation string))
- (list 'quote var)))))
+ (list
+ ;; Put the defined variable in this library's load-history entry
+ ;; just as a real defvar would, but only in top-level forms.
+ (when (and (cddr form) (null byte-compile-current-form))
+ `(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))
+ `(put ',var 'variable-documentation ,string))
+ (if (cddr form) ; `value' provided
+ (if (eq fun 'defconst)
+ ;; `defconst' sets `var' unconditionally.
+ (let ((tmp (make-symbol "defconst-tmp-var")))
+ `(let ((,tmp ,value))
+ (eval '(defconst ,var ,tmp))))
+ ;; `defvar' sets `var' only when unbound.
+ `(if (not (boundp ',var)) (setq ,var ,value))))
+ `',var))))
(defun byte-compile-autoload (form)
(and (byte-compile-constp (nth 1 form))
(eval (nth 5 form)) ; macro-p
(not (fboundp (eval (nth 1 form))))
(byte-compile-warn
- "The compiler ignores `autoload' except at top level. You should
+ "The compiler ignores `autoload' except at top level. You should
probably put the autoload of the macro `%s' at top-level."
(eval (nth 1 form))))
(byte-compile-normal-call form))
-;; Lambda's in valid places are handled as special cases by various code.
+;; Lambdas in valid places are handled as special cases by various code.
;; The ones that remain are errors.
(defun byte-compile-lambda-form (form)
(error "`lambda' used as function name is invalid"))
))
\f
+(defun batch-byte-compile-if-not-done ()
+ "Like `byte-compile-file' but doesn't recompile if already up to date.
+Use this from the command line, with `-batch';
+it won't work in an interactive Emacs."
+ (batch-byte-compile t))
+
;;; by crl@newton.purdue.edu
;;; Only works noninteractively.
;;;###autoload
-(defun batch-byte-compile ()
+(defun batch-byte-compile (&optional noforce)
"Run `byte-compile-file' on the files remaining on the command line.
Use this from the command line, with `-batch';
it won't work in an interactive Emacs.
Each file is processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
+For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\".
+If NOFORCE is non-nil, don't recompile a file that seems to be
+already up-to-date."
;; command-line-args-left is what is left of the command line (from startup.el)
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)
(let ((error nil))
(while command-line-args-left
(if (file-directory-p (expand-file-name (car command-line-args-left)))
+ ;; Directory as argument.
(let ((files (directory-files (car command-line-args-left)))
source dest)
- (while files
- (if (and (string-match emacs-lisp-file-regexp (car files))
- (not (auto-save-file-name-p (car files)))
- (setq source (expand-file-name (car files)
+ (dolist (file files)
+ (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 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)))
- (setq files (cdr files))))
- (if (null (batch-byte-compile-file (car command-line-args-left)))
- (setq error t)))
+ (setq error t)))))
+ ;; Specific file argument
+ (if (or (not noforce)
+ (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 error t))))
(setq command-line-args-left (cdr command-line-args-left)))
- (message "Done")
(kill-emacs (if error 1 0))))
(defun batch-byte-compile-file (file)
(or command-line-args-left
(setq command-line-args-left '(".")))
(while command-line-args-left
- (byte-recompile-directory (car command-line-args-left))
+ (byte-recompile-directory (car command-line-args-left) 0)
(setq command-line-args-left (cdr command-line-args-left)))
(kill-emacs 0))
-(make-obsolete 'dot 'point)
-(make-obsolete 'dot-max 'point-max)
-(make-obsolete 'dot-min 'point-min)
-(make-obsolete 'dot-marker 'point-marker)
-
-(make-obsolete 'buffer-flush-undo 'buffer-disable-undo)
-(make-obsolete 'baud-rate "use the baud-rate variable instead")
-(make-obsolete 'compiled-function-p 'byte-code-function-p)
-(make-obsolete 'define-function 'defalias)
-(make-obsolete-variable 'auto-fill-hook 'auto-fill-function)
-(make-obsolete-variable 'blink-paren-hook 'blink-paren-function)
-(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function)
-(make-obsolete-variable 'temp-buffer-show-hook
- 'temp-buffer-show-function)
+(make-obsolete 'dot 'point "before 19.15")
+(make-obsolete 'dot-max 'point-max "before 19.15")
+(make-obsolete 'dot-min 'point-min "before 19.15")
+(make-obsolete 'dot-marker 'point-marker "before 19.15")
+
+(make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15")
+(make-obsolete 'baud-rate "use the baud-rate variable instead" "before 19.15")
+(make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15")
+(make-obsolete 'define-function 'defalias "20.1")
+(make-obsolete-variable 'auto-fill-hook 'auto-fill-function "before 19.15")
+(make-obsolete-variable 'blink-paren-hook 'blink-paren-function "before 19.15")
+(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function "before 19.15")
(make-obsolete-variable 'inhibit-local-variables
- "use enable-local-variables (with the reversed sense).")
+ "use enable-local-variables (with the reversed sense)."
+ "before 19.15")
(make-obsolete-variable 'unread-command-char
- "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1.")
+ "use unread-command-events instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1."
+ "before 19.15")
(make-obsolete-variable 'unread-command-event
- "use unread-command-events; which is a list of events rather than a single event.")
-(make-obsolete-variable 'suspend-hooks 'suspend-hook)
-(make-obsolete-variable 'comment-indent-hook 'comment-indent-function)
-(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead.")
-(make-obsolete-variable 'executing-macro 'executing-kbd-macro)
+ "use unread-command-events; which is a list of events rather than a single event."
+ "before 19.15")
+(make-obsolete-variable 'suspend-hooks 'suspend-hook "before 19.15")
+(make-obsolete-variable 'comment-indent-hook 'comment-indent-function "before 19.15")
+(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead." "before 19.34")
+(make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34")
(make-obsolete-variable 'before-change-function
- "use before-change-functions; which is a list of functions rather than a single function.")
+ "use before-change-functions; which is a list of functions rather than a single function."
+ "before 19.34")
(make-obsolete-variable 'after-change-function
- "use after-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face)
+ "use after-change-functions; which is a list of functions rather than a single function."
+ "before 19.34")
+(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face "before 19.34")
(make-obsolete-variable 'post-command-idle-hook
- "use timers instead, with `run-with-idle-timer'.")
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
(make-obsolete-variable 'post-command-idle-delay
- "use timers instead, with `run-with-idle-timer'.")
+ "use timers instead, with `run-with-idle-timer'." "before 19.34")
(provide 'byte-compile)
(provide 'bytecomp)
(assq 'byte-code (symbol-function 'byte-compile-form))
(let ((byte-optimize nil) ; do it fast
(byte-compile-warnings nil))
- (mapcar '(lambda (x)
- (or noninteractive (message "compiling %s..." x))
- (byte-compile x)
- (or noninteractive (message "compiling %s...done" x)))
+ (mapcar (lambda (x)
+ (or noninteractive (message "compiling %s..." x))
+ (byte-compile x)
+ (or noninteractive (message "compiling %s...done" x)))
'(byte-compile-normal-call
byte-compile-form
byte-compile-body
byte-compile-variable-ref))))
nil)
+(run-hooks 'bytecomp-load-hook)
+
;;; bytecomp.el ends here
HCoop / bpt / emacs.git / blobdiff