TIFptr get_tip(CTXTdeclc Psc psc) {
TIFptr *tip = get_tip_or_tdisp(psc);
#ifndef MULTI_THREAD
return tip?(*tip):NULL;
#else
if (!tip) { /* get it out of dispatch table */
CPtr temp1 = (CPtr) get_ep(psc);
if ((get_type(psc) == T_DYNA) &&
(*(pb)(temp1) == switchonthread)) {
temp1 = dynpredep_to_prortb(CTXTc temp1);
if (temp1 && (*(pb)temp1 == tabletrysingle) )
return *(TIFptr *)(temp1+2);
else return (TIFptr) NULL;
} else {
if (get_tabled(psc)) {
xsb_error("Internal Error in table dispatch\n");
} else {
return NULL;
}
}
}
if (TIF_EvalMethod(*tip) != DISPATCH_BLOCK) return *tip;
/* *tip points to 3rd word in TDispBlk, so get addr of TDispBlk */
{ struct TDispBlk_t *tdispblk = (struct TDispBlk_t *) (*tip);
TIFptr rtip = (TIFptr)((&(tdispblk->Thread0))[xsb_thread_entry]);
if (!rtip) {
rtip = New_TIF(CTXTc psc);
(&(tdispblk->Thread0))[xsb_thread_entry] = rtip;
}
return rtip;
}
#endif
}
/* message_pump is also known as OP_TIMED_OUT (when WIN_NT is defined) */
int message_pump()
{
MSG msg;
if ((xsb_timer_id = SetTimer(NULL,
0,
/* set timeout period */
(UINT)((int)pflags[SYS_TIMER] * 1000),
(TIMERPROC)xsb_timer_handler))
== 0) {
xsb_error("SOCKET_REQUEST: Can't create timer: %d\n", GetLastError());
return TIMER_SETUP_ERR;
}
exitFlag=STILL_WAITING;
while ((exitFlag==STILL_WAITING) && GetMessage(&msg,NULL,0,0)) {
DispatchMessage(&msg);
if (msg.wParam == NORMAL_TERMINATION)
break;
}
if (xsb_timer_id != 0)
TURNOFFALARM;
if (exitFlag == TIMED_OUT)
return TRUE; /* timed out */
else
return FALSE; /* not timed out */
}
/* Returns:
normal: SOCK_OK
EOF: SOCK_READMSG_EOF
error: SOCK_READMSG_FAILED
Read message header, then read the message itself.
*/
static int readmsg(SOCKET sock_handle, char **msg_buff, UInteger *msg_len)
{
size_t actual_len;
/* 4-char buf that keeps the length of the subsequent msg */
char lenbuf[XSB_MSG_HEADER_LENGTH];
size_t msglen, net_encoded_len;
// TODO: consider adding protection against interrupts, EINTR, like
// in socket_get0.
actual_len =
// the MSG_PEEK flag makes it only peek at the first XSB_MSG_HEADER_LENGTH
// bytes. This is needed in order to talk to datagram sockets.
(size_t)recvfrom(sock_handle,lenbuf,XSB_MSG_HEADER_LENGTH,MSG_PEEK,NULL,0);
if (SOCKET_OP_FAILED(actual_len)) return SOCK_READMSG_FAILED;
if (actual_len == 0) {
*msg_buff = NULL;
return SOCK_READMSG_EOF;
}
memcpy((void *) &net_encoded_len, (void *) lenbuf, XSB_MSG_HEADER_LENGTH);
msglen = ntohl((u_long)net_encoded_len)+XSB_MSG_HEADER_LENGTH;
*msg_len = msglen*sizeof(char);
/* the space allocated here for msg_buff is released in the
"SOCKET_RECV" case of xsb_socket_request */
*msg_buff=(char *)mem_calloc(msglen,sizeof(char),OTHER_SPACE);
// TODO: consider adding protection against interrupts, EINTR, like
// in socket_get0.
actual_len = recvfrom(sock_handle,*msg_buff,(int)msglen,0,NULL,0);
if (SOCKET_OP_FAILED(actual_len)) return SOCK_READMSG_FAILED;
/* The following may arise, if somebody sends messages to XSB not through
socket_send, but in a home-grown way. In that case, we cannot be sure that
messages are composed correctly and that the header contains a correct
length of the message body. */
if (actual_len != msglen) {
xsb_error("[SOCKET_RECV] Ill-formed message. Its length %ld differs from the header value %ld",
msglen, actual_len);
return SOCK_HEADER_LEN_MISMATCH;
}
return SOCK_OK;
}
/* the following function is a general format for timeout control. it takes
function calls which need timeout control as argument and controls the
timeout for different platform */
int make_timed_call(xsbTimeout *pptr, void (*fptr)(xsbTimeout *))
{
#ifdef WIN_NT
int return_msg; /* message_pump() return value */
#endif
SETALARM; /* specify the timer handler in Unix;
Noop in Windows (done in SetTimer) */
#ifdef WIN_NT
/* create a concurrent timed thread;
pptr points to the procedure to be timed */
pptr->parent_thread=(long)GetCurrentThreadId();
if((timedThread = _beginthread(fptr,0,(void*)(pptr)))==-1) {
xsb_error("SOCKET_REQUEST: Can't create concurrent timer thread\n");
return TIMER_SETUP_ERR;
}
/* OP_TIMED_OUT returns TRUE/FALSE/TIMER_SETUP_ERR */
if ((return_msg = OP_TIMED_OUT) == TIMER_SETUP_ERR)
return TIMER_SETUP_ERR;
else if (!return_msg) { /* no timeout */
TURNOFFALARM;
return FALSE;
} else { /* timeout */
TURNOFFALARM;
return TRUE;
}
#else /* UNIX */
if ( !OP_TIMED_OUT ) { /* no timeout */
SET_TIMER; /* specify the timeout period */
(*fptr)(pptr); /* procedure call that needs timeout control */
TURNOFFALARM;
return FALSE;
} else { /* timeout */
TURNOFFALARM;
return TRUE;
}
#endif
}
int op_timed_out(CTXTdeclc xsbTimeout *timeout)
{
struct timespec wakeup_time; // time.h
int rc;
wakeup_time.tv_sec = time(NULL) + (int)pflags[SYS_TIMER];
pthread_mutex_lock(&timeout->timeout_info.mutex);
rc = pthread_cond_timedwait(&timeout->timeout_info.condition,
&timeout->timeout_info.mutex, &wakeup_time);
pthread_mutex_unlock(&timeout->timeout_info.mutex);
if (rc != 0) {
switch(rc) {
case EINVAL:
xsb_bug("pthread_cond_timedwait returned EINVAL");
break;
case ETIMEDOUT:
break;
case ENOMEM:
xsb_error("Not enough memory to wait\n");
break;
default:
xsb_bug("pthread_cond_timedwait returned an unexpected value (%d)\n", rc);
}
}
TURNOFFALARM; // mt-noop(?)
switch (timeout->timeout_info.exitFlag) {
case STILL_WAITING: /* The call timed out */
PTHREAD_CANCEL(timeout->timeout_info.timedThread);
return TRUE;
case TIMED_OUT:
return TRUE;
case NORMAL_TERMINATION:
return FALSE;
default:
xsb_bug("timed call's exit flag is an unexpected value (%d)", timeout->timeout_info.exitFlag);
return FALSE;
}
}
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;
}
/* the following function is a general format for timeout control. it takes
function calls which need timeout control as argument and controls the
timeout for different platform */
int make_timed_call(CTXTdeclc xsbTimeout *pptr, void (*fptr)(xsbTimeout *))
{
#if defined(WIN_NT) || defined(MULTI_THREAD)
int return_msg; /* message_pump() return value */
#endif
#ifdef MULTI_THREAD /* USE PTHREADS */
#ifdef WIN_NT
pptr->timeout_info.timedThread = mem_alloc(sizeof(pthread_t),LEAK_SPACE);
#define TIMED_THREAD_CREATE_ARG pptr->timeout_info.timedThread
#else
#define TIMED_THREAD_CREATE_ARG &pptr->timeout_info.timedThread
#endif
pptr->timeout_info.th=th;
// below, fptr is pointer to start routine, pptr is pointer to arg-array.
// TIMED_THREAD_CREATE_ARG is a cell of timeout_info.
if (pthread_create(TIMED_THREAD_CREATE_ARG, NULL, fptr, pptr)) {
xsb_error("SOCKET_REQUEST: Can't create concurrent timer thread\n");
return TIMER_SETUP_ERR;
}
PTHREAD_DETACH(pptr->timeout_info.timedThread);
return_msg = OP_TIMED_OUT(pptr);
#ifdef WIN_NT
mem_dealloc(pptr->timeout_info.timedThread,sizeof(pthread_t),LEAK_SPACE);
#endif
if (return_msg == TIMER_SETUP_ERR) {
return TIMER_SETUP_ERR;
} else if (!return_msg) { /* no timeout */
TURNOFFALARM;
return FALSE;
} else { /* timeout */
TURNOFFALARM;
return TRUE;
}
#else /* not multithreaded */
#ifdef WIN_NT
/* create a concurrent timed thread;
pptr points to the procedure to be timed */
pptr->timeout_info.parent_thread = (Integer)GetCurrentThreadId();
if((timedThread = _beginthread((void *)fptr,0,(void*)(pptr)))==-1) {
xsb_error("SOCKET_REQUEST: Can't create concurrent timer thread\n");
return TIMER_SETUP_ERR;
}
return_msg = OP_TIMED_OUT(pptr);
/* OP_TIMED_OUT returns TRUE/FALSE/TIMER_SETUP_ERR */
if (return_msg == TIMER_SETUP_ERR) {
return TIMER_SETUP_ERR;
} else if (!return_msg) { /* no timeout */
TURNOFFALARM;
return FALSE;
} else { /* timeout */
TURNOFFALARM;
return TRUE;
}
#else /* UNIX */
SETALARM; /* specify the timer handler in Unix;
Noop in Windows (done in SetTimer) */
if ( !OP_TIMED_OUT ) { /* no timeout */
SET_TIMER; /* specify the timeout period */
(*fptr)(CTXTc pptr); /* procedure call that needs timeout control */
TURNOFFALARM;
return FALSE;
} else { /* timeout */
TURNOFFALARM;
return TRUE;
}
#endif
#endif
}
CPtr insert_interned_rec(int reclen, int areaindex, CPtr termrec) {
struct intterm_rec *recptr, *prev;
Integer hashindex;
int i, found;
CPtr hc_term;
if (!hc_block[areaindex].base) { /* allocate first block */
hc_block[areaindex].base =
mem_calloc(sizeof(Cell),(1+hc_num_in_block*(1+reclen)),OTHER_SPACE); /* for now, make own space*/
if (!hc_block[areaindex].base) {
xsb_error("No memory for interned terms\n");
}
hc_block[areaindex].hashtab = 0;
hc_block[areaindex].hashtab_size = 0;
hc_block[areaindex].freechain = 0;
hc_block[areaindex].freedisp = &(hc_block[areaindex].base->recs);
}
if (!hc_block[areaindex].hashtab) {
hc_block[areaindex].hashtab = mem_calloc(sizeof(Cell),it_hashtab_size,OTHER_SPACE);
if (!hc_block[areaindex].hashtab) xsb_abort("No memory for interned terms\n");
hc_block[areaindex].hashtab_size = it_hashtab_size;
}
hashindex = it_hash(hc_block[areaindex].hashtab_size,reclen,termrec);
prev = recptr = hc_block[areaindex].hashtab[hashindex];
while (recptr) {
found = 1;
hc_term = &(recptr->intterm_psc);
for (i=0; i<reclen; i++) {
if (cell(hc_term+i) != cell(termrec+i)) {
found = 0; break;
}
}
if (found) {/*printf("old %p\n",hc_term);*/ return hc_term;}
prev = recptr;
recptr = recptr->next;
}
recptr = hc_block[areaindex].freedisp;
if ((CPtr)recptr >= (CPtr)(&(hc_block[areaindex].base->recs)) + (hc_num_in_block*(1+reclen))) {
struct intterm_block *newblock;
// printf("oflow: %p\n",recptr);
newblock = mem_calloc(sizeof(Cell),(1+hc_num_in_block*(1+reclen)),OTHER_SPACE);
if (!newblock) {
xsb_error("No memory for interned terms\n");
}
newblock->nextblock = hc_block[areaindex].base;
hc_block[areaindex].base = newblock;
hc_block[areaindex].freedisp = &(newblock->recs);
recptr = &(newblock->recs);
// printf("Alloc new block for interned structs: %d, %p-%p\n",reclen,newblock,((char *)newblock)+((1+hc_num_in_block*(1+reclen))*sizeof(Cell)));
}
hc_block[areaindex].freedisp = (struct intterm_rec *)((CPtr)(hc_block[areaindex].freedisp) + reclen+1);
if (prev) prev->next = recptr; else hc_block[areaindex].hashtab[hashindex] = recptr;
recptr->next = 0;
hc_term = &(recptr->intterm_psc);
for (i=0; i<reclen; i++) {
cell(hc_term+i) = cell(termrec+i);
}
/*printf("new %p\n",hc_term);*/
return hc_term;
}
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 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 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;
}
