Changeset 35385 in project
 Timestamp:
 04/07/18 22:57:39 (8 months ago)
 Location:
 release/4/srfi27/trunk
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

release/4/srfi27/trunk/mrg32k3a.scm
r34967 r35385 21 21 (import chicken foreign) 22 22 23 ( import23 (use 24 24 srfi4 25 25 (only numbers <= inexact>exact exact>inexact number?) … … 31 31 checkpositiveinteger 32 32 randomlargeinteger randomlargereal 33 nativerealprecision?)) 34 (requirelibrary 35 srfi4 36 numbers 37 typeerrors 38 randomsource entropysource 39 fputils 40 srfi27numbers) 33 nativerealprecision?) 34 #;crunch) 41 35 42 36 (declare … … 338 332 ; available this is not necessary, but pseudorandomize! is expected 339 333 ; to be called only occasionally so we do not provide this implementation. 334 335 #; 336 (crunch 337 ; 338 (define (ringlc a b i0 i1 i2 j0 j1 j2 m wsqr) ;linear combination 339 (let ((fpW 65536.0)) ;wordsize to split {0..2^321} 340 (let ( 341 (m::double m) 342 (wsqr::double wsqr) 343 (a0h (quotient (f64vectorref a i0) fpW)) 344 (a0l (modulo (f64vectorref a i0) fpW)) 345 (a1h (quotient (f64vectorref a i1) fpW)) 346 (a1l (modulo (f64vectorref a i1) fpW)) 347 (a2h (quotient (f64vectorref a i2) fpW)) 348 (a2l (modulo (f64vectorref a i2) fpW)) 349 (b0h (quotient (f64vectorref b j0) fpW)) 350 (b0l (modulo (f64vectorref b j0) fpW)) 351 (b1h (quotient (f64vectorref b j1) fpW)) 352 (b1l (modulo (f64vectorref b j1) fpW)) 353 (b2h (quotient (f64vectorref b j2) fpW)) 354 (b2l (modulo (f64vectorref b j2) fpW)) ) 355 (let ( 356 (comb 357 (+ 358 (+ (* (+ (* a0h b0h) (+ (* a1h b1h) (* a2h b2h))) wsqr) 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 noninline 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 noninline 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 (ringproduct! 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 (fpWSQR1 209.0) 391 (fpWSQR2 22853.0) ) 392 ; 393 (f64vectorset! v 0 (ringlc a b 0 1 2 0 3 6 fpM1 fpWSQR1)) ;(A*B)_00 mod m1 394 (f64vectorset! v 1 (ringlc a b 0 1 2 1 4 7 fpM1 fpWSQR1)) ;(A*B)_01 395 (f64vectorset! v 2 (ringlc a b 0 1 2 2 5 8 fpM1 fpWSQR1)) 396 (f64vectorset! v 3 (ringlc a b 3 4 5 0 3 6 fpM1 fpWSQR1)) ;(A*B)_10 397 (f64vectorset! v 4 (ringlc a b 3 4 5 1 4 7 fpM1 fpWSQR1)) 398 (f64vectorset! v 5 (ringlc a b 3 4 5 2 5 8 fpM1 fpWSQR1)) 399 (f64vectorset! v 6 (ringlc a b 6 7 8 0 3 6 fpM1 fpWSQR1)) 400 (f64vectorset! v 7 (ringlc a b 6 7 8 1 4 7 fpM1 fpWSQR1)) 401 (f64vectorset! v 8 (ringlc a b 6 7 8 2 5 8 fpM1 fpWSQR1)) 402 (f64vectorset! v 9 (ringlc a b 9 10 11 9 12 15 fpM2 fpWSQR2)) ;(A*B)_00 mod m2 403 (f64vectorset! v 10 (ringlc a b 9 10 11 10 13 16 fpM2 fpWSQR2)) 404 (f64vectorset! v 11 (ringlc a b 9 10 11 11 14 17 fpM2 fpWSQR2)) 405 (f64vectorset! v 12 (ringlc a b 12 13 14 9 12 15 fpM2 fpWSQR2)) 406 (f64vectorset! v 13 (ringlc a b 12 13 14 10 13 16 fpM2 fpWSQR2)) 407 (f64vectorset! v 14 (ringlc a b 12 13 14 11 14 17 fpM2 fpWSQR2)) 408 (f64vectorset! v 15 (ringlc a b 15 16 17 9 12 15 fpM2 fpWSQR2)) 409 (f64vectorset! v 16 (ringlc a b 15 16 17 10 13 16 fpM2 fpWSQR2)) 410 (f64vectorset! v 17 (ringlc a b 15 16 17 11 14 17 fpM2 fpWSQR2)) ) 411 ; 412 (void) ) 413 ) 414 415 (defineconstant fpWSQR1 209.0) ;w^2 mod m1 416 (defineconstant fpWSQR2 22853.0) ;w^2 mod m2 340 417 341 418 (define mrg32k3apseudorandomizestate … … 431 508 (set! mrg32k3agen2 (power A 16.0)) ) ) 432 509 ;compute M = A^(16 + i*2^127 + j*2^76) 433 (let ((M 434 (product 435 mrg32k3agen2 436 (product 437 (power mrg32k3agen0 (fpmodulo i fp2^28)) 438 (power mrg32k3agen1 (fpmodulo j fp2^28)))))) 510 (let ( 511 (M 512 (product 513 mrg32k3agen2 514 (product 515 (power mrg32k3agen0 (fpmodulo i fp2^28)) 516 (power mrg32k3agen1 (fpmodulo j fp2^28))))) ) 439 517 ;the new state 440 518 (f64vector 441 (f64vectorref M 0)442 (f64vectorref M 3)443 (f64vectorref M 6)444 (f64vectorref M 9)445 (f64vectorref M 12)446 (f64vectorref M 15)) ) ) ) )519 (f64vectorref M 0) 520 (f64vectorref M 3) 521 (f64vectorref M 6) 522 (f64vectorref M 9) 523 (f64vectorref M 12) 524 (f64vectorref M 15)) ) ) ) ) 447 525 448 526 ; G. Marsaglia's simple 16bit generator with carry 
release/4/srfi27/trunk/srfi27.setup
r34974 r35385 89 89 #:inline? #t 90 90 #:types? #t 91 ;c++ w/ crunch 91 92 #:compileoptions `(scrutinize ,@utiloptn) ) 92 93
Note: See TracChangeset
for help on using the changeset viewer.