Changeset 36501 in project


Ignore:
Timestamp:
09/05/18 17:57:40 (2 weeks ago)
Author:
kon
Message:

better word handling

Location:
release/5/bloom-filter/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/5/bloom-filter/trunk/bloom-filter.egg

    r36368 r36501  
    44((synopsis "Bloom Filter")
    55 (category data)
    6  (version "2.0.1")
     6 (version "2.1.0")
    77 (author "[[kon lovett]]")
    88 (license "BSD")
  • release/5/bloom-filter/trunk/bloom-filter.scm

    r36368 r36501  
    8282      4 ) ) )
    8383
    84 (define (object-data-pointer obj)
     84(define-inline (object-data-pointer obj)
    8585  ;skip over the machine-word header
    8686  (pointer+ (object->pointer obj) MACHINE-WORD-SIZE) )
    8787
    88 ;
     88(define-inline (pointer-word-offset ptr idx)
     89  (pointer+ ptr (fx* idx MACHINE-WORD-SIZE)) )
     90
     91(define-inline (object-data-offset obj idx)
     92  (pointer-word-offset (object-data-pointer obj) idx) )
     93
    8994(cond-expand
    9095  (64bit
    91     (: unsigned-integer64-ref unsigned-native-integer-getter)
    92     (define (unsigned-integer64-ref obj idx)
    93       (pointer-u64-ref (pointer+ (object-data-pointer obj) idx)) ) )
     96    (: wordvector64-ref unsigned-native-integer-getter)
     97    (define (wordvector64-ref obj idx)
     98      (pointer-u64-ref (object-data-offset obj idx)) ) )
    9499  (else
    95     (: unsigned-integer32-ref unsigned-native-integer-getter)
    96     (define (unsigned-integer32-ref obj idx)
    97       (pointer-u32-ref (pointer+ (object-data-pointer obj) idx)) ) ) )
    98 
    99 (: unsigned-native-integer-ref unsigned-native-integer-getter)
    100 ;
    101 (define unsigned-native-integer-ref
     100    (: wordvector32-ref unsigned-native-integer-getter)
     101    (define (wordvector32-ref obj idx)
     102      (pointer-u32-ref (object-data-offset obj idx)) ) ) )
     103
     104(: wordvector-ref unsigned-native-integer-getter)
     105;
     106(define wordvector-ref
    102107  (cond-expand
    103108    (64bit
    104       unsigned-integer64-ref )
     109      wordvector64-ref )
    105110    (else
    106       unsigned-integer32-ref ) ) )
     111      wordvector32-ref ) ) )
    107112
    108113;;; Record Type
     
    151156(define (message-digest-result->integers obj m wrdcnt bytrem ls)
    152157  ;
    153   (define (words)
    154     (let loop ((idx 0) (ls ls))
    155       (if (fx= idx wrdcnt)
    156         ls
     158  (define (whole-words)
     159    (let loop ((idx 0) (ints ls))
     160      (if (fx>= idx wrdcnt)
     161        ints
    157162        (let* (
    158           (num (unsigned-native-integer-ref obj idx))
    159           (int (inexact->exact (fpfloor (exact->inexact (remainder num m))))) )
    160           (loop (fx+ idx 1) (cons int ls)) ) ) ) )
    161   ;
    162   (let* (
    163     (ptr (object->pointer obj))
    164     (bytoff (fx* wrdcnt MACHINE-WORD-SIZE))
    165     (ptr (pointer+ ptr bytoff)) )
    166     (do (
    167       (cnt bytrem (fx- cnt 1))
    168       (ptr ptr (pointer+ ptr 1))
    169       (int 0 (fx+ int (pointer-u8-ref ptr))) )
    170       ((fx= 0 cnt)
    171         (reverse! (cons int (words))) ) ) ) )
     163          (num (wordvector-ref obj idx))
     164          (int (remainder num m)) )
     165          (loop (fx+ idx 1) (cons int ints)) ) ) ) )
     166  ;
     167  (define (partial-word)
     168    (let (
     169      (ptr (object->pointer obj))
     170      (bytoff (fx* wrdcnt MACHINE-WORD-SIZE)) )
     171      (do (
     172        (cnt  bytrem                (fx- cnt 1))
     173        (ptr  (pointer+ ptr bytoff) (pointer+ ptr 1))
     174        (int  0                     (fx+ int (pointer-u8-ref ptr))) )
     175        ((fx>= 0 cnt) int)) ) )
     176  ;
     177  (reverse! (cons (partial-word) (whole-words))) )
    172178
    173179(: make-bloom-filter-hasher (message-digest-primitive fixnum -> bloom-filter-hasher))
Note: See TracChangeset for help on using the changeset viewer.