void plgi_calling_context(control_t *context, atom_t *module, atom_t *name, int *arity)
{
predicate_t pred;
module_t m;
atom_t n;
gsize a;
pred = PL_foreign_context_predicate(context);
PL_predicate_info(pred, &n, &a, &m);
if ( module ) *module = PL_module_name(m);
if ( name ) *name = n;
if ( arity ) *arity = a;
}
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);
}
