/** @pred optimizer_set_g(+I,+G) Set the current value for `g[I]` (the
partial derivative of _F_ with respect to `x[I]`). Can only be called
from the evaluate call back predicate.
*/
static int set_g_value(void) {
YAP_Term t1=YAP_ARG1;
YAP_Term t2=YAP_ARG2;
int i=0;
if (optimizer_status != OPTIMIZER_STATUS_CB_EVAL) {
printf("ERROR: optimizer_set_g/2 can only be called by the evaluation call back function.\n");
return FALSE;
}
if (YAP_IsIntTerm(t1)) {
i=YAP_IntOfTerm(t1);
} else {
return FALSE;
}
if (i<0 || i>=n) {
return FALSE;
}
if (YAP_IsFloatTerm(t2)) {
g[i]=(lbfgsfloatval_t) YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
g[i]=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
return TRUE;
}
static mxArray*
get_array(YAP_Term ti)
{
if (YAP_IsIntTerm(ti)) {
return mxCreateDoubleScalar(YAP_IntOfTerm(ti));
} else if (YAP_IsFloatTerm(ti)) {
return mxCreateDoubleScalar(YAP_FloatOfTerm(ti));
} else if (YAP_IsAtomTerm(ti)) {
return matlab_getvar(ti);
} else if (YAP_IsPairTerm(ti)) {
YAP_Term tv = YAP_HeadOfTerm(ti);
YAP_Term tf = YAP_TailOfTerm(ti);
const mxArray *mout;
if (!YAP_IsAtomTerm(tv)) {
char s[BUFSIZE];
if (!YAP_StringToBuffer(ti, s, BUFSIZE))
return FALSE;
return mxCreateString(s);
}
mout = matlab_getvar(tv);
if (!mout)
return FALSE;
if (YAP_IsIntTerm(tf)) {
return mxGetFieldByNumber(mout, 0, YAP_IntOfTerm(tf));
} else if (YAP_IsAtomTerm(tf)) {
const char *s=YAP_AtomName(YAP_AtomOfTerm(tf));
return mxGetField(mout, 0, s);
} else {
return NULL;
}
} else {
return (mxArray *)YAP_IntOfTerm(YAP_ArgOfTerm(1,ti));
}
}
/** @pred optimizer_set_x(+I,+X)
Set the current value for `x[I]`. Only possible when the optimizer is
initialized but not running.
*/
static int set_x_value(void) {
YAP_Term t1=YAP_ARG1;
YAP_Term t2=YAP_ARG2;
int i=0;
if (optimizer_status!=OPTIMIZER_STATUS_INITIALIZED) {
printf("ERROR: set_x_value/2 can be called only when the optimizer is initialized and not running.\n");
return FALSE;
}
if (YAP_IsIntTerm(t1)) {
i=YAP_IntOfTerm(t1);
} else {
return FALSE;
}
if (i<0 || i>=n) {
printf("ERROR: invalid index for set_x_value/2.\n");
return FALSE;
}
if (YAP_IsFloatTerm(t2)) {
x[i]=(lbfgsfloatval_t) YAP_FloatOfTerm(t2);
} else if (YAP_IsIntTerm(t2)) {
x[i]=(lbfgsfloatval_t) YAP_IntOfTerm(t2);
} else {
return FALSE;
}
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);
}
/*
* 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_intersect(void) {
/* check args */
if (!YAP_IsIntTerm(arg_itrie_dest))
return FALSE;
if (!YAP_IsIntTerm(arg_itrie_source))
return FALSE;
/* intersect itrie */
itrie_intersect((TrEntry) YAP_IntOfTerm(arg_itrie_dest), (TrEntry) YAP_IntOfTerm(arg_itrie_source));
return TRUE;
}
static int p_trie_join(void) {
/* check args */
if (!YAP_IsIntTerm(arg_trie_dest))
return FALSE;
if (!YAP_IsIntTerm(arg_trie_source))
return FALSE;
/* join trie */
trie_join((TrEntry) YAP_IntOfTerm(arg_trie_dest), (TrEntry) YAP_IntOfTerm(arg_trie_source));
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_count_join(void) {
YAP_Int entries;
/* check args */
if (!YAP_IsIntTerm(arg_trie1))
return FALSE;
if (!YAP_IsIntTerm(arg_trie2))
return FALSE;
/* count join trie */
entries = trie_count_join((TrEntry) YAP_IntOfTerm(arg_trie1), (TrEntry) YAP_IntOfTerm(arg_trie2));
return YAP_Unify(arg_entries, YAP_MkIntTerm(entries));
}
static int p_itrie_count_intersect(void) {
YAP_Int entries;
/* check args */
if (!YAP_IsIntTerm(arg_itrie1))
return FALSE;
if (!YAP_IsIntTerm(arg_itrie2))
return FALSE;
/* count intersect itrie */
entries = itrie_count_intersect((TrEntry) YAP_IntOfTerm(arg_itrie1), (TrEntry) YAP_IntOfTerm(arg_itrie2));
return YAP_Unify(arg_entries, YAP_MkIntTerm(entries));
}
/*
* Provides information regarding a handle, ie. if a communication operation has been completed.
* If the operation has been completed the predicate succeeds with the completion status,
* otherwise it fails.
*
* mpi_test(+Handle,-Status,-Data).
*/
static YAP_Bool
mpi_test_recv(void) {
YAP_Term t1 = YAP_Deref(YAP_ARG1); // data
MPI_Status status;
MPI_Request *handle;
int flag,len,ret;
char *s;
YAP_Term out;
// The first argument (handle) must be an integer
if(!YAP_IsIntTerm(t1)) {
return false;
}
CONT_TIMER();
handle=INT2HANDLE(YAP_IntOfTerm(t1));
//
if( MPI_CALL(MPI_Test( handle , &flag, &status ))!=MPI_SUCCESS) {
PAUSE_TIMER();
return false;
}
s=(char*)get_request(handle);
len=strlen(s);
out = string2term(s,(size_t*)&len);
// make sure we only fetch ARG3 after constructing the term
ret=YAP_Unify(YAP_ARG3,out);
free_request(handle);
PAUSE_TIMER();
return(ret & YAP_Unify(YAP_ARG2,YAP_MkIntTerm(status.MPI_ERROR)));
}
/** @pred optimizer_initialize(+N,+Module,+Evaluate,+Progress)
Create space to optimize a function with _N_ variables (_N_ has to be
integer).
+ _Module</span>_ is the name of the module where the call back
predicates can be found,
+ _Evaluate_ is the call back predicate (arity 3)
to evaluate the function math <span class="math">_F</span>_,
+ _Progress_ is the call back predicate invoked
(arity 8) after every iteration
Example
~~~~
optimizer_initialize(1,user,evaluate,progress)</span>
~~~~
The evaluate call back predicate has to be of the type
`evaluate(-F,+N,+Step)`. It has to calculate the current function
value _F_. _N_ is the
size of the parameter vector (the value which was used to initialize
LBFGS) and _Step_ is the current state of the
line search. The call back predicate can access the current values of
`x[i]` by calling `optimizer_get_x(+I,-Xi)`. Finally, the call back
predicate has to calculate the gradient of _F</span>_
and set its value by calling `optimizer_set_g(+I,+Gi)` for every `1<=I<=N`.
The progress call back predicate has to be of the type
`progress(+F,+X_Norm,+G_Norm,+Step,+N,+Iteration,+LS,-Continue)`. It
is called after every iteration. The call back predicate can access
the current values of _X_ and of the gradient by calling
`optimizer_get_x(+I,-Xi)` and `optimizer_get_g`(+I,-Gi)`
respectively. However, it must not call the setter predicates for <span
class="code"_X_ or _G_. If it tries to do so, the optimizer will
terminate with an error. If _Continue_ is set to 0 (int) the
optimization process will continue for one more iteration, any other
value will terminate the optimization process.
*/
static int optimizer_initialize(void) {
YAP_Term t1 = YAP_ARG1;
int temp_n=0;
if (optimizer_status!=OPTIMIZER_STATUS_NONE) {
printf("ERROR: Optimizer has already been initialized. Please call optimizer_finalize/0 first.\n");
return FALSE;
}
if (! YAP_IsIntTerm(t1)) {
return FALSE;
}
temp_n=YAP_IntOfTerm(t1);
if (temp_n<1) {
return FALSE;
}
x = lbfgs_malloc(temp_n);
if (x == NULL) {
printf("ERROR: Failed to allocate a memory block for variables.\n");
return FALSE;
}
n=temp_n;
optimizer_status=OPTIMIZER_STATUS_INITIALIZED;
return TRUE;
}
static int p_trie_traverse_init(void) {
TrData data;
/* check args */
if (!YAP_IsIntTerm(arg_trie))
return FALSE;
if (!YAP_IsIntTerm(arg_init_ref))
return FALSE;
/* traverse trie */
if (!(data = trie_traverse_init((TrEntry) YAP_IntOfTerm(arg_trie), (TrData) YAP_IntOfTerm(arg_init_ref)))) {
YAP_cut_fail();
return FALSE;
}
return YAP_Unify(arg_ref, YAP_MkIntTerm((YAP_Int) data));
}
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);
}
}
/*
* mpi_test(+Handle,-Status)
*
* Provides information regarding a handle, ie. if a communication operation has been completed.
* If the operation has been completed the predicate succeeds with the completion status,
* otherwise it fails.
* ).
*/
static YAP_Bool
mpi_test(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1), // Handle
t2 = YAP_Deref(YAP_ARG2); // Status
MPI_Status status;
MPI_Request *handle;
int flag;
// The first argument (handle) must be an integer
if(!YAP_IsIntTerm(t1)) {
return false;
}
CONT_TIMER();
handle=INT2HANDLE(YAP_IntOfTerm(t1));
//
MPI_CALL(MPI_Test( handle , &flag, &status ));
if( flag != true ) {
PAUSE_TIMER();
return false;
}
free_request(handle);
PAUSE_TIMER();
return(YAP_Unify(t2,YAP_MkIntTerm(status.MPI_ERROR)));
}
/** mpi_wait(+Handle,-Status,-Data
*
* Completes a non-blocking operation. IF the operation was a send, the
* function waits until the message is buffered or sent by the runtime
* system. At this point the send buffer is released. If the operation
* was a receive, it waits until the message is copied to the receive
* buffer.
* .
*/
static YAP_Bool
mpi_wait_recv(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1); // data
MPI_Status status;
MPI_Request *handle;
char *s;
int ret;
size_t len;
YAP_Term out;
// The first argument (handle) must be an integer
if(!YAP_IsIntTerm(t1)) {
return false;
}
CONT_TIMER();
handle=INT2HANDLE(YAP_IntOfTerm(t1));
s=(char*)get_request(handle);
// wait for communication completion
if( MPI_CALL(MPI_Wait( handle , &status )) != MPI_SUCCESS) {
PAUSE_TIMER();
return false;
}
len=YAP_SizeOfExportedTerm(s);
// make sure we only fetch ARG3 after constructing the term
out = string2term(s,(size_t*)&len);
MSG_RECV(len);
free_request(handle);
PAUSE_TIMER();
ret=YAP_Unify(YAP_ARG3,out);
return(ret & YAP_Unify(YAP_ARG2,YAP_MkIntTerm(status.MPI_ERROR)));
}
static int p_itrie_get_data(void) {
YAP_Term list;
YAP_Term item;
YAP_Functor f;
YAP_Int pos, neg, time;
/* check arg */
if (!YAP_IsIntTerm(arg_ref))
return FALSE;
/* get data */
itrie_get_data((TrData) YAP_IntOfTerm(arg_ref), &pos, &neg, &time);
list = YAP_MkAtomTerm(YAP_LookupAtom("[]"));
f = YAP_MkFunctor(YAP_LookupAtom("timestamp"), 1);
item = YAP_MkIntTerm(time);
item = YAP_MkApplTerm(f, 1, &item);
list = YAP_MkPairTerm(item, list);
f = YAP_MkFunctor(YAP_LookupAtom("neg"), 1);
item = YAP_MkIntTerm(neg);
item = YAP_MkApplTerm(f, 1, &item);
list = YAP_MkPairTerm(item, list);
f = YAP_MkFunctor(YAP_LookupAtom("pos"), 1);
item = YAP_MkIntTerm(pos);
item = YAP_MkApplTerm(f, 1, &item);
list = YAP_MkPairTerm(item, list);
return YAP_Unify(arg_data, list);
}
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 p_trie_close(void) {
/* check arg */
if (!YAP_IsIntTerm(arg_trie))
return FALSE;
/* close trie */
trie_close((TrEntry) YAP_IntOfTerm(arg_trie));
return TRUE;
}
static int p_itrie_print(void) {
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* print itrie */
itrie_print((TrEntry) YAP_IntOfTerm(arg_itrie));
return TRUE;
}
static int p_trie_remove_entry(void) {
/* check arg */
if (!YAP_IsIntTerm(arg_ref))
return FALSE;
/* remove trie entry */
trie_remove_entry((TrData) YAP_IntOfTerm(arg_ref));
return TRUE;
}
static int p_itrie_update_entry(void) {
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* update entry */
itrie_update_entry((TrEntry) YAP_IntOfTerm(arg_itrie), arg_entry);
return TRUE;
}
static int p_itrie_remove_subtree(void) {
/* check arg */
if (!YAP_IsIntTerm(arg_ref))
return FALSE;
/* remove subtree */
itrie_remove_subtree((TrData) YAP_IntOfTerm(arg_ref));
return TRUE;
}
static int p_trie_put_entry(void) {
TrData data;
/* check args */
if (!YAP_IsIntTerm(arg_trie))
return FALSE;
/* put trie entry */
data = trie_put_entry((TrEntry) YAP_IntOfTerm(arg_trie), arg_entry);
return YAP_Unify(arg_ref, YAP_MkIntTerm((YAP_Int) data));
}
static int p_itrie_get_entry(void) {
YAP_Term entry;
/* check arg */
if (!YAP_IsIntTerm(arg_ref))
return FALSE;
/* get entry */
entry = itrie_get_entry((TrData) YAP_IntOfTerm(arg_ref));
return YAP_Unify(arg_entry, entry);
}
static int p_itrie_check_entry(void) {
TrData data;
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* check entry */
if (!(data = itrie_check_entry((TrEntry) YAP_IntOfTerm(arg_itrie), arg_entry)))
return FALSE;
return YAP_Unify(arg_ref, YAP_MkIntTerm((YAP_Int) data));
}
static int p_trie_get_first_entry(void) {
TrData data;
/* check args */
if (!YAP_IsIntTerm(arg_trie))
return FALSE;
/* get first trie entry */
if (!(data = trie_get_first_entry((TrEntry) YAP_IntOfTerm(arg_trie))))
return FALSE;
return YAP_Unify(arg_ref, YAP_MkIntTerm((YAP_Int) data));
}
/*
* 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
}