Benchmarking temporary Lisp objects [Was: Re: [RFC] temporary Lisp_Strings]

[Dmitry Antipov <dmantipov@yandex.ru>]

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

To whom it may concern, I decided to start from conses and vectors
just because this is simpler than strings.  My experimental stuff
is attached, and typical benchmark output may be something like:

Average of 100: stack allocation is 6.879408 times faster for conses
Average of 1000: stack allocation is 7.390145 times faster for conses
Average of 10000: stack allocation is 4.154356 times faster for conses
Average of 100000: stack allocation is 2.417694 times faster for conses

Average of 10: stack allocation is 11.535833 times faster for vectors
Average of 100: stack allocation is 4.731400 times faster for vectors
Average of 1000: stack allocation is 1.443268 times faster for vectors

Note that this is sustained allocation speed; since we're unlikely to
allocate large amounts of Lisp data on stack, real speedup may vary.

Questions:
1) Should alloca_vector fallback to Fmake_vector for large vectors?
2) Is there a way to rewrite alloca_xxx macros to avoid statement
    expressions?  IIUC this is not portable beyond gcc and compilers
    that mimics it (clang, Intel's icc).

Dmitry


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

=== modified file 'src/alloc.c'
--- src/alloc.c	2014-08-29 07:29:47 +0000
+++ src/alloc.c	2014-09-03 09:41:26 +0000
@@ -7118,8 +7118,76 @@
 	   file, line, msg);
   terminate_due_to_signal (SIGABRT, INT_MAX);
 }
-#endif
-\f
+
+/* Stress alloca with inconveniently-sized requests and check
+   whether all allocated areas may be used for Lisp_Object.  */
+
+static void
+verify_alloca (void)
+{
+  int i;
+  enum { ALLOCA_CHECK_MAX = 256 };
+  for (i = 0; i < ALLOCA_CHECK_MAX; i++)
+    {
+      char *ptr = alloca (i + 1);
+      eassert (valid_pointer_for_lisp_object (ptr));
+    }
+}
+
+#else /* not ENABLE_CHECKING */
+
+#define verify_alloca() ((void) 0)
+
+#endif /* ENABLE_CHECKING */
+
+DEFUN ("cons-benchmark", Fcons_benchmark, Scons_benchmark, 1, 1, 0,
+       doc: /* Benchmark cons allocation.  */)
+  (Lisp_Object obj)
+{
+  double x, y;
+  ptrdiff_t i, max;
+  struct timespec ts;
+
+  CHECK_NUMBER (obj);
+  max = XINT (obj);
+
+  ts = current_timespec ();
+  for (i = 0, obj = Qnil; i < max; i++)
+    obj = Fcons (Qt, obj);
+  x = timespectod (timespec_sub (current_timespec (), ts));
+
+  ts = current_timespec ();
+  for (i = 0, obj = Qnil; i < max; i++)
+    obj = alloca_cons (Qt, obj);
+  y = timespectod (timespec_sub (current_timespec (), ts));
+
+  return Fcons (make_float (x), make_float (y));
+}
+
+DEFUN ("vector-benchmark", Fvector_benchmark, Svector_benchmark, 1, 1, 0,
+       doc: /* Benchmark vector allocation.  */)
+  (Lisp_Object obj)
+{
+  double x, y;
+  ptrdiff_t i, max;
+  struct timespec ts;
+
+  CHECK_NUMBER (obj);
+  max = XINT (obj);
+
+  ts = current_timespec ();
+  for (i = 0, obj = Qnil; i < max; i++)
+    obj = Fmake_vector (make_number (i + 1), Qnil);
+  x = timespectod (timespec_sub (current_timespec (), ts));
+
+  ts = current_timespec ();
+  for (i = 0, obj = Qnil; i < max; i++)
+      obj = alloca_vector (i + 1, Qnil);
+  y = timespectod (timespec_sub (current_timespec (), ts));
+
+  return Fcons (make_float (x), make_float (y));
+}
+
 /* Initialization.  */
 
 void
@@ -7129,6 +7197,8 @@
   purebeg = PUREBEG;
   pure_size = PURESIZE;
 
+  verify_alloca ();
+
 #if GC_MARK_STACK || defined GC_MALLOC_CHECK
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);
@@ -7284,6 +7354,9 @@
 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
   defsubr (&Sgc_status);
 #endif
+
+  defsubr (&Scons_benchmark);
+  defsubr (&Svector_benchmark);
 }
 
 /* When compiled with GCC, GDB might say "No enum type named

=== modified file 'src/lisp.h'
--- src/lisp.h	2014-09-02 18:05:00 +0000
+++ src/lisp.h	2014-09-03 09:37:46 +0000
@@ -4533,6 +4533,37 @@
       memory_full (SIZE_MAX);				       \
   } while (false)
 
+/* True if Lisp_Object may be placed at P.  Used only
+   under ENABLE_CHECKING and optimized away otherwise.  */
+
+INLINE bool
+valid_pointer_for_lisp_object (void *p)
+{
+  uintptr_t v = (uintptr_t) p;
+  return !(USE_LSB_TAG ? (v & ~VALMASK) : v >> VALBITS);
+}
+
+/* Allocate Lisp_Cons on stack.  */
+
+#define alloca_cons(head, tail)				\
+  ({ struct Lisp_Cons *_c = alloca (sizeof *_c);	\
+     eassert (valid_pointer_for_lisp_object (_c));	\
+     _c->car = (head), _c->u.cdr = (tail);		\
+     make_lisp_ptr (_c, Lisp_Cons); })
+
+/* Allocate Lisp_Vector on stack, with respect to MAX_ALLOCA limit.  */
+
+#define alloca_vector(slots, init)				\
+  ({ struct Lisp_Vector *_v;					\
+     ptrdiff_t _i, _n = header_size + (slots) * word_size;	\
+     eassert (_n <= MAX_ALLOCA);				\
+     _v = alloca (_n);						\
+     eassert (valid_pointer_for_lisp_object (_v));		\
+     _v->header.size = (slots);					\
+     for (_i = 0; _i < _v->header.size; _i++)			\
+       _v->contents[_i] = init;					\
+     make_lisp_ptr (_v, Lisp_Vectorlike); })
+
 /* Loop over all tails of a list, checking for cycles.
    FIXME: Make tortoise and n internal declarations.
    FIXME: Unroll the loop body so we don't need `n'.  */


[-- Attachment #3: cons-vector-benchmark.el --]
[-- Type: text/x-emacs-lisp, Size: 670 bytes --]

(defun cons-benchmark-test ()
  (interactive)
  (dolist (size '(100 1000 10000 100000))
    (let ((avg 0.0))
      (dotimes (i 1000)
	(let ((data (cons-benchmark size)))
	  (setq avg (+ avg (/ (car data) (cdr data))))))
      (message
       "Average of %d: stack allocation is %f times faster for conses"
       size (/ avg 1000.0)))))

(defun vector-benchmark-test ()
  (interactive)
  (dolist (size '(10 100 1000))
    (let ((avg 0.0))
      (dotimes (i 1000)
	(let ((data (vector-benchmark size)))
	  (setq avg (+ avg (/ (car data) (cdr data))))))
      (message
       "Average of %d: stack allocation is %f times faster for vectors"
       size (/ avg 1000.0)))))