Changeset 35385 in project
- Timestamp:
- 04/07/18 22:57:39 (3 weeks ago)
- Location:
- release/4/srfi-27/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/srfi-27/trunk/mrg32k3a.scm
r34967 r35385 21 21 (import chicken foreign) 22 22 23 ( import23 (use 24 24 srfi-4 25 25 (only numbers <= inexact->exact exact->inexact number?) … … 31 31 check-positive-integer 32 32 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) 41 35 42 36 (declare … … 338 332 ; available this is not necessary, but pseudo-randomize! is expected 339 333 ; 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 #| 368 Undefined 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 382 ld: symbol(s) not found for architecture x86_64 383 clang: 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 340 417 341 418 (define mrg32k3a-pseudo-randomize-state … … 431 508 (set! mrg32k3a-gen2 (power A 16.0)) ) ) 432 509 ;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))))) ) 439 517 ;the new state 440 518 (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)) ) ) ) ) 447 525 448 526 ; G. Marsaglia's simple 16-bit generator with carry -
release/4/srfi-27/trunk/srfi-27.setup
r34974 r35385 89 89 #:inline? #t 90 90 #:types? #t 91 ;-c++ w/ crunch 91 92 #:compile-options `(-scrutinize ,@utiloptn) ) 92 93
Note: See TracChangeset
for help on using the changeset viewer.