rev 436 - in trunk: include/prothon modules/DBM modules/File modules/Prosist src
SVN User <[email protected]> Sat, 01 May 2004 00:06:47 -0400
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: mark
Date: 2004-05-01 00:06:44 -0400 (Sat, 01 May 2004)
New Revision: 436
Modified:
trunk/include/prothon/prothon.h
trunk/include/prothon/prothon_dll.h
trunk/modules/DBM/DBM.c
trunk/modules/File/File.c
trunk/modules/Prosist/Prosist.c
trunk/src/builtins-dict.c
trunk/src/builtins-float.c
trunk/src/builtins-int.c
trunk/src/builtins-list.c
trunk/src/builtins-string.c
trunk/src/builtins-thread.c
trunk/src/builtins-tuple.c
trunk/src/object.c
trunk/src/parser_routines.c
trunk/src/src.vcproj
Log:
added obj_set_data_owner
Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/include/prothon/prothon.h 2004-05-01 04:06:44 UTC (rev 436)
@@ -469,17 +469,21 @@
// Clobbers binary data in dest object (copy)
void copy_object_data(isp ist, obj_p copy, obj_p obj);
-// SET_TYPE_IF_EXC: Set data type field and throw exception if already set
-#define SET_TYPE_IF_EXC(obj, type) \
- if ((obj)->data_type != DATA_TYPE_NONE) \
- raise_exception(ist, OBJ(INTERNAL_EXC), "object binary data overwrite attempt"); \
- else \
- (obj)->data_type = (type); \
- if (ist->exception_obj)
+// SET_TYPE_IF_EXC: Set data type and owner, throw exception if already set
+#define SET_TYPE_IF_EXC(owner, obj, type) \
+ if ((obj)->data_type != DATA_TYPE_NONE) \
+ raise_exception(ist, OBJ(INTERNAL_EXC), \
+ "object binary data overwrite attempt"); \
+ else { (obj)->data_type = (type); \
+ obj_set_data_owner(ist, obj, owner); \
+ } if (ist->exception_obj)
// OBJ_DATA_OWNER: Return owner prototype of binary data in obj
obj_p obj_data_owner(obj_p obj);
+// OBJ_SET_DATA_OWNER: Set the owner of the binary data in obj to owner prototype
+void obj_set_data_owner(isp ist, obj_p obj, obj_p owner);
+
// GET_ATTR: Find attr in object that matches a key and return the attr value.
// Searches object for attr with key that matches the given key symbol object.
// If no attr is found with a matching key, then NULL is returned.
@@ -1037,7 +1041,7 @@
// WARNING: obj_malloc does not internally lock the object it is modifying. This is
// because it is usually used on a new object. If you use it on a public object, be
// sure to write_lock the object before calling obj_malloc.
-void* obj_malloc (isp ist, obj_p obj, size_t size);
+void* obj_malloc (isp ist, obj_p proto, obj_p obj, size_t size);
void* obj_realloc(isp ist, obj_p obj, size_t size);
void obj_free (isp ist, obj_p obj);
Modified: trunk/include/prothon/prothon_dll.h
===================================================================
--- trunk/include/prothon/prothon_dll.h 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/include/prothon/prothon_dll.h 2004-05-01 04:06:44 UTC (rev 436)
@@ -105,6 +105,7 @@
obj_p (*new_object)(isp ist, obj_p proto);
void (*copy_object_data)(isp ist, obj_p copy, obj_p obj);
obj_p (*obj_data_owner)(obj_p obj);
+ void (*obj_set_data_owner)(isp ist, obj_p obj, obj_p owner);
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);
@@ -125,7 +126,7 @@
void* (*pr_realloc)(void *p, size_t nbytes);
void (*pr_free)(void *p);
- void* (*obj_malloc) (isp ist, obj_p obj, size_t size);
+ void* (*obj_malloc) (isp ist, obj_p proto, obj_p obj, size_t size);
void* (*obj_realloc)(isp ist, obj_p obj, size_t size);
void (*obj_free) (isp ist, obj_p obj);
@@ -174,10 +175,14 @@
obj_p* parms, obj_p dlocals)
#define BIN_CHK(slf) \
- if (self != slf##_OBJ && obj_data_owner(self) != slf##_OBJ) { \
+do {obj_p owner; \
+ if ( self == slf##_OBJ || \
+ !(owner = obj_data_owner(self)) ) break; \
+ if (owner != slf##_OBJ) { \
raise_exception(ist, OBJ(INTERNAL_EXC), \
"object has wrong binary data, expected %s", #slf); \
- return NULL; }
+ return NULL; } \
+} while (0)
#define MAIN_MODULE_INIT(name) \
static void name##_module_install(void); \
@@ -271,6 +276,7 @@
#define new_object (*services->new_object)
#define copy_object_data (*services->copy_object_data)
#define obj_data_owner (*services->obj_data_owner)
+#define obj_set_data_owner (*services->obj_set_data_owner)
#define set_obj_doc_f (*services->set_obj_doc_f)
#define pr_malloc (*services->pr_malloc)
#define pr_realloc (*services->pr_realloc)
Modified: trunk/modules/DBM/DBM.c
===================================================================
--- trunk/modules/DBM/DBM.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/modules/DBM/DBM.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -168,7 +168,7 @@
set_attr(ist, self, sym(ist, "uperm"), parms[7]);
read_lock(ist, self);
- SET_TYPE_IF_EXC(self, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(DB_OBJ, self, DATA_TYPE_DATAPTR) return NULL;
self->data.ptr = db;
return OBJ(NONE);
Modified: trunk/modules/File/File.c
===================================================================
--- trunk/modules/File/File.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/modules/File/File.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -98,7 +98,7 @@
filep->stream = fp;
filep->pool = subpool;
filep->flags = flags;
- SET_TYPE_IF_EXC(file_obj, DATA_TYPE_DATAPTR) return;
+ SET_TYPE_IF_EXC(File_OBJ, file_obj, DATA_TYPE_DATAPTR) return;
file_obj->data.ptr = filep;
file_obj->rd_access = ACC_USER1;
file_obj->wr_access = ACC_USER1;
@@ -277,7 +277,7 @@
str_obj->data_type = DATA_TYPE_IMMDATA;
buf = str_obj->data.str;
} else {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+size+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+size+1);
buf = obj_str->str;
}
num_read = size;
@@ -292,7 +292,7 @@
size_t next_read = (readall ? size : size - total_read);
size_t new_len = total_read + next_read;
if (str_obj->data_type == DATA_TYPE_IMMDATA && new_len >= IMMEDIATE_DATA_LEN) {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+new_len+1);
buf = obj_str->str;
} else {
obj_str = obj_realloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
@@ -354,7 +354,7 @@
str_obj->data_type = DATA_TYPE_IMMDATA;
buf = str_obj->data.str;
} else {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+size+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+size+1);
buf = obj_str->str;
}
aprerr = apr_file_gets(buf, (int)(size + 1), STREAM(self));
@@ -368,7 +368,7 @@
size_t next_read = (readall ? size : size - total_read);
size_t new_len = total_read + next_read;
if (str_obj->data_type == DATA_TYPE_IMMDATA && new_len >= IMMEDIATE_DATA_LEN) {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+new_len+1);
buf = obj_str->str;
} else {
obj_str = obj_realloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
@@ -432,7 +432,7 @@
str_obj->data_type = DATA_TYPE_IMMDATA;
buf = str_obj->data.str;
} else {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+size+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+size+1);
buf = obj_str->str;
}
aprerr = apr_file_gets(buf, (int)(size - total_read + 1), STREAM(self));
@@ -448,7 +448,7 @@
size_t next_read = (readall ? size : size - total_read);
size_t new_len = num_read + next_read;
if (str_obj->data_type == DATA_TYPE_IMMDATA && new_len >= IMMEDIATE_DATA_LEN) {
- obj_str = obj_malloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), str_obj, sizeof(pr_str_t)+new_len+1);
buf = obj_str->str;
} else {
obj_str = obj_realloc(ist, str_obj, sizeof(pr_str_t)+new_len+1);
Modified: trunk/modules/Prosist/Prosist.c
===================================================================
--- trunk/modules/Prosist/Prosist.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/modules/Prosist/Prosist.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -954,7 +954,7 @@
aprerr = apr_dbm_open_ex(&db, "SDBM", name, mode, uperm, cntxt);
IF_APR_ERR("opening Prosist database") return NULL;
- SET_TYPE_IF_EXC(self, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(Prosist_OBJ, self, DATA_TYPE_DATAPTR) return NULL;
self->data.ptr = psrecp = pr_malloc(sizeof(psrec_t));
psrecp->db = db;
psrecp->pool = cntxt;
Modified: trunk/src/builtins-dict.c
===================================================================
--- trunk/src/builtins-dict.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-dict.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -73,7 +73,7 @@
obj_p dict_obj = NEW_OBJ(OBJ(DICT_PROTO));
dict_p dict;
initial_size = max(initial_size, DEFAULT_INITIAL_DICT_SIZE);
- dict = obj_malloc(ist, dict_obj, (DICT_OVERHEAD+initial_size)*sizeof(dict_t));
+ dict = obj_malloc(ist, OBJ(DICT_PROTO), dict_obj, (DICT_OVERHEAD+initial_size)*sizeof(dict_t));
memset(dict, 0, (DICT_OVERHEAD+initial_size)*sizeof(dict_t));
dictsize(dict) = initial_size;
return dict_obj;
@@ -261,7 +261,7 @@
set_obj_id(Dict_OBJ, *, Dict);
set_attr(ist, OBJ(OBJECT), sym(ist, "Dict"), Dict_OBJ);
- dict = obj_malloc(ist, Dict_OBJ, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
+ dict = obj_malloc(ist, OBJ(DICT_PROTO), Dict_OBJ, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
if_exc_return;
memset(dict, 0, (DICT_OVERHEAD+DEFAULT_INITIAL_DICT_SIZE)*sizeof(dict_t));
dictsize(dict) = DEFAULT_INITIAL_DICT_SIZE;
@@ -278,8 +278,8 @@
obj_p list;
int i, llen, size = max(DEFAULT_INITIAL_DICT_SIZE, (int) dict_len(ist, parms[1])*3);
- SET_TYPE_IF_EXC(self, DATA_TYPE_DATAPTR) return NULL;
- dict = obj_malloc(ist, self, dict_sizeof(size));
+ SET_TYPE_IF_EXC(Dict_OBJ, self, DATA_TYPE_DATAPTR) return NULL;
+ dict = obj_malloc(ist, OBJ(DICT_PROTO), self, dict_sizeof(size));
memset(dict, 0, dict_sizeof(size));
dictsize(dict) = size;
list = dict_keys_values(ist, parms[1], 2 /*list*/);
Modified: trunk/src/builtins-float.c
===================================================================
--- trunk/src/builtins-float.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-float.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -112,7 +112,7 @@
double f = 0.0;
if (list_len(ist, parms[1]))
FLOAT__PARAM(0, f);
- SET_TYPE_IF_EXC(self, DATA_TYPE_IMMDATA) return NULL;
+ SET_TYPE_IF_EXC(Float_OBJ, self, DATA_TYPE_IMMDATA) return NULL;
self->imm_data_len = IMMEDIATE_DATA_LEN;
self->data.f64 = f;
return OBJ(NONE);
Modified: trunk/src/builtins-int.c
===================================================================
--- trunk/src/builtins-int.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-int.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -110,15 +110,17 @@
DEF(Int, __init__, FORM_STAR_PARAM) {
i64_t i = 0;
+ BIN_CHK(Int);
if (list_len(ist, parms[1]))
INT_64_PARAM(0,i);
- SET_TYPE_IF_EXC(self, DATA_TYPE_IMMDATA) return NULL;
+ SET_TYPE_IF_EXC(Int_OBJ, self, DATA_TYPE_IMMDATA) return NULL;
self->imm_data_len = IMMEDIATE_DATA_LEN;
self->data.i64 = i;
return OBJ(NONE);
}
DEF(Int, __bool__QUES, NULL) {
+ BIN_CHK(Int);
if (Int_value(self)) return OBJ(PR_TRUE);
else return OBJ(PR_FALSE);
}
Modified: trunk/src/builtins-list.c
===================================================================
--- trunk/src/builtins-list.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-list.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -98,7 +98,7 @@
list_p lstp;
lstp = obj->data.ptr =
pr_malloc(list_sizeof(max(initial_size, 2)));
- SET_TYPE_IF_EXC(obj, DATA_TYPE_DATAPTR) return;
+ SET_TYPE_IF_EXC(OBJ(LIST_PROTO), obj, DATA_TYPE_DATAPTR) return;
lstpsize(lstp) = max(initial_size, 2);
lstplen(lstp) = 0;
}
Modified: trunk/src/builtins-string.c
===================================================================
--- trunk/src/builtins-string.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-string.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -83,7 +83,7 @@
obj->imm_data_len = (int) len;
strcpy(obj->data.str, str);
} else {
- obj_str = obj_malloc(ist, obj, sizeof(pr_str_t)+len+1); if_exc_return NULL;
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+len+1); if_exc_return NULL;
obj_str->len = len;
strcpy(&(obj_str->str[0]), str);
}
@@ -103,7 +103,7 @@
memcpy(obj->data.str, str, len);
obj->data.str[len] = 0;
} else {
- obj_str = obj_malloc(ist, obj, sizeof(pr_str_t)+len+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+len+1);
obj_str->len = len;
memcpy(&(obj_str->str[0]), str, len);
obj_str->str[len] = 0;
@@ -116,13 +116,13 @@
void set_string_data(isp ist, obj_p obj, char* p, size_t len) {
pr_str_p obj_str;
if (len < 8) {
- SET_TYPE_IF_EXC(obj, DATA_TYPE_IMMDATA) return;
+ SET_TYPE_IF_EXC(OBJ(STRING_PROTO), obj, DATA_TYPE_IMMDATA) return;
obj->imm_data_len = (u8_t) len;
memcpy(obj->data.str, p, len);
obj->data.str[len] = 0;
} else {
- SET_TYPE_IF_EXC(obj, DATA_TYPE_DATAPTR) return;
- obj_str = obj->data.ptr = obj_malloc(ist, obj, sizeof(pr_str_t)+len+1);
+ SET_TYPE_IF_EXC(OBJ(STRING_PROTO), obj, DATA_TYPE_DATAPTR) return;
+ obj_str = obj->data.ptr = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+len+1);
obj_str->len = len;
memcpy(&(obj_str->str[0]), p, len);
obj_str->str[len] = 0;
@@ -149,6 +149,7 @@
DEF(String, __init__, FORM_STAR_PARAM) {
char *s;
+ BIN_CHK(String);
if (!list_len(ist, parms[1]))
s = "";
else
@@ -218,7 +219,7 @@
memcpy(&(obj->data.str[slen]), pr_strptr(other), olen);
obj->data.str[tlen] = 0;
} else {
- obj_str = obj_malloc(ist, obj, sizeof(pr_str_t)+tlen+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+tlen+1);
obj_str->len = tlen;
memcpy(&(obj_str->str[0]), pr_strptr(self), slen);
memcpy(&(obj_str->str[slen]), pr_strptr(other), olen);
@@ -249,7 +250,7 @@
memcpy(obj->data.str+i*len, pr_strptr(self), len);
obj->data.str[tlen] = 0;
} else {
- obj_str = obj_malloc(ist, obj, sizeof(pr_str_t)+tlen+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+tlen+1);
if(!obj_str) {
raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for string multiplication");
return NULL;
@@ -351,7 +352,7 @@
obj->imm_data_len = (int) tlen;
dest_ptr = obj->data.str;
} else {
- obj_str = obj_malloc(ist, obj, sizeof(pr_str_t)+tlen+1);
+ obj_str = obj_malloc(ist, OBJ(STRING_PROTO), obj, sizeof(pr_str_t)+tlen+1);
if(!obj_str) {
raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for string multiplication");
return NULL;
@@ -426,7 +427,7 @@
if ((ch = *((char*)self->data.ptr))) {
self->data.ptr = (i64_t *)(((char*)self->data.ptr) + 1);
res = NEW_OBJ(String_OBJ);
- res_str = (char*)obj_malloc(ist, res, 2);
+ res_str = (char*)obj_malloc(ist, OBJ(STRING_PROTO), res, 2);
res_str[0] = ch;
res_str[1] = 0;
} else
Modified: trunk/src/builtins-thread.c
===================================================================
--- trunk/src/builtins-thread.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-thread.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -74,7 +74,7 @@
obj_p thread_obj;
pr_thread_p thread_ptr;
thread_obj = NEW_OBJ(OBJ(THREAD_PROTO));
- SET_TYPE_IF_EXC(thread_obj, DATA_TYPE_DATAPTR) return;
+ SET_TYPE_IF_EXC(OBJ(THREAD_PROTO), thread_obj, DATA_TYPE_DATAPTR) return;
thread_ptr = thread_obj->data.ptr = pr_malloc(sizeof(pr_thread_t));
memset(thread_obj->data.ptr, 0, sizeof(pr_thread_t));
thread_ptr->ist = ist;
@@ -132,7 +132,7 @@
if (!thread_obj) {
thread_obj = NEW_OBJ(OBJ(THREAD_PROTO));
- SET_TYPE_IF_EXC(thread_obj, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(OBJ(THREAD_PROTO), thread_obj, DATA_TYPE_DATAPTR) return NULL;
thread_obj->data.ptr = pr_malloc(sizeof(pr_thread_t));
memset(thread_obj->data.ptr, 0, sizeof(pr_thread_t));
}
@@ -195,7 +195,7 @@
set_attr(ist, Thread_OBJ, sym(ist, "USER2"), NEW_INT( ACC_USER2));
set_attr(ist, Thread_OBJ, sym(ist, "SYSTEM"), NEW_INT(ACC_SYSTEM));
- thread = obj_malloc(ist, Thread_OBJ, sizeof(pr_thread_t));
+ thread = obj_malloc(ist, Thread_OBJ, Thread_OBJ, sizeof(pr_thread_t));
if_exc_return;
memset(thread, 0, sizeof(pr_thread_t));
Thread_OBJ->unclonable = TRUE;
@@ -216,7 +216,7 @@
if (parms[5] != OBJ(NONE))
CHECK_TYPE_EXC(parms[5], OBJ(STRING_PROTO), "string");
CHECK_TYPE_EXC(parms[7], OBJ(INT_PROTO), "integer");
- SET_TYPE_IF_EXC(self, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(Thread_OBJ, self, DATA_TYPE_DATAPTR) return NULL;
self->data.ptr = pr_malloc(sizeof(pr_thread_t));
memset(self->data.ptr, 0, sizeof(pr_thread_t));
uthread = &(((pr_thread_p)self->data.ptr)->user_thread_data);
@@ -325,7 +325,7 @@
aprerr = apr_pool_create(&subpool, get_pr_head_pool());
IF_APR_ERR("out of memory creating mutex") return NULL;
- SET_TYPE_IF_EXC(self, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(Mutex_OBJ, self, DATA_TYPE_DATAPTR) return NULL;
aprerr = apr_thread_mutex_create((apr_thread_mutex_t**)(&self->data.ptr), APR_THREAD_MUTEX_UNNESTED, subpool);
IF_APR_ERR("error creating mutex in apr_thread_mutex_create") return NULL;
self->unclonable = TRUE;
Modified: trunk/src/builtins-tuple.c
===================================================================
--- trunk/src/builtins-tuple.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/builtins-tuple.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -226,7 +226,7 @@
raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "memory allocation failed for tuple multiplication");
return NULL;
}
- SET_TYPE_IF_EXC(res, DATA_TYPE_DATAPTR) return NULL;
+ SET_TYPE_IF_EXC(Tuple_OBJ, res, DATA_TYPE_DATAPTR) return NULL;
lstpsize(lstp) = size;
lstplen(lstp) = size;
for(i=0; i < times; i++)
Modified: trunk/src/object.c
===================================================================
--- trunk/src/object.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/object.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -199,6 +199,7 @@
dll_services.proto_item = proto_item;
dll_services.dump = dump;
dll_services.obj_data_owner = obj_data_owner;
+ dll_services.obj_set_data_owner = obj_set_data_owner;
/* Setup the core objects. Order counts here */
OBJ(OBJECT) = NEW_OBJ(NULL);
@@ -306,6 +307,20 @@
return copy;
}
+//********************************* obj_set_data_owner ************************
+void obj_set_data_owner(isp ist, obj_p obj, obj_p owner) {
+ attr_p attrp;
+ int i, numprotos, owner_set = FALSE;
+ if (obj == owner || !obj->has_attrs) return;
+ attrp = obj->attr_proto.attrs;
+ numprotos = attr_plen(attrp);
+ for (i=0; i < numprotos; i++)
+ owner_set |= (attr_pp(attrp, i)->proto.owns_binary =
+ (attr_proto_item(attrp, i) == owner));
+ if (!owner_set)
+ raise_exception(ist, OBJ(INTERNAL_EXC), "obj_set_data_owner error");
+}
+
//********************************* obj_data_owner ****************************
obj_p obj_data_owner(obj_p obj) {
attr_p attrp;
@@ -937,14 +952,14 @@
}
//********************************* obj_alloc ***************************
-void* obj_malloc(isp ist, obj_p obj, size_t size) {
+void* obj_malloc(isp ist, obj_p proto, obj_p obj, size_t size) {
if (size <= sizeof(obj_data_t)){
- SET_TYPE_IF_EXC(obj, DATA_TYPE_IMMDATA)
+ SET_TYPE_IF_EXC(proto, obj, DATA_TYPE_IMMDATA)
return NULL;
obj->imm_data_len = (int) size;
return &obj->data;
} else {
- SET_TYPE_IF_EXC(obj, DATA_TYPE_DATAPTR)
+ SET_TYPE_IF_EXC(proto, obj, DATA_TYPE_DATAPTR)
return NULL;
obj->data.ptr = pr_malloc(size);
return obj->data.ptr;
Modified: trunk/src/parser_routines.c
===================================================================
--- trunk/src/parser_routines.c 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/parser_routines.c 2004-05-01 04:06:44 UTC (rev 436)
@@ -511,7 +511,7 @@
res->code_data[k++].bytecode.param = 3;
func = new_object(IST, OBJ(FUNC_PROTO));
code_len = sizeof(code) + body->len * sizeof(code_t);
- memmove(obj_malloc(IST, func, code_len), body, code_len);
+ memmove(obj_malloc(IST, OBJ(FUNC_PROTO), func, code_len), body, code_len);
res->code_data[k++].data = func;
res->code_data[k++].num = llen;
assert(k = len);
@@ -1236,7 +1236,7 @@
add_code(self, res, &k);
func = new_object(IST, OBJ(FUNC_PROTO));
code_len = blen * sizeof(code_t);
- memmove(obj_malloc(IST, func, code_len), body, code_len);
+ memmove(obj_malloc(IST, OBJ(FUNC_PROTO), func, code_len), body, code_len);
switch (flg) {
case DEF_FLG: opcode = OP_DEF; pcnt = 3; depth_dec = 2; break;
case GEN_FLG: opcode = OP_GEN; pcnt = 3; depth_dec = 2; break;
@@ -1353,7 +1353,7 @@
code_p int_to_obj(void* param, i64_t num){
code_p res;
obj_p obj = new_object(IST, OBJ(INT_PROTO));
- *((i64_t*) obj_malloc(IST, obj, sizeof(i64_t))) = num;
+ *((i64_t*) obj_malloc(IST, OBJ(INT_PROTO), obj, sizeof(i64_t))) = num;
res = new_code(param, 2, 1, 1, OP_PUSH);
res->code_data[0].bytecode.param = 2;
res->code_data[1].data = obj;
@@ -1362,9 +1362,9 @@
}
code_p float_to_obj(void* param, double num, int imag_flag){
code_p res;
- obj_p obj = new_object(IST,
- (imag_flag == NEW_IMAG? OBJ(IMAG_PROTO) : OBJ(FLOAT_PROTO)) );
- *((double*) obj_malloc(IST, obj, sizeof(double))) = num;
+ obj_p proto = (imag_flag == NEW_IMAG? OBJ(IMAG_PROTO) : OBJ(FLOAT_PROTO));
+ obj_p obj = new_object(IST, proto);
+ *((double*) obj_malloc(IST, proto, obj, sizeof(double))) = num;
res = new_code(param, 2, 1, 1, OP_PUSH);
res->code_data[0].bytecode.param = 2;
res->code_data[1].data = obj;
@@ -1375,15 +1375,15 @@
code_p p = new_code(param, 2, 1, 1, OP_PUSH);
pr_str_p obj_str;
size_t len = strlen(str);
- obj_p obj = new_object(IST,
- (long_flag == NEW_LONG? OBJ(LONG_PROTO) : OBJ(STRING_PROTO)) );
+ obj_p proto = (long_flag == NEW_LONG? OBJ(LONG_PROTO) : OBJ(STRING_PROTO));
+ obj_p obj = new_object(IST, proto);
if (len < IMMEDIATE_DATA_LEN) {
obj->data_type = DATA_TYPE_IMMDATA;
obj->imm_data_len = (int) len;
memcpy(obj->data.str, str, len);
obj->data.str[len] = 0;
} else {
- obj_str = obj_malloc(IST, obj, sizeof(pr_str_t)+len+1);
+ obj_str = obj_malloc(IST, proto, obj, sizeof(pr_str_t)+len+1);
obj_str->len = len;
memcpy(&(obj_str->str[0]), str, len);
obj_str->str[len] = 0;
Modified: trunk/src/src.vcproj
===================================================================
--- trunk/src/src.vcproj 2004-05-01 01:33:08 UTC (rev 435)
+++ trunk/src/src.vcproj 2004-05-01 04:06:44 UTC (rev 436)
@@ -247,7 +247,7 @@
Name="Resource Files"
Filter="rc;ico;cur;bmp;dlg;rc2;rct;bin;rgs;gif;jpg;jpeg;jpe">
<File
- RelativePath="..\pr\closure.pr">
+ RelativePath="..\pr\bin.pr">
</File>
<File
RelativePath="init.pth">