comparison lisp/emacs-lisp/bytecomp.el @ 105847:ca4611bcf0d4

(byte-compile-version-cond): Remove macro. (byte-compile-compatibility): Remove option. (byte-compile-close-variables, byte-compile-fix-header) (byte-compile-insert-header, byte-compile-output-docform) (byte-compile-file-form-defmumble, byte-compile-byte-code-maker) (byte-compile-lambda, byte-compile-form, byte-defop-compiler19) (byte-compile-list, byte-compile-concat, byte-compile-function-form) (byte-compile-insert, byte-compile-defun): Remove support for byte-compile-compatibility and Emacs 18. (Bug#4571)

105846:e2ca82d9bfab

    (load "byte-run"))

;; The feature of compiling in a specific target Emacs version
;; has been turned off because compile time options are a bad idea.
(defmacro byte-compile-single-version () nil)
(defmacro byte-compile-version-cond (cond) cond)

;; The crud you see scattered through this file of the form
;;   (or (and (boundp 'epoch::version) epoch::version)
;;	  (string-lessp emacs-version "19"))
;; is because the Epoch folks couldn't be bothered to follow the

(autoload 'byte-decompile-bytecode "byte-opt")

(defcustom byte-compile-verbose
  (and (not noninteractive) (> baud-rate search-slow-speed))
  "Non-nil means print messages describing progress of byte-compiler."
  :group 'bytecomp
  :type 'boolean)

(defcustom byte-compile-compatibility nil
  "Non-nil means generate output that can run in Emacs 18.
This only means that it can run in principle, if it doesn't require
facilities that have been added more recently."
  :group 'bytecomp
  :type 'boolean)

;; (defvar byte-compile-generate-emacs19-bytecodes
;;         (not (or (and (boundp 'epoch::version) epoch::version)

		;; Close over these variables so that `byte-compiler-options'
		;; can change them on a per-file basis.
		;;
		(byte-compile-verbose byte-compile-verbose)
		(byte-optimize byte-optimize)
		(byte-compile-compatibility byte-compile-compatibility)
		(byte-compile-dynamic byte-compile-dynamic)
		(byte-compile-dynamic-docstrings
		 byte-compile-dynamic-docstrings)
;; 		(byte-compile-generate-emacs19-bytecodes
;; 		 byte-compile-generate-emacs19-bytecodes)

(defun byte-compile-fix-header (filename inbuffer outbuffer)
  (with-current-buffer outbuffer
    ;; See if the buffer has any multibyte characters.
    (when (< (point-max) (position-bytes (point-max)))
      (when (byte-compile-version-cond byte-compile-compatibility)
	(error "Version-18 compatibility not valid with multibyte characters"))
      (goto-char (point-min))
      ;; Find the comment that describes the version test.
      (search-forward "\n;;; This file")
      (beginning-of-line)
      (narrow-to-region (point) (point-max))

      ;; benefit is that you can add this to /etc/magic:

      ;; 0	string		;ELC		GNU Emacs Lisp compiled file,
      ;; >4	byte		x		version %d

      (insert
       ";ELC"
       (if (byte-compile-version-cond byte-compile-compatibility) 18 23)
       "\000\000\000\n"
       )
      (insert ";;; Compiled by "
	      (or (and (boundp 'user-mail-address) user-mail-address)
		  (concat (user-login-name) "@" (system-name)))
	      " on "
	      (current-time-string) "\n;;; from file " filename "\n")

	      (cond
	       ((eq byte-optimize 'source) "with source-level optimization only")
	       ((eq byte-optimize 'byte) "with byte-level optimization only")
	       (byte-optimize "with all optimizations")
	       (t "without optimization"))
	      (if (byte-compile-version-cond byte-compile-compatibility)
		  "; compiled with Emacs 18 compatibility.\n"
		".\n"))
      (if dynamic
	  (insert ";;; Function definitions are lazy-loaded.\n"))
      (if (not (byte-compile-version-cond byte-compile-compatibility))
	  (let (intro-string minimum-version)
	    ;; Figure out which Emacs version to require,
	    ;; and what comment to use to explain why.
	    ;; Note that this fails to take account of whether
	    ;; the buffer contains multibyte characters.  We may have to
	    ;; compensate at the end in byte-compile-fix-header.
	    (if dynamic-docstrings
	      (setq intro-string
		    ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
		    minimum-version "19.29")
	    (setq intro-string
		  ";;; This file uses opcodes which do not exist in Emacs 18.\n"
		  minimum-version "19"))
	  ;; Now insert the comment and the error check.
	  (insert
	   "\n"
	   intro-string
	   ;; Have to check if emacs-version is bound so that this works
	   ;; in files loaded early in loadup.el.
	   "(if (and (boundp 'emacs-version)\n"
	   ;; If there is a name at the end of emacs-version,
	   ;; don't try to check the version number.
	   "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
	   "\t (or (and (boundp 'epoch::version) epoch::version)\n"
	   (format "\t     (string-lessp emacs-version \"%s\")))\n"
		   minimum-version)
	   "    (error \"`"
	   ;; prin1-to-string is used to quote backslashes.
	   (substring (prin1-to-string (file-name-nondirectory filename))
		      1 -1)
	   (format "' was compiled for Emacs %s or later\"))\n\n"
		   minimum-version)
	   ;; Insert semicolons as ballast, so that byte-compile-fix-header
	   ;; can delete them so as to keep the buffer positions
	   ;; constant for the actual compiled code.
	   ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n"))
      ;; Here if we want Emacs 18 compatibility.
      (when dynamic-docstrings
	(error "Version-18 compatibility doesn't support dynamic doc strings"))
      (when byte-compile-dynamic
	(error "Version-18 compatibility doesn't support dynamic byte code"))
      (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
		"\n")))))

;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defvar bytecomp-outbuffer)

      (let (position)

        ;; Insert the doc string, and make it a comment with #@LENGTH.
        (and (>= (nth 1 info) 0)
             dynamic-docstrings
             (not byte-compile-compatibility)
             (progn
               ;; Make the doc string start at beginning of line
               ;; for make-docfile's sake.
               (insert "\n")
               (setq position

	(byte-compile-flush-pending)
	(if (not (stringp (nth 3 form)))
	    ;; No doc string.  Provide -1 as the "doc string index"
	    ;; so that no element will be treated as a doc string.
	    (byte-compile-output-docform
	     (if (byte-compile-version-cond byte-compile-compatibility)
		 "\n(fset '" "\n(defalias '")
	     bytecomp-name
	     (cond ((atom code)
		    (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
		   ((eq (car code) 'quote)
		    (setq code new-one)

		  1)
	     nil)
	  ;; Output the form by hand, that's much simpler than having
	  ;; b-c-output-file-form analyze the defalias.
	  (byte-compile-output-docform
	   (if (byte-compile-version-cond byte-compile-compatibility)
	       "\n(fset '" "\n(defalias '")
	   bytecomp-name
	   (cond ((atom code)
		  (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
		 ((eq (car code) 'quote)
		  (setq code new-one)

    (byte-compile-top-level sexp))))

;; Given a function made by byte-compile-lambda, make a form which produces it.
(defun byte-compile-byte-code-maker (fun)
  (cond
   ((byte-compile-version-cond byte-compile-compatibility)
    ;; Return (quote (lambda ...)).
    (list 'quote (byte-compile-byte-code-unmake fun)))
   ;; ## atom is faster than compiled-func-p.
   ((atom fun)				; compiled function.
    ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
    ;; would have produced a lambda.
    fun)

				(prin1-to-string bytecomp-int)))))
    ;; Process the body.
    (let ((compiled (byte-compile-top-level
		     (cons 'progn bytecomp-body) nil 'lambda)))
      ;; Build the actual byte-coded function.
      (if (and (eq 'byte-code (car-safe compiled))
	       (not (byte-compile-version-cond
		     byte-compile-compatibility)))
	  (apply 'make-byte-code
		 (append (list bytecomp-arglist)
			 ;; byte-string, constants-vector, stack depth
			 (cdr compiled)
			 ;; optionally, the doc string.

                    ;; for CL compiler macros since the symbol may be
                    ;; `cl-byte-compile-compiler-macro' but if CL isn't
                    ;; loaded, this function doesn't exist.
                    (or (not (memq bytecomp-handler
				   '(cl-byte-compile-compiler-macro)))
                        (functionp bytecomp-handler))
		    (not (and (byte-compile-version-cond
                               byte-compile-compatibility)
                              (get (get bytecomp-fn 'byte-opcode)
				   'emacs19-opcode))))
               (funcall bytecomp-handler form)
	     (byte-compile-normal-call form))
	   (if (byte-compile-warning-enabled-p 'cl-functions)
	       (byte-compile-cl-warn form))))
	((and (or (byte-code-function-p (car form))

		(list 'put (list 'quote opcode)
		      ''byte-opcode-invert (list 'quote function)))
	fnform))))

(defmacro byte-defop-compiler19 (function &optional compile-handler)
  ;; Just like byte-defop-compiler, but defines an opcode that will only
  ;; be used when byte-compile-compatibility is false.
  (if (and (byte-compile-single-version)
	   byte-compile-compatibility)
      ;; #### instead of doing nothing, this should do some remprops,
      ;; #### to protect against the case where a single-version compiler
      ;; #### is loaded into a world that has contained a multi-version one.
      nil
    (list 'progn
      (list 'put
	(list 'quote
	  (or (car (cdr-safe function))
	      (intern (concat "byte-"
		        (symbol-name (or (car-safe function) function))))))
	''emacs19-opcode t)
      (list 'byte-defop-compiler function compile-handler))))

(defmacro byte-defop-compiler-1 (function &optional compile-handler)
  (list 'byte-defop-compiler (list function nil) compile-handler))



	   (byte-compile-constant nil))
	  ((< count 5)
	   (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)))
	   (mapc 'byte-compile-form (cdr form))
	   (byte-compile-out 'byte-listN count))
	  (t (byte-compile-normal-call form)))))

(defun byte-compile-concat (form)

	    (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
	    0))
	  ;; Concat of one arg is not a no-op if arg is not a string.
	  ((= count 0)
	   (byte-compile-form ""))
	  ((and (< count 256) (not (byte-compile-version-cond
				    byte-compile-compatibility)))
	   (mapc 'byte-compile-form (cdr form))
	   (byte-compile-out 'byte-concatN count))
	  ((byte-compile-normal-call form)))))

(defun byte-compile-minus (form)

(defun byte-compile-function-form (form)
  (byte-compile-constant
   (cond ((symbolp (nth 1 form))
	  (nth 1 form))
	 ;; If we're not allowed to use #[] syntax, then output a form like
	 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code.
	 ;; In this situation, calling make-byte-code at run-time will usually
	 ;; be less efficient than processing a call to byte-code.
	 ((byte-compile-version-cond byte-compile-compatibility)
	  (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form))))
	 ((byte-compile-lambda (nth 1 form))))))

(defun byte-compile-indent-to (form)
  (let ((len (length form)))
    (cond ((= len 2)

	   (byte-compile-subr-wrong-args form "1-2")))))

(defun byte-compile-insert (form)
  (cond ((null (cdr form))
	 (byte-compile-constant nil))
	((and (not (byte-compile-version-cond
		    byte-compile-compatibility))
	      (<= (length form) 256))
	 (mapc 'byte-compile-form (cdr form))
	 (if (cdr (cdr form))
	     (byte-compile-out 'byte-insertN (length (cdr form)))
	   (byte-compile-out 'byte-insert 0)))
	((memq t (mapcar 'consp (cdr (cdr form))))

  ;; This is not used for file-level defuns with doc strings.
  (if (symbolp (car form))
      (byte-compile-set-symbol-position (car form))
    (byte-compile-set-symbol-position 'defun)
    (error "defun name must be a symbol, not %s" (car form)))
  (if (byte-compile-version-cond byte-compile-compatibility)
      (progn
	(byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
	 (list 'fset
	       (list 'quote (nth 1 form))
	       (byte-compile-byte-code-maker
		(byte-compile-lambda (cdr (cdr form)) t))))
	(byte-compile-discard))
    ;; We prefer to generate a defalias form so it will record the function
    ;; definition just like interpreting a defun.
    (byte-compile-form
     (list 'defalias
	   (list 'quote (nth 1 form))
	   (byte-compile-byte-code-maker
	    (byte-compile-lambda (cdr (cdr form)) t)))
     t))
  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect

105847:ca4611bcf0d4

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

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

(autoload 'byte-decompile-bytecode "byte-opt")

(defcustom byte-compile-verbose
  (and (not noninteractive) (> baud-rate search-slow-speed))
  "Non-nil means print messages describing progress of byte-compiler."
  :group 'bytecomp
  :type 'boolean)

;; (defvar byte-compile-generate-emacs19-bytecodes
;;         (not (or (and (boundp 'epoch::version) epoch::version)

		;; Close over these variables so that `byte-compiler-options'
		;; can change them on a per-file basis.
		;;
		(byte-compile-verbose byte-compile-verbose)
		(byte-optimize byte-optimize)
		(byte-compile-dynamic byte-compile-dynamic)
		(byte-compile-dynamic-docstrings
		 byte-compile-dynamic-docstrings)
;; 		(byte-compile-generate-emacs19-bytecodes
;; 		 byte-compile-generate-emacs19-bytecodes)

(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)))
      (goto-char (point-min))
      ;; Find the comment that describes the version test.
      (search-forward "\n;;; This file")
      (beginning-of-line)
      (narrow-to-region (point) (point-max))

      ;; benefit is that you can add this to /etc/magic:

      ;; 0	string		;ELC		GNU Emacs Lisp compiled file,
      ;; >4	byte		x		version %d

      (insert ";ELC" 23 "\000\000\000\n")
      (insert ";;; Compiled by "
	      (or (and (boundp 'user-mail-address) user-mail-address)
		  (concat (user-login-name) "@" (system-name)))
	      " on "
	      (current-time-string) "\n;;; from file " filename "\n")

	      (cond
	       ((eq byte-optimize 'source) "with source-level optimization only")
	       ((eq byte-optimize 'byte) "with byte-level optimization only")
	       (byte-optimize "with all optimizations")
	       (t "without optimization"))
		".\n")
      (if dynamic
	  (insert ";;; Function definitions are lazy-loaded.\n"))
      (let (intro-string minimum-version)
	;; Figure out which Emacs version to require,
	;; and what comment to use to explain why.
	;; Note that this fails to take account of whether
	;; the buffer contains multibyte characters.  We may have to
	;; compensate at the end in byte-compile-fix-header.
	(if dynamic-docstrings
	    (setq intro-string
		  ";;; This file uses dynamic docstrings, first added in Emacs 19.29.\n"
		  minimum-version "19.29")
	  (setq intro-string
		";;; This file uses opcodes which do not exist in Emacs 18.\n"
		minimum-version "19"))
	;; Now insert the comment and the error check.
	(insert
	 "\n"
	 intro-string
	 ;; Have to check if emacs-version is bound so that this works
	 ;; in files loaded early in loadup.el.
	 "(if (and (boundp 'emacs-version)\n"
	 ;; If there is a name at the end of emacs-version,
	 ;; don't try to check the version number.
	 "\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
	 "\t (or (and (boundp 'epoch::version) epoch::version)\n"
	 (format "\t     (string-lessp emacs-version \"%s\")))\n"
		 minimum-version)
	 "    (error \"`"
	 ;; prin1-to-string is used to quote backslashes.
	 (substring (prin1-to-string (file-name-nondirectory filename))
		    1 -1)
	 (format "' was compiled for Emacs %s or later\"))\n\n"
		 minimum-version)
	 ;; Insert semicolons as ballast, so that byte-compile-fix-header
	 ;; can delete them so as to keep the buffer positions
	 ;; constant for the actual compiled code.
	 ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))))

;; Dynamically bound in byte-compile-from-buffer.
;; NB also used in cl.el and cl-macs.el.
(defvar bytecomp-outbuffer)

      (let (position)

        ;; Insert the doc string, and make it a comment with #@LENGTH.
        (and (>= (nth 1 info) 0)
             dynamic-docstrings
             (progn
               ;; Make the doc string start at beginning of line
               ;; for make-docfile's sake.
               (insert "\n")
               (setq position

	(byte-compile-flush-pending)
	(if (not (stringp (nth 3 form)))
	    ;; No doc string.  Provide -1 as the "doc string index"
	    ;; so that no element will be treated as a doc string.
	    (byte-compile-output-docform
	     "\n(defalias '"
	     bytecomp-name
	     (cond ((atom code)
		    (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
		   ((eq (car code) 'quote)
		    (setq code new-one)

		  1)
	     nil)
	  ;; Output the form by hand, that's much simpler than having
	  ;; b-c-output-file-form analyze the defalias.
	  (byte-compile-output-docform
	   "\n(defalias '"
	   bytecomp-name
	   (cond ((atom code)
		  (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
		 ((eq (car code) 'quote)
		  (setq code new-one)

    (byte-compile-top-level sexp))))

;; Given a function made by byte-compile-lambda, make a form which produces it.
(defun byte-compile-byte-code-maker (fun)
  (cond
   ;; ## atom is faster than compiled-func-p.
   ((atom fun)				; compiled function.
    ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
    ;; would have produced a lambda.
    fun)

				(prin1-to-string bytecomp-int)))))
    ;; Process the body.
    (let ((compiled (byte-compile-top-level
		     (cons 'progn bytecomp-body) nil 'lambda)))
      ;; Build the actual byte-coded function.
      (if (eq 'byte-code (car-safe compiled))
	  (apply 'make-byte-code
		 (append (list bytecomp-arglist)
			 ;; byte-string, constants-vector, stack depth
			 (cdr compiled)
			 ;; optionally, the doc string.

                    ;; for CL compiler macros since the symbol may be
                    ;; `cl-byte-compile-compiler-macro' but if CL isn't
                    ;; loaded, this function doesn't exist.
                    (or (not (memq bytecomp-handler
				   '(cl-byte-compile-compiler-macro)))
                        (functionp bytecomp-handler)))
               (funcall bytecomp-handler form)
	     (byte-compile-normal-call form))
	   (if (byte-compile-warning-enabled-p 'cl-functions)
	       (byte-compile-cl-warn form))))
	((and (or (byte-code-function-p (car form))

		(list 'put (list 'quote opcode)
		      ''byte-opcode-invert (list 'quote function)))
	fnform))))

(defmacro byte-defop-compiler19 (function &optional compile-handler)
  ;; Just like byte-defop-compiler, but used to define an opcode to only
  ;; be used when byte-compile-compatibility was false.
  (list 'progn
	(list 'put
	      (list 'quote
		    (or (car (cdr-safe function))
			(intern (concat "byte-"
					(symbol-name (or (car-safe function)
							 function))))))
	      ''emacs19-opcode t)
	(list 'byte-defop-compiler function compile-handler)))

(defmacro byte-defop-compiler-1 (function &optional compile-handler)
  (list 'byte-defop-compiler (list function nil) compile-handler))



	   (byte-compile-constant nil))
	  ((< count 5)
	   (mapc 'byte-compile-form (cdr form))
	   (byte-compile-out
	    (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
	  ((< count 256)
	   (mapc 'byte-compile-form (cdr form))
	   (byte-compile-out 'byte-listN count))
	  (t (byte-compile-normal-call form)))))

(defun byte-compile-concat (form)

	    (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
	    0))
	  ;; Concat of one arg is not a no-op if arg is not a string.
	  ((= count 0)
	   (byte-compile-form ""))
	  ((< count 256)
	   (mapc 'byte-compile-form (cdr form))
	   (byte-compile-out 'byte-concatN count))
	  ((byte-compile-normal-call form)))))

(defun byte-compile-minus (form)

(defun byte-compile-function-form (form)
  (byte-compile-constant
   (cond ((symbolp (nth 1 form))
	  (nth 1 form))
	 ((byte-compile-lambda (nth 1 form))))))

(defun byte-compile-indent-to (form)
  (let ((len (length form)))
    (cond ((= len 2)

	   (byte-compile-subr-wrong-args form "1-2")))))

(defun byte-compile-insert (form)
  (cond ((null (cdr form))
	 (byte-compile-constant nil))
	((<= (length form) 256)
	 (mapc 'byte-compile-form (cdr form))
	 (if (cdr (cdr form))
	     (byte-compile-out 'byte-insertN (length (cdr form)))
	   (byte-compile-out 'byte-insert 0)))
	((memq t (mapcar 'consp (cdr (cdr form))))

  ;; This is not used for file-level defuns with doc strings.
  (if (symbolp (car form))
      (byte-compile-set-symbol-position (car form))
    (byte-compile-set-symbol-position 'defun)
    (error "defun name must be a symbol, not %s" (car form)))
  ;; We prefer to generate a defalias form so it will record the function
  ;; definition just like interpreting a defun.
  (byte-compile-form
   (list 'defalias
	 (list 'quote (nth 1 form))
	 (byte-compile-byte-code-maker
	  (byte-compile-lambda (cdr (cdr form)) t)))
   t)
  (byte-compile-constant (nth 1 form)))

(defun byte-compile-defmacro (form)
  ;; This is not used for file-level defmacros with doc strings.
  (byte-compile-body-do-effect