install_t
install_time()
{ MODULE_user = PL_new_module(PL_new_atom("user"));
FUNCTOR_alarm1 = PL_new_functor(PL_new_atom("$alarm"), 1);
FUNCTOR_alarm4 = PL_new_functor(PL_new_atom("alarm"), 4);
FUNCTOR_module2 = PL_new_functor(PL_new_atom(":"), 2);
ATOM_remove = PL_new_atom("remove");
ATOM_install = PL_new_atom("install");
ATOM_done = PL_new_atom("done");
ATOM_next = PL_new_atom("next");
ATOM_scheduled = PL_new_atom("scheduled");
PREDICATE_call1 = PL_predicate("call", 1, "user");
PL_register_foreign("alarm_at", 4, alarm4_abs, PL_FA_TRANSPARENT);
PL_register_foreign("alarm", 4, alarm4_rel, PL_FA_TRANSPARENT);
PL_register_foreign("alarm_at", 3, alarm3_abs, PL_FA_TRANSPARENT);
PL_register_foreign("alarm", 3, alarm3_rel, PL_FA_TRANSPARENT);
PL_register_foreign("remove_alarm", 1, remove_alarm, 0);
PL_register_foreign("uninstall_alarm",1, uninstall_alarm,0);
PL_register_foreign("install_alarm", 1, install_alarm, 0);
PL_register_foreign("install_alarm", 2, install_alarm2, 0);
PL_register_foreign("remove_alarm_notrace",1, remove_alarm, PL_FA_NOTRACE);
PL_register_foreign("current_alarms", 5, current_alarms, 0);
#ifdef O_DEBUG
PL_register_foreign("time_debug", 1, pl_time_debug, 0);
#endif
installHandler();
PL_on_halt(cleanup, NULL);
}
install_t install_clingo(void) {
ATOM_sup = PL_new_atom("sup");
ATOM_inf = PL_new_atom("inf");
ATOM_minus = PL_new_atom("-");
ATOM_hash = PL_new_atom("#");
ATOM_atoms = PL_new_atom("atoms");
ATOM_terms = PL_new_atom("terms");
ATOM_shown = PL_new_atom("shown");
ATOM_csp = PL_new_atom("csp");
ATOM_comp = PL_new_atom("comp");
FUNCTOR_hash1 = PL_new_functor(ATOM_hash, 1);
FUNCTOR_tilde1 = PL_new_functor(PL_new_atom("~"), 1);
FUNCTOR_clingo_error1 = PL_new_functor(PL_new_atom("clingo_error"), 1);
FUNCTOR_error2 = PL_new_functor(PL_new_atom("error"), 2);
PL_register_foreign("clingo_new", 2, pl_clingo_new, 0);
PL_register_foreign("clingo_close", 1, pl_clingo_close, 0);
PL_register_foreign("clingo_add", 3, pl_clingo_add, 0);
PL_register_foreign("clingo_ground", 2, pl_clingo_ground, 0);
PL_register_foreign("clingo_solve", 4, pl_clingo_solve,
PL_FA_NONDETERMINISTIC);
PL_register_foreign("clingo_assign_external", 3, pl_clingo_assign_external,
0);
PL_register_foreign("clingo_release_external", 2,
pl_clingo_release_external, 0);
}
static void
init_constants()
{ FUNCTOR_word1 = PL_new_functor(PL_new_atom("word"), 1);
FUNCTOR_space1 = PL_new_functor(PL_new_atom("space"), 1);
FUNCTOR_integer1 = PL_new_functor(PL_new_atom("integer"), 1);
FUNCTOR_character1= PL_new_functor(PL_new_atom("character"), 1);
FUNCTOR_newline1 = PL_new_functor(PL_new_atom("newline"), 1);
}
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;
}
static void
init_constants()
{
ATOM_arg = PL_new_atom("arg");
ATOM_atom = PL_new_atom("atom");
ATOM_code_list = PL_new_atom("code_list");
ATOM_downcase = PL_new_atom("downcase");
ATOM_eq = PL_new_atom("=");
ATOM_escape = PL_new_atom("escape");
ATOM_exact = PL_new_atom("exact");
ATOM_field = PL_new_atom("field");
ATOM_field_count = PL_new_atom("field_count");
ATOM_field_separator = PL_new_atom("field_separator");
ATOM_file = PL_new_atom("file");
ATOM_float = PL_new_atom("float");
ATOM_functor = PL_new_atom("functor");
ATOM_integer = PL_new_atom("integer");
ATOM_hexadecimal = PL_new_atom("hexadecimal");
ATOM_key_field = PL_new_atom("key_field");
ATOM_map_space_to_underscore = PL_new_atom("map_space_to_underscore");
ATOM_prefix = PL_new_atom("prefix");
ATOM_record = PL_new_atom("record");
ATOM_record_separator = PL_new_atom("record_separator");
ATOM_size = PL_new_atom("size");
ATOM_skip = PL_new_atom("skip");
ATOM_sorted = PL_new_atom("sorted");
ATOM_string = PL_new_atom("string");
ATOM_substring = PL_new_atom("substring");
ATOM_syntax = PL_new_atom("syntax");
ATOM_unique = PL_new_atom("unique");
ATOM_width = PL_new_atom("width");
ATOM_window = PL_new_atom("window");
FUNCTOR_minus2 = PL_new_functor(PL_new_atom("-"), 2);
}
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;
}
install_t
install_random()
{ FUNCTOR_rand3 = PL_new_functor(PL_new_atom("rand"), 3);
PL_register_foreign("random", 1, p_random, 0);
PL_register_foreign("setrand", 1, p_setrand, 0);
PL_register_foreign("getrand", 1, p_getrand, 0);
}
int
init_errors(void)
{ MKFUNCTOR(error, 2);
MKFUNCTOR(literal, 1);
FUNCTOR_colon2 = PL_new_functor(PL_new_atom(":"), 2);
return TRUE;
}
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;
}
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_get_ps_parameters(term_t file, term_t iseps, term_t bb)
{ char *fname;
FILE *fd;
if ( !PL_get_chars(file, &fname, CVT_ALL) )
return PL_warning("get_ps_parameters/3: invalid filename");
if ( (fd = fopen(fname, "r")) )
{ char buf[MAXLINE];
char *s;
if ( (s=fgets(buf, sizeof(buf), fd)) )
{ if ( substr(s, "EPSF") )
PL_unify_atom_chars(iseps, "eps");
else
PL_unify_atom_chars(iseps, "ps");
}
do
{ double a1, a2, a3, a4;
if ( sscanf(buf, "%%%%BoundingBox: %lf %lf %lf %lf", &a1, &a2, &a3, &a4) == 4 )
{ fclose(fd);
return PL_unify_term(bb,
PL_FUNCTOR, PL_new_functor(PL_new_atom("bb"), 4),
PL_FLOAT, a1,
PL_FLOAT, a2,
PL_FLOAT, a3,
PL_FLOAT, a4);
}
} while( (s=fgets(buf, sizeof(buf), fd)) );
fclose(fd);
PL_warning("get_ps_parameters/3: could not find %%%%BoundingBox in %s",
fname);
PL_fail;
}
PL_warning("get_ps_parameters/3: could not open %s", fname);
PL_fail;
}
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 = -1; /* Won't get any better */
break;
}
if ( !rc && (except = PL_exception(qid)) )
{ restore_after_exception(except);
rc = -1;
}
if ( qid ) PL_close_query(qid);
if ( fid ) PL_discard_foreign_frame(fid);
if ( !except )
break;
} while(loop);
return rc;
}
install_t
install_socket()
{ nbio_init("socket");
ATOM_reuseaddr = PL_new_atom("reuseaddr");
ATOM_bindtodevice = PL_new_atom("bindtodevice");
ATOM_broadcast = PL_new_atom("broadcast");
ATOM_nodelay = PL_new_atom("nodelay");
ATOM_dispatch = PL_new_atom("dispatch");
ATOM_nonblock = PL_new_atom("nonblock");
ATOM_infinite = PL_new_atom("infinite");
ATOM_as = PL_new_atom("as");
ATOM_atom = PL_new_atom("atom");
ATOM_string = PL_new_atom("string");
ATOM_codes = PL_new_atom("codes");
ATOM_max_message_size = PL_new_atom("max_message_size");
FUNCTOR_socket1 = PL_new_functor(PL_new_atom("$socket"), 1);
PL_register_foreign("tcp_accept", 3, pl_accept, 0);
PL_register_foreign("tcp_bind", 2, pl_bind, 0);
PL_register_foreign("tcp_connect", 2, pl_connect, 0);
PL_register_foreign("tcp_listen", 2, pl_listen, 0);
PL_register_foreign("tcp_open_socket", 3, pl_open_socket, 0);
PL_register_foreign("tcp_socket", 1, tcp_socket, 0);
PL_register_foreign("tcp_close_socket", 1, pl_close_socket, 0);
PL_register_foreign("tcp_setopt", 2, pl_setopt, 0);
PL_register_foreign("tcp_host_to_address", 2, pl_host_to_address, 0);
PL_register_foreign("gethostname", 1, pl_gethostname, 0);
PL_register_foreign("tcp_select", 3, tcp_select, 0);
PL_register_foreign("udp_socket", 1, udp_socket, 0);
PL_register_foreign("udp_receive", 4, udp_receive, 0);
PL_register_foreign("udp_send", 4, udp_send, 0);
#ifdef O_DEBUG
PL_register_foreign("tcp_debug", 1, pl_debug, 0);
#endif
}
install_t
install_process()
{
#ifdef __WINDOWS__
win_init();
#endif
MKATOM(stdin);
MKATOM(stdout);
MKATOM(stderr);
MKATOM(std);
MKATOM(null);
MKATOM(process);
MKATOM(detached);
MKATOM(cwd);
MKATOM(env);
MKATOM(window);
MKATOM(timeout);
MKATOM(release);
MKATOM(infinite);
MKFUNCTOR(pipe, 1);
MKFUNCTOR(error, 2);
MKFUNCTOR(type_error, 2);
MKFUNCTOR(domain_error, 2);
MKFUNCTOR(process_error, 2);
MKFUNCTOR(system_error, 2);
MKFUNCTOR(resource_error, 1);
MKFUNCTOR(exit, 1);
MKFUNCTOR(killed, 1);
FUNCTOR_eq2 = PL_new_functor(PL_new_atom("="), 2);
PL_register_foreign("process_create", 2, process_create, 0);
PL_register_foreign("process_wait", 3, process_wait, 0);
PL_register_foreign("process_kill", 2, process_kill, 0);
}
foreign_t pl_reportViolation(term_t RuleT, term_t MsgT, term_t CulpritsT) {
// FIXME: all 'return FALSE' should be PL_warning'
const char *Rule;
if ( !PL_get_atom_chars(RuleT, (char **) &Rule)) return FALSE;
const char *Msg;
if ( !PL_get_atom_chars(MsgT, (char **) &Msg)) return FALSE;
// atom_t StmtA = PL_new_atom("stmt");
// functor_t StmtF = PL_new_functor(StmtA, 1);
atom_t NamedDeclA = PL_new_atom("NamedDecl");
functor_t NamedDeclF = PL_new_functor(NamedDeclA, 2);
// functor_t SortF;
// if ( !PL_get_functor(LocT, &SortF)) return FALSE;
// term_t ElemT = PL_new_term_ref();
// if ( !PL_get_arg(1, LocT, ElemT)) return FALSE;
// SourceLocation SL;
// if ( PL_unify_functor(LocT, StmtF)) {
// Stmt *S;
// if ( !PL_get_pointer(ElemT, (void **) &S)) return FALSE;
// SL = S->getLocStart();
// }
// // FIXME: same for Decl and other elems.
const CompilerInstance &CI = getCompilationInfo()->getCompilerInstance();
DiagnosticsEngine &DE = CI.getDiagnostics();
Twine MsgWithRule = Twine(Rule) + Twine(": ") + Twine(Msg);
unsigned DiagId = DE.getCustomDiagID(DiagnosticsEngine::Warning,
MsgWithRule.str());
DiagnosticBuilder DB = DE.Report(DiagId);
term_t HeadT = PL_new_term_ref();
term_t ListT = PL_copy_term_ref(CulpritsT); // copy as we need to write
while(PL_get_list(ListT, HeadT, ListT)) {
term_t ElemT = PL_new_term_ref();
if ( !PL_get_arg(1, HeadT, ElemT)) return FALSE;
if ( PL_unify_functor(HeadT, NamedDeclF)) {
const NamedDecl *ND;
if ( !PL_get_pointer(ElemT, (void **) &ND)) return FALSE;
DB << ND->getDeclName();
continue;
}
// FIXME: same for Type and other elems
}
DB.~DiagnosticBuilder(); // Emits the diagnostic
ListT = PL_copy_term_ref(CulpritsT);
while(PL_get_list(ListT, HeadT, ListT)) {
functor_t SortF;
if ( !PL_get_functor(HeadT, &SortF)) return FALSE;
term_t ElemT = PL_new_term_ref();
if ( !PL_get_arg(1, HeadT, ElemT)) return FALSE;
term_t MsgT = PL_new_term_ref();
if ( !PL_get_arg(2, HeadT, MsgT)) return FALSE;
const char *Msg;
if ( !PL_get_atom_chars(MsgT, (char **) &Msg)) return FALSE;
if ( PL_unify_functor(HeadT, NamedDeclF)) {
const NamedDecl *ND;
if ( !PL_get_pointer(ElemT, (void **) &ND)) return FALSE;
DiagId = DE.getCustomDiagID(DiagnosticsEngine::Note, Msg);
DiagnosticBuilder DB = DE.Report(ND->getLocStart(), DiagId);
DB << ND->getDeclName();
DB.~DiagnosticBuilder(); // Emits the diagnostic
continue;
}
// FIXME: same for Type and other elems
}
return TRUE;
}
install_t
install_tipc()
{ FILE *fp = fopen("/sys/module/tipc/version", "r");
if(fp)
{ char buf[32];
size_t n = fread(buf, sizeof(char), sizeof(buf), fp);
if(n > 0)
tipc_version = buf[0] - '0';
fclose(fp);
}
nbio_init("tipc");
ATOM_scope = PL_new_atom("scope");
ATOM_no_scope = PL_new_atom("no_scope");
ATOM_node = PL_new_atom("node");
ATOM_cluster = PL_new_atom("cluster");
ATOM_zone = PL_new_atom("zone");
ATOM_all = PL_new_atom("all");
ATOM_importance = PL_new_atom("importance");
ATOM_low = PL_new_atom("low");
ATOM_medium = PL_new_atom("medium");
ATOM_high = PL_new_atom("high");
ATOM_critical = PL_new_atom("critical");
ATOM_src_droppable = PL_new_atom("src_droppable");
ATOM_dest_droppable = PL_new_atom("dest_droppable");
ATOM_conn_timeout = PL_new_atom("conn_timeout");
ATOM_socket_type = PL_new_atom("socket_type");
ATOM_dgram = PL_new_atom("dgram");
ATOM_rdm = PL_new_atom("rdm");
ATOM_seqpacket = PL_new_atom("seqpacket");
ATOM_stream = PL_new_atom("stream");
ATOM_dispatch = PL_new_atom("dispatch");
ATOM_nodelay = PL_new_atom("nodelay");
ATOM_nonblock = PL_new_atom("nonblock");
ATOM_as = PL_new_atom("as");
ATOM_atom = PL_new_atom("atom");
ATOM_string = PL_new_atom("string");
ATOM_codes = PL_new_atom("codes");
FUNCTOR_tipc_socket1 = PL_new_functor(PL_new_atom("$tipc_socket"), 1);
FUNCTOR_port_id = PL_new_functor(PL_new_atom("port_id"), 2);
FUNCTOR_name3 = PL_new_functor(PL_new_atom("name"), 3);
FUNCTOR_name_seq3 = PL_new_functor(PL_new_atom("name_seq"), 3);
FUNCTOR_mcast3 = PL_new_functor(PL_new_atom("mcast"), 3);
PL_register_foreign("tipc_socket", 2, tipc_socket, 0);
PL_register_foreign("tipc_close_socket", 1, tipc_close_socket, 0);
PL_register_foreign("tipc_setopt", 2, pl_tipc_setopt, 0);
PL_register_foreign("tipc_bind", 3, pl_tipc_bind, 0);
PL_register_foreign("tipc_listen", 2, tipc_listen, 0);
PL_register_foreign("tipc_open_socket", 3, tipc_open_socket, 0);
PL_register_foreign("tipc_accept", 3, pl_tipc_accept, 0);
PL_register_foreign("tipc_connect", 2, pl_tipc_connect, 0);
PL_register_foreign("tipc_get_name", 2, pl_tipc_get_name, 0);
PL_register_foreign("tipc_get_peer_name", 2, pl_tipc_get_peer_name, 0);
PL_register_foreign("tipc_receive", 4, pl_tipc_receive, 0);
PL_register_foreign("tipc_send", 4, pl_tipc_send, 0);
PL_register_foreign("tipc_subscribe", 5, pl_tipc_subscribe, 0);
PL_register_foreign("tipc_receive_subscr_event", 2, pl_tipc_receive_subscr_event, 0);
}
static int unify_value(term_t t, clingo_symbol_t v) {
// NOTE: the clingo_symbol_* functions below only fail
// if applied to the wrong type
// they do not allocate
switch (clingo_symbol_type(v)) {
case clingo_symbol_type_number: {
int number;
clingo_symbol_number(v, &number);
return PL_unify_integer(t, number);
}
case clingo_symbol_type_string: {
char const *str;
clingo_symbol_string(v, &str);
return PL_unify_chars(t, PL_STRING | REP_UTF8, (size_t)-1, str);
}
case clingo_symbol_type_infimum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_inf);
}
case clingo_symbol_type_supremum: {
return PL_unify_term(t, PL_FUNCTOR, FUNCTOR_hash1, PL_ATOM, ATOM_sup);
}
case clingo_symbol_type_function: {
// FIXME: functions can have signs represented as -f(x) in gringo
char const *str;
clingo_symbol_t const *args;
size_t size;
int rc;
clingo_symbol_name(v, &str);
clingo_symbol_arguments(v, &args, &size);
if (size == 0) {
if (!(rc =
PL_unify_chars(t, PL_ATOM | REP_UTF8, (size_t)-1, str))) {
goto out_function;
}
} else {
clingo_symbol_t const *it, *ie;
atom_t name;
term_t arg;
int i;
name = PL_new_atom(str);
if (!(rc = PL_unify_functor(t, PL_new_functor(name, size)))) {
goto out_function;
}
PL_unregister_atom(name);
arg = PL_new_term_ref();
for (i = 1, it = args, ie = it + size; it != ie; ++it, i++) {
_PL_get_arg(i, t, arg);
if (!unify_value(arg, *it)) {
goto out_function;
}
}
}
out_function:
return rc;
}
default:
assert(FALSE);
return FALSE;
}
}
