From: <cli...@li...> - 2007-09-23 19:13:26
|
Send clisp-cvs mailing list submissions to cli...@li... To subscribe or unsubscribe via the World Wide Web, visit https://lists.sourceforge.net/lists/listinfo/clisp-cvs or, via email, send a message with subject or body 'help' to cli...@li... You can reach the person managing the list at cli...@li... When replying, please edit your Subject line so it is more specific than "Re: Contents of clisp-cvs digest..." CLISP CVS commits for today Today's Topics: 1. clisp/modules/dirkey dirkey.c,1.15,1.16 (Sam Steingold) 2. clisp/modules/berkeley-db bdb.c,1.108,1.109 (Sam Steingold) 3. clisp/src .gdbinit,1.42,1.43 (Sam Steingold) 4. clisp/modules/clx/new-clx clx.f,2.68,2.69 (Sam Steingold) 5. clisp/modules/gdbm gdbm.c, 1.13, 1.14 gdbm.lisp, 1.3, 1.4 test.tst, 1.4, 1.5 (onjo) ---------------------------------------------------------------------- Message: 1 Date: Sun, 23 Sep 2007 15:30:31 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/dirkey dirkey.c,1.15,1.16 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/dirkey In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv9766/modules/dirkey Modified Files: dirkey.c Log Message: standardize on "error_..." naming convention Index: dirkey.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/dirkey/dirkey.c,v retrieving revision 1.15 retrieving revision 1.16 diff -u -d -r1.15 -r1.16 --- dirkey.c 14 May 2005 13:45:40 -0000 1.15 +++ dirkey.c 23 Sep 2007 15:30:29 -0000 1.16 @@ -352,7 +352,7 @@ #endif #if defined(ACCESS_LDAP) -nonreturning_function(static, fehler_ldap, +nonreturning_function(static, error_ldap, (object dk, object path, char* errmsg)) { end_system_call(); pushSTACK(NIL); pushSTACK(path); pushSTACK(dk); @@ -360,7 +360,7 @@ STACK_3 = CLSTEXT(errmsg); fehler(error,"~S(~S ~S): ~S"); } -#define LDAP_ERR2STR(d,p,status) fehler_ldap(d,p,ldap_err2string(status)) +#define LDAP_ERR2STR(d,p,status) error_ldap(d,p,ldap_err2string(status)) #define LDAP_RES2STR(d,p,ld,res) LDAP_ERR2STR(d,p,ldap_result2error(ld,res,1)) #endif ------------------------------ Message: 2 Date: Sun, 23 Sep 2007 15:30:31 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/berkeley-db bdb.c,1.108,1.109 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/berkeley-db In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv9766/modules/berkeley-db Modified Files: bdb.c Log Message: standardize on "error_..." naming convention Index: bdb.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/berkeley-db/bdb.c,v retrieving revision 1.108 retrieving revision 1.109 diff -u -d -r1.108 -r1.109 --- bdb.c 23 Sep 2007 04:13:19 -0000 1.108 +++ bdb.c 23 Sep 2007 15:30:28 -0000 1.109 @@ -1,6 +1,6 @@ /* * CLISP: Berkeley-DB <http://www.sleepycat.com/docs/api_c/> - * Copyright (C) 2003-2005 by Sam Steingold + * Copyright (C) 2003-2007 by Sam Steingold */ /* have to undefing UNICODE _here_ because clisp.h will #include <windows.h> */ @@ -177,7 +177,7 @@ ALREADY_ABORTED DELETED LOCK_NOTEXIST NEEDSPLIT REP_EGENCHG \ REP_LOGREADY REP_PAGEDONE SURPRISE_KID SWAPBYTES TIMEOUT TXN_CKP \ VERIFY_FATAL) -nonreturning_function(static, bdb_error, (int status, char *caller)) { +nonreturning_function(static, error_bdb, (int status, char *caller)) { end_system_call(); pushSTACK(`BDB::BDB-ERROR`); /* error type */ pushSTACK(`:CODE`); pushSTACK(bdb_errno_reverse(status)); @@ -266,7 +266,7 @@ int db_error_code; \ begin_system_call(); \ db_error_code = caller args; cleanup \ - if (db_error_code) bdb_error(db_error_code,#caller); \ + if (db_error_code) error_bdb(db_error_code,#caller); \ end_system_call(); \ } while(0) #define SYSCALL(caller,args) SYSCALL1(caller,args,) @@ -389,7 +389,7 @@ STACK_2 = value1; goto host_restart; } - if (status) bdb_error(status,"dbe->set_rpc_server"); + if (status) error_bdb(status,"dbe->set_rpc_server"); } if (!missingp(STACK_4)) /* :PASSWD */ dbe_set_encryption(dbe,&STACK_3,&STACK_4); @@ -839,7 +839,7 @@ status = dbe->get_cachesize(dbe,&gbytes,&bytes,&ncache); end_system_call(); if (status) { - if (errorp) bdb_error(status,"dbe->get_cachesize"); + if (errorp) error_bdb(status,"dbe->get_cachesize"); error_message_reset(); value1 = value2 = NIL; } else cache2lisp (gbytes, bytes, ncache); @@ -885,7 +885,7 @@ status = dbe->get_home(dbe,&home); end_system_call(); if (status) { - if (errorp) bdb_error(status,"dbe->get_home"); + if (errorp) error_bdb(status,"dbe->get_home"); error_message_reset(); return T; } if (home == NULL) return NIL; @@ -900,7 +900,7 @@ status = dbe->get_open_flags(dbe,&flags); end_system_call(); if (status) { - if (errorp) bdb_error(status,"dbe->get_open_flags"); + if (errorp) error_bdb(status,"dbe->get_open_flags"); error_message_reset(); return T; } return check_dbe_open_flags_to_list(flags); @@ -1469,7 +1469,7 @@ case DB_KEYEMPTY: VALUES1(`:KEYEMPTY`); error_message_reset(); return; } } - bdb_error(status,"db->get"); + error_bdb(status,"db->get"); } if (action == DB_SET_RECNO) { pushSTACK(dbt_to_object(&key,key_type,0)); @@ -1679,7 +1679,7 @@ switch (status) { case 0: VALUES0; break; case DB_KEYEXIST: VALUES1(`:KEYEXIST`); error_message_reset(); break; - default: bdb_error(status,"db->put"); + default: error_bdb(status,"db->put"); } break; } @@ -1778,7 +1778,7 @@ end_system_call(); } }); - if (status) bdb_error(status,"db->verify"); + if (status) error_bdb(status,"db->verify"); VALUES0; skipSTACK(3); } @@ -1836,7 +1836,7 @@ status = db->get_open_flags(db,&flags); end_system_call(); if (status) { - if (errorp) bdb_error(status,"db->get_open_flags"); + if (errorp) error_bdb(status,"db->get_open_flags"); error_message_reset(); return T; } return check_db_open_flags_to_list(flags); @@ -1972,7 +1972,7 @@ status = db->get_cachesize(db,&gbytes,&bytes,&ncache); end_system_call(); if (status) { - if (errorp) bdb_error(status,"db->get_cachesize"); + if (errorp) error_bdb(status,"db->get_cachesize"); error_message_reset(); value1 = value2 = NIL; } else cache2lisp (gbytes, bytes, ncache); @@ -1988,7 +1988,7 @@ status = db->get_dbname(db,&fname,&dbname); end_system_call(); if (status) { - if (errorp) bdb_error(status,"db->get_dbname"); + if (errorp) error_bdb(status,"db->get_dbname"); error_message_reset(); value1 = value2 = NIL; } else { @@ -2018,7 +2018,7 @@ status = db->getter(db,&value); \ end_system_call(); \ if (status) { \ - if (errorp) bdb_error(status,"db->" #getter); \ + if (errorp) error_bdb(status,"db->" #getter); \ error_message_reset(); \ return NIL; \ } else \ @@ -2247,7 +2247,7 @@ case DB_KEYEMPTY: VALUES1(`:KEYEMPTY`); error_message_reset(); return; } } - bdb_error(status,"dbc->c_get"); + error_bdb(status,"dbc->c_get"); } if (action == DB_GET_RECNO) { /* the only value is RECNO */ VALUES1(dbt_to_object(&val,val_type,-1)); @@ -2313,7 +2313,7 @@ free(obj.data); if (status) { free(dblock); - bdb_error(status,"dbe->lock_get"); + error_bdb(status,"dbe->lock_get"); } end_system_call(); pushSTACK(allocate_fpointer(dblock)); pushSTACK(STACK_2); @@ -2558,7 +2558,7 @@ case DB_NOTFOUND: VALUES1(`:NOTFOUND`); error_message_reset(); return; } } - bdb_error(status,"logc->get"); + error_bdb(status,"logc->get"); } if (action == DB_SET) { /* STACK_0 is the LSN */ } else STACK_0 = make_lsn(&lsn); @@ -2693,7 +2693,7 @@ status = dbe->txn_recover(dbe,preplist,tx_max,&retnum,flags); if (status) { free(preplist); end_system_call(); - bdb_error(status,"dbe->txn_recover"); + error_bdb(status,"dbe->txn_recover"); } end_system_call(); for (ii=0; ii<retnum; ii++) { ------------------------------ Message: 3 Date: Sun, 23 Sep 2007 15:33:19 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/src .gdbinit,1.42,1.43 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/src In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv10615/src Modified Files: .gdbinit Log Message: standardize on "error_..." naming convention Index: .gdbinit =================================================================== RCS file: /cvsroot/clisp/clisp/src/.gdbinit,v retrieving revision 1.42 retrieving revision 1.43 diff -u -d -r1.42 -r1.43 --- .gdbinit 23 Sep 2007 05:11:12 -0000 1.42 +++ .gdbinit 23 Sep 2007 15:33:16 -0000 1.43 @@ -23,10 +23,10 @@ # -i ../tests/tests -x '(run-test "***/test")' # -i clx/new-clx/demos/clx-demos.lisp -x '(clx-demos:qix)' -x '(clx-demos:koch)' -x '(clx-demos:sokoban)' break my_type_error - break closed_display_error - break bdb_error - break my_gdbm_error - break pcre_error + break error_closed_display + break error_bdb + break error_gdbm + break error_pcre end document full debug the full linking set ------------------------------ Message: 4 Date: Sun, 23 Sep 2007 15:34:58 +0000 From: Sam Steingold <sd...@us...> Subject: clisp/modules/clx/new-clx clx.f,2.68,2.69 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/clx/new-clx In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv11026/modules/clx/new-clx Modified Files: clx.f Log Message: standardize on "error_..." naming convention Index: clx.f =================================================================== RCS file: /cvsroot/clisp/clisp/modules/clx/new-clx/clx.f,v retrieving revision 2.68 retrieving revision 2.69 diff -u -d -r2.68 -r2.69 --- clx.f 13 May 2007 18:25:01 -0000 2.68 +++ clx.f 23 Sep 2007 15:34:55 -0000 2.69 @@ -501,7 +501,7 @@ pushSTACK(type); pushSTACK(datum); pushSTACK(TheSubr(subr_self)->name); fehler (type_error, ("~S: ~S is not of type ~S")); } -nonreturning_function (static, closed_display_error, +nonreturning_function (static, error_closed_display, (object caller, object dpy)) { pushSTACK(`XLIB::CLOSED-DISPLAY`); pushSTACK(`:DISPLAY`); pushSTACK(dpy); @@ -682,7 +682,7 @@ { pushSTACK(dpy); if (!ensure_living_display(&(STACK_0))) - closed_display_error(TheSubr(subr_self)->name,STACK_0); + error_closed_display(TheSubr(subr_self)->name,STACK_0); return TheStructure (popSTACK())->recdata[slot_DISPLAY_HASH_TABLE]; } @@ -691,7 +691,7 @@ static Display *pop_display (void) { if (!ensure_living_display(&(STACK_0))) - closed_display_error(TheSubr(subr_self)->name,STACK_0); + error_closed_display(TheSubr(subr_self)->name,STACK_0); STACK_0 = TheStructure (STACK_0)->recdata[slot_DISPLAY_FOREIGN_POINTER]; return (Display*) TheFpointer(popSTACK())->fp_pointer; } @@ -1634,7 +1634,7 @@ { XID xid = get_uint29 (STACK_0); if (!ensure_living_display (&(STACK_1))) - closed_display_error(TheSubr(subr_self)->name,STACK_1); + error_closed_display(TheSubr(subr_self)->name,STACK_1); VALUES1(make_xid_obj_2 (type, STACK_1, xid, NIL)); skipSTACK(2); } ------------------------------ Message: 5 Date: Sun, 23 Sep 2007 16:53:13 +0000 From: onjo <m_...@us...> Subject: clisp/modules/gdbm gdbm.c, 1.13, 1.14 gdbm.lisp, 1.3, 1.4 test.tst, 1.4, 1.5 To: cli...@li... Message-ID: <E1I...@ma...> Update of /cvsroot/clisp/clisp/modules/gdbm In directory sc8-pr-cvs4.sourceforge.net:/tmp/cvs-serv7950 Modified Files: gdbm.c gdbm.lisp test.tst Log Message: add GDBM:WITH-OPEN-DB macro. GDBM-FETCH, GDBM-DELETE, GDBM-EXISTS: add vector support. GDBM-FIRSTKEY, GDBM-NEXTKEY: new keyword argument :BINARY. Index: gdbm.lisp =================================================================== RCS file: /cvsroot/clisp/clisp/modules/gdbm/gdbm.lisp,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- gdbm.lisp 20 Sep 2007 15:20:35 -0000 1.3 +++ gdbm.lisp 23 Sep 2007 16:53:11 -0000 1.4 @@ -7,7 +7,7 @@ "GDBM - The GNU database manager - <http://www.gnu.org/software/gdbm/>") (:use #:lisp) (:export #:gdbm #:gdbm-version - #:gdbm-open #:gdbm-close #:do-db #:with-db + #:gdbm-open #:gdbm-close #:do-db #:with-open-db #:gdbm-store #:gdbm-fetch #:gdbm-delete #:gdbm-exists #:gdbm-firstkey #:gdbm-nextkey #:gdbm-reorganize #:gdbm-sync #:gdbm-setopt)) @@ -26,10 +26,18 @@ (format stream "~A." (gdbm-error-message condition))))) -(defmacro do-db ((key-var gdbm) &body body) +(defmacro do-db ((key-var gdbm &rest options) &body body) "Iterate over the GDBM keys in LOOP." (let ((db (gensym "DO-DB"))) `(loop :with ,db = ,gdbm - :for ,key-var = (gdbm:gdbm-firstkey ,db) - :then (gdbm:gdbm-nextkey ,db ,key-var) + :for ,key-var = (gdbm:gdbm-firstkey ,db ,@options) + :then (gdbm:gdbm-nextkey ,db ,key-var ,@options) :while ,key-var ,@body))) + +(defmacro with-open-db ((db filename &rest options) &body body) + (multiple-value-bind (body-rest declarations) (system::parse-body body) + `(let ((,db (gdbm-open ,filename ,@options))) + (declare (read-only ,db) ,@declarations) + (unwind-protect (multiple-value-prog1 (progn ,@body-rest) + (when ,db (gdbm-close ,db))) + (when ,db (gdbm-close ,db)))))) \ No newline at end of file Index: test.tst =================================================================== RCS file: /cvsroot/clisp/clisp/modules/gdbm/test.tst,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- test.tst 20 Sep 2007 15:53:21 -0000 1.4 +++ test.tst 23 Sep 2007 16:53:11 -0000 1.5 @@ -27,6 +27,8 @@ (gdbm:gdbm-fetch *db* "key1") "value1" +(gdbm:gdbm-fetch *db* "key1" :binary nil) "value1" + (gdbm:gdbm-store *db* "key1" "value2" :flag :insert) NIL (gdbm:gdbm-fetch *db* "key1") "value1" @@ -35,12 +37,22 @@ (gdbm:gdbm-fetch *db* "key1") "value2" +(gdbm:gdbm-exists *db* #(107 101 121 48)) NIL + +(gdbm:gdbm-exists *db* #(107 101 121 49)) T + +(gdbm:gdbm-fetch *db* #(107 101 121 49)) "value2" + (gdbm:gdbm-store *db* "key1" "value3") T (gdbm:gdbm-fetch *db* "key1") "value3" +(gdbm:gdbm-exists *db* #(107 101 121 50)) NIL + (gdbm:gdbm-store *db* "key2" "test2") T +(gdbm:gdbm-exists *db* #(107 101 121 50)) T + (gdbm:gdbm-fetch *db* "key2") "test2" (gdbm:gdbm-fetch *db* "key2" :binary T) #(116 101 115 116 50) @@ -85,4 +97,21 @@ (gdbm:gdbm-close *db*) T +(gdbm:gdbm-close *db*) NIL + +(gdbm:with-open-db (db "test.db" :read-write :reader) + (gdbm:do-db (key db) + :summing (length (gdbm:gdbm-fetch db key :binary t)))) 4001 + +(gdbm:with-open-db (db "test.db" :read-write :writer) + (gdbm:gdbm-store db #(0 0 0 0) #(1 1 1 1)) + (gdbm:do-db (key db :binary t) + :summing (length (gdbm:gdbm-fetch db key :binary t)))) 4005 + +(gdbm:with-open-db (db "test.db" :read-write :reader) + (show (gdbm:gdbm-fetch db #(0 0 0 0) :binary t))) #(1 1 1 1) + +(gdbm:with-open-db (db "test.db" :read-write :reader) + (type-of (gdbm:gdbm-fetch db #(0 0 0 0) :binary t))) (simple-array (unsigned-byte 8) (4)) + (pathnamep (delete-file "test.db")) T Index: gdbm.c =================================================================== RCS file: /cvsroot/clisp/clisp/modules/gdbm/gdbm.c,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- gdbm.c 23 Sep 2007 15:30:29 -0000 1.13 +++ gdbm.c 23 Sep 2007 16:53:11 -0000 1.14 @@ -97,6 +97,22 @@ skipSTACK(1); } +#define with_gdbm_key(key_obj, var, statement) \ + if (stringp(key_obj)) { \ + with_string_0(key_obj, GLO(foreign_encoding), var, statement); \ + } else if (vectorp(key_obj)) { \ + char* var; int var##_len; \ + if (!bit_vector_p(Atype_8Bit,key_obj)) { \ + pushSTACK(key_obj); pushSTACK(GLO(type_uint8_vector)); \ + funcall(L(coerce),2); \ + if (!bit_vector_p(Atype_8Bit,value1)) { NOTREACHED; } \ + key_obj = value1; \ + } \ + var = &TheSbvector(key_obj)->data[0]; var##_len = vector_length(key_obj); \ + statement; \ + } else NOTREACHED; + + DEFCHECKER(gdbm_store_flag, prefix=GDBM, REPLACE INSERT); DEFUN(GDBM:GDBM-STORE, dbf key content &key FLAG) { @@ -120,29 +136,21 @@ binary_p = 1; } - if (dbf && stringp(key_obj) && (string_p || binary_p)) { - with_string_0(key_obj, GLO(foreign_encoding), ks, { - key.dptr = ks; - key.dsize = ks_len; - if (binary_p) { - content.dptr = (char*)&TheSbvector(array)->data[0]; - content.dsize = vector_length(array); - if (dbf) { - VALUES_IF(!gdbm_store(dbf, key, content, flag)); - } else { - VALUES1(NIL); - } - } else { - with_string_0(content_obj, GLO(foreign_encoding), cs, { - content.dptr = cs; - content.dsize = cs_len; - if (dbf) { - VALUES_IF(!gdbm_store(dbf, key, content, flag)); - } else { - VALUES1(NIL); - } - }); - } + if (dbf && (string_p || binary_p)) { + with_gdbm_key(key_obj, ks, { + key.dptr = ks; + key.dsize = ks_len; + if (binary_p) { + content.dptr = (char*)&TheSbvector(array)->data[0]; + content.dsize = vector_length(array); + VALUES_IF(!gdbm_store(dbf, key, content, flag)); + } else { + with_string_0(content_obj, GLO(foreign_encoding), cs, { + content.dptr = cs; + content.dsize = cs_len; + VALUES_IF(!gdbm_store(dbf, key, content, flag)); + }); + } }); } else { VALUES1(NIL); @@ -155,33 +163,29 @@ object binary = popSTACK(); int binary_p = !missingp(binary); object key_obj = popSTACK(); - datum key; + datum key, ret; skipSTACK(1); /* drop dbf */ - if (dbf && stringp(key_obj)) { - with_string_0(key_obj, GLO(foreign_encoding), ks, { - key.dptr = ks; - key.dsize = ks_len; - if (dbf) { - datum ret = gdbm_fetch(dbf, key); - if (ret.dptr == NULL) { - VALUES1(NIL); - } else { - if (!binary_p) { - VALUES1(n_char_to_string(ret.dptr, ret.dsize, - GLO(foreign_encoding))); - } else { - object vector = allocate_bit_vector(Atype_8Bit,ret.dsize); - int i = 0; - for (i=0;i<ret.dsize;i++) - TheSbvector(vector)->data[i] = ret.dptr[i]; - VALUES1(vector); - } - free(ret.dptr); - } - } else { - VALUES1(NIL); - } + if (dbf) { + with_gdbm_key(key_obj, ks, { + key.dptr = ks; + key.dsize = ks_len; + ret = gdbm_fetch(dbf, key); + if (ret.dptr == NULL) { + VALUES1(NIL); + } else { + if (!binary_p) { + VALUES1(n_char_to_string(ret.dptr, ret.dsize, + GLO(foreign_encoding))); + } else { + object vector = allocate_bit_vector(Atype_8Bit,ret.dsize); + int i = 0; + for (i=0;i<ret.dsize;i++) + TheSbvector(vector)->data[i] = ret.dptr[i]; + VALUES1(vector); + } + free(ret.dptr); + } }); } else { VALUES1(NIL); @@ -195,19 +199,15 @@ datum key; skipSTACK(1); /* drop dbf */ - if (dbf && stringp(key_obj)) { - with_string_0(key_obj, GLO(foreign_encoding), ks, { - key.dptr = ks; - key.dsize = ks_len; - if (dbf) { - if (gdbm_delete(dbf, key) == -1) { - VALUES1(NIL); - } else { - VALUES1(T); - } - } else { - VALUES1(NIL); - } + if (dbf) { + with_gdbm_key(key_obj, ks, { + key.dptr = ks; + key.dsize = ks_len; + if (gdbm_delete(dbf, key) == -1) { + VALUES1(NIL); + } else { + VALUES1(T); + } }); } else { VALUES1(NIL); @@ -216,42 +216,49 @@ /* convert datum to Lisp string and release memory in datum can trigger GC */ -static object datum_to_object (datum d) { +static object datum_to_object (datum d, int binary) { if (d.dptr == NULL) return NIL; - else { + else if (binary==0) { object o = n_char_to_string(d.dptr, d.dsize, GLO(foreign_encoding)); free(d.dptr); return o; + } else { + object o = allocate_bit_vector(Atype_8Bit,d.dsize); + int i = 0; + for (i=0;i<d.dsize;i++) + TheSbvector(o)->data[i] = d.dptr[i]; + free(d.dptr); + return o; } } -DEFUN(GDBM:GDBM-FIRSTKEY, dbf) +DEFUN(GDBM:GDBM-FIRSTKEY, dbf &key BINARY) { - GDBM_FILE dbf = check_gdbm(popSTACK()); + int binary_p = !missingp(STACK_0); + GDBM_FILE dbf = check_gdbm(STACK_1); + + skipSTACK(2); if (dbf) { - VALUES1(datum_to_object(gdbm_firstkey(dbf))); + VALUES1(datum_to_object(gdbm_firstkey(dbf),binary_p)); } else { VALUES1(NIL); } } -DEFUN(GDBM:GDBM-NEXTKEY, dbf key) +DEFUN(GDBM:GDBM-NEXTKEY, dbf key &key BINARY) { - GDBM_FILE dbf = check_gdbm(STACK_1); - object key_obj = popSTACK(); + int binary_p = !missingp(STACK_0); + object key_obj = STACK_1; + GDBM_FILE dbf = check_gdbm(STACK_2); datum key; - skipSTACK(1); /* drop dbf */ + skipSTACK(3); /* drop dbf */ - if (dbf && stringp(key_obj)) { - with_string_0(key_obj, GLO(foreign_encoding), ks, { + if (dbf) { + with_gdbm_key(key_obj, ks, { key.dptr = ks; key.dsize = ks_len; - if (dbf) { - VALUES1(datum_to_object(gdbm_nextkey(dbf, key))); - } else { - VALUES1(NIL); - } + VALUES1(datum_to_object(gdbm_nextkey(dbf, key),binary_p)); }); } else { VALUES1(NIL); @@ -294,19 +301,15 @@ datum key; skipSTACK(1); /* drop dbf */ - if (dbf && stringp(key_obj)) { - with_string_0(key_obj, GLO(foreign_encoding), ks, { - key.dptr = ks; - key.dsize = ks_len; - if (dbf) { - if (gdbm_exists(dbf, key)) { - VALUES1(T); - } else { - VALUES1(NIL); - } - } else { - VALUES1(NIL); - } + if (dbf) { + with_gdbm_key(key_obj, ks, { + key.dptr = ks; + key.dsize = ks_len; + if (gdbm_exists(dbf, key)) { + VALUES1(T); + } else { + VALUES1(NIL); + } }); } else { VALUES1(NIL); ------------------------------ ------------------------------------------------------------------------- This SF.net email is sponsored by: Microsoft Defy all challenges. Microsoft(R) Visual Studio 2005. http://clk.atdmt.com/MRT/go/vse0120000070mrt/direct/01/ ------------------------------ _______________________________________________ clisp-cvs mailing list cli...@li... https://lists.sourceforge.net/lists/listinfo/clisp-cvs End of clisp-cvs Digest, Vol 17, Issue 13 ***************************************** |
From: Sam S. <sd...@gn...> - 2007-09-24 00:44:30
|
> + if (dbf && (string_p || binary_p)) { > + with_gdbm_key(key_obj, ks, { > + key.dptr = ks; > + key.dsize = ks_len; > + if (binary_p) { > + content.dptr = (char*)&TheSbvector(array)->data[0]; > + content.dsize = vector_length(array); > + VALUES_IF(!gdbm_store(dbf, key, content, flag)); > + } else { > + with_string_0(content_obj, GLO(foreign_encoding), cs, { > + content.dptr = cs; > + content.dsize = cs_len; > + VALUES_IF(!gdbm_store(dbf, key, content, flag)); > + }); > + } why not use with_gdbm_key() for content_obj too? > + if (dbf) { > + with_gdbm_key(key_obj, ks, { > + key.dptr = ks; > + key.dsize = ks_len; > + ret = gdbm_fetch(dbf, key); > + if (ret.dptr == NULL) { > + VALUES1(NIL); > + } else { > + if (!binary_p) { > + VALUES1(n_char_to_string(ret.dptr, ret.dsize, > + GLO(foreign_encoding))); > + } else { > + object vector = allocate_bit_vector(Atype_8Bit,ret.dsize); > + int i = 0; > + for (i=0;i<ret.dsize;i++) > + TheSbvector(vector)->data[i] = ret.dptr[i]; > + VALUES1(vector); > + } > + free(ret.dptr); > + } why not use here datum_to_object()? |
From: Masayuki O. <mas...@gm...> - 2007-09-24 02:53:04
|
Hi, Sam. [...] > why not use with_gdbm_key() for content_obj too? [...] > why not use here datum_to_object()? It's *very* nice code!! I perceive a lack of imagination. :-) Thanks. -- Masayuki Onjo |
From: Sam S. <sd...@gn...> - 2007-09-24 14:26:45
|
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1 Hi Masayuki, Masayuki Onjo wrote: >> why not use with_gdbm_key() for content_obj too? >> why not use here datum_to_object()? > > It's *very* nice code!! thank you! OK, now you need to replace :BINARY argument with :TYPE argument which can be 'STRING, 'VECTOR, 'INTEGER, 'SINGLE-FLOAT or 'DOUBLE-FLOAT. you will need to change datum_to_object and with_datum but nothing else. the GDBM structure, in addition to the GDBM_FILE pointer, should also contain the path and the default :TYPE for conversion. Sam. -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.6 (GNU/Linux) Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org iD8DBQFG98kbPp1Qsf2qnMcRAq/8AJ4tAx5FNyAvy9+19SPHcjQHuygyUQCgj1rF 3VDz+wKEiML4QT1MzrnuTV0= =rzlf -----END PGP SIGNATURE----- |