int get_prefixed_iri(rdf_db *db, term_t t, atom_t *ap) { if ( PL_is_functor(t, FUNCTOR_colon2) ) { term_t a = PL_new_term_ref(); atom_t alias, local, uri; _PL_get_arg(1, t, a); if ( !PL_get_atom(a, &alias) ) return FALSE; _PL_get_arg(2, t, a); if ( !PL_get_atom(a, &local) ) return FALSE; if ( (uri = cached_expansion(alias, local)) ) { *ap = uri; return TRUE; } if ( (uri = expand_prefix(db, alias, local)) ) { cache_expansion(alias, local, uri); *ap = uri; return TRUE; } } return FALSE; }
cairo_bool_t plcairo_term_to_ps_level(term_t t, cairo_ps_level_t *level) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_ps_level_t: %p", t, level); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoPSLevel", 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 ( a == ATOM_cairo_ps_level_2 ) { *level = CAIRO_PS_LEVEL_2; } else if ( a == ATOM_cairo_ps_level_3 ) { *level = CAIRO_PS_LEVEL_3; } else { return PL_domain_error("CairoPSLevel", t); } return TRUE; }
static const uri_component_ranges * base_ranges(term_t t) { atom_t a; if ( PL_get_atom(t, &a) ) { base_cache *base = myBase(); if ( base->atom != a ) { size_t len; pl_wchar_t *s; if ( base->atom ) { PL_unregister_atom(base->atom); PL_free(base->text); } if ( !PL_get_wchars(t, &len, &s, CVT_ATOM|BUF_MALLOC) ) return NULL; base->atom = a; PL_register_atom(a); base->text = s; parse_uri(&base->ranges, len, s); } return &base->ranges; } else { type_error("atom", t); return NULL; } }
static int sha_options(term_t options, optval *result) { term_t opts = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); /* defaults */ memset(result, 0, sizeof(*result)); result->algorithm = ALGORITHM_SHA1; result->digest_size = SHA1_DIGEST_SIZE; while(PL_get_list(opts, opt, opts)) { atom_t aname; int arity; if ( PL_get_name_arity(opt, &aname, &arity) && arity == 1 ) { term_t a = PL_new_term_ref(); _PL_get_arg(1, opt, a); if ( aname == ATOM_algorithm ) { atom_t a_algorithm; result->algorithm_term = a; if ( !PL_get_atom(a, &a_algorithm) ) return pl_error(NULL, 0, NULL, ERR_TYPE, a, "algorithm"); if ( a_algorithm == ATOM_sha1 ) { result->algorithm = ALGORITHM_SHA1; result->digest_size = SHA1_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha224 ) { result->algorithm = ALGORITHM_SHA224; result->digest_size = SHA224_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha256 ) { result->algorithm = ALGORITHM_SHA256; result->digest_size = SHA256_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha384 ) { result->algorithm = ALGORITHM_SHA384; result->digest_size = SHA384_DIGEST_SIZE; } else if ( a_algorithm == ATOM_sha512 ) { result->algorithm = ALGORITHM_SHA512; result->digest_size = SHA512_DIGEST_SIZE; } else return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "algorithm"); } } else { return pl_error(NULL, 0, NULL, ERR_TYPE, opt, "option"); } } if ( !PL_get_nil(opts) ) return pl_error("sha_hash", 1, NULL, ERR_TYPE, opts, "list"); return TRUE; }
static int get_order_table(term_t handle, OrdTable *t) { atom_t name; OrdTable ot; if ( PL_get_atom(handle, &name) && (ot = findOrdTable(name)) ) { *t = ot; return TRUE; } return FALSE; }
int query_loop(atom_t goal, int loop) { GET_LD int rc; int clear_stacks = (LD->query == NULL); do { fid_t fid; qid_t qid = 0; term_t except = 0; predicate_t p; if ( !resetProlog(clear_stacks) ) goto error; if ( !(fid = PL_open_foreign_frame()) ) goto error; p = PL_pred(PL_new_functor(goal, 0), MODULE_system); if ( (qid = PL_open_query(MODULE_system, PL_Q_NORMAL, p, 0)) ) { rc = PL_next_solution(qid); } else { error: except = exception_term; rc = FALSE; /* Won't get any better */ break; } if ( !rc && (except = PL_exception(qid)) ) { atom_t a; tracemode(FALSE, NULL); debugmode(DBG_OFF, NULL); setPrologFlagMask(PLFLAG_LASTCALL); if ( PL_get_atom(except, &a) && a == ATOM_aborted ) { #ifdef O_DEBUGGER callEventHook(PLEV_ABORT); #endif printMessage(ATOM_informational, PL_ATOM, ATOM_aborted); } } if ( qid ) PL_close_query(qid); if ( fid ) PL_discard_foreign_frame(fid); if ( !except ) break; } while(loop); return rc; }
static foreign_t pl_tipc_bind(term_t Socket, term_t Address, term_t opt) { struct sockaddr_tipc sockaddr; size_t addrlen = sizeof(sockaddr); int socket; atom_t a; int arity; memset(&sockaddr, 0, sizeof(sockaddr)); if ( !tipc_get_socket(Socket, &socket) || !nbio_get_tipc_sockaddr(Address, &sockaddr) ) return FALSE; if ( PL_get_name_arity(opt, &a, &arity) ) { if ( (a == ATOM_scope || a == ATOM_no_scope) && arity == 1 ) { atom_t val; term_t a1 = PL_new_term_ref(); if (PL_get_arg(1, opt, a1)) { signed char ival = 0; if ( !PL_get_atom(a1, &val) ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "atom"); if ( val == ATOM_zone ) ival = TIPC_ZONE_SCOPE; else if ( val == ATOM_cluster ) ival = TIPC_CLUSTER_SCOPE; else if ( val == ATOM_node ) ival = TIPC_NODE_SCOPE; else if ( val == ATOM_all && a == ATOM_no_scope) addrlen = 0; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "node, cluster, or zone"); sockaddr.scope = (a == ATOM_scope) ? ival : -ival; if ( nbio_bind(socket, (struct sockaddr*)&sockaddr, addrlen) < 0 ) return FALSE; } } else return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1, opt, "scoping option"); return TRUE; } return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "scope/1"); }
static int restore_after_exception(term_t except) { GET_LD atom_t a; int rc = TRUE; tracemode(FALSE, NULL); debugmode(DBG_OFF, NULL); setPrologFlagMask(PLFLAG_LASTCALL); if ( PL_get_atom(except, &a) && a == ATOM_aborted ) { rc = ( callEventHook(PLEV_ABORT) && printMessage(ATOM_informational, PL_ATOM, ATOM_aborted) ); } return rc; }
cairo_bool_t plcairo_term_to_pattern_type(term_t t, cairo_pattern_type_t *pattern_type) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_pattern_type_t: %p", t, pattern_type); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoPatternType", 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 ( a == ATOM_cairo_pattern_type_solid ) { *pattern_type = CAIRO_PATTERN_TYPE_SOLID; } else if ( a == ATOM_cairo_pattern_type_surface ) { *pattern_type = CAIRO_PATTERN_TYPE_SURFACE; } else if ( a == ATOM_cairo_pattern_type_linear ) { *pattern_type = CAIRO_PATTERN_TYPE_LINEAR; } else if ( a == ATOM_cairo_pattern_type_radial ) { *pattern_type = CAIRO_PATTERN_TYPE_RADIAL; } else if ( a == ATOM_cairo_pattern_type_mesh ) { *pattern_type = CAIRO_PATTERN_TYPE_MESH; } else if ( a == ATOM_cairo_pattern_type_raster_source ) { *pattern_type = CAIRO_PATTERN_TYPE_RASTER_SOURCE; } else { return PL_domain_error("CairoPatternType", t); } return TRUE; }
cairo_bool_t plcairo_term_to_filter(term_t t, cairo_filter_t *filter) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_filter_t: %p", t, filter); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoFilter", 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 ( a == ATOM_cairo_filter_fast ) { *filter = CAIRO_FILTER_FAST; } else if ( a == ATOM_cairo_filter_good ) { *filter = CAIRO_FILTER_GOOD; } else if ( a == ATOM_cairo_filter_best ) { *filter = CAIRO_FILTER_BEST; } else if ( a == ATOM_cairo_filter_nearest ) { *filter = CAIRO_FILTER_NEAREST; } else if ( a == ATOM_cairo_filter_bilinear ) { *filter = CAIRO_FILTER_BILINEAR; } else if ( a == ATOM_cairo_filter_gaussian ) { *filter = CAIRO_FILTER_GAUSSIAN; } else { return PL_domain_error("CairoFilter", t); } return TRUE; }
static foreign_t uri_encoded(term_t what, term_t qv, term_t enc) { pl_wchar_t *s; size_t len; atom_t w; int flags; if ( !PL_get_atom(what, &w) ) return type_error("atom", what); if ( w == ATOM_query_value ) flags = ESC_QVALUE; else if ( w == ATOM_fragment ) flags = ESC_FRAGMENT; else if ( w == ATOM_path ) flags = ESC_PATH; else return domain_error("uri_component", what); fill_flags(); if ( !PL_is_variable(qv) ) { charbuf out; int rc; init_charbuf(&out); if ( !add_encoded_term_charbuf(&out, qv, flags) ) { free_charbuf(&out); return FALSE; } rc = PL_unify_wchars(enc, PL_ATOM, out.here-out.base, out.base); free_charbuf(&out); return rc; } else if ( PL_get_wchars(enc, &len, &s, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) ) { range r; r.start = s; r.end = s+len; return unify_decoded_atom(qv, &r, flags); } else { return FALSE; } }
static int get_max_chr(term_t t, int *maxchr) { atom_t a; if ( PL_get_atom(t, &a) ) { if ( a == ATOM_iso_latin_1 ) *maxchr = 0xff; else if ( a == ATOM_utf8 ) *maxchr = 0x7ffffff; else if ( a == ATOM_unicode ) *maxchr = 0xffff; else if ( a == ATOM_ascii ) *maxchr = 0x7f; else return sgml2pl_error(ERR_DOMAIN, "encoding", t); return TRUE; } return sgml2pl_error(ERR_TYPE, "atom", t); }
static foreign_t process_wait(term_t pid, term_t code, term_t options) { pid_t p; wait_options opts; term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); if ( !get_pid(pid, &p) ) return FALSE; memset(&opts, 0, sizeof(opts)); while(PL_get_list(tail, head, tail)) { atom_t name; int arity; if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 ) return type_error(head, "option"); _PL_get_arg(1, head, arg); if ( name == ATOM_timeout ) { atom_t a; if ( !(PL_get_atom(arg, &a) && a == ATOM_infinite) ) { if ( !PL_get_float(arg, &opts.timeout) ) return type_error(arg, "timeout"); opts.has_timeout = TRUE; } } else if ( name == ATOM_release ) { if ( !PL_get_bool(arg, &opts.release) ) return type_error(arg, "boolean"); if ( opts.release == FALSE ) return domain_error(arg, "true"); } else return domain_error(head, "process_wait_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return wait_for_pid(p, code, &opts); }
static int get_lang_stemmer(term_t t, struct sb_stemmer **stemmer) { stem_cache *cache = get_cache(); atom_t lang; int i; if ( !PL_get_atom(t, &lang) ) return type_error("atom", t); for(i=0; i<CACHE_SIZE; i++) { if ( cache->stemmers[i].language == lang ) { *stemmer = cache->stemmers[i].stemmer; return TRUE; } } for(i=0; i<CACHE_SIZE; i++) { if ( !cache->stemmers[i].stemmer ) { struct sb_stemmer *st; if ( !(st= sb_stemmer_new(PL_atom_chars(lang), NULL)) ) { if ( errno == ENOMEM ) return resource_error("memory"); else return domain_error("snowball_algorithm", t); } cache->stemmers[i].language = lang; cache->stemmers[i].stemmer = st; PL_register_atom(cache->stemmers[i].language); *stemmer = cache->stemmers[i].stemmer; return TRUE; } } assert(0); /* TBD: clean cache */ return FALSE; }
cairo_bool_t plcairo_term_to_extend(term_t t, cairo_extend_t *extend) { atom_t a; PLCAIRO_debug(" term: 0x%lx ---> cairo_extend_t: %p", t, extend); if ( !PL_get_atom(t, &a) ) { return PL_type_error("CairoExtend", 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 ( a == ATOM_cairo_extend_none ) { *extend = CAIRO_EXTEND_NONE; } else if ( a == ATOM_cairo_extend_repeat ) { *extend = CAIRO_EXTEND_REPEAT; } else if ( a == ATOM_cairo_extend_reflect ) { *extend = CAIRO_EXTEND_REFLECT; } else if ( a == ATOM_cairo_extend_pad ) { *extend = CAIRO_EXTEND_PAD; } else { return PL_domain_error("CairoExtend", t); } return TRUE; }
static int get_stream(term_t t, p_options *info, p_stream *stream) { atom_t a; if ( PL_get_atom(t, &a) ) { if ( a == ATOM_null ) { stream->type = std_null; return TRUE; } else if ( a == ATOM_std ) { stream->type = std_std; return TRUE; } else { return domain_error(t, "process_stream"); } } else if ( PL_is_functor(t, FUNCTOR_pipe1) ) { stream->term = PL_new_term_ref(); _PL_get_arg(1, t, stream->term); stream->type = std_pipe; info->pipes++; return TRUE; } else return type_error(t, "process_stream"); }
static foreign_t pl_rl_add_history(term_t text) { atom_t a; static atom_t last = 0; if ( PL_get_atom(text, &a) ) { if ( a != last ) { TCHAR *s; if ( last ) PL_unregister_atom(last); last = a; PL_register_atom(last); PL_get_wchars(text, NULL, &s, CVT_ATOM); rlc_add_history(PL_current_console(), s); } return TRUE; } return FALSE; }
static int get_dst_arg(int i, term_t t, term_t a, int *val) { GET_LD atom_t name; _PL_get_arg(i, t, a); if ( PL_get_atom(a, &name) ) { if ( name == ATOM_true ) { *val = TRUE; return TRUE; } else if ( name == ATOM_false ) { *val = FALSE; return TRUE; } else if ( name == ATOM_minus ) { *val = -1; return TRUE; } } else if ( PL_is_variable(a) ) { *val = -2; return TRUE; } return PL_get_bool_ex(a, val); /* generate an error */ }
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 udp_receive(term_t Socket, term_t Data, term_t From, term_t options) { struct sockaddr_in sockaddr; #ifdef __WINDOWS__ int alen = sizeof(sockaddr); #else socklen_t alen = sizeof(sockaddr); #endif int socket; int flags = 0; char buf[UDP_MAXDATA]; ssize_t n; int as = PL_STRING; 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; int arity; if ( PL_get_name_arity(head, &name, &arity) && arity == 1 ) { _PL_get_arg(1, head, arg); if ( name == ATOM_as ) { atom_t a; if ( !PL_get_atom(arg, &a) ) return pl_error(NULL, 0, NULL, ERR_TYPE, head, "atom"); if ( a == ATOM_atom ) as = PL_ATOM; else if ( a == ATOM_codes ) as = PL_CODE_LIST; else if ( a == ATOM_string ) as = PL_STRING; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, arg, "as_option"); } } else return pl_error(NULL, 0, NULL, ERR_TYPE, head, "option"); } if ( !PL_get_nil(tail) ) return pl_error(NULL, 0, NULL, ERR_TYPE, tail, "list"); } if ( !tcp_get_socket(Socket, &socket) || !nbio_get_sockaddr(From, &sockaddr) ) return FALSE; if ( (n=nbio_recvfrom(socket, buf, sizeof(buf), flags, (struct sockaddr*)&sockaddr, &alen)) == -1 ) return nbio_error(errno, TCP_ERRNO); if ( !PL_unify_chars(Data, as, n, buf) ) return FALSE; return unify_address(From, &sockaddr); }
word pl_current_functor(term_t name, term_t arity, control_t h) { GET_LD atom_t nm = 0; size_t index; int i, last=FALSE; int ar; fid_t fid; switch( ForeignControl(h) ) { case FRG_FIRST_CALL: if ( PL_get_atom(name, &nm) && PL_get_integer(arity, &ar) ) return isCurrentFunctor(nm, ar) ? TRUE : FALSE; if ( !(PL_is_integer(arity) || PL_is_variable(arity)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_integer, arity); if ( !(PL_is_atom(name) || PL_is_variable(name)) ) return PL_error("current_functor", 2, NULL, ERR_DOMAIN, ATOM_atom, name); index = 1; break; case FRG_REDO: PL_get_atom(name, &nm); index = ForeignContextInt(h); break; case FRG_CUTTED: default: succeed; } fid = PL_open_foreign_frame(); LOCK(); for(i=MSB(index); !last; i++) { size_t upto = (size_t)2<<i; FunctorDef *b = GD->functors.array.blocks[i]; if ( upto >= GD->functors.highest ) { upto = GD->functors.highest; last = TRUE; } for(; index<upto; index++) { FunctorDef fd = b[index]; if ( fd && fd->arity > 0 && (!nm || nm == fd->name) ) { if ( PL_unify_atom(name, fd->name) && PL_unify_integer(arity, fd->arity) ) { UNLOCK(); ForeignRedoInt(index+1); } else { PL_rewind_foreign_frame(fid); } } } } UNLOCK(); return FALSE; }
static foreign_t pl_new_order_table(term_t name, term_t options) { OrdTable t = malloc(sizeof(ordtable)); term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); exact_table(t); if ( !PL_get_atom(name, &t->name) ) { free(t); return error(ERR_INSTANTIATION, "new_order_table/2", 1, name); } while(PL_get_list(tail, head, tail)) { atom_t name; int arity; if ( PL_get_name_arity(head, &name, &arity) ) { if ( name == ATOM_case_insensitive ) { case_insensitive_table(t); } else if ( name == ATOM_iso_latin_1 ) { iso_latin_1_table(t); } else if ( name == ATOM_iso_latin_1_case_insensitive ) { iso_latin_1_case_table(t); } else if ( name == ATOM_copy && arity == 1 ) { term_t a = PL_new_term_ref(); OrdTable from; _PL_get_arg(1, head, a); if ( get_order_table(a, &from) ) { copy_table(t, from); } else { free(t); return FALSE; } } else if ( arity == 1 ) { fid_t fid = PL_open_foreign_frame(); term_t a = PL_new_term_ref(); _PL_get_arg(1, head, a); if ( !parse_set(t, name, a) ) goto err1; PL_close_foreign_frame(fid); } else if ( name == ATOM_eq && arity == 2 ) { fid_t fid = PL_open_foreign_frame(); term_t c = PL_new_term_ref(); int from, to; if ( !PL_get_arg(1, head, c) || !get_char(c, &from) || !PL_get_arg(2, head, c) || !get_char(c, &to) ) { free(t); return FALSE; } ORD(t, from) = to; PL_close_foreign_frame(fid); } else goto err1; } else { err1: free(t); return error(ERR_INSTANTIATION, "new_order_table/2", 2, options); } } if ( !PL_get_nil(tail) ) goto err1; register_table(t); PL_succeed; }
bool scan_options(term_t options, int flags, atom_t optype, const opt_spec *specs, ...) { GET_LD va_list args; const opt_spec *s; optvalue values[MAXOPTIONS]; term_t list = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t tmp = PL_new_term_ref(); term_t val = PL_new_term_ref(); int n; if ( truePrologFlag(PLFLAG_ISO) ) flags |= OPT_ALL; va_start(args, specs); for( n=0, s = specs; s->name; s++, n++ ) values[n].ptr = va_arg(args, void *); va_end(args); while ( PL_get_list(list, head, list) ) { atom_t name; int arity; if ( PL_get_name_arity(head, &name, &arity) ) { if ( name == ATOM_equals && arity == 2 ) { _PL_get_arg(1, head, tmp); if ( !PL_get_atom(tmp, &name) ) goto itemerror; _PL_get_arg(2, head, val); } else if ( arity == 1 ) { _PL_get_arg(1, head, val); } else if ( arity == 0 ) PL_put_atom(val, ATOM_true); } else if ( PL_is_variable(head) ) { return PL_error(NULL, 0, NULL, ERR_INSTANTIATION); } else { itemerror: return PL_error(NULL, 0, NULL, ERR_DOMAIN, optype, head); } for( n=0, s = specs; s->name; n++, s++ ) { if ( s->name == name ) { switch((s->type & OPT_TYPE_MASK)) { case OPT_BOOL: { int bval; if ( !PL_get_bool_ex(val, &bval) ) return FALSE; *values[n].b = bval; break; } case OPT_INT: { if ( !PL_get_integer_ex(val, values[n].i) ) return FALSE; break; } case OPT_LONG: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].l = LONG_MAX; else if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; break; } case OPT_NATLONG: { if ( !PL_get_long_ex(val, values[n].l) ) return FALSE; if ( *(values[n].l) <= 0 ) return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_not_less_than_one, val); break; } case OPT_SIZE: { if ( (s->type & OPT_INF) && PL_is_inf(val) ) *values[n].sz = (size_t)-1; else if ( !PL_get_size_ex(val, values[n].sz) ) return FALSE; break; } case OPT_DOUBLE: { if ( !PL_get_float_ex(val, values[n].f) ) return FALSE; break; } case OPT_STRING: { char *str; if ( !PL_get_chars(val, &str, CVT_ALL|CVT_EXCEPTION) ) /* copy? */ return FALSE; *values[n].s = str; break; } case OPT_ATOM: { atom_t a; if ( !PL_get_atom_ex(val, &a) ) return FALSE; *values[n].a = a; break; } #ifdef O_LOCALE case OPT_LOCALE: { PL_locale *l; PL_locale **lp = values[n].ptr; if ( !getLocaleEx(val, &l) ) return FALSE; *lp = l; break; } #endif case OPT_TERM: { *values[n].t = val; val = PL_new_term_ref(); /* can't reuse anymore */ break; } default: assert(0); fail; } break; } } if ( !s->name && (flags & OPT_ALL) ) goto itemerror; } if ( !PL_get_nil(list) ) return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_list, list); succeed; }
static foreign_t pl_tipc_setopt(term_t Socket, term_t opt) { int socket; atom_t a; int arity; if ( !tipc_get_socket(Socket, &socket) ) return FALSE; if ( PL_get_name_arity(opt, &a, &arity) ) { if ( a == ATOM_importance && arity == 1 ) { atom_t val; term_t a1 = PL_new_term_ref(); int ival = TIPC_LOW_IMPORTANCE; if (PL_get_arg(1, opt, a1)) { if(!PL_get_atom(a1, &val) ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "atom"); if(val == ATOM_low) ival = TIPC_LOW_IMPORTANCE; else if(val == ATOM_medium) ival = TIPC_MEDIUM_IMPORTANCE; else if(val == ATOM_high) ival = TIPC_HIGH_IMPORTANCE; else if(val == ATOM_critical) ival = TIPC_CRITICAL_IMPORTANCE; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "low, medium, high, or critical"); return((tipc_setopt(socket, NB_TIPC_IMPORTANCE, ival) == 0) ? TRUE : FALSE); } } if ( ((a == ATOM_dest_droppable) || (a == ATOM_src_droppable)) && arity == 1 ) { int val; term_t a1 = PL_new_term_ref(); int option = (a == ATOM_dest_droppable) ? NB_TIPC_DEST_DROPPABLE : NB_TIPC_SRC_DROPPABLE; if (PL_get_arg(1, opt, a1)) { if(!PL_get_bool(a1, &val) ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "boolean"); return((tipc_setopt(socket, option, val) == 0) ? TRUE : FALSE); } } if ( a == ATOM_conn_timeout && arity == 1 ) { double val; int ival; term_t a1 = PL_new_term_ref(); if (PL_get_arg(1, opt, a1)) { if(!PL_get_float(a1, &val) || val < 0) return pl_error(NULL, 0, NULL, ERR_DOMAIN, a1, "float"); ival = val * 1000; // time is in milliseconds return((tipc_setopt(socket, NB_TIPC_CONN_TIMEOUT, ival) == 0) ? TRUE : FALSE); } } if ( a == ATOM_nodelay && arity <= 1 ) { int enable, rc; if ( arity == 0 ) { enable = TRUE; } else /*if ( arity == 1 )*/ { term_t a = PL_new_term_ref(); _PL_get_arg(1, opt, a); if ( !PL_get_bool(a, &enable) ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, a, "boolean"); } if ( (rc=nbio_setopt(socket, TCP_NO_DELAY, enable) == 0) ) return TRUE; if ( rc == -2 ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option"); } if ( a == ATOM_nonblock && arity == 0 ) return((nbio_setopt(socket, TCP_NONBLOCK) == 0) ? TRUE : FALSE ); if ( a == ATOM_dispatch && arity == 1 ) { int val; term_t a1 = PL_new_term_ref(); if ( PL_get_arg(1, opt, a1) && PL_get_bool(a1, &val) ) { if ( nbio_setopt(socket, TCP_DISPATCH, val) == 0 ) return TRUE; return FALSE; } } } return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option"); }
static foreign_t udp_receive(term_t Socket, term_t Data, term_t From, term_t options) { struct sockaddr_in sockaddr; #ifdef __WINDOWS__ int alen = sizeof(sockaddr); #else socklen_t alen = sizeof(sockaddr); #endif int socket; int flags = 0; char smallbuf[UDP_DEFAULT_BUFSIZE]; char *buf = smallbuf; int bufsize = UDP_DEFAULT_BUFSIZE; term_t varport = 0; ssize_t n; int as = PL_STRING; int rc; 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 ) { _PL_get_arg(1, head, arg); if ( name == ATOM_as ) { atom_t a; if ( !PL_get_atom(arg, &a) ) return pl_error(NULL, 0, NULL, ERR_TYPE, head, "atom"); if ( a == ATOM_atom ) as = PL_ATOM; else if ( a == ATOM_codes ) as = PL_CODE_LIST; else if ( a == ATOM_string ) as = PL_STRING; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, arg, "as_option"); } else if ( name == ATOM_max_message_size ) { if ( !PL_get_integer(arg, &bufsize) ) return pl_error(NULL, 0, NULL, ERR_TYPE, arg, "integer"); if ( bufsize < 0 || bufsize > UDP_MAXDATA ) return pl_error(NULL, 0, NULL, ERR_DOMAIN, arg, "0 - 65535"); } } else return pl_error(NULL, 0, NULL, ERR_TYPE, head, "option"); } if ( !PL_get_nil(tail) ) return pl_error(NULL, 0, NULL, ERR_TYPE, tail, "list"); } if ( !tcp_get_socket(Socket, &socket) || !nbio_get_sockaddr(From, &sockaddr, &varport) ) return FALSE; if ( bufsize > UDP_DEFAULT_BUFSIZE ) { if ( !(buf = malloc(bufsize)) ) return pl_error(NULL, 0, NULL, ERR_RESOURCE, "memory"); } if ( (n=nbio_recvfrom(socket, buf, bufsize, flags, (struct sockaddr*)&sockaddr, &alen)) == -1 ) { rc = nbio_error(errno, TCP_ERRNO); goto out; } rc = ( PL_unify_chars(Data, as, n, buf) && unify_address(From, &sockaddr) ); out: if ( buf != smallbuf ) free(buf); return rc; }