static int
mp_add_to_form(const char *name, size_t nlen,
const char *value, size_t len,
const char *file, void *closure)
{ term_t head = PL_new_term_ref();
term_t tail = (term_t) closure;
term_t val = PL_new_term_ref();
long vl;
double vf;
int rc;
atom_t aname = 0;
if ( isinteger(value, &vl, len) )
rc = PL_put_integer(val, vl);
else if ( isfloat(value, &vf, len) )
rc = PL_put_float(val, vf);
else
rc = PL_unify_chars(val, PL_ATOM|REP_UTF8, len, value);
rc = ( rc &&
PL_unify_list(tail, head, tail) &&
(aname = PL_new_atom_nchars(nlen, name)) &&
PL_unify_term(head,
PL_FUNCTOR, PL_new_functor(aname, 1),
PL_TERM, val) );
if ( aname )
PL_unregister_atom(aname);
return rc;
}
/********************
* fact_field_term
********************/
static int
fact_field_term(OhmFact *fact, char *field, term_t term)
{
GValue *value;
int i;
double d;
char *s;
if ((value = ohm_fact_get(fact, field)) == NULL)
return FALSE;
switch (G_VALUE_TYPE(value)) {
case G_TYPE_INT:
i = g_value_get_int(value);
PL_put_integer(term, i);
break;
case G_TYPE_UINT:
i = g_value_get_uint(value);
PL_put_integer(term, i);
break;
case G_TYPE_LONG:
i = g_value_get_long(value);
PL_put_integer(term, i);
break;
case G_TYPE_ULONG:
i = g_value_get_ulong(value);
PL_put_integer(term, i);
break;
case G_TYPE_DOUBLE:
d = g_value_get_double(value);
PL_put_float(term, d);
break;
case G_TYPE_FLOAT:
d = 1.0 * g_value_get_float(value);
PL_put_float(term, d);
break;
case G_TYPE_STRING:
s = (char *)g_value_get_string(value);
PL_put_atom_chars(term, s);
break;
default:
return FALSE;
}
return TRUE;
}
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);
}