static int
p_startmatlab(void)
{
char opts[BUFSIZE];
const char *ptr;
YAP_Term topts = YAP_ARG1;
if (Meng)
return TRUE;
if (YAP_IsAtomTerm(topts))
ptr = YAP_AtomName(YAP_AtomOfTerm(topts));
else
{
if (!YAP_StringToBuffer(topts,opts, BUFSIZE))
return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(-1));
ptr = opts;
}
if (!strlen(ptr)) {
if (!(Meng = engOpen("\0"))) {
return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(-2));
}
} else {
if (!(Meng = engOpen(ptr))) {
return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(-2));
}
}
engOutputBuffer(Meng, NULL, 0);
return TRUE;
}
static int
p_getrand(void)
{
return(YAP_Unify(YAP_ARG1,YAP_MkIntTerm(a1)) &&
YAP_Unify(YAP_ARG2,YAP_MkIntTerm(b1)) &&
YAP_Unify(YAP_ARG3,YAP_MkIntTerm(c1)));
}
/*
* Returns the major and minor version of MPI.
* mpi_version(-Major,-Minor).
*/
static YAP_Bool
mpi_version(term_t YAP_ARG1,...){
int major,minor;
MPI_CALL(MPI_Get_version(&major,&minor));
return (YAP_Unify(YAP_ARG1,YAP_MkIntTerm(major)) && YAP_Unify(YAP_ARG2,YAP_MkIntTerm(minor)));
}
/* Return time in a structure */
static YAP_Bool sysmktime(void) {
#if defined(__MINGW32__) || _MSC_VER
SYSTEMTIME stime, stime0;
FILETIME ftime, ftime0;
stime.wYear = YAP_IntOfTerm(YAP_ARG1);
stime.wMonth = YAP_IntOfTerm(YAP_ARG2);
stime.wDay = YAP_IntOfTerm(YAP_ARG3);
stime.wHour = YAP_IntOfTerm(YAP_ARG4);
stime.wMinute = YAP_IntOfTerm(YAP_ARG5);
stime.wSecond = YAP_IntOfTerm(YAP_ARG6);
stime.wMilliseconds = 0;
stime0.wYear = 1970;
stime0.wMonth = 1;
stime0.wDay = 1;
stime0.wHour = 12;
stime0.wMinute = 0;
stime0.wSecond = 0;
stime0.wMilliseconds = 0;
if (!SystemTimeToFileTime(&stime, &ftime)) {
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
}
if (!SystemTimeToFileTime(&stime0, &ftime0)) {
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
}
#if __GNUC__
{
unsigned long long f1 = (((unsigned long long)ftime.dwHighDateTime) << 32) +
(unsigned long long)ftime.dwLowDateTime;
unsigned long long f0 =
(((unsigned long long)ftime0.dwHighDateTime) << 32) +
(unsigned long long)ftime0.dwLowDateTime;
return YAP_Unify(YAP_ARG7, YAP_MkIntTerm((long int)((f1 - f0) / 10000000)));
}
#else
return FALSE;
#endif
#else
#ifdef HAVE_MKTIME
struct tm loc;
time_t tim;
loc.tm_year = YAP_IntOfTerm(YAP_ARG1) - 1900;
loc.tm_mon = YAP_IntOfTerm(YAP_ARG2) - 1;
loc.tm_mday = YAP_IntOfTerm(YAP_ARG3);
loc.tm_hour = YAP_IntOfTerm(YAP_ARG4);
loc.tm_min = YAP_IntOfTerm(YAP_ARG5);
loc.tm_sec = YAP_IntOfTerm(YAP_ARG6);
loc.tm_isdst = -1;
if ((tim = mktime(&loc)) == (time_t)-1) {
return YAP_Unify(YAP_ARG8, YAP_MkIntTerm(errno));
}
return YAP_Unify(YAP_ARG7, YAP_MkIntTerm(tim));
#else
oops
#endif /* HAVE_MKTIME */
#endif /* WINDOWS */
}
/** 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)));
}
/** @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 YAP_Bool host_id(void) {
#if HAVE_GETHOSTID
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(gethostid())));
#else
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(0)));
#endif
}
static YAP_Bool pid(void) {
#if defined(__MINGW32__) || _MSC_VER
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(_getpid())));
#else
return (YAP_Unify(YAP_ARG1, YAP_MkIntTerm(getpid())));
#endif
}
static YAP_Bool error_message(void) {
#if HAVE_STRERROR
return YAP_Unify(YAP_ARG2, YAP_MkAtomTerm(YAP_LookupAtom(
strerror(YAP_IntOfTerm(YAP_ARG1)))));
#else
return YAP_Unify(YAP_ARG2, YAP_ARG1);
#endif
}
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);
}
/* execute a command as a detached process */
static YAP_Bool do_shell(void) {
#if defined(__MINGW32__) || _MSC_VER
YAP_Error(0, 0L, "system not available in this configuration");
return (FALSE);
#elif HAVE_SYSTEM
char *buf = YAP_AllocSpaceFromYap(BUF_SIZE);
int sys;
if (buf == NULL) {
YAP_Error(0, 0L, "No Temporary Space for Shell");
return (FALSE);
}
#if HAVE_STRNCPY
strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)), BUF_SIZE);
strncpy(buf, " ", BUF_SIZE);
strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)), BUF_SIZE);
strncpy(buf, " ", BUF_SIZE);
strncpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)), BUF_SIZE);
#else
strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1)));
strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2)));
strcpy(buf, " ");
strcpy(buf, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3)));
#endif
sys = system(buf);
YAP_FreeSpaceFromYap(buf);
if (sys < 0) {
return YAP_Unify(YAP_ARG5, YAP_MkIntTerm(errno));
}
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys));
#else
char *cptr[4];
int t;
int sys;
cptr[0] = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
cptr[1] = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG2));
cptr[2] = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG3));
cptr[3] = NULL;
t = fork();
if (t < 0) {
return YAP_Unify(YAP_ARG5, YAP_MkIntTerm(errno));
} else if (t == 0) {
t = execvp(cptr[0], cptr);
return t;
} else {
t = wait(&sys);
if (t < 0) {
return YAP_Unify(YAP_ARG5, YAP_MkIntTerm(errno));
}
}
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(sys));
#endif
}
static int
cuda_coverage( void )
{
int32_t *mat;
#if defined(DATALOG) || defined(TUFFY)
int32_t *query = NULL;
setQuery(YAP_ARG1, &query);
#endif
int32_t n = Cuda_Eval(facts, cf, rules, cr, query, & mat, 0, 0);
int32_t post = YAP_AtomToInt(YAP_AtomOfTerm(YAP_ARG2));
int32_t i = n/2, min = 0, max = n-1;
int32_t t0, t1;
if (n < 0)
return FALSE;
if (n == 0) {
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(0)) &&
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(0));
}
t0 = mat[0], t1 = mat[(n-1)*2];
if (t0 == t1) { /* all sametype */
free( mat );
/* all pos */
if (t0 == post)
return YAP_Unify(YAP_ARG3, YAP_MkIntTerm(n)) &&
YAP_Unify(YAP_ARG4, YAP_MkIntTerm(0));
/* all neg */
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(n)) &&
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(0));
}
do {
i = (min+max)/2;
if (i == min) i++;
if (mat[i*2] == t0) {
min = i;
} else {
max = i;
}
if (min+1 == max) {
free( mat );
if (t0 == post)
return YAP_Unify(YAP_ARG3, YAP_MkIntTerm(max)) &&
YAP_Unify(YAP_ARG4, YAP_MkIntTerm(n-max));
/* all neg */
return YAP_Unify(YAP_ARG4, YAP_MkIntTerm(max)) &&
YAP_Unify(YAP_ARG3, YAP_MkIntTerm(n-max));
}
} while ( TRUE );
}
static YAP_Bool p_tmpdir(void) {
#if defined(__MINGW32__) || _MSC_VER
char buf[512];
DWORD out = GetTempPath(512, buf);
if (!out) {
return (YAP_Unify(YAP_ARG2, WinError()));
}
if (out > 511) {
char *nbuf = malloc(out + 1);
if (!nbuf)
return YAP_Unify(YAP_ARG2,
YAP_MkAtomTerm(YAP_LookupAtom("no malloc memory")));
out = GetTempPath(512, nbuf);
if (!out) {
return YAP_Unify(YAP_ARG2, WinError());
}
return YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(nbuf)));
}
return YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(buf)));
#else
char *s;
if ((s = getenv("TMPDIR")))
return YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(s)));
#ifdef P_tmpdir
return YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(P_tmpdir)));
#endif
return YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom("/tmp")));
#endif
}
/** @pred system(+ _S_)
Passes command _S_ to the Bourne shell (on UNIX environments) or the
current command interpreter in WIN32 environments.
Note that it executes them command as a detached process. It requires
`system` to be implemented by the system library.
*/
static YAP_Bool do_system(void) {
char *command = (char *)YAP_AtomName(YAP_AtomOfTerm(YAP_ARG1));
#if HAVE_SYSTEM
int sys = system(command);
if (sys < 0) {
return YAP_Unify(YAP_ARG3, YAP_MkIntTerm(errno));
}
return YAP_Unify(YAP_ARG2, YAP_MkIntTerm(sys));
#else
YAP_Error(0, 0L, "system not available in this configuration, trying %s",
command);
return FALSE;
#endif
}
static int p_itrie_max_stats(void) {
YAP_Int memory, tries, entries, nodes;
/* get stats */
itrie_max_stats(&memory, &tries, &entries, &nodes);
if (!YAP_Unify(arg_memory, YAP_MkIntTerm(memory)))
return FALSE;
if (!YAP_Unify(arg_tries, YAP_MkIntTerm(tries)))
return FALSE;
if (!YAP_Unify(arg_entries, YAP_MkIntTerm(entries)))
return FALSE;
if (!YAP_Unify(arg_nodes, YAP_MkIntTerm(nodes)))
return FALSE;
return TRUE;
}
static int
p_create_cell_matrix_and_copy1(void)
{
int rows, cols;
mxArray *mat;
YAP_Term tl = YAP_ARG3;
rows = YAP_IntOfTerm(YAP_ARG1);
cols = YAP_IntOfTerm(YAP_ARG2);
if (!(mat = mxCreateCellMatrix(rows, cols)))
return FALSE;
while (YAP_IsPairTerm(tl)) {
YAP_Term th = YAP_HeadOfTerm(tl);
int off = MAT_ACCESS(YAP_IntOfTerm(YAP_ArgOfTerm(1,th))-1,
YAP_IntOfTerm(YAP_ArgOfTerm(2,th))-1,
rows,cols);
mxArray *mat2 = get_array(YAP_ArgOfTerm(3,th));
mxSetCell(mat,off, mat2);
tl = YAP_TailOfTerm(tl);
}
if (YAP_IsAtomTerm(YAP_ARG4)) {
return !engPutVariable(Meng, YAP_AtomName(YAP_AtomOfTerm(YAP_ARG4)), mat);
}
return YAP_Unify(YAP_ARG4,address2term(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;
}
/* return YAP's environment */
static YAP_Bool p_environ(void) {
#if HAVE_ENVIRON && 0
#if HAVE__NSGETENVIRON
char **ptr = _NSGetEnviron();
#elif defined(__MINGW32__) || _MSC_VER
extern char **_environ;
char **ptr = _environ;
#else
extern char **environ;
char **ptr = environ;
#endif
YAP_Term t1 = YAP_ARG1;
long int i;
i = YAP_IntOfTerm(t1);
if (ptr[i] == NULL)
return (FALSE);
else {
YAP_Term t = YAP_BufferToString(ptr[i]);
return (YAP_Unify(t, YAP_ARG2));
}
#else
YAP_Error(0, 0L, "environ not available in this configuration");
return (FALSE);
#endif
}
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);
}
/*
* 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_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_get_variable(void)
{
YAP_Term t;
mxArray *mat;
const mwSize *dims;
int ndims;
mat = get_array(YAP_ARG1);
if (!mat)
return FALSE;
dims = mxGetDimensions(mat);
ndims = mxGetNumberOfDimensions(mat);
if (mxIsInt32(mat)) {
INT32_T *input = (INT32_T *)mxGetPr(mat);
t = cp_ints32(ndims, (int *)dims, input, 1, 0, YAP_TermNil());
} else if (mxIsInt64(mat)) {
INT64_T *input = (INT64_T *)mxGetPr(mat);
t = cp_ints64(ndims, (int *)dims, input, 1, 0, YAP_TermNil());
} else if (mxIsInt32(mat) || mxIsInt64(mat) || mxIsCell(mat)) {
t = cp_cells(ndims, (int *)dims, mat, 1, 0, YAP_TermNil());
} else if (mxIsDouble(mat)) {
double *input = mxGetPr(mat);
t = cp_floats(ndims, (int *)dims, input, 1, 0, YAP_TermNil());
} else {
return FALSE;
}
return YAP_Unify(YAP_ARG2, t);
}
static YAP_Bool equality(void) {
YAP_Term arg1, arg2, arg3, out;
int varIndex;
int value;
int i;
variable v;
DdNode *node, *tmp, *var;
arg1 = YAP_ARG1;
arg2 = YAP_ARG2;
arg3 = YAP_ARG3;
varIndex = YAP_IntOfTerm(arg1);
value = YAP_IntOfTerm(arg2);
v = vars_ex[ex][varIndex];
i = v.firstBoolVar;
tmp = Cudd_ReadOne(mgr_ex[ex]);
Cudd_Ref(tmp);
node = NULL;
for (i = v.firstBoolVar; i < v.firstBoolVar + value; i++) {
var = Cudd_bddIthVar(mgr_ex[ex], i);
node = Cudd_bddAnd(mgr_ex[ex], tmp, Cudd_Not(var));
Cudd_Ref(node);
Cudd_RecursiveDeref(mgr_ex[ex], tmp);
tmp = node;
}
if (!(value == v.nVal - 1)) {
var = Cudd_bddIthVar(mgr_ex[ex], v.firstBoolVar + value);
node = Cudd_bddAnd(mgr_ex[ex], tmp, var);
Cudd_Ref(node);
Cudd_RecursiveDeref(mgr_ex[ex], tmp);
}
out = YAP_MkIntTerm((YAP_Int)node);
return (YAP_Unify(out, arg3));
}
static YAP_Bool
mpi_get_processor_name(term_t YAP_ARG1,...) {
char name[MPI_MAX_PROCESSOR_NAME];
int length;
MPI_CALL(MPI_Get_processor_name(name,&length));
return (YAP_Unify(YAP_ARG1,YAP_MkAtomTerm(YAP_LookupAtom(name))));
}
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);
}
/** md5( +Text, -Key, -Remaining keyq
* encode text using OpenSSL
*
* arg Text is a List of ASCII codes
* arg2 and 3: difference list with the character codes for the
* digest.
*
* @return whether ARG1's md5 unifies with the difference liat.
*/
static YAP_Bool md5(void) {
unsigned char buf[64];
md5_state_t pms;
const char *s;
size_t len = -1;
if (!(s = YAP_StringToBuffer(YAP_ARG1, NULL, len)) || s[0] == 0)
return false;
md5_init(&pms);
md5_append(&pms, (const unsigned char *)s, strlen(s));
md5_finish(&pms, buf);
// free((void *)s);
YAP_Term t = YAP_ARG3;
int i = 16;
while (i > 0) {
int top, bop;
i--;
top = buf[i] >> 4;
if (top > 9)
top = (top - 10) + 'a';
else
top = top + '0';
bop = buf[i] & 15;
if (bop > 9)
bop = (bop - 10) + 'a';
else
bop = bop + '0';
t = YAP_MkPairTerm(YAP_MkIntTerm(top),
YAP_MkPairTerm(YAP_MkIntTerm(bop), t));
}
return YAP_Unify(YAP_ARG2, t);
}
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_itrie_usage(void) {
YAP_Int entries, nodes, virtualnodes;
/* check arg */
if (!YAP_IsIntTerm(arg_itrie))
return FALSE;
/* get itrie usage */
itrie_usage((TrEntry) YAP_IntOfTerm(arg_itrie), &entries, &nodes, &virtualnodes);
if (!YAP_Unify(arg_entries, YAP_MkIntTerm(entries)))
return FALSE;
if (!YAP_Unify(arg_nodes, YAP_MkIntTerm(nodes)))
return FALSE;
if (!YAP_Unify(arg_virtualnodes, YAP_MkIntTerm(virtualnodes)))
return FALSE;
return TRUE;
}
static YAP_Bool host_name(void) {
#if defined(__MINGW32__) || _MSC_VER
char name[MAX_COMPUTERNAME_LENGTH + 1];
DWORD nSize = MAX_COMPUTERNAME_LENGTH + 1;
if (GetComputerName(name, &nSize) == 0) {
return (YAP_Unify(YAP_ARG2, WinError()));
}
#else
#if HAVE_GETHOSTNAME
char name[256];
if (gethostname(name, 256) == -1) {
/* return an error number */
return (YAP_Unify(YAP_ARG2, YAP_MkIntTerm(errno)));
}
#endif
#endif /* defined(__MINGW32__) || _MSC_VER */
return (YAP_Unify(YAP_ARG1, YAP_MkAtomTerm(YAP_LookupAtom(name))));
}
