(FILECREATED " 8-Dec-86 12:59:44" {QV}<PEDERSEN>LISP>TEST-UNBOXED-FLOAT.;3 9243   

      changes to:  (VARS TEST-UNBOXED-FLOATCOMS UNBOXED-FLOAT-BENCHMARK-SUITE)
		   (FNS PRINT-UNBOXED-FLOAT-BENCHMARK RUN-UNBOXED-FLOAT-BENCHMARKS SETUP-UFARRAYS 
			TEST.BLKDIFF TEST.BLKPLUS TEST.BLKTIMES TEST.POLYNOM TEST.UFABS 
			TEST.UFDIFFERENCE TEST.UFEMPTYLOOP TEST.UFGREATERP TEST.UFIX TEST.UFMAX 
			TEST.UFMIN TEST.UFMINUS TEST.UFPLUS TEST.UFQUOTIENT TEST.UFTIMES)

      previous date: "28-Aug-86 13:27:15" {QV}<PEDERSEN>LISP>TEST-UNBOXED-FLOAT.;2)


(* Copyright (c) 1986 by Xerox Corporation. All rights reserved.)

(PRETTYCOMPRINT TEST-UNBOXED-FLOATCOMS)

(RPAQQ TEST-UNBOXED-FLOATCOMS ((FNS PRINT-UNBOXED-FLOAT-BENCHMARK RUN-UNBOXED-FLOAT-BENCHMARKS 
				      SETUP-UFARRAYS TEST.BLKDIFF TEST.BLKPLUS TEST.BLKTIMES 
				      TEST.POLYNOM TEST.UFABS TEST.UFDIFFERENCE TEST.UFEMPTYLOOP 
				      TEST.UFGREATERP TEST.UFIX TEST.UFMAX TEST.UFMIN TEST.UFMINUS 
				      TEST.UFPLUS TEST.UFQUOTIENT TEST.UFTIMES)
	(VARS UNBOXED-FLOAT-BENCHMARK-SUITE)
	(FILES (FROM VALUEOF DIRECTORIES)
	       CMLARRAY)
	(FILES (FROM VALUEOF DIRECTORIES)
	       UNBOXEDOPS)
	(FILES (FROM {QV}<PEDERSEN>LISP>)
	       ARRAYSUPPORT)))
