Example #1
0
/* print a prolog_term into a buffer.
(Atoms are quoted if !toplevel and it's necessary for Prolog reading) */
void printpterm(prolog_term term, int toplevel, char *straddr, long int *ind)
{
  int i;

  if (is_var(term)) {
      sprintf(tempstring,"_%p",term);
      strcpy(straddr+*ind,tempstring);
      *ind += strlen(tempstring);
  } else if (is_int(term)) {
      sprintf(tempstring,"%d",p2c_int(term));
      strcpy(straddr+*ind,tempstring);
      *ind += strlen(tempstring);
  } else if (is_float(term)) {
      sprintf(tempstring,"%f",p2c_float(term));
      strcpy(straddr+*ind,tempstring);
      *ind += strlen(tempstring);
  } else if (is_nil(term)) {
      strcpy(straddr+*ind,"[]");
      *ind += 2;
  } else if (is_string(term)) {
      printpstring(p2c_string(term),toplevel,straddr,ind);
  } else if (is_list(term)) {
      strcpy(straddr+*ind,"[");
      *ind += 1;
      printpterm(p2p_car(term),FALSE,straddr,ind);
      term = p2p_cdr(term);
      while (is_list(term)) {
          strcpy(straddr+*ind,",");
          *ind += 1;
          printpterm(p2p_car(term),FALSE,straddr,ind);
          term = p2p_cdr(term);
      }
      if (!is_nil(term)) {
          strcpy(straddr+*ind,"|");
          *ind += 1;
          printpterm(term,FALSE,straddr,ind);
      }
      strcpy(straddr+*ind,"]");
      *ind += 1;
  } else if (is_functor(term)) {
      printpstring(p2c_functor(term),FALSE,straddr,ind);
      if (p2c_arity(term) > 0) {
          strcpy(straddr+*ind,"(");
          *ind += 1;
          printpterm(p2p_arg(term,1),FALSE,straddr,ind);
          for (i = 2; i <= p2c_arity(term); i++) {
              strcpy(straddr+*ind,",");
              *ind += 1;
              printpterm(p2p_arg(term,i),FALSE,straddr,ind);
          }
          strcpy(straddr+*ind,")");
          *ind += 1;
      }
  } else fprintf(stderr,"error, unrecognized type");
}
Example #2
0
int add_varc(int nVal,prolog_term probabilities)
{
    variable * v;
    int i;
    double p,p0;

    nVars=nVars+1;
    vars=(variable *) realloc(vars,nVars * sizeof(variable));
    v=&vars[nVars-1];
    v->nVal=nVal;

    probs=(double *) realloc(probs,(((boolVars+v->nVal-1)* sizeof(double))));
    p0=1;
    for (i=0; i<v->nVal-1; i++)
    {
        p=p2c_float(p2p_car(probabilities));
        probs[boolVars+i]=p/p0;
        probabilities=p2p_cdr(probabilities);

        p0=p0*(1-p/p0);
    }
    v->firstBoolVar=boolVars;
    boolVars=boolVars+v->nVal-1;

    return  nVars-1;
}
Example #3
0
/* calculate approximate length of a printed term.  For space alloc. */
DWORD clenpterm(prolog_term term)
{
  int i, clen;

  if (is_var(term)) return 11;
  else if (is_int(term)) return 12;
  else if (is_float(term)) return 12;
  else if (is_nil(term)) return 2;
  else if (is_string(term)) return strlen(p2c_string(term))+5;
  else if (is_list(term)) {
      clen = 1;
      clen += clenpterm(p2p_car(term)) + 1;
      while (is_list(term)) {
          clen += clenpterm(p2p_car(term)) + 1;
          term = p2p_cdr(term);
      }
      if (!is_nil(term)) {
          clen += clenpterm(term) + 1;
      }
      return clen+1;
  } else if (is_functor(term)) {
      clen = strlen(p2c_functor(term))+5;
      if (p2c_arity(term) > 0) {
          clen += clenpterm(p2p_arg(term,1)) + 1;
          for (i = 2; i <= p2c_arity(term); i++) {
              clen += clenpterm(p2p_arg(term,i)) + 1;
          }
          return clen + 1;
      } else return clen;
  } else {
      fprintf(stderr,"error, unrecognized type");
      return 0;
  }
}
Example #4
0
int return_to_prolog(PyObject *pValue)
{
	if(pValue == Py_None){
		return 1;
	}
	if(PyInt_Check(pValue))
	{
		int result = PyInt_AS_LONG(pValue);
		extern_ctop_int(3, result);
		return 1;
	}
	else if(PyFloat_Check(pValue))
	{
		float result = PyFloat_AS_DOUBLE(pValue);
		extern_ctop_float(3, result);
		return 1;
	}else if(PyString_Check(pValue))
	{
		char *result = PyString_AS_STRING(pValue);
		extern_ctop_string(3, result);
		return 1;
	}else if(PyList_Check(pValue))
	{
		size_t size = PyList_Size(pValue);
		size_t i = 0;
		prolog_term head, tail;
		prolog_term P = p2p_new();
		tail = P;
		
		for(i = 0; i < size; i++)
		{
			c2p_list(CTXTc tail);
			head = p2p_car(CTXTc tail);
			PyObject *pyObj = PyList_GetItem(pValue, i);
			int temp = PyInt_AS_LONG(pyObj);
			c2p_int(temp, head);
			//convert_pyObj_prObj(pyObj, &head);				
			tail = p2p_cdr(tail);
		}
		c2p_nil(CTXTc tail);
		p2p_unify(P, reg_term(CTXTc 3));
		return 1;
	}else
	{
		//returns an object refernce to prolog side.
		pyobj_ref_node *node = 	add_pyobj_ref_list(pValue);
		//printf("node : %p", node);	
	char str[30];
		sprintf(str, "%p", node);
		//extern_ctop_string(3,str);
	  prolog_term ref = p2p_new();
		c2p_functor("pyObject", 1, ref);
		prolog_term ref_inner = p2p_arg(ref, 1);
    c2p_string(str, ref_inner);		
		p2p_unify(ref, reg_term(CTXTc 3));	
		return 1;
	}
	return 0;
}
DllExport int call_conv pl_encode_url()
{

  char	*url;
  char *dir, *file_base, *suffix;

  check_thread_context
  url = (char *) extern_ptoc_string(1);
 
  encode(url, &dir, &file_base, &suffix);

  c2p_string(CTXTc dir, p2p_car(reg_term(CTXTc 2)));
  c2p_string(CTXTc file_base, p2p_car(p2p_cdr(reg_term(CTXTc 2))));
  c2p_string(CTXTc suffix, p2p_car(p2p_cdr(p2p_cdr(reg_term(CTXTc 2)))));

  return TRUE;
}
Example #6
0
int find_length_prolog_list(prolog_term V)
{
	prolog_term temp = V;
	int count= 0;
	while(!(is_nil(temp)))
	{
		p2p_car(temp);
		count++;
		temp = p2p_cdr(temp);
	}
	return count;
}
Example #7
0
/* 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;
}
/**
 * Remove uninstantiated terms in the warning list at end
 * Input : Warning term
 **/
