;;;-*- Mode:LISP; Package:BENCH-DERIVU; Base:10; source->source-optimizations: UCODE -*-
;;; We should time this with optimizations:T and optimization: UCODE
;;; to see what effect hand-microcode mapcar vs open-coding really is.
;;; From the "Dick Gabriel" Benchmark Series.
;;; Enhancements (C) Copyright 1983, Lisp Machine, Inc.

(EVAL-WHEN (EVAL COMPILE LOAD)
  (DEFCONST *TO-UCOMPILE* '(DER1 DERIV))
  (MAPC #'(LAMBDA (X)
	    (PUTPROP X T 'COMPILER:MICROCOMPILE)
	    (PUTPROP X
		     T ; ':DYNAMIC
		     ':DEPEND-ON-BEING-MICROCOMPILED))
	    *TO-UCOMPILE*))

;;;BEGIN
;;; DERIV
#-LISPM (DECLARE (MAPEX T))

(DEFUN DER1 (A) (LIST 'QUOTIENT (DERIV A) A))


(DEFUN DERIV (A)
	(COND 
	 ((ATOM A)
	  (COND ((EQ A 'X) 1) (T 0)))
	 ((EQ (CAR A) 'PLUS) (cons 'plus (MAPCAR #'DERIV (cdr a))))
	 ((EQ (CAR A) 'DIFFERENCE) 
	  (CONS 'DIFFERENCE (MAPCAR #'DERIV 
				    (CDR A))))
	 ((EQ (CAR A) 'TIMES)
	  (LIST 'TIMES 
		A 
		(CONS 'PLUS (MAPCAR #'DER1 (CDR A)))))
	 ((EQ (CAR A) 'QUOTIENT)
	  (LIST 'DIFFERENCE 
		(LIST 'QUOTIENT 
		      (DERIV (CADR A)) 
		      (CADDR A))
		(LIST 'QUOTIENT 
		      (CADR A) 
		      (LIST 'TIMES
			    (CADDR A)
			    (CADDR A)
			    (DERIV (CADDR A))))))
	 (T 'ERROR)))

(DEFUN RUN ()
 (DECLARE #-LISPM (FIXNUM I))
 (DO ((I 0 (1+ I)))
     ((= I 1000.))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))
     (DERIV '(PLUS (TIMES 3 X X) (TIMES A X X) (TIMES B X) 5))))

;(include "timer.lsp")

(defconst *ucode-loaded? nil)

(defun load-ucode ()
  (apply #'compiler:ma-load *to-ucompile*)
  (setq *ucode-loaded? t))

(timer timit
       (if *ucode-loaded? (run) "ucode not loaded"))

;;;END