Re: Making 'eq' == 'eql' in bignum branch

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

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

Eli Zaretskii wrote:
> Well, the FP calculations in Lisp are certainly in places that get
> used a lot: the line-move stuff and window.el stuff.

OK, I constructed a little benchmark based on some of the window.el stuff, and 
timed it with immediate floats instead of the longstanding way of implementing 
floats as pointers into the heap, and on this benchmark Emacs was 82% faster 
with immediate floats, i.e., the CPU time on my usual 64-bit platform for (bench 
1000000) shrank from 10.776 now to 5.914 seconds with immediate floats. So it 
looks promising. This was the only benchmark I tried.

Patch to Emacs and benchmark source code attached. The benchmark was 
byte-compiled. The Emacs patch is just a hack; it's not intended to be a real 
implementation.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: flo.diff --]
[-- Type: text/x-patch; name="flo.diff", Size: 8268 bytes --]

diff --git a/configure.ac b/configure.ac
index b6918671e4..74200dd75b 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1515,6 +1515,12 @@ AC_DEFUN
   CPPFLAGS="$C_SWITCH_SYSTEM $C_SWITCH_MACHINE $CPPFLAGS"
 fi
 
+AC_CHECK_SIZEOF([int])
+AC_CHECK_SIZEOF([long int])
+AC_CHECK_SIZEOF([long long int])
+AC_CHECK_SIZEOF([float])
+AC_CHECK_SIZEOF([double])
+
 # Suppress obsolescent Autoconf test for size_t; Emacs assumes C99 or better.
 AC_DEFUN([AC_TYPE_SIZE_T])
 # Likewise for obsolescent test for uid_t, gid_t; Emacs assumes them.
diff --git a/src/alloc.c b/src/alloc.c
index ad716f543c..763df583ab 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2643,12 +2643,14 @@ static int float_block_index = FLOAT_BLOCK_SIZE;
 
 static struct Lisp_Float *float_free_list;
 
+#if FLOAT_REPR == FLOAT_TAGGED
+
 /* Return a new float object with value FLOAT_VALUE.  */
 
 Lisp_Object
-make_float (double float_value)
+make_tagged_float (double float_value)
 {
-  register Lisp_Object val;
+  Lisp_Object val;
 
   MALLOC_BLOCK_INPUT;
 
@@ -2685,6 +2687,7 @@ make_float (double float_value)
   return val;
 }
 
+#endif
 
 \f
 /***********************************************************************
@@ -5505,6 +5508,7 @@ static Lisp_Object
 purecopy (Lisp_Object obj)
 {
   if (INTEGERP (obj)
+      || (FLOAT_REPR != FLOAT_TAGGED && FLOATP (obj))
       || (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
       || SUBRP (obj))
     return obj;    /* Already pure.  */
@@ -6600,8 +6604,11 @@ mark_object (Lisp_Object arg)
       }
 
     case Lisp_Float:
-      CHECK_ALLOCATED_AND_LIVE (live_float_p);
-      FLOAT_MARK (XFLOAT (obj));
+      if (FLOAT_REPR == FLOAT_TAGGED)
+	{
+	  CHECK_ALLOCATED_AND_LIVE (live_float_p);
+	  FLOAT_MARK (XFLOAT (obj));
+	}
       break;
 
     case_Lisp_Int:
@@ -6673,7 +6680,7 @@ survives_gc_p (Lisp_Object obj)
       break;
 
     case Lisp_Float:
-      survives_p = FLOAT_MARKED_P (XFLOAT (obj));
+      survives_p = FLOAT_REPR != FLOAT_TAGGED || FLOAT_MARKED_P (XFLOAT (obj));
       break;
 
     default:
diff --git a/src/lisp.h b/src/lisp.h
index bdece817bd..b4ee5656c7 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -81,18 +81,21 @@ DEFINE_GDB_SYMBOL_END (GCTYPEBITS)
 typedef int EMACS_INT;
 typedef unsigned int EMACS_UINT;
 enum { EMACS_INT_WIDTH = INT_WIDTH, EMACS_UINT_WIDTH = UINT_WIDTH };
+#  define SIZEOF_EMACS_INT SIZEOF_INT
 #  define EMACS_INT_MAX INT_MAX
 #  define pI ""
 # elif INTPTR_MAX <= LONG_MAX && !defined WIDE_EMACS_INT
 typedef long int EMACS_INT;
 typedef unsigned long EMACS_UINT;
 enum { EMACS_INT_WIDTH = LONG_WIDTH, EMACS_UINT_WIDTH = ULONG_WIDTH };
