rev 321 - in trunk: . include/prothon src

Author: mark
Date: 2004-04-10 20:07:29 -0400 (Sat, 10 Apr 2004)
New Revision: 321

Modified:
   trunk/STATUS.txt
   trunk/include/prothon/prothon.h
   trunk/src/builtins-core.c
   trunk/src/builtins-thread.c
   trunk/src/object.c
   trunk/src/src.vcproj
Log:
added threads.pr

Modified: trunk/STATUS.txt
===================================================================
--- trunk/STATUS.txt	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/STATUS.txt	2004-04-11 00:07:29 UTC (rev 321)
@@ -3,8 +3,6 @@
 
 --- add list comprehension
 
---- add thread object so prothon code can create threads
-
 --- catch exceptions during module loading
 
 --- help() in interactive console()
@@ -41,6 +39,8 @@
 How do we add "properties"?
 
 Python add-on C module adapter for Prothon
+Swig or other (what GTK port used?) backend
+auto python -> prothon source converter
 
 Guido's regret list for Python
 	drop 3-way compare? (but... comparing lists) (what is this MCH?)

Modified: trunk/include/prothon/prothon.h
===================================================================
--- trunk/include/prothon/prothon.h	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/include/prothon/prothon.h	2004-04-11 00:07:29 UTC (rev 321)
@@ -510,16 +510,24 @@
 int has_proto_QUES(isp ist, obj_p obj, obj_p obj_proto);
 
 // CHECK_TYPE_EXC: Convenience macro for type validation of objects
-// (usually self).
+// (usually parms[1])
 #define CHECK_TYPE_EXC(__obj, __proto_obj, name)			\
