static DWORD
dde_initialise(void)
{ GET_LD
DWORD ddeInst;
dde_init_constants();
if ( !(ddeInst=LD->os.dde_instance) )
{ if ( DdeInitializeW(&ddeInst, (PFNCALLBACK)DdeCallback,
APPCLASS_STANDARD|CBF_FAIL_ADVISES|CBF_FAIL_POKES|
CBF_SKIP_REGISTRATIONS|CBF_SKIP_UNREGISTRATIONS,
0L) == DMLERR_NO_ERROR)
{ LD->os.dde_instance = ddeInst;
#ifdef O_PLMT
PL_thread_at_exit(dde_uninitialise, NULL, FALSE);
#endif
} else
{ dde_warning("initialise");
}
DEBUG(1, Sdprintf("Thread %d: created ddeInst %d\n",
PL_thread_self(), ddeInst));
}
return ddeInst;
}
int
outOfStack(void *stack, stack_overflow_action how)
{ GET_LD
Stack s = stack;
const char *msg = "unhandled stack overflow";
if ( LD->outofstack )
{ Sdprintf("[Thread %d]: failed to recover from %s-overflow\n",
PL_thread_self(), s->name);
print_backtrace_named(msg);
save_backtrace("crash");
print_backtrace_named("crash");
fatalError("Sorry, cannot continue");
return FALSE; /* NOTREACHED */
}
save_backtrace(msg);
LD->trim_stack_requested = TRUE;
LD->exception.processing = TRUE;
LD->outofstack = stack;
switch(how)
{ case STACK_OVERFLOW_THROW:
case STACK_OVERFLOW_RAISE:
{ fid_t fid;
blockGC(0 PASS_LD);
if ( (fid=PL_open_foreign_frame()) )
{ PL_clearsig(SIG_GC);
s->gced_size = 0; /* after handling, all is new */
if ( !PL_unify_term(LD->exception.tmp,
PL_FUNCTOR, FUNCTOR_error2,
PL_FUNCTOR, FUNCTOR_resource_error1,
PL_ATOM, ATOM_stack,
PL_CHARS, s->name) )
fatalError("Out of stack inside out-of-stack handler");
if ( how == STACK_OVERFLOW_THROW )
{ PL_close_foreign_frame(fid);
unblockGC(0 PASS_LD);
PL_throw(LD->exception.tmp);
warning("Out of %s stack while not in Prolog!?", s->name);
assert(0);
} else
{ PL_raise_exception(LD->exception.tmp);
}
PL_close_foreign_frame(fid);
}
unblockGC(0 PASS_LD);
fail;
}
}
assert(0);
fail;
}
static void
print_trace (void)
{ void *array[100];
size_t size;
char **strings;
size_t i;
size = backtrace(array, sizeof(array)/sizeof(void *));
strings = backtrace_symbols(array, size);
#ifdef _REENTRANT
Sdprintf("on_alarm() Prolog-context [thread %d]:\n", PL_thread_self());
#else
Sdprintf("on_alarm() Prolog-context:\n");
#endif
PL_action(PL_ACTION_BACKTRACE, 3);
Sdprintf("on_alarm() C-context:\n");
for(i = 0; i < size; i++)
{ if ( !strstr(strings[i], "checkData") )
Sdprintf("\t[%d] %s\n", i, strings[i]);
}
free(strings);
}
static void
zown(zipper *z)
{ int tid = PL_thread_self();
if ( z->owner != tid )
{ simpleMutexLock(&z->lock);
z->owner = tid;
}
}
int
wrlock(rwlock *lock, int allow_readers)
{ int self = PL_thread_self();
if ( lock->writer == self ) /* recursive write lock, used for */
{ lock->lock_level++; /* nested transactions */
return TRUE;
}
pthread_mutex_lock(&lock->mutex);
if ( lock->writer == -1 && lock->readers == 0 )
{ ok:
lock->writer = self;
lock->lock_level = 1;
lock->allow_readers = allow_readers;
pthread_mutex_unlock(&lock->mutex);
DEBUG(3, Sdprintf("WRLOCK(%d): OK\n", self));
return TRUE;
}
if ( self < lock->thread_max && lock->read_by_thread[self] > 0 )
{ DEBUG(1, Sdprintf("SELF(%d) has %d readers\n",
self, lock->read_by_thread[self]));
pthread_mutex_unlock(&lock->mutex);
return permission_error("write", "rdf_db", "default",
"Operation would deadlock");
}
lock->waiting_writers++;
DEBUG(3, Sdprintf("WRLOCK(%d): waiting ...\n", self));
for(;;)
{ int rc = pthread_cond_wait(&lock->wrcondvar, &lock->mutex);
if ( rc == EINTR )
{ if ( PL_handle_signals() < 0 )
{ lock->waiting_writers--;
pthread_mutex_unlock(&lock->mutex);
return FALSE;
}
continue;
} else if ( rc == 0 )
{ if ( lock->writer == -1 && lock->readers == 0 )
{ lock->waiting_writers--;
goto ok;
}
} else
{ assert(0); /* TBD: OS errors */
}
}
}
static void
zdisown(zipper *z)
{
#ifndef NDEBUG
int tid = PL_thread_self();
assert(z->owner == tid);
#endif
if ( z->lock_count == 0 )
{ z->owner = 0;
simpleMutexUnlock(&z->lock);
}
}
int
wrlock(rwlock *lock, int allow_readers)
{ int self = PL_thread_self();
if ( lock->writer == self ) /* recursive write lock, used for */
{ lock->lock_level++; /* nested transactions */
return TRUE;
}
EnterCriticalSection(&lock->mutex);
if ( lock->writer == -1 && lock->readers == 0 )
{ ok:
lock->writer = self;
lock->lock_level = 1;
lock->allow_readers = allow_readers;
LeaveCriticalSection(&lock->mutex);
DEBUG(3, Sdprintf("WRLOCK(%d): OK\n", self));
return TRUE;
}
if ( self < lock->thread_max && lock->read_by_thread[self] > 0 )
{ LeaveCriticalSection(&lock->mutex);
return permission_error("write", "rdf_db", "default",
"Operation would deadlock");
}
lock->waiting_writers++;
DEBUG(3, Sdprintf("WRLOCK(%d): waiting ...\n", self));
for(;;)
{ int rc = win32_cond_wait(&lock->wrcondvar, &lock->mutex);
if ( rc == WAIT_INTR )
{ lock->waiting_writers--;
LeaveCriticalSection(&lock->mutex);
return FALSE;
} else if ( rc == 0 )
{ if ( lock->writer == -1 && lock->readers == 0 )
{ lock->waiting_writers--;
goto ok;
}
} else
{ assert(0); /* TBD: OS errors */
}
}
}
static int
zlock(zipper *z)
{ int tid = PL_thread_self();
if ( z->owner != tid )
{ simpleMutexLock(&z->lock);
z->owner = tid;
z->lock_count = 1;
} else
{ z->lock_count++;
}
return TRUE;
}
int
unlock(rwlock *lock, int rd) /* TRUE: read lock */
{ int self = PL_thread_self();
int signal;
if ( lock->writer == self && lock->lock_level > 1 )
{ lock->lock_level--;
return TRUE;
}
pthread_mutex_lock(&lock->mutex);
if ( rd ) /* read lock */
{ lock->readers--;
lock->read_by_thread[self]--;
signal = (lock->readers == 0);
} else
{ lock->writer = -1;
lock->allow_readers = TRUE;
signal = TRUE;
}
if ( signal )
{ enum { NONE, READ, WRITE, UPGRADE } waiting;
waiting = (lock->waiting_upgrade ? UPGRADE :
lock->waiting_writers ? WRITE :
lock->waiting_readers ? READ : NONE);
pthread_mutex_unlock(&lock->mutex);
switch(waiting)
{ case UPGRADE:
pthread_cond_signal(&lock->upcondvar);
break;
case WRITE:
pthread_cond_signal(&lock->wrcondvar);
break;
case READ:
pthread_cond_signal(&lock->rdcondvar);
break;
default:
;
}
} else
{ pthread_mutex_unlock(&lock->mutex);
}
return TRUE;
}
install_t
install_pcecall(void)
{ context.pce_thread = PL_thread_self();
#ifdef __WINDOWS__
setup();
#else
context.pipe[0] = context.pipe[1] = -1;
#endif
PL_register_foreign("in_pce_thread", 1,
in_pce_thread, PL_FA_META, "0");
PL_register_foreign("in_pce_thread_sync2", 2, in_pce_thread_sync2, 0);
PL_register_foreign("set_pce_thread", 0, set_pce_thread, 0);
PL_register_foreign("pce_dispatch", 0, pl_pce_dispatch, 0);
}
int
unlock(rwlock *lock, int rd)
{ int self = PL_thread_self();
int signal;
if ( lock->writer == self && lock->lock_level > 1 )
{ lock->lock_level--;
return TRUE;
}
EnterCriticalSection(&lock->mutex);
if ( rd ) /* must be a read lock */
{ lock->readers--;
lock->read_by_thread[self]--;
signal = (lock->readers == 0);
} else
{ lock->writer = -1;
lock->allow_readers = TRUE;
signal = TRUE;
}
if ( signal )
{ enum { NONE, READ, WRITE, UPGRADE } waiting;
waiting = (lock->waiting_upgrade ? UPGRADE :
lock->waiting_writers ? WRITE :
lock->waiting_readers ? READ : NONE);
switch(waiting)
{ case UPGRADE:
win32_cond_signal(&lock->upcondvar);
break;
case WRITE:
win32_cond_signal(&lock->wrcondvar);
break;
case READ:
win32_cond_signal(&lock->rdcondvar);
break;
default:
;
}
}
LeaveCriticalSection(&lock->mutex); /* In our __WINDOWS__ emulation we */
/* must hold the associated mutex */
return TRUE;
}
int
rdlock(rwlock *lock)
{ int self = PL_thread_self();
if ( lock->writer == self )
{ lock->lock_level++; /* read nested in write */
return TRUE;
}
pthread_mutex_lock(&lock->mutex);
if ( lock->allow_readers == TRUE )
{ ok:
lock->readers++;
register_reader(lock, self);
pthread_mutex_unlock(&lock->mutex);
return TRUE;
}
lock->waiting_readers++;
for(;;)
{ int rc = pthread_cond_wait(&lock->rdcondvar, &lock->mutex);
if ( rc == EINTR )
{ if ( PL_handle_signals() < 0 )
{ lock->waiting_readers--;
pthread_mutex_unlock(&lock->mutex);
return FALSE;
}
continue;
} else if ( rc == 0 )
{ if ( lock->allow_readers == TRUE )
{ lock->waiting_readers--;
goto ok;
}
} else
{ assert(0); /* TBD: OS errors */
}
}
}
int
rdlock(rwlock *lock)
{ int self = PL_thread_self();
if ( lock->writer == self )
{ lock->lock_level++; /* read nested in write */
return TRUE;
}
EnterCriticalSection(&lock->mutex);
if ( lock->allow_readers == TRUE )
{ ok:
lock->readers++;
register_reader(lock, self);
LeaveCriticalSection(&lock->mutex);
return TRUE;
}
lock->waiting_readers++;
for(;;)
{ int rc = win32_cond_wait(&lock->rdcondvar, &lock->mutex);
if ( rc == WAIT_INTR )
{ lock->waiting_readers--;
LeaveCriticalSection(&lock->mutex);
return FALSE;
} else if ( rc == 0 )
{ if ( lock->allow_readers == TRUE )
{ lock->waiting_readers--;
goto ok;
}
} else
{ assert(0); /* TBD: OS errors */
}
}
}
static int
zunlock(zipper *z)
{ int tid = PL_thread_self();
if ( z->owner == tid )
{ if ( z->lock_count == 0 )
{ term_t t;
error:
{ GET_LD
return ( (t=PL_new_term_ref()) &&
unify_zipper(t, z) &&
PL_permission_error("unlock", "zipper", t)
);
}
}
if ( --z->lock_count == 0 )
{ z->owner = 0;
simpleMutexUnlock(&z->lock);
}
} else
void check_prolog(pTHX_ pMY_CXT) {
if (!c_prolog_ok) {
if(!PL_is_initialised(NULL, NULL)) {
args2argv();
if(!PL_initialise(PL_argc, PL_argv)) {
die ("unable to start prolog engine");
}
push_frame(aTHX_ aMY_CXT);
c_prolog_init=1;
}
#ifdef MULTIPLICITY
if(PL_thread_self()==-1) {
if(PL_thread_attach_engine(NULL)==-1) {
die ("unable to create prolog thread engine");
}
push_frame(aTHX_ aMY_CXT);
c_prolog_init=1;
}
#endif
c_prolog_ok=1;
}
}
static int
installEvent(Event ev)
{ int rc;
ev->thread_id = pthread_self();
ev->pl_thread_id = PL_thread_self();
LOCK();
if ( !scheduler_running )
{ pthread_attr_t attr;
TheSchedule()->stop = FALSE;
pthread_attr_init(&attr);
pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_DETACHED);
pthread_attr_setstacksize(&attr, 8192);
rc = pthread_create(&scheduler, &attr, alarm_loop, NULL);
pthread_attr_destroy(&attr);
if ( rc != 0 )
{ UNLOCK();
return pl_error("alarm", 4, "Failed to start schedule thread",
ERR_ERRNO, rc);
}
DEBUG(1, Sdprintf("Started scheduler thread\n"));
scheduler_running = TRUE;
}
rc = insertEvent(ev);
UNLOCK();
if ( rc )
pthread_cond_signal(&cond);
return rc;
}
static foreign_t
set_pce_thread(void)
{ int tid = PL_thread_self();
if ( tid != context.pce_thread )
{ context.pce_thread = tid;
if ( context.input_hook_saved )
{ PL_dispatch_hook(context.input_hook);
#ifdef __WINDOWS__
indirect_rlc_update_hook(context.update_hook);
#endif
context.input_hook_saved = FALSE;
}
#ifdef __WINDOWS__
if ( context.window )
{ DestroyWindow(context.window);
context.window = 0;
}
setPceThread(GetCurrentThreadId());
setup();
set_menu_thread();
#endif
if ( context.pce_thread != 1 )
{ context.input_hook = PL_dispatch_hook(NULL);
#ifdef __WINDOWS__
context.update_hook = indirect_rlc_update_hook(NULL);
#endif
context.input_hook_saved = TRUE;
}
}
return TRUE;
}
static void
on_alarm(int sig)
{ Event ev;
schedule *sched = TheSchedule();
pthread_t self = pthread_self();
DEBUG(1, Sdprintf("Signal received in %d\n",
PL_thread_self()));
#ifdef BACKTRACE
DEBUG(10, print_trace());
#endif
for(;;)
{ struct timeval now;
term_t goal = 0;
module_t module = NULL;
gettimeofday(&now, NULL);
LOCK();
for(ev = sched->first; ev; ev=ev->next)
{ struct timeval left;
assert(ev->magic == EV_MAGIC);
if ( (ev->flags & (EV_DONE|EV_FIRED)) ||
!pthread_equal(self, ev->thread_id) )
continue;
left.tv_sec = ev->at.tv_sec - now.tv_sec;
left.tv_usec = ev->at.tv_usec - now.tv_usec;
if ( left.tv_usec < 0 )
{ left.tv_sec--;
left.tv_usec += 1000000;
}
if ( left.tv_sec < 0 ||
(left.tv_sec == 0 && left.tv_usec == 0) )
{ DEBUG(1, Sdprintf("Calling event\n"));
ev->flags |= EV_DONE;
module = ev->module;
goal = PL_new_term_ref();
PL_recorded(ev->goal, goal);
if ( ev->flags & EV_REMOVE )
freeEvent(ev);
break;
}
}
UNLOCK();
if ( goal )
{ PL_call_predicate(module,
PL_Q_PASS_EXCEPTION,
PREDICATE_call1,
goal);
} else
break;
}
DEBUG(1, Sdprintf("Processed pending events; signalling scheduler\n"));
pthread_cond_signal(&cond);
}
/** polling loop til buffer ready
*/
ssize_t Swipl_IO::_read_(char *buf, size_t bufsize) {
qDebug() << "_read_" << CVP(target);
int thid = PL_thread_self();
// handle setup interthread and termination
for ( ; ; ) {
{ QMutexLocker lk(&sync);
if (target) {
if (!target->thids.contains(thid)) {
target->add_thread(thid);
int rc =
PL_thread_at_exit(eng_at_exit, this, FALSE);
qDebug() << "installed" << rc;
}
break;
}
}
if ( PL_handle_signals() < 0 )
return -1;
SwiPrologEngine::msleep(10);
}
if ( buffer.isEmpty() ) {
PL_write_prompt(TRUE);
emit user_prompt(thid, SwiPrologEngine::is_tty(this));
}
for ( ; ; ) {
{ QMutexLocker lk(&sync);
if (!query.isEmpty()) {
try {
int rc = PlCall(query.toStdWString().data());
qDebug() << "PlCall" << query << rc;
}
catch(PlException e) {
qDebug() << t2w(e);
}
query.clear();
}
uint n = buffer.length();
Q_ASSERT(bufsize >= n);
if (n > 0) {
uint l = bufsize < n ? bufsize : n;
memcpy(buf, buffer, l);
buffer.remove(0, l);
return l;
}
if (target->status == ConsoleEdit::eof) {
target->status = ConsoleEdit::running;
return 0;
}
}
if ( PL_handle_signals() < 0 )
return -1;
SwiPrologEngine::msleep(10);
}
}
int
outOfStack(void *stack, stack_overflow_action how)
{ GET_LD
Stack s = stack;
const char *msg = "out-of-stack";
if ( LD->outofstack )
{ Sdprintf("[Thread %d]: failed to recover from %s-overflow\n",
PL_thread_self(), s->name);
print_backtrace_named(msg);
save_backtrace("crash");
print_backtrace_named("crash");
fatalError("Sorry, cannot continue");
return FALSE; /* NOTREACHED */
}
save_backtrace(msg);
if ( s->spare != s->def_spare )
{ Sdprintf("[Thread %d]: %s-overflow: spare=%ld\n"
"Last resource exception:\n",
PL_thread_self(), s->name, (long)s->spare);
print_backtrace_named("exception");
}
LD->trim_stack_requested = TRUE;
LD->exception.processing = TRUE;
LD->outofstack = stack;
switch(how)
{ case STACK_OVERFLOW_THROW:
case STACK_OVERFLOW_RAISE:
{ if ( gTop+5 < gMax )
{ Word p = gTop;
p[0] = FUNCTOR_error2; /* see (*) above */
p[1] = consPtr(&p[3], TAG_COMPOUND|STG_GLOBAL);
p[2] = PL_new_atom(s->name);
p[3] = FUNCTOR_resource_error1;
p[4] = ATOM_stack;
gTop += 5;
PL_unregister_atom(p[2]);
*valTermRef(LD->exception.bin) = consPtr(p, TAG_COMPOUND|STG_GLOBAL);
freezeGlobal(PASS_LD1);
} else
{ Sdprintf("Out of %s-stack. No room for exception term. Aborting.\n", s->name);
*valTermRef(LD->exception.bin) = ATOM_aborted;
}
exception_term = exception_bin;
if ( how == STACK_OVERFLOW_THROW &&
LD->exception.throw_environment )
{ /* see PL_throw() */
longjmp(LD->exception.throw_environment->exception_jmp_env, 1);
}
return FALSE;
}
default:
assert(0);
fail;
}
}
