/usr/share/doc/stalin/benchmarks/fannkuch.sc is in stalin 0.11-5.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 | (define (fannkuch-1 n perm perm1 zaehl permmax)
(define (fill p n)
(do ((i 0 (+ i 1))) ((>= i n))
(vector-set! p i i)))
(define (vector-copy1 perm perm1 n)
(do ((i 0 (+ i 1))) ((>= i n))
(vector-set! perm i (vector-ref perm1 i))))
(define (vector-copy2 perm perm1 n)
(do ((i 0 (+ i 1))) ((>= i n))
(vector-set! perm i (vector-ref perm1 i))))
(define (flip k k2 perm n)
(do ((i 0 (+ i 1))) ((>= i k2))
(let* ((temp (vector-ref perm i))
(j (- k i)))
(vector-set! perm i (vector-ref perm j))
(vector-set! perm j temp))))
(define (kreuz-loop zaehl r)
(if (not (= r 1))
(let ((i (- r 1)))
(vector-set! zaehl i r)
(kreuz-loop zaehl i))))
(define (shift r perm1 n)
(let ((perm0 (vector-ref perm1 0)))
(let loop ((i 0))
(if (not (= i r))
(let ((k (+ i 1)))
(vector-set! perm1 i (vector-ref perm1 k))
(loop k))))
(vector-set! perm1 r perm0)))
(define (count-flips perm n)
(let loop ((count 0))
(let ((k (vector-ref perm 0)))
(cond ((= k 0) count)
(else (flip k (quotient (+ k 1) 2) perm n)
(loop (+ count 1)))))))
(fill perm1 n)
(let main ((bishmax -1)
(r n))
(kreuz-loop zaehl r)
(if (not (or (= (vector-ref perm1 0) 0)
(let ((i (- n 1))) (= (vector-ref perm1 i) i))))
(begin (vector-copy1 perm perm1 n)
(let ((count (count-flips perm n)))
(if (> count bishmax)
(begin (set! bishmax count)
(vector-copy2 permmax perm1 n))))))
(let loop ((r 1))
(cond ((= r n) bishmax)
(else (shift r perm1 n)
(let ((i (- (vector-ref zaehl r) 1)))
(vector-set! zaehl r i)
(if (<= i 0) (loop (+ r 1)) (main bishmax r))))))))
(define (fannkuch n)
(fannkuch-1 n
(make-vector n)
(make-vector n)
(make-vector n)
(make-vector n)))
(do ((i 0 (+ i 1))) ((= i 10))
(write (fannkuch 10))
(newline))
|