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; }
static int add_to_form(const char *name, size_t nlen, const char *value, size_t len, void *closure) { term_t head = PL_new_term_ref(); term_t tail = (term_t) closure; term_t val = PL_new_term_ref(); int rc; atom_t aname = 0; if ( isnumber(value, len) ) { rc = unify_number(val, value, len); } 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; }
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; }
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 foreign_t archive_property(term_t archive, term_t prop, term_t value) { archive_wrapper *ar; atom_t pn; const char *s; if ( !get_archive(archive, &ar) || !PL_get_atom_ex(prop, &pn) ) return FALSE; #ifdef HAVE_ARCHIVE_FILTER_COUNT if ( pn == ATOM_filter ) { int i, fcount = archive_filter_count(ar->archive); term_t tail = PL_copy_term_ref(value); term_t head = PL_new_term_ref(); for(i=0; i<fcount; i++) { s = archive_filter_name(ar->archive, i); if ( !s || strcmp(s, "none") == 0 ) continue; if ( !PL_unify_list(tail, head, tail) || !PL_unify_atom_chars(head, s) ) return FALSE; } return PL_unify_nil(tail); } #endif return FALSE; }
static foreign_t pl_group_info(term_t group, term_t info) { int gid; struct group grp, *pgrp; char buf[1000]; char *name; term_t members = PL_new_term_ref(); term_t tail = PL_copy_term_ref(members); term_t head = PL_new_term_ref(); char **memp; if ( PL_get_integer(group, &gid) ) { again1: errno = 0; if ( getgrgid_r(gid, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again1; } return error(errno, "info", "group", group); } } else if ( PL_get_chars(group, &name, CVT_ATOMIC|REP_MB) ) { again2: errno = 0; if ( getgrnam_r(name, &grp, buf, sizeof(buf), &pgrp) != 0 ) { if ( errno == EINTR ) { if ( PL_handle_signals() < 0 ) return FALSE; goto again2; } return error(errno, "info", "group", group); } } else { return PL_type_error("group", group); } if ( !pgrp ) return PL_existence_error("group", group); for(memp=pgrp->gr_mem; *memp; memp++) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_chars(head, PL_ATOM|REP_MB, -1, *memp) ) return FALSE; } if ( !PL_unify_nil(tail) ) return FALSE; return PL_unify_term(info, PL_FUNCTOR_CHARS, "group_info", 4, PL_MBCHARS, pgrp->gr_name, PL_MBCHARS, pgrp->gr_passwd, PL_INT, (int)pgrp->gr_gid, PL_TERM, members ); }
static foreign_t snowball_algorithms(term_t list) { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); const char **algos = sb_stemmer_list(); int i; for(i=0; algos[i]; i++) { if ( !PL_unify_list(tail, head, tail) || !PL_unify_atom_chars(head, algos[i]) ) return FALSE; } return PL_unify_nil(tail); }
// 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 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; }
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); }
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); }