source code
;; The Computer Language Benchmarks Game
;; https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
;;
;; Adapted from the C (gcc) code by Sebastien Loisel
;;
;; Contributed by Christopher Neufeld
;; Modified by Juho Snellman 2005-10-26
;; * Use SIMPLE-ARRAY instead of ARRAY in declarations
;; * Use TRUNCATE instead of / for fixnum division
;; * Rearrange EVAL-A to make it more readable and a bit faster
;; Modified by Andy Hefner 2008-09-18
;; * Eliminate array consing
;; * Clean up type declarations in eval-A
;; * Distribute work across multiple cores on SBCL
;; Modified by Witali Kusnezow 2008-12-02
;; * use right shift instead of truncate for division in eval-A
;; * redefine eval-A as a macro
;; Modified by Lorenzo Bolla 2010-12-06
;; * added declaim at top of file
;; This is our most expensive function. Optimized with the knowledge
;; that 'n' will never be "huge". This will break if 'n' exceeds
;; approximately half of the square root of the largest fixnum
;; supported by the implementation. On 32-bit sbcl,
;; 'most-positive-fixnum' is 536870911, and we can support values of
;; 'n' above 11000.
(declaim (optimize (speed 3) (safety 0) (space 0)))
(defmacro eval-A (i j)
`(let* ((n (+ ,i ,j))
(n+1 (1+ n)))
(declare (type (integer 0 22000) n n+1))
(/ (float (+ (ash (* n n+1) -1) ,i 1) 0d0))))
(defun eval-At-times-u (u n Au start end)
(declare (type fixnum n start end)
(type (simple-array double-float) u Au))
(loop for i from start below end do
(setf (aref Au i)
(loop for j below n
summing (* (aref u j) (eval-A j i))
of-type double-float))))
(defun eval-A-times-u (u n Au start end)
(declare (type fixnum n start end)
(type (simple-array double-float) u Au))
(loop for i from start below end do
(setf (aref Au i)
(loop for j below n
summing (* (aref u j) (eval-A i j))
of-type double-float))))
#+sb-thread
(defun execute-parallel (start end function)
(declare (optimize (speed 0)))
(let* ((num-threads 4))
(loop with step = (truncate (- end start) num-threads)
for index from start below end by step
collecting (let ((start index)
(end (min end (+ index step))))
(sb-thread:make-thread
(lambda () (funcall function start end))))
into threads
finally (mapcar #'sb-thread:join-thread threads))))
#-sb-thread
(defun execute-parallel (start end function )
(funcall function start end))
(defun eval-AtA-times-u (u AtAu v n start end)
(execute-parallel start end
(lambda (start end)
(eval-A-times-u u n v start end)))
(execute-parallel start end
(lambda (start end)
(eval-At-times-u v n AtAu start end))))
(defun main (&optional n-supplied)
(let ((n (or n-supplied
(parse-integer (or (car (last #+sbcl sb-ext:*posix-argv*
#+clisp ext:*args*
#+cmu extensions:*command-line-strings*
#+gcl si::*command-args*))
"2000")))))
(declare (type fixnum n))
(or (typep (* (- (* 2 n) 1) (- (* 2 n) 2)) 'fixnum)
(error "The supplied value of 'n' breaks the optimizations in EVAL-A"))
(let ((u (make-array n :element-type 'double-float :initial-element 1.0d0))
(v (make-array n :element-type 'double-float))
(tmp (make-array n :element-type 'double-float)))
(declare (type (simple-array double-float) U V))
(dotimes (i 10)
(eval-AtA-times-u u v tmp n 0 n)
(eval-AtA-times-u v u tmp n 0 n))
(let ((vBv 0.0d0)
(vv 0.0d0))
(dotimes (i n)
(incf vBv (* (aref u i) (aref v i)))
(incf vv (* (aref v i) (aref v i))))
(format t "~11,9F~%" (sqrt (the (double-float 0d0) (/ vBv vv))))))))
notes, command-line, and program output
NOTES:
64-bit Ubuntu quad core
SBCL 2.0.4
Fri, 22 May 2020 00:32:02 GMT
MAKE:
cp: 'spectralnorm.sbcl-2.sbcl' and './spectralnorm.sbcl-2.sbcl' are the same file
SBCL built with: /usr/local/bin/sbcl --userinit /dev/null --batch --eval '(load "spectralnorm.sbcl-2.sbcl_compile")'
### START spectralnorm.sbcl-2.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql (lambda (c) (abort c)))) (require :sb-concurrency) (load (compile-file "spectralnorm.sbcl-2.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END spectralnorm.sbcl-2.sbcl_compile
; compiling file "/home/dunham/8000-benchmarksgame/bench/spectralnorm/spectralnorm.sbcl-2.sbcl" (written 26 APR 2018 12:50:14 PM):
; compiling (DECLAIM (OPTIMIZE # ...))
; compiling (DEFMACRO EVAL-A ...)
; compiling (DEFUN EVAL-AT-TIMES-U ...)
; compiling (DEFUN EVAL-A-TIMES-U ...)
; compiling (DEFUN EXECUTE-PARALLEL ...)
; compiling (DEFUN EVAL-ATA-TIMES-U ...)
; compiling (DEFUN MAIN ...)
; file: /home/dunham/8000-benchmarksgame/bench/spectralnorm/spectralnorm.sbcl-2.sbcl
; in: DEFUN MAIN
; (/ VBV VV)
;
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
; The second argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
;
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a NUMBER, not a SINGLE-FLOAT.
; The second argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
;
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
;
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a NUMBER, not a DOUBLE-FLOAT.
; The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
;
; note: unable to
; convert x/2^k to shift
; due to type uncertainty:
; The first argument is a NUMBER, not a INTEGER.
; The second argument is a NUMBER, not a INTEGER.
; (- (* 2 N) 1)
;
; note: forced to do GENERIC-- (cost 10)
; unable to do inline fixnum arithmetic (cost 1) because:
; The first argument is a (INTEGER -9223372036854775808 9223372036854775806), not a FIXNUM.
; The result is a (VALUES
; (INTEGER -9223372036854775809 9223372036854775805)
; &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a (INTEGER -9223372036854775808 9223372036854775806), not a FIXNUM.
; The result is a (VALUES
; (INTEGER -9223372036854775809 9223372036854775805)
; &OPTIONAL), not a (VALUES FIXNUM &REST T).
; etc.
; (- (* 2 N) 2)
;
; note: forced to do GENERIC-- (cost 10)
; unable to do inline fixnum arithmetic (cost 1) because:
; The first argument is a (INTEGER -9223372036854775808 9223372036854775806), not a FIXNUM.
; The result is a (VALUES
; (INTEGER -9223372036854775810 9223372036854775804)
; &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a (INTEGER -9223372036854775808 9223372036854775806), not a FIXNUM.
; The result is a (VALUES
; (INTEGER -9223372036854775810 9223372036854775804)
; &OPTIONAL), not a (VALUES FIXNUM &REST T).
; etc.
; (* (- (* 2 N) 1) (- (* 2 N) 2))
;
; note: forced to do GENERIC-* (cost 30)
; unable to do inline fixnum arithmetic (cost 2) because:
; The first argument is a (INTEGER -9223372036854775809 9223372036854775805), not a FIXNUM.
; The second argument is a (INTEGER -9223372036854775810
; 9223372036854775804), not a FIXNUM.
; The result is a (VALUES
; (INTEGER -85070591730234615856620279821087277050
; 85070591730234615893513767968506380290)
; &OPTIONAL), not a (VALUES FIXNUM &REST T).
; unable to do inline (signed-byte 64) arithmetic (cost 4) because:
; The first argument is a (INTEGER -9223372036854775809 9223372036854775805), not a (SIGNED-BYTE
; 64).
; The second argument is a (INTEGER -9223372036854775810
; 9223372036854775804), not a (SIGNED-BYTE 64).
; The result is a (VALUES
; (INTEGER -85070591730234615856620279821087277050
; 85070591730234615893513767968506380290)
; &OPTIONAL), not a (VALUES (SIGNED-BYTE 64) &REST T).
; etc.
; (INCF VBV (* (AREF U I) (AREF V I)))
; --> SETQ THE
; ==>
; (+ (* (AREF U I) (AREF V I)) VBV)
;
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline float arithmetic (cost 2) because:
; The second argument is a NUMBER, not a DOUBLE-FLOAT.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES DOUBLE-FLOAT
; &REST T).
; unable to do inline float arithmetic (cost 4) because:
; The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES
; (COMPLEX DOUBLE-FLOAT)
; &REST T).
; (INCF VV (* (AREF V I) (AREF V I)))
; --> SETQ THE
; ==>
; (+ (* (AREF V I) (AREF V I)) VV)
;
; note: forced to do GENERIC-+ (cost 10)
; unable to do inline float arithmetic (cost 2) because:
; The second argument is a NUMBER, not a DOUBLE-FLOAT.
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES DOUBLE-FLOAT
; &REST T).
; unable to do inline float arithmetic (cost 4) because:
; The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES
; (COMPLEX DOUBLE-FLOAT)
; &REST T).
; (/ VBV VV)
;
; note: forced to do full call
; unable to do inline float arithmetic (cost 19) because:
; The first argument is a NUMBER, not a DOUBLE-FLOAT.
; The second argument is a NUMBER, not a DOUBLE-FLOAT.
; (- (* 2 N) 1)
;
; note: doing signed word to integer coercion (cost 20), for:
; the first argument of GENERIC--
; (- (* 2 N) 2)
;
; note: doing signed word to integer coercion (cost 20), for:
; the first argument of GENERIC--
; (INCF VBV (* (AREF U I) (AREF V I)))
; --> SETQ THE
; ==>
; (+ (* (AREF U I) (AREF V I)) VBV)
;
; note: doing float to pointer coercion (cost 13), for:
; the first argument of GENERIC-+
; (INCF VV (* (AREF V I) (AREF V I)))
; --> SETQ THE
; ==>
; (+ (* (AREF V I) (AREF V I)) VV)
;
; note: doing float to pointer coercion (cost 13), for:
; the first argument of GENERIC-+
; (FORMAT T "~11,9F~%" (SQRT (THE (DOUBLE-FLOAT 0.0d0) (/ VBV VV))))
; --> FORMAT SB-INT:NAMED-LAMBDA FUNCTION BLOCK LET
; ==>
; (SB-FORMAT::FORMAT-FIXED STREAM SB-FORMAT::FORMAT-ARG1 #:FVAR3 #:FVAR4
; #:FVAR5 #:FVAR6 #:FVAR7 NIL)
;
; note: doing float to pointer coercion (cost 13)
;
; compilation unit finished
; printed 16 notes
; wrote /home/dunham/benchmarksgame_quadcore/spectralnorm/tmp/spectralnorm.sbcl-2.fasl
; compilation finished in 0:00:00.242
### START spectralnorm.sbcl-2.sbcl_run
(main) (quit)
### END spectralnorm.sbcl-2.sbcl_run
4.84s to complete and log all make actions
COMMAND LINE:
/usr/local/bin/sbcl --dynamic-space-size 500 --noinform --core sbcl.core --userinit /dev/null --load spectralnorm.sbcl-2.sbcl_run 5500
PROGRAM OUTPUT:
1.274224153