int immediate_depends_ptrlist(CTXTdeclc callnodeptr call1){
VariantSF subgoal;
int count = 0;
CPtr oldhreg = NULL;
calllistptr cl;
reg[4] = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
if(IsNonNULL(call1)){ /* This can be called from some non incremental predicate */
cl= call1->inedges;
while(IsNonNULL(cl)){
subgoal = (VariantSF) cl->inedge_node->callnode->goal;
if(IsNonNULL(subgoal)){/* fact check */
count++;
check_glstack_overflow(4,pcreg,2);
oldhreg = hreg-2;
follow(oldhreg++) = makeint(subgoal);
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
}
cl=cl->next;
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
}
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
DllExport int call_conv curl_allocate_error_term()
{
check_thread_context
global_error_term = reg_term(CTXTc 1);
global_warning_term = reg_term(CTXTc 2);
return TRUE;
}
/*
* call as: between_datime(+T1,+T2,+T3)
* Checks if T1 is between T2 and T3
*/
int between_datime(CTXTdecl)
{
prolog_term t1 = reg_term(CTXTc 1);
prolog_term t2 = reg_term(CTXTc 2);
prolog_term t3 = reg_term(CTXTc 3);
if (!is_functor(t1) && !is_functor(t2) && !is_functor(t3))
return FALSE;
int t1_arity = p2c_arity(t1);
int t2_arity = p2c_arity(t2);
int t3_arity = p2c_arity(t3);
int t1_ts = p2c_int(p2p_arg(t1,1));
int t2_ts = p2c_int(p2p_arg(t2,1));
int t3_ts = p2c_int(p2p_arg(t3,1));
int t1_coun = 0;
int t2_coun = 0;
int t3_coun = 0;
if ( t1_arity > 1 && t2_arity > 1 && t3_arity > 1 )
{
t1_coun = p2c_int(p2p_arg(t1,2));
t2_coun = p2c_int(p2p_arg(t2,2));
t3_coun = p2c_int(p2p_arg(t3,2));
}
return aux_less_datime(t2_ts,t1_ts,t2_coun,t1_coun) &&
aux_less_datime(t1_ts,t3_ts,t1_coun,t3_coun);
}
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;
}
/* reg 1: tag for this call
reg 2: filter list of goals to keep (keep all if [])
reg 3: returned list of changed goals
reg 4: used as temp (in case of heap expansion)
*/
int create_changed_call_list(CTXTdecl){
callnodeptr call1;
VariantSF subgoal;
TIFptr tif;
int j, count = 0,arity;
Psc psc;
CPtr oldhreg = NULL;
reg[4] = makelist(hreg);
new_heap_free(hreg); // make heap consistent
new_heap_free(hreg);
while ((call1 = delete_calllist_elt(&changed_gl)) != EMPTY){
subgoal = (VariantSF) call1->goal;
tif = (TIFptr) subgoal->tif_ptr;
psc = TIF_PSC(tif);
if (in_reg2_list(CTXTc psc)) {
count++;
arity = get_arity(psc);
check_glstack_overflow(4,pcreg,2+arity*200); // guess for build_subgoal_args...
oldhreg = hreg-2;
if(arity>0){
sreg = hreg;
follow(oldhreg++) = makecs(hreg);
hreg += arity + 1;
new_heap_functor(sreg, psc);
for (j = 1; j <= arity; j++) {
new_heap_free(sreg);
cell_array1[arity-j] = cell(sreg-1);
}
build_subgoal_args(subgoal);
}else{
follow(oldhreg++) = makestring(get_name(psc));
}
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg); // make heap consistent
new_heap_free(hreg);
}
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
/*
int i;
for(i=0; i<callqptr; i++){
if(IsNonNULL(callq[i]) && (callq[i]->deleted==1)){
sfPrintGoal(stdout,(VariantSF)callq[i]->goal,NO);
printf(" %d %d\n",callq[i]->falsecount,callq[i]->deleted);
}
}
printf("-----------------------------\n");
*/
}
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);
}
/*
For a callnode call1 returns a Prolog list of callnode on which call1
immediately depends.
*/
int immediate_inedges_list(CTXTdeclc callnodeptr call1){
VariantSF subgoal;
TIFptr tif;
int j, count = 0,arity;
Psc psc;
CPtr oldhreg = NULL;
calllistptr cl;
reg[4] = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
if(IsNonNULL(call1)){ /* This can be called from some non incremental predicate */
cl= call1->inedges;
while(IsNonNULL(cl)){
subgoal = (VariantSF) cl->inedge_node->callnode->goal;
if(IsNonNULL(subgoal)){/* fact check */
count++;
tif = (TIFptr) subgoal->tif_ptr;
psc = TIF_PSC(tif);
arity = get_arity(psc);
check_glstack_overflow(4,pcreg,2+arity*200); // don't know how much for build_subgoal_args...
oldhreg = hreg-2;
if(arity>0){
sreg = hreg;
follow(oldhreg++) = makecs(hreg);
hreg += arity + 1;
new_heap_functor(sreg, psc);
for (j = 1; j <= arity; j++) {
new_heap_free(sreg);
cell_array1[arity-j] = cell(sreg-1);
}
build_subgoal_args(subgoal);
}else{
follow(oldhreg++) = makestring(get_name(psc));
}
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
}
cl=cl->next;
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
}else{
xsb_warn("Called with non-incremental predicate\n");
reg[4] = makenil;
}
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
/* file_stat(+FileName, +FuncNumber, -Result) */
xsbBool file_stat(CTXTdeclc int callno, char *file)
{
struct stat stat_buff;
int retcode;
#ifdef WIN_NT
size_t filenamelen; // windows doesn't allow trailing slash, others do
filenamelen = strlen(file);
if (file[filenamelen-1] == '/' || file[filenamelen-1] == '\\') {
char ss = file[filenamelen-1];
file[filenamelen-1] = '\0';
retcode = stat(file, &stat_buff);
file[filenamelen-1] = ss; // reset
} else
#endif
retcode = stat(file, &stat_buff);
switch (callno) {
case IS_PLAIN_FILE: {
if (retcode == 0 && S_ISREG(stat_buff.st_mode))
return TRUE;
else return FALSE;
}
case IS_DIRECTORY: {
if (retcode == 0 && S_ISDIR(stat_buff.st_mode))
return TRUE;
else return FALSE;
}
case STAT_FILE_TIME: {
/* This is DSW's hack to get 32 bit time values.
The idea is to call this builtin as file_time(File,time(T1,T2))
where T1 represents the most significant 8 bits and T2 represents
the least significant 24.
***This probably breaks 64 bit systems, so David will look into it!
*/
int functor_arg3 = isconstr(reg_term(CTXTc 3));
if (!retcode && functor_arg3) {
/* file exists & arg3 is a term, return 2 words*/
c2p_int(CTXTc (prolog_int)(stat_buff.st_mtime >> 24),p2p_arg(reg_term(CTXTc 3),1));
c2p_int(CTXTc 0xFFFFFF & stat_buff.st_mtime,p2p_arg(reg_term(CTXTc 3),2));
} else if (!retcode) {
/* file exists, arg3 non-functor: issue an error */
ctop_int(CTXTc 3, (prolog_int)stat_buff.st_mtime);
} else if (functor_arg3) {
/* no file, and arg3 is functor: return two 0's */
c2p_int(CTXTc 0, p2p_arg(reg_term(CTXTc 3),2));
c2p_int(CTXTc 0, p2p_arg(reg_term(CTXTc 3),1));
} else {
/* no file, no functor: return 0 */
ctop_int(CTXTc 3, 0);
}
return TRUE;
}
DllExport int call_conv load_nquad_file(CTXTdecl)
{
char *filename = p2c_string(reg_term(CTXTdecl 1));
unsigned char *uri_string;
raptor_uri *uri, *base_uri;
world = raptor_new_world();
rdf_parser = raptor_new_parser(world, "nquads");
raptor_parser_set_statement_handler(rdf_parser, NULL, handle_term);
uri_string = raptor_uri_filename_to_uri_string(filename);
uri = raptor_new_uri(world, uri_string);
base_uri = raptor_uri_copy(uri);
raptor_parser_parse_file(rdf_parser, uri, base_uri);
raptor_free_parser(rdf_parser);
raptor_free_uri(base_uri);
raptor_free_uri(uri);
raptor_free_memory(uri_string);
raptor_free_world(world);
return 1;
}
DllExport int call_conv set_nq_prefix(CTXTdecl)
{
prolog_term arg = reg_term(CTXTdecl 1);
prefix = p2c_string(CTXTdecl arg);
return 1;
}
/*
* call as: equal_datime(T1,T2)
* Checks if T1 and T2 are the same date
*/
int equal_datime(CTXTdecl)
{
prolog_term t1 = reg_term(CTXTc 1);
prolog_term t2 = reg_term(CTXTc 2);
if(!is_functor(t1) && !is_functor(t2))
return FALSE;
int t1_ts = p2c_int(p2p_arg(t1,1));
int t2_ts = p2c_int(p2p_arg(t2,1));
if (t1_ts==t2_ts)
return TRUE;
else
return FALSE;
}
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 return_scc_list(CTXTdeclc SCCNode * nodes, int num_nodes){
VariantSF subgoal;
TIFptr tif;
int cur_node = 0,arity, j;
Psc psc;
CPtr oldhreg = NULL;
reg[4] = makelist(hreg);
new_heap_free(hreg); new_heap_free(hreg);
do {
subgoal = (VariantSF) nodes[cur_node].node;
tif = (TIFptr) subgoal->tif_ptr;
psc = TIF_PSC(tif);
arity = get_arity(psc);
// printf("subgoal %p, %s/%d\n",subgoal,get_name(psc),arity);
check_glstack_overflow(4,pcreg,2+arity*200); // don't know how much for build_subgoal_args..
oldhreg=hreg-2; // ptr to car
if(arity>0){
sreg = hreg;
follow(oldhreg++) = makecs(sreg);
new_heap_functor(sreg,get_ret_psc(2)); // car pts to ret/2 psc
hreg += 3; // hreg pts past ret/2
sreg = hreg;
follow(hreg-1) = makeint(nodes[cur_node].component); // arg 2 of ret/2 pts to component
follow(hreg-2) = makecs(sreg);
new_heap_functor(sreg, psc); // arg 1 of ret/2 pts to goal psc
hreg += arity + 1;
for (j = 1; j <= arity; j++) {
new_heap_free(sreg);
cell_array1[arity-j] = cell(sreg-1);
}
build_subgoal_args(subgoal);
} else{
follow(oldhreg++) = makestring(get_name(psc));
}
follow(oldhreg) = makelist(hreg); // cdr points to next car
new_heap_free(hreg); new_heap_free(hreg);
cur_node++;
} while (cur_node < num_nodes);
follow(oldhreg) = makenil; // cdr points to next car
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
/* file_stat(+FileName, +FuncNumber, -Result) */
xsbBool file_stat(CTXTdeclc int callno, char *file)
{
struct stat stat_buff;
int retcode = stat(file, &stat_buff);
switch (callno) {
case IS_PLAIN_FILE: {
if (retcode == 0 && S_ISREG(stat_buff.st_mode))
return TRUE;
else return FALSE;
}
case IS_DIRECTORY: {
if (retcode == 0 && S_ISDIR(stat_buff.st_mode))
return TRUE;
else return FALSE;
}
case STAT_FILE_TIME: {
/* This is DSW's hack to get 32 bit time values.
The idea is to call this builtin as file_time(File,time(T1,T2))
where T1 represents the most significant 8 bits and T2 represents
the least significant 24.
***This probably breaks 64 bit systems, so David will look into it!
*/
int functor_arg3 = isconstr(reg_term(CTXTc 3));
if (!retcode && functor_arg3) {
/* file exists & arg3 is a term, return 2 words*/
c2p_int(CTXTc stat_buff.st_mtime >> 24,p2p_arg(reg_term(CTXTc 3),1));
c2p_int(CTXTc 0xFFFFFF & stat_buff.st_mtime,p2p_arg(reg_term(CTXTc 3),2));
} else if (!retcode) {
/* file exists, arg3 non-functor: issue an error */
xsb_warn("Arg 3 (the time argument) must be of the form time(X,Y)");
ctop_int(CTXTc 3, (0x7FFFFFF & stat_buff.st_mtime));
} else if (functor_arg3) {
/* no file, and arg3 is functor: return two 0's */
c2p_int(CTXTc 0, p2p_arg(reg_term(CTXTc 3),2));
c2p_int(CTXTc 0, p2p_arg(reg_term(CTXTc 3),1));
} else {
/* no file, no functor: return 0 */
xsb_warn("Arg 3 (the time argument) must be of the form time(X,Y)");
ctop_int(CTXTc 3, 0);
}
return TRUE;
}
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
}
/*
* call as: is_datime(+T)
* Returns true if T is a datime (with or without counter)
*/
int is_datime(CTXTdecl)
{
prolog_term t = reg_term(CTXTc 1);
if(is_functor(t))
{
char *func = p2c_functor(t);
if(strcmp(func,"datime")==0)
return TRUE;
}
return FALSE;
}
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;
}
/*
* call as: datime_minus_datime(T1,T2,Sec)
* Returns Sec as the diff in seconds between T1 and T2
*/
int datime_minus_datime(CTXTdecl)
{
prolog_term t1 = reg_term(CTXTc 1);
prolog_term t2 = reg_term(CTXTc 2);
if(!is_functor(t1) && !is_functor(t2))
return FALSE;
int t1_ts = p2c_int(p2p_arg(t1,1));
int t2_ts = p2c_int(p2p_arg(t2,1));
int diff = 0;
if(t1_ts < t2_ts)
diff = t2_ts - t1_ts;
else
diff = t1_ts - t2_ts;
c2p_int(CTXTc diff,reg_term(CTXTc 3));
return TRUE;
}
/* 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;
}
/*
* call as: next_valid_timestamp(Ts1,Ts2,Interval,NTs)
* Returns NTs as the next valid timestamp after Ts2 taking into account the
* interval. This is useful for the periodics events
*/
int next_valid_timestamp(CTXTdecl)
{
int ts = p2c_int(reg_term(CTXTc 1));
int interval = p2c_int(reg_term(CTXTc 3));
int ts_now = p2c_int(reg_term(CTXTc 2));
int next_ts = 0;
if (ts_now <= ts)
{
next_ts = ts + interval;
c2p_int(CTXTc next_ts, reg_term(CTXTc 4));
return TRUE;
}
int diff = (ts_now - ts);
int left_time = diff % interval;
next_ts = ts_now + (interval - left_time);
c2p_int(CTXTc next_ts, reg_term(CTXTc 4));
return TRUE;
}
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);
}
}
/*******************************************************************
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: less_datime(T1,T2)
* Return true if T1 is an older date than T2
*/
int less_datime(CTXTdecl)
{
prolog_term t1 = reg_term(CTXTc 1);
prolog_term t2 = reg_term(CTXTc 2);
if (!is_functor(t1) || !is_functor(t2))
{
return FALSE;
}
int t1_arity = p2c_arity(t1);
int t2_arity = p2c_arity(t2);
int t1_ts = p2c_int(p2p_arg(t1,1));
int t2_ts = p2c_int(p2p_arg(t2,1));
int t1_coun = 0;
int t2_coun = 0;
if ( t1_arity > 1 && t2_arity > 1 )
{
t1_coun = p2c_int(p2p_arg(t1,2));
t2_coun = p2c_int(p2p_arg(t2,2));
}
return aux_less_datime(t1_ts,t2_ts,t1_coun,t2_coun);
}
static xsbBool set_error_code(CTXTdeclc int ErrCode, int ErrCodeArgNumber, char *Where)
{
prolog_term ecode_value_term, ecode_arg_term = p2p_new(CTXT);
ecode_value_term = reg_term(CTXTc ErrCodeArgNumber);
if (!isref(ecode_value_term) &&
!(isointeger(ecode_value_term)))
xsb_abort("[%s] Arg %d (the error code) must be a variable or an integer!",
Where, ErrCodeArgNumber);
c2p_int(CTXTc ErrCode, ecode_arg_term);
return p2p_unify(CTXTc ecode_arg_term, ecode_value_term);
}
/*******************************************************************
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;
}
int immediate_affects_ptrlist(CTXTdeclc callnodeptr call1){
VariantSF subgoal;
int count = 0;
CPtr oldhreg = NULL;
struct hashtable *h;
struct hashtable_itr *itr;
callnodeptr cn;
reg[4] = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
if(IsNonNULL(call1)){ /* This can be called from some non incremental predicate */
h=call1->outedges->hasht;
itr = hashtable1_iterator(h);
if (hashtable1_count(h) > 0){
do {
cn = hashtable1_iterator_value(itr);
if(IsNonNULL(cn->goal)){
count++;
subgoal = (VariantSF) cn->goal;
check_glstack_overflow(4,pcreg,2);
oldhreg=hreg-2;
follow(oldhreg++) = makeint(subgoal);
follow(oldhreg) = makelist(hreg);
new_heap_free(hreg);
new_heap_free(hreg);
}
} while (hashtable1_iterator_advance(itr));
}
if (count>0)
follow(oldhreg) = makenil;
else
reg[4] = makenil;
}
return unify(CTXTc reg_term(CTXTc 3),reg_term(CTXTc 4));
}
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;
}
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;
}
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;
}
