From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.org!not-for-mail
From: Paul Pogonyshev <pogonyshev@gmx.net>
Newsgroups: gmane.emacs.devel
Subject: my old bytecode optimization patch
Date: Sun, 1 Jul 2007 18:21:09 +0300
Message-ID: <200707011821.09523.pogonyshev@gmx.net>
NNTP-Posting-Host: lo.gmane.org
Mime-Version: 1.0
Content-Type: text/plain;
  charset="us-ascii"
Content-Transfer-Encoding: 7bit
X-Trace: sea.gmane.org 1183302632 15714 80.91.229.12 (1 Jul 2007 15:10:32 GMT)
X-Complaints-To: usenet@sea.gmane.org
NNTP-Posting-Date: Sun, 1 Jul 2007 15:10:32 +0000 (UTC)
To: emacs-devel@gnu.org
Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Sun Jul 01 17:10:31 2007
Return-path: <emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org>
Envelope-to: ged-emacs-devel@m.gmane.org
Original-Received: from lists.gnu.org ([199.232.76.165])
	by lo.gmane.org with esmtp (Exim 4.50)
	id 1I514I-0001Gm-TS
	for ged-emacs-devel@m.gmane.org; Sun, 01 Jul 2007 17:10:31 +0200
Original-Received: from localhost ([127.0.0.1] helo=lists.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.43)
	id 1I514I-0006BW-AH
	for ged-emacs-devel@m.gmane.org; Sun, 01 Jul 2007 11:10:30 -0400
Original-Received: from mailman by lists.gnu.org with tmda-scanned (Exim 4.43)
	id 1I514E-0006BP-Ty
	for emacs-devel@gnu.org; Sun, 01 Jul 2007 11:10:26 -0400
Original-Received: from exim by lists.gnu.org with spam-scanned (Exim 4.43)
	id 1I514E-0006B7-Be
	for emacs-devel@gnu.org; Sun, 01 Jul 2007 11:10:26 -0400
Original-Received: from [199.232.76.173] (helo=monty-python.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.43) id 1I514E-0006B4-4F
	for emacs-devel@gnu.org; Sun, 01 Jul 2007 11:10:26 -0400
Original-Received: from mail.gmx.net ([213.165.64.20])
	by monty-python.gnu.org with smtp (Exim 4.60)
	(envelope-from <pogonyshev@gmx.net>) id 1I514D-0002El-KQ
	for emacs-devel@gnu.org; Sun, 01 Jul 2007 11:10:25 -0400
Original-Received: (qmail invoked by alias); 01 Jul 2007 15:10:24 -0000
Original-Received: from unknown (EHLO [80.94.234.57]) [80.94.234.57]
	by mail.gmx.net (mp058) with SMTP; 01 Jul 2007 17:10:24 +0200
X-Authenticated: #16844820
X-Provags-ID: V01U2FsdGVkX186gcRLPyU63Zh9yCCCzUfb65DXiDs5LnM9F/i5NY
	Yp1x3NvCEB48+R
User-Agent: KMail/1.7.2
Content-Disposition: inline
X-Y-GMX-Trusted: 0
X-detected-kernel: Linux 2.6 (newer, 1)
X-BeenThere: emacs-devel@gnu.org
X-Mailman-Version: 2.1.5
Precedence: list
List-Id: "Emacs development discussions." <emacs-devel.gnu.org>
List-Unsubscribe: <http://lists.gnu.org/mailman/listinfo/emacs-devel>,
	<mailto:emacs-devel-request@gnu.org?subject=unsubscribe>
List-Archive: <http://lists.gnu.org/pipermail/emacs-devel>
List-Post: <mailto:emacs-devel@gnu.org>
List-Help: <mailto:emacs-devel-request@gnu.org?subject=help>
List-Subscribe: <http://lists.gnu.org/mailman/listinfo/emacs-devel>,
	<mailto:emacs-devel-request@gnu.org?subject=subscribe>
Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org
Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org
Xref: news.gmane.org gmane.emacs.devel:74112
Archived-At: <http://permalink.gmane.org/gmane.emacs.devel/74112>

Hi,

I'm not sure what became with this patch, most likely it just got
forgotten.

The patch:
http://lists.gnu.org/archive/html/emacs-devel/2004-09/msg00715.html

RMS blessing:
http://lists.gnu.org/archive/html/emacs-devel/2004-09/msg00780.html

For convenience, I also append the patch text below.

Paul


*** byte-opt.el	23 Jun 2007 12:18:07 +0300	1.94
--- byte-opt.el	01 Jul 2007 18:11:16 +0300	
***************
*** 1444,1449 ****
--- 1444,1475 ----
       byte-member byte-assq byte-quo byte-rem)
     byte-compile-side-effect-and-error-free-ops))
  
