~ chicken-core (chicken-5) 97c470e8bd08cf3ffe2bb27d04a748499f0eae21

commit 97c470e8bd08cf3ffe2bb27d04a748499f0eae21
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Nov 3 14:43:48 2017 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri Nov 3 14:43:48 2017 +0100

    move error checks for random-* into C to allow specializing for the fixnum type

diff --git a/extras.scm b/extras.scm
index 63f49ed6..f4cccce5 100644
--- a/extras.scm
+++ b/extras.scm
@@ -649,31 +649,24 @@
 (import scheme chicken chicken.time chicken.io foreign)
 
 (define (set-pseudo-random-seed! buf #!optional n)
+  ;; doesn't enforce size of buf being at least 4 bytes
   (if n
       (##sys#check-fixnum n 'set-pseudo-random-seed!)
       (set! n (##sys#size buf)))
   (unless (##core#inline "C_byteblockp" buf)
-    (##sys#error 'set-pseudo-random-seed!
-                 "invalid buffer type" buf))
+    (##sys#error 'set-pseudo-random-seed! "invalid buffer type" buf))
   (##core#inline "C_set_random_seed" buf
                  (##core#inline "C_i_fixnum_min" 
                                 n 
                                 (##sys#size buf))))
 
 (define (pseudo-random-integer n)
-  (define (badrange)
-    (##sys#error 'pseudo-random-integer "invalid range" n))
   (cond ((##core#inline "C_fixnump" n)
-         (if (##core#inline "C_fixnum_lessp" n 0)
-             (badrange)
-             (##core#inline "C_random_fixnum" n)))
+         (##core#inline "C_random_fixnum" n))
         ((not (##core#inline "C_i_bignump" n))
          (##sys#error 'pseudo-random-integer "bad argument type" n))
         (else
-          (if (##core#inline "C_i_lessp" n 0)
-              (badrange)
-              (##core#inline_allocate ("C_s_a_u_i_random_int" 2)
-                                      n)))))
+          (##core#inline_allocate ("C_s_a_u_i_random_int" 2) n))))
 
 (define random-bytes
   (let ((in #f)
diff --git a/runtime.c b/runtime.c
index 60803e01..c9f5f3f5 100644
--- a/runtime.c
+++ b/runtime.c
@@ -12590,6 +12590,16 @@ static C_u32 random_word(void)
 C_regparm C_word C_random_fixnum(C_word n)
 { 
   C_u32 r = random_word();
+  C_word nf;
+
+  if (!(n & C_FIXNUM_BIT))
+    barf(C_BAD_ARGUMENT_TYPE_NO_FIXNUM_ERROR, "pseudo-random-integer", n);
+
+  nf = C_unfix(n);
+
+  if(nf < 0)
+    barf(C_OUT_OF_RANGE_ERROR, "pseudo-random-integer", n, C_fix(0));
+
   return C_fix(((double)r / 0xffffffffUL) * C_unfix(n));
 } 
 
@@ -12598,6 +12608,10 @@ C_regparm C_word C_fcall
 C_s_a_u_i_random_int(C_word **ptr, C_word n, C_word rn)
 {
   C_uword *start, *end;
+
+  if(C_bignum_negativep(rn))
+    barf(C_OUT_OF_RANGE_ERROR, "pseudo-random-integer", rn, C_fix(0));
+
   int len = integer_length_abs(rn);
   C_word size = C_fix(C_BIGNUM_BITS_TO_DIGITS(len));
   C_word result = C_allocate_scratch_bignum(ptr, size, C_SCHEME_FALSE, C_SCHEME_FALSE);