Changeset 14025 in project for release/4/err5rsarithmetic/trunk/err5rsarithmeticbitwise.scm
 Timestamp:
 04/01/09 02:51:29 (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

release/4/err5rsarithmetic/trunk/err5rsarithmeticbitwise.scm
r13998 r14025 135 135 } 136 136 137 #if 0 /* Unused */138 static const unsigned char139 BitReverseTable256[] = {140 0x00, 0x80, 0x40, 0xC0, 0x20, 0xA0, 0x60, 0xE0, 0x10, 0x90, 0x50, 0xD0, 0x30, 0xB0, 0x70, 0xF0,141 0x08, 0x88, 0x48, 0xC8, 0x28, 0xA8, 0x68, 0xE8, 0x18, 0x98, 0x58, 0xD8, 0x38, 0xB8, 0x78, 0xF8,142 0x04, 0x84, 0x44, 0xC4, 0x24, 0xA4, 0x64, 0xE4, 0x14, 0x94, 0x54, 0xD4, 0x34, 0xB4, 0x74, 0xF4,143 0x0C, 0x8C, 0x4C, 0xCC, 0x2C, 0xAC, 0x6C, 0xEC, 0x1C, 0x9C, 0x5C, 0xDC, 0x3C, 0xBC, 0x7C, 0xFC,144 0x02, 0x82, 0x42, 0xC2, 0x22, 0xA2, 0x62, 0xE2, 0x12, 0x92, 0x52, 0xD2, 0x32, 0xB2, 0x72, 0xF2,145 0x0A, 0x8A, 0x4A, 0xCA, 0x2A, 0xAA, 0x6A, 0xEA, 0x1A, 0x9A, 0x5A, 0xDA, 0x3A, 0xBA, 0x7A, 0xFA,146 0x06, 0x86, 0x46, 0xC6, 0x26, 0xA6, 0x66, 0xE6, 0x16, 0x96, 0x56, 0xD6, 0x36, 0xB6, 0x76, 0xF6,147 0x0E, 0x8E, 0x4E, 0xCE, 0x2E, 0xAE, 0x6E, 0xEE, 0x1E, 0x9E, 0x5E, 0xDE, 0x3E, 0xBE, 0x7E, 0xFE,148 0x01, 0x81, 0x41, 0xC1, 0x21, 0xA1, 0x61, 0xE1, 0x11, 0x91, 0x51, 0xD1, 0x31, 0xB1, 0x71, 0xF1,149 0x09, 0x89, 0x49, 0xC9, 0x29, 0xA9, 0x69, 0xE9, 0x19, 0x99, 0x59, 0xD9, 0x39, 0xB9, 0x79, 0xF9,150 0x05, 0x85, 0x45, 0xC5, 0x25, 0xA5, 0x65, 0xE5, 0x15, 0x95, 0x55, 0xD5, 0x35, 0xB5, 0x75, 0xF5,151 0x0D, 0x8D, 0x4D, 0xCD, 0x2D, 0xAD, 0x6D, 0xED, 0x1D, 0x9D, 0x5D, 0xDD, 0x3D, 0xBD, 0x7D, 0xFD,152 0x03, 0x83, 0x43, 0xC3, 0x23, 0xA3, 0x63, 0xE3, 0x13, 0x93, 0x53, 0xD3, 0x33, 0xB3, 0x73, 0xF3,153 0x0B, 0x8B, 0x4B, 0xCB, 0x2B, 0xAB, 0x6B, 0xEB, 0x1B, 0x9B, 0x5B, 0xDB, 0x3B, 0xBB, 0x7B, 0xFB,154 0x07, 0x87, 0x47, 0xC7, 0x27, 0xA7, 0x67, 0xE7, 0x17, 0x97, 0x57, 0xD7, 0x37, 0xB7, 0x77, 0xF7,155 0x0F, 0x8F, 0x4F, 0xCF, 0x2F, 0xAF, 0x6F, 0xEF, 0x1F, 0x9F, 0x5F, 0xDF, 0x3F, 0xBF, 0x7F, 0xFF};156 157 #define REVERSE_BYTE( b ) BitReverseTable256[ (b) ]158 159 #define REVERSE_LOW_BITS( b, w ) \160 ((CHAR_BIT == (w)) \161 ? REVERSE_BYTE( b ) \162 : (HIGH_BITS( REVERSE_BYTE( LOW_BITS( (b), (w) ) ), (w) ) >> (w)))163 164 #define REVERSE_BITS( b, s, e ) \165 ((0 == (s)) \166 ? REVERSE_LOW_BITS( (b), (e) ) \167 : (REVERSE_LOW_BITS( ((b) >> (e)), ((e)  (s)) ) << (e)))168 #endif169 170 #if 0 /* Doesn't work */171 137 static C_uword 172 C_uword_ bits_reverse( C_uword n, C_uword s, C_uword e)138 C_uword_rotate_bit_field( C_uword n, unsigned int s, unsigned int e, unsigned int c ) 173 139 { 174 #define FULBYT( n ) ((n) / CHAR_BIT) 175 #define REMBYT( n ) (0 == ((n) % CHAR_BIT) ? 0 : 1) 176 #define TOTBYT( n ) (FULBYT( n ) + REMBYT( n )) 177 #ifdef C_BIG_ENDIAN 178 # define BYTPTR( n, p ) (((uint8_t *) &n) + (sizeof( C_uword )  FULBYT( p ))) 179 #else 180 # define BYTPTR( n, p ) (((uint8_t *) &n) + FULBYT( e )) 181 #endif 182 183 #ifdef C_SIXTY_FOUR 184 #else 185 #endif 186 187 C_uword wid = e  s; 188 189 C_uword SS = s % CHAR_BIT; 190 C_uword EE = e % CHAR_BIT; 191 C_word FUL = (C_word) wid  (SS * CHAR_BIT)  (EE * CHAR_BIT); 192 193 C_uword SE = MIN( CHAR_BIT, EE ); 194 C_uword ES = MAX( 0, FUL ); 195 196 uint8_t *srt = BYTPTR( n, e ); 197 uint8_t *end = BYTPTR( n, s ); 198 199 for ( ; end > srt; ++srt, end) { 200 C_uword tmp = REVERSE_BYTE( *srt ); 201 *srt = REVERSE_BYTE( *end ); 202 *end = temp; 140 if (0 != n) { 141 unsigned int wid = e  s; 142 unsigned int cnt = c % wid; 143 C_uword fld = BITS( n, s, e ); 144 return BITS_COPY( n, s, e, ((fld << cnt) ^ (fld >> (wid  cnt))) ); 203 145 } 204 146 205 *srt = REVERSE_BITS( *srt, s % CHAR_BIT, e % CHAR_BIT ); 206 *end = REVERSE_BITS( *end, s % CHAR_BIT, e % CHAR_BIT ); 147 return 0; 207 148 } 208 #endif209 149 210 150 static C_uword 211 C_ word_bits_bit_count( C_word n)151 C_uword_reverse( C_uword n, int c ) 212 152 { 213 C_return( (0 < n) 214 ? C_uword_bits( (C_uword) n ) 215 : ((0 == n) ? 0 : /*~*/ C_uword_bits( (C_uword) ~n )) ); 153 int isneg = ((C_word) n) < 0; 154 unsigned int mask = isneg ? ~((C_word) n) : n; 155 C_uword revval = 0; 156 for (c; 0 <= c; c, mask >>= 1) { 157 revval = (revval << 1)  (1 & mask) ; 158 } 159 return isneg ? ~revval : revval; 216 160 } 217 161 218 #if 0 /* Doesn't work */219 162 static C_uword 220 C_uword_ bits_rotate_bit_field( C_uword n, C_uword s, C_uword e, C_uword c)163 C_uword_reverse_bit_field( C_uword n, unsigned int s, unsigned int e ) 221 164 { 222 #define ASH( n , s ) ((0 < (s)) ? ((n) << (s)) : ((n) >> (s))) 223 224 C_uword wid = e  s; 225 226 if (0 == wid) C_return( n ); 227 else { 228 C_word cnt = c % wid; 229 C_uword msk = LOW_MASK( wid ); 230 C_uword fld = BITS( n, s, e ); 231 232 C_return( ((((msk & ASH( fld, cnt ))  ASH( fld, cnt  wid ))) << s)  (n & ~ (msk << s)) ); 233 } 234 235 #undef ASH 165 unsigned int width = e  s; 166 C_uword mask = ~(((C_uword) 1) << width); 167 return (C_uword_reverse( (mask & (n >> s)), width ) << s)  (~(mask << s) & n); 236 168 } 237 #else238 static C_uword239 C_uword_bits_rotate_bit_field( C_uword n, C_uword s, C_uword e, C_uword c )240 {241 if (0 == n) C_return( n );242 else {243 C_uword wid = e  s;244 C_uword cnt = c % wid;245 C_uword fld = BITS( n, s, e );246 247 #if 0248 C_return( BITS_COPY( n, s, e, ((fld << cnt) ^ (fld >> (wid  cnt))) ) );249 #else250 C_return( BITS_COPY( n, s, e, ((fld << cnt) ^ (fld >> (wid  cnt))) ) );251 #endif252 }253 }254 #endif255 169 <# 256 170 … … 315 229 (%boolean>bit obj) ) ) 316 230 231 ;; Fold operations 232 233 ;Note  argument order is (func acc cur) & not (func cur acc) as in (fold func). 234 235 (defineinline (%bwfold loc func init ls) 236 (%checkinteger loc init) 237 (let loop ((ls ls) (acc init)) 238 (if (%null? ls) acc 239 (let ((cur (%car ls))) 240 (%checkinteger loc cur) 241 (loop (%cdr ls) (func acc cur)) ) ) ) ) 242 317 243 ;;; 318 244 319 245 (module err5rsarithmeticbitwise (;export 320 ; ERR5RS321 ;;bitwiseand bitwiseior bitwisexor bitwisenot  from chicken246 ;; ERR5RS 247 bitwiseand bitwiseior bitwisexor bitwisenot 322 248 bitwiseif 323 249 bitwisetest? … … 334 260 bitwiselist>integer bitwiseinteger>list 335 261 bitwisearithmeticshift bitwisearithmeticshiftleft bitwisearithmeticshiftright 336 ; Extras 262 ;; Chicken Originals 263 chicken:bitwisenot chicken:bitwiseand chicken:bitwiseior chicken:bitwisexor 264 ;; Extras 337 265 pow2log2 338 266 bitwiselastbitset 339 267 bitwiseifnot 340 268 boolean>bit 269 *bitwiseand *bitwiseior *bitwisexor *bitwisenot 341 270 *bitwiseif 342 271 *bitwisetest? … … 357 286 *pow2log2) 358 287 359 (import scheme chicken foreign srfi1 intlimits) 288 (import scheme 289 (rename chicken 290 (bitwiseand chicken:bitwiseand) 291 (bitwiseior chicken:bitwiseior) 292 (bitwisexor chicken:bitwisexor) 293 (bitwisenot chicken:bitwisenot)) 294 foreign srfi1 intlimits) 360 295 361 296 (requirelibrary srfi1 intlimits) … … 389 324 ;; ERR5RS 390 325 326 (define *bitwisenot 327 (foreignlambda* integer ((unsignedinteger n)) 328 "return( ~n );")) 329 330 (define *bitwiseand 331 (foreignlambda* integer ((unsignedinteger n) (unsignedinteger m)) 332 "return( n & m );")) 333 334 (define *bitwiseior 335 (foreignlambda* integer ((unsignedinteger n) (unsignedinteger m)) 336 "return( n  m );")) 337 338 (define *bitwisexor 339 (foreignlambda* integer ((unsignedinteger n) (unsignedinteger m)) 340 "return( n ^ m );")) 341 391 342 (define *bitwiseif 392 (foreignlambda* unsignedint ((integer m) (integer t) (integer f))393 " C_return( BITS_MERGE( m, t, f ) );"))343 (foreignlambda* integer ((unsignedinteger m) (unsignedinteger t) (unsignedinteger f)) 344 "return( BITS_MERGE( m, t, f ) );")) 394 345 395 346 (define *bitwisetest? 396 (foreignlambda* bool (( integer a) (integer b))397 " C_return( BITS_TEST( a, b ) );"))347 (foreignlambda* bool ((unsignedinteger a) (unsignedinteger b)) 348 "return( BITS_TEST( a, b ) );")) 398 349 399 350 (define *bitwisebitcount 400 (foreignlambda unsignedint "C_ word_bits_bit_count"integer))351 (foreignlambda unsignedint "C_uword_bits" unsignedinteger)) 401 352 402 353 (define *bitwiselength 403 (foreignlambda* unsignedint (( integer n))404 " C_return( C_uword_log2( (C_uword) ((n < 0) ? ~ n : n )) );"))354 (foreignlambda* unsignedint ((unsignedinteger n)) 355 "return( C_uword_log2( ((C_word) n) < 0 ? ~n : n ) );")) 405 356 406 357 (define *bitwisefirstbitset 407 (foreignlambda* int (( integer n))408 " C_return( C_UWORD_LOG2_FACTORS( (C_uword)n ) );"))358 (foreignlambda* int ((unsignedinteger n)) 359 "return( C_UWORD_LOG2_FACTORS( n ) );")) 409 360 410 361 (define *bitwisebitset? 411 (foreignlambda* bool (( integer n) (unsignedint i))412 " C_return( BIT_TEST( n, i ) );"))362 (foreignlambda* bool ((unsignedinteger n) (unsignedint i)) 363 "return( BIT_TEST( n, i ) );")) 413 364 414 365 (define *bitwisecopybit 415 (foreignlambda* integer (( integer to) (unsignedint i) (unsignedint b))416 " C_return( BIT_COPY( to, i, b ) );"))366 (foreignlambda* integer ((unsignedinteger to) (unsignedint i) (unsignedint b)) 367 "return( BIT_COPY( to, i, b ) );")) 417 368 418 369 (define *bitwisebitfield 419 (foreignlambda* integer (( integer n) (unsignedint s) (unsignedint e))420 " C_return( BITS( n, s, e ) );"))370 (foreignlambda* integer ((unsignedinteger n) (unsignedint s) (unsignedint e)) 371 "return( BITS( n, s, e ) );")) 421 372 422 373 (define *bitwisecopybitfield 423 (foreignlambda* integer (( integer t) (unsignedint s) (unsignedint e) (integer f))424 " C_return( BITS_COPY( t, s, e, f ) );"))374 (foreignlambda* integer ((unsignedinteger t) (unsignedint s) (unsignedint e) (unsignedinteger f)) 375 "return( BITS_COPY( t, s, e, f ) );")) 425 376 426 377 (define *bitwiserotatebitfield 427 (foreignlambda* integer ((integer n) (unsignedint s) (unsignedint e) (unsignedint c)) 428 "C_return( C_uword_bits_rotate_bit_field( (C_uword) n, s, e, c ) );")) 429 378 (foreignlambda integer "C_uword_rotate_bit_field" unsignedinteger unsignedint unsignedint unsignedint)) 379 380 (define *bitwisereverse 381 (foreignlambda integer "C_uword_reverse" unsignedinteger unsignedint)) 382 383 #; 430 384 (define (*bitwisereverse n c) 431 385 (let ((negval? (%negative? n))) … … 435 389 ((%fxnegative? count) (if negval? (%bitwisenot revval) revval)) ) ) ) 436 390 437 #; ;DOESN'T WORK438 391 (define *bitwisereversebitfield 439 (foreignlambda integer "C_uword_bits_reverse" integer unsignedint unsignedint)) 440 392 (foreignlambda integer "C_uword_reverse_bit_field" unsignedinteger unsignedint unsignedint)) 393 394 #; 441 395 (define (*bitwisereversebitfield n s e) 442 396 (let* ((width (%fx e s)) … … 448 402 449 403 ; returns (list lsb .. msb) 450 (define (*bitwiselist>integer l yst)451 (let loop ((ls l yst) (i 0) (n 0))404 (define (*bitwiselist>integer ls) 405 (let loop ((ls ls) (i 0) (n 0)) 452 406 (if (%null? ls) n 453 (loop (%cdr ls) (%fx + i 1) (*bitwisecopybit n i (%boolean>bit (%car ls)))) ) ) )407 (loop (%cdr ls) (%fxadd1 i) (*bitwisecopybit n i (%boolean>bit (%car ls)))) ) ) ) 454 408 455 409 ; returns (list lsb .. msb) … … 457 411 (let ((zeros (makelist machinewordbits #f))) 458 412 (lambda (n #!optional bitlen) 459 (if (%zero? n) 460 (if bitlen (take zeros bitlen) zeros) 413 (if (%zero? n) (if bitlen (take zeros bitlen) zeros) 461 414 (let ((bitlen (or bitlen (*bitwiselength n)))) 462 415 (let loop ((i 0) (ils '())) … … 464 417 (loop (%fxadd1 i) (%cons (*bitwisebitset? n i) ils)) ) ) ) ) ) ) ) 465 418 466 (define (*bitwisearithmeticshift value signedcount) 467 (%arithmeticshift value signedcount) ) 468 469 (define (*bitwisearithmeticshiftleft value count) 470 (%arithmeticshift value count) ) 471 472 (define (*bitwisearithmeticshiftright value count) 473 (%arithmeticshift value (%fxneg count)) ) 419 (define (*bitwisearithmeticshift value signedcount) (%arithmeticshift value signedcount)) 420 421 (define (*bitwisearithmeticshiftleft value count) (%arithmeticshift value count)) 422 423 (define (*bitwisearithmeticshiftright value count) (%arithmeticshift value (%fxneg count))) 474 424 475 425 ;; Extras 476 426 477 427 (define *bitwiseifnot 478 (foreignlambda* unsignedint ((integer m) (integer t) (integer f))479 " C_return( BITS_MERGE_NOT( m, t, f ) );"))428 (foreignlambda* integer ((unsignedinteger m) (unsignedinteger t) (unsignedinteger f)) 429 "return( BITS_MERGE_NOT( m, t, f ) );")) 480 430 481 431 (define *bitwiselastbitset 482 (foreignlambda* unsignedint (( integer n))483 " C_return( C_uword_log2( (C_uword) n ));"))432 (foreignlambda* unsignedint ((unsignedinteger n)) 433 "return( C_uword_log2( n )  1);")) 484 434 485 435 (define *pow2log2 486 (foreignlambda* unsignedint (( integer n))487 " C_return( 2 << C_uword_log2( (C_uword)n ) );"))436 (foreignlambda* unsignedint ((unsignedinteger n)) 437 "return( 2 << C_uword_log2( n ) );")) 488 438 489 439 ;;; ERR5RS 440 441 (define (bitwisenot value) 442 (%checkinteger 'bitwisenot value) 443 (*bitwisenot value) ) 444 445 (define (bitwiseand value . values) 446 (%bwfold 'bitwiseand *bitwiseand value values) ) 447 448 (define (bitwiseior value . values) 449 (%bwfold 'bitwiseior *bitwiseior value values) ) 450 451 (define (bitwisexor value . values) 452 (%bwfold 'bitwisexor *bitwisexor value values) ) 490 453 491 454 (define (bitwiseif mask true false) … … 551 514 (*bitwisereversebitfield value start end) ) 552 515 553 (define (bitwiselist>integer lyst)554 (%checklist 'bitwiselist>integer lyst)555 (*bitwiselist>integer lyst) )516 (define (bitwiselist>integer bits) 517 (%checklist 'bitwiselist>integer bits) 518 (*bitwiselist>integer bits) ) 556 519 557 520 (define (bitwiseinteger>list value #!optional bitlen)
Note: See TracChangeset
for help on using the changeset viewer.