;;;-*- Mode:LISP; Package:BENCH-DDERIVU; Base:10; source->source-optimizations:t -*-
;;; From the "Dick Gabriel" Benchmark Series.
;;; Enhancements (C) Copyright 1983, Lisp Machine, Inc.

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

(eval-when (eval compile load)
  (defconst *to-ucompile* '( (:property plus deriv) (:property difference deriv)
			     (:property times deriv) (:property quotient deriv)
			     der1 deriv run))
  (MAPC #'(LAMBDA (X)
	    (si:function-spec-PUTPROP X T 'COMPILER:MICROCOMPILE)
	    (si:function-spec-PUTPROP X
				      T ; ':DYNAMIC
				      ':DEPEND-ON-BEING-MICROCOMPILED))
	*TO-UCOMPILE*))

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

(DEFUN (PLUS DERIV) (A)
       (CONS 'PLUS (MAPCAR #'DERIV A)))

(DEFUN (DIFFERENCE DERIV) (A)
       (CONS 'DIFFERENCE (MAPCAR #'DERIV 
				 A)))

(DEFUN (TIMES DERIV) (A)
	(LIST 'TIMES (CONS 'TIMES A)
		(CONS 'PLUS (MAPCAR 'DER1 A))))

(DEFUN (QUOTIENT DERIV) (A)
       (LIST 'DIFFERENCE 
	     (LIST 'QUOTIENT 
		   (DERIV (CAR A)) 
		   (CADR A))
	     (LIST 'QUOTIENT 
		   (CAR A) 
		   (LIST 'TIMES
			 (CADR A)
			 (CADR A)
			 (DERIV (CADR A))))))

 (DEFUN DERIV (A)
	(COND 
	 ((ATOM A)
	  (COND ((EQ A 'X) 1) (T 0)))
	 (T (LET ((DERIV (GET (CAR A) 'DERIV)))
		 (COND (DERIV (FUNCALL DERIV (CDR A)))
		       (T 'ERROR))))))

(DEFUN RUN ()
 (DECLARE (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-without-interrupts timit 
       (if *ucode-loaded? (run) "ucode not loaded"))

;;;END