void free_unused_strings() {
size_t i;
void *ptr, *prevptr;
int used = 0, unused = 0;
for (i = 0; i < string_table.size; i++) {
if (string_table.table[i] != NULL) {
prevptr = &string_table.table[i];
ptr = *(void **)prevptr;
while (ptr != NULL) {
if ((*(Integer *)ptr) & 1) {
used++;
(*(Integer *)ptr) &= ~1;
prevptr = ptr;
ptr = *(void **)ptr;
} else {
unused++;
// printf("fs: %s\n",(((char *)ptr))+sizeof(void *));
*(void **)prevptr = *(void **)ptr;
mem_dealloc(ptr,strlen(((char *)ptr)+sizeof(void *))+sizeof(void *)+1,STRING_SPACE);
// *(((char *)ptr)+sizeof(void *)) = '?';
ptr = *(void **)prevptr;
string_table.contains--;
// ptr = *(void **)ptr; // replace with above when have marked all
}
}
}
}
// if (unused > 0) printf("%d",unused);
// printf("string_table scanned. used=%d, unused=%d\n",used,unused);
}
void expand_symbol_table() {
Pair *new_table, *bucket_ptr, cur_pair, next_pair;
Psc cur_psc;
size_t index, new_size, new_index;
new_size = next_prime(symbol_table.size);
new_table = (Pair *)mem_calloc(new_size, sizeof(void *),ATOM_SPACE);
for (bucket_ptr = (Pair *)symbol_table.table, index = 0;
index < symbol_table.size; bucket_ptr++, index++)
for (cur_pair = *bucket_ptr; cur_pair != NULL; cur_pair = next_pair) {
next_pair = pair_next(cur_pair);
cur_psc = pair_psc(cur_pair);
new_index = hash(get_name(cur_psc), get_arity(cur_psc), new_size);
pair_next(cur_pair) = new_table[new_index];
new_table[new_index] = cur_pair;
}
mem_dealloc((void *)symbol_table.table,symbol_table.size,ATOM_SPACE);
symbol_table.size = new_size;
symbol_table.table = (void **)new_table;
/*printf("expanded atom table to: %d\n",new_size);*/
}
void *worker_thread(void *pmyid) {
long myid, validateLength, length, i, j, k, l, m;
float sum;
float *src1, *src2, *dst;
float *asrc1, *asrc2, *adst;
myid = (long) pmyid;
printf("THREAD#%02ld START!!!\n", myid);
//cpu affinity
pinCPU(pmyid);
//init and alloc
mem_alloc_init(pmyid);
//sync-point
// worker_thread_sync(pmyid);
//do-work
matmul_c(pmyid);
//validate
matmul_validate(pmyid);
//clean-up
mem_dealloc(pmyid);
if(DODEBUG) fflush(stdout);
printf("THREAD#%02ld END!!!\n", myid);
if(DODEBUG) fflush(stdout);
if(myid) pthread_exit((void*)pmyid);
}
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 set_xsbinfo_dir () {
struct stat *fileinfo = mem_alloc(1*sizeof(struct stat),LEAK_SPACE);
char old_xinitrc[MAXPATHLEN], new_xinitrc[MAXPATHLEN],
user_config_dir[MAXPATHLEN], user_arch_dir[MAXPATHLEN];
int retcode;
if (!fileinfo) {
xsb_abort("No core memory to allocate stat structure.\n");
}
snprintf(xsbinfo_dir_gl, MAXPATHLEN, "%s%c.xsb", user_home_gl, SLASH);
snprintf(old_xinitrc, MAXPATHLEN, "%s%c.xsbrc", user_home_gl, SLASH);
snprintf(new_xinitrc, MAXPATHLEN, "%s%cxsbrc", xsbinfo_dir_gl, SLASH);
snprintf(user_config_dir, MAXPATHLEN, "%s%cconfig", xsbinfo_dir_gl, SLASH);
snprintf(user_arch_dir, MAXPATHLEN, "%s%c%s", user_config_dir, SLASH, FULL_CONFIG_NAME);
/* Create USER_HOME/.xsb directory, if it doesn't exist. */
check_create_dir(xsbinfo_dir_gl);
check_create_dir(user_config_dir);
check_create_dir(user_arch_dir);
retcode = stat(old_xinitrc, fileinfo);
if ((retcode == 0) && (stat(new_xinitrc, fileinfo) != 0)) {
xsb_warn("It appears that you have an old-style `.xsbrc' file!\n The XSB initialization file is now %s.\n If your `.xinitrc' defines the `library_directory' predicate,\n please consult the XSB manual for the new conventions.", new_xinitrc);
}
mem_dealloc(fileinfo,1*sizeof(struct stat),LEAK_SPACE);
}
/* Check if PATH exists. Create if it doesn't. Bark if it can't create or if
PATH exists, but isn't a directory. */
static void check_create_dir(char *path) {
struct stat *fileinfo = mem_alloc(1*sizeof(struct stat),LEAK_SPACE);
int retcode = stat(path, fileinfo);
if (!fileinfo) {
xsb_abort("No core memory to allocate stat structure.\n");
}
if (retcode == 0 && ! S_ISDIR(fileinfo->st_mode)) {
xsb_warn("File `%s' is not a directory!\n XSB uses this directory to store data.", path);
/* exit(1); */
}
if (retcode != 0)
#ifdef WIN_NT
retcode = mkdir(path);
#else
retcode = mkdir(path, 0755);
#endif
if (retcode != 0) {
xsb_warn("Cannot create directory `%s'!\n XSB uses this directory to store data.", path);
/* exit(1); */
}
mem_dealloc(fileinfo,1*sizeof(struct stat),LEAK_SPACE);
}
void expand_string_table() {
void **new_table, **bucket_ptr, **cur_entry, **next_entry;
char *string;
size_t index, new_size, new_index;
new_size = next_prime(string_table.size);
new_table = (void **)mem_calloc(new_size, sizeof(void *),STRING_SPACE);
for (bucket_ptr = string_table.table, index = 0;
index < string_table.size;
bucket_ptr++, index++)
for (cur_entry = (void **)*bucket_ptr;
cur_entry != NULL;
cur_entry = next_entry) {
next_entry = (void **)*cur_entry;
string = (char *)(cur_entry + 1);
new_index = hash(string, 0, new_size);
*cur_entry = new_table[new_index];
new_table[new_index] = (void *)cur_entry;
}
mem_dealloc((void *)string_table.table,string_table.size*sizeof(void *),STRING_SPACE);
string_table.size = new_size;
string_table.table = new_table;
// printf("expanded string table to: %ld\n",new_size);
}
/* utility function to destroy a select call */
static void select_destroy(CTXTdeclc char *connection_name)
{
int i;
int connectname_found = FALSE;
SYS_MUTEX_LOCK(MUTEX_SOCKETS);
for (i=0; i < MAXCONNECT; i++) {
if(connections[i].empty_flag==FALSE) {
/* find the matching connection_name to destroy */
if (strcmp(connection_name, connections[i].connection_name) == 0) {
connectname_found = TRUE;
/* destroy the corresponding structure */
FD_ZERO(&connections[i].readset);
FD_ZERO(&connections[i].writeset);
FD_ZERO(&connections[i].exceptionset);
connections[i].connection_name = NULL;
connections[i].maximum_fd = 0;
/* free the fds obtained by mem_alloc() */
mem_dealloc(connections[i].read_fds,connections[i].sizer,OTHER_SPACE);
mem_dealloc(connections[i].write_fds,connections[i].sizew,OTHER_SPACE);
mem_dealloc(connections[i].exception_fds,connections[i].sizee,OTHER_SPACE);
connections[i].sizer = 0;
connections[i].sizew = 0 ;
connections[i].sizee = 0 ;
connections[i].empty_flag = TRUE; /* set the destroyed slot to empty */
break;
}
}
}
SYS_MUTEX_UNLOCK(MUTEX_SOCKETS);
/* if no matching connection_name */
if (!connectname_found)
xsb_abort("[SOCKET_SELECT_DESTROY] connection `%s' doesn't exist",
connection_name);
SQUASH_LINUX_COMPILER_WARN(connectname_found) ;
}
void leave(GtkWidget *widget, gpointer *data)
{
draw_stop();
save_config(widget);
input_thread_stopper(data_handle);
close_datasource(data_handle);
/* Free all buffers */
mem_dealloc();
gtk_main_quit();
}
void unload_seg(pseg s)
{
pindex i1, i2 ;
pseg prev, next ;
/* free the index blocks */
i1 = seg_index(s) ;
while (i1) {
i2 = i_next(i1) ;
mem_dealloc((pb)i1, i_size(i1),COMPILED_SPACE);
i1 = i2;
}
/* delete segment from segment dllist and dealloc it */
next = seg_next(s) ;
prev = seg_prev(s) ;
if (next) seg_prev(next) = prev ;
if (prev) seg_next(prev) = next ;
if (last_text==s) last_text = prev ;
mem_dealloc((pb)seg_hdr(s), seg_size(s),COMPILED_SPACE);
}
void smFreeBlocks(Structure_Manager *pSM) {
void *pCurBlock, *pNextBlock;
pCurBlock = SM_CurBlock(*pSM);
while ( IsNonNULL(pCurBlock) ) {
pNextBlock = SMBlk_NextBlock(pCurBlock);
mem_dealloc(pCurBlock,SM_NewBlockSize(*pSM),TABLE_SPACE);
pCurBlock = pNextBlock;
}
SM_CurBlock(*pSM) = SM_NextStruct(*pSM) = SM_LastStruct(*pSM) = NULL;
SM_AllocList(*pSM) = SM_FreeList(*pSM) = NULL;
}
void reinit_extace(int new_nsamp)
{
/* Stop drawing the display */
draw_stop();
if(data_handle != -1) /* stop if previously opened */
{
input_thread_stopper(data_handle);
close_datasource(data_handle);
}
/* Free all buffers */
mem_dealloc();
scope_begin_l = 0;
scope_begin_l = 0;
/* auto shift lag slightly to maintain good sync
* The idea is the shift the lag slighly so that the "on-time" data
* is in the MIDDLE of the window function for better eye/ear matchup
*/
nsamp = new_nsamp;
convolve_factor = floor(nsamp/width) < 3 ? floor(nsamp/width) : 3 ;
if (convolve_factor == 0)
convolve_factor = 1;
recalc_markers = TRUE;
recalc_scale = TRUE;
mem_alloc();
setup_datawindow(NULL,(WindowFunction)window_func);
ring_rate_changed();
ring_pos=0;
/* only start if it has been stopped above */
if(data_handle != -1 && (data_handle=open_datasource(data_source)) >= 0)
{
#ifdef USING_FFTW2
fftw_destroy_plan(plan);
plan = fftw_create_plan(nsamp, FFTW_FORWARD, FFTW_ESTIMATE);
#elif USING_FFTW3
fftw_cleanup();
plan = fftw_plan_r2r_1d(nsamp, raw_fft_in, raw_fft_out,FFTW_R2HC, FFTW_ESTIMATE);
#endif
input_thread_starter(data_handle);
ring_rate_changed(); /* Fix all gui controls that depend on
* ring_rate (adjustments and such
*/
draw_start();
}
}
xsbBool str_cat(CTXTdecl)
{
char *str1, *str2, *tmpstr;
size_t tmpstr_len;
term = ptoc_tag(CTXTc 1);
term2 = ptoc_tag(CTXTc 2);
if (isatom(term) && isatom(term2)) {
str1 = string_val(term);
str2 = string_val(term2);
tmpstr_len = strlen(str1) + strlen(str2) + 1;
tmpstr = (char *)mem_alloc(tmpstr_len,LEAK_SPACE);
strcpy(tmpstr, str1);
strcat(tmpstr, str2);
str1 = string_find(tmpstr, 1);
mem_dealloc(tmpstr,tmpstr_len,LEAK_SPACE);
return atom_unify(CTXTc makestring(str1), ptoc_tag(CTXTc 3));
} else return FALSE;
}
/* destruction is necessary for automatic VarString's,
or else there will be a memory leak */
static inline void vs_destroy(VarString *vstr)
{
if (vstr->string == NULL) {
#ifdef DEBUG_VARSTRING
fprintf(stderr,
"Attempt to deallocate uninitialized variable-length string\n");
return;
#else
return;
// xsb_bug("Attempt to deallocate uninitialized variable-length string");
#endif
}
#ifdef DEBUG_VARSTRING
fprintf(stderr,
"Deallocating a variable-length string\n");
#endif
mem_dealloc(vstr->string,vstr->size,OTHER_SPACE);
vstr->string = NULL;
vstr->size = 0;
vstr->length = 0;
vstr->increment = 0;
}
void dfs_outedges(CTXTdeclc callnodeptr call1){
callnodeptr cn;
struct hashtable *h;
struct hashtable_itr *itr;
int ctr = 0;
int incr_callgraph_dfs_top = -1;
int incr_callgraph_dfs_size;
IncrCallgraphDFSFrame *incr_callgraph_dfs;
// printf("1) calling dfs %p; subgoal ",call1); print_callnode(stddbg,call1); printf("\n");
incr_callgraph_dfs =
(IncrCallgraphDFSFrame *) mem_alloc(10000*sizeof(IncrCallgraphDFSFrame),
TABLE_SPACE);
incr_callgraph_dfs_size = 10000;
dfs_outedges_check_non_completed(CTXTc call1);
if (!is_fact_in_callgraph(call1)) call1->deleted = 1;
h=call1->outedges->hasht;
if (hashtable1_count(h) > 0){
// printf("1-call1: %p \n",call1);
push_dfs_frame(call1,0);
}
while (incr_callgraph_dfs_top > -1) {
itr = 0;
do {
if (incr_callgraph_dfs[incr_callgraph_dfs_top].itr) {
itr = incr_callgraph_dfs[incr_callgraph_dfs_top].itr;
// printf("1-top %d itr %p\n",incr_callgraph_dfs_top,itr);
if (!hashtable1_iterator_advance(itr)) { // last element in the hash
itr = 0;
cn = incr_callgraph_dfs[incr_callgraph_dfs_top].cn;
add_callnode(&affected_gl,cn);
// printf("+ adding callnode %p\n",cn);
pop_dfs_frame;
}
}
else {
h=incr_callgraph_dfs[incr_callgraph_dfs_top].cn->outedges->hasht;
if (hashtable1_count(h) > 0) {
itr = hashtable1_iterator(h); // initialize
incr_callgraph_dfs[incr_callgraph_dfs_top].itr = itr;
}
else {
cn = incr_callgraph_dfs[incr_callgraph_dfs_top].cn;
add_callnode(&affected_gl,cn);
// printf("+ adding callnode %p\n",cn);
pop_dfs_frame;
}
}
} while (itr == 0 && incr_callgraph_dfs_top > -1);
if (incr_callgraph_dfs_top > -1) {
cn = hashtable1_iterator_value(itr);
// printf("top %d cn: %p itr: %p\n",incr_callgraph_dfs_top,cn,itr);
// printf("2) recursive dfs %p; subgoal ",cn); print_callnode(stddbg,cn); printf("\n");
cn->falsecount++;
if (cn->deleted==0) {
dfs_outedges_check_non_completed(CTXTc cn);
cn->deleted = 1;
// h=cn->outedges->hasht;
// if (hashtable1_count(h) > 0) {
push_dfs_frame(cn,0);
// }
}
}
}
mem_dealloc(incr_callgraph_dfs, incr_callgraph_dfs_size*sizeof(IncrCallgraphDFSFrame),
TABLE_SPACE);
}
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;
}
/* 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 gc_heap(CTXTdeclc int arity, int ifStringGC)
{
#ifdef GC
CPtr p;
double begin_marktime, end_marktime,
end_slidetime, end_copy_time,
begin_stringtime, end_stringtime;
size_t marked = 0, marked_dregs = 0, i;
int ii;
size_t start_heap_size;
size_t rnum_in_trieinstr_unif_stk = (trieinstr_unif_stkptr-trieinstr_unif_stk)+1;
DECL_GC_PROFILE;
garbage_collecting = 1; // flag for profiling that we are gc-ing
// printf("start gc(%ld): e:%p,h:%p,hf:%p\n",(long)(cpu_time()*1000),ereg,hreg,hfreg);
INIT_GC_PROFILE;
if (pflags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (pflags[GARBAGE_COLLECT] == SLIDING_GC) |
(pflags[GARBAGE_COLLECT] == INDIRECTION_SLIDE_GC);
if (fragmentation_only)
slide = FALSE;
heap_early_reset = ls_early_reset = 0;
GC_PROFILE_START_SUMMARY;
begin_marktime = cpu_time();
start_heap_size = hreg+1-(CPtr)glstack.low;
/* make sure the top choice point heap pointer
that might not point into heap, does */
if (hreg == cp_hreg(breg)) {
*hreg = makeint(666) ;
hreg++;
}
#ifdef SLG_GC
/* same for the freeze heap pointer */
if (hfreg == hreg && hreg == cp_hreg(bfreg)) {
*hreg = makeint(66600);
hreg++;
}
#endif
/* copy the aregs to the top of the heap - only if sliding */
/* just hope there is enough space */
/* this happens best before the stack_boundaries are computed */
if (slide) {
if (delayreg != NULL) {
arity++;
reg[arity] = (Cell)delayreg;
}
for (ii = 1; ii <= arity; ii++) {
// printf("reg[%d] to heap: %lx\n",ii,(size_t)reg[i]);
*hreg = reg[ii];
hreg++;
}
arity += (int)rnum_in_trieinstr_unif_stk;
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
// printf("trieinstr_unif_stk[%d] to heap: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
*hreg = trieinstr_unif_stk[i];
hreg++;
}
// printf("extended heap: hreg=%p, arity=%d, rnum_in=%d\n",hreg,arity, rnum_in_trieinstr_unif_stk);
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
// printf("hfreg to heap is %p at %p, rnum_in_trieinstr_unif_stk=%d,arity=%d,delay=%p\n",hfreg,hreg,rnum_in_trieinstr_unif_stk,arity,delayreg);
*(hreg++) = (Cell) hfreg;
#endif
}
if (top_of_localstk < hreg) {
fprintf(stderr,"stack clobbered: no space for gc_heap\n");
xsb_exit( "stack clobbered");
}
gc_strings = ifStringGC; /* default */
gc_strings = should_gc_strings(); // collect strings for any reason?
marked = mark_heap(CTXTc arity, &marked_dregs);
end_marktime = cpu_time();
if (fragmentation_only) {
/* fragmentation is expressed as ratio not-marked/total heap in use
this is internal fragmentation only. we print marked and total,
so that postprocessing can do what it wants with this info. */
xsb_dbgmsg((LOG_GC, "marked_used_missed(%d,%d,%d,%d).",
marked,hreg+1-(CPtr)glstack.low,
heap_early_reset,ls_early_reset));
free_marks:
#ifdef PRE_IMAGE_TRAIL
/* re-tag pre image cells in trail */
for (p = tr_bot; p <= tr_top ; p++ ) {
if (tr_pre_marked(p-tr_bot)) {
*p = *p | PRE_IMAGE_MARK;
tr_clear_pre_mark(p-tr_bot);
}
}
#endif
/* get rid of the marking areas - if they exist */
if (heap_marks) { mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE); heap_marks = NULL; }
if (tr_marks) { mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE); tr_marks = NULL; }
if (ls_marks) { mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE); ls_marks = NULL; }
if (cp_marks) { mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE); cp_marks = NULL; }
if (slide_buf) { mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE); slide_buf = NULL; }
goto end;
}
GC_PROFILE_MARK_SUMMARY;
/* An attempt to add some gc/expansion policy;
ideally this should be user-controlled */
#if (! defined(GC_TEST))
if (marked > ((hreg+1-(CPtr)glstack.low)*mark_threshold))
{
GC_PROFILE_QUIT_MSG;
if (slide)
hreg -= arity;
total_time_gc += (double)
(end_marktime-begin_marktime);
goto free_marks; /* clean-up temp areas and get out of here... */
}
#endif
total_collected += (start_heap_size - marked);
if (slide)
{
GC_PROFILE_SLIDE_START_TIME;
hreg = slide_heap(CTXTc marked) ;
#ifdef DEBUG_VERBOSE
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#endif
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (CPtr) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
arity -= (int)rnum_in_trieinstr_unif_stk;
for (ii = 1; ii <= arity; ii++) {
reg[ii] = *p++;
// printf("heap to reg[%d]: %lx\n",ii,(size_t)reg[i]);
}
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
for (i = 0; i < rnum_in_trieinstr_unif_stk; i++) {
trieinstr_unif_stk[i] = *p++;
// printf("heap to trieinstr_unif_stk[%d]: %lx\n",i,(size_t)trieinstr_unif_stk[i]);
}
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime);
GC_PROFILE_SLIDE_FINAL_SUMMARY;
}
else
{ /* else we call the copying collector a la Cheney */
CPtr begin_new_heap, end_new_heap;
GC_PROFILE_COPY_START_TIME;
begin_new_heap = (CPtr)mem_alloc(marked*sizeof(Cell),GC_SPACE);
if (begin_new_heap == NULL)
xsb_exit( "copying garbage collection could not allocate new heap");
end_new_heap = begin_new_heap+marked;
hreg = copy_heap(CTXTc marked,begin_new_heap,end_new_heap,arity);
mem_dealloc(begin_new_heap,marked*sizeof(Cell),GC_SPACE);
adapt_hfreg_from_choicepoints(CTXTc hreg);
hbreg = cp_hreg(breg);
#ifdef SLG_GC
hfreg = hreg;
#endif
end_copy_time = cpu_time();
total_time_gc += (double)
(end_copy_time - begin_marktime);
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(CTXTc arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
mem_dealloc((heap_marks-1),heap_marks_size,GC_SPACE) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
mem_dealloc(tr_marks,tr_top-tr_bot+1,GC_SPACE) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
mem_dealloc(ls_marks,ls_bot - ls_top + 1,GC_SPACE) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
mem_dealloc(cp_marks,cp_bot - cp_top + 1,GC_SPACE) ;
cp_marks = NULL ;
}
if (slide_buf) {
mem_dealloc(slide_buf,(slide_buf_size+1)*sizeof(CPtr),GC_SPACE);
slide_buf = NULL;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (pflags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
/*************** GC STRING-TABLE (already marked from heap) *******************/
#ifndef NO_STRING_GC
#ifdef MULTI_THREAD
if (flags[NUM_THREADS] == 1) {
#endif
if (gc_strings && (flags[STRING_GARBAGE_COLLECT] == 1)) {
num_sgc++;
begin_stringtime = cpu_time();
mark_nonheap_strings(CTXT);
free_unused_strings();
// printf("String GC reclaimed: %d bytes\n",beg_string_space_size - pspacesize[STRING_SPACE]);
gc_strings = FALSE;
end_stringtime = cpu_time();
total_time_gc += end_stringtime - begin_stringtime;
}
/* update these even if no GC, to avoid too many calls just to gc strings */
last_string_space_size = pspacesize[STRING_SPACE];
last_assert_space_size = pspacesize[ASSERT_SPACE];
force_string_gc = FALSE;
#ifdef MULTI_THREAD
}
#endif
#endif /* ndef NO_STRING_GC */
GC_PROFILE_POST_REPORT;
garbage_collecting = 0;
#endif /* GC */
// printf(" end gc(%ld), hf:%p,h:%p, space=%d\n",(long)(cpu_time()*1000),hfreg,hreg,(pb)top_of_localstk - (pb)top_of_heap);
return(TRUE);
} /* gc_heap */
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
}
