static
int
p_rl_set_out(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
YAP_Term t2=YAP_Deref(YAP_ARG2);
IDTYPE id;
NUM val;
RL_Tree *tree;
// Check args
if (YAP_IsVarTerm(t1) || YAP_IsVarTerm(t2) )
return(FALSE);
id = YAP_IntOfTerm(t1);
val = YAP_IntOfTerm(t2);
tree=ID2PTR(id);
#ifdef STATS
STORE_TREE_SIZE(tree);
set_in_rl(tree,val,OUT);
UPDATE_MEM_USAGE(tree);
#else
set_in_rl(tree,val,OUT);
#endif
return (TRUE);
}
/** @pred optimizer_run(-F,-Status)
Runs the optimization, _F is the best (minimal) function value and
Status (int) is the status code returned by libLBFGS. Anything except
0 indicates an error, see the documentation of libLBFGS for the
meaning.
*/
static int optimizer_run(void) {
int ret = 0;
YAP_Term t1 = YAP_ARG1;
YAP_Term t2 = YAP_ARG2;
YAP_Int s1, s2;
lbfgsfloatval_t fx;
lbfgsfloatval_t * tmp_x=x;
if (optimizer_status == OPTIMIZER_STATUS_NONE) {
printf("ERROR: Memory for parameter vector not initialized, please call optimizer_initialize/1 first.\n");
return FALSE;
}
if (optimizer_status != OPTIMIZER_STATUS_INITIALIZED) {
printf("ERROR: Optimizer is running right now. Please wait till it is finished.\n");
return FALSE;
}
// both arguments have to be variables
if (! YAP_IsVarTerm(t1) || ! YAP_IsVarTerm(t2)) {
return FALSE;
}
s1 = YAP_InitSlot(t1);
s2 = YAP_InitSlot(t2);
optimizer_status = OPTIMIZER_STATUS_RUNNING;
ret = lbfgs(n, x, &fx, evaluate, progress, NULL, ¶m);
x=tmp_x;
optimizer_status = OPTIMIZER_STATUS_INITIALIZED;
YAP_Unify(YAP_GetFromSlot(s1),YAP_MkFloatTerm(fx));
YAP_Unify(YAP_GetFromSlot(s2),YAP_MkIntTerm(ret));
return TRUE;
}
static int
item2(YAP_Term tvar, YAP_Term titem, int offx, int offy)
{
mxArray *mat;
int rows;
int cols;
int off;
mat = get_array(tvar);
rows = mxGetM(mat);
cols = mxGetN(mat);
off = MAT_ACCESS(offx,offy,rows,cols);
if (!mat)
return FALSE;
if (mxIsInt32(mat)) {
INT32_T *input = (INT32_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsInt64(mat)) {
INT64_T *input = (INT64_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsCell(mat)) {
if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm((YAP_Int)mxGetCell(mat,off)));
} else {
mxArray *mat2 = get_array(titem);
mxSetCell(mat,off, mat2);
}
} else if (mxIsDouble(mat)) {
double *input = mxGetPr(mat);
if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else {
return YAP_Unify(titem, YAP_MkFloatTerm(input[off]));
}
} else
return FALSE;
return cp_back(tvar, mat);
}
static int p_trie_mode(void) {
YAP_Term mode_term;
const char *mode_str;
YAP_Int mode;
/* get mode */
if (YAP_IsVarTerm(arg_mode)) {
mode = trie_get_mode();
if (mode == TRIE_MODE_STANDARD)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("std"));
else if (mode == TRIE_MODE_REVERSE)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("rev"));
else
return FALSE;
return YAP_Unify(arg_mode, mode_term);
}
/* set mode */
mode_str = YAP_AtomName(YAP_AtomOfTerm(arg_mode));
if (!strcmp(mode_str, "std"))
mode = TRIE_MODE_STANDARD;
else if (!strcmp(mode_str, "rev"))
mode = TRIE_MODE_REVERSE;
else
return FALSE;
trie_set_mode(mode);
return TRUE;
}
static
int
p_rl_copy(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1); // src
YAP_Term t2=YAP_Deref(YAP_ARG2); // dest
RL_Tree* new_tree;
IDTYPE id1,newid;
RL_Tree* tree;
// Check args
if (!YAP_IsIntTerm(t1))
return(FALSE);
if (!YAP_IsVarTerm(t2))
return(FALSE);
//
id1=YAP_IntOfTerm(t1);
tree=ID2PTR(id1);
new_tree=copy_rl(tree);
if(new_tree==NULL) {
fprintf(stderr,"Error creating new rl.");
return (FALSE);
}
//
#ifdef STATS
ADD_MEM_USAGE(new_tree);
#endif
// return list reference
newid=YAP_MkIntTerm(PTR2ID(new_tree));
if(!YAP_Unify(YAP_Deref(YAP_ARG2),newid))
return (FALSE);
return(TRUE);
}
static
int
p_rl_new(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
YAP_Term t2=YAP_Deref(YAP_ARG2);
RL_Tree* new_tree;
IDTYPE newid;
// Check args
if (!YAP_IsIntTerm(t1) || !YAP_IsVarTerm(t2)) {
fprintf(stderr,"Error in rl_new arguments\n");
return(FALSE);
}
//
new_tree=new_rl(YAP_IntOfTerm(t1));
if(new_tree==NULL) {
fprintf(stderr,"Error creating new rl.");
return (FALSE);
}
//printf("New rl %d %p--%u\n",PTR2ID(new_tree),new_tree,(int)new_tree,YAP_IntOfTerm(t1));
// return reference
newid=YAP_MkIntTerm(PTR2ID(new_tree));
if(!YAP_Unify(YAP_Deref(YAP_ARG2),newid))
return (FALSE);
return(TRUE);
}
static
int
p_rl_b_in1(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
YAP_Term t2=YAP_Deref(YAP_ARG2);
IDTYPE id;
NUM val;
RL_Tree *tree;
// Check args
if (!YAP_IsIntTerm(t1)) {
YAP_cut_fail();
return(FALSE);
}
if ( YAP_IsVarTerm(t2) ) {
// return all in through backtracking
YAP_PRESERVE_DATA(back_data,yap_back_data_type);
back_data->last_solution = YAP_MkIntTerm(0);
return p_rl_b_in2();
} else {
id = YAP_IntOfTerm(t1);
tree=ID2PTR(id);
val = YAP_IntOfTerm(t2);
if ( in_rl(tree,val) ) {
YAP_cut_succeed();
return (TRUE);
}
YAP_cut_fail();
return (FALSE);
}
}
static
int
p_rl_set_all_in(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
IDTYPE id;
RL_Tree *tree;
// Check args
if (YAP_IsVarTerm(t1) )
return(FALSE);
id = YAP_IntOfTerm(t1);
tree=ID2PTR(id);
#ifdef STATS
STORE_TREE_SIZE(tree);
rl_all(tree,IN);
freeze_rl(tree);
UPDATE_MEM_USAGE(tree);
#else
rl_all(tree,IN);
freeze_rl(tree);
#endif
return (TRUE);
}
/*
* Blocking communication function. The message is sent immediatly.
* mpi_send(+Data, +Destination, +Tag).
*/
static YAP_Bool
mpi_send(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1),
t2 = YAP_Deref(YAP_ARG2),
t3 = YAP_Deref(YAP_ARG3);
char *str=NULL;
int dest,tag;
size_t len=0;
int val;
if (YAP_IsVarTerm(t1) || !YAP_IsIntTerm(t2) || !YAP_IsIntTerm(t3)) {
return false;
}
CONT_TIMER();
//
dest = YAP_IntOfTerm(t2);
tag = YAP_IntOfTerm(t3);
// the data is packaged as a string
str=term2string(NULL,&len,t1);
#if defined(DEBUG) && 0
write_msg(__FUNCTION__,__FILE__,__LINE__,"%s(%s,%u, MPI_CHAR,%d,%d)\n",__FUNCTION__,str,len,dest,tag);
#endif
// send the data
val=(MPI_CALL(MPI_Send( str, len, MPI_CHAR, dest, tag, MPI_COMM_WORLD))==MPI_SUCCESS?true:false);
PAUSE_TIMER();
return(val);
}
static int
item1(YAP_Term tvar, YAP_Term titem, int off)
{
mxArray *mat;
mat = get_array(tvar);
if (!mat)
return FALSE;
if (mxIsInt32(mat)) {
INT32_T *input = (INT32_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsInt64(mat)) {
INT64_T *input = (INT64_T *)mxGetPr(mat);
if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm(input[off]));
} else
return FALSE;
} else if (mxIsCell(mat)) {
if (YAP_IsVarTerm(titem)) {
return YAP_Unify(titem, YAP_MkIntTerm((YAP_Int)mxGetCell(mat,off)));
} else {
mxArray *mat2 = get_array(titem);
mxSetCell(mat,off, mat2);
}
} else if (mxIsDouble(mat)) {
double *input = mxGetPr(mat);
if (YAP_IsFloatTerm(titem)) {
input[off] = YAP_FloatOfTerm(titem);
} else if (YAP_IsIntTerm(titem)) {
input[off] = YAP_IntOfTerm(titem);
} else {
return YAP_Unify(titem, YAP_MkFloatTerm(input[off]));
}
} else
return FALSE;
return cp_back(tvar, mat);
}
static int
load_facts( void ) {
int32_t nrows = YAP_IntOfTerm(YAP_ARG1);
int32_t ncols = YAP_IntOfTerm(YAP_ARG2), i = 0;
YAP_Term t3 = YAP_ARG3;
int32_t *mat = (int32_t *)malloc(sizeof(int32_t)*nrows*ncols);
int32_t pname = YAP_AtomToInt(YAP_NameOfFunctor(YAP_FunctorOfTerm(YAP_HeadOfTerm(t3))));
predicate *pred;
while(YAP_IsPairTerm(t3)) {
int32_t j = 0;
YAP_Term th = YAP_HeadOfTerm(t3);
for (j = 0; j < ncols; j++) {
YAP_Term ta = YAP_ArgOfTerm(j+1, th);
if (YAP_IsAtomTerm(ta)) {
mat[i*ncols+j] = YAP_AtomToInt(YAP_AtomOfTerm(ta));
} else {
mat[i*ncols+j] = YAP_IntOfTerm(ta);
}
}
t3 = YAP_TailOfTerm( t3 );
i++;
}
if (YAP_IsVarTerm( YAP_ARG4)) {
// new
pred = (predicate *)malloc(sizeof(predicate));
} else {
pred = (predicate *)YAP_IntOfTerm(YAP_ARG4);
if (pred->address_host_table)
free( pred->address_host_table );
}
pred->name = pname;
pred->num_rows = nrows;
pred->num_columns = ncols;
pred->is_fact = TRUE;
pred->address_host_table = mat;
Cuda_NewFacts(pred);
if (YAP_IsVarTerm( YAP_ARG4)) {
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm((YAP_Int)pred));
} else {
return TRUE;
}
}
/*
* Broadcasts a message from the process with rank "root" to
* all other processes of the group.
* mpi_ibcast(+Root,+Data,+Tag).
*/
static YAP_Bool
my_ibcast(YAP_Term t1,YAP_Term t2, YAP_Term t3) {
int root;
int k,worldsize;
size_t len=0;
char *str;
int tag;
BroadcastRequest *b;
//fprintf(stderr,"ibcast1");
//The arguments should be bound
if(YAP_IsVarTerm(t2) || !YAP_IsIntTerm(t1) || !YAP_IsIntTerm(t3)) {
return false;
}
CONT_TIMER();
// fprintf(stderr,"ibcast2");
MPI_CALL(MPI_Comm_size(MPI_COMM_WORLD,&worldsize));
root = YAP_IntOfTerm(t1);
tag = YAP_IntOfTerm(t3);
str = term2string(NULL,&len,t2);
b=new_broadcast();
if ( b==NULL ) {
PAUSE_TIMER();
return false;
}
//fprintf(stderr,"ibcast3");
for(k=0;k<=worldsize-1;++k) {
if(k!=root) {
MPI_Request *handle=(MPI_Request*)malloc(sizeof(MPI_Request));
MSG_SENT(len);
// Use async send
if(MPI_CALL(MPI_Isend(str, len, MPI_CHAR, k, tag, MPI_COMM_WORLD,handle))!=MPI_SUCCESS) {
free(handle);
PAUSE_TIMER();
return false;
}
new_broadcast_request(b,handle,str);
//new_request(handle,str);
USED_BUFFER();
}
}
if(!b->nreq)//release b if no messages were sent (worldsize==1)
free(b);
#if defined(DEBUG) && defined(MALLINFO)
{
struct mallinfo s = mallinfo();
printf("%d: %d=%d/%d\n",getpid(),s.arena,s.uordblks,s.fordblks); //vsc
}
#endif
PAUSE_TIMER();
//fprintf(stderr,"ibcast4");
return true;
}
static int p_itrie_open(void) {
TrEntry itrie;
/* check arg */
if (!YAP_IsVarTerm(arg_itrie))
return FALSE;
/* open itrie */
itrie = itrie_open();
return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie));
}
/*
* Non blocking communication function. The message is sent when possible. To check for the status of the message,
* the mpi_wait and mpi_test should be used. Until mpi_wait is called, the memory allocated for the buffer containing
* the message is not released.
*
* mpi_isend(+Data, +Destination, +Tag, -Handle).
*/
static YAP_Bool
mpi_isend(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1),
t2 = YAP_Deref(YAP_ARG2),
t3 = YAP_Deref(YAP_ARG3),
t4 = YAP_Deref(YAP_ARG4);
char *str=NULL;
int dest,tag;
size_t len=0;
MPI_Request *handle=(MPI_Request*)malloc(sizeof(MPI_Request));
CONT_TIMER();
if ( handle==NULL ) return false;
if (YAP_IsVarTerm(t1) || !YAP_IsIntTerm(t2) || !YAP_IsIntTerm(t3) || !YAP_IsVarTerm(t4)) {
PAUSE_TIMER();
return false;
}
//
dest = YAP_IntOfTerm(t2);
tag = YAP_IntOfTerm(t3);
//
str=term2string(NULL,&len,t1);
MSG_SENT(len);
// send the data
if( MPI_CALL(MPI_Isend( str, len, MPI_CHAR, dest, tag, MPI_COMM_WORLD ,handle)) != MPI_SUCCESS ) {
PAUSE_TIMER();
return false;
}
#ifdef DEBUG
write_msg(__FUNCTION__,__FILE__,__LINE__,"%s(%s,%u, MPI_CHAR,%d,%d)\n",__FUNCTION__,str,len,dest,tag);
#endif
USED_BUFFER(); // informs the prologterm2c module that the buffer is now used and should not be messed
// We must associate the string to each handle
new_request(handle,str);
PAUSE_TIMER();
return(YAP_Unify(YAP_ARG4,YAP_MkIntTerm(HANDLE2INT(handle))));// it should always succeed
}
/*
* Implements a non-blocking receive operation.
* mpi_irecv(?Source,?Tag,-Handle).
*/
static YAP_Bool
mpi_irecv(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1),
t2 = YAP_Deref(YAP_ARG2),
t3 = YAP_Deref(YAP_ARG3);
int tag, orig;
MPI_Request *mpi_req=(MPI_Request*)malloc(sizeof(MPI_Request));
// The third argument (data) must be unbound
if(!YAP_IsVarTerm(t3)) {
//Yap_Error(INSTANTIATION_ERROR, t_data, "mpi_receive");
return false;
}
/* The first argument (Source) must be bound to an integer
(the rank of the source) or left unbound (i.e. any source
is OK) */
if (YAP_IsVarTerm(t1)) orig = MPI_ANY_SOURCE;
else if( !YAP_IsIntTerm(t1) ) return false;
else orig = YAP_IntOfTerm(t1);
/* The third argument must be bound to an integer (the tag)
or left unbound (i.e. any tag is OK) */
if (YAP_IsVarTerm(t2)) tag = MPI_ANY_TAG;
else if( !YAP_IsIntTerm(t2) ) return false;
else tag = YAP_IntOfTerm( t2 );
CONT_TIMER();
RESET_BUFFER();
if( MPI_CALL(MPI_Irecv( BUFFER_PTR, BLOCK_SIZE, MPI_CHAR, orig, tag,
MPI_COMM_WORLD, mpi_req )) != MPI_SUCCESS ) {
PAUSE_TIMER();
return false;
}
new_request(mpi_req,BUFFER_PTR);
DEL_BUFFER();
PAUSE_TIMER();
return YAP_Unify(t3,YAP_MkIntTerm(HANDLE2INT(mpi_req)));
}
static
int
p_rl_in(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
YAP_Term t2=YAP_Deref(YAP_ARG2);
IDTYPE id;
NUM val;
RL_Tree *tree;
// Check args
if (YAP_IsVarTerm(t1) || YAP_IsVarTerm(t2) )
return(FALSE);
id = YAP_IntOfTerm(t1);
val = YAP_IntOfTerm(t2);
tree=ID2PTR(id);
if ( in_rl(tree,val) )
return (TRUE);
return (FALSE);
}
static int
cuda_init_facts( void ) {
int32_t nrows = YAP_IntOfTerm(YAP_ARG1);
int32_t ncols = YAP_IntOfTerm(YAP_ARG2);
int32_t *mat = (int32_t *)malloc(sizeof(int32_t)*nrows*ncols);
int32_t pname = YAP_AtomToInt(YAP_AtomOfTerm(YAP_ARG3));
predicate *pred;
strcat(names, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)));
strcat(names, " ");
if (!mat)
return FALSE;
if (YAP_IsVarTerm( YAP_ARG4)) {
// new
pred = (predicate *)malloc(sizeof(predicate));
} else {
pred = (predicate *)YAP_IntOfTerm(YAP_ARG4);
if (pred->address_host_table)
free( pred->address_host_table );
}
pred->name = pname;
pred->num_rows = nrows;
pred->num_columns = ncols;
pred->is_fact = TRUE;
pred->address_host_table = mat;
currentPred = pred;
currentFact = 0;
if (YAP_IsVarTerm( YAP_ARG4)) {
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm((YAP_Int)pred));
} else {
return TRUE;
}
}
static int p_itrie_loadFromStream(void) {
TrEntry itrie;
FILE *file;
/* check args */
if (!YAP_IsVarTerm(arg_itrie))
return FALSE;
if (!(file = (FILE*) YAP_FileDescriptorFromStream(arg_stream)))
return FALSE;
/* load itrie */
if (!(itrie = itrie_load(file)))
return FALSE;
return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie));
}
static int p_itrie_mode(void) {
YAP_Term mode_term;
const char *mode_str;
YAP_Int mode;
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* get mode */
if (YAP_IsVarTerm(arg_mode)) {
mode = itrie_get_mode((TrEntry) YAP_IntOfTerm(arg_itrie));
if (mode == ITRIES_MODE_INC_POS)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("inc_pos"));
else if (mode == ITRIES_MODE_DEC_POS)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("dec_pos"));
else if (mode == ITRIES_MODE_INC_NEG)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("inc_neg"));
else if (mode == ITRIES_MODE_DEC_NEG)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("dec_neg"));
else if (mode == ITRIES_MODE_NONE)
mode_term = YAP_MkAtomTerm(YAP_LookupAtom("none"));
else
return FALSE;
return YAP_Unify(arg_mode, mode_term);
}
/* set mode */
mode_str = YAP_AtomName(YAP_AtomOfTerm(arg_mode));
if (!strcmp(mode_str, "inc_pos"))
mode = ITRIES_MODE_INC_POS;
else if (!strcmp(mode_str, "dec_pos"))
mode = ITRIES_MODE_DEC_POS;
else if (!strcmp(mode_str, "inc_neg"))
mode = ITRIES_MODE_INC_NEG;
else if (!strcmp(mode_str, "dec_neg"))
mode = ITRIES_MODE_DEC_NEG;
else if (!strcmp(mode_str, "none"))
mode = ITRIES_MODE_NONE;
else
return FALSE;
itrie_set_mode((TrEntry) YAP_IntOfTerm(arg_itrie), mode);
return TRUE;
}
static YAP_Bool
mpi_default_buffer_size(term_t YAP_ARG1,...)
{
YAP_Term t2;
intptr_t IBLOCK_SIZE;
if (!YAP_Unify(YAP_ARG1,YAP_MkIntTerm(BLOCK_SIZE)))
return false;
t2 = YAP_ARG2;
if (YAP_IsVarTerm(t2))
return true;
if (!YAP_IsIntTerm(t2))
return false;
IBLOCK_SIZE= YAP_IntOfTerm(t2);
if (IBLOCK_SIZE < 0) {
IBLOCK_SIZE=4*1024;
return false;
}
BLOCK_SIZE = IBLOCK_SIZE;
return true;
}
static
int
p_rl_print(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
IDTYPE id;
RL_Tree *tree;
// Check args
if (YAP_IsVarTerm(t1) ) {
fprintf(stderr,"Error printing tree..");
return(FALSE);
}
id = YAP_IntOfTerm(t1);
tree=ID2PTR(id);
display_tree(tree);
return (TRUE);
}
static int p_itrie_timestamp(void) {
YAP_Int time;
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* get mode */
if (YAP_IsVarTerm(arg_time)) {
time = itrie_get_timestamp((TrEntry) YAP_IntOfTerm(arg_itrie));
return YAP_Unify(arg_time, YAP_MkIntTerm(time));
}
/* set mode */
if (YAP_IsIntTerm(arg_time)) {
time = YAP_IntOfTerm(arg_time);
itrie_set_timestamp((TrEntry) YAP_IntOfTerm(arg_itrie), time);
return TRUE;
}
return FALSE;
}
static
int
p_rl_free(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
IDTYPE id;
RL_Tree* tree;
// Check args
if (YAP_IsVarTerm(t1))
return(FALSE);
id=YAP_IntOfTerm(t1);
tree=ID2PTR(id);
#ifdef STATS
FREE_MEM_USAGE(tree);
#endif
free_rl(tree);
return (TRUE);
}
static
int
p_rl_size(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1),t_size;
IDTYPE id;
RL_Tree* tree;
unsigned int size;
if (YAP_IsVarTerm(t1))
return(FALSE);
id = YAP_IntOfTerm(t1);
tree=ID2PTR(id);
size=tree->size*sizeof(RL_Node)+sizeof(RL_Tree);
t_size=YAP_MkIntTerm(size);
if(!YAP_Unify(YAP_ARG2,t_size) )
return (FALSE);
return(TRUE);
}
static int p_itrie_load(void) {
TrEntry itrie;
const char *file_str;
FILE *file;
/* check args */
if (!YAP_IsVarTerm(arg_itrie))
return FALSE;
if (!YAP_IsAtomTerm(arg_file))
return FALSE;
/* open file */
file_str = YAP_AtomName(YAP_AtomOfTerm(arg_file));
if (!(file = fopen(file_str, "r")))
return FALSE;
/* load itrie and close file */
if (!(itrie = itrie_load(file)))
return FALSE;
if (fclose(file))
return FALSE;
return YAP_Unify(arg_itrie, YAP_MkIntTerm((YAP_Int) itrie));
}
/*
* Broadcasts a message from the process with rank "root" to
* all other processes of the group.
* Note: Collective communication means all processes within a communicator call the same routine.
* To be able to use a regular MPI_Recv to recv the messages, one should use mpi_bcast2
* mpi_bcast_int(+Root,+Data,+Tag).
*/
static YAP_Bool
my_bcast(YAP_Term t1,YAP_Term t2, YAP_Term t3) {
int root;
int k,worldsize;
size_t len=0;
char *str;
int tag;
//The arguments should be bound
if(YAP_IsVarTerm(t2) || !YAP_IsIntTerm(t1) || !YAP_IsIntTerm(t3)) {
return false;
}
CONT_TIMER();
MPI_CALL(MPI_Comm_size(MPI_COMM_WORLD,&worldsize));
root = YAP_IntOfTerm(t1);
tag = YAP_IntOfTerm(t3);
str=term2string(NULL,&len,t2);
for(k=0;k<=worldsize-1;++k)
if(k!=root) {
// Use async send?
MSG_SENT(len);
if(MPI_CALL(MPI_Send( str, len, MPI_CHAR, k, tag, MPI_COMM_WORLD))!=MPI_SUCCESS) {
PAUSE_TIMER();
return false;
}
#ifdef DEBUG
write_msg(__FUNCTION__,__FILE__,__LINE__,"bcast2(%s,%u, MPI_CHAR,%d,%d)\n",str,len,k,tag);
#endif
}
PAUSE_TIMER();
return true;
}
static int
load_rule( void ) {
// maximum of 2K symbols per rule, should be enough for ILP
int32_t vec[2048], *ptr = vec, *nvec, neg[2048];
// qK different variables;
YAP_Term vars[1024];
int32_t nvars = 0, x;
int32_t ngoals = YAP_IntOfTerm(YAP_ARG1); /* gives the number of goals */
int32_t ncols = YAP_IntOfTerm(YAP_ARG2);
YAP_Term t3 = YAP_ARG3;
YAP_Atom name = YAP_NameOfFunctor(YAP_FunctorOfTerm(YAP_HeadOfTerm(t3)));
int32_t pname = YAP_AtomToInt(name);
const char *strname = YAP_AtomName(name);
predicate *pred;
int32_t cont = 0;
memset(neg, 0x0, 2048 * sizeof(int32_t));
while(YAP_IsPairTerm(t3)) {
int32_t j = 0, m;
YAP_Term th = YAP_HeadOfTerm(t3);
YAP_Functor f = YAP_FunctorOfTerm( th );
int32_t n = YAP_ArityOfFunctor( f );
YAP_Atom at = YAP_NameOfFunctor( f );
if (at == AtomEq)
*ptr++ = SBG_EQ;
else if (at == AtomGt)
*ptr++ = SBG_GT;
else if (at == AtomLt)
*ptr++ = SBG_LT;
else if (at == AtomGe)
*ptr++ = SBG_GE;
else if (at == AtomLe)
*ptr++ = SBG_LE;
else if (at == AtomDf)
*ptr++ = SBG_DF;
else if (at == AtomNt)
{
neg[cont] = 1;
cont++;
}
else
{
*ptr++ = YAP_AtomToInt( at );
cont++;
}
for (j = 0; j < n; j++) {
YAP_Term ta = YAP_ArgOfTerm(j+1, th);
if (YAP_IsVarTerm(ta)) {
int32_t k;
for (k = 0; k< nvars; k++) {
if (vars[k] == ta) {
*ptr++ = k+1;
break;
}
}
if (k == nvars) {
vars[k] = ta;
*ptr++ = k+1;
nvars++;
}
} else if (YAP_IsAtomTerm(ta)) {
*ptr++ = -YAP_AtomToInt(YAP_AtomOfTerm(ta));
} else if (YAP_IsApplTerm(ta)) {
f = YAP_FunctorOfTerm( ta );
at = YAP_NameOfFunctor( f );
m = YAP_ArityOfFunctor( f );
*ptr++ = YAP_AtomToInt( at );
for (x = 0; x < m; x++) {
YAP_Term ta2 = YAP_ArgOfTerm(x+1, ta);
if (YAP_IsVarTerm(ta2)) {
int32_t k;
for (k = 0; k < nvars; k++) {
if (vars[k] == ta2) {
*ptr++ = k+1;
break;
}
}
if (k == nvars) {
vars[k] = ta2;
*ptr++ = k+1;
nvars++;
}
} else if (YAP_IsAtomTerm(ta2)) {
*ptr++ = -YAP_AtomToInt(YAP_AtomOfTerm(ta));
} else {
*ptr++ = -YAP_IntOfTerm(ta);
}
}
} else {
*ptr++ = -YAP_IntOfTerm(ta);
}
}
*ptr++ = 0;
t3 = YAP_TailOfTerm( t3 );
}
if (YAP_IsVarTerm( YAP_ARG4)) {
// new
pred = (predicate *)malloc(sizeof(predicate));
} else {
pred = (predicate *)YAP_IntOfTerm(YAP_ARG4);
if (pred->address_host_table)
free( pred->address_host_table );
}
pred->name = pname;
pred->num_rows = ngoals;
pred->num_columns = ncols;
pred->is_fact = FALSE;
x = (strlen(strname) + 1) * sizeof(char);
pred->predname = (char *)malloc(x);
memcpy(pred->predname, strname, x);
nvec = (int32_t *)malloc(sizeof(int32_t)*(ptr-vec));
memcpy(nvec, vec, sizeof(int32_t)*(ptr-vec));
pred->address_host_table = nvec;
pred->negatives = (int32_t *)malloc(sizeof(int32_t) * cont);
memcpy(pred->negatives, neg, sizeof(int32_t) * cont);
Cuda_NewRule( pred );
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm((YAP_Int)pred));
}
static YAP_Bool regexp(void)
{
unsigned int buflen = (unsigned int)YAP_IntOfTerm(YAP_ARG2)+1;
unsigned int sbuflen = (unsigned int)YAP_IntOfTerm(YAP_ARG4)+1;
char *buf, *sbuf;
regex_t reg;
int out;
size_t nmatch;
regmatch_t *pmatch;
long int tout;
int yap_flags = YAP_IntOfTerm(YAP_ARG5);
int regcomp_flags = REG_EXTENDED;
if ((buf = (char *)YAP_AllocSpaceFromYap(buflen)) == NULL) {
/* early exit */
return(FALSE);
}
if (YAP_StringToBuffer(YAP_ARG1,buf,buflen) == FALSE) {
/* something went wrong, possibly a type checking error */
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (yap_flags & 1)
regcomp_flags |= REG_ICASE;
/* cool, now I have my string in the buffer, let's have some fun */
if (yap_regcomp(®,buf, regcomp_flags) != 0) {
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (YAP_IsVarTerm(YAP_ARG7)) {
nmatch = reg.re_nsub;
} else {
nmatch = YAP_IntOfTerm(YAP_ARG7);
}
if ((sbuf = (char *)YAP_AllocSpaceFromYap(sbuflen)) == NULL) {
/* early exit */
yap_regfree(®);
YAP_FreeSpaceFromYap(buf);
return(FALSE);
}
if (YAP_StringToBuffer(YAP_ARG3,sbuf,sbuflen) == FALSE) {
/* something went wrong, possibly a type checking error */
yap_regfree(®);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
return(FALSE);
}
pmatch = YAP_AllocSpaceFromYap(sizeof(regmatch_t)*(nmatch));
out = yap_regexec(®,sbuf,nmatch,pmatch,0);
if (out == 0) {
/* match succeed, let's fill the match in */
long int i;
YAP_Term TNil = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
YAP_Functor FDiff = YAP_MkFunctor(YAP_LookupAtom("-"),2);
tout = TNil;
for (i = nmatch-1; i >= 0; --i) {
int j;
YAP_Term t = TNil;
if (pmatch[i].rm_so != -1) {
if (yap_flags & 2) {
YAP_Term to[2];
to[0] = YAP_MkIntTerm(pmatch[i].rm_so);
to[1] = YAP_MkIntTerm(pmatch[i].rm_eo);
t = YAP_MkApplTerm(FDiff,2,to);
} else {
for (j = pmatch[i].rm_eo-1; j >= pmatch[i].rm_so; j--) {
t = YAP_MkPairTerm(YAP_MkIntTerm(sbuf[j]),t);
}
}
tout = YAP_MkPairTerm(t,tout);
}
}
out = !YAP_Unify(tout, YAP_ARG6);
}
else if (out != REG_NOMATCH) {
out = 0;
}
yap_regfree(®);
YAP_FreeSpaceFromYap(buf);
YAP_FreeSpaceFromYap(sbuf);
YAP_FreeSpaceFromYap(pmatch);
return(out == 0);
}
/*
* Implements a blocking receive operation.
* mpi_recv(?Source,?Tag,-Data).
*/
static YAP_Bool
mpi_recv(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1),
t2 = YAP_Deref(YAP_ARG2),
t3 = YAP_Deref(YAP_ARG3),
t4;
int tag, orig;
int len=0;
MPI_Status status;
//The third argument (data) must be unbound
if(!YAP_IsVarTerm(t3)) {
return false;
}
/* The first argument (Source) must be bound to an integer
(the rank of the source) or left unbound (i.e. any source
is OK) */
if (YAP_IsVarTerm(t1)) orig = MPI_ANY_SOURCE;
else if( !YAP_IsIntTerm(t1) ) return false;
else orig = YAP_IntOfTerm(t1);
/* The second argument must be bound to an integer (the tag)
or left unbound (i.e. any tag is OK) */
if (YAP_IsVarTerm(t2)) tag = MPI_ANY_TAG;
else if( !YAP_IsIntTerm(t2) ) return false;
else tag = YAP_IntOfTerm( t2 );
CONT_TIMER();
// probe for term' size
if( MPI_CALL(MPI_Probe( orig, tag, MPI_COMM_WORLD, &status )) != MPI_SUCCESS) {
PAUSE_TIMER();
return false;
}
if( MPI_CALL(MPI_Get_count( &status, MPI_CHAR, &len )) != MPI_SUCCESS ||
status.MPI_TAG==MPI_UNDEFINED ||
status.MPI_SOURCE==MPI_UNDEFINED) {
PAUSE_TIMER();
return false;
}
//realloc memory buffer
change_buffer_size((size_t)(len+1));
BUFFER_LEN=len;
// Already know the source from MPI_Probe()
if( orig == MPI_ANY_SOURCE ) {
orig = status.MPI_SOURCE;
if( !YAP_Unify(t1, YAP_MkIntTerm(orig))) {
PAUSE_TIMER();
return false;
}
}
// Already know the tag from MPI_Probe()
if( tag == MPI_ANY_TAG ) {
tag = status.MPI_TAG;
if( !YAP_Unify(t2, YAP_MkIntTerm(status.MPI_TAG))) {
PAUSE_TIMER();
return false;
}
}
// Receive the message as a string
if( MPI_CALL(MPI_Recv( BUFFER_PTR, BUFFER_LEN, MPI_CHAR, orig, tag,
MPI_COMM_WORLD, &status )) != MPI_SUCCESS ) {
/* Getting in here should never happen; it means that the first
package (containing size) was sent properly, but there was a glitch with
the actual content! */
PAUSE_TIMER();
return false;
}
#ifdef DEBUG
write_msg(__FUNCTION__,__FILE__,__LINE__,"%s(%s,%u, MPI_CHAR,%d,%d)\n",__FUNCTION__,BUFFER_PTR, BUFFER_LEN, orig, tag);
#endif
MSG_RECV(BUFFER_LEN);
t4=string2term(BUFFER_PTR,&BUFFER_LEN);
PAUSE_TIMER();
return(YAP_Unify(YAP_ARG3,t4));
}
