X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fbyte-optimize.el;h=2ab79db239b9493537121f2aca4f33f82148ef1f;hb=2bf45e07013c281a55bc509b24f5e83568f3d0fd;hp=fe99286cc3628360c9b67c3b3e1f64df6e201f2e;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git.1

diff --git a/lisp/byte-optimize.el b/lisp/byte-optimize.el
index fe99286..2ab79db 100644
--- a/lisp/byte-optimize.el
+++ b/lisp/byte-optimize.el
@@ -1,8 +1,8 @@
-;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
+;;; byte-optimize.el --- the optimization passes of the emacs-lisp byte compiler.
 
 ;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.
 
-;; Author: Jamie Zawinski <jwz@netscape.com>
+;; Author: Jamie Zawinski <jwz@jwz.org>
 ;;	Hallvard Furuseth <hbf@ulrik.uio.no>
 ;; Keywords: internal
 
@@ -19,7 +19,7 @@
 ;; General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with XEmacs; see the file COPYING.  If not, write to the 
+;; along with XEmacs; see the file COPYING.  If not, write to the
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
@@ -32,14 +32,14 @@
 ;; You can, however, make a faster pig."
 ;;
 ;; Or, to put it another way, the emacs byte compiler is a VW Bug.  This code
-;; makes it be a VW Bug with fuel injection and a turbocharger...  You're 
+;; makes it be a VW Bug with fuel injection and a turbocharger...  You're
 ;; still not going to make it go faster than 70 mph, but it might be easier
 ;; to get it there.
 ;;
 
 ;; TO DO:
 ;;
