Re: master d582356: * src/fns.c (Frandom): Handle bignum `limit`s

[Pip Cet <pipcet@gmail.com>]

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

On Fri, Mar 5, 2021 at 7:56 PM Stefan Monnier <monnier@iro.umontreal.ca> wrote:

> > And, all of this could happen in Lisp, couldn't it? Should it?
>
> You might be right: we should probably export just `get_random` (and the
> seeding part) to ELisp and then write the rest in ELisp.

Does this look okay? It passes make check, so it must be correct!

Pip

[-- Attachment #2: 0001-Implement-random-in-Lisp-exposing-only-random-fixnum.patch --]
[-- Type: text/x-patch, Size: 7204 bytes --]

From d1e97317b0fdb8eb6cd34d13a2874c1792a484c3 Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Sat, 6 Mar 2021 07:37:22 +0000
Subject: [PATCH] Implement random in Lisp, exposing only random-fixnum from C

* src/buffer.c (Fgenerate_new_buffer_name): Call intern ("random").
* src/fns.c (Frandom): Rename to Frandom_fixnum and simplify.
(ccall2): Remove function.
(random_bignum): Remove function.
(syms_of_fns): Register random-fixnum, not random.
* lisp/subr.el (random): New function.
---
 lisp/subr.el | 43 ++++++++++++++++++++++++++++
 src/buffer.c |  6 +++-
 src/fns.c    | 80 +++++-----------------------------------------------
 3 files changed, 55 insertions(+), 74 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 0b5634739993f..fd7bc0283875b 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -6238,4 +6238,47 @@ internal--format-docstring-line
 This is intended for internal use only."
   (internal--fill-string-single-line (apply #'format string objects)))
 
+(defun random (&optional limit)
+  "Return a pseudo-random integer.
+By default, return a fixnum; all fixnums are equally likely.
+With positive integer LIMIT, return random integer in interval [0,LIMIT).
+With float argument LIMIT, return a float between 0 and LIMIT.
+With argument t, set the random number seed from the system's entropy
+pool if available, otherwise from less-random volatile data such as the time.
+With a string argument, set the seed based on the string's contents.
+
+See Info node `(elisp)Random Numbers' for more details."
+  (cond
+   ((null limit)
+    (random-fixnum))
+   ((natnump limit)
+    (if (<= limit 0)
+        (error "Non-positive argument"))
+    (let (okay remainder)
+      (while (not okay)
+        (let ((val 0)
+              (lim limit)
+              (bits 0)
+              (bits-per-iteration (1-
+                                   (truncate
+                                    (log (1+ most-positive-fixnum) 2)))))
+          (while (not (zerop lim))
+            (let ((rand (logand (1- (lsh 1 bits-per-iteration))
+                                (random-fixnum))))
+              (setq bits (+ bits bits-per-iteration))
+              (setq val (logior (lsh val bits-per-iteration)
+                                rand))
+              (setq lim (lsh lim (- bits-per-iteration)))))
+          (setq remainder (% val limit))
+          (setq okay (<= (- val remainder)
+                         (- (lsh 1 bits) limit)))))
+      remainder))
+  ((floatp limit)
+   (* (random-integer (lsh 1 64))
+      (/ 1.0 (float (lsh 1 64)))
+      limit))
+  ((eq limit t) (random-fixnum limit))
+  ((stringp limit) (random-fixnum limit))
+  ((error "invalid limit %S" limit))))
+
 ;;; subr.el ends here
diff --git a/src/buffer.c b/src/buffer.c
index 03c10cc7ae5ba..20a2219e10a49 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -1149,7 +1149,11 @@ DEFUN ("generate-new-buffer-name", Fgenerate_new_buffer_name,
       char number[sizeof "-999999"];
 
       /* Use XFIXNUM instead of XFIXNAT to work around GCC bug 80776.  */
-      int i = XFIXNUM (Frandom (make_fixnum (1000000)));
+      Lisp_Object rand = CALLN (Ffuncall, intern ("random"),
+				make_fixnum (1000000));
+      if (!FIXNUMP (rand) || XFIXNUM (rand) < 0 || XFIXNUM (rand) >= 1000000)
+	error ("random broken");
+      int i = XFIXNUM (rand);
       eassume (0 <= i && i < 1000000);
 
       AUTO_STRING_WITH_LEN (lnumber, number, sprintf (number, "-%d", i));
diff --git a/src/fns.c b/src/fns.c
index b193ad648a96c..a65a5d88d4e4a 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -54,88 +54,22 @@ DEFUN ("identity", Fidentity, Sidentity, 1, 1, 0,
   return argument;
 }
 
-static Lisp_Object
-ccall2 (Lisp_Object (f) (ptrdiff_t nargs, Lisp_Object *args),
-        Lisp_Object arg1, Lisp_Object arg2)
-{
-  Lisp_Object args[2] = {arg1, arg2};
-  return f (2, args);
-}
-
-static Lisp_Object
-get_random_bignum (Lisp_Object limit)
-{
-  /* This is a naive transcription into bignums of the fixnum algorithm.
-     I'd be quite surprised if that's anywhere near the best algorithm
-     for it.  */
-  while (true)
-    {
-      Lisp_Object val = make_fixnum (0);
-      Lisp_Object lim = limit;
-      int bits = 0;
-      int bitsperiteration = FIXNUM_BITS - 1;
-      do
-        {
-          /* Shift by one so it is a valid positive fixnum.  */
-          EMACS_INT rand = get_random () >> 1;
-          Lisp_Object lrand = make_fixnum (rand);
-          bits += bitsperiteration;
-          val = ccall2 (Flogior,
-                        Fash (val, make_fixnum (bitsperiteration)),
-                        lrand);
-          lim = Fash (lim, make_fixnum (- bitsperiteration));
-        }
-      while (!EQ (lim, make_fixnum (0)));
-      /* Return the remainder, except reject the rare case where
-	 get_random returns a number so close to INTMASK that the
-	 remainder isn't random.  */
-      Lisp_Object remainder = Frem (val, limit);
-      if (!NILP (ccall2 (Fleq,
-	                 ccall2 (Fminus, val, remainder),
-	                 ccall2 (Fminus,
-	                         Fash (make_fixnum (1), make_fixnum (bits)),
-	                         limit))))
-	return remainder;
-    }
-}
-
-DEFUN ("random", Frandom, Srandom, 0, 1, 0,
+DEFUN ("random-fixnum", Frandom_fixnum, Srandom_fixnum, 0, 1, 0,
        doc: /* Return a pseudo-random integer.
-By default, return a fixnum; all fixnums are equally likely.
-With positive integer LIMIT, return random integer in interval [0,LIMIT).
-With argument t, set the random number seed from the system's entropy
-pool if available, otherwise from less-random volatile data such as the time.
-With a string argument, set the seed based on the string's contents.
+Return a fixnum; all fixnums are equally likely.  With argument t, also set
+the random number seed from the system's entropy pool if available, otherwise
+from less-random volatile data such as the time.
+With a string argument, also set the seed based on the string's contents.
 
 See Info node `(elisp)Random Numbers' for more details.  */)
   (Lisp_Object limit)
 {
-  EMACS_INT val;
-
   if (EQ (limit, Qt))
     init_random ();
   else if (STRINGP (limit))
     seed_random (SSDATA (limit), SBYTES (limit));
-  if (BIGNUMP (limit))
-    {
-      if (0 > mpz_sgn (*xbignum_val (limit)))
-        xsignal2 (Qwrong_type_argument, Qnatnump, limit);
-      return get_random_bignum (limit);
-    }
 
-  val = get_random ();
-  if (FIXNUMP (limit) && 0 < XFIXNUM (limit))
-    while (true)
-      {
-	/* Return the remainder, except reject the rare case where
-	   get_random returns a number so close to INTMASK that the
-	   remainder isn't random.  */
-	EMACS_INT remainder = val % XFIXNUM (limit);
-	if (val - remainder <= INTMASK - XFIXNUM (limit) + 1)
-	  return make_fixnum (remainder);
-	val = get_random ();
-      }
-  return make_ufixnum (val);
+  return make_ufixnum (get_random ());
 }
 \f
 /* Random data-structure functions.  */
@@ -5968,7 +5902,7 @@ syms_of_fns (void)
   use_short_answers = false;
 
   defsubr (&Sidentity);
-  defsubr (&Srandom);
+  defsubr (&Srandom_fixnum);
   defsubr (&Slength);
   defsubr (&Ssafe_length);
   defsubr (&Slength_less);
-- 
2.30.1