Changeset 35385 in project

Timestamp:

04/07/18 22:57:39 (14 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:

• mrg32k3a.scm (modified) (4 diffs)
• srfi-27.setup (modified) (1 diff)

release/4/srfi-27/trunk/mrg32k3a.scm

@@ -21 +21 @@
 (import chicken foreign)
 
-(import
+(use
   srfi-4
   (only numbers <= inexact->exact exact->inexact number?)
@@ -31 +31 @@
     check-positive-integer
     random-large-integer random-large-real
-    native-real-precision?))
-(require-library
-  srfi-4
-  numbers
-  type-errors
-  random-source entropy-source
-  fp-utils
-  srfi-27-numbers)
+    native-real-precision?)
+  #;crunch)
 
 (declare
@@ -338 +332 @@
 ; available this is not necessary, but pseudo-randomize! is expected
 ; to be called only occasionally so we do not provide this implementation.
+
+#;
+(crunch
+  ;
+  (define (ring-lc a b i0 i1 i2 j0 j1 j2 m w-sqr) ;linear combination
+    (let ((fpW 65536.0)) ;wordsize to split {0..2^32-1}
+      (let (
+        (m::double m)
+        (w-sqr::double w-sqr)
+        (a0h (quotient (f64vector-ref a i0) fpW))
+        (a0l (modulo (f64vector-ref a i0) fpW))
+        (a1h (quotient (f64vector-ref a i1) fpW))
+        (a1l (modulo (f64vector-ref a i1) fpW))
+        (a2h (quotient (f64vector-ref a i2) fpW))
+        (a2l (modulo (f64vector-ref a i2) fpW))
+        (b0h (quotient (f64vector-ref b j0) fpW))
+        (b0l (modulo (f64vector-ref b j0) fpW))
+        (b1h (quotient (f64vector-ref b j1) fpW))
+        (b1l (modulo (f64vector-ref b j1) fpW))
+        (b2h (quotient (f64vector-ref b j2) fpW))
+        (b2l (modulo (f64vector-ref b j2) fpW)) )
+        (let (
+          (comb
+            (+
+              (+ (* (+ (* a0h b0h) (+ (* a1h b1h) (* a2h b2h))) w-sqr)
+                (* fpW
+                  (+ (* a0h b0l)
+                    (+ (* a0l b0h)
+                      (+ (* a1h b1l)
+                        (+ (* a1l b1h) (+ (* a2h b2l) (* a2l b2h))))))))
+              (+ (* a0l b0l) (+ (* a1l b1l) (* a2l b2l))))) )
+          ;
+          (modulo comb m) ) ) ) )
+#|
+Undefined symbols for architecture x86_64:
+  "vtable for __cxxabiv1::__class_type_info", referenced from:
+      typeinfo for crunch_buffer<double> in mrg32k3a.o
+  NOTE: a missing vtable usually means the first non-inline virtual member function has no definition.
+  "vtable for __cxxabiv1::__si_class_type_info", referenced from:
+      typeinfo for crunch_vector<double> in mrg32k3a.o
+  NOTE: a missing vtable usually means the first non-inline virtual member function has no definition.
+  "operator delete(void*)", referenced from:
+      crunch_vector<double>::~crunch_vector() in mrg32k3a.o
+      crunch_buffer<double>::~crunch_buffer() in mrg32k3a.o
+  "___gxx_personality_v0", referenced from:
+      f229(crunch_vector<double>, crunch_vector<double>, crunch_vector<double>) in mrg32k3a.o
+      stub829(long, long, long, long) in mrg32k3a.o
+      Dwarf Exception Unwind Info (__eh_frame) in mrg32k3a.o
+ld: symbol(s) not found for architecture x86_64
+clang: error: linker command failed with exit code 1 (use -v to see invocation)
+|#
+  #; ;
+  (define (ring-product! v a b) ;A*B in ((Z/m1*Z) x (Z/m2*Z))^(3x3)
+    (let (
+      (fpM1 4294967087.0)   ;modulus of component 1
+      (fpM2 4294944443.0)   ;modulus of component 2
+      (fpW-SQR1 209.0)
+      (fpW-SQR2 22853.0) )
+      ;
+      (f64vector-set! v 0 (ring-lc a b  0  1  2   0  3  6  fpM1 fpW-SQR1)) ;(A*B)_00 mod m1
+      (f64vector-set! v 1 (ring-lc a b  0  1  2   1  4  7  fpM1 fpW-SQR1)) ;(A*B)_01
+      (f64vector-set! v 2 (ring-lc a b  0  1  2   2  5  8  fpM1 fpW-SQR1))
+      (f64vector-set! v 3 (ring-lc a b  3  4  5   0  3  6  fpM1 fpW-SQR1)) ;(A*B)_10
+      (f64vector-set! v 4 (ring-lc a b  3  4  5   1  4  7  fpM1 fpW-SQR1))
+      (f64vector-set! v 5 (ring-lc a b  3  4  5   2  5  8  fpM1 fpW-SQR1))
+      (f64vector-set! v 6 (ring-lc a b  6  7  8   0  3  6  fpM1 fpW-SQR1))
+      (f64vector-set! v 7 (ring-lc a b  6  7  8   1  4  7  fpM1 fpW-SQR1))
+      (f64vector-set! v 8 (ring-lc a b  6  7  8   2  5  8  fpM1 fpW-SQR1))
+      (f64vector-set! v 9 (ring-lc a b  9 10 11   9 12 15  fpM2 fpW-SQR2)) ;(A*B)_00 mod m2
+      (f64vector-set! v 10 (ring-lc a b  9 10 11  10 13 16  fpM2 fpW-SQR2))
+      (f64vector-set! v 11 (ring-lc a b  9 10 11  11 14 17  fpM2 fpW-SQR2))
+      (f64vector-set! v 12 (ring-lc a b 12 13 14   9 12 15  fpM2 fpW-SQR2))
+      (f64vector-set! v 13 (ring-lc a b 12 13 14  10 13 16  fpM2 fpW-SQR2))
+      (f64vector-set! v 14 (ring-lc a b 12 13 14  11 14 17  fpM2 fpW-SQR2))
+      (f64vector-set! v 15 (ring-lc a b 15 16 17   9 12 15  fpM2 fpW-SQR2))
+      (f64vector-set! v 16 (ring-lc a b 15 16 17  10 13 16  fpM2 fpW-SQR2))
+      (f64vector-set! v 17 (ring-lc a b 15 16 17  11 14 17  fpM2 fpW-SQR2)) )
+      ;
+      (void) )
+)
+
+(define-constant fpW-SQR1 209.0)   ;w^2 mod m1
+(define-constant fpW-SQR2 22853.0) ;w^2 mod m2
 
 (define mrg32k3a-pseudo-randomize-state
@@ -431 +508 @@
           (set! mrg32k3a-gen2 (power A 16.0)) ) )
       ;compute M = A^(16 + i*2^127 + j*2^76)
