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

Last change on this file since 35473 was 35473, checked in by kon, 7 months ago

fix make reals type, add type for clock entropy

File size: 1.4 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 chicken foreign)
10
11(use entropy-source entropy-support)
12
13;;;
14
15#>
16#include <time.h>
17#include <math.h>
18/* linear congruential generator */
19#define MULTIPLIER  25214903917.0
20#define LIMITER     81474976711000.0
21<#
22
23(define f64init (foreign-lambda* double ()
24  "C_return( (double) time( NULL ) );"))
25
26(define f64rand (foreign-lambda* double ((double f64seed))
27  "double x = 11.0 + (MULTIPLIER * f64seed);
28  C_return( fmod( x, LIMITER ) );"))
29
30;;;
31
32(include "srfi-27-common-types")
33
34;;; Entropy from system clock
35
36(: make-entropy-source-system-clock (--> entropy-source))
37;
38(define (make-entropy-source-system-clock)
39  (let* (
40    (*f64seed* (f64init))
41    (*f64rand*
42      (lambda ()
43        (set! *f64seed* (f64rand *f64seed*))
44        *f64seed*)) )
45    (*make-entropy-source
46      ;
47      make-entropy-source-system-clock
48      ;
49      'system-clock
50      ;
51      "Entropy from system clock"
52      ;
53      (lambda ()
54        (make-entropic-u8/f64 *f64rand*) )
55      ;
56      *f64rand*
57      ;
58      (lambda (u8cnt u8vec)
59        (entropic-u8vector-filled/f64 u8cnt u8vec *f64rand*) )
60      ;
61      (lambda (f64cnt f64vec)
62        (entropic-f64vector-filled f64cnt f64vec *f64rand*) ) ) ) )
63
64(register-entropy-source! 'system-clock make-entropy-source-system-clock)
65
66) ;module entropy-clock
Note: See TracBrowser for help on using the repository browser.