/*
lookup_ht(HT,Key,Values) :-
term_hash(Key,Hash),
HT = ht(Capacity,_,Table),
Index is (Hash mod Capacity) + 1,
arg(Index,Table,Bucket),
nonvar(Bucket),
( Bucket = K-Vs ->
K == Key,
Values = Vs
;
lookup(Bucket,Key,Values)
).
lookup([K - V | KVs],Key,Value) :-
( K = Key ->
V = Value
;
lookup(KVs,Key,Value)
).
*/
static foreign_t
pl_lookup_ht1(term_t ht, term_t pl_hash, term_t key, term_t values)
{
int capacity;
int hash;
int index;
term_t pl_capacity = PL_new_term_ref();
term_t table = PL_new_term_ref();
term_t bucket = PL_new_term_ref();
/* HT = ht(Capacity,_,Table) */
PL_get_arg(1, ht, pl_capacity);
PL_get_integer(pl_capacity, &capacity);
PL_get_arg(3, ht, table);
/* Index is (Hash mod Capacity) + 1 */
PL_get_integer(pl_hash, &hash);
index = (hash % capacity) + 1;
/* arg(Index,Table,Bucket) */
PL_get_arg(index, table, bucket);
/* nonvar(Bucket) */
if (PL_is_variable(bucket)) PL_fail;
if (PL_is_list(bucket)) {
term_t pair = PL_new_term_ref();
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
while (PL_get_list(bucket, pair,bucket)) {
PL_get_arg(1, pair, k);
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, pair, vs);
return PL_unify(values,vs);
}
}
PL_fail;
} else {
term_t k = PL_new_term_ref();
term_t vs = PL_new_term_ref();
PL_get_arg(1, bucket, k);
/* K == Key */
if ( PL_compare(k,key) == 0 ) {
/* Values = Vs */
PL_get_arg(2, bucket, vs);
return PL_unify(values,vs);
} else {
PL_fail;
}
}
}
cairo_bool_t
plcairo_extend_to_term(cairo_extend_t extend,
term_t t)
{
term_t t0 = PL_new_term_ref();
PLCAIRO_debug(" cairo_extend_t: %d ---> term: 0x%lx", extend, t);
if ( !ATOM_cairo_extend_none )
{
ATOM_cairo_extend_none = PL_new_atom("CAIRO_EXTEND_NONE");
ATOM_cairo_extend_repeat = PL_new_atom("CAIRO_EXTEND_REPEAT");
ATOM_cairo_extend_reflect = PL_new_atom("CAIRO_EXTEND_REFLECT");
ATOM_cairo_extend_pad = PL_new_atom("CAIRO_EXTEND_PAD");
}
if ( extend == CAIRO_EXTEND_NONE )
{ PL_put_atom(t0, ATOM_cairo_extend_none);
}
else if ( extend == CAIRO_EXTEND_REPEAT )
{ PL_put_atom(t0, ATOM_cairo_extend_repeat);
}
else if ( extend == CAIRO_EXTEND_REFLECT )
{ PL_put_atom(t0, ATOM_cairo_extend_reflect);
}
else if ( extend == CAIRO_EXTEND_PAD )
{ PL_put_atom(t0, ATOM_cairo_extend_pad);
}
else
{ g_assert_not_reached();
}
return PL_unify(t, t0);
}
cairo_bool_t
plcairo_ps_level_to_term(cairo_ps_level_t level,
term_t t)
{
term_t t0 = PL_new_term_ref();
PLCAIRO_debug(" cairo_ps_level_t: %d ---> term: 0x%lx", level, t);
if ( !ATOM_cairo_ps_level_2 )
{
ATOM_cairo_ps_level_2 = PL_new_atom("CAIRO_PS_LEVEL_2");
ATOM_cairo_ps_level_3 = PL_new_atom("CAIRO_PS_LEVEL_3");
}
if ( level == CAIRO_PS_LEVEL_2 )
{ PL_put_atom(t0, ATOM_cairo_ps_level_2);
}
else if ( level == CAIRO_PS_LEVEL_3 )
{ PL_put_atom(t0, ATOM_cairo_ps_level_3);
}
else
{ g_assert_not_reached();
}
return PL_unify(t, t0);
}
gboolean
plgi_gbytes_to_term(GBytes *bytes,
term_t t)
{
term_t list = PL_copy_term_ref(t);
term_t head = PL_new_term_ref();
const guint8 *data;
gsize size;
gint i;
PLGI_debug(" GBytes: %p ---> term: 0x%lx", bytes, t);
data = g_bytes_get_data(bytes, &size);
for ( i = 0; i < size; i++ )
{ term_t a = PL_new_term_ref();
guint8 v = data[i];
if ( !plgi_guint8_to_term(v, a) )
{ return FALSE;
}
if ( !(PL_unify_list(list, head, list) &&
PL_unify(head, a)) )
{ return FALSE;
}
}
if ( !PL_unify_nil(list) )
{ return FALSE;
}
return TRUE;
}
static int
put_write_options(term_t opts_in, write_options *options)
{ GET_LD
term_t newlist = PL_new_term_ref();
term_t precopt = PL_new_term_ref();
fid_t fid = PL_open_foreign_frame();
term_t head = PL_new_term_ref();
term_t tail = PL_copy_term_ref(opts_in);
term_t newhead = PL_new_term_ref();
term_t newtail = PL_copy_term_ref(newlist);
int rc = TRUE;
while(rc && PL_get_list(tail, head, tail))
{ if ( !PL_is_functor(head, FUNCTOR_priority1) )
rc = ( PL_unify_list(newtail, newhead, newtail) &&
PL_unify(newhead, head) );
}
if ( rc )
{ rc = ( PL_unify_list(newtail, head, newtail) &&
PL_unify_functor(head, FUNCTOR_priority1) &&
PL_get_arg(1, head, precopt) &&
PL_unify_nil(newtail) );
}
if ( rc )
{ options->write_options = newlist;
options->prec_opt = precopt;
}
PL_close_foreign_frame(fid);
return rc;
}
/*************************
* swi_list_length
*************************/
int
swi_list_length(term_t pl_list)
{
fid_t frame;
predicate_t pr_length;
term_t pl_args, pl_length;
int length;
frame = PL_open_foreign_frame();
pr_length = PL_predicate("length", 2, NULL);
pl_args = PL_new_term_refs(2);
pl_length = pl_args + 1;
length = -1;
if (!PL_unify(pl_args, pl_list) ||
!PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args))
goto out;
PL_get_integer(pl_length, &length);
out:
PL_discard_foreign_frame(frame);
return length;
}
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;
}
/** assign a tuple to something:
*/
static foreign_t python_assign_tuple(term_t t_lhs, term_t t_rhs) {
PyObject *e;
Py_ssize_t sz;
functor_t f;
e = term_to_python(t_rhs, true);
if (!e || !PyTuple_Check(e)) {
return -1;
}
sz = PyTuple_Size(e);
switch (PL_term_type(t_lhs)) {
case PL_VARIABLE:
return PL_unify(t_lhs, t_rhs);
case PL_ATOM:
return assign_python(py_Main, t_rhs, e);
case PL_TERM:
if (PL_get_functor(t_lhs, &f)) {
term_t targ = PL_new_term_ref();
// assign a tuple to a tuple
if (PL_functor_name(f) == ATOM_t && ((sz = PL_functor_arity(f)))) {
Py_ssize_t i;
for (i = 0; i < sz; i++) {
PL_get_arg(i + 1, t_lhs, targ);
assign_python(py_Main, targ, PyTuple_GetItem(e, i));
}
} else if (PL_functor_name(f) == ATOM_comma) {
int n = conj_size(t_lhs);
if (n != sz)
return -1;
return conj_copy(t_lhs, e, 0);
} else if (PL_functor_name(f) == ATOM_dot) { // vectors
size_t len;
term_t tail = PL_new_term_ref();
PL_skip_list(t_lhs, tail, &len);
if (!PL_get_nil(tail))
return -1;
term_t arg = tail;
size_t i;
for (i = 0; i < len; i++) {
if (!PL_get_list(t_rhs, arg, t_rhs)) {
return -1;
}
if (assign_python(py_Main, arg, PyTuple_GetItem(e, i)) < 0)
return -1;
}
}
}
}
return -1;
}
foreign_t
pop_b(term_t t)
{
/*TODO : memory check */
term_t tmp = PL_new_term_ref();
char* out = (char*)StackPop(event_stack);
printf("pop : %s\n",out);
GoalToterm(tmp,out);
PL_unify(t,tmp);
free(out);
return TRUE;
}
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_uri_authority_components(term_t components,
size_t len, const pl_wchar_t *s)
{ const pl_wchar_t *end = &s[len];
const pl_wchar_t *e;
range user = {0};
range passwd = {0};
range host = {0};
range port = {0};
term_t t = PL_new_term_refs(5);
term_t av = t+1;
if ( (e=skip_not(s, end, L"@")) && e<end )
{ user.start = s;
user.end = e;
s = e+1;
if ( (e=skip_not(user.start, user.end, L":")) && e<user.end )
{ passwd.start = e+1;
passwd.end = user.end;
user.end = e;
}
}
host.start = s;
host.end = skip_not(s, end, L":");
if ( host.end < end )
{ port.start = host.end+1;
port.end = end;
}
if ( user.start )
unify_decoded_atom(av+0, &user, ESC_USER);
if ( passwd.start )
unify_decoded_atom(av+1, &passwd, ESC_PASSWD);
unify_decoded_atom(av+2, &host, ESC_HOST);
if ( port.start )
{ wchar_t *ep;
long pn = wcstol(port.start, &ep, 10);
if ( ep == port.end )
{ if ( !PL_put_integer(av+3, pn) )
return FALSE;
} else
{ unify_decoded_atom(av+3, &port, ESC_PORT);
}
}
return (PL_cons_functor_v(t, FUNCTOR_uri_authority4, av) &&
PL_unify(components, t));
}
cairo_bool_t
plcairo_pattern_to_term(cairo_pattern_t *pattern,
term_t t)
{
PLGIBlobType blob_type;
gpointer data;
term_t t0 = PL_new_term_ref();
PLCAIRO_debug(" cairo_pattern_t: %p ---> term: 0x%lx", pattern, t);
if ( !pattern )
{ return ( plgi_put_null(t0) && PL_unify(t, t0) );
}
data = pattern;
blob_type = PLGI_BLOB_BOXED;
if ( !plgi_put_blob(blob_type, CAIRO_GOBJECT_TYPE_PATTERN,
PL_new_atom("CairoPattern"), TRUE, data, t0) )
{ return FALSE;
}
return PL_unify(t, t0);;
}
/*************************
* list_length
*************************/
static int
list_length(term_t pl_list)
{
predicate_t pr_length;
term_t pl_args, pl_length;
int length;
pr_length = PL_predicate("length", 2, NULL);
pl_args = PL_new_term_refs(2);
pl_length = pl_args + 1;
if (!PL_unify(pl_args, pl_list) ||
!PL_call_predicate(NULL, PL_Q_NORMAL, pr_length, pl_args))
length = -1;
else
PL_get_integer(pl_length, &length);
return length;
}
cairo_bool_t
plcairo_filter_to_term(cairo_filter_t filter,
term_t t)
{
term_t t0 = PL_new_term_ref();
PLCAIRO_debug(" cairo_filter_t: %d ---> term: 0x%lx", filter, t);
if ( !ATOM_cairo_filter_fast )
{
ATOM_cairo_filter_fast = PL_new_atom("CAIRO_FILTER_FAST");
ATOM_cairo_filter_good = PL_new_atom("CAIRO_FILTER_GOOD");
ATOM_cairo_filter_best = PL_new_atom("CAIRO_FILTER_BEST");
ATOM_cairo_filter_nearest = PL_new_atom("CAIRO_FILTER_NEAREST");
ATOM_cairo_filter_bilinear = PL_new_atom("CAIRO_FILTER_BILINEAR");
ATOM_cairo_filter_gaussian = PL_new_atom("CAIRO_FILTER_GAUSSIAN");
}
if ( filter == CAIRO_FILTER_FAST )
{ PL_put_atom(t0, ATOM_cairo_filter_fast);
}
else if ( filter == CAIRO_FILTER_GOOD )
{ PL_put_atom(t0, ATOM_cairo_filter_good);
}
else if ( filter == CAIRO_FILTER_BEST )
{ PL_put_atom(t0, ATOM_cairo_filter_best);
}
else if ( filter == CAIRO_FILTER_NEAREST )
{ PL_put_atom(t0, ATOM_cairo_filter_nearest);
}
else if ( filter == CAIRO_FILTER_BILINEAR )
{ PL_put_atom(t0, ATOM_cairo_filter_bilinear);
}
else if ( filter == CAIRO_FILTER_GAUSSIAN )
{ PL_put_atom(t0, ATOM_cairo_filter_gaussian);
}
else
{ g_assert_not_reached();
}
return PL_unify(t, t0);
}
cairo_bool_t
plcairo_pattern_type_to_term(cairo_pattern_type_t pattern_type,
term_t t)
{
term_t t0 = PL_new_term_ref();
PLCAIRO_debug(" cairo_pattern_type_t: %d ---> term: 0x%lx", pattern_type, t);
if ( !ATOM_cairo_pattern_type_solid )
{
ATOM_cairo_pattern_type_solid = PL_new_atom("CAIRO_PATTERN_TYPE_SOLID");
ATOM_cairo_pattern_type_surface = PL_new_atom("CAIRO_PATTERN_TYPE_SURFACE");
ATOM_cairo_pattern_type_linear = PL_new_atom("CAIRO_PATTERN_TYPE_LINEAR");
ATOM_cairo_pattern_type_radial = PL_new_atom("CAIRO_PATTERN_TYPE_RADIAL");
ATOM_cairo_pattern_type_mesh = PL_new_atom("CAIRO_PATTERN_TYPE_MESH");
ATOM_cairo_pattern_type_raster_source = PL_new_atom("CAIRO_PATTERN_TYPE_RASTER_SOURCE");
}
if ( pattern_type == CAIRO_PATTERN_TYPE_SOLID )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_solid);
}
else if ( pattern_type == CAIRO_PATTERN_TYPE_SURFACE )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_surface);
}
else if ( pattern_type == CAIRO_PATTERN_TYPE_LINEAR )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_linear);
}
else if ( pattern_type == CAIRO_PATTERN_TYPE_RADIAL )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_radial);
}
else if ( pattern_type == CAIRO_PATTERN_TYPE_MESH )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_mesh);
}
else if ( pattern_type == CAIRO_PATTERN_TYPE_RASTER_SOURCE )
{ PL_put_atom(t0, ATOM_cairo_pattern_type_raster_source);
}
else
{ g_assert_not_reached();
}
return PL_unify(t, t0);
}
static int
unify_query_string_components(term_t list, size_t len, const pl_wchar_t *qs)
{ if ( len == 0 )
{ return PL_unify_nil(list);
} else
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t eq = PL_new_term_refs(3);
term_t nv = eq+1;
const pl_wchar_t *end = &qs[len];
while(qs < end)
{ range name, value;
name.start = qs;
name.end = skip_not(qs, end, L"=");
if ( name.end < end )
{ value.start = name.end+1;
value.end = skip_not(value.start, end, L"&;");
qs = value.end+1;
} else
{ return syntax_error("illegal_uri_query");
}
PL_put_variable(nv+0);
PL_put_variable(nv+1);
unify_decoded_atom(nv+0, &name, ESC_QNAME);
unify_decoded_atom(nv+1, &value, ESC_QVALUE);
if ( !PL_cons_functor_v(eq, FUNCTOR_equal2, nv) ||
!PL_unify_list(tail, head, tail) ||
!PL_unify(head, eq) )
return FALSE;
}
return PL_unify_nil(tail);
}
}
static int unify_list_from_span(term_t list, clingo_symbol_t const *syms,
size_t slen) {
int rc;
term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t tmp = PL_new_term_ref();
clingo_symbol_t const *it, *ie;
for (it = syms, ie = it + slen; it != ie; ++it) {
PL_put_variable(tmp);
if (!(rc = (unify_value(tmp, *it) && PL_unify_list(tail, head, tail) &&
PL_unify(head, tmp)))) {
goto out;
}
}
if (!(rc = PL_unify_nil(tail))) {
goto out;
}
out:
return rc;
}
/********************
* swi_list_new
********************/
term_t
swi_list_new(char **items, int n, term_t result)
{
term_t list = PL_new_term_ref();
term_t item = PL_new_term_ref();
if (n < 0) { /* NULL-terminated list, calculate items */
n = 0;
if (items)
while (items[n])
n++;
}
PL_put_nil(list);
while (n-- > 0) {
PL_put_atom_chars(item, items[n]);
PL_cons_list(list, item, list);
}
if (result && PL_is_variable(result))
PL_unify(list, result);
return list;
}
static foreign_t
do_quote(term_t in, term_t quoted, char **map, int maxchr)
{ char *inA = NULL;
wchar_t *inW = NULL;
size_t len;
const unsigned char *s;
charbuf buffer;
int changes = 0;
int rc;
if ( !PL_get_nchars(in, &len, &inA, CVT_ATOMIC) &&
!PL_get_wchars(in, &len, &inW, CVT_ATOMIC) )
return sgml2pl_error(ERR_TYPE, "atom", in);
if ( len == 0 )
return PL_unify(in, quoted);
init_buf(&buffer);
if ( inA )
{ for(s = (unsigned char*)inA ; len-- > 0; s++ )
{ int c = *s;
if ( map[c] )
{ if ( !add_str_buf(&buffer, map[c]) )
return FALSE;
changes++;
} else if ( c > maxchr )
{ char buf[10];
sprintf(buf, "&#%d;", c);
if ( !add_str_buf(&buffer, buf) )
return FALSE;
changes++;
} else
{ add_char_buf(&buffer, c);
}
}
if ( changes > 0 )
rc = PL_unify_atom_nchars(quoted, used_buf(&buffer), buffer.bufp);
else
rc = PL_unify(in, quoted);
} else
{ for( ; len-- > 0; inW++ )
{ int c = *inW;
if ( c <= 0xff && map[c] )
{ if ( !add_str_bufW(&buffer, map[c]) )
return FALSE;
changes++;
} else if ( c > maxchr )
{ char buf[10];
sprintf(buf, "&#%d;", c);
if ( !add_str_bufW(&buffer, buf) )
return FALSE;
changes++;
}else
{ add_char_bufW(&buffer, c);
}
}
if ( changes > 0 )
rc = PL_unify_wchars(quoted, PL_ATOM,
used_buf(&buffer)/sizeof(wchar_t),
(wchar_t*)buffer.bufp);
else
rc = PL_unify(in, quoted);
}
free_buf(&buffer);
return rc;
}
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 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;
}
static foreign_t
uri_components(term_t URI, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ uri_component_ranges ranges;
term_t rt = PL_new_term_refs(6);
term_t av = rt+1;
parse_uri(&ranges, len, s);
unify_range(av+0, &ranges.scheme);
unify_range(av+1, &ranges.authority);
unify_range(av+2, &ranges.path);
unify_range(av+3, &ranges.query);
unify_range(av+4, &ranges.fragment);
return (PL_cons_functor_v(rt, FUNCTOR_uri_components5, av) &&
PL_unify(components, rt));
} else if ( PL_is_functor(components, FUNCTOR_uri_components5) )
{ charbuf b;
int rc;
init_charbuf(&b);
/* schema */
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
add_charbuf(&b, ':');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* authority */
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '/');
add_charbuf(&b, '/');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* path */
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* query */
if ( (rc=get_text_arg(components, 4, &len, &s, TXT_EX_TEXT)) == TRUE )
{ if ( len > 0 )
{ add_charbuf(&b, '?');
add_nchars_charbuf(&b, len, s);
}
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* fragment */
if ( (rc=get_text_arg(components, 5, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '#');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(URI, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else /* generate an error */
{ return PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
static foreign_t
pl_uuid(term_t UUID, term_t options)
{ unsigned int mode = UUID_MAKE_V1;
atom_t format = ATOM_atom;
uuid_t *uuid;
char *ns = NULL;
char *str = NULL;
int rc;
uuid_rc_t urc;
if ( !PL_get_nil(options) )
{ term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t arg = PL_new_term_ref();
while( PL_get_list(tail, head, tail) )
{ atom_t name;
size_t arity;
if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
return PL_type_error("option", head);
_PL_get_arg(1, head, arg);
if ( name == ATOM_version )
{ int v;
if ( !PL_get_integer_ex(arg, &v) )
return FALSE;
switch(v)
{ case 1: mode = UUID_MAKE_V1; break;
case 2: mode = UUID_MAKE_MC; break;
case 3: mode = UUID_MAKE_V3; break;
case 4: mode = UUID_MAKE_V4; break;
case 5: mode = UUID_MAKE_V5; break;
default: return PL_domain_error("uuid_version", arg);
}
} else if ( name == ATOM_format )
{ if ( !PL_get_atom_ex(arg, &format) )
return FALSE;
if ( format != ATOM_atom && format != ATOM_integer )
return PL_domain_error("uuid_format", arg);
} else
{ char *newns = NULL;
if ( name == ATOM_dns )
{ newns = "ns:DNS";
} else if ( name == ATOM_url )
{ newns = "ns:URL";
} else if ( name == ATOM_oid )
{ newns = "ns:OID";
} else if ( name == ATOM_x500 )
{ newns = "ns:X500";
}
if ( newns )
{ ns = newns;
if ( !PL_get_chars(arg, &str, CVT_ATOM|CVT_EXCEPTION) )
return FALSE;
if ( mode == UUID_MAKE_V1 )
mode = UUID_MAKE_V3;
}
}
}
if ( !PL_get_nil_ex(tail) )
return FALSE;
}
switch(mode)
{ case UUID_MAKE_V1:
case UUID_MAKE_MC:
case UUID_MAKE_V4:
uuid_create(&uuid);
if ( (urc=uuid_make(uuid, mode)) != UUID_RC_OK )
return PL_warning("UUID: make: %s\n", uuid_error(urc));
break;
case UUID_MAKE_V3:
case UUID_MAKE_V5:
{ uuid_t *uuid_ns;
if ( !ns )
return PL_existence_error("uuid_context", options);
uuid_create(&uuid);
uuid_create(&uuid_ns);
uuid_load(uuid_ns, ns);
if ( (urc=uuid_make(uuid, mode, uuid_ns, str)) != UUID_RC_OK )
return PL_warning("UUID: make: %s\n", uuid_error(urc));
uuid_destroy(uuid_ns);
break;
}
default:
assert(0);
return FALSE;
}
if ( format == ATOM_atom )
{ char buf[UUID_LEN_STR+1];
void *ptr = buf;
size_t datalen = sizeof(buf);
if ( (urc=uuid_export(uuid, UUID_FMT_STR, &ptr, &datalen)) != UUID_RC_OK )
return PL_warning("UUID: export: %s\n", uuid_error(urc));
rc = PL_unify_chars(UUID, PL_ATOM|REP_ISO_LATIN_1, (size_t)-1, buf);
} else if ( format == ATOM_integer )
{ char buf[UUID_LEN_SIV+1];
void *ptr = buf;
size_t datalen = sizeof(buf);
term_t tmp = PL_new_term_ref();
if ( (urc=uuid_export(uuid, UUID_FMT_SIV, &ptr, &datalen)) != UUID_RC_OK )
return PL_warning("UUID: export: %s\n", uuid_error(urc));
rc = ( PL_chars_to_term(buf, tmp) &&
PL_unify(UUID, tmp)
);
} else
{ assert(0);
return FALSE;
}
uuid_destroy(uuid);
return rc;
}
static foreign_t
tcp_select(term_t Streams, term_t Available, term_t timeout)
{ fd_set fds;
struct timeval t, *to;
double time;
int n, max = 0, ret, min = 1000000;
fdentry *map = NULL;
term_t head = PL_new_term_ref();
term_t streams = PL_copy_term_ref(Streams);
term_t available = PL_copy_term_ref(Available);
term_t ahead = PL_new_term_ref();
int from_buffer = 0;
atom_t a;
FD_ZERO(&fds);
while( PL_get_list(streams, head, streams) )
{ IOSTREAM *s;
#ifdef __WINDOWS__
nbio_sock_t fd;
#else
int fd;
#endif
fdentry *e;
if ( !PL_get_stream_handle(head, &s) )
return FALSE;
#ifdef __WINDOWS__
fd = fdFromHandle(s->handle);
#else
fd = Sfileno(s);
#endif
PL_release_stream(s);
if ( fd < 0 || !is_socket_stream(s) )
{ return pl_error("tcp_select", 3, NULL, ERR_DOMAIN,
head, "socket_stream");
}
/* check for input in buffer */
if ( s->bufp < s->limitp )
{ if ( !PL_unify_list(available, ahead, available) ||
!PL_unify(ahead, head) )
return FALSE;
from_buffer++;
}
e = alloca(sizeof(*e));
e->fd = fd;
e->stream = PL_copy_term_ref(head);
e->next = map;
map = e;
#ifdef __WINDOWS__
FD_SET((SOCKET)fd, &fds);
#else
FD_SET(fd, &fds);
#endif
if ( fd > max )
max = fd;
if( fd < min )
min = fd;
}
if ( !PL_get_nil(streams) )
return pl_error("tcp_select", 3, NULL, ERR_TYPE, Streams, "list");
if ( from_buffer > 0 )
return PL_unify_nil(available);
if ( PL_get_atom(timeout, &a) && a == ATOM_infinite )
{ to = NULL;
} else
{ if ( !PL_get_float(timeout, &time) )
return pl_error("tcp_select", 3, NULL,
ERR_TYPE, timeout, "number");
if ( time >= 0.0 )
{ t.tv_sec = (int)time;
t.tv_usec = ((int)(time * 1000000) % 1000000);
} else
{ t.tv_sec = 0;
t.tv_usec = 0;
}
to = &t;
}
while( (ret=nbio_select(max+1, &fds, NULL, NULL, to)) == -1 &&
errno == EINTR )
{ fdentry *e;
if ( PL_handle_signals() < 0 )
return FALSE; /* exception */
FD_ZERO(&fds); /* EINTR may leave fds undefined */
for(e=map; e; e=e->next) /* so we rebuild it to be safe */
{ FD_SET((SOCKET)e->fd, &fds);
}
}
switch(ret)
{ case -1:
return pl_error("tcp_select", 3, NULL, ERR_ERRNO, errno, "select", "streams", Streams);
case 0: /* Timeout */
break;
default: /* Something happened -> check fds */
for(n=min; n <= max; n++)
{ if ( FD_ISSET(n, &fds) )
{ if ( !PL_unify_list(available, ahead, available) ||
!PL_unify(ahead, findmap(map, n)) )
return FALSE;
}
}
break;
}
return PL_unify_nil(available);
}
/********************
* pl_fact_exists
********************/
static foreign_t
pl_fact_exists(term_t pl_name,
term_t pl_fields, term_t pl_list, control_t handle)
{
context_t *ctx;
char *name, factname[64];
fid_t frame;
term_t pl_values;
OhmFact *f;
switch (PL_foreign_control(handle)) {
case PL_FIRST_CALL:
if (!PL_is_list(pl_fields) || /*!PL_is_list(pl_list) ||*/
!PL_get_chars(pl_name, &name, CVT_ALL))
PL_fail;
strncpy(factname, name, sizeof(factname));
factname[sizeof(factname)-1] = '\0';
if ((ctx = malloc(sizeof(*ctx))) == NULL)
PL_fail;
memset(ctx, 0, sizeof(*ctx));
if (get_field_names(ctx, pl_fields) != 0) {
free(ctx);
PL_fail;
}
ctx->store = ohm_fact_store_get_fact_store();
ctx->facts = ohm_fact_store_get_facts_by_name(ctx->store, factname);
break;
case PL_REDO:
ctx = PL_foreign_context_address(handle);
break;
case PL_CUTTED:
ctx = PL_foreign_context_address(handle);
goto nomore;
default:
PL_fail;
}
/* XXX TODO: shouldn't we discard the frame here instead of closing them */
frame = PL_open_foreign_frame();
while (ctx->facts != NULL) {
f = (OhmFact *)ctx->facts->data;
ctx->facts = g_slist_next(ctx->facts);
if (!fact_values(ctx, f, &pl_values) && PL_unify(pl_list, pl_values)) {
PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */
PL_retry_address(ctx);
}
PL_rewind_foreign_frame(frame);
}
PL_close_foreign_frame(frame); /* PL_discard_foreign_frame ??? */
nomore:
if (ctx->fields)
free(ctx->fields);
free(ctx);
PL_fail;
}