static foreign_t python_field(term_t parent, term_t att, term_t tobj) { PyObject *pF; atom_t name; char *s; int arity; if (!PL_get_name_arity(att, &name, &arity)) { { return false; } } else { PyObject *p; // got Scope.Exp // get Scope ... p = term_to_python(parent, true); // Exp if (!PL_get_name_arity(att, &name, &arity)) { { return false; } } s = PL_atom_chars(name); if (arity == 1 && !strcmp(s, "()")) { if (!PL_get_arg(1, att, att)) { return false; } if (!PL_get_name_arity(att, &name, &arity)) { { return false; } } s = PL_atom_chars(name); } if (!s || !p) { { return false; } } else if ((pF = PyObject_GetAttrString(p, s)) == NULL) { PyErr_Clear(); { return false; } } } { foreign_t rc; rc = address_to_term(pF, tobj); return rc; } }
static foreign_t tipc_socket(term_t socket, term_t opt) { atom_t a; int arity; if ( PL_get_name_arity(opt, &a, &arity) && arity == 0) { int type; if ( a == ATOM_dgram ) type = SOCK_DGRAM; else if ( a == ATOM_rdm ) type = SOCK_RDM; else if ( a == ATOM_seqpacket ) type = SOCK_SEQPACKET; else if ( a == ATOM_stream ) type = SOCK_STREAM; else return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "rdm, dgram, seqpacket, or stream"); return create_tipc_socket(socket, type); } else return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1, opt, "atom"); return FALSE; }
static int process_console_options(rlc_console_attr *attr, term_t options) { term_t tail = PL_copy_term_ref(options); term_t opt = PL_new_term_ref(); while(PL_get_list(tail, opt, tail)) { atom_t name; const char *s; int arity; if ( !PL_get_name_arity(opt, &name, &arity) ) return type_error(opt, "compound"); s = PL_atom_chars(name); if ( streq(s, "registry_key") && arity == 1 ) { TCHAR *key; if ( !get_chars_arg_ex(1, opt, &key) ) return FALSE; attr->key = key; } else return domain_error(opt, "window_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return TRUE; }
static PyObject *find_obj(PyObject *ob, term_t lhs) { char *s; PyObject *out, *pName; int arity = 0; if (!PL_get_atom_chars(lhs, &s)) { atom_t name; if (!PL_get_name_arity(lhs, &name, &arity)) return NULL; s = PL_atom_chars(name); } if (ob) { out = PyObject_GetAttrString(ob, s); return out; } if (!ob && !arity) { #if PY_MAJOR_VERSION < 3 pName = PyString_FromString(s); #else pName = PyUnicode_FromString(s); #endif if (pName == NULL) { return NULL; } if ((out = PyImport_Import(pName))) { Py_IncRef(out); // Py_DecRef(pName); ?? return out; } } if (!ob && py_Main && (out = PyObject_GetAttrString(py_Main, s))) return out; return NULL; }
static foreign_t pl_setopt(term_t Socket, term_t opt) { int socket; atom_t a; int arity; if ( !tcp_get_socket(Socket, &socket) ) return FALSE; if ( PL_get_name_arity(opt, &a, &arity) ) { if ( a == ATOM_reuseaddr && arity == 0 ) { if ( nbio_setopt(socket, TCP_REUSEADDR, TRUE) == 0 ) return TRUE; return FALSE; } else 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 ) goto not_implemented; return FALSE; } else if ( a == ATOM_broadcast && arity == 0 ) { if ( nbio_setopt(socket, UDP_BROADCAST, TRUE) == 0 ) return TRUE; return FALSE; } else 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; } } else if ( a == ATOM_nonblock && arity == 0 ) { if ( nbio_setopt(socket, TCP_NONBLOCK) == 0 ) return TRUE; return FALSE; } } not_implemented: return pl_error(NULL, 0, NULL, ERR_DOMAIN, opt, "socket_option"); }
rb_red_blk_tree* buildEventMap() { printf("--- Generating Event Rule Map ... \n"); rb_red_blk_tree* EventTree = RBTreeCreate(Compare_EventType,DestroyEventType,DestroyInfoEventKey,PrintEventKey,PrintInfoEventKey); if(!EventTree) { printf("Error Building the Event Rule Map.\n"); return NULL; } int i=0; term_t a0 = PL_new_term_refs(3); term_t b0 = PL_new_term_refs(2); static predicate_t p; static functor_t event_functor; char myEvents[256][256]; int arity; eventType* temp=NULL; if ( !event_functor ) event_functor = PL_new_functor(PL_new_atom("event"), 2); PL_cons_functor(a0+1,event_functor,b0,b0+1); if ( !p ) p = PL_predicate("trClause", 3, NULL); qid_t qid = PL_open_query(NULL, PL_Q_NORMAL, p, a0); while(PL_next_solution(qid) != FALSE) { //termToString(b0,myEvents[i]); atom_t name; PL_get_name_arity(b0, &name, &arity); sprintf(myEvents[i],"%s",PL_atom_chars(name)); temp=(eventType*)calloc(1,sizeof(eventType)); trClause* trc=(trClause*)calloc(1,sizeof(trClause)); strcpy(temp->name,PL_atom_chars(name)); temp->arity = arity; RBTreeInsert(EventTree,temp,trc); temp=NULL; trc=NULL; padding(' ',4); printf("+New Event Signature : %s/%d\n",myEvents[i],arity); i++; } PL_close_query(qid); #if DEBUG RBTreePrint(EventTree); #endif printf("--- Done!\n"); return EventTree; }
static int parse_options(term_t options, p_options *info) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); term_t arg = PL_new_term_ref(); info->window = MAYBE; 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_stdin ) { if ( !get_stream(arg, info, &info->streams[0]) ) return FALSE; } else if ( name == ATOM_stdout ) { if ( !get_stream(arg, info, &info->streams[1]) ) return FALSE; } else if ( name == ATOM_stderr ) { if ( !get_stream(arg, info, &info->streams[2]) ) return FALSE; } else if ( name == ATOM_process ) { info->pid = PL_copy_term_ref(arg); } else if ( name == ATOM_detached ) { if ( !PL_get_bool(arg, &info->detached) ) return type_error(arg, "boolean"); } else if ( name == ATOM_cwd ) { #ifdef __WINDOWS__ if ( !PL_get_wchars(arg, NULL, &info->cwd, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC) ) return FALSE; #else if ( !PL_get_chars(arg, &info->cwd, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC|REP_FN) ) return FALSE; #endif } else if ( name == ATOM_window ) { if ( !PL_get_bool(arg, &info->window) ) return type_error(arg, "boolean"); } else if ( name == ATOM_env ) { if ( !parse_environment(arg, info) ) return FALSE; } else return domain_error(head, "process_option"); } if ( !PL_get_nil(tail) ) return type_error(tail, "list"); return TRUE; }
static foreign_t uri_query_components(term_t string, term_t list) { pl_wchar_t *s; size_t len; if ( PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) ) { return unify_query_string_components(list, len, s); } else if ( PL_is_list(list) ) { term_t tail = PL_copy_term_ref(list); term_t head = PL_new_term_ref(); term_t nv = PL_new_term_refs(2); charbuf out; int rc; fill_flags(); init_charbuf(&out); while( PL_get_list(tail, head, tail) ) { atom_t fname; int arity; if ( PL_is_functor(head, FUNCTOR_equal2) || PL_is_functor(head, FUNCTOR_pair2) ) { _PL_get_arg(1, head, nv+0); _PL_get_arg(2, head, nv+1); } else if ( PL_get_name_arity(head, &fname, &arity) && arity == 1 ) { PL_put_atom(nv+0, fname); _PL_get_arg(1, head, nv+1); } else { free_charbuf(&out); return type_error("name_value", head); } if ( out.here != out.base ) add_charbuf(&out, '&'); if ( !add_encoded_term_charbuf(&out, nv+0, ESC_QNAME) ) { free_charbuf(&out); return FALSE; } add_charbuf(&out, '='); if ( !add_encoded_term_charbuf(&out, nv+1, ESC_QVALUE) ) { free_charbuf(&out); return FALSE; } } rc = PL_unify_wchars(string, PL_ATOM, out.here-out.base, out.base); free_charbuf(&out); return rc; } else { return PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION); } return FALSE; }
// parse a list of Prolog terms and add arguments to an OSC message static int add_msg_args(lo_message msg, term_t list) { term_t head=PL_new_term_ref(); // copy term ref so as not to modify original list=PL_copy_term_ref(list); while (PL_get_list(list,head,list)) { atom_t name; int arity; const char *type; if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term"); type=PL_atom_chars(name); switch (arity) { case 1: { term_t a1=PL_new_term_ref(); PL_get_arg(1,head,a1); if (!strcmp(type,"int")) { int x; if (!PL_get_integer(a1,&x)) return type_error(a1,"integer"); lo_message_add_int32(msg,x); } else if (!strcmp(type,"double")) { double x; if (!PL_get_float(a1,&x)) return type_error(a1,"float"); lo_message_add_double(msg,x); } else if (!strcmp(type,"string")) { char *x; if (!PL_get_chars(a1,&x,CVT_ATOM|CVT_STRING)) return type_error(a1,"string"); lo_message_add_string(msg,x); } else if (!strcmp(type,"symbol")) { char *x; if (!PL_get_chars(a1,&x,CVT_ATOM)) return type_error(a1,"atom"); lo_message_add_symbol(msg,x); } else if (!strcmp(type,"float")) { double x; if (!PL_get_float(a1,&x)) return type_error(a1,"float"); lo_message_add_float(msg,(float)x); } break; } case 0: { if (!strcmp(type,"true")) lo_message_add_true(msg); else if (!strcmp(type,"false")) lo_message_add_false(msg); else if (!strcmp(type,"nil")) lo_message_add_nil(msg); else if (!strcmp(type,"inf")) lo_message_add_infinitum(msg); break; } } } if (!PL_get_nil(list)) return type_error(list,"nil"); return TRUE; }
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; }
/* * get the name and arity of an SWI Event. */ eventType* getEventType(term_t event_term) { atom_t name; int arity; char* eventName = (char*)malloc(256*sizeof(char)); eventType* ev = (eventType*)malloc(sizeof(eventType)); PL_get_name_arity(event_term,&name,&arity); eventName = PL_atom_chars(name); strcpy(ev->name,eventName); ev->arity=arity; return ev; }
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"); }
/* * Trigger an event without explicitely defining timestamps */ foreign_t triggerEvent_u(term_t args) { atom_t name; int arity=0; PL_get_name_arity(args,&name,&arity); /* find from _event_hash the EventModel to follow */ eventHash tempEventHash; eventHash* foundEventNode = NULL; memset(&tempEventHash,0,sizeof(eventHash)); tempEventHash.ev.arity=arity; strcpy(tempEventHash.ev.name,PL_atom_chars(name)); HASH_FIND(hh,_event_hash,&tempEventHash.ev,sizeof(eventType),foundEventNode); /* if EventModel is in the Hash */ if(foundEventNode != NULL) { EtalisEvent *myEvent=(EtalisEvent*)malloc(sizeof(EtalisEvent)); myEvent->RootModel=foundEventNode->myNode; if (arity != 0) parse_validate_args(args,myEvent); newTimeStamp(&myEvent->timestamps[0]); myEvent->timestamps[1] = myEvent->timestamps[0]; /* debg models */ #ifdef DEBUG EtalisEventNode *myModel = myEvent->RootModel; EtalisExecNode *myExec = myModel->parentNode; #endif /* f dbg */ debug("--- Triggering event ... %s/%d @ [%ld.%06ld,%ld.%06ld]\n",myEvent->RootModel->event.name,myEvent->RootModel->event.arity,myEvent->timestamps[0].time,myEvent->timestamps[0].parts,myEvent->timestamps[1].time,myEvent->timestamps[1].parts); foundEventNode->myNode->trigger(myEvent); } PL_succeed; }
void default_op_parser(EtalisExecNode* operatorNode,term_t t) { assert(operatorNode != NULL); PL_open_foreign_frame(); operatorNode->leftChild=(EtalisEventNode*)malloc(sizeof(EtalisEventNode)); operatorNode->rightChild=NULL; operatorNode->condition=NULL; operatorNode->window_size=0; term_t _left_event=t; atom_t _left_event_name; PL_get_name_arity(_left_event,&_left_event_name,&((operatorNode->leftChild)->event.arity)); strcpy(operatorNode->leftChild->event.name,PL_atom_chars(_left_event_name)); }
/* todo */ void parse_validate_args(term_t args, EtalisEvent* event) { event->args = malloc(sizeof(int)*event->RootModel->event.arity); int arity; PL_get_name_arity(args, NULL, &arity); term_t arg_terms = PL_new_term_refs(arity); /* assuming that all arguments are ints */ /* todo implement for other types */ size_t arg_iterator; for(arg_iterator=0;arg_iterator<event->RootModel->event.arity;arg_iterator++) { PL_get_arg(arg_iterator+1,args,arg_terms+arg_iterator); PL_get_integer(arg_terms+arg_iterator,(int*)event->args+arg_iterator); } }
// parse a list of type terms and encode as a NULL terminated // string where each character encodes the type of one argument. static int get_types_list(term_t list, char *typespec, int len) { term_t head=PL_new_term_ref(); int count=0; // copy term ref so as not to modify original list=PL_copy_term_ref(list); while (PL_get_list(list,head,list) && count<len) { atom_t name; int arity; const char *type; if (!PL_get_name_arity(head,&name,&arity)) return type_error(head,"term"); type=PL_atom_chars(name); switch (arity) { case 1: { if (!strcmp(type,"int")) { typespec[count++]='i'; } else if (!strcmp(type,"double")) { typespec[count++]='d'; } else if (!strcmp(type,"string")) { typespec[count++]='s'; } else if (!strcmp(type,"symbol")) { typespec[count++]='S'; } else if (!strcmp(type,"float")) { typespec[count++]='f'; } break; } case 0: { if (!strcmp(type,"true")) typespec[count++]='T'; else if (!strcmp(type,"false")) typespec[count++]='F'; else if (!strcmp(type,"nil")) typespec[count++]='N'; else if (!strcmp(type,"inf")) typespec[count++]='I'; break; } } } typespec[count]=0; if (!PL_get_nil(list)) return type_error(list,"nil"); return TRUE; }
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 int md5_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->encoding = REP_UTF8; while(PL_get_list(opts, opt, opts)) { atom_t aname; size_t 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_encoding ) { atom_t a_enc; if ( !PL_get_atom_ex(a, &a_enc) ) return FALSE; if ( a_enc == ATOM_utf8 ) result->encoding = REP_UTF8; else if ( a_enc == ATOM_octet ) result->encoding = REP_ISO_LATIN_1; else return PL_domain_error("encoding", a); } } else { return PL_type_error("option", opt); } } if ( !PL_get_nil(opts) ) return PL_type_error("list", opts); return TRUE; }
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 foreign_t alarm4_gen(time_abs_rel abs_rel, term_t time, term_t callable, term_t id, term_t options) { Event ev; double t; module_t m = NULL; unsigned long flags = 0L; if ( options ) { term_t tail = PL_copy_term_ref(options); term_t head = PL_new_term_ref(); while( PL_get_list(tail, head, tail) ) { atom_t name; int arity; if ( PL_get_name_arity(head, &name, &arity) ) { if ( arity == 1 ) { term_t arg = PL_new_term_ref(); _PL_get_arg(1, head, arg); if ( name == ATOM_remove ) { int t = FALSE; if ( !pl_get_bool_ex(arg, &t) ) return FALSE; if ( t ) flags |= EV_REMOVE; } else if ( name == ATOM_install ) { int t = TRUE; if ( !pl_get_bool_ex(arg, &t) ) return FALSE; if ( !t ) flags |= EV_NOINSTALL; } } } } if ( !PL_get_nil(tail) ) return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 4, options, "list"); } if ( !PL_get_float(time, &t) ) return pl_error(NULL, 0, NULL, ERR_ARGTYPE, 1, time, "number"); if ( !(ev = allocEvent()) ) return FALSE; if (abs_rel==TIME_REL) setTimeEvent(ev, t); else setTimeEventAbs(ev,t); if ( !unify_timer(id, ev) ) { freeEvent(ev); /* not linked: no need to lock */ return FALSE; } ev->flags = flags; PL_strip_module(callable, &m, callable); ev->module = m; ev->goal = PL_record(callable); if ( !(ev->flags & EV_NOINSTALL) ) { int rc; if ( (rc=installEvent(ev)) != TRUE ) { freeEvent(ev); /* not linked: no need to lock */ return alarm_error(id, rc); } } return TRUE; }
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); }
static foreign_t cgi_property(term_t cgi, term_t prop) { IOSTREAM *s; cgi_context *ctx; term_t arg = PL_new_term_ref(); atom_t name; int arity; int rc = TRUE; if ( !get_cgi_stream(cgi, &s, &ctx) ) return FALSE; if ( !PL_get_name_arity(prop, &name, &arity) || arity != 1 ) { rc = type_error(prop, "cgi_property"); goto out; } _PL_get_arg(1, prop, arg); if ( name == ATOM_request ) { if ( ctx->request ) rc = unify_record(arg, ctx->request); else rc = PL_unify_nil(arg); } else if ( name == ATOM_header ) { if ( ctx->header ) rc = unify_record(arg, ctx->header); else rc = PL_unify_nil(arg); } else if ( name == ATOM_id ) { rc = PL_unify_int64(arg, ctx->id); } else if ( name == ATOM_client ) { rc = PL_unify_stream(arg, ctx->stream); } else if ( name == ATOM_transfer_encoding ) { rc = PL_unify_atom(arg, ctx->transfer_encoding); } else if ( name == ATOM_connection ) { rc = PL_unify_atom(arg, ctx->connection ? ctx->connection : ATOM_close); } else if ( name == ATOM_content_length ) { if ( ctx->transfer_encoding == ATOM_chunked ) rc = PL_unify_int64(arg, ctx->chunked_written); else rc = PL_unify_int64(arg, ctx->datasize - ctx->data_offset); } else if ( name == ATOM_header_codes ) { if ( ctx->data_offset > 0 ) rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->data_offset, ctx->data); else /* incomplete header */ rc = PL_unify_chars(arg, PL_CODE_LIST, ctx->datasize, ctx->data); } else if ( name == ATOM_state ) { atom_t state; switch(ctx->state) { case CGI_HDR: state = ATOM_header; break; case CGI_DATA: state = ATOM_data; break; case CGI_DISCARDED: state = ATOM_discarded; break; default: assert(0); } rc = PL_unify_atom(arg, state); } else { rc = existence_error(prop, "cgi_property"); } out: if ( !PL_release_stream(s) ) { if ( PL_exception(0) ) PL_clear_exception(); } return rc; }
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; }
/* General structure of a rule : [Rule_Label] ComplexEvent <- CEP_Clause [WHERE_Clause] [WITHIN_Clause] */ void construct_rule(EtalisBatch* batch,term_t term) { EtalisExecNode* NodeRule = batch->nodes; assert(NodeRule != NULL); atom_t cep_name; int temp_arity; int i=0; int LUT_Size=2; #ifdef DEBUG printf("--- Constructing rule: \n"); #endif /* WITHIN Clause */ parse_within_op_(NodeRule,term); /*TODO Add a check that a within is explicitely stated in the rule */ /* WHERE Clause */ parse_where_op_(NodeRule,term); /* CEP Clause */ term_t cep_term = PL_new_term_refs(2); if(NodeRule->has_condition == ETALIS_TRUE) { term_t first_level_term = PL_new_term_refs(2); PL_get_arg(1,term,first_level_term); PL_get_arg(1,first_level_term,cep_term); } else PL_get_arg(1,term,cep_term); PL_get_name_arity(cep_term, &cep_name, &temp_arity); char* aaa = PL_atom_chars(cep_name); /* find the right CEP operator */ while(strcmp(CEP_LUT_[i].CEP_name,PL_atom_chars(cep_name)) != 0 && i<LUT_Size) i++; NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1; NodeRule->right_exec.exec_1=CEP_LUT_[i].exec2.exec_1; if(i != LUT_Size) /*The operator is found in the CEP_LUT_*/ { switch (CEP_LUT_[i].CEP_arity) { case 1: NodeRule->op_type=unary; strcpy(NodeRule->name,CEP_LUT_[i].CEP_name); NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1; break; case 2: NodeRule->op_type=binary; strcpy(NodeRule->name,CEP_LUT_[i].CEP_name); NodeRule->left_exec.exec_1=CEP_LUT_[i].exec1.exec_1; NodeRule->right_exec.exec_1=CEP_LUT_[i].exec2.exec_1; CEP_LUT_[i].parser_func(NodeRule,cep_term); break; default: printf("error compiling the rules\n"); } } else /*no operator is found : identity operator is assumed*/ { NodeRule->op_type=unary; strcpy(NodeRule->name,"identity"); NodeRule->left_exec.exec_1=_cep_identity; default_op_parser(NodeRule,cep_term); } /* triggering an event should execute the correct function*/ /* deprecated */ /* NodeRule->leftChild->trigger=NodeRule->left_exec.exec_1; if(NodeRule->op_type == binary) NodeRule->rightChild->trigger=NodeRule->right_exec.exec_1; */ /* setting the tree connections between the events and the CEP operator */ NodeRule->leftChild->parentNode=NodeRule; if(NodeRule->op_type == binary) NodeRule->rightChild->parentNode=NodeRule; /** Propagate the WHERE Clauses */ where_binarization(NodeRule); }
/* compile all rules */ EtalisExecTree* buildExecTree() { printf("--- Generating Rule Tree ...\n"); EtalisExecTree* tree = calloc(1,sizeof(EtalisExecTree)); tree->size=3; /* TODO (hafsi#4#): fixme */ /*if more than one rule, find out how many complex events*/ tree->exec=print_event; tree->complexEvents = (EtalisExecNode*)calloc(tree->size,sizeof(EtalisExecNode)); EtalisBatch* temp_batch = (EtalisBatch*)malloc(sizeof(EtalisBatch)); int i=0; static predicate_t p; term_t _args_binary_event_rule = PL_new_term_refs(3); atom_t name; int temp_arity; if ( !p ) p = PL_predicate("binary_event_rule", 3, NULL); qid_t qid = PL_open_query(NULL, PL_Q_NORMAL, p, _args_binary_event_rule); while(PL_next_solution(qid) != FALSE) { EtalisEventNode* temp_event = tree->complexEvents+i; /* next complex event */ EtalisExecNode* temp_operator =(EtalisExecNode*)malloc(sizeof(EtalisExecNode)); memset(temp_operator,0,sizeof(EtalisExecNode)); assert( temp_event != NULL && temp_operator != NULL); temp_event->parentNode=NULL; /*a complex event does not have a parent*/ temp_event->childNode=temp_operator; temp_event->trigger=_cep_print_event; /* by default, triggering a complx event would print it */ temp_operator->parentEvent=temp_event; temp_batch->batchSize=1; temp_batch->nodes=temp_operator; /*get label*/ PL_get_name_arity(_args_binary_event_rule, &name, &temp_arity); strcpy(temp_batch->label,PL_atom_chars(name)); /*get complex event*/ PL_get_name_arity(_args_binary_event_rule+1, &name, &temp_arity); strcpy(temp_event->event.name,PL_atom_chars(name)); temp_event->event.arity = temp_arity; /*get rule*/ construct_rule(temp_batch,_args_binary_event_rule+2); /* init a stack for each event*/ /* query the tree in the depth */ EtalisEventNode* temp_event_index = temp_operator->leftChild; for (temp_event_index = temp_operator->leftChild;temp_event_index->childNode != NULL;temp_event_index = temp_event_index->childNode->leftChild) { temp_event_index->eventStack = StackCreate(); if(temp_event_index->parentNode->op_type == binary) temp_event_index->parentNode->rightChild->eventStack = StackCreate(); } /* Create stack for leaf nodes*/ temp_event_index->eventStack = StackCreate(); if(temp_event_index->parentNode->op_type == binary) temp_event_index->parentNode->rightChild->eventStack = StackCreate(); /* build argument logical models */ /* if(temp_operator->has_condition == ETALIS_TRUE) { ; build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2); } else { build_args_map(temp_operator,_args_binary_event_rule+1,_args_binary_event_rule+2); } */ /*print the rule*/ /* only if debugging */ #ifdef DEBUG /*print_rule(temp_event);*/ #endif /*add to event hash*/ addToEventHash(temp_operator); i++; /*next rule*/ }; PL_close_query(qid); /*from the rules build the tree*/ printf("--- Done!\n"); return tree; }
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"); }
void parse_seq_op_ (EtalisExecNode* operatorNode,term_t t) { assert(operatorNode != NULL); fid_t fid = PL_open_foreign_frame(); /*get components of the operator*/ term_t _level_1 = PL_new_term_refs(2); term_t _left_event=_level_1; term_t _right_event=_level_1+1; atom_t _left_event_name,_right_event_name; int temp_arity,i=0; /* TODO check for embedded operators, if operator -> parse right function ; else get atomic events */ PL_get_arg(1,t,_left_event); PL_get_name_arity(_left_event,&_left_event_name,&temp_arity); char * tt = PL_atom_chars(_left_event_name); i=0; while(strcmp(CEP_LUT_[i].CEP_name,PL_atom_chars(_left_event_name)) != 0 && i<LUT_Size) i++; /* #CONT */ if(i != LUT_Size) /*The operator is found in the CEP_LUT_*/ /* create a temp event */ { EtalisEventNode* TempEvent = (EtalisEventNode*)calloc(1,sizeof(EtalisEventNode)); /* this temp event is the complex event of the embedded operation */ TempEvent->event.arity = 0; strcpy(TempEvent->event.name,"temp_"); /* TODO Temp Events */ /* Temp Events have no arguments */ TempEvent->parentNode = operatorNode; strcpy(TempEvent->parentNode->name,tt); TempEvent->is_temp = ETALIS_TRUE; operatorNode->leftChild = TempEvent; EtalisExecNode* NewNodeRule = (EtalisExecNode*)calloc(1,sizeof(EtalisExecNode)); /* binarization and allocation of the embedded operator */ TempEvent->childNode = NewNodeRule; NewNodeRule->parentEvent = TempEvent; TempEvent->trigger = _seq_win_cep_l; switch (CEP_LUT_[i].CEP_arity) { case 1: break; case 2: /* found embedded */ CEP_LUT_[i].parser_func(NewNodeRule,_left_event); break; default: printf("error compiling the rules\n"); } } else /* an atomic event has been found */ { operatorNode->leftChild = (EtalisEventNode*) calloc(1,sizeof(EtalisEventNode)); PL_get_name_arity(_left_event,&_left_event_name,(int *)&((operatorNode->leftChild)->event.arity)); strcpy(operatorNode->leftChild->event.name,PL_atom_chars(_left_event_name)); operatorNode->leftChild->childNode = NULL; operatorNode->leftChild->parentNode=operatorNode; operatorNode->leftChild->is_temp = ETALIS_FALSE; if (operatorNode->parentEvent->is_temp) strcat(operatorNode->parentEvent->event.name,operatorNode->leftChild->event.name); operatorNode->leftChild->trigger = _seq_win_cep_l; } PL_get_arg(2,t,_right_event); operatorNode->rightChild = (EtalisEventNode*) calloc(1,sizeof(EtalisEventNode)); PL_get_name_arity(_right_event,&_right_event_name,(int *)&(operatorNode->rightChild->event.arity)); strcpy(operatorNode->rightChild->event.name,PL_atom_chars(_right_event_name)); operatorNode->rightChild->childNode = NULL; operatorNode->rightChild->parentNode = operatorNode; operatorNode->rightChild->is_temp = ETALIS_FALSE; PL_discard_foreign_frame(fid); if (operatorNode->parentEvent->is_temp) { strcat(operatorNode->parentEvent->event.name,operatorNode->rightChild->event.name); operatorNode->rightChild->trigger = _seq_win_cep_l; } else /* event is latest event in the call list */ { operatorNode->rightChild->trigger = _seq_batch_r; } ; }
/* * parse a where clause and add the information into the ExecNode. * TODO #hafsi#5# * TODO implement a non binary, rule wide WHERE clause parser and interpreter. * */ void parse_where_op_(EtalisExecNode* operatorNode, term_t t) { /* find out whether a where clause is used */ term_t constraints = PL_new_term_refs(3); atom_t wheref; int arr; ETALIS_BOOL where_available=0; PL_get_arg(1,t,constraints); PL_get_name_arity(constraints,&wheref,&arr); char* gg = (char*)malloc(sizeof(char)*256); memset(gg,0,256); gg = PL_atom_chars(wheref); if(!strcmp(gg,"wheref")) where_available = ETALIS_TRUE; if(where_available) { /* process where clause */ /* A = eventClause(unlabeled, e2(_G321, _G322, _G323, _G324), withinop(wheref(seqf(a(_G321, _G322), d(_G323, _G324)), conditions), 2.0)) */ operatorNode->whereNode =(EtalisWhereNode*)malloc(sizeof(EtalisWhereNode)); memset(operatorNode->whereNode,0,sizeof(EtalisWhereNode)); term_t _where_level_1 = PL_new_term_refs(2); term_t rule_gut_term = _where_level_1+1; term_t constraints_term = _where_level_1+2; PL_get_arg(1,t,_where_level_1); PL_get_arg(1,_where_level_1,rule_gut_term); PL_get_arg(2,_where_level_1,constraints_term); #ifdef DEBUG char* testing = (char*)malloc(sizeof(char)*256); char* args = (char*)malloc(sizeof(char)*256); *args="\0"; memset(testing,0,256); int size_contraints,idx=0; PL_get_name_arity(constraints_term,NULL,&size_contraints); termToStringVerbatim(_where_level_1,testing,args); /* wheref(seqf(seqf(a(_G1776),b(_G1778)),c(_G1780)),,(>(_G1776,1),<(_G1778,2))) */ int j=strlen(testing); int num_=0; for (j=strlen(testing)-2;j>0;j--) { if (testing[j] == ')') num_++; if (testing[j] == '(') num_--; /*printf("%c : %d : %d\n",testing[j],j,num_);*/ if(num_ == 0 ) break; } char* real_constr = testing + j ; printf("--- WHERE Block detected | Constraints: %s \n",real_constr); #endif operatorNode->has_condition=ETALIS_TRUE; } else /* no constraints are detected */ { /*get atomic events of the operator*/ /* A = eventClause(unlabeled, e2(_G321, _G322, _G323, _G324), withinop(seqf(a(_G321, _G322), d(_G323, _G324)), 2.0)). */ operatorNode->has_condition=ETALIS_FALSE; } }
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_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; }