-      (let ((M
-              (product
-                mrg32k3a-gen2
-                (product
-                  (power mrg32k3a-gen0 (fpmodulo i fp2^28))
-                  (power mrg32k3a-gen1 (fpmodulo j fp2^28))))))
+      (let (
+        (M
+          (product
+            mrg32k3a-gen2
+            (product
+              (power mrg32k3a-gen0 (fpmodulo i fp2^28))
+              (power mrg32k3a-gen1 (fpmodulo j fp2^28))))) )
         ;the new state
         (f64vector
-         (f64vector-ref M 0)
-         (f64vector-ref M 3)
-         (f64vector-ref M 6)
-         (f64vector-ref M 9)
-         (f64vector-ref M 12)
-         (f64vector-ref M 15)) ) ) ) )
+          (f64vector-ref M 0)
+          (f64vector-ref M 3)
+          (f64vector-ref M 6)
+          (f64vector-ref M 9)
+          (f64vector-ref M 12)
+          (f64vector-ref M 15)) ) ) ) )
 
 ; G. Marsaglia's simple 16-bit generator with carry

release/4/srfi-27/trunk/srfi-27.setup

@@ -89 +89 @@
   #:inline? #t
   #:types? #t
+  ;-c++ w/ crunch
   #:compile-options `(-scrutinize ,@utiloptn) )