Newsgroups: comp.lang.lisp
Path: cantaloupe.srv.cs.cmu.edu!nntp.club.cc.cmu.edu!godot.cc.duq.edu!news.duke.edu!news-feed-1.peachnet.edu!gatech!howland.reston.ans.net!spool.mu.edu!sgiblab!pacbell.com!att-out!nntpa!nntpa.cb.att.com!lgm
From: lgm@polaris.ih.att.com (Lawrence G. Mayka)
Subject: Re: Comparison: Beta - Lisp
In-Reply-To: haible@ma2s2.mathematik.uni-karlsruhe.de's message of 10 Sep 1994 21:29:59 GMT
Message-ID: <LGM.94Sep11111230@polaris.ih.att.com>
Sender: news@nntpa.cb.att.com (Netnews Administration)
Nntp-Posting-Host: polaris.ih.att.com
Organization: AT&T Bell Laboratories, Naperville, Illinois, USA
References: <34n2qe$d74@nz12.rz.uni-karlsruhe.de> <lenngrayCvunsr.448@netcom.com>
	<34q30t$n76@nz12.rz.uni-karlsruhe.de>
	<34qbac$ohk@infosrv.edvz.univie.ac.at>
	<34t8gn$1g6@nz12.rz.uni-karlsruhe.de>
Date: Sun, 11 Sep 1994 16:12:30 GMT
Lines: 120

In article <34t8gn$1g6@nz12.rz.uni-karlsruhe.de> haible@ma2s2.mathematik.uni-karlsruhe.de (Bruno Haible) writes:

   Bernhard Pfahringer <bernhard@ai.univie.ac.at> wrote:
   >> Lisp compilers produce good code, but they can't compete with good C
   >> compilers in this case.
   >
   > May not be the case: I've timed your function using both CMUCL 17c and
   > Lucid CL 4.0.0, CMUCL is 3 times faster than Lucid, so:
   >          CMUCL  (estimate!)                15 sec
   >
   > which is just a factor of 2 off of C.

   This agrees with some figures measured by Simon Leinen:

   Sun 4/670MP, 40MHz SuperSPARC     acc -fast		 1.5  sec user
   Sun 4/670MP, 40MHz SuperSPARC     CMU CL 17e		 3.08 sec user
   Sun 4/670MP, 40MHz SuperSPARC     LispWorks 3.2		15.58 sec user
   Sun 4/670MP, 40MHz SuperSPARC     Allegro 4.1		33.87 sec user

   Indeed CMUCL is only a factor of 2 off of C. I am happy to eat my words
   about Lisp compiler's code.

I forgot some additional type declarations needed to avoid checking
the GC write barrier when vector elements are modified.  My new
result for

(time (fannkuch-fast 9))

on LispWorks 3.2 is

An early-1993 Sparc LX			3.81 sec
An early-1993, low-end Sparc 10		2.97 sec

I have attached the again-modified version of the benchmark.

-------------------------------
(in-package :cl-user)

(defun fannkuch-fast (&optional (n (progn
                                     (format *query-io* "n = ?")
                                     (parse-integer (read-line *query-io*)))))
  (declare (optimize (safety 0) (speed 3) (space 0) (debug 0))
           (fixnum n))
  (unless (and (> n 0) (<= n 100))
    (return-from fannkuch-fast))
  (let ((perm (make-array n :initial-element 0))
	(perm1 (make-array n :initial-element 0))
	(zaehl (make-array n :initial-element 0))
	(permmax (make-array n :initial-element 0))
	(bishmax -1))
    (declare (type simple-vector perm perm1 zaehl permmax)
             (dynamic-extent perm perm1 zaehl permmax)
             (fixnum bishmax))
    (dotimes (i n)
      (declare (fixnum i))
      (setf (svref perm1 i) i))
    (prog ((\t n))
      (declare (fixnum \t))
      Kreuz
      (when (= \t 1)
	(go standardroutine))
      (setf (svref zaehl (the fixnum (1- \t))) \t)
      (setf \t (the fixnum (1- \t)))
      (go Kreuz)
      Dollar
      (when (= \t n)
        (go fertig))
      (let ((perm0 (svref perm1 0)))
	(declare (fixnum perm0))
	(dotimes (i \t)
	  (declare (fixnum i))
	  (setf (svref perm1 i) (the fixnum (svref perm1 (the fixnum (1+ i))))))
	(setf (svref perm1 \t) perm0))
      (when (> (the fixnum (setf (svref zaehl \t)
			         (the fixnum (1- (the fixnum (svref zaehl \t))))))
	       0)
	(go Kreuz))
      (setf \t (the fixnum (1+ \t)))
      (go Dollar)
      standardroutine
      (dotimes (i n)
	(declare (fixnum i))
	(setf (svref perm i) (the fixnum (svref perm1 i))))
      (let ((Spiegelungsanzahl 0)
            (k 0))
	(declare (fixnum Spiegelungsanzahl k))
	(loop
	 (when (= (the fixnum (setq k (svref perm 0))) 0)
           (return))
	 (let ((k2 (ash (the fixnum (1+ k)) -1)))
	   (declare (fixnum k2))
	   (dotimes (i k2)
	     (declare (fixnum i))
	     (rotatef (the fixnum (svref perm i))
                      (the fixnum (svref perm (the fixnum (- k i)))))))
	 (setf Spiegelungsanzahl (the fixnum (1+ Spiegelungsanzahl))))
	(when (> Spiegelungsanzahl bishmax)
	  (setq bishmax Spiegelungsanzahl)
	  (dotimes (i n)
	    (declare (fixnum i))
	    (setf (svref permmax i) (the fixnum (svref perm1 i))))))
      (go Dollar)
      fertig)
    (format t "The maximum was ~D.~% at " bishmax)
    (format t "(")
    (dotimes (i n)
      (declare (fixnum i))
      (when (> i 0)
        (format t " "))
      (format t "~D" (the fixnum (1+ (the fixnum (svref permmax i))))))
    (format t ")")
    (terpri)
    (values)))
-----------------------------------------
--
        Lawrence G. Mayka
        AT&T Bell Laboratories
        lgm@ieain.att.com

Standard disclaimer.
