Re: Some thoughts about Emacs performance

[Robert Boyer <robertstephenboyer@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 7263 bytes --]

Dear Simon,

That's the kindest message I have ever received.  Thank you so very much.
Made my day and my life.

I am hoping, using 'native-compile', about which I have heard great things,
to contribute one function that is the same as 'stable-sort' in Common
Lisp.  It runs, in SBCL, about twice as fast as SBCL's stable-sort.  See
the attached file n3ms.lisp. The really stunning news to me is that my
friend Grant Passmore, running on an M3 machine only yesterday, and taking
advantage of threads in SBCL, saw a 5x performance improvement over SBCL's
stable-sort.  I have not the slightest clue about whether threads are in
Emacs or in its future.

The name of my function is 'msa'. I have attached the file msa.el in its
current state of development. It is far from finished and no one in their
right mind will try to use it!  But great Emacs minds might read it and
tell me things I need to know.

The threads code I added to 'msa' for SBCL is I think an amazing comment
upon what a fantastic job the SBCL folks have done for threads.  My
addition to 'msa' to take advantage of threads is only about a dozen lines
long, and in my extremely unhumble opinion, it is a dozen lines of the
greatest beauty that I have ever seen. May the Lord bless John von Neumann,
wherever he is, for 'merge-sort'.

But I do fear for the worst.  I am 77 and have always worried too much,  I
also attach a file that I just sent to rms, because I cannot yet use m-x
report-emacs-bug, due to some mailer problem.  I run on a $100 Lenovo
Chromebook, and somehow, by magic Emacs 28 just suddenly appeared a few
days ago and it is great, except for 1. some mailer problem with
report-emacs-bug and 2. crucial to my work on msa, the following bug
report, in the attached file compile-bug.el, on native-compile.

I say I fear for the worst because if that bug is what I think it is, it
would kill 'msa' performance.
Very secondarily, even if the bug is fixed, I have no idea how I could ever
take advantage of it!
Emacs 28 appeared by magic on my Chromebook only a few days ago.  I have
always depended upon the kindness of friends and strangers, who have
magically installed Emacs for me.  All I did to install Emacs on my
Chromebook was to run this command:

   sudo apt-get install emacs

Great minds, I guess you guys with Emacs, at Google, and at Debian should
know that is all I know and all I need to know, so far, about installing
Emacs.

Thanks so very, very much for your extremely kind letter,

Bob

P. S.  You mention 'random'.  My bet is that unless you fix the bug that I
mention above, no one could ever do a random via native-compiler that would
be competitive.  Using *declared *fixnum and vectors is crucial to any
speed-competitive work on 'random' that I can imagine.

P. P. S. My home phone is 512 467 0182. Phone me any time.  You or anyone
else doing Emacs development. If you like, since I can call anywhere in the
USA for free, I will hang up and call you right back if you prefer.

P. P. P. S.  You kindly mentioned the ancient 'boyer' benchmark.  One must
know about it that it has a bug, as far as truth rather than performance
testing, is concerned.  Whoever translated that file from Maclisp to Common
Lisp failed to note that 'member' now needs a :test 'equal bit in the call.
Common Lisp defaults the test to 'eql, and that is not what one needs.
Anyway, that code is only for performance testing.  Nqthm and ACL2 are real
theorem-proving programs written in Common Lisp and they are both easy to
obtain for 'free', or for 'gratis', as rms is now saying.  To some I guess,
'free' may sometimes have a bad connotation; not for me, though.  May the
Free Software Foundation forever flourish.  What Harvard has done for us
all: Gates, Zuckerberg, Stallman.

On Fri, Feb 16, 2024 at 8:08 AM Simon Leinen <simon.leinen@gmail.com> wrote:

