;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; CHICKEN bindings to Bob Jenkins' ISAAC CSPRNG.
;;;
;;; http://burtleburtle.net/bob/rand/isaacafa.html
;;;
;;; This software is written by Evan Hanson <evhan@foldling.org> and
;;; placed in the Public Domain. All warranties are disclaimed.
;;;

(declare
  (module isaac)
  (export make-isaac)
  (disable-interrupts)
  (fixnum-arithmetic))

#>

#include "randport.c"
#define RANDCTX sizeof(struct randctx)
#define SEED sizeof(ub4[RANDSIZ])

<#

(define-foreign-variable RANDCTX unsigned-int)
(define-foreign-variable SEED unsigned-int)

(define randctx-randinit
  (foreign-primitive ((blob c) (blob s))
   "C_memcpy(((struct randctx *)c)->randrsl, s, SEED);"
   "randinit(((struct randctx *)c), TRUE);"))

(define randctx-rand
  (foreign-primitive unsigned-long ((blob c))
   "C_return(rand((struct randctx *)c));"))

;;
;; Creates a new ISAAC instance.
;;
;; The result is a procedure of no arguments that returns a random
;; fixnum value on each invocation.
;;
;; `seed` is used to initialize the procedure's stream of random values.
;; If given, it should be a blob of size 2048. If not given, a block of
;; uninitialized memory will be used.
;;
;; If cryptographic security is desired, `seed` should itself be the
;; result of some secure random source. On Linux and BSD, 2048 bytes
;; from "/dev/urandom" or "/dev/arandom" will suffice.
;;
(: make-isaac (#!optional blob -> (-> fixnum)))
(define (make-isaac #!optional (seed (make-blob SEED)))
  (assert (blob? seed) "seed argument must be a blob")
  (assert (>= (blob-size seed) SEED) (sprintf "seed must be at least ~a bytes" SEED))
  (let ((c (make-blob RANDCTX)))
    (randctx-randinit c seed)
    (lambda () (randctx-rand c))))