summaryrefslogtreecommitdiff
path: root/tools
diff options
context:
space:
mode:
Diffstat (limited to 'tools')
-rw-r--r--tools/dup.scm2
-rw-r--r--tools/t101.scm2
-rw-r--r--tools/tbig.scm3
-rw-r--r--tools/tclo.scm2
-rw-r--r--tools/tcopy.scm2
-rw-r--r--tools/teq.scm2
-rwxr-xr-xtools/testsnd9
-rw-r--r--tools/tfft.scm3
-rw-r--r--tools/thash.scm7
-rw-r--r--tools/tmap.scm2
-rw-r--r--tools/tmisc.scm2
-rw-r--r--tools/tshoot.scm64
-rw-r--r--tools/tsort.scm4
-rw-r--r--tools/valcall.scm8
14 files changed, 84 insertions, 28 deletions
diff --git a/tools/dup.scm b/tools/dup.scm
index f5fc45f..217dc8c 100644
--- a/tools/dup.scm
+++ b/tools/dup.scm
@@ -4,7 +4,7 @@
;;; "alloc-lines" is any number bigger than the number of lines in "file"
;;; (dups 16 "s7.c" 91000) finds all 16-line matches in s7.c which (we wish) has less than 91000 lines in all
-(set! (*s7* 'heap-size) (* 2 1024000))
+;(set! (*s7* 'heap-size) (* 2 1024000))
(define dups
(let ((unique #f))
diff --git a/tools/t101.scm b/tools/t101.scm
index e2a8774..0470bc4 100644
--- a/tools/t101.scm
+++ b/tools/t101.scm
@@ -22,7 +22,7 @@
(let ((aux-file (format #f "t101-aux-~D.scm" (set! aux-counter (+ aux-counter 1)))))
(call-with-output-file aux-file
(lambda (p)
- (format p "(with-input-from-file \"all-lg-results\" (lambda () (display (with-output-to-string (lambda () (load \"s7test.scm\")))) (newline)))")
+ (format p "(with-input-from-file \"/home/bil/cl/all-lg-results\" (lambda () (display (with-output-to-string (lambda () (load \"s7test.scm\")))) (newline)))")
(format p "(load \"s7test.scm\")~%(exit)~%")))
(format *stderr* "~%~NC~%test: stdin from all-lg-results~%" 80 #\-)
(system (string-append "./repl " aux-file)))
diff --git a/tools/tbig.scm b/tools/tbig.scm
index b23aded..db14586 100644
--- a/tools/tbig.scm
+++ b/tools/tbig.scm
@@ -5,6 +5,7 @@
(set! (*s7* 'max-vector-length) (ash 1 36))
(set! (*s7* 'max-string-length) (ash 1 36))
(set! (*s7* 'safety) -1)
+;; setting heap-size slows us down
(load "s7test-block.so" (sublet (curlet) (cons 'init_func 'block_init)))
@@ -27,7 +28,6 @@
(define fft-size (ash 1 17))
(define little-size 1000000)
-
;; --------------------------------------------------------------------------------
(format () "complex fft...~%")
@@ -626,7 +626,6 @@
(float-vector-test)
(clear-and-gc)
-
(define (float-2d-fft rl n dir)
(when rl
(let ((tempr 0.0)
diff --git a/tools/tclo.scm b/tools/tclo.scm
index 64edf80..8de766b 100644
--- a/tools/tclo.scm
+++ b/tools/tclo.scm
@@ -1,3 +1,5 @@
+(set! (*s7* 'heap-size) (* 8 1024000))
+
(define* (f0 a b)
(display b #f))
diff --git a/tools/tcopy.scm b/tools/tcopy.scm
index 0d52cd8..4a75d87 100644
--- a/tools/tcopy.scm
+++ b/tools/tcopy.scm
@@ -2,7 +2,7 @@
;; depends on running s7test first normally
(load "s7test-block.so" new-env))
-(set! (*s7* 'heap-size) 1024000)
+;(set! (*s7* 'heap-size) 1024000)
(define (test-copy size)
(let ((old-string (make-string size #\a))
diff --git a/tools/teq.scm b/tools/teq.scm
index 0079ed7..d139619 100644
--- a/tools/teq.scm
+++ b/tools/teq.scm
@@ -1,6 +1,6 @@
;;; cyclic/shared timing tests
-(set! (*s7* 'heap-size) (* 2 1024000))
+;(set! (*s7* 'heap-size) (* 2 1024000))
;;; equal? write/object->string/format cyclic-sequences
diff --git a/tools/testsnd b/tools/testsnd
index d1ea149..6f8cad8 100755
--- a/tools/testsnd
+++ b/tools/testsnd
@@ -76,10 +76,10 @@ echo ' '
./snd -l snd-test
# ./snd lint.scm -e '(begin (lint "s7test.scm" #f) (exit))'
-cp s7test.scm tmptest.scm
-./snd tools/sed.scm -e '(sed "tmptest.scm" "tmp" "(define full-test #f)" "(define full-test #t)")'
-mv tmp tmptest.scm
-./snd tmptest.scm
+# cp s7test.scm tmptest.scm
+# ./snd tools/sed.scm -e '(sed "tmptest.scm" "tmp" "(define full-test #f)" "(define full-test #t)")'
+# mv tmp tmptest.scm
+# ./snd tmptest.scm
echo ' '
echo ' '
@@ -345,6 +345,7 @@ cp orig-snd-test.scm snd-test.scm
# sed snd-test.scm -e 's/(define test-at-random 0)/(define test-at-random 100)/g' > tmp
mv tmp snd-test.scm
+# this hangs sometimes?
echo ' '
echo ' '
./snd --version
diff --git a/tools/tfft.scm b/tools/tfft.scm
index 8da1272..55cc680 100644
--- a/tools/tfft.scm
+++ b/tools/tfft.scm
@@ -146,8 +146,7 @@
(fill! cdata 0.0)
(vector-set! cdata 2 1+i)
(vector-set! cdata (- n 1) 1-i)
- (cfft cdata)))
- )
+ (cfft cdata))))
(fft-bench)
diff --git a/tools/thash.scm b/tools/thash.scm
index 2003d91..1828322 100644
--- a/tools/thash.scm
+++ b/tools/thash.scm
@@ -28,9 +28,8 @@
(<= k start))
(+ k 1)))))
(when (> end start)
- (let* ((word (string->symbol (substring line start end)))
- (refs (or (hash-table-ref counts word) 0)))
- (hash-table-set! counts word (+ refs 1)))))
+ (let ((word (string->symbol (substring line start end))))
+ (hash-table-set! counts word (+ (or (hash-table-ref counts word) 0) 1)))))
(set! new-pos (+ pos 1))))
(close-input-port port)
@@ -83,7 +82,7 @@
(let ()
(define (hash-ints)
- (let ((counts (make-hash-table 8 = (cons integer? integer?))))
+ (let ((counts (make-hash-table)))
(do ((i 0 (+ i 1))
(z (random 100) (random 100)))
((= i 5000000) counts)
diff --git a/tools/tmap.scm b/tools/tmap.scm
index 4098d28..e96133d 100644
--- a/tools/tmap.scm
+++ b/tools/tmap.scm
@@ -1,6 +1,6 @@
;;; sequence tests
-(set! (*s7* 'heap-size) (* 4 1024000))
+;(set! (*s7* 'heap-size) (* 4 1024000))
(define (less-than a b)
(or (< a b) (> b a)))
diff --git a/tools/tmisc.scm b/tools/tmisc.scm
index 1984506..107219e 100644
--- a/tools/tmisc.scm
+++ b/tools/tmisc.scm
@@ -1,4 +1,4 @@
-(set! (*s7* 'heap-size) 1024000)
+(set! (*s7* 'heap-size) (* 2 1024000))
(define size 500000)
diff --git a/tools/tshoot.scm b/tools/tshoot.scm
index 9085c38..84bfdf5 100644
--- a/tools/tshoot.scm
+++ b/tools/tshoot.scm
@@ -176,7 +176,7 @@
(format *stderr* "~D~9Ttrees of depth ~D~30Tcheck: ~D~%" iterations depth check)))))
(format *stderr* "long lived tree of depth ~D~30Tcheck: ~D~%" max-depth (item-check long-lived-tree)))))))
-;(binary-tree 21) ; 26 secs
+;;(binary-tree 21) ; 20 secs
(binary-tree 6)
;;; stretch tree of depth 22 check: 8388607
@@ -217,7 +217,8 @@
;(collatz 300000)
;; Maximum stopping distance 442, starting number 230631
-;; .66 secs
+;; .6 secs
+
(collatz 20000)
;;; --------------------------------------------------------------------------------
@@ -240,16 +241,71 @@
(set! L (cdr L))))))))
(let ()
- (define (count-primes limit) ; for limit=10000000 12.7 secs 664579
+ (define (count-primes limit) ; for limit=10000000 12.3 secs 664579
(let ((primes 0))
(do ((i 2 (+ i 1)))
((= i limit)
primes)
(if (prime? i)
(set! primes (+ primes 1))))))
-
(display (count-primes 100000)) (newline)) ; 9592
;;; --------------------------------------------------------------------------------
+;;;
+;;; spectral-norm, based on code by Anthony Borla (Computer Benchmarks Game)
+
+(let ((weights #f))
+
+ (define (mulAv n v av)
+ (fill! av 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ (float-vector-set! av i (+ (float-vector-ref av i)
+ (* (/ 1.0 (+ i (float-vector-ref weights (+ i j))))
+ (float-vector-ref v j)))))))
+
+ (define (mulAtV n v atv)
+ (fill! atv 0.0)
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (do ((j 0 (+ j 1)))
+ ((= j n))
+ (float-vector-set! atv i (+ (float-vector-ref atv i)
+ (* (/ 1.0 (+ j (float-vector-ref weights (+ i j))))
+ (float-vector-ref v j)))))))
+
+ (define (mulAtAv n v atav)
+ (let ((u (make-float-vector n 0.0)))
+ (mulAv n v u)
+ (mulAtV n u atav)))
+
+ (define (spectral-norm n)
+ (let ((u (make-float-vector n 1.0))
+ (v (make-float-vector n 0.0))
+ (vBv 0.0) (vV 0.0))
+
+ (set! weights (make-float-vector (* 2 n)))
+ (do ((i 0 (+ i 1)))
+ ((= i (* 2 n)))
+ (float-vector-set! weights i (+ (* 0.5 i (+ i 1)) 1.0)))
+
+ (do ((i 0 (+ i 1)))
+ ((= i 10))
+ (mulAtAv n u v)
+ (mulAtAv n v u))
+
+ (do ((i 0 (+ i 1)))
+ ((= i n))
+ (set! vBv (+ vBv (* (float-vector-ref u i) (float-vector-ref v i))))
+ (set! vV (+ vV (* (float-vector-ref v i) (float-vector-ref v i)))))
+
+ (sqrt (/ vBv vV))))
+
+ (display (spectral-norm 125)) ; (spectral-norm 5500) takes about 19.4 secs
+ (newline))
+
+;;; --------------------------------------------------------------------------------
(exit)
diff --git a/tools/tsort.scm b/tools/tsort.scm
index adfb562..1d5b558 100644
--- a/tools/tsort.scm
+++ b/tools/tsort.scm
@@ -1,4 +1,4 @@
-(set! (*s7* 'heap-size) 1024000)
+;(set! (*s7* 'heap-size) 1024000)
(let ((size 100000))
(define (less a b)
@@ -12,7 +12,7 @@
(<= a b)))
(define (closure-less a b)
(and (< a b)
- (= (abs (+ (* 2 (- 3)) 1)) 5))) ; force all-x to give up!
+ (= (abs (+ (* 2 (- 3)) 1)) 5))) ; force optimizer to give up!
(define (begin-less a b)
(if (and (< a b) (> a b)) (display "oops"))
(< a b))
diff --git a/tools/valcall.scm b/tools/valcall.scm
index ab78110..58a1964 100644
--- a/tools/valcall.scm
+++ b/tools/valcall.scm
@@ -75,16 +75,16 @@
(list (list "repl" "tpeak.scm")
(list "repl" "tauto.scm")
- (list "repl" "tshoot.scm")
(list "repl" "tref.scm")
+ (list "repl" "tshoot.scm")
(list "snd -noinit" "make-index.scm")
(list "repl" "teq.scm")
(list "repl" "s7test.scm")
(list "repl" "tvect.scm")
(list "repl" "tmisc.scm")
(list "repl" "lt.scm")
- (list "repl" "tform.scm")
(list "repl" "tlet.scm")
+ (list "repl" "tform.scm")
(list "repl" "tcopy.scm")
(list "repl" "tread.scm")
(list "repl" "tclo.scm")
@@ -92,10 +92,10 @@
(list "repl" "fbench.scm")
(list "repl" "titer.scm")
(list "repl" "trclo.scm")
- (list "repl" "tset.scm")
- (list "repl" "dup.scm")
(list "repl" "tmap.scm")
+ (list "repl" "tset.scm")
(list "repl" "tsort.scm")
+ (list "repl" "dup.scm")
(list "repl" "tmac.scm")
(list "repl" "tfft.scm")
(list "repl" "trec.scm")
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-01 17:56:19 +0000