From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Paul Pogonyshev 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: 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 ) 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." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-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: 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.)