fannkuch-redux Lisp SBCL #2 program
source code
;; The Computer Language Benchmarks Game
;; http://benchmarksgame.alioth.debian.org/
;;;
;;; By Jon Smith
;;; Tranlated from OCaml implementation by ?, who translated it from
;;; the Scala implementation by Otto Bommer.
;;;
;;; This is a single core implementation.
;;; I am sure that this program can be improved upon quite a lot.
;;; Most likely it will involve knowing how sbcl does its optimizations.
;;; As you can see, I simply used fixnums everywhere. There may be a better choice.
;;;
;;; To compile
;;; sbcl --load fannkuch.lisp --eval "(save-lisp-and-die \"fannkuch.core\" :purify t :toplevel (lambda () (main) (quit)))"
;;; To run
;;; sbcl --noinform --core fannkuch.core %A
(declaim (optimize (speed 3) (safety 0) (space 1) (debug 0)))
(defun fannkuch (n)
(declare (type fixnum n))
(let ((csum 0)
(fmax 0))
(declare (type fixnum fmax))
(let ((perm (make-array n :element-type 'fixnum))
(copy (make-array n :element-type 'fixnum))
(num 0))
(loop for i from 0 to (- n 1) do (setf (aref perm i) i))
(labels ((do-iter (ht)
(declare (type fixnum ht))
(if (= ht 1)
(progn
(loop for i from 0 to (- n 1) do (setf (aref copy i) (aref perm i)))
(let ((c 0))
(declare (type fixnum c))
(let ((z (aref copy 0)))
(loop until (= z 0) do
(progn
(loop for i from 0 to (ash z -1)
do (let ((temp (aref copy i))
(k (- z i)))
(setf (aref copy i) (aref copy k))
(setf (aref copy k) temp)))
(incf c)
(setf z (aref copy 0)))))
(setf csum (+ csum (if (evenp num) c (- c))))
(when (> c fmax)
(setf fmax c)))
(incf num))
(loop for i from 1 to ht do
(progn (do-iter (- ht 1))
(let ((temp (aref perm 0))
(m (- ht 1)))
(loop for i from 1 to m do
(setf (aref perm (- i 1)) (aref perm i)))
(setf (aref perm m) temp)))))))
(do-iter n)))
(format t "~s~%Pfannkuchen(~s) = ~s~%" csum n fmax)))
(defun main ()
(let* ((args (cdr sb-ext:*posix-argv*))
(n (parse-integer (car args))))
(fannkuch n)))
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
SBCL 1.4.0
Thu, 26 Oct 2017 16:35:05 GMT
MAKE:
cp: 'fannkuchredux.sbcl-2.sbcl' and './fannkuchredux.sbcl-2.sbcl' are the same file
SBCL built with: /opt/src/sbcl-1.4.0/bin/sbcl --userinit /dev/null --batch --eval '(load "fannkuchredux.sbcl-2.sbcl_compile")'
### START fannkuchredux.sbcl-2.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql (lambda (c) (abort c)))) (load (compile-file "fannkuchredux.sbcl-2.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END fannkuchredux.sbcl-2.sbcl_compile
; compiling file "/home/dunham/benchmarksgame/bench/fannkuchredux/fannkuchredux.sbcl-2.sbcl" (written 24 JAN 2013 01:22:33 PM):
; compiling (DECLAIM (OPTIMIZE # ...))
; compiling (DEFUN FANNKUCH ...)
; file: /home/dunham/benchmarksgame/bench/fannkuchredux/fannkuchredux.sbcl-2.sbcl
; in: DEFUN FANNKUCH
; (INCF NUM)
; --> SETQ THE
; ==>
; (+ 1 NUM)
;
; note: unable to
; associate +/+ of constants
; due to type uncertainty:
; The first argument is a NUMBER, not a RATIONAL.
;
; note: unable to
; associate +/- of constants
; due to type uncertainty:
; The first argument is a NUMBER, not a RATIONAL.
; (+ CSUM
; (IF (EVENP NUM)
; C
; (- C)))
;
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline (signed-byte 64) arithmetic (cost 5) because:
; The first argument is a NUMBER, not a (SIGNED-BYTE 64).
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES (SIGNED-BYTE 64)
; &REST T).
; etc.
; (INCF NUM)
; --> SETQ THE
; ==>
; (+ 1 NUM)
;
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline fixnum arithmetic (cost 1) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a NUMBER, not a FIXNUM.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES FIXNUM &REST T).
; etc.
; compiling (DEFUN MAIN ...);
; compilation unit finished
; printed 4 notes
; /home/dunham/benchmarksgame_quadcore/fannkuchredux/tmp/fannkuchredux.sbcl-2.fasl written
; compilation finished in 0:00:00.020
### START fannkuchredux.sbcl-2.sbcl_run
(main) (quit)
### END fannkuchredux.sbcl-2.sbcl_run
3.49s to complete and log all make actions
COMMAND LINE:
/opt/src/sbcl-1.4.0/bin/sbcl --noinform --core sbcl.core --userinit /dev/null --load fannkuchredux.sbcl-2.sbcl_run 12
PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65