(DEFINEQ

(PRINT-UNBOXED-FLOAT-BENCHMARK
  [LAMBDA (F N)                                              (* jop: "20-Aug-86 17:09")
    (LET ((TESTFN (PACK* (QUOTE TEST.)
			   F)))
         (PRINTOUT T T "***************" , F , "Benchmark ******************" T T)
         (PRINTOUT T T T "Starting the" , F , "run (TIMEALL (" TESTFN , N ")" T T)
         (SETQ VALUE (TIMEALL (APPLY* TESTFN N)))
         (PRINTOUT T "Value is" , VALUE T T)
         (FRPTQ 10 (RECLAIM))
         (PRINTOUT T T "Repeating the TIMEALL" T T)
         (SETQ VALUE (TIMEALL (APPLY* TESTFN N)))
         (PRINTOUT T "Value is" , VALUE T T)
         (FRPTQ 10 (RECLAIM))
         (PRINTOUT T T F , "Finished" T T])

(RUN-UNBOXED-FLOAT-BENCHMARKS
  [LAMBDA (BENCHMARKS)                                       (* jop: "31-Mar-86 16:54")

          (* * BENCHMARKS should be a list of the desired Benchmarks)


    (DECLARE (GLOBALVARS UNBOXED-FLOAT-BENCHMARK-SUITE))
    (if (NULL BENCHMARKS)
	then (SETQ BENCHMARKS UNBOXED-FLOAT-BENCHMARK-SUITE))
    (SETUP-UFARRAYS)
    (RESETLST (LET ((DRIBBLE.FILE (PACKFILENAME (QUOTE HOST)
						    (QUOTE DSK)
						    (QUOTE NAME)
						    (PACK* MAKESYSNAME "-" (MACHINETYPE)
							     "-UNBOXEDFLOAT")
						    (QUOTE EXTENSION)
						    (QUOTE BENCHMARKS)))
		      VALUE)
		     (DECLARE (SPECVARS VALUE))
		     (RESETSAVE NIL (QUOTE (TERPRI)))
		     (RESETSAVE *PRINT-ARRAY* T)
		     (RESETSAVE NIL (LIST (QUOTE PRIN1)
					      (CONCAT "Benchmark Results in " DRIBBLE.FILE)))
		     (RESETSAVE (DRIBBLE DRIBBLE.FILE))
		     (MOVD (QUOTE PAGEFULLFN)
			     (QUOTE PAGEFULLFN.SAVE))
		     (RESETSAVE NIL (QUOTE (MOVD PAGEFULLFN.SAVE PAGEFULLFN)))
		     (MOVD (QUOTE NILL)
			     (QUOTE PAGEFULLFN))
		     (printout T T "MACHINETYPE = " (MACHINETYPE)
			       T)
		     (printout T T "MAKESYSNAME = " MAKESYSNAME T)
		     (printout T T "MAKESYSDATE = " MAKESYSDATE T)
		     (printout T T "DATE = " (DATE)
			       T)
		     (printout T T "USERNAME = " (USERNAME)
			       T T)
		     (for BM in BENCHMARKS do (PRINT-UNBOXED-FLOAT-BENCHMARK (CAR BM)
										     (CADR BM)))
		     (PRINTOUT T "Finished benchmarking" T T])

(SETUP-UFARRAYS
  [LAMBDA NIL
    (DECLARE (GLOBALVARS ARRAY-A ARRAY-B))               (* edited: " 8-Dec-86 12:42")
    (SETQ ARRAY-A (MAKE-ARRAY 100 (QUOTE :ELEMENT-TYPE)
				  (QUOTE SINGLE-FLOAT)))
    (SETQ ARRAY-B (MAKE-ARRAY 100 (QUOTE :ELEMENT-TYPE)
				  (QUOTE SINGLE-FLOAT)
				  (QUOTE :INITIAL-ELEMENT)
				  1.0])

(TEST.BLKDIFF
  [LAMBDA (N)                                                (* edited: " 8-Dec-86 12:51")
    (DECLARE (GLOBALVARS ARRAY-A))
    (LET ((ABASE (ARRAYBASE ARRAY-A))
	  (SIZE (ARRAY-TOTAL-SIZE ARRAY-A)))
         (FRPTQ N (\BLKFDIFF ABASE ABASE ABASE SIZE))
     ARRAY-A])

(TEST.BLKPLUS
  [LAMBDA (N)                                                (* edited: " 8-Dec-86 12:51")
    (DECLARE (GLOBALVARS ARRAY-A))
    (LET ((ABASE (ARRAYBASE ARRAY-A))
	  (SIZE (ARRAY-TOTAL-SIZE ARRAY-A)))
         (FRPTQ N (\BLKFPLUS ABASE ABASE ABASE SIZE))
     ARRAY-A])

(TEST.BLKTIMES
  [LAMBDA (N)                                                (* edited: " 8-Dec-86 12:52")
    (DECLARE (GLOBALVARS ARRAY-A))
    (LET ((ABASE (ARRAYBASE ARRAY-A))
	  (SIZE (ARRAY-TOTAL-SIZE ARRAY-A)))
         (FRPTQ N (\BLKFTIMES ABASE ABASE ABASE SIZE))
     ARRAY-A])

(TEST.POLYNOM
  [LAMBDA (N)                                                (* edited: " 8-Dec-86 12:52")
    (DECLARE (GLOBALVARS ARRAY-B))
    (LET ((BBASE (ARRAYBASE ARRAY-B))
	  (ORDER (SUB1 (ARRAY-TOTAL-SIZE ARRAY-B)))
	  RESULT)
         (DECLARE (TYPE FLOATP RESULT))
         (FRPTQ N (SETQ RESULT (\POLYNOM 1.0 BBASE ORDER)))
     RESULT])

(TEST.UFABS
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:15")
    (bind (X ← 1.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (UFABS X)) finally (RETURN RESULT])

(TEST.UFDIFFERENCE
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:12")
    (bind (X ← 1.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (FDIFFERENCE RESULT X)) finally (RETURN RESULT])

(TEST.UFEMPTYLOOP
  [LAMBDA (N)                                                (* jop: "20-Aug-86 18:16")
    (for I from 1 to N do NIL])

(TEST.UFGREATERP
  [LAMBDA (N)                                                (* jop: "20-Aug-86 16:49")
    (bind (X ← 2.0)
	    (Y ← 1.0)
	    RESULT declare (TYPE FLOATP X Y) for I from 1 to N do (SETQ RESULT
									      (UFGREATERP X Y))
       finally (RETURN RESULT])

(TEST.UFIX
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:11")
    (bind (X ← 1.0)
	    RESULT declare (TYPE FLOATP X) for I from 1 to N do (SETQ RESULT
									    (UFIX X))
       finally (RETURN RESULT])

(TEST.UFMAX
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:16")
    (bind (X ← 1.0)
	    (Y ← 2.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X Y RESULT) for I from 1 to N
       do (SETQ RESULT (UFMAX X Y)) finally (RETURN RESULT])

(TEST.UFMIN
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:15")
    (bind (X ← 1.0)
	    (Y ← 2.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X Y RESULT) for I from 1 to N
       do (SETQ RESULT (UFMIN X Y)) finally (RETURN RESULT])

(TEST.UFMINUS
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:18")
    (bind (X ← 1.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (UFMINUS X)) finally (RETURN RESULT])

(TEST.UFPLUS
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:13")
    (bind (X ← 1.0)
	    (RESULT ← 0.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (FPLUS RESULT X)) finally (RETURN RESULT])

(TEST.UFQUOTIENT
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:13")
    (bind (X ← .99999)
	    (RESULT ← 1.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (FQUOTIENT RESULT X)) finally (RETURN RESULT])

(TEST.UFTIMES
  [LAMBDA (N)                                                (* jop: "20-Aug-86 17:13")
    (bind (X ← 1.0001)
	    (RESULT ← 1.0) declare (TYPE FLOATP X RESULT) for I from 1 to N
       do (SETQ RESULT (FTIMES RESULT X)) finally (RETURN RESULT])
)

(RPAQQ UNBOXED-FLOAT-BENCHMARK-SUITE ((UFEMPTYLOOP 10000)
					(UFPLUS 10000)
					(UFDIFFERENCE 10000)
					(UFTIMES 10000)
					(UFQUOTIENT 10000)
					(UFGREATERP 10000)
					(UFABS 10000)
					(UFMINUS 10000)
					(UFIX 10000)
					(UFMAX 10000)
					(UFMIN 10000)
					(BLKPLUS 1000)
					(BLKDIFF 1000)
					(BLKTIMES 1000)
					(POLYNOM 1000)))
(FILESLOAD (FROM VALUEOF DIRECTORIES)
	   CMLARRAY)
(FILESLOAD (FROM VALUEOF DIRECTORIES)
	   UNBOXEDOPS)
(FILESLOAD (FROM {QV}<PEDERSEN>LISP>)
	   ARRAYSUPPORT)
(PUTPROPS TEST-UNBOXED-FLOAT COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1227 8635 (PRINT-UNBOXED-FLOAT-BENCHMARK 1237 . 1973) (RUN-UNBOXED-FLOAT-BENCHMARKS 
1975 . 3643) (SETUP-UFARRAYS 3645 . 4024) (TEST.BLKDIFF 4026 . 4342) (TEST.BLKPLUS 4344 . 4660) (
TEST.BLKTIMES 4662 . 4980) (TEST.POLYNOM 4982 . 5373) (TEST.UFABS 5375 . 5670) (TEST.UFDIFFERENCE 5672
 . 5987) (TEST.UFEMPTYLOOP 5989 . 6150) (TEST.UFGREATERP 6152 . 6476) (TEST.UFIX 6478 . 6769) (
TEST.UFMAX 6771 . 7085) (TEST.UFMIN 7087 . 7401) (TEST.UFMINUS 7403 . 7702) (TEST.UFPLUS 7704 . 8007) 
(TEST.UFQUOTIENT 8009 . 8323) (TEST.UFTIMES 8325 . 8633)))))
STOP