(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "XCL-USER")

(il:filecreated "14-Jun-88 11:10:38" il:{qv}<pedersen>lisp>float-tester.\;9
 9756   

      il:|changes| il:|to:|  (verified-tests cos-test exp-test log-test sin-test poly box unbox ubabs ubnegate ubfix ub+ ub- ub* ub/ ub> ubmax ubmin mixed/ int> float> mixed> int- float- mixed- int+ float+ mixed+ int* float* mixed* int/ float/)
 (il:vars il:float-testercoms) (il:functions define-verified-test) (il:define-types verified-tests) (file-environments "FLOAT-TESTER")

      il:|previous| il:|date:| "14-Jun-88 11:05:17" il:{qv}<pedersen>lisp>float-tester.\;8)


; Copyright (c) 1988 by Xerox Corporation.  All rights reserved.

(il:prettycomprint il:float-testercoms)

(il:rpaqq il:float-testercoms ((il:files il:tester) (il:coms (il:* il:|;;| "Boxed opcodes") (verified-tests int+ float+ mixed+) (verified-tests int- float- mixed-) (verified-tests int* float* mixed*) (verified-tests int/ float/ mixed/) (verified-tests int> float> mixed>)) (il:coms (il:* il:|;;| "Unboxed opcodes [scalar]") (il:* il:|;;| "Ubfloat1") (verified-tests box unbox ubabs ubnegate ubfix) (il:* il:|;;| "Ubfloat2") (verified-tests ub+ ub- ub* ub/ ub> ubmax ubmin) (il:* il:|;;| "Ubfloat3") (verified-tests poly)) (il:coms (il:* il:|;;| "Transcendentals --- stress test") (verified-tests sin-test cos-test exp-test log-test)) (file-environments "FLOAT-TESTER")))

(il:filesload il:tester)



(il:* il:|;;| "Boxed opcodes")



(define-verified-test int+ "Opcodes IPLUS,FPLUS, and PLUS, both args integer" (let ((x 3)) (with-collection (dolist (y (quote (1 -3 9834756987354 21845 -54))) (collect (il:iplus x y)) (collect (il:fplus x y)) (collect (il:plus x y))))))

(define-verified-test float+ "Opcodes IPLUS,FPLUS, and PLUS, both args float" (let ((x 3.0)) (with-collection (dolist (y (quote (1.0 -3.0 -3.4028235E+38 21845.0 -54.0))) (collect (il:iplus x y)) (collect (il:fplus x y)) (collect (il:plus x y))))))

(define-verified-test mixed+ "Opcodes IPLUS,FPLUS, and PLUS, mixed args" (let ((x 3.0)) (with-collection (dolist (y (quote (1 -3 1/3 9834756987354 21845 -54))) (collect (il:iplus x y)) (collect (il:fplus x y)) (collect (il:plus x y))))))

