comparison lisp/emacs-lisp/bytecomp.el @ 83353:532e0a9335a9

Merged in changes from CVS trunk. Plus added lisp/term tweaks. Patches applied: * [e-mail]--2004/emacs--cvs-trunk--0--base-0 tag of [e-mail]--gnu-2005/emacs--cvs-trunk--0--patch-474 * [e-mail]--2004/emacs--cvs-trunk--0--patch-1 Add CVS metadata files. * [e-mail]--2004/emacs--cvs-trunk--0--patch-2 Update from CVS. git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-393

83352:b258b3492423

;;; bytecomp.el --- compilation of Lisp code into byte code

;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
;;   2003, 2004, 2005  Free Software Foundation, Inc.

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Maintainer: FSF
;; Keywords: lisp

		      (const obsolete) (const noruntime)
		      (const cl-functions) (const interactive-only))))

(defvar byte-compile-interactive-only-functions
  '(beginning-of-buffer end-of-buffer replace-string replace-regexp
			insert-file)
  "List of commands that are not meant to be called from Lisp.")

(defvar byte-compile-not-obsolete-var nil
  "If non-nil, this is a variable that shouldn't be reported as obsolete.")

      (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
    ,tag))

(defmacro byte-compile-maybe-guarded (condition &rest body)
  "Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is the test in an `if' form or in a `cond' clause.
BODY is to compile the first arm of the if or the body of the
cond clause.  If CONDITION is of the form `(foundp 'foo)'
or `(boundp 'foo)', the relevant warnings from BODY about foo
being undefined will be suppressed."
  (declare (indent 1) (debug t))
  `(let* ((fbound
	   (if (eq 'fboundp (car-safe ,condition))
	       (and (eq 'quote (car-safe (nth 1 ,condition)))
		    ;; Ignore if the symbol is already on the

			  (nth 1 (nth 1 ,condition)))))
	  ;; Maybe add to the bound list.
	  (byte-compile-bound-variables
	   (if bound
	       (cons bound byte-compile-bound-variables)
	     byte-compile-bound-variables)))
     (progn ,@body)
     ;; Maybe remove the function symbol from the unresolved list.
     (if fbound
	 (setq byte-compile-unresolved-functions
	       (delq (assq fbound byte-compile-unresolved-functions)
		     byte-compile-unresolved-functions)))))

(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.

	(byte-compile-goto 'byte-goto-if-nil elsetag)
	(byte-compile-maybe-guarded clause
	  (byte-compile-form (nth 2 form) for-effect))
	(byte-compile-goto 'byte-goto donetag)
	(byte-compile-out-tag elsetag)
	(byte-compile-body (cdr (cdr (cdr form))) for-effect)
	(byte-compile-out-tag donetag))))
  (setq for-effect nil))

(defun byte-compile-cond (clauses)
  (let ((donetag (byte-compile-make-tag))

	    ((cdr clauses)
	     (byte-compile-form (car clause))
	     (if (null (cdr clause))
		 ;; First clause is a singleton.
		 (byte-compile-goto-if t for-effect donetag)
		 (setq nexttag (byte-compile-make-tag))
		 (byte-compile-goto 'byte-goto-if-nil nexttag)
		 (byte-compile-maybe-guarded (car clause)
		   (byte-compile-body (cdr clause) for-effect))
		 (byte-compile-goto 'byte-goto donetag)
		 (byte-compile-out-tag nexttag)))))
    ;; Last clause
    (let ((guard (car clause)))
      (and (cdr clause) (not (eq guard t))
	   (progn (byte-compile-form guard)
		  (byte-compile-goto-if nil for-effect donetag)

(defun byte-compile-and (form)
  (let ((failtag (byte-compile-make-tag))
	(args (cdr form)))
    (if (null args)
	(byte-compile-form-do-effect t)
      (while (cdr args)
	(byte-compile-form (car args))
	(byte-compile-goto-if nil for-effect failtag)
	(setq args (cdr args)))
      (byte-compile-form-do-effect (car args))
      (byte-compile-out-tag failtag))))

(defun byte-compile-or (form)
  (let ((wintag (byte-compile-make-tag))
	(args (cdr form)))
    (if (null args)
	(byte-compile-form-do-effect nil)
      (while (cdr args)
	(byte-compile-form (car args))
	(byte-compile-goto-if t for-effect wintag)
	(setq args (cdr args)))
      (byte-compile-form-do-effect (car args))
      (byte-compile-out-tag wintag))))

(defun byte-compile-while (form)
  (let ((endtag (byte-compile-make-tag))
	(looptag (byte-compile-make-tag)))
    (byte-compile-out-tag looptag)

(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
  (let (byte-compile-warnings)
    (byte-compile-form (cons 'progn (cdr form)))))

;;; tags

;; Note: Most operations will strip off the 'TAG, but it speeds up
;; optimization to have the 'TAG as a part of the tag.

83353:532e0a9335a9

;;; bytecomp.el --- compilation of Lisp code into byte code

;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
;;   2003, 2004, 2005 Free Software Foundation, Inc.

;; Author: Jamie Zawinski <[e-mail]>
;;	Hallvard Furuseth <[e-mail]>
;; Maintainer: FSF
;; Keywords: lisp

		      (const obsolete) (const noruntime)
		      (const cl-functions) (const interactive-only))))

(defvar byte-compile-interactive-only-functions
  '(beginning-of-buffer end-of-buffer replace-string replace-regexp
    insert-file insert-buffer insert-file-literally)
  "List of commands that are not meant to be called from Lisp.")

(defvar byte-compile-not-obsolete-var nil
  "If non-nil, this is a variable that shouldn't be reported as obsolete.")

      (if ,discard 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
    ,tag))

(defmacro byte-compile-maybe-guarded (condition &rest body)
  "Execute forms in BODY, potentially guarded by CONDITION.
CONDITION is a variable whose value is a test in an `if' or `cond'.
BODY is the code to compile  first arm of the if or the body of the
cond clause.  If CONDITION's value is of the form (fboundp 'foo)
or (boundp 'foo), the relevant warnings from BODY about foo's
being undefined will be suppressed.

If CONDITION's value is (not (featurep 'emacs)) or (featurep 'xemacs),
that suppresses all warnings during execution of BODY."
  (declare (indent 1) (debug t))
  `(let* ((fbound
	   (if (eq 'fboundp (car-safe ,condition))
	       (and (eq 'quote (car-safe (nth 1 ,condition)))
		    ;; Ignore if the symbol is already on the

			  (nth 1 (nth 1 ,condition)))))
	  ;; Maybe add to the bound list.
	  (byte-compile-bound-variables
	   (if bound
	       (cons bound byte-compile-bound-variables)
	     byte-compile-bound-variables))
	  ;; Suppress all warnings, for code not used in Emacs.
	  (byte-compile-warnings
	   (if (member ,condition '((featurep 'xemacs)
				    (not (featurep 'emacs))))
	       nil byte-compile-warnings)))
     (unwind-protect
	 (progn ,@body)
       ;; Maybe remove the function symbol from the unresolved list.
       (if fbound
	   (setq byte-compile-unresolved-functions
		 (delq (assq fbound byte-compile-unresolved-functions)
		       byte-compile-unresolved-functions))))))

(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.

	(byte-compile-goto 'byte-goto-if-nil elsetag)
	(byte-compile-maybe-guarded clause
	  (byte-compile-form (nth 2 form) for-effect))
	(byte-compile-goto 'byte-goto donetag)
	(byte-compile-out-tag elsetag)
	(byte-compile-maybe-guarded (list 'not clause)
	  (byte-compile-body (cdr (cdr (cdr form))) for-effect))
	(byte-compile-out-tag donetag))))
  (setq for-effect nil))

(defun byte-compile-cond (clauses)
  (let ((donetag (byte-compile-make-tag))

	    ((cdr clauses)
	     (byte-compile-form (car clause))
	     (if (null (cdr clause))
		 ;; First clause is a singleton.
		 (byte-compile-goto-if t for-effect donetag)
	       (setq nexttag (byte-compile-make-tag))
	       (byte-compile-goto 'byte-goto-if-nil nexttag)
	       (byte-compile-maybe-guarded (car clause)
		 (byte-compile-body (cdr clause) for-effect))
	       (byte-compile-goto 'byte-goto donetag)
	       (byte-compile-out-tag nexttag)))))
    ;; Last clause
    (let ((guard (car clause)))
      (and (cdr clause) (not (eq guard t))
	   (progn (byte-compile-form guard)
		  (byte-compile-goto-if nil for-effect donetag)

(defun byte-compile-and (form)
  (let ((failtag (byte-compile-make-tag))
	(args (cdr form)))
    (if (null args)
	(byte-compile-form-do-effect t)
      (byte-compile-and-recursion args failtag))))

;; Handle compilation of a nontrivial `and' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-and-recursion (rest failtag)
  (if (cdr rest)
      (progn
	(byte-compile-form (car rest))
	(byte-compile-goto-if nil for-effect failtag)
	(byte-compile-maybe-guarded (car rest)
	  (byte-compile-and-recursion (cdr rest) failtag)))
    (byte-compile-form-do-effect (car rest))
    (byte-compile-out-tag failtag)))

