xemacs-beta: lisp/bytecomp.el comparison

comparison lisp/bytecomp.el @ 5503:7b5946dbfb96

Drop support for generating code appropriate for Emacs 19, bytecomp.el lisp/ChangeLog addition: 2011-05-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-two-args-19->20): Removed. * bytecomp.el (byte-compile-emacs19-compatibility): Removed. * bytecomp.el (byte-defop-compiler20): Removed. * bytecomp.el (byte-defop-compiler-rmsfun): Removed. * bytecomp.el (emacs-lisp-file-regexp): * bytecomp.el (byte-compile-print-gensym): * bytecomp.el (byte-compiler-legal-options): * bytecomp.el (byte-compiler-obsolete-options): * bytecomp.el (byte-compile-close-variables): * bytecomp.el (byte-compile-insert-header): * bytecomp.el (byte-compile-output-file-form): * bytecomp.el (byte-compile-output-docform): * bytecomp.el (byte-compile-out-toplevel): * bytecomp.el (byte-compile-form): * bytecomp.el (byte-defop-compiler-1): * bytecomp.el (eq): * bytecomp.el (equal): * bytecomp.el (member): * bytecomp.el (byte-compile-noop): * bytecomp.el (byte-compile-save-current-buffer): Remove support for generating code appropriate to Emacs 19. * bytecomp.el (byte-compile-eval): Avoid erroring here if the car of some entry in the macro environment is not a symbol, as is the case for symbol macros. * bytecomp.el (or): Use slightly better style when compiling the most important functions if bytecomp.el has just been loaded interpreted.

author	Aidan Kehoe <kehoea@parhasard.net>
date	Sat, 07 May 2011 12:26:39 +0100
parents	248176c74e6b
children	b0d87f92e60b

comparison

equal deleted inserted replaced

-:5b08be74bb53
+:7b5946dbfb96
 ;;;                                                 mapc, and similar)
 ;;;                             'quoted-lambda (quoting a lambda expression
 ;;;                                             as data, not as a function,
 ;;;                                             and using it in a function
 ;;;                                             context )
-;;; byte-compile-emacs19-compatibility	Whether the compiler should
-;;;				generate .elc files which can be loaded into
-;;;				generic emacs 19.
 ;;; emacs-lisp-file-regexp	Regexp for the extension of source-files;
 ;;;				see also the function `byte-compile-dest-file'.
 ;;; byte-compile-overwrite-file	If nil, delete old .elc files before saving.
 ;;;
 ;;; Most of the above parameters can also be set on a file-by-file basis; see
 (or (fboundp 'defsubst)
 ;; This really ought to be loaded already!
 (load-library "bytecomp-runtime"))
-(eval-when-compile
-(defvar byte-compile-single-version t
-"If this is true, the choice of emacs version (v19 or v20) byte-codes will
-be hard-coded into bytecomp when it compiles itself.  If the compiler itself
-is compiled with optimization, this causes a speedup.")
-(cond
-(byte-compile-single-version
-(defmacro byte-compile-single-version () t)
-(defmacro byte-compile-version-cond (cond) (list 'quote (eval cond))))
-(t
-(defmacro byte-compile-single-version () nil)
-(defmacro byte-compile-version-cond (cond) cond)))
-)
 (defvar emacs-lisp-file-regexp "\\.el$"
 "*Regexp which matches Emacs Lisp source files.
 You may want to redefine `byte-compile-dest-file' if you change this.")
 ;; This enables file name handlers such as jka-compr
 (defvar byte-compile-verbose
 (and (not noninteractive) (> (device-baud-rate) search-slow-speed))
 "*Non-nil means print messages describing progress of byte-compiler.")
