From 09dbdaae7703e925c085829b4fbef21b85331930 Mon Sep 17 00:00:00 2001 From: Dmitry Shubin Date: Sat, 26 Jun 2010 22:06:35 +0400 Subject: [PATCH] gdbm: switch back to simpler error handling scheme --- extra/gdbm/ffi/ffi.factor | 28 +++++++++++++-- extra/gdbm/gdbm.factor | 75 +++++++-------------------------------- 2 files changed, 37 insertions(+), 66 deletions(-) diff --git a/extra/gdbm/ffi/ffi.factor b/extra/gdbm/ffi/ffi.factor index 142e2ae2f7..382315b4fe 100644 --- a/extra/gdbm/ffi/ffi.factor +++ b/extra/gdbm/ffi/ffi.factor @@ -50,7 +50,29 @@ FUNCTION: int gdbm_exists ( GDBM_FILE dbf, datum key ) ; FUNCTION: int gdbm_setopt ( GDBM_FILE dbf, int option, int* value, int size ) ; FUNCTION: int gdbm_fdesc ( GDBM_FILE dbf ) ; -TYPEDEF: int gdbm_error -C-GLOBAL: gdbm_error gdbm_errno +ENUM: gdbm-error + gdbm-no-error + gdbm-malloc-error + gdbm-block-size-error + gdbm-file-open-error + gdbm-file-write-error + gdbm-file-seek-error + gdbm-file-read-error + gdbm-bad-magic-number + gdbm-empty-database + gdbm-cant-be-reader + gdbm-cant-be-writer + gdbm-reader-cant-delete + gdbm-reader-cant-store + gdbm-reader-cant-reorganize + gdbm-unknown-update + gdbm-item-not-found + gdbm-reorganize-failed + gdbm-cannot-replace + gdbm-illegal-data + gdbm-option-already-set + gdbm-illegal-option ; -FUNCTION: c-string gdbm_strerror ( gdbm_error errno ) ; +C-GLOBAL: gdbm-error gdbm_errno + +FUNCTION: c-string gdbm_strerror ( gdbm-error errno ) ; diff --git a/extra/gdbm/gdbm.factor b/extra/gdbm/gdbm.factor index 2f052a3872..bc3ac33d8b 100644 --- a/extra/gdbm/gdbm.factor +++ b/extra/gdbm/gdbm.factor @@ -1,9 +1,8 @@ ! Copyright (C) 2010 Dmitry Shubin. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors alien.c-types alien.data alien.destructors assocs -biassocs classes.struct combinators destructors gdbm.ffi io.backend -kernel libc literals locals math namespaces sequences serialize -strings ; +USING: accessors alien.c-types alien.data alien.destructors +classes.struct combinators destructors gdbm.ffi io.backend kernel libc +literals locals math namespaces sequences serialize strings ; IN: gdbm TUPLE: gdbm @@ -12,59 +11,13 @@ TUPLE: gdbm { flags integer initial: $ GDBM_WRCREAT } { mode integer initial: OCT: 644 } ; -SINGLETONS: - gdbm-no-error gdbm-malloc-error - gdbm-block-size-error gdbm-file-open-error - gdbm-file-write-error gdbm-file-seek-error - gdbm-file-read-error gdbm-bad-magic-number - gdbm-empty-database gdbm-cant-be-reader - gdbm-cant-be-writer gdbm-reader-cant-delete - gdbm-reader-cant-store gdbm-reader-cant-reorganize - gdbm-unknown-update gdbm-item-not-found - gdbm-reorganize-failed gdbm-cannot-replace - gdbm-illegal-data gdbm-option-already-set - gdbm-illegal-option ; - -ERROR: gdbm-unknown-error error ; - biassoc ; - -: error>code ( error -- code ) - dup error-table value-at [ ] [ gdbm-unknown-error ] ?if ; - -: code>error ( code -- error ) error-table at ; - -: gdbm-throw ( -- * ) gdbm_errno code>error throw ; +: gdbm-throw ( -- * ) gdbm_errno throw ; : check-error ( ret -- ) 0 = [ gdbm-throw ] unless ; - SYMBOL: current-dbf : dbf ( -- dbf ) current-dbf get ; @@ -91,10 +44,17 @@ DESTRUCTOR: gdbm-close gdbm_store check-error ] with-destructors ; +:: (gdbm-setopt) ( option value -- ) + [ + int heap-size dup malloc &free :> ( size ptr ) + value ptr 0 int set-alien-value + dbf option ptr size gdbm_setopt check-error + ] with-destructors ; + PRIVATE> -: gdbm-error-message ( error -- msg ) error>code gdbm_strerror ; +ALIAS: gdbm-error-message gdbm_strerror : gdbm-replace ( key content -- ) GDBM_REPLACE gdbm-store ; : gdbm-insert ( key content -- ) GDBM_INSERT gdbm-store ; @@ -126,17 +86,6 @@ PRIVATE> [ dbf swap object>datum gdbm_exists c-bool> ] with-destructors ; - ( size ptr ) - value ptr 0 int set-alien-value - dbf option ptr size gdbm_setopt check-error - ] with-destructors ; - -PRIVATE> - : gdbm-setopt ( option value -- ) over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ;