示例#1
0
文件: string_xsb.c 项目: flavioc/XSB
/*
  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)));
}
示例#2
0
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;
				}
			}
		}
	}
}
示例#3
0
文件: cgi.c 项目: miar/yaptab-linear
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;
}
示例#4
0
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");
    }
  }
示例#6
0
文件: mexutil.c 项目: jvbenavi/c_prj
/**
* 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;
	}
}
示例#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;
}
示例#8
0
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();
}
示例#9
0
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;
	}
}
示例#10
0
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;
 //
}
示例#11
0
/***************************************************************************//**
 * @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;
}
示例#12
0
/***************************************************************************//**
 * @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;
}
示例#13
0
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();
	}
}
示例#14
0
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);
}
示例#16
0
文件: string_xsb.c 项目: flavioc/XSB
/* 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);
}
示例#17
0
文件: string_xsb.c 项目: flavioc/XSB
/* 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);
}
示例#18
0
文件: system_xsb.c 项目: flavioc/XSB
/* 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;
}
示例#19
0
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;
}
示例#20
0
文件: subp.c 项目: flavioc/XSB
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;
  }
}
示例#21
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;
}