Changeset 38606 in project for release


Ignore:
Timestamp:
04/09/20 07:09:38 (4 months ago)
Author:
Kon Lovett
Message:

fix bitwise-count (remove wrong quick path)

Location:
release/5/bitwise-utils/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/bitwise-utils/trunk/bitwise-utils.egg

    r38602 r38606  
    33
    44((synopsis "Bitwise utilities")
    5  (version "1.1.1")
     5 (version "1.1.2")
    66 (category data)
    77 (author "[[kon lovett]]")
  • release/5/bitwise-utils/trunk/bitwise-utils.scm

    r38602 r38606  
    7878
    7979;;
     80
     81;FIXME bitwise-split more like string-chop then string-split
    8082
    8183(: arithmetic-shift-left (integer fixnum --> integer))
     
    105107(define (arithmetic-shift-right n w) (arithmetic-shift n (- w)))
    106108
     109(define (bitwise-zeros b) (arithmetic-shift-left -1 b))
     110
     111(define (bitwise-ones b) (bitwise-not (bitwise-zeros b)))
     112
     113(define (bitwise-abs n) (if (negative? n) (bitwise-not n) n))
     114
     115(define (bitwise-drop-right n w)
     116  (bitwise-and (arithmetic-shift-right n w) (bitwise-ones (- (integer-length n) w))) )
     117
     118(define (bitwise-cons a b)
     119  (bitwise-ior (logical-shift-left a (integer-length b)) b) )
     120
    107121;5 #t => +0...011111
    108122;5 #f => -1...100000
    109123(define (bitwise-mask b #!optional (on? #t))
    110   (if (zero? b) 0
    111     (let ((res (arithmetic-shift-left -1 b)))
    112       (if on? (bitwise-not res) res) ) ) )
    113 
    114 (define (*logical-shift-right n w)
    115   (bitwise-and (arithmetic-shift-right n w) (bitwise-mask (- (integer-length n) w))) )
     124  (if on? (bitwise-ones b)
     125    (bitwise-zeros b) ) )
    116126
    117127;preserves sign - doesn't sign extend
     
    119129(define (logical-shift-right n w)
    120130  (if (zero? w) n
    121     (let ((res (*logical-shift-right (abs n) w)))
     131    (let ((res (bitwise-drop-right (abs n) w)))
    122132      (if (negative? n) (- res) res) ) ) )
    123133
    124 (define (*bitwise-join a b)
    125   (bitwise-ior (logical-shift-left a (integer-length b)) b) )
    126 
    127134;#b10 #b0000001 #b101 => #b101101
    128 (define (bitwise-join n . ns) (foldl (cut *bitwise-join <> <>) n ns))
     135(define (bitwise-join n . ns)
     136  (foldl (cut bitwise-cons <> <>) n ns) )
    129137
    130138;babcdef 2 => ba bc de f
     
    133141(define (bitwise-split n w)
    134142  (if (or (zero? n) (zero? w)) `(,n)
    135     (let ((neg? (negative? n)) (mask (bitwise-mask w)))
     143    (let ((neg? (negative? n)) (mask (bitwise-ones w)))
    136144      (let loop ((n (abs n)) (ns '()))
    137145        (if (zero? n) (if neg? (map - ns) ns)
    138           (loop (*logical-shift-right n w) (cons (bitwise-and n mask) ns)) ) ) ) ) )
    139 
    140 (define (bitwise-abs n) (if (negative? n) (bitwise-not n) n))
     146          (loop (bitwise-drop-right n w) (cons (bitwise-and n mask) ns)) ) ) ) ) )
    141147
    142148(define *uword-size* (foreign-type-size "C_uword"))
     
    152158        "return( C_uword_bits( (C_uword) n ) );")) ) )
    153159
     160(define (integer->uwords n) (bitwise-split n (* 8 *uword-size*)))
     161
     162(define (add-uword-bits c n) (+ c (uword-bitwise-count n)))
     163
    154164(define (bitwise-count n)
    155165  (let ((n (bitwise-abs n)))
    156166    (if (fixnum? n) (uword-bitwise-count n)
    157       (foldl
    158         (lambda (c i) (+ c (uword-bitwise-count i)))
    159         0
    160         (bitwise-split n (* 8 *uword-size*))) ) ) )
     167      (foldl add-uword-bits 0 (integer->uwords n)) ) ) )
    161168
    162169(define (bitwise-merge mask n0 n1)
     
    202209  (let* (
    203210    (width (- end start))
    204     (mask (bitwise-mask width))
     211    (mask (bitwise-ones width))
    205212    (zn (bitwise-and mask (arithmetic-shift-right n start))) )
    206213    (bitwise-ior
     
    212219    (width (- end start))
    213220    (count (modulo count width))
    214     (mask (bitwise-mask width))
     221    (mask (bitwise-ones width))
    215222    (zn (bitwise-and mask (arithmetic-shift-right n start))) )
    216223    (bitwise-ior
Note: See TracChangeset for help on using the changeset viewer.