comparison lisp/emacs-lisp/bytecomp.el @ 50570:80ed0fdbf171

Use push, with-current-buffer, dolist, ... (byte-compile-const-variables): New var. (byte-compile-close-variables): Reset it. (byte-compile-file-form-defvar, byte-compile-defvar): Update it. (byte-compile-const-symbol-p): Now arg `value' to check defconsts. (byte-compile-variable-ref): Use it and improve warning message. (byte-compile-check-lambda-list): Use byte-compile-const-symbol-p. (byte-compile-lapcode): Remove unused vars. (byte-compile-eval): Fix thinko in handling of old-autoloads. (byte-recompile-directory): Use the expanded form for directory. (byte-compile-track-mouse): Use modern backquote syntax. (byte-compile-defvar): Detect and properly handle (defconst a). (byte-compile-defalias-warn): Remove unused arg `alias'. (byte-compile-defalias): Update call.

50569:f7bd4869e2a8

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.121 $")

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(require 'backquote)

(or (fboundp 'defsubst)
    ;; 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.
(defmacro byte-compile-single-version () nil)
(defmacro byte-compile-version-cond (cond) cond)

(defvar byte-compile-variables nil
  "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.")
(defvar byte-compile-free-references)
(defvar byte-compile-free-assignments)

(defvar byte-compiler-error-flag)

  "Turns lapcode into bytecode.  The lapcode is destroyed."
  ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
  (let ((pc 0)			; Program counter
	op off			; Operation & offset
	(bytes '())		; Put the output bytes here
	(patchlist nil)		; List of tags and goto's to patch
	rest rel tmp)
    (while lap
      (setq op (car (car lap))
	    off (cdr (car lap)))
      (cond ((not (symbolp op))
	     (error "Non-symbolic opcode `%s'" op))

		  (cond
		   ((symbolp s)
		    (unless (memq s old-autoloads)
		      (put s 'byte-compile-noruntime t)))
		   ((and (consp s) (eq t (car s)))
		    (push s old-autoloads))
		   ((and (consp s) (eq 'autoload (car s)))
		    (put (cdr s) 'byte-compile-noruntime t)))))))
	  ;; Go through current-load-list for the locally defined funs.
	  (let (old-autoloads)
	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	      (let ((s (pop hist-nil-new)))
		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (put s 'byte-compile-noruntime t))
		(when (and (consp s) (eq t (car s)))
		  (push s old-autoloads))))))))))

(defun byte-compile-eval-before-compile (form)
  "Evaluate FORM for `eval-and-compile'."
  (let ((hist-nil-orig current-load-list))
    (prog1 (eval form)

       "the following functions are not known to be defined:"
       unresolved)))
  nil)


(defsubst byte-compile-const-symbol-p (symbol)
  (or (memq symbol '(nil t))
      (keywordp symbol)))

(defmacro byte-compile-constp (form)
  "Return non-nil if FORM is a constant."
  `(cond ((consp ,form) (eq (car ,form) 'quote))
	 ((not (symbolp ,form)))

		 ;; Copy it because the compiler may patch into the
		 ;; macroenvironment.
		 (copy-alist byte-compile-initial-macro-environment))
		(byte-compile-function-environment nil)
		(byte-compile-bound-variables nil)
		(byte-compile-free-references nil)
		(byte-compile-free-assignments nil)
		;;
		;; Close over these variables so that `byte-compiler-options'
		;; can change them on a per-file basis.

      nil
    (save-some-buffers)
    (force-mode-line-update))
  (save-current-buffer
    (byte-goto-log-buffer)
    (setq default-directory directory)
    (let ((directories (list (expand-file-name directory)))
	  (default-directory default-directory)
	  (skip-count 0)
	  (fail-count 0)
	  (file-count 0)

      ;; if the buffer contains multibyte characters.
      (and filename (byte-compile-fix-header filename inbuffer outbuffer))))
    outbuffer))

(defun byte-compile-fix-header (filename inbuffer outbuffer)
  (save-excursion
    (set-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))

	  (print-gensym t))
      (princ "\n" outbuffer)
      (prin1 form outbuffer)
      nil)))

(defun byte-compile-output-docform (preface name info form specindex quoted)
  "Print a form with a doc string.  INFO is (prefix doc-index postfix).
If PREFACE and NAME are non-nil, print them too,
before INFO and the FORM but after the doc string itself.
If SPECINDEX is non-nil, it is the index in FORM

	       ;; 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))

;; so make-docfile can recognise them.  Most other things can be output
;; as byte-code.

(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
(defun byte-compile-file-form-defsubst (form)
  (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
	 (setq byte-compile-current-form (nth 1 form))
	 (byte-compile-warn "defsubst %s was used before it was defined"
			    (nth 1 form))))
  (byte-compile-file-form
   (macroexpand form byte-compile-macro-environment))
  ;; Return nil so the form is not output twice.
  nil)

(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)
    (if (memq 'free-vars byte-compile-warnings)
	(setq byte-compile-bound-variables
	      (cons (nth 1 form) byte-compile-bound-variables)))
    (cond ((consp (nth 2 form))
	   (setq form (copy-sequence form))
	   (setcar (cdr (cdr form))
		   (byte-compile-top-level (nth 2 form) nil 'file))))
    form))

(put 'custom-declare-variable 'byte-hunk-handler
     'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
  (if (memq 'free-vars byte-compile-warnings)
      (setq byte-compile-bound-variables
	    (cons (nth 1 (nth 1 form)) byte-compile-bound-variables)))
  (let ((tail (nthcdr 4 form)))
    (while tail
      ;; If there are any (function (lambda ...)) expressions, compile
      ;; those functions.
      (if (and (consp (car tail))

    (while list
      (let ((arg (car list)))
	(when (symbolp arg)
	  (byte-compile-set-symbol-position arg))
	(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)

		    ;; Discard the doc string
		    ;; unless it is the last element of the body.
		    (if (cdr body)
			(setq body (cdr body))))))
	 (int (assq 'interactive body)))
    (cond (int
	   (byte-compile-set-symbol-position 'interactive)
	   ;; Skip (interactive) if it is in front (the most usual location).
	   (if (eq int (car body))
	       (setq body (cdr body)))
	   (cond ((consp (cdr int))
		  (if (cdr (cdr int))
		      (byte-compile-warn "malformed interactive spec: %s"
					 (prin1-to-string int)))
		  ;; If the interactive spec is a call to `list',
		  ;; don't compile it, because `call-interactively'
		  ;; looks at the args of `list'.
		  (let ((form (nth 1 int)))
		    (while (memq (car-safe form) '(let let* progn save-excursion))
		      (while (consp (cdr form))
			(setq form (cdr form)))
		      (setq form (car form)))
		    (or (eq (car-safe form) 'list)
			(setq int (list 'interactive
					(byte-compile-top-level (nth 1 int)))))))
		 ((cdr int)
		  (byte-compile-warn "malformed interactive spec: %s"
				     (prin1-to-string int))))))
    (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
      (if (and (eq 'byte-code (car-safe compiled))
	       (not (byte-compile-version-cond
		     byte-compile-compatibility)))
	  (apply 'make-byte-code
		 (append (list arglist)

  (byte-compile-out 'byte-call (length (cdr form))))

(defun byte-compile-variable-ref (base-op var)
  (when (symbolp var)
    (byte-compile-set-symbol-position var))
  (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")
			 (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))
	       (when (cdr ob)))
	  (byte-compile-warn "%s is an obsolete variable%s; %s" var

			     (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
		  (cons var byte-compile-bound-variables))
	  (or (boundp var)
	      (memq var byte-compile-bound-variables)
	      (if (eq base-op 'byte-varset)
		  (or (memq var byte-compile-free-assignments)
		      (progn
			(byte-compile-warn "assignment to free variable %s" var)
			(setq byte-compile-free-assignments
			      (cons var byte-compile-free-assignments))))
		(or (memq var byte-compile-free-references)
		    (progn
		      (byte-compile-warn "reference to free variable %s" var)
		      (setq byte-compile-free-references
			    (cons var byte-compile-free-references)))))))))
  (let ((tmp (assq var byte-compile-variables)))
    (or tmp
	(setq tmp (list var)
	      byte-compile-variables (cons tmp byte-compile-variables)))
    (byte-compile-out base-op tmp)))

(defmacro byte-compile-get-constant (const)
  `(or (if (stringp ,const)
	   (assoc ,const byte-compile-constants)

	    (args (copy-sequence (cdr form))))
	(byte-compile-form (car args))
	(setq args (cdr args))
	(or args (setq args '(0)
		       opcode (get '+ 'byte-opcode)))
	(while args
	  (byte-compile-form (car args))
	  (byte-compile-out opcode 0)
	  (setq args (cdr args))))
    (byte-compile-constant (eval form))))


;; more complicated compiler macros

(defun byte-compile-let (form)
  ;; First compute the binding values in the old scope.
  (let ((varlist (car (cdr form))))
    (while varlist
      (if (consp (car varlist))
	  (byte-compile-form (car (cdr (car varlist))))
	(byte-compile-push-constant nil))
      (setq varlist (cdr varlist))))
  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
	(varlist (reverse (car (cdr form)))))
    (while varlist
      (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
						   (car (car varlist))
						 (car varlist)))
      (setq varlist (cdr varlist)))
    (byte-compile-body-do-effect (cdr (cdr form)))
    (byte-compile-out 'byte-unbind (length (car (cdr form))))))

(defun byte-compile-let* (form)
  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
	(varlist (copy-sequence (car (cdr form)))))
    (while varlist
      (if (atom (car varlist))
	  (byte-compile-push-constant nil)
	(byte-compile-form (car (cdr (car varlist))))
	(setcar varlist (car (car varlist))))
      (byte-compile-variable-ref 'byte-varbind (car varlist))
      (setq varlist (cdr varlist)))
    (byte-compile-body-do-effect (cdr (cdr form)))
    (byte-compile-out 'byte-unbind (length (car (cdr form))))))


(byte-defop-compiler-1 /= byte-compile-negated)

  (byte-compile-form-do-effect (car (cdr form)))
  (byte-compile-out 'byte-unbind 1))

(defun byte-compile-track-mouse (form)
  (byte-compile-form
   (list
    'funcall
    (list 'quote
	  (list 'lambda nil
		(cons 'track-mouse
		      (byte-compile-top-level-body (cdr form))))))))

(defun byte-compile-condition-case (form)
  (let* ((var (nth 1 form))
	 (byte-compile-bound-variables
	  (if var (cons var byte-compile-bound-variables)

  (let ((fun (nth 0 form))
	(var (nth 1 form))
	(value (nth 2 form))
	(string (nth 3 form)))
    (byte-compile-set-symbol-position fun)
    (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
      ;; 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))

	`(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)
  (byte-compile-set-symbol-position 'autoload)
  (and (byte-compile-constp (nth 1 form))

	   (consp (nth 2 form))
	   (eq (car (nth 2 form)) 'quote)
	   (consp (cdr (nth 2 form)))
	   (symbolp (nth 1 (nth 2 form))))
      (progn
	(byte-compile-defalias-warn (nth 1 (nth 1 form))
				    (nth 1 (nth 2 form)))
	(setq byte-compile-function-environment
	      (cons (cons (nth 1 (nth 1 form))
			  (nth 1 (nth 2 form)))
		    byte-compile-function-environment))))
  (byte-compile-normal-call form))

;; Turn off warnings about prior calls to the function being defalias'd.
;; This could be smarter and compare those calls with
;; the function it is being aliased to.
(defun byte-compile-defalias-warn (new alias)
  (let ((calls (assq new byte-compile-unresolved-functions)))
    (if calls
	(setq byte-compile-unresolved-functions
	      (delq calls byte-compile-unresolved-functions)))))


	  (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
	(setq byte-compile-depth (cdr (cdr tag))))
    (setcdr (cdr tag) byte-compile-depth)))

(defun byte-compile-goto (opcode tag)
  (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
  (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
			(1- byte-compile-depth)
		      byte-compile-depth))
  (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
				(1- byte-compile-depth))))

(defun byte-compile-out (opcode offset)
  (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
  (cond ((eq opcode 'byte-call)
	 (setq byte-compile-depth (- byte-compile-depth offset)))
	((eq opcode 'byte-return)
	 ;; This is actually an unnecessary case, because there should be
	 ;; no more opcodes behind byte-return.

50570:80ed0fdbf171

;; Maintainer: FSF
;; Keywords: lisp

;;; This version incorporates changes up to version 2.10 of the
;;; Zawinski-Furuseth compiler.
(defconst byte-compile-version "$Revision: 2.122 $")

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

(require 'backquote)

(or (fboundp 'defsubst)
    ;; 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)

(defvar byte-compile-variables nil
  "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.")
(defvar byte-compile-const-variables nil
  "List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references)
(defvar byte-compile-free-assignments)

(defvar byte-compiler-error-flag)

  "Turns lapcode into bytecode.  The lapcode is destroyed."
  ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
  (let ((pc 0)			; Program counter
	op off			; Operation & offset
	(bytes '())		; Put the output bytes here
	(patchlist nil))	; List of tags and goto's to patch
    (while lap
      (setq op (car (car lap))
	    off (cdr (car lap)))
      (cond ((not (symbolp op))
	     (error "Non-symbolic opcode `%s'" op))

		  (cond
		   ((symbolp s)
		    (unless (memq s old-autoloads)
		      (put s 'byte-compile-noruntime t)))
		   ((and (consp s) (eq t (car s)))
		    (push (cdr s) old-autoloads))
		   ((and (consp s) (eq 'autoload (car s)))
		    (put (cdr s) 'byte-compile-noruntime t)))))))
	  ;; Go through current-load-list for the locally defined funs.
	  (let (old-autoloads)
	    (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig)))
	      (let ((s (pop hist-nil-new)))
		(when (and (symbolp s) (not (memq s old-autoloads)))
		  (put s 'byte-compile-noruntime t))
		(when (and (consp s) (eq t (car s)))
		  (push (cdr s) old-autoloads))))))))))

(defun byte-compile-eval-before-compile (form)
  "Evaluate FORM for `eval-and-compile'."
  (let ((hist-nil-orig current-load-list))
    (prog1 (eval form)

       "the following functions are not known to be defined:"
       unresolved)))
  nil)


(defsubst byte-compile-const-symbol-p (symbol &optional value)
  "Non-nil if SYMBOL is constant.
If VALUE is nil, only return non-nil if the value of the symbol is the
symbol itself."
  (or (memq symbol '(nil t))
      (keywordp symbol)
      (if value (memq symbol byte-compile-const-variables))))

(defmacro byte-compile-constp (form)
  "Return non-nil if FORM is a constant."
  `(cond ((consp ,form) (eq (car ,form) 'quote))
	 ((not (symbolp ,form)))

		 ;; Copy it because the compiler may patch into the
		 ;; macroenvironment.
		 (copy-alist byte-compile-initial-macro-environment))
		(byte-compile-function-environment nil)
		(byte-compile-bound-variables nil)
		(byte-compile-const-variables nil)
		(byte-compile-free-references nil)
		(byte-compile-free-assignments nil)
		;;
		;; Close over these variables so that `byte-compiler-options'
		;; can change them on a per-file basis.

      nil
    (save-some-buffers)
    (force-mode-line-update))
  (save-current-buffer
    (byte-goto-log-buffer)
    (setq default-directory (expand-file-name directory))
    (let ((directories (list (expand-file-name directory)))
	  (default-directory default-directory)
	  (skip-count 0)
	  (fail-count 0)
	  (file-count 0)

      ;; if the buffer contains multibyte characters.
      (and filename (byte-compile-fix-header filename inbuffer outbuffer))))
    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))

	  (print-gensym t))
      (princ "\n" outbuffer)
      (prin1 form outbuffer)
      nil)))

(defvar print-gensym-alist)		;Used before print-circle existed.

(defun byte-compile-output-docform (preface name info form specindex quoted)
  "Print a form with a doc string.  INFO is (prefix doc-index postfix).
If PREFACE and NAME are non-nil, print them too,
before INFO and the FORM but after the doc string itself.
If SPECINDEX is non-nil, it is the index in FORM

	       ;; 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-continuous-numbering t)
	       print-number-table
	       (index 0))
	   (prin1 (car form) outbuffer)
	   (while (setq form (cdr form))

;; so make-docfile can recognise them.  Most other things can be output
;; as byte-code.

(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
(defun byte-compile-file-form-defsubst (form)
  (when (assq (nth 1 form) byte-compile-unresolved-functions)
    (setq byte-compile-current-form (nth 1 form))
    (byte-compile-warn "defsubst %s was used before it was defined"
		       (nth 1 form)))
  (byte-compile-file-form
   (macroexpand form byte-compile-macro-environment))
  ;; Return nil so the form is not output twice.
  nil)

(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 (memq 'free-vars byte-compile-warnings)
      (push (nth 1 form) byte-compile-dynamic-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))
		   (byte-compile-top-level (nth 2 form) nil 'file))))
    form))

(put 'custom-declare-variable 'byte-hunk-handler
     'byte-compile-file-form-custom-declare-variable)
(defun byte-compile-file-form-custom-declare-variable (form)
  (when (memq 'free-vars byte-compile-warnings)
    (push (nth 1 (nth 1 form)) byte-compile-bound-variables))
  (let ((tail (nthcdr 4 form)))
    (while tail
      ;; If there are any (function (lambda ...)) expressions, compile
      ;; those functions.
      (if (and (consp (car tail))

    (while list
      (let ((arg (car list)))
	(when (symbolp arg)
	  (byte-compile-set-symbol-position arg))
	(cond ((or (not (symbolp arg))
		   (byte-compile-const-symbol-p arg t))
	       (error "Invalid lambda variable %s" arg))
	      ((eq arg '&rest)
	       (unless (cdr list)
		 (error "&rest without variable name"))
	       (when (cddr list)

		    ;; Discard the doc string
		    ;; unless it is the last element of the body.
		    (if (cdr body)
			(setq body (cdr body))))))
	 (int (assq 'interactive body)))
    ;; Process the interactive spec.
    (when int
      (byte-compile-set-symbol-position 'interactive)
      ;; Skip (interactive) if it is in front (the most usual location).
      (if (eq int (car body))
	  (setq body (cdr body)))
      (cond ((consp (cdr int))
	     (if (cdr (cdr int))
		 (byte-compile-warn "malformed interactive spec: %s"
				    (prin1-to-string int)))
	     ;; If the interactive spec is a call to `list',
	     ;; don't compile it, because `call-interactively'
	     ;; looks at the args of `list'.
	     (let ((form (nth 1 int)))
	       (while (memq (car-safe form) '(let let* progn save-excursion))
		 (while (consp (cdr form))
		   (setq form (cdr form)))
		 (setq form (car form)))
	       (or (eq (car-safe form) 'list)
		   (setq int (list 'interactive
				   (byte-compile-top-level (nth 1 int)))))))
	    ((cdr int)
	     (byte-compile-warn "malformed interactive spec: %s"
				(prin1-to-string int)))))
    ;; Process the body.
    (let ((compiled (byte-compile-top-level (cons 'progn 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)))
	  (apply 'make-byte-code
		 (append (list arglist)

  (byte-compile-out 'byte-call (length (cdr form))))

(defun byte-compile-variable-ref (base-op var)
  (when (symbolp var)
    (byte-compile-set-symbol-position var))
  (if (or (not (symbolp var))
	  (byte-compile-const-symbol-p 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 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))
	       (when (cdr ob)))
	  (byte-compile-warn "%s is an obsolete variable%s; %s" var

			     (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)
	    (push var byte-compile-bound-variables)
	  (or (boundp var)
	      (memq var byte-compile-bound-variables)
	      (if (eq base-op 'byte-varset)
		  (or (memq var byte-compile-free-assignments)
		      (progn
			(byte-compile-warn "assignment to free variable %s" var)
			(push var byte-compile-free-assignments)))
		(or (memq var byte-compile-free-references)
		    (progn
		      (byte-compile-warn "reference to free variable %s" var)
		      (push var byte-compile-free-references))))))))
  (let ((tmp (assq var byte-compile-variables)))
    (unless tmp
      (setq tmp (list var))
      (push tmp byte-compile-variables))
    (byte-compile-out base-op tmp)))

(defmacro byte-compile-get-constant (const)
  `(or (if (stringp ,const)
	   (assoc ,const byte-compile-constants)

	    (args (copy-sequence (cdr form))))
	(byte-compile-form (car args))
	(setq args (cdr args))
	(or args (setq args '(0)
		       opcode (get '+ 'byte-opcode)))
	(dolist (arg args)
	  (byte-compile-form arg)
	  (byte-compile-out opcode 0)))
    (byte-compile-constant (eval form))))


;; more complicated compiler macros

(defun byte-compile-let (form)
  ;; First compute the binding values in the old scope.
  (let ((varlist (car (cdr form))))
    (dolist (var varlist)
      (if (consp var)
	  (byte-compile-form (car (cdr var)))
	(byte-compile-push-constant nil))))
  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
	(varlist (reverse (car (cdr form)))))
    (dolist (var varlist)
      (byte-compile-variable-ref 'byte-varbind (if (consp var) (car var) var)))
    (byte-compile-body-do-effect (cdr (cdr form)))
    (byte-compile-out 'byte-unbind (length (car (cdr form))))))

(defun byte-compile-let* (form)
  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
	(varlist (copy-sequence (car (cdr form)))))
    (dolist (var varlist)
      (if (atom var)
	  (byte-compile-push-constant nil)
	(byte-compile-form (car (cdr var)))
	(setq var (car var)))
      (byte-compile-variable-ref 'byte-varbind var))
    (byte-compile-body-do-effect (cdr (cdr form)))
    (byte-compile-out 'byte-unbind (length (car (cdr form))))))


(byte-defop-compiler-1 /= byte-compile-negated)

  (byte-compile-form-do-effect (car (cdr form)))
  (byte-compile-out 'byte-unbind 1))

(defun byte-compile-track-mouse (form)
  (byte-compile-form
   `(funcall '(lambda nil
		(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))

(defun byte-compile-condition-case (form)
  (let* ((var (nth 1 form))
	 (byte-compile-bound-variables
	  (if var (cons var byte-compile-bound-variables)

  (let ((fun (nth 0 form))
	(var (nth 1 form))
	(value (nth 2 form))
	(string (nth 3 form)))
    (byte-compile-set-symbol-position fun)
    (when (or (> (length form) 4)
	      (and (eq fun 'defconst) (null (cddr form))))
      (byte-compile-warn
       "%s called with %d arguments, but accepts only %s"
       fun (length (cdr form)) "2-3"))
    (when (memq 'free-vars byte-compile-warnings)
      (push var byte-compile-dynamic-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))

	`(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")))
		`(funcall '(lambda (,tmp) (defconst ,var ,tmp))
			  ,value))
	    ;; `defvar' sets `var' only when unbound.
	    `(if (not (boundp ',var)) (setq ,var ,value)))
	(when (eq fun 'defconst)
	  ;; This will signal an appropriate error at runtime.
	  `(eval ',form)))
      `',var))))

(defun byte-compile-autoload (form)
  (byte-compile-set-symbol-position 'autoload)
  (and (byte-compile-constp (nth 1 form))

	   (consp (nth 2 form))
	   (eq (car (nth 2 form)) 'quote)
	   (consp (cdr (nth 2 form)))
	   (symbolp (nth 1 (nth 2 form))))
      (progn
	(byte-compile-defalias-warn (nth 1 (nth 1 form)))
	(setq byte-compile-function-environment
	      (cons (cons (nth 1 (nth 1 form))
			  (nth 1 (nth 2 form)))
		    byte-compile-function-environment))))
  (byte-compile-normal-call form))

;; Turn off warnings about prior calls to the function being defalias'd.
;; This could be smarter and compare those calls with
;; the function it is being aliased to.
(defun byte-compile-defalias-warn (new)
  (let ((calls (assq new byte-compile-unresolved-functions)))
    (if calls
	(setq byte-compile-unresolved-functions
	      (delq calls byte-compile-unresolved-functions)))))


	  (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
	(setq byte-compile-depth (cdr (cdr tag))))
    (setcdr (cdr tag) byte-compile-depth)))

(defun byte-compile-goto (opcode tag)
  (push (cons opcode tag) byte-compile-output)
  (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
			(1- byte-compile-depth)
		      byte-compile-depth))
  (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
				(1- byte-compile-depth))))

(defun byte-compile-out (opcode offset)
  (push (cons opcode offset) byte-compile-output)
  (cond ((eq opcode 'byte-call)
	 (setq byte-compile-depth (- byte-compile-depth offset)))
	((eq opcode 'byte-return)
	 ;; This is actually an unnecessary case, because there should be
	 ;; no more opcodes behind byte-return.