Re: Floating-point constant folding in Emacs byte compiler

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 889 bytes --]

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.


[-- Attachment #2: 0001-Avoid-Fortran-style-floating-point-optimization.patch --]
[-- Type: text/x-patch, Size: 11689 bytes --]

From 34a2afa85daf513631512309f01aea55f77f6fec Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
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