rev 313 - trunk/src
SVN User <[email protected]>
| Newsgroups | gmane.comp.lang.prothon.cvs |
|---|---|
| Message-ID | <[email protected]> |
Author: mark
Date: 2004-04-09 21:10:16 -0400 (Fri, 09 Apr 2004)
New Revision: 313
Added:
trunk/src/builtins-thread.c
Modified:
trunk/src/builtins-core.c
trunk/src/console.c
trunk/src/interp.c
trunk/src/interp.h
trunk/src/main.c
trunk/src/memory_mgr.c
trunk/src/src.vcproj
trunk/src/thread.h
Log:
added builtins-thread.c
Modified: trunk/src/builtins-core.c
===================================================================
--- trunk/src/builtins-core.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/builtins-core.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -143,14 +143,12 @@
}
DEF(Object, set_read_access, FORM_RPARAM) {
- int rqacc;
CHECK_TYPE_EXC(parms[1], OBJ(INT_PROTO), "integer");
- rqacc = (int) parms[1]->data.i64;
- if (rqacc > ist->access) {
- raise_exception(ist, OBJ(PERMISSION_EXC), "attempt to raise access greater than own level");
+ if (ist->access < get_obj_wracc(self)) {
+ raise_exception(ist, OBJ(PERMISSION_EXC), "write access permission error");
return NULL;
}
- set_obj_rdacc(self, rqacc);
+ set_obj_rdacc(self, (int) parms[1]->data.i64);
return parms[1];
}
@@ -159,14 +157,12 @@
}
DEF(Object, set_write_access, FORM_RPARAM) {
- int rqacc;
CHECK_TYPE_EXC(parms[1], OBJ(INT_PROTO), "integer");
- rqacc = (int) parms[1]->data.i64;
- if (rqacc > ist->access) {
- raise_exception(ist, OBJ(PERMISSION_EXC), "attempt to raise access greater than own level");
+ if (ist->access < get_obj_wracc(self)) {
+ raise_exception(ist, OBJ(PERMISSION_EXC), "write access permission error");
return NULL;
}
- set_obj_wracc(self, rqacc);
+ set_obj_wracc(self, (int) parms[1]->data.i64);
return parms[1];
}
Added: trunk/src/builtins-thread.c
===================================================================
--- trunk/src/builtins-thread.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/builtins-thread.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -0,0 +1,198 @@
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+
+// builtins.c
+
+#include <stdio.h>
+#include <string.h>
+
+#include <apr_strings.h>
+
+#include <prothon/prothon.h>
+#include "thread.h"
+#include "object.h"
+#include <prothon/prothon_dll.h>
+
+obj_p new_thread_object;
+clist_p thread_registry;
+DECLARE_PR_LOCK(thread_registry_lock);
+
+MODULE_DECLARE(Thread);
+
+//**************************** register_thread ********************************
+/* New threads must call this first thing, it will release the
+ * thread_registry_lock so that other threads can start.
+ * Returns the matching thread object */
+obj_p register_thread(isp ist, apr_thread_t *this_thread)
+{
+ obj_p res = new_thread_object;
+ pr_thread_p thread_ptr = res->data.ptr;
+ thread_ptr->ist = ist;
+ thread_ptr->apr_os_thread = apr_os_thread_current();
+ thread_ptr->apr_thread = this_thread;
+ clist_append(thread_registry, res);
+ thread_ptr->running = TRUE;
+ pr_unlock(&thread_registry_lock);
+ return res;
+}
+
+static apr_threadattr_t *thread_attr = NULL;
+static apr_pool_t *thread_pool = NULL;
+
+//********************************* new_thread_obj ****************************
+obj_p new_thread_obj(isp ist, apr_thread_start_t thread_func, void *thread_data)
+{
+ 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);
+ }
+ }
+
+ 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);
+ }
+ }
+
+ /* Lock this, so we don't start a new thread, until the last one
+ * calls register_thread(). */
+ pr_lock(&thread_registry_lock);
+
+ new_thread_object = new_object(ist, OBJ(THREAD_PROTO));
+ new_thread_object->data_type = OBJ_TYPE_DATAPTR;
+ new_thread_object->data.ptr = pr_malloc(sizeof(pr_thread_t));
+ memset(new_thread_object->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);
+ }
+ return new_thread_object;
+}
+
+//********************************* os_thread_2_apr ***************************
+apr_thread_t* os_thread_2_apr(apr_os_thread_t os_thread) {
+ int i;
+ apr_thread_t *res = NULL;
+
+ pr_lock(&thread_registry_lock);
+ for (i = 0; i < clist_len(thread_registry); i++) {
+ obj_p thread_obj = clist_item(thread_registry, i);
+ pr_thread_p thread_ptr = thread_obj->data.ptr;
+ if (thread_ptr->apr_os_thread == os_thread) {
+ res = thread_ptr->apr_thread;
+ break;
+ }
+ }
+ pr_unlock(&thread_registry_lock);
+
+ return res;
+}
+
+
+MODULE_START(Thread)
+{
+ pr_thread_p thread;
+
+ Thread_OBJ = OBJ(THREAD_PROTO);
+ MODULE_SET_DOC(Thread, "thread object prototype");
+ set_attr(ist, OBJ(OBJECT), sym(ist, "Thread"), Thread_OBJ);
+
+ Thread_OBJ->data_type = OBJ_TYPE_DATAPTR;
+ thread = obj_malloc(Thread_OBJ, sizeof(pr_thread_t));
+ memset(thread, 0, sizeof(pr_thread_t));
+}
+
+
+DEF(Thread, __init__, list2(ist, sym(ist, "access"), new_int_obj(ist, -1))) {
+ int rqacclevel;
+ CHECK_TYPE_EXC(parms[1], OBJ(INT_PROTO), "integer");
+ rqacclevel = (int) parms[1]->data.i64;
+ if (rqacclevel == -1) rqacclevel = ist->access;
+ if (ist->access < rqacclevel) {
+ raise_exception(ist, OBJ(PERMISSION_EXC),
+ "attempt to start thread with higher access level than own");
+ return NULL;
+ }
+ // ist->access = rqacclevel; XXX
+ return OBJ(NONE);
+}
+
+DEF(Thread, __str__, NULL) {
+ 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));
+ else
+ apr_snprintf(name, sizeof(name), "<Thread:%lx>", (unsigned long)(uintptr_t)self);
+ return new_string_obj(ist, name);
+}
+
+
+MAIN_MODULE_INIT(Thread)
+{
+ MODULE_SUB_INIT(Thread);
+ MODULE_ADD_SYM(Thread, __init__);
+ MODULE_ADD_SYM(Thread, __str__);
+}
Property changes on: trunk/src/builtins-thread.c
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/src/console.c
===================================================================
--- trunk/src/console.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/console.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -181,7 +181,7 @@
void console(isp ist) {
obj_p res;
- exec_frame_t* frame = NULL;
+ frame_p frame = NULL;
char buf[16];
int ind_level = 0, colon_flg = FALSE;
char histfile[512], *home;
Modified: trunk/src/interp.c
===================================================================
--- trunk/src/interp.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/interp.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -72,7 +72,7 @@
static FILE* tfout=NULL;
-static int prt_code_line(exec_frame_t* frame, code_p code, int pc, FILE* fout);
+static int prt_code_line(frame_p frame, code_p code, int pc, FILE* fout);
isp get_ist(access_t access) {
isp ist = pr_malloc(sizeof(interp_state_t));
@@ -83,7 +83,7 @@
return ist;
}
-void trace_step(exec_frame_t* frame) {
+void trace_step(frame_p frame) {
int i;
if (!tfout) tfout = fopen("code_trace.txt", "w");
prt_code_line(frame, fr_code, fr_pc, tfout);
@@ -94,16 +94,16 @@
fflush(tfout);
}
-//******************************** new_exec_frame *****************************
-exec_frame_t* new_exec_frame( isp ist, obj_p syn_self, obj_p self, obj_p globals,
+//******************************** create_frame *****************************
+frame_p create_frame( isp ist, obj_p syn_self, obj_p self, obj_p globals,
obj_p syn_locals, obj_p dyn_locals, obj_p locals,
obj_p func_obj, code_p code_in ) {
- exec_frame_t* frame;
+ frame_p frame;
code_p code;
size_t flen;
if (func_obj) code = obj_data_p(func_obj);
else code = code_in;
- flen = sizeof(exec_frame_t) + (code->max_stack_depth+STACK_PADDING) * sizeof(obj_p);
+ flen = sizeof(frame_t) + (code->max_stack_depth+STACK_PADDING) * sizeof(obj_p);
frame = pr_malloc(flen);
memset(frame, 0, flen);
frame->syn_self = syn_self;
@@ -248,7 +248,7 @@
//******************************** load_frame_params **************************
void load_frame_params( isp ist,
- exec_frame_t* old_frame,
+ frame_p old_frame,
obj_p func_obj,
int parm_cnt, obj_p *actparams) {
int i, llen;
@@ -282,7 +282,7 @@
}
//******************************** add_frame_to_exception *********************
-void add_frame_to_exception(isp ist, exec_frame_t* frame) {
+void add_frame_to_exception(isp ist, frame_p frame) {
int i, pc, line=0, col=0;
clist_p srcmap;
obj_p fstk_obj, orig_excobj, str_obj=NULL;
@@ -353,7 +353,7 @@
}
//******************************** import_module **********************************
-obj_p import_module( isp ist, exec_frame_t* frame, int param,
+obj_p import_module( isp ist, frame_p frame, int param,
int store_local, obj_p alias, int return_mod ){
int i, llen, pkg_depth = 1;
obj_p dest_module, module_symbol, dmod;
@@ -500,9 +500,9 @@
}
//******************************** do_return **********************************
-#define DONE_FRAME_FLAG ((exec_frame_t*) 1)
-obj_p do_return( isp ist, exec_frame_t* frame,
- exec_frame_t* *switch_frame, exec_frame_t* *free_frame, obj_p return_value ){
+#define DONE_FRAME_FLAG ((frame_p) 1)
+obj_p do_return( isp ist, frame_p frame,
+ frame_p *switch_frame, frame_p *free_frame, obj_p return_value ){
obj_p res = NULL;
if (fr_prev) {
if (fr_pc == fr_code->len && fr_sp == 0)
@@ -526,7 +526,7 @@
}
//******************************** fr_exstk_append ****************************
-void exstk_push(exec_frame_t* frame, exception_entry_t* exc_entry){
+void exstk_push(frame_p frame, exception_entry_t* exc_entry){
if (!fr_exstk) fr_exstk = new_clist(5);
clist_append(fr_exstk, exc_entry);
}
@@ -564,8 +564,7 @@
obj_p func_obj, temp = NULL;
opcode_t op;
int i, param, super_flag;
- exec_frame_t *switch_frame = NULL, *free_frame = NULL;
- exec_frame_t* frame = ist->frame;
+ frame_p switch_frame = NULL, free_frame = NULL, frame = ist->frame;
int have_exstk, exc_try_loc = 0, exc_exc_loc = 0, return_flag = FALSE;
int exc_final=0, exc_final_return=0, stack_lim = frame->code->max_stack_depth;
obj_p exc_waiting=NULL, return_value = 0;
@@ -773,7 +772,7 @@
}
#endif
if (op == OP_GEN) {
- exec_frame_t* new_frame = new_exec_frame( ist,
+ frame_p new_frame = create_frame( ist,
NULL, frame->self, NULL, NULL,
frame->dyn_locals, frame->locals, func, NULL );
new_frame->gen_marker = TRUE;
@@ -850,7 +849,7 @@
parse_state* state;
code_p code;
obj_p str_obj;
- exec_frame_t* new_frame;
+ frame_p new_frame;
str_obj = fr_pop;
if (!has_proto_QUES(ist, str_obj, OBJ(STRING_PROTO))){
raise_exception(ist, OBJ(TYPE_EXC), "Exec parameter must be a string");
@@ -858,7 +857,7 @@
}
state = parse_file_or_string(ist, NULL, strch(str_obj));
if (!state || !(code = (state->parse_results))) break;
- new_frame = new_exec_frame( ist, NULL, frame->self, frame->globals, frame->syn_locals,
+ new_frame = create_frame( ist, NULL, frame->self, frame->globals, frame->syn_locals,
frame->dyn_locals, frame->locals, NULL, code );
new_frame->globals = frame->globals;
new_frame->syn_locals = frame->syn_locals;
@@ -882,11 +881,11 @@
fr_push(res);
} else if (has_proto_QUES(ist, func_obj, OBJ(FUNC_PROTO))) {
obj_p new_locals, syn_self;
- exec_frame_t* new_frame;
+ frame_p new_frame;
if (intrp_exobj) break;
new_locals = new_object(ist, NULL);
syn_self = get_attr(ist, func_obj, SYM(__SELF__)); if (intrp_exobj) break;
- new_frame = new_exec_frame( ist, syn_self, NULL, NULL, NULL,
+ new_frame = create_frame( ist, syn_self, NULL, NULL, NULL,
frame->locals, new_locals, func_obj, NULL );
fr_next = new_frame;
new_frame->prev_frame = frame;
@@ -894,7 +893,7 @@
if (intrp_exobj) break;
switch_frame = new_frame;
} else if (has_proto_QUES(ist, func_obj, OBJ(GEN_PROTO))) {
- exec_frame_t* tmp_frame;
+ frame_p tmp_frame;
if (intrp_exobj) break;
tmp_frame = func_obj->data.ptr;
frame->next_frame = tmp_frame;
@@ -914,7 +913,7 @@
} break;
case OP_WITH:
fr_sp--;
- switch_frame = new_exec_frame( ist, NULL, fr_stack[fr_sp], frame->globals, frame->syn_locals,
+ switch_frame = create_frame( ist, NULL, fr_stack[fr_sp], frame->globals, frame->syn_locals,
frame->dyn_locals, frame->locals, fr_data(1), NULL );
switch_frame->prev_frame = frame;
frame->next_frame = switch_frame;
@@ -935,7 +934,7 @@
break;
}
if (fr_stack[fr_sp+1] == SYM(NEXT) && has_proto_QUES(ist, fr_stack[fr_sp], OBJ(GEN_PROTO))) {
- exec_frame_t* new_frame=(exec_frame_t*)(fr_stack[fr_sp]->data.ptr);
+ frame_p new_frame=(frame_p)(fr_stack[fr_sp]->data.ptr);
if (!new_frame) {
raise_exception(ist, OBJ(STOP_ITERATION_EXC), NULL);
break;
@@ -979,11 +978,11 @@
fr_push(res);
} else if (has_proto_QUES(ist, func_obj, OBJ(FUNC_PROTO))) {
obj_p new_locals, syn_self;
- exec_frame_t* new_frame;
+ frame_p new_frame;
if (intrp_exobj) break;
new_locals = new_object(ist, NULL);
syn_self = get_attr(ist, func_obj, SYM(__SELF__)); if (intrp_exobj) break;
- new_frame = new_exec_frame( ist, syn_self, super_flag? frame->self : fr_stack[fr_sp], NULL, NULL,
+ new_frame = create_frame( ist, syn_self, super_flag? frame->self : fr_stack[fr_sp], NULL, NULL,
frame->locals, new_locals, func_obj, NULL );
fr_next = new_frame;
new_frame->prev_frame = frame;
@@ -991,7 +990,7 @@
if (intrp_exobj) break;
switch_frame = new_frame;
} else if (has_proto_QUES(ist, func_obj, OBJ(GEN_PROTO))) {
- exec_frame_t* tmp_frame;
+ frame_p tmp_frame;
if (intrp_exobj) break;
tmp_frame = func_obj->data.ptr;
frame->next_frame = tmp_frame;
@@ -1023,7 +1022,7 @@
ist->exception_obj = fr_pop;
break;
case OP_YIELD: {
- exec_frame_t* fp;
+ frame_p fp;
for (fp=frame; fp && !(fp->gen_marker); fp=fp->prev_frame);
if (!fp)
raise_exception(ist, OBJ(INTERPRETER_EXC), "Yield without enclosing gen operator");
@@ -1117,7 +1116,7 @@
fr_sp = 0;
add_frame_to_exception(ist, frame);
while (!have_exstk && frame->prev_frame && !last_called_from_c) {
- exec_frame_t* tmp_frame = frame;
+ frame_p tmp_frame = frame;
last_called_from_c = frame->called_from_c;
frame = ist->frame = frame->prev_frame;
#ifdef TRACE_INTERPRETER
@@ -1225,7 +1224,7 @@
if (!func_sym) del_unlock(self);
return res;
} else if (has_proto_QUES(ist, func_obj, OBJ(FUNC_PROTO))) {
- exec_frame_t *frame, *new_frame;
+ frame_p frame, new_frame;
obj_p new_locals, syn_self;
if (!ist) {
raise_exception(ist, OBJ(INTERNAL_EXC), "Illegal function call to Prothon function");
@@ -1243,7 +1242,7 @@
if (!func_sym) del_unlock(self);
return 0;
}
- new_frame = new_exec_frame( ist, syn_self, self, NULL, NULL, dyn_locals,
+ new_frame = create_frame( ist, syn_self, self, NULL, NULL, dyn_locals,
new_locals, func_obj, NULL );
new_frame->called_from_c = TRUE;
ist->frame->next_frame = new_frame;
@@ -1306,10 +1305,10 @@
}
//******************************** exec_string ********************************
-obj_p exec_string(isp ist, char* str, int get_frame, exec_frame_t* *frame_p) {
+obj_p exec_string(isp ist, char* str, int get_frame, frame_p *framep) {
code_p code;
obj_p new_locals;
- exec_frame_t *frame, *new_frame;
+ frame_p frame, new_frame;
parse_state* state = parse_file_or_string(ist, NULL, str);
if (check_exceptions(ist))
@@ -1329,20 +1328,20 @@
dump_code(ist, NULL, code, name);
}
#endif
- if (frame_p && *frame_p) {
- frame = *frame_p;
- new_frame = new_exec_frame( ist, NULL, frame->self, frame->globals,
+ if (framep && *framep) {
+ frame = *framep;
+ new_frame = create_frame( ist, NULL, frame->self, frame->globals,
frame->syn_locals, frame->dyn_locals, frame->locals, NULL, code );
- pr_free(*frame_p);
+ pr_free(*framep);
frame = NULL;
} else {
frame = ist->frame;
if (frame)
- new_frame = new_exec_frame( ist, NULL, frame->self, frame->globals,
+ new_frame = create_frame( ist, NULL, frame->self, frame->globals,
frame->syn_locals, frame->dyn_locals, frame->locals, NULL, code );
else {
new_locals = new_object(ist, NULL);
- new_frame = new_exec_frame( ist, NULL, OBJ(ROOT_GLOBALS), OBJ(ROOT_GLOBALS),
+ new_frame = create_frame( ist, NULL, OBJ(ROOT_GLOBALS), OBJ(ROOT_GLOBALS),
new_locals, new_locals, new_locals, NULL, code );
}
}
@@ -1351,7 +1350,7 @@
if (frame) ist->frame->next_frame = new_frame;
new_frame->prev_frame = ist->frame;
ist->frame = new_frame;
- if (get_frame) *frame_p = new_frame;
+ if (get_frame) *framep = new_frame;
return exec_loop(ist);
}
@@ -1359,8 +1358,8 @@
int load_module( isp ist, obj_p module_name, obj_p dyn_locals,
obj_p dest_module, obj_p module_alias, char* filename, char* comment,
obj_p module, char* exec_string ) {
- obj_p new_locals;
- exec_frame_t *frame, *new_frame;
+ obj_p new_locals, thread;
+ frame_p frame, new_frame;
parse_state* state;
char full_doc[1024], *name;
code_p code;
@@ -1396,11 +1395,14 @@
frame = ist->frame;
new_locals = new_object(ist, NULL);
set_attr(ist, module, SYM(__LOCALS__), new_locals);
- new_frame = new_exec_frame( ist, NULL, module, module, dest_module, dyn_locals, new_locals, NULL, code );
+ new_frame = create_frame( ist, NULL, module, module, dest_module, dyn_locals, new_locals, NULL, code );
new_frame->called_from_c = TRUE;
if (frame) ist->frame->next_frame = new_frame;
new_frame->prev_frame = ist->frame;
ist->frame = new_frame;
+ if (module && (thread = get_attr(ist, module, sym(ist, "thread"))))
+ thread_frame(thread) = new_frame;
+ if_exc_return FALSE;
exec_loop(ist); if_exc_return FALSE;
if (dest_module){
if (!module_alias) module_alias = module_name;
@@ -1438,7 +1440,9 @@
module = new_object(ist, OBJ(ROOT_GLOBALS));
su(i);
set_attr(ist, OBJ(MODULES), main_sym, module);
+ set_attr(ist, OBJ(OBJECT), main_sym, module);
set_attr(ist, thread_obj, sym(ist, "name"), new_string_obj(ist, name));
+ set_attr(ist, module, sym(ist, "thread"), thread_obj);
un_su(i);
thread_p->main_id = main_index;
break;
@@ -1496,7 +1500,7 @@
}
//******************************** prt_code_line ******************************
-static int prt_code_line(exec_frame_t* frame, code_p code, int pc, FILE* fout)
+static int prt_code_line(frame_p frame, code_p code, int pc, FILE* fout)
{
char str[CODE_DATA_STR_SIZE];
opcode_t op;
Modified: trunk/src/interp.h
===================================================================
--- trunk/src/interp.h 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/interp.h 2004-04-10 01:10:16 UTC (rev 313)
@@ -59,6 +59,7 @@
#include "object.h"
#include "parser.h"
+#include "thread.h"
#include <apr_thread_proc.h>
@@ -71,9 +72,9 @@
#define INITIAL_EXCEPTION_STACK_SIZE 10
#define EXCEPTION_STACK_GROWTH_FACTOR 2
-typedef struct exec_frame_t {
- struct exec_frame_t* next_frame;
- struct exec_frame_t* prev_frame;
+typedef struct frame_t {
+ frame_p next_frame;
+ frame_p prev_frame;
int called_from_c;
int calling_init;
int do_not_free;
@@ -86,10 +87,10 @@
obj_p globals;
int pc;
code_p code;
- clist_p exc_stack;
+ clist_p exc_stack;
int stack_ptr;
obj_p stack[];
-} exec_frame_t;
+} frame_t;
typedef struct {
int final;
@@ -111,7 +112,7 @@
void *main_thread(apr_thread_t *handle, void *filename);
-obj_p exec_string(isp ist, char* str, int get_frame, exec_frame_t* *frame_p);
+obj_p exec_string(isp ist, char* str, int get_frame, frame_p *framep);
int load_module( isp ist, obj_p module_name, obj_p dyn_locals,
obj_p dest_module, obj_p module_alias, char* filename, char* comment,
Modified: trunk/src/main.c
===================================================================
--- trunk/src/main.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/main.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -62,6 +62,7 @@
#include <prothon/prothon_dll.h>
#include "memory_mgr.h"
#include "parser.h"
+#include "thread.h"
#include "interp.h"
#include <apr_time.h>
@@ -85,91 +86,6 @@
}
-static obj_p new_thread_object;
-static clist_p thread_registry;
-static DECLARE_PR_LOCK(thread_registry_lock);
-
-//**************************** register_thread ********************************
-/* New threads must call this first thing, it will release the
- * thread_registry_lock so that other threads can start.
- * Returns the matching thread object */
-obj_p register_thread(isp ist, apr_thread_t *this_thread)
-{
- obj_p res = new_thread_object;
- pr_thread_p thread_ptr = res->data.ptr;
- thread_ptr->ist = ist;
- thread_ptr->apr_os_thread = apr_os_thread_current();
- thread_ptr->apr_thread = this_thread;
- clist_append(thread_registry, res);
- thread_ptr->running = TRUE;
- pr_unlock(&thread_registry_lock);
- return res;
-}
-
-static apr_threadattr_t *thread_attr = NULL;
-static apr_pool_t *thread_pool = NULL;
-
-//********************************* new_thread_obj ****************************
-obj_p new_thread_obj(isp ist, apr_thread_start_t thread_func, void *thread_data)
-{
- 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);
- }
- }
-
- 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);
- }
- }
-
- /* Lock this, so we don't start a new thread, until the last one
- * calls register_thread(). */
- pr_lock(&thread_registry_lock);
-
- new_thread_object = new_object(ist, OBJ(THREAD_PROTO));
- new_thread_object->data_type = OBJ_TYPE_DATAPTR;
- new_thread_object->data.ptr = pr_malloc(sizeof(pr_thread_t));
- memset(new_thread_object->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);
- }
- return new_thread_object;
-}
-
-//********************************* os_thread_2_apr ***************************
-apr_thread_t* os_thread_2_apr(apr_os_thread_t os_thread) {
- int i;
- apr_thread_t *res = NULL;
-
- pr_lock(&thread_registry_lock);
- for (i = 0; i < clist_len(thread_registry); i++) {
- obj_p thread_obj = clist_item(thread_registry, i);
- pr_thread_p thread_ptr = thread_obj->data.ptr;
- if (thread_ptr->apr_os_thread == os_thread) {
- res = thread_ptr->apr_thread;
- break;
- }
- }
- pr_unlock(&thread_registry_lock);
-
- return res;
-}
-
//********************************* main **************************************
int main(int argc, char *argv[]) {
obj_p sys_argv_obj, main_argv_obj, threads, code_str_obj, main1_thread_obj;
@@ -256,6 +172,8 @@
apr_sleep(PAUSE_MS*1000);
if (cmd_line_option_i_flg && (!main1_thread_ptr || !main1_thread_ptr->running)) {
ist->access = ACC_USER2;
+ if (main1_thread_ptr)
+ ist->frame = main1_thread_ptr->frame;
console(ist);
ist->access = ACC_SYSTEM;
cmd_line_option_i_flg = FALSE;
@@ -263,6 +181,8 @@
}
if (cmd_line_option_i_flg) {
ist->access = ACC_USER2;
+ if (main1_thread_ptr)
+ ist->frame = main1_thread_ptr->frame;
console(ist);
ist->access = ACC_SYSTEM;
}
Modified: trunk/src/memory_mgr.c
===================================================================
--- trunk/src/memory_mgr.c 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/memory_mgr.c 2004-04-10 01:10:16 UTC (rev 313)
@@ -207,6 +207,12 @@
if (ist->exception_obj) {
printf("Warning: memory manager unable to scan object: %lx\n",
(unsigned long)(uintptr_t)obj);
+
+ printf("Dumping object details to mem-mgr-obj-dump.txt\n");
+ printf("Aborting Prothon\n");
+ dump(ist, "mem-mgr-obj-dump.txt", obj);
+ pr_exit(1);
+
printf(" exception: %s\n",
strch(get_attr(ist, ist->exception_obj, SYM(__DOC__))));
ist->exception_obj = 0;
Modified: trunk/src/src.vcproj
===================================================================
--- trunk/src/src.vcproj 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/src.vcproj 2004-04-10 01:10:16 UTC (rev 313)
@@ -152,6 +152,9 @@
RelativePath=".\builtins-string.c">
</File>
<File
+ RelativePath=".\builtins-thread.c">
+ </File>
+ <File
RelativePath=".\builtins-tuple.c">
</File>
<File
Modified: trunk/src/thread.h
===================================================================
--- trunk/src/thread.h 2004-04-09 23:14:37 UTC (rev 312)
+++ trunk/src/thread.h 2004-04-10 01:10:16 UTC (rev 313)
@@ -0,0 +1,73 @@
+
+/* ====================================================================
+ * The Prothon License Agreement, Version 1.1
+ *
+ * Copyright (c) 2004 Hahn Creative Applications, http://hahnca.com.
+ * All rights reserved.
+ *
+ * 1. This LICENSE AGREEMENT is between Hahn Creative Applications ("HCA"),
+ * and the Individual or Organization ("Licensee") accessing and otherwise
+ * using Prothon software in source or binary form and its associated
+ * documentation.
+ *
+ * 2. Subject to the terms and conditions of this License Agreement, HCA
+ * hereby grants Licensee a nonexclusive, royalty-free, world-wide license
+ * to reproduce, analyze, test, perform and/or display publicly, prepare
+ * derivative works, distribute, and otherwise use Prothon alone or in any
+ * derivative version, provided, however, that HCA's License Agreement and
+ * HCA's notice of copyright, i.e., "Copyright (c) 2004 Hahn Creative
+ * Applications; All Rights Reserved" are retained in Prothon alone or
+ * in any derivative version prepared by Licensee.
+ *
+ * 3. In the event Licensee prepares a derivative work that is based on or
+ * incorporates Prothon or any part thereof, and wants to make the
+ * derivative work available to others as provided herein, then Licensee
+ * hereby agrees to include in any such work a brief summary of the
+ * changes made to Prothon.
+ *
+ * 4. HCA is making Prothon available to Licensee on an "AS IS" basis.
+ * HCA MAKES NO REPRESENTATIONS OR WARRANTIES, EXPRESS OR IMPLIED. BY WAY
+ * OF EXAMPLE, BUT NOT LIMITATION, HCA MAKES NO AND DISCLAIMS ANY
+ * REPRESENTATION OR WARRANTY OF MERCHANTABILITY OR FITNESS FOR ANY
+ * PARTICULAR PURPOSE OR THAT THE USE OF PROTHON WILL NOT INFRINGE ANY
+ * THIRD PARTY RIGHTS.
+ *
+ * 5. HCA SHALL NOT BE LIABLE TO LICENSEE OR ANY OTHER USERS OF PROTHON
+ * FOR ANY INCIDENTAL, SPECIAL, OR CONSEQUENTIAL DAMAGES OR LOSS AS A
+ * RESULT OF MODIFYING, DISTRIBUTING, OR OTHERWISE USING PROTHON, OR ANY
+ * DERIVATIVE THEREOF, EVEN IF ADVISED OF THE POSSIBILITY THEREOF.
+ *
+ * 6. This License Agreement will automatically terminate upon a material
+ * breach of its terms and conditions.
+ *
+ * 7. Nothing in this License Agreement shall be deemed to create any
+ * relationship of agency, partnership, or joint venture between HCA and
+ * Licensee. This License Agreement does not grant permission to use HCA
+ * trademarks or trade name in a trademark sense to endorse or promote
+ * products or services of Licensee, or any third party.
+ *
+ * 8. By copying, installing or otherwise using Prothon, Licensee agrees
+ * to be bound by the terms and conditions of this License Agreement.
+ * ====================================================================
+ */
+
+// thread.h
+
+#ifndef THREAD_H
+#define THREAD_H
+
+#include "clist.h"
+
+extern obj_p new_thread_object;
+extern clist_p thread_registry;
+//extern DECLARE_PR_LOCK(thread_registry_lock);
+extern pr_lock_t thread_registry_lock;
+
+#define thread_frame(thread_obj) (((pr_thread_p)((thread_obj)->data.ptr))->frame)
+
+obj_p register_thread(isp ist, apr_thread_t *this_thread);
+obj_p new_thread_obj(isp ist, apr_thread_start_t thread_func, void *thread_data);
+apr_thread_t* os_thread_2_apr(apr_os_thread_t os_thread);
+
+
+#endif // #ifndef THREAD_H
\ No newline at end of file