int get_bulk_match_result__( void ) {
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
if (perlObjectStatus == UNLOADED ) {
load_perl__();
return(FAILURE);
}
if ( bulkMatchList[ptoc_int(CTXTc 1)] == NULL )
return FAILURE; /*no match*/
else{
int match_seq_number= ptoc_int(CTXTc 1);
int match_array_sz= ptoc_int(CTXTc 3);
if (match_seq_number < match_array_sz) {
/* c2p_string(CTXTc bulkMatchList[match_seq_number], reg_term(CTXTc 2)); */
ctop_string(CTXTc 2, (char *)string_find(bulkMatchList[match_seq_number],1));
return SUCCESS;
}
else return FAILURE;
}
}
static int socket_put(CTXTdeclc int *rc, int timeout) {
SOCKET sock_handle;
char tmpch;
sock_handle = (SOCKET) ptoc_int(CTXTc 2);
tmpch = (char)ptoc_int(CTXTc 3);
if (write_select(sock_handle, timeout)) {
*rc = sendto(sock_handle, &tmpch, 1, 0, NULL,0);
return NORMAL_TERMINATION;
} else {
return TIMED_OUT;
}
}
/*-----------------------------------------------------------------------------*/
void ODBCColumns()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
char tmpstr[255];
char *str1, *str2, *str3;
RETCODE rc;
strcpy(tmpstr,ptoc_string(3));
str1 = strtok(tmpstr,".");
str2 = str3 = NULL;
if (str1) str2 = strtok(NULL,".");
if (str2) str3 = strtok(NULL,".");
if (!str3 && !str2) {str3 = str1; str1 = NULL;}
else if (!str3) {str3 = str2; str2 = NULL;}
/* printf("str1 %s, str2 %s, str3 %s\n",str1,str2,str3);*/
if (((rc=SQLColumns(cur->hstmt,
str1, SQL_NTS,
str2, SQL_NTS,
str3, SQL_NTS,
NULL,0)) == SQL_SUCCESS) ||
(rc == SQL_SUCCESS_WITH_INFO)) {
ctop_int(4,0);
} else {
ctop_int(4,PrintErrorMsg(cur));
SetCursorClose(cur);
}
return;
}
static int socket_send(CTXTdeclc int *rc, int timeout) {
SOCKET sock_handle = (SOCKET) ptoc_int(CTXTc 2);
char *send_msg_aux = ptoc_string(CTXTc 3);
size_t msg_body_len, full_msg_len, network_encoded_len;
char *message_buffer;
if (!write_select(sock_handle, timeout)) {
return TIMED_OUT;
}
/* We we add 1 since the message is a string that ends with a '\0' (this is
how it is pased from XSB to send_msg_aux) */
msg_body_len = strlen(send_msg_aux)+1;
full_msg_len = msg_body_len+XSB_MSG_HEADER_LENGTH;
/* We use the first XSB_MSG_HEADER_LENGTH bytes for the message size. */
message_buffer = mem_calloc(full_msg_len, sizeof(char),LEAK_SPACE);
network_encoded_len = htonl((u_long)msg_body_len);
memcpy((void*)(message_buffer), (void *)&network_encoded_len, XSB_MSG_HEADER_LENGTH);
strcpy(message_buffer+XSB_MSG_HEADER_LENGTH, send_msg_aux);
*rc = sendto(sock_handle, message_buffer, (int)full_msg_len, 0, NULL, 0);
mem_dealloc(message_buffer,full_msg_len*sizeof(char),LEAK_SPACE);
return NORMAL_TERMINATION;
}
/*-----------------------------------------------------------------------------*/
void ODBCTables()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
RETCODE rc;
if (cur->Status == 2) { /* reusing opened cursor*/
rc = SQLFreeStmt(cur->hstmt,SQL_CLOSE);
if ((rc != SQL_SUCCESS) && (rc != SQL_SUCCESS_WITH_INFO)) {
ctop_int(3, PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
}
if (((rc=SQLTables(cur->hstmt,
NULL, 0,
NULL, 0,
NULL, 0,
NULL, 0)) == SQL_SUCCESS) ||
(rc == SQL_SUCCESS_WITH_INFO)) {
ctop_int(3,0);
} else {
ctop_int(3,PrintErrorMsg(cur));
SetCursorClose(cur);
}
return;
}
/*-----------------------------------------------------------------------------*/
void ODBCUserTables()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
UWORD TablePrivilegeExists;
RETCODE rc;
/* since some ODBC drivers don't implement the function SQLTablePrivileges*/
/* we check it first*/
SQLGetFunctions(cur->hdbc,SQL_API_SQLTABLEPRIVILEGES,&TablePrivilegeExists);
if (!TablePrivilegeExists) {
printf("Privilege concept does not exist in this DVMS: you probably can access any of the existing tables\n");
ctop_int(3, 2);
return;
}
if (((rc=SQLTablePrivileges(cur->hstmt,
NULL, 0,
NULL, 0,
NULL, 0)) == SQL_SUCCESS) ||
(rc == SQL_SUCCESS_WITH_INFO))
ctop_int(3,0);
else {
ctop_int(3,PrintErrorMsg(cur));
SetCursorClose(cur);
}
return;
}
static int socket_recv(CTXTdeclc int *rc, char** buffer, UInteger *buffer_len, int timeout) {
SOCKET sock_handle = (SOCKET) ptoc_int(CTXTc 2);
if (read_select(sock_handle, timeout)) {
*rc = readmsg(sock_handle, buffer, buffer_len);
return NORMAL_TERMINATION;
} else
return TIMED_OUT;
}
/*-----------------------------------------------------------------------------*/
void ODBCConnectOption()
{
HDBC hdbc = (HDBC)ptoc_int(2);
int set = ptoc_int(3);
long value = 0;
RETCODE rc;
if (set) {
rc = SQLSetConnectOption(hdbc,(UWORD)ptoc_int(4),(UDWORD)ptoc_int(5));
} else {
rc = SQLGetConnectOption(hdbc,(UWORD)ptoc_int(4),(PTR)&value);
ctop_int(5,value);
}
if ((rc == SQL_SUCCESS) || (rc == SQL_SUCCESS_WITH_INFO))
ctop_int(6,0);
else ctop_int(6,PrintErrorMsg(NULL));
}
static int socket_accept(CTXTdeclc SOCKET *sock_handle, int timeout) {
SOCKET sock_handle_in = (SOCKET) ptoc_int(CTXTc 2);
if (read_select(sock_handle_in, timeout)) {
*sock_handle = accept(sock_handle_in, NULL, NULL);
return NORMAL_TERMINATION;
} else {
return TIMED_OUT;
}
}
/*-----------------------------------------------------------------------------*/
void SetBindVarNum()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
int NumBindVars = ptoc_int(3);
if (cur->Status == 2) {
if (cur->NumBindVars != NumBindVars)
xsb_exit("Number of Bind values provided does not agree with query\n");
return;
}
cur->NumBindVars = NumBindVars;
cur->BindList = malloc(sizeof(UCHAR *) * NumBindVars);
if (!cur->BindList)
xsb_exit("Not enough memory for cur->BindList!");
cur->BindTypes = malloc(sizeof(int) * NumBindVars);
if (!cur->BindTypes)
xsb_exit("Not enough memory for cur->BindTypes!");
}
/*-----------------------------------------------------------------------------*/
void Parse()
{
int j;
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
RETCODE rc;
if (cur->Status == 2) { /* reusing opened cursor*/
rc = SQLFreeStmt(cur->hstmt,SQL_CLOSE);
if ((rc != SQL_SUCCESS) && (rc != SQL_SUCCESS_WITH_INFO)) {
ctop_int(3, PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
/* reset just char select vars, since they store addr of chars*/
for (j = 0; j < cur->NumBindVars; j++) {
if (cur->BindTypes[j] == 2)
rc = SQLBindParameter(cur->hstmt, (short)(j+1), SQL_PARAM_INPUT, SQL_C_CHAR,
SQL_CHAR, 0, 0,(char *) cur->BindList[j], 0, &SQL_NTSval);
}
} else {
if (SQLPrepare(cur->hstmt, cur->Sql, SQL_NTS) != SQL_SUCCESS) {
ctop_int(3,PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
/* set the bind variables*/
for (j = 0; j < cur->NumBindVars; j++) {
if (cur->BindTypes[j] == 2)
/* we're sloppy here. it's ok for us to use the default values*/
rc = SQLBindParameter(cur->hstmt, (short)(j+1), SQL_PARAM_INPUT, SQL_C_CHAR,
SQL_CHAR, 0, 0,(char *)cur->BindList[j], 0, &SQL_NTSval);
else if (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);
} else
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(3,PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
}
}
/* submit it for execution*/
if (SQLExecute(cur->hstmt) != SQL_SUCCESS) {
ctop_int(3,PrintErrorMsg(cur));
SetCursorClose(cur);
return;
}
ctop_int(3,0);
return;
}
int get_bulk_match_result__( void ) {
if (perlObjectStatus == UNLOADED ) {
load_perl__();
return(FAILURE);
}
if ( bulkMatchList[ptoc_int(1)] == NULL )
return FAILURE; /*no match*/
else{
int match_seq_number= ptoc_int(1);
int match_array_sz= ptoc_int(3);
if (match_seq_number < match_array_sz) {
/* c2p_string( bulkMatchList[match_seq_number], reg_term(2)); */
ctop_string(2, (char *)string_find(bulkMatchList[match_seq_number],1));
return SUCCESS;
}
else return FAILURE;
}
}
int get_match_resultC__( void ) {
int order;
#ifdef MULTI_THREAD
if( NULL == th)
th = xsb_get_main_thread();
#endif
int submatch_number=ptoc_int(CTXTc 1);
/*--------------------------------------------------------------------------
Convert from Prolog-side convention for refering to submatches to
the corresponding array index numbers in match result storage.
--------------------------------------------------------------------------*/
switch (submatch_number) {
case MATCH: /*MATCH = -1*/
order = 0; /* actual position in the memory */
break;
case PREMATCH: /*PREMATCH = -2*/
order = 1;
break;
case POSTMATCH: /*POSTMATCH = -3*/
order = 2;
break;
case LAST_PAREN_MATCH: /*LAST_PAREN_MATCH = -4*/
order = 3;
break;
default:
if ( submatch_number > MAX_SUB_MATCH ) {
char message[120];
sprintf(message,
"Specified submatch number %d exceeds the limit: %d\n",
submatch_number, MAX_SUB_MATCH);
xsb_warn(message);
order = -99;
}
else order = submatch_number+3; /* actual position in the memory */
break;
}
if (order == -99) return(FAILURE);
if ( matchPattern == NULL ) { /*didn't try_match before*/
xsb_warn("Call try_match/2 first!");
return(FAILURE);
} else if ( !strcmp(matchResults[order],"") || matchResults[order] == NULL )
return(FAILURE); /*no match found, return FAILURE */
else {
c2p_string(CTXTc matchResults[order], reg_term(CTXTc 2));
return(SUCCESS);
}
}
static int socket_get0(CTXTdeclc int *rc, char* message_read, int timeout) {
SOCKET sock_handle;
sock_handle = (SOCKET) ptoc_int(CTXTc 2);
if (read_select(sock_handle, timeout)) {
do {
XSB_SOCKET_ERRORCODE_RESET;
*rc = recvfrom(sock_handle, message_read, 1, 0, NULL, 0);
} while (*rc == -1 && XSB_SOCKET_ERRORCODE == EINTR);
return NORMAL_TERMINATION;
} else {
return TIMED_OUT;
}
}
/*-----------------------------------------------------------------------------*/
void ODBCDisconnect()
{
struct Cursor *cur = FCursor;
struct Cursor *tcur;
struct NumberofCursors *numi = FCurNum, *numj = FCurNum;
HDBC hdbc = (HDBC)ptoc_int(2);
if (!serverConnected) return;
if (hdbc == NULL) { /* close entire connection*/
if (FCursor != NULL)
xsb_abort("Must close all connections before shutting down");
SQLFreeEnv(henv);
serverConnected = 0;
return;
}
/* only free cursors associated with this connection (hdbc)*/
while((numj != NULL) && (numj->hdbc != hdbc)){
if(numj != FCurNum) numi=numi->NCurNum;
numj=numj->NCurNum;
}
if(numj != NULL){
if(numj == FCurNum) FCurNum=numj->NCurNum;
else numi->NCurNum=numj->NCurNum;
free(numj);
}
while (cur != NULL) {
if (cur->hdbc == hdbc) {
tcur = cur->NCursor;
if (cur->Status != 0) SetCursorClose(cur);
SQLFreeStmt(cur->hstmt,SQL_DROP);
if (cur->PCursor) (cur->PCursor)->NCursor = cur->NCursor;
else FCursor = cur->NCursor;
if (cur->NCursor) (cur->NCursor)->PCursor = cur->PCursor;
else LCursor = cur->PCursor;
free(cur);
/* (num->CursorCount)-- */
cur = tcur;
}
else cur = cur->NCursor;
}
SQLDisconnect(hdbc);
SQLFreeConnect(hdbc);
/* SQLFreeEnv(henv);*/
serverConnected = 0;
}
void get_statistics(CTXTdecl) {
int type;
type = ptoc_int(CTXTc 3);
switch (type) {
// runtime [since start of Prolog,since previous statistics]
// CPU time used while executing, excluding time spent
// garbage collecting, stack shifting, or in system calls.
case RUNTIME: {
double tot_cpu, incr_cpu;
tot_cpu = cpu_time();
incr_cpu = tot_cpu - last_cpu;
last_cpu = tot_cpu;
// tds.time_count = incr_cpu - time_start;
// reset_stat_total(); /* reset 'ttt' struct variable (all 0's) */
ctop_float(CTXTc 4, tot_cpu);
ctop_float(CTXTc 5, incr_cpu);
break;
}
case WALLTIME: {
double tot_wall,this_wall,incr_wall;
this_wall = real_time();
tot_wall = this_wall - realtime_count_gl;
if (!last_wall) last_wall = realtime_count_gl;
incr_wall = this_wall - last_wall;
last_wall = this_wall;
ctop_float(CTXTc 4, tot_wall);
ctop_float(CTXTc 5, incr_wall);
break;
}
case SHARED_TABLESPACE:
{
#ifdef MULTI_THREAD
statistics_inusememory(CTXTc type);
#else
xsb_abort("statistics/2 with parameter shared_tables not supported in this configuration\n");
#endif
break;
}
default: {
statistics_inusememory(CTXTc type);
break;
}
}
}
/*-----------------------------------------------------------------------------*/
void ODBCRollback()
{
struct Cursor *cur = FCursor;
HDBC hdbc = (HDBC)ptoc_int(2);
RETCODE rc;
if (((rc=SQLTransact(henv,hdbc,SQL_ROLLBACK)) == SQL_SUCCESS) ||
(rc == SQL_SUCCESS_WITH_INFO)) {
/* only close those with right hdbc*/
while (cur != NULL) {
if (cur->hdbc == hdbc && cur->Status != 0) SetCursorClose(cur);
cur = cur->NCursor;
}
ctop_int(3,0);
} else
ctop_int(3, PrintErrorMsg(NULL));
return;
}
/*-----------------------------------------------------------------------------*/
void FetchNextRow()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
RETCODE rc;
if (!serverConnected || cur->Status == 0) {
ctop_int(3,2);
return;
}
rc = SQLFetch(cur->hstmt);
if ((rc == SQL_SUCCESS) || (rc == SQL_SUCCESS_WITH_INFO))
ctop_int(3,0);
else if (rc == SQL_NO_DATA_FOUND){
cur->Status = 1; /* done w/fetching. set cursor status to unused */
ctop_int(3,1);
}
else {
SetCursorClose(cur); /* error occured in fetching*/
ctop_int(3,2);
}
return;
}
int sys_syscall(CTXTdeclc int callno)
{
int result=-1;
struct stat stat_buff;
switch (callno) {
case SYS_exit: {
int exit_code;
exit_code = (int)ptoc_int(CTXTc 3);
xsb_error("\nXSB exited with exit code: %d", exit_code);
exit(exit_code); break;
}
case SYS_getpid :
#ifndef WIN_NT
result = getpid();
#else
result = _getpid();
#endif
break;
#if (!defined(WIN_NT))
case SYS_link :
result = link(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
#endif
case SYS_mkdir: {
#ifndef WIN_NT
/* create using mode 700 */
result = mkdir(ptoc_longstring(CTXTc 3), 0700);
#else
result = _mkdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_rmdir: {
#ifndef WIN_NT
result = rmdir(ptoc_longstring(CTXTc 3));
#else
result = _rmdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_unlink: result = unlink(ptoc_longstring(CTXTc 3)); break;
case SYS_chdir : result = chdir(ptoc_longstring(CTXTc 3)); break;
case SYS_access: {
switch(*ptoc_string(CTXTc 4)) {
case 'r': /* read permission */
result = access(ptoc_longstring(CTXTc 3), R_OK_XSB);
break;
case 'w': /* write permission */
result = access(ptoc_longstring(CTXTc 3), W_OK_XSB);
break;
case 'x': /* execute permission */
result = access(ptoc_longstring(CTXTc 3), X_OK_XSB);
break;
default:
result = -1;
}
break;
}
case SYS_stat : {
/* Who put this in??? What did s/he expect to get out of this call?
stat_buff is never returned (and what do you do with it in Prolog?)!!!
*/
result = stat(ptoc_longstring(CTXTc 3), &stat_buff);
break;
}
case SYS_rename:
result = rename(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
case SYS_cwd: {
char current_dir[MAX_CMD_LEN];
/* returns 0, if != NULL, 1 otherwise */
result = (getcwd(current_dir, MAX_CMD_LEN-1) == NULL);
if (result == 0)
ctop_string(CTXTc 3,current_dir);
break;
}
case SYS_filecopy: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = (file_copy(CTXTc from,to,"w") == 0);
break;
}
case SYS_fileappend: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = (file_copy(CTXTc from,to,"a") == 0);
break;
}
case SYS_create: {
result = open(ptoc_longstring(CTXTc 3),O_CREAT|O_EXCL,S_IREAD|S_IWRITE);
if (result >= 0) close(result);
break;
}
case SYS_readlink: {
char *inpath = ptoc_longstring(CTXTc 3);
// char *outpath = file_readlink(CTXTc inpath);
char *outpath = file_readlink(inpath);
if (outpath == NULL) {
// memory for this case is dealocated in file_readlink in pathname_xsb.c
result = -1;
} else {
ctop_string(CTXTc 4,outpath);
mem_dealloc(outpath,MAXPATHLEN,OTHER_SPACE);
result = 0;
}
break;
}
case SYS_realpath: {
char *inpath = ptoc_longstring(CTXTc 3);
char *outpath = file_realpath(inpath);
if (outpath == NULL) {
// memory for this case is dealocated in file_readlink in pathname_xsb.c
result = -1;
} else {
ctop_string(CTXTc 4,outpath);
mem_dealloc(outpath,MAXPATHLEN,OTHER_SPACE);
result = 0;
}
break;
}
case STATISTICS_2: {
get_statistics(CTXT);
break;
}
case SYS_epoch_seconds: {
ctop_int(CTXTc 3,(Integer)time(0));
break;
}
case SYS_epoch_msecs: {
static struct timeb time_epoch;
ftime(&time_epoch);
ctop_int(CTXTc 3,(Integer)(time_epoch.time));
ctop_int(CTXTc 4,(Integer)(time_epoch.millitm));
break;
}
case SYS_main_memory_size: {
size_t memory_size = getMemorySize();
ctop_int(CTXTc 3,(UInteger)memory_size);
break;
}
default: xsb_abort("[SYS_SYSCALL] Unknown system call number, %d", callno);
}
return result;
}
int sys_syscall(CTXTdeclc int callno)
{
int result=-1;
struct stat stat_buff;
switch (callno) {
case SYS_exit: {
int exit_code;
exit_code = ptoc_int(CTXTc 3);
xsb_mesg("\nXSB exited with exit code: %d", exit_code);
exit(exit_code); break;
}
#if (!defined(WIN_NT))
case SYS_getpid : result = getpid(); break;
case SYS_link : result = link(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4)); break;
#endif
case SYS_mkdir: {
#ifndef WIN_NT
/* create using mode 700 */
result = mkdir(ptoc_longstring(CTXTc 3), 0700);
#else
result = _mkdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_rmdir: {
#ifndef WIN_NT
result = rmdir(ptoc_longstring(CTXTc 3));
#else
result = _rmdir(ptoc_longstring(CTXTc 3));
#endif
break;
}
case SYS_unlink: result = unlink(ptoc_longstring(CTXTc 3)); break;
case SYS_chdir : result = chdir(ptoc_longstring(CTXTc 3)); break;
case SYS_access: {
switch(*ptoc_string(CTXTc 4)) {
case 'r': /* read permission */
result = access(ptoc_longstring(CTXTc 3), R_OK_XSB);
break;
case 'w': /* write permission */
result = access(ptoc_longstring(CTXTc 3), W_OK_XSB);
break;
case 'x': /* execute permission */
result = access(ptoc_longstring(CTXTc 3), X_OK_XSB);
break;
default:
result = -1;
}
break;
}
case SYS_stat : {
/* Who put this in??? What did s/he expect to get out of this call?
stat_buff is never returned (and what do you do with it in Prolog?)!!!
*/
result = stat(ptoc_longstring(CTXTc 3), &stat_buff);
break;
}
case SYS_rename:
result = rename(ptoc_longstring(CTXTc 3), ptoc_longstring(CTXTc 4));
break;
case SYS_cwd: {
char current_dir[MAX_CMD_LEN];
/* returns 0, if != NULL, 1 otherwise */
result = (getcwd(current_dir, MAX_CMD_LEN-1) == NULL);
if (result == 0)
ctop_string(CTXTc 3,current_dir);
break;
}
case SYS_filecopy: {
char *from = ptoc_longstring(CTXTc 3);
char *to = ptoc_longstring(CTXTc 4);
result = file_copy(from,to);
break;
}
case SYS_create: {
result = open(ptoc_longstring(CTXTc 3),O_CREAT|O_EXCL,S_IREAD|S_IWRITE);
if (result >= 0) close(result);
break;
}
case STATISTICS_2: {
get_statistics(CTXT);
break;
}
default: xsb_abort("[SYS_SYSCALL] Unknown system call number, %d", callno);
}
return result;
}
/* 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));
}
/*-----------------------------------------------------------------------------*/
int GetColumn()
{
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
int ColCurNum = ptoc_int(3);
Cell op1;
Cell op = ptoc_tag(4);
UDWORD len;
if (ColCurNum < 0 || ColCurNum >= cur->NumCols) {
/* no more columns in the result row*/
ctop_int(5,1);
return TRUE;
}
ctop_int(5,0);
/* get the data*/
if (cur->OutLen[ColCurNum] == SQL_NULL_DATA) {
/* column value is NULL*/
return unify(op,nullStrAtom);
}
/* convert the string to either integer, float or string*/
/* according to the column type and pass it back to XSB*/
switch (ODBCToXSBType(cur->ColTypes[ColCurNum])) {
case SQL_C_CHAR:
/* convert the column string to a C string */
len = ((cur->ColLen[ColCurNum] < cur->OutLen[ColCurNum])?
cur->ColLen[ColCurNum]:cur->OutLen[ColCurNum]);
*(cur->Data[ColCurNum]+len) = '\0';
/* compare strings here, so don't intern strings unnecessarily*/
XSB_Deref(op);
if (isref(op))
return unify(op, makestring(string_find(cur->Data[ColCurNum],1)));
if (isconstr(op) && get_arity(get_str_psc(op)) == 1) {
STRFILE strfile;
op1 = cell(clref_val(op)+1);
XSB_Deref(op1);
strfile.strcnt = strlen(cur->Data[ColCurNum]);
strfile.strptr = strfile.strbase = cur->Data[ColCurNum];
read_canonical_term(NULL,&strfile,op1); /* terminating '.'? */
return TRUE;
}
if (!isstring(op)) return FALSE;
if (strcmp(string_val(op),cur->Data[ColCurNum])) return FALSE;
return TRUE;
case SQL_C_BINARY:
/* convert the column string to a C string */
len = ((cur->ColLen[ColCurNum] < cur->OutLen[ColCurNum])?
cur->ColLen[ColCurNum]:cur->OutLen[ColCurNum]);
*(cur->Data[ColCurNum]+len) = '\0';
/* compare strings here, so don't intern strings unnecessarily*/
XSB_Deref(op);
if (isref(op))
return unify(op, makestring(string_find(cur->Data[ColCurNum],1)));
if (isconstr(op) && get_arity(get_str_psc(op)) == 1) {
STRFILE strfile;
op1 = cell(clref_val(op)+1);
XSB_Deref(op1);
strfile.strcnt = strlen(cur->Data[ColCurNum]);
strfile.strptr = strfile.strbase = cur->Data[ColCurNum];
read_canonical_term(NULL,&strfile,op1); /* terminating '.'? */
return TRUE;
}
if (!isstring(op)) return FALSE;
if (strcmp(string_val(op),cur->Data[ColCurNum])) return FALSE;
return TRUE;
case SQL_C_SLONG:
return unify(op,makeint(*(long *)(cur->Data[ColCurNum])));
case SQL_C_FLOAT:
return unify(op,makefloat(*(float *)(cur->Data[ColCurNum])));
}
return FALSE;
}
/*-----------------------------------------------------------------------------*/
void ODBCConnect()
{
UCHAR *server;
UCHAR *pwd;
UCHAR *connectIn;
HDBC hdbc = NULL;
RETCODE rc;
/* if we don't yet have an environment, allocate one.*/
if (!henv) {
/* allocate environment handler*/
rc = SQLAllocEnv(&henv);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Environment allocation failed");
ctop_int(6, 0);
return;
}
/* SQLSetEnvAttr(henv, SQL_ATTR_ODBC_VERSION, (SQLPOINTER)SQL_OV_ODBC2,
SQL_IS_UINTEGER);
*/
LCursor = FCursor = NULL;
FCurNum = NULL;
nullStrAtom = makestring(string_find("NULL",1));
}
/* allocate connection handler*/
rc = SQLAllocConnect(henv, &hdbc);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Connection Resources Allocation Failed");
ctop_int(6, 0);
return;
}
if (!ptoc_int(2)) {
/* get server name, user id and password*/
server = (UCHAR *)ptoc_string(3);
strcpy(uid, (UCHAR *)ptoc_string(4));
pwd = (UCHAR *)ptoc_string(5);
/* connect to database*/
rc = SQLConnect(hdbc, server, SQL_NTS, uid, SQL_NTS, pwd, SQL_NTS);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
SQLFreeConnect(hdbc);
xsb_error("Connection to server %s failed", server);
ctop_int(6, 0);
return;
}
} else {
/* connecting through driver using a connection string */
connectIn = (UCHAR *)ptoc_longstring(3);
rc = SQLDriverConnect(hdbc, NULL, connectIn, SQL_NTS, NULL, 0, NULL,SQL_DRIVER_NOPROMPT);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
SQLFreeConnect(hdbc);
xsb_error("Connection to driver failed: %s", connectIn);
ctop_int(6, 0);
return;
}
}
serverConnected = 1;
ctop_int(6, (long)hdbc);
return;
}
static int socket_connect(CTXTdeclc int *rc, int timeout) {
int error;
socklen_t len;
SOCKET sock_handle;
int domain, portnum;
SOCKADDR_IN socket_addr;
domain = (int)ptoc_int(CTXTc 2);
sock_handle = (SOCKET) ptoc_int(CTXTc 3);
portnum = (int)ptoc_int(CTXTc 4);
/** this may not set domain to a valid value; in this case the connect() will fail */
translate_domain(domain, &domain);
/*** prepare to connect ***/
FillWithZeros(socket_addr);
socket_addr.sin_port = htons((unsigned short)portnum);
socket_addr.sin_family = AF_INET;
socket_addr.sin_addr.s_addr =
inet_addr((char*)get_host_IP(ptoc_string(CTXTc 5)));
if (timeout > 0) {
/* Set up timeout */
if(! SET_SOCKET_BLOCKING(sock_handle, block_false)) {
xsb_error("Cannot save options");
return TIMER_SETUP_ERR;
}
/* This will return immediately */
*rc = connect(sock_handle,(PSOCKADDR)&socket_addr,sizeof(socket_addr));
error = XSB_SOCKET_ERRORCODE;
/* restore flags */
if(! SET_SOCKET_BLOCKING(sock_handle, block_true)) {
xsb_error("Cannot restore the flags: %d (0x%x)", XSB_SOCKET_ERRORCODE, XSB_SOCKET_ERRORCODE);
return TIMER_SETUP_ERR;
}
/* return and indicate an error immediately unless the connection
* was successful or the connect is still in progress. */
if(*rc < 0 && error != EINPROGRESS && error != EWOULDBLOCK) {
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
/* Wait until the connect is completed (or a timeout occurs) */
error = write_select(sock_handle, timeout);
if(error == 0) {
closesocket(sock_handle);
*rc = XSB_SOCKET_ERRORCODE;
return TIMED_OUT;
}
/* Get the return code from the connect */
len=sizeof(error);
error = GETSOCKOPT(sock_handle, SOL_SOCKET, SO_ERROR, &error, &len);
if(error < 0) {
xsb_error("GETSOCKOPT failed");
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
/* error=0 means success, otherwise it contains the errno */
if(error) {
*rc = error;
return NORMAL_TERMINATION; /* Since it didn't time out */
}
*rc = (int)sock_handle;
return NORMAL_TERMINATION;
} else {
*rc = connect(sock_handle,(PSOCKADDR)&socket_addr,sizeof(socket_addr));
return NORMAL_TERMINATION;
}
}
/*-----------------------------------------------------------------------------*/
void FindFreeCursor()
{
struct Cursor *curi = FCursor, *curj = NULL, *curk = NULL;
struct NumberofCursors *num = FCurNum;
HDBC hdbc = (HDBC)ptoc_int(2);
char *Sql_stmt = ptoc_longstring(3);
RETCODE rc;
/* search */
while (curi != NULL) {
if (curi->hdbc == hdbc) { /* only look at stmt handles for this connection */
if (curi->Status == 0) curj = curi; /* cursor never been used*/
else {
if (curi->Status == 1) { /* a closed cursor*/
/* same statement as this one, so grab and return it*/
if (!strcmp(curi->Sql,Sql_stmt)) {
if (curi != FCursor) {
(curi->PCursor)->NCursor = curi->NCursor;
if (curi == LCursor) LCursor = curi->PCursor;
else (curi->NCursor)->PCursor = curi->PCursor;
FCursor->PCursor = curi;
curi->PCursor = NULL;
curi->NCursor = FCursor;
FCursor = curi;
}
curi->Status = 2;
ctop_int(4, (long)curi);
/*printf("reuse cursor: %p\n",curi);*/
return;
} else {
curk = curi; /* otherwise just record it*/
}
}
}
}
curi = curi->NCursor;
}
/* done w/ the search; see what was found*/
if (curj != NULL) { /* give priority to an unused cursor*/
curi = curj;
/*printf("take unused cursor: %p\n",curi);*/
}
else {
while((num != NULL) && (num->hdbc != hdbc)){
num=num->NCurNum;
}
if(num == NULL){
num = (struct NumberofCursors *)malloc(sizeof(struct NumberofCursors));
num->hdbc = hdbc;
num->NCurNum=FCurNum;
FCurNum=num;
num->CursorCount=0;
}
if (num->CursorCount < MAXCURSORNUM) { /* allocate a new cursor if allowed*/
/* problem here: should have numberOfCursors for each connection */
curi = (struct Cursor *)calloc(sizeof(struct Cursor),1);
curi->PCursor = NULL;
curi->NCursor = FCursor;
if (FCursor == NULL) LCursor = curi;
else FCursor->PCursor = curi;
FCursor = curi;
rc = SQLAllocStmt(hdbc,&(curi->hstmt));
if (!((rc==SQL_SUCCESS) ||
(rc==SQL_SUCCESS_WITH_INFO))) {
free(curi);
/* numberOfCursors--; */
xsb_abort("while trying to allocate ODBC statement\n");
}
num->CursorCount++;
/*printf("allocate a new cursor: %p\n",curi);*/
}
else if (curk == NULL) { /* no cursor left*/
ctop_int(4, 0);
return;
}
else { /* steal a cursor*/
curi = curk;
SetCursorClose(curi);
/*printf("steal a cursor: %p\n",curi);*/
}
}
/* move to front of list.*/
if (curi != FCursor) {
(curi->PCursor)->NCursor = curi->NCursor;
if (curi == LCursor) LCursor = curi->PCursor;
else (curi->NCursor)->PCursor = curi->PCursor;
FCursor->PCursor = curi;
curi->PCursor = NULL;
curi->NCursor = FCursor;
FCursor = curi;
}
curi->hdbc = hdbc;
curi->Sql = (UCHAR *)strdup(Sql_stmt);
if (!curi->Sql)
xsb_exit("Not enough memory for SQL stmt in FindFreeCursor!");
curi->Status = 3;
ctop_int(4, (long)curi);
return;
}
void get_statistics(CTXTdecl) {
int type;
type = (int)ptoc_int(CTXTc 3);
switch (type) {
// runtime [since start of Prolog,since previous statistics]
// CPU time used while executing, excluding time spent
// garbage collecting, stack shifting, or in system calls.
case RUNTIME: {
double tot_cpu, incr_cpu;
tot_cpu = cpu_time();
incr_cpu = tot_cpu - last_cpu;
last_cpu = tot_cpu;
ctop_float(CTXTc 4, tot_cpu);
ctop_float(CTXTc 5, incr_cpu);
break;
}
case WALLTIME: {
double tot_wall,this_wall,incr_wall;
this_wall = real_time();
tot_wall = this_wall - realtime_count_gl;
if (!last_wall) last_wall = realtime_count_gl;
incr_wall = this_wall - last_wall;
last_wall = this_wall;
ctop_float(CTXTc 4, tot_wall);
ctop_float(CTXTc 5, incr_wall);
break;
}
case SHARED_TABLESPACE:
{
#ifdef MULTI_THREAD
get_memory_statistics(CTXTc type);
#else
xsb_abort("statistics/2 with parameter shared_tables not supported in this configuration\n");
#endif
break;
}
case IDG_COUNTS: {
ctop_int(CTXTc 4,current_call_node_count_gl);
ctop_int(CTXTc 5,current_call_edge_count_gl);
break;
}
case TABLE_OPS: {
UInteger ttl_ops = ans_chk_ins + NumSubOps_AnswerCheckInsert,
ttl_ins = ans_inserts + NumSubOps_AnswerInsert;
ctop_int(CTXTc 4,NumSubOps_CallCheckInsert);
ctop_int(CTXTc 5,NumSubOps_ProducerCall);
ctop_int(CTXTc 6,var_subg_chk_ins_gl);
ctop_int(CTXTc 7,var_subg_inserts_gl);
ctop_int(CTXTc 8,ttl_ops);
ctop_int(CTXTc 9,ttl_ins);
}
default: {
get_memory_statistics(CTXTc type);
break;
}
}
}
/*-----------------------------------------------------------------------------*/
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;
}
/*-----------------------------------------------------------------------------*/
void ODBCDataSources()
{
static SQLCHAR DSN[SQL_MAX_DSN_LENGTH+1];
static SQLCHAR Description[SQL_MAX_DSN_LENGTH+1];
RETCODE rc;
int seq;
SWORD dsn_size, descr_size;
Cell op2 = ptoc_tag(3);
Cell op3 = ptoc_tag(4);
if (!henv) {
/* allocate environment handler*/
rc = SQLAllocEnv(&henv);
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Environment allocation failed");
ctop_int(5,1);
return;
}
LCursor = FCursor = NULL;
FCurNum = NULL;
nullStrAtom = makestring(string_find("NULL",1));
}
seq = ptoc_int(2);
if (seq == 1) {
rc = SQLDataSources(henv,SQL_FETCH_FIRST,DSN,
SQL_MAX_DSN_LENGTH,&dsn_size,
Description,SQL_MAX_DSN_LENGTH,
&descr_size);
if (rc == SQL_NO_DATA_FOUND) {
ctop_int(5,2);
return;
}
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Environment allocation failed");
ctop_int(5,1);
return;
}
} else {
rc = SQLDataSources(henv,SQL_FETCH_NEXT,DSN,
SQL_MAX_DSN_LENGTH,&dsn_size,
Description,SQL_MAX_DSN_LENGTH,
&descr_size);
if (rc == SQL_NO_DATA_FOUND) {
ctop_int(5,2);
return;
}
if (rc != SQL_SUCCESS && rc != SQL_SUCCESS_WITH_INFO) {
xsb_error("Environment allocation failed");
ctop_int(5,1);
return;
}
}
XSB_Deref(op2);
if (isref(op2))
unify(op2, makestring(string_find(DSN,1)));
else {
xsb_error("[ODBCDataSources] Param 2 should be a free variable.");
ctop_int(5,1);
return;
}
XSB_Deref(op3);
if (isref(op3))
unify(op3, makestring(string_find(Description,1)));
else {
xsb_error("[ODBCDataSources] Param 3 should be a free variable.");
ctop_int(5,1);
return;
}
ctop_int(5,0);
return;
}
/*-----------------------------------------------------------------------------*/
void ODBCDescribeSelect()
{
int j;
UCHAR colname[50];
SWORD colnamelen;
SWORD scale;
SWORD nullable;
UDWORD collen;
struct Cursor *cur = (struct Cursor *)ptoc_int(2);
cur->NumCols = 0;
SQLNumResultCols(cur->hstmt, (SQLSMALLINT*)&(cur->NumCols));
if (!(cur->NumCols)) {
/* no columns are affected, set cursor status to unused */
cur->Status = 1;
ctop_int(3,2);
return;
}
/* if we aren't reusing a closed statement handle, we need to get*/
/* resulting rowset info and allocate memory for it*/
if (cur->Status != 2) {
cur->ColTypes =
(SWORD *)malloc(sizeof(SWORD) * cur->NumCols);
if (!cur->ColTypes)
xsb_exit("Not enough memory for ColTypes!");
cur->Data =
(UCHAR **)malloc(sizeof(char *) * cur->NumCols);
if (!cur->Data)
xsb_exit("Not enough memory for Data!");
cur->OutLen =
(UDWORD *)malloc(sizeof(UDWORD) * cur->NumCols);
if (!cur->OutLen)
xsb_exit("Not enough memory for OutLen!");
cur->ColLen =
(UDWORD *)malloc(sizeof(UDWORD) * cur->NumCols);
if (!cur->ColLen)
xsb_exit("Not enough memory for ColLen!");
for (j = 0; j < cur->NumCols; j++) {
SQLDescribeCol(cur->hstmt, (short)(j+1), (UCHAR FAR*)colname,
sizeof(colname), &colnamelen,
&(cur->ColTypes[j]),
&collen, &scale, &nullable);
/* SQLServer returns this wierd type for a system table, treat it as varchar?*/
if (cur->ColTypes[j] == -9) cur->ColTypes[j] = SQL_VARCHAR;
colnamelen = (colnamelen > 49) ? 49 : colnamelen;
colname[colnamelen] = '\0';
if (!(cur->ColLen[j] =
DisplayColSize(cur->ColTypes[j],collen,colname))) {
/* let SetCursorClose function correctly free all the memory allocated*/
/* for Data storage: cur->Data[j]'s*/
cur->NumCols = j; /* set so close frees memory allocated thus far*/
SetCursorClose(cur);
/* return(1);*/
ctop_int(3,1);
return;
}
cur->Data[j] =
(UCHAR *) malloc(((unsigned) cur->ColLen[j]+1)*sizeof(UCHAR));
if (!cur->Data[j])
xsb_exit("Not enough memory for Data[j]!");
}
}
/* bind them*/
for (j = 0; j < cur->NumCols; j++) {
SQLBindCol(cur->hstmt, (short)(j+1),
ODBCToXSBType(cur->ColTypes[j]), cur->Data[j],
cur->ColLen[j], (SDWORD FAR *)(&(cur->OutLen[j])));
}
/* return 0;*/
ctop_int(3,0);
return;
}
