static int
error(int error, const char *op, const char *type, term_t culprit)
{ if ( error == EAGAIN )
return PL_resource_error("rlimit_nproc");
else if ( error == EMFILE )
return PL_resource_error("max_files");
else if ( error == ENOMEM )
return PL_resource_error("memory");
else if ( error == ERANGE )
return PL_resource_error("buffer_space");
else
return PL_permission_error(op, type, culprit);
}
static int unify_model(term_t t, int show, clingo_model_t *model) {
clingo_symbol_t *atoms = NULL;
size_t alen;
int rc;
if (!(rc = clingo_status(clingo_model_symbols_size(model, show, &alen)))) {
goto out;
}
atoms = malloc(sizeof(*atoms) * alen);
if (!atoms) {
rc = PL_resource_error("memory");
goto out;
}
if (!(rc = clingo_status(clingo_model_symbols(model, show, atoms, alen)))) {
goto out;
}
if (!(rc = unify_list_from_span(t, atoms, alen))) {
goto out;
}
out:
free(atoms);
return rc;
}
static int get_params(term_t t, clingo_part_t *pv) {
int rc;
atom_t name;
term_t arg;
clingo_symbol_t *values = NULL;
if (!(rc = get_name_arity(t, &name, &pv->size))) {
rc = PL_type_error("callable", t);
goto out;
}
arg = PL_new_term_ref();
if (!(values = malloc(sizeof(*pv->params) * pv->size))) {
rc = PL_resource_error("memory");
goto out;
}
for (size_t i = 0; i < pv->size; i++) {
_PL_get_arg(i + 1, t, arg);
if (!(rc = clingo_status(get_value(arg, &values[i], FALSE)))) {
goto out;
}
}
pv->params = values;
pv->name = PL_atom_chars(name);
values = NULL;
out:
if (values) {
free(values);
}
return rc;
}
static int
get_exe(term_t exe, p_options *info)
{ int arity;
term_t arg = PL_new_term_ref();
if ( !PL_get_name_arity(exe, &info->exe_name, &arity) )
return type_error(exe, "callable");
PL_put_atom(arg, info->exe_name);
#ifdef __WINDOWS__
if ( !PL_get_wchars(arg, NULL, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC) )
return FALSE;
if ( !win_command_line(exe, arity, info->exe, &info->cmdline) )
return FALSE;
#else /*__WINDOWS__*/
if ( !PL_get_chars(arg, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
if ( !(info->argv = PL_malloc((arity+2)*sizeof(char*))) )
return PL_resource_error("memory");
memset(info->argv, 0, (arity+2)*sizeof(char*));
if ( !(info->argv[0] = PL_malloc(strlen(info->exe)+1)) )
return PL_resource_error("memory");
strcpy(info->argv[0], info->exe);
{ int i;
for(i=1; i<=arity; i++)
{ _PL_get_arg(i, exe, arg);
if ( !PL_get_chars(arg, &info->argv[i],
CVT_ATOMIC|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
}
info->argv[i] = NULL;
}
#endif /*__WINDOWS__*/
return TRUE;
}
static foreign_t pl_clingo_ground(term_t ccontrol, term_t parts) {
clingo_env *ctl;
clingo_part_t *part_vec = NULL;
size_t plen = 0;
int rc;
if (!(rc = get_clingo(ccontrol, &ctl))) {
goto out;
}
switch (PL_skip_list(parts, 0, &plen)) {
case PL_LIST: {
term_t tail = PL_copy_term_ref(parts);
term_t head = PL_new_term_ref();
if (!(part_vec = malloc(sizeof(*part_vec) * plen))) {
rc = PL_resource_error("memory");
goto out;
}
memset(part_vec, 0, sizeof(*part_vec) * plen);
for (size_t i = 0; PL_get_list(tail, head, tail); i++) {
if (!(rc = get_params(head, &part_vec[i]))) {
goto out;
}
}
break;
}
default: {
rc = PL_type_error("list", parts);
goto out;
}
}
if (!(rc = clingo_status(clingo_control_ground(ctl->control, part_vec, plen,
call_function, ctl)))) {
goto out;
}
out:
if (part_vec) {
for (size_t i = 0; i < plen; i++) {
if (part_vec[i].params) {
free((void *)part_vec[i].params);
}
}
free(part_vec);
}
return rc;
}
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 foreign_t pl_clingo_add(term_t ccontrol, term_t params, term_t program) {
char *prog;
clingo_env *ctl;
atom_t name;
size_t arity;
char *param_buf[FAST_PARAMS];
char **prog_params = param_buf;
term_t arg = PL_new_term_ref();
int rc;
if (!(rc = get_clingo(ccontrol, &ctl))) {
goto out;
}
if (!get_name_arity(params, &name, &arity)) {
rc = PL_type_error("callable", params);
goto out;
}
if (arity + 1 > FAST_PARAMS &&
!(prog_params = malloc(sizeof(char *) * arity))) {
rc = PL_resource_error("memory");
goto out;
}
for (size_t i = 0; i < arity; i++) {
_PL_get_arg(i + 1, params, arg);
if (!(rc =
get_null_terminated_string(arg, &prog_params[i], CVT_ATOM))) {
goto out;
}
}
if (!(rc = get_null_terminated_string(program, &prog,
CVT_ATOM | CVT_STRING | CVT_LIST |
BUF_DISCARDABLE))) {
goto out;
}
if (!(rc = clingo_status(
clingo_control_add(ctl->control, PL_atom_chars(name),
(const char **)prog_params, arity, prog)))) {
goto out;
}
out:
if (prog_params != param_buf) {
free(prog_params);
}
return rc;
}
static foreign_t
in_pce_thread(term_t goal)
{ prolog_goal *g = malloc(sizeof(*g));
if ( !g )
return PL_resource_error("memory");
if ( !init_prolog_goal(g, goal, FALSE) )
{ free(g);
return FALSE;
}
PostMessage(context.window, WM_CALL, (WPARAM)0, (LPARAM)g);
return TRUE;
}
static foreign_t
archive_open_entry(term_t archive, term_t stream)
{ archive_wrapper *ar;
IOSTREAM *s;
if ( !get_archive(archive, &ar) )
return FALSE;
if ( (s=Snew(ar, SIO_INPUT|SIO_RECORDPOS, &ar_entry_functions)) )
{ ar->status = AR_OPENED_ENTRY;
if ( PL_unify_stream(stream, s) )
{ PL_register_atom(ar->symbol); /* We may no longer reference the */
return TRUE; /* archive itself */
}
Sclose(s);
return FALSE;
}
return PL_resource_error("memory");
}
static foreign_t
in_pce_thread(term_t goal)
{ 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, FALSE) )
return FALSE;
rc = write(context.pipe[1], &g, sizeof(g));
if ( rc == sizeof(g) )
return TRUE;
return FALSE;
}
static int
setup(void)
{ if ( context.pipe[0] > 0 )
return TRUE;
DLOCK();
if ( context.pipe[0] == -1 )
{ if ( pipe(context.pipe) == -1 )
{ DUNLOCK();
return PL_resource_error("open_files");
}
context.id = XtAppAddInput(pceXtAppContext(NULL),
context.pipe[0],
(XtPointer)(XtInputReadMask),
on_input, &context);
}
DUNLOCK();
return TRUE;
}
static int
create_pipes(p_options *info)
{ int i;
for(i=0; i<3; i++)
{ p_stream *s = &info->streams[i];
if ( s->term )
{ if ( i == 2 && info->streams[1].term &&
PL_compare(info->streams[1].term, info->streams[2].term) == 0 )
{ s->fd[0] = info->streams[1].fd[0];
s->fd[1] = info->streams[1].fd[1];
} else
{ if ( pipe(s->fd) )
{ assert(errno = EMFILE);
return PL_resource_error("open_files");
}
}
}
}
return TRUE;
}
static int
unify_number(term_t t, const char *s, size_t len)
{ char buf[100];
char *a, *o;
const char *i;
int rc;
if ( len+1 > sizeof(buf) )
{ if ( !(a = malloc(len+1)) )
return PL_resource_error("memory");
} else
{ a = buf;
}
for(i=s,o=a; len-- > 0; )
*o++ = (char)*i++;
*o = '\0';
rc = PL_chars_to_term(a, t);
if ( a != buf )
free(a);
return rc;
}
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
archive_open_stream(term_t data, term_t handle, term_t options)
{ IOSTREAM *datas;
archive_wrapper *ar;
term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t arg = PL_new_term_ref();
if ( !PL_get_stream_handle(data, &datas) )
return FALSE;
if ( !(datas->flags & SIO_INPUT) )
{ PL_release_stream(datas);
return PL_domain_error("input_stream", data);
}
ar = PL_malloc(sizeof(*ar));
memset(ar, 0, sizeof(*ar));
ar->data = datas;
ar->magic = ARCHIVE_MAGIC;
if ( !PL_unify_blob(handle, ar, sizeof(*ar), &archive_blob) )
return FALSE;
while( PL_get_list_ex(tail, head, tail) )
{ atom_t name;
int arity;
if ( !PL_get_name_arity(head, &name, &arity) ||
!PL_get_arg(1, head, arg) )
return PL_type_error("option", head);
if ( name == ATOM_compression || name == ATOM_filter )
{ atom_t c;
if ( !PL_get_atom_ex(arg, &c) )
return FALSE;
if ( c == ATOM_all )
ar->type |= FILTER_ALL;
#ifdef FILTER_BZIP2
else if ( c == ATOM_bzip2 )
ar->type |= FILTER_BZIP2;
#endif
#ifdef FILTER_COMPRESS
else if ( c == ATOM_compress )
ar->type |= FILTER_COMPRESS;
#endif
#ifdef FILTER_GZIP
else if ( c == ATOM_gzip )
ar->type |= FILTER_GZIP;
#endif
#ifdef FILTER_GRZIP
else if ( c == ATOM_grzip )
ar->type |= FILTER_GRZIP;
#endif
#ifdef FILTER_LRZIP
else if ( c == ATOM_lrzip )
ar->type |= FILTER_LRZIP;
#endif
#ifdef FILTER_LZIP
else if ( c == ATOM_lzip )
ar->type |= FILTER_LZIP;
#endif
#ifdef FILTER_LZMA
else if ( c == ATOM_lzma )
ar->type |= FILTER_LZMA;
#endif
#ifdef FILTER_LZOP
else if ( c == ATOM_lzop )
ar->type |= FILTER_LZOP;
#endif
#ifdef FILTER_NONE
else if ( c == ATOM_none )
ar->type |= FILTER_NONE;
#endif
#ifdef FILTER_RPM
else if ( c == ATOM_rpm )
ar->type |= FILTER_RPM;
#endif
#ifdef FILTER_UU
else if ( c == ATOM_uu )
ar->type |= FILTER_UU;
#endif
#ifdef FILTER_XZ
else if ( c == ATOM_xz )
ar->type |= FILTER_XZ;
#endif
else
return PL_domain_error("filter", arg);
} else if ( name == ATOM_format )
{ atom_t f;
if ( !PL_get_atom_ex(arg, &f) )
return FALSE;
if ( f == ATOM_all )
ar->type |= FORMAT_ALL;
#ifdef FORMAT_7ZIP
else if ( f == ATOM_7zip )
ar->type |= FORMAT_7ZIP;
#endif
#ifdef FORMAT_AR
else if ( f == ATOM_ar )
ar->type |= FORMAT_AR;
#endif
#ifdef FORMAT_CAB
else if ( f == ATOM_cab )
ar->type |= FORMAT_CAB;
#endif
#ifdef FORMAT_CPIO
else if ( f == ATOM_cpio )
ar->type |= FORMAT_CPIO;
#endif
#ifdef FORMAT_EMPTY
else if ( f == ATOM_empty )
ar->type |= FORMAT_EMPTY;
#endif
#ifdef FORMAT_GNUTAR
else if ( f == ATOM_gnutar )
ar->type |= FORMAT_GNUTAR;
#endif
#ifdef FORMAT_ISO9960
else if ( f == ATOM_iso9960 )
ar->type |= FORMAT_ISO9960;
#endif
#ifdef FORMAT_LHA
else if ( f == ATOM_lha )
ar->type |= FORMAT_LHA;
#endif
#ifdef FORMAT_MTREE
else if ( f == ATOM_mtree )
ar->type |= FORMAT_MTREE;
#endif
#ifdef FORMAT_RAR
else if ( f == ATOM_rar )
ar->type |= FORMAT_RAR;
#endif
#ifdef FORMAT_RAW
else if ( f == ATOM_raw )
ar->type |= FORMAT_RAW;
#endif
#ifdef FORMAT_TAR
else if ( f == ATOM_tar )
ar->type |= FORMAT_TAR;
#endif
#ifdef FORMAT_XAR
else if ( f == ATOM_xar )
ar->type |= FORMAT_XAR;
#endif
#ifdef FORMAT_ZIP
else if ( f == ATOM_zip )
ar->type |= FORMAT_ZIP;
#endif
else
return PL_domain_error("format", arg);
} else if ( name == ATOM_close_parent )
{ if ( !PL_get_bool_ex(arg, &ar->close_parent) )
return FALSE;
}
}
if ( !PL_get_nil_ex(tail) )
return FALSE;
if ( !(ar->type & FILTER_ALL) )
ar->type |= FILTER_ALL;
if ( !(ar->type & FORMAT_MASK) )
ar->type |= FORMAT_ALL;
if ( !(ar->archive = archive_read_new()) )
return PL_resource_error("memory");
if ( (ar->type & FILTER_ALL) == FILTER_ALL )
{ archive_read_support_filter_all(ar->archive);
} else
{
#ifdef FILTER_BZIP2
enable_type(ar, FILTER_BZIP2, archive_read_support_filter_bzip2);
#endif
#ifdef FILTER_COMPRESS
enable_type(ar, FILTER_COMPRESS, archive_read_support_filter_compress);
#endif
#ifdef FILTER_GZIP
enable_type(ar, FILTER_GZIP, archive_read_support_filter_gzip);
#endif
#ifdef FILTER_GRZIP
enable_type(ar, FILTER_GRZIP, archive_read_support_filter_grzip);
#endif
#ifdef FILTER_LRZIP
enable_type(ar, FILTER_LRZIP, archive_read_support_filter_lrzip);
#endif
#ifdef FILTER_LZIP
enable_type(ar, FILTER_LZIP, archive_read_support_filter_lzip);
#endif
#ifdef FILTER_LZMA
enable_type(ar, FILTER_LZMA, archive_read_support_filter_lzma);
#endif
#ifdef FILTER_LZOP
enable_type(ar, FILTER_LZOP, archive_read_support_filter_lzop);
#endif
#ifdef FILTER_NONE
enable_type(ar, FILTER_NONE, archive_read_support_filter_none);
#endif
#ifdef FILTER_RPM
enable_type(ar, FILTER_RPM, archive_read_support_filter_rpm);
#endif
#ifdef FILTER_UU
enable_type(ar, FILTER_UU, archive_read_support_filter_uu);
#endif
#ifdef FILTER_XZ
enable_type(ar, FILTER_XZ, archive_read_support_filter_xz);
#endif
}
if ( (ar->type & FORMAT_ALL) == FORMAT_ALL )
{ archive_read_support_format_all(ar->archive);
#ifdef FORMAT_RAW
enable_type(ar, FORMAT_RAW, archive_read_support_format_raw);
#endif
} else
{
#ifdef FORMAT_7ZIP
enable_type(ar, FORMAT_7ZIP, archive_read_support_format_7zip);
#endif
#ifdef FORMAT_AR
enable_type(ar, FORMAT_AR, archive_read_support_format_ar);
#endif
#ifdef FORMAT_CAB
enable_type(ar, FORMAT_CAB, archive_read_support_format_cab);
#endif
#ifdef FORMAT_CPIO
enable_type(ar, FORMAT_CPIO, archive_read_support_format_cpio);
#endif
#ifdef FORMAT_EMPTY
enable_type(ar, FORMAT_EMPTY, archive_read_support_format_empty);
#endif
#ifdef FORMAT_GNUTAR
enable_type(ar, FORMAT_GNUTAR, archive_read_support_format_gnutar);
#endif
#ifdef FORMAT_ISO9960
enable_type(ar, FORMAT_ISO9960, archive_read_support_format_iso9660);
#endif
#ifdef FORMAT_LHA
enable_type(ar, FORMAT_LHA, archive_read_support_format_lha);
#endif
#ifdef FORMAT_MTREE
enable_type(ar, FORMAT_MTREE, archive_read_support_format_mtree);
#endif
#ifdef FORMAT_RAR
enable_type(ar, FORMAT_RAR, archive_read_support_format_rar);
#endif
#ifdef FORMAT_RAW
enable_type(ar, FORMAT_RAW, archive_read_support_format_raw);
#endif
#ifdef FORMAT_TAR
enable_type(ar, FORMAT_TAR, archive_read_support_format_tar);
#endif
#ifdef FORMAT_XAR
enable_type(ar, FORMAT_XAR, archive_read_support_format_xar);
#endif
#ifdef FORMAT_ZIP
enable_type(ar, FORMAT_ZIP, archive_read_support_format_zip);
#endif
}
#ifdef HAVE_ARCHIVE_READ_OPEN1
archive_read_set_callback_data(ar->archive, ar);
archive_read_set_open_callback(ar->archive, ar_open);
archive_read_set_read_callback(ar->archive, ar_read);
archive_read_set_skip_callback(ar->archive, ar_skip);
archive_read_set_seek_callback(ar->archive, ar_seek);
archive_read_set_close_callback(ar->archive, ar_close);
if ( archive_read_open1(ar->archive) == ARCHIVE_OK )
{ ar->status = AR_OPENED;
return TRUE;
}
#else
if ( archive_read_open2(ar->archive, ar,
ar_open, ar_read, ar_skip, ar_close) == ARCHIVE_OK )
{ ar->status = AR_OPENED;
return TRUE;
}
#endif
return archive_error(ar);
}
static foreign_t pl_clingo_solve(term_t ccontrol, term_t assumptions,
term_t Show, term_t Model, control_t h) {
int rc = TRUE;
solve_state *state = NULL;
clingo_symbolic_literal_t *assump_vec = NULL;
int control = PL_foreign_control(h);
if (control == PL_FIRST_CALL) {
size_t alen = 0;
if (!(state = malloc(sizeof(*state)))) {
rc = PL_resource_error("memory");
goto out;
}
memset(state, 0, sizeof(*state));
if (!(rc = get_clingo(ccontrol, &state->ctl))) {
goto out;
}
if (PL_skip_list(assumptions, 0, &alen) != PL_LIST) {
rc = PL_type_error("list", assumptions);
goto out;
}
term_t tail = PL_copy_term_ref(assumptions);
term_t head = PL_new_term_ref();
if (!(assump_vec = malloc(sizeof(*assump_vec) * alen))) {
rc = PL_resource_error("memory");
goto out;
}
memset(assump_vec, 0, sizeof(*assump_vec) * alen);
for (size_t i = 0; PL_get_list(tail, head, tail); i++) {
if (!(rc = clingo_status(get_assumption(head, &assump_vec[i])))) {
goto out;
}
}
if (!(rc = clingo_status(clingo_control_solve_iteratively(
state->ctl->control, assump_vec, alen, &state->it)))) {
goto out;
}
} else {
state = PL_foreign_context_address(h);
}
while (control != PL_PRUNED) {
clingo_model_t *model;
if (!(rc = clingo_status(
clingo_solve_iteratively_next(state->it, &model)))) {
goto out;
}
if (model) {
int show;
if (!(rc = get_show_map(Show, &show))) {
goto out;
}
if (!(rc = unify_model(Model, show, model))) {
if (PL_exception(0)) {
goto out;
}
} else {
PL_retry_address(state);
state = NULL;
break;
}
} else {
rc = FALSE;
break;
}
}
out:
if (assump_vec) {
free(assump_vec);
}
if (state) {
if (state->it) {
clingo_solve_iteratively_close(state->it);
}
free(state);
}
return rc;
}
