--- a/lisp/byte-optimize.el	Mon Aug 13 11:33:40 2007 +0200
+++ b/lisp/byte-optimize.el	Mon Aug 13 11:35:02 2007 +0200
@@ -473,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)))))
 
@@ -699,33 +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))
+
   (case (length (cdr form))
-    ((0)
+    ((0)				; (+)
      (condition-case ()
 	 (eval form)
        (error form)))
 
-    ;; `add1' and `sub1' are a marginally fewer instructions
-    ;; than `plus' and `minus', so use them when possible.
-    ((2)
-     (cond
-      ((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)))
+    ;; 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))
 
-    ;; 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)))
+    ((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))
@@ -735,54 +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))
-;;;    )
-    )
+
+  (case (length (cdr form))
+    ((0)				; (-)
+     (condition-case ()
+	 (eval form)
+       (error 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))
-  )
+    ;; 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))))))
+	((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))
@@ -801,13 +810,13 @@
     (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)
-			(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)))
@@ -1219,9 +1228,7 @@
   ;; fetch and return the offset for the current opcode.
   ;; return NIL if this opcode has no offset
   ;; OP, PTR and BYTES are used and set dynamically
-  (defvar op)
-  (defvar ptr)
-  (defvar bytes)
+  (declare (special op ptr bytes))
   (cond ((< op byte-nth)
 	 (let ((tem (logand op 7)))
 	   (setq op (logand op 248))
@@ -1455,9 +1462,10 @@
 
 (defun byte-optimize-lapcode (lap &optional for-effect)
   "Simple peephole optimizer.  LAP is both modified and returned."
-  (let (lap0 ;; off0 unused
-	lap1 ;; off1
-	lap2 ;; off2
+  (let (lap0
+	lap1
+	lap2
+	variable-frequency
 	(keep-going 'first-time)
 	(add-depth 0)
 	rest tmp tmp2 tmp3
@@ -1903,28 +1911,29 @@
     ;; Rebuild byte-compile-constants / byte-compile-variables.
     ;; Simple optimizations that would inhibit other optimizations if they
     ;; were done in the optimizing loop, and optimizations which there is no
-    ;;  need to do more than once.
+    ;; need to do more than once.
     (setq byte-compile-constants nil
-	  byte-compile-variables nil)
+	  byte-compile-variables nil
+	  variable-frequency (make-hash-table :test 'eq))
     (setq rest lap)
     (while rest
       (setq lap0 (car rest)
 	    lap1 (nth 1 rest))
-      (if (memq (car lap0) byte-constref-ops)
-	  (if (eq (cdr lap0) 'byte-constant)
-	      (or (memq (cdr lap0) byte-compile-variables)
-		  (setq byte-compile-variables (cons (cdr lap0)
-						     byte-compile-variables)))
-	    (or (memq (cdr lap0) byte-compile-constants)
-		(setq byte-compile-constants (cons (cdr lap0)
-						   byte-compile-constants)))))
+      (case (car lap0)
+	((byte-varref byte-varset byte-varbind)
+	 (incf (gethash (cdr lap0) variable-frequency 0))
+	 (unless (memq (cdr lap0) byte-compile-variables)
+	   (push (cdr lap0) byte-compile-variables)))
+	((byte-constant)
+	 (unless (memq (cdr lap0) byte-compile-constants)
+	   (push (cdr lap0) byte-compile-constants))))
       (cond (;;
-	     ;; const-C varset-X const-C  -->  const-C dup varset-X
+	     ;; const-C varset-X  const-C  -->  const-C dup varset-X
 	     ;; const-C varbind-X const-C  -->  const-C dup varbind-X
 	     ;;
 	     (and (eq (car lap0) 'byte-constant)
 		  (eq (car (nth 2 rest)) 'byte-constant)
-		  (eq (cdr lap0) (car (nth 2 rest)))
+		  (eq (cdr lap0) (cdr (nth 2 rest)))
 		  (memq (car lap1) '(byte-varbind byte-varset)))
 	     (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
 				   lap0 lap1 lap0 lap0 lap1)
@@ -1960,6 +1969,21 @@
 	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
 	    )
       (setq rest (cdr rest)))
+    ;; Since the first 6 entries of the compiled-function constants
+    ;; vector are most efficient for varref/set/bind ops, we sort by
+    ;; reference count.  This generates maximally space efficient and
+    ;; pretty time-efficient byte-code.  See `byte-compile-constants-vector'.
+    (setq byte-compile-variables
+	  (sort byte-compile-variables
+		#'(lambda (v1 v2)
+		    (< (gethash v1 variable-frequency)
+		       (gethash v2 variable-frequency)))))
+    ;; Another hack - put the most used variable in position 6, for
+    ;; better locality of reference with adjoining constants.
+    (let ((tail (last byte-compile-variables 6)))
+      (setq byte-compile-variables
+	    (append (nbutlast byte-compile-variables 6)
+		    (nreverse tail))))
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)