From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Paul Eggert Newsgroups: gmane.emacs.devel Subject: Re: Floating-point constant folding in Emacs byte compiler Date: Fri, 23 Mar 2018 13:00:26 -0700 Organization: UCLA Computer Science Department Message-ID: <0091d26e-c8e6-b081-36c9-ec74c7521e3b@cs.ucla.edu> References: <2ce39e5c-cd1b-65d6-b125-719caad67932@cs.ucla.edu> <83h8p7i4ho.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------69CB57F5E1386E236403A0D9" X-Trace: blaine.gmane.org 1521835125 18451 195.159.176.226 (23 Mar 2018 19:58:45 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 23 Mar 2018 19:58:45 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.6.0 Cc: monnier@iro.umontreal.ca, emacs-devel@gnu.org To: Eli Zaretskii Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Fri Mar 23 20:58:40 2018 Return-path: Envelope-to: ged-emacs-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ezSpi-0004gp-Mb for ged-emacs-devel@m.gmane.org; Fri, 23 Mar 2018 20:58:38 +0100 Original-Received: from localhost ([::1]:39585 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ezSrm-0007Km-5q for ged-emacs-devel@m.gmane.org; Fri, 23 Mar 2018 16:00:46 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:36750) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ezSre-0007IV-Ep for emacs-devel@gnu.org; Fri, 23 Mar 2018 16:00:40 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ezSrc-0006sc-C0 for emacs-devel@gnu.org; Fri, 23 Mar 2018 16:00:38 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:35600) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1ezSrW-0006lU-Bp; Fri, 23 Mar 2018 16:00:30 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id AEEB5161706; Fri, 23 Mar 2018 13:00:28 -0700 (PDT) Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10032) with ESMTP id GY_60Rsu4vfm; Fri, 23 Mar 2018 13:00:27 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 3E61216171A; Fri, 23 Mar 2018 13:00:27 -0700 (PDT) X-Virus-Scanned: amavisd-new at zimbra.cs.ucla.edu Original-Received: from zimbra.cs.ucla.edu ([127.0.0.1]) by localhost (zimbra.cs.ucla.edu [127.0.0.1]) (amavisd-new, port 10026) with ESMTP id blXhJ4WEw18e; Fri, 23 Mar 2018 13:00:26 -0700 (PDT) Original-Received: from Penguin.CS.UCLA.EDU (Penguin.CS.UCLA.EDU [131.179.64.200]) by zimbra.cs.ucla.edu (Postfix) with ESMTPSA id E35B8161706; Fri, 23 Mar 2018 13:00:26 -0700 (PDT) In-Reply-To: <83h8p7i4ho.fsf@gnu.org> Content-Language: en-US X-detected-operating-system: by eggs.gnu.org: GNU/Linux 3.x [fuzzy] X-Received-From: 131.179.128.68 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:223976 Archived-At: This is a multi-part message in MIME format. --------------69CB57F5E1386E236403A0D9 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit On 03/23/2018 01:24 AM, Eli Zaretskii wrote: > I think we should strive to leave the byte code platform-independent. That's my thought as well. The byte-compiler was taking the Fortran attitude that if an optimization would be allowed on an infinite-precision machine, then do it even if it results in different answers on real machines due to rounding error or overflow. This loses predictability and means that .elc files are not machine-independent. Althopugh performance trumps predictability for Fortran, predictability is more important for Emacs, as its users will not notice any performance loss but they might be affected by the differing answers. I took a quick look through the byte optimizer and removed the Fortran-style floating-point optimizations that I found, by installing the attached. This doesn't seem to affect performance significantly on Emacs itself. --------------69CB57F5E1386E236403A0D9 Content-Type: text/x-patch; name="0001-Avoid-Fortran-style-floating-point-optimization.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename*0="0001-Avoid-Fortran-style-floating-point-optimization.patch" >From 34a2afa85daf513631512309f01aea55f77f6fec Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 23 Mar 2018 12:57:39 -0700 Subject: [PATCH] Avoid Fortran-style floating-point optimization When optimizing arithmetic operations, avoid optimizations that are valid for mathematical numbers but invalid for floating-point. For example, do not optimize (+ 1 v 0.5) to (+ v 1.5), as they may not be the same due to rounding errors. In general, floating-point numbers cannot be constant-folded, since that would make .elc files platform-dependent. * lisp/emacs-lisp/byte-opt.el (byte-optimize-associative-math): Do not optimize floats. (byte-optimize-nonassociative-math, byte-optimize-approx-equal) (byte-optimize-delay-constants-math, byte-compile-butlast) (byte-optimize-logmumble): Remove; no longer used. (byte-optimize-minus): Do not optimize (- 0 x) to (- x). (byte-optimize-multiply): Do not optimize (* -1 x) to (- x). (byte-optimize-divide): Do not optimize (/ x -1) to (- x). (logand, logior, logxor): Optimize with byte-optimize-predicate instead of with byte-optimize-logmumble. * test/lisp/emacs-lisp/bytecomp-tests.el: (byte-opt-testsuite-arith-data): Add a couple of test cases. --- lisp/emacs-lisp/byte-opt.el | 168 ++++----------------------------- test/lisp/emacs-lisp/bytecomp-tests.el | 6 +- 2 files changed, 24 insertions(+), 150 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 55343e1e3a..a5e0e21964 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -656,15 +656,15 @@ byte-compile-nilconstp ((not (symbolp form)) nil) ((null form)))) -;; If the function is being called with constant numeric args, +;; If the function is being called with constant integer args, ;; evaluate as much as possible at compile-time. This optimizer -;; assumes that the function is associative, like + or *. +;; assumes that the function is associative, like min or max. (defun byte-optimize-associative-math (form) (let ((args nil) (constants nil) (rest (cdr form))) (while rest - (if (numberp (car rest)) + (if (integerp (car rest)) (setq constants (cons (car rest) constants)) (setq args (cons (car rest) args))) (setq rest (cdr rest))) @@ -678,82 +678,7 @@ byte-optimize-associative-math (apply (car form) constants)) form))) -;; If the function is being called with constant numeric args, -;; evaluate as much as possible at compile-time. This optimizer -;; assumes that the function satisfies -;; (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn) -;; like - and /. -(defun byte-optimize-nonassociative-math (form) - (if (or (not (numberp (car (cdr form)))) - (not (numberp (car (cdr (cdr form)))))) - form - (let ((constant (car (cdr form))) - (rest (cdr (cdr form)))) - (while (numberp (car rest)) - (setq constant (funcall (car form) constant (car rest)) - rest (cdr rest))) - (if rest - (cons (car form) (cons constant rest)) - constant)))) - -;;(defun byte-optimize-associative-two-args-math (form) -;; (setq form (byte-optimize-associative-math form)) -;; (if (consp form) -;; (byte-optimize-two-args-left form) -;; form)) - -;;(defun byte-optimize-nonassociative-two-args-math (form) -;; (setq form (byte-optimize-nonassociative-math form)) -;; (if (consp form) -;; (byte-optimize-two-args-right form) -;; form)) - -(defun byte-optimize-approx-equal (x y) - (<= (* (abs (- x y)) 100) (abs (+ x y)))) - -;; Collect all the constants from FORM, after the STARTth arg, -;; and apply FUN to them to make one argument at the end. -;; For functions that can handle floats, that optimization -;; can be incorrect because reordering can cause an overflow -;; that would otherwise be avoided by encountering an arg that is a float. -;; We avoid this problem by (1) not moving float constants and -;; (2) not moving anything if it would cause an overflow. -(defun byte-optimize-delay-constants-math (form start fun) - ;; Merge all FORM's constants from number START, call FUN on them - ;; and put the result at the end. - (let ((rest (nthcdr (1- start) form)) - (orig form) - ;; t means we must check for overflow. - (overflow (memq fun '(+ *)))) - (while (cdr (setq rest (cdr rest))) - (if (integerp (car rest)) - (let (constants) - (setq form (copy-sequence form) - rest (nthcdr (1- start) form)) - (while (setq rest (cdr rest)) - (cond ((integerp (car rest)) - (setq constants (cons (car rest) constants)) - (setcar rest nil)))) - ;; If necessary, check now for overflow - ;; that might be caused by reordering. - (if (and overflow - ;; We have overflow if the result of doing the arithmetic - ;; on floats is not even close to the result - ;; of doing it on integers. - (not (byte-optimize-approx-equal - (apply fun (mapcar 'float constants)) - (float (apply fun constants))))) - (setq form orig) - (setq form (nconc (delq nil form) - (list (apply fun (nreverse constants))))))))) - form)) - -(defsubst byte-compile-butlast (form) - (nreverse (cdr (reverse form)))) - (defun byte-optimize-plus (form) - ;; Don't call `byte-optimize-delay-constants-math' (bug#1334). - ;;(setq form (byte-optimize-delay-constants-math form 1 '+)) (if (memq 0 form) (setq form (delq 0 (copy-sequence form)))) ;; For (+ constants...), byte-optimize-predicate does the work. (when (memq nil (mapcar 'numberp (cdr form))) @@ -767,26 +692,19 @@ byte-optimize-plus (setq integer (nth 1 form) other (nth 2 form)) (setq integer (nth 2 form) other (nth 1 form))) (setq form - (list (if (eq integer 1) '1+ '1-) other)))) - ;; Here, we could also do - ;; (+ x y ... 1) --> (1+ (+ x y ...)) - ;; (+ x y ... -1) --> (1- (+ x y ...)) - ;; The resulting bytecode is smaller, but is it faster? -- cyd - )) + (list (if (eq integer 1) '1+ '1-) other)))))) (byte-optimize-predicate form)) (defun byte-optimize-minus (form) - ;; Don't call `byte-optimize-delay-constants-math' (bug#1334). - ;;(setq form (byte-optimize-delay-constants-math form 2 '+)) ;; Remove zeros. (when (and (nthcdr 3 form) (memq 0 (cddr form))) (setq form (nconc (list (car form) (cadr form)) (delq 0 (copy-sequence (cddr form))))) - ;; After the above, we must turn (- x) back into (- x 0) + ;; After the above, we must turn (- x) back into (- x 0). (or (cddr form) (setq form (nconc form (list 0))))) - ;; For (- constants..), byte-optimize-predicate does the work. + ;; For (- constants...), byte-optimize-predicate does the work. (when (memq nil (mapcar 'numberp (cdr form))) (cond ;; (- x 1) --> (1- x) @@ -794,71 +712,25 @@ byte-optimize-minus (setq form (list '1- (nth 1 form)))) ;; (- x -1) --> (1+ x) ((equal (nthcdr 2 form) '(-1)) - (setq form (list '1+ (nth 1 form)))) - ;; (- 0 x) --> (- x) - ((and (eq (nth 1 form) 0) - (= (length form) 3)) - (setq form (list '- (nth 2 form)))) - ;; Here, we could also do - ;; (- x y ... 1) --> (1- (- x y ...)) - ;; (- x y ... -1) --> (1+ (- x y ...)) - ;; The resulting bytecode is smaller, but is it faster? -- cyd - )) + (setq form (list '1+ (nth 1 form)))))) (byte-optimize-predicate form)) (defun byte-optimize-multiply (form) - (setq form (byte-optimize-delay-constants-math form 1 '*)) - ;; For (* constants..), byte-optimize-predicate does the work. - (when (memq nil (mapcar 'numberp (cdr form))) - ;; After `byte-optimize-predicate', if there is a INTEGER constant - ;; in FORM, it is in the last element. - (let ((last (car (reverse (cdr form))))) - (cond - ;; Would handling (* ... 0) here cause floating point errors? - ;; See bug#1334. - ((eq 1 last) (setq form (byte-compile-butlast form))) - ((eq -1 last) - (setq form (list '- (if (nthcdr 3 form) - (byte-compile-butlast form) - (nth 1 form)))))))) + (if (memq 1 form) (setq form (delq 1 (copy-sequence form)))) + ;; For (* integers..), byte-optimize-predicate does the work. (byte-optimize-predicate form)) (defun byte-optimize-divide (form) - (setq form (byte-optimize-delay-constants-math form 2 '*)) - ;; After `byte-optimize-predicate', if there is a INTEGER constant - ;; in FORM, it is in the last element. - (let ((last (car (reverse (cdr (cdr form)))))) - (cond - ;; Runtime error (leave it intact). - ((or (null last) - (eq last 0) - (memql 0.0 (cddr form)))) - ;; No constants in expression - ((not (numberp last))) - ;; For (* constants..), byte-optimize-predicate does the work. - ((null (memq nil (mapcar 'numberp (cdr form))))) - ;; (/ x y.. 1) --> (/ x y..) - ((and (eq last 1) (nthcdr 3 form)) - (setq form (byte-compile-butlast form))) - ;; (/ x -1), (/ x .. -1) --> (- x), (- (/ x ..)) - ((eq last -1) - (setq form (list '- (if (nthcdr 3 form) - (byte-compile-butlast form) - (nth 1 form))))))) + ;; Remove 1s. + (when (and (nthcdr 3 form) + (memq 1 (cddr form))) + (setq form (nconc (list (car form) (cadr form)) + (delq 1 (copy-sequence (cddr form))))) + ;; After the above, we must turn (/ x) back into (/ x 1). + (or (cddr form) + (setq form (nconc form (list 1))))) (byte-optimize-predicate form)) -(defun byte-optimize-logmumble (form) - (setq form (byte-optimize-delay-constants-math form 1 (car form))) - (byte-optimize-predicate - (cond ((memq 0 form) - (setq form (if (eq (car form) 'logand) - (cons 'progn (cdr form)) - (delq 0 (copy-sequence form))))) - ((and (eq (car-safe form) 'logior) - (memq -1 form)) - (cons 'progn (cdr form))) - (form)))) - (defun byte-optimize-binary-predicate (form) (cond @@ -923,9 +795,9 @@ byte-optimize-identity (put 'string< 'byte-optimizer 'byte-optimize-predicate) (put 'string-lessp 'byte-optimizer 'byte-optimize-predicate) -(put 'logand 'byte-optimizer 'byte-optimize-logmumble) -(put 'logior 'byte-optimizer 'byte-optimize-logmumble) -(put 'logxor 'byte-optimizer 'byte-optimize-logmumble) +(put 'logand 'byte-optimizer 'byte-optimize-predicate) +(put 'logior 'byte-optimizer 'byte-optimize-predicate) +(put 'logxor 'byte-optimizer 'byte-optimize-predicate) (put 'lognot 'byte-optimizer 'byte-optimize-predicate) (put 'car 'byte-optimizer 'byte-optimize-predicate) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 6ae7cdb9f9..7330c67614 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -38,8 +38,7 @@ byte-opt-testsuite-arith-data (let ((a 3) (b 2) (c 1.0)) (/ a b c)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (+ a -1 b)) (let ((a (+ 1 (expt 2 -64))) (b (expt 2 -65))) (- a 1 (- b))) - ;; This fails. Should it be a bug? - ;; (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) + (let ((a (expt 2 -1074)) (b 0.125)) (* a 8 b)) (let ((a 1.0)) (* a 0)) (let ((a 1.0)) (* a 2.0 0)) (let ((a 1.0)) (/ 0 a)) @@ -244,6 +243,9 @@ byte-opt-testsuite-arith-data (let ((a 3) (b 2) (c 1.0)) (/ a b c 0)) (let ((a 3) (b 2) (c 1.0)) (/ a b c 1)) (let ((a 3) (b 2) (c 1.0)) (/ a b c -1)) + + (let ((a t)) (logand 0 a)) + ;; Test switch bytecode (let ((a 3)) (cond ((eq a 1) 'one) ((eq a 2) 'two) ((eq a 3) 'three) (t t))) (let ((a 'three)) (cond ((eq a 'one) 1) ((eq a 2) 'two) ((eq a 'three) 3) -- 2.14.3 --------------69CB57F5E1386E236403A0D9--