source: project/release/4/srfi-27/trunk/entropy-clock.scm @ 34208

Last change on this file since 34208 was 34208, checked in by kon, 18 months ago

fix bernoulli rand gen arg

File size: 1.3 KB
Line 
1;;;; entropy-clock.scm
2;;;; Kon Lovett, Oct '09
3
4(module entropy-clock
5
6(;export
7  make-entropy-source-system-clock)
8
9(import scheme)
10
11(import chicken foreign)
12
13(use entropy-source entropy-support)
14
15;;;
16
17#>
18#include <time.h>
19#include <math.h>
20
21static double
22f64init()
23{
24  return (double) time( NULL );
25}
26
27static double
28f64rand( double f64seed )
29{
30  double x = 11.0 + (25214903917.0 * f64seed);
31  return fmod( x, 281474976711000.0 ); /* actually remainder */
32}
33<#
34
35(define f64init (foreign-lambda double "f64init"))
36(define f64rand (foreign-lambda double "f64rand" double))
37
38;;; Entropy from system clock
39
40(define (make-entropy-source-system-clock)
41  (let* ((f64seed (f64init) )
42         (_f64rand
43          (lambda ()
44            (set! f64seed (f64rand f64seed))
45            f64seed ) ) )
46    (*make-entropy-source
47      ;
48      make-entropy-source-system-clock
49      ;
50      'system-clock
51      ;
52      "Entropy from system clock"
53      ;
54      (lambda ()
55        (make-entropic-u8/f64 _f64rand) )
56      ;
57      _f64rand
58      ;
59      (lambda (u8cnt u8vec)
60        (entropic-u8vector-filled/f64 u8cnt u8vec _f64rand) )
61      ;
62      (lambda (f64cnt f64vec)
63        (entropic-f64vector-filled f64cnt f64vec _f64rand) ) ) ) )
64
65(register-entropy-source! 'system-clock make-entropy-source-system-clock)
66
67) ;module entropy-clock
Note: See TracBrowser for help on using the repository browser.