Ignore:
Timestamp:
04/29/18 16:18:57 (7 months ago)
Author:
kon
Message:

fix make reals type, add type for clock entropy

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/entropy-clock.scm

    r34208 r35473  
    77  make-entropy-source-system-clock)
    88
    9 (import scheme)
    10 
    11 (import chicken foreign)
     9(import scheme chicken foreign)
    1210
    1311(use entropy-source entropy-support)
     
    1816#include <time.h>
    1917#include <math.h>
    20 
    21 static double
    22 f64init()
    23 {
    24   return (double) time( NULL );
    25 }
    26 
    27 static double
    28 f64rand( double f64seed )
    29 {
    30   double x = 11.0 + (25214903917.0 * f64seed);
    31   return fmod( x, 281474976711000.0 ); /* actually remainder */
    32 }
     18/* linear congruential generator */
     19#define MULTIPLIER  25214903917.0
     20#define LIMITER     81474976711000.0
    3321<#
    3422
    35 (define f64init (foreign-lambda double "f64init"))
    36 (define f64rand (foreign-lambda double "f64rand" double))
     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")
    3733
    3834;;; Entropy from system clock
    3935
     36(: make-entropy-source-system-clock (--> entropy-source))
     37;
    4038(define (make-entropy-source-system-clock)
    41   (let* ((f64seed (f64init) )
    42          (_f64rand
    43           (lambda ()
    44             (set! f64seed (f64rand f64seed))
    45             f64seed ) ) )
     39  (let* (
     40    (*f64seed* (f64init))
     41    (*f64rand*
     42      (lambda ()
     43        (set! *f64seed* (f64rand *f64seed*))
     44        *f64seed*)) )
    4645    (*make-entropy-source
    4746      ;
     
    5352      ;
    5453      (lambda ()
    55         (make-entropic-u8/f64 _f64rand) )
     54        (make-entropic-u8/f64 *f64rand*) )
    5655      ;
    57       _f64rand
     56      *f64rand*
    5857      ;
    5958      (lambda (u8cnt u8vec)
    60         (entropic-u8vector-filled/f64 u8cnt u8vec _f64rand) )
     59        (entropic-u8vector-filled/f64 u8cnt u8vec *f64rand*) )
    6160      ;
    6261      (lambda (f64cnt f64vec)
    63         (entropic-f64vector-filled f64cnt f64vec _f64rand) ) ) ) )
     62        (entropic-f64vector-filled f64cnt f64vec *f64rand*) ) ) ) )
    6463
    6564(register-entropy-source! 'system-clock make-entropy-source-system-clock)
Note: See TracChangeset for help on using the changeset viewer.