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_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);
}
/*
* 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);
}
/*
* 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)));
}
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_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);
}
/*
* 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(+Root,+Data).
*/
static YAP_Bool
mpi_bcast(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1),
t2 = YAP_Deref(YAP_ARG2);
int root,val;
size_t len=0;
char *str;
int rank;
//The arguments should be bound
if(!YAP_IsIntTerm(t1)) {
return false;
}
MPI_CALL(MPI_Comm_rank(MPI_COMM_WORLD, &rank));
CONT_TIMER();
root = YAP_IntOfTerm(t1);
if (root == rank) {
str=term2string(NULL,&len,t2);
#ifdef DEBUG
write_msg(__FUNCTION__,__FILE__,__LINE__,"mpi_bcast(%s,%u, MPI_CHAR,%d)\n",str,len,root);
#endif
} else {
RESET_BUFFER();
str = BUFFER_PTR;
len = BLOCK_SIZE;
}
// send the data
val=(MPI_CALL(MPI_Bcast( str, len, MPI_CHAR, root, MPI_COMM_WORLD))==MPI_SUCCESS?true:false);
#ifdef MPISTATS
{
int size;
MPI_CALL(MPI_Comm_size(MPI_COMM_WORLD, &size));
MSG_SENT(len*size);
}
#endif
PAUSE_TIMER();
if (root != rank) {
YAP_Term out;
len=YAP_SizeOfExportedTerm(str);
// make sure we only fetch ARG3 after constructing the term
out = string2term(str,(size_t*)&len);
MSG_RECV(len);
if (!YAP_Unify(YAP_ARG2, out))
return false;
}
return(val);
}
/** 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)));
}
/*
* 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)));
}
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);
}
static
int
p_rl_mem_usage(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
if(!YAP_Unify(t1,YAP_MkIntTerm(memory_usage)) )
return (FALSE);
return(TRUE);
}
static
int
p_rl_b_in2(void) {
YAP_Term t1=YAP_Deref(YAP_ARG1);
IDTYPE id;
NUM val;
RL_Tree *tree;
YAP_PRESERVED_DATA(back_data,yap_back_data_type);
id = YAP_IntOfTerm(t1);
tree=ID2PTR(id);
val=YAP_IntOfTerm(back_data->last_solution);
val=rl_next_in_bigger(tree,val);
if ( val > 0 && YAP_Unify(YAP_Deref(YAP_ARG2),YAP_MkIntTerm(val))) {
back_data->last_solution=YAP_MkIntTerm(val);
return TRUE;
}
YAP_cut_fail();
return (FALSE);
}
/*
* 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.
* mpi_wait(+Handle,-Status).
*/
static YAP_Bool
mpi_wait(term_t YAP_ARG1,...) {
YAP_Term t1 = YAP_Deref(YAP_ARG1), // Handle
t2 = YAP_Deref(YAP_ARG2); // Status
MPI_Status status;
MPI_Request *handle;
// The first argument must be an integer (an handle)
if(!YAP_IsIntTerm(t1)) {
return false;
}
handle=INT2HANDLE(YAP_IntOfTerm(t1));
CONT_TIMER();
// probe for term' size
if( MPI_CALL(MPI_Wait( handle , &status )) != MPI_SUCCESS ) {
PAUSE_TIMER();
return false;
}
free_request(handle);
PAUSE_TIMER();
return(YAP_Unify(t2,YAP_MkIntTerm(status.MPI_ERROR)));
}
/*
* 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
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_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_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);
}
/*
* 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));
}