;;; -*- Mode:LISP; Package:BENCH-UTENN; Base:10; source-optimizations:t -*-

;;; benchmarks submitted to LMI by the University of Tennesee Space Institute
;;; Dr Moonis Ali, Professor of Computer Science.

(defun fac1 (n) (and (f1 n) t))

(defun f1 (n)
  (cond ((eq n 0) 1)
	(t (times n (f1 (sub1 n))))))

(defun fac2 (n) (and (f2 n) t))

(defun f2 (n)
  (prog (x)
	(setq x 1)
     loop (setq x (times x n))
	(setq n (sub1 n))
	(and (equal n 0) (return x))
	(go loop)))

(defvar *l*)

(defun con (num)
  (prog ()
	(setq *l* '(b))
     loop (and (equal num 0) (return nil))
	(setq *l* (cons 'a *l*))
	(setq num (sub1 num))
	(go loop)))

(defun match1 (l)
  (prog ()
     loop (and (eq (car l) 'b) (return 'b))
	(setq l (cdr l))
	(go loop)))

(defun match2 (l)
  (cond ((eq (car l) 'b) 'b)
	(t (match2 (cdr l)))))


(verify:deftest fac1-100
		:code (fac1 100)
		:loop-count 200)

(verify:deftest fac1-250
		:code (fac1 250)
		:loop-count 50)

(verify:deftest fac1-400
		:code (fac1 400)
		:loop-count 10)

(verify:deftest fac2-100
		:code (fac2 100)
		:loop-count 200)

(verify:deftest fac2-250
		:code (fac2 250)
		:loop-count 50)

(verify:deftest fac2-400
		:code (fac2 400)
		:loop-count 10)

(defvar *l-500* (progn (con 500) *l*))

(defvar *l-1000* (progn (con 1000) *l*))

(defvar *l-3000* (progn (con 3000) *l*))

(verify:deftest match1-500
		:code (match1 *l-500*)
		:loop-count 300)

(verify:deftest match1-1000
		:code (match1 *l-1000*)
		:loop-count 150)

(verify:deftest match1-3000
		:code (match1 *l-3000*)
		:loop-count 50)

(verify:deftest match2-500
		:code (match2 *l-500*)
		:loop-count 300)

(verify:deftest match2-1000
		:code (match2 *l-1000*)
		:loop-count 150)

(verify:deftest match2-3000
		:code (match2 *l-3000*)
		:loop-count 50)

(verify:deftest con-500
		:code (con 500)
		:loop-count 100)

(verify:deftest con-1000
		:code (con 1000)
		:loop-count 50)

(verify:deftest con-3000
		:code (con 3000)
		:loop-count 16)

(defun run-all-tests ()
  (mapcar 'verify:run-test
	  (verify:tests-in-file (si:get-source-file-name 'run-all-tests))))