Several people have kindly ported my ray tracer from this page:

  http://www.ffconsultancy.com/free/ray_tracer/languages.html

to Lisp. Some of them are reporting competitive performance. However, when I
try to run their programs with either CMUCL or SBCL they are two orders of
magnitude slower. Given the number of people claiming similarly good
performance, I'd like to know what the possible cause of the relative
slowdown on my computer is?

My system is an unladen 900MHz Athlon T-bird with 768Mb RAM running Debian
testing with SBCL 0.8.16 and CMUCL "19b-release-20050628-3 + minimal debian
patches". Other people have both slower and faster CPUs and more and less
RAM but all are consistently much faster than mine.

I believe SBCL always compiles to native code and I am asking CMUCL to
compile to native code with:

(compile-file "ray4.lisp")
(load "ray4.x86f")
(time (main 6.0 "image.pgm" 256.0 4.0))

Any ideas?

Also, I just tried running the ackermann and harmonic tests from the
shootout and they run at the same (fast) speed on my machine as on the
shootout's machine. So it seems the problem is specific to raytracing-like
code.

I'm completely stumped.

Have a look over in c.l.scheme for the uproar around this topic /
poster

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

(defconstant infinity most-positive-single-float)
(defconstant delta (the single-float (sqrt single-float-epsilon)))

(declaim (inline vec v* v+ v- dot unitise ray vec make-ray make-sphere x y z
ray_trace))

(defstruct (vec (:conc-name nil) (:constructor vec (x y z)))
  (x 0.0 :type single-float)
  (y 0.0 :type single-float)
  (z 0.0 :type single-float))

(defun v* (s r)
  (declare (single-float s))
    (the vec (vec (* s (x r)) (* s (y r)) (* s (z r)))))

(defmacro defvfun (name op)
  `(defun ,name (a b)
    (vec (,op (x a) (x b))
         (,op (y a) (y b))
         (,op (z a) (z b)))))

(defvfun v+ +)
(defvfun v- -)

(defun dot (a b)
  (+ (* (x a) (x b)) (* (y a) (y b)) (* (z a) (z b))))

(defun unitise (r)
  (the vec (v* (/ 1 (the single-float (sqrt (dot r r)))) r)))

(defstruct (ray (:conc-name nil))
  (orig (vec 0.0 0.0 0.0) :type vec)
  (dir (vec 0.0 0.0 0.0) :type vec))

(defun ray (orig dir) (make-ray :orig orig :dir dir))

(defstruct (sphere (:conc-name nil))
  (center (vec 0.0 0.0 0.0) :type vec)
  (radius 0.0 :type single-float))

(shadow 'group)
(defstruct (group (:conc-name nil) (:include sphere))
  (children () :type list))

(defun ray_sphere (ray sphere)
  (let* ((v    (v- (center sphere) (orig ray)))
         (b    (dot v (dir ray)))
         (disc (+ (- (* b b) (dot v v)) (* (radius sphere) (radius
sphere)))))
    (if (< disc 0.0) infinity
        (let ((disc (sqrt disc)))
          (let ((t2 (+ b disc))
                (t1 (- b disc)))
            (cond ((< t2 0.0) infinity)
                  ((> t1 0.0) t1)
                  (t t2)))))))

(defun intersect (ray scene)
  (labels ((aux (hit scene)
             (destructuring-bind (lam . _) hit
               (declare (ignore _) (single-float lam))
               (etypecase scene
                 (group
                   (if (>= (ray_sphere ray scene) lam)
                       hit
                       (reduce #'aux (children scene) :initial-value hit)))
                 (sphere
                  (let ((lamt (ray_sphere ray scene)))
                    (if (>= lamt lam) hit
                        (cons lamt (unitise (v- (v+ (orig ray) (v* lamt (dir
ray))) (center scene)))))))))))
    (aux `(,infinity . (vec 0.0 0.0 0.0)) scene)))

(defun ray_trace (light ray scene)
  (destructuring-bind (lam . normal) (intersect ray scene)
    (declare (single-float lam))
    (if (= lam infinity) 0.0
      (let ((g (dot normal light)))
        (if (>= g 0.0) 0.0
          (let ((p (v+ (v+ (orig ray) (v* lam (dir ray))) (v* delta
normal))))
            (destructuring-bind (lam . _)
                (intersect (ray p (v* -1.0 light)) scene)
              (declare (ignore _) (single-float lam))
              (if (< lam infinity) 0.0 (- g)))))))))

(defun create (n c r)
  (declare (single-float r)
           (fixnum n))
  (let ((obj (make-sphere :center c :radius r)))
    (if (= n 1)
        obj
        (let ((rt (* 3.0 (/ r (sqrt 12.0)))))
          (labels ((aux (x z) (create (1- n) (v+ c (vec x rt z)) (/ r
2.0))))
            (make-group :center c
                        :radius (* 3.0 r)
                        :children (list* obj (mapcar #'aux
                                                     (list (- rt) rt (- rt)
rt)
                                                     (list (- rt) (- rt) rt
rt)))))))))

