;;;; /dev/urandom-state
;;;; Christophe Rhodes <csr21@cantab.net>
;;;; 2009-12-28

;;;; This short file is primarily intended as an example of a
;;;; random-state implementation using SBCL’s embryonic
;;;; CL:RANDOM-STATE protocol.

;;; First, we define a class.  We inherit from both CL:STANDARD-OBJECT
;;; and CL:RANDOM-STATE; we can do this even though CL:RANDOM-STATE is
;;; a CL:STRUCTURE-CLASS (and inherits from CL:STRUCTURE-OBJECT)
;;; because CL:RANDOM-STATE has been declared in its definition as
;;; subclassable.  (For details on this, consult the documentation or,
;;; more realistically, the source code).  We define for this class a
;;; single, :CLASS-allocated slot for an open stream to the
;;; non-blocking random device; strictly speaking this is a
;;; file-descriptor leak, in that it’s only closed when the Lisp
;;; process exits, but there is only one such fd in play per Lisp
;;; image.

(defclass /dev/urandom-state (standard-object random-state)
  ((s :allocation :class
      :initform (open "/dev/urandom" :element-type 'unsigned-byte))))

;;; There are three protocol functions to implement.  The first,
;;; RANDOM-WORD, must return a 32-bit integer from the random state
;;; and update the state.  Since we are reading directly from the
;;; kernel’s entropy pool or PRNG, we don’t have any state to update,
;;; but we must construct our 32-bit word from the octets that we
;;; read.  Calls to CL:RANDOM end up calling this function, whether to
;;; generate an integer or a floating point sample; this protocol
;;; function is also available to be used in layered protocols, for
;;; example for generating samples from particular statistical
;;; distributions.

(defmethod random-word ((state /dev/urandom-state))
  (let ((s (slot-value state 's)))
    (dpb (read-byte s) (byte 8 24)
         (dpb (read-byte s) (byte 8 16)
              (dpb (read-byte s) (byte 8 8) (read-byte s))))))

;;; The other two protocol functions support calls to
;;; CL:MAKE-RANDOM-STATE.  MAKE-RANDOM-STATE-LIKE is called when CL:T
;;; is passed to CL:MAKE-RANDOM-STATE, and must construct a
;;; freshly-initialized random state of the same class.  In this case
;;; that task is easy; we simply construct a new instance of this
;;; class, as we don’t need to do any initialization.

(defmethod make-random-state-like ((state /dev/urandom-state))
  (make-instance '/dev/urandom-state))

;;; COPY-RANDOM-STATE is called when CL:NIL or a CL:RANDOM-STATE
;;; object is passed to CL:MAKE-RANDOM-STATE, and should produce a
;;; copy of the CL:RANDOM-STATE argument it is given in the fifth
;;; sense of the CLHS glossary entry for “copy”: a state that will
;;; produce the same sequence of numbers if CL:RANDOM is called with
;;; the same arguments in the same order.  In this case, we can’t do
;;; that, so we signal an continuable error instead, allowing the user
;;; to generate a fresh random state instead.

(defmethod copy-random-state ((state /dev/urandom-state))
  (cerror "Create a fresh random state instead" "Cannot copy[5] ~S" state)
  (make-random-state-like state))

\documentclass{article}

\usepackage{fontspec}

\catcode`;=\active
\gdef;{\normalsize\rmfamily\catcode`\ =\active\relax\def\cpar{\ }\def\cspace{ }}
\catcode`\ =\active
\def\cspace{\catcode`;11\relax~}
\gdef {\cspace}
\gdef\cpar{\par}
\def\cnl{\catcode`;=\active\small\ttfamily\cpar\def\cpar{\par}\def\cspace{\catcode`;11\relax~}\relax}
\catcode`\^^M=\active\def^^M{\cnl}
\begin{document}
\input{random.lisp}
\end{document}