diff --git a/src/gabriel/boyer.cl b/src/gabriel/boyer.cl index 2c5d44d40..3e80d666a 100644 --- a/src/gabriel/boyer.cl +++ b/src/gabriel/boyer.cl @@ -4,6 +4,8 @@ ;;; BOYER -- Logic programming benchmark, originally written by Bob Boyer. ;;; Fairly CONS intensive. +(in-package "TESTING") + (defvar **unify-subst**) (defvar **temp-temp**) diff --git a/src/gabriel/browse.cl b/src/gabriel/browse.cl index b715cdc85..194ff88ef 100644 --- a/src/gabriel/browse.cl +++ b/src/gabriel/browse.cl @@ -4,6 +4,8 @@ ;;; BROWSE -- Benchmark to create and browse through an AI-like data base ;;; of units. +(in-package "TESTING") + ;;; n is # of symbols ;;; m is maximum amount of stuff on the plist ;;; npats is the number of basic patterns on the unit diff --git a/src/gabriel/ctak.cl b/src/gabriel/ctak.cl index ebba2370a..9e5a918de 100644 --- a/src/gabriel/ctak.cl +++ b/src/gabriel/ctak.cl @@ -3,6 +3,8 @@ ;;; CTAK -- A version of the TAKeuchi function that uses the CATCH/THROW facility. +(in-package "TESTING") + (defun ctak (x y z) (catch 'ctak (ctak-aux x y z))) diff --git a/src/gabriel/dderiv.cl b/src/gabriel/dderiv.cl index 275545cd5..2841b0678 100644 --- a/src/gabriel/dderiv.cl +++ b/src/gabriel/dderiv.cl @@ -16,6 +16,8 @@ ;;; property list of FOO under the indicator BAR, in this case. You may have ;;; to do something like: +(in-package "TESTING") + ;;; :property keyword is not Common Lisp. (defun dderiv-aux (a) diff --git a/src/gabriel/deriv.cl b/src/gabriel/deriv.cl index e8755644f..c3f6b5282 100644 --- a/src/gabriel/deriv.cl +++ b/src/gabriel/deriv.cl @@ -4,6 +4,8 @@ ;;; DERIV -- Symbolic derivative benchmark written by Vaughn Pratt. ;;; It uses a simple subset of Lisp and does a lot of CONSing. +(in-package "TESTING") + (defun deriv-aux (a) (list '/ (deriv a) a)) (defun deriv (a) diff --git a/src/gabriel/destru-mod.cl b/src/gabriel/destru-mod.cl index 810c04a58..8da32fac2 100644 --- a/src/gabriel/destru-mod.cl +++ b/src/gabriel/destru-mod.cl @@ -6,7 +6,8 @@ ;;mod: add fixnum declaration for n in the following let: ;; (let ((n (floor (the fixnum (length (car l1))) 2))) - +(in-package "TESTING") + (defun destructive (n m) (declare (type fixnum n m)) (let ((l (do ((i 10. (the fixnum (1- i))) diff --git a/src/gabriel/destru.cl b/src/gabriel/destru.cl index 84b6c51ce..f4f308ef2 100644 --- a/src/gabriel/destru.cl +++ b/src/gabriel/destru.cl @@ -3,6 +3,8 @@ ;; DESTRU -- Destructive operation benchmark +(in-package "TESTING") + (defun destructive (n m) (declare (type fixnum n m)) (let ((l (do ((i 10. (the fixnum (1- i))) diff --git a/src/gabriel/div2.cl b/src/gabriel/div2.cl index 4ac84ca71..5882fbbed 100644 --- a/src/gabriel/div2.cl +++ b/src/gabriel/div2.cl @@ -4,6 +4,8 @@ ;;; DIV2 -- Benchmark which divides by 2 using lists of n ()'s. ;;; This file contains a recursive as well as an iterative test. +(in-package "TESTING") + (defun create-n (n) (declare (type fixnum n)) (do ((n n (the fixnum (1- n))) diff --git a/src/gabriel/fft-mod.cl b/src/gabriel/fft-mod.cl index c0b0b7327..fb736f4b4 100644 --- a/src/gabriel/fft-mod.cl +++ b/src/gabriel/fft-mod.cl @@ -4,6 +4,8 @@ ;; FFT -- This is an FFT benchmark written by Harry Barrow. ;; It tests a variety of floating point operations, including array references. +(in-package "TESTING") + (defvar **fft-re** (make-array 1025. :element-type #+excl 'single-float #+lucid 'float #+KCL 'single-float diff --git a/src/gabriel/fft.cl b/src/gabriel/fft.cl index 2351f2b99..4a54612ab 100644 --- a/src/gabriel/fft.cl +++ b/src/gabriel/fft.cl @@ -4,6 +4,8 @@ ;; FFT -- This is an FFT benchmark written by Harry Barrow. ;; It tests a variety of floating point operations, including array references. +(in-package "TESTING") + (defvar **fft-re** (make-array 1025. :element-type #+excl 'single-float #+lucid 'float #+KCL 'single-float diff --git a/src/gabriel/fprint.cl b/src/gabriel/fprint.cl index a097cb276..9ac4c0635 100644 --- a/src/gabriel/fprint.cl +++ b/src/gabriel/fprint.cl @@ -3,6 +3,8 @@ ;;; FPRINT -- Benchmark to print to a file. +(in-package "TESTING") + (defvar test-atoms '(abcdef12 cdefgh23 efghij34 ghijkl45 ijklmn56 klmnop67 mnopqr78 opqrst89 qrstuv90 stuvwx01 uvwxyz12 wxyzab23 xyzabc34 123456ab 234567bc 345678cd diff --git a/src/gabriel/fread.cl b/src/gabriel/fread.cl index b14a21631..aadc395f2 100644 --- a/src/gabriel/fread.cl +++ b/src/gabriel/fread.cl @@ -5,6 +5,8 @@ ;;; Pronounced "FRED". Requires the existance of FPRINT.TST which is created ;;; by FPRINT. +(in-package "TESTING") + (defun fread () (let ((stream (open "/tmp/fprint.tst" :direction :input))) (read stream) diff --git a/src/gabriel/frpoly-mod.cl b/src/gabriel/frpoly-mod.cl index 75b1e65d0..bd02f4132 100644 --- a/src/gabriel/frpoly-mod.cl +++ b/src/gabriel/frpoly-mod.cl @@ -18,6 +18,8 @@ ;; used to handle polynomial coefficients in a recursive ;; way. Declaring them global is the wrong approach. +(in-package "TESTING") + (defvar ans) (defvar coef) (defvar f) diff --git a/src/gabriel/frpoly.cl b/src/gabriel/frpoly.cl index 52e42e5be..07d77efaa 100644 --- a/src/gabriel/frpoly.cl +++ b/src/gabriel/frpoly.cl @@ -18,6 +18,8 @@ ;; used to handle polynomial coefficients in a recursive ;; way. Declaring them global is the wrong approach. +(in-package "TESTING") + (defvar ans) (defvar coef) (defvar f) diff --git a/src/gabriel/puzzle-mod.cl b/src/gabriel/puzzle-mod.cl index beffa5f69..ceb530e1e 100644 --- a/src/gabriel/puzzle-mod.cl +++ b/src/gabriel/puzzle-mod.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + (eval-when (compile load eval) (defconstant puzzle-size 511.) (defconstant puzzle-classmax 3.) diff --git a/src/gabriel/puzzle-mod1.cl b/src/gabriel/puzzle-mod1.cl index 9f2dacd13..fb352e552 100644 --- a/src/gabriel/puzzle-mod1.cl +++ b/src/gabriel/puzzle-mod1.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + (eval-when (compile load eval) (defconstant puzzle-size 511.) (defconstant puzzle-classmax 3.) diff --git a/src/gabriel/puzzle-mod2.cl b/src/gabriel/puzzle-mod2.cl index 011db453a..d8adcff1f 100644 --- a/src/gabriel/puzzle-mod2.cl +++ b/src/gabriel/puzzle-mod2.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + (eval-when (compile load eval) (defconstant puzzle-size 511.) (defconstant puzzle-classmax 3.) diff --git a/src/gabriel/puzzle.cl b/src/gabriel/puzzle.cl index 85993008e..840e5467b 100644 --- a/src/gabriel/puzzle.cl +++ b/src/gabriel/puzzle.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + (eval-when (compile load eval) (defconstant puzzle-size 511.) (defconstant puzzle-classmax 3.) diff --git a/src/gabriel/stak.cl b/src/gabriel/stak.cl index c9609d381..652aa06be 100644 --- a/src/gabriel/stak.cl +++ b/src/gabriel/stak.cl @@ -4,6 +4,8 @@ ;;; STAK -- The TAKeuchi function with special variables instead of ;;; parameter passing. +(in-package "TESTING") + (defvar stak-x) (defvar stak-y) (defvar stak-z) diff --git a/src/gabriel/tak-mod.cl b/src/gabriel/tak-mod.cl index 474b565a0..321a4139f 100644 --- a/src/gabriel/tak-mod.cl +++ b/src/gabriel/tak-mod.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + #+excl (eval-when (compile) (setq comp::register-use-threshold 6)) diff --git a/src/gabriel/tak.cl b/src/gabriel/tak.cl index 88874e1c8..fbcda92fb 100644 --- a/src/gabriel/tak.cl +++ b/src/gabriel/tak.cl @@ -1,6 +1,8 @@ ;; $Header$ ;; $Locker$ +(in-package "TESTING") + #+excl (eval-when (compile) (setq comp::register-use-threshold 6)) diff --git a/src/gabriel/takl.cl b/src/gabriel/takl.cl index 2d15be7d5..50579d296 100644 --- a/src/gabriel/takl.cl +++ b/src/gabriel/takl.cl @@ -3,6 +3,8 @@ ;;; TAKL -- The TAKeuchi function using lists as counters. +(in-package "TESTING") + (defun listn (n) (declare (type fixnum n)) (if (not (= 0 n)) diff --git a/src/gabriel/takr.cl b/src/gabriel/takr.cl index c728621f3..dd4c80ffb 100644 --- a/src/gabriel/takr.cl +++ b/src/gabriel/takr.cl @@ -5,6 +5,8 @@ ;;; memory effects. Results should be the same as for TAK on stack machines. ;;; Distribution of calls is not completely flat. +(in-package "TESTING") + (defun tak0 (x y z) (declare (type fixnum x y z)) (cond ((not (< y x)) z) diff --git a/src/gabriel/tprint.cl b/src/gabriel/tprint.cl index 18e11956d..7ad84574b 100644 --- a/src/gabriel/tprint.cl +++ b/src/gabriel/tprint.cl @@ -3,6 +3,8 @@ ;;; TPRINT -- Benchmark to print and read to the terminal. +(in-package "TESTING") + (defvar test-atoms '(abc1 cde2 efg3 ghi4 ijk5 klm6 mno7 opq8 qrs9 stu0 uvw1 wxy2 xyz3 123a 234b 345c 456d 567d 678e 789f 890g)) diff --git a/src/gabriel/traverse.cl b/src/gabriel/traverse.cl index cfd3ebbbc..29c31653a 100644 --- a/src/gabriel/traverse.cl +++ b/src/gabriel/traverse.cl @@ -3,6 +3,7 @@ ;;; TRAVERSE -- Benchmark which creates and traverses a tree structure. +(in-package "TESTING") (eval-when (eval compile load) (defstruct node diff --git a/src/gabriel/triang-mod.cl b/src/gabriel/triang-mod.cl index ecb90aac0..425f3590d 100644 --- a/src/gabriel/triang-mod.cl +++ b/src/gabriel/triang-mod.cl @@ -3,6 +3,8 @@ ;;; TRIANG -- Board game benchmark. +(in-package "TESTING") + (defvar a) (defvar b) (defvar c) @@ -10,10 +12,10 @@ (defvar final) (eval-when (eval compile) -(proclaim '(special board sequence a b c)) -(proclaim '(special board sequence a b c)) +(proclaim '(special board seq a b c)) +(proclaim '(special board seq a b c)) (proclaim '(type (vector fixnum ) board)) -(proclaim '(type (vector fixnum ) sequence)) +(proclaim '(type (vector fixnum ) seq)) (proclaim '(type (vector fixnum ) a)) (proclaim '(type (vector fixnum ) b)) (proclaim '(type (vector fixnum ) c)) @@ -26,7 +28,7 @@ (defun triang-setup () (setq board (make-array 16 :element-type 'fixnum :initial-element 1)) - (setq sequence (make-array 14 :element-type 'fixnum :initial-element 0)) + (setq seq (make-array 14 :element-type 'fixnum :initial-element 0)) (setq a (make-array 37 @@ -61,8 +63,8 @@ (let ((lp (last-position))) (unless (member lp final :test #'eq) (push lp final))) - ;;; (format t "~&~s" (cdr (simple-vector-to-list sequence))) - (push (cdr (simple-vector-to-list sequence)) + ;;; (format t "~&~s" (cdr (simple-vector-to-list seq))) + (push (cdr (simple-vector-to-list seq)) answer) t) ; this is a hack to replace LISTARRAY ((and (eql 1 (aref board (aref a i))) (eql 1 (aref board (aref b i))) @@ -70,7 +72,7 @@ (setf (aref board (aref a i)) 0) (setf (aref board (aref b i)) 0) (setf (aref board (aref c i)) 1) - (setf (aref sequence depth) i) + (setf (aref seq depth) i) (do ((j 0 (the fixnum (+ j 1))) (depth (the fixnum (+ depth 1)))) ((or (= j 36) @@ -94,11 +96,5 @@ (try i 1))) (defun testtriang () - (declare (notinline cos aref)) - (print (cos 1.0)) (triang-setup) - (print board) - (print (aref a 22)) - (print (aref b 22)) - (print (aref c 22)) (gogogo 22)) diff --git a/src/gabriel/triang-old-mod.cl b/src/gabriel/triang-old-mod.cl index c7337418c..f3a99d849 100644 --- a/src/gabriel/triang-old-mod.cl +++ b/src/gabriel/triang-old-mod.cl @@ -3,6 +3,8 @@ ;;; TRIANG -- Board game benchmark. +(in-package "TESTING") + (proclaim '(special board sequence a b c)) (proclaim '(type (vector fixnum) a b c)) diff --git a/src/gabriel/triang.cl b/src/gabriel/triang.cl index a37aacf7e..155624717 100644 --- a/src/gabriel/triang.cl +++ b/src/gabriel/triang.cl @@ -3,13 +3,15 @@ ;;; TRIANG -- Board game benchmark. -(declaim (special board sequence a b c)) +(in-package "TESTING") + +(declaim (special board seq a b c)) (defvar answer) (defvar final) (defun triang-setup () (setq board (make-array 16 :initial-element 1)) - (setq sequence (make-array 14 :initial-element 0)) + (setq seq (make-array 14 :initial-element 0)) (setq a (make-array 37 @@ -39,7 +41,7 @@ (let ((lp (last-position))) (unless (member lp final :test #'eq) (push lp final))) - (push (cdr (simple-vector-to-list sequence)) + (push (cdr (simple-vector-to-list seq)) answer) t) ; this is a hack to replace LISTARRAY ((and (eq 1 (svref board (svref a i))) (eq 1 (svref board (svref b i))) @@ -47,7 +49,7 @@ (setf (svref board (svref a i)) 0) (setf (svref board (svref b i)) 0) (setf (svref board (svref c i)) 1) - (setf (svref sequence depth) i) + (setf (svref seq depth) i) (do ((j 0 (the fixnum (+ j 1))) (depth (the fixnum (+ depth 1)))) ((or (= j 36)