> Bob,
>
> welcome to the emacs-devel list, and thanks a lot for *your* wonderful
> contributions (theorem prover, string search, and Lisp benchmarking -
> I remember boyer.lisp from RPG's reference work[1]).
>
> On Thu, Feb 8, 2024 at 8:15 AM Robert Boyer
> <robertstephenboyer@gmail.com> wrote:
> >
> > Emacs 27.1 has a 'sort' function that takes longer than stable-sort of
> SBCL. Maybe
> > by a factor of 2. See also my attached file 'ms.lisp'.
> >
> > There may be a lot that can be improved in Emacs'
> > handling of cl-loop, setf, elt, or cl-random.
>
> In this case, cl-random seems to be the main culprit for the slow
> initialization—replacing that with plain "random" speeds it up by
> about a factor of ten.  There was some discussion on the list recently
> about cl-random vs. random. The main functional difference is that
> cl-random supports a defined state. But the performance difference may
> be due more to the fact that random is written in C, and cl-random in
> Lisp.
>
> As for the sorting itself, both Emacs and SBCL seem to use mergesort
> in their implementations of (stable-)sort.  Emacs's implementation is
> written in C, SBCL's in Lisp. Performance is quite similar—on my
> system (Apple Macbook Air M2) Emacs takes about 35% longer to sort a
> million random numbers than SBCL.  (On the other hand when sorting it
> again, i.e. when the vector is already fully sorter, Emacs is quite a
> bit faster than SBCL—maybe Emacs chose to optimize for partly-sorted
> vectors at the expense of a bit of performance for random input.)
>
> In general, the Emacs Lisp runtime system and compiler(s) aren't as
> optimized as SBCL for general Lisp use.  But it gets quite close!
>
> On the other hand, Emacs has editor-specific code (e.g. redisplay) and
> data structures (e.g. buffers) which are highly optimized and partly
> written in C.  But it doesn't try to be a standalone platform for
> performance-oriented Lisp developers.  Of course Emacs is very
> suitable as a Software Development Environment for systems such as
> SBCL, and there are many good integration options—personally I use the
> SLIME package these days.
>
> Best regards, and enjoy Lisping in Emacs!
> --
> Simon.
>
> > ;; First some Emacs, with times on my $100 Chromebook.
> >
> > (setq n 6)
> > (defun make-random-array (n)
> >   (let ((a (make-vector n 0)))
> >     (cl-loop for i below n do
> >              (setf (elt a i) (cl-random 1000000)))
> >     a))
> > (byte-compile 'make-random-array)
> > (benchmark '(setq foo (make-random-array (expt 10 n))) 1) -- 2.3 seconds
> > (benchmark '(sort foo '<) 1) -- 1 second
> >
> > ;; Second some Common Lisp, with times for SBCL on my $100 Chromebook.
> >
> > (defparameter n 6)
> > (defun make-random-array (n)
> >   (declare (fixnum n))
> >   (let ((a (make-array n)))
> >     (declare (type array a))
> >     (loop for i fixnum below n do
> >           (setf (aref a i) (random most-positive-fixnum)))
> >     a))
> > (time (defparameter foo (make-random-array (expt 10 n))))  -- .041
> seconds
> > (time (progn (stable-sort foo '<) nil)) -- .45 seconds
> >
> > Thanks so much for Emacs, which is so great that I cannot put it
> > into words.
> >
> > Bob
>
>
> [1] https://dreamsongs.com/Files/Timrep.pdf
>

[-- Attachment #1.2: Type: text/html, Size: 8575 bytes --]

[-- Attachment #2: msa.el --]
[-- Type: application/octet-stream, Size: 10001 bytes --]

;; with-temp-file

(defvar msa-scratch (make-vector 1 0))

(defvar msa-input (make-vector 1 0))

(defvar msa-type t)

(defvar msa-predicate '<)

(defvar msa-tmp-file "msa-tmp-file.el")

(defvar msa-tmp-buffer "msa-tmp-buffer")

(defvar msa-1-body
  "(defun msa-1 (start end input scratch)
     (declare (fixnum start end) (vector input scratch))
     (let* ((start+1 (1+ start))
            (end-start (- end start))
            (mid (+ start (floor end-start 2))))
       (declare (fixnum start+1 end-start mid))
       (cond
        ((or (eql start end) (eql start+1 end))
         (cl-return-from msa-1 nil))
        ((eql end-start 2)
         (let ((as-start (aref input start))
               (as-start+1 (aref input start+1)))
           (cond ((msa-predicate (key as-start+1) (key as-start))
                  (setf (aref input start) as-start+1)
                  (setf (aref input start+1) as-start)))
           (cl-return-from msa-1 nil)))
        (t
         (let ((k1 (key (aref input start)))
               (k2 (key (aref input (1+ start))))
               (i start)
               (mid-2 (- mid 2)))
           (declare (fixnum i mid-2))
           (cl-loop
            (cond ((eql i mid-2)
                   (msa-1 mid end input scratch)
                   (cl-return nil))
                  ((or (msa-equal k1 k2) (msa-predicate k1 k2))
                   (setq k1 k2)
                   (setq k2 (key (aref input (+ i 2))))
                   (cl-incf i))
                  (t (msa-1 start mid input scratch)
                     (msa-1 mid end input scratch)
                     (cl-return nil))))
           (let ((i0 start) (i1 mid) (end0 mid) (end1 end))
             (declare (fixnum i0 i1 end0 end1))
             (let ((si 0))
               (declare (fixnum si))
               (cl-loop (cond ((= i end-start) (cl-return nil)))
                        (cond ((eql i0 end0)
                               (setf (aref scratch si) (aref input i1))
                               (cl-incf i1))
                              ((eql i1 end1)
                               (setf (aref scratch si) (aref input i0))
                               (cl-incf i0))
                              (t (let* ((x0 (aref input i0))
                                        (x1 (aref input i1))
                                        (k0 (key x0))
                                        (k1 (key x1)))
                                   (cond ((or (msa-equal k0 k1) (msa-predicate k0 k1))
                                          (setf (aref scratch si) x0)
                                          (cl-incf i0))
                                         (t (setf (aref scratch si) x1)
                                            (cl-incf i1))))))))
             (let ((i 0) (j start))
               (declare (fixnum i j))
               (cl-loop (cond ((eql i end-start) (cl-return nil)))
                        (setf (aref input j) (aref scratch i))
                        (cl-incf i)))
             input))))))")

(setq msa-1-body
  "(defun msa-1 (start end input scratch)
     (declare (fixnum start end) (vector input scratch))
     (let* ((start+1 (1+ start))
            (end-start (- end start))
            (mid (+ start (floor end-start 2))))
       (declare (fixnum start+1 end-start mid))
       (cond
        ((or (eql start end) (eql start+1 end))
         (cl-return-from msa-1 nil))
        ((eql end-start 2)
         (let ((as-start (aref input start))
               (as-start+1 (aref input start+1)))
           (cond ((msa-predicate (key as-start+1) (key as-start))
                  (setf (aref input start) as-start+1)
                  (setf (aref input start+1) as-start)))
           (cl-return-from msa-1 nil)))
        (t
         (let ((k1 (key (aref input start)))
               (k2 (key (aref input (1+ start))))
               (i start)
               (mid-2 (- mid 2)))
           (declare (fixnum i mid-2))
           (cl-loop
            (cond ((eql i mid-2)
                   (msa-1 mid end input scratch)
                   (cl-return nil))
                  ((or (msa-equal k1 k2) (msa-predicate k1 k2))
                   (setq k1 k2)
                   (setq k2 (key (aref input (+ i 2))))
                   (cl-incf i))
                  (t (msa-1 start mid input scratch)
                     (msa-1 mid end input scratch)
                     (cl-return nil))))
           (let ((i0 start) (i1 mid) (end0 mid) (end1 end))
             (declare (fixnum i0 i1 end0 end1))
             (let ((si 0))
               (declare (fixnum si))
               (cl-loop (cond ((= i end-start) (cl-return nil)))
                        (cond ((eql i0 end0)
                               (setf (aref scratch si) (aref input i1))
                               (cl-incf i1))
                              ((eql i1 end1)
                               (setf (aref scratch si) (aref input i0))
                               (cl-incf i0))
                              (t (let* ((x0 (aref input i0))
                                        (x1 (aref input i1))
                                        (k0 (key x0))
                                        (k1 (key x1)))
                                   (cond ((or (msa-equal k0 k1) (msa-predicate k0 k1))
                                          (setf (aref scratch si) x0)
                                          (cl-incf i0))
                                         (t (setf (aref scratch si) x1)
                                            (cl-incf i1))))))))
             (let ((i 0) (j start))
               (declare (fixnum i j))
               (cl-loop (cond ((eql i end-start) (cl-return nil)))
                        (setf (aref input j) (aref scratch i))
                        (cl-incf i)))
             input))))))")

(defun msa (ar msa-predicate key)
  (cond ((not (or (null ar) (vectorp ar) (and (consp ar) (null (cdr (last ar))))))
         (error "msa: first argument is not a proper sequence.")))
  (cond ((not (functionp msa-predicate))
         (error "msa: msa-predicate is not a function.")))
  (cond ((null key))
        ((or (not (symbolp key)) (not (functionp key)))
         (error "msa: key must be a symbol.")))
  (cond ((eq key 'identity) (setq key nil)))
  (let ((len (length ar)))
    (declare (fixnum len))
    (cond ((= len 0) nil)
          (t (cond ((<= len (length msa-scratch)))
                   (t (setq msa-scratch (make-vector len 0))))
             (setq msa-input
                   (cond ((consp ar)
                          (let ((ans (make-vector len 0)))
                            (let ((i 0) (l ar))
                              (declare (fixnum i))
                              (while (< i len)
                                (setf (aref ans i) (car l))
                                (setq l (cdr l))
                                (cl-incf i)))
                            ans))
                         (t ar)))
             (let ((msa-all-fixnum t) (msa-all-float t)
                   (msa-all-keys-real t) (orig-ar ar))
               (let ((i 0))
                 (declare (fixnum i))
                 (while (< i len)
                   (let ((x (cond ((null key) (aref msa-input i))
                                  (t (funcall key (aref msa-input i))))))
                     (cond ((and msa-all-keys-real
                                 (not (member (type-of x) '(float integer))))
                            (setq msa-all-keys-real nil)))
                     (cond ((and msa-all-fixnum
                                 (not (fixnump x)))
                            (setq msa-all-fixnum nil)))
                     (cond ((and msa-all-float
                                 (not (floatp x)))
                            (setq msa-all-float nil)))
                     (cl-incf i)))
                 (let ((msa-type (cond (msa-all-fixnum 'fixnum)
                                       (msa-all-float 'float)
                                       (t t))))
                   (switch-to-buffer msa-tmp-buffer)
                   (kill-region (point-min) (point-max))
                   (with-output-to-temp-buffer msa-tmp-buffer
                     (print `(defvar key ',key))
                     (print `(defmacro key (x)
                               (cond ((null key) x)
                                     (t `(,key ,x)))))
                     (print `(defmacro msa-equal (x y)
                               (cond (msa-all-keys-real `(eql ,x ,y))
                                     (t `(equal ,x ,y)))))
                     (print `(defmacro msa-predicate (x y)
                               `(let ((xv ,x) (yv ,y))
                                  (declare (fixnum xv yv))
                                  (,msa-predicate xv yv))))
                     (princ msa-1-body)
                     (write-file msa-tmp-file)
                     ;; (write-file "msa-debug.el")
                     (switch-to-buffer msa-tmp-file)
                     (emacs-lisp-native-compile-and-load)
                     ;; (kill-buffer msa-tmp-file)
                     (eval `(msa-1 0 ,len msa-input msa-scratch))
                     (let ((i 0))
                       (declare (fixnum i))
                       (while (< i len)
                         (setf (aref msa-scratch i) 0)))
                     (cond ((vectorp orig-ar)
                            (let ((i 0))
                              (declare (fixnum i))
                              (setf (aref orig-ar i) (aref msa-input i))))
                           (t (let ((i 0) (tail orig-ar))
                                (declare (fixnum i))
                                (while tail
                                  (setf (car tail) (aref msa-input i))
                                  (cl-incf i)
                                  (setq tail (cdr tail))))))
                     (setq msa-input (make-vector 1 0))
                     ar))))))))

[-- Attachment #3: compile-bug.el --]
[-- Type: application/octet-stream, Size: 1731 bytes --]

;; Let us suppose that this is the file "compile-bug.el"

;; Invoking (native-compile "compile-bug.el") should work, I do believe.
;; However it fails and the error message is printed below.

;; It cannot be emphasized enough how serious this problem seems to me, Bob
;; Boyer, robertstephenboyer@gmail.com.

;; The reason it is so SERIOUS is that ANY Lisp compiler would need to be
;; delighted to see such a typing expression as

;;   (declare (fixnum start end) (vector input scratch))

;; Why? BECAUSE it means that the compiler does not have to lay down code to
;; type check the type of start, end, input, and scratch!!!!

;; However, (byte-compile "compile-bug.el") results in the following error message:

;; Compiling file /mnt/chromeos/GoogleDrive/MyDrive/Linux/working/compile-bug.el at Fri Feb 16 08:25:19 2024
;; compile-bug.el:2:45: Warning: Unknown defun property ‘fixnum’ in foo
;; compile-bug.el:2:45: Warning: Unknown defun property ‘vector’ in foo

(defun foo (start end input scratch)
  (declare (fixnum start end) (vector input scratch))
  (list start end input scratch))

;; foo works fine

;; Here is an example form for the invocation of foo:

;; (foo 1 2 (make-vector 3 4) (make-vector 5 6))

;; That form runs ok if it is running with foo interpreted.

;; (byte-compile 'foo) runs ok.

;; One can run the same form after byte-compiling and it runs ok.

;; However, (native-compile "compile-bug.el") fails with
;; the error report:

;; Compiling file /mnt/chromeos/GoogleDrive/MyDrive/Linux/working/compile-bug.el at Fri Feb 16 08:35:04 2024
;; compile-bug.el:12:45: Warning: Unknown defun property ‘fixnum’ in foo
;; compile-bug.el:12:45: Warning: Unknown defun property ‘vector’ in foo



[-- Attachment #4: n3ms.lisp --]
[-- Type: application/x-lisp, Size: 29191 bytes --]