Re: PCL 70 times slower than Ernie with 1000 cars.

[Gregor.pa@Xerox.COM]

    Date: Mon, 14 Nov 88 15:19:10 PST
    From: burdorf%taos@rand.org

    I'm sorry to report this sad fact, but Bruce Florman  requested
    that I do a comparison between ERNIE and PCL with 1000 cars on
    the carwash simulation.

In short your numbers are:

  PCL   4871 seconds (81 minutes)
  Ernie 63   seconds (1 minute)

So that the PCL version of the program is about 78 times slower than the
Ernie version.

At the end of this message is a version of the carwash program converted
to using defstruct and typecase.  I can tell you that this version of
the program, on a SUN4, in Lucid Lisp, compiled with the prodcution
compiler took more than 40 minutes to run (I got tired of waiting for it
to finish).

This suggests that what is going on here has nothing to do with the
object system, but is in fact an artifact of the program.  One question
I would ask is who wrote the original carwash program?  What process was
taken to convert that version to the PCL version?  

I ask is because when I look at the carwash program I see a number of
astounding performance bugs.  This kind of math is not specialty, but it
appears to me that these bugs are more than quadratic in the number of
cars.  There are also a number of what appear to be off by 1 errors, but
I can't tell whether they effect performance.

I suspect, but can't know, that in the conversion from ERNIE code to PCL
code, some performance inefficiences were inadvertently introduced which
have nothing to do with the underlying object system.  Once again, I
would ask to see the code for the Ernie version of the program.

Please try comparing this version of the program with both the ERNIE and
PCL versions.  Because time is money, you might want to try all three
with 500 cars rather than 1000.

(defstruct bert)

(defstruct (simulator (:include bert)
		      (:conc-name nil))
  (things-to-do  nil)
  (history  nil)
  (db  nil))

(defstruct (clock (:include bert)
		  (:conc-name nil))
  (current-time 0)
  (actors-running nil)
  (ticksize 1))

(defvar *clock* (make-clock))

(defun do-after (obj n action)
  (let ((l (things-to-do obj))
	(ti (+ (current-time *clock*) n)))
    (when (or (not l) (< ti (caar l)))
      (setf (actors-running *clock*)
	    (inserttm (cons ti obj) (actors-running *clock*))))
    (setf (things-to-do obj)
	  (inserttm (cons ti action)
		    (things-to-do obj)))))

(defun tick (cl)
  (let ((newtime (+ (current-time *clock*)
		    (ticksize *clock*))))
    (do* ((events (actors-running *clock*) (actors-running *clock*)))
	 ((not (and  events  (>= newtime (caar events)))))
	 (setf (current-time *clock*) (caar events))
	 (do ((ev events (cdr ev)))
	     ((not (and ev (equal (current-time *clock*) (caar ev)))))
	   (pop (actors-running *clock*))
	   (atick (cdar ev))))
    (setf (current-time *clock*) newtime)))

(defun atick (obj)
  (let ((ttd nil))
    (do nil
	((not (and (setq ttd (things-to-do obj))
		   (>= (current-time *clock*) (caar ttd)))))
      (EVAL (CDAR TTD))
      (pop (things-to-do obj)))
    (when (things-to-do obj)
      (setf (actors-running *clock*)
	    (mergetm (cons (caar (things-to-do obj)) obj)
		     (actors-running *clock*))))))
	     

(defun run (cl)
  (do nil 
      ((not (actors-running cl)))
    (tick cl)))

(DEFUN TICK-TIMES (CL N)			;This is weird, it used
  (DOTIMES (I (1- N))				;to use a hand coded do
    (TICK CL)))					;instead of dotimes.  It
						;also only does it n-1
						;times not n times.


(defun inserttm (itm l)
  (cond ((null l) (list itm))
	((< (car itm) (CAR (CAR l)))
	 (cons itm l))
	(t (cons (car l)
		 (inserttm itm (cdr l))))))

(defun mergetm (itm l)
  (cond ((member itm l) l)
	(t (inserttm itm l))))



(defstruct (delayer (:include simulator)
		    (:conc-name nil))
  (twxwindow nil)
  (twxautopix nil)
  (twautofont nil)
  (IQ nil)
  (car-x-pos nil)
  (car-y-pos nil)
  (queue-x-pos nil)
  (queue-y-pos  nil)
  (in-use nil)
  (delay-factor nil))


(defstruct (vacuumer  (:include delayer)
		      (:conc-name nil))
  (illegal-alien nil)
  (vacuumer-ashtray-contents nil)
  (carwash1-iq nil)
  (carwash2-iq nil)
  (carwash1-delay nil)
  (carwash2-delay nil))

(defstruct (waxer (:include delayer)))
       
(defstruct (carwash (:include delayer)))
              
(defstruct (autos (:include simulator)
		  (:conc-name nil))
  (autos-ashtray-contents nil))

(defun ashtray-contents (obj)
  (etypecase obj
    (vacuumer (vacuumer-ashtray-contents obj))
    (autos (autos-ashtray-contents obj))))

(defvar autoinstances nil)

