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

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

fix make reals type, add type for clock entropy

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