07513e1996-10-04Fredrik Hübinette (Hubbe) #include "global.h" #include "threads.h" #include "array.h" #include "object.h"
6d1a5e1996-10-07Fredrik Hübinette (Hubbe) #include "macros.h"
07513e1996-10-04Fredrik Hübinette (Hubbe)  int num_threads = 1; int threads_disabled = 0;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe) struct object *thread_id;
07513e1996-10-04Fredrik Hübinette (Hubbe)  #ifdef _REENTRANT
5988921996-10-05Fredrik Hübinette (Hubbe) MUTEX_T interpreter_lock;
07513e1996-10-04Fredrik Hübinette (Hubbe) struct program *mutex_key = 0;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe) struct program *thread_id_prog = 0;
07513e1996-10-04Fredrik Hübinette (Hubbe) pthread_attr_t pattr;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe) struct thread_starter { struct object *id; struct array *args; };
07513e1996-10-04Fredrik Hübinette (Hubbe) void *new_thread_func(void * data) {
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  struct thread_starter arg = *(struct thread_starter *)data;
07513e1996-10-04Fredrik Hübinette (Hubbe)  JMP_BUF back; INT32 args;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  free((char *)data); args=arg.args->size;
07513e1996-10-04Fredrik Hübinette (Hubbe)  mt_lock( & interpreter_lock); init_interpreter();
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  thread_id=arg.id;
07513e1996-10-04Fredrik Hübinette (Hubbe)  if(SETJMP(back)) { exit_on_error="Error in handle_error in master object!\nPrevious error:"; assign_svalue_no_free(sp++, & throw_value); APPLY_MASTER("handle_error", 1); pop_stack(); automatic_fatal=0; } else {
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  push_array_items(arg.args); arg.args=0;
07513e1996-10-04Fredrik Hübinette (Hubbe)  f_call_function(args);
6d1a5e1996-10-07Fredrik Hübinette (Hubbe) 
07513e1996-10-04Fredrik Hübinette (Hubbe)  } UNSETJMP(back);
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  destruct(thread_id); free_object(thread_id); thread_id=0;
07513e1996-10-04Fredrik Hübinette (Hubbe)  cleanup_interpret(); num_threads--;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  mt_unlock(& interpreter_lock);
07513e1996-10-04Fredrik Hübinette (Hubbe)  th_exit(0); } void f_thread_create(INT32 args) {
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  struct thread_starter *arg;
07513e1996-10-04Fredrik Hübinette (Hubbe)  pthread_t dummy; int tmp;
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  arg=ALLOC_STRUCT(thread_starter); arg->args=aggregate_array(args); arg->id=clone(thread_id_prog,0); tmp=th_create(&dummy,new_thread_func,arg); if(!tmp) { num_threads++; push_object(arg->id); arg->id->refs++; } else { free_object(arg->id); free_array(arg->args); free((char *)arg); push_int(0); } } void f_this_thread(INT32 args) { pop_n_elems(args); push_object(thread_id); thread_id->refs++;
07513e1996-10-04Fredrik Hübinette (Hubbe) } void th_init() { mt_lock( & interpreter_lock); pthread_attr_init(&pattr); pthread_attr_setstacksize(&pattr, 2 * 1024 * 1204); pthread_attr_setdetachstate(&pattr, PTHREAD_CREATE_DETACHED); add_efun("thread_create",f_thread_create,"function(mixed ...:int)",OPT_SIDE_EFFECT);
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  add_efun("this_thread",f_this_thread,"function(:object)",OPT_EXTERNAL_DEPEND);
07513e1996-10-04Fredrik Hübinette (Hubbe) }
5988921996-10-05Fredrik Hübinette (Hubbe) #define THIS_MUTEX ((struct mutex_storage *)(fp->current_storage)) /* Note: * No reference is kept to the key object, it is destructed if the * mutex is destructed. The key pointer is set to zero by the * key object when the key is destructed. */ struct mutex_storage { COND_T condition; struct object *key; }; struct key_storage { struct mutex_storage *mut; int initialized; }; static MUTEX_T mutex_kluge; #define OB2KEY(X) ((struct key_storage *)((X)->storage))
07513e1996-10-04Fredrik Hübinette (Hubbe)  void f_mutex_lock(INT32 args) {
5988921996-10-05Fredrik Hübinette (Hubbe)  struct mutex_storage *m;
07513e1996-10-04Fredrik Hübinette (Hubbe)  struct object *o;
5988921996-10-05Fredrik Hübinette (Hubbe) 
07513e1996-10-04Fredrik Hübinette (Hubbe)  pop_n_elems(args); m=THIS_MUTEX;
5988921996-10-05Fredrik Hübinette (Hubbe)  o=clone(mutex_key,0); mt_lock(& mutex_kluge);
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_ALLOW();
5988921996-10-05Fredrik Hübinette (Hubbe)  while(m->key) co_wait(& m->condition, & mutex_kluge); OB2KEY(o)->mut=m; m->key=o; mt_unlock(&mutex_kluge);
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_DISALLOW(); push_object(o); } void f_mutex_trylock(INT32 args) {
5988921996-10-05Fredrik Hübinette (Hubbe)  struct mutex_storage *m; struct object *o; int i=0;
07513e1996-10-04Fredrik Hübinette (Hubbe)  pop_n_elems(args);
5988921996-10-05Fredrik Hübinette (Hubbe)  o=clone(mutex_key,0);
07513e1996-10-04Fredrik Hübinette (Hubbe)  m=THIS_MUTEX;
5988921996-10-05Fredrik Hübinette (Hubbe)  mt_lock(& mutex_kluge);
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_ALLOW();
5988921996-10-05Fredrik Hübinette (Hubbe)  if(!m->key) { OB2KEY(o)->mut=THIS_MUTEX; m->key=o; i=1; } mt_unlock(&mutex_kluge);
07513e1996-10-04Fredrik Hübinette (Hubbe)  THREADS_DISALLOW(); if(i) { push_object(o); } else {
5988921996-10-05Fredrik Hübinette (Hubbe)  destruct(o); free_object(o);
07513e1996-10-04Fredrik Hübinette (Hubbe)  push_int(0); } }
5988921996-10-05Fredrik Hübinette (Hubbe) void init_mutex_obj(struct object *o) { co_init(& THIS_MUTEX->condition); THIS_MUTEX->key=0; }
07513e1996-10-04Fredrik Hübinette (Hubbe) 
5988921996-10-05Fredrik Hübinette (Hubbe) void exit_mutex_obj(struct object *o) { if(THIS_MUTEX->key) destruct(THIS_MUTEX->key); co_destroy(& THIS_MUTEX->condition); } #define THIS_KEY ((struct key_storage *)(fp->current_storage)) void init_mutex_key_obj(struct object *o) { THIS_KEY->mut=0; THIS_KEY->initialized=1; }
07513e1996-10-04Fredrik Hübinette (Hubbe)  void exit_mutex_key_obj(struct object *o) {
5988921996-10-05Fredrik Hübinette (Hubbe)  mt_lock(& mutex_kluge); if(THIS_KEY->mut)
07513e1996-10-04Fredrik Hübinette (Hubbe)  {
5988921996-10-05Fredrik Hübinette (Hubbe) #ifdef DEBUG if(THIS_KEY->mut->key != o) fatal("Mutex unlock from wrong key %p != %p!\n",THIS_KEY->mut->key,o); #endif THIS_KEY->mut->key=0; co_signal(& THIS_KEY->mut->condition); THIS_KEY->mut=0; THIS_KEY->initialized=0;
07513e1996-10-04Fredrik Hübinette (Hubbe)  }
5988921996-10-05Fredrik Hübinette (Hubbe)  mt_unlock(& mutex_kluge);
07513e1996-10-04Fredrik Hübinette (Hubbe) } #define THIS_COND ((COND_T *)(fp->current_storage)) void f_cond_wait(INT32 args) { COND_T *c;
5988921996-10-05Fredrik Hübinette (Hubbe)  struct object *key;
07513e1996-10-04Fredrik Hübinette (Hubbe)  if(args > 1) pop_n_elems(args - 1);
5988921996-10-05Fredrik Hübinette (Hubbe)  c=THIS_COND; if(args > 0)
07513e1996-10-04Fredrik Hübinette (Hubbe)  {
5988921996-10-05Fredrik Hübinette (Hubbe)  struct mutex_storage *mut; if(sp[-1].type != T_OBJECT)
07513e1996-10-04Fredrik Hübinette (Hubbe)  error("Bad argument 1 to condition->wait()\n");
5988921996-10-05Fredrik Hübinette (Hubbe)  key=sp[-1].u.object; if(key->prog != mutex_key) error("Bad argument 1 to condition->wait()\n"); mt_lock(&mutex_kluge); mut=OB2KEY(key)->mut; THREADS_ALLOW(); /* Unlock mutex */ mut->key=0; OB2KEY(key)->mut=0; co_signal(& mut->condition);
07513e1996-10-04Fredrik Hübinette (Hubbe) 
5988921996-10-05Fredrik Hübinette (Hubbe)  /* Wait and allow mutex operations */ co_wait(c,&mutex_kluge); if(OB2KEY(key)->initialized) { /* Lock mutex */ while(mut->key) co_wait(& mut->condition, & mutex_kluge); mut->key=key; OB2KEY(key)->mut=mut; } mt_unlock(&mutex_kluge); THREADS_DISALLOW();
07513e1996-10-04Fredrik Hübinette (Hubbe)  pop_stack();
5988921996-10-05Fredrik Hübinette (Hubbe)  } else { THREADS_ALLOW(); co_wait(c, 0); THREADS_DISALLOW();
07513e1996-10-04Fredrik Hübinette (Hubbe)  } } void f_cond_signal(INT32 args) { pop_n_elems(args); co_signal(THIS_COND); } void f_cond_broadcast(INT32 args) { pop_n_elems(args); co_broadcast(THIS_COND); } void init_cond_obj(struct object *o) { co_init(THIS_COND); } void exit_cond_obj(struct object *o) { co_destroy(THIS_COND); } void th_init_programs() { start_new_program();
5988921996-10-05Fredrik Hübinette (Hubbe)  add_storage(sizeof(struct mutex_storage));
07513e1996-10-04Fredrik Hübinette (Hubbe)  add_function("lock",f_mutex_lock,"function(:object)",0); add_function("trylock",f_mutex_trylock,"function(:object)",0); set_init_callback(init_mutex_obj); set_exit_callback(exit_mutex_obj); end_c_program("/precompiled/mutex"); start_new_program();
5988921996-10-05Fredrik Hübinette (Hubbe)  add_storage(sizeof(struct key_storage)); set_init_callback(init_mutex_key_obj);
07513e1996-10-04Fredrik Hübinette (Hubbe)  set_exit_callback(exit_mutex_key_obj); mutex_key=end_c_program("/precompiled/mutex_key");
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  mutex_key->refs++;
07513e1996-10-04Fredrik Hübinette (Hubbe)  start_new_program(); add_storage(sizeof(COND_T)); add_function("wait",f_cond_wait,"function(void|object:void)",0); add_function("signal",f_cond_signal,"function(:void)",0); add_function("broadcast",f_cond_broadcast,"function(:void)",0); set_init_callback(init_cond_obj); set_exit_callback(exit_cond_obj); end_c_program("/precompiled/condition");
6d1a5e1996-10-07Fredrik Hübinette (Hubbe)  start_new_program(); thread_id_prog=end_c_program("/precompiled/thread"); thread_id_prog->refs++; thread_id=clone(thread_id_prog,0); } void th_cleanup() { if(mutex_key) { free_program(mutex_key); mutex_key=0; } if(thread_id_prog) { free_program(thread_id_prog); thread_id_prog=0; } if(thread_id) { destruct(thread_id); free_object(thread_id); thread_id=0; }
07513e1996-10-04Fredrik Hübinette (Hubbe) } #endif