Changeset 35385 in project


Ignore:
Timestamp:
04/07/18 22:57:39 (8 months ago)
Author:
kon
Message:

crunch kinda works for me but wtf is it doing w/ dtors, & anyway yet another dependency

Location:
release/4/srfi-27/trunk
Files:
2 edited

Legend:

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

    r34967 r35385  
    2121(import chicken foreign)
    2222
    23 (import
     23(use
    2424  srfi-4
    2525  (only numbers <= inexact->exact exact->inexact number?)
     
    3131    check-positive-integer
    3232    random-large-integer random-large-real
    33     native-real-precision?))
    34 (require-library
    35   srfi-4
    36   numbers
    37   type-errors
    38   random-source entropy-source
    39   fp-utils
    40   srfi-27-numbers)
     33    native-real-precision?)
     34  #;crunch)
    4135
    4236(declare
     
    338332; available this is not necessary, but pseudo-randomize! is expected
    339333; to be called only occasionally so we do not provide this implementation.
     334
     335#;
     336(crunch
     337  ;
     338  (define (ring-lc a b i0 i1 i2 j0 j1 j2 m w-sqr) ;linear combination
     339    (let ((fpW 65536.0)) ;wordsize to split {0..2^32-1}
     340      (let (
     341        (m::double m)
     342        (w-sqr::double w-sqr)
     343        (a0h (quotient (f64vector-ref a i0) fpW))
     344        (a0l (modulo (f64vector-ref a i0) fpW))
     345        (a1h (quotient (f64vector-ref a i1) fpW))
     346        (a1l (modulo (f64vector-ref a i1) fpW))
     347        (a2h (quotient (f64vector-ref a i2) fpW))
     348        (a2l (modulo (f64vector-ref a i2) fpW))
     349        (b0h (quotient (f64vector-ref b j0) fpW))
     350        (b0l (modulo (f64vector-ref b j0) fpW))
     351        (b1h (quotient (f64vector-ref b j1) fpW))
     352        (b1l (modulo (f64vector-ref b j1) fpW))
     353        (b2h (quotient (f64vector-ref b j2) fpW))
     354        (b2l (modulo (f64vector-ref b j2) fpW)) )
     355        (let (
     356          (comb
     357            (+
     358              (+ (* (+ (* a0h b0h) (+ (* a1h b1h) (* a2h b2h))) w-sqr)
     359                (* fpW
     360                  (+ (* a0h b0l)
     361                    (+ (* a0l b0h)
     362                      (+ (* a1h b1l)
     363                        (+ (* a1l b1h) (+ (* a2h b2l) (* a2l b2h))))))))
     364              (+ (* a0l b0l) (+ (* a1l b1l) (* a2l b2l))))) )
     365          ;
     366          (modulo comb m) ) ) ) )
     367#|
     368Undefined symbols for architecture x86_64:
     369  "vtable for __cxxabiv1::__class_type_info", referenced from:
     370      typeinfo for crunch_buffer<double> in mrg32k3a.o
     371  NOTE: a missing vtable usually means the first non-inline virtual member function has no definition.
     372  "vtable for __cxxabiv1::__si_class_type_info", referenced from:
     373      typeinfo for crunch_vector<double> in mrg32k3a.o
     374  NOTE: a missing vtable usually means the first non-inline virtual member function has no definition.
     375  "operator delete(void*)", referenced from:
     376      crunch_vector<double>::~crunch_vector() in mrg32k3a.o
     377      crunch_buffer<double>::~crunch_buffer() in mrg32k3a.o
     378  "___gxx_personality_v0", referenced from:
     379      f229(crunch_vector<double>, crunch_vector<double>, crunch_vector<double>) in mrg32k3a.o
     380      stub829(long, long, long, long) in mrg32k3a.o
     381      Dwarf Exception Unwind Info (__eh_frame) in mrg32k3a.o
     382ld: symbol(s) not found for architecture x86_64
     383clang: error: linker command failed with exit code 1 (use -v to see invocation)
     384|#
     385  #; ;
     386  (define (ring-product! v a b) ;A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
     387    (let (
     388      (fpM1 4294967087.0)   ;modulus of component 1
     389      (fpM2 4294944443.0)   ;modulus of component 2
     390      (fpW-SQR1 209.0)
     391      (fpW-SQR2 22853.0) )
     392      ;
     393      (f64vector-set! v 0 (ring-lc a b  0  1  2   0  3  6  fpM1 fpW-SQR1)) ;(A*B)_00 mod m1
     394      (f64vector-set! v 1 (ring-lc a b  0  1  2   1  4  7  fpM1 fpW-SQR1)) ;(A*B)_01
     395      (f64vector-set! v 2 (ring-lc a b  0  1  2   2  5  8  fpM1 fpW-SQR1))
     396      (f64vector-set! v 3 (ring-lc a b  3  4  5   0  3  6  fpM1 fpW-SQR1)) ;(A*B)_10
     397      (f64vector-set! v 4 (ring-lc a b  3  4  5   1  4  7  fpM1 fpW-SQR1))
     398      (f64vector-set! v 5 (ring-lc a b  3  4  5   2  5  8  fpM1 fpW-SQR1))
     399      (f64vector-set! v 6 (ring-lc a b  6  7  8   0  3  6  fpM1 fpW-SQR1))
     400      (f64vector-set! v 7 (ring-lc a b  6  7  8   1  4  7  fpM1 fpW-SQR1))
     401      (f64vector-set! v 8 (ring-lc a b  6  7  8   2  5  8  fpM1 fpW-SQR1))
     402      (f64vector-set! v 9 (ring-lc a b  9 10 11   9 12 15  fpM2 fpW-SQR2)) ;(A*B)_00 mod m2
     403      (f64vector-set! v 10 (ring-lc a b  9 10 11  10 13 16  fpM2 fpW-SQR2))
     404      (f64vector-set! v 11 (ring-lc a b  9 10 11  11 14 17  fpM2 fpW-SQR2))
     405      (f64vector-set! v 12 (ring-lc a b 12 13 14   9 12 15  fpM2 fpW-SQR2))
     406      (f64vector-set! v 13 (ring-lc a b 12 13 14  10 13 16  fpM2 fpW-SQR2))
     407      (f64vector-set! v 14 (ring-lc a b 12 13 14  11 14 17  fpM2 fpW-SQR2))
     408      (f64vector-set! v 15 (ring-lc a b 15 16 17   9 12 15  fpM2 fpW-SQR2))
     409      (f64vector-set! v 16 (ring-lc a b 15 16 17  10 13 16  fpM2 fpW-SQR2))
     410      (f64vector-set! v 17 (ring-lc a b 15 16 17  11 14 17  fpM2 fpW-SQR2)) )
     411      ;
     412      (void) )
     413)
     414
     415(define-constant fpW-SQR1 209.0)   ;w^2 mod m1
     416(define-constant fpW-SQR2 22853.0) ;w^2 mod m2
    340417
    341418(define mrg32k3a-pseudo-randomize-state
     
    431508          (set! mrg32k3a-gen2 (power A 16.0)) ) )
    432509      ;compute M = A^(16 + i*2^127 + j*2^76)
    433       (let ((M
    434               (product
    435                 mrg32k3a-gen2
    436                 (product
    437                   (power mrg32k3a-gen0 (fpmodulo i fp2^28))
    438                   (power mrg32k3a-gen1 (fpmodulo j fp2^28))))))
     510      (let (
     511        (M
     512          (product
     513            mrg32k3a-gen2
     514            (product
     515              (power mrg32k3a-gen0 (fpmodulo i fp2^28))
     516              (power mrg32k3a-gen1 (fpmodulo j fp2^28))))) )
    439517        ;the new state
    440518        (f64vector
    441          (f64vector-ref M 0)
    442          (f64vector-ref M 3)
    443          (f64vector-ref M 6)
    444          (f64vector-ref M 9)
    445          (f64vector-ref M 12)
    446          (f64vector-ref M 15)) ) ) ) )
     519          (f64vector-ref M 0)
     520          (f64vector-ref M 3)
     521          (f64vector-ref M 6)
     522          (f64vector-ref M 9)
     523          (f64vector-ref M 12)
     524          (f64vector-ref M 15)) ) ) ) )
    447525
    448526; G. Marsaglia's simple 16-bit generator with carry
  • release/4/srfi-27/trunk/srfi-27.setup

    r34974 r35385  
    8989  #:inline? #t
    9090  #:types? #t
     91  ;-c++ w/ crunch
    9192  #:compile-options `(-scrutinize ,@utiloptn) )
    9293
Note: See TracChangeset for help on using the changeset viewer.