static foreign_t
in_pce_thread_sync2(term_t goal, term_t vars)
{ prolog_goal *g = malloc(sizeof(*g));
MSG msg;
int rc = FALSE;
if ( !g )
return PL_resource_error("memory");
if ( !init_prolog_goal(g, goal, TRUE) )
{ free(g);
return FALSE;
}
g->client = GetCurrentThreadId();
PostMessage(context.window, WM_CALL, (WPARAM)0, (LPARAM)g);
while( GetMessage(&msg, NULL, 0, 0) )
{ TranslateMessage(&msg);
DispatchMessage(&msg);
if ( PL_handle_signals() < 0 )
return FALSE;
switch(g->state)
{ case G_TRUE:
{ term_t v = PL_new_term_ref();
rc = PL_recorded(g->result, v) && PL_unify(vars, v);
PL_erase(g->result);
goto out;
}
case G_FALSE:
goto out;
case G_ERROR:
{ term_t ex = PL_new_term_ref();
if ( PL_recorded(g->result, ex) )
rc = PL_raise_exception(ex);
PL_erase(g->result);
goto out;
}
default:
continue;
}
}
out:
free(g);
return rc;
}
static int
unify_record(term_t t, record_t r)
{ if ( r )
{ term_t t2 = PL_new_term_ref();
PL_recorded(r, t2);
return PL_unify(t, t2);
}
return FALSE;
}
static void
call_prolog_goal(prolog_goal *g)
{ fid_t fid;
static predicate_t pred = NULL;
int rc;
if ( !pred )
pred = PL_predicate("call", 1, "user");
if ( (fid = PL_open_foreign_frame()) )
{ term_t t = PL_new_term_ref();
term_t vars;
rc = PL_recorded(g->goal, t);
PL_erase(g->goal);
g->goal = 0;
g->state = G_RUNNING;
if ( rc )
{ qid_t qid;
int flags = PL_Q_NORMAL;
if ( g->acknowledge )
{ flags |= PL_Q_CATCH_EXCEPTION;
vars = PL_new_term_ref();
if ( !PL_get_arg(2, t, vars) || /* Goal-Vars */
!PL_get_arg(1, t, t) )
{ PL_warning("ERROR: in_pce_thread: bad goal-vars term");
}
} else
{ vars = 0;
}
if ( (qid = PL_open_query(g->module, flags, pred, t)) )
{ rc = PL_next_solution(qid);
if ( rc )
{ g->state = G_TRUE;
if ( vars )
g->result = PL_record(vars);
} else
{ term_t ex;
if ( g->acknowledge && (ex=PL_exception(qid)) )
{ g->result = PL_record(ex);
g->state = G_ERROR;
} else
{ g->state = G_FALSE;
}
}
PL_cut_query(qid);
} else
PL_warning("ERROR: pce: out of global stack");
}
PL_discard_foreign_frame(fid);
} else
PL_warning("ERROR: pce: out of global stack");
}
// handle OSC message by calling the associated Prolog goal
static int prolog_handler(const char *path, const char *types, lo_arg **argv,
int argc, lo_message msg, void *user_data)
{
term_t goal = PL_new_term_ref();
term_t term0 = PL_new_term_refs(3);
term_t term1 = term0+1;
term_t term2 = term0+2;
term_t list;
int i, rc=0;
PL_recorded((record_t)user_data,goal); // retrieve the goal term
PL_put_term(term0,goal); // term_t goal encoded in user_data
PL_put_atom_chars(term1,path);
list = PL_copy_term_ref(term2);
for (i=0; i<argc; i++) {
term_t head=PL_new_term_ref();
term_t tail=PL_new_term_ref();
if (!PL_unify_list(list,head,tail)) PL_fail;
switch (types[i]) {
case 'c': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"char",1,PL_INT,(int)argv[i]->c); break;
case 'i': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int",1,PL_INT,argv[i]->i); break;
case 'h': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"int64",1,PL_INT64,argv[i]->h); break;
case 'f': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"float",1,PL_FLOAT,(double)argv[i]->f); break;
case 'd': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"double",1,PL_DOUBLE,argv[i]->d); break;
case 's': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"string",1,PL_CHARS,&argv[i]->s); break;
case 'S': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"symbol",1,PL_CHARS,&argv[i]->S); break;
case 'T': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"true",0); break;
case 'F': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"false",0); break;
case 'N': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"nil",0); break;
case 'I': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"inf",0); break;
case 'b': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"blob",0); break;
case 't': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"timetag",2,
PL_INT64,(int64_t)argv[i]->t.sec,
PL_INT64,(int64_t)argv[i]->t.frac);
break;
case 'm': rc=PL_unify_term(head,PL_FUNCTOR_CHARS,"midi",4,
PL_INT,(int)argv[i]->m[0], PL_INT,(int)argv[i]->m[1],
PL_INT,(int)argv[i]->m[2], PL_INT,(int)argv[i]->m[3]);
break;
}
if (!rc) PL_fail;
list=tail;
}
return PL_unify_nil(list) && PL_call_predicate(NULL,PL_Q_NORMAL,call3,term0);
}
static foreign_t
current_alarms(term_t time, term_t goal, term_t id, term_t status,
term_t matching)
{ Event ev;
term_t next = PL_new_term_ref();
term_t g = PL_new_term_ref();
term_t tail = PL_copy_term_ref(matching);
term_t head = PL_new_term_ref();
term_t av = PL_new_term_refs(4);
pthread_t self = pthread_self();
LOCK();
ev = TheSchedule()->first;
for(; ev; ev = ev->next)
{ atom_t s;
double at;
fid_t fid;
if ( !pthread_equal(self, ev->thread_id) )
continue;
fid = PL_open_foreign_frame();
if ( ev->flags & EV_DONE )
s = ATOM_done;
else if ( ev == TheSchedule()->scheduled )
s = ATOM_next;
else
s = ATOM_scheduled;
if ( !PL_unify_atom(status, s) )
goto nomatch;
PL_recorded(ev->goal, g);
if ( !PL_unify_term(goal,
PL_FUNCTOR, FUNCTOR_module2,
PL_ATOM, PL_module_name(ev->module),
PL_TERM, g) )
goto nomatch;
at = (double)ev->at.tv_sec + (double)ev->at.tv_usec / 1000000.0;
if ( !PL_unify_float(time, at) )
goto nomatch;
if ( !unify_timer(id, ev) )
goto nomatch;
PL_discard_foreign_frame(fid);
if ( !PL_put_float(av+0, at) || /* time */
!PL_recorded(ev->goal, av+1) || /* goal */
!PL_put_variable(av+2) || /* id */
!unify_timer(av+2, ev) ||
!PL_put_atom(av+3, s) || /* status */
!PL_cons_functor_v(next, FUNCTOR_alarm4, av) )
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
if ( PL_unify_list(tail, head, tail) &&
PL_unify(head, next) )
{ continue;
} else
{ PL_close_foreign_frame(fid);
UNLOCK();
return FALSE;
}
nomatch:
PL_discard_foreign_frame(fid);
}
UNLOCK();
return PL_unify_nil(tail);
}
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);
}
static foreign_t
in_pce_thread_sync2(term_t goal, term_t vars)
{ prolog_goal *g;
int rc;
if ( !setup() )
return FALSE;
if ( !(g = malloc(sizeof(*g))) )
return PL_resource_error("memory");
if ( !init_prolog_goal(g, goal, TRUE) )
return FALSE;
pthread_cond_init(&g->cv, NULL);
pthread_mutex_init(&g->mutex, NULL);
rc = write(context.pipe[1], &g, sizeof(g));
if ( rc == sizeof(g) )
{ rc = FALSE;
pthread_mutex_lock(&g->mutex);
for(;;)
{ struct timespec timeout;
#ifdef HAVE_CLOCK_GETTIME
struct timespec now;
clock_gettime(CLOCK_REALTIME, &now);
timeout.tv_sec = now.tv_sec;
timeout.tv_nsec = (now.tv_nsec+250000000);
#else
struct timeval now;
gettimeofday(&now, NULL);
timeout.tv_sec = now.tv_sec;
timeout.tv_nsec = (now.tv_usec+250000) * 1000;
#endif
if ( timeout.tv_nsec >= 1000000000 ) /* some platforms demand this */
{ timeout.tv_nsec -= 1000000000;
timeout.tv_sec += 1;
}
pthread_cond_timedwait(&g->cv, &g->mutex, &timeout);
if ( PL_handle_signals() < 0 )
goto out;
switch(g->state)
{ case G_TRUE:
{ term_t v = PL_new_term_ref();
rc = PL_recorded(g->result, v) && PL_unify(vars, v);
PL_erase(g->result);
goto out;
}
case G_FALSE:
goto out;
case G_ERROR:
{ term_t ex = PL_new_term_ref();
if ( PL_recorded(g->result, ex) )
rc = PL_raise_exception(ex);
PL_erase(g->result);
goto out;
}
default:
continue;
}
}
out:
pthread_mutex_unlock(&g->mutex);
}
pthread_mutex_destroy(&g->mutex);
pthread_cond_destroy(&g->cv);
free(g);
return rc;
}