(defun byte-compile-or (form)
  (let ((wintag (byte-compile-make-tag))
	(args (cdr form)))
    (if (null args)
	(byte-compile-form-do-effect nil)
      (byte-compile-or-recursion args wintag))))

;; Handle compilation of a nontrivial `or' call.
;; We use tail recursion so we can use byte-compile-maybe-guarded.
(defun byte-compile-or-recursion (rest wintag)
  (if (cdr rest)
      (progn
	(byte-compile-form (car rest))
	(byte-compile-goto-if t for-effect wintag)
	(byte-compile-maybe-guarded (list 'not (car rest))
	  (byte-compile-or-recursion (cdr rest) wintag)))
    (byte-compile-form-do-effect (car rest))
    (byte-compile-out-tag wintag)))

(defun byte-compile-while (form)
  (let ((endtag (byte-compile-make-tag))
	(looptag (byte-compile-make-tag)))
    (byte-compile-out-tag looptag)

(byte-defop-compiler-1 with-no-warnings byte-compile-no-warnings)
(defun byte-compile-no-warnings (form)
  (let (byte-compile-warnings)
    (byte-compile-form (cons 'progn (cdr form)))))

;; Warn about misuses of make-variable-buffer-local.
(byte-defop-compiler-1 make-variable-buffer-local byte-compile-make-variable-buffer-local)
(defun byte-compile-make-variable-buffer-local (form)
  (if (eq (car-safe (car-safe (cdr-safe form))) 'quote)
      (byte-compile-warn
       "`make-variable-buffer-local' should be called at toplevel"))
  (byte-compile-normal-call form))
(put 'make-variable-buffer-local
     'byte-hunk-handler 'byte-compile-form-make-variable-buffer-local)
(defun byte-compile-form-make-variable-buffer-local (form)
  (byte-compile-keep-pending form 'byte-compile-normal-call))


;;; tags

;; Note: Most operations will strip off the 'TAG, but it speeds up
;; optimization to have the 'TAG as a part of the tag.