Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Do not trust *read-default-float-format* #5

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Do not trust *read-default-float-format* #5

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion buffers/typedefs.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -265,7 +265,7 @@
(def-native-type-info gpu-single-float-type :float "float" 4 4)

(def method lisp-type-of ((type gpu-single-float-type))
(lisp-real-type-name type 'single-float :cv (lambda (x) (float x 1.0))))
(lisp-real-type-name type 'single-float :cv (lambda (x) (float x 1.0f0))))

(def class gpu-double-float-type (gpu-native-float-type)
()
Expand Down
8 changes: 4 additions & 4 deletions core/builtins.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -441,7 +441,7 @@
(def delimited-builtin + "+" :zero 0)
(def delimited-builtin - "-" :zero 0 :single-pfix "-")
(def delimited-builtin * "*" :zero 1)
(def delimited-builtin / "/" :zero 1.0
(def delimited-builtin / "/" :zero 1.0f0
:typechecker ensure-div-result-type
:single-pfix (if (typep -ret-type- 'gpu-double-float-type)
"1.0/" "1.0f/"))
Expand Down Expand Up @@ -659,8 +659,8 @@
(mklog (gpu-single-float-type 10) (code "log10f(" arg ")"))
(mklog (gpu-single-float-type 2) (code "log2f(" arg ")"))
(mklog (gpu-single-float-type null) (code "logf(" arg ")"))
(mklog (gpu-single-float-type null real) (code (log (float arg 1.0))))
(mklog (gpu-single-float-type real real) (code (log (float arg 1.0) base)))
(mklog (gpu-single-float-type null real) (code (log (float arg 1.0f0))))
(mklog (gpu-single-float-type real real) (code (log (float arg 1.0f0) base)))
;; double
(mklog (gpu-double-float-type 10) (code "log10(" arg ")"))
(mklog (gpu-double-float-type 2) (code "log2(" arg ")"))
Expand All @@ -686,7 +686,7 @@
(mkexp (gpu-single-float-type 10) (code "exp10f(" arg ")"))
(mkexp (gpu-single-float-type 2) (code "exp2f(" arg ")"))
(mkexp (gpu-single-float-type null) (code "expf(" arg ")"))
(mkexp (gpu-single-float-type real) (code "expf(" arg "*" (log (float base 1.0)) ")"))
(mkexp (gpu-single-float-type real) (code "expf(" arg "*" (log (float base 1.0f0)) ")"))
(mkexp (gpu-single-float-type t) (code "powf(" base "," arg ")"))
;; double
(mkexp (gpu-double-float-type 10) (code "exp10(" arg ")"))
Expand Down
4 changes: 2 additions & 2 deletions cuda/target.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -229,7 +229,7 @@
(multiple-value-bind (arg1 rargs)
(if (rest args)
(values (first args) (rest args))
(values 1.0 args))
(values 1.0f0 args))
(code "__fdividef(" arg1 ",")
(emit-separated -stream- rargs "*")
(code ")"))
Expand Down Expand Up @@ -286,7 +286,7 @@
(call-next-method)))))
(mkexp (gpu-single-float-type 10) (code "__exp10f(" arg ")"))
(mkexp (gpu-single-float-type null) (code "__expf(" arg ")"))
(mkexp (gpu-single-float-type real) (code "__expf(" arg "*" (log (float base 1.0)) ")"))
(mkexp (gpu-single-float-type real) (code "__expf(" arg "*" (log (float base 1.0f0)) ")"))
(mkexp (gpu-single-float-type t) (code "__powf(" base "," arg ")")))

;; Min/max builtins
Expand Down
42 changes: 21 additions & 21 deletions test/buffers.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -37,25 +37,25 @@
(is (equal (loop for i from 0 below 5
collect (bref buffer 1 i))
(loop for i from 0 below 5 collect (float (+ i 5)))))
(buffer-fill buffer 0.5 :start 2 :end 23)
(buffer-fill buffer 0.5f0 :start 2 :end 23)
(is (index-buffer? buffer :start 0 :end 2))
(is (index-buffer? buffer :start 23))
(is (buffer-filled? buffer 0.5 :start 2 :end 23)))
(is (buffer-filled? buffer 0.5f0 :start 2 :end 23)))

(def test test/buffers/copy-array-buffer (buffer)
(let ((arr1 (make-array '(5 5) :element-type 'single-float))
(arr2 (make-array 25 :element-type 'single-float :initial-element 1.0)))
(arr2 (make-array 25 :element-type 'single-float :initial-element 1.0f0)))
(buffer-fill buffer 0)
(copy-full-buffer buffer arr2)
(is (zero-buffer? arr2))
(set-index-buffer arr1)
(copy-full-buffer arr1 buffer)
(is (index-buffer? buffer))
(buffer-fill arr2 0.5)
(buffer-fill arr2 0.5f0)
(copy-buffer-data arr2 2 buffer 2 (- 23 2))
(is (index-buffer? buffer :start 0 :end 2))
(is (index-buffer? buffer :start 23))
(is (buffer-filled? buffer 0.5 :start 2 :end 23))))
(is (buffer-filled? buffer 0.5f0 :start 2 :end 23))))

(def test test/buffers/copy-buffer-buffer (buffer1 buffer2 buffer3 buffer4)
(buffer-fill buffer1 0)
Expand All @@ -82,35 +82,35 @@
(def test test/buffers/displaced-buffer (buffer1 buffer2)
(let* ((arr1 (buffer-displace buffer1 :offset 5 :dimensions '(2 5)))
(arr2 (buffer-displace buffer2 :offset 5 :dimensions '(2 5)))
(tmp (make-array '(5 5) :element-type 'single-float :initial-element 0.0))
(tmp (make-array '(5 5) :element-type 'single-float :initial-element 0.0f0))
(tmp1 (buffer-displace tmp :offset 5 :dimensions '(2 5))))
(set-index-buffer buffer1)
(is (index-buffer? arr1 :shift -5)) ; displaced read
(buffer-fill arr1 0.0) ; displaced fill
(buffer-fill arr1 0.0f0) ; displaced fill
(is (index-buffer? buffer1 :start 0 :end 5))
(is (buffer-filled? buffer1 0.0 :start 5 :end 15))
(is (buffer-filled? buffer1 0.0f0 :start 5 :end 15))
(is (index-buffer? buffer1 :start 15))
(set-index-buffer arr1) ; displaced write
(is (index-buffer? buffer1 :start 5 :end 15 :shift 5))
(set-index-buffer buffer2)
(buffer-fill buffer1 0.0)
(buffer-fill buffer1 0.0f0)
(copy-full-buffer arr2 arr1) ; displaced dev -> dev
(is (buffer-filled? buffer1 0.0 :start 0 :end 5))
(is (buffer-filled? buffer1 0.0f0 :start 0 :end 5))
(is (index-buffer? buffer1 :start 5 :end 15))
(is (buffer-filled? buffer1 0.0 :start 15))
(buffer-fill arr1 0.0)
(is (buffer-filled? buffer1 0.0f0 :start 15))
(buffer-fill arr1 0.0f0)
(is (zero-buffer? buffer1))
(set-index-buffer tmp)
(copy-full-buffer tmp1 arr1) ; displaced host -> dev
(is (buffer-filled? buffer1 0.0 :start 0 :end 5))
(is (buffer-filled? buffer1 0.0f0 :start 0 :end 5))
(is (index-buffer? buffer1 :start 5 :end 15))
(is (buffer-filled? buffer1 0.0 :start 15))
(buffer-fill tmp 0.0)
(is (buffer-filled? buffer1 0.0f0 :start 15))
(buffer-fill tmp 0.0f0)
(is (zero-buffer? tmp))
(copy-full-buffer arr1 tmp1) ; displaced dev -> host
(is (buffer-filled? tmp 0.0 :start 0 :end 5))
(is (buffer-filled? tmp 0.0f0 :start 0 :end 5))
(is (index-buffer? tmp :start 5 :end 15))
(is (buffer-filled? tmp 0.0 :start 15))))
(is (buffer-filled? tmp 0.0f0 :start 15))))

(def test test/buffers/all (buffer1 buffer2 buffer3 buffer4)
(test/buffers/basic-buffer buffer1)
Expand All @@ -129,13 +129,13 @@

(def fixture foreign-arrs
(with-deref-buffers ((*foreign-arr1*
(make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
(make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0f0))
(*foreign-arr2*
(make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0))
(make-foreign-array '(5 5) :element-type 'single-float :initial-element 0.0f0))
(*foreign-arr3*
(make-foreign-array 25 :element-type 'single-float :initial-element 0.0))
(make-foreign-array 25 :element-type 'single-float :initial-element 0.0f0))
(*foreign-arr4*
(make-foreign-array 25 :element-type 'single-float :initial-element 0.0)))
(make-foreign-array 25 :element-type 'single-float :initial-element 0.0f0)))
(-body-)))

(def test test/buffers/foreign ()
Expand Down
34 changes: 17 additions & 17 deletions test/cuda-driver.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,9 +27,9 @@
(unwind-protect
(progn
(setf *cuda-arr1* (make-cuda-array '(5 5) :element-type 'single-float
:pitch-elt-size 4 :initial-element 0.0))
:pitch-elt-size 4 :initial-element 0.0f0))
(setf *cuda-arr2* (make-cuda-array '(5 5) :element-type 'single-float
:pitch-elt-size 4 :initial-element 0.0))
:pitch-elt-size 4 :initial-element 0.0f0))
(setf *cuda-arr3* (make-cuda-array '(5 5) :element-type 'single-float
:pitch-elt-size 16 :initial-element 0))
(setf *cuda-arr4* (make-cuda-array '(5 5) :element-type 'single-float
Expand All @@ -44,13 +44,13 @@

(def fixture cuda-host-arrs
(with-deref-buffers ((*cuda-host-arr1*
(make-cuda-host-array '(5 5) :element-type 'single-float :initial-element 0.0))
(make-cuda-host-array '(5 5) :element-type 'single-float :initial-element 0.0f0))
(*cuda-host-arr2*
(make-cuda-host-array '(5 5) :element-type 'single-float :initial-element 0.0))
(make-cuda-host-array '(5 5) :element-type 'single-float :initial-element 0.0f0))
(*cuda-host-arr3*
(make-cuda-host-array 25 :element-type 'single-float :initial-element 0.0))
(make-cuda-host-array 25 :element-type 'single-float :initial-element 0.0f0))
(*cuda-host-arr4*
(make-cuda-host-array 25 :element-type 'single-float :initial-element 0.0)))
(make-cuda-host-array 25 :element-type 'single-float :initial-element 0.0f0)))
(-body-)))

(def test verify-wrap-pitch (blk offset size commands)
Expand Down Expand Up @@ -117,12 +117,12 @@
(baz-val (cl-gpu::gpu-global-value baz-var)))
(is (eq instance instance))
;; Initially zero
(is (eql foo-val 0.0))
(is (eql foo-val 0.0f0))
(is (eql bar-val nil))
(is (zero-buffer? baz-val))
;; Fill in static data
(setf foo-val 3.0)
(is (eql foo-val 3.0))
(setf foo-val 3.0f0)
(is (eql foo-val 3.0f0))
(set-index-buffer baz-val)
(is (index-buffer? baz-val))
;; Attach an array
Expand All @@ -139,7 +139,7 @@
(reinitialize-instance module)
(is (not (eql old-handle (cl-gpu::cuda-module-instance-handle instance)))))
;; Verify that the values are still there
(is (eql foo-val 3.0))
(is (eql foo-val 3.0f0))
(is (index-buffer? bar-val))
(is (index-buffer? baz-val))
;; Verify auto-wipe
Expand All @@ -149,7 +149,7 @@
(is (zero-buffer? (cl-gpu::buffer-of bar-var)))))))

(declaim (type single-float *test-global-val*))
(defparameter *test-global-val* 0.7)
(defparameter *test-global-val* 0.7f0)

(def test test/cuda-driver/cuda-module-args ()
(with-fixture cuda-context
Expand Down Expand Up @@ -182,11 +182,11 @@
(result (cl-gpu::gpu-global-value (aref items 3)))
(ptr (cl-gpu::cuda-linear-handle (slot-value baz 'cl-gpu::blk))))
(is (zero-buffer? result))
(funcall kernel 0.5 baz :baz baz)
(funcall kernel 0.5f0 baz :baz baz)
(is (every #'=
(buffer-as-array result)
(list ptr 48 6 48 24 4 ptr)))
(is (= (bref baz 1 1 1) 1.2))))))
(is (= (bref baz 1 1 1) 1.2f0))))))

(def test test/cuda-driver/compute ()
(with-fixture cuda-context
Expand Down Expand Up @@ -232,12 +232,12 @@
(type (array single-float 2) avs))
(setf (aref data 0) (tuple-raw-aref avs 1 4)
(aref res 1) (tuple-raw-aref avs 0 4))))
(is (equalp (bref res 0) #(0.0 0.0 0.0 0.0)))
(is (equalp (bref res 1) #(0.0 0.0 0.0 0.0)))
(is (equalp (bref res 0) #(0.0f0 0.0f0 0.0f0 0.0f0)))
(is (equalp (bref res 1) #(0.0f0 0.0f0 0.0f0 0.0f0)))
(set-index-buffer *cuda-arr1*)
(kernel res *cuda-arr1*)
(is (equalp (bref res 1) #(0.0 1.0 2.0 3.0)))
(is (equalp (bref res 0) #(1.0 2.0 3.0 4.0))))))
(is (equalp (bref res 1) #(0.0f0 1.0f0 2.0f0 3.0f0)))
(is (equalp (bref res 0) #(1.0f0 2.0f0 3.0f0 4.0f0))))))

(def function cuda-allocate-dummy-block ()
(make-cuda-array 10))
Expand Down
54 changes: 27 additions & 27 deletions test/translator.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,7 +38,7 @@
(def function float= (a b)
(ignore-errors
(or (= a b)
(< (/ (abs (- a b)) (max a b)) 0.0001))))
(< (/ (abs (- a b)) (max a b)) 1f-4))))

(defvar *last-tested-module* nil)

Expand Down Expand Up @@ -89,14 +89,14 @@
(cast int32 (abs (the int64 -3)))
(max 1) (max 4 2) (max 3 9 6) (max 1 8 2 3)
(min 1) (min 4 2) (min 3 9 6) (min 1 8 2 3))
(test-float (- 3.0) (+ 1 8.0 4) (- 2.0 7 3) (* 2.0 9 4)
(/ 5.0 2) (/ 5.0) (1+ 2.0) (1- 2.0)
(abs -3.0) (abs 3.0)
(max 1.0) (max 4.0 2) (max 3.0 9 6) (max 1.0 8 2 3)
(min 1.0) (min 4.0 2) (min 3.0 9 6) (min 1.0 8 2 3))
(test-float (- 3.0f0) (+ 1 8.0f0 4) (- 2.0f0 7 3) (* 2.0f0 9 4)
(/ 5.0f0 2) (/ 5.0f0) (1+ 2.0f0) (1- 2.0f0)
(abs -3.0f0) (abs 3.0f0)
(max 1.0f0) (max 4.0f0 2) (max 3.0f0 9 6) (max 1.0f0 8 2 3)
(min 1.0f0) (min 4.0f0 2) (min 3.0f0 9 6) (min 1.0f0 8 2 3))
(test-bool t nil (not t) (not nil)
(zerop 0) (zerop 1) (zerop 0.0) (zerop 1.0)
(nonzerop 0) (nonzerop 1) (nonzerop 0.0) (nonzerop 1.0)
(zerop 0) (zerop 1) (zerop 0.0f0) (zerop 1.0f0)
(nonzerop 0) (nonzerop 1) (nonzerop 0.0f0) (nonzerop 1.0f0)
(> 1 2) (> 2 1) (> 3 2 1) (> 3 1 2) (> 3 3 2)
(>= 1 2) (>= 2 1) (>= 3 2 1) (>= 3 1 2) (>= 3 3 2)
(= 1 1) (= 1 2) (= 1 1 1) (= 1 1 2)
Expand All @@ -119,11 +119,11 @@

(def test test/translator/compute-3 (target)
(test-computations (target)
(let ((a 12.3))
(test-float (sin 0.39) (sinh 0.39) (asin 0.39) (asinh 1.39)
(cos 0.39) (cosh 0.39) (acos 0.39) (acosh 1.39)
(tan 0.39) (tanh 0.39) (atan 0.39) (atanh 0.39)
(exp 0.39) (sqrt 0.39)
(let ((a 12.3f0))
(test-float (sin 0.39f0) (sinh 0.39f0) (asin 0.39f0) (asinh 1.39f0)
(cos 0.39f0) (cosh 0.39f0) (acos 0.39f0) (acosh 1.39f0)
(tan 0.39f0) (tanh 0.39f0) (atan 0.39f0) (atanh 0.39f0)
(exp 0.39f0) (sqrt 0.39f0)
(log 100) (log 100 2) (log 100 10) (log 100 11) (log 100 a)
(expt 2 10) (expt 10 10) (expt 11 10) (expt a 10)))))

Expand All @@ -133,19 +133,19 @@
(let ((a 12))
(declare (type uint32 a))
(symbol-macrolet ((13U (the uint32 13)))
(test-float (ffloor 3.5) (ffloor -3.5) (fceiling 3.5) (fceiling -3.5)
(ftruncate 3.5) (ftruncate -3.5) (fround 3.5) (fround -3.5)
(ffloor 13.5 8) (ffloor -13.5 8) (ffloor 13.5 10) (ffloor -13.5 10)
(fceiling 13.5 8) (fceiling -13.5 8) (fceiling 13.5 10) (fceiling -13.5 10)
(ftruncate 13.5 8) (ftruncate -13.5 8) (ftruncate 13.5 10) (ftruncate -13.5 10)
(fround 13.5 8) (fround -13.5 8) (fround 13.5 10) (fround -13.5 10)
(rem 13.5 8) (rem -13.5 8) (rem 13.5 10) (rem -13.5 10))
(test-int (floor 3.5) (floor -3.5) (ceiling 3.5) (ceiling -3.5)
(truncate 3.5) (truncate -3.5) (round 3.5) (round -3.5)
(floor 13.5 8) (floor -13.5 8) (floor 13.5 10) (floor -13.5 10)
(ceiling 13.5 8) (ceiling -13.5 8) (ceiling 13.5 10) (ceiling -13.5 10)
(truncate 13.5 8) (truncate -13.5 8) (truncate 13.5 10) (truncate -13.5 10)
(round 13.5 8) (round -13.5 8) (round 13.5 10) (round -13.5 10)
(test-float (ffloor 3.5f0) (ffloor -3.5f0) (fceiling 3.5f0) (fceiling -3.5f0)
(ftruncate 3.5f0) (ftruncate -3.5f0) (fround 3.5f0) (fround -3.5f0)
(ffloor 13.5f0 8) (ffloor -13.5f0 8) (ffloor 13.5f0 10) (ffloor -13.5f0 10)
(fceiling 13.5f0 8) (fceiling -13.5f0 8) (fceiling 13.5f0 10) (fceiling -13.5f0 10)
(ftruncate 13.5f0 8) (ftruncate -13.5f0 8) (ftruncate 13.5f0 10) (ftruncate -13.5f0 10)
(fround 13.5f0 8) (fround -13.5f0 8) (fround 13.5f0 10) (fround -13.5f0 10)
(rem 13.5f0 8) (rem -13.5f0 8) (rem 13.5f0 10) (rem -13.5f0 10))
(test-int (floor 3.5f0) (floor -3.5f0) (ceiling 3.5f0) (ceiling -3.5f0)
(truncate 3.5f0) (truncate -3.5f0) (round 3.5f0) (round -3.5f0)
(floor 13.5f0 8) (floor -13.5f0 8) (floor 13.5f0 10) (floor -13.5f0 10)
(ceiling 13.5f0 8) (ceiling -13.5f0 8) (ceiling 13.5f0 10) (ceiling -13.5f0 10)
(truncate 13.5f0 8) (truncate -13.5f0 8) (truncate 13.5f0 10) (truncate -13.5f0 10)
(round 13.5f0 8) (round -13.5f0 8) (round 13.5f0 10) (round -13.5f0 10)
(floor 13U 8) (floor -13 8) (floor 13U 10) (floor -13 10) (floor 13U a)
(ceiling 13U 8) (ceiling -13 8) (ceiling 13U 10) (ceiling -13 10) (ceiling 13U a)
(truncate 13U 8) (truncate -13 8) (truncate 13U 10) (truncate -13 10) (truncate 13U a)
Expand All @@ -164,7 +164,7 @@
(test-int (test1 2 3) (test1 2 3 4) (test1 2 3 4 :d 5)
(test1 2 3 4 :e 7) (test1 2 3 4 :e 7 :d 3)
(test2 7 3) (test2 7 3 :c 9))
(test-float (test2 0.3 0.2) (test-gpu-f 7 0.1 -2))
(test-float (test2 0.3f0 0.2f0) (test-gpu-f 7 0.1f0 -2))
(let ((iv 0))
(test-int (test2 1 2 :z (incf iv))
(test2 1 2 :c (incf iv) :z (setf iv -3)))))))
Expand Down
41 changes: 21 additions & 20 deletions test/utils.lisp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -13,26 +13,27 @@
(muffle-warning))

(def test test/utils/r-w-array ()
(let ((arr (make-array 5 :element-type 'single-float
:initial-contents '(0.0 0.1 0.2 0.3 0.4))))
(with-open-file (s "cl-gpu.test.tmp"
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))
(write-array arr s))
(let ((res (with-open-file (s "cl-gpu.test.tmp"
:direction :input
:element-type '(unsigned-byte 8))
(read-array nil s :allocate t)))
(res2 (with-open-file (s "cl-gpu.test.tmp"
:direction :input
:element-type '(unsigned-byte 8))
(read-array (make-array 5 :element-type 'single-float) s))))
(delete-file "cl-gpu.test.tmp")
(is (equal (array-dimensions arr)
(array-dimensions res)))
(is (every #'eql arr res))
(is (every #'eql arr res2)))))
(with-standard-io-syntax
(let ((arr (make-array 5 :element-type 'single-float
:initial-contents '(0.0f0 0.1f0 0.2f0 0.3f0 0.4f0))))
(with-open-file (s "cl-gpu.test.tmp"
:direction :output
:if-exists :supersede
:element-type '(unsigned-byte 8))
(write-array arr s))
(let ((res (with-open-file (s "cl-gpu.test.tmp"
:direction :input
:element-type '(unsigned-byte 8))
(read-array nil s :allocate t)))
(res2 (with-open-file (s "cl-gpu.test.tmp"
:direction :input
:element-type '(unsigned-byte 8))
(read-array (make-array 5 :element-type 'single-float) s))))
(delete-file "cl-gpu.test.tmp")
(is (equal (array-dimensions arr)
(array-dimensions res)))
(is (every #'eql arr res))
(is (every #'eql arr res2))))))

(def test test/utils/copy-gvector ()
(let ((arr1 (make-array 5 :initial-contents '(1 2 3 4 5)))
Expand Down