(define-verified-test int- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args integer" (let ((x 3)) (with-collection (dolist (y (quote (1 3 9834756987354 21845 -54))) (collect (il:idifference x y)) (collect (il:fdifference x y)) (collect (il:difference x y))))))

(define-verified-test float- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, both args float" (let ((x 3.0)) (with-collection (dolist (y (quote (1.0 3.0 3.4028235E+38 21845.0 -54.0))) (collect (il:idifference x y)) (collect (il:fdifference x y)) (collect (il:difference x y))))))

(define-verified-test mixed- "Opcodes IDIFFERENCE,FDIFFERENCE, and DIFFERENCE, mixed args" (let ((x 3.0)) (with-collection (dolist (y (quote (1 3 1/3 9834756987354 21845 -54))) (collect (il:idifference x y)) (collect (il:fdifference x y)) (collect (il:difference x y))))))

(define-verified-test int* "Opcodes ITIMES,FTIMES, and TIMES, both args integer" (let ((x 3)) (with-collection (dolist (y (quote (45 345235424 0 23 21845))) (collect (il:itimes x y)) (collect (il:ftimes x y)) (collect (il:times x y))))))

(define-verified-test float* "Opcodes ITIMES,FTIMES, and TIMES, both args float" (let ((x 3.0)) (with-collection (dolist (y (quote (45.0 0.0 1.1342745E+38 -21845.0))) (collect (il:itimes x y)) (collect (il:ftimes x y)) (collect (il:times x y))))))

(define-verified-test mixed* "Opcodes ITIMES,FTIMES, and TIMES, mixed args" (let ((x 3.0)) (with-collection (dolist (y (quote (45 1/3 345235424 0 23 21845))) (collect (il:itimes x y)) (collect (il:ftimes x y)) (collect (il:times x y))))))

(define-verified-test int/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args integer" (let ((x 21845)) (with-collection (dolist (y (quote (21845 1 345235424 -45))) (collect (il:iquotient x y)) (collect (il:fquotient x y)) (collect (il:quotient x y))))))

(define-verified-test float/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, both args float" (let ((x 21845.0)) (with-collection (dolist (y (quote (21845.0 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (collect (il:iquotient x y)) (collect (il:fquotient x y)) (collect (il:quotient x y))))))

(define-verified-test mixed/ "Opcodes IQUOTIENT,FQUOTIENT, and QUOTIENT, args mixed" (let ((x 21845.0)) (with-collection (dolist (y (quote (21845 1 4/3 -1345619432 45))) (collect (il:iquotient x y)) (collect (il:fquotient x y)) (collect (il:quotient x y))))))

(define-verified-test int> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (let ((x 21845)) (with-collection (dolist (y (quote (21845 -45 345235424 22000))) (collect (il:igreaterp x y)) (collect (il:fgreaterp x y)) (collect (il:greaterp x y))))))

(define-verified-test float> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (let ((x 21845.0)) (with-collection (dolist (y (quote (21845.0 -45.0 3.4523542E+8 22000.0))) (collect (il:igreaterp x y)) (collect (il:fgreaterp x y)) (collect (il:greaterp x y))))))

(define-verified-test mixed> "Opcodes IGREATERP,FGREATERP, and GREATERP, both args integer" (let ((x 21845.0)) (with-collection (dolist (y (quote (21845 1/3 -45 5498457654 22000))) (collect (il:igreaterp x y)) (collect (il:fgreaterp x y)) (collect (il:greaterp x y))))))



(il:* il:|;;| "Unboxed opcodes [scalar]")





(il:* il:|;;| "Ubfloat1")



(define-verified-test box "Opcode BOX (UBFLOAT1 0)" (with-collection (dolist (x (quote ((16256 . 0) (0 . 0) (49716 . 0) (26309 . 45156)))) (collect (il:\\floatbox (il:\\vag2 (car x) (cdr x)))))))

(define-verified-test unbox "Opcode UNBOX (UBFLOAT1 1)" (with-collection (dolist (x (quote (1.0 0.0 -45.0 4.6678E+23))) (let ((y (il:\\floatunbox x))) (collect (cons (il:\\hiloc y) (il:\\loloc y)))))))

(define-verified-test ubabs "Opcode UFABS (UBFLOAT1 2)" (flet ((ubabs (x) (il:\\floatbox ((il:opcodes il:ubfloat1 2) (il:\\floatunbox x))))) (with-collection (dolist (x (quote (-1.0 0.0 -45.0 4.6678E+23))) (collect (ubabs x))))))

(define-verified-test ubnegate "Opcode UFNEGATE (UBFLOAT1 3)" (flet ((ubnegate (x) (il:\\floatbox ((il:opcodes il:ubfloat1 3) (il:\\floatunbox x))))) (with-collection (dolist (x (quote (-1.0 0.0 -45.0 4.6678E+23))) (collect (ubnegate x))))))

(define-verified-test ubfix "Opcode UFIX (UBFLOAT1 4)" (flet ((ubfix (x) ((il:opcodes il:ubfloat1 4) (il:\\floatunbox x)))) (with-collection (dolist (x (quote (-1.0 0.0 -45.0 4.6678E+23))) (collect (ubfix x))))))



(il:* il:|;;| "Ubfloat2")



(define-verified-test ub+ "Opcode UFADD (UBFLOAT2 0)" (flet ((ub+ (x y) (il:\\floatbox ((il:opcodes il:ubfloat2 0) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 3.0)) (with-collection (dolist (y (quote (1.0 -3.0 -3.4028235E+38 21845.0 3))) (collect (ub+ x y)))))))

(define-verified-test ub- "Opcode UFSUB (UBFLOAT2 1)" (flet ((ub- (x y) (il:\\floatbox ((il:* il:|;;| "ub -") (il:opcodes il:ubfloat2 1) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 3.0)) (with-collection (dolist (y (quote (1.0 3.0 3.4028235E+38 21845 1/3 -54.0))) (collect (ub- x y)))))))

(define-verified-test ub* "Opcode UFMULT (UBFLOAT2 3)" (flet ((ub* (x y) (il:\\floatbox ((il:opcodes il:ubfloat2 3) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 3.0)) (with-collection (dolist (y (quote (45.0 0.0 1.1342745E+38 -21845.0))) (collect (ub* x y)))))))

(define-verified-test ub/ "Opcode UFDIV (UBFLOAT2 4)" (flet ((ub/ (x y) (il:\\floatbox ((il:opcodes il:ubfloat2 4) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 21845.0)) (with-collection (dolist (y (quote (0.001 1.0 -3.4523542E+8 45.0 3.4028235E+38))) (collect (ub/ x y)))))))

(define-verified-test ub> "Opcode UFGREAT (UBFLOAT2 5)" (flet ((ub> (x y) ((il:opcodes il:ubfloat2 5) (il:\\floatunbox x) (il:\\floatunbox y)))) (let ((x 21845.0)) (with-collection (dolist (y (quote (21845.0 -45.0 3.4523542E+8 0.001))) (collect (ub> x y)))))))

(define-verified-test ubmax "Opcode UFMAX (UBFLOAT2 6)" (flet ((ubmax (x y) (il:\\floatbox ((il:opcodes il:ubfloat2 6) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 21845.0)) (with-collection (dolist (y (quote (21845.0 -45.0 3.4523542E+8 0.001))) (collect (ubmax x y)))))))

(define-verified-test ubmin "Opcode UFMAX (UBFLOAT2 7)" (flet ((ubmin (x y) (il:\\floatbox ((il:opcodes il:ubfloat2 7) (il:\\floatunbox x) (il:\\floatunbox y))))) (let ((x 21845.0)) (with-collection (dolist (y (quote (21845.0 -45.0 3.4523542E+8 0.001))) (collect (ubmin x y)))))))



(il:* il:|;;| "Ubfloat3")



(define-verified-test poly "Opcode POLY (UBFLOAT3 0)" (flet ((poly (x base size) (il:\\floatbox ((il:opcodes il:ubfloat3 0) (il:\\floatunbox x) base size)))) (let* ((array (make-array 4 :element-type (quote single-float) :initial-contents (quote (1.0 2.0 3.0 4.0)))) (base (il:%array-base array))) (with-collection (dolist (pair (quote ((1.0 . 3) (1.0 . 1) (3.5 . 3)))) (collect (poly (car pair) base (cdr pair))))))))



(il:* il:|;;| "Transcendentals --- stress test")



(define-verified-test sin-test "Function SIN" (with-collection (dolist (x (quote (0.0 1/3 -1.2 12.6))) (collect (sin (* pi x))))))

(define-verified-test cos-test "Function COS" (with-collection (dolist (x (quote (0.0 1/3 -1.2 12.6))) (collect (cos (* pi x))))))

(define-verified-test exp-test "Function EXP" (with-collection (dolist (x (quote (1.0 20.5 1/3 -5.2))) (collect (exp x)))))

(define-verified-test log-test "Function LOG" (with-collection (dolist (x (quote (2.7182817 -2.0 453.78))) (collect (log x)))))

(define-file-environment "FLOAT-TESTER" :package "XCL-USER" :readtable "XCL" :compiler :compile-file)
(il:putprops il:float-tester il:copyright ("Xerox Corporation" 1988))
(il:declare\: il:dontcopy
  (il:filemap (nil)))
il:stop