[Shootout-list] Mandelbrot Set for CMUCL and SBCL 2nd try

[Yannick Gingras]

--nextPart2497443.vGPu0YfsS4
Content-Type: text/plain;
  charset="iso-8859-1"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: inline


Hi, I saw that my previous submission generated an error.  I don't
know why and the output seems to be right but I was using
single-floats and that could have produced an output slightly
divergent from the implementations using double floats.

Here is a version using double-floats and doing the complex mult by
hand like in C.

;;; The Great Computer Language Shootout
;;;   http://shootout.alioth.debian.org/

;;;   contributed by Yannick Gingras <ygingras@ygingras.net>

;;;   for a colorful web zoomer for the Mandelbrot Set by the same
;;;   author see http://fract.ygingras.net/


(declaim (optimize speed (debug 0) (safety 0)))
 =20
(defun render (size &optional (stream *standard-output*))
  (declare (type fixnum size)
           (type stream stream))
  (let* ((inc (/ 2.0d0 size))
         (code 0)
         (mask 128)
         (zi 0.0d0)
         (zr 0.0d0)
         (tr 0.0d0)
         (base-imag -1.0d0)
         (base-real -1.5d0)
         (str (make-string (ceiling (* size size) 8)))
         (cur-char -1))
    (declare (type (unsigned-byte 8) code mask)
             (type double-float zr zi tr base-real base-imag inc)
             (type fixnum cur-char))
    (format stream "P4~%~d ~d~%" size size)
    (dotimes (y size)
      (declare (type fixnum y))
      (dotimes (x size)
        (declare (type fixnum x))
        (setf zr 0.0d0)
        (setf zi 0.0d0)
        (when (not (dotimes (n 50)
                     (when (< 4.0d0 (+ (* zr zr) (* zi zi)))
                       (return t))
                     (setf tr (+ (* zr zr) (- (* zi zi)) base-real))
                     (setf zi (+ (* 2.0d0 zr zi) base-imag))
                     (setf zr tr)))
          (setf code (logior mask code)))
        (setf mask (ash mask -1))
        (when (zerop mask)
          (setf mask 128)
          (setf (elt str (incf cur-char)) (code-char code))
          (setf code 0))
        (incf base-real inc))
      (setf base-real -1.5d0)
      (incf base-imag inc))
    (when (/=3D 128 mask)
      (setf (elt str (incf cur-char)) (code-char code)))
    (write-sequence str stream))
  t)

(defun main ()
  (let* ((args #+sbcl sb-ext:*posix-argv*
               #+cmu extensions:*command-line-strings*
               #+gcl si::*command-args*)
         (n (parse-integer (car (last args)))))
    (render n)))


=2D-=20
Yannick Gingras         Math Student, UQAM
Join FSF as an Associate Member at:
  http://member.fsf.org/join?referrer=3D2327


--nextPart2497443.vGPu0YfsS4
Content-Type: application/pgp-signature

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.5 (GNU/Linux)

iD8DBQBCRvnaX5grbfhLwA4RAmHUAJwOWysLwwnhOcJ1jisjZBJkiz13HgCfTte9
9svWUL2D7rCYjvj2yZOvURY=
=O/mH
-----END PGP SIGNATURE-----

--nextPart2497443.vGPu0YfsS4--