예제 #1
0
파일: string_xsb.c 프로젝트: jianqiao/code
/*
  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 size_t 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 */
    Integer 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 (isointeger(beg_offset_term)) {
        if (oint_val(beg_offset_term) < 0) {
            beg_bos_offset = FALSE;
        }
    }
    if (isointeger(end_offset_term)) {
        if (oint_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)));
}
int  get_incr_sccs(CTXTdeclc Cell listterm) {
  Cell orig_listterm, intterm, node;
    long int node_num=0;
    int i = 0, dfn, component = 1;     int * dfn_stack; int dfn_top = 0, ret;
    SCCNode * nodes;
    struct hashtable_itr *itr;     struct hashtable* hasht; 
    XSB_Deref(listterm);
    hasht = create_hashtable1(HASH_TABLE_SIZE, hashid, equalkeys);
    orig_listterm = listterm;
    intterm = get_list_head(listterm);
    XSB_Deref(intterm);
    //    printf("listptr %p @%p\n",listptr,(CPtr) int_val(*listptr));
    insert_some(hasht,(void *) oint_val(intterm),(void *) node_num);
    node_num++; 

    listterm = get_list_tail(listterm);
    XSB_Deref(listterm);
    while (!isnil(listterm)) {
      intterm = get_list_head(listterm);
      XSB_Deref(intterm);
      node = oint_val(intterm);
      if (NULL == search_some(hasht, (void *)node)) {
	insert_some(hasht,(void *)node,(void *)node_num);
	node_num++;
      }
      listterm = get_list_tail(listterm);
      XSB_Deref(listterm);
    }
    nodes = (SCCNode *) mem_calloc(node_num, sizeof(SCCNode),OTHER_SPACE); 
    dfn_stack = (int *) mem_alloc(node_num*sizeof(int),OTHER_SPACE); 
    listterm = orig_listterm;; 
    //printf("listptr %p @%p\n",listptr,(void *)int_val(*(listptr)));
    intterm = get_list_head(listterm);
    XSB_Deref(intterm);
    nodes[0].node = (CPtr) oint_val(intterm);
    listterm = get_list_tail(listterm);
    XSB_Deref(listterm);
    i = 1;
    while (!isnil(listterm)) {
      intterm = get_list_head(listterm);
      XSB_Deref(intterm);
      node = oint_val(intterm);
      nodes[i].node = (CPtr) node;
      listterm = get_list_tail(listterm);
      XSB_Deref(listterm);
      i++;
    }
    itr = hashtable1_iterator(hasht);       
    SQUASH_LINUX_COMPILER_WARN(itr);
    //    do {
    //      printf("k %p val %p\n",hashtable1_iterator_key(itr),hashtable1_iterator_value(itr));
    //    } while (hashtable1_iterator_advance(itr));

    listterm = orig_listterm;
    //    printf("2: k %p v %p\n",(void *) int_val(*listptr),
    //	   search_some(hasht,(void *) int_val(*listptr)));

    //    while (!isnil(*listptr)) {  now all wrong...
    //      listptr = listptr + 1;
    //      node = int_val(*clref_val(listptr));
    //      printf("2: k %p v %p\n",(CPtr) node,search_some(hasht,(void *) node));
    //      listptr = listptr + 1;
    //    }
    dfn = 1;
    for (i = 0; i < node_num; i++) {
      if (nodes[i].dfn == 0) 
	xsb_compute_scc(nodes,dfn_stack,i,&dfn_top,hasht,&dfn,&component);
      //      printf("++component for node %d is %d (high %d)\n",i,nodes[i].component,component);
    }
    ret = return_scc_list(CTXTc  nodes, node_num);
    hashtable1_destroy(hasht,0);
    mem_dealloc(nodes,node_num*sizeof(SCCNode),OTHER_SPACE); 
    mem_dealloc(dfn_stack,node_num*sizeof(int),OTHER_SPACE); 
    return ret;
}
예제 #3
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;
}
예제 #4
0
/* in order to save builtin numbers, create a single socket function with
 * options socket_request(SockOperation,....)  */
