int main(int argc, char *argv[])
{
int rc;
int return_size = 15;
char *return_string;
return_string = malloc(return_size);
int myargc = 1;
char *myargv[1];
myargv[0] = strip_names_from_path(xsb_executable_full_path(argv[0]),3);
if (xsb_init(myargc,myargv)) {
fprintf(stderr,"%s initializing XSB: %s\n",xsb_get_init_error_type(),
xsb_get_init_error_message());
exit(XSB_ERROR);
}
#ifdef MULTI_THREAD
th_context *th = xsb_get_main_thread();
#define xsb_get_main_thread_macro() xsb_get_main_thread()
#else
#define xsb_get_main_thread_macro()
#endif
c2p_functor(CTXTc "consult",1,reg_term(CTXTc 1));
c2p_string(CTXTc "edb.P",p2p_arg(reg_term(CTXTc 1),1));
/* Create command to consult a file: edb.P, and send it. */
if (xsb_command(CTXT) == XSB_ERROR)
fprintf(stderr,"++Error consulting edb.P: %s/%s\n",
xsb_get_error_type(xsb_get_main_thread_macro()),
xsb_get_error_message(xsb_get_main_thread_macro()));
c2p_functor(CTXTc "pregs",3,reg_term(CTXTc 1));
rc = xsb_query(CTXT);
while (rc == XSB_SUCCESS) {
printf("Answer: pregs(%s,%s,%s)\n",
xsb_var_string(1),xsb_var_string(2),xsb_var_string(2));
rc = xsb_next(CTXT);
}
if (rc == XSB_ERROR)
fprintf(stderr,"++Query Error: %s/%s\n",
xsb_get_error_type(xsb_get_main_thread_macro()),
xsb_get_error_message(xsb_get_main_thread_macro()));
xsb_close(CTXT);
return(0);
}
DllExport int call_conv fibr(CTXTdecl) {
int inarg, f1, f2;
inarg = p2c_int(reg_term(CTXTc 1)); // get the input argument
if (inarg <= 1) { // if small, return answer directly
c2p_int(CTXTc 1,reg_term(CTXTc 2));
return TRUE;
}
xsb_query_save(CTXTc 2); // prepare for calling XSB
c2p_functor(CTXTc "fibp",2,reg_term(CTXTc 1)); // setup call
c2p_int(CTXTc inarg-1,p2p_arg(reg_term(CTXTc 1),1)); // and inp arg
if (xsb_query(CTXT)) { // call XSB
printf("Error calling fibp 1.\n");
fflush(stdout);
return FALSE;
}
f1 = p2c_int(p2p_arg(reg_term(CTXTc 1),2)); // get answer
if (xsb_close_query(CTXT)) { // throw away other (nonexistent) answers
printf("Error closing fibp 1.\n");
fflush(stdout);
return FALSE;
}
c2p_functor(CTXTc "fibp",2,reg_term(CTXTc 1)); // prepare for 2nd call to XSB
c2p_int(CTXTc inarg-2,p2p_arg(reg_term(CTXTc 1),1)); // and its inp arg
if (xsb_query(CTXT)) { // and call query
printf("Error calling fibp 2.\n");
fflush(stdout);
return FALSE;
}
f2 = p2c_int(p2p_arg(reg_term(CTXTc 1),2)); // and get its answer
if (xsb_next(CTXT) != XSB_FAILURE) { // get next answer, which must NOT exist
printf("Error getting next fibp 2.\n");
fflush(stdout);
return FALSE;
}
if (xsb_query_restore(CTXT)) { // restore regs to prepare for exit
printf("Error finishing.\n");
fflush(stdout);
return FALSE;
}
c2p_int(CTXTc f1+f2,reg_term(CTXTc 2)); // set our answer
return TRUE; // and return successfully
}
int return_to_prolog(PyObject *pValue)
{
if(pValue == Py_None){
return 1;
}
if(PyInt_Check(pValue))
{
int result = PyInt_AS_LONG(pValue);
extern_ctop_int(3, result);
return 1;
}
else if(PyFloat_Check(pValue))
{
float result = PyFloat_AS_DOUBLE(pValue);
extern_ctop_float(3, result);
return 1;
}else if(PyString_Check(pValue))
{
char *result = PyString_AS_STRING(pValue);
extern_ctop_string(3, result);
return 1;
}else if(PyList_Check(pValue))
{
size_t size = PyList_Size(pValue);
size_t i = 0;
prolog_term head, tail;
prolog_term P = p2p_new();
tail = P;
for(i = 0; i < size; i++)
{
c2p_list(CTXTc tail);
head = p2p_car(CTXTc tail);
PyObject *pyObj = PyList_GetItem(pValue, i);
int temp = PyInt_AS_LONG(pyObj);
c2p_int(temp, head);
//convert_pyObj_prObj(pyObj, &head);
tail = p2p_cdr(tail);
}
c2p_nil(CTXTc tail);
p2p_unify(P, reg_term(CTXTc 3));
return 1;
}else
{
//returns an object refernce to prolog side.
pyobj_ref_node *node = add_pyobj_ref_list(pValue);
//printf("node : %p", node);
char str[30];
sprintf(str, "%p", node);
//extern_ctop_string(3,str);
prolog_term ref = p2p_new();
c2p_functor("pyObject", 1, ref);
prolog_term ref_inner = p2p_arg(ref, 1);
c2p_string(str, ref_inner);
p2p_unify(ref, reg_term(CTXTc 3));
return 1;
}
return 0;
}
void *ll_command_rs(void * arg) {
th_context *r_th;
r_th = (th_context *)arg;
c2p_functor(r_th,"ll_test_r",0,reg_term(r_th,1));
if (xsb_command(r_th) == XSB_ERROR)
fprintf(stderr,"LowLevel command error r: %s/%s\n",xsb_get_error_type(r_th),xsb_get_error_message(r_th));
return NULL;
}
/*******************************************************************
Succeeding commands
*********************************************************************/
void *command_ps(void * arg) {
int rc;
th_context *p_th;
p_th = (th_context *)arg;
pthread_mutex_lock(&user_p_ready_mut);
c2p_functor(p_th, "test_p",0,reg_term(p_th,1));
if ((rc = xsb_command(p_th)) == XSB_ERROR)
fprintf(stderr,"Command error p: %s/%s\n",xsb_get_error_type(p_th),xsb_get_error_message(p_th));
pthread_mutex_unlock(&user_p_ready_mut);
return NULL;
}
/*
* call as: datime_plus_sec(T1,Sec,T2)
* Returns T2 as the result of date T1 plus Sec seconds
*/
int datime_plus_sec(CTXTdecl)
{
prolog_term t1 = reg_term(CTXTc 1);
if(!is_functor(t1))
return FALSE;
int t1_ts = p2c_int(p2p_arg(t1,1));
int sec = p2c_int(reg_term(CTXTc 2));
if (p2c_arity(t1) > 1)
{
int counter = p2p_arg(t1,2);
c2p_functor(CTXTc "datime",2,reg_term(CTXTc 3));
c2p_int(CTXTc t1_ts+sec,p2p_arg(reg_term(CTXTc 3),1));
c2p_int(CTXTc counter,p2p_arg(reg_term(CTXTc 3),2));
}
else
{
c2p_functor(CTXTc "datime",1,reg_term(CTXTc 3));
c2p_int(CTXTc t1_ts+sec,p2p_arg(reg_term(CTXTc 3),1));
}
return TRUE;
}
void *ll_command_ps(void * arg) {
th_context *p_th;
int rc = 0;
p_th = (th_context *)arg;
c2p_functor(p_th,"ll_test_p",0,reg_term(p_th,1));
if ((rc = xsb_command(p_th)) == XSB_ERROR)
fprintf(stderr,"LowLevel command error p: %s/%s\n",xsb_get_error_type(p_th),xsb_get_error_message(p_th));
else if (rc == XSB_FAILURE) printf("llp failed\n");
else if (rc == XSB_SUCCESS) printf("llp succeeded\n");
return NULL;
}
void *command_rs(void * arg) {
int rc;
th_context *r_th;
r_th = (th_context *)arg;
pthread_mutex_lock(&user_r_ready_mut);
c2p_functor(r_th, "test_r",0,reg_term(r_th,1));
if ((rc = xsb_command(r_th)) == XSB_ERROR)
fprintf(stderr,"++Command Error r: %s/%s\n",
xsb_get_error_type(r_th),xsb_get_error_message(r_th));
pthread_mutex_unlock(&user_r_ready_mut);
return NULL;
}
void *command_rs_err(void * arg) {
int rc;
th_context *r_th;
pthread_mutex_lock(&user_r_ready_mut);
r_th = (th_context *)arg;
c2p_functor(r_th, "test_r_err",0,reg_term(r_th,1));
if ((rc = xsb_command(r_th)) == XSB_ERROR)
fprintf(stderr,"Planned command error r: %s/%s\n",
xsb_get_error_type(r_th),xsb_get_error_message(r_th));
else if (rc == XSB_FAILURE)
fprintf(stderr,"++r_err failed improperly\n");
pthread_mutex_unlock(&user_r_ready_mut);
return NULL;
}
/* call as: current_datime(-D)
Returns the predicate datime(D) where D is the current time in ms*/
int current_datime(CTXTdecl)
{
time_t now;
time(&now);
prolog_term t = reg_term(CTXTc 1);
if (is_functor(t))
{
char *func = p2c_functor(t);
if(strcmp(func,"datime")==0)
{
c2p_int(CTXTc now, p2p_arg(reg_term(CTXTc 1),1));
return TRUE;
}
return FALSE;
}
c2p_functor(CTXTc "datime",1,reg_term(CTXTc 1));
c2p_int(CTXTc now, p2p_arg(reg_term(CTXTc 1),1));
return TRUE;
}
void *close_query_rs(void * arg) {
int rc;
th_context *r_th;
pthread_mutex_lock(&user_r_ready_mut);
r_th = (th_context *)arg;
c2p_functor(r_th, "rregs",3,reg_term(r_th, 1));
rc = xsb_query(r_th);
if (rc == XSB_ERROR)
fprintf(stderr,"++Closed query Error r: %s/%s\n",
xsb_get_error_type(r_th),xsb_get_error_message(r_th));
printf("Closed return r(%d,%d,%d)\n",
(p2c_int(p2p_arg(reg_term(r_th, 2),1))),
(p2c_int(p2p_arg(reg_term(r_th, 2),2))),
(p2c_int(p2p_arg(reg_term(r_th, 2),3))));
rc = xsb_close_query(r_th);
if (rc == XSB_FAILURE)
fprintf(stderr,"++Failure on closed query (r)!\n");
pthread_mutex_unlock(&user_r_ready_mut);
return NULL;
}
/*******************************************************************
Closed queries
*********************************************************************/
void *close_query_ps(void * arg) {
int rc;
th_context *p_th;
pthread_mutex_lock(&user_p_ready_mut);
p_th = (th_context *)arg;
c2p_functor(p_th, "pregs",3,reg_term(p_th, 1));
rc = xsb_query(p_th);
if (rc == XSB_ERROR)
fprintf(stderr,"++Closed query Error p: %s/%s\n",
xsb_get_error_type(p_th),xsb_get_error_message(p_th));
printf("Closed return p(%s,%s,%s)\n",
(p2c_string(p2p_arg(reg_term(p_th, 2),1))),
(p2c_string(p2p_arg(reg_term(p_th, 2),2))),
(p2c_string(p2p_arg(reg_term(p_th, 2),3))));
rc = xsb_close_query(p_th);
if (rc == XSB_FAILURE)
fprintf(stderr,"++Failure on closed query (p)!\n");
pthread_mutex_unlock(&user_p_ready_mut);
return NULL;
}
void *query_rs_err(void * arg) {
int rc;
th_context *r_th;
pthread_mutex_lock(&user_r_ready_mut);
r_th = (th_context *)arg;
c2p_functor(r_th, "rregs_err",3,reg_term(r_th, 1));
rc = xsb_query(r_th);
while (rc == XSB_SUCCESS) {
printf("Pre-err return r(%d,%d,%d)\n",
(p2c_int(p2p_arg(reg_term(r_th, 2),1))),
(p2c_int(p2p_arg(reg_term(r_th, 2),2))),
(p2c_int(p2p_arg(reg_term(r_th, 2),3))));
rc = xsb_next(r_th);
}
if (rc == XSB_ERROR)
fprintf(stderr,"Planned query Error r: %s/%s\n",
xsb_get_error_type(r_th),xsb_get_error_message(r_th));
pthread_mutex_unlock(&user_r_ready_mut);
return NULL;
}
/*******************************************************************
Successful queries
*********************************************************************/
void *query_ps(void * arg) {
int rc;
th_context *p_th;
pthread_mutex_lock(&user_p_ready_mut);
p_th = (th_context *)arg;
c2p_functor(p_th, "pregs",3,reg_term(p_th, 1));
rc = xsb_query(p_th);
while (rc == XSB_SUCCESS) {
printf("Answer: pregs(%s,%s,%s)\n",
(p2c_string(p2p_arg(reg_term(p_th, 2),1))),
(p2c_string(p2p_arg(reg_term(p_th, 2),2))),
(p2c_string(p2p_arg(reg_term(p_th, 2),3))));
rc = xsb_next(p_th);
}
if (rc == XSB_ERROR)
fprintf(stderr,"++Query Error p: %s/%s\n",
xsb_get_error_type(p_th),xsb_get_error_message(p_th));
pthread_mutex_unlock(&user_p_ready_mut);
return NULL;
}
static void c2p_raptor_term(CTXTdecl struct raptor_node_item triple, prolog_term t)
{
switch(triple.type)
{
case RAPTOR_TERM_TYPE_UNKNOWN:
// printf("BUILD: (UKNOWN)" );
c2p_nil(CTXTdecl t);
break ;
case RAPTOR_TERM_TYPE_URI:
// printf("uri( %s )", raptor_uri_as_string(triple->value.uri));
c2p_functor(CTXTdecl "url", 1, t);
prolog_term uri_str = p2p_arg(CTXTdecl t, 1);
c2p_string(CTXTdecl (char *)triple.arg1, uri_str);
break ;
case RAPTOR_TERM_TYPE_LITERAL:
//printf("literal( %s, %s, %s )", triple->value.literal.string, raptor_uri_as_string(triple->value.literal.datatype), triple->value.literal.language);
c2p_functor(CTXTdecl "literal", 3, t);
// the actual string
prolog_term lit_str = p2p_arg(CTXTdecl t, 1);
c2p_string(CTXTdecl (char *)triple.arg1, lit_str);
// the datatype
prolog_term dt_str = p2p_arg(CTXTdecl t, 2);
if(triple.arg2 != NULL)
c2p_string(CTXTdecl (char *)triple.arg2, dt_str);
else
c2p_string(CTXTdecl "", dt_str);
// the language
prolog_term lang_str = p2p_arg(CTXTdecl t, 3);
if(triple.arg3 != NULL)
c2p_string(CTXTdecl (char *)triple.arg3, lang_str);
else
c2p_string(CTXTdecl "", lang_str);
break ;
case RAPTOR_TERM_TYPE_BLANK:
// printf("blank( %s )", triple->value.blank.string);
c2p_functor(CTXTdecl "blank", 1, t);
prolog_term blank_str = p2p_arg(CTXTdecl t, 1);
c2p_string(CTXTdecl (char *)triple.arg1, blank_str);
break ;
default:
c2p_nil(CTXTdecl t);
break ;
}
//return t;
}
/* TLS: making a conservative guess at which system calls need to be
mutexed. I'm doing it whenever I see the process table altered or
affected, so this is the data structure that its protecting.
At some point, the SET_FILEPTRs should be protected against other
threads closing that stream. Perhaps for such things a
thread-specific stream table should be used.
*/
xsbBool sys_system(CTXTdeclc int callno)
{
// int pid;
Integer pid;
switch (callno) {
case PLAIN_SYSTEM_CALL: /* dumb system call: no communication with XSB */
/* this call is superseded by shell and isn't used */
ctop_int(CTXTc 3, system(ptoc_string(CTXTc 2)));
return TRUE;
case SLEEP_FOR_SECS:
#ifdef WIN_NT
Sleep((int)iso_ptoc_int_arg(CTXTc 2,"sleep/1",1) * 1000);
#else
sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1));
#endif
return TRUE;
case GET_TMP_FILENAME:
ctop_string(CTXTc 2,tempnam(NULL,NULL));
return TRUE;
case IS_PLAIN_FILE:
case IS_DIRECTORY:
case STAT_FILE_TIME:
case STAT_FILE_SIZE:
return file_stat(CTXTc callno, ptoc_longstring(CTXTc 2));
case EXEC: {
#ifdef HAVE_EXECVP
/* execs a new process in place of XSB */
char *params[MAX_SUBPROC_PARAMS+2];
prolog_term cmdspec_term;
int index = 0;
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term)) {
prolog_term temp, head;
char *string_head=NULL;
if (isnil(cmdspec_term))
xsb_abort("[exec] Arg 1 must not be an empty list.");
temp = cmdspec_term;
do {
head = p2p_car(temp);
temp = p2p_cdr(temp);
if (isstring(head))
string_head = string_val(head);
else
xsb_abort("[exec] non-string argument passed in list.");
params[index++] = string_head;
if (index > MAX_SUBPROC_PARAMS)
xsb_abort("[exec] Too many arguments.");
} while (!isnil(temp));
params[index] = NULL;
} else if (isstring(cmdspec_term)) {
char *string = string_val(cmdspec_term);
split_command_arguments(string, params, "exec");
} else
xsb_abort("[exec] 1st argument should be term or list of strings.");
if (execvp(params[0], params))
xsb_abort("[exec] Exec call failed.");
#else
xsb_abort("[exec] builtin not supported in this architecture.");
#endif
}
case SHELL: /* smart system call: like SPAWN_PROCESS, but returns error code
instead of PID. Uses system() rather than execvp.
Advantage: can pass arbitrary shell command. */
case SPAWN_PROCESS: { /* spawn new process, reroute stdin/out/err to XSB */
/* +CallNo=2, +ProcAndArgsList,
-StreamToProc, -StreamFromProc, -StreamFromProcStderr,
-Pid */
static int pipe_to_proc[2], pipe_from_proc[2], pipe_from_stderr[2];
int toproc_stream=-1, fromproc_stream=-1, fromproc_stderr_stream=-1;
int pid_or_status;
FILE *toprocess_fptr=NULL,
*fromprocess_fptr=NULL, *fromproc_stderr_fptr=NULL;
char *params[MAX_SUBPROC_PARAMS+2]; /* one for progname--0th member,
one for NULL termination*/
prolog_term cmdspec_term, cmdlist_temp_term;
prolog_term cmd_or_arg_term;
xsbBool toproc_needed=FALSE, fromproc_needed=FALSE, fromstderr_needed=FALSE;
char *cmd_or_arg=NULL, *shell_cmd=NULL;
int idx = 0, tbl_pos;
char *callname=NULL;
xsbBool params_are_in_a_list=FALSE;
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (callno == SPAWN_PROCESS)
callname = "spawn_process/5";
else
callname = "shell/[1,2,5]";
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term))
params_are_in_a_list = TRUE;
else if (isstring(cmdspec_term))
shell_cmd = string_val(cmdspec_term);
else if (isref(cmdspec_term))
xsb_instantiation_error(CTXTc callname,1);
else
xsb_type_error(CTXTc "atom or list e.g. [command, arg, ...]",cmdspec_term,callname,1);
// xsb_abort("[%s] Arg 1 must be an atom or a list [command, arg, ...]",
// callname);
/* the user can indicate that he doesn't want either of the streams created
by putting an atom in the corresponding argument position */
if (isref(reg_term(CTXTc 3)))
toproc_needed = TRUE;
if (isref(reg_term(CTXTc 4)))
fromproc_needed = TRUE;
if (isref(reg_term(CTXTc 5)))
fromstderr_needed = TRUE;
/* if any of the arg streams is already used by XSB, then don't create
pipes --- use these streams instead. */
if (isointeger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, oint_val(reg_term(CTXTc 3)));
}
if (isointeger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, oint_val(reg_term(CTXTc 4)));
}
if (isointeger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, oint_val(reg_term(CTXTc 5)));
}
if (!isref(reg_term(CTXTc 6)))
xsb_type_error(CTXTc "variable (to return process id)",reg_term(CTXTc 6),callname,5);
// xsb_abort("[%s] Arg 5 (process id) must be a variable", callname);
if (params_are_in_a_list) {
/* fill in the params[] array */
if (isnil(cmdspec_term))
xsb_abort("[%s] Arg 1 must not be an empty list", callname);
cmdlist_temp_term = cmdspec_term;
do {
cmd_or_arg_term = p2p_car(cmdlist_temp_term);
cmdlist_temp_term = p2p_cdr(cmdlist_temp_term);
if (isstring(cmd_or_arg_term)) {
cmd_or_arg = string_val(cmd_or_arg_term);
}
else
xsb_abort("[%s] Non string list member in the Arg",
callname);
params[idx++] = cmd_or_arg;
if (idx > MAX_SUBPROC_PARAMS)
xsb_abort("[%s] Too many arguments passed to subprocess",
callname);
} while (!isnil(cmdlist_temp_term));
params[idx] = NULL; /* null termination */
} else { /* params are in a string */
if (callno == SPAWN_PROCESS)
split_command_arguments(shell_cmd, params, callname);
else {
/* if callno==SHELL => call system() => don't split shell_cmd */
params[0] = shell_cmd;
params[1] = NULL;
}
}
/* -1 means: no space left */
if ((tbl_pos = get_free_process_cell()) < 0) {
xsb_warn(CTXTc "Can't create subprocess because XSB process table is full");
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
/* params[0] is the progname */
pid_or_status = xsb_spawn(CTXTc params[0], params, callno,
(toproc_needed ? pipe_to_proc : NULL),
(fromproc_needed ? pipe_from_proc : NULL),
(fromstderr_needed ? pipe_from_stderr : NULL),
toprocess_fptr, fromprocess_fptr,
fromproc_stderr_fptr);
if (pid_or_status < 0) {
xsb_warn(CTXTc "[%s] Subprocess creation failed, Error: %d, errno: %d, Cmd: %s", callname,pid_or_status,errno,params[0]);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(CTXTc toprocess_fptr,callname,"pipe","w",CURRENT_CHARSET);
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(CTXTc fromprocess_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(CTXTc fromproc_stderr_fptr,callname,"pipe","r",CURRENT_CHARSET);
ctop_int(CTXTc 5, fromproc_stderr_stream);
}
ctop_int(CTXTc 6, pid_or_status);
xsb_process_table.process[tbl_pos].pid = pid_or_status;
xsb_process_table.process[tbl_pos].to_stream = toproc_stream;
xsb_process_table.process[tbl_pos].from_stream = fromproc_stream;
xsb_process_table.process[tbl_pos].stderr_stream = fromproc_stderr_stream;
concat_array(CTXTc params, " ",
xsb_process_table.process[tbl_pos].cmdline,MAX_CMD_LEN);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case GET_PROCESS_TABLE: { /* sys_system(3, X). X is bound to the list
of the form [process(Pid,To,From,Stderr,Cmdline), ...] */
int i;
prolog_term table_term_tail, listHead;
prolog_term table_term=reg_term(CTXTc 2);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!isref(table_term))
xsb_abort("[GET_PROCESS_TABLE] Arg 1 must be a variable");
table_term_tail = table_term;
for (i=0; i<MAX_SUBPROC_NUMBER; i++) {
if (!FREE_PROC_TABLE_CELL(xsb_process_table.process[i].pid)) {
c2p_list(CTXTc table_term_tail); /* make it into a list */
listHead = p2p_car(table_term_tail);
c2p_functor(CTXTc "process", 5, listHead);
c2p_int(CTXTc xsb_process_table.process[i].pid, p2p_arg(listHead,1));
c2p_int(CTXTc xsb_process_table.process[i].to_stream, p2p_arg(listHead,2));
c2p_int(CTXTc xsb_process_table.process[i].from_stream, p2p_arg(listHead,3));
c2p_int(CTXTc xsb_process_table.process[i].stderr_stream,
p2p_arg(listHead,4));
c2p_string(CTXTc xsb_process_table.process[i].cmdline, p2p_arg(listHead,5));
table_term_tail = p2p_cdr(table_term_tail);
}
}
c2p_nil(CTXTc table_term_tail); /* bind tail to nil */
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return p2p_unify(CTXTc table_term, reg_term(CTXTc 2));
}
case PROCESS_STATUS: {
prolog_term pid_term=reg_term(CTXTc 2), status_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (!isref(status_term))
xsb_abort("[PROCESS_STATUS] Arg 2 (process status) must be a variable");
switch (process_status(pid)) {
case RUNNING:
c2p_string(CTXTc "running", status_term);
break;
case STOPPED:
c2p_string(CTXTc "stopped", status_term);
break;
case EXITED_NORMALLY:
c2p_string(CTXTc "exited_normally", status_term);
break;
case EXITED_ABNORMALLY:
c2p_string(CTXTc "exited_abnormally", status_term);
break;
case ABORTED:
c2p_string(CTXTc "aborted", status_term);
break;
case INVALID:
c2p_string(CTXTc "invalid", status_term);
break;
default:
c2p_string(CTXTc "unknown", status_term);
}
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case PROCESS_CONTROL: {
/* sys_system(PROCESS_CONTROL, +Pid, +Signal). Signal: wait, kill */
int status;
prolog_term pid_term=reg_term(CTXTc 2), signal_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isointeger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = (int)oint_val(pid_term);
if (isstring(signal_term) && strcmp(string_val(signal_term), "kill")==0) {
if (KILL_FAILED(pid)) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
CloseHandle((HANDLE) pid);
#endif
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
if (isconstr(signal_term)
&& strcmp(p2c_functor(signal_term),"wait") == 0
&& p2c_arity(signal_term)==1) {
int exit_status;
if (WAIT(pid, status) < 0) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
exit_status = status;
#else
if (WIFEXITED(status))
exit_status = WEXITSTATUS(status);
else
exit_status = -1;
#endif
p2p_unify(CTXTc p2p_arg(signal_term,1), makeint(exit_status));
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
xsb_warn(CTXTc "[PROCESS_CONTROL] Arg 2: Invalid signal specification. Must be `kill' or `wait(Var)'");
return FALSE;
}
case LIST_DIRECTORY: {
/* assume all type- and mode-checking is done in Prolog */
prolog_term handle = reg_term(CTXTc 2); /* ref for handle */
char *dir_name = ptoc_longstring(CTXTc 3); /* +directory name */
prolog_term filename = reg_term(CTXTc 4); /* reference for name of file */
if (is_var(handle))
return xsb_find_first_file(CTXTc handle,dir_name,filename);
else
return xsb_find_next_file(CTXTc handle,dir_name,filename);
}
default:
xsb_abort("[SYS_SYSTEM] Wrong call number (an XSB bug)");
} /* end case */
return TRUE;
}
static int bindReturnList(prolog_term returnList, struct xsb_data** result, struct xsb_queryHandle* qHandle)
{
prolog_term element;
char* temp;
char c;
int i, j;
int rFlag;
if (is_nil(returnList) && result == NULL) {
rFlag = RESULT_NONEMPTY_OR_NOT_REQUESTED;
}
if (!is_nil(returnList) && result == NULL && qHandle->state == QUERY_BEGIN) {
errorMesg = "XSB_DBI_ERROR: Invalid return list in query";
errorNumber = "XSB_DBI_013";
rFlag = INVALID_RETURN_LIST;
}
else if (!is_nil(returnList) && result == NULL) {
while (!is_nil(returnList)) {
element = p2p_car(returnList);
c2p_nil(CTXTc element);
returnList = p2p_cdr(returnList);
}
rFlag = RESULT_EMPTY_BUT_REQUESTED;
}
i = 0;
if (result != NULL) {
while (!is_nil(returnList)) {
if (qHandle->numResultCols <= i) {
errorMesg = "XSB_DBI ERROR: Number of requested columns exceeds the number of columns in the query";
errorNumber = "XSB_DBI_011";
rFlag = TOO_MANY_RETURN_COLS;
return rFlag;
}
element = p2p_car(returnList);
if (result == NULL) {
c2p_nil(CTXTc element);
}
else if (is_var(element) && result[i]->type == STRING_TYPE) {
if (result[i]->val == NULL)
c2p_nil(CTXTc element);
else {
c = result[i]->val->str_val[0];
if (c == DB_INTERFACE_TERM_SYMBOL) {
temp = (char *)malloc(strlen(result[i]->val->str_val) * sizeof(char));
for (j = 1 ; j < (int)strlen(result[i]->val->str_val) ; j++) {
temp[j-1] = result[i]->val->str_val[j];
}
temp[strlen(result[i]->val->str_val) - 1] = '\0';
c2p_functor(CTXTc "term", 1, element);
c2p_string(CTXTc temp, p2p_arg(element, 1));
if (temp != NULL) {
free(temp);
temp = NULL;
}
}
else {
c2p_string(CTXTc result[i]->val->str_val, element);
}
}
}
else if (is_var(element) && result[i]->type == INT_TYPE)
c2p_int(CTXTc result[i]->val->i_val, element);
else if (is_var(element) && result[i]->type == FLOAT_TYPE)
c2p_float(CTXTc result[i]->val->f_val, element);
returnList = p2p_cdr(returnList);
i++;
}
rFlag = RESULT_NONEMPTY_OR_NOT_REQUESTED;
}
if (result != NULL && qHandle->numResultCols > i) {
errorMesg = "XSB_DBI ERROR: Number of requested columns is less than the number of returned columns";
errorNumber = "XSB_DBI_012";
rFlag = TOO_FEW_RETURN_COLS;
return rFlag;
}
return rFlag;
}
int main(int argc, char *argv[])
{
int rcode;
int myargc = 3;
char *myargv[3];
/* xsb_init relies on the calling program to pass the absolute or relative
path name of the XSB installation directory. We assume that the current
program is sitting in the directory .../examples/c_calling_xsb/
To get installation directory, we strip 3 file names from the path. */
myargv[0] = strip_names_from_path(xsb_executable_full_path(argv[0]), 3);
myargv[1] = "-n";
myargv[2] = "-e writeln(hello). writeln(kkk).";
/* Initialize xsb */
xsb_init(myargc,myargv); /* depend on user to put in right options (-n) */
/* Create command to consult a file: ctest.P, and send it. */
c2p_functor("consult",1,reg_term(1));
c2p_string("ctest",p2p_arg(reg_term(1),1));
if (xsb_command()) {
printf("Error consulting ctest.P.\n");
fflush(stdout);
}
if (xsb_command_string("consult(basics).")) {
printf("Error (string) consulting basics.\n");
fflush(stdout);
}
/* Create the query p(300,X,Y) and send it. */
c2p_functor("p",3,reg_term(1));
c2p_int(300,p2p_arg(reg_term(1),1));
rcode = xsb_query();
/* Print out answer and retrieve next one. */
while (!rcode) {
if (!(is_string(p2p_arg(reg_term(2),1)) &
is_string(p2p_arg(reg_term(2),2))))
printf("2nd and 3rd subfields must be atoms\n");
else
printf("Answer: %d, %s(%s), %s(%s)\n",
p2c_int(p2p_arg(reg_term(1),1)),
p2c_string(p2p_arg(reg_term(1),2)),
xsb_var_string(1),
p2c_string(p2p_arg(reg_term(1),3)),
xsb_var_string(2)
);
fflush(stdout);
rcode = xsb_next();
}
/* Create the string query p(300,X,Y) and send it, use higher-level
routines. */
xsb_make_vars(3);
xsb_set_var_int(300,1);
rcode = xsb_query_string("p(X,Y,Z).");
/* Print out answer and retrieve next one. */
while (!rcode) {
if (!(is_string(p2p_arg(reg_term(2),2)) &
is_string(p2p_arg(reg_term(2),3))))
printf("2nd and 3rd subfields must be atoms\n");
else
printf("Answer: %d, %s, %s\n",
xsb_var_int(1),
xsb_var_string(2),
xsb_var_string(3)
);
fflush(stdout);
rcode = xsb_next();
}
/* Close connection */
xsb_close();
printf("cmain exit\n");
return(0);
}
int convert_pyObj_prObj(PyObject *pyObj, prolog_term *prTerm)
{
if(pyObj == Py_None){
return 1;// todo: check this case for a list with a none in the list. how does prolog side react
}
if(PyInt_Check(pyObj))
{
int result = PyInt_AS_LONG(pyObj);
//extern_ctop_int(3, result);
c2p_int(result, *prTerm);
return 1;
}
else if(PyFloat_Check(pyObj))
{
float result = PyFloat_AS_DOUBLE(pyObj);
//extern_ctop_float(3, result);
c2p_float(result, *prTerm);
return 1;
}else if(PyString_Check(pyObj))
{
char *result = PyString_AS_STRING(pyObj);
//extern_ctop_string(3, result);
c2p_string(result, *prTerm);
return 1;
}else if(PyList_Check(pyObj))
{
size_t size = PyList_Size(pyObj);
size_t i = 0;
prolog_term head, tail;
prolog_term P = p2p_new();
tail = P;
for(i = 0; i < size; i++)
{
c2p_list(CTXTc tail);
head = p2p_car(CTXTc tail);
PyObject *pyObjInner = PyList_GetItem(pyObj, i);
//int temp = PyInt_AS_LONG(pyObj);
//c2p_int(temp, head);
convert_pyObj_prObj(pyObjInner, &head);
tail = p2p_cdr(tail);
}
c2p_nil(CTXTc tail);
//p2p_unify(P, reg_term(CTXTc 3));
return 1;
}else
{
//returns an object refernce to prolog side.
pyobj_ref_node *node = add_pyobj_ref_list(pyObj);
//printf("node : %p", node);
char str[30];
sprintf(str, "%p", node);
//extern_ctop_string(3,str);
prolog_term ref = p2p_new();
c2p_functor("pyObject", 1, ref);
prolog_term ref_inner = p2p_arg(ref, 1);
c2p_string(str, ref_inner);
p2p_unify(ref, *prTerm);
return 1;
}
}
DllExport int call_conv get_next_result(CTXTdecl)
{
if(head == NULL) return 0;
// process the head raptor-term and build a term
prolog_term return_term = reg_term(CTXTdecl 1);
prolog_term t = p2p_new();
c2p_functor(CTXTdecl prefix, 4, t);
c2p_raptor_term(CTXTdecl head->subject, p2p_arg(CTXTdecl t, 1));
c2p_raptor_term(CTXTdecl head->predicate, p2p_arg(CTXTdecl t, 2));
c2p_raptor_term(CTXTdecl head->object, p2p_arg(CTXTdecl t, 3));
c2p_raptor_term(CTXTdecl head->graph, p2p_arg(CTXTdecl t, 4));
p2p_unify(return_term, t);
// pop the head off the queue
struct raptor_node *old_head = head;
if(tail == head)
{
tail = NULL;
head = NULL;
}
else
head = head->prev;
// free up the strings
//printf("1");
if(old_head->subject.arg1 != NULL)
free(old_head->subject.arg1);
if(old_head->subject.arg2 != NULL)
free(old_head->subject.arg2);
if(old_head->subject.arg3 != NULL)
free(old_head->subject.arg3);
//printf("2");
if(old_head->predicate.arg1 != NULL)
free(old_head->predicate.arg1);
if(old_head->predicate.arg2 != NULL)
free(old_head->predicate.arg2);
if(old_head->predicate.arg3 != NULL)
free(old_head->predicate.arg3);
//printf("3");
if(old_head->object.arg1 != NULL)
free(old_head->object.arg1);
if(old_head->object.arg2 != NULL)
free(old_head->object.arg2);
if(old_head->object.arg3 != NULL)
free(old_head->object.arg3);
//printf("4");
if(old_head->graph.arg1 != NULL)
free(old_head->graph.arg1);
if(old_head->graph.arg2 != NULL)
free(old_head->graph.arg2);
if(old_head->graph.arg3 != NULL)
free(old_head->graph.arg3);
//printf("5");
free(old_head);
// return
return 1;
}
/* XSB regular expression matcher entry point
In:
Arg1: regexp
Arg2: string
Arg3: offset
Arg4: match_flags: Var means case-sensitive/extended;
number: ignorecase/extended
List: [{extended|ignorecase},...]
Out:
Arg5: list of the form [match(bo0,eo0), match(bo1,eo1),...]
where bo*,eo* specify the beginning and ending offsets of the
matched substrings.
All matched substrings are returned. Parenthesized expressions are
ignored.
*/
int do_bulkmatch__(void)
{
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
prolog_term listHead, listTail;
/* Prolog args are first assigned to these, so we could examine the types
of these objects to determine if we got strings or atoms. */
prolog_term regexp_term, input_term, offset_term;
prolog_term output_term = p2p_new(CTXT);
char *regexp_ptr=NULL; /* regular expression ptr */
char *input_string=NULL; /* string where matches are to be found */
int match_flags=FALSE;
int return_code, paren_number, offset;
regmatch_t *match_array;
int last_pos=0, input_len;
if (first_call)
initialize_regexp_tbl();
regexp_term = reg_term(CTXTc 1); /* Arg1: regexp */
if (is_string(regexp_term)) /* check it */
regexp_ptr = string_val(regexp_term);
else if (is_list(regexp_term))
regexp_ptr = p_charlist_to_c_string(CTXTc regexp_term, ®exp_buffer,
"RE_BULKMATCH", "regular expression");
else
xsb_abort("[RE_BULKMATCH] Arg 1 (the regular expression) must be an atom or a character list");
input_term = reg_term(CTXTc 2); /* Arg2: string to find matches in */
if (is_string(input_term)) /* check it */
input_string = string_val(input_term);
else if (is_list(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"RE_BULKMATCH", "input string");
} else
xsb_abort("[RE_BULKMATCH] Arg 2 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
offset_term = reg_term(CTXTc 3); /* arg3: offset within the string */
if (! is_int(offset_term))
xsb_abort("[RE_BULKMATCH] Arg 3 (the offset) must be an integer");
offset = int_val(offset_term);
if (offset < 0 || offset > input_len)
xsb_abort("[RE_BULKMATCH] Arg 3 (=%d) must be between 0 and %d", input_len);
/* arg 4 specifies flags: _, number, list [extended,ignorecase] */
match_flags = make_flags(reg_term(CTXTc 4), "RE_BULKMATCH");
last_pos = offset;
/* returned result */
listTail = output_term;
while (last_pos < input_len) {
return_code = xsb_re_match(regexp_ptr, input_string+last_pos, match_flags,
&match_array, &paren_number, "RE_BULKMATCH");
/* exit on no match */
if (! return_code) break;
c2p_list(CTXTc listTail); /* make it into a list */
listHead = p2p_car(listTail); /* get head of the list */
/* bind i-th match to listHead as match(beg,end) */
c2p_functor(CTXTc "match", 2, listHead);
c2p_int(CTXTc match_array[0].rm_so+last_pos, p2p_arg(listHead,1));
c2p_int(CTXTc match_array[0].rm_eo+last_pos, p2p_arg(listHead,2));
listTail = p2p_cdr(listTail);
if (match_array[0].rm_eo > 0)
last_pos = match_array[0].rm_eo+last_pos;
else
last_pos++;
}
c2p_nil(CTXTc listTail); /* bind tail to nil */
return p2p_unify(CTXTc output_term, reg_term(CTXTc 5));
}
/**
* Function to handle the errors. It creates an appropriate error term
* for the prolog side to throw.
* Input : type of error
* Output : TRUE on success, FALSE on failure
**/
int
sgml2pl_error(plerrorid id, ...)
{
prolog_term except = p2p_new();
prolog_term formal = p2p_new();
prolog_term swi = p2p_new();
prolog_term tmp1 = p2p_new();
prolog_term tmp;
va_list args;
char msgbuf[1024];
char *msg = NULL;
va_start(args, id);
/*Create the appropriate error term based on the type of error*/
switch(id)
{
case ERR_ERRNO: /*Standard unix errors*/
{
int err = va_arg(args, int);
msg = strerror(err);
switch(err)
{
/*Not enough memory error*/
case ENOMEM:
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "resource_error", 1, tmp);
c2p_string( "no_memory", p2p_arg( tmp, 1));
p2p_unify( tmp1, formal);
break;
/*No access error*/
case EACCES:
{
const char *file = va_arg(args, const char *);
const char *action = va_arg(args, const char *);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "permission_error", 3, tmp);
c2p_string( (char*)action, p2p_arg(tmp, 1));
c2p_string( "file", p2p_arg(tmp, 2));
c2p_string ( (char*)file, p2p_arg(tmp, 3));
p2p_unify( tmp1, formal);
break;
}
/*Entity not found error*/
case ENOENT:
{
const char *file = va_arg(args, const char *);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "permission_error", 2, tmp);
c2p_string( "file", p2p_arg(tmp, 1));
c2p_string ( (char*)file, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
break;
}
/*Defaults to system error*/
default:
{
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_string("system_error", tmp);
p2p_unify( tmp1, formal);
break;
}
}
break;
}
case ERR_TYPE:
{
const char *expected = va_arg(args, const char*);
prolog_term actual = va_arg(args, prolog_term);
/*Type error*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
if( is_attv( actual) && strcmp(expected, "variable") != 0 )
{
c2p_string( "instantiation_error", tmp);
p2p_unify( tmp1, formal);
}
else
{
c2p_functor( "type_error", 2, tmp);
c2p_string( (char*)expected, p2p_arg(tmp, 1));
p2p_unify ( actual, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
}
break;
}
case ERR_DOMAIN: /*Domain error*/
{
const char *expected = va_arg(args, const char*);
prolog_term actual = va_arg(args, prolog_term);
/*Improper domain of functor*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
if( is_attv( actual) && strcmp(expected, "variable") != 0 )
{
c2p_string( "instantiation_error", tmp);
p2p_unify( tmp1, formal);
}
else
{
c2p_functor( "domain_error", 2, tmp);
c2p_string( (char*)expected, p2p_arg(tmp, 1));
p2p_unify( actual, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
}
break;
}
case ERR_EXISTENCE: /*Existence error*/
{
const char *type = va_arg(args, const char *);
prolog_term obj = va_arg(args, prolog_term);
/*Resource not found*/
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "existence_error", 2, tmp);
c2p_string( (char*)type, p2p_arg(tmp, 1));
p2p_unify ( obj, p2p_arg(tmp, 2));
p2p_unify( tmp1, formal);
break;
}
case ERR_FAIL:
{
/*Goal failed error*/
prolog_term goal = va_arg(args, prolog_term);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "goal_failed", 1, tmp);
p2p_unify( p2p_arg( tmp,1), goal);
p2p_unify( tmp1, formal);
break;
}
case ERR_LIMIT:
{
/*Limit exceeded error*/
const char *limit = va_arg(args, const char *);
long maxval = va_arg(args, long);
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "limit_exceeded", 2, tmp);
c2p_string( (char*)limit, p2p_arg( tmp,1));
c2p_int( maxval, p2p_arg( tmp, 2));
p2p_unify( tmp1, formal);
break;
}
case ERR_MISC:
{
/*Miscellaneous error*/
const char *id = va_arg(args, const char *);
const char *fmt = va_arg(args, const char *);
vsprintf(msgbuf, fmt, args);
msg = msgbuf;
c2p_functor("sgml", 1, tmp1);
tmp = p2p_arg( tmp1, 1);
c2p_functor( "miscellaneous", 1, tmp);
c2p_string( (char*)id, p2p_arg( tmp, 1));
p2p_unify( tmp1, formal);
break;
}
default:
assert(0);
}
va_end(args);
if ( msg )
{
prolog_term msgterm = p2p_new();
if ( msg )
{
c2p_string( msg, msgterm);
}
tmp = p2p_new();
c2p_functor( "context", 1, tmp);
p2p_unify( p2p_arg( tmp, 1), msgterm);
p2p_unify( tmp, swi);
}
/*Create the error term to throw*/
tmp = p2p_new();
c2p_functor( "error", 2, tmp);
p2p_unify( p2p_arg( tmp, 1), formal);
p2p_unify( p2p_arg( tmp, 2), swi);
p2p_unify( tmp, except);
return p2p_unify( global_error_term, except);
}
