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)); }