(let ((filename.db "gdbm-check.db"))
(ignore-errors (lambda () (delete-file filename.db)))
- (let ((dbf (gdbm-open filename.db 0 GDBM_WRCREAT #o660)))
+ (let ((dbf (gdbm-open filename.db 0 gdbm_wrcreat #o660)))
;; Must be set before first store.
- (gdbm-setopt dbf GDBM_CACHESIZE 101)
+ (gdbm-setopt dbf 'cachesize 101)
- (gdbm-store dbf "Silly String" "Testing 1 2 3." GDBM_REPLACE)
+ (gdbm-store dbf "Silly String" "Testing 1 2 3." gdbm_replace)
(if (not (condition?
(ignore-errors
- (lambda () (gdbm-store dbf "NullString" "" GDBM_INSERT)))))
+ (lambda () (gdbm-store dbf "NullString" "" gdbm_insert)))))
(error "storing null content did not signal"))
(if (not (condition?
(ignore-errors
- (lambda () (gdbm-store dbf "" "NullString" GDBM_INSERT)))))
+ (lambda () (gdbm-store dbf "" "NullString" gdbm_insert)))))
(error "storing null key did not signal"))
- (if (not (eq? #t (gdbm-store dbf "Silly String" "Ahoy!" GDBM_REPLACE)))
+ (if (not (eq? #t (gdbm-store dbf "Silly String" "Ahoy!" gdbm_replace)))
(error "replace produced wrong indication"))
- (if (not (eq? #f (gdbm-store dbf "Silly String" "Oy!" GDBM_INSERT)))
+ (if (not (eq? #f (gdbm-store dbf "Silly String" "Oy!" gdbm_insert)))
(error "double insert produced no indication"))
- (gdbm-setopt dbf GDBM_SYNCMODE 1)
+ (gdbm-setopt dbf 'syncmode 1)
(let ((content (gdbm-fetch dbf "Silly String")))
(if (not (string=? "Ahoy!" content))
(let ((k (gdbm-firstkey dbf)))
(if k
(error "empty database returned a firstkey:" k)))
- (gdbm-store dbf "AString" "Testing 1 2 3." GDBM_INSERT)
- (gdbm-store dbf "ASecondString" "Testing 1 2 3." GDBM_REPLACE)
- (gdbm-store dbf "AThirdString" "Testing 1 2 3." GDBM_INSERT)
+ (gdbm-store dbf "AString" "Testing 1 2 3." gdbm_insert)
+ (gdbm-store dbf "ASecondString" "Testing 1 2 3." gdbm_replace)
+ (gdbm-store dbf "AThirdString" "Testing 1 2 3." gdbm_insert)
#;
(let ((keys (sort (gdbm-keys dbf) string<?)))
(if (not (equal? keys '("ASecondString" "AString" "AThirdString")))
(gdbm-reorganize dbf)
(gdbm-sync dbf)
- (gdbm-setopt dbf 'SYNCMODE #f)
+ (gdbm-setopt dbf 'syncmode #f)
(gdbm-version)
(gdbm-close dbf))
(if (not (condition?
(ignore-errors
- (lambda () (gdbm-open "notfound.db" 0 GDBM_READER 0)))))
+ (lambda () (gdbm-open "notfound.db" 0 gdbm_reader 0)))))
(error "opened a nonexistent database file:" gdbf))
- (let ((dbf2 (gdbm-open filename.db 0 GDBM_READER 0)))
+ (let ((dbf2 (gdbm-open filename.db 0 gdbm_reader 0)))
(let ((keys (sort (gdbm-keys dbf2) string<?)))
(if (not (equal? keys '("ASecondString" "AString" "AThirdString")))
(error "bogus keys:" keys))
|#
-;;;; The GDBM option.
+;;;; The gdbm option.
;;; package: (gdbm)
(declare (usual-integrations))
(bytevector-length bytes)
(string-length bytes)))
-;; Parameters to gdbm_open for READERS, WRITERS, and WRITERS who can
+;; Parameters to gdbm_open for readers, writers, and writers who can
;; create the database.
-(define GDBM_READER (C-enum "GDBM_READER")) ;A reader.
-(define GDBM_WRITER (C-enum "GDBM_WRITER")) ;A writer.
-(define GDBM_WRCREAT(C-enum "GDBM_WRCREAT")) ;A writer. Create the db if needed.
-(define GDBM_NEWDB (C-enum "GDBM_NEWDB")) ;A writer. Always create a new db.
-(define GDBM_FAST (C-enum "GDBM_FAST")) ;Write fast! => No fsyncs.
+(define gdbm_reader (C-enum "GDBM_READER")) ;A reader.
+(define gdbm_writer (C-enum "GDBM_WRITER")) ;A writer.
+(define gdbm_wrcreat (C-enum "GDBM_WRCREAT")) ;A writer. Create the db if needed.
+(define gdbm_newdb (C-enum "GDBM_NEWDB")) ;A writer. Always create a new db.
+(define gdbm_fast (C-enum "GDBM_FAST")) ;Write fast! => No fsyncs.
(define (gdbm-open filename block-size flags mode)
- (guarantee integer? block-size 'GDBM-OPEN)
- (guarantee integer? mode 'GDBM-OPEN)
+ (guarantee integer? block-size 'gdbm-open)
+ (guarantee integer? mode 'gdbm-open)
(let ((args (make-alien '|gdbm_args|))
(flagsnum (guarantee-gdbm-open-flags flags))
(filename (->namestring (merge-pathnames filename))))
(define (guarantee-gdbm-open-flags flags)
(define (flag->number flag)
(case flag
- ((READER) (C-enum "GDBM_READER"))
- ((WRITER) (C-enum "GDBM_WRITER"))
- ((WRCREAT) (C-enum "GDBM_WRCREAT"))
- ((NEWDB) (C-enum "GDBM_NEWDB"))
- ((FAST) (C-enum "GDBM_FAST"))
- (else (error:wrong-type-argument flags "gdbm-open flags" 'GDBM-OPEN))))
+ ((reader) (C-enum "GDBM_READER"))
+ ((writer) (C-enum "GDBM_WRITER"))
+ ((wrcreat) (C-enum "GDBM_WRCREAT"))
+ ((newdb) (C-enum "GDBM_NEWDB"))
+ ((fast) (C-enum "GDBM_FAST"))
+ (else (error:wrong-type-argument flags "gdbm-open flags" 'gdbm-open))))
(cond ((integer? flags) flags)
((symbol? flags) (flag->number flags))
((list-of-type? flags symbol?)
(reduce + 0 (map flag->number flags)))
- (else (error:wrong-type-argument flags "gdbm-open flags" 'GDBM-OPEN))))
+ (else (error:wrong-type-argument flags "gdbm-open flags" 'gdbm-open))))
(define (gdbm-close gdbf)
- (guarantee-gdbf gdbf 'GDBM-CLOSE)
+ (guarantee-gdbf gdbf 'gdbm-close)
(with-gdbf-locked
gdbf
(lambda ()
;; Parameters to gdbm_store for simple insertion or replacement in the
;; case that the key is already in the database.
-(define GDBM_INSERT (C-enum "GDBM_INSERT")) ;Never replace old data.
-(define GDBM_REPLACE (C-enum "GDBM_REPLACE")) ;Always replace old data.
+(define gdbm_insert (C-enum "GDBM_INSERT")) ;Never replace old data.
+(define gdbm_replace (C-enum "GDBM_REPLACE")) ;Always replace old data.
(define (gdbm-store gdbf key content flag)
- (guarantee-gdbf gdbf 'GDBM-STORE)
- (guarantee-nonnull-string key 'GDBM-STORE)
- (guarantee-nonnull-string content 'GDBM-STORE)
- (let ((flagnum (cond ((= flag GDBM_INSERT) flag)
- ((= flag GDBM_REPLACE) flag)
- ((eq? flag 'INSERT) (C-enum "GDBM_INSERT"))
- ((eq? flag 'REPLACE) (C-enum "GDBM_REPLACE"))
+ (guarantee-gdbf gdbf 'gdbm-store)
+ (guarantee-nonnull-string key 'gdbm-store)
+ (guarantee-nonnull-string content 'gdbm-store)
+ (let ((flagnum (cond ((= flag gdbm_insert) flag)
+ ((= flag gdbm_replace) flag)
+ ((eq? flag 'insert) (C-enum "GDBM_INSERT"))
+ ((eq? flag 'replace) (C-enum "GDBM_REPLACE"))
(else (error:wrong-type-argument flag "gdbm-store flag"
- 'GDBM-STORE)))))
+ 'gdbm-store)))))
(with-gdbf-locked-open
- gdbf 'GDBM-STORE
+ gdbf 'gdbm-store
(lambda (args)
(gdbf-args-put-key! args key)
(gdbf-args-put-content! args content)
(else (gdbm-error gdbf "gdbm_store"))))))))
(define (gdbm-fetch gdbf key)
- (guarantee-gdbf gdbf 'GDBM-FETCH)
- (guarantee-nonnull-string key 'GDBM-FETCH)
+ (guarantee-gdbf gdbf 'gdbm-fetch)
+ (guarantee-nonnull-string key 'gdbm-fetch)
(with-gdbf-locked-open
- gdbf 'GDBM-FETCH
+ gdbf 'gdbm-fetch
(lambda (args)
(gdbf-args-put-key! args key)
(C-call "do_gdbm_fetch" args)
(gdbf-args-get-content args))))
(define (gdbm-exists? gdbf key)
- (guarantee-gdbf gdbf 'GDBM-EXISTS?)
- (guarantee-nonnull-string key 'GDBM-EXISTS?)
+ (guarantee-gdbf gdbf 'gdbm-exists?)
+ (guarantee-nonnull-string key 'gdbm-exists?)
(with-gdbf-locked-open
- gdbf 'GDBM-EXISTS
+ gdbf 'gdbm-exists
(lambda (args)
(gdbf-args-put-key! args key)
(not (zero? (C-call "do_gdbm_exists" args))))))
(define (gdbm-delete gdbf key)
- (guarantee-gdbf gdbf 'GDBM-DELETE)
- (guarantee-nonnull-string key 'GDBM-DELETE)
+ (guarantee-gdbf gdbf 'gdbm-delete)
+ (guarantee-nonnull-string key 'gdbm-delete)
(with-gdbf-locked-open
- gdbf 'GDBM-DELETE
+ gdbf 'gdbm-delete
(lambda (args)
(gdbf-args-put-key! args key)
(zero? (C-call "do_gdbm_delete" (gdbf-args gdbf))))))
(define (gdbm-keys gdbf)
- (guarantee-gdbf gdbf 'GDBM-KEYS)
+ (guarantee-gdbf gdbf 'gdbm-keys)
(with-gdbf-locked-open
- gdbf 'GDBM-KEYS
+ gdbf 'gdbm-keys
(lambda (args)
(C-call "do_gdbm_firstkey" args)
(let ((key (gdbf-args-get-key args)))
keys)))))))
(define (gdbm-firstkey gdbf)
- (guarantee-gdbf gdbf 'GDBM-FIRSTKEY)
+ (guarantee-gdbf gdbf 'gdbm-firstkey)
(with-gdbf-locked-open
- gdbf 'GDBM-FIRSTKEY
+ gdbf 'gdbm-firstkey
(lambda (args)
(C-call "do_gdbm_firstkey" args)
(gdbf-args-get-key args))))
(define (gdbm-nextkey gdbf key)
- ;; Returns #f if KEY is not (or no longer) in the database. Use
+ ;; Returns #f if key is not (or no longer) in the database. Use
;; gdbm-keys to read a complete list despite deletes. Gdbm-keys
;; also avoids copying the keys back for gdbm_nextkey.
- (guarantee-gdbf gdbf 'GDBM-NEXTKEY)
- (guarantee-nonnull-string key 'GDBM-NEXTKEY)
+ (guarantee-gdbf gdbf 'gdbm-nextkey)
+ (guarantee-nonnull-string key 'gdbm-nextkey)
(with-gdbf-locked-open
- gdbf 'GDBM-NEXTKEY
+ gdbf 'gdbm-nextkey
(lambda (args)
(gdbf-args-put-key! args key)
(if (zero? (C-call "do_gdbm_nextkey" args))
#f))))
(define (gdbm-reorganize gdbf)
- (guarantee-gdbf gdbf 'GDBM-REORGANIZE)
+ (guarantee-gdbf gdbf 'gdbm-reorganize)
(with-gdbf-locked-open
- gdbf 'GDBM-REORGANIZE
+ gdbf 'gdbm-reorganize
(lambda (args)
(if (not (zero? (C-call "do_gdbm_reorganize" args)))
(gdbm-error gdbf "gdbm_reorganize")))))
(define (gdbm-sync gdbf)
- (guarantee-gdbf gdbf 'GDBM-SYNC)
+ (guarantee-gdbf gdbf 'gdbm-sync)
(with-gdbf-locked-open
- gdbf 'GDBM-SYNC
+ gdbf 'gdbm-sync
(lambda (args)
(C-call "do_gdbm_sync" args))))
(define (gdbm-strerror errno)
- (guarantee fixnum? errno 'GDBM-STRERROR)
+ (guarantee fixnum? errno 'gdbm-strerror)
(c-peek-cstring (C-call "gdbm_strerror" (make-alien '(* char)) errno)))
(define (strerror errno)
- (guarantee fixnum? errno 'STRERROR)
+ (guarantee fixnum? errno 'strerror)
(c-peek-cstring (C-call "strerror" (make-alien '(* char)) errno)))
;; Parameters to gdbm_setopt, specifing the type of operation to perform.
-(define GDBM_CACHESIZE (C-enum "GDBM_CACHESIZE")) ;Set the cache size.
-(define GDBM_SYNCMODE (C-enum "GDBM_SYNCMODE")) ;Toggle fast mode.
+(define gdbm_cachesize (C-enum "GDBM_CACHESIZE")) ;Set the cache size.
+(define gdbm_syncmode (C-enum "GDBM_SYNCMODE")) ;Toggle fast mode.
(define (gdbm-setopt gdbf opt val)
- (guarantee-gdbf gdbf 'GDBM-SETOPT)
+ (guarantee-gdbf gdbf 'gdbm-setopt)
(let* ((optnum
- (cond ((eq? opt 'SYNCMODE) (C-enum "GDBM_SYNCMODE"))
- ((eq? opt 'CACHESIZE) (C-enum "GDBM_CACHESIZE"))
- ((and (number? opt) (= opt GDBM_SYNCMODE)) opt)
- ((and (number? opt) (= opt GDBM_CACHESIZE)) opt)
- (else (error:wrong-type-argument opt "option" 'GDBM-SETOPT))))
+ (cond ((eq? opt 'syncmode) (C-enum "GDBM_SYNCMODE"))
+ ((eq? opt 'cachesize) (C-enum "GDBM_CACHESIZE"))
+ ((and (number? opt) (= opt gdbm_syncmode)) opt)
+ ((and (number? opt) (= opt gdbm_cachesize)) opt)
+ (else (error:wrong-type-argument opt "option" 'gdbm-setopt))))
(valnum
- (cond ((= optnum GDBM_SYNCMODE)
- (cond ((not val) 0)
+ (cond ((= optnum gdbm_syncmode)
+ (cond ((eq? val #f) 0)
((eq? val #t) 1)
((zero? val) val)
((= val 1) val)
- (else (error:wrong-type-argument val "SYNCMODE boolean"
- 'GDBM-SETOPT))))
- ((= optnum GDBM_CACHESIZE)
- (guarantee integer? val 'GDBM-SETOPT)
+ (else (error:wrong-type-argument val "syncmode"
+ 'gdbm-setopt))))
+ ((= optnum gdbm_cachesize)
+ (guarantee integer? val 'gdbm-setopt)
val))))
(with-gdbf-locked-open
- gdbf 'GDBM-SETOPT
+ gdbf 'gdbm-setopt
(lambda (args)
(if (not (zero? (C-call "do_gdbm_setopt" args optnum valnum)))
(gdbm-error gdbf "gdbm_setopt"))))))
\f
(define-structure (gdbf (constructor make-gdbf)
(print-procedure
- (standard-print-method 'GDBF
+ (standard-print-method 'gdbf
(lambda (gdbf)
(list (gdbf-filename gdbf))))))
;; Note that communicating through this malloced-per-GDBM_FILE