;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; This can be the 'byte-compile property of any symbol.
(autoload 'byte-compile-inline-expand "byte-opt")
-;; This is the entrypoint to the lapcode optimizer pass1.
+;; This is the entry point to the lapcode optimizer pass1.
(autoload 'byte-optimize-form "byte-opt")
-;; This is the entrypoint to the lapcode optimizer pass2.
+;; This is the entry point to the lapcode optimizer pass2.
(autoload 'byte-optimize-lapcode "byte-opt")
(autoload 'byte-compile-unfold-lambda "byte-opt")
(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 delete-backward-char)
+ goto-line comint-run delete-backward-char toggle-read-only)
"List of commands that are not meant to be called from Lisp.")
(defvar byte-compile-not-obsolete-vars nil
- "If non-nil, a list of variables that shouldn't be reported as obsolete.")
+ "List of variables that shouldn't be reported as obsolete.")
+(defvar byte-compile-global-not-obsolete-vars nil
+ "Global list of variables that shouldn't be reported as obsolete.")
(defvar byte-compile-not-obsolete-funcs nil
- "If non-nil, a list of functions that shouldn't be reported as obsolete.")
+ "List of functions that shouldn't be reported as obsolete.")
(defcustom byte-compile-generate-call-tree nil
"Non-nil means collect call-graph information when compiling.
(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
"Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
-CONST2 may be evaulated multiple times."
+CONST2 may be evaluated multiple times."
`(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8)
,bytes ,pc))
(setcar (cdr bytes-tail) (logand pc 255))
(setcar bytes-tail (lsh pc -8))
;; FIXME: Replace this by some workaround.
- (if (> (car bytes) 255) (error "Bytecode overflow")))
+ (if (> (car bytes-tail) 255) (error "Bytecode overflow")))
(apply 'unibyte-string (nreverse bytes))))
(let* ((funcp (get symbol 'byte-obsolete-info))
(obsolete (or funcp (get symbol 'byte-obsolete-variable)))
(instead (car obsolete))
- (asof (if funcp (nth 2 obsolete) (cdr obsolete))))
+ (asof (nth 2 obsolete)))
(unless (and funcp (memq symbol byte-compile-not-obsolete-funcs))
(byte-compile-warn "`%s' is an obsolete %s%s%s" symbol
(if funcp "function" "variable")
- (if asof (concat " (as of Emacs " asof ")") "")
+ (if asof (concat " (as of " asof ")") "")
(cond ((stringp instead)
(concat "; " instead))
(instead
(enable-local-eval nil))
;; Arg of t means don't alter enable-local-variables.
(normal-mode t)
- (setq filename buffer-file-name))
+ ;; There may be a file local variable setting (bug#10419).
+ (setq buffer-read-only nil
+ filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
(setq default-directory (file-name-directory filename)))
;; Check if the file's local variables explicitly specify not to
(with-current-buffer output-buffer
(goto-char (point-max))
(insert "\n") ; aaah, unix.
- (if (file-writable-p target-file)
- ;; We must disable any code conversion here.
- (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))
- (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"
- (if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
- target-file)))
+ (if (file-writable-p target-file)
+ ;; We must disable any code conversion here.
+ (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))
+ (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"
+ (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)
(byte-compile-keep-pending form)))))
;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognise them. Most other things can be output
+;; so make-docfile can recognize them. Most other things can be output
;; as byte-code.
(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
(defun byte-compile-file-form-defvar (form)
- (if (null (nth 3 form))
- ;; 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 (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))
+ (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))
+ (if (and (null (cddr form)) ;No `value' provided.
+ (eq (car form) 'defvar)) ;Just a declaration.
+ nil
(cond ((consp (nth 2 form))
- (setq form (copy-sequence form))
- (setcar (cdr (cdr form))
- (byte-compile-top-level (nth 2 form) nil 'file))))
+ (setq form (copy-sequence form))
+ (setcar (cdr (cdr form))
+ (byte-compile-top-level (nth 2 form) nil 'file))))
form))
(put 'define-abbrev-table 'byte-hunk-handler
(setq form (cdr form)))
(setq form (car form)))
(if (and (eq (car-safe form) 'list)
- ;; The spec is evaled in callint.c in dynamic-scoping
+ ;; The spec is evalled in callint.c in dynamic-scoping
;; mode, so just leaving the form unchanged would mean
;; it won't be eval'd in the right mode.
(not lexical-binding))
(limits '(5 ; Use the 1-byte varref codes,
63 ; 1-constlim ; 1-byte byte-constant codes,
255 ; 2-byte varref codes,
- 65535)) ; 3-byte codes for the rest.
+ 65535 ; 3-byte codes for the rest.
+ 65535)) ; twice since we step when we swap.
limit)
(while (or rest other)
(setq limit (car limits))
(setcdr (car rest) (setq i (1+ i)))
(setq ret (cons (car rest) ret))))
(setq rest (cdr rest)))
- (setq limits (cdr limits)
- rest (prog1 other
+ (setq limits (cdr limits) ;Step
+ rest (prog1 other ;&Swap.
(setq other rest))))
(apply 'vector (nreverse (mapcar 'car ret)))))
That command is designed for interactive use only" fn))
(if (and (fboundp (car form))
(eq (car-safe (symbol-function (car form))) 'macro))
- (byte-compile-report-error
- (format "Forgot to expand macro %s" (car form))))
+ (byte-compile-log-warning
+ (format "Forgot to expand macro %s" (car form)) nil :error))
(if (and handler
;; Make sure that function exists. This is important
;; for CL compiler macros since the symbol may be
(cond
((<= (+ alen alen) fmax2)
;; Add missing &optional (or &rest) arguments.
- (dotimes (i (- (/ (1+ fmax2) 2) alen))
+ (dotimes (_ (- (/ (1+ fmax2) 2) alen))
(byte-compile-push-constant nil)))
((zerop (logand fmax2 1))
(byte-compile-log-warning "Too many arguments for inlined function"
(assert (eq byte-compile-depth (1+ start-depth))
nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))
-(defun byte-compile-check-variable (var &optional binding)
- "Do various error checks before a use of the variable VAR.
-If BINDING is non-nil, VAR is being bound."
+(defun byte-compile-check-variable (var access-type)
+ "Do various error checks before a use of the variable VAR."
(when (symbolp var)
(byte-compile-set-symbol-position var))
(cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
(when (byte-compile-warning-enabled-p 'constants)
- (byte-compile-warn (if binding
+ (byte-compile-warn (if (eq access-type 'let-bind)
"attempt to let-bind %s `%s`"
"variable reference to %s `%s'")
(if (symbolp var) "constant" "nonvariable")
(prin1-to-string var))))
- ((and (get var 'byte-obsolete-variable)
- (not (memq var byte-compile-not-obsolete-vars)))
+ ((let ((od (get var 'byte-obsolete-variable)))
+ (and od
+ (not (memq var byte-compile-not-obsolete-vars))
+ (not (memq var byte-compile-global-not-obsolete-vars))
+ (or (case (nth 1 od)
+ (set (not (eq access-type 'reference)))
+ (get (eq access-type 'reference))
+ (t t)))))
(byte-compile-warn-obsolete var))))
(defsubst byte-compile-dynamic-variable-op (base-op var)
(defun byte-compile-dynamic-variable-bind (var)
"Generate code to bind the lexical variable VAR to the top-of-stack value."
- (byte-compile-check-variable var t)
+ (byte-compile-check-variable var 'let-bind)
(push var byte-compile-bound-variables)
(byte-compile-dynamic-variable-op 'byte-varbind var))
(defun byte-compile-variable-ref (var)
"Generate code to push the value of the variable VAR on the stack."
- (byte-compile-check-variable var)
+ (byte-compile-check-variable var 'reference)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
(defun byte-compile-variable-set (var)
"Generate code to set the variable VAR from the top-of-stack value."
- (byte-compile-check-variable var)
+ (byte-compile-check-variable var 'assign)
(let ((lex-binding (assq var byte-compile--lexical-environment)))
(if lex-binding
;; VAR is lexically bound
;; and (funcall (function foo)) will lose with autoloads.
(defun byte-compile-function-form (form)
- (byte-compile-constant (if (symbolp (nth 1 form))
- (nth 1 form)
- (byte-compile-lambda (nth 1 form)))))
+ (byte-compile-constant (if (eq 'lambda (car-safe (nth 1 form)))
+ (byte-compile-lambda (nth 1 form))
+ (nth 1 form))))
(defun byte-compile-indent-to (form)
(let ((len (length form)))
(defun byte-compile-if (form)
(byte-compile-form (car (cdr form)))
;; Check whether we have `(if (fboundp ...' or `(if (boundp ...'
- ;; and avoid warnings about the relevent symbols in the consequent.
+ ;; and avoid warnings about the relevant symbols in the consequent.
(let ((clause (nth 1 form))
(donetag (byte-compile-make-tag)))
(if (null (nthcdr 3 form))
(byte-defop-compiler-1 make-obsolete-variable)
(defun byte-compile-make-obsolete-variable (form)
(when (eq 'quote (car-safe (nth 1 form)))
- (push (nth 1 (nth 1 form)) byte-compile-not-obsolete-vars))
+ (push (nth 1 (nth 1 form)) byte-compile-global-not-obsolete-vars))
(byte-compile-normal-call form))
+(defconst byte-compile-tmp-var (make-symbol "def-tmp-var"))
+
(defun byte-compile-defvar (form)
- ;; This is not used for file-level defvar/consts with doc strings.
+ ;; This is not used for file-level defvar/consts.
(when (and (symbolp (nth 1 form))
(not (string-match "[-*/:$]" (symbol-name (nth 1 form))))
(byte-compile-warning-enabled-p 'lexical))
(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
- ;; just as a real defvar would, but only in top-level forms.
- (when (and (cddr form) (null byte-compile-current-form))
- `(setq current-load-list (cons ',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
- (let ((byte-compile-not-obsolete-vars (list var)))
- (if (eq fun 'defconst)
- ;; `defconst' sets `var' unconditionally.
- (let ((tmp (make-symbol "defconst-tmp-var")))
- `(funcall '(lambda (,tmp) (defconst ,var ,tmp))
- ,value))
- ;; `defvar' sets `var' only when unbound.
- `(if (not (default-boundp ',var)) (setq-default ,var ,value))))
- (when (eq fun 'defconst)
- ;; This will signal an appropriate error at runtime.
- `(eval ',form)))
- `',var))))
+ (when (and string (not (stringp string)))
+ (byte-compile-warn "third arg to `%s %s' is not a string: %s"
+ fun var string))
+ (byte-compile-form-do-effect
+ (if (cddr form) ; `value' provided
+ ;; Quote with `quote' to prevent byte-compiling the body,
+ ;; which would lead to an inf-loop.
+ `(funcall '(lambda (,byte-compile-tmp-var)
+ (,fun ,var ,byte-compile-tmp-var ,@(nthcdr 3 form)))
+ ,value)
+ (if (eq fun 'defconst)
+ ;; This will signal an appropriate error at runtime.
+ `(eval ',form)
+ ;; A simple (defvar foo) just returns foo.
+ `',var)))))
(defun byte-compile-autoload (form)
(byte-compile-set-symbol-position 'autoload)
(defun byte-compile-form-make-variable-buffer-local (form)
(byte-compile-keep-pending form 'byte-compile-normal-call))
+(byte-defop-compiler-1 add-to-list byte-compile-add-to-list)
+(defun byte-compile-add-to-list (form)
+ ;; FIXME: This could be used for `set' as well, except that it's got
+ ;; its own opcode, so the final `byte-compile-normal-call' needs to
+ ;; be replaced with something else.
+ (pcase form
+ (`(,fun ',var . ,_)
+ (byte-compile-check-variable var 'assign)
+ (if (assq var byte-compile--lexical-environment)
+ (byte-compile-log-warning
+ (format "%s cannot use lexical var `%s'" fun var)
+ nil :error)
+ (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+ (boundp var)
+ (memq var byte-compile-bound-variables)
+ (memq var byte-compile-free-references))
+ (byte-compile-warn "assignment to free variable `%S'" var)
+ (push var byte-compile-free-references)))))
+ (byte-compile-normal-call form))
\f
;;; tags