+#  define SIZEOF_EMACS_INT SIZEOF_LONG_INT
 #  define EMACS_INT_MAX LONG_MAX
 #  define pI "l"
 # elif INTPTR_MAX <= LLONG_MAX
 typedef long long int EMACS_INT;
 typedef unsigned long long int EMACS_UINT;
 enum { EMACS_INT_WIDTH = LLONG_WIDTH, EMACS_UINT_WIDTH = ULLONG_WIDTH };
+#  define SIZEOF_EMACS_INT SIZEOF_LONG_LONG_INT
 #  define EMACS_INT_MAX LLONG_MAX
 /* MinGW supports %lld only if __USE_MINGW_ANSI_STDIO is non-zero,
    which is arranged by config.h, and (for mingw.org) if GCC is 6.0 or
@@ -618,6 +621,9 @@ enum CHECK_LISP_OBJECT_TYPE { CHECK_LISP_OBJECT_TYPE = false };
 INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
 					      Lisp_Object);
 
+/* Defined in alloc.c.  */
+extern Lisp_Object make_tagged_float (double);
+
 /* Defined in chartab.c.  */
 extern Lisp_Object char_table_ref (Lisp_Object, int);
 extern void char_table_set (Lisp_Object, int, Lisp_Object);
@@ -2640,6 +2646,34 @@ XBUFFER_OBJFWD (union Lisp_Fwd *a)
 }
 \f
 /* Lisp floating point type.  */
+
+/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
+   representations, have infinities and NaNs, and do not trap on
+   exceptions.  Define IEEE_FLOATING_POINT to 1 if this host is one of the
+   typical ones.  The C11 macro __STDC_IEC_559__ is close to what is
+   wanted here, but is not quite right because Emacs does not require
+   all the features of C11 Annex F (and does not require C11 at all,
+   for that matter).  */
+
+#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
+			     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
+
+/* Whether Lisp floats are represented directly in Lisp_Object values,
+   as opposed to tagged pointers to storage.  */
+#define FLOAT_TAGGED 0
+#define FLOAT_FLOAT 1
+#define FLOAT_DOUBLE 2
+#define FLOAT_REPR (! (USE_LSB_TAG && IEEE_FLOATING_POINT) ? FLOAT_TAGGED \
+		    : SIZEOF_EMACS_INT == SIZEOF_FLOAT ? FLOAT_FLOAT	\
+		    : SIZEOF_EMACS_INT == SIZEOF_DOUBLE ? FLOAT_DOUBLE	\
+		    : FLOAT_TAGGED)
+#if FLOAT_REPR == FLOAT_FLOAT
+typedef float emacs_float;
+#elif FLOAT_REPR == FLOAT_DOUBLE
+typedef double emacs_float;
+#endif
+
+/* If Lisp floats are tagged pointers, they point to this.  */
 struct Lisp_Float
   {
     union
@@ -2655,9 +2689,21 @@ INLINE bool
   return lisp_h_FLOATP (x);
 }
 
+INLINE Lisp_Object
+make_float (double d)
+{
+#if FLOAT_REPR == FLOAT_TAGGED
+  return make_tagged_float (d);
+#else
+  return XIL (((union { emacs_float f; EMACS_INT i; }) {d} . i & VALMASK)
+	      + Lisp_Float);
+#endif
+}
+
 INLINE struct Lisp_Float *
 XFLOAT (Lisp_Object a)
 {
+  eassume (FLOAT_REPR == FLOAT_TAGGED);
   eassert (FLOATP (a));
   return XUNTAG (a, Lisp_Float, struct Lisp_Float);
 }
@@ -2665,19 +2711,18 @@ XFLOAT (Lisp_Object a)
 INLINE double
 XFLOAT_DATA (Lisp_Object f)
 {
-  return XFLOAT (f)->u.data;
-}
-
-/* Most hosts nowadays use IEEE floating point, so they use IEC 60559
-   representations, have infinities and NaNs, and do not trap on
-   exceptions.  Define IEEE_FLOATING_POINT to 1 if this host is one of the
-   typical ones.  The C11 macro __STDC_IEC_559__ is close to what is
-   wanted here, but is not quite right because Emacs does not require
-   all the features of C11 Annex F (and does not require C11 at all,
-   for that matter).  */
+  union { EMACS_INT i; float f; double d; } u = { .i = XLI (f) - Lisp_Float };
 
