steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gdbm: switch back to simpler error handling scheme

db4
Dmitry Shubin 2010-06-26 22:06:35 +04:00
parent cb361af8b4
commit 09dbdaae77
2 changed files with 37 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
extra/gdbm/ffi/ffi.factor
View File

@ -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 ) ;

75
extra/gdbm/gdbm.factor
View File

@ -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 ;
<PRIVATE
: error-table ( -- table )
{
{ 0 gdbm-no-error }
{ 1 gdbm-malloc-error }
{ 2 gdbm-block-size-error }
{ 3 gdbm-file-open-error }
{ 4 gdbm-file-write-error }
{ 5 gdbm-file-seek-error }
{ 6 gdbm-file-read-error }
{ 7 gdbm-bad-magic-number }
{ 8 gdbm-empty-database }
{ 9 gdbm-cant-be-reader }
{ 10 gdbm-cant-be-writer }
{ 11 gdbm-reader-cant-delete }
{ 12 gdbm-reader-cant-store }
{ 13 gdbm-reader-cant-reorganize }
{ 14 gdbm-unknown-update }
{ 15 gdbm-item-not-found }
{ 16 gdbm-reorganize-failed }
{ 17 gdbm-cannot-replace }
{ 18 gdbm-illegal-data }
{ 19 gdbm-option-already-set }
{ 20 gdbm-illegal-option }
} >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 ;
<PRIVATE
:: (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-setopt ( option value -- )
over GDBM_CACHESIZE = [ >c-bool ] unless (gdbm-setopt) ;