Some thoughts about Emacs performance

Some thoughts about Emacs performance

[Robert Boyer]

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

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.

;; 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

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

[-- Attachment #2: ms.lisp --]
[-- Type: application/octet-stream, Size: 13979 bytes --]

; -*- coding: utf-8 -*-

;;; ms.lisp was coded by Robert S. Boyer, roberstephenboyer@gmail.com, in
;;; 2024. ms.lisp is public domain. It runs in SBCL.  The main function
;;; in ms.lisp is msa, which is simply good old merge sort.

;;; ms.lisp is
;;; https://drive.google.com/file/d/1OEYqc7wmGjUtj7Hhy_3QmOS23yJ4Izaf/view?usp=sharing

;;; Consider sorting an array of 10 million random rationals and floats.

;;; msa         takes 37.082  real seconds.
;;; stable-sort takes 69.321  real seconds.
;;; sort        takes 110.047 real seconds.

;;; The above three times were obtained using SBCL on my $100 Lenovo Chromebook.

;;; The following three times were obtained on an M3 machine by Grant Passmore.

;;; msa         takes 5.73    seconds.
;;; stable-sort takes 7.241   seconds.
;;; sort        takes 15.811  seconds.

;;; After (load "ms.lisp") one may run this form to confirm my timing results.

#|
(let* ((a (make-random-array-mixed (expt 10 7))) 
       (ac1 (copy-seq a))
       (ac2 (copy-seq a)))
  (gc :full t) 
  (format t "~%Timing msa.") 
  (time (msa a))
  (gc :full t)
  (format t "~%Timing stable-sort.") 
  (time (stable-sort ac1 '<))
  (gc :full t)
  (format t "~%Timing sort.") 
  (time (sort ac2 '<))
  (cond ((or (not (equalp a ac1)) (not (equalp a ac2)))
         (error "failed")))
  t)
|#

;;; I use --dynamic-space-size 32000 in my SBCL startup file.
;;; you can simply invoke
;;;   sbcl --dynamic-space-size 32000
;;; to start sbcl.

;;; (long-test-msa) will run tests of msa vs. stable-sort and sort on mixed,
;;; fixnum, and float random arrays of sizes starting at one million and
;;; going up by a million. I cannot get past 19 million on my Chromebook due
;;; to space problems.

;;; On arrays of mixed rationals and floats, msa does seem generally a good
;;; bit faster. On arrays that are all fixnums, msa is roughly as good as
;;; stable-sort. On arrays that are all floats, msa is about 25% worse than
;;; stable-sort, and I have no idea why.

(in-package "COMMON-LISP-USER")

(declaim (optimize (safety 0) (speed 3) (debug 0)))

(defun print-date-and-time ()
  (multiple-value-bind
   (second minute hour day month year day-of-week dst-p tz)
   (get-decoded-time)
   (declare (ignore dst-p tz))
   (format *standard-output*
           "~2,'0d:~2,'0d:~2,'0d, ~a, ~d/~2,'0d/~d~%"
           hour minute second
           (nth day-of-week '("Monday" "Tuesday" "Wednesday" "Thursday"
                              "Friday" "Saturday" "Sunday"))
           month day year)))

;;; We turn on reporting of garbage collection. The header asks Emacs to
;;; enter auto-revert-tail mode.

(let ((stream (open "gc-logfile.txt" :direction :output
                    :if-exists :supersede
                    :if-does-not-exist :create)))
  ;; (setf (gc-logfile) nil) turns gc reporting off.
  (format stream "-*- Mode: auto-revert-tail -*-~%")
  (let ((*standard-output* stream))
    (terpri)
    (print-date-and-time)
    (terpri))
  (close stream)
  (setf (gc-logfile) "gc-logfile.txt")
  (gc :full t))

(defparameter msa-input (make-array 1))

(defparameter msa-scratch (make-array 1))

(declaim (type simple-vector msa-input msa-scratch))

(deftype rational-or-float () '(or rational float))

(defmacro my-< (x y)
  (let ((gx (gensym)) (gy (gensym)))
    `(let ((,gx ,x) (,gy ,y))
       (cond ((and (typep ,gx 'fixnum) (typep ,gy 'fixnum))
              (< (the fixnum ,gx) (the fixnum ,gy)))
             ((and (typep ,gx 'float) (typep ,gy 'float))
              (< (the float ,gx) (the float ,gy)))
             (t (< ,gx ,gy))))))

(defun msa-1 (start end)
  (declare (fixnum start end))
  (let ((start+1 (the fixnum (1+ start)))
        (end-start (the fixnum (- end start))))
    (declare (fixnum start+1 end-start))
    (cond ((or (= start end) (= start+1 end)))
          ((= end-start 2)
           (let ((as-start (svref msa-input start))
                 (as-start+1 (svref msa-input start+1)))
             (declare (rational-or-float as-start as-start+1))
             (cond ((my-< as-start+1 as-start)
                    (setf (svref msa-input start) as-start+1)
                    (setf (svref msa-input start+1) as-start)))))
          (t (let ((mid (the fixnum (+ start (the fixnum (floor end-start 2))))))
               (declare (fixnum mid))
               (cond ((= start+1 mid))
                     (t (msa-1 start mid)))
               (msa-1 mid end)
               (let ((i0 start) (i1 mid) (end0 mid) (end1 end))
                 (declare (fixnum i0 i1 end0 end1))
                 (loop for si fixnum below end-start do
                       (cond ((= i0 end0)
                              (setf (svref msa-scratch si) (svref msa-input i1))
                              (incf i1))
                             ((= i1 end1)
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             ((my-< (the rational-or-float (svref msa-input i0))
                                    (the rational-or-float (svref msa-input i1)))
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             (t (setf (svref msa-scratch si) (svref msa-input i1))
                                (incf i1)))))
               (loop for i fixnum below end-start as j fixnum from start do
                     (setf (svref msa-input j) (svref msa-scratch i))))))
    nil))

(defun msa-1-fixnum (start end)
  (declare (fixnum start end))
  (let ((start+1 (the fixnum (1+ start)))
        (end-start (the fixnum (- end start))))
    (declare (fixnum start+1 end-start))
    (cond ((or (= start end) (= start+1 end)))
          ((= end-start 2)
           (let ((as-start (svref msa-input start))
                 (as-start+1 (svref msa-input start+1)))
             (declare (fixnum as-start as-start+1))
             (cond ((< as-start+1 as-start)
                    (setf (svref msa-input start) as-start+1)
                    (setf (svref msa-input start+1) as-start)))))
          (t (let ((mid (the fixnum (+ start (the fixnum (floor end-start 2))))))
               (declare (fixnum mid))
               (cond ((= start+1 mid))
                     (t (msa-1-fixnum start mid)))
               (msa-1-fixnum mid end)
               (let ((i0 start) (i1 mid) (end0 mid) (end1 end))
                 (declare (fixnum i0 i1 end0 end1))
                 (loop for si fixnum below end-start do
                       (cond ((= i0 end0)
                              (setf (svref msa-scratch si) (svref msa-input i1))
                              (incf i1))
                             ((= i1 end1)
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             ((< (the fixnum (svref msa-input i0))
                                 (the fixnum (svref msa-input i1)))
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             (t (setf (svref msa-scratch si) (svref msa-input i1))
                                (incf i1)))))
               (loop for i fixnum below end-start as j fixnum from start do
                     (setf (svref msa-input j) (svref msa-scratch i))))))
    nil))

(defun msa-1-float (start end)
  (declare (fixnum start end))
  (let ((start+1 (the fixnum (1+ start)))
        (end-start (the fixnum (- end start))))
    (declare (fixnum start+1 end-start))
    (cond ((or (= start end) (= start+1 end)))
          ((= end-start 2)
           (let ((as-start (svref msa-input start))
                 (as-start+1 (svref msa-input start+1)))
             (declare (float as-start as-start+1))
             (cond ((< as-start+1 as-start)
                    (setf (svref msa-input start) as-start+1)
                    (setf (svref msa-input start+1) as-start)))))
          (t (let ((mid (the fixnum (+ start (the fixnum (floor end-start 2))))))
               (declare (fixnum mid))
               (cond ((= start+1 mid))
                     (t (msa-1-float start mid)))
               (msa-1-float mid end)
               (let ((i0 start) (i1 mid) (end0 mid) (end1 end))
                 (declare (fixnum i0 i1 end0 end1))
                 (loop for si fixnum below end-start do
                       (cond ((= i0 end0)
                              (setf (svref msa-scratch si) (svref msa-input i1))
                              (incf i1))
                             ((= i1 end1)
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             ((< (the float (svref msa-input i0))
                                 (the float (svref msa-input i1)))
                              (setf (svref msa-scratch si) (svref msa-input i0))
                              (incf i0))
                             (t (setf (svref msa-scratch si) (svref msa-input i1))
                                (incf i1)))))
               (loop for i fixnum below end-start as j fixnum from start do
                     (setf (svref msa-input j) (svref msa-scratch i))))))
    nil))

(defun msa (ar)
  "(msa ar) takes a one dimensional array ar of rationals or floats,
   sorts ar by <, and returns ar. msa creates a scratch array the length of
   ar. If ar is not a simple-vector, then ar also creates another array the
   length of ar."
  (cond ((not (typep ar '(array t (*))))
         (error "msa input not an array of one dimension")))
  (let ((len (length ar)) (ar ar) (all-fixnum t) (all-float t))
    (declare (fixnum len) (type simple-vector ar))
    (loop for i fixnum below len do
          (let ((x (aref ar i)))
            (cond ((not (typep x 'rational-or-float))
                   (error "ar takes an array of rationals or floats."))
                  ((not (typep x 'fixnum)) (setq all-fixnum nil))
                  ((not (typep x 'float)) (setq all-float nil)))))
    (cond ((typep ar 'simple-vector)
           (setq msa-input ar))
          (t (setq msa-input (copy-seq msa-input))))
    (setq msa-scratch (make-array len))
    (cond (all-fixnum
           ;; (format t "~%msa-1-fixnum.")
           (msa-1-fixnum 0 len))
          (all-float
           ;; (format t "~%msa-1-float.")
           (msa-1-float 0 len))
          (t (msa-1 0 len)))
    (cond ((typep ar 'simple-vector))
          (t (loop for i below len do
                   (setf (aref ar i) (svref msa-input i)))))
    (setq msa-input (make-array 1))
    (setq msa-scratch (make-array 1))
    ;; (gc :full t)
    ar))

;;; The remainder of this file concerns testing.

(defparameter test-msa-ar1 (make-array 1))

(defparameter test-msa-ar2 (make-array 1))

(defun make-random-array-fixed (n)
  (declare (fixnum n))
  (let ((a (make-array n)))
    (declare (type (array t (*)) a))
    (loop for i fixnum below n do
          (setf (aref a i) (random most-positive-fixnum)))
    a))

(defun make-random-array-float (n)
  (declare (fixnum n))
  (let ((a (make-array n)))
    (declare (type (array t (*)) a))
    (loop for i fixnum below n do
          (setf (aref a i) (float (random most-positive-fixnum))))
    a))

(defun random-mixed ()
  (let* ((c (random 3))
         (x (* 2 most-positive-fixnum))
         (n (random x))
         (d (random x)))
    (cond ((= d 0) (setq d 1)))
    (cond ((= c 0) n)
          ((= c 1) (/ n d))
          ((= c 2) (float (/ n d))))))

(defun make-random-array-mixed (n)
  (declare (fixnum n))
  (let ((a (make-array n)))
    (declare (type (array t (*)) a))
    (loop for i fixnum below n do
          (setf (aref a i) (random-mixed)))
    a))

(defun test-msa-mixed (n)
  "(test-msa n) creates an array ar1 of n random rationals and floats,
   creates a copy ar2 of ar1, calls (msa ar1), calls (stable-sort ar2 '<),
   and returns (equalp ar1 ar2)."
  (declare (fixnum n))
  (format t "~%running (test-msa-mixed ~:d)." n)
  (setq test-msa-ar1 (make-random-array-mixed n))
  (setq test-msa-ar2 (copy-seq test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (msa test-msa-ar1).")
  (time (msa test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (stable-sort test-msa-ar2 '<).")
  (time (stable-sort test-msa-ar2 '<))
  (equalp test-msa-ar1 test-msa-ar2))

(defun test-msa-fixed (n)
  "(test-msa n) creates an array ar1 of n random fixnums,
   creates a copy ar2 of ar1, calls (msa ar1), calls (stable-sort ar2 '<),
   and returns (equalp ar1 ar2)."
  (declare (fixnum n))
  (format t "~%running (test-msa-fixed ~:d)." n)
  (setq test-msa-ar1 (make-random-array-fixed n))
  (setq test-msa-ar2 (copy-seq test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (msa test-msa-ar1).")
  (time (msa test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (stable-sort test-msa-ar2 '<).")
  (time (stable-sort test-msa-ar2 '<))
  (equalp test-msa-ar1 test-msa-ar2))

(defun test-msa-float (n)
  "(test-msa n) creates an array ar1 of n random floats, creates a copy ar2
   of ar1, calls (msa ar1), calls (stable-sort ar2 '<), and returns (equalp
   ar1 ar2)."
  (declare (fixnum n))
  (format t "~%running (test-msa-float ~:d)." n)
  (setq test-msa-ar1 (make-random-array-float n))
  (setq test-msa-ar2 (copy-seq test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (msa test-msa-ar1).")
  (time (msa test-msa-ar1))
  (gc :full t)
  (format t "~%Timing of (stable-sort test-msa-ar2 '<).")
  (time (stable-sort test-msa-ar2 '<))
  (equalp test-msa-ar1 test-msa-ar2))

(defun long-test-msa ()
  (loop for i from 1 do 
        (let ((n (* i (expt 10 6))))
          (cond ((not (test-msa-mixed n))
                 (error "long-test failed mixed at ~:d." n)))
          (cond ((not (test-msa-fixed n))
                 (error "long-test failed fixed at ~:d." n)))
          (cond ((not (test-msa-float n))
                 (error "long-test failed float at ~:d." n))))))

Re: Some thoughts about Emacs performance

[Ihor Radchenko]

Robert Boyer <robertstephenboyer@gmail.com> writes:

> 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.

When comparing Elisp and SBCL, it is more fair to compare
native-compiler Elisp rather than byte-compiled.
Then, both codes are compiled to machine code.

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: Some thoughts about Emacs performance

[Simon Leinen]

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

Re: Some thoughts about Emacs performance

[Robert Boyer]

[-- 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 --]

Re: Some thoughts about Emacs performance

[Ihor Radchenko]

Robert Boyer <robertstephenboyer@gmail.com> writes:

> 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!

As Andrea mentioned in
https://yhetil.org/emacs-devel/yp1cyssanrp.fsf@fencepost.gnu.org/, type
declarations are not yet supported and it is not yet clear how long it
will take to implement type declaration support.

If you wish to contribute a better sorting to Emacs, another option
might be contributing to Emacs C sources. Check out src/sort.c file
(tim_sort) for the sort implementation that is currently in use.
https://git.savannah.gnu.org/cgit/emacs.git/tree/src/sort.c#n915

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>

Re: Some thoughts about Emacs performance

[Robert Boyer]

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

> Another option might be contributing to Emacs C sources.

Surely you're joking, Mr. Feynman.  1.  sort in Emacs is, I do believe,
written in C and seems ok, but could be improved. 2. You probably cannot
imagine, in this day, how totally ignorant I am of C!  It is unforgivable.

> it is not yet clear how long it will take to implement type declaration
support.

My bet is that it will be a long time coming, from the vibes I get.  But
what do I know?

Bob


On Mon, Feb 19, 2024 at 6:25 AM Ihor Radchenko <yantar92@posteo.net> wrote:

> Robert Boyer <robertstephenboyer@gmail.com> writes:
>
> > 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!
>
> As Andrea mentioned in
> https://yhetil.org/emacs-devel/yp1cyssanrp.fsf@fencepost.gnu.org/, type
> declarations are not yet supported and it is not yet clear how long it
> will take to implement type declaration support.
>
> If you wish to contribute a better sorting to Emacs, another option
> might be contributing to Emacs C sources. Check out src/sort.c file
> (tim_sort) for the sort implementation that is currently in use.
> https://git.savannah.gnu.org/cgit/emacs.git/tree/src/sort.c#n915
>
> --
> Ihor Radchenko // yantar92,
> Org mode contributor,
> Learn more about Org mode at <https://orgmode.org/>.
> Support Org development at <https://liberapay.com/org-mode>,
> or support my work at <https://liberapay.com/yantar92>
>


-- 
Anything I seem to state should be taken as a question.  I am at least 77
and feeble.

[-- Attachment #2: Type: text/html, Size: 2830 bytes --]

Re: Some thoughts about Emacs performance

[Robert Boyer]

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

Dear Simon,
You note:

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.

You are so right.  'msa' kills 'stable sort' on a few examples, namely an
array
that is all 0's and an array that is 1, 2, 3, ...

Below  is some info on sorting arrays that are 21 million long.

But I should mention that I regard what my 'msa' does to catch the easy
cases may be nothing in comparison to what sorting pros can do.

Best,

Bob

Running (test-msa-0 21,000,000).
Timing (MSA TEST-MSA-AR1 '< :KEY 'CAR).
WARNING: redefining COMMON-LISP-USER::KEY in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-EQUAL in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-PREDICATE in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-1 in DEFUN
Evaluation took:
  3.334 seconds of real time
  3.267129 seconds of total run time (2.323391 user, 0.943738 system)
  [ Run times consist of 0.154 seconds GC time, and 3.114 seconds non-GC
time. ]
  97.99% CPU
  31 forms interpreted
  115 lambdas converted
  5,990,145,243 processor cycles
  174,860,640 bytes consed


Timing (STABLE-SORT TEST-MSA-AR2 '< :KEY 'CAR).
Evaluation took:
  12.729 seconds of real time
  12.562949 seconds of total run time (11.935063 user, 0.627886 system)
  [ Run times consist of 0.232 seconds GC time, and 12.331 seconds non-GC
time. ]
  98.70% CPU
  22,870,125,432 processor cycles
  168,006,352 bytes consed


Running (test-msa-ascending 21,000,000).
Timing (MSA TEST-MSA-AR1 '< :KEY 'CAR).
WARNING: redefining COMMON-LISP-USER::KEY in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-EQUAL in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-PREDICATE in DEFMACRO
WARNING: redefining COMMON-LISP-USER::MSA-1 in DEFUN
Evaluation took:
  2.525 seconds of real time
  2.514507 seconds of total run time (2.471494 user, 0.043013 system)
  99.60% CPU
  31 forms interpreted
  115 lambdas converted
  4,536,551,428 processor cycles
  6,823,488 bytes consed


Timing (STABLE-SORT TEST-MSA-AR2 '< :KEY 'CAR).
Evaluation took:
  12.914 seconds of real time
  12.823063 seconds of total run time (12.407732 user, 0.415331 system)
  [ Run times consist of 0.227 seconds GC time, and 12.597 seconds non-GC
time. ]
  99.30% CPU
  23,203,467,086 processor cycles
  168,006,128 bytes consed




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 #2: Type: text/html, Size: 7180 bytes --]

Re: Some thoughts about Emacs performance

[Robert Boyer]

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

Dear Simon,

You mention 'random'. Below is 'random' in SBCL. I am clueless about how
good it is.

It takes people like Knuth to do this sort of thing well. Way over my head,
even though I have a Ph. D. in math.

I once heard the following random assertion: NSA, rms's favorite
organization I am sure, was at the time the largest employer of
mathematicians in the USA.

Did you know that the British spooks invented RSA before RSA did? Of course
those fucking spooks didn't tell the public. Criminal.

I wonder if Churchill had Turing, among others, in mind when he said: Never
in the field of human conflict was so much owed by so many to so few.

'Shit' is all I have to say about security, despite the large part of my
past
salary that might have been federally spook funded! Unlike rms, I like to
get
paid. At NSA's insistence, I got kicked off the board of my company
Computational Logic when I refused to get a security clearance.
Eventually, when funding dried up, the company folded.

Thank God for RSA. I can remember at a party for the MIT AI Lab, when
funding
did not look too hot, Moses said that 'security' might be a way to go to
look
for funding. It may be nice for him that our president gets $2,000,000,000
a year for the White House, in part to make it secure, but if anyone claims
to know
anything about security, I say, how come the news is constantly filled with
horror stories about hackers breaking in.

I once heard that Minsky, bless his soul, refused to let his students spend
time worrying about security on his DEC PDP-10 because it would only lead to
other students wasting time figuring out how to crack the system. But
'random' is one of the coolest ideas in the world. Where would we ever be
without hash tables! I am so glad that 'sxhash' is in Emacs Lisp and Common
Lisp!

I send far too much email. Is there a group Email Addicts Anonymous?

I am 77. I cannot pick up a coin on the floor. I am not to be trusted about
anything I say.

With highest regards,

Bob

I recommend to Emacs folks working on 'native-compiler' that they look at
the
18 uses of "declare" in the following! You want efficiency in Lisp, you use
"declare".

------------------------------------------------------------------------------

;;;; This software is part of the SBCL system. See the README file for
;;;; more information.
;;;;
;;;; This software is derived from the CMU CL system, which was
;;;; written at Carnegie Mellon University and released into the
;;;; public domain. The software is in the public domain and is
;;;; provided with absolutely no warranty. See the COPYING and CREDITS
;;;; files for more information.

(in-package "SB-KERNEL")

;;;; Constants
(defconstant mt19937-n 624)
(defconstant mt19937-m 397)
(defconstant mt19937-upper-mask #x80000000)
(defconstant mt19937-lower-mask #x7FFFFFFF)
(defconstant mt19937-a #x9908B0DF)
(defconstant mt19937-b #x9D2C5680)
(defconstant mt19937-c #xEFC60000)

;;;; RANDOM-STATEs

;;; The state is stored in a (simple-array (unsigned-byte 32) (627))
;;; wrapped in a random-state structure:
;;;
;;; 0-1:  Constant matrix A. [0, #x9908b0df]
;;; 2:   Index k.
;;; 3-626: State.

(deftype random-state-state () `(simple-array (unsigned-byte 32) (,(+ 3
mt19937-n))))

(defmethod make-load-form ((random-state random-state) &optional
environment)
 (make-load-form-saving-slots random-state :environment environment))

(defmethod print-object ((state random-state) stream)
 (if (and *print-readably* (not *read-eval*))
   (print-not-readable-error state stream)
   (format stream "#S(~S ~S #.~S)"
       'random-state
       ':state
       `(make-array ,(+ 3 mt19937-n)
        :element-type
        '(unsigned-byte 32)
        :initial-contents
        ',(coerce (random-state-state state) 'list)))))

;;; Generate and initialize a new random-state array. Index is
;;; initialized to 1 and the states to 32bit integers excluding zero.
;;;
;;; Seed - A 32bit number.
;;;
;;; See Knuth TAOCP Vol2. 3rd Ed. P.106 for multiplier.
;;; In the previous versions, MSBs of the seed affect only MSBs of the
array.
(defun init-random-state (&optional (seed 5489) state)
 (declare (type (unsigned-byte 32) seed))
 (let ((state (or state (make-array 627 :element-type '(unsigned-byte
32)))))
  (check-type state random-state-state)
  (setf (aref state 0) 0)
  (setf (aref state 1) mt19937-a)
  (setf (aref state 2) mt19937-n)
  (loop for i below mt19937-n
   for p from 3
   for s = seed then
   (logand #xFFFFFFFF
       (+ (* 1812433253
          (logxor s (ash s -30)))
        i))
   do (setf (aref state p) s))
  state))

(defvar *random-state*)
(defun !random-cold-init ()
 (/show0 "entering !RANDOM-COLD-INIT")
 (setf *random-state* (%make-random-state (init-random-state)))
 (/show0 "returning from !RANDOM-COLD-INIT"))

;;; Q: Why is there both MAKE-RANDOM-STATE and SEED-RANDOM-STATE?
;;; A: Because the DEFKNOWN for MAKE-RANDOM-STATE is more restricted
;;;  and doesn't accept numerical state.
(defun make-random-state (&optional state)
 "Make a random state object. The optional STATE argument specifies a seed
for deterministic pseudo-random number generation.

As per the Common Lisp standard,
- If STATE is NIL or not supplied, return a copy of the default
 *RANDOM-STATE*.
- If STATE is a random state, return a copy of it.
- If STATE is T, return a randomly initialized state (using operating-system
 provided randomness where available, otherwise a poor substitute based on
 internal time and PID).

See SB-EXT:SEED-RANDOM-STATE for a SBCL extension to this functionality."
 (/show0 "entering MAKE-RANDOM-STATE")
 (seed-random-state state))

(defun fallback-random-seed ()
 ;; When /dev/urandom is not available, we make do with time and pid
 ;; Thread ID and/or address of a CONS cell would be even better, but...
 ;; [ADDRESS-BASED-COUNTER-VAL in 'target-sxhash' could be used here]
 (/show0 "No /dev/urandom, using randomness from time and pid")
 (+ (get-internal-real-time)
  (ash (sb-unix:unix-getpid) 32)))

#-win32
(defun os-random-seed ()
 (or
 ;; On unices, we try to read from /dev/urandom and pass the results
 ;; to our (simple-array (unsigned-byte 32) (*)) processor below.
 ;; More than 256 bits would provide a false sense of security.
 ;; If you need more bits than that, you probably also need
 ;; a better algorithm too.
 (ignore-errors
  (with-open-file (r "/dev/urandom" :element-type '(unsigned-byte 32)
                   :direction :input :if-does-not-exist :error)
   (let ((a (make-array '(8) :element-type '(unsigned-byte 32))))
    (aver (= 8 (read-sequence a r)))
    a)))
 (fallback-random-seed)))

#+win32
(defun os-random-seed ()
 (/show0 "Getting randomness from CryptGenRandom")
 (or (sb-win32:crypt-gen-random 32)
   (fallback-random-seed)))

(defun seed-random-state (&optional state)
 "Make a random state object. The optional STATE argument specifies a seed
for deterministic pseudo-random number generation.

As per the Common Lisp standard for MAKE-RANDOM-STATE,
- If STATE is NIL or not supplied, return a copy of the default
 *RANDOM-STATE*.
- If STATE is a random state, return a copy of it.
- If STATE is T, return a randomly initialized state (using operating-system
 provided randomness where available, otherwise a poor substitute based on
 internal time and pid).

As a supported SBCL extension, we also support receiving as a seed an object
of the following types:
- (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*))
- UNSIGNED-BYTE
While we support arguments of any size and will mix the provided bits into
the random state, it is probably overkill to provide more than 256 bits
worth
of actual information.

This particular SBCL version also accepts an argument of the following type:
(SIMPLE-ARRAY (UNSIGNED-BYTE 32) (*))

This particular SBCL version uses the popular MT19937 PRNG algorithm, and
its
internal state only effectively contains about 19937 bits of information.
http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html
"
 (declare (explicit-check))
 (named-let seed-random-state ((state state))
 (etypecase state
  ;; Easy standard cases
  (null
  (/show0 "copying *RANDOM-STATE*")
  (%make-random-state (copy-seq (random-state-state *random-state*))))
  (random-state
  (/show0 "copying the provided RANDOM-STATE")
  (%make-random-state (copy-seq (random-state-state state))))
  ;; Standard case, less easy: try to randomly initialize a state.
  ((eql t)
  (/show0 "getting randomness from the operating system")
  (seed-random-state (os-random-seed)))
  ;; For convenience to users, we accept (simple-array (unsigned-byte 8)
(*))
  ;; We just convert it to (simple-array (unsigned-byte 32) (*)) in a
  ;; completely straightforward way.
  ;; TODO: probably similarly accept other word sizes.
  ((simple-array (unsigned-byte 8) (*))
  (/show0 "getting random seed from byte vector (converting to 32-bit-word
vector)")
  (let* ((l (length state))
      (m (ceiling l 4))
      (r (if (>= l 2496) 0 (mod l 4)))
      (y (make-array (list m) :element-type '(unsigned-byte 32))))
      (loop for i from 0 below (- m (if (zerop r) 0 1))
       for j = (* i 4) do
       (setf (aref y i)
          (+ (aref state j)
            (ash (aref state (+ j 1)) 8)
            (ash (aref state (+ j 2)) 16)
            (ash (aref state (+ j 3)) 24))))
      (unless (zerop r) ;; The last word may require special treatment.
       (let* ((p (1- m)) (q (* 4 p)))
        (setf (aref y p)
          (+ (aref state q)
            (if (< 1 r) (ash (aref state (+ q 1)) 8) 0)
            (if (= 3 r) (ash (aref state (+ q 2)) 16) 0)))))
      (seed-random-state y)))
  ;; Also for convenience, we accept non-negative integers as seeds.
  ;; Small ones get passed to init-random-state, as before.
  ((unsigned-byte 32)
  (/show0 "getting random seed from 32-bit word")
  (%make-random-state (init-random-state state)))
  ;; Larger ones ones get trivially chopped into an array of (unsigned-byte
32)
  ((unsigned-byte)
  (/show0 "getting random seed from bignum (converting to 32-bit-word
vector)")
  (loop with l = (ceiling (integer-length state) 32)
   with s = (make-array (list l) :element-type '(unsigned-byte 32))
   for i below l
   for p from 0 by 32
   do (setf (aref s i) (ldb (byte 32 p) state))
   finally (return (seed-random-state s))))
  ;; Last but not least, when provided an array of 32-bit words, we truncate
  ;; it to 19968 bits and mix these into an initial state. We reuse the same
  ;; method as the authors of the original algorithm. See
  ;;
http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt19937ar.c
  ;; NB: their mt[i] is our (aref s (+ 3 i))
  ((simple-array (unsigned-byte 32) (*))
  (/show0 "getting random seed from 32-bit-word vector")
  (let ((s (init-random-state 19650218))
     (i 1) (j 0) (l (length state)))
   (loop for k downfrom (max mt19937-n l) above 0 do
    (setf (aref s (+ i 3))
       (logand #xFFFFFFFF
           (+ (logxor (aref s (+ i 3))
                 (* 1664525
                  (logxor (aref s (+ i 2))
                      (ash (aref s (+ i 2)) -30))))
             (aref state j) j))) ;; non-linear
    (incf i) (when (>= i mt19937-n) (setf (aref s 3) (aref s (+ 2
mt19937-n)) i 1))
    (incf j) (when (>= j l) (setf j 0)))
   (loop for k downfrom (1- mt19937-n) above 0 do
    (setf (aref s (+ i 3))
       (logand #xFFFFFFFF
           (- (logxor (aref s (+ i 3))
                 (* 1566083941
                  (logxor (aref s (+ i 2))
                      (ash (aref s (+ i 2)) -30))))
             i))) ;; non-linear
    (incf i) (when (>= i mt19937-n) (setf (aref s 3) (aref s (+ 2
mt19937-n)) i 1)))
   (setf (aref s 3) #x80000000) ;; MSB is 1; assuring non-zero initial array
   (%make-random-state s))))))

;;;; random entries

;;; This function generates a 32bit integer between 0 and #xffffffff
;;; inclusive.

;;; portable implementation
#-x86
(defun random-mt19937-update (state)
 (declare (type random-state-state state)
     (optimize (speed 3) (safety 0)))
 (let ((y 0))
  (declare (type (unsigned-byte 32) y))
  (do ((kk 3 (1+ kk)))
    ((>= kk (+ 3 (- mt19937-n mt19937-m))))
   (declare (type (mod 628) kk))
   (setf y (logior (logand (aref state kk) mt19937-upper-mask)
           (logand (aref state (1+ kk)) mt19937-lower-mask)))
   (setf (aref state kk) (logxor (aref state (+ kk mt19937-m))
                  (ash y -1) (aref state (logand y 1)))))
  (do ((kk (+ (- mt19937-n mt19937-m) 3) (1+ kk)))
    ((>= kk (+ (1- mt19937-n) 3)))
   (declare (type (mod 628) kk))
   (setf y (logior (logand (aref state kk) mt19937-upper-mask)
           (logand (aref state (1+ kk)) mt19937-lower-mask)))
   (setf (aref state kk) (logxor (aref state (+ kk (- mt19937-m mt19937-n)))
                  (ash y -1) (aref state (logand y 1)))))
  (setf y (logior (logand (aref state (+ 3 (1- mt19937-n)))
              mt19937-upper-mask)
          (logand (aref state 3) mt19937-lower-mask)))
  (setf (aref state (+ 3 (1- mt19937-n)))
     (logxor (aref state (+ 3 (1- mt19937-m)))
         (ash y -1) (aref state (logand y 1)))))
 (values))

(declaim (start-block random %random-single-float %random-double-float
           random-chunk big-random-chunk))

(declaim (inline random-chunk))
#-x86
(defun random-chunk (state)
 (declare (type random-state state))
 (let* ((state (random-state-state state))
    (k (aref state 2)))
  (declare (type (mod 628) k))
  (when (= k mt19937-n)
   (random-mt19937-update state)
   (setf k 0))
  (setf (aref state 2) (1+ k))
  (let ((y (aref state (+ 3 k))))
   (declare (type (unsigned-byte 32) y))
   (setf y (logxor y (ash y -11)))
   (setf y (logxor y (ash (logand y (ash mt19937-b -7)) 7)))
   (setf y (logxor y (ash (logand y (ash mt19937-c -15)) 15)))
   (setf y (logxor y (ash y -18)))
   y)))

;;; Using inline VOP support, only available on the x86 so far.
;;;
;;; FIXME: It would be nice to have some benchmark numbers on this.
;;; My inclination is to get rid of the nonportable implementation
;;; unless the performance difference is just enormous.
#+x86
(defun random-chunk (state)
 (declare (type random-state state))
 (sb-vm::random-mt19937 (random-state-state state)))

(declaim (inline big-random-chunk))
(defun big-random-chunk (state)
 (declare (type random-state state))
 (logior (ash (random-chunk state) 32)
     (random-chunk state)))

;;; Handle the single or double float case of RANDOM. We generate a
;;; float between 0.0 and 1.0 by clobbering the significand of 1.0
;;; with random bits, then subtracting 1.0. This hides the fact that
;;; we have a hidden bit.
(declaim (inline %random-single-float %random-double-float))
(declaim (ftype (function ((single-float ($0f0)) random-state)
             (single-float $0f0))
        %random-single-float))
(defun %random-single-float (arg state)
 (declare (type (single-float ($0f0)) arg)
     (type random-state state))
 (loop for candidate of-type single-float
    = (* arg
      (- (make-single-float
        (dpb (ash (random-chunk state)
             (- sb-vm:single-float-digits n-random-chunk-bits))
           sb-vm:single-float-significand-byte
           (single-float-bits $1.0)))
        $1.0))
    while (#+x86 eql ;; Can't use = due to 80-bit precision
       #-x86 =
       candidate arg)
    finally (return candidate)))
(declaim (ftype (function ((double-float ($0d0)) random-state)
             (double-float $0d0))
        %random-double-float))

;;; 32-bit version
#+nil
(defun %random-double-float (arg state)
 (declare (type (double-float ($0d0)) arg)
     (type random-state state))
 (* (float (random-chunk state) $1d0) (/ $1d0 (expt 2 32))))

;;; 53-bit version
#-x86
(defun %random-double-float (arg state)
 (declare (type (double-float ($0d0)) arg)
     (type random-state state))
 (loop for candidate of-type double-float
    = (* arg
      (- (sb-impl::make-double-float
        (dpb (ash (random-chunk state)
             (- sb-vm:double-float-digits n-random-chunk-bits 32))
           sb-vm:double-float-significand-byte
           (sb-impl::double-float-high-bits $1d0))
        (random-chunk state))
        $1d0))
    while (= candidate arg)
    finally (return candidate)))

;;; using a faster inline VOP
#+x86
(defun %random-double-float (arg state)
 (declare (type (double-float ($0d0)) arg)
     (type random-state state))
 (let ((state-vector (random-state-state state)))
  (loop for candidate of-type double-float
     = (* arg
       (- (sb-impl::make-double-float
         (dpb (ash (sb-vm::random-mt19937 state-vector)
              (- sb-vm:double-float-digits n-random-chunk-bits
                sb-vm:n-word-bits))
            sb-vm:double-float-significand-byte
            (sb-impl::double-float-high-bits $1d0))
         (sb-vm::random-mt19937 state-vector))
         $1d0))
     ;; Can't use = due to 80-bit precision
     while (eql candidate arg)
     finally (return candidate))))

;;;; random fixnums

;;; Generate and return a pseudo random fixnum less than ARG. To achieve
;;; equidistribution an accept-reject loop is used.
;;; No extra effort is made to detect the case of ARG being a power of
;;; two where rejection is not possible, as the cost of checking for
;;; this case is the same as doing the rejection test. When ARG is
;;; larger than (expt 2 N-RANDOM-CHUNK-BITS), which can only happen if
;;; the random chunk size is half the word size, two random chunks are
;;; used in each loop iteration, otherwise only one. Finally, the
;;; rejection probability could often be reduced by not masking the
;;; chunk but rejecting only values as least as large as the largest
;;; multiple of ARG that fits in a chunk (or two), but this is not done
;;; as the speed gains due to needing fewer loop iterations are by far
;;; outweighted by the cost of the two divisions required (one to find
;;; the multiplier and one to bring the result into the correct range).
(declaim (inline %random-fixnum))
(defun %random-fixnum (arg state)
 (declare (type (integer 1 #.most-positive-fixnum) arg)
     (type random-state state))
 (if (= arg 1)
   0
   (let* ((n-bits (integer-length (1- arg)))
      (mask (1- (ash 1 n-bits))))
    (macrolet ((accept-reject-loop (generator)
          `(loop
            (let ((bits (logand mask (,generator state))))
             (when (< bits arg)
              (return bits))))))
     (aver (<= n-bits (* 2 n-random-chunk-bits)))
     (if (<= n-bits n-random-chunk-bits)
       (accept-reject-loop random-chunk)
       (accept-reject-loop big-random-chunk))))))

(defun random (arg &optional (state *random-state*))
 (declare (inline %random-fixnum
         %random-single-float %random-double-float
         #+long-float %random-long-float))
 (declare (explicit-check))
 (cond
  ((and (fixnump arg) (> arg 0))
  (%random-fixnum arg state))
  ((and (typep arg 'single-float) (> arg $0.0f0))
  (%random-single-float arg state))
  ((and (typep arg 'double-float) (> arg $0.0d0))
  (%random-double-float arg state))
  #+long-float
  ((and (typep arg 'long-float) (> arg $0.0l0))
  (%random-long-float arg state))
  ((and (bignump arg) (> arg 0))
  (%random-bignum arg state))
  (t
  (error 'simple-type-error
      :expected-type '(or (integer 1) (float (0))) :datum arg
      :format-control "~@<Argument is neither a positive integer nor a ~
              positive float: ~2I~_~S~:>"
      :format-arguments (list arg)))))

;;;; This implementation of RANDOM is based on the Mersenne Twister random
;;;; number generator "MT19937" due to Matsumoto and Nishimura. See:
;;;;  Makoto Matsumoto and T. Nishimura, "Mersenne twister: A
;;;;  623-dimensionally equidistributed uniform pseudorandom number
;;;;  generator.", ACM Transactions on Modeling and Computer Simulation,
;;;;  Vol. 8, No. 1, January pp.3-30 (1998) DOI:10.1145/272991.272995
;;;; http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/emt.html


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 #2: Type: text/html, Size: 26985 bytes --]

RE: [External] : Re: Some thoughts about Emacs performance

[Drew Adams]

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

https://www.quantamagazine.org/scientists-find-optimal-balance-of-data-storage-and-time-20240208/

Where would we ever be without Messieurs Boyer & Moore? ;-)
Thank you. To your health!

Where would we ever be without hash tables! I am so glad that 'sxhash' is in Emacs Lisp and Common Lisp!

[-- Attachment #2: Type: text/html, Size: 3250 bytes --]

Re: Some thoughts about Emacs performance

[Robert Boyer]

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

>
> > But it doesn't try to be a standalone platform for
> > performance-oriented Lisp developers.
>


> I hope that Emacs merges with SBCL.
>


> Emacs and SBCL are amongst the greatest inventions in the history of the
> world.
>


> Of course I should mention gcc and Linux and so much that the Free
> Software Foundation has given us, e.g., their 'sort' which can sort files
> of amazing length at amazing speed.  It is crucial to my ongoing work on
> automatic theorem proving.  If you've got a billion clause records and want
> to flush duplicates, who you gonna call but /usr/bin/sort.  That's what I
> say, and what I do.  To do that in Lisp might consume more space than I
> have except on my SD card.   I run on a $100 chromebook and my 256 gb SD
> card only cost $30, and 1 tb SD cards are coming soon at a price I think I
> will be able to afford.



> But of course, Coq may be the fastest thing except for C.  And it has
> 'sanitary' macros.
>


> Where would I be without unsanitary macros!  My sorting algorithm 'msa'
> depends upon them!
>


> But what do I know about sanitation.


I think that the following are very unsanitary, but what do I know?
         (eval

>          '(defmacro key (x)
>             (cond (key
>                    (cond ((symbolp key) `(the ,msa-type (,key ,x)))
>                          (t `(the ,msa-type (funcall ,key ,x)))))
>                   (t `(the ,msa-type ,x)))))
>         (eval
>          '(defmacro msa-equal (x y)
>             (cond (msa-all-keys-real `(eql ,x ,y))
>                   (t `(equal ,x ,y)))))
>         (eval
>          '(defmacro msa-predicate (x y)
>             (cond ((symbolp msa-predicate) `(,msa-predicate ,x ,y))
>                   (t `(funcall ',msa-predicate ,x ,y)))))


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 #2: Type: text/html, Size: 7835 bytes --]

Re: Some thoughts about Emacs performance

[Arthur Miller]

>Robert Boyer <robertstephenboyer@gmail.com> writes:
>
>> 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.
>
>When comparing Elisp and SBCL, it is more fair to compare
>native-compiler Elisp rather than byte-compiled.
>Then, both codes are compiled to machine code.

The sort is implemented in C, so it does not matter so much, but I did compiled
to native with comp-speed 3, and I have replaced cl-random (lisp) call with call
to random (C).

What I have seen was that on first few runs, sbcl was faster.

Definitely not as a drammatic difference as in Robert's test,
but SBCL was still somewhat faster:

Emacs:

(benchmark 1 '(setq foo (make-random-array (expt 10 n))))
Elapsed time: 0.097354s (0.053204s in 1 GCs)

(benchmark 1 '(sort foo '<))
Elapsed time: 0.271281s

SBCL:
CL-USER> (time (defparameter foo (make-random-array (expt 10 n))))

Evaluation took:
  0.020 seconds of real time
  0.015625 seconds of total run time (0.000000 user, 0.015625 system)
  80.00% CPU
  50,840,363 processor cycles
  8,000,016 bytes consed
  

CL-USER> (time (progn (stable-sort foo '<) nil))

Evaluation took:
  0.165 seconds of real time
  0.125000 seconds of total run time (0.109375 user, 0.015625 system)
  75.76% CPU
  413,349,272 processor cycles
  8,000,016 bytes consed

That was consistent for few times. However, after some time, Emacs was beating
SBCL in sorting.

Emacs for sort was varying 0.015 ~ 0.02; mostly ~0.017.

SBCL, was varying 0.065 ~ 0.085, mostly ~0.065.

For array creation, SBCL is beating Emacs, every time, by a magnitude. Emacs was
around 0.1 ~ 0.12, while SBCL was 0.017 ~ 0.022

Speeds were quite stable for both Emacs and SBCL in later runs.

Unfortunately I only have access to older sbcl version on Windows;
I have seen from the mailing list that they have been working on the sort
implementation so it will be exciting to see what they have come up with.

Emacs version:

GNU Emacs 29.2 (build 2, x86_64-w64-mingw32) of 2024-02-01 (build from GNU ftp
server 29.2_1 for Windows OS - can't build myself configure script fails)

CPU: 13th Gen Intel(R) Core(TM) i5-1345U   1.60 GHz
RAM: 16 GB
OS: Win 11 build 22H2

$ sbcl --version
SBCL 2.3.2

Re: Some thoughts about Emacs performance

[Ihor Radchenko]

Arthur Miller <arthur.miller@live.com> writes:

> For array creation, SBCL is beating Emacs, every time, by a magnitude. Emacs was
> around 0.1 ~ 0.12, while SBCL was 0.017 ~ 0.022
>
> Speeds were quite stable for both Emacs and SBCL in later runs.
>
> Unfortunately I only have access to older sbcl version on Windows;
> I have seen from the mailing list that they have been working on the sort
> implementation so it will be exciting to see what they have come up with.
>
> Emacs version:
>
> GNU Emacs 29.2 (build 2, x86_64-w64-mingw32) of 2024-02-01 (build from GNU ftp
> server 29.2_1 for Windows OS - can't build myself configure script fails)

Do note that vector creation may be faster on master. See
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=65491

-- 
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>