Ubuntu : Intel® Q6600® one core
Computer Language Benchmarks Game      [[ Play ]]

- all benchmarks - n-body fannkuch-redux meteor-contest fasta fasta-redux spectral-norm reverse-complement mandelbrot k-nucleotide regex-dna pidigits chameneos-redux thread-ring binary-trees-redux binary-trees - all languages - Ada 2005 GNAT ATS C CINT C gcc Clojure C# Mono C++ g++ Dart Erlang HiPE F# Mono Fortran Intel Go Haskell GHC Java 7 JavaScript V8 Lisp SBCL Lua OCaml Pascal Free Pascal Perl PHP Python 3 Racket Ruby 2.0 Ruby JRuby Scala Smalltalk VisualWorks x86 one core x64 quad-core x86 quad-core x64 one core

 performance measurements

Each table row shows performance measurements for this Lisp SBCL program with a particular command-line input value N.

N	CPU secs	Elapsed secs	Memory KB	Code B	≈ CPU Load
10	0.44	0.44	12,684	821	0% 0% 4% 98%
11	5.12	5.12	13,212	821	0% 4% 3% 100%
12	61.48	61.50	13,744	821	0% 0% 0% 100%

Read the ↓ make, command line, and program output logs to see how this program was run.

Read fannkuch-redux benchmark to see what this program should do.

 notes

This is SBCL 1.1.7, an implementation of ANSI Common Lisp.

 fannkuch-redux Lisp SBCL #3 program source code

;;   The Computer Language Benchmarks Game
;;   http://benchmarksgame.alioth.debian.org/
;;;
;;; By Jon Smith (rev 3) added some more declarations.
;;; 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

;(setf *efficiency-note-cost-threshold* 1)
;(setf *efficiency-note-limit* 8)

(declaim (optimize (speed 3) (safety 0) (space 1) (debug 0)))

(defmacro sb (a) `(the fixnum ,a))
(deftype sb () 'fixnum)

(defmacro setlambda(n)
  (declare (type fixnum n))
  (let ((copy (gensym))
	(perm (gensym)))
  `(lambda (,perm ,copy)
     (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
      (type (simple-array sb (,n)) ,copy ,perm))
     ,@(loop for i of-type fixnum from 0 below n collect
	    `(setf (aref ,copy ,i) (aref ,perm ,i))))))

(defmacro countfliplambda (n)
  (declare (type fixnum n))
  (let ((copy (gensym))
	(c (gensym))
	(z (gensym)))
    `(lambda (,copy &aux (,c 0))
       (declare (optimize (speed 3) (safety 0) (space 0) (debug 0))
		(type sb ,c)
		(type (simple-array sb (,n)) ,copy))
       (let ((,z (aref ,copy 0)))
	 (loop until (= ,z 0) do
	      (progn
		(case ,z 
		  ,@(loop for i of-type sb from 1 to (- n 1) collect
			 `(,i
			   ,@(loop for j of-type sb from 0 to (ash i -1)
				if (not (= j (- i j)))
				collect `(rotatef (aref ,copy ,j) 
						  (aref ,copy ,(- i j)))))))
		(incf ,c)
		(setf ,z (aref ,copy 0)))))
       ,c)))

(defun fannkuch (n)
  (declare (type sb n))
  (let ((csum 0)
	(fmax 0))
    (declare (type sb csum fmax))
    (let ((perm (make-array n :element-type 'fixnum))
	  (copy (make-array n :element-type 'fixnum))
	  (num 0)
	  (cflip (the (function ((simple-array sb (*)))) (eval `(countfliplambda ,n))))
	  (copyfn (the (function ((simple-array sb (*)) (simple-array sb (*)))) (eval `(setlambda ,n)))))
      (declare (type (simple-array sb (*)) perm copy)
	       (type sb num))

      (loop for i from 0 to (- n 1) do (setf (aref perm i) i))
      
      (labels ((do-iter (ht)
		 (declare (type sb ht))
		 (if (= ht 1)
		     (progn
		       (funcall copyfn perm copy)
		       (let ((c (funcall cflip copy)))
			 (declare (type sb c))
			 (setf csum (sb (+ csum  (sb (if (evenp num) c (- c))))))
			 (when (> c fmax)
			   (setf fmax c)))
		       (incf num))
		     (loop for i of-type sb from 1 to ht do
			  (let ((m (- ht 1))) 
			    (do-iter m)
			    (let ((temp (aref perm 0)))
			      (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)))

 make, command-line, and program output logs

Fri, 03 May 2013 21:51:28 GMT

MAKE:
cp: ‘fannkuchredux.sbcl-3.sbcl’ and ‘./fannkuchredux.sbcl-3.sbcl’ are the same file
SBCL built with: /usr/local/bin/sbcl --userinit /dev/null --batch --eval '(load "fannkuchredux.sbcl-3.sbcl_compile")'
### START fannkuchredux.sbcl-3.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql      (lambda (c) (abort c))))      (load (compile-file "fannkuchredux.sbcl-3.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END fannkuchredux.sbcl-3.sbcl_compile


; compiling file "/home/dunham/benchmarksgame/bench/fannkuchredux/fannkuchredux.sbcl-3.sbcl" (written 24 JAN 2013 02:01:14 PM):
; compiling (DECLAIM (OPTIMIZE # ...))
; compiling (DEFMACRO SB ...)
; compiling (DEFTYPE SB ...)
; compiling (DEFMACRO SETLAMBDA ...)
; compiling (DEFMACRO COUNTFLIPLAMBDA ...)
; compiling (DEFUN FANNKUCH ...)
; compiling (DEFUN MAIN ...)

; /home/dunham/benchmarksgame_onecore/fannkuchredux/tmp/fannkuchredux.sbcl-3.fasl written
; compilation finished in 0:00:00.045
[undoing binding stack and other enclosing state... done]
[saving current Lisp image into sbcl.core:
writing 3512 bytes from the read-only space at 0x0x1000000
writing 2256 bytes from the static space at 0x0x1100000
writing 28209152 bytes from the dynamic space at 0x0x9000000
done]
### START fannkuchredux.sbcl-3.sbcl_run
(main) (quit)
### END fannkuchredux.sbcl-3.sbcl_run

0.61s to complete and log all make actions

COMMAND LINE:
/usr/local/bin/sbcl   --noinform --core sbcl.core --userinit /dev/null --load fannkuchredux.sbcl-3.sbcl_run 12

PROGRAM OUTPUT:
3968050
Pfannkuchen(12) = 65

  Home   Conclusions   License   Play