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;
}
DllExport int call_conv pl_encode_url()
{
char *url;
char *dir, *file_base, *suffix;
check_thread_context
url = (char *) extern_ptoc_string(1);
encode(url, &dir, &file_base, &suffix);
c2p_string(CTXTc dir, p2p_car(reg_term(CTXTc 2)));
c2p_string(CTXTc file_base, p2p_car(p2p_cdr(reg_term(CTXTc 2))));
c2p_string(CTXTc suffix, p2p_car(p2p_cdr(p2p_cdr(reg_term(CTXTc 2)))));
return TRUE;
}
DllExport int call_conv exception(void)
{
prolog_term number;
prolog_term message;
number = reg_term(CTXTc 1);
message = reg_term(CTXTc 2);
if (is_var(message) && errorMesg != NULL && errorNumber != NULL) {
c2p_string(CTXTc errorMesg, message);
c2p_string(CTXTc errorNumber, number);
errorMesg = NULL;
errorNumber = NULL;
return TRUE;
}
return FALSE;
}
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);
}
int get_match_resultC__( void ) {
int order;
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
int submatch_number=ptoc_int(CTXTc 1);
/*--------------------------------------------------------------------------
Convert from Prolog-side convention for refering to submatches to
the corresponding array index numbers in match result storage.
--------------------------------------------------------------------------*/
switch (submatch_number) {
case MATCH: /*MATCH = -1*/
order = 0; /* actual position in the memory */
break;
case PREMATCH: /*PREMATCH = -2*/
order = 1;
break;
case POSTMATCH: /*POSTMATCH = -3*/
order = 2;
break;
case LAST_PAREN_MATCH: /*LAST_PAREN_MATCH = -4*/
order = 3;
break;
default:
if ( submatch_number > MAX_SUB_MATCH ) {
char message[120];
sprintf(message,
"Specified submatch number %d exceeds the limit: %d\n",
submatch_number, MAX_SUB_MATCH);
xsb_warn(message);
order = -99;
}
else order = submatch_number+3; /* actual position in the memory */
break;
}
if (order == -99) return(FAILURE);
if ( matchPattern == NULL ) { /*didn't try_match before*/
xsb_warn("Call try_match/2 first!");
return(FAILURE);
} else if ( !strcmp(matchResults[order],"") || matchResults[order] == NULL )
return(FAILURE); /*no match found, return FAILURE */
else {
c2p_string(CTXTc matchResults[order], reg_term(CTXTc 2));
return(SUCCESS);
}
}
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;
}
DllExport int call_conv pl_load_page()
{
prolog_term head, tail, result = 0;
char *functor, *url = NULL, *data = NULL;
char *username = NULL, *password = NULL;
curl_opt options = init_options();
curl_ret ret_vals;
check_thread_context
tail = reg_term(CTXTc 1);
if(!is_list(tail))
return curl2pl_error(ERR_DOMAIN, "source", tail);
while(is_list(tail)){
head = p2p_car(tail);
tail = p2p_cdr(tail);
if(is_functor(head)){
functor = p2c_functor(head);
if(!strcmp(functor,"source")){
prolog_term term_url_func, term_url = 0;
term_url_func = p2p_arg(head, 1);
if(is_functor(term_url_func)){
if(!strcmp(p2c_functor(term_url_func), "url")){
term_url = p2p_arg(term_url_func, 1);
url = p2c_string(term_url);
data = load_page(url, options, &ret_vals);
}
else{
return curl2pl_error(ERR_MISC, "source", term_url);
}
}
else{
return curl2pl_error(ERR_MISC, "source", "Improper input format");
}
}
else if(!strcmp(functor,"options")){
prolog_term term_options = p2p_arg(head, 1);
prolog_term term_option;
while(is_list(term_options)){
term_option = p2p_car(term_options);
if(!strcmp(p2c_functor(term_option), "redirect")) {
if(!strcmp(p2c_string(p2p_arg(term_option, 1)), "true"))
options.redir_flag = 1;
else
options.redir_flag = 0;
}
else if(!strcmp(p2c_functor(term_option), "secure")){
if(!strcmp(p2c_string(p2p_arg(term_option, 1)), "false"))
options.secure.flag = 0;
else
options.secure.crt_name = p2c_string(p2p_arg(term_option, 1));
}
else if(!strcmp(p2c_functor(term_option), "auth")){
username = p2c_string(p2p_arg(term_option, 1));
password = p2c_string(p2p_arg(term_option, 2));
options.auth.usr_pwd = (char *) malloc ((strlen(username) + strlen(password) + 2) * sizeof(char));
strcpy(options.auth.usr_pwd, username);
strcat(options.auth.usr_pwd, ":");
strcat(options.auth.usr_pwd, password);
}
else if(!strcmp(p2c_functor(term_option), "timeout")){
options.timeout = (int)p2c_int(p2p_arg(term_option, 1));
}
else if(!strcmp(p2c_functor(term_option), "url_prop")){
options.url_prop = options.redir_flag;
}
else if(!strcmp(p2c_functor(term_option), "user_agent")){
options.user_agent = p2c_string(p2p_arg(term_option, 1));
}
else if(!strcmp(p2c_functor(term_option), "post")){
options.post_data = p2c_string(p2p_arg(term_option, 1));
}
term_options = p2p_cdr(term_options);
}
}
else if(!strcmp(functor,"document")){
result = p2p_arg(head, 1);
}
else if(!strcmp(functor,"properties")){
c2p_int(CTXTc (int) ret_vals.size, p2p_arg(head, 1));
/* the following code can be used to convert to local/UTC time, if
necessary. Note: XSB uses local time, and ret_vals.modify_time
is local, too.
struct tm * timeinfo;
timeinfo = gmtime(&(ret_vals.modify_time)); // UTC time
timeinfo = localtime(&(ret_vals.modify_time)); // local time
c2p_int(CTXTc (int) mktime(timeinfo), p2p_arg(head,2));
*/
/* return modification time as an integer */
c2p_int(CTXTc (int) ret_vals.modify_time, p2p_arg(head,2));
/*
The following converts time to string - not useful
if (ctime(&ret_vals.modify_time) == NULL)
c2p_string("", p2p_arg(head, 2));
else
c2p_string(CTXTc (char *) ctime(&ret_vals.modify_time),
p2p_arg(head, 2));
*/
}
}
else{
return curl2pl_error(ERR_DOMAIN, "source", head);
}
}
c2p_string(CTXTc data, result);
return TRUE;
}
/* 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);
}
/* XSB string substitution entry point: replace substrings specified in Arg2
with strings in Arg3.
In:
Arg1: string
Arg2: substring specification, a list [s(B1,E1),s(B2,E2),...]
Arg3: list of replacement strings
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool string_substitute(CTXTdecl)
{
/* 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 input_term, output_term;
prolog_term subst_reg_term, subst_spec_list_term, subst_spec_list_term1;
prolog_term subst_str_term=(prolog_term)0,
subst_str_list_term, subst_str_list_term1;
char *input_string=NULL; /* string where matches are to be found */
char *subst_string=NULL;
prolog_term beg_term, end_term;
Integer beg_offset=0, end_offset=0, input_len;
Integer last_pos = 0; /* last scanned pos in input string */
/* the output buffer is made large enough to include the input string and the
substitution string. */
int conversion_required=FALSE; /* from C string to Prolog char list */
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"STRING_SUBSTITUTE", "input string");
conversion_required = TRUE;
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: substring specification */
subst_spec_list_term = reg_term(CTXTc 2);
if (!islist(subst_spec_list_term) && !isnil(subst_spec_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 2 must be a list [s(B1,E1),s(B2,E2),...]");
/* handle substitution string */
subst_str_list_term = reg_term(CTXTc 3);
if (! islist(subst_str_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 4 (the output) must be an unbound variable");
subst_spec_list_term1 = subst_spec_list_term;
subst_str_list_term1 = subst_str_list_term;
if (isnil(subst_spec_list_term1)) {
XSB_StrSet(&output_buffer, input_string);
goto EXIT;
}
if (isnil(subst_str_list_term1))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must not be an empty list");
do {
subst_reg_term = p2p_car(subst_spec_list_term1);
subst_spec_list_term1 = p2p_cdr(subst_spec_list_term1);
if (!isnil(subst_str_list_term1)) {
subst_str_term = p2p_car(subst_str_list_term1);
subst_str_list_term1 = p2p_cdr(subst_str_list_term1);
if (isatom(subst_str_term)) {
subst_string = string_val(subst_str_term);
} else if (islist(subst_str_term)) {
subst_string = p_charlist_to_c_string(CTXTc subst_str_term, &subst_buf,
"STRING_SUBSTITUTE",
"substitution string");
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
}
beg_term = p2p_arg(subst_reg_term,1);
end_term = p2p_arg(subst_reg_term,2);
if (!(isointeger(beg_term)) ||
!(isointeger(end_term)))
xsb_abort("[STRING_SUBSTITUTE] Non-integer in Arg 2");
else {
beg_offset = oint_val(beg_term);
end_offset = oint_val(end_term);
}
/* -1 means end of string */
if (end_offset < 0)
end_offset = input_len;
if ((end_offset < beg_offset) || (beg_offset < last_pos))
xsb_abort("[STRING_SUBSTITUTE] Substitution regions in Arg 2 not sorted");
/* do the actual replacement */
XSB_StrAppendBlk(&output_buffer,input_string+last_pos,(int)(beg_offset-last_pos));
XSB_StrAppend(&output_buffer, subst_string);
last_pos = end_offset;
} while (!isnil(subst_spec_list_term1));
XSB_StrAppend(&output_buffer, input_string+end_offset);
EXIT:
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "STRING_SUBSTITUTE", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
/* XSB string substitution entry point
In:
Arg1: string
Arg2: beginning offset
Arg3: ending offset. `_' or -1: end of string, -2: char before last, etc.
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool substring(CTXTdecl)
{
/* 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 input_term, output_term;
prolog_term beg_offset_term, end_offset_term;
char *input_string=NULL; /* string where matches are to be found */
Integer beg_offset=0, end_offset=0, input_len=0, substring_len=0;
int conversion_required=FALSE;
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"SUBSTRING", "input string");
conversion_required = TRUE;
} else
xsb_abort("[SUBSTRING] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: beginning offset */
beg_offset_term = reg_term(CTXTc 2);
if (! (isointeger(beg_offset_term)))
xsb_abort("[SUBSTRING] Arg 2 (the beginning offset) must be an integer");
beg_offset = oint_val(beg_offset_term);
if (beg_offset < 0)
beg_offset = 0;
else if (beg_offset > input_len)
beg_offset = input_len;
/* arg 3: ending offset */
end_offset_term = reg_term(CTXTc 3);
if (isref(end_offset_term))
end_offset = input_len;
else if (! (isointeger(end_offset_term)))
xsb_abort("[SUBSTRING] Arg 3 (the end offset) must be integer or _");
else end_offset = oint_val(end_offset_term);
if (end_offset < 0)
end_offset = input_len + 1 + end_offset;
else if (end_offset > input_len)
end_offset = input_len;
else if (end_offset < beg_offset)
end_offset = beg_offset;
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[SUBSTRING] Arg 4 (the output string) must be an unbound variable");
/* do the actual replacement */
substring_len = end_offset-beg_offset;
XSB_StrAppendBlk(&output_buffer, input_string+beg_offset, (int)substring_len);
XSB_StrNullTerminate(&output_buffer);
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "SUBSTRING", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
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;
}
}
/**
* 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);
}