(defun main (level file-name n ss)
  (declare (fixnum level n ss))
  (let ((scene (create level (vec 0.0 -1.0 0.0) 1.0))
        (light (unitise (vec -1.0 -3.0 2.0)))
        (-n/2 (- (/ (float n) 2.0)))
        (1-n/2 (1- (/ (float n) 2.0))))
    (with-open-file (s
file-name :if-exists :supersede :if-does-not-exist :create :direction :output)
      (format s "P5~%~A ~A~%255~%" n n))
    (with-open-file (s file-name :element-type '(unsigned-byte
8) :if-exists :append :direction :output)
      (loop for y of-type single-float from 1-n/2 downto -n/2
            ;;do (sb-ext:gc-off)
            do (print y)
            do (loop for x of-type single-float from -n/2 to 1-n/2
            do (let ((g 0.0))
                 (declare (single-float g))
                 (loop for dx of-type single-float from x below (1+ x) by (/
1.0 ss)
                       do (loop for dy of-type single-float from y below (1+
y) by (/ 1.0 ss)
                                do (let ((d (unitise (vec dx dy (float
n)))))
                                     (incf g (ray_trace light (ray (vec 0.0
0.0 -4.0) d) scene)))))
                 (let ((g (+ 0.5 (* 255.0 (/ g (* (float ss) (float
ss)))))))
                   (write-byte (floor g) s))))))))

#+sbcl (setf (sb-ext:BYTES-CONSED-BETWEEN-GCS) 100000000)

(time (main 6 "image.pgm" 160 4))
(quit)

; cpu time (non-gc) 60,202 msec (00:01:00.202) user, 421 msec system
; cpu time (gc)     33,623 msec user, 10 msec system
; cpu time (total)  93,825 msec (00:01:33.825) user, 431 msec system
; real time  105,632 msec (00:01:45.632)
; space allocation:
;  967,240 cons cells, 3,719,472,272 other bytes, 4,472 static bytes

But converting all "single-float"  to double-float:

; cpu time (non-gc) 4,446 msec user, 120 msec system
; cpu time (gc)     2,524 msec user, 0 msec system
; cpu time (total)  6,970 msec user, 120 msec system
; real time  7,961 msec
; space allocation:
;  418,422 cons cells, 292,782,544 other bytes, 0 static bytes
The compiler complained about the "shadow" statement
warning: compile-file found "SHADOW" at the top-level --  see the
          documentation for
          comp:*cltl1-compile-file-toplevel-compatibility-p*

My guess is that much of the verbosity for the sbcl version could be struck
out of the allegro cl version without any loss in speed, and that careful attention
to other potential optimizations/ declarations could squeeze out better performance.

It could be that this single/double issue relates to your AMD64 timings.
Most of it may be converting single to double and back.

It is interesting that single vs double precision has such bizarre and (for
me) unexpected performance implications...

Another possible pitfall on older SBCLs (<0.8.21) is that they don't
honor the compiler policy for code entered on the repl, but compile it
with low speed, high debug/safety. If you've been pasting the code
into the repl instead of LOADing it, performance would indeed be
horrible.

| Right. Is Allegro CL free?

It has a free trial version.  <http://www.franz.com/>.

Thanks for the help. I'll repost when I get results with the new compiler.

    5.21 seconds of real time
    4.15 seconds of user run time
    0.62 seconds of system run time
    0 page faults and
    509,569,248 bytes consed

This seems to be on-par with other people's observations.

This compares to 1.037s for OCaml and 0.987s for C++, so SBCL is now much
more competitive.

Thanks for all the help!

Also, MLton often beats g++, so functional languages aren't slow coaches any
more...

Most typical of all is that such benchmarks (including this ray
tracing thing) don't have much of anything interesting to say about
anything.

/Jon

I'd like to do another benchmark with an example from scientific computing
next...

For symbolic processing, or anything non-number-chrunchy I wouldn't be
surprised if an application written in Lisp (compiled) isn't a bit
slower than the same app written in C++ or Java.  But of course nobody
writes an app in several languages...

     So what have we learned?  We confirmed what we pretty much
     knew: you can write a C program in CL, at which point the
     relative speed of your C and CL versions will depend on the
     relative quality of the code generation.

I am sure Jon can pick up some nice tricks in the thread.

<http://groups.google.com/group/comp.lang.lisp/msg/ae59ca28867ced78?hl...>

I hadn't actually read the implementation before now but I've got to say
that my ray tracer is a whole lot more fun. :-)

I'll check out the thread in more detail - thanks for the link.

If you want to compare Ocaml to a specific implementation of Lisp, then
target CMUCL, SBCL, CLISP, Lispworks etc. However, if you want to
compare the performance of Lisp to the performance of Ocaml then choose
the fastest implementation of Lisp available and run that. Allego,
Lispworks and Corman (Corman is Windows only) are all free to you for
this purpose.

I've also being using GCL to compile it so far.