[To reply replace "Aaron.Sloman.XX" with "A.Sloman"]
I thought the following message originally posted to comp.lang.lisp
would be of interest to readers of comp.lang.pop and pop-forum
There was some discussion in followups.
I suspect (without checking) that Poplog Lisp's comparatively poor
performance on the FFT test is partly due to the fact that in Poplog
arrays are procedures rather than special data-structures, and
partly due to something that needs to be fixed in the Poplog Lisp
implementation of array accesses. (In a test I saw some months ago,
using Poplog lisp took far longer than using Pop-11 for the same
algorithm. I think John Williams partly diagnosed the problem at the
time, but was too busy to do anything about it.).
Re-posted message follows.
Aaron
===================================================================
John Watton <john.watton@alcoa.com> writes, in comp.lang.lisp
> Date: Wed, 01 Dec 1999 20:14:29 GMT
A while ago I mentioned in a posting that I had done some benchmarking
of Common Lisp's for Win32. I received a few emails requesting the
results. So....here they are.
CL-TYPE Allegro CL LispWorks Poplog CL CLISP CormanLisp
CL-VER 5.0.1 4.1.18 2.0 1999-07-22 1.3
BOYER 1.000 10.050 1.033 4.040 1.708
BROWSE 1.000 4.487 2.184 5.142 3.355
CTAK 1.000 1.839 5.903 4.258 3.757
DDERIV 1.288 3.220 2.190 3.220 1.000
DERIV 1.483 3.758 1.928 3.791 1.000
DESTRU 1.000 2.639 2.222 5.361 1.500
DIV2 1.279 4.256 1.790 5.864 1.000
FFT 1.000 41.050 67.000 46.050 53.998
FPRINT 1.630 1.935 4.261 1.000 6.168
FREAD 1.458 6.958 1.250 1.000 8.534
FRPOLY 1.084 1.737 1.000 3.106 1.299
PUZZLE 1.441 1.816 1.000 4.850 5.409
STAK 1.000 1.333 2.310 4.167 3.910
TAK 1.000 3.500 3.500 21.025 1.863
TAKL 1.000 2.321 2.321 16.357 1.608
TAKR 1.000 4.273 2.000 9.182 1.450
TRAVERSE 1.000 5.156 3.370 13.167 5.829
TRIANG 1.287 1.000 2.779 15.688 8.254
RHYME 1.000 2.178 1.831 2.324 95.729
PRIMECOUNTFIXNUM 1.000 1.740 2.122 3.878 6.463
PRIMECOUNTBIGNUM 2.296 1.000 1.063 1.489 26.100
PNPOLY 1.000 1.290 32.031 42.536 42.301
GENERICFUNCTIONS 1.000 1.111 5.926 3.951 37.946
SLOTVALUES 1.074 1.000 1.407 1.639 5.027
TOTAL 1.000 3.872 5.382 7.877 11.483
Notes:
1) All benchmarks run on a Pentium II at 366Mhz with Windows NT.
2) The benchmark values are normalized to the best performer. The total
is computed
as the sum of the individual normalized values and then is normalized
itself. This
means that each benchmark is weighted equally in the total.
3) Allegro CL http://www.franz.com (I used the commercial version)
4) Lispworks http://www.harlequin.com (I used the commercial version)
5) Poplog CL http://www.cs.bham.ac.uk/research/poplog/freepoplog.html
(Free with source)
7) Clisp http://clisp.cons.org (Free with source)
8) CormanLisp http://corman.net (Free with source) Cormanlisp is the
least complete and robust. Write-line and asin do not work. Loop macro
doesn't understand minimizing or of-type. Defstruct cannot do (:type
list). with-open-file :if-exists :append appears to :supersede
instead. Environment information functions are not implemented.
9) Gabriel benchmarks downloaded from
ftp://ftp.cs.umass.edu/pub/eksl/gabriel/. Benchmarks run with
(optimize (speed 3) (safety 1) (space 0)).
10) Primecount benchmarks also make use of a Lispworks nonANSI
declaration
(optimize (fixnum 0)).
11) Rhyme exercises read and write of ascii files along with string sort
and list reversal.
12) Primecountfixnum is a fixnum integer intensive computation.
13) Primecountbignum is a bignum integer intensive computation.
14) Pnpoly is a floating point intensive computation. Pnpoly is
optimized
for floating point using declarations and optimized for (speed 3) and
(safety 0). I believe that only Allegro CL and Lispworks pay any
attention. Unfortunately Lispworks also requires a (declare (optimize
(float 0))) to make any real gains as well. This is an nonANSI
feature. It is also not a very robust one. FFT is floating point
intensive but the use of (float 3) only came up with Lispworks
compiler errors.
15) Genericfunctions and slotvalues test generic function calling and
slot
value accessing. They were obtained from the CormanLisp distribution.
16) My source:
(defun rhyme (from to &aux dict)
(declare (optimize (speed 3) (safety 0)))
(with-open-file (in from :direction :input)
(setq dict (loop for w = (read-line in nil nil)
until (not w) collect w)))
(setq dict (mapc #'nreverse dict))
(setq dict (sort dict #'string<))
(setq dict (mapc #'nreverse dict))
(with-open-file (out to :direction :output :if-exists :supersede)
(dolist (x dict)
#-cormanlisp (write-line x out)
#+cormanlisp (progn (write-string x out) (terpri out))
)))
(defun prime-count (s e)
(declare (optimize (speed 3) (safety 0))
#+Lispworks (optimize (fixnum-safety 3))
(integer s e))
(macrolet ((search-template (typeint)
`(loop for n of-type ,typeint from (if (oddp x) x (1+
x)) to y by 2
for stop of-type ,typeint = (isqrt n)
with count of-type ,typeint = (if (<= x 2 y) 1 0) ;
to count 2
when (= n (loop for test-div of-type ,typeint from
3 to stop by 2
when (zerop (mod n test-div)) do
(return test-div)
finally (return n)))
do (incf count)
finally (print count))))
(flet ((search-fixnum-range (x y) (search-template fixnum))
(search-bignum-range (x y) (search-template integer)))
(if (> e most-positive-fixnum)
(search-bignum-range s e)
(search-fixnum-range s e)))))
(defun pnpoly (npol xp yp x y)
(declare (optimize (speed 3) (safety 0))
#+Lispworks (optimize (float 0))
(fixnum npol)
(double-float x y)
(type (simple-array double-float (*)) xp yp))
(let* ((c nil)
(j (1- npol)))
(declare (fixnum j))
(dotimes (i npol c)
(declare (fixnum i))
(if (and (or (and (<= (aref yp i) y) (< y (aref yp j)))
(and (<= (aref yp j) y) (< y (aref yp i))))
(< x (+ (aref xp i) (/ (* (- (aref xp j) (aref xp i))
(- y (aref yp i)))
(- (aref yp j) (aref yp i))))))
(setq c (not c)))
(setq j i))))
(defun pnpolymain (npol div)
(declare (optimize (speed 3) (safety 0))
#+Lispworks (optimize (float 0))
(fixnum npol div))
(let* ((xp (make-array npol :element-type 'double-float))
(yp (make-array npol :element-type 'double-float))
(theta 0.0d0)
(a 10.0d0)
#+clisp (pi (float pi 0.0d0))
(fdiv (/ (* 2 a) div))
(count 0))
(declare (double-float fdiv a theta)
(fixnum count)
(type (simple-array double-float (*)) xp yp))
(dotimes (i npol)
(declare (fixnum i))
(setq theta (/ (* 2 i pi) npol))
(setf (aref xp i) (+ a (* a (expt (cos theta) 3)))
(aref yp i) (+ a (* a (expt (sin theta) 3)))))
(dotimes (u (1+ div))
(declare (fixnum u))
(dotimes (v (1+ div))
(declare (fixnum v))
(if (pnpoly npol xp yp
#+Lispworks (* (coerce u 'double-float) fdiv)
#-Lispworks (* u fdiv)
#+Lispworks (* (coerce v 'double-float) fdiv)
#-Lispworks (* v fdiv)
)
(incf count))))
(format t "Area: ~a" (/ (* count 4 a a) (* (1+ div) (1+ div))))))
(defclass foo () ())
(defclass bar () (a b c))
(defclass baz () (x y))
(defgeneric gf-1-1 (a))
(defmethod gf-1-1 ((a foo)))
(defgeneric gf-1-2 (a))
(defmethod gf-1-2 ((a foo)))
(defmethod gf-1-2 ((a symbol)))
(defgeneric gf-1-3 (a))
(defmethod gf-1-3 ((a integer)))
(defmethod gf-1-3 ((a bar)))
(defmethod gf-1-3 ((a t)))
(defgeneric gf-2-3 (a b))
(defmethod gf-2-3 ((a integer) (b bar)))
(defmethod gf-2-3 ((a foo) (b t)))
(defmethod gf-2-3 ((a t) (b integer)))
(defun bench-gfs ()
(let ((foo (make-instance 'foo))
(bar (make-instance 'bar))
(baz (make-instance 'baz)))
(dotimes (i 10000)
(gf-1-1 foo)
(gf-1-1 foo)
(gf-1-2 foo)
(gf-1-2 'quux)
(gf-1-3 5)
(gf-1-3 foo)
(gf-2-3 5 bar)
(gf-2-3 foo 'quux)
(gf-2-3 baz 7))))
(defun bench-slot-value ()
(let ((bar (make-instance 'bar))
(baz (make-instance 'baz)))
(dotimes (i 100000)
(setf (slot-value bar 'a) 10)
(setf (slot-value baz 'y) 20)
(slot-value bar 'a)
(setf (slot-value bar 'c) 777)
(slot-value bar 'c)
(slot-value baz 'y))))
(defmacro ttime (&rest body)
`(progn ,@body))
(defun testrhyme ()
(print (ttime (rhyme "c:/personal/wattojd/benchmarks/gabriel/dict.txt"
"c:/personal/wattojd/benchmarks/gabriel/rhyme.txt"))))
(defun testprimecountfixnum ()
(print (ttime (prime-count 0 200000))))
(defun testprimecountbignum ()
(print (ttime (prime-count 1000000000050 1000000000100))))
(defun testpnpoly ()
(print (ttime (pnpolymain 200 400))))
(defun testgenericfunctions ()
(print (ttime (bench-gfs))))
(defun testslotvalues ()
(print (ttime (bench-slot-value))))
--
John Watton
Alcoa Inc.
===================================================================
--
Aaron Sloman, ( http://www.cs.bham.ac.uk/~axs/ )
School of Computer Science, The University of Birmingham, B15 2TT, UK
EMAIL A.Sloman AT cs.bham.ac.uk (NB: Anti Spam address)
PAPERS: http://www.cs.bham.ac.uk/research/cogaff/
|