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: Mon, 26 Mar 2018 17:08:37 -0700 Organization: UCLA Computer Science Department Message-ID: <4719b869-2050-aa33-792b-48ce795b70bd@cs.ucla.edu> References: <2ce39e5c-cd1b-65d6-b125-719caad67932@cs.ucla.edu> <83vadmgfbz.fsf@gnu.org> <87d0zr2n1u.fsf@gmail.com> <83h8p2g99p.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="------------8E961AE9F074257E2CAD06F8" X-Trace: blaine.gmane.org 1522109209 6042 195.159.176.226 (27 Mar 2018 00:06:49 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 27 Mar 2018 00:06:49 +0000 (UTC) User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.6.0 To: Stefan Monnier , emacs-devel@gnu.org Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Mar 27 02:06:45 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 1f0c8T-0001V3-1S for ged-emacs-devel@m.gmane.org; Tue, 27 Mar 2018 02:06:45 +0200 Original-Received: from localhost ([::1]:59630 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f0cAW-0006bA-Dk for ged-emacs-devel@m.gmane.org; Mon, 26 Mar 2018 20:08:52 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:48159) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1f0cAO-0006WN-GF for emacs-devel@gnu.org; Mon, 26 Mar 2018 20:08:46 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1f0cAL-0002pC-Nn for emacs-devel@gnu.org; Mon, 26 Mar 2018 20:08:44 -0400 Original-Received: from zimbra.cs.ucla.edu ([131.179.128.68]:52960) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1f0cAL-0002oa-BM for emacs-devel@gnu.org; Mon, 26 Mar 2018 20:08:41 -0400 Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id DFD091615E8; Mon, 26 Mar 2018 17:08:39 -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 DasJ-vHuqByp; Mon, 26 Mar 2018 17:08:37 -0700 (PDT) Original-Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id D13BC161621; Mon, 26 Mar 2018 17:08:37 -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 WCyPozxwm3i4; Mon, 26 Mar 2018 17:08:37 -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 B4B9A1615E8; Mon, 26 Mar 2018 17:08:37 -0700 (PDT) In-Reply-To: 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:224081 Archived-At: This is a multi-part message in MIME format. --------------8E961AE9F074257E2CAD06F8 Content-Type: text/plain; charset=utf-8; format=flowed Content-Transfer-Encoding: 7bit On 03/26/2018 10:52 AM, Stefan Monnier wrote: > I think TRT is for the byte-compiler to refrain from performing this > optimization when the result doesn't fit within 30bits. Yes, this seems like the right way to go for Emacs, since we value reproducibility and safety over performance for numeric computation. I installed the attached patch into master, to try to do that. --------------8E961AE9F074257E2CAD06F8 Content-Type: text/x-patch; name="0001-Fix-constant-folding-of-overflows.patch" Content-Disposition: attachment; filename="0001-Fix-constant-folding-of-overflows.patch" Content-Transfer-Encoding: quoted-printable >From e3b742dcc3d2f1946969d87839e3b72b0f52c513 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Mon, 26 Mar 2018 17:03:54 -0700 Subject: [PATCH] Fix constant folding of overflows This suppresses some byte-code optimizations that were invalid in the presence of integer overflows, because they meant that .elc files assumed the runtime behavior of the compiling platform, as opposed to the runtime platform. Problem reported by Pip Cet in: https://lists.gnu.org/r/emacs-devel/2018-03/msg00753.html * lisp/emacs-lisp/byte-opt.el (byte-opt--portable-max) (byte-opt--portable-min): New constants. (byte-opt--portable-numberp, byte-opt--arith-reduce) (byte-optimize-1+, byte-optimize-1-): New functions. (byte-optimize-plus, byte-optimize-minus, byte-optimize-multiply) (byte-optimize-divide): Avoid invalid optimizations. (1+, 1-): Use new optimizers. (byte-optimize-or, byte-optimize-cond): Simplify by using remq instead of delq and copy-sequence. --- lisp/emacs-lisp/byte-opt.el | 175 +++++++++++++++++++++++++++++++-------= ------ 1 file changed, 124 insertions(+), 51 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 004f58cc12..3bc4c438d6 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -678,59 +678,134 @@ byte-optimize-associative-math (apply (car form) constants)) form))) =20 +;; Portable Emacs integers fall in this range. +(defconst byte-opt--portable-max #x1fffffff) +(defconst byte-opt--portable-min (- -1 byte-opt--portable-max)) + +;; True if N is a number that works the same on all Emacs platforms. +;; Portable Emacs fixnums are exactly representable as floats on all +;; Emacs platforms, and (except for -0.0) any floating-point number +;; that equals one of these integers must be the same on all +;; platforms. Although other floating-point numbers such as 0.5 are +;; also portable, it can be tricky to characterize them portably so +;; they are not optimized. +(defun byte-opt--portable-numberp (n) + (and (numberp n) + (<=3D byte-opt--portable-min n byte-opt--portable-max) + (=3D n (floor n)) + (not (and (floatp n) (zerop n) + (condition-case () (< (/ n) 0) (error)))))) + +;; Use OP to reduce any leading prefix of portable numbers in the list +;; (cons ACCUM ARGS) down to a single portable number, and return the +;; resulting list A of arguments. The idea is that applying OP to A +;; is equivalent to (but likely more efficient than) applying OP to +;; (cons ACCUM ARGS), on any Emacs platform. Do not make any special +;; provision for (- X) or (/ X); for example, it is the caller=E2=80=99s +;; responsibility that (- 1 0) should not be "optimized" to (- 1). +(defun byte-opt--arith-reduce (op accum args) + (when (byte-opt--portable-numberp accum) + (let (accum1) + (while (and (byte-opt--portable-numberp (car args)) + (byte-opt--portable-numberp + (setq accum1 (condition-case () + (funcall op accum (car args)) + (error)))) + (=3D accum1 (funcall op (float accum) (car args)))) + (setq accum accum1) + (setq args (cdr args))))) + (cons accum args)) + (defun byte-optimize-plus (form) - (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))) + (let ((args (remq 0 (byte-opt--arith-reduce #'+ 0 (cdr form))))) (cond + ;; (+) -> 0 + ((null args) 0) + ;; (+ n) -> n, where n is a number + ((and (null (cdr args)) (numberp (car args))) (car args)) ;; (+ x 1) --> (1+ x) and (+ x -1) --> (1- x). - ((and (=3D (length form) 3) - (or (memq (nth 1 form) '(1 -1)) - (memq (nth 2 form) '(1 -1)))) - (let (integer other) - (if (memq (nth 1 form) '(1 -1)) - (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)))))) - (byte-optimize-predicate form)) + ((and (null (cddr args)) (or (memq 1 args) (memq -1 args))) + (let* ((arg1 (car args)) (arg2 (cadr args)) + (integer-is-first (memq arg1 '(1 -1))) + (integer (if integer-is-first arg1 arg2)) + (other (if integer-is-first arg2 arg1))) + (list (if (eq integer 1) '1+ '1-) other))) + ;; not further optimized + ((equal args (cdr form)) form) + (t (cons '+ args))))) =20 (defun byte-optimize-minus (form) - ;; 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). - (or (cddr form) - (setq form (nconc form (list 0))))) - ;; For (- constants...), byte-optimize-predicate does the work. - (when (memq nil (mapcar 'numberp (cdr form))) - (cond - ;; (- x 1) --> (1- x) - ((equal (nthcdr 2 form) '(1)) - (setq form (list '1- (nth 1 form)))) - ;; (- x -1) --> (1+ x) - ((equal (nthcdr 2 form) '(-1)) - (setq form (list '1+ (nth 1 form)))))) - (byte-optimize-predicate form)) + (let ((args (cdr form))) + (if (and (cdr args) + (null (cdr (setq args (byte-opt--arith-reduce + #'- (car args) (cdr args))))) + (numberp (car args))) + ;; The entire argument list reduced to a constant; return it. + (car args) + ;; Remove non-leading zeros, except for (- x 0). + (when (memq 0 (cdr args)) + (setq args (cons (car args) (or (remq 0 (cdr args)) (list 0))))) + (cond + ;; (- x 1) --> (1- x) + ((equal (cdr args) '(1)) + (list '1- (car args))) + ;; (- x -1) --> (1+ x) + ((equal (cdr args) '(-1)) + (list '1+ (car args))) + ;; (- n) -> -n, where n and -n are portable numbers. + ;; This must be done separately since byte-opt--arith-reduce + ;; is not applied to (- n). + ((and (null (cdr args)) + (byte-opt--portable-numberp (car args)) + (byte-opt--portable-numberp (- (car args)))) + (- (car args))) + ;; not further optimized + ((equal args (cdr form)) form) + (t (cons '- args)))))) + +(defun byte-optimize-1+ (form) + (let ((args (cdr form))) + (when (null (cdr args)) + (let ((n (car args))) + (when (and (byte-opt--portable-numberp n) + (byte-opt--portable-numberp (1+ n))) + (setq form (1+ n)))))) + form) + +(defun byte-optimize-1- (form) + (let ((args (cdr form))) + (when (null (cdr args)) + (let ((n (car args))) + (when (and (byte-opt--portable-numberp n) + (byte-opt--portable-numberp (1- n))) + (setq form (1- n)))))) + form) =20 (defun byte-optimize-multiply (form) - (if (memq 1 form) (setq form (delq 1 (copy-sequence form)))) - ;; For (* integers..), byte-optimize-predicate does the work. - (byte-optimize-predicate form)) + (let* ((args (remq 1 (byte-opt--arith-reduce #'* 1 (cdr form))))) + (cond + ;; (*) -> 1 + ((null args) 1) + ;; (* n) -> n, where n is a number + ((and (null (cdr args)) (numberp (car args))) (car args)) + ;; not further optimized + ((equal args (cdr form)) form) + (t (cons '* args))))) =20 (defun byte-optimize-divide (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)) - + (let ((args (cdr form))) + (if (and (cdr args) + (null (cdr (setq args (byte-opt--arith-reduce + #'/ (car args) (cdr args))))) + (numberp (car args))) + ;; The entire argument list reduced to a constant; return it. + (car args) + ;; Remove non-leading 1s, except for (/ x 1). + (when (memq 1 (cdr args)) + (setq args (cons (car args) (or (remq 1 (cdr args)) (list 1))))) + (if (equal args (cdr form)) + form + (cons '/ args))))) =20 (defun byte-optimize-binary-predicate (form) (cond @@ -800,8 +875,8 @@ byte-optimize-memq (put '> 'byte-optimizer 'byte-optimize-predicate) (put '<=3D 'byte-optimizer 'byte-optimize-predicate) (put '>=3D 'byte-optimizer 'byte-optimize-predicate) -(put '1+ 'byte-optimizer 'byte-optimize-predicate) -(put '1- 'byte-optimizer 'byte-optimize-predicate) +(put '1+ 'byte-optimizer 'byte-optimize-1+) +(put '1- 'byte-optimizer 'byte-optimize-1-) (put 'not 'byte-optimizer 'byte-optimize-predicate) (put 'null 'byte-optimizer 'byte-optimize-predicate) (put 'consp 'byte-optimizer 'byte-optimize-predicate) @@ -854,8 +929,7 @@ byte-optimize-or ;; Throw away nil's, and simplify if less than 2 args. ;; If there is a literal non-nil constant in the args to `or', throw a= way all ;; following forms. - (if (memq nil form) - (setq form (delq nil (copy-sequence form)))) + (setq form (remq nil form)) (let ((rest form)) (while (cdr (setq rest (cdr rest))) (if (byte-compile-trueconstp (car rest)) @@ -872,9 +946,8 @@ byte-optimize-cond (let (rest) ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ..= .) (while (setq rest (assq nil (cdr form))) - (setq form (delq rest (copy-sequence form)))) - (if (memq nil (cdr form)) - (setq form (delq nil (copy-sequence form)))) + (setq form (remq rest form))) + (setq form (remq nil form)) (setq rest form) (while (setq rest (cdr rest)) (cond ((byte-compile-trueconstp (car-safe (car rest))) --=20 2.14.3 --------------8E961AE9F074257E2CAD06F8--