;;-*-LISP-*-
;;
;; Some code for generating BenchMark reports. I have run this
;; in Maclisp, Franz, NIL, and Lispmachine lisps.
;; This tries to provide reasonable timing information on each system,
;; in a form which can be use for indirect comparisons. No attempt
;; is made to normalize the numerical data, as this is best done
;; during a second analysis pass.
;; 2:21pm  Friday, 2 October 1981  -George Carrette.

;; Summary of available timers:
;; LISPM: (TIME) with (TIME-DIFFERENCE T1 T2) gives 60'th of sec wallclock.
;; MACLISP: (RUNTIME) (STATUS GCTIME) give microseconds cpu time.
;; FRANZ: (PTIME) gives a list (RUNTIME GCTIME) in 60'th of sec cpu time.
;; NIL:   (RUNTIME) gives cpu time in 100'th of sec. 
;;        (TIME) gives wallclock accurate to seconds.
;;
;; Notes: Page fault information is also important, as is wallclock time
;;        on all systems. 
;; N.B. This code must be in all lower case, as to be easily read in
;;      multics maclisp and Franz.

(defprop bench 1 version)

#+(or pdp10 nil) (herald bench)

(declare (special bench-output-stream))

(defun benchmark-to-file (l filename)
  #+lispm
  (with-open-file (stream filename '(:out))
		  (benchmark-to-stream l stream))
  #-lispm
  (let ((stream))
    (unwind-protect
     (benchmark-to-stream l (setq stream #-franz (open filename 'out)
				         #+franz (outfile filename)))
     (and stream (close stream)))))

(defun benchmark (l)
  (benchmark-to-stream l
		       #+(or lispm nil)
		       terminal-io
		       #-(or lispm nil)
		       t))

(defun benchmark-to-stream (l bench-output-stream)
  (let (#+(or maclisp lispm) (base 10.)
	  before accumulator)
    (bench-print-header l)
    (setq before (benchstate))
    (setq accumulator (benchstate-difference before before))
    (do ((l l (cdr l))
	 (j 0 (1+ j)))
	((null l)
	 (bench-print "**total accumulated time for this benchmark**")
	 (benchstate-print accumulator)
	 (bench-print "**total time including printing**")
	 (benchstate-print (benchstate-difference (benchstate) before))
	 (bench-print "***end of test***"))
      (bench-print `("expression number" ,j))
      (bench-print (car l))
      (let ((state (benchstate)))
	(let ((result (eval (car l))))
	  (setq state (benchstate-difference (benchstate) state))
	  (benchstate-print state)
	  (setq accumulator (benchstate-accumulate accumulator state))
	  (bench-print result))))))

(defun benchstate ()
  #+maclisp (list (runtime) (status gctime))
  #+nil     (list (runtime) (time))
  #+franz   (ptime)
  #+lispm   (time))

(defun benchstate-difference (x y)
  #+maclisp (list (- (car x) (car y)) (- (cadr x) (cadr y)))
  #+nil     (list (- (car x) (car y)) (-$ (cadr x) (cadr y)))
  #+franz   (list (- (car x) (car y)) (- (cadr x) (cadr y)))
  #+lispm   (time-difference x y))

(defun benchstate-accumulate (x y)
    #+maclisp (list (+ (car x) (car y)) (+ (cadr x) (cadr y)))
    #+nil     (list (+ (car x) (car y)) (+$ (cadr x) (cadr y)))
    #+franz   (list (+ (car x) (car y)) (+ (cadr x) (cadr y)))
    #+lispm   (+ x y))

(defun benchstate-print (x)
  (bench-print
   #+maclisp `(,(car x) "cpu runtime" ,(cadr x) "gctime" "in microseconds")
   #+nil  `(,(car x) "centiseconds cpu runtime" ,(cadr x) "seconds realtime.")
   #+franz`(,(car x) "cpu runtime" ,(cadr x) "gctime" "in 60'ths of a second")
   #+lispm `(,x "60'ths of a second realtime.")))

(defun bench-print (x)
  (print x bench-output-stream)
  #+franz
  ;; ah yes, winning franz.
  (terpri bench-output-stream))

(defun bench-print-header (l)
  (bench-print `("benchmark by run by"
		 #+(or maclisp nil)       ,(status userid)
		 #+lispm                  ,user-id
		 #-(or maclisp nil lispm) "somebody"))
  (bench-print #+(or maclisp nil) `(,(status dow) ,(status daytime)
						  ,(status date))
	       #+lispm            (time:print-current-date ())
	       #-(or maclisp nil lispm) "on some date")
  (bench-print `("ready to benchmark" ,(length l) "expressions.")))