rev 377 - in trunk: include/prothon modules/File modules/OS modules/Prosist modules/Re modules/SQLite modules/dbm src
SVN User <[email protected]> Sat, 17 Apr 2004 19:50:36 -0400
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: mark
Date: 2004-04-17 19:50:32 -0400 (Sat, 17 Apr 2004)
New Revision: 377
Modified:
trunk/include/prothon/prothon.h
trunk/modules/File/File.c
trunk/modules/OS/OS.c
trunk/modules/Prosist/Prosist.c
trunk/modules/Re/Re.c
trunk/modules/SQLite/SQLite.c
trunk/modules/dbm/DBM.c
trunk/modules/dbm/dbm.vcproj
trunk/src/builtins-core.c
trunk/src/builtins-list.c
trunk/src/builtins-string.c
trunk/src/builtins-thread.c
trunk/src/console.c
trunk/src/init.pth
trunk/src/interp.c
trunk/src/main.c
trunk/src/memory_mgr.c
trunk/src/object.c
trunk/src/symbol.c
trunk/src/sys.c
Log:
DBM module added and builds in windows, not tested
Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/include/prothon/prothon.h 2004-04-17 23:50:32 UTC (rev 377)
@@ -568,6 +568,21 @@
obj_p new_string_n_obj(isp ist, char* string, size_t n);
#define NEW_STRINGN(string, n) new_string_n_obj(ist, string, n)
+// PR_STRPTR: macro to retreive string object as a C string
+// warning, string objects may contain null chars so C string result may be short
+// This corresponds to dptr member of apr_datum_t.
+#define pr_strptr(str_obj) \
+( !(str_obj) ? NULL : \
+ (str_obj)->data_type == DATA_TYPE_IMMDATA ? (str_obj)->data.str : \
+ ((str_obj)->data_type == DATA_TYPE_DATAPTR ? ((pr_str_p)((str_obj)->data.ptr))->str : NULL) )
+
+// PR_STRLEN: macro to retreive string length of a string object
+// warning, string objects may contain null chars that this length ignores
+// This corresponds to dsize member of apr_datum_t.
+#define pr_strlen(str_obj) \
+ ( ((str_obj)->data_type == DATA_TYPE_IMMDATA) ? (size_t)((str_obj)->imm_data_len) : \
+ (((str_obj)->data_type == DATA_TYPE_DATAPTR) ? ((pr_str_p)((str_obj)->data.ptr))->len : 0 ) )
+
// NEW_LIST_OBJ: Create a new list object with a given initial size
obj_p new_list_obj(isp ist, size_t initial_size);
#define NEW_LIST(size) new_list_obj(ist, size)
@@ -802,35 +817,43 @@
// xxx_PARAM: Convenience macro for validation and assignment of params
// index is 1..n where 1 is first parameter and n is last
-#define INT_32_PARAM(index, var) \
+#define INT_32_PARAM(index, var) /* int var; */ \
if (!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(INT_PROTO))) { \
raise_exception(ist, OBJ(TYPE_EXC), \
"expected a integer in parameter " #index); \
return NULL; \
} \
(var) = (int) parms[((index)-1)*2+1]->data.i64
-#define INT_64_PARAM(index, var) \
+#define INT_64_PARAM(index, var) /* i64_t var; */ \
if (!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(INT_PROTO))) { \
raise_exception(ist, OBJ(TYPE_EXC), \
"expected a integer in parameter " #index); \
return NULL; \
} \
(var) = parms[((index)-1)*2+1]->data.i64
-#define FLOAT__PARAM(index, var) \
+#define FLOAT__PARAM(index, var) /* double var; */ \
if (!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(FLOAT_PROTO))) { \
raise_exception(ist, OBJ(TYPE_EXC), \
"expected a float in parameter " #index); \
return NULL; \
} \
(var) = parms[((index)-1)*2+1]->data.f64
-#define STRING_PARAM(index, var) \
+#define STRING_PARAM(index, var) /* char* var; */ \
if (!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(STRING_PROTO))) { \
raise_exception(ist, OBJ(TYPE_EXC), \
"expected a string in parameter " #index); \
return NULL; \
} \
- (var) = strch(parms[((index)-1)*2+1])
-#define SEQ_NS_PARAM(index, var) \
+ (var) = pr_strptr(parms[((index)-1)*2+1])
+#define STRBIN_PARAM(index, var) /* apr_datum_t var; */ \
+ if (!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(STRING_PROTO))) { \
+ raise_exception(ist, OBJ(TYPE_EXC), \
+ "expected a string in parameter " #index); \
+ return NULL; \
+ } \
+ (var).dptr = pr_strptr(parms[((index)-1)*2+1]); \
+ (var).dsize = pr_strlen(parms[((index)-1)*2+1]);
+#define SEQ_NS_PARAM(index, var) /* obj_p var; */ \
if ( has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(STRING_PROTO)) || \
!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(SEQ_PROTO))) { \
raise_exception(ist, OBJ(TYPE_EXC), \
@@ -838,10 +861,10 @@
return NULL; \
} \
(var) = parms[((index)-1)*2+1]
-#define SEQ_OR_PARAM(index, var) \
+#define SEQ_OR_PARAM(index, var) /* obj_p var; */ \
if ( has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(STRING_PROTO)) || \
!has_proto_QUES(ist, parms[((index)-1)*2+1], OBJ(SEQ_PROTO))) { \
- list = NEW_LIST(1); \
+ list = NEW_LIST(1); \
list_append(ist, list, parms[((index)-1)*2+1]); \
(var) = list; \
} else \
@@ -894,7 +917,7 @@
// AS_STR: Call __str__ function on any object
// Get C string representation of any object by calling __str__ function on it.
-#define as_str(ist, obj) strch(call_func0((ist), (obj), SYM(__STR__)))
+#define as_str(ist, obj) pr_strptr(call_func0((ist), (obj), SYM(__STR__)))
// COVERS: Macro to determine if a type can be coerced to another type
// Returns true if data type of o1 can represent all data that type of o2 can
@@ -958,20 +981,7 @@
( (obj)->data_type == DATA_TYPE_IMMDATA ? &((obj)->data) : \
( (obj)->data_type == DATA_TYPE_DATAPTR ? (obj)->data.ptr : NULL ) ) )
-// STRCH: macro to retreive string object as a C string
-// warning, string objects may contain null chars so C string result may be short
-#define strch(str_obj) \
-( !(str_obj) ? NULL : \
- (str_obj)->data_type == DATA_TYPE_IMMDATA ? (str_obj)->data.str : \
- ((str_obj)->data_type == DATA_TYPE_DATAPTR ? ((pr_str_p)((str_obj)->data.ptr))->str : NULL) )
-// pr_strlen: macro to retreive string length of a string object
-// warning, string objects may contain null chars that this length ignores
-#define pr_strlen(str_obj) \
- ( ((str_obj)->data_type == DATA_TYPE_IMMDATA) ? (size_t)((str_obj)->imm_data_len) : \
- (((str_obj)->data_type == DATA_TYPE_DATAPTR) ? ((pr_str_p)((str_obj)->data.ptr))->len : 0 ) )
-
-
//************************** OBJECT LOCKING ***********************************
// Prothon allows multiple threads to run at once and even multiple interpreters.
// Data is shared at the object level. There is only one set of objects that
Modified: trunk/modules/File/File.c
===================================================================
--- trunk/modules/File/File.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/File/File.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -611,7 +611,7 @@
return NULL;
}
if (has_proto_QUES(ist, parms[1], OBJ(STRING_PROTO))) {
- str = strch(parms[1]);
+ str = pr_strptr(parms[1]);
size = pr_strlen(parms[1]);
aprerr = apr_file_write(STREAM(self), str, &size);
if (aprerr != APR_SUCCESS) {
@@ -627,7 +627,7 @@
raise_exception(ist, OBJ(TYPE_EXC), "file writeLines lst item must be a string");
return NULL;
}
- str = strch(item);
+ str = pr_strptr(item);
size = pr_strlen(item);
aprerr = apr_file_write(STREAM(self), str, &size);
if (aprerr != APR_SUCCESS) {
Modified: trunk/modules/OS/OS.c
===================================================================
--- trunk/modules/OS/OS.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/OS/OS.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -74,7 +74,7 @@
set_obj_doc(ist->exception_obj, "object is not of type string");
return NULL;
}
- return NEW_INT(system(strch(parms[1])));
+ return NEW_INT(system(pr_strptr(parms[1])));
}
MAIN_MODULE_INIT(OS)
Modified: trunk/modules/Prosist/Prosist.c
===================================================================
--- trunk/modules/Prosist/Prosist.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/Prosist/Prosist.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -136,7 +136,7 @@
dbdata_p dbdatap;
CHECK_TYPE_EXC(parms[1], OBJ(STRING_PROTO), "string");
- filename = strch(parms[1]);
+ filename = pr_strptr(parms[1]);
root_obj = parms[3];
if (parms[5] == OBJ(PR_TRUE)) overwrite = TRUE;
Modified: trunk/modules/Re/Re.c
===================================================================
--- trunk/modules/Re/Re.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/Re/Re.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -404,7 +404,7 @@
set_attr(ist, match_obj, sym(ist, "lastindex"), lastindex_obj);
arr[0] = 0; arr[1] = match_obj;
if (!repl_is_func)
- repl = strch(parms[1]);
+ repl = pr_strptr(parms[1]);
m = pr_malloc((ngrps+1)*sizeof(regmatch_t));
m[0].rm_so = -1; m[0].rm_eo = 0;
last_split = 0;
@@ -453,7 +453,7 @@
raise_exception(ist, OBJ(TYPE_EXC), "repl callback function must return a string");
return NULL;
}
- repl = strch(repl_obj);
+ repl = pr_strptr(repl_obj);
}
}
p1 = repl;
@@ -558,7 +558,7 @@
s_lim = s + size;
p2 = s;
orig_s_obj = get_attr(ist, self, sym(ist, "string")); if_exc_return NULL;
- orig_s = strch(orig_s_obj);
+ orig_s = pr_strptr(orig_s_obj);
if (unescape(ist, self, orig_s, &p1, &p2, &s, &s_lim)) return NULL;
res = NEW_STRING(s);
pr_free(s);
@@ -593,7 +593,7 @@
}
}
orig_s_obj = get_attr(ist, self, sym(ist, "string")); if_exc_return NULL;
- orig_s = strch(orig_s_obj);
+ orig_s = pr_strptr(orig_s_obj);
if (!parms[3] || !(llen = (int)list_len(ist, parms[3]))) {
j = (int)(parms[1]->data.i64);
sp = (int)(list_item(ist, self, j*2 )->data.i64);
@@ -620,7 +620,7 @@
char* orig_s;
obj_p orig_s_obj, res = new_tuple_obj(ist, ngrps);
orig_s_obj = get_attr(ist, self, sym(ist, "string")); if_exc_return NULL;
- orig_s = strch(orig_s_obj);
+ orig_s = pr_strptr(orig_s_obj);
for (i=0; i < ngrps; i++) {
sp = (int)(list_item(ist, self, i*2 )->data.i64);
ep = (int)(list_item(ist, self, i*2+1)->data.i64);
Modified: trunk/modules/SQLite/SQLite.c
===================================================================
--- trunk/modules/SQLite/SQLite.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/SQLite/SQLite.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -105,7 +105,7 @@
obj_p conn_obj;
char *filename, *errmsg=NULL;
CHECK_TYPE_EXC(parms[1], OBJ(STRING_PROTO), "string");
- filename = strch(parms[1]);
+ filename = pr_strptr(parms[1]);
conn_obj = NEW_OBJ(Connection_OBJ);
set_obj_doc(conn_obj, "SQLite connection");
conn_obj->unclonable = TRUE;
@@ -189,7 +189,7 @@
char *sql, *errmsg=NULL;
CHECK_TYPE_EXC(parms[1], OBJ(STRING_PROTO), "string");
- sql = strch(parms[1]);
+ sql = pr_strptr(parms[1]);
if (parms[3] != OBJ(NONE)) {
raise_exception(ist, Error_OBJ, "parameters not implemented yet");
return NULL;
Modified: trunk/modules/dbm/DBM.c
===================================================================
--- trunk/modules/dbm/DBM.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/dbm/DBM.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -54,12 +54,27 @@
#include <prothon/prothon_dll.h>
+#include <apr_strings.h>
#include <apr_dbm.h>
+typedef apr_dbm_t* apr_dbm_p;
+
+#define IF_APR_DBM_ERR(db, msg1) \
+ if (aprerr != APR_SUCCESS){ \
+ char *msg2, buf[256], errbuf[256]; \
+ msg2 = apr_dbm_geterror((db), NULL, errbuf, sizeof(errbuf)); \
+ apr_snprintf(buf, sizeof(buf), "dbm error in %s: %s", (msg1), msg2);\
+ return NULL; \
+ }
+
MODULE_DECLARE(DBM);
MODULE_DECLARE(DB);
+MODULE_DECLARE(DBM_Exc);
-MODULE_CONSTANT_DECLARE(DBM, READONLY);
+MODULE_CONSTANT_DECLARE(DBM, READONLY );
+MODULE_CONSTANT_DECLARE(DBM, READWRITE);
+MODULE_CONSTANT_DECLARE(DBM, RWCREATE );
+MODULE_CONSTANT_DECLARE(DBM, RWTRUNC );
MODULE_START(DBM)
{
@@ -75,80 +90,199 @@
MODULE_ADD_TO_OBJ(DB, DBM_OBJ, "DB");
DBM_OBJ->unclonable = TRUE;
- MODULE_CONSTANT_INT(DBM, READONLY, APR_DBM_READONLY);
+ DBM_Exc_OBJ = NEW_OBJ(NULL);
+ set_obj_doc(DBM_Exc_OBJ, "DBM DB error");
+ set_obj_id(DBM_Exc_OBJ, DBM, DBMError);
+ MODULE_ADD_TO_OBJ(DBM_Exc, DBM_OBJ, "DBMError");
+ DBM_OBJ->unclonable = TRUE;
+
+ MODULE_CONSTANT_INT(DBM, READONLY, APR_DBM_READONLY ); // read-only access
+ MODULE_CONSTANT_INT(DBM, READWRITE, APR_DBM_READWRITE); // read-write access
+ MODULE_CONSTANT_INT(DBM, RWCREATE, APR_DBM_RWCREATE ); // r/w, create if needed
+ MODULE_CONSTANT_INT(DBM, RWTRUNC, APR_DBM_RWTRUNC ); // r/w, truncate if already there
}
-DEF(DB, __init__, FPARM4( filename, NULL,
- mode, DBM_READONLY,
- dbtype, new_string_obj(ist, "SDBM"),
- access, NEW_INT(-1) ) ) {
-// apr_status_t aprerr;
- char *filename, *dbtype;
- int mode, access;
+DEF( DB, __init__, FPARM4( name, NULL,
+ mode, DBM_RWCREATE,
+ type, NEW_STRING("SDBM"),
+ uperm, NEW_INT(APR_UREAD|APR_UWRITE) ) ) {
+ apr_status_t aprerr;
+ apr_dbm_p db;
+ apr_pool_t* cntxt;
+ char *name, *type;
+ int mode, uperm;
- STRING_PARAM(1, filename);
+ STRING_PARAM(1, name);
INT_32_PARAM(2, mode);
- STRING_PARAM(3, dbtype);
- INT_32_PARAM(4, access);
-/*
-apr_status_t apr_dbm_open_ex ( apr_dbm_t ** dbm,
- const char * type,
- const char * name,
- apr_int32_t mode,
- apr_fileperms_t perm,
- apr_pool_t * cntxt
- )
-
- Open a dbm file by file name and type of DBM
+ STRING_PARAM(3, type);
+ INT_32_PARAM(4, uperm);
-Parameters:
-dbm The newly opened database
-type The type of the DBM (not all may be available at run time)
- GDBM for GDBM files
- SDBM for SDBM files
- DB for berkeley DB files
- NDBM for NDBM files
- default for the default DBM type
-
-
-name The dbm file name to open
-mode The flag value
- APR_DBM_READONLY open for read-only access
- APR_DBM_READWRITE open for read-write access
- APR_DBM_RWCREATE open for r/w, create if needed
- APR_DBM_RWTRUNC open for r/w, truncate if already there
-
-
-perm Permissions to apply to if created
-cntxt The pool to use when creating the dbm
- */
+ aprerr = apr_pool_create(&cntxt, get_pr_head_pool());
+ IF_APR_ERR("out of memory opening dbm database") return NULL;
+
+ aprerr = apr_dbm_open_ex(&db, type, name, mode, uperm, cntxt);
+ IF_APR_ERR("opening dbm database") return NULL;
+
+ set_attr(ist, self, sym(ist, "name"), parms[1]);
+ set_attr(ist, self, sym(ist, "mode"), parms[3]);
+ set_attr(ist, self, sym(ist, "type"), parms[5]);
+ set_attr(ist, self, sym(ist, "uperm"), parms[7]);
+
+ self->data_type = DATA_TYPE_DATAPTR;
+ self->data.ptr = db;
+
+ return OBJ(NONE);
+}
+
+DEF(DB, close, NULL) {
+ apr_dbm_p db = self->data.ptr;
+ if (db) apr_dbm_close(db);
+ self->data.ptr = NULL;
return self;
}
+DEF(DB, closed_QUES, NULL) {
+ apr_dbm_p db = self->data.ptr;
+ if (db) return OBJ(PR_FALSE);
+ else return OBJ(PR_TRUE);
+}
-MAIN_MODULE_INIT(DBM) {
- MODULE_SUB_INIT(DBM);
+DEF(DB, fetch, FPARM1(key, NULL)) {
+ apr_status_t aprerr;
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key, value;
- MODULE_ADD_SYM(DB, __init__);
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "fetching from closed dbm database"); return NULL; }
+ STRBIN_PARAM(1, key);
+
+ aprerr = apr_dbm_fetch (db, key, &value);
+ IF_APR_DBM_ERR(db, "fetch(key)");
+
+ return NEW_STRINGN(value.dptr, value.dsize);
}
+DEF(DB, store, FPARM2(key, NULL, value, NULL)) {
+ apr_status_t aprerr;
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key, value;
-/*
-*apr_status_t apr_dbm_open_ex (apr_dbm_t **dbm, const char *type, const char *name, apr_int32_t mode, apr_fileperms_t perm, apr_pool_t *cntxt)
-apr_status_t apr_dbm_open (apr_dbm_t **dbm, const char *name, apr_int32_t mode, apr_fileperms_t perm, apr_pool_t *cntxt)
-void apr_dbm_close (apr_dbm_t *dbm)
-apr_status_t apr_dbm_fetch (apr_dbm_t *dbm, apr_datum_t key, apr_datum_t *pvalue)
-apr_status_t apr_dbm_store (apr_dbm_t *dbm, apr_datum_t key, apr_datum_t value)
-apr_status_t apr_dbm_delete (apr_dbm_t *dbm, apr_datum_t key)
-int apr_dbm_exists (apr_dbm_t *dbm, apr_datum_t key)
-apr_status_t apr_dbm_firstkey (apr_dbm_t *dbm, apr_datum_t *pkey)
-apr_status_t apr_dbm_nextkey (apr_dbm_t *dbm, apr_datum_t *pkey)
-void apr_dbm_freedatum (apr_dbm_t *dbm, apr_datum_t data)
-char * apr_dbm_geterror (apr_dbm_t *dbm, int *errcode, char *errbuf, apr_size_t errbufsize)
-apr_status_t apr_dbm_get_usednames_ex (apr_pool_t *pool, const char *type, const char *pathname, const char **used1, const char **used2)
-void apr_dbm_get_usednames (apr_pool_t *pool, const char *pathname, const char **used1, const char **used2)
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "storing to closed dbm database"); return NULL; }
-*/
+ STRBIN_PARAM(1, key);
+ STRBIN_PARAM(2, value);
+ aprerr = apr_dbm_store (db, key, value);
+ IF_APR_DBM_ERR(db, "store(key,value)");
+ return parms[3];
+}
+
+DEF(DB, delete, FPARM1(key, NULL)) {
+ apr_status_t aprerr;
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key;
+
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "deleting key from closed dbm database"); return NULL; }
+
+ STRBIN_PARAM(1, key);
+
+ aprerr = apr_dbm_delete(db, key);
+ IF_APR_DBM_ERR(db, "delete(key)");
+
+ return parms[1];
+}
+
+DEF(DB, exists_QUES, FPARM1(key, NULL)) {
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key;
+
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "exists?(key) on closed dbm database"); return NULL; }
+
+ STRBIN_PARAM(1, key);
+
+ if (apr_dbm_exists(db, key)) return OBJ(PR_TRUE);
+ else return OBJ(PR_FALSE);
+}
+
+DEF(DB, firstKey, NULL) {
+ apr_status_t aprerr;
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key;
+
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "firstKey() on closed dbm database"); return NULL; }
+
+ aprerr = apr_dbm_firstkey(db, &key);
+ IF_APR_DBM_ERR(db, "firstKey()");
+
+ return NEW_STRINGN(key.dptr, key.dsize);
+}
+
+DEF(DB, nextKey, FPARM1(key, NULL)) {
+ apr_status_t aprerr;
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t key;
+
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "nextKey(key) on closed dbm database"); return NULL; }
+
+ STRBIN_PARAM(1, key);
+
+ aprerr = apr_dbm_nextkey(db, &key);
+ IF_APR_DBM_ERR(db, "nextKey(key)");
+ return NEW_STRINGN(key.dptr, key.dsize);
+}
+
+DEF(DB, freeDatum, FPARM1(data, NULL)) {
+ apr_dbm_p db = self->data.ptr;
+ apr_datum_t data;
+
+ if (!db) { raise_exception(ist, DBM_Exc_OBJ, "nextKey(key) on closed dbm database"); return NULL; }
+ STRBIN_PARAM(1, data);
+ apr_dbm_freedatum(db, data);
+ return parms[1];
+}
+DEF( DB, getUsedNames, FPARM2( name, NULL,
+ type, NEW_STRING("SDBM") ) ) {
+ apr_status_t aprerr;
+ apr_pool_t* pool;
+ obj_p res;
+ char *name, *type, *used1, *used2;
+
+ STRING_PARAM(1, name);
+ STRING_PARAM(2, type);
+
+ aprerr = apr_pool_create(&pool, get_pr_head_pool());
+ IF_APR_ERR("out of memory in getUsedNames()") return NULL;
+
+ aprerr = apr_dbm_get_usednames_ex(pool, type, name, &used1, &used2);
+ IF_APR_ERR("get_usednames() in dbm") return NULL;
+
+ res = NEW_LIST(2);
+ list_append(ist, res, NEW_STRING(used1));
+ // apr_free(used1); XXX how do I free these?
+ if (used2) {
+ list_append(ist, res, NEW_STRING(used2));
+ // apr_free(used2); XXX how do I free these?
+ } else
+ list_append(ist, res, OBJ(NONE));
+ set_immutable(res);
+ switch_proto(ist, res, OBJ(TUPLE_PROTO));
+ return res;
+}
+
+MAIN_MODULE_INIT(DBM) {
+ MODULE_SUB_INIT(DBM);
+ MODULE_ADD_SYM(DB, __init__);
+ MODULE_ADD_SYM(DB, close);
+ MODULE_ADD_SYM(DB, closed_QUES);
+ MODULE_ADD_SYM(DB, fetch);
+ MODULE_ADD_SYM(DB, store);
+ MODULE_ADD_SYM(DB, delete);
+ MODULE_ADD_SYM(DB, exists_QUES);
+ MODULE_ADD_SYM(DB, firstKey);
+ MODULE_ADD_SYM(DB, nextKey);
+ MODULE_ADD_SYM(DB, freeDatum);
+ MODULE_ADD_SYM(DB, getUsedNames);
+}
+
+
Modified: trunk/modules/dbm/dbm.vcproj
===================================================================
--- trunk/modules/dbm/dbm.vcproj 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/modules/dbm/dbm.vcproj 2004-04-17 23:50:32 UTC (rev 377)
@@ -33,11 +33,11 @@
Name="VCCustomBuildTool"/>
<Tool
Name="VCLinkerTool"
- AdditionalDependencies="apr.lib wsock32.lib"
+ AdditionalDependencies="apr.lib aprutil.lib wsock32.lib"
OutputFile="$(OutDir)/dbm.dll"
LinkIncremental="2"
- AdditionalLibraryDirectories="C:\prothon\apr\apr\LibR"
- IgnoreDefaultLibraryNames=""
+ AdditionalLibraryDirectories="C:\prothon\apr\apr\LibR;C:\prothon\apr\apr-util\LibR"
+ IgnoreDefaultLibraryNames="LIBCMTD.LIB"
GenerateDebugInformation="TRUE"
ProgramDatabaseFile="$(OutDir)/dbm.pdb"
SubSystem="2"
Modified: trunk/src/builtins-core.c
===================================================================
--- trunk/src/builtins-core.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/builtins-core.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -246,7 +246,7 @@
DEF(Object, __str__, NULL) {
char str[1024];
obj_p doc = get_attr(ist, self, SYM(__DOC__));
- char* p = strch(doc);
+ char* p = pr_strptr(doc);
if (doc)
apr_snprintf(str, sizeof(str), "<Object:%lx:%s>", (unsigned long)(uintptr_t)self, p);
else
@@ -528,7 +528,7 @@
if (seq_type == SEQ_TYPE_STRING) {
self_len = (int) pr_strlen(self);
- self_str = strch(self);
+ self_str = pr_strptr(self);
} else
self_len = (int) list_len(ist, self);
slice_item1 = list_item(ist, slice,0);
Modified: trunk/src/builtins-list.c
===================================================================
--- trunk/src/builtins-list.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/builtins-list.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -68,14 +68,14 @@
static int seq_len(isp ist, obj_p seq) {
if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO)))
- return (int) strlen(strch(seq));
+ return (int) strlen(pr_strptr(seq));
else return (int) list_len(ist, seq);
}
static obj_p seq_item(isp ist, obj_p seq, int i) {
char s[2];
if (has_proto_QUES(ist, seq, OBJ(STRING_PROTO))) {
- s[0] = strch(seq)[i];
+ s[0] = pr_strptr(seq)[i];
s[1] = 0;
return NEW_STRING(s);
} else
Modified: trunk/src/builtins-string.c
===================================================================
--- trunk/src/builtins-string.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/builtins-string.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -143,7 +143,7 @@
DEF(String, __hash__, NULL) {
i32_t res = 0x9a7c5e3;
char *p;
- for(p=strch(self); *p; p++) res += 131 * (*p);
+ for(p=pr_strptr(self); *p; p++) res += 131 * (*p);
return new_hash_obj(ist, res);
}
@@ -173,7 +173,7 @@
raise_exception(ist, OBJ(TYPE_EXC), "Cannot compare a string and non-string");
return NULL;
}
- return NEW_INT(strcmp(strch(self), strch(other)));
+ return NEW_INT(strcmp(pr_strptr(self), pr_strptr(other)));
}
DEF(String, __add__, FORM_RPARAM){
@@ -187,14 +187,14 @@
if (tlen < IMMEDIATE_DATA_LEN) {
obj->data_type = DATA_TYPE_IMMDATA;
obj->imm_data_len = (int) tlen;
- memcpy(&(obj->data.str[0]), strch(self), slen);
- memcpy(&(obj->data.str[slen]), strch(other), olen);
+ memcpy(&(obj->data.str[0]), pr_strptr(self), slen);
+ memcpy(&(obj->data.str[slen]), pr_strptr(other), olen);
obj->data.str[tlen] = 0;
} else {
obj_str = obj_malloc(obj, sizeof(pr_str_t)+tlen+1);
obj_str->len = tlen;
- memcpy(&(obj_str->str[0]), strch(self), slen);
- memcpy(&(obj_str->str[slen]), strch(other), olen);
+ memcpy(&(obj_str->str[0]), pr_strptr(self), slen);
+ memcpy(&(obj_str->str[slen]), pr_strptr(other), olen);
obj_str->str[tlen] = 0;
}
obj->immutable = TRUE;
@@ -218,7 +218,7 @@
obj->data_type = DATA_TYPE_IMMDATA;
obj->imm_data_len = (int) tlen;
for(i=0; i < times; i++)
- memcpy(obj->data.str+i*len, strch(self), len);
+ memcpy(obj->data.str+i*len, pr_strptr(self), len);
obj->data.str[tlen] = 0;
} else {
obj_str = obj_malloc(obj, sizeof(pr_str_t)+tlen+1);
@@ -228,7 +228,7 @@
}
obj_str->len = tlen;
for(i=0; i < times; i++)
- memcpy(obj_str->str+i*len, strch(self), len);
+ memcpy(obj_str->str+i*len, pr_strptr(self), len);
obj_str->str[tlen] = 0;
}
obj->immutable = TRUE;
@@ -240,7 +240,7 @@
obj_p res, argv_obj = parms[1];
size_t i, argc;
pr_arg_p argv;
- char *fmt_str = strch(self), *buf;
+ char *fmt_str = pr_strptr(self), *buf;
apr_status_t aprerr;
if ( has_proto_QUES(ist, argv_obj, OBJ(STRING_PROTO)) ||
@@ -259,7 +259,7 @@
argv[i].arg.f64 = arg_obj->data.f64;
argv[i].type = ARG_TYPE_FLOAT;
} else if (has_proto_QUES(ist, arg_obj, OBJ(STRING_PROTO))) {
- argv[i].arg.str = strch(arg_obj);
+ argv[i].arg.str = pr_strptr(arg_obj);
argv[i].type = ARG_TYPE_STRING;
} else {
raise_exception(ist, OBJ(TYPE_EXC), "invalid type for string (%) format");
@@ -281,13 +281,13 @@
DEF(String, __iter__, NULL) {
obj_p gen_obj = NEW_OBJ(StringGen_OBJ);
gen_obj->data_type = DATA_TYPE_DATAPTR;
- gen_obj->data.ptr = strch(self);
+ gen_obj->data.ptr = pr_strptr(self);
set_attr(ist, gen_obj, sym(ist, "saved_string"), self);
return gen_obj;
}
DEF(String, ord, NULL) {
- return NEW_INT((int)(*strch(self)));
+ return NEW_INT((int)(*pr_strptr(self)));
}
DEF(String, join, FORM_RPARAM) {
@@ -304,7 +304,7 @@
llen = (int) list_len(ist, parms[1]);
if (!llen) return NEW_STRING("");
str_list = NEW_LIST(llen);
- self_str = strch(self);
+ self_str = pr_strptr(self);
self_len = pr_strlen(self);
tlen = 0;
for (i=0; i < llen; i++) {
@@ -330,7 +330,7 @@
for(i=0, ofs=0; i < llen; i++) {
obj_p str_obj = list_item(ist, str_list, i);
size_t str_len = pr_strlen(str_obj);
- memcpy(dest_ptr+ofs, strch(str_obj), str_len);
+ memcpy(dest_ptr+ofs, pr_strptr(str_obj), str_len);
ofs += str_len;
if (i != llen-1) {
memcpy(dest_ptr+ofs, self_str, self_len);
@@ -346,14 +346,14 @@
DEF(String, __in__QUES, FORM_RPARAM) {
if (!has_proto_QUES(ist, parms[1], String_OBJ))
return call_func1(ist, parms[1], SYM(__RIN__QUES), self);
- if (strstr(strch(parms[1]), strch(self))) return OBJ(PR_TRUE);
+ if (strstr(pr_strptr(parms[1]), pr_strptr(self))) return OBJ(PR_TRUE);
else return OBJ(PR_FALSE);
}
DEF(String, __notIn__QUES, FORM_RPARAM) {
if (!has_proto_QUES(ist, parms[1], String_OBJ))
return call_func1(ist, parms[1], SYM(__RNOTIN__QUES), self);
- if (strstr(strch(parms[1]), strch(self))) return OBJ(PR_FALSE);
+ if (strstr(pr_strptr(parms[1]), pr_strptr(self))) return OBJ(PR_FALSE);
else return OBJ(PR_TRUE);
}
@@ -385,7 +385,7 @@
obj_p res = NULL;
char* res_str;
wrlock_rtrn(self) NULL;
- if ((ch = *strch(self))) {
+ if ((ch = *pr_strptr(self))) {
self->data.ptr = (i64_t *)(((char*)self->data.ptr) + 1);
res = NEW_OBJ(String_OBJ);
res_str = (char*)obj_malloc(res, 2);
Modified: trunk/src/builtins-thread.c
===================================================================
--- trunk/src/builtins-thread.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/builtins-thread.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -246,7 +246,7 @@
obj_p name_obj;
char name[80];
if ((name_obj = get_attr(ist, self, sym(ist, "name"))))
- apr_snprintf(name, sizeof(name), "<Thread:%s>", strch(name_obj));
+ apr_snprintf(name, sizeof(name), "<Thread:%s>", pr_strptr(name_obj));
else
apr_snprintf(name, sizeof(name), "<Thread:%lx>", (unsigned long)(uintptr_t)self);
return NEW_STRING(name);
Modified: trunk/src/console.c
===================================================================
--- trunk/src/console.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/console.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -89,14 +89,14 @@
obj_p prompt;
if (!sys) sys = get_attr(ist, OBJ(OBJECT), sym(ist, "Sys"));
prompt = get_attr(ist, sys, sym(ist, "ps1"));
- return strch(prompt);
+ return pr_strptr(prompt);
}
char* ps2(isp ist){
obj_p prompt;
if (!sys) sys = get_attr(ist, OBJ(OBJECT), sym(ist, "Sys"));
prompt = get_attr(ist, sys, sym(ist, "ps2"));
- return strch(prompt);
+ return pr_strptr(prompt);
}
int get_src(isp ist) {
Modified: trunk/src/init.pth
===================================================================
--- trunk/src/init.pth 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/init.pth 2004-04-17 23:50:32 UTC (rev 377)
@@ -10,6 +10,7 @@
c:\prothon\modules\prosist\debug
c:\prothon\modules\SQLite\debug
c:\prothon\modules\OS\debug
+c:\prothon\modules\DBM\debug
# this is executed before Main1 as module PthMod1
Modified: trunk/src/interp.c
===================================================================
--- trunk/src/interp.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/interp.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -480,13 +480,13 @@
for (i = 0; i < llen; i++) {
apr_snprintf(full_path, sizeof(full_path), "%s/%s/__init__.pr",
- strch(list_item(ist, path_list, i)),
+ pr_strptr(list_item(ist, path_list, i)),
symch(ist, fr_data(pkg_depth)));
if (apr_stat(&finfo, full_path, APR_FINFO_TYPE, get_pr_head_pool()) ==
APR_SUCCESS && finfo.filetype == APR_REG) {
apr_snprintf(pkg_path, sizeof(pkg_path), "%s/%s",
- strch(list_item(ist, path_list, i)),
+ pr_strptr(list_item(ist, path_list, i)),
symch(ist, fr_data(pkg_depth)));
if (alias && pkg_depth < param-1)
@@ -557,7 +557,7 @@
alias = module_symbol;
for (i = 0; i < llen; i++) {
- apr_cpystrn(full_path, strch(list_item(ist, path_list, i)),
+ apr_cpystrn(full_path, pr_strptr(list_item(ist, path_list, i)),
sizeof(full_path));
if (load_dll_module(ist, full_path, module_name, dest_module, alias))
@@ -576,7 +576,7 @@
} else {
for(i = 0; i < llen; i++) {
apr_snprintf(full_path, sizeof(full_path), "%s/%s.pr",
- strch(list_item(ist, path_list, i)),
+ pr_strptr(list_item(ist, path_list, i)),
module_name);
if (load_module(ist, module_symbol, frame->locals, dest_module,
alias, full_path, ": a module", NULL, NULL ))
@@ -962,7 +962,7 @@
raise_exception(ist, OBJ(TYPE_EXC), "Exec parameter must be a string");
break;
}
- state = parse_file_or_string(ist, NULL, strch(str_obj));
+ state = parse_file_or_string(ist, NULL, pr_strptr(str_obj));
if (!state || !(code = (state->parse_results))) break;
new_frame = create_frame( ist, NULL, frame->self, frame->globals, frame->syn_locals,
frame->dyn_locals, frame->locals, NULL, code );
@@ -1195,7 +1195,7 @@
if (fr_stack[fr_sp+i]) {
obj_p str_obj = call_func0(ist, fr_stack[fr_sp+i], SYM(__STR__));
if (intrp_exobj) break;
- printf("%s ", strch(str_obj));
+ printf("%s ", pr_strptr(str_obj));
} else if (i == param-1) goto endcase;
printf("\n");
} break;
@@ -1391,7 +1391,7 @@
if ((fstk_obj = get_attr(ist, orig_excobj, sym(ist, "frame_stack")))) {
for (i = (int) list_len(ist, fstk_obj) - 3; i >= 0; i -= 3) {
printf( "--- File: %s, line: %"APR_INT64_T_FMT", char: %"APR_INT64_T_FMT"\n",
- strch(list_item(ist, fstk_obj, i )),
+ pr_strptr(list_item(ist, fstk_obj, i )),
*((i64_t *)obj_data_p(list_item(ist, fstk_obj, i+1))),
*((i64_t *)obj_data_p(list_item(ist, fstk_obj, i+2))) );
}
@@ -1405,9 +1405,9 @@
obj_p doc = get_attr(ist, exc, SYM(__DOC__));
if (doc && exc != orig_excobj)
- printf("%s, ", strch(doc));
+ printf("%s, ", pr_strptr(doc));
else if (doc)
- printf("%s.\n\n", strch(doc));
+ printf("%s.\n\n", pr_strptr(doc));
}
}
}
@@ -1532,7 +1532,7 @@
int i, main_index=1;
obj_p main_sym, module, thread_obj;
pr_thread_p thread_p;
- char* filename = strch(list_item(ist, (obj_p)argv, 0));
+ char* filename = pr_strptr(list_item(ist, (obj_p)argv, 0));
#ifdef DEBUG_THREADS
printf("Starting a main thread\n");
Modified: trunk/src/main.c
===================================================================
--- trunk/src/main.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/main.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -125,7 +125,7 @@
sysinit(ist, argv[0], sys_argv_obj);
if ((code_str_obj = get_attr(ist, sys_argv_obj, sym(ist, "code")))) {
- exec_string(ist, strch(code_str_obj), FALSE, NULL);
+ exec_string(ist, pr_strptr(code_str_obj), FALSE, NULL);
check_exceptions(ist);
}
cmd_line_option_i_flg = (int)(intptr_t) get_attr(ist, sys_argv_obj, sym(ist, "i"));
Modified: trunk/src/memory_mgr.c
===================================================================
--- trunk/src/memory_mgr.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/memory_mgr.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -210,7 +210,7 @@
dump(ist, "mm-obj-dump.txt", obj);
pr_exit(1);
printf(" exception: %s\n",
- strch(get_attr(ist, ist->exception_obj, SYM(__DOC__))));
+ pr_strptr(get_attr(ist, ist->exception_obj, SYM(__DOC__))));
ist->exception_obj = 0;
} else if (obj_list) {
int i, llen = (int) list_len(ist, obj_list);
Modified: trunk/src/object.c
===================================================================
--- trunk/src/object.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/object.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -898,7 +898,7 @@
int i;
obj_p doc;
doc = get_attr(ist, obj, SYM(__DOC__));
- if (doc) {fprintf(fout,"obj(%lx) doc: %s\n", (unsigned long)(uintptr_t)obj, strch(doc)); prt_flg = 1;}
+ if (doc) {fprintf(fout,"obj(%lx) doc: %s\n", (unsigned long)(uintptr_t)obj, pr_strptr(doc)); prt_flg = 1;}
else {fprintf(fout,"%s\n",as_str(ist, obj)); prt_flg = 1;}
for(i=0; i < clist_len(object_list); i++)
if (clist_item(object_list, i) == obj)
Modified: trunk/src/symbol.c
===================================================================
--- trunk/src/symbol.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/symbol.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -258,7 +258,7 @@
if (sym_obj) {
s_obj = get_attr(ist, sym_obj, SYM(__STRING__));
if (s_obj) {
- char* tmp = strch(s_obj);
+ char* tmp = pr_strptr(s_obj);
return tmp;
}
}
Modified: trunk/src/sys.c
===================================================================
--- trunk/src/sys.c 2004-04-17 20:51:35 UTC (rev 376)
+++ trunk/src/sys.c 2004-04-17 23:50:32 UTC (rev 377)
@@ -126,7 +126,7 @@
#endif
for(i=0; i < llen; i++) {
- char* item = strch(list_item(ist, list, i));
+ char* item = pr_strptr(list_item(ist, list, i));
if (!strcmp(full_path, item))
return;
}