From d1e97317b0fdb8eb6cd34d13a2874c1792a484c3 Mon Sep 17 00:00:00 2001 From: Pip Cet 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 ()); } /* 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