/*
Input:
Arg1: +Substr
Arg2: + String
Arg3: +forward/reverse (checks only f/r)
f means the first match from the start of String
r means the first match from the end of String
Output:
Arg4: Beg
Beg is the offset where Substr matches. Must be a variable or an
integer
Arg5: End
End is the offset of the next character after the end of Substr
Must be a variable or an integer.
Both Beg and End can be negative, in which case they represent the offset
from the 2nd character past the end of String.
For instance, -1 means the next character past the end of String,
so End = -1 means that Substr must be a suffix of String..
The meaning of End and of negative offsets is consistent with substring
and string_substitute predicates.
*/
xsbBool str_match(CTXTdecl)
{
static char *subptr, *stringptr, *direction, *matchptr;
static int substr_beg, substr_end;
int reverse=TRUE; /* search in reverse */
int beg_bos_offset=TRUE; /* measure beg offset from the beg of string */
int end_bos_offset=TRUE; /* measure end offset from the beg of string */
int str_len, sub_len; /* length of string and substring */
Cell beg_offset_term, end_offset_term;
term = ptoc_tag(CTXTc 1);
term2 = ptoc_tag(CTXTc 2);
term3 = ptoc_tag(CTXTc 3);
beg_offset_term = ptoc_tag(CTXTc 4);
end_offset_term = ptoc_tag(CTXTc 5);
if (!isatom(term) || !isatom(term2) || !isatom(term3)) {
xsb_abort("STR_MATCH: Arguments 1,2,3 must be bound to strings");
}
subptr = string_val(term);
stringptr = string_val(term2);
direction = string_val(term3);
if (*direction == 'f')
reverse=FALSE;
else if (*direction != 'r')
xsb_abort("STR_MATCH: Argument 3 must be bound to forward/reverse");
str_len=strlen(stringptr);
sub_len=strlen(subptr);
if (isinteger(beg_offset_term)|isboxedinteger(beg_offset_term)) {
if (int_val(beg_offset_term) < 0) {
beg_bos_offset = FALSE;
}
}
if (isinteger(end_offset_term)|isboxedinteger(end_offset_term)) {
if (int_val(end_offset_term) < 0) {
end_bos_offset = FALSE;
}
}
if (reverse)
matchptr = xsb_strrstr(stringptr, subptr);
else
matchptr = strstr(stringptr, subptr);
if (matchptr == NULL) return FALSE;
substr_beg = (beg_bos_offset?
matchptr - stringptr : -(str_len - (matchptr - stringptr))
);
substr_end = (end_bos_offset?
(matchptr - stringptr) + sub_len
: -(str_len + 1 - (matchptr - stringptr) - sub_len)
);
return
(p2p_unify(CTXTc beg_offset_term, makeint(substr_beg))
&& p2p_unify(CTXTc end_offset_term, makeint(substr_end)));
}
static void actionphase() {
int num,i,j;
int list[MAXCARD];
char s[MAXSMALLS];
while(cur->action && (num=countcardsmask(TYPE_ACTION))) {
printf("type 1 to %d to play an action card or 0 to skip.\n",num);
for(i=j=0;i<cur->handn;i++)
if(card[player[currentplayer].hand[i]].type&TYPE_ACTION) {
list[j]=i;
printf(" %d. %s\n",++j,card[player[currentplayer].hand[i]].fullname);
}
while(1) {
scanf(scans,s);
if(isinteger(s)) {
j=strtol(s,0,10);
if(!j) return;
else {
playcard(cur->hand[list[j-1]]);
cur->action--;
movecard(list[j-1],cur->hand,&cur->handn,cur->playarea,&cur->playarean);
break;
}
}
}
}
}
static int
mp_add_to_form(const char *name, size_t nlen,
const char *value, size_t len,
const char *file, void *closure)
{ term_t head = PL_new_term_ref();
term_t tail = (term_t) closure;
term_t val = PL_new_term_ref();
long vl;
double vf;
int rc;
atom_t aname = 0;
if ( isinteger(value, &vl, len) )
rc = PL_put_integer(val, vl);
else if ( isfloat(value, &vf, len) )
rc = PL_put_float(val, vf);
else
rc = PL_unify_chars(val, PL_ATOM|REP_UTF8, len, value);
rc = ( rc &&
PL_unify_list(tail, head, tail) &&
(aname = PL_new_atom_nchars(nlen, name)) &&
PL_unify_term(head,
PL_FUNCTOR, PL_new_functor(aname, 1),
PL_TERM, val) );
if ( aname )
PL_unregister_atom(aname);
return rc;
}
bool CFileSizeFilter::UpdateData(bool /*SaveAndValidate*/)
{
CString Temp;
m_FilterType = m_FileSizeFilterForm.m_FilterTypeControl.GetCurSel();
m_FileSizeFilterForm.m_Value1Control.GetWindowText(Temp);
if ( !isinteger(Temp) )
return false;
m_Value1 = _ttol(Temp);
m_FileSizeFilterForm.m_Value2Control.GetWindowText(Temp);
if ( !isinteger(Temp) )
return false;
m_Value2 = _ttol(Temp);
return true;
}
void Handlers::request(
http_connection::weak_pointer weak_ptr,
via::http::rx_request const& request,
std::string const& body)
{
//std::cout << "\n\nRx request: " << request.uri() << std::endl;
//std::cout << "Rx body: " << body << std::endl;
http_connection::shared_pointer connection(weak_ptr.lock());
if (connection)
{
UrlParser url(request.uri());
//std::cout << url.command << std::endl;
if (url.command == "img.jpg")
{
int k=0;
if (url.query_key == "prev") {
if (url.query_value.empty() || !isinteger(url.query_value, &k)) {
k = 0;
}
}
auto resp = getGETResponse(k);
connection->send(std::move(resp.first), std::move(resp.second));
}
else {
std::ifstream t(configPath + "index.html");
if (t)
{
std::string str(
(std::istreambuf_iterator<char>(t)),
std::istreambuf_iterator<char>());
via::http::tx_response response(via::http::response_status::code::OK);
response.add_server_header();
response.add_date_header();
response.add_header("Content-Type", "text/html");
response.add_header("charset", "utf-8");
response.add_content_length_header(str.size());
connection->send(response, str);
////std::cout << str << std::endl;
}
else {
via::http::tx_response response(via::http::response_status::code::NOT_FOUND);
connection->send(response, "Index Not Found");
//std::cout << "index not found" << std::endl;
}
}
}
else {
console->error("Failed to lock http_connection::weak_pointer");
}
}
/**
* Test if all elements in an array can be interpreted as integers.
*/
bool isallinteger(const mxArray* arr) {
if (mxIsCell(arr)) {
mexErrMsgIdAndTxt(__ARGTYPEMISMATCH__, "Cell arrays are not supported.");
return false;
} else if (mxIsStruct(arr)) {
mexErrMsgIdAndTxt(__ARGTYPEMISMATCH__, "Structure arrays are not supported.");
return false;
} else if (mxIsSparse(arr)) {
mexErrMsgIdAndTxt(__ARGTYPEMISMATCH__, "Sparse integer arrays are not supported.");
return false;
} else {
mwSize n = mxGetNumberOfElements(arr);
const double* pr = mxGetPr(arr);
const double* pi = mxGetPi(arr);
mwSize i;
if (pr == NULL) {
mexErrMsgIdAndTxt(__ARGTYPEMISMATCH__, "Operation supported only on numeric arrays.");
}
if (pi != NULL) { /* real and imaginary part */
for (i = 0; i < n; i++) {
if (!isinteger(*(pr++)) || !isinteger(*(pi++))) {
return false;
}
}
} else { /* real part only */
for (i = 0; i < n; i++) {
if (!isinteger(*(pr++))) {
return false;
}
}
}
return true;
}
}
/* get the size of the list input from prolog side */
static int getsize (prolog_term list)
{
int size = 0;
prolog_term head;
while (!isnil(list)) {
head = p2p_car(list);
if(!(isinteger(head)))
xsb_abort("A non-integer socket descriptor encountered in a socket operation");
list = p2p_cdr(list);
size++;
}
return size;
}
void
factor(void)
{
save();
p2 = pop();
p1 = pop();
if (isinteger(p1)) {
push(p1);
factor_number(); // see pollard.cpp
} else {
push(p1);
push(p2);
factorpoly();
}
restore();
}
static void buyphase() {
int num,i,j,pid,id;
int list[MAXCARD];
char s[MAXSMALLS];
while((num=countcardsmask(TYPE_TREASURE))) {
printf("type 1 to %d to play a treasure card or 0 to skip.\n",num);
for(i=j=0;i<cur->handn;i++)
if(card[player[currentplayer].hand[i]].type&TYPE_TREASURE) {
list[j]=i;
printf(" %d. %s\n",++j,card[player[currentplayer].hand[i]].fullname);
}
while(1) {
scanf(scans,s);
if(isinteger(s)) {
j=strtol(s,0,10);
if(!j) goto buy;
else {
playcard(cur->hand[list[j-1]]);
movecard(list[j-1],cur->hand,&cur->handn,cur->playarea,&cur->playarean);
break;
}
}
}
}
buy:
/* the rules for prosperity clarifies the following: it's not allowed to play
treasure cards after buying a card! so no playing copper after buying grand
market. */
/* TODO take into account cards that change the money values, for
example increasing copper value by 1 */
while(player[currentplayer].buy) {
printf("you have %d money, %d potions and %d buys!\n",player[currentplayer].money,player[currentplayer].potion,player[currentplayer].buy);
if((pid=choosepiletogain(currentplayer,0,player[currentplayer].money,0,player[currentplayer].potion))>-1) {
id=pile[pid].card[pile[pid].cards-1];
player[currentplayer].buy--;
player[currentplayer].money-=money_cost_L(id);
player[currentplayer].potion-=potion_cost_L(id);
gaincardfromsupply(pid,currentplayer);
} else break;
}
}
bool CFilenameLayer::UpdateData(bool /*SaveAndValidate*/)
{
bool GoodData = true;
CString sTemp;
// get data from dialog
m_CaseSensitive = m_FilenameLayerForm.m_CaseSensitive.GetCheck() == BST_CHECKED;
m_FilenameMatchMode = m_FilenameLayerForm.GetCheckedRadioButton(IDC_MATCH_FILENAMES,IDC_MATCH_WORDS) ;
m_FilenameLayerForm.m_WordCountCtrl.GetWindowText(sTemp);
m_WordCount = _ttoi(sTemp);
//
// validate data
switch ( m_FilenameMatchMode )
{
case IDC_MATCH_FILENAMES:
case IDC_MATCH_NOT_FILENAME:
case IDC_MATCH_EXTENSIONS:
case IDC_MATCH_NOT_EXTENSIONS:
case IDC_MATCH_WORDS:
GoodData = true;
break;
default:
GoodData = false;
break;
}
if ( m_WordCount < 1 || m_WordCount > MAX_PATH )
GoodData = false;
if ( ! isinteger(sTemp) )
GoodData = false;
//
// return result
return GoodData;
//
}
/***************************************************************************//**
* @author Hayden Waisanen
*
* @par Description:
* This function creates a socket for the specifed ip address and port.
* Modified version of the example code given in class.
*
* @par Class:
* Reroute
*
* @param[in] string ip
* @param[in] string port
*
* @returns int - socket file descriptor
*
******************************************************************************/
int Reroute::createSocket(string ip, string port)
{
int sockfd = 0;
struct sockaddr_in serv_addr;
//Check if the port is an integer
if(!isinteger(port))
{
cout << "Port must be an integer" << endl;
return -1;
}
if((sockfd = socket(AF_INET, SOCK_STREAM, 0)) < 0)
{
cout << "\n Error : Could not create socket \n" << endl;
return -1;
}
//Zero out serv_addr
memset(&serv_addr, '0', sizeof(serv_addr));
serv_addr.sin_family = AF_INET;
serv_addr.sin_port = htons(stringToInt(port));
if(inet_pton(AF_INET, ip.c_str(), &serv_addr.sin_addr)<=0)
{
cout << "\n inet_pton error occured" << endl;
return -1;
}
if( connect(sockfd, (struct sockaddr *)&serv_addr, sizeof(serv_addr)) < 0)
{
cout << "\n Error : Connect Failed" << endl;
return -1;
}
return sockfd;
}
/***************************************************************************//**
* @author Hayden Waisanen
*
* @par Description:
* This function creates a server socket listener file descriptor in order
* to output to a client application. It listens on the specified port.
*
* Modified for example code given in class
*
* @par Class:
* Reroute
*
* @param[in] string port - Port to output to
*
* @returns int - connection file descriptor
*
******************************************************************************/
int Reroute::listenForSocket(string port)
{
int listenfd = 0, connfd = 0;
int sockopt = 1;
struct sockaddr_in serv_addr;
//Check if port is an integer
if(!isinteger(port))
{
cout << "Port must be an integer" << endl;
return -1;
}
listenfd = socket(AF_INET, SOCK_STREAM, 0);
setsockopt(listenfd, SOL_SOCKET, SO_REUSEADDR, &sockopt, sizeof(int));
memset(&serv_addr, '0', sizeof(serv_addr));
serv_addr.sin_family = AF_INET;
serv_addr.sin_addr.s_addr = htonl(INADDR_ANY);
serv_addr.sin_port = htons(stringToInt(port));
if(bind(listenfd, (struct sockaddr*)&serv_addr, sizeof(serv_addr)) == -1)
{
perror("Error");
cout << endl;
return -1;
}
listen(listenfd, 10);
//Wait for a connection
connfd = accept(listenfd, (struct sockaddr*)NULL, NULL);
return connfd;
}
void
yyfloor(void)
{
double d;
p1 = pop();
if (!isnum(p1)) {
push_symbol(FLOOR);
push(p1);
list(2);
return;
}
if (isdouble(p1)) {
d = floor(p1->u.d);
push_double(d);
return;
}
if (isinteger(p1)) {
push(p1);
return;
}
p3 = alloc();
p3->k = NUM;
p3->u.q.a = mdiv(p1->u.q.a, p1->u.q.b);
p3->u.q.b = mint(1);
push(p3);
if (isnegativenumber(p1)) {
push_integer(-1);
add();
}
}
int
pop_integer(void)
{
int n;
save();
p1 = pop();
switch (p1->k) {
case NUM:
if (isinteger(p1) && MLENGTH(p1->u.q.a) == 1) {
n = p1->u.q.a[0];
if (n & 0x80000000)
n = 0x80000000;
else
n *= MSIGN(p1->u.q.a);
} else
n = 0x80000000;
break;
case DOUBLE:
n = (int) p1->u.d;
if ((double) n != p1->u.d)
n = 0x80000000;
break;
default:
n = 0x80000000;
break;
}
restore();
return n;
}
void
yypower(void)
{
int n;
p2 = pop();
p1 = pop();
// both base and exponent are rational numbers?
if (isrational(p1) && isrational(p2)) {
push(p1);
push(p2);
qpow();
return;
}
// both base and exponent are either rational or double?
if (isnum(p1) && isnum(p2)) {
push(p1);
push(p2);
dpow();
return;
}
if (istensor(p1)) {
power_tensor();
return;
}
if (p1 == symbol(E) && car(p2) == symbol(LOG)) {
push(cadr(p2));
return;
}
if (p1 == symbol(E) && isdouble(p2)) {
push_double(exp(p2->u.d));
return;
}
// 1 ^ a -> 1
// a ^ 0 -> 1
if (equal(p1, one) || iszero(p2)) {
push(one);
return;
}
// a ^ 1 -> a
if (equal(p2, one)) {
push(p1);
return;
}
// (a * b) ^ c -> (a ^ c) * (b ^ c)
if (car(p1) == symbol(MULTIPLY)) {
p1 = cdr(p1);
push(car(p1));
push(p2);
power();
p1 = cdr(p1);
while (iscons(p1)) {
push(car(p1));
push(p2);
power();
multiply();
p1 = cdr(p1);
}
return;
}
// (a ^ b) ^ c -> a ^ (b * c)
if (car(p1) == symbol(POWER)) {
push(cadr(p1));
push(caddr(p1));
push(p2);
multiply();
power();
return;
}
// (a + b) ^ n -> (a + b) * (a + b) ...
if (expanding && isadd(p1) && isnum(p2)) {
push(p2);
n = pop_integer();
// this && n != 0x80000000 added by DDC
// as it's not always the case that 0x80000000
// is negative
if (n > 1 && n != 0x80000000) {
power_sum(n);
return;
}
}
// sin(x) ^ 2n -> (1 - cos(x) ^ 2) ^ n
if (trigmode == 1 && car(p1) == symbol(SIN) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
cosine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// cos(x) ^ 2n -> (1 - sin(x) ^ 2) ^ n
if (trigmode == 2 && car(p1) == symbol(COS) && iseveninteger(p2)) {
push_integer(1);
push(cadr(p1));
sine();
push_integer(2);
power();
subtract();
push(p2);
push_rational(1, 2);
multiply();
power();
return;
}
// complex number? (just number, not expression)
if (iscomplexnumber(p1)) {
// integer power?
// n will be negative here, positive n already handled
if (isinteger(p2)) {
// / \ n
// -n | a - ib |
// (a + ib) = | -------- |
// | 2 2 |
// \ a + b /
push(p1);
conjugate();
p3 = pop();
push(p3);
push(p3);
push(p1);
multiply();
divide();
push(p2);
negate();
power();
return;
}
// noninteger or floating power?
if (isnum(p2)) {
#if 1 // use polar form
push(p1);
mag();
push(p2);
power();
push_integer(-1);
push(p1);
arg();
push(p2);
multiply();
push(symbol(PI));
divide();
power();
multiply();
#else // use exponential form
push(p1);
mag();
push(p2);
power();
push(symbol(E));
push(p1);
arg();
push(p2);
multiply();
push(imaginaryunit);
multiply();
power();
multiply();
#endif
return;
}
}
if (simplify_polar())
return;
push_symbol(POWER);
push(p1);
push(p2);
list(3);
}
/* XSB string substitution entry point
In:
Arg1: string
Arg2: beginning offset
Arg3: ending offset. `_' or -1: end of string, -2: char before last, etc.
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool substring(CTXTdecl)
{
/* Prolog args are first assigned to these, so we could examine the types
of these objects to determine if we got strings or atoms. */
prolog_term input_term, output_term;
prolog_term beg_offset_term, end_offset_term;
char *input_string=NULL; /* string where matches are to be found */
int beg_offset=0, end_offset=0, input_len=0, substring_len=0;
int conversion_required=FALSE;
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"SUBSTRING", "input string");
conversion_required = TRUE;
} else
xsb_abort("[SUBSTRING] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: beginning offset */
beg_offset_term = reg_term(CTXTc 2);
if (! (isinteger(beg_offset_term)|isboxedinteger(beg_offset_term)))
xsb_abort("[SUBSTRING] Arg 2 (the beginning offset) must be an integer");
beg_offset = int_val(beg_offset_term);
if (beg_offset < 0)
beg_offset = 0;
else if (beg_offset > input_len)
beg_offset = input_len;
/* arg 3: ending offset */
end_offset_term = reg_term(CTXTc 3);
if (isref(end_offset_term))
end_offset = input_len;
else if (! (isinteger(end_offset_term)|isboxedinteger(end_offset_term)))
xsb_abort("[SUBSTRING] Arg 3 (the end offset) must be integer or _");
else end_offset = int_val(end_offset_term);
if (end_offset < 0)
end_offset = input_len + 1 + end_offset;
else if (end_offset > input_len)
end_offset = input_len;
else if (end_offset < beg_offset)
end_offset = beg_offset;
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[SUBSTRING] Arg 4 (the output string) must be an unbound variable");
/* do the actual replacement */
substring_len = end_offset-beg_offset;
XSB_StrAppendBlk(&output_buffer, input_string+beg_offset, substring_len);
XSB_StrNullTerminate(&output_buffer);
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "SUBSTRING", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
/* XSB string substitution entry point: replace substrings specified in Arg2
with strings in Arg3.
In:
Arg1: string
Arg2: substring specification, a list [s(B1,E1),s(B2,E2),...]
Arg3: list of replacement strings
Out:
Arg4: new (output) string
Always succeeds, unless error.
*/
xsbBool string_substitute(CTXTdecl)
{
/* Prolog args are first assigned to these, so we could examine the types
of these objects to determine if we got strings or atoms. */
prolog_term input_term, output_term;
prolog_term subst_reg_term, subst_spec_list_term, subst_spec_list_term1;
prolog_term subst_str_term=(prolog_term)0,
subst_str_list_term, subst_str_list_term1;
char *input_string=NULL; /* string where matches are to be found */
char *subst_string=NULL;
prolog_term beg_term, end_term;
int beg_offset=0, end_offset=0, input_len;
int last_pos = 0; /* last scanned pos in input string */
/* the output buffer is made large enough to include the input string and the
substitution string. */
int conversion_required=FALSE; /* from C string to Prolog char list */
XSB_StrSet(&output_buffer,"");
input_term = reg_term(CTXTc 1); /* Arg1: string to find matches in */
if (isatom(input_term)) /* check it */
input_string = string_val(input_term);
else if (islist(input_term)) {
input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
"STRING_SUBSTITUTE", "input string");
conversion_required = TRUE;
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 1 (the input string) must be an atom or a character list");
input_len = strlen(input_string);
/* arg 2: substring specification */
subst_spec_list_term = reg_term(CTXTc 2);
if (!islist(subst_spec_list_term) && !isnil(subst_spec_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 2 must be a list [s(B1,E1),s(B2,E2),...]");
/* handle substitution string */
subst_str_list_term = reg_term(CTXTc 3);
if (! islist(subst_str_list_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
output_term = reg_term(CTXTc 4);
if (! isref(output_term))
xsb_abort("[STRING_SUBSTITUTE] Arg 4 (the output) must be an unbound variable");
subst_spec_list_term1 = subst_spec_list_term;
subst_str_list_term1 = subst_str_list_term;
if (isnil(subst_spec_list_term1)) {
XSB_StrSet(&output_buffer, input_string);
goto EXIT;
}
if (isnil(subst_str_list_term1))
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must not be an empty list");
do {
subst_reg_term = p2p_car(subst_spec_list_term1);
subst_spec_list_term1 = p2p_cdr(subst_spec_list_term1);
if (!isnil(subst_str_list_term1)) {
subst_str_term = p2p_car(subst_str_list_term1);
subst_str_list_term1 = p2p_cdr(subst_str_list_term1);
if (isatom(subst_str_term)) {
subst_string = string_val(subst_str_term);
} else if (islist(subst_str_term)) {
subst_string = p_charlist_to_c_string(CTXTc subst_str_term, &subst_buf,
"STRING_SUBSTITUTE",
"substitution string");
} else
xsb_abort("[STRING_SUBSTITUTE] Arg 3 must be a list of strings");
}
beg_term = p2p_arg(subst_reg_term,1);
end_term = p2p_arg(subst_reg_term,2);
if (!(isinteger(beg_term)|isboxedinteger(beg_term)) ||
!(isinteger(end_term)|isboxedinteger(end_term)))
xsb_abort("[STRING_SUBSTITUTE] Non-integer in Arg 2");
else{
beg_offset = int_val(beg_term);
end_offset = int_val(end_term);
}
/* -1 means end of string */
if (end_offset < 0)
end_offset = input_len;
if ((end_offset < beg_offset) || (beg_offset < last_pos))
xsb_abort("[STRING_SUBSTITUTE] Substitution regions in Arg 2 not sorted");
/* do the actual replacement */
XSB_StrAppendBlk(&output_buffer,input_string+last_pos,beg_offset-last_pos);
XSB_StrAppend(&output_buffer, subst_string);
last_pos = end_offset;
} while (!isnil(subst_spec_list_term1));
XSB_StrAppend(&output_buffer, input_string+end_offset);
EXIT:
/* get result out */
if (conversion_required)
c_string_to_p_charlist(CTXTc output_buffer.string, output_term,
4, "STRING_SUBSTITUTE", "Arg 4");
else
c2p_string(CTXTc output_buffer.string, output_term);
return(TRUE);
}
/* TLS: making a conservative guess at which system calls need to be
mutexed. I'm doing it whenever I see the process table altered or
affected, so this is the data structure that its protecting.
At some point, the SET_FILEPTRs should be protected against other
threads closing that stream. Perhaps for such things a
thread-specific stream table should be used.
*/
xsbBool sys_system(CTXTdeclc int callno)
{
int pid;
switch (callno) {
case PLAIN_SYSTEM_CALL: /* dumb system call: no communication with XSB */
/* this call is superseded by shell and isn't used */
ctop_int(CTXTc 3, system(ptoc_string(CTXTc 2)));
return TRUE;
case SLEEP_FOR_SECS:
#ifdef WIN_NT
Sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1) * 1000);
#else
sleep(iso_ptoc_int_arg(CTXTc 2,"sleep/1",1));
#endif
return TRUE;
case GET_TMP_FILENAME:
ctop_string(CTXTc 2,tmpnam(NULL));
return TRUE;
case IS_PLAIN_FILE:
case IS_DIRECTORY:
case STAT_FILE_TIME:
case STAT_FILE_SIZE:
return file_stat(CTXTc callno, ptoc_longstring(CTXTc 2));
case EXEC: {
#ifdef HAVE_EXECVP
/* execs a new process in place of XSB */
char *params[MAX_SUBPROC_PARAMS+2];
prolog_term cmdspec_term;
int index = 0;
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term)) {
prolog_term temp, head;
char *string_head=NULL;
if (isnil(cmdspec_term))
xsb_abort("[exec] Arg 1 must not be an empty list.");
temp = cmdspec_term;
do {
head = p2p_car(temp);
temp = p2p_cdr(temp);
if (isstring(head))
string_head = string_val(head);
else
xsb_abort("[exec] non-string argument passed in list.");
params[index++] = string_head;
if (index > MAX_SUBPROC_PARAMS)
xsb_abort("[exec] Too many arguments.");
} while (!isnil(temp));
params[index] = NULL;
} else if (isstring(cmdspec_term)) {
char *string = string_val(cmdspec_term);
split_command_arguments(string, params, "exec");
} else
xsb_abort("[exec] 1st argument should be term or list of strings.");
if (execvp(params[0], params))
xsb_abort("[exec] Exec call failed.");
#else
xsb_abort("[exec] builtin not supported in this architecture.");
#endif
}
case SHELL: /* smart system call: like SPAWN_PROCESS, but returns error code
instead of PID. Uses system() rather than execvp.
Advantage: can pass arbitrary shell command. */
case SPAWN_PROCESS: { /* spawn new process, reroute stdin/out/err to XSB */
/* +CallNo=2, +ProcAndArgsList,
-StreamToProc, -StreamFromProc, -StreamFromProcStderr,
-Pid */
static int pipe_to_proc[2], pipe_from_proc[2], pipe_from_stderr[2];
int toproc_stream=-1, fromproc_stream=-1, fromproc_stderr_stream=-1;
int pid_or_status;
FILE *toprocess_fptr=NULL,
*fromprocess_fptr=NULL, *fromproc_stderr_fptr=NULL;
char *params[MAX_SUBPROC_PARAMS+2]; /* one for progname--0th member,
one for NULL termination*/
prolog_term cmdspec_term, cmdlist_temp_term;
prolog_term cmd_or_arg_term;
xsbBool toproc_needed=FALSE, fromproc_needed=FALSE, fromstderr_needed=FALSE;
char *cmd_or_arg=NULL, *shell_cmd=NULL;
int idx = 0, tbl_pos;
char *callname=NULL;
xsbBool params_are_in_a_list=FALSE;
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (callno == SPAWN_PROCESS)
callname = "spawn_process/5";
else
callname = "shell/[1,2,5]";
cmdspec_term = reg_term(CTXTc 2);
if (islist(cmdspec_term))
params_are_in_a_list = TRUE;
else if (isstring(cmdspec_term))
shell_cmd = string_val(cmdspec_term);
else if (isref(cmdspec_term))
xsb_instantiation_error(CTXTc callname,1);
else
xsb_type_error(CTXTc "atom or list e.g. [command, arg, ...]",cmdspec_term,callname,1);
// xsb_abort("[%s] Arg 1 must be an atom or a list [command, arg, ...]",
// callname);
/* the user can indicate that he doesn't want either of the streams created
by putting an atom in the corresponding argument position */
if (isref(reg_term(CTXTc 3)))
toproc_needed = TRUE;
if (isref(reg_term(CTXTc 4)))
fromproc_needed = TRUE;
if (isref(reg_term(CTXTc 5)))
fromstderr_needed = TRUE;
/* if any of the arg streams is already used by XSB, then don't create
pipes --- use these streams instead. */
if (isinteger(reg_term(CTXTc 3))|isboxedinteger(reg_term(CTXTc 3))) {
SET_FILEPTR(toprocess_fptr, int_val(reg_term(CTXTc 3)));
}
if (isinteger(reg_term(CTXTc 4))|isboxedinteger(reg_term(CTXTc 4))) {
SET_FILEPTR(fromprocess_fptr, int_val(reg_term(CTXTc 4)));
}
if (isinteger(reg_term(CTXTc 5))|isboxedinteger(reg_term(CTXTc 5))) {
SET_FILEPTR(fromproc_stderr_fptr, int_val(reg_term(CTXTc 5)));
}
if (!isref(reg_term(CTXTc 6)))
xsb_type_error(CTXTc "variable (to return process id)",reg_term(CTXTc 6),callname,5);
// xsb_abort("[%s] Arg 5 (process id) must be a variable", callname);
if (params_are_in_a_list) {
/* fill in the params[] array */
if (isnil(cmdspec_term))
xsb_abort("[%s] Arg 1 must not be an empty list", callname);
cmdlist_temp_term = cmdspec_term;
do {
cmd_or_arg_term = p2p_car(cmdlist_temp_term);
cmdlist_temp_term = p2p_cdr(cmdlist_temp_term);
if (isstring(cmd_or_arg_term)) {
cmd_or_arg = string_val(cmd_or_arg_term);
}
else
xsb_abort("[%s] Non string list member in the Arg",
callname);
params[idx++] = cmd_or_arg;
if (idx > MAX_SUBPROC_PARAMS)
xsb_abort("[%s] Too many arguments passed to subprocess",
callname);
} while (!isnil(cmdlist_temp_term));
params[idx] = NULL; /* null termination */
} else { /* params are in a string */
if (callno == SPAWN_PROCESS)
split_command_arguments(shell_cmd, params, callname);
else {
/* if callno==SHELL => call system() => don't split shell_cmd */
params[0] = shell_cmd;
params[1] = NULL;
}
}
/* -1 means: no space left */
if ((tbl_pos = get_free_process_cell()) < 0) {
xsb_warn("Can't create subprocess because XSB process table is full");
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
/* params[0] is the progname */
pid_or_status = xsb_spawn(CTXTc params[0], params, callno,
(toproc_needed ? pipe_to_proc : NULL),
(fromproc_needed ? pipe_from_proc : NULL),
(fromstderr_needed ? pipe_from_stderr : NULL),
toprocess_fptr, fromprocess_fptr,
fromproc_stderr_fptr);
if (pid_or_status < 0) {
xsb_warn("[%s] Subprocess creation failed", callname);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
if (toproc_needed) {
toprocess_fptr = fdopen(pipe_to_proc[1], "w");
toproc_stream = xsb_intern_fileptr(toprocess_fptr,callname,"pipe","w");
ctop_int(CTXTc 3, toproc_stream);
}
if (fromproc_needed) {
fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
fromproc_stream = xsb_intern_fileptr(fromprocess_fptr,callname,"pipe","r");
ctop_int(CTXTc 4, fromproc_stream);
}
if (fromstderr_needed) {
fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
fromproc_stderr_stream
= xsb_intern_fileptr(fromproc_stderr_fptr,callname,"pipe","r");
ctop_int(CTXTc 5, fromproc_stderr_stream);
}
ctop_int(CTXTc 6, pid_or_status);
xsb_process_table.process[tbl_pos].pid = pid_or_status;
xsb_process_table.process[tbl_pos].to_stream = toproc_stream;
xsb_process_table.process[tbl_pos].from_stream = fromproc_stream;
xsb_process_table.process[tbl_pos].stderr_stream = fromproc_stderr_stream;
concat_array(CTXTc params, " ",
xsb_process_table.process[tbl_pos].cmdline,MAX_CMD_LEN);
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case GET_PROCESS_TABLE: { /* sys_system(3, X). X is bound to the list
of the form [process(Pid,To,From,Stderr,Cmdline), ...] */
int i;
prolog_term table_term_tail, listHead;
prolog_term table_term=reg_term(CTXTc 2);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!isref(table_term))
xsb_abort("[GET_PROCESS_TABLE] Arg 1 must be a variable");
table_term_tail = table_term;
for (i=0; i<MAX_SUBPROC_NUMBER; i++) {
if (!FREE_PROC_TABLE_CELL(xsb_process_table.process[i].pid)) {
c2p_list(CTXTc table_term_tail); /* make it into a list */
listHead = p2p_car(table_term_tail);
c2p_functor(CTXTc "process", 5, listHead);
c2p_int(CTXTc xsb_process_table.process[i].pid, p2p_arg(listHead,1));
c2p_int(CTXTc xsb_process_table.process[i].to_stream, p2p_arg(listHead,2));
c2p_int(CTXTc xsb_process_table.process[i].from_stream, p2p_arg(listHead,3));
c2p_int(CTXTc xsb_process_table.process[i].stderr_stream,
p2p_arg(listHead,4));
c2p_string(CTXTc xsb_process_table.process[i].cmdline, p2p_arg(listHead,5));
table_term_tail = p2p_cdr(table_term_tail);
}
}
c2p_nil(CTXTc table_term_tail); /* bind tail to nil */
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return p2p_unify(CTXTc table_term, reg_term(CTXTc 2));
}
case PROCESS_STATUS: {
prolog_term pid_term=reg_term(CTXTc 2), status_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isinteger(pid_term)|isboxedinteger(pid_term)))
xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
pid = int_val(pid_term);
if (!isref(status_term))
xsb_abort("[PROCESS_STATUS] Arg 2 (process status) must be a variable");
switch (process_status(pid)) {
case RUNNING:
c2p_string(CTXTc "running", status_term);
break;
case STOPPED:
c2p_string(CTXTc "stopped", status_term);
break;
case EXITED_NORMALLY:
c2p_string(CTXTc "exited_normally", status_term);
break;
case EXITED_ABNORMALLY:
c2p_string(CTXTc "exited_abnormally", status_term);
break;
case ABORTED:
c2p_string(CTXTc "aborted", status_term);
break;
case INVALID:
c2p_string(CTXTc "invalid", status_term);
break;
default:
c2p_string(CTXTc "unknown", status_term);
}
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
case PROCESS_CONTROL: {
/* sys_system(PROCESS_CONTROL, +Pid, +Signal). Signal: wait, kill */
int status;
prolog_term pid_term=reg_term(CTXTc 2), signal_term=reg_term(CTXTc 3);
SYS_MUTEX_LOCK( MUTEX_SYS_SYSTEM );
init_process_table();
if (!(isinteger(pid_term)|isboxedinteger(pid_term)))
xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
pid = int_val(pid_term);
if (isstring(signal_term) && strcmp(string_val(signal_term), "kill")==0) {
if (KILL_FAILED(pid)) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
CloseHandle((HANDLE) pid);
#endif
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
if (isconstr(signal_term)
&& strcmp(p2c_functor(signal_term),"wait") == 0
&& p2c_arity(signal_term)==1) {
int exit_status;
if (WAIT(pid, status) < 0) {
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return FALSE;
}
#ifdef WIN_NT
exit_status = status;
#else
if (WIFEXITED(status))
exit_status = WEXITSTATUS(status);
else
exit_status = -1;
#endif
p2p_unify(CTXTc p2p_arg(signal_term,1), makeint(exit_status));
SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
return TRUE;
}
xsb_warn("[PROCESS_CONTROL] Arg 2: Invalid signal specification. Must be `kill' or `wait(Var)'");
return FALSE;
}
case LIST_DIRECTORY: {
/* assume all type- and mode-checking is done in Prolog */
prolog_term handle = reg_term(CTXTc 2); /* ref for handle */
char *dir_name = ptoc_longstring(CTXTc 3); /* +directory name */
prolog_term filename = reg_term(CTXTc 4); /* reference for name of file */
if (is_var(handle))
return xsb_find_first_file(CTXTc handle,dir_name,filename);
else
return xsb_find_next_file(CTXTc handle,dir_name,filename);
}
default:
xsb_abort("[SYS_SYSTEM] Wrong call number (an XSB bug)");
} /* end case */
return TRUE;
}
static DE intern_delay_element(Cell delay_elem)
{
DE de;
CPtr cptr = (CPtr) cs_val(delay_elem);
/*
* All the following information about delay_elem is set in
* delay_negatively() or delay_positively(). Note that cell(cptr) is
* the delay_psc ('DL').
*/
VariantSF subgoal;
NODEptr ans_subst;
CPtr ret_n = 0;
int arity;
Cell tmp_cell;
tmp_cell = cell(cptr + 1);
subgoal = (VariantSF) addr_val(tmp_cell);
tmp_cell = cell(cptr + 2);
ans_subst = (NODEptr) addr_val(tmp_cell);
tmp_cell = cell(cptr + 3);
/*
* cell(cptr + 3) can be one of the following:
* 1. integer 0 (NEG_DELAY), for a negative DE;
* 2. string "ret", for a positive DE with arity 0;
* 3. constr ret/n, for a positive DE with arity >=1.
*/
if (isinteger(tmp_cell) || isstring(tmp_cell))
arity = 0;
else {
ret_n = (CPtr) cs_val(tmp_cell);
arity = get_arity((Psc) get_str_psc(cell(cptr + 3)));
}
#ifdef DEBUG_DELAYVAR
xsb_dbgmsg((LOG_DEBUG,">>>> "));
dbg_print_delay_list(LOG_DEBUG,stddbg, delayreg);
xsb_dbgmsg((LOG_DEBUG, "\n"));
xsb_dbgmsg((LOG_DEBUG, ">>>> (Intern ONE de) arity of answer subsf = %d\n",
arity));
#endif
if (!was_simplifiable(subgoal, ans_subst)) {
new_entry(de,
released_des,
next_free_de,
current_de_block,
current_de_block_top,
de_next,
DE,
de_block_size,
"Not enough memory to expand DE space");
de_subgoal(de) = subgoal;
de_ans_subst(de) = ans_subst; /* Leaf of the answer (substitution) trie */
#ifdef DEBUG_DELAYVAR
de_subs_fact(de) = NULL;
#ifndef IGNORE_DELAYVAR
if (arity != 0) {
de_subs_fact_leaf(de) = delay_chk_insert(arity, ret_n + 1,
(CPtr *) &de_subs_fact(de));
}
#endif /* IGNORE_DELAYVAR */
#else
#ifndef IGNORE_DELAYVAR
if (arity != 0) {
CPtr hook = NULL;
de_subs_fact_leaf(de) = delay_chk_insert(arity, ret_n + 1,
&hook);
}
#endif /* IGNORE_DELAYVAR */
#endif
return de;
}
else
return NULL;
}
int compare(CTXTdeclc const void * v1, const void * v2)
{
int comp;
CPtr cptr1, cptr2;
Cell val1 = (Cell) v1 ;
Cell val2 = (Cell) v2 ;
XSB_Deref(val2); /* val2 is not in register! */
XSB_Deref(val1); /* val1 is not in register! */
if (val1 == val2) return 0;
switch(cell_tag(val1)) {
case XSB_FREE:
case XSB_REF1:
if (isattv(val2))
return vptr(val1) - (CPtr)dec_addr(val2);
else if (isnonvar(val2)) return -1;
else { /* in case there exist local stack variables in the */
/* comparison, globalize them to guarantee that their */
/* order is retained as long as nobody "touches" them */
/* in the future -- without copying garbage collection */
if ((top_of_localstk <= vptr(val1)) &&
(vptr(val1) <= (CPtr)glstack.high-1)) {
bld_free(hreg);
bind_ref(vptr(val1), hreg);
hreg++;
val1 = follow(val1); /* deref again */
}
if ((top_of_localstk <= vptr(val2)) &&
(vptr(val2) <= (CPtr)glstack.high-1)) {
bld_free(hreg);
bind_ref(vptr(val2), hreg);
hreg++;
val2 = follow(val2); /* deref again */
}
return vptr(val1) - vptr(val2);
}
case XSB_FLOAT:
if (isref(val2) || isattv(val2)) return 1;
else if (isofloat(val2))
return sign(float_val(val1) - ofloat_val(val2));
else return -1;
case XSB_INT:
if (isref(val2) || isofloat(val2) || isattv(val2)) return 1;
else if (isinteger(val2))
return int_val(val1) - int_val(val2);
else if (isboxedinteger(val2))
return int_val(val1) - boxedint_val(val2);
else return -1;
case XSB_STRING:
if (isref(val2) || isofloat(val2) || isinteger(val2) || isattv(val2))
return 1;
else if (isstring(val2)) {
return strcmp(string_val(val1), string_val(val2));
}
else return -1;
case XSB_STRUCT:
// below, first 2 if-checks test to see if this struct is actually a number representation,
// (boxed float or boxed int) and if so, does what the number case would do, only with boxed_val
// macros.
if (isboxedinteger(val1)) {
if (isref(val2) || isofloat(val2) || isattv(val2)) return 1;
else if (isinteger(val2))
return boxedint_val(val1) - int_val(val2);
else if (isboxedinteger(val2))
return boxedint_val(val1) - boxedint_val(val2);
else return -1;
} else if (isboxedfloat(val1)) {
if (isref(val2) || isattv(val2)) return 1;
else if (isofloat(val2))
return sign(boxedfloat_val(val1) - ofloat_val(val2));
else return -1;
} else if (cell_tag(val2) != XSB_STRUCT && cell_tag(val2) != XSB_LIST) return 1;
else {
int arity1, arity2;
Psc ptr1 = get_str_psc(val1);
Psc ptr2 = get_str_psc(val2);
arity1 = get_arity(ptr1);
if (islist(val2)) arity2 = 2;
else arity2 = get_arity(ptr2);
if (arity1 != arity2) return arity1-arity2;
if (islist(val2)) comp = strcmp(get_name(ptr1), ".");
else comp = strcmp(get_name(ptr1), get_name(ptr2));
if (comp || (arity1 == 0)) return comp;
cptr1 = clref_val(val1);
cptr2 = clref_val(val2);
for (arity2 = 1; arity2 <= arity1; arity2++) {
if (islist(val2))
comp = compare(CTXTc (void*)cell(cptr1+arity2), (void*)cell(cptr2+arity2-1));
else
comp = compare(CTXTc (void*)cell(cptr1+arity2), (void*)cell(cptr2+arity2));
if (comp) break;
}
return comp;
}
break;
case XSB_LIST:
if (cell_tag(val2) != XSB_STRUCT && cell_tag(val2) != XSB_LIST) return 1;
else if (isconstr(val2)) return -(compare(CTXTc (void*)val2, (void*)val1));
else { /* Here we are comparing two list structures. */
cptr1 = clref_val(val1);
cptr2 = clref_val(val2);
comp = compare(CTXTc (void*)cell(cptr1), (void*)cell(cptr2));
if (comp) return comp;
return compare(CTXTc (void*)cell(cptr1+1), (void*)cell(cptr2+1));
}
break;
case XSB_ATTV:
if (isattv(val2))
return (CPtr)dec_addr(val1) - (CPtr)dec_addr(val2);
else if (isref(val2))
return (CPtr)dec_addr(val1) - vptr(val2);
else
return -1;
default:
xsb_abort("Compare (unknown tag %ld); returning 0", cell_tag(val1));
return 0;
}
}
/*-----------------------------------------------------------------------------*/
void SetBindVal()
{
RETCODE rc;
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
int j = ptoc_int(3);
Cell BindVal = ptoc_tag(4);
if (!((j >= 0) && (j < cur->NumBindVars)))
xsb_exit("Abnormal argument in SetBindVal!");
/* if we're reusing an opened cursor w/ the statement number*/
/* reallocate BindVar if type has changed (May not be such a good idea?)*/
if (cur->Status == 2) {
if (isinteger(BindVal)) {
if (cur->BindTypes[j] != 0) {
if (cur->BindTypes[j] != 2) free((void *)cur->BindList[j]);
cur->BindList[j] = (UCHAR *)malloc(sizeof(int));
cur->BindTypes[j] = 0;
rc = SQLBindParameter(cur->hstmt, (short)(j+1), SQL_PARAM_INPUT,
SQL_C_SLONG, SQL_INTEGER,
0, 0, (int *)(cur->BindList[j]), 0, NULL);
if (rc != SQL_SUCCESS) {
ctop_int(5,PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
}
*((int *)cur->BindList[j]) = oint_val(BindVal);
} else if (isfloat(BindVal)) {
if (cur->BindTypes[j] != 1) {
/*printf("ODBC: Changing Type: flt to %d\n",cur->BindTypes[j]);*/
if (cur->BindTypes[j] != 2) free((void *)cur->BindList[j]);
cur->BindList[j] = (UCHAR *)malloc(sizeof(float));
cur->BindTypes[j] = 1;
rc = SQLBindParameter(cur->hstmt, (short)(j+1), SQL_PARAM_INPUT,
SQL_C_FLOAT, SQL_FLOAT,
0, 0, (float *)(cur->BindList[j]), 0, NULL);
if (rc != SQL_SUCCESS) {
ctop_int(5,PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
}
*((float *)cur->BindList[j]) = (float)float_val(BindVal);
} else if (isstring(BindVal)) {
if (cur->BindTypes[j] != 2) {
/*printf("ODBC: Changing Type: str to %d\n",cur->BindTypes[j]);*/
free((void *)cur->BindList[j]);
cur->BindTypes[j] = 2;
/* SQLBindParameter will be done anyway*/
}
cur->BindList[j] = string_val(BindVal);
} else if (isconstr(BindVal) && get_arity(get_str_psc(BindVal))==1) {
letter_flag = 1;
wcan_disp = 0;
write_canonical_term(p2p_arg(BindVal,1));
if (term_string[j]) free(term_string[j]);
term_string[j] = malloc(wcan_disp+1);
strncpy(term_string[j],wcan_string,wcan_disp);
term_string[j][wcan_disp] = '\0';
cur->BindTypes[j] = 2;
cur->BindList[j] = term_string[j];
} else {
xsb_exit("Unknown bind variable type, %d", cur->BindTypes[j]);
}
ctop_int(5,0);
return;
}
/* otherwise, memory needs to be allocated in this case*/
if (isinteger(BindVal)) {
cur->BindTypes[j] = 0;
cur->BindList[j] = (UCHAR *)malloc(sizeof(int));
if (!cur->BindList[j])
xsb_exit("Not enough memory for an int in SetBindVal!");
*((int *)cur->BindList[j]) = oint_val(BindVal);
} else if (isfloat(BindVal)) {
cur->BindTypes[j] = 1;
cur->BindList[j] = (UCHAR *)malloc(sizeof(float));
if (!cur->BindList[j])
xsb_exit("Not enough memory for a float in SetBindVal!");
*((float *)cur->BindList[j]) = (float)float_val(BindVal);
} else if (isstring(BindVal)) {
cur->BindTypes[j] = 2;
cur->BindList[j] = string_val(BindVal);
} else if (isconstr(BindVal) && get_arity(get_str_psc(BindVal))==1) {
letter_flag = 1;
wcan_disp = 0;
write_canonical_term(p2p_arg(BindVal,1));
if (term_string[j]) free(term_string[j]);
term_string[j] = malloc(wcan_disp+1);
strncpy(term_string[j],wcan_string,wcan_disp);
term_string[j][wcan_disp] = '\0';
cur->BindTypes[j] = 2;
cur->BindList[j] = term_string[j];
} else {
xsb_exit("Unknown bind variable type, %d", cur->BindTypes[j]);
}
ctop_int(5,0);
return;
}