-do {									\
+do {														\
 	if (!has_proto_QUES(ist, __obj, __proto_obj)) {			\
-		raise_exception(ist, OBJ(TYPE_EXC),			\
-				"object is not of type " #name);	\
-		return NULL;						\
-	}								\
+		raise_exception(ist, OBJ(TYPE_EXC),					\
+				"object is not of type " #name);			\
+		return NULL;										\
+	}														\
 } while(0)
 
+// IF_APR_ERR: Convenience macro for apr call error checking
+#define IF_APR_ERR(msg)													\
+	if (aprerr != APR_SUCCESS) {										\
+		char buf[80];  apr_strerror(aprerr, buf, sizeof(buf));			\
+		raise_exception(ist, OBJ(INTERNAL_EXC), "%s: %s", (msg), buf);	\
+	}																	\
+	if (aprerr != APR_SUCCESS)
+
 // SWITCH_PROTO_TO: Replace all old protos with a new single proto object
 void switch_proto_to(isp ist, obj_p obj, obj_p new_proto);
 

Modified: trunk/src/builtins-core.c
===================================================================
--- trunk/src/builtins-core.c	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/src/builtins-core.c	2004-04-11 00:07:29 UTC (rev 321)
@@ -311,6 +311,15 @@
 DEF(Object, Current_thread, NULL) {
 	return os_thread_2_obj(apr_os_thread_current());
 }
+
+DEF(Object, Sleep, FORM_RPARAM) {
+	obj_p thd;
+	CHECK_TYPE_EXC(parms[1], OBJ(FLOAT_PROTO), "float");
+	thd = os_thread_2_obj(apr_os_thread_current());
+	call_func1(ist, thd, sym(ist, "sleep"), new_float_obj(ist, parms[1]->data.f64));
+	return parms[1];
+}
+
 // ***************************** PR_FALSE *****************************************
 
 MODULE_START(False)
@@ -653,6 +662,7 @@
 	MODULE_ADD_SYM(Object, __notin__QUES);
 	MODULE_ADD_SYM(Object, attrs);
 	MODULE_ADD_SYM(Object, Current_thread);
+	MODULE_ADD_SYM(Object, Sleep);
 
 	MODULE_SUB_INIT(Seq);
 

Modified: trunk/src/builtins-thread.c
===================================================================
--- trunk/src/builtins-thread.c	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/src/builtins-thread.c	2004-04-11 00:07:29 UTC (rev 321)
@@ -113,23 +113,17 @@
 					  void *thread_data, obj_p thread_obj ) {
 	apr_status_t aprerr;
 	apr_thread_t *new_thread = NULL;
-	char buf[1024];
 
 	if (!thread_pool) {
-		if ((aprerr = apr_pool_create(&thread_pool, get_pr_head_pool())) != APR_SUCCESS) {
-			printf("Main error: apr_pool_create: %s\n",
-				apr_strerror(aprerr, buf, sizeof(buf)));
-			pr_exit(1);
-		}
+		aprerr = apr_pool_create(&thread_pool, get_pr_head_pool());
+		IF_APR_ERR("apr_pool_create") return NULL;
 	}
 
 	if (!thread_attr) {
-		if ((aprerr = apr_threadattr_create(&thread_attr, thread_pool)) != APR_SUCCESS ||
-		    (aprerr = apr_threadattr_detach_set(thread_attr, 1)) != APR_SUCCESS) {
-			printf("Main error: apr_threadattr: %s\n",
-				apr_strerror(aprerr, buf, sizeof(buf)));
-			pr_exit(1);
-		}
+		aprerr = apr_threadattr_create(&thread_attr, thread_pool);
+		IF_APR_ERR("apr_threadattr_create") return NULL;
+		aprerr = apr_threadattr_detach_set(thread_attr, 1);
+		IF_APR_ERR("apr_threadattr_detach_set") return NULL;
 	}
 
 	/* Lock this, so we don't start a new thread, until the last one
@@ -143,12 +137,9 @@
 		memset(thread_obj->data.ptr, 0, sizeof(pr_thread_t));
 	}
 
-	if ( ( aprerr = apr_thread_create( &new_thread, thread_attr, thread_func,
-					            thread_data, thread_pool ) ) != APR_SUCCESS ) {
-		printf("Main error: apr_thread_create: %s\n",
-			apr_strerror(aprerr, buf, sizeof(buf)));
-		pr_exit(1);
-	}
+	aprerr = apr_thread_create(&new_thread, thread_attr, thread_func, thread_data, thread_pool);
+	IF_APR_ERR("apr_thread_create") return NULL;
+
 	new_thread_object = thread_obj;
 	return thread_obj;
 }
@@ -304,11 +295,8 @@
 		raise_exception(ist, OBJ(INTERPRETER_EXC), "cannot join this thread");
 		return NULL;
 	}
-	aprerr = apr_thread_join(&retval, thread_ptr->apr_thread); 
-	if (aprerr != APR_SUCCESS) {
-		raise_exception(ist, OBJ(INTERNAL_EXC), "error calling apr_thread_join");
-		return NULL;
-	}
+	aprerr = apr_thread_join(&retval, thread_ptr->apr_thread);
+	IF_APR_ERR("error in thread join") return NULL;
 	return new_int_obj(ist, retval);
 }
 
@@ -333,16 +321,10 @@
 	apr_pool_t *subpool;
 
 	aprerr = apr_pool_create(&subpool, get_pr_head_pool());
-	if (aprerr != APR_SUCCESS) {
-		raise_exception(ist, OBJ(OUTOFMEMORY_EXC), "out of memory creating mutex");
-		return NULL;
-	}
+	IF_APR_ERR("out of memory creating mutex") return NULL;
 	self->data_type = OBJ_TYPE_DATAPTR;
 	aprerr = apr_thread_mutex_create(&((apr_thread_mutex_t*)(self->data.ptr)), APR_THREAD_MUTEX_UNNESTED, subpool);
-	if (aprerr != APR_SUCCESS) {
-		raise_exception(ist, OBJ(INTERNAL_EXC), "error creating mutex in apr_thread_mutex_create");
-		return NULL;
-	}
+	IF_APR_ERR("error creating mutex in apr_thread_mutex_create") return NULL;
 	return OBJ(NONE);
 }
 
@@ -354,10 +336,7 @@
 
 DEF(Mutex, lock, NULL) {
 	apr_status_t aprerr = apr_thread_mutex_lock((apr_thread_mutex_t*)(self->data.ptr));
-	if (aprerr != APR_SUCCESS) {
-		raise_exception(ist, OBJ(INTERNAL_EXC), "error in apr_thread_mutex_lock");
-		return NULL;
-	}
+	IF_APR_ERR("error in apr_thread_mutex_lock") return NULL;
 	return self;
 }
 
@@ -365,18 +344,13 @@
 	apr_status_t aprerr = apr_thread_mutex_trylock((apr_thread_mutex_t*)(self->data.ptr));
 	if (APR_STATUS_IS_EBUSY(aprerr)) return OBJ(PR_FALSE);
 	else if (aprerr == APR_SUCCESS)	 return OBJ(PR_TRUE);
-	else {
-		raise_exception(ist, OBJ(INTERNAL_EXC), "error in apr_thread_mutex_trylock");
-		return NULL;
-	}
+	IF_APR_ERR("error in apr_thread_mutex_trylock") return NULL;
+	return NULL;
 }
 
 DEF(Mutex, unlock, NULL) {
 	apr_status_t aprerr = apr_thread_mutex_unlock((apr_thread_mutex_t*)(self->data.ptr));
-	if (aprerr != APR_SUCCESS) {
-		raise_exception(ist, OBJ(INTERNAL_EXC), "error in apr_thread_mutex_unlock");
-		return NULL;
-	}
+	IF_APR_ERR("error in apr_thread_mutex_unlock") return NULL;
 	return self;
 }
 

Modified: trunk/src/object.c
===================================================================
--- trunk/src/object.c	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/src/object.c	2004-04-11 00:07:29 UTC (rev 321)
@@ -316,7 +316,6 @@
 	return res;
 }
 
-
 //********************************* raise_exception ***************************
 void raise_exception(isp ist, obj_p proto_obj, const char *format, ...)
 {
@@ -324,7 +323,7 @@
 		proto_obj = OBJ(EXCEPTION);
 	ist->exception_obj = new_object(ist, proto_obj);
 	if (format) {
-		char err_buf[512];
+		char *p, err_buf[512];
 		va_list ap;
 
 		va_start(ap, format);
@@ -332,6 +331,10 @@
 		va_end(ap);
 
 		ist->exception_obj->wr_access = ACC_GUEST;
+
+		p = err_buf + strlen(err_buf) - 1;
+		while (*p == '.' || *p == ' ' || *p == '\t') { *p = 0; p--; }
+
 		add_doc_to_obj(ist, ist->exception_obj, err_buf);
 	}
 }

Modified: trunk/src/src.vcproj
===================================================================
--- trunk/src/src.vcproj	2004-04-10 22:56:28 UTC (rev 320)
+++ trunk/src/src.vcproj	2004-04-11 00:07:29 UTC (rev 321)
@@ -288,6 +288,9 @@
 			<File
 				RelativePath="..\pr\test.pr">
 			</File>
+			<File
+				RelativePath="..\pr\threads.pr">
+			</File>
 		</Filter>
 	</Files>
 	<Globals>