(defvar vacuumer1 (make-vacuumer
		    ':delay-factor   3
		    ':illegal-alien   t
		    ':carwash1-delay   12
		    ':carwash2-delay   2
		    ':queue-x-pos   10
		    ':queue-y-pos   100
		    ':car-x-pos   50
		    ':car-y-pos   175))

(defvar waxer1 (make-waxer
		 ':delay-factor   8
		 ':queue-x-pos   400
		 ':queue-y-pos   120
	 	 ':car-x-pos   430
		 ':car-y-pos   175))

(defvar  carwash1 (make-carwash
		    ':delay-factor   12
		    ':queue-x-pos   100
		    ':queue-y-pos   10
		    ':car-x-pos   200
		    ':car-y-pos   80))

(defvar carwash2 (make-carwash
		   ':delay-factor   2
		   ':queue-x-pos   100
		   ':queue-y-pos   280
		   ':car-x-pos   200
		   ':car-y-pos   205))


(defun add-to-queue (obj auto)
  ;add a new entry to an object's input queue.
  (setf (iq obj) (APPEND (iq obj) (list auto))))

(defun next-iq-entry (obj)
  ;process the next iq entry off of a queue.
  (cond ((iq obj)
	 (do-after obj 0.1 `(write-icon ',obj))
	 (do-after obj 0.2 `(finish ',obj ',(car (iq obj))))
	 (setf (in-use obj) t)
	 (setf (iq obj) (cdr (iq obj))))))
	   
(defun not-in-use (obj)
  ;This function sets the delayer to not in use.
  (setf (in-use obj) nil))

(defun write-icon (obj) nil)

(defun finish-carwash (cwash auto)
  ;pass the automobile off to the next position.
  (let ((st (delay-factor cwash)))
    (do-after cwash st  `(write-icon ',cwash))
    (do-after waxer1 st `(add-to-queue waxer1  ',auto))
    (do-after waxer1 (+ st 0.1) `(next-iq-entry waxer1))
    (do-after cwash st `(not-in-use ',cwash))
    (do-after cwash st `(next-iq-entry ',cwash))))
    
(defun leaving-vacuum (vac auto))

(defun stopped-stealing (vax auto))

(defun finish (station auto)
  (etypecase station
    (carwash (finish-carwash station auto))
    (vacuumer (finish-vacuumer station auto))
    (waxer (finish-waxer station auto))))

(defun finish-vacuumer (vac auto)
  ;preschedule getting the carwash queues.
  (let* ((vacst (delay-factor vac))
	 (queue1 (iq carwash1))
	 (queue2 (iq carwash2))
	 (empty-carwash (cond ((in-use carwash1) carwash2)
			      ((in-use carwash2) carwash1)
			      ((> (length queue1) (length queue2))
			       carwash2)
			      (t carwash1)))
	 (delay nil)
	 (st (delay-factor empty-carwash)))
    (when (and (eq (autos-ashtray-contents auto) 'money)
	       (illegal-alien vac))
      (do-after vac 0.5 `(stopped-stealing ',vac ',auto)))
    (setq delay (+ st (find-times (if (eq empty-carwash carwash1)
				      queue1
				      queue2))))
    (do-after empty-carwash vacst `(add-to-queue ',empty-carwash ',auto))
    (do-after empty-carwash delay `(next-iq-entry ',empty-carwash))
    (do-after vac vacst `(leaving-vacuum ',vac ',auto))
    (do-after vac vacst `(next-iq-entry ',vac))
    (do-after vac vacst `(write-icon ',vac))))

(defun find-times (x)
  (if x (length x) 1))

(defun finish-waxer (wax auto)
  ;see if more to wax.
  (let ((st (delay-factor wax)))
    (do-after  wax st `(write-icon ',wax))
    (do-after wax  st `(next-iq-entry ',wax))))


(defun get-going ()
  (setf (iq vacuumer1) nil)
  (setf (things-to-do vacuumer1) nil)
  (setf (things-to-do waxer1) nil)
  (setf (iq waxer1) nil)
  (setf (things-to-do carwash1) nil)
  (setf (iq carwash1) nil)
  (setf (things-to-do carwash2) nil)
  (setf (iq carwash2) nil)
  (setf (actors-running *clock*) nil)
  (do ((auto (car autoinstances) (car restainst))
       (restainst (cdr autoinstances) (cdr restainst))
	 (n 1 (1+ n)))
      ((null  restainst))
    (add-to-queue vacuumer1 (eval auto)))
   ; (flush-screen artist)
  (next-iq-entry vacuumer1)
  (run *clock*))

(defun init-graphics () nil)

(defun generate-cars (n)
  (setq autoinstances nil)
  (do ((x 1 (1+ x)))
      ((< n x))
    (write-car-instance x)))  

(defun write-car-instance ( num)
  (let ((rnum (random num))
	(instance (intern (format nil "AUTO-~D" num))))
    (setq autoinstances (cons instance autoinstances))
    (eval `(defvar ,instance (make-autos
			       ':autos-ashtray-contents (case (rem ,rnum 3)
							  (0   'ashes)
							  (1  'gum)
							  (2 'money)))))))
				     
				     		    

-------