DllExport int call_conv curl_finalize_warn()
{
  /*Temporary prolog term to iterate over the warnings list*/
  prolog_term tmp;

  check_thread_context
  tmp = reg_term(CTXTc 1);
  while( is_list(tmp)){
    tmp = p2p_cdr(tmp);
  }
  if( is_var(tmp)){
    c2p_nil(CTXTc tmp);
  }
  return TRUE;
}
Example #9
0
/* utility function to return the available socket descriptors after testing */
static void test_ready(CTXTdeclc prolog_term *avail_sockfds, fd_set *fdset,
		       int *fds, int size) 
{
  prolog_term head;
  int i=0;

  for (i=0;i<size;i++) {
    c2p_list(CTXTc *avail_sockfds);
    if (FD_ISSET(fds[i], fdset)) {
      head = p2p_car(*avail_sockfds);
      c2p_int(CTXTc fds[i], head);
      *avail_sockfds = p2p_cdr(*avail_sockfds);
    } 
  }
  c2p_nil(CTXTc *avail_sockfds);
  return;
}
Example #10
0
int prlist2pyList(prolog_term V, PyObject *pList, int count)
{
	prolog_term temp = V;
	prolog_term head;
	// PyObject *pValue;
	int i;
	for(i = 0; i <count;i++)
	{ //fill ;+i){
		head = p2p_car(temp);
		// int ctemp = p2c_int(head);//currently only a list of integers, need to expand it for all types. 
		// pValue = PyInt_FromLong(ctemp);
		PyObject *pyObj = NULL;
		if( !convert_prObj_pyObj(head, &pyObj))
			return FALSE;
		PyList_SetItem(pList, i, pyObj);
		temp = p2p_cdr(temp);
	}	
	return TRUE;
}
static int make_flags(prolog_term flag_term, char *context)
{
  int flags = 0;
  prolog_term aux_list=flag_term, head_trm;
  char *head;

#ifdef MULTI_THREAD
  if( NULL == th)
	th = xsb_get_main_thread();
#endif

  if (is_var(flag_term))
    return REG_EXTENDED;
  else if (is_int(flag_term))
    return (REG_EXTENDED | REG_ICASE);

  if (is_nil(flag_term))
    return 0; /* basic, case-sensitive */

  if (! is_list(flag_term))
    xsb_abort("[%s] Arg 4 (flags) must be a variable, an integer, or a list",
	      context);

  do {
    head_trm = p2p_car(aux_list);
    aux_list = p2p_cdr(aux_list);
    if (!is_string(head_trm))
      xsb_abort("[%s] Arg 4: allowed flags are `extended' and `ignorecase'",
		context);
    head = string_val(head_trm);
    if (strcmp(head,"extended")==0)
      flags = flags | REG_EXTENDED;
    else if (strcmp(head,"ignorecase")==0)
      flags = flags | REG_ICASE;
  } while (!is_nil(aux_list));
  
  return flags;
}
Example #12
0
static xsbBool list_sockfd(prolog_term list, fd_set *fdset, int *max_fd,
			   int **fds, int * size)
{
  int i=0;
  prolog_term local=list;
  prolog_term head;

  *size = getsize(local);
  *fds = (int*)mem_alloc(sizeof(int)*(*size),OTHER_SPACE);

  while (!isnil(list)) {
    head = p2p_car(list);
    (*fds)[i++] = (int)p2c_int(head);
    list = p2p_cdr(list);
  }

  for (i=0; i<(*size); i++) {
    /* turn on the bit in the fd_set */
    FD_SET((*fds)[i], fdset);
    *max_fd = xsb_max(*max_fd, (*fds)[i]);
  }

  return TRUE;
}
static char* buildSQLQuery(prolog_term sqlQueryList)
{
  prolog_term element;
  char* sqlQuery;
  char* temp;
  int cnt;
  size_t i;

  sqlQuery = (char *)malloc(QUERY_SIZE * sizeof(char)+1);
  sqlQuery[0] = '\0';
  while (!is_nil(sqlQueryList)) {
    element = p2p_car(sqlQueryList);
    sqlQueryList = p2p_cdr(sqlQueryList);
    if (is_string(element)) {
      if (p2c_string(element)[0] == DB_INTERFACE_TERM_SYMBOL) {
	cnt = 0;
	temp = (char *)malloc(ELEMENT_SIZE * sizeof(char)+1);
	temp[cnt++] = '\'';
	/* protect inner quotes in Prolog terms */
	for (i = 0 ; i < strlen(p2c_string(element)) ; i++) {
	  if (p2c_string(element)[i] == '\'') {
	    temp[cnt++] = '\\';
	    temp[cnt++] = p2c_string(element)[i];
	  }
	  else {
	    temp[cnt++] = p2c_string(element)[i];
	  }
	}
	temp[cnt++] = '\'';
	temp[cnt++] = '\0';
	strcat(sqlQuery, temp);
	if (temp != NULL) {
	  free(temp);
	  temp = NULL;
	}
      }
      else {
	strcat(sqlQuery, p2c_string(element));
      }
    }
    else if (is_int(element)) {
      temp = (char *)malloc(ELEMENT_SIZE * sizeof(char));
      sprintf(temp, "%d", (int)p2c_int(element));
      strcat(sqlQuery, temp);  
      if (temp != NULL) {
	free(temp);
	temp = NULL;
      }
    }
    else if (is_float(element)) {
      temp = (char *)malloc(ELEMENT_SIZE * sizeof(char));
      sprintf(temp, "%f", p2c_float(element));			
      strcat(sqlQuery, temp);
      if (temp != NULL) {
	free(temp);
	temp = NULL;
      }
    }
    else if (is_var(element)) {
      errorMesg = "XSB_DBI ERROR: Unbound variable in parameter list";
    }
  }
  return sqlQuery;
}
/* 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 string
   Out:
       Arg4: new (output) string
   Always succeeds, unless error.
*/
int do_regsubstitute__(void)
{
#ifdef MULTI_THREAD
  if( NULL == th)
	th = xsb_get_main_thread();
#endif

  /* 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 (is_string(input_term)) /* check it */
    input_string = string_val(input_term);
  else if (is_list(input_term)) {
    input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
					  "RE_SUBSTITUTE", "input string");
    conversion_required = TRUE;
  } else
    xsb_abort("[RE_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 (!is_list(subst_spec_list_term) && !is_nil(subst_spec_list_term))
    xsb_abort("[RE_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 (! is_list(subst_str_list_term))
    xsb_abort("[RE_SUBSTITUTE] Arg 3 must be a list of strings");

  output_term = reg_term(CTXTc 4);
  if (! is_var(output_term))
    xsb_abort("[RE_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 (is_nil(subst_spec_list_term1)) {
    XSB_StrSet(&output_buffer, input_string);
    goto EXIT;
  }
  if (is_nil(subst_str_list_term1))
    xsb_abort("[RE_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 (!is_nil(subst_str_list_term1)) {
      subst_str_term = p2p_car(subst_str_list_term1);
      subst_str_list_term1 = p2p_cdr(subst_str_list_term1);

      if (is_string(subst_str_term)) {
	subst_string = string_val(subst_str_term);
      } else if (is_list(subst_str_term)) {
	subst_string = p_charlist_to_c_string(CTXTc subst_str_term, &subst_buf,
					      "RE_SUBSTITUTE",
					      "substitution string");
      } else 
	xsb_abort("[RE_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 (!is_int(beg_term) || !is_int(end_term))
      xsb_abort("[RE_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("[RE_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 (!is_nil(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,
			   "RE_SUBSTITUTE", "Arg 4");
  else
    /* DO NOT intern. When atom table garbage collection is in place, then
       replace the instruction with this:
       	   c2p_string(output_buffer, output_term);
       The reason for not interning is that in Web page
       manipulation it is often necessary to process the same string many
       times. This can cause atom table overflow. Not interning allws us to
       circumvent the problem.  */
    ctop_string(CTXTc 4, output_buffer.string);
  
  return(TRUE);
}
/* XSB regular expression matcher entry point
   In:
       Arg1: regexp
       Arg2: string
       Arg3: offset
       Arg4: match_flags: Var means case-sensitive/extended;
       	       	          number: ignorecase/extended
			  List: [{extended|ignorecase},...]
   Out:
       Arg5: list of the form [match(bo0,eo0), match(bo1,eo1),...]
       	     where bo*,eo* specify the beginning and ending offsets of the
	     matched substrings.
	     All matched substrings are returned. Parenthesized expressions are
	     ignored.
*/
int do_bulkmatch__(void)
{
#ifdef MULTI_THREAD
  if( NULL == th)
	th = xsb_get_main_thread();
#endif

  prolog_term listHead, listTail;
  /* 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 regexp_term, input_term, offset_term;
  prolog_term output_term = p2p_new(CTXT);
  char *regexp_ptr=NULL;      /* regular expression ptr	       	      */
  char *input_string=NULL;    /* string where matches are to be found */
  int match_flags=FALSE;
  int return_code, paren_number, offset;
  regmatch_t *match_array;
  int last_pos=0, input_len;
  
  if (first_call)
    initialize_regexp_tbl();

  regexp_term = reg_term(CTXTc 1);  /* Arg1: regexp */
  if (is_string(regexp_term)) /* check it */
    regexp_ptr = string_val(regexp_term);
  else if (is_list(regexp_term))
    regexp_ptr = p_charlist_to_c_string(CTXTc regexp_term, &regexp_buffer,
					"RE_BULKMATCH", "regular expression");
  else
    xsb_abort("[RE_BULKMATCH] Arg 1 (the regular expression) must be an atom or a character list");

  input_term = reg_term(CTXTc 2);  /* Arg2: string to find matches in */
  if (is_string(input_term)) /* check it */
    input_string = string_val(input_term);
  else if (is_list(input_term)) {
    input_string = p_charlist_to_c_string(CTXTc input_term, &input_buffer,
					  "RE_BULKMATCH", "input string");
  } else
    xsb_abort("[RE_BULKMATCH] Arg 2 (the input string) must be an atom or a character list");

  input_len = strlen(input_string);
  
  offset_term = reg_term(CTXTc 3); /* arg3: offset within the string */
  if (! is_int(offset_term))
    xsb_abort("[RE_BULKMATCH] Arg 3 (the offset) must be an integer");
  offset = int_val(offset_term);
  if (offset < 0 || offset > input_len)
    xsb_abort("[RE_BULKMATCH] Arg 3 (=%d) must be between 0 and %d", input_len);

   /* arg 4 specifies flags: _, number, list [extended,ignorecase] */
  match_flags = make_flags(reg_term(CTXTc 4), "RE_BULKMATCH");

  last_pos = offset;
  /* returned result */
  listTail = output_term;
  while (last_pos < input_len) {
    return_code = xsb_re_match(regexp_ptr, input_string+last_pos, match_flags,
			       &match_array, &paren_number, "RE_BULKMATCH");
    /* exit on no match */
    if (! return_code) break;

    c2p_list(CTXTc listTail); /* make it into a list */
    listHead = p2p_car(listTail); /* get head of the list */

    /* bind i-th match to listHead as match(beg,end) */
    c2p_functor(CTXTc "match", 2, listHead);
    c2p_int(CTXTc match_array[0].rm_so+last_pos, p2p_arg(listHead,1));
    c2p_int(CTXTc match_array[0].rm_eo+last_pos, p2p_arg(listHead,2));

    listTail = p2p_cdr(listTail);
    if (match_array[0].rm_eo > 0)
      last_pos = match_array[0].rm_eo+last_pos;
    else
      last_pos++;
  }

  c2p_nil(CTXTc listTail); /* bind tail to nil */
  return p2p_unify(CTXTc output_term, reg_term(CTXTc 5));
}
DllExport int call_conv pl_load_page()
{

  prolog_term head, tail, result = 0;

  char *functor, *url = NULL, *data = NULL;
  char *username = NULL, *password = NULL;

  curl_opt options = init_options();
  curl_ret ret_vals;

	
  check_thread_context
  tail = reg_term(CTXTc 1);
  
  if(!is_list(tail))
    return curl2pl_error(ERR_DOMAIN, "source", tail);

  while(is_list(tail)){
    
    head = p2p_car(tail); 
    tail = p2p_cdr(tail);

    if(is_functor(head)){
      
      functor = p2c_functor(head);
   
      if(!strcmp(functor,"source")){

	prolog_term term_url_func, term_url = 0;

	term_url_func = p2p_arg(head, 1);
     
	if(is_functor(term_url_func)){
		
	  if(!strcmp(p2c_functor(term_url_func), "url")){
	    
	    term_url = p2p_arg(term_url_func, 1);
	    url = p2c_string(term_url);
	    data = load_page(url, options, &ret_vals);
	  }
	  else{
	    return curl2pl_error(ERR_MISC, "source", term_url);
	  }
	}
	else{
	  return curl2pl_error(ERR_MISC, "source", "Improper input format");
	}
      }
      else if(!strcmp(functor,"options")){

	prolog_term term_options = p2p_arg(head, 1);
	prolog_term term_option;

	while(is_list(term_options)){

		term_option = p2p_car(term_options);
		if(!strcmp(p2c_functor(term_option), "redirect")) {
			if(!strcmp(p2c_string(p2p_arg(term_option, 1)), "true"))
				options.redir_flag = 1;
			else
				options.redir_flag = 0;
		}
		else if(!strcmp(p2c_functor(term_option), "secure")){
			if(!strcmp(p2c_string(p2p_arg(term_option, 1)), "false"))
				options.secure.flag = 0;
			else
				options.secure.crt_name = p2c_string(p2p_arg(term_option, 1));
		}
		else if(!strcmp(p2c_functor(term_option), "auth")){
			username = p2c_string(p2p_arg(term_option, 1));
			password = p2c_string(p2p_arg(term_option, 2));
			options.auth.usr_pwd = (char *) malloc ((strlen(username) + strlen(password) + 2) * sizeof(char));
			strcpy(options.auth.usr_pwd, username);
			strcat(options.auth.usr_pwd, ":");
			strcat(options.auth.usr_pwd, password);			
		}
		else if(!strcmp(p2c_functor(term_option), "timeout")){
		  options.timeout = (int)p2c_int(p2p_arg(term_option, 1));
		}
		else if(!strcmp(p2c_functor(term_option), "url_prop")){
			options.url_prop = options.redir_flag;
		}
		else if(!strcmp(p2c_functor(term_option), "user_agent")){
			options.user_agent = p2c_string(p2p_arg(term_option, 1));
		}
		else if(!strcmp(p2c_functor(term_option), "post")){
			options.post_data = p2c_string(p2p_arg(term_option, 1));
		}
		term_options = p2p_cdr(term_options);
	}

      }
      else if(!strcmp(functor,"document")){

	result = p2p_arg(head, 1);
      }
      else if(!strcmp(functor,"properties")){

	c2p_int(CTXTc (int) ret_vals.size, p2p_arg(head, 1));
	/* the following code can be used to convert to local/UTC time, if
	    necessary. Note: XSB uses local time, and ret_vals.modify_time
	    is local, too.

	    struct tm * timeinfo;
	    timeinfo = gmtime(&(ret_vals.modify_time)); // UTC time
	    timeinfo = localtime(&(ret_vals.modify_time)); // local time
	    c2p_int(CTXTc (int) mktime(timeinfo), p2p_arg(head,2));
	*/
	/* return modification time as an integer */
	c2p_int(CTXTc (int) ret_vals.modify_time, p2p_arg(head,2));
	/*
	  The following converts time to string - not useful

	  if (ctime(&ret_vals.modify_time) == NULL)
	      c2p_string("", p2p_arg(head, 2));
	  else
	      c2p_string(CTXTc (char *) ctime(&ret_vals.modify_time),
		         p2p_arg(head, 2));
	*/
      }
    }
    else{
      return curl2pl_error(ERR_DOMAIN, "source", head);
    }
  }

  c2p_string(CTXTc data, result);

return TRUE;
}
Example #17
0
int convert_pyObj_prObj(PyObject *pyObj, prolog_term *prTerm)
{
	if(pyObj == Py_None){
		return 1;// todo: check this case for a list with a none in the list. how does prolog side react 
	}
	if(PyInt_Check(pyObj))
	{
		int result = PyInt_AS_LONG(pyObj);
		//extern_ctop_int(3, result);
		c2p_int(result, *prTerm);
		return 1;
	}
	else if(PyFloat_Check(pyObj))
	{
		float result = PyFloat_AS_DOUBLE(pyObj);
		//extern_ctop_float(3, result);
		c2p_float(result, *prTerm);
		return 1;
	}else if(PyString_Check(pyObj))
	{
		char *result = PyString_AS_STRING(pyObj);
		//extern_ctop_string(3, result);
		c2p_string(result, *prTerm);
		return 1;
	}else if(PyList_Check(pyObj))
	{
		size_t size = PyList_Size(pyObj);
		size_t i = 0;
		prolog_term head, tail;
		prolog_term P = p2p_new();
		tail = P;
		
		for(i = 0; i < size; i++)
		{
			c2p_list(CTXTc tail);
			head = p2p_car(CTXTc tail);
			PyObject *pyObjInner = PyList_GetItem(pyObj, i);
			//int temp = PyInt_AS_LONG(pyObj);
			//c2p_int(temp, head);
			convert_pyObj_prObj(pyObjInner, &head);				
			tail = p2p_cdr(tail);
		}
		c2p_nil(CTXTc tail);
		//p2p_unify(P, reg_term(CTXTc 3));
		return 1;
	}else
	{
		//returns an object refernce to prolog side.
		pyobj_ref_node *node = 	add_pyobj_ref_list(pyObj);
		//printf("node : %p", node);	
		char str[30];
		sprintf(str, "%p", node);
		//extern_ctop_string(3,str);
	  	prolog_term ref = p2p_new();
		c2p_functor("pyObject", 1, ref);
		prolog_term ref_inner = p2p_arg(ref, 1);
    	c2p_string(str, ref_inner);		
		p2p_unify(ref, *prTerm);	
		return 1;
	}
}
Example #18
0
/* 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;
  Integer 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((int)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,tempnam(NULL,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 (isointeger(reg_term(CTXTc 3))) {
      SET_FILEPTR(toprocess_fptr, oint_val(reg_term(CTXTc 3)));
    }
    if (isointeger(reg_term(CTXTc 4))) {
      SET_FILEPTR(fromprocess_fptr, oint_val(reg_term(CTXTc 4)));
    }
    if (isointeger(reg_term(CTXTc 5))) {
      SET_FILEPTR(fromproc_stderr_fptr, oint_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(CTXTc "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(CTXTc "[%s] Subprocess creation failed, Error: %d, errno: %d, Cmd: %s", callname,pid_or_status,errno,params[0]);
      SYS_MUTEX_UNLOCK( MUTEX_SYS_SYSTEM );
      return FALSE;
    }

    if (toproc_needed) {
      toprocess_fptr = fdopen(pipe_to_proc[1], "w");
      toproc_stream =  xsb_intern_fileptr(CTXTc toprocess_fptr,callname,"pipe","w",CURRENT_CHARSET); 
      ctop_int(CTXTc 3, toproc_stream);
    }
    if (fromproc_needed) {
      fromprocess_fptr = fdopen(pipe_from_proc[0], "r");
      fromproc_stream =  xsb_intern_fileptr(CTXTc fromprocess_fptr,callname,"pipe","r",CURRENT_CHARSET); 
      ctop_int(CTXTc 4, fromproc_stream);
    }
    if (fromstderr_needed) {
      fromproc_stderr_fptr = fdopen(pipe_from_stderr[0], "r");
      fromproc_stderr_stream
	= xsb_intern_fileptr(CTXTc fromproc_stderr_fptr,callname,"pipe","r",CURRENT_CHARSET); 
      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 (!(isointeger(pid_term)))
      xsb_abort("[PROCESS_STATUS] Arg 1 (process id) must be an integer");
    pid = (int)oint_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 (!(isointeger(pid_term)))
      xsb_abort("[PROCESS_CONTROL] Arg 1 (process id) must be an integer");
    pid = (int)oint_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(CTXTc "[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 int bindReturnList(prolog_term returnList, struct xsb_data** result, struct xsb_queryHandle* qHandle)
{
  prolog_term element;
  char* temp;
  char c;
  int i, j;
  int rFlag;
  
  if (is_nil(returnList) && result == NULL) {
    rFlag = RESULT_NONEMPTY_OR_NOT_REQUESTED;
  }

  if (!is_nil(returnList) && result == NULL && qHandle->state == QUERY_BEGIN) {
    errorMesg = "XSB_DBI_ERROR: Invalid return list in query";
    errorNumber = "XSB_DBI_013";
    rFlag = INVALID_RETURN_LIST;
  }  
  else if (!is_nil(returnList) && result == NULL) {
    while (!is_nil(returnList)) {
      element = p2p_car(returnList);
      c2p_nil(CTXTc element);
      returnList = p2p_cdr(returnList);
    }
    rFlag = RESULT_EMPTY_BUT_REQUESTED;
  }

  i = 0;
  if (result != NULL) {
    while (!is_nil(returnList)) {
      if (qHandle->numResultCols <= i) {
	errorMesg = "XSB_DBI ERROR: Number of requested columns exceeds the number of columns in the query";
	errorNumber = "XSB_DBI_011";
	rFlag = TOO_MANY_RETURN_COLS;
	return rFlag;
      }
      element = p2p_car(returnList);
      if (result == NULL) {
	c2p_nil(CTXTc element);
      }
      else if (is_var(element) && result[i]->type == STRING_TYPE) {
	if (result[i]->val == NULL)
	  c2p_nil(CTXTc element);
	else {
	  c = result[i]->val->str_val[0];
	  if (c == DB_INTERFACE_TERM_SYMBOL) {
	    temp = (char *)malloc(strlen(result[i]->val->str_val) * sizeof(char));
	    for (j = 1 ; j < (int)strlen(result[i]->val->str_val) ; j++) {
	      temp[j-1] = result[i]->val->str_val[j];
	    }
	    temp[strlen(result[i]->val->str_val) - 1] = '\0';
	    c2p_functor(CTXTc "term", 1, element);
	    c2p_string(CTXTc temp, p2p_arg(element, 1));    
	    if (temp != NULL) {
	      free(temp);
	      temp = NULL;
	    }
	  }
	  else {
	    c2p_string(CTXTc result[i]->val->str_val, element);
	  }
	}
      }
      else if (is_var(element) && result[i]->type == INT_TYPE)
	c2p_int(CTXTc result[i]->val->i_val, element);
      else if (is_var(element) && result[i]->type == FLOAT_TYPE)
	c2p_float(CTXTc result[i]->val->f_val, element);
      returnList = p2p_cdr(returnList);
      i++;
    }
    rFlag = RESULT_NONEMPTY_OR_NOT_REQUESTED;
  }

  if (result != NULL && qHandle->numResultCols > i) {
    errorMesg = "XSB_DBI ERROR: Number of requested columns is less than the number of returned columns";
    errorNumber = "XSB_DBI_012";
    rFlag = TOO_FEW_RETURN_COLS;
    return rFlag;
  }
  return rFlag;
}
Example #20
0
/* 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;
    Integer beg_offset=0, end_offset=0, input_len;
    Integer 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 (!(isointeger(beg_term)) ||
                !(isointeger(end_term)))
            xsb_abort("[STRING_SUBSTITUTE] Non-integer in Arg 2");
        else {
            beg_offset = oint_val(beg_term);
            end_offset = oint_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,(int)(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);
}
DllExport int call_conv executePreparedStatement(void)
{
  struct xsb_data** (*executeStmtDriver)(struct xsb_data**, struct xsb_queryHandle*);
  char* (*errorMesgDriver)();
  void (*freeResultDriver)();
  struct xsb_queryHandle* qHandle;
  struct xsb_connectionHandle* cHandle;
  struct xsb_data** bindValues;
  struct xsb_data** result;
  prolog_term bindList, returnList, element;
  char *queryHandle, *chandle;
  int i, val;

  queryHandle = ptoc_string(CTXTc 1);
  bindList = reg_term(CTXTc 2);
  returnList = reg_term(CTXTc 3);
  qHandle = NULL; 
  cHandle = NULL;
  bindValues = NULL;
  result = NULL;

  if ((qHandle = isQueryHandle(queryHandle)) == NULL) {
    errorMesg = "XSB_DBI ERROR: Query handle does not exist";
    errorNumber = "XSB_DBI_005";
    return FALSE;
  }
  if (qHandle->state == QUERY_BEGIN) {
    bindValues =
      (struct xsb_data **)malloc(qHandle->numParams * sizeof(struct xsb_data *));
    for (i = 0 ; i < qHandle->numParams ; i++) 
      bindValues[i] = NULL;
    for (i = 0 ; i < qHandle->numParams ; i++) {
      bindValues[i] = (struct xsb_data *)malloc(sizeof(struct xsb_data));
      bindValues[i]->val = NULL; 
      if (is_nil(bindList)) {
	errorMesg = "XSB_DBI ERROR: Not all paremeters supplied";
	errorNumber = "XSB_DBI_008";
        freeBindValues(bindValues,qHandle->numParams); 
	return FALSE;
      }
      element = p2p_car(bindList);
      if (is_string(element)) {
	bindValues[i]->type = STRING_TYPE;
	bindValues[i]->length = strlen(p2c_string(element));
	bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
	bindValues[i]->val->str_val = p2c_string(element);
      }
      else if (is_int(element)) {
	bindValues[i]->type = INT_TYPE;
	bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
	bindValues[i]->val->i_val = p2c_int(element);
      }
      else if (is_float(element)) {
	bindValues[i]->type = FLOAT_TYPE;
	bindValues[i]->val = (union xsb_value *)malloc(sizeof(union xsb_value));
	bindValues[i]->val->f_val = p2c_float(element);
      }
      else if (is_functor(element)) {
      }
      else if (is_var(element)) {
	errorMesg = "XSB_DBI ERROR: Unbound variable in parameter list";
	errorNumber = "XSB_DBI_009";
        freeBindValues(bindValues,qHandle->numParams); 
	return FALSE;
      }
      bindList = p2p_cdr(bindList);
    }
  }
	
  if (getDriverFunction(qHandle->connHandle->driver, EXEC_PREPARE) != NULL)
    executeStmtDriver =
      getDriverFunction(qHandle->connHandle->driver, EXEC_PREPARE)->executeStmtDriver;
  else{
    freeBindValues(bindValues,qHandle->numParams); 
    return FALSE;
  }
  result = executeStmtDriver(bindValues, qHandle);

  freeBindValues(bindValues,qHandle->numParams); 
  if (result == NULL && qHandle->state == QUERY_BEGIN) {
    if (getDriverFunction(qHandle->connHandle->driver, ERROR_MESG) != NULL)
      errorMesgDriver =
	getDriverFunction(qHandle->connHandle->driver, ERROR_MESG)->errorMesgDriver;
    else
      return FALSE;
    
    errorMesg = errorMesgDriver();
    if (errorMesg != NULL)
      return FALSE;
  }
  
  val = bindReturnList(returnList, result, qHandle);

  if (result == NULL) {
    qHandle->state = QUERY_BEGIN;
  }
  else {
    if (getDriverFunction(qHandle->connHandle->driver, FREE_RESULT) != NULL)
      freeResultDriver = getDriverFunction(qHandle->connHandle->driver, FREE_RESULT)->freeResultDriver;
    else 
      return FALSE;

    freeResultDriver(result, qHandle->numResultCols); 
  }

  if (val == TOO_MANY_RETURN_COLS || val == TOO_FEW_RETURN_COLS || val == INVALID_RETURN_LIST)
    return FALSE;

  cHandle = qHandle->connHandle;
  chandle = cHandle->handle;
  if ((cHandle = isConnectionHandle(chandle)) != NULL) {
    if (getDriverFunction(cHandle->driver, ERROR_MESG) != NULL)
      errorMesgDriver =
	getDriverFunction(cHandle->driver, ERROR_MESG)->errorMesgDriver;
    else
      return FALSE;
	  
    errorMesg = errorMesgDriver();
    errorNumber = "XSB_DBI_000";
  }

  /* 
     if (errorMesg == NULL && (val == RESULT_NONEMPTY_OR_NOT_REQUESTED
			    || val == RESULT_EMPTY_BUT_REQUESTED)){
  */
  if (errorMesg == NULL && val == RESULT_NONEMPTY_OR_NOT_REQUESTED) {
    return TRUE;
  }
  else
    return FALSE;
}