-#define IEEE_FLOATING_POINT (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \
-			     && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128)
+  switch (FLOAT_REPR)
+    {
+    case FLOAT_FLOAT:
+      return u.f;
+    case FLOAT_DOUBLE:
+      return u.d;
+    default:
+      return XFLOAT (f)->u.data;
+    }
+}
 
 /* A character, declared with the following typedef, is a member
    of some character set associated with the current buffer.  */
@@ -3696,7 +3741,6 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
 				   VECSIZE (type), tag))
 
 extern bool gc_in_progress;
-extern Lisp_Object make_float (double);
 extern void display_malloc_warning (void);
 extern ptrdiff_t inhibit_garbage_collection (void);
 extern Lisp_Object build_overlay (Lisp_Object, Lisp_Object, Lisp_Object);
diff --git a/src/print.c b/src/print.c
index 34c7fa12b6..c10bbc5ac2 100644
--- a/src/print.c
+++ b/src/print.c
@@ -39,6 +39,7 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include <float.h>
 #include <ftoastr.h>
 #include <math.h>
+#include <stdlib.h>
 
 #if IEEE_FLOATING_POINT
 # include <ieee754.h>
@@ -1029,7 +1030,26 @@ float_to_string (char *buf, double data)
     {
       /* Generate the fewest number of digits that represent the
 	 floating point value without losing information.  */
-      len = dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
+      if (FLOAT_REPR == FLOAT_TAGGED)
+	len = dtoastr (buf, FLOAT_TO_STRING_BUFSIZE - 2, 0, 0, data);
+      else
+	for (int prec = ((fabs (data)
+			  < (FLOAT_REPR == FLOAT_FLOAT
+			     ? (double) FLT_MIN
+			     : DBL_MIN))
+			 ? 1
+			 : ((FLOAT_REPR == FLOAT_FLOAT ? FLT_DIG : DBL_DIG)
+			    - 1));
+	       ; prec++)
+	  {
+	    len = snprintf (buf, FLOAT_TO_STRING_BUFSIZE - 2,
+			    "%.*g", prec, data);
+	    if (isnan (data))
+	      break;
+	    if (XFLOAT_DATA (make_float (strtod (buf, NULL))) == data)
+	      break;
+	  }
+
       /* The decimal point must be printed, or the byte compiler can
 	 get confused (Bug#8033). */
       width = 1;

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: bench-float.el --]
[-- Type: text/x-emacs-lisp; name="bench-float.el", Size: 1661 bytes --]

;;; -*- lexical-binding:t -*-

;; Inspired by window--resize-child-windows-normal

(defvar this-delta 10)
(defvar window-height 50)
(defvar window-normal-size 0.5)
(defvar my-subs '(0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8))
(defvar my-tmp nil)

; (defun bench-nth (n l)
;   (while (and l (not (zerop n)))
;     (setq l (cdr l))
;     (setq n (1- n)))
;   (car l))

(defun bench-with (n)
  (let ((start (float-time (get-internal-run-time)))
	(i 0))
    (while (< i n)
      (let* ((delta-normal
              (if (= (- this-delta) window-height)
                  (- window-normal-size)
                (/ (float this-delta)
                   window-height)))
             (parent-normal 0.0))
        (dolist (sub my-subs)
          (setq parent-normal
                (+ parent-normal window-normal-size sub)))
        (dolist (sub my-subs)
	  (let ((old-normal (+ sub window-normal-size)))
            (setq my-tmp
	          (min 1.0 ; Don't get larger than 1.
		       (max (- old-normal
			       (* (/ old-normal parent-normal)
			          delta-normal))
		            ;; Don't drop below 0.
		            0.0)))))
        (let ((sum 0))
          (dolist (sub my-subs)
            (setq sum (+ sum window-normal-size sub))
            (setq my-tmp (min 1.0 (max (- 1.0 sum) 0.0))))))
      (setq i (1+ i)))
    (- (float-time (get-internal-run-time)) start)))

(defun bench-without (n)
  (let ((start (float-time (get-internal-run-time)))
	(i 0))
    (while (< i n)
      (setq i (1+ i)))
    (- (float-time (get-internal-run-time)) start)))

(defun bench (n)
  (- (bench-with n)
     (bench-without n)))