+ (defconst byte-compile-side-effect-free-dynamically-safe-ops
+   '(;; Same as `byte-compile-side-effect-free-ops' but without
+     ;; `byte-varref', `byte-symbol-value' and certain editing
+     ;; primitives.
+     byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
+     byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
+     byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
+     byte-point-min byte-following-char byte-preceding-char
+     byte-eolp byte-eobp byte-bolp byte-bobp
+     ;;
+     ;; Bytecodes from `byte-compile-side-effect-and-error-free-ops'.
+     ;; We are not going to remove them, so it is fine.
+     byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
+     byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
+     byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
+     byte-plus byte-max byte-min byte-mult byte-char-after
+     byte-string= byte-string< byte-nthcdr byte-elt
+     byte-member byte-assq byte-quo byte-rem))
+ 
+ (put 'debug-on-error 'binding-is-magic t)
+ (put 'debug-on-abort 'binding-is-magic t)
+ (put 'inhibit-quit 'binding-is-magic t)
+ (put 'quit-flag 'binding-is-magic t)
+ (put 'gc-cons-threshold 'binding-is-magic t)
+ (put 'track-mouse 'binding-is-magic t)
+ 
  ;; This crock is because of the way DEFVAR_BOOL variables work.
  ;; Consider the code
  ;;
***************
*** 1848,1853 ****
--- 1874,1928 ----
  		      (setq lap (delq lap0 lap))))
  	       (setq keep-going t))
  	      ;;
+ 	      ;; varbind-X [car/cdr/ ...] unbind-1 --> discard [car/cdr/ ...]
+ 	      ;; varbind-X [car/cdr/ ...] unbind-N
+ 	      ;;   --> discard [car/cdr/ ...] unbind-(N-1)
+ 	      ;;
+ 	      ((and (eq 'byte-varbind (car lap1))
+ 		    (not (get (cadr lap1) 'binding-is-magic)))
+ 	       (setq tmp (cdr rest))
+ 	       (while
+ 		   (or
+ 		    (memq (caar (setq tmp (cdr tmp)))
+ 			  byte-compile-side-effect-free-dynamically-safe-ops)
+ 		    (and (eq (caar tmp) 'byte-varref)
+ 			 (not (eq (cadr (car tmp)) (cadr lap1))))))
+ 	       (when (eq 'byte-unbind (caar tmp))
+ 		 ;; Avoid evalling this crap when not logging anyway
+ 		 (when (memq byte-optimize-log '(t lap))
+ 		   (let ((format-string)
+ 			 (args))
+ 		     (if (and (= (aref byte-stack+-info (symbol-value (car lap0)))
+ 				 1)
+ 			      (memq (car lap0) side-effect-free))
+ 			 (setq format-string
+ 			       "  %s %s [car/cdr/ ...] %s\t-->\t[car/cdr/ ...]"
+ 			       args (list lap0 lap1 (car tmp)))
+ 		       (setq format-string
+ 			     "  %s [car/cdr/ ...] %s\t-->\t%s [car/cdr/ ...]"
+ 			     args (list lap1 (car tmp) (cons 'byte-discard 0))))
+ 		     (when (> (cdar tmp) 1)
+ 		       (setq format-string (concat format-string " %s"))
+ 		       (nconc args (list (cons 'byte-unbind (1- (cdar tmp))))))
+ 		     (apply 'byte-compile-log-lap-1 format-string args)))
+ 		 ;; Do the real work
+ 		 (if (and (= (aref byte-stack+-info (symbol-value (car lap0)))
+ 			     1)
+ 			  (memq (car lap0) side-effect-free))
+ 		     ;; Optimization: throw const/dup/... varbind right away.
+ 		     (progn
+ 		       (setcar rest (nth 2 rest))
+ 		       (setcdr rest (nthcdr 3 rest)))
+ 		   (setcar lap1 'byte-discard)
+ 		   (setcdr lap1 0))
+ 		 (if (= (cdar tmp) 1)
+ 		     (progn
+ 		       ;; Throw away unbind-1
+ 		       (setcar tmp (nth 1 tmp))
+ 		       (setcdr tmp (nthcdr 2 tmp)))
+ 		   (setcdr (car tmp) (1- (cdar tmp))))
+ 		 (setq keep-going t)))
+ 	      ;;
  	      ;; X: varref-Y    ...     varset-Y goto-X  -->
  	      ;; X: varref-Y Z: ... dup varset-Y goto-Z
  	      ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)