The Computer Language
Benchmarks Game

mandelbrot Lisp SBCL #3 program

source code

;;   The Computer Language Benchmarks Game
;;   http://benchmarksgame.alioth.debian.org/
;;;
;;; resubmitted by Wade Humeniuk (Fix Stream Problem)
;;; resubmitted by Jon Smith (Remove silly assertion causing it to break on 16000 size)
;;; re-resubmitted by Jon Smith (with a silly hack to make it parallel).
;;; Original contributed by Yannick Gingras
;;;
;;; To compile
;;; sbcl --load mandelbrot.lisp --eval "(save-lisp-and-die \"mandelbrot.core\" :purify t :toplevel (lambda () (main) (quit)))"
;;; To run
;;; sbcl --noinform --core mandelbrot.core %A

(defun render (size stream)
  (declare (type fixnum size) (stream stream)
	   (optimize (speed 3) (safety 0) (debug 0)))
  (let* ((code 0) 
	 (bit 0)
         (zr 0.0d0)
	 (zi 0.0d0)
	 (tr 0.0d0)
	 (delta (/ 2d0 size))
         (base-real -1.5d0) 
	 (base-imag -1.0d0)
         (buffer (make-array (* size (ceiling size 8)) :element-type '(unsigned-byte 8)))
         (index 0))

    (declare (type (unsigned-byte 8) code )
             (type double-float zr zi tr base-real base-imag delta)
             (type fixnum index bit))

    (dotimes (y size)
      (setf base-imag (- 1.0d0 (* delta y)))
      (dotimes (x size)
	(setf base-real (+ -1.5d0 (* delta x))
	      zr base-real
	      zi base-imag)
        (setf code  
	      (if (dotimes (n 50)
		    (when (< 4.0d0 (+ (* zr zr) (* zi zi)))
		      (return t))
		    (setf tr (+ (* zr zr) (- (* zi zi)) base-real)
			  zi (+ (* 2.0d0 zr zi) base-imag)
			  zr tr))
		  (ash code 1)
		  (logior (ash code 1) #x01)))
	(when (= (incf bit) 8)
	  (setf (aref buffer index) code
		bit 0 code 0)
	  (incf index))))

    (write-sequence buffer stream)))

(defun par-render (size stream)
  (declare (type fixnum size)		(stream stream)
	   (optimize (speed 3) (safety 0) (debug 0)))

  (let* ((buffer (make-array (* size (ceiling size 8)) :element-type '(unsigned-byte 8)))
	 (quarter-size (ceiling size 4))
	 (quarter-array (ceiling (the (unsigned-byte 32) (* size size)) 32)))
    

    (labels ((render-sub (y-start y-end index)
	       (let ((code 0) 
		     (bit 0)
		     (zr 0.0d0) (zi 0.0d0) (tr 0.0d0)
		     (delta (/ 2d0 size))
		     (base-real -1.5d0)  (base-imag -1.0d0))
		 (declare (type (unsigned-byte 8) code)
			  (type double-float zr zi tr base-real base-imag delta)
			  (type fixnum index bit))


		 (do ((y y-start (1+ y)))
		     ((= y y-end))
		   (declare (type (unsigned-byte 32) y))

		   (setf base-imag (- 1.0d0 (* delta y)))
		   (dotimes (x size)
		     (setf base-real (+ -1.5d0 (* delta x))
			   zr base-real
			   zi base-imag)
		     (setf code  
			   (if (dotimes (n 50)
				 (when (< 4.0d0 (+ (* zr zr) (* zi zi)))
				   (return t))
				 (setf tr (+ (* zr zr) (- (* zi zi)) base-real)
				       zi (+ (* 2.0d0 zr zi) base-imag)
				       zr tr))
			       (ash code 1)
			       (logior (ash code 1) #x01)))
		     (when (= (incf bit) 8)
		       (setf (aref buffer index) code
			     bit 0 
			     code 0)
		       (incf index))
		     )))))
      (let (threads)
	(dotimes (i 4)
	  (let ((start (* i quarter-size))
		(end (* (+ i 1) quarter-size))
		(idx (* i quarter-array)))
	    (push (sb-thread:make-thread (lambda () (render-sub start end idx))) threads)))
	(dolist (thread threads)
	  (sb-thread:join-thread thread)))
      (write-sequence buffer stream))))

(defun main ()
  (declare (optimize (speed 0) (safety 3)))
  (let* ((args sb-ext:*posix-argv*)
	 (n (parse-integer (second args))))
    (with-open-stream (stream (sb-sys:make-fd-stream (sb-sys:fd-stream-fd sb-sys:*stdout*)
						     :element-type :default
						     :buffering :full
						     :output t :input nil))

      (format stream "P4~%~d ~d~%" n n)
      #+sb-thread(par-render n stream)
      #-sb-thread(render n stream)
      (force-output stream))))
    

notes, command-line, and program output

NOTES:
32-bit Ubuntu one core
SBCL 1.3.10


Sat, 01 Oct 2016 04:12:16 GMT

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

; compiling file "/home/dunham/benchmarksgame/bench/mandelbrot/mandelbrot.sbcl-3.sbcl" (written 24 JAN 2013 02:01:15 PM):
; compiling (DEFUN RENDER ...)
; compiling (DEFUN PAR-RENDER ...)
; file: /home/dunham/benchmarksgame/bench/mandelbrot/mandelbrot.sbcl-3.sbcl
; in: DEFUN PAR-RENDER
;     (* SIZE SIZE)
; 
; note: forced to do GENERIC-* (cost 30)
;       unable to do inline fixnum arithmetic (cost 4) because:
;       The result is a (VALUES (UNSIGNED-BYTE 32) &OPTIONAL), not a (VALUES
;                                                                     FIXNUM
;                                                                     &REST T).
;       unable to do inline (signed-byte 32) arithmetic (cost 5) because:
;       The result is a (VALUES (UNSIGNED-BYTE 32) &OPTIONAL), not a (VALUES
;                                                                     (SIGNED-BYTE
;                                                                      32)
;                                                                     &REST T).
;       etc.

;     (CEILING (THE (UNSIGNED-BYTE 32) (* SIZE SIZE)) 32)
; --> LET 
; ==>
;   (+ SB-C::X 31)
; 
; note: forced to do GENERIC-+ (cost 10)
;       unable to do inline fixnum arithmetic (cost 1) because:
;       The first argument is a (UNSIGNED-BYTE 32), not a FIXNUM.
;       The result is a (VALUES (INTEGER 31 4294967326) &OPTIONAL), not a (VALUES
;                                                                          FIXNUM
;                                                                          &REST
;                                                                          T).
;       unable to do inline fixnum arithmetic (cost 2) because:
;       The first argument is a (UNSIGNED-BYTE 32), not a FIXNUM.
;       The result is a (VALUES (INTEGER 31 4294967326) &OPTIONAL), not a (VALUES
;                                                                          FIXNUM
;                                                                          &REST
;                                                                          T).
;       etc.

; --> LET VALUES 
; ==>
;   (ASH SB-C::X -5)
; 
; note: forced to do full call
;       unable to do inline ASH (cost 2) because:
;       The first argument is a (INTEGER 31 4294967326), not a FIXNUM.
;       unable to do inline ASH (cost 3) because:
;       The first argument is a (INTEGER 31 4294967326), not a (UNSIGNED-BYTE 32).
;       etc.

;     (= Y Y-END)
; --> EQL IF 
; ==>
;   (EQL SB-C::X SB-C::Y)
; 
; note: forced to do GENERIC-EQL (cost 10)
;       unable to do inline fixnum comparison (cost 4) because:
;       The first argument is a (UNSIGNED-BYTE 32), not a FIXNUM.
;       The second argument is a (INTEGER -536870912 536870912), not a FIXNUM.

;     (LAMBDA () (RENDER-SUB START END IDX))
; --> FUNCTION SB-C::%%ALLOCATE-CLOSURES 
; ==>
;   (SB-C::%ALLOCATE-CLOSURES
;    '(#<SB-C::CLAMBDA
;        :%SOURCE-NAME SB-C::.ANONYMOUS.
;        :%DEBUG-NAME (LAMBDA # :IN PAR-RENDER)
;        :KIND NIL
;        :TYPE #<SB-KERNEL:FUN-TYPE #>
;        :WHERE-FROM :DEFINED
;        :VARS NIL {ABF5B31}>))
; 
; note: doing signed word to integer coercion (cost 20), for:
;       the second argument of CLOSURE-INIT

;     (= Y Y-END)
; --> EQL IF 
; ==>
;   (EQL SB-C::X SB-C::Y)
; 
; note: doing unsigned word to integer coercion (cost 20) from Y, for:
;       the first argument of GENERIC-EQL

; compiling (DEFUN MAIN ...); 
; compilation unit finished
;   printed 6 notes


; /home/dunham/benchmarksgame_onecore/mandelbrot/tmp/mandelbrot.sbcl-3.fasl written
; compilation finished in 0:00:00.036
[undoing binding stack and other enclosing state... done]
[saving current Lisp image into sbcl.core:
writing 3120 bytes from the read-only space at 0x1000000
writing 2304 bytes from the static space at 0x1100000
writing 28151808 bytes from the dynamic space at 0x9000000
done]
### START mandelbrot.sbcl-3.sbcl_run
(main) (quit)
### END mandelbrot.sbcl-3.sbcl_run

0.60s to complete and log all make actions

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

(BINARY) PROGRAM OUTPUT NOT SHOWN