Mandelbrot with terminal I/O

mandel-arry.lisp

;;;; Mandelbrot with terminal I/O
;;;
;;; An attempt to write code that can be optimized by sbcl.
;;; Note that this is not a serious benchmark, most time is spent in I/O,
;;; it is mostly for looking at the resulting disassembly.
;;;
;;; from: https://demo.sourceprobe.com/github.com/sourceprobe/mandelbrot_lisp/mandel.lisp


(deftype window-dimension () `(integer 0 ,most-positive-fixnum))


(defconstant +max-iterations+ 26)

(defconstant +output-res-x+ 3.5d0)
(defconstant +output-res-y+ 2.0d0)
(defconstant +output-offset-x+ -2.5d0)
(defconstant +output-offset-y+ -1.0d0)

(defconstant +resolution-x+ (coerce 150 'window-dimension))
(defconstant +resolution-y+ (coerce 60 'window-dimension))


(declaim (inline show calc))

(defun show (val)
  "Turn # iterations into a char for display."
  (if (<= val +max-iterations+)
      (code-char (+ val -1 (char-code #\A)))
      #\Space))

(defun calc (x y)
  "Calculate how many steps are required."
  (declare (optimize speed))

  ; "(coerce x 'double-float)" will make all calculations of the next line
  ; happen in double-float which is what we want
  (let ((xi (+ +output-offset-x+ (* (coerce x 'double-float) (/ +output-res-x+ +resolution-x+))))
        (yi (+ +output-offset-y+ (* (coerce y 'double-float) (/ +output-res-y+ +resolution-y+)))))
    (loop for iters upto +max-iterations+

          ; sbcl doesn't find the common subexpressions (* x x) and (* y y)
          ; so we'll extract them manually below
	  ;for x of-type double-float = 0.0d0 then (+ (- (* x x) (* y y)) xi)
	  ;and y of-type double-float = 0.0d0 then (+ (* x y 2) yi)
	  ;while (< (+ (* x x) (* y y)) 4)

          for xsq of-type double-float = 0.0d0 then (* x x)
          and ysq of-type double-float = 0.0d0 then (* y y)
	  for x of-type double-float = 0.0d0 then (+ (- xsq ysq) xi)
	  and y of-type double-float = 0.0d0 then (+ (* x y 2.0d0) yi)
	  while (< (+ xsq ysq) 4.0d0)

	  finally (return iters))))

(defun draw-window ()
  (let* ((size (+ (* +resolution-x+ +resolution-y+) +resolution-y+))
         (out (make-string size))
         (idx 0))
    (declare (dynamic-extent out))
    (dotimes (y +resolution-y+)
      (dotimes (x +resolution-x+)
        (setf (aref out idx) (show (calc x y)))
        (incf idx))
      (setf (aref out idx) #\Newline)
      (incf idx))
    (princ out)
    nil))

(defun main ()
  (draw-window))

(time (main))

;(disassemble 'draw-window)