Changeset 13496 in project


Ignore:
Timestamp:
03/05/09 05:48:23 (11 years ago)
Author:
Jim Ursetto
Message:

tokyocabinet: expand HDB API, avoid segfaults

Location:
release/3/tokyocabinet
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • release/3/tokyocabinet/tokyocabinet.meta

    r12323 r13496  
    77 (author "Alex Shinn")
    88 (doc-from-wiki)
     9 (needs easyffi)
    910 (files "tokyocabinet.scm" "tokyocabinet.setup" "tokyocabinet.html"))
  • release/3/tokyocabinet/tokyocabinet.scm

    r13486 r13496  
    1717  tc-hdb-fold
    1818  tc-hdb-iter-init tc-hdb-iter-next
     19  tc-hdb-sync tc-hdb-vanish tc-hdb-copy
     20  tc-hdb-path
     21  tc-hdb-transaction-begin tc-hdb-transaction-commit tc-hdb-transaction-abort
     22  tc-hdb-record-count tc-hdb-file-size
    1923  ))
    2024
     
    3337
    3438"))
     39
     40;;; Hash table API
    3541
    3642;; tc-hdb-tune flags
     
    6167(define TC_HDBOLCKNB HDBOLCKNB)
    6268
    63 (define %tc-hdb-new (foreign-lambda c-pointer "tchdbnew"))
     69(define-record tc-hdb ptr path)
     70(define-record-printer (tc-hdb hdb port)
     71  (fprintf port "#<tc-hdb ~A on ~S>"
     72           (or (tc-hdb-ptr hdb) "(closed)")
     73           (tc-hdb-path hdb)))
    6474
    65 (define %tc-hdb-del
    66   (foreign-lambda* void ((c-pointer hdb))
    67     "tchdbdel((TCHDB*) hdb);"))
     75(define-foreign-type hdb
     76  (nonnull-c-pointer "TCHDB")
     77  ; tc-hdb-ptr
     78  )
    6879
    69 (define %tc-hdb-set-mutex!
    70   (foreign-lambda* bool ((c-pointer hdb))
    71     "return(tchdbsetmutex((TCHDB*) hdb));"))
    72 
    73 (define %tc-hdb-set-cache!
    74   (foreign-lambda* bool ((c-pointer hdb) (int rcnum))
    75     "return(tchdbsetcache((TCHDB*) hdb, rcnum));"))
    76 
    77 (define %tc-hdb-set-xmsiz!
    78   (foreign-lambda* bool ((c-pointer hdb) (int xmsiz))
    79     "return(tchdbsetxmsiz((TCHDB*) hdb, xmsiz));"))
    80 
    81 (define %tc-hdb-tune!
    82   (foreign-lambda* bool ((c-pointer hdb)
    83                          (int bnum) (int apow) (int fpow) (int opts))
    84     "return(tchdbtune((TCHDB*) hdb, bnum, apow, fpow, opts));"))
    85 
    86 (define %tc-hdb-open
    87   (foreign-lambda* bool ((c-pointer hdb) (c-string file) (int flags))
    88     "return(tchdbopen(hdb, file, flags));"))
     80#>? #include "tcapi.h" <#
    8981
    9082(define (tc-hdb-open file
     
    9890                     (cache-limit #f)
    9991                     (mmap-size #f))
    100   (let ((hdb (%tc-hdb-new)))
    101     (and hdb
     92  (let ((hdb (make-tc-hdb (%tc-hdb-new) file)))
     93    (and (tc-hdb-ptr hdb)
    10294         ;; make sure all the specified keyword settings succeed, and
    103          ;; return the hdb c-pointer
     95         ;; return the hdb record
    10496         (or (and
    105               (or (not mutex?) (%tc-hdb-set-mutex! hdb))
    106               (or (not cache-limit) (%tc-hdb-set-cache! hdb cache-limit))
    107               (or (not mmap-size) (%tc-hdb-set-xmsiz! hdb mmap-size))
     97              (or (not mutex?) (%tc-hdb-setmutex hdb))
     98              (or (not cache-limit) (%tc-hdb-setcache hdb cache-limit))
     99              (or (not mmap-size) (%tc-hdb-setxmsiz hdb mmap-size))
    108100              (or (not (or num-buckets record-alignment num-free-blocks
    109101                           tune-opts))
    110                   (%tc-hdb-tune! hdb
    111                                  (or num-buckets 0)
    112                                  (or record-alignment -1)
    113                                  (or num-free-blocks -1)
    114                                  (or tune-opts 0)))
     102                  (%tc-hdb-tune hdb
     103                                (or num-buckets 0)
     104                                (or record-alignment -1)
     105                                (or num-free-blocks -1)
     106                                (or tune-opts 0)))
    115107              (%tc-hdb-open hdb file flags)
    116108              hdb)
     
    120112               #f)))))
    121113
    122 (define tc-hdb-close
    123   (foreign-lambda* bool ((c-pointer hdb))
    124     "if (tchdbclose((TCHDB*) hdb)) {"
    125     "    tchdbdel((TCHDB*) hdb);"
    126     "    return(1);"
    127     "} else {"
    128     "    return(0);"
    129     "}"))
    130 
    131 (define %tc-hdb-put!
    132   (foreign-lambda* bool ((c-pointer hdb)
    133                          (pointer kptr) (int ksize)
    134                          (pointer vptr) (int vsize))
    135     "return(tchdbput((TCHDB*) hdb, kptr, ksize, vptr, vsize));"))
     114(define (tc-hdb-close hdb)
     115  (and (%tc-hdb-close hdb)
     116       (begin (%tc-hdb-del hdb)
     117              (tc-hdb-ptr-set! hdb #f) ; prevent further use
     118              #t)))
    136119
    137120(define (tc-hdb-put! hdb key value)
    138   (%tc-hdb-put! hdb key (string-length key) value (string-length value)))
    139 
    140 (define %tc-hdb-delete!
    141   (foreign-lambda* bool ((c-pointer hdb) (pointer kptr) (int ksize))
    142     "return(tchdbout((TCHDB*) hdb, kptr, ksize));"))
     121  (%tc-hdb-put hdb key (string-length key)
     122               value (string-length value)))
    143123
    144124(define (tc-hdb-delete! hdb key)
    145   (%tc-hdb-delete! hdb key (string-length key)))
     125  (%tc-hdb-out hdb key (string-length key)))
    146126
    147127(define (tc-hdb-get hdb key)
    148   (define tchdbget
    149     (foreign-lambda c-pointer "tchdbget"
    150                     c-pointer scheme-pointer int (c-pointer int)))
    151128  (let-location ((size int))
    152     (and-let* ((valptr (tchdbget hdb key
     129    (and-let* ((ptr (%tc-hdb-get hdb key
    153130                                 (string-length key) (location size))))
    154       ;; Exception handling imposes an unacceptable overhead.
    155       (when (fx> size +max-string-length+)
    156         (free valptr)
    157         (error 'tc-hdb-get "value length too long" size))
    158       (let ((val (make-string size)))
    159         (##core#inline "copy_string_result" valptr size val)
    160         (free valptr)
    161         val))))
     131      (sized-c-string* ptr size 'tc-hdb-get))))
    162132
    163 (define tc-hdb-iter-init
    164   (foreign-lambda* bool ((c-pointer hdb))
    165     "return(tchdbiterinit((TCHDB*) hdb));"))
     133;; Copy size bytes from ptr into new string and free ptr.
     134;; Like c-string* return type but does not use null terminator.
     135;; Note: Exception handling imposes an unacceptable overhead.
     136(define (sized-c-string* ptr size #!optional (where 'sized-c-string*))
     137  (when (> size +max-string-length+)
     138    (free ptr)
     139    (error where "string length too long" size))
     140  (let ((val (make-string size)))
     141    (##core#inline "copy_string_result" ptr size val)
     142    (free ptr)
     143    val))
    166144
    167 (define tc-hdb-iter-next
    168   (foreign-lambda* c-string ((c-pointer hdb))
    169     "return(tchdbiternext2((TCHDB*) hdb));"))
     145(define tc-hdb-iter-init %tc-hdb-iterinit)
     146(define (tc-hdb-iter-next hdb)
     147  (let-location ((size int))
     148    (and-let* ((ptr (%tc-hdb-iternext hdb #$size)))
     149      (sized-c-string* ptr size 'tc-hdb-iter-next))))
    170150
    171151(define (tc-hdb-fold hdb kons knil)
     
    177157          (let ((val (tc-hdb-get hdb key)))
    178158            (lp (kons key val acc)))))))
     159
     160(define tc-hdb-sync %tc-hdb-sync)
     161(define tc-hdb-vanish %tc-hdb-vanish)
     162(define tc-hdb-copy %tc-hdb-copy)
     163(define tc-hdb-transaction-begin  %tc-hdb-tranbegin)
     164(define tc-hdb-transaction-commit %tc-hdb-trancommit)
     165(define tc-hdb-transaction-abort  %tc-hdb-tranabort)
     166(define tc-hdb-record-count %tc-hdb-rnum)
     167(define tc-hdb-file-size %tc-hdb-fsiz)
     168
     169;;; B+-tree API
     170
  • release/3/tokyocabinet/tokyocabinet.setup

    r13486 r13496  
    11
    2 (run (csc -s -O2 -G -d0
     2(run (csc -s -O2 -G -d0 -X easyffi
    33          -emit-exports tokyocabinet.exports
    44          tokyocabinet.scm -ltokyocabinet))
     
    77 'tokyocabinet
    88 "tokyocabinet.so"
    9  '((version 1.02)
     9 '((version 1.03)
    1010   (exports "tokyocabinet.exports")))
Note: See TracChangeset for help on using the changeset viewer.