Changeset 39177 in project
 Timestamp:
 11/08/20 20:21:39 (4 months ago)
 Location:
 release/5/bitwiseutils/trunk
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

release/5/bitwiseutils/trunk/bitwiseutils.scm
r39174 r39177 83 83 (define (bitwiseabs n) (if (negative? n) (bitwisenot n) n)) 84 84 85 (define (bitwisedropright n w) 86 (bitwiseand (arithmeticshiftright n w) (bitwiseones ( (integerlength n) w))) ) 87 88 (define (bitwisecons a b) 89 (bitwiseior (logicalshiftleft a (integerlength b)) b) ) 85 (define (bitwisedropright n w) (bitwiseand (arithmeticshiftright n w) 86 (bitwiseones ( (integerlength n) w)))) 87 88 (define (bitwisecons a b) (bitwiseior (logicalshiftleft a (integerlength b)) b)) 90 89 91 90 ;5 #t => +0...011111 92 91 ;5 #f => 1...100000 93 (define (bitwisemask b #!optional (on? #t)) 94 (if on? (bitwiseones b) 95 (bitwisezeros b) ) ) 92 (define (bitwisemask b #!optional (on? #t)) (if on? (bitwiseones b) (bitwisezeros b))) 96 93 97 94 ;preserves sign  doesn't sign extend … … 103 100 104 101 ;#b10 #b0000001 #b101 => #b101101 105 (define (bitwisejoin n . ns) 106 (foldl (cut bitwisecons <> <>) n ns) ) 102 (define (bitwisejoin n . ns) (foldl bitwisecons n ns)) 107 103 108 104 ;babcdef 2 => ba bc de f … … 163 159 164 160 (define (bitwisemerge mask n0 n1) 165 (bitwiseior 166 (bitwiseand mask n0) 167 (bitwiseand (bitwisenot mask) n1)) ) 168 169 (define (bitwisenth? index n) 170 (bit>boolean n index) ) 171 172 (define (bitwiseany? n1 n2) 173 (not (zero? (bitwiseand n1 n2))) ) 174 175 (define (bitwisefirstset n) 176 (sub1 (integerlength (bitwiseand n ( n)))) ) 161 (bitwiseior (bitwiseand mask n0) 162 (bitwiseand (bitwisenot mask) n1)) ) 163 164 (define (bitwisenth? index n) (bit>boolean n index)) 165 166 (define (bitwiseany? n1 n2) (not (zero? (bitwiseand n1 n2)))) 167 168 (define (bitwisefirstset n) (sub1 (integerlength (bitwiseand n ( n))))) 177 169 178 170 (define (bitwisereverse n k) … … 182 174 ((negative? k) (if (negative? n) (bitwisenot rvs) rvs)))) 183 175 184 (define (bitwiserotate k count len) 185 (bitwisefieldrotate k count 0 len) ) 176 (define (bitwiserotate k count len) (bitwisefieldrotate k count 0 len)) 186 177 187 178 (define (bitwisesetnth to index on?) 188 (if on? 189 (bitwiseior to (arithmeticshift 1 index)) 179 (if on? (bitwiseior to (arithmeticshift 1 index)) 190 180 (bitwiseand to (bitwisenot (arithmeticshift 1 index))) ) ) 191 181 192 182 (define (bitwisefield n start end) 193 (bitwiseand 194 (bitwisenot (arithmeticshift 1 ( end start))) 195 (arithmeticshiftright n start)) ) 183 (bitwiseand (bitwisenot (arithmeticshift 1 ( end start))) 184 (arithmeticshiftright n start)) ) 196 185 197 186 (define (bitwisefieldcopy to from start end) … … 202 191 203 192 (define (bitwisefieldreverse n start end) 204 (let* ( 205 (width ( end start)) 206 (mask (bitwiseones width)) 207 (zn (bitwiseand mask (arithmeticshiftright n start))) ) 208 (bitwiseior 209 (arithmeticshift (bitwisereverse zn width) start) 210 (bitwiseand (bitwisenot (arithmeticshift mask start)) n)) ) ) 193 (let* ((width ( end start)) 194 (mask (bitwiseones width)) 195 (zn (bitwiseand mask (arithmeticshiftright n start))) ) 196 (bitwiseior (arithmeticshift (bitwisereverse zn width) start) 197 (bitwiseand (bitwisenot (arithmeticshift mask start)) n)) ) ) 211 198 212 199 (define (bitwisefieldrotate n count start end) 213 (let* ( 214 (width ( end start)) 215 (count (modulo count width)) 216 (mask (bitwiseones width)) 217 (zn (bitwiseand mask (arithmeticshiftright n start))) ) 200 (let* ((width ( end start)) 201 (count (modulo count width)) 202 (mask (bitwiseones width)) 203 (zn (bitwiseand mask (arithmeticshiftright n start))) ) 218 204 (bitwiseior 219 205 (arithmeticshift 220 (bitwiseior 221 (bitwiseand mask (arithmeticshift zn count)) 222 (arithmeticshift zn ( count width))) 206 (bitwiseior (bitwiseand mask (arithmeticshift zn count)) 207 (arithmeticshift zn ( count width))) 223 208 start) 224 209 (bitwiseand (bitwisenot (arithmeticshift mask start)) n)) ) ) 
release/5/bitwiseutils/trunk/tests/bitwiseutilstest.scm
r38599 r39177 10 10 (import bitwiseutils) 11 11 (import (chicken bitwise)) 12 13 (define (hex>number x) (string>number x 16)) 14 (define (number>hex x) (number>string x 16)) 15 (define (negate x) (* 1 x)) 12 16 13 17 ;(bitwisejoin #t 23 '()) … … 51 55 (test '(0) (bitwisesplit 0 0)) 52 56 53 (test '("a" "b" "c" "d" "e" "f") (map (cut number>string <> 16)(bitwisesplit #xabcdef 4)))54 (test '("a" "b" "c" "d" "e" "f") (map (cut number>string <> 16)(bitwisesplit #xabcdef 4)))57 (test '("a" "b" "c" "d" "e" "f") (map number>hex (bitwisesplit #xabcdef 4))) 58 (test '("a" "b" "c" "d" "e" "f") (map number>hex (bitwisesplit #xabcdef 4))) 55 59 56 (test '("b0000000" "0" "110000deadbeef") (map (cut number>string <> 16) (bitwisesplit #xb0000000000000000000000000110000deadbeef 64))) 57 (test '("b0000000" "0" "110000deadbeef") (map (cut number>string <> 16) (bitwisesplit #xb0000000000000000000000000110000deadbeef 64))) 60 ;NOTE not bitwisejoin <inverse> bitwisesplit due to sign 61 (test #xabcdef (apply bitwisejoin (map hex>number '("a" "b" "c" "d" "e" "f")))) 62 (test #xabcdef (negate (apply bitwisejoin (map (o negate hex>number) '("a" "b" "c" "d" "e" "f"))))) 63 64 (test '("b0000000" "0" "110000deadbeef") (map number>hex (bitwisesplit #xb0000000000000000000000000110000deadbeef 64))) 65 (test '("b0000000" "0" "110000deadbeef") (map number>hex (bitwisesplit #xb0000000000000000000000000110000deadbeef 64))) 58 66 59 67 (test 29 (bitwisecount #xb0000000000000000000000000110000deadbeef))
Note: See TracChangeset
for help on using the changeset viewer.