-(defvar byte-compile-emacs19-compatibility
-(not (emacs-version>= 20))
-"*Non-nil means generate output that can run in Emacs 19.")
 (defvar byte-compile-print-gensym t
 "*Non-nil means generate code that creates unique symbols at run-time.
 This is achieved by printing uninterned symbols using the `#:SYMBOL'
 notation, so that they will be read uninterned when run.
 With this feature, code that uses uninterned symbols in macros will
-not be runnable under pre-21.0 XEmacsen.
+not be runnable under pre-21.0 XEmacsen.")
-When `byte-compile-emacs19-compatibility' is non-nil, this variable is
-ignored and considered to be nil.")
 (defvar byte-optimize t
 "*Enables optimization in the byte compiler.
 nil means don't do any optimization.
 t means do all optimizations.
 ;;; "If a file being compiled contains a `defmacro' form, the macro is
 ;;; defined temporarily for the rest of the compilation of that file."
 (defun byte-compile-eval (form)
 (let ((save-macro-environment nil))
 (unwind-protect
-	(loop for (sym . def) in byte-compile-macro-environment do
+	(loop
-	  (push
+	  for (sym . def) in byte-compile-macro-environment
-	   (if (fboundp sym) (cons sym (symbol-function sym)) sym)
+	  do (when (symbolp sym)
-	   save-macro-environment)
+	       (push
-	  (fset sym (cons 'macro def))
+		(if (fboundp sym)
+		    (cons sym (symbol-function sym))
+		  sym)
+		save-macro-environment)
+	       (fset sym (cons 'macro def)))
 	  finally return (eval form))
 (dolist (elt save-macro-environment)
 	(if (symbolp elt)
 	    (fmakunbound elt)
 	  (fset (car elt) (cdr elt)))))))
 ;; Compiler options
 (defconst byte-compiler-legal-options
 '((optimize byte-optimize (t nil source byte) val)
-(file-format byte-compile-emacs19-compatibility (emacs19 emacs20)
+(file-format byte-compile-emacs19-compatibility (emacs20)
 		 (eq val 'emacs19))
 (delete-errors byte-compile-delete-errors (t nil) val)
 (verbose byte-compile-verbose (t nil) val)
 (new-bytecodes byte-compile-new-bytecodes (t nil) val)
 (warnings byte-compile-warnings
 			 unresolved discarded-consing quoted-lambda))
 	      val)))
 ;; XEmacs addition
 (defconst byte-compiler-obsolete-options
-'((new-bytecodes t)))
+'((new-bytecodes t) (byte-compile-emacs19-compatibility nil)))
-;; Inhibit v19/v20 selectors if the version is hardcoded.
-;; #### 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)
-(setcar (cdr (cdr (assq 'file-format byte-compiler-legal-options)))
-	  (if (byte-compile-version-cond byte-compile-emacs19-compatibility)
-	      '(emacs19) '(emacs20)))))
-;; now we can copy it.
-(setq byte-compiler-legal-options byte-compiler-legal-options)
 (defun byte-compiler-options-handler (&rest args)
 (let (key val desc choices)
 (while args
 (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
 	;; 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-emacs19-compatibility
-	 byte-compile-emacs19-compatibility)
 	(byte-compile-checks-on-load
 	 byte-compile-checks-on-load)
 	(byte-compile-dynamic byte-compile-dynamic)
 	(byte-compile-dynamic-docstrings
 	 byte-compile-dynamic-docstrings)
 ;; 0	string		;ELC		XEmacs Lisp compiled file,
 ;; >4	byte		x		version %d
 ;;
 (insert
 ";ELC"
-(if (byte-compile-version-cond byte-compile-emacs19-compatibility) 19 20)
+20
 "\000\000\000\n")
 (when (not (eq (find-coding-system 'raw-text-unix)
 		   (find-coding-system buffer-file-coding-system)))
 (insert (format ";;;###coding system: %s\n"
 		      (coding-system-name buffer-file-coding-system))))
 					 '(autoload custom-declare-variable)))
 (let ((print-escape-newlines t)
 	  (print-length nil)
 	  (print-level nil)
 	  (print-readably t)	; print #[] for bytecode, 'x for (quote x)
-	  (print-gensym (if (and byte-compile-print-gensym
+	  (print-gensym (if byte-compile-print-gensym '(t) nil))
-				 (not byte-compile-emacs19-compatibility))
-			    '(t) nil))
 print-gensym-alist)
 (when byte-compile-output-preface
 (princ "\n(progn " byte-compile-outbuffer)
 (prin1 byte-compile-output-preface byte-compile-outbuffer))
 (princ "\n" byte-compile-outbuffer)
 	 (let ((print-escape-newlines t)
 	       (print-readably t)	; print #[] for bytecode, 'x for (quote x)
 	       ;; Use a cons cell to say that we want
 	       ;; print-gensym-alist not to be cleared between calls
 	       ;; to print functions.
-	       (print-gensym (if (and byte-compile-print-gensym
+	       (print-gensym (if byte-compile-print-gensym '(t) nil))
-				      (not byte-compile-emacs19-compatibility))
-				 '(t) nil))
 	       print-gensym-alist
 	       (index 0))
 (when byte-compile-output-preface
 (princ "\n(progn " byte-compile-outbuffer)
 (prin1 byte-compile-output-preface byte-compile-outbuffer))
 			     (setq body (cons (list 'quote tmp) body)))
 		       (setq body (cons tmp body))))
 		    ((and maycall
 			  ;; Allow a funcall if at most one atom follows it.
 			  (null (nthcdr 3 rest))
-			  (setq tmp
+			  (setq tmp (get (car (car rest)) 'byte-opcode-invert))
-				;; XEmacs change for rms funs
-				(or (and
-				     (byte-compile-version-cond
-				      byte-compile-emacs19-compatibility)
-				     (get (car (car rest))
-					  'byte-opcode19-invert))
-				    (get (car (car rest))
-					 'byte-opcode-invert)))
 			  (or (null (cdr rest))
 			      (and (memq output-type '(file progn t))
 				   (cdr (cdr rest))
 				   (eq (car (nth 1 rest)) 'byte-discard)
 				   (progn (setq rest (cdr rest)) t))))
 	((symbolp (car form))
 	 (let* ((fn (car form))
 		(handler (get fn 'byte-compile)))
 	   (if (memq fn '(t nil))
 	       (byte-compile-warn "%s called as a function" fn))
-	   (if (and handler
+	   (if handler
-		    (or (not (byte-compile-version-cond
-			      byte-compile-emacs19-compatibility))
-			(not (get (get fn 'byte-opcode) 'emacs20-opcode))))
 	       (funcall handler form)
 	     (if (memq 'callargs byte-compile-warnings)
 		 (byte-compile-callargs-warn form))
 	     (byte-compile-normal-call form))))
 	((and (or (compiled-function-p (car form))
 		      ''byte-opcode (list 'quote opcode))
 		(list 'put (list 'quote opcode)
 		      ''byte-opcode-invert (list 'quote function)))
 	fnform))))
-(defmacro byte-defop-compiler20 (function &optional compile-handler)
-;; Just like byte-defop-compiler, but defines an opcode that will only
-;; be used when byte-compile-emacs19-compatibility is false.
-(if (and (byte-compile-single-version)
-	   byte-compile-emacs19-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))))))
-	''emacs20-opcode t)
-(list 'byte-defop-compiler function compile-handler))))
-;; XEmacs addition:
-(defmacro byte-defop-compiler-rmsfun (function &optional compile-handler)
-;; for functions like `eq' that compile into different opcodes depending
-;; on the Emacs version: byte-old-eq for v19, byte-eq for v20.
-(let ((opcode (intern (concat "byte-" (symbol-name function))))
-	(opcode19 (intern (concat "byte-old-" (symbol-name function))))
-	(fnform
-	 (list 'put (list 'quote function) ''byte-compile
-	       (list 'quote
-		     (or (cdr (assq compile-handler
-				    '((2 . byte-compile-two-args-19->20)
-				      )))
-			 compile-handler
-			 (intern (concat "byte-compile-"
-					 (symbol-name function))))))))
-(list 'progn fnform
-	  (list 'put (list 'quote function)
-		''byte-opcode (list 'quote opcode))
-	  (list 'put (list 'quote function)
-		''byte-opcode19 (list 'quote opcode19))
-	  (list 'put (list 'quote opcode)
-		''byte-opcode-invert (list 'quote function))
-	  (list 'put (list 'quote opcode19)
-		''byte-opcode19-invert (list 'quote function)))))
 (defmacro byte-defop-compiler-1 (function &optional compile-handler)
 (list 'byte-defop-compiler (list function nil) compile-handler))
 (put 'byte-call 'byte-opcode-invert 'funcall)
 ;; How old is this stuff? -slb
 ;(byte-defop-compiler (dot byte-point)		0+1)
 ;(byte-defop-compiler (dot-max byte-point-max)	0+1)
 ;(byte-defop-compiler (dot-min byte-point-min)	0+1)
 (byte-defop-compiler point		0+1)
-(byte-defop-compiler-rmsfun eq		2)
+(byte-defop-compiler eq		2)
 (byte-defop-compiler point-max		0+1)
 (byte-defop-compiler point-min		0+1)
 (byte-defop-compiler following-char	0+1)
 (byte-defop-compiler preceding-char	0+1)
 (byte-defop-compiler current-column	0+1)
 ;; FSF has special function here; generalized here by the 1+2 stuff.
 (byte-defop-compiler (indent-to-column byte-indent-to) 1+2)
 (byte-defop-compiler indent-to		1+2)
-(byte-defop-compiler-rmsfun equal	2)
+(byte-defop-compiler equal	2)
 (byte-defop-compiler eolp		0+1)
 (byte-defop-compiler eobp		0+1)
 (byte-defop-compiler bolp		0+1)
 (byte-defop-compiler bobp		0+1)
 (byte-defop-compiler current-buffer	0)
 ;;(byte-defop-compiler read-char	0) ;; obsolete
-(byte-defop-compiler-rmsfun memq	2)
+(byte-defop-compiler memq	2)
 (byte-defop-compiler interactive-p	0)
 (byte-defop-compiler widen		0+1)
 (byte-defop-compiler end-of-line	0-1+1)
 (byte-defop-compiler forward-char	0-1+1)
 (byte-defop-compiler forward-line	0-1+1)
 (byte-defop-compiler numberp		1)
 (byte-defop-compiler fixnump		1)
 (byte-defop-compiler skip-chars-forward     1-2+1)
 (byte-defop-compiler skip-chars-backward    1-2+1)
 (byte-defop-compiler eq			2)
-; (byte-defop-compiler20 old-eq 	 	2)
+; (byte-defop-compiler old-eq 	 	2)
-; (byte-defop-compiler20 old-memq		2)
+; (byte-defop-compiler old-memq		2)
 (byte-defop-compiler cons		2)
 (byte-defop-compiler aref		2)
 (byte-defop-compiler get		2+1)
 (byte-defop-compiler nth		2)
 (byte-defop-compiler subseq byte-compile-subseq)
 (byte-defop-compiler downcase		1+1)
 (byte-defop-compiler string=		2)
 (byte-defop-compiler string<		2)
 (byte-defop-compiler (string-equal byte-string=) 2)
 (byte-defop-compiler (string-lessp byte-string<) 2)
-; (byte-defop-compiler20 old-equal	2)
+; (byte-defop-compiler old-equal	2)
 (byte-defop-compiler nthcdr		2)
 (byte-defop-compiler elt		2)
-(byte-defop-compiler20 old-member	2)
+(byte-defop-compiler old-member	2)
-(byte-defop-compiler20 old-assq		2)
+(byte-defop-compiler old-assq		2)
 (byte-defop-compiler (rplaca byte-setcar) 2)
 (byte-defop-compiler (rplacd byte-setcdr) 2)
 (byte-defop-compiler setcar		2)
 (byte-defop-compiler setcdr		2)
 (byte-defop-compiler delete-region	2+1)
 (byte-defop-compiler-1 bind-multiple-value-limits)
 (byte-defop-compiler multiple-value-list-internal)
 (byte-defop-compiler-1 multiple-value-call)
 (byte-defop-compiler throw)
-(byte-defop-compiler-rmsfun member	2)
+(byte-defop-compiler member	2)
-(byte-defop-compiler-rmsfun assq	2)
+(byte-defop-compiler assq	2)
 ;;####(byte-defop-compiler move-to-column	1)
 (byte-defop-compiler-1 interactive byte-compile-noop)
 (byte-defop-compiler-1 domain byte-compile-domain)
 (defun byte-compile-one-arg-with-two-extra (form)
 (case (length (cdr form))
 (1     (byte-compile-one-arg form))
 ((2 3) (byte-compile-normal-call form))
 (t     (byte-compile-subr-wrong-args form "1-3"))))
-;; XEmacs: used for functions that have a different opcode in v19 than v20.
-;; this includes `eq', `equal', and other old-ified functions.
-(defun byte-compile-two-args-19->20 (form)
-(if (not (eql (length form) 3))
-(byte-compile-subr-wrong-args form 2)
-(byte-compile-form (car (cdr form)))  ;; Push the arguments
-(byte-compile-form (nth 2 form))
-(if (byte-compile-version-cond byte-compile-emacs19-compatibility)
-	(byte-compile-out (get (car form) 'byte-opcode19) 0)
-(byte-compile-out (get (car form) 'byte-opcode) 0))))
 (defun byte-compile-noop (form)
 (byte-compile-constant nil))
 (defun byte-compile-discard ()
 (byte-compile-out 'byte-save-restriction 0)
 (byte-compile-body-do-effect (cdr form))
 (byte-compile-out 'byte-unbind 1))
 (defun byte-compile-save-current-buffer (form)
-(if (byte-compile-version-cond byte-compile-emacs19-compatibility)
+(byte-compile-out 'byte-save-current-buffer 0)
-;; `save-current-buffer' special operator is not available in XEmacs 19.
+(byte-compile-body-do-effect (cdr form))
-(byte-compile-form
+(byte-compile-out 'byte-unbind 1))
-`(let ((_byte_compiler_save_buffer_emulation_closure_ (current-buffer)))
-	  (unwind-protect
-	      (progn ,@(cdr form))
-	    (and (buffer-live-p _byte_compiler_save_buffer_emulation_closure_)
-		 (set-buffer _byte_compiler_save_buffer_emulation_closure_)))))
-(byte-compile-out 'byte-save-current-buffer 0)
-(byte-compile-body-do-effect (cdr form))
-(byte-compile-out 'byte-unbind 1)))
 (defun byte-compile-with-output-to-temp-buffer (form)
 (byte-compile-form (car (cdr form)))
 (byte-compile-out 'byte-temp-output-buffer-setup 0)
 (byte-compile-body (cdr (cdr form)))
 ;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles
 ;; itself, compile some of its most used recursive functions (at load time).
 ;;
 (eval-when-compile
 (or (compiled-function-p (symbol-function 'byte-compile-form))
-(assq 'byte-code (symbol-function 'byte-compile-form))
 (let ((byte-optimize nil) ; do it fast
 	   (byte-compile-warnings nil))
-(mapcar #'(lambda (x)
+(map nil (if noninteractive
-		   (or noninteractive (message "compiling %s..." x))
+		    #'byte-compile
-		   (byte-compile x)
+		  #'(lambda (x)
-		   (or noninteractive (message "compiling %s...done" x)))
+		      (message "compiling %s..." x)
-	       '(byte-compile-normal-call
+		      (byte-compile x)
-		 byte-compile-form
+		      (message "compiling %s...done" x)))
-		 byte-compile-body
+	    '(byte-compile-normal-call
-		 ;; Inserted some more than necessary, to speed it up.
+	      byte-compile-form
-		 byte-compile-top-level
+	      byte-compile-body
-		 byte-compile-out-toplevel
+	      ;; Inserted some more than necessary, to speed it up.
-		 byte-compile-constant
+	      byte-compile-top-level
-		 byte-compile-variable-ref))))
+	      byte-compile-out-toplevel
-nil)
+	      byte-compile-constant
+	      byte-compile-variable-ref)))))
 (run-hooks 'bytecomp-load-hook)
 ;;; bytecomp.el ends here

Mercurial > hg > xemacs-beta

comparison lisp/bytecomp.el @ 5503:7b5946dbfb96