rev 394 - in trunk: bin include/prothon modules/Prosist modules/Re src
SVN User <[email protected]> Mon, 19 Apr 2004 15:09:17 -0400
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: mark
Date: 2004-04-19 15:09:14 -0400 (Mon, 19 Apr 2004)
New Revision: 394
Modified:
trunk/bin/rel.bat
trunk/include/prothon/prothon.h
trunk/include/prothon/prothon_dll.h
trunk/modules/Prosist/Prosist.c
trunk/modules/Re/Re.c
trunk/src/builtins-core.c
trunk/src/builtins-dict.c
trunk/src/builtins-tuple.c
trunk/src/dict.h
trunk/src/interp.c
trunk/src/object.c
trunk/src/object.h
trunk/src/parser.h
trunk/src/parser_routines.c
trunk/src/prothon.y
trunk/src/symbol.c
trunk/src/sys.c
Log:
made major changes to symbol handling, evertyhing compiles
and runs in Visual Studio in win32, cannot run outside
of dev system in win32, get weird
"Program too big to fit in memory" message from old
msdos days???
Modified: trunk/bin/rel.bat
===================================================================
--- trunk/bin/rel.bat 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/bin/rel.bat 2004-04-19 19:09:14 UTC (rev 394)
@@ -8,21 +8,21 @@
rmdir win32release
mkdir win32release\Prothon\pr
-copy src\win32release\prothon.exe win32release\Prothon
+copy src\release\prothon.exe win32release\Prothon
-copy modules\DBM\win32release\DBM.dll win32release\Prothon
-copy modules\File\win32release\File.dll win32release\Prothon
-copy modules\OS\win32release\OS.dll win32release\Prothon
-rem copy modules\Prosist\win32release\Prosist.dll win32release\Prothon
-copy modules\Re\win32release\Re.dll win32release\Prothon
-copy modules\SQLite\win32release\SQLite.dll win32release\Prothon
+copy modules\DBM\release\DBM.dll win32release\Prothon
+copy modules\File\release\File.dll win32release\Prothon
+copy modules\OS\release\OS.dll win32release\Prothon
+rem copy modules\Prosist\release\Prosist.dll win32release\Prothon
+copy modules\Re\release\Re.dll win32release\Prothon
+copy modules\SQLite\release\SQLite.dll win32release\Prothon
-copy bin\rel.pth win32release\Prothon
-copy bin\msvcr71.dll win32release\Prothon
+copy bin\rel.pth win32release\Prothon
+copy bin\msvcr71.dll win32release\Prothon
-copy readme.txt win32release\Prothon
-copy changes.txt win32release\Prothon
-copy LICENSE win32release\Prothon\LICENSE.txt
+copy readme.txt win32release\Prothon
+copy changes.txt win32release\Prothon
+copy LICENSE win32release\Prothon\LICENSE.txt
-copy pr\*.pr win32release\Prothon\pr
+copy pr\*.pr win32release\Prothon\pr
Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/include/prothon/prothon.h 2004-04-19 19:09:14 UTC (rev 394)
@@ -60,8 +60,8 @@
//#define DEBUG_THREADS
//#define DEBUG_MEM_MGR
//#define TRACE_PARSER
-//#define DUMP_MODULE_CODE
-//#define TRACE_INTERPRETER
+#define DUMP_MODULE_CODE
+#define TRACE_INTERPRETER
//#define DUMP_OBJECTS_AT_END
//*****************************************************************************
@@ -477,6 +477,14 @@
// If no attr is found to delete it returns FALSE, else TRUE.
int del_attr(isp ist, obj_p obj, obj_p key);
+// ATTR_xxx: functions to scan attribute table
+// key is the unique integer assigned to each symbol by the symbol table
+// you can use key_to_symstr(key) to find the symbol string for an attribute
+attr_key_t attr_first_key(isp ist, obj_p obj);
+attr_key_t attr_next_key(isp ist, obj_p obj, attr_key_t key);
+obj_p attr_value_by_key(isp ist, obj_p obj, attr_key_t key);
+char* key_to_symstr(isp ist, attr_key_t key);
+
// INS_PROTO: Insert an object in the list of proto objects.
// This is the immediate protos for an object, not the reachable.
// Pos == 0 means head of list and pos >= len means append at end.
@@ -540,9 +548,9 @@
// SYM: Create (or access an existing) symbol object from a C string.
// Symbols are not garbage collected as they are automatically
-// added to the OBJ(SYMBOLS) dictionary with a string object
+// added to the OBJ(SYMBOLS) dictionary with a int object (key code)
// as the key and the symbol as the value. No two symbols have the
-// same string value.
+// same int key code value.
// A Prothon variable such as "x" in x=1 is a symbol.
obj_p sym(isp ist, char* symbol_string);
@@ -587,6 +595,28 @@
obj_p new_list_obj(isp ist, size_t initial_size);
#define NEW_LIST(size) new_list_obj(ist, size)
+// NEW_TUPLE_OBJ: Create a new immutable tuple object
+// A tuple is identical to a list except that at the Prothon level it is
+// immutable. At the C level this means that you should not modify it
+// once you have given it away to other code. It is implemented the same
+// way as a list so all the list functions will work on a tuple.
+// This creation function actually calls NEW_LIST() and changes the
+// proto to TUPLE_PROTO. After calling this you should set all the data
+// items with list_append() before releasing the object to other code.
+obj_p new_tuple_obj(isp ist, int fixed_size);
+#define NEW_TUPLE(fixed_size) new_tuple_obj(ist, fixed_size)
+
+// NEW_DICT_OBJ: Create a new dictionary object
+// A dictionary stores objects much like the attributes are stored except that
+// any immutable object can be the key, not just a symbol. Lookups are more
+// expensive since hashes are used and an __eq__QUES call must be made during the
+// lookup unlike attributes that just use the key identity for comparisom.
+// Make sure the initial size is at least twice as large as the intended number
+// of objects you will be adding initially. Expanding a dictionary is an expensive
+// operation.
+obj_p new_dict_obj(isp ist, int initial_size);
+#define NEW_DICT(initial_size) new_dict_obj(ist, initial_size);
+
// CLONE_LIST_OBJ: Create a new list object that's a shallow copy of another
obj_p copy_list_obj(isp ist, obj_p list_obj);
@@ -615,26 +645,6 @@
obj_p list8(isp ist, obj_p item1, obj_p item2, obj_p item3, obj_p item4,
obj_p item5, obj_p item6, obj_p item7, obj_p item8 );
-// NEW_TUPLE_OBJ: Create a new immutable tuple object
-// A tuple is identical to a list except that at the Prothon level it is
-// immutable. At the C level this means that you should not modify it
-// once you have given it away to other code. It is implemented the same
-// way as a list so all the list functions will work on a tuple.
-// This creation function actually calls NEW_LIST() and changes the
-// proto to TUPLE_PROTO. After calling this you should set all the data
-// items with list_append() before releasing the object to other code.
-obj_p new_tuple_obj(isp ist, int fixed_size);
-
-// NEW_DICT_OBJ: Create a new dictionary object
-// A dictionary stores objects much like the attributes are stored except that
-// any immutable object can be the key, not just a symbol. Lookups are more
-// expensive since hashes are used and an __eq__QUES call must be made during the
-// lookup unlike attributes that just use the key identity for comparisom.
-// Make sure the initial size is at least twice as large as the intended number
-// of objects you will be adding initially. Expanding a dictionary is an expensive
-// operation.
-obj_p new_dict_obj(isp ist, int initial_size);
-
// DICT_ADD: Add a key/value pair to the dictionary. Replace old one if key exists.
// Key equality is determined by the __eq__QUES function on the key objects. The __eq__QUES
// function is called on the existing key in the dict with the passed key as the parameter.
@@ -681,7 +691,7 @@
// HASH_MASK: Maximum value for any hash function to return.
// Minimum value is 1.
-#define HASH_MASK 0x7fffffff;
+#define HASH_MASK 0x7fffffff
// HASH_VALUE: Integer value of a hash object returned by __hash__ function.
#define hash_value(hash_obj) (hash_obj->data.i32[0])
@@ -1039,6 +1049,20 @@
void set_immutable(obj_p obj);
void clr_immutable(obj_p obj);
+//************************** UNCLONABLE BIT ***********************************
+// Each object has a bit called unclonable. This bit tells the interpreter
+// that the object represents a real-world object such as a file, or it
+// represents a time-dependent object such as a mutex lock. When this bit
+// is set, then the copy() function in Object knows that this object should
+// never be copied. Systems that store objects such as the Prosist persistance
+// storage database also use this bit as an indicator that this object should
+// not be stored. Some objects such as prototypes also set this bit if they
+// don't want more than one copy of themself around (this is similar to a
+// singleton in a class-based system).
+void set_unclonable(obj_p obj);
+void clr_unclonable(obj_p obj);
+int is_unclonable(obj_p obj);
+
//************************** DELETE LOCKING ***********************************
// The garbage collection process in the memory manager will delete any object
// that isn't recursively contained in the root globals container. This means
Modified: trunk/include/prothon/prothon_dll.h
===================================================================
--- trunk/include/prothon/prothon_dll.h 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/include/prothon/prothon_dll.h 2004-04-19 19:09:14 UTC (rev 394)
@@ -103,6 +103,16 @@
void (*set_obj_doc_f)(isp ist, obj_p obj, char* str);
obj_p (*dict_keys_values)(isp ist, obj_p dict_obj, int key_flg);
obj_p (*check_exceptions)(isp ist);
+ attr_key_t (*attr_first_key)(isp ist, obj_p obj);
+ attr_key_t (*attr_next_key)(isp ist, obj_p obj, attr_key_t key);
+ obj_p (*attr_value_by_key)(isp ist, obj_p obj, attr_key_t key);
+ int (*dict_add)(isp ist, obj_p dict_obj, obj_p key_in, obj_p value_in);
+ obj_p (*dict_item)(isp ist, obj_p dict_obj, obj_p key_in);
+ int (*is_unclonable)(obj_p obj);
+ char* (*key_to_symstr)(isp ist, attr_key_t key);
+ obj_p (*new_dict_obj)(isp ist, int initial_size);
+ int (*proto_len)(isp ist, obj_p obj);
+ obj_p (*proto_item)(isp ist, obj_p obj, int i);
void* (*pr_malloc)(size_t nbytes);
void* (*pr_realloc)(void *p, size_t nbytes);
@@ -112,9 +122,9 @@
void* (*obj_realloc)(isp ist, obj_p obj, size_t size);
void (*obj_free) (isp ist, obj_p obj);
- int (*read_lock)(isp ist, obj_p obj);
+ int (*read_lock)(isp ist, obj_p obj);
void (*read_unlock)(isp ist, obj_p obj);
- int (*write_lock)(isp ist, obj_p obj);
+ int (*write_lock)(isp ist, obj_p obj);
void (*write_unlock)(isp ist, obj_p obj);
void (*del_lock)(obj_p obj);
@@ -265,6 +275,16 @@
#define set_obj_wracc (*services->set_obj_wracc)
#define get_obj_rdacc (*services->get_obj_rdacc)
#define get_obj_wracc (*services->get_obj_wracc)
+#define attr_first_key (*services->attr_first_key)
+#define attr_next_key (*services->attr_next_key)
+#define attr_value_by_key (*services->attr_value_by_key)
+#define dict_add (*services->dict_add)
+#define dict_item (*services->dict_item)
+#define is_unclonable (*services->is_unclonable)
+#define key_to_symstr (*services->key_to_symstr)
+#define new_dict_obj (*services->new_dict_obj)
+#define proto_len (*services->proto_len)
+#define proto_item (*services->proto_item)
#endif // OBJECT_H
Modified: trunk/modules/Prosist/Prosist.c
===================================================================
--- trunk/modules/Prosist/Prosist.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/modules/Prosist/Prosist.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -55,11 +55,25 @@
#include <prothon/prothon_dll.h>
+#include <apr_strings.h>
#include <apr_dbm.h>
+#define INITIAL_OBJ_COUNT 32
+
typedef apr_dbm_t* apr_dbm_p;
+typedef struct {
+ apr_dbm_p db;
+ obj_p root;
+ i32_t nextid;
+ obj_p id_to_idobj;
+ obj_p idobj_to_id;
+ obj_p id_to_obj;
+ obj_p obj_to_id;
+} dbrec_t;
+typedef dbrec_t* dbrec_p;
+
MODULE_DECLARE(Prosist);
MODULE_DECLARE(DB);
MODULE_DECLARE(ProsistExc);
@@ -69,7 +83,185 @@
MODULE_CONSTANT_DECLARE(Prosist, RWCREATE );
MODULE_CONSTANT_DECLARE(Prosist, RWTRUNCATE );
+#define BUF_BLOCK_SIZE 1024
+#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);\
+ }if (aprerr != APR_SUCCESS)
+
+#define ADD_CHR(c) \
+{if (idx == buf_size) { \
+ buf_size += BUF_BLOCK_SIZE; \
+ buf = pr_realloc(buf, buf_size); \
+} (buf[idx++] = (c)); }
+
+#define ADD_NUM(num) \
+ if ((n = apr_snprintf(buf+idx, buf_size-idx, "%d", (num))) == (buf_size-idx)) { \
+ buf_size += BUF_BLOCK_SIZE; \
+ buf = pr_realloc(buf, buf_size); \
+ n = apr_snprintf(buf+idx, buf_size-idx, "%d", (num)); \
+ } idx += n
+
+#define ADD_REF(obj) ADD_NUM(obj_to_id_f(ist, dbrecp, (obj)))
+
+#define ADD_STR(str) \
+ if ((n = apr_snprintf(buf+idx, buf_size-idx, "%s", (str))) == (buf_size-idx)) { \
+ buf_size += BUF_BLOCK_SIZE; \
+ buf = pr_realloc(buf, buf_size); \
+ n = apr_snprintf(buf+idx, buf_size-idx, "%s", (str)); \
+ } idx += n
+
+#define ADD_MEM(ptr, len) \
+ if (idx+len > buf_size) { \
+ buf_size = idx+len+BUF_BLOCK_SIZE; \
+ buf = pr_realloc(buf, buf_size); \
+ } memcpy(buf+idx, ptr, len); idx += len
+
+i32_t load_dbm_int(char* key) {
+ return 0;
+}
+
+void store_dbm_int(char* key, i32_t val) {
+
+}
+
+i32_t obj_to_id_f(isp ist, dbrec_p dbrecp, obj_p obj) {
+ obj_p id_obj = dict_item(ist, dbrecp->obj_to_id, obj);
+ if (!id_obj) {
+ id_obj = NEW_INT(dbrecp->nextid++);
+ dict_add(ist, dbrecp->obj_to_id, obj, id_obj);
+ dict_add(ist, dbrecp->id_to_obj, id_obj, obj);
+ }
+ return (int) id_obj->data.i64;
+}
+
+apr_datum_t obj_to_datum(isp ist, dbrec_p dbrecp, obj_p obj) {
+ obj_p id_tuple, proxy_obj;
+ int bad_proxy = FALSE;
+ apr_datum_t datum;
+ char *buf;
+
+ datum.dptr = NULL;
+ datum.dsize = 0;
+ if (id_tuple = get_attr(ist, obj, SYM(__ID__))) {
+ size_t slen;
+ char* s1 = pr_strptr(list_item(ist, id_tuple, 0));
+ char* s2 = pr_strptr(list_item(ist, id_tuple, 1));
+ if_exc_return datum;
+ slen = strlen(s1)+strlen(s2)+2;
+ datum.dptr = buf = pr_malloc(slen+1);
+ datum.dsize = slen;
+ strcpy(buf, "*");
+ strcat(buf, s1);
+ strcat(buf, "*");
+ strcat(buf, s2);
+ dict_add(ist, dbrecp->id_to_idobj, id_tuple, obj);
+ dict_add(ist, dbrecp->idobj_to_id, obj, id_tuple);
+ } else {
+ proxy_obj = call_func0(ist, obj, SYM(__TOSTORPROXY__));
+ if_exc_return datum;
+ if (!proxy_obj) bad_proxy = TRUE;
+ else if (proxy_obj != OBJ(NONE) && !is_unclonable(proxy_obj)) {
+ int i, idx=0, n, plen, buf_size;
+ int added_attr = FALSE;
+ char* buf = pr_malloc(BUF_BLOCK_SIZE);
+
+ rdlock_rtrn(proxy_obj) datum;
+ plen = proto_len(ist, obj), buf_size = BUF_BLOCK_SIZE;
+ for(i=0; i < plen; i++) {
+ i32_t id = obj_to_id_f(ist, dbrecp, proto_item(ist, obj, i));
+ if(ist->exception_obj) {
+ read_unlock(ist, proxy_obj);
+ pr_free(buf);
+ return datum;
+ }
+ ADD_CHR('p');
+ ADD_NUM(id);
+ if (i < plen-1) ADD_CHR(',')
+ else ADD_CHR(';');
+ }
+ if (!obj->has_attrs) {
+ attr_key_t key = attr_first_key(ist, obj);
+ while(key) {
+ ADD_CHR('a');
+ ADD_STR(key_to_symstr(ist, key));
+ ADD_CHR(':');
+ ADD_REF(attr_value_by_key(ist, obj, key));
+ ADD_CHR(',');
+ added_attr = TRUE;
+ key = attr_next_key(ist, obj, key);
+ }
+ }
+ if (added_attr) { idx--; ADD_CHR(';'); }
+ if (obj->data_type == DATA_TYPE_IMMDATA) {
+ ADD_CHR('i');
+ ADD_NUM(obj->imm_data_len);
+ ADD_CHR(':');
+ ADD_MEM(&(obj->data), 8);
+ }
+ if (has_proto_QUES(ist, obj, OBJ(STRING_PROTO))) {
+ ADD_CHR('s');
+ ADD_MEM(pr_strptr(obj), (int) pr_strlen(obj));
+ } else if (has_proto_QUES(ist, obj, OBJ(TUPLE_PROTO))) {
+ int llen = (int) list_len(ist, obj);
+ ADD_CHR('l');
+ for (i=0; i < llen; i++) {
+ ADD_REF(list_item(ist, obj, i));
+ if (i < llen-1) ADD_CHR(',');
+ }
+ } else if (obj->data_type == DATA_TYPE_DATAPTR)
+ bad_proxy = TRUE;
+ read_unlock(ist, proxy_obj);
+
+ datum.dptr = buf;
+ datum.dsize = idx;
+ }
+ }
+ if (bad_proxy) {
+ if (datum.dptr) pr_free(datum.dptr);
+ raise_exception(ist, ProsistExc_OBJ, "unstorable object found in tree");
+ datum.dptr = NULL;
+ datum.dsize = 0;
+ }
+ return datum;
+}
+
+//******************************** apr_str ************************************
+apr_datum_t apr_str(char* str){
+ apr_datum_t apr_str;
+ apr_str.dptr = str;
+ apr_str.dsize = strlen(str);
+ return apr_str;
+}
+
+//******************************** load_object ********************************
+obj_p load_object(isp ist, dbrec_p dbrecp ) {
+ return NULL;
+}
+
+
+//******************************** store_object *******************************
+void store_object(isp ist, dbrec_p dbrecp) {
+ apr_status_t aprerr;
+ apr_datum_t root_datum;
+ if (apr_dbm_exists(dbrecp->db, apr_str("0"))) {
+ raise_exception(ist, ProsistExc_OBJ, "Database already exists");
+ return;
+ }
+ root_datum = obj_to_datum(ist, dbrecp, dbrecp->root);
+ if (!root_datum.dptr) {
+ raise_exception(ist, ProsistExc_OBJ, "root object is not storable");
+ return;
+ }
+ aprerr = apr_dbm_store(dbrecp->db, apr_str("0"), root_datum);
+ IF_APR_DBM_ERR(dbrecp->db, "storing root object") return;
+}
+
+
+//******************************** FUNCTION DEFS ******************************
MODULE_START(Prosist)
{
Prosist_OBJ = NEW_OBJ(NULL);
@@ -101,6 +293,7 @@
apr_status_t aprerr;
apr_pool_t* cntxt;
apr_dbm_p db;
+ dbrec_p dbrecp;
char *name;
obj_p root_obj;
int mode, uperm;
@@ -110,26 +303,23 @@
INT_32_PARAM(3, mode);
INT_32_PARAM(4, uperm);
- aprerr = apr_pool_create(&cntxt, get_pr_head_pool());
- IF_APR_ERR("out of memory opening Prosist database") return NULL;
-
- aprerr = apr_dbm_open_ex(&db, "SDBM", name, mode, uperm, cntxt);
- IF_APR_ERR("opening Prosist database") return NULL;
-
if (root_obj == OBJ(NONE)) {
if (mode == APR_DBM_RWTRUNC) {
raise_exception(ist, ProsistExc_OBJ, "root == None incompatible with RWTRUNC mode");
return NULL;
}
- //root_obj = load_object(ist, dbdatap, 0);
} else {
if (mode != APR_DBM_RWCREATE && mode != APR_DBM_RWTRUNC) {
raise_exception(ist, ProsistExc_OBJ, "root obj given but mode doesn't allow creation");
return NULL;
}
- //store_object(ist, dbdatap, root_obj);
}
+ aprerr = apr_pool_create(&cntxt, get_pr_head_pool());
+ IF_APR_ERR("out of memory opening Prosist database") return NULL;
+ aprerr = apr_dbm_open_ex(&db, "SDBM", name, mode, uperm, cntxt);
+ IF_APR_ERR("opening Prosist database") return NULL;
+
read_unlock(ist, self);
set_obj_rdacc(self, ACC_USER1);
set_obj_doc(self, "Prosist DataBase");
@@ -138,8 +328,22 @@
read_lock(ist, self);
self->data_type = DATA_TYPE_DATAPTR;
- self->data.ptr = db;
+ self->data.ptr = dbrecp = pr_malloc(sizeof(dbrec_t));
+ dbrecp->db = db;
+ dbrecp->id_to_idobj = NEW_DICT(4*INITIAL_OBJ_COUNT);
+ dbrecp->idobj_to_id = NEW_DICT(4*INITIAL_OBJ_COUNT);
+ dbrecp->id_to_obj = NEW_DICT(4*INITIAL_OBJ_COUNT);
+ dbrecp->obj_to_id = NEW_DICT(4*INITIAL_OBJ_COUNT);
+ if (root_obj == OBJ(NONE)) {
+ dbrecp->nextid = load_dbm_int("!nextid");
+ dbrecp->root = load_object(ist, dbrecp);
+ } else {
+ dbrecp->root = root_obj;
+ dbrecp->nextid = 1;
+ store_object(ist, dbrecp);
+ store_dbm_int("!nextid", dbrecp->nextid);
+ }
return OBJ(NONE);
}
/*
Modified: trunk/modules/Re/Re.c
===================================================================
--- trunk/modules/Re/Re.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/modules/Re/Re.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -176,7 +176,7 @@
else
list_append(ist, res, NEW_STRINGN(s+sp, m[1].rm_eo-sp));
} else {
- tuple_obj = new_tuple_obj(ist, ngrps);
+ tuple_obj = NEW_TUPLE(ngrps);
for (i=1; i <= ngrps; i++) {
sp = m[i].rm_so; ep = m[i].rm_eo;
if (sp == -1) list_append(ist, tuple_obj, NEW_STRING(""));
@@ -539,7 +539,7 @@
raise_exception(ist, ReException_OBJ, "span function groupid parameter value invalid");
return NULL;
}
- res = new_tuple_obj(ist, 2);
+ res = NEW_TUPLE(2);
list_append(ist, res, list_item(ist, self, 2*grp ));
list_append(ist, res, list_item(ist, self, 2*grp+1));
res->immutable = TRUE;
@@ -601,7 +601,7 @@
if (sp == -1) return OBJ(NONE);
else return NEW_STRINGN(orig_s+sp, ep-sp);
} else {
- res = new_tuple_obj(ist, llen);
+ res = NEW_TUPLE(llen);
for (i=0; i < llen; i++) {
obj_p item = list_item(ist, parms[3], i);
j = (int)(item->data.i64);
@@ -618,7 +618,7 @@
DEF( ReMatch, groups, FPARM1(default, OBJ(NONE))) {
int i, ngrps = (int)list_len(ist, self)/2, sp, ep;
char* orig_s;
- obj_p orig_s_obj, res = new_tuple_obj(ist, ngrps);
+ obj_p orig_s_obj, res = NEW_TUPLE(ngrps);
orig_s_obj = get_attr(ist, self, sym(ist, "string")); if_exc_return NULL;
orig_s = pr_strptr(orig_s_obj);
for (i=0; i < ngrps; i++) {
Modified: trunk/src/builtins-core.c
===================================================================
--- trunk/src/builtins-core.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/builtins-core.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -311,15 +311,15 @@
size_t alen, asize;
attr_p attrp;
obj_p dict_obj;
- if (!self->has_attrs) return new_dict_obj(ist, 0);
+ if (!self->has_attrs) return NEW_DICT(0);
attrp = self->attr_proto.attrs;
asize = attr_asize(attrp);
alen = attr_alen(attrp);
- dict_obj = new_dict_obj(ist, (int)alen);
+ dict_obj = NEW_DICT((int)alen);
for (i=0; i < (int) asize; i++) {
if (attr_ap(attrp,i)->attr.key > 0)
dict_add( ist, dict_obj,
- NEW_STRING(keych(ist, attr_ap(attrp,i)->attr.key)),
+ NEW_STRING(key_to_symstr(ist, attr_ap(attrp,i)->attr.key)),
attr_ap(attrp,i)->attr.value );
}
return dict_obj;
@@ -583,7 +583,7 @@
exp_len = max(exp_len, 0);
switch(seq_type) {
case SEQ_TYPE_TUPLE:
- res = new_tuple_obj(ist, exp_len);
+ res = NEW_TUPLE(exp_len);
for(i = index1; i < index2; i += index3)
list_append(ist, res, list_item(ist, self, i));
break;
@@ -608,7 +608,7 @@
exp_len = max(exp_len, 0)+1;
switch(seq_type) {
case SEQ_TYPE_TUPLE:
- res = new_tuple_obj(ist, exp_len);
+ res = NEW_TUPLE(exp_len);
for(i = index1; i > index2; i += index3)
list_append(ist, res, list_item(ist, self, i));
break;
Modified: trunk/src/builtins-dict.c
===================================================================
--- trunk/src/builtins-dict.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/builtins-dict.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -64,6 +64,10 @@
#include "object.h"
#include <prothon/prothon_dll.h>
+MODULE_DECLARE(Dict);
+MODULE_DECLARE(DictGen);
+MODULE_DECLARE(DictRestore);
+
//********************************* new_dict_obj ******************************
obj_p new_dict_obj(isp ist, int initial_size){
obj_p dict_obj = NEW_OBJ(OBJ(DICT_PROTO));
@@ -81,15 +85,45 @@
return FALSE; \
}
+//********************************* dict_realloc *****************************
+dict_p dict_realloc(dict_p dict) {
+ dict_p dp, old_dict = dict;
+ i32_t i, j, hash_in, old_size = (int) dictsize(dict);
+ i32_t size = max(((int)dictsize(dict) * DICT_PAD_PERCENT_FACTOR) / 100, DEFAULT_INITIAL_DICT_SIZE);
+ i32_t len = (int) dictlen(dict);
+ dict = pr_malloc(dict_sizeof(size));
+ memset(dict, 0, dict_sizeof(size));
+ dictsize(dict) = size;
+ dictlen(dict) = len;
+ for(i=0; i < old_size; i++) {
+ if ((hash_in = dicthash(old_dict, i)) > 0) {
+ for (j=hash_in; (dp=dictptr(dict,j))->entry.hash; j++);
+ dp->entry.hash = hash_in;
+ dp->entry.key = dictkey(old_dict, j);
+ dp->entry.value = dictitem(old_dict, j);
+ }
+ }
+ pr_free(old_dict);
+ return dict;
+}
+
//********************************* dict_add **********************************
int dict_add(isp ist, obj_p dict_obj, obj_p key_in, obj_p value_in) {
i32_t i, hash, hash_in, match=FALSE;
obj_p key, rp[2];
dict_p dict, dp, hole=NULL;
rp[0]=0; rp[1]=key_in;
- hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
+ if (has_proto_QUES(ist, key_in, OBJ(INT_PROTO)))
+ hash_in = ((i32_t) key_in->data.i64) & HASH_MASK;
+ else
+ hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
+ if (!hash_in) hash_in++;
dict_wr_chk();
dict = (dict_p) obj_data_p(dict_obj);
+
+ if (((dictlen(dict) * 100) / dictsize(dict)) > DICT_MAX_PERCENT_FULL)
+ dict_obj->data.ptr = dict = dict_realloc(dict);
+
for (i=hash_in; (key=((dp=dictptr(dict,i))->entry.key)); i++){
hash = dp->entry.hash;
if (hash < 0) { hole = dp; continue; }
@@ -133,7 +167,11 @@
dict_p dict, dp;
rp[0]=0; rp[1]=key_in;
rdlock_rtrn(dict_obj) NULL;
- hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
+ if (has_proto_QUES(ist, key_in, OBJ(INT_PROTO)))
+ hash_in = ((i32_t) key_in->data.i64) & HASH_MASK;
+ else
+ hash_in = hash_value(call_func(ist, key_in, SYM(__HASH__), 0, NULL, NULL));
+ if (!hash_in) hash_in++;
dict_rd_chk();
dict = (dict_p) obj_data_p(dict_obj);
for (i=hash_in; (key=((dp=dictptr(dict,i))->entry.key)); i++){
@@ -197,9 +235,6 @@
return list_obj;
}
-MODULE_DECLARE(Dict);
-MODULE_DECLARE(DictGen);
-
// ***************************** DICT ******************************************
MODULE_START(Dict)
@@ -446,10 +481,29 @@
return gen_obj;
}
+DEF(Dict, __toStorProxy__, NULL) {
+ obj_p proxy_obj = dict_keys_values(ist, self, 4 /*list*/);
+ switch_proto(ist, proxy_obj, DictRestore_OBJ);
+ return proxy_obj;
+}
+MODULE_START(DictRestore) {
+ DictRestore_OBJ = NEW_OBJ(OBJ(LIST_PROTO));
+ set_obj_id(DictRestore_OBJ, *, DictRestore);
+}
+
+DEF(DictRestore, __fromStorProxy__, NULL) {
+ int i, llen = (int)list_len(ist, self);
+ obj_p dict = NEW_DICT(2*llen);
+ for (i=0; i < llen; i += 2)
+ dict_add(ist, dict, list_item(ist, self, i), list_item(ist, self, i+1));
+ return dict;
+}
+
MODULE_START(DictGen)
{
DictGen_OBJ = NEW_OBJ(NULL);
+ set_obj_id(DictGen_OBJ, *, DictGen);
}
DEF(DictGen, next, NULL) {
@@ -489,9 +543,13 @@
MODULE_ADD_SYM(Dict, __setItem__);
MODULE_ADD_SYM(Dict, __delItem__);
MODULE_ADD_SYM(Dict, __iter__);
+ MODULE_ADD_SYM(Dict, __toStorProxy__);
MODULE_ADD_SYM(Dict, __objList__);
MODULE_ADD_SYM(Dict, __cDataLen__);
+ MODULE_SUB_INIT(DictRestore);
+ MODULE_ADD_SYM(DictRestore, __fromStorProxy__);
+
MODULE_SUB_INIT(DictGen);
MODULE_ADD_SYM(DictGen, next);
Modified: trunk/src/builtins-tuple.c
===================================================================
--- trunk/src/builtins-tuple.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/builtins-tuple.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -214,7 +214,7 @@
times = (int)parms[1]->data.i64;
size = len*times;
if(times == 0) {
- obj_p res = new_tuple_obj(ist, 0);
+ obj_p res = NEW_TUPLE(0);
res ->immutable = TRUE;
return res;
}
Modified: trunk/src/dict.h
===================================================================
--- trunk/src/dict.h 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/dict.h 2004-04-19 19:09:14 UTC (rev 394)
@@ -54,7 +54,12 @@
// dict.h
#define DEFAULT_INITIAL_DICT_SIZE 8
+#define DICT_MAX_PERCENT_FULL 40
+#define DICT_PAD_PERCENT_FACTOR 300
+#define ATTRS_MAX_PERCENT_FULL 40
+#define ATTRS_PAD_PERCENT_FACTOR 300
+
typedef struct {
size_t size;
size_t len;
@@ -73,15 +78,15 @@
typedef dict_t* dict_p;
-#define dict_sizeof(n) (sizeof(dict_hdr_t) + (n) * sizeof(dict_entry_t))
+#define dict_sizeof(n) (((n)+DICT_OVERHEAD) * sizeof(dict_entry_t))
#define dict_size_bytes(dict) (dict_sizeof(dictsize(dict)))
-#define DICT_HDR_INDEX 0
-#define DICT_OVERHEAD 1
-#define dict_d(dict_obj) ((dict_p)obj_data_p(dict_obj))
+#define DICT_HDR_INDEX 0
+#define DICT_OVERHEAD 1
+#define dict_d(dict_obj) ((dict_p)((dict_obj)->data.ptr))
#define dictsize(dict) (((dict_p)(dict))[DICT_HDR_INDEX].hdr.size)
#define dictlen(dict) (((dict_p)(dict))[DICT_HDR_INDEX].hdr.len)
-#define dictptr(dict, i) (((dict_p)(dict))+DICT_OVERHEAD+((i)%dictsize(dict)))
+#define dictptr(dict, i) ( ((dict_p)(dict)) + DICT_OVERHEAD + ((i)%dictsize(dict)) )
#define dicthash(dict,i) (dictptr(((dict_p)(dict)),i)->entry.hash)
#define dictkey(dict, i) (dictptr(((dict_p)(dict)),i)->entry.key)
#define dictitem(dict,i) (dictptr(((dict_p)(dict)),i)->entry.value)
Modified: trunk/src/interp.c
===================================================================
--- trunk/src/interp.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/interp.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -821,7 +821,7 @@
}
} break;
case OP_NEWTUPLE: {
- obj_p tuple_obj = new_tuple_obj(ist, param);
+ obj_p tuple_obj = NEW_TUPLE(param);
fr_sp -= param;
listlen(tuple_obj) = param;
for (i=0; i < param; i++)
@@ -836,7 +836,7 @@
fr_push(list_obj);
} break;
case OP_NEWDICT: {
- obj_p dict_obj = new_dict_obj(ist, param);
+ obj_p dict_obj = NEW_DICT(param);
fr_sp -= param;
for (i=0; i < param; i+=2) {
dict_add(ist, dict_obj, fr_stack[fr_sp+i], fr_stack[fr_sp+i+1]);
Modified: trunk/src/object.c
===================================================================
--- trunk/src/object.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/object.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -179,7 +179,18 @@
dll_services.get_obj_rdacc = get_obj_rdacc;
dll_services.get_obj_wracc = get_obj_wracc;
dll_services.check_exceptions = check_exceptions;
+ dll_services.attr_first_key = attr_first_key;
+ dll_services.attr_next_key = attr_next_key;
+ dll_services.attr_value_by_key = attr_value_by_key;
+ dll_services.dict_add = dict_add;
+ dll_services.dict_item = dict_item;
+ dll_services.is_unclonable = is_unclonable;
+ dll_services.key_to_symstr = key_to_symstr;
+ dll_services.new_dict_obj = new_dict_obj;
+ dll_services.proto_len = proto_len;
+ dll_services.proto_item = proto_item;
+
/* Setup the core objects. Order counts here */
OBJ(OBJECT) = NEW_OBJ(NULL);
OBJ(OBJECT)->attr_proto.proto = OBJ(OBJECT);
@@ -206,11 +217,11 @@
OBJ(DICT_PROTO) = NEW_OBJ(NULL);
OBJ(FUNC_PROTO) = NEW_OBJ(NULL);
- OBJ(SYMBOLS) = NEW_LIST(SYM_ENUM_COUNT+100);
+ OBJ(SYMBOLS) = NEW_DICT(SYM_ENUM_COUNT+100);
init_symbol(ist);
- set_obj_doc(OBJ(SYMBOLS), "Symbols: list of all symbol objects");
+ set_obj_doc(OBJ(SYMBOLS), "Symbols: dictionary of all symbol objects");
/* Now load the actual modules for the builtin prototypes */
BUILTIN_LOAD(Core);
@@ -289,6 +300,29 @@
free_wrlock(obj);
}
+//********************************* set_unclonable ****************************
+void set_unclonable(obj_p obj){
+ get_wrlock(obj, NO_WAIT);
+ obj->unclonable = TRUE;
+ free_wrlock(obj);
+}
+
+//********************************* clr_unclonable ****************************
+void clr_unclonable(obj_p obj){
+ get_wrlock(obj, NO_WAIT);
+ obj->unclonable = FALSE;
+ free_wrlock(obj);
+}
+
+//********************************* is_unclonable *****************************
+int is_unclonable(obj_p obj) {
+ int res;
+ get_wrlock(obj, NO_WAIT);
+ res = obj->unclonable;
+ free_wrlock(obj);
+ return res;
+}
+
//********************************* set_obj_rdacc *****************************
void set_obj_rdacc(obj_p obj, int access) {
get_wrlock(obj, NO_WAIT);
@@ -473,6 +507,45 @@
}
//********************************* switch_proto ****************************
+
+attr_key_t attr_first_key(isp ist, obj_p obj) {
+ int i;
+ size_t asize;
+ attr_p attrp;
+ if (!obj->has_attrs) return 0;
+ attrp = obj->attr_proto.attrs;
+ asize = attr_asize(attrp);
+ for (i=0; i < (int) asize; i++) {
+ if (attr_ap(attrp,i)->attr.key > 0)
+ return attr_ap(attrp,i)->attr.key;
+ }
+ return 0;
+}
+
+attr_key_t attr_next_key(isp ist, obj_p obj, attr_key_t key) {
+ if (obj->has_attrs){
+ attr_p attrs = obj->attr_proto.attrs;
+ attr_key_t i, akey, tgt = key;
+ int asize = (int) attr_asize(attrs);
+ for(i=tgt; (akey=(attr_ap(attrs, i))->attr.key) && (tgt!=akey); i++);
+ if (akey) {
+ for(i=(i+1)%asize; (akey=(attr_ap(attrs, i))->attr.key) <= 0 && i < asize; i++);
+ if (akey > 0 && i < asize) return akey;
+ }
+ }
+ return 0;
+}
+
+obj_p attr_value_by_key(isp ist, obj_p obj, attr_key_t key) {
+ if (obj->has_attrs){
+ attr_p ptr, attrs = obj->attr_proto.attrs;
+ attr_key_t i, akey, tgt = key;
+ for(i=tgt; (akey=((ptr=attr_ap(attrs, i))->attr.key)) && (tgt!=akey); i++);
+ if (akey) return ptr->attr.value;
+ }
+ return NULL;
+}
+
void switch_proto(isp ist, obj_p obj, obj_p new_proto) {
attr_p attrs;
wrlock_rtrn(obj);
@@ -873,17 +946,20 @@
fclose(fout);
}
-//********************************* keych *************************************
-char* keych(isp ist, attr_key_t key) {
- int i, len;
+
+
+//********************************* key_to_symstr *************************************
+char* key_to_symstr(isp ist, attr_key_t key) {
char* res;
- rdlock_rtrn(OBJ(SYMBOLS)) NULL;
- len = (int) list_len(ist, OBJ(SYMBOLS));
- for(i=0; i < len; i++)
- if (list_item(ist, OBJ(SYMBOLS),i)->data.key == key)
- break;
- res = symch(ist, list_item(ist, OBJ(SYMBOLS),i));
- read_unlock(ist, OBJ(SYMBOLS));
+ obj_p key_obj = NEW_INT(key);
+ obj_p sym_obj = dict_item(ist, OBJ(SYMBOLS), key_obj);
+ if (!sym_obj) {
+ raise_exception(ist, OBJ(INTERNAL_EXC), "key_to_symstr sym lookup error");
+ return "";
+ }
+ res = symch(ist, sym_obj);
+ del_unlock(key_obj);
+ del_unlock(sym_obj);
return res;
}
@@ -937,7 +1013,7 @@
if (attrs[i].attr.key > 0) {
attr_key_t key = attrs[i].attr.key;
obj_p val = attrs[i].attr.value;
- ind(dep+1); fprintf(fout,"KEY: %s\n", keych(ist, key)); prt_flg = 1;
+ ind(dep+1); fprintf(fout,"KEY: %s\n", key_to_symstr(ist, key)); prt_flg = 1;
ind(dep+1); fprintf(fout,"VALUE: ");prt_flg = 1;
if (val) dump_obj(ist, val, dep+1);
else fprintf(fout,"0\n");prt_flg = 1;
Modified: trunk/src/object.h
===================================================================
--- trunk/src/object.h 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/object.h 2004-04-19 19:09:14 UTC (rev 394)
@@ -140,8 +140,6 @@
char* numonly(char* s, char* buf);
-char* keych(isp ist, attr_key_t key);
-
void dump(isp ist, char* dumpfilename, obj_p obj);
void dump_obj(isp ist, obj_p obj, int dep);
Modified: trunk/src/parser.h
===================================================================
--- trunk/src/parser.h 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/parser.h 2004-04-19 19:09:14 UTC (rev 394)
@@ -117,7 +117,7 @@
#define OR_FLAG 0
#define AND_FLAG 1
#define NEW_LIST_ 0
-#define NEW_TUPLE 1
+#define NEW_TUPLE_ 1
#define NEW_REAL 0
#define NEW_IMAG 1
#define NEW_STRN 0
Modified: trunk/src/parser_routines.c
===================================================================
--- trunk/src/parser_routines.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/parser_routines.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -1272,7 +1272,7 @@
for(i=0; i < clist_len(lst); i++)
add_code_to(clist_item(lst,i), res, &k);
res->code_data[k ].bytecode.opcode =
- (tuple_flag == NEW_TUPLE ? OP_NEWTUPLE : OP_NEWLIST);
+ (tuple_flag == NEW_TUPLE_ ? OP_NEWTUPLE : OP_NEWLIST);
res->code_data[k++].bytecode.param = clist_len(lst);
pr_free(lst);
res->stack_depth -= clist_len(lst);
Modified: trunk/src/prothon.y
===================================================================
--- trunk/src/prothon.y 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/prothon.y 2004-04-19 19:09:14 UTC (rev 394)
@@ -540,7 +540,7 @@
| '{' brace_params '}' { $$ = new_dict(yylex_param, $2); }
| '[' list_params ']' { $$ = new_tuple_list(yylex_param, $2, NEW_LIST_); }
| '(' expr ')' { $$ = $2; }
- | '(' tuple_params ')' { $$ = new_tuple_list(yylex_param, $2, NEW_TUPLE); }
+ | '(' tuple_params ')' { $$ = new_tuple_list(yylex_param, $2, NEW_TUPLE_); }
| obj '(' function_params ')' { $$ = obj_func_params(yylex_param, $1, $3); }
| attr_ref '(' function_params ')' { $$ = self_func_params(yylex_param, $1, $3); }
| unbound_ref '(' function_params ')' { $$ = unbound_func_params(yylex_param, $1, $3); }
Modified: trunk/src/symbol.c
===================================================================
--- trunk/src/symbol.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/symbol.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -246,7 +246,7 @@
set_attr(ist, sym, STRING_SYM, NEW_STRING(s));
sym->wr_access = ACC_SYSTEM;
su(i);
- list_append(ist, OBJ(SYMBOLS), sym);
+ dict_add(ist, OBJ(SYMBOLS), NEW_INT(sym->data.key), sym);
un_su(i);
pr_free(s);
return sym;
Modified: trunk/src/sys.c
===================================================================
--- trunk/src/sys.c 2004-04-18 18:01:08 UTC (rev 393)
+++ trunk/src/sys.c 2004-04-19 19:09:14 UTC (rev 394)
@@ -186,7 +186,7 @@
have_home = TRUE;
set_attr(ist, sys_module, sym(ist, "prothonhome"), NEW_STRING(home));
}
- vers_tuple = new_tuple_obj(ist, 3);
+ vers_tuple = NEW_TUPLE(3);
list_append(ist, vers_tuple, NEW_STRING(PROTHON_VERSION_NUMBER));
list_append(ist, vers_tuple, NEW_STRING(numonly(PROTHON_VERSION_BUILD, path)));
list_append(ist, vers_tuple, NEW_STRING(PROTHON_VERSION_DATE));