From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Robert Boyer Newsgroups: gmane.emacs.devel Subject: Re: Some thoughts about Emacs performance Date: Fri, 16 Feb 2024 12:06:15 -0600 Message-ID: References: Mime-Version: 1.0 Content-Type: multipart/alternative; boundary="000000000000dd21330611839b51" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="17700"; mail-complaints-to="usenet@ciao.gmane.io" Cc: Emacs developers To: Simon Leinen Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Fri Feb 16 20:36:45 2024 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1rb40r-0004Sg-HD for ged-emacs-devel@m.gmane-mx.org; Fri, 16 Feb 2024 20:36:45 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1rb40B-0003r8-Ax; Fri, 16 Feb 2024 14:36:03 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1rb2cB-0004IS-1X for emacs-devel@gnu.org; Fri, 16 Feb 2024 13:07:11 -0500 Original-Received: from mail-ej1-x635.google.com ([2a00:1450:4864:20::635]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1rb2bx-0004Wk-CM for emacs-devel@gnu.org; Fri, 16 Feb 2024 13:07:08 -0500 Original-Received: by mail-ej1-x635.google.com with SMTP id a640c23a62f3a-a3db0b8b313so215811666b.0 for ; Fri, 16 Feb 2024 10:06:56 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1708106814; x=1708711614; darn=gnu.org; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:from:to:cc:subject:date:message-id:reply-to; bh=8wGFQwYLwImb/RGl0B+bejY+uFkBKkCzpRgImsaUglY=; b=VENlHprKEzJAOQdiNJ2cnnpiZVc/FoOfFm4QXFJhVJgX443ZP6+rNEwp+VehI0cG4H Mc3uWohZnku7grJrurvsp+hynIvj5HheYkYwYbBKVECmIe9m8xExHeC80/4R4ZksaO26 FKiCaApd3d1zexGMswLBpLn5KvE1cT+QjaeKN8+RfMgX0GqsdF6xHydRFVkioaxxIEIg 3lbxYes/3vXEvMVUrr7dDCGbyZQzLHDng8dKB8Youheo1qpLomlyG6buzJHgz7iZwLWl 5r7SP0fFmzabg41jS9RVBnSk//SHEO86Ju8/5tyhlIVDi0Ji9FmGeT4lPw8m9vBL7OKK NvFg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1708106814; x=1708711614; h=cc:to:subject:message-id:date:from:in-reply-to:references :mime-version:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=8wGFQwYLwImb/RGl0B+bejY+uFkBKkCzpRgImsaUglY=; b=uPxOA4sCmFlqBgQGysJqYa8xVQbzwyTx+5i81Zkc/9j1aVHJ7qphpDC0XT8wt132Lh NpKVcUjSAohO+CtLbT39b8IevimpKTJHt2HMwMbTaLG5FDbFKVtAodBXUH4Cnac32lm7 8iMzop655I+zL7WKJkpb+iCUIOexKulNM6L4PAl1ElswI7LHPkFHmcW21HdF8cHOtcVH dAsVKDIqKTtcFtMjuBN0dGSbLz9Iuw8dKKRvaedURRXush1gXt0Y7KMnE8tJvqWtmTAL UtoRm5rGAKQq1RE0D9b0HEdpGmZW7qTCt+qMxdVGYm09dKSuzkzbK/reEM0Pa4A678Qx 2epg== X-Gm-Message-State: AOJu0YyaIBXi5DEnCcig8yPwJQmf5/6TJBm31s9qs5l0yw1WcGcMO1tY jhv4jcUkERn6tjj+8GMNwkmIX8HwAiRlgfc1gN20FqNI4dQNIRQabIdIXZaOpefSnuwp9CVpEgu 3aqgESCRgi0xA7/HRjrZvX2S3YUzYXpheQsA= X-Google-Smtp-Source: AGHT+IF9WceMTEjHYDhkEzb7ht+lIcihnNn35lyYNNUnNb0XL4ESfAq6LA+nChIo1nxuMP9cw3cmAGbHITxHFRdMu+o= X-Received: by 2002:a17:906:5615:b0:a3d:2762:71f7 with SMTP id f21-20020a170906561500b00a3d276271f7mr4189144ejq.66.1708106813611; Fri, 16 Feb 2024 10:06:53 -0800 (PST) In-Reply-To: Received-SPF: pass client-ip=2a00:1450:4864:20::635; envelope-from=robertstephenboyer@gmail.com; helo=mail-ej1-x635.google.com X-Spam_score_int: -2 X-Spam_score: -0.3 X-Spam_bar: / X-Spam_report: (-0.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, FREEMAIL_FROM=0.001, HTML_MESSAGE=0.001, LOTS_OF_MONEY=0.001, PERCENT_RANDOM=1.838, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, T_FILL_THIS_FORM_SHORT=0.01, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=no autolearn_force=no X-Spam_action: no action X-Mailman-Approved-At: Fri, 16 Feb 2024 14:36:01 -0500 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:316252 Archived-At: --000000000000dd21330611839b51 Content-Type: text/plain; charset="UTF-8" Content-Transfer-Encoding: quoted-printable 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 t= o 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 =3D 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-syste= m 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 (=3D 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-syste= m 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 objec= t 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 (>=3D 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 =3D (* 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 (=3D 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 =3D (ceiling (integer-length state) 32) with s =3D (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 truncat= e ;; it to 19968 bits and mix these into an initial state. We reuse the sam= e ;; 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 (>=3D i mt19937-n) (setf (aref s 3) (aref s (+ 2 mt19937-n)) i 1)) (incf j) (when (>=3D 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 (>=3D 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 arra= y (%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))) ((>=3D 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))) ((>=3D 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 (=3D 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 =3D (* 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 =3D due to 80-bit precision #-x86 =3D 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 =3D (* 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 (=3D 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 =3D (* 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 =3D 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 (=3D 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 (<=3D n-bits (* 2 n-random-chunk-bits))) (if (<=3D 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 "~@" :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=E2=80=AFAM Simon Leinen 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=E2=80=AFAM Robert Boyer > 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=E2=80=94replacing 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=E2=80=94on 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=E2=80=94maybe Emacs chose to optimize for partly-sor= ted > 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=E2=80=94personally I us= e 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 second= s > > (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 > --000000000000dd21330611839b51 Content-Type: text/html; charset="UTF-8" Content-Transfer-Encoding: quoted-printable
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 f= ollowing random assertion: NSA, rms's favorite
organization I am sur= e, 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 c= ourse
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! Unl= ike rms, I like to get
paid. At NSA's insistence, I got kicked off t= he board of my company
Computational Logic when I refused to get = a security clearance.=C2=A0
Eventually, when funding dried up, th= e company folded.

Thank God for RSA. I can remember at a party for t= he MIT AI Lab, when funding
did not look too hot, Moses said that 's= ecurity' might be a way to go to look
for funding. It may be nice fo= r 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
horr= or stories about hackers breaking in.

I once heard that Minsky, bles= s his soul, refused to let his students spend
time worrying about securi= ty on his DEC PDP-10 because it would only lead to
other students wastin= g 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
L= isp!

I send far too much email. Is there a group Email Addicts Anony= mous?

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 t= hey look at the
18 uses of "declare" in the following! You wan= t 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 releas= ed into the
;;;; public domain. The software is in the public domain and= is
;;;; provided with absolutely no warranty. See the COPYING and CREDI= TS
;;;; files for more information.

(in-package "SB-KERNEL&q= uot;)

;;;; Constants
(defconstant mt19937-n 624)
(defconstant = mt19937-m 397)
(defconstant mt19937-upper-mask #x80000000)
(defconsta= nt 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: =C2=A0Constant matrix A. [0, #x9908b0df]
;;; 2: =C2=A0 Inde= x k.
;;; 3-626: State.

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

(defmethod make-load-for= m ((random-state random-state) &optional environment)
=C2=A0(make-lo= ad-form-saving-slots random-state :environment environment))

(defmet= hod print-object ((state random-state) stream)
=C2=A0(if (and *print-rea= dably* (not *read-eval*))
=C2=A0 =C2=A0(print-not-readable-error state s= tream)
=C2=A0 =C2=A0(format stream "#S(~S ~S #.~S)"
=C2=A0 = =C2=A0 =C2=A0 =C2=A0'random-state
=C2=A0 =C2=A0 =C2=A0 =C2=A0':s= tate
=C2=A0 =C2=A0 =C2=A0 =C2=A0`(make-array ,(+ 3 mt19937-n)
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 :element-type
=C2=A0 =C2=A0 =C2=A0 =C2=A0 '(uns= igned-byte 32)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 :initial-contents
=C2=A0 = =C2=A0 =C2=A0 =C2=A0 ',(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 af= fect only MSBs of the array.
(defun init-random-state (&optional (se= ed 5489) state)
=C2=A0(declare (type (unsigned-byte 32) seed))
=C2=A0= (let ((state (or state (make-array 627 :element-type '(unsigned-byte 32= )))))
=C2=A0 (check-type state random-state-state)
=C2=A0 (setf (aref= state 0) 0)
=C2=A0 (setf (aref state 1) mt19937-a)
=C2=A0 (setf (are= f state 2) mt19937-n)
=C2=A0 (loop for i below mt19937-n
=C2=A0 =C2= =A0for p from 3
=C2=A0 =C2=A0for s =3D seed then
=C2=A0 =C2=A0(logand= #xFFFFFFFF
=C2=A0 =C2=A0 =C2=A0 =C2=A0(+ (* 1812433253
=C2=A0 =C2=A0= =C2=A0 =C2=A0 =C2=A0 (logxor s (ash s -30)))
=C2=A0 =C2=A0 =C2=A0 =C2= =A0 i))
=C2=A0 =C2=A0do (setf (aref state p) s))
=C2=A0 state))
(defvar *random-state*)
(defun !random-cold-init ()
=C2=A0(/show0 &= quot;entering !RANDOM-COLD-INIT")
=C2=A0(setf *random-state* (%make= -random-state (init-random-state)))
=C2=A0(/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
;;; =C2=A0and doesn't accept numerical state.(defun make-random-state (&optional state)
=C2=A0"Make a rando= m state object. The optional STATE argument specifies a seed
for determi= nistic pseudo-random number generation.

As per the Common Lisp stand= ard,
- If STATE is NIL or not supplied, return a copy of the default
= =C2=A0*RANDOM-STATE*.
- If STATE is a random state, return a copy of it.=
- If STATE is T, return a randomly initialized state (using operating-s= ystem
=C2=A0provided randomness where available, otherwise a poor substi= tute based on
=C2=A0internal time and PID).

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

(defun fallback-random-seed ()
=C2=A0;; When /dev/urandom is not= available, we make do with time and pid
=C2=A0;; Thread ID and/or addre= ss of a CONS cell would be even better, but...
=C2=A0;; [ADDRESS-BASED-C= OUNTER-VAL in 'target-sxhash' could be used here]
=C2=A0(/show0 = "No /dev/urandom, using randomness from time and pid")
=C2=A0(= + (get-internal-real-time)
=C2=A0 (ash (sb-unix:unix-getpid) 32)))
#-win32
(defun os-random-seed ()
=C2=A0(or
=C2=A0;; On unices, w= e try to read from /dev/urandom and pass the results
=C2=A0;; to our (si= mple-array (unsigned-byte 32) (*)) processor below.
=C2=A0;; More than 2= 56 bits would provide a false sense of security.
=C2=A0;; If you need mo= re bits than that, you probably also need
=C2=A0;; a better algorithm to= o.
=C2=A0(ignore-errors
=C2=A0 (with-open-file (r "/dev/urandom&= quot; :element-type '(unsigned-byte 32)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0:direction :input :if-does-not-exi= st :error)
=C2=A0 =C2=A0(let ((a (make-array '(8) :element-type '= ;(unsigned-byte 32))))
=C2=A0 =C2=A0 (aver (=3D 8 (read-sequence a r)))<= br>=C2=A0 =C2=A0 a)))
=C2=A0(fallback-random-seed)))

#+win32
(= defun os-random-seed ()
=C2=A0(/show0 "Getting randomness from Cryp= tGenRandom")
=C2=A0(or (sb-win32:crypt-gen-random 32)
=C2=A0 =C2= =A0(fallback-random-seed)))

(defun seed-random-state (&optional = state)
=C2=A0"Make a random state object. The optional STATE argume= nt 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
=C2=A0*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
=C2=A0prov= ided randomness where available, otherwise a poor substitute based on
= =C2=A0internal time and pid).

As a supported SBCL extension, we also= support receiving as a seed an object
of the following types:
- (SIM= PLE-ARRAY (UNSIGNED-BYTE 8) (*))
- UNSIGNED-BYTE
While we support arg= uments 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 i= nformation.

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

This p= articular 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
"
=C2= =A0(declare (explicit-check))
=C2=A0(named-let seed-random-state ((state= state))
=C2=A0(etypecase state
=C2=A0 ;; Easy standard cases
=C2= =A0 (null
=C2=A0 (/show0 "copying *RANDOM-STATE*")
=C2=A0 (= %make-random-state (copy-seq (random-state-state *random-state*))))
=C2= =A0 (random-state
=C2=A0 (/show0 "copying the provided RANDOM-STATE= ")
=C2=A0 (%make-random-state (copy-seq (random-state-state state))= ))
=C2=A0 ;; Standard case, less easy: try to randomly initialize a stat= e.
=C2=A0 ((eql t)
=C2=A0 (/show0 "getting randomness from the o= perating system")
=C2=A0 (seed-random-state (os-random-seed)))
= =C2=A0 ;; For convenience to users, we accept (simple-array (unsigned-byte = 8) (*))
=C2=A0 ;; We just convert it to (simple-array (unsigned-byte 32)= (*)) in a
=C2=A0 ;; completely straightforward way.
=C2=A0 ;; TODO: = probably similarly accept other word sizes.
=C2=A0 ((simple-array (unsig= ned-byte 8) (*))
=C2=A0 (/show0 "getting random seed from byte vect= or (converting to 32-bit-word vector)")
=C2=A0 (let* ((l (length st= ate))
=C2=A0 =C2=A0 =C2=A0 (m (ceiling l 4))
=C2=A0 =C2=A0 =C2=A0 (r = (if (>=3D l 2496) 0 (mod l 4)))
=C2=A0 =C2=A0 =C2=A0 (y (make-array (= list m) :element-type '(unsigned-byte 32))))
=C2=A0 =C2=A0 =C2=A0 (l= oop for i from 0 below (- m (if (zerop r) 0 1))
=C2=A0 =C2=A0 =C2=A0 =C2= =A0for j =3D (* i 4) do
=C2=A0 =C2=A0 =C2=A0 =C2=A0(setf (aref y i)
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (+ (aref state j)
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 (ash (aref state (+ j 1)) 8)
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 (ash (aref state (+ j 2)) 16)
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 (ash (aref state (+ j 3)) 24))))
=C2=A0 =C2=A0 = =C2=A0 (unless (zerop r) ;; The last word may require special treatment.=C2=A0 =C2=A0 =C2=A0 =C2=A0(let* ((p (1- m)) (q (* 4 p)))
=C2=A0 =C2=A0= =C2=A0 =C2=A0 (setf (aref y p)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (+ (a= ref state q)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (if (< 1 r) (a= sh (aref state (+ q 1)) 8) 0)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = (if (=3D 3 r) (ash (aref state (+ q 2)) 16) 0)))))
=C2=A0 =C2=A0 =C2=A0 = (seed-random-state y)))
=C2=A0 ;; Also for convenience, we accept non-ne= gative integers as seeds.
=C2=A0 ;; Small ones get passed to init-random= -state, as before.
=C2=A0 ((unsigned-byte 32)
=C2=A0 (/show0 "ge= tting random seed from 32-bit word")
=C2=A0 (%make-random-state (in= it-random-state state)))
=C2=A0 ;; Larger ones ones get trivially choppe= d into an array of (unsigned-byte 32)
=C2=A0 ((unsigned-byte)
=C2=A0 = (/show0 "getting random seed from bignum (converting to 32-bit-word ve= ctor)")
=C2=A0 (loop with l =3D (ceiling (integer-length state) 32)=
=C2=A0 =C2=A0with s =3D (make-array (list l) :element-type '(unsign= ed-byte 32))
=C2=A0 =C2=A0for i below l
=C2=A0 =C2=A0for p from 0 by = 32
=C2=A0 =C2=A0do (setf (aref s i) (ldb (byte 32 p) state))
=C2=A0 = =C2=A0finally (return (seed-random-state s))))
=C2=A0 ;; Last but not le= ast, when provided an array of 32-bit words, we truncate
=C2=A0 ;; it to= 19968 bits and mix these into an initial state. We reuse the same
=C2= =A0 ;; method as the authors of the original algorithm. See
=C2=A0 ;; http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/MT2002/CODES/mt1993= 7ar.c
=C2=A0 ;; NB: their mt[i] is our (aref s (+ 3 i))
=C2=A0 ((= simple-array (unsigned-byte 32) (*))
=C2=A0 (/show0 "getting random= seed from 32-bit-word vector")
=C2=A0 (let ((s (init-random-state = 19650218))
=C2=A0 =C2=A0 =C2=A0(i 1) (j 0) (l (length state)))
=C2=A0= =C2=A0(loop for k downfrom (max mt19937-n l) above 0 do
=C2=A0 =C2=A0 (= setf (aref s (+ i 3))
=C2=A0 =C2=A0 =C2=A0 =C2=A0(logand #xFFFFFFFF
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(+ (logxor (aref s (+ i 3))
=C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(* 1664525
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (logxor (are= f s (+ i 2))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (ash (aref s (+ i 2)) -30))))
=C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0(aref state j) j))) ;; non-linear
=C2=A0 =C2=A0 = (incf i) (when (>=3D i mt19937-n) (setf (aref s 3) (aref s (+ 2 mt19937-= n)) i 1))
=C2=A0 =C2=A0 (incf j) (when (>=3D j l) (setf j 0)))
=C2= =A0 =C2=A0(loop for k downfrom (1- mt19937-n) above 0 do
=C2=A0 =C2=A0 (= setf (aref s (+ i 3))
=C2=A0 =C2=A0 =C2=A0 =C2=A0(logand #xFFFFFFFF
= =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(- (logxor (aref s (+ i 3))
=C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(* 1566083941=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (logxor (ar= ef s (+ i 2))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 (ash (aref s (+ i 2)) -30))))
=C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0i))) ;; non-linear
=C2=A0 =C2=A0 (incf i) (wh= en (>=3D i mt19937-n) (setf (aref s 3) (aref s (+ 2 mt19937-n)) i 1)))=C2=A0 =C2=A0(setf (aref s 3) #x80000000) ;; MSB is 1; assuring non-zero = initial array
=C2=A0 =C2=A0(%make-random-state s))))))

;;;; rando= m entries

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

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

(declaim (start-block random %random-single-float = %random-double-float
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0random-chu= nk big-random-chunk))

(declaim (inline random-chunk))
#-x86
(d= efun random-chunk (state)
=C2=A0(declare (type random-state state))
= =C2=A0(let* ((state (random-state-state state))
=C2=A0 =C2=A0 (k (aref s= tate 2)))
=C2=A0 (declare (type (mod 628) k))
=C2=A0 (when (=3D k mt1= 9937-n)
=C2=A0 =C2=A0(random-mt19937-update state)
=C2=A0 =C2=A0(setf= k 0))
=C2=A0 (setf (aref state 2) (1+ k))
=C2=A0 (let ((y (aref stat= e (+ 3 k))))
=C2=A0 =C2=A0(declare (type (unsigned-byte 32) y))
=C2= =A0 =C2=A0(setf y (logxor y (ash y -11)))
=C2=A0 =C2=A0(setf y (logxor y= (ash (logand y (ash mt19937-b -7)) 7)))
=C2=A0 =C2=A0(setf y (logxor y = (ash (logand y (ash mt19937-c -15)) 15)))
=C2=A0 =C2=A0(setf y (logxor y= (ash y -18)))
=C2=A0 =C2=A0y)))

;;; Using inline VOP support, on= ly available on the x86 so far.
;;;
;;; FIXME: It would be nice to ha= ve some benchmark numbers on this.
;;; My inclination is to get rid of t= he nonportable implementation
;;; unless the performance difference is j= ust enormous.
#+x86
(defun random-chunk (state)
=C2=A0(declare (ty= pe random-state state))
=C2=A0(sb-vm::random-mt19937 (random-state-state= state)))

(declaim (inline big-random-chunk))
(defun big-random-c= hunk (state)
=C2=A0(declare (type random-state state))
=C2=A0(logior = (ash (random-chunk state) 32)
=C2=A0 =C2=A0 =C2=A0(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-doub= le-float))
(declaim (ftype (function ((single-float ($0f0)) random-state= )
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(single-float $0f0))=C2=A0 =C2=A0 =C2=A0 =C2=A0 %random-single-float))
(defun %random-sing= le-float (arg state)
=C2=A0(declare (type (single-float ($0f0)) arg)
= =C2=A0 =C2=A0 =C2=A0(type random-state state))
=C2=A0(loop for candidate= of-type single-float
=C2=A0 =C2=A0 =3D (* arg
=C2=A0 =C2=A0 =C2=A0 (= - (make-single-float
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (dpb (ash (random-chunk= state)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(- sb-vm:single-= float-digits n-random-chunk-bits))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0sb-vm:single-float-significand-byte
=C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0(single-float-bits $1.0)))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 $1.0= ))
=C2=A0 =C2=A0 while (#+x86 eql ;; Can't use =3D due to 80-bit pre= cision
=C2=A0 =C2=A0 =C2=A0 =C2=A0#-x86 =3D
=C2=A0 =C2=A0 =C2=A0 =C2= =A0candidate arg)
=C2=A0 =C2=A0 finally (return candidate)))
(declaim= (ftype (function ((double-float ($0d0)) random-state)
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(double-float $0d0))
=C2=A0 =C2=A0 =C2=A0= =C2=A0 %random-double-float))

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

;;; 53-bit ver= sion
#-x86
(defun %random-double-float (arg state)
=C2=A0(declare = (type (double-float ($0d0)) arg)
=C2=A0 =C2=A0 =C2=A0(type random-state = state))
=C2=A0(loop for candidate of-type double-float
=C2=A0 =C2=A0 = =3D (* arg
=C2=A0 =C2=A0 =C2=A0 (- (sb-impl::make-double-float
=C2=A0= =C2=A0 =C2=A0 =C2=A0 (dpb (ash (random-chunk state)
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(- sb-vm:double-float-digits n-random-chunk-= bits 32))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0sb-vm:double-float-si= gnificand-byte
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(sb-impl::double= -float-high-bits $1d0))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 (random-chunk state)= )
=C2=A0 =C2=A0 =C2=A0 =C2=A0 $1d0))
=C2=A0 =C2=A0 while (=3D candida= te arg)
=C2=A0 =C2=A0 finally (return candidate)))

;;; using a fa= ster inline VOP
#+x86
(defun %random-double-float (arg state)
=C2= =A0(declare (type (double-float ($0d0)) arg)
=C2=A0 =C2=A0 =C2=A0(type r= andom-state state))
=C2=A0(let ((state-vector (random-state-state state)= ))
=C2=A0 (loop for candidate of-type double-float
=C2=A0 =C2=A0 =C2= =A0=3D (* arg
=C2=A0 =C2=A0 =C2=A0 =C2=A0(- (sb-impl::make-double-float<= br>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(dpb (ash (sb-vm::random-mt19937 state= -vector)
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (- sb-vm:doubl= e-float-digits n-random-chunk-bits
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 sb-vm:n-word-bits))
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 sb-vm:double-float-significand-byte
=C2=A0 =C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0 (sb-impl::double-float-high-bits $1d0))
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0(sb-vm::random-mt19937 state-vector))
=C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0$1d0))
=C2=A0 =C2=A0 =C2=A0;; Can't use =3D due = to 80-bit precision
=C2=A0 =C2=A0 =C2=A0while (eql candidate arg)
=C2= =A0 =C2=A0 =C2=A0finally (return candidate))))

;;;; random fixnums
;;; Generate and return a pseudo random fixnum less than ARG. To achi= eve
;;; 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 si= ze is half the word size, two random chunks are
;;; used in each loop it= eration, otherwise only one. Finally, the
;;; rejection probability coul= d often be reduced by not masking the
;;; chunk but rejecting only value= s as least as large as the largest
;;; multiple of ARG that fits in a ch= unk (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))
(d= efun %random-fixnum (arg state)
=C2=A0(declare (type (integer 1 #.most-p= ositive-fixnum) arg)
=C2=A0 =C2=A0 =C2=A0(type random-state state))
= =C2=A0(if (=3D arg 1)
=C2=A0 =C2=A00
=C2=A0 =C2=A0(let* ((n-bits (int= eger-length (1- arg)))
=C2=A0 =C2=A0 =C2=A0 (mask (1- (ash 1 n-bits))))<= br>=C2=A0 =C2=A0 (macrolet ((accept-reject-loop (generator)
=C2=A0 =C2= =A0 =C2=A0 =C2=A0 =C2=A0 `(loop
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2= =A0 (let ((bits (logand mask (,generator state))))
=C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0(when (< bits arg)
=C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0 =C2=A0 =C2=A0 (return bits))))))
=C2=A0 =C2=A0 =C2=A0(aver= (<=3D n-bits (* 2 n-random-chunk-bits)))
=C2=A0 =C2=A0 =C2=A0(if (&l= t;=3D n-bits n-random-chunk-bits)
=C2=A0 =C2=A0 =C2=A0 =C2=A0(accept-rej= ect-loop random-chunk)
=C2=A0 =C2=A0 =C2=A0 =C2=A0(accept-reject-loop bi= g-random-chunk))))))

(defun random (arg &optional (state *random= -state*))
=C2=A0(declare (inline %random-fixnum
=C2=A0 =C2=A0 =C2=A0 = =C2=A0 =C2=A0%random-single-float %random-double-float
=C2=A0 =C2=A0 =C2= =A0 =C2=A0 =C2=A0#+long-float %random-long-float))
=C2=A0(declare (expli= cit-check))
=C2=A0(cond
=C2=A0 ((and (fixnump arg) (> arg 0))
= =C2=A0 (%random-fixnum arg state))
=C2=A0 ((and (typep arg 'single-f= loat) (> arg $0.0f0))
=C2=A0 (%random-single-float arg state))
=C2= =A0 ((and (typep arg 'double-float) (> arg $0.0d0))
=C2=A0 (%rand= om-double-float arg state))
=C2=A0 #+long-float
=C2=A0 ((and (typep a= rg 'long-float) (> arg $0.0l0))
=C2=A0 (%random-long-float arg st= ate))
=C2=A0 ((and (bignump arg) (> arg 0))
=C2=A0 (%random-bignum= arg state))
=C2=A0 (t
=C2=A0 (error 'simple-type-error
=C2=A0= =C2=A0 =C2=A0 :expected-type '(or (integer 1) (float (0))) :datum arg<= br>=C2=A0 =C2=A0 =C2=A0 :format-control "~@<Argument is neither a p= ositive integer nor a ~
=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0= positive float: ~2I~_~S~:>"
=C2=A0 =C2=A0 =C2=A0 :format-argume= nts (list arg)))))

;;;; This implementation of RANDOM is based on th= e Mersenne Twister random
;;;; number generator "MT19937" due = to Matsumoto and Nishimura. See:
;;;; =C2=A0Makoto Matsumoto and T. Nish= imura, "Mersenne twister: A
;;;; =C2=A0623-dimensionally equidistri= buted uniform pseudorandom number
;;;; =C2=A0generator.", ACM Trans= actions on Modeling and Computer Simulation,
;;;; =C2=A0Vol. 8, No. 1, J= anuary pp.3-30 (1998) DOI:10.1145/272991.272995
;;;; http://www.math.sci.hiros= hima-u.ac.jp/~m-mat/MT/emt.html


On Fri, Feb 16, 2024 at 8:= 08=E2=80=AFAM Simon Leinen <si= mon.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=E2=80=AFAM Robert Boyer
<rober= tstephenboyer@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=E2=80=94replacing that with plain "random" speeds = it up by
about a factor of ten.=C2=A0 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.=C2=A0 Emacs's implementation= is
written in C, SBCL's in Lisp. Performance is quite similar=E2=80=94on m= y
system (Apple Macbook Air M2) Emacs takes about 35% longer to sort a
million random numbers than SBCL.=C2=A0 (On the other hand when sorting it<= br> again, i.e. when the vector is already fully sorter, Emacs is quite a
bit faster than SBCL=E2=80=94maybe Emacs chose to optimize for partly-sorte= d
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.=C2=A0 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.=C2=A0 But it doesn't try to be a standalone platform for<= br> performance-oriented Lisp developers.=C2=A0 Of course Emacs is very
suitable as a Software Development Environment for systems such as
SBCL, and there are many good integration options=E2=80=94personally 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)
>=C2=A0 =C2=A0(let ((a (make-vector n 0)))
>=C2=A0 =C2=A0 =C2=A0(cl-loop for i below n do
>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 (setf (elt a i) (cl-ra= ndom 1000000)))
>=C2=A0 =C2=A0 =C2=A0a))
> (byte-compile 'make-random-array)
> (benchmark '(setq foo (make-random-array (expt 10 n))) 1) -- 2.3 s= econds
> (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)
>=C2=A0 =C2=A0(declare (fixnum n))
>=C2=A0 =C2=A0(let ((a (make-array n)))
>=C2=A0 =C2=A0 =C2=A0(declare (type array a))
>=C2=A0 =C2=A0 =C2=A0(loop for i fixnum below n do
>=C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0 =C2=A0(setf (aref a i) (random most-= positive-fixnum)))
>=C2=A0 =C2=A0 =C2=A0a))
> (time (defparameter foo (make-random-array (expt 10 n))))=C2=A0 -- .04= 1 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
--000000000000dd21330611839b51--