xsbBool xsb_socket_request(CTXTdecl)
{
  int ecode = 0;  /* error code for socket ops */
  int timeout_flag;
  SOCKET sock_handle;
  int domain, portnum;
  SOCKADDR_IN socket_addr;
  struct linger sock_linger_opt;
  int rc;
  char *message_buffer = NULL; /* initialized to keep compiler happy */
  UInteger msg_len = 0;	  /* initialized to keep compiler happy */
  char char_read;

  switch (ptoc_int(CTXTc 1)) {
  case SOCKET_ROOT: /* this is the socket() request */
    /* socket_request(SOCKET_ROOT,+domain,-socket_fd,-Error,_,_,_) 
       Currently only AF_INET domain */
    domain = (int)ptoc_int(CTXTc 2); 
    if (!translate_domain(domain, &domain)) {
      return FALSE;
    }
    
    sock_handle = socket(domain, SOCK_STREAM, IPPROTO_TCP);
	
    /* error handling */
    if (BAD_SOCKET(sock_handle)) {
      ecode = XSB_SOCKET_ERRORCODE;
      perror("SOCKET_REQUEST");
    } else {
      ecode = SOCK_OK;
    }

    ctop_int(CTXTc 3, (SOCKET) sock_handle);
	
    return set_error_code(CTXTc ecode, 4, "SOCKET_REQUEST");

  case SOCKET_BIND:
    /* socket_request(SOCKET_BIND,+domain,+sock_handle,+port,-Error,_,_) 
       Currently only supports AF_INET */
    sock_handle = (SOCKET) ptoc_int(CTXTc 3);
    portnum = (int)ptoc_int(CTXTc 4);
    domain = (int)ptoc_int(CTXTc 2);

    if (!translate_domain(domain, &domain)) {
      return FALSE;
    }
    
    /* Bind server to the agreed upon port number.
    ** See commdef.h for the actual port number. */
    FillWithZeros(socket_addr);
    socket_addr.sin_port = htons((unsigned short)portnum);
    socket_addr.sin_family = AF_INET;
#ifndef WIN_NT
    socket_addr.sin_addr.s_addr = htonl(INADDR_ANY);
#endif
    
    rc = bind(sock_handle, (PSOCKADDR) &socket_addr, sizeof(socket_addr));
	
    /* error handling */
    if (SOCKET_OP_FAILED(rc)) {
      ecode = XSB_SOCKET_ERRORCODE;
      perror("SOCKET_BIND");
    } else
      ecode = SOCK_OK;

    return set_error_code(CTXTc ecode, 5, "SOCKET_BIND");

  case SOCKET_LISTEN: 
    /* socket_request(SOCKET_LISTEN,+sock_handle,+length,-Error,_,_,_) */
    sock_handle = (SOCKET) ptoc_int(CTXTc 2);
    rc = listen(sock_handle, (int)ptoc_int(CTXTc 3));

    /* error handling */
    if (SOCKET_OP_FAILED(rc)) {
      ecode = XSB_SOCKET_ERRORCODE;
      perror("SOCKET_LISTEN");
    } else
      ecode = SOCK_OK;

    return set_error_code(CTXTc ecode, 4, "SOCKET_LISTEN");

  case SOCKET_ACCEPT:
    timeout_flag = socket_accept(CTXTc (SOCKET *)&rc, (int)pflags[SYS_TIMER]);
	  
    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
    } else {
      /* error handling */ 
      if (BAD_SOCKET(rc)) {
	ecode = XSB_SOCKET_ERRORCODE;
	perror("SOCKET_ACCEPT");
	sock_handle = rc; /* shut up warning */
      } else {
	sock_handle = rc; /* accept() returns sock_out */
	ecode = SOCK_OK;
      }
	       
      ctop_int(CTXTc 3, (SOCKET) sock_handle);
	       
      return set_error_code(CTXTc ecode,  4,  "SOCKET_ACCEPT");	  
    }
  case SOCKET_CONNECT: {
    /* socket_request(SOCKET_CONNECT,+domain,+sock_handle,+port,
       +hostname,-Error) */
    timeout_flag = socket_connect(CTXTc &rc, (int)pflags[SYS_TIMER]);

    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 6, "SOCKET_CONNECT");
    } else if (timeout_flag == TIMER_SETUP_ERR) {
      return set_error_code(CTXTc TIMER_SETUP_ERR, 6, "SOCKET_CONNECT");
    } else {
      /* error handling */
      if (SOCKET_OP_FAILED(rc)) {
	ecode = XSB_SOCKET_ERRORCODE;
	perror("SOCKET_CONNECT");
	/* close, because if connect() fails then socket becomes unusable */
	closesocket(ptoc_int(CTXTc 3));
      } else {
	ecode = SOCK_OK;
      }
      return set_error_code(CTXTc ecode,  6,  "SOCKET_CONNECT");
    }
  }

  case SOCKET_CLOSE: 
    /* socket_request(SOCKET_CLOSE,+sock_handle,-Error,_,_,_,_) */
    
    sock_handle = (SOCKET)ptoc_int(CTXTc 2);
    
    /* error handling */
    rc = closesocket(sock_handle);
    if (SOCKET_OP_FAILED(rc)) {
      ecode = XSB_SOCKET_ERRORCODE;
      perror("SOCKET_CLOSE");
    } else
      ecode = SOCK_OK;
    
    return set_error_code(CTXTc ecode, 3, "SOCKET_CLOSE");
    
  case SOCKET_RECV:
    /* socket_request(SOCKET_RECV,+Sockfd, -Msg, -Error,_,_,_) */
    // TODO: consider adding protection against interrupts, EINTR, like
    //       in socket_get0.
    timeout_flag = socket_recv(CTXTc &rc, &message_buffer, &msg_len, (int)pflags[SYS_TIMER]);
	  
    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
    } else {
      /* error handling */
      switch (rc) {
      case SOCK_OK:
	ecode = SOCK_OK;
	break;
      case SOCK_READMSG_FAILED:
	ecode = XSB_SOCKET_ERRORCODE;
	perror("SOCKET_RECV");
	break;
      case SOCK_READMSG_EOF:
	ecode = SOCK_EOF;
	break;
      case SOCK_HEADER_LEN_MISMATCH:
	ecode = XSB_SOCKET_ERRORCODE;
	break;
      default:
	xsb_abort("XSB bug: [SOCKET_RECV] invalid return code from readmsg");
      }
	       
      if (message_buffer != NULL) {
	/* use message_buffer+XSB_MSG_HEADER_LENGTH because the first
	   XSB_MSG_HEADER_LENGTH bytes are for the message length header */
	ctop_string(CTXTc 3, (char*)message_buffer+XSB_MSG_HEADER_LENGTH);
	mem_dealloc(message_buffer,msg_len,OTHER_SPACE);
      } else {  /* this happens at the end of a file */
	ctop_string(CTXTc 3, (char*)"");
      }
	       
      return set_error_code(CTXTc ecode, 4, "SOCKET_RECV");  
    }
	       
  case SOCKET_SEND:
    /* socket_request(SOCKET_SEND,+Sockfd, +Msg, -Error,_,_,_) */
    timeout_flag = socket_send(CTXTc &rc, (int)pflags[SYS_TIMER]);
    
    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
    } else {
      /* error handling */
      if (SOCKET_OP_FAILED(rc)) {
	ecode = XSB_SOCKET_ERRORCODE;
	perror("SOCKET_SEND");
      } else {
	ecode = SOCK_OK;
      }
      return set_error_code(CTXTc ecode,  4,  "SOCKET_SEND"); 
    }

  case SOCKET_GET0:
    /* socket_request(SOCKET_GET0,+Sockfd,-C,-Error,_,_,_) */
    message_buffer = &char_read;
    timeout_flag = socket_get0(CTXTc &rc, message_buffer, (int)pflags[SYS_TIMER]);
	  
    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
    } else {
      /*error handling */ 
      switch (rc) {
      case 1:
	ctop_int(CTXTc 3,(unsigned char)message_buffer[0]);
	ecode = SOCK_OK;
	break;
      case 0:
	ecode = SOCK_EOF;
	break;
      default:
	ctop_int(CTXTc 3,-1);
	perror("SOCKET_GET0");
	ecode = XSB_SOCKET_ERRORCODE;
      }
	       
      return set_error_code(CTXTc ecode,  4,  "SOCKET_GET0");
    }    
  case SOCKET_PUT:
    /* socket_request(SOCKET_PUT,+Sockfd,+C,-Error_,_,_) */
    timeout_flag = socket_put(CTXTc &rc, (int)pflags[SYS_TIMER]);
	       
    if (timeout_flag == TIMED_OUT) {
      return set_error_code(CTXTc TIMEOUT_ERR, 4, "SOCKET_SEND");
    } else {
      /* error handling */
      if (rc == 1) {
	ecode = SOCK_OK;
      } else if (SOCKET_OP_FAILED(rc)) {
	ecode = XSB_SOCKET_ERRORCODE;
	perror("SOCKET_PUT");
      }
	       
      return set_error_code(CTXTc ecode,  4,  "SOCKET_PUT");
    }
  case SOCKET_SET_OPTION: {
    /* socket_request(SOCKET_SET_OPTION,+Sockfd,+OptionName,+Value,_,_,_) */
    
    char *option_name = ptoc_string(CTXTc 3);
    
    sock_handle = (SOCKET)ptoc_int(CTXTc 2);

    /* Set the "linger" parameter to a small number of seconds */
    if (0==strcmp(option_name,"linger")) {
      int  linger_time=(int)ptoc_int(CTXTc 4);
      
      if (linger_time < 0) {
	sock_linger_opt.l_onoff = FALSE;
	sock_linger_opt.l_linger = 0;
      } else {
	sock_linger_opt.l_onoff = TRUE;
	sock_linger_opt.l_linger = linger_time;
      }
      
      if (SETSOCKOPT(sock_handle, SOL_SOCKET, SO_LINGER,
		     &sock_linger_opt, sizeof(sock_linger_opt))
	  < 0) {
	xsb_warn(CTXTc "[SOCKET_SET_OPTION] Cannot set socket linger time");
	return FALSE;
      } 
    }else {
      xsb_warn(CTXTc "[SOCKET_SET_OPTION] Invalid option, `%s'", option_name);
      return FALSE;
    }
    
    return TRUE;
  }

  case SOCKET_SET_SELECT:  {  
    /*socket_request(SOCKET_SET_SELECT,+connection_name,
      +R_sockfd,+W_sockfd,+E_sockfd) */
    prolog_term R_sockfd, W_sockfd, E_sockfd;
    int i, connection_count;
    int rmax_fd=0, wmax_fd=0, emax_fd=0; 
    char *connection_name = ptoc_string(CTXTc 2);
    
    /* bind fds to input arguments */
    R_sockfd = reg_term(CTXTc 3);
    W_sockfd = reg_term(CTXTc 4);
    E_sockfd = reg_term(CTXTc 5);	
    
    /* initialize the array of connect_t structure for select call */	
    init_connections(CTXT); 
    
    SYS_MUTEX_LOCK(MUTEX_SOCKETS);
    /* check whether the same connection name exists */
    for (i=0;i<MAXCONNECT;i++) {
      if ((connections[i].empty_flag==FALSE) &&
	  (strcmp(connection_name,connections[i].connection_name)==0)) 	
	xsb_abort("[SOCKET_SET_SELECT] Connection `%s' already exists!",
		  connection_name);
    }
    
    /* check whether there is empty slot left for connection */	
    if ((connection_count=checkslot())<MAXCONNECT) {
      if (connections[connection_count].connection_name == NULL) {
	connections[connection_count].connection_name = connection_name;
	connections[connection_count].empty_flag = FALSE;
	
	/* call the utility function separately to take the fds in */
	list_sockfd(R_sockfd, &connections[connection_count].readset,
		    &rmax_fd, &connections[connection_count].read_fds,
		    &connections[connection_count].sizer);
	list_sockfd(W_sockfd, &connections[connection_count].writeset,
		    &wmax_fd, &connections[connection_count].write_fds,
		    &connections[connection_count].sizew);
	list_sockfd(E_sockfd, &connections[connection_count].exceptionset, 
		    &emax_fd,&connections[connection_count].exception_fds,
		    &connections[connection_count].sizee);
	
	connections[connection_count].maximum_fd =
	  xsb_max(xsb_max(rmax_fd,wmax_fd), emax_fd);
      } else 
	/* if this one is reached, it is probably a bug */
	xsb_abort("[SOCKET_SET_SELECT] All connections are busy!");
    } else
      xsb_abort("[SOCKET_SET_SELECT] Max number of collections exceeded!");
    SYS_MUTEX_UNLOCK(MUTEX_SOCKETS);
    
    return TRUE;
  }
  
  case SOCKET_SELECT: {
    /* socket_request(SOCKET_SELECT,+connection_name, +timeout
       -avail_rsockfds,-avail_wsockfds,
       -avail_esockfds,-ecode)
       Returns 3 prolog_terms for available socket fds */

    prolog_term Avail_rsockfds, Avail_wsockfds, Avail_esockfds;
    prolog_term Avail_rsockfds_tail, Avail_wsockfds_tail, Avail_esockfds_tail;

    int maxfd;
    int i;       /* index for connection_count */
    char *connection_name = ptoc_string(CTXTc 2);
    struct timeval *tv;
    prolog_term timeout_term;
    int timeout =0;
    int connectname_found = FALSE;
    int count=0;			

    SYS_MUTEX_LOCK(MUTEX_SOCKETS);
    /* specify the time out */
    timeout_term = reg_term(CTXTc 3);
    if (isointeger(timeout_term)) {
      timeout = (int)oint_val(timeout_term);
      /* initialize tv */
      tv = (struct timeval *)mem_alloc(sizeof(struct timeval),LEAK_SPACE);
      tv->tv_sec = timeout;
      tv->tv_usec = 0;
    } else
      tv = NULL; /* no timeouts */

    /* initialize the prolog term */ 
    Avail_rsockfds = p2p_new(CTXT);
    Avail_wsockfds = p2p_new(CTXT);
    Avail_esockfds = p2p_new(CTXT); 

    /* bind to output arguments */
    Avail_rsockfds = reg_term(CTXTc 4);
    Avail_wsockfds = reg_term(CTXTc 5);
    Avail_esockfds = reg_term(CTXTc 6);

    Avail_rsockfds_tail = Avail_rsockfds;
    Avail_wsockfds_tail = Avail_wsockfds;
    Avail_esockfds_tail = Avail_esockfds;

    /*
      // This was wrong. Lists are now made inside test_ready()
      c2p_list(CTXTc Avail_rsockfds_tail);
      c2p_list(CTXTc Avail_wsockfds_tail);	
      c2p_list(CTXTc Avail_esockfds_tail); 
    */
    
    for (i=0; i < MAXCONNECT; i++) {
      /* find the matching connection_name to select */
      if(connections[i].empty_flag==FALSE) {
	if (strcmp(connection_name, connections[i].connection_name) == 0) {
	  connectname_found = TRUE;
	  count = i;
	  break;
	} 
      }
    }
    if( i >= MAXCONNECT )  /* if no matching connection_name */
      xsb_abort("[SOCKET_SELECT] connection `%s' doesn't exist",
		connection_name); 
    
    /* compute maxfd for select call */
    maxfd = connections[count].maximum_fd + 1;

    /* FD_SET all sockets */
    set_sockfd( CTXTc count );

    /* test whether the socket fd is available */
    rc = select(maxfd, &connections[count].readset, 
		&connections[count].writeset,
		&connections[count].exceptionset, tv);
    
    /* error handling */	
    if (rc == 0)     /* timed out */
      ecode = TIMEOUT_ERR;
    else if (SOCKET_OP_FAILED(rc)) {
      perror("SOCKET_SELECT");
      ecode = XSB_SOCKET_ERRORCODE;
    } else {      /* no error */
      ecode = SOCK_OK;
	 
      /* call the utility function to return the available socket fds */
      test_ready(CTXTc &Avail_rsockfds_tail, &connections[count].readset,
		 connections[count].read_fds,connections[count].sizer);

      test_ready(CTXTc &Avail_wsockfds_tail, &connections[count].writeset,
		 connections[count].write_fds,connections[count].sizew);

      test_ready(CTXTc &Avail_esockfds_tail,&connections[count].exceptionset,
		 connections[count].exception_fds,connections[count].sizee);
    }
    SYS_MUTEX_UNLOCK(MUTEX_SOCKETS);

    if (tv) mem_dealloc((struct timeval *)tv,sizeof(struct timeval),LEAK_SPACE);
    SQUASH_LINUX_COMPILER_WARN(connectname_found) ; 
    return set_error_code(CTXTc ecode, 7, "SOCKET_SELECT");
  }

  case SOCKET_SELECT_DESTROY:  { 
    /*socket_request(SOCKET_SELECT_DESTROY, +connection_name) */
    char *connection_name = ptoc_string(CTXTc 2);
    select_destroy(CTXTc connection_name);
    return TRUE;
  }

  default:
    xsb_warn(CTXTc "[SOCKET_REQUEST] Invalid socket request %d", (int) ptoc_int(CTXTc 1));
    return FALSE;
  }

  /* This trick would report a bug, if a newly added case
     doesn't have a return clause */
  xsb_bug("SOCKET_REQUEST case %d has no return clause", ptoc_int(CTXTc 1));
}
예제 #5
0
파일: string_xsb.c 프로젝트: jianqiao/code
/* 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);
}
예제 #6
0
파일: string_xsb.c 프로젝트: jianqiao/code
/* 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 */
    Integer 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 (! (isointeger(beg_offset_term)))
        xsb_abort("[SUBSTRING] Arg 2 (the beginning offset) must be an integer");
    beg_offset = oint_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 (! (isointeger(end_offset_term)))
        xsb_abort("[SUBSTRING] Arg 3 (the end offset) must be integer or _");
    else end_offset = oint_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, (int)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);
}
예제 #7
0
파일: odbc_xsb.c 프로젝트: eden/navajoverb
/*-----------------------------------------------------------------------------*/
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;
}