xemacs-beta: lisp/byte-optimize.el comparison

comparison lisp/byte-optimize.el @ 442:abe6d1db359e r21-2-36

Import from CVS: tag r21-2-36

author	cvs
date	Mon, 13 Aug 2007 11:35:02 +0200
parents	8de8e3f6228a
children	576fb035e263

comparison

equal deleted inserted replaced

-:72a7cfa4a488
+:abe6d1db359e
 		   (setq backwards (cdr backwards)))
 		 (if (and (cdr form) (null backwards))
 		     (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)))))
 	  ((eq fn 'interactive)
 	   (byte-compile-warn "misplaced interactive spec: %s"
 (defun byte-optimize-plus (form)
 (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 know the sole arg
+;; (actually, it would be safe if we knew the sole arg
 ;; is not a marker).
-;;	((null (cdr (cdr form))) (nth 1 form))
+;; ((1)
-(t form)))
+;;  (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.
+;; Now only first and last element can be an integer.
-(let ((last (car (reverse (nthcdr 3 form)))))
+(let ((last (last (nthcdr 3 form))))
 (cond ((eq 0 last)
 	   ;; (- x y ... 0)  --> (- x y ...)
 	   (setq form (copy-sequence form))
 	   (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
 	  ;; If form is (- CONST foo... CONST), merge first and last.
 	  ((and (numberp (nth 1 form))
 		(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
+(case (length (cdr form))
-;;; (actually, it would be safe if we know the sole arg
+((0)				; (-)
-;;; is not a marker).
+(condition-case ()
-;;;  (if (eq (nth 2 form) 0)
+	 (eval form)
-;;;      (nth 1 form)			; (- x 0)  -->  x
+(error form)))
-(byte-optimize-predicate
-(if (and (null (cdr (cdr (cdr form))))
+;; It is not safe to delete the function entirely
-	      (eq (nth 1 form) 0))	; (- 0 x)  -->  (- x)
+;; (actually, it would be safe if we knew the sole arg
-	 (cons (car form) (cdr (cdr form)))
+;; is not a marker).
-form))
+;; ((1)
-;;;    )
+;;  (nth 1 form)
-)
+((2)				; (+ x y)
-;; `add1' and `sub1' are a marginally fewer instructions than `plus'
+(byte-optimize-predicate
-;; and `minus', so use them when possible.
+(cond
-(cond ((and (null (nthcdr 3 form))
+;; `add1' and `sub1' are a marginally fewer instructions than `plus'
-	      (eq (nth 2 form) 1))
+;; and `minus', so use them when possible.
-	 (list '1- (nth 1 form)))	; (- x 1)  -->  (1- x)
+((eq (nth 2 form)  1) `(1- ,(nth 1 form))) ; (- x 1)  --> (1- x)
-	((and (null (nthcdr 3 form))
+((eq (nth 2 form) -1) `(1+ ,(nth 1 form))) ; (- x -1) --> (1+ x)
-	      (eq (nth 2 form) -1))
+((eq (nth 1 form)  0) `(-  ,(nth 2 form))) ; (- 0 x)  --> (- x)
-	 (list '1+ (nth 1 form)))	; (- x -1)  -->  (1+ x)
+(t form))))
-	(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))))
+	((let ((last (last form)))
-	   (cond ((eq 0 last)  (cons 'progn (cdr form)))
+	   (byte-optimize-predicate
-		 ((eq 1 last)  (delq 1 (copy-sequence form)))
+	    (cond ((eq 0 last)  (cons 'progn (cdr form)))
-		 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
+		  ((eq 1 last)  (delq 1 (copy-sequence form)))
-		 ((and (eq 2 last)
+		  ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
-		       (memq t (mapcar 'symbolp (cdr form))))
+		  ((and (eq 2 last)
-		  (prog1 (setq form (delq 2 (copy-sequence form)))
+			(memq t (mapcar 'symbolp (cdr form))))
-		    (while (not (symbolp (car (setq form (cdr form))))))
+		   (prog1 (setq form (delq 2 (copy-sequence form)))
-		    (setcar form (list '+ (car form) (car form)))))
+		     (while (not (symbolp (car (setq form (cdr form))))))
-		 (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))
 			(not (zerop last))
 			(condition-case nil
 				      (butlast (cdr (cdr form)))))
 		     last nil))))
 (cond
 ;;;	  ((null (cdr (cdr form)))
 ;;;	   (nth 1 form))
-	  ((eq (nth 1 form) 0)
+((eq (nth 1 form) 0)
-	   (append '(progn) (cdr (cdr form)) '(0)))
+(append '(progn) (cdr (cdr form)) '(0)))
-	  ((eq last -1)
+((eq last -1)
-	   (list '- (if (nthcdr 3 form)
+(list '- (if (nthcdr 3 form)
-			(butlast form)
+		   (butlast form)
-		      (nth 1 form))))
+		 (nth 1 form))))
-	  (form))))
+(form))))
 (defun byte-optimize-logmumble (form)
 (setq form (byte-optimize-delay-constants-math form 1 (car form)))
 (byte-optimize-predicate
 (cond ((memq 0 form)
 (defun disassemble-offset ()
 "Don't call this!"
 ;; 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)
+(declare (special op ptr bytes))
-(defvar ptr)
-(defvar bytes)
 (cond ((< op byte-nth)
 	 (let ((tem (logand op 7)))
 	   (setq op (logand op 248))
 	   (cond ((eq tem 6)
 		  (setq ptr (1+ ptr))	;offset in next byte
 ;If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
 ;may generate incorrect code.")
 (defun byte-optimize-lapcode (lap &optional for-effect)
 "Simple peephole optimizer.  LAP is both modified and returned."
-(let (lap0 ;; off0 unused
+(let (lap0
-	lap1 ;; off1
+	lap1
-	lap2 ;; off2
+	lap2
+	variable-frequency
 	(keep-going 'first-time)
 	(add-depth 0)
 	rest tmp tmp2 tmp3
 	(side-effect-free (if byte-compile-delete-errors
 			      byte-compile-side-effect-free-ops
 )
 ;; Cleanup stage:
 ;; 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)
+(case (car lap0)
-	  (if (eq (cdr lap0) 'byte-constant)
+	((byte-varref byte-varset byte-varbind)
-	      (or (memq (cdr lap0) byte-compile-variables)
+	 (incf (gethash (cdr lap0) variable-frequency 0))
-		  (setq byte-compile-variables (cons (cdr lap0)
+	 (unless (memq (cdr lap0) byte-compile-variables)
-						     byte-compile-variables)))
+	   (push (cdr lap0) byte-compile-variables)))
-	    (or (memq (cdr lap0) byte-compile-constants)
+	((byte-constant)
-		(setq byte-compile-constants (cons (cdr lap0)
+	 (unless (memq (cdr lap0) byte-compile-constants)
-						   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)
 	     (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1)))
 	     (setcar (cdr rest) (cons 'byte-dup 0))
 	     (setq keep-going t)
 	     (setq lap (delq lap0 lap))
 	     (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)
 (provide 'byte-optimize)

Mercurial > hg > xemacs-beta

comparison lisp/byte-optimize.el @ 442:abe6d1db359e r21-2-36