-;; (apply '(lambda (x &rest y) ...) 1 (foo))
+;; (apply #'(lambda (x &rest y) ...) 1 (foo))
 ;;
 ;; maintain a list of functions known not to access any global variables
 ;; (actually, give them a 'dynamically-safe property) and then
@@ -64,17 +64,17 @@
 ;; Simple defsubsts often produce forms like
 ;;    (let ((v1 (f1)) (v2 (f2)) ...)
 ;;       (FN v1 v2 ...))
-;; It would be nice if we could optimize this to 
+;; It would be nice if we could optimize this to
 ;;    (FN (f1) (f2) ...)
 ;; but we can't unless FN is dynamically-safe (it might be dynamically
 ;; referring to the bindings that the lambda arglist established.)
 ;; One of the uncountable lossages introduced by dynamic scope...
 ;;
-;; Maybe there should be a control-structure that says "turn on 
+;; Maybe there should be a control-structure that says "turn on
 ;; fast-and-loose type-assumptive optimizations here."  Then when
 ;; we see a form like (car foo) we can from then on assume that
 ;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic 
+;; But, this won't win much because of (you guessed it) dynamic
 ;; scope.  Anything down the stack could change the value.
 ;; (Another reason it doesn't work is that it is perfectly valid
 ;; to call car with a null argument.)  A better approach might
@@ -109,7 +109,7 @@
 ;;
 ;; However, if there was even a single let-binding around the COND,
 ;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return."  Adding a 
+;; byte-op between the final "call" and "return."  Adding a
 ;; Bunbind_all byteop would fix this.
 ;;
 ;;   (defun foo (x y z) ... (foo a b c))
@@ -131,8 +131,8 @@
 ;;
 ;; Wouldn't it be nice if Emacs Lisp had lexical scope.
 ;;
-;; Idea: the form (lexical-scope) in a file means that the file may be 
-;; compiled lexically.  This proclamation is file-local.  Then, within 
+;; Idea: the form (lexical-scope) in a file means that the file may be
+;; compiled lexically.  This proclamation is file-local.  Then, within
 ;; that file, "let" would establish lexical bindings, and "let-dynamic"
 ;; would do things the old way.  (Or we could use CL "declare" forms.)
 ;; We'd have to notice defvars and defconsts, since those variables should
@@ -142,31 +142,31 @@
 ;; in the file being compiled (doing a boundp check isn't good enough.)
 ;; Fdefvar() would have to be modified to add something to the plist.
 ;;
-;; A major disadvantage of this scheme is that the interpreter and compiler 
-;; would have different semantics for files compiled with (dynamic-scope).  
+;; A major disadvantage of this scheme is that the interpreter and compiler
+;; would have different semantics for files compiled with (dynamic-scope).
 ;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked 
+;; modify the interpreter to obey this (unless the loader was hacked
 ;; in some grody way, but that's a really bad idea.)
 ;;
 ;; HA!  RMS removed the following paragraph from his version of
-;; byte-opt.el.
+;; byte-optimize.el.
 ;;
 ;; Really the Right Thing is to make lexical scope the default across
-;; the board, in the interpreter and compiler, and just FIX all of 
+;; the board, in the interpreter and compiler, and just FIX all of
 ;; the code that relies on dynamic scope of non-defvarred variables.
 
 ;; Other things to consider:
 
 ;; Associative math should recognize subcalls to identical function:
-;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
+;;(disassemble #'(lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
 ;; This should generate the same as (1+ x) and (1- x)
 
-;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
+;;(disassemble #'(lambda (x) (cons (+ x 1) (- x 1))))
 ;; An awful lot of functions always return a non-nil value.  If they're
 ;; error free also they may act as true-constants.
 
-;;(disassemble (lambda (x) (and (point) (foo))))
-;; When 
+;;(disassemble #'(lambda (x) (and (point) (foo))))
+;; When
 ;;   - all but one arguments to a function are constant
 ;;   - the non-constant argument is an if-expression (cond-expression?)
 ;; then the outer function can be distributed.  If the guarding
@@ -174,20 +174,20 @@
 ;; arguments may be any expressions.  Since, however, the code size
 ;; can increase this way they should be "simple".  Compare:
 
-;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
-;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
+;;(disassemble #'(lambda (x) (eq (if (point) 'a 'b) 'c)))
+;;(disassemble #'(lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
 
 ;; (car (cons A B)) -> (progn B A)
-;;(disassemble (lambda (x) (car (cons (foo) 42))))
+;;(disassemble #'(lambda (x) (car (cons (foo) 42))))
 
 ;; (cdr (cons A B)) -> (progn A B)
-;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
+;;(disassemble #'(lambda (x) (cdr (cons 42 (foo)))))
 
 ;; (car (list A B ...)) -> (progn B ... A)
-;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
+;;(disassemble #'(lambda (x) (car (list (foo) 42 (bar)))))
 
 ;; (cdr (list A B ...)) -> (progn A (list B ...))
-;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
+;;(disassemble #'(lambda (x) (cdr (list 42 (foo) (bar)))))
 
 
 ;;; Code:
@@ -199,31 +199,32 @@
       (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
   (byte-compile-log-1
    (apply 'format format
-     (let (c a)
-       (mapcar '(lambda (arg)
-		  (if (not (consp arg))
-		      (if (and (symbolp arg)
-			       (string-match "^byte-" (symbol-name arg)))
-			  (intern (substring (symbol-name arg) 5))
-			arg)
-		    (if (integerp (setq c (car arg)))
-			(error "non-symbolic byte-op %s" c))
-		    (if (eq c 'TAG)
-			(setq c arg)
-		      (setq a (cond ((memq c byte-goto-ops)
-				     (car (cdr (cdr arg))))
-				    ((memq c byte-constref-ops)
-				     (car (cdr arg)))
-				    (t (cdr arg))))
-		      (setq c (symbol-name c))
-		      (if (string-match "^byte-." c)
-			  (setq c (intern (substring c 5)))))
-		    (if (eq c 'constant) (setq c 'const))
-		    (if (and (eq (cdr arg) 0)
-			     (not (memq c '(unbind call const))))
-			c
-		      (format "(%s %s)" c a))))
-	       args)))))
+	  (let (c a)
+	    (mapcar
+	     #'(lambda (arg)
+		 (if (not (consp arg))
+		     (if (and (symbolp arg)
+			      (string-match "^byte-" (symbol-name arg)))
+			 (intern (substring (symbol-name arg) 5))
+		       arg)
+		   (if (integerp (setq c (car arg)))
+		       (error "non-symbolic byte-op %s" c))
+		   (if (eq c 'TAG)
+		       (setq c arg)
+		     (setq a (cond ((memq c byte-goto-ops)
+				    (car (cdr (cdr arg))))
+				   ((memq c byte-constref-ops)
+				    (car (cdr arg)))
+				   (t (cdr arg))))
+		     (setq c (symbol-name c))
+		     (if (string-match "^byte-." c)
+			 (setq c (intern (substring c 5)))))
+		   (if (eq c 'constant) (setq c 'const))
+		   (if (and (eq (cdr arg) 0)
+			    (not (memq c '(unbind call const))))
+		       c
+		     (format "(%s %s)" c a))))
+	     args)))))
 
 (defmacro byte-compile-log-lap (format-string &rest args)
   (list 'and
@@ -238,20 +239,21 @@
 
 (defun byte-optimize-inline-handler (form)
   "byte-optimize-handler for the `inline' special-form."
-  (cons 'progn
-	(mapcar
-	 '(lambda (sexp)
-	    (let ((fn (car-safe sexp)))
-	      (if (and (symbolp fn)
-		    (or (cdr (assq fn byte-compile-function-environment))
-		      (and (fboundp fn)
-			(not (or (cdr (assq fn byte-compile-macro-environment))
-				 (and (consp (setq fn (symbol-function fn)))
-				      (eq (car fn) 'macro))
-				 (subrp fn))))))
-		  (byte-compile-inline-expand sexp)
-		sexp)))
-	 (cdr form))))
+  (cons
+   'progn
+   (mapcar
+    #'(lambda (sexp)
+	(let ((fn (car-safe sexp)))
+	  (if (and (symbolp fn)
+		   (or (cdr (assq fn byte-compile-function-environment))
+		       (and (fboundp fn)
+			    (not (or (cdr (assq fn byte-compile-macro-environment))
+				     (and (consp (setq fn (symbol-function fn)))
+					  (eq (car fn) 'macro))
+				     (subrp fn))))))
+	      (byte-compile-inline-expand sexp)
+	    sexp)))
+    (cdr form))))
 
 
 ;; Splice the given lap code into the current instruction stream.
@@ -293,7 +295,7 @@
 	  (cons fn (cdr form)))))))
 
 ;;; ((lambda ...) ...)
-;;; 
+;;;
 (defun byte-compile-unfold-lambda (form &optional name)
   (or name (setq name "anonymous lambda"))
   (let ((lambda (car form))
@@ -348,7 +350,7 @@
 		(byte-compile-warn
 		 "attempt to open-code %s with too many arguments" name))
 	    form)
-	(let ((newform 
+	(let ((newform
 	       (if bindings
 		   (cons 'let (cons (nreverse bindings) body))
 		 (cons 'progn body))))
@@ -392,27 +394,29 @@
 	   ;; are more deeply nested are optimized first.
 	   (cons fn
 	     (cons
-	      (mapcar '(lambda (binding)
-			 (if (symbolp binding)
-			     binding
-			   (if (cdr (cdr binding))
-			       (byte-compile-warn "malformed let binding: %s"
-						  (prin1-to-string binding)))
-			   (list (car binding)
-				 (byte-optimize-form (nth 1 binding) nil))))
-		      (nth 1 form))
+	      (mapcar
+	       #'(lambda (binding)
+		   (if (symbolp binding)
+		       binding
+		     (if (cdr (cdr binding))
+			 (byte-compile-warn "malformed let binding: %s"
+					    (prin1-to-string binding)))
+		     (list (car binding)
+			   (byte-optimize-form (nth 1 binding) nil))))
+	       (nth 1 form))
 	      (byte-optimize-body (cdr (cdr form)) for-effect))))
 	  ((eq fn 'cond)
 	   (cons fn
-		 (mapcar '(lambda (clause)
-			    (if (consp clause)
-				(cons
-				 (byte-optimize-form (car clause) nil)
-				 (byte-optimize-body (cdr clause) for-effect))
-			      (byte-compile-warn "malformed cond form: %s"
-						 (prin1-to-string clause))
-			      clause))
-			 (cdr form))))
+		 (mapcar
+		  #'(lambda (clause)
+		      (if (consp clause)
+			  (cons
+			   (byte-optimize-form (car clause) nil)
+			   (byte-optimize-body (cdr clause) for-effect))
+			(byte-compile-warn "malformed cond form: %s"
+					   (prin1-to-string clause))
+			clause))
+		  (cdr form))))
 	  ((eq fn 'progn)
 	   ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
 	   (if (cdr (cdr form))
@@ -431,28 +435,28 @@
 	     (cons (byte-optimize-form (nth 1 form) t)
 	       (cons (byte-optimize-form (nth 2 form) for-effect)
 		     (byte-optimize-body (cdr (cdr (cdr form))) t)))))
-	  
+
 	  ((memq fn '(save-excursion save-restriction save-current-buffer))
 	   ;; those subrs which have an implicit progn; it's not quite good
 	   ;; enough to treat these like normal function calls.
 	   ;; This can turn (save-excursion ...) into (save-excursion) which
 	   ;; will be optimized away in the lap-optimize pass.
 	   (cons fn (byte-optimize-body (cdr form) for-effect)))
-	  
+
 	  ((eq fn 'with-output-to-temp-buffer)
 	   ;; this is just like the above, except for the first argument.
 	   (cons fn
 	     (cons
 	      (byte-optimize-form (nth 1 form) nil)
 	      (byte-optimize-body (cdr (cdr form)) for-effect))))
-	  
+
 	  ((eq fn 'if)
 	   (cons fn
 	     (cons (byte-optimize-form (nth 1 form) nil)
 	       (cons
 		(byte-optimize-form (nth 2 form) for-effect)
 		(byte-optimize-body (nthcdr 3 form) for-effect)))))
-	  
+
 	  ((memq fn '(and or))  ; remember, and/or are control structures.
 	   ;; take forms off the back until we can't any more.
 	   ;; In the future it could conceivably be a problem that the
@@ -469,6 +473,10 @@
 		     (byte-compile-log
 		      "  all subforms of %s called for effect; deleted" form))
 		 (and backwards
+                      ;; Now optimize the rest of the forms. We need the return
+                      ;; values. We already did the car.
+                      (setcdr backwards
+                              (mapcar 'byte-optimize-form (cdr backwards)))
 		      (cons fn (nreverse backwards))))
 	     (cons fn (mapcar 'byte-optimize-form (cdr form)))))
 
@@ -476,7 +484,7 @@
 	   (byte-compile-warn "misplaced interactive spec: %s"
 			      (prin1-to-string form))
 	   nil)
-	  
+
 	  ((memq fn '(defun defmacro function
 		      condition-case save-window-excursion))
 	   ;; These forms are compiled as constants or by breaking out
@@ -492,7 +500,7 @@
 	   (cons fn
 		 (cons (byte-optimize-form (nth 1 form) for-effect)
 		       (cdr (cdr form)))))
-	   
+
 	  ((eq fn 'catch)
 	   ;; the body of a catch is compiled (and thus optimized) as a
 	   ;; top-level form, so don't do it here.  The tag is never
@@ -510,7 +518,7 @@
 		    (setq form (macroexpand form
 					    byte-compile-macro-environment))))
 	   (byte-optimize-form form for-effect))
-	  
+
 	  ((not (symbolp fn))
 	   (or (eq 'mocklisp (car-safe fn)) ; ha!
 	       (byte-compile-warn "%s is a malformed function"
@@ -528,7 +536,7 @@
 	   ;; appending a nil here might not be necessary, but it can't hurt.
 	   (byte-optimize-form
 	    (cons 'progn (append (cdr form) '(nil))) t))
-	  
+
 	  (t
 	   ;; Otherwise, no args can be considered to be for-effect,
 	   ;; even if the called function is for-effect, because we
@@ -542,7 +550,7 @@
   ;; First, optimize all sub-forms of this one.
   (setq form (byte-optimize-form-code-walker form for-effect))
   ;;
-  ;; after optimizing all subforms, optimize this form until it doesn't
+  ;; After optimizing all subforms, optimize this form until it doesn't
   ;; optimize any further.  This means that some forms will be passed through
   ;; the optimizer many times, but that's necessary to make the for-effect
   ;; processing do as much as possible.
@@ -564,10 +572,10 @@
 
 
 (defun byte-optimize-body (forms all-for-effect)
-  ;; optimize the cdr of a progn or implicit progn; all forms is a list of
+  ;; Optimize the cdr of a progn or implicit progn; `forms' is a list of
   ;; forms, all but the last of which are optimized with the assumption that
-  ;; they are being called for effect.  the last is for-effect as well if
-  ;; all-for-effect is true.  returns a new list of forms.
+  ;; they are being called for effect.  The last is for-effect as well if
+  ;; all-for-effect is true.  Returns a new list of forms.
   (let ((rest forms)
 	(result nil)
 	fe new)
@@ -592,12 +600,13 @@
 ;; I'd like this to be a defsubst, but let's not be self-referential...
 (defmacro byte-compile-trueconstp (form)
   ;; Returns non-nil if FORM is a non-nil constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((eq (, form) t)))))
+  `(cond ((consp ,form) (eq (car ,form) 'quote))
+	 ((not (symbolp ,form)))
+	 ((eq ,form t))
+	 ((keywordp ,form))))
 
 ;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer 
+;; evaluate as much as possible at compile-time.  This optimizer
 ;; assumes that the function is associative, like + or *.
 (defun byte-optimize-associative-math (form)
   (let ((args nil)
@@ -694,37 +703,37 @@
   (setq form (byte-optimize-delay-constants-math form 1 '+))
   (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
   ;;(setq form (byte-optimize-associative-two-args-math form))
-  (cond ((null (cdr form))
-	 (condition-case ()
-	     (eval form)
-	   (error form)))
-
-	;; `add1' and `sub1' are a marginally fewer instructions
-	;; than `plus' and `minus', so use them when possible.
-	((and (null (nthcdr 3 form))
-	      (eq (nth 2 form) 1))
-	 (list '1+ (nth 1 form)))	; (+ x 1)  -->  (1+ x)
-	((and (null (nthcdr 3 form))
-	      (eq (nth 1 form) 1))
-	 (list '1+ (nth 2 form)))	; (+ 1 x)  -->  (1+ x)
-	((and (null (nthcdr 3 form))
-	      (eq (nth 2 form) -1))
-	 (list '1- (nth 1 form)))	; (+ x -1)  -->  (1- x)
-	((and (null (nthcdr 3 form))
-	      (eq (nth 1 form) -1))
-	 (list '1- (nth 2 form)))	; (+ -1 x)  -->  (1- x)
 
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;	((null (cdr (cdr form))) (nth 1 form))
-	(t form)))
+  (case (length (cdr form))
+    ((0)				; (+)
+     (condition-case ()
+	 (eval form)
+       (error form)))
+
+    ;; It is not safe to delete the function entirely
+    ;; (actually, it would be safe if we knew the sole arg
+    ;; is not a marker).
+    ;; ((1)
+    ;;  (nth 1 form))
+
+    ((2)				; (+ x y)
+     (byte-optimize-predicate
+      (cond
+       ;; `add1' and `sub1' are a marginally fewer instructions
+       ;; than `plus' and `minus', so use them when possible.
+       ((eq (nth 1 form)  1) `(1+ ,(nth 2 form))) ; (+ 1 x)   -->  (1+ x)
+       ((eq (nth 2 form)  1) `(1+ ,(nth 1 form))) ; (+ x 1)   -->  (1+ x)
+       ((eq (nth 1 form) -1) `(1- ,(nth 2 form))) ; (+ -1 x)  -->  (1- x)
+       ((eq (nth 2 form) -1) `(1- ,(nth 1 form))) ; (+ x -1)  -->  (1- x)
+       (t form))))
+
+    (t (byte-optimize-predicate form))))
 
 (defun byte-optimize-minus (form)
   ;; Put constants at the end, except the last constant.
   (setq form (byte-optimize-delay-constants-math form 2 '+))
-  ;; Now only first and last element can be a number.
-  (let ((last (car (reverse (nthcdr 3 form)))))
+  ;; Now only first and last element can be an integer.
+  (let ((last (last (nthcdr 3 form))))
     (cond ((eq 0 last)
 	   ;; (- x y ... 0)  --> (- x y ...)
 	   (setq form (copy-sequence form))
@@ -734,57 +743,55 @@
 		(numberp last))
 	   (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
 			     (delq last (copy-sequence (nthcdr 3 form))))))))
-  (setq form
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;;  (if (eq (nth 2 form) 0)
-;;;      (nth 1 form)			; (- x 0)  -->  x
-    (byte-optimize-predicate
-     (if (and (null (cdr (cdr (cdr form))))
-	      (eq (nth 1 form) 0))	; (- 0 x)  -->  (- x)
-	 (cons (car form) (cdr (cdr form)))
-       form))
-;;;    )
-    )
-
-  ;; `add1' and `sub1' are a marginally fewer instructions than `plus'
-  ;; and `minus', so use them when possible.
-  (cond ((and (null (nthcdr 3 form))
-	      (eq (nth 2 form) 1))
-	 (list '1- (nth 1 form)))	; (- x 1)  -->  (1- x)
-	((and (null (nthcdr 3 form))
-	      (eq (nth 2 form) -1))
-	 (list '1+ (nth 1 form)))	; (- x -1)  -->  (1+ x)
-	(t
-	 form))
-  )
+
+  (case (length (cdr form))
+    ((0)				; (-)
+     (condition-case ()
+	 (eval form)
+       (error form)))
+
+    ;; It is not safe to delete the function entirely
+    ;; (actually, it would be safe if we knew the sole arg
+    ;; is not a marker).
+    ;; ((1)
+    ;;  (nth 1 form)
+
+    ((2)				; (+ x y)
+     (byte-optimize-predicate
+      (cond
+       ;; `add1' and `sub1' are a marginally fewer instructions than `plus'
+       ;; and `minus', so use them when possible.
+       ((eq (nth 2 form)  1) `(1- ,(nth 1 form))) ; (- x 1)  --> (1- x)
+       ((eq (nth 2 form) -1) `(1+ ,(nth 1 form))) ; (- x -1) --> (1+ x)
+       ((eq (nth 1 form)  0) `(-  ,(nth 2 form))) ; (- 0 x)  --> (- x)
+       (t form))))
+
+    (t (byte-optimize-predicate form))))
 
 (defun byte-optimize-multiply (form)
   (setq form (byte-optimize-delay-constants-math form 1 '*))
-  ;; If there is a constant in FORM, it is now the last element.
+  ;; If there is a constant integer in FORM, it is now the last element.
   (cond ((null (cdr form)) 1)
 ;;; It is not safe to delete the function entirely
 ;;; (actually, it would be safe if we know the sole arg
 ;;; is not a marker or if it appears in other arithmetic).
 ;;;	((null (cdr (cdr form))) (nth 1 form))
-	((let ((last (car (reverse form))))
-	   (cond ((eq 0 last)  (cons 'progn (cdr form)))
-		 ((eq 1 last)  (delq 1 (copy-sequence form)))
-		 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
-		 ((and (eq 2 last)
-		       (memq t (mapcar 'symbolp (cdr form))))
-		  (prog1 (setq form (delq 2 (copy-sequence form)))
-		    (while (not (symbolp (car (setq form (cdr form))))))
-		    (setcar form (list '+ (car form) (car form)))))
-		 (form))))))
-
-(defsubst byte-compile-butlast (form)
-  (nreverse (cdr (reverse form))))
+	((let ((last (last form)))
+	   (byte-optimize-predicate
+	    (cond ((eq 0 last)  (cons 'progn (cdr form)))
+		  ((eq 1 last)  (delq 1 (copy-sequence form)))
+		  ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
+		  ((and (eq 2 last)
+			(memq t (mapcar 'symbolp (cdr form))))
+		   (prog1 (setq form (delq 2 (copy-sequence form)))
+		     (while (not (symbolp (car (setq form (cdr form))))))
+		     (setcar form (list '+ (car form) (car form)))))
+		  (form)))))))
 
 (defun byte-optimize-divide (form)
   (setq form (byte-optimize-delay-constants-math form 2 '*))
-  (let ((last (car (reverse (cdr (cdr form))))))
+  ;; If there is a constant integer in FORM, it is now the last element.
+  (let ((last (last (cdr (cdr form)))))
     (if (numberp last)
 	(cond ((= (length form) 3)
 	       (if (and (numberp (nth 1 form))
@@ -794,22 +801,22 @@
 			  (error nil)))
 		   (setq form (list 'progn (/ (nth 1 form) last)))))
 	      ((= last 1)
-	       (setq form (byte-compile-butlast form)))
+	       (setq form (butlast form)))
 	      ((numberp (nth 1 form))
 	       (setq form (cons (car form)
 				(cons (/ (nth 1 form) last)
-				      (byte-compile-butlast (cdr (cdr form)))))
+				      (butlast (cdr (cdr form)))))
 		     last nil))))
-    (cond 
+    (cond
 ;;;	  ((null (cdr (cdr form)))
 ;;;	   (nth 1 form))
-	  ((eq (nth 1 form) 0)
-	   (append '(progn) (cdr (cdr form)) '(0)))
-	  ((eq last -1)
-	   (list '- (if (nthcdr 3 form)
-			(byte-compile-butlast form)
-		      (nth 1 form))))
-	  (form))))
+     ((eq (nth 1 form) 0)
+      (append '(progn) (cdr (cdr form)) '(0)))
+     ((eq last -1)
+      (list '- (if (nthcdr 3 form)
+		   (butlast form)
+		 (nth 1 form))))
+     (form))))
 
 (defun byte-optimize-logmumble (form)
   (setq form (byte-optimize-delay-constants-math form 1 (car form)))
@@ -885,6 +892,7 @@
 (put 'stringp 'byte-optimizer 'byte-optimize-predicate)
 (put 'string< 'byte-optimizer 'byte-optimize-predicate)
 (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
+(put 'length 'byte-optimizer 'byte-optimize-predicate)
 
 (put 'logand 'byte-optimizer 'byte-optimize-logmumble)
 (put 'logior 'byte-optimizer 'byte-optimize-logmumble)
@@ -897,9 +905,9 @@
 (put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
 
 
-;; I'm not convinced that this is necessary.  Doesn't the optimizer loop 
+;; I'm not convinced that this is necessary.  Doesn't the optimizer loop
 ;; take care of this? - Jamie
-;; I think this may some times be necessary to reduce ie (quote 5) to 5,
+;; I think this may some times be necessary to reduce eg. (quote 5) to 5,
 ;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
 (put 'quote 'byte-optimizer 'byte-optimize-quote)
 (defun byte-optimize-quote (form)
@@ -1028,6 +1036,12 @@
 (put 'if    'byte-optimizer 'byte-optimize-if)
 (put 'while 'byte-optimizer 'byte-optimize-while)
 
+;; Remove any reason for avoiding `char-before'.
+(defun byte-optimize-char-before (form)
+  `(char-after (1- ,(or (nth 1 form) '(point))) ,@(cdr (cdr form))))
+
+(put 'char-before 'byte-optimizer 'byte-optimize-char-before)
+
 ;; byte-compile-negation-optimizer lives in bytecomp.el
 ;(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
 (put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
@@ -1052,7 +1066,7 @@
 	    (if (listp (nth 1 last))
 		(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
 		  (nconc (list 'funcall fn) butlast
-			 (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
+			 (mapcar #'(lambda (x) (list 'quote x)) (nth 1 last))))
 	      (byte-compile-warn
 	       "last arg to apply can't be a literal atom: %s"
 	       (prin1-to-string last))
@@ -1098,7 +1112,7 @@
 	(setq form (list 'cdr form)))
       form)))
 
-;;; enumerating those functions which need not be called if the returned 
+;;; enumerating those functions which need not be called if the returned
 ;;; value is not used.  That is, something like
 ;;;    (progn (list (something-with-side-effects) (yow))
 ;;;           (foo))
@@ -1122,11 +1136,21 @@
 	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
 	 float floor format
 	 get get-buffer get-buffer-window getenv get-file-buffer
+	 ;; hash-table functions
+	 make-hash-table copy-hash-table
+	 gethash
+	 hash-table-count
+	 hash-table-rehash-size
+	 hash-table-rehash-threshold
+	 hash-table-size
+	 hash-table-test
+	 hash-table-type
+	 ;;
 	 int-to-string
 	 length log log10 logand logb logior lognot logxor lsh
 	 marker-buffer max member memq min mod
 	 next-window nth nthcdr number-to-string
-	 parse-colon-path previous-window
+	 parse-colon-path plist-get previous-window
 	 radians-to-degrees rassq regexp-quote reverse round
 	 sin sqrt string< string= string-equal string-lessp string-to-char
 	 string-to-int string-to-number substring symbol-plist
@@ -1134,7 +1158,14 @@
 	 ;; XEmacs change: window-edges -> window-pixel-edges
 	 window-buffer window-dedicated-p window-pixel-edges window-height
 	 window-hscroll window-minibuffer-p window-width
-	 zerop))
+	 zerop
+	 ;; functions defined by cl
+	 oddp evenp plusp minusp
+	 abs expt signum last butlast ldiff
+	 pairlis gcd lcm
+	 isqrt floor* ceiling* truncate* round* mod* rem* subseq
+	 list-length getf
+	 ))
       (side-effect-and-error-free-fns
        '(arrayp atom
 	 bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
@@ -1147,6 +1178,7 @@
 	 dot dot-marker eobp eolp eq eql equal eventp extentp
 	 extent-live-p floatp framep frame-live-p
 	 get-largest-window get-lru-window
+	 hash-table-p
 	 identity ignore integerp integer-or-marker-p interactive-p
 	 invocation-directory invocation-name
 	 ;; keymapp may autoload in XEmacs, so not on this list!
@@ -1161,14 +1193,15 @@
 	 user-full-name user-login-name user-original-login-name
 	 user-real-login-name user-real-uid user-uid
 	 vector vectorp
-	 window-configuration-p window-live-p windowp)))
-  (while side-effect-free-fns
-    (put (car side-effect-free-fns) 'side-effect-free t)
-    (setq side-effect-free-fns (cdr side-effect-free-fns)))
-  (while side-effect-and-error-free-fns
-    (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
-    (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
-  nil)
+	 window-configuration-p window-live-p windowp
+	 ;; Functions defined by cl
+	 eql floatp-safe list* subst acons equalp random-state-p
+	 copy-tree sublis
+	 )))
+  (dolist (fn side-effect-free-fns)
+    (put fn 'side-effect-free t))
+  (dolist (fn side-effect-and-error-free-fns)
+    (put fn 'side-effect-free 'error-free)))
 
 
 (defun byte-compile-splice-in-already-compiled-code (form)
@@ -1326,10 +1359,7 @@
     (if endtag
 	(setq lap (cons (cons nil endtag) lap)))
     ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
-    (mapcar (function (lambda (elt)
-			(if (numberp elt)
-			    elt
-			  (cdr elt))))
+    (mapcar #'(lambda (elt) (if (numberp elt) elt (cdr elt)))
 	    (nreverse lap))))
 
 
@@ -1360,7 +1390,7 @@
     byte-current-buffer byte-interactive-p))
 
 (defconst byte-compile-side-effect-free-ops
-  (nconc 
+  (nconc
    '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
      byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
      byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
@@ -1392,7 +1422,7 @@
 ;;;	varbind pop-up-windows
 ;;;	not
 ;;;
-;;; we break the program, because it will appear that pop-up-windows and 
+;;; we break the program, because it will appear that pop-up-windows and
 ;;; old-pop-ups are not EQ when really they are.  So we have to know what
 ;;; the BOOL variables are, and not perform this optimization on them.
 ;;;
@@ -1572,7 +1602,7 @@
 	      ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
 	      ;;
 	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;; 
+	      ;;
 	      ((and (or (eq 'byte-goto-if-nil (car lap0))
 			(eq 'byte-goto-if-not-nil (car lap0)))	; gotoX
 		    (eq 'byte-goto (car lap1))			; gotoY
@@ -1675,7 +1705,7 @@
 				   str (concat str " %s")
 				   i (1+ i))))
 		 (if opt-p
-		     (let ((tagstr 
+		     (let ((tagstr
 			    (if (eq 'TAG (car (car tmp)))
 				(format "%d:" (car (cdr (car tmp))))
 			      (or (car tmp) ""))))
@@ -1857,7 +1887,7 @@
 				     (byte-goto-if-not-nil-else-pop .
 				      byte-goto-if-nil-else-pop))))
 			newtag)
-		  
+
 		  (nth 1 newtag)
 		  )
 		 (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
@@ -1953,17 +1983,18 @@
      (assq 'byte-code (symbol-function 'byte-optimize-form))
      (let ((byte-optimize nil)
 	   (byte-compile-warnings nil))
-       (mapcar '(lambda (x)
-		  (or noninteractive (message "compiling %s..." x))
-		  (byte-compile x)
-		  (or noninteractive (message "compiling %s...done" x)))
-	       '(byte-optimize-form
-		 byte-optimize-body
-		 byte-optimize-predicate
-		 byte-optimize-binary-predicate
-		 ;; Inserted some more than necessary, to speed it up.
-		 byte-optimize-form-code-walker
-		 byte-optimize-lapcode))))
+       (mapcar
+	#'(lambda (x)
+	    (or noninteractive (message "compiling %s..." x))
+	    (byte-compile x)
+	    (or noninteractive (message "compiling %s...done" x)))
+	'(byte-optimize-form
+	  byte-optimize-body
+	  byte-optimize-predicate
+	  byte-optimize-binary-predicate
+	  ;; Inserted some more than necessary, to speed it up.
+	  byte-optimize-form-code-walker
+	  byte-optimize-lapcode))))
  nil)
 
 ;;; byte-optimize.el ends here