mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-18 21:29:18 +02:00
159 lines
5 KiB
Scheme
159 lines
5 KiB
Scheme
#|
|
|
| Copyright (c) 2017 Koz Ross
|
|
|
|
|
| Permission is hereby granted, free of charge, to any person obtaining a copy of
|
|
| this software and associated documentation files (the "Software"), to deal in
|
|
| the Software without restriction, including without limitation the rights to
|
|
| use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
|
|
| the Software, and to permit persons to whom the Software is furnished to do so,
|
|
| subject to the following conditions:
|
|
|
|
|
| The above copyright notice and this permission notice shall be included in all
|
|
| copies or substantial portions of the Software.
|
|
|
|
|
| THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
|
| IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
|
|
| FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
|
|
| COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
|
| IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
|
| CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
|
|#
|
|
|
|
(import
|
|
(scheme base)
|
|
(srfi 60)
|
|
(cyclone test))
|
|
|
|
(define a #b1100)
|
|
(define b #b1010)
|
|
(define c #b1110)
|
|
|
|
(define (dec->bin x) (number->string x 2))
|
|
|
|
(define (test-commutative op)
|
|
(test (op a b) (op b a)))
|
|
|
|
(define (test-associative op)
|
|
(test (op a (op b c)) (op (op a b) c)))
|
|
|
|
(test-group
|
|
"logand"
|
|
(test "1000" (dec->bin (logand a b)))
|
|
(test "1000" (dec->bin (bitwise-and a b)))
|
|
(test-commutative logand)
|
|
(test-commutative bitwise-and)
|
|
(test-associative logand)
|
|
(test-associative bitwise-and))
|
|
|
|
(test-group
|
|
"logior"
|
|
(test "1110" (dec->bin (logior a b)))
|
|
(test "1110" (dec->bin (bitwise-ior a b)))
|
|
(test-commutative logior)
|
|
(test-commutative bitwise-ior)
|
|
(test-associative logior)
|
|
(test-associative bitwise-ior))
|
|
|
|
(test-group
|
|
"logxor"
|
|
(test "110" (dec->bin (logxor a b)))
|
|
(test "110" (dec->bin (bitwise-xor a b)))
|
|
(test-commutative logxor)
|
|
(test-commutative bitwise-xor)
|
|
(test-associative logxor)
|
|
(test-associative bitwise-xor))
|
|
|
|
(test-group
|
|
"lognot"
|
|
(test "11111111111111111111111101111111" (dec->bin (lognot #b10000000)))
|
|
(test "11111111111111111111111101111111" (dec->bin (bitwise-not #b10000000)))
|
|
(test "11111111111111111111111111111111" (dec->bin (lognot #b0)))
|
|
(test "11111111111111111111111111111111" (dec->bin (bitwise-not #b0))))
|
|
|
|
(test-group
|
|
"logtest"
|
|
(test-not (logtest #b0100 #b1011))
|
|
(test-assert (logtest #b0100 #b0111)))
|
|
|
|
(test-group
|
|
"logcount"
|
|
(test 4 (logcount #b10101010))
|
|
(test 4 (bit-count #b10101010))
|
|
(test 0 (logcount 0))
|
|
(test 0 (bit-count 0))
|
|
(test 1 (logcount -2))
|
|
(test 1 (bit-count -2)))
|
|
|
|
(test-group
|
|
"integer-length"
|
|
(test 8 (integer-length #b10101010))
|
|
(test 0 (integer-length 0))
|
|
(test 4 (integer-length #b1111)))
|
|
|
|
(test-group
|
|
"log2-binary-factors"
|
|
(do
|
|
((i 0 (+ i 1))
|
|
(fsb-results #(-1 0 1 0 2 0 1 0 3 0 1 0 2 0 1 0 4)))
|
|
((= i 17))
|
|
(let ((res (vector-ref fsb-results i)))
|
|
(test res (log2-binary-factors i))
|
|
(test res (first-set-bit i))
|
|
(test res (log2-binary-factors (- i)))
|
|
(test res (first-set-bit (- i))))))
|
|
|
|
(test-group
|
|
"logbit"
|
|
(test-assert (logbit? 0 #b1101))
|
|
(test-assert (bit-set? 0 #b1101))
|
|
(test-not (logbit? 1 #b1101))
|
|
(test-not (bit-set? 1 #b1101))
|
|
(test-assert (logbit? 2 #b1101))
|
|
(test-assert (bit-set? 2 #b1101))
|
|
(test-assert (logbit? 3 #b1101))
|
|
(test-assert (bit-set? 3 #b1101))
|
|
(test-not (logbit? 4 #b1101))
|
|
(test-not (bit-set? 4 #b1101)))
|
|
|
|
(test-group
|
|
"copy-bit"
|
|
(test "1" (dec->bin (copy-bit 0 0 #t)))
|
|
(test "100" (dec->bin (copy-bit 2 0 #t)))
|
|
(test "1011" (dec->bin (copy-bit 2 #b1111 #f))))
|
|
|
|
(test-group
|
|
"bit-field"
|
|
(test "1010" (dec->bin (bit-field #b1101101010 0 4)))
|
|
(test "10110" (dec->bin (bit-field #b1101101010 4 9))))
|
|
|
|
(test-group
|
|
"copy-bit-field"
|
|
(test "1101100000" (dec->bin (copy-bit-field #b1101101010 0 0 4)))
|
|
(test "1101101111" (dec->bin (copy-bit-field #b1101101010 -1 0 4)))
|
|
(test "110100111110000" (dec->bin (copy-bit-field #b110100100010000 -1 5 9))))
|
|
|
|
(test-group
|
|
"ash"
|
|
(test "1000" (dec->bin (ash #b1 3)))
|
|
(test "1000" (dec->bin (arithmetic-shift #b1 3)))
|
|
(test "101" (dec->bin (ash #b1010 -1)))
|
|
(test "101" (dec->bin (arithmetic-shift #b1010 -1))))
|
|
|
|
(test-group
|
|
"rotate-bit-field"
|
|
(test "10" (dec->bin (rotate-bit-field #b0100 3 0 4)))
|
|
(test "10" (dec->bin (rotate-bit-field #b0100 -1 0 4)))
|
|
(test "110100010010000" (dec->bin (rotate-bit-field #b110100100010000
|
|
-1
|
|
5
|
|
9)))
|
|
(test "110100000110000" (dec->bin (rotate-bit-field #b110100100010000
|
|
1
|
|
5
|
|
9))))
|
|
|
|
(test-group
|
|
"reverse-bit-field"
|
|
(test "E5" (number->string (reverse-bit-field #xa7 0 8) 16)))
|
|
|
|
(test-exit)
|