rev 441 - in trunk: include/prothon modules/DBM modules/File modules/Prosist modules/Re modules/SQLite pr src
SVN User <[email protected]> Sat, 01 May 2004 21:07:48 -0400
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: mark
Date: 2004-05-01 21:07:45 -0400 (Sat, 01 May 2004)
New Revision: 441
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/modules/Re/Re.c
trunk/modules/SQLite/SQLite.c
trunk/pr/modint.pr
trunk/pr/test.pr
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/interp.c
trunk/src/memory_mgr.c
trunk/src/object.c
trunk/src/src.vcproj
Log:
Fixed binary reg facility and usage in many objects,
all tests run now
Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/include/prothon/prothon.h 2004-05-02 01:07:45 UTC (rev 441)
@@ -56,7 +56,7 @@
#define PROTHON_H
//**************************** DEBUG DEFINITIONS ******************************
-
+
//#define DEBUG_THREADS
//#define DEBUG_MEM_MGR
//#define TRACE_PARSER
@@ -478,8 +478,9 @@
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);
+// PROTO_OWNS_BINARY: Prototype owns binary data in obj
+// for example, if proto is Int, then binary data is in Int format
+int proto_owns_binary(isp ist, obj_p proto, 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);
Modified: trunk/include/prothon/prothon_dll.h
===================================================================
--- trunk/include/prothon/prothon_dll.h 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/include/prothon/prothon_dll.h 2004-05-02 01:07:45 UTC (rev 441)
@@ -104,7 +104,7 @@
obj_p (*sym)(isp ist, char* symbol);
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);
+ int (*proto_owns_binary)(isp ist, obj_p proto, 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);
@@ -174,19 +174,18 @@
static obj_p slf##func(isp ist, obj_p self, int pcnt, \
obj_p* parms, obj_p dlocals)
-#define BIN_CHK(slf) \
-do {obj_p owner; \
- if ( self == slf##_OBJ || \
- !(owner = obj_data_owner(self)) ) break; \
- if (owner != slf##_OBJ) { \
- if ( owner == OBJ(TUPLE_PROTO) && slf##_OBJ == OBJ(LIST_PROTO) || \
- owner == OBJ(LIST_PROTO) && slf##_OBJ == OBJ(TUPLE_PROTO) ) \
- break; \
- raise_exception(ist, OBJ(INTERNAL_EXC), \
- "object has wrong binary data, expected %s", #slf); \
- return NULL; } \
-} while (0)
+#define BIN_EMPTY_CHK() \
+ if (self->data_type != DATA_TYPE_NONE) { \
+ raise_exception(ist, OBJ(INTERNAL_EXC), \
+ "object has binary data, expected none"); \
+ return NULL; }
+#define BIN_CHK(slf) \
+ if (!proto_owns_binary(ist, slf##_OBJ, self)) { \
+ raise_exception(ist, OBJ(INTERNAL_EXC), \
+ "object has wrong binary data, expected %s", #slf); \
+ return NULL; }
+
#define MAIN_MODULE_INIT(name) \
static void name##_module_install(void); \
PR_DECLARE_EXPORT void name##_dll_entry(pr_services_t* srvcs) \
@@ -278,7 +277,7 @@
#define raise_exception (*services->raise_exception)
#define new_object (*services->new_object)
#define copy_object_data (*services->copy_object_data)
-#define obj_data_owner (*services->obj_data_owner)
+#define proto_owns_binary (*services->proto_owns_binary)
#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)
Modified: trunk/modules/DBM/DBM.c
===================================================================
--- trunk/modules/DBM/DBM.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/modules/DBM/DBM.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -152,6 +152,7 @@
char *name, *type;
int mode, uperm;
+ BIN_EMPTY_CHK();
STRING_PARAM(1, name);
INT_32_PARAM(2, mode);
STRING_PARAM(3, type);
Modified: trunk/modules/File/File.c
===================================================================
--- trunk/modules/File/File.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/modules/File/File.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -136,6 +136,7 @@
char *path, *mode;
int bufsize;
+ BIN_EMPTY_CHK();
STRING_PARAM(1, path);
STRING_PARAM(2, mode);
INT_32_PARAM(3, bufsize);
@@ -184,7 +185,6 @@
}
DEF(File, __objList__, FORM_RPARAM) {
- BIN_CHK(File);
return parms[1];
}
@@ -655,7 +655,6 @@
DEF(File, setStdOut, FORM_RPARAM) {
int i;
- BIN_CHK(File);
if (!has_proto_QUES(ist, parms[1], File_OBJ)) {
raise_exception(ist, OBJ(TYPE_EXC), "stdout can only be assigned to a file object");
return NULL;
Modified: trunk/modules/Prosist/Prosist.c
===================================================================
--- trunk/modules/Prosist/Prosist.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/modules/Prosist/Prosist.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -932,6 +932,7 @@
obj_p root_obj;
int mode, uperm;
+ BIN_EMPTY_CHK();
STRING_PARAM(1, name);
root_obj = parms[3];
INT_32_PARAM(3, mode);
Modified: trunk/modules/Re/Re.c
===================================================================
--- trunk/modules/Re/Re.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/modules/Re/Re.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -498,7 +498,7 @@
MODULE_START(ReMatch)
{
- ReMatch_OBJ = NEW_OBJ(NULL);
+ ReMatch_OBJ = NEW_OBJ(OBJ(LIST_PROTO));
MODULE_SET_DOC(ReMatch, "prototype for regular expression match objects");
set_obj_id(ReMatch_OBJ, Re, Match);
MODULE_ADD_TO_OBJ(ReMatch, Re_OBJ, "Match");
Modified: trunk/modules/SQLite/SQLite.c
===================================================================
--- trunk/modules/SQLite/SQLite.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/modules/SQLite/SQLite.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -110,7 +110,7 @@
set_obj_doc(conn_obj, "SQLite connection");
conn_obj->unclonable = TRUE;
set_obj_rdacc(conn_obj, ACC_USER1);
- conn_obj->data_type = DATA_TYPE_DATAPTR;
+ SET_TYPE_IF_EXC(Connection_OBJ, conn_obj, DATA_TYPE_DATAPTR) return NULL;
conn_obj->data.ptr = sqlite_open(filename, 0, &errmsg);
if (errmsg) {
raise_exception(ist, Error_OBJ, errmsg);
@@ -125,7 +125,7 @@
cursor_p cursorp;
obj_p curs_obj = NEW_OBJ(Cursor_OBJ);
set_obj_doc(curs_obj, "SQLite cursor");
- curs_obj->data_type = DATA_TYPE_DATAPTR;
+ SET_TYPE_IF_EXC(Cursor_OBJ, curs_obj, DATA_TYPE_DATAPTR) return NULL;
cursorp = curs_obj->data.ptr = pr_malloc(sizeof(cursor_t));
cursorp->ist = ist;
cursorp->conn_obj = self;
Modified: trunk/pr/modint.pr
===================================================================
--- trunk/pr/modint.pr 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/pr/modint.pr 2004-05-02 01:07:45 UTC (rev 441)
@@ -1,28 +1,23 @@
#!/usr/bin/env prothon
-ModInt = Object()
-with ModInt:
- $modulo = 10 #default
- def $__init__(*x):
- if Len(x): $val = x[0] # val kludge here
+object ModInt(Int):
+ $modulo = 10
+ def $__init__(i=0):
+ return ^__init__(i % $modulo)
def $__add__(other):
if $modulo != other.modulo:
raise TypeError
- return Mod16Int(($val + other.val) % $modulo)
- def $__str__():
- return $val.__str__()
-
-Mod16Int = ModInt()
-Mod16Int.modulo = 16
+ return ^__call__(^__add__(other) % $modulo)
+object Mod16Int(ModInt):
+ $modulo = 16
+
i = Mod16Int(27)
-j = Mod16Int(4)
-k = i+j
-m = Mod16Int(19)
+j = Mod16Int(8)
+print """
-print
-print 'Following should print ...'
-print 'i: 27, j: 4, k: 15, m: 19, k+m: 2'
-print 'i: '+i+', j: '+j+', k: '+k+', m: '+m+', k+m: '+(k+m)
-print
+should print
+11 + 8 = 03
+"""
+print "%i + %i = %02i" % (i, j, (i + j))
Modified: trunk/pr/test.pr
===================================================================
--- trunk/pr/test.pr 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/pr/test.pr 2004-05-02 01:07:45 UTC (rev 441)
@@ -1,20 +1,21 @@
#!/usr/bin/env prothon
-def New(proto, *args, **kwargs):
- newObj = Proto(proto)
- newObj.__init__(*args, **kwargs)
- return newObj
+import File
-p = Object()
-with p:
- $x = None
- def $__init__(x):
- $x = x
- def $__str__():
- return '*'+$x+'*'
+stdout = File.stdout
+stdin = File.stdin
+stderr = File.stderr
-x = New(p, 1)
-print x
+stdout.write("Enter your name: ")
-y = New(p, 'a')
-print y
+name = stdin.readLine()
+
+stdout.write("Hello " + name)
+
+stderr.write("This is written on stderr\n")
+
+print "Opening test file for stdout"
+
+File.setStdOut(File("stdout.txt", "w+"))
+stdout.write("Should still go to stdout\n")
+File.stdout.write("Should go to stdout.txt file\n")
Modified: trunk/src/builtins-dict.c
===================================================================
--- trunk/src/builtins-dict.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-dict.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -278,7 +278,8 @@
obj_p list;
int i, llen, size = max(DEFAULT_INITIAL_DICT_SIZE, (int) dict_len(ist, parms[1])*3);
- dict = obj_malloc(ist, OBJ(DICT_PROTO), self, dict_sizeof(size));
+ BIN_EMPTY_CHK();
+ 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 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-float.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -110,6 +110,7 @@
DEF(Float, __init__, FORM_STAR_PARAM) {
double f = 0.0;
+ BIN_EMPTY_CHK();
if (list_len(ist, parms[1]))
FLOAT__PARAM(0, f);
SET_TYPE_IF_EXC(Float_OBJ, self, DATA_TYPE_IMMDATA) return NULL;
Modified: trunk/src/builtins-int.c
===================================================================
--- trunk/src/builtins-int.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-int.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -110,7 +110,7 @@
DEF(Int, __init__, FORM_STAR_PARAM) {
i64_t i = 0;
- BIN_CHK(Int);
+ BIN_EMPTY_CHK();
if (list_len(ist, parms[1]))
INT_64_PARAM(0,i);
SET_TYPE_IF_EXC(Int_OBJ, self, DATA_TYPE_IMMDATA) return NULL;
@@ -119,6 +119,13 @@
return OBJ(NONE);
}
+DEF(Int, __str__, NULL){
+ char str[24];
+ BIN_CHK(Int);
+ apr_snprintf(str, sizeof(str), "%"APR_INT64_T_FMT, (i64_t)Int_value(self));
+ return NEW_STRING(str);
+}
+
DEF(Int, __bool__QUES, NULL) {
BIN_CHK(Int);
if (Int_value(self)) return OBJ(PR_TRUE);
@@ -328,13 +335,6 @@
return NEW_INT(Int_value(self) << Int_value(other));
}
-DEF(Int, __str__, NULL){
- char str[24];
- BIN_CHK(Int);
- apr_snprintf(str, sizeof(str), "%"APR_INT64_T_FMT, (i64_t)Int_value(self));
- return NEW_STRING(str);
-}
-
DEF(Int, __iter__, NULL) {
obj_p gen_obj = NEW_INT(0);
BIN_CHK(Int);
Modified: trunk/src/builtins-list.c
===================================================================
--- trunk/src/builtins-list.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-list.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -313,6 +313,7 @@
}
DEF(List, __init__, FORM_STAR_PARAM) {
+ BIN_EMPTY_CHK();
read_unlock(ist, self);
read_unlock(ist, parms[1]);
copy_object_data(ist, self, parms[1]);
Modified: trunk/src/builtins-string.c
===================================================================
--- trunk/src/builtins-string.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-string.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -148,7 +148,7 @@
DEF(String, __init__, FORM_STAR_PARAM) {
char *s;
- BIN_CHK(String);
+ BIN_EMPTY_CHK();
if (!list_len(ist, parms[1]))
s = "";
else
Modified: trunk/src/builtins-thread.c
===================================================================
--- trunk/src/builtins-thread.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-thread.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -210,6 +210,7 @@
obj_p name_obj;
user_thread_p uthread;
+ BIN_EMPTY_CHK();
CHECK_TYPE_EXC(parms[1], OBJ(FUNC_PROTO), "function");
if (parms[3] != OBJ(NONE))
CHECK_TYPE_EXC(parms[3], OBJ(SEQ_PROTO), "sequence");
Modified: trunk/src/builtins-tuple.c
===================================================================
--- trunk/src/builtins-tuple.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/builtins-tuple.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -94,6 +94,7 @@
}
DEF(Tuple, __init__, FORM_STAR_PARAM) {
+ BIN_EMPTY_CHK();
read_unlock(ist, self);
read_unlock(ist, parms[1]);
copy_object_data(ist, self, parms[1]);
@@ -125,7 +126,6 @@
}
DEF(Tuple, __objList__, FORM_RPARAM) {
- BIN_CHK(Tuple);
return self;
}
Modified: trunk/src/interp.c
===================================================================
--- trunk/src/interp.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/interp.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -1057,7 +1057,6 @@
}
set_attr(ist, fr_stack[fr_sp], fr_stack[fr_sp+1], new_obj); IF_EXC_BREAK;
del_unlock(new_obj);
- //call_func0(ist, new_obj, SYM(__INIT__)); IF_EXC_BREAK;
fr_push(new_obj);
} // fall into OP_WITH on purpose
case OP_WITH:
Modified: trunk/src/memory_mgr.c
===================================================================
--- trunk/src/memory_mgr.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/memory_mgr.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -208,6 +208,7 @@
printf("Dumping object details to mm-obj-dump.txt\n");
printf("Aborting Prothon\n");
dump(ist, "mm-obj-dump.txt", obj);
+ dump(ist, "mm-ist-dump.txt", ist->exception_obj);
pr_exit(1);
printf(" exception: %s\n",
pr_strptr(get_attr(ist, ist->exception_obj, SYM(__DOC__))));
Modified: trunk/src/object.c
===================================================================
--- trunk/src/object.c 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/object.c 2004-05-02 01:07:45 UTC (rev 441)
@@ -198,7 +198,7 @@
dll_services.proto_len = proto_len;
dll_services.proto_item = proto_item;
dll_services.dump = dump;
- dll_services.obj_data_owner = obj_data_owner;
+ dll_services.proto_owns_binary = proto_owns_binary;
dll_services.obj_set_data_owner = obj_set_data_owner;
/* Setup the core objects. Order counts here */
@@ -321,20 +321,31 @@
raise_exception(ist, OBJ(INTERNAL_EXC), "obj_set_data_owner error");
}
-//********************************* obj_data_owner ****************************
-obj_p obj_data_owner(obj_p obj) {
+//********************************* proto_owns_binary *************************
+int proto_owns_binary(isp ist, obj_p proto, obj_p obj) {
attr_p attrp;
- int i, numprotos;
+ obj_p owner = NULL;
+ int i, numprotos, res;
if ( obj->data_type != DATA_TYPE_IMMDATA &&
obj->data_type != DATA_TYPE_DATAPTR )
- return NULL;
- if (!obj->has_attrs) return obj->attr_proto.proto;
- attrp = obj->attr_proto.attrs;
- numprotos = attr_plen(attrp);
- for (i=0; i < numprotos; i++)
- if (attr_pp(attrp, i)->proto.owns_binary)
- return attr_proto_item(attrp, i);
- return NULL;
+ return FALSE;
+ if (proto == obj) return TRUE;
+ if (!obj->has_attrs) owner = obj->attr_proto.proto;
+ else {
+ attrp = obj->attr_proto.attrs;
+ numprotos = attr_plen(attrp);
+ for (i=0; i < numprotos; i++)
+ if (attr_pp(attrp, i)->proto.owns_binary) {
+ owner = attr_proto_item(attrp, i);
+ break;
+ }
+ }
+ res = owner &&
+ ( (proto == owner) || has_proto_QUES(ist, proto, owner) ||
+ has_proto_QUES(ist, owner, proto) );
+ if (!res)
+ owner = NULL;
+ return res;
}
//********************************* free_object *******************************
@@ -647,11 +658,8 @@
//********************************* switch_proto ******************************
void switch_proto(isp ist, obj_p obj, obj_p new_proto) {
attr_p attrs;
- obj_p old_proto = obj_data_owner(obj);
wrlock_rtrn(obj);
- if ( old_proto != new_proto &&
- !( old_proto == OBJ(LIST_PROTO) && new_proto == OBJ(TUPLE_PROTO) ||
- old_proto == OBJ(TUPLE_PROTO) && new_proto == OBJ(LIST_PROTO) ) ) {
+ if (!proto_owns_binary(ist, new_proto, obj)) {
if (obj->data_type == DATA_TYPE_DATAPTR)
pr_free(obj->data.ptr);
obj->data_type = DATA_TYPE_NONE;
Modified: trunk/src/src.vcproj
===================================================================
--- trunk/src/src.vcproj 2004-05-01 07:05:52 UTC (rev 440)
+++ trunk/src/src.vcproj 2004-05-02 01:07:45 UTC (rev 441)
@@ -259,9 +259,6 @@
RelativePath="prothon.y">
</File>
<File
- RelativePath="..\pr\re.pr">
- </File>
- <File
RelativePath="..\status.txt">
</File>
<File