static char *get_host_IP(char *host_name_or_IP) {
struct hostent *host_struct;
struct in_addr *ptr;
char **listptr;
char *error;
/* if host_name_or_IP is an IP addr, then just return; else use
gethostbyname */
if (IS_IP_ADDR(host_name_or_IP))
return(host_name_or_IP);
host_struct = gethostbyname(host_name_or_IP);
if( host_struct == NULL )
{
if( h_errno == HOST_NOT_FOUND )
error = "socket: host not found" ;
else if ( h_errno == NO_ADDRESS || h_errno == NO_DATA )
error = "socket: host doesn't have a valid IP address" ;
else if( h_errno == NO_RECOVERY )
error = "socket: non recoverable error" ;
else if( h_errno == TRY_AGAIN )
error = "socket: temporary error" ;
else
error = "socket: unknown error" ;
xsb_abort( error ) ;
}
listptr = host_struct->h_addr_list;
if ((ptr = (struct in_addr *) *listptr++) != NULL) {
xsb_mesg(" IP address: %s", inet_ntoa(*ptr));
return(inet_ntoa(*ptr));
}
return NULL;
}
/*
* Called through builtins statistics/1 and statistics/0.
* ( statistics :- statistics(1). )
*/
void print_statistics(CTXTdeclc int amount) {
switch (amount) {
case 0: /* Reset Statistical Parameters */
#ifndef MULTI_THREAD
realtime_count_gl = real_time();
perproc_reset_stat(); /* reset op-counts, starting time, and 'tds'
struct variable (all 0's) */
reset_stat_total(); /* reset 'ttt' struct variable (all 0's) */
xsb_mesg("Statistics is reset.");
break;
#else
realtime_count_gl = real_time();
break;
#endif
case 1: /* Default use: Print Stack Usage and CPUtime: */
perproc_stat(); /* move max usage into 'ttt' struct variable */
total_stat(CTXTc real_time()-realtime_count_gl); /* print */
reset_stat_total(); /* reset 'ttt' struct variable (all 0's) */
break;
case 2: /* Print Detailed Table Usage */
print_detailed_tablespace_stats(CTXT);
break;
case 3: /* Print Detailed Table, Stack, and CPUtime */
#ifndef MULTI_THREAD
perproc_stat();
total_stat(CTXTc real_time()-realtime_count_gl);
reset_stat_total();
print_detailed_tablespace_stats(CTXT);
print_detailed_subsumption_stats();
break;
#else
fprintf(stdwarn,"statistics(3) not yet implemented for MT engine\n");
break;
#endif
case 4: /* mutex use (if PROFILE_MUTEXES is defined) */
print_mutex_use();
print_mem_allocs();
break;
case 5:
dis(0);
break; /* output memory image - data only; for debugging */
case 6:
dis(1);
break; /* output memory image - data + text; for debugging */
#ifdef CP_DEBUG
case 7:
print_cp_backtrace();
break;
#endif
case 8: /* print symbol/string statistics */
symbol_table_stats();
string_table_stats();
break;
}
}
xsbBool startInterruptThread(SOCKET intSocket)
{
xsb_mesg("Beginning interrupt thread on socket %ld",(int)intSocket);
#ifdef _MT
_beginthread( checkJavaInterrupt, 0, (void*)intSocket );
#endif
return 1;
}
/* Our separate thread */
void checkJavaInterrupt(void *info)
{
char ch;
SOCKET intSocket = (SOCKET)info;
xsb_dbgmsg((LOG_DEBUG, "Thread started on socket %ld",(int)intSocket));
while(1){
if (1!=recv(intSocket,&ch,1,0)) {
xsb_warn("Problem handling interrupt from Java");
}
else
xsb_mesg("--- Java interrupt detected");
/* Avoid those annoying lags? */
fflush(stdout);
fflush(stderr);
fflush(stdmsg);
fflush(stdwarn);
fflush(stddbg);
keyint_proc(SIGINT); /* Do XSB's "interrupt" thing */
}
}
xsbBool glstack_realloc(CTXTdeclc size_t new_size, int arity)
{
CPtr new_heap_bot=NULL ; /* bottom of new Global Stack area */
CPtr new_ls_bot ; /* bottom of new Local Stack area */
size_t heap_offset ; /* offsets between the old and new */
size_t local_offset ; /* stack bottoms, measured in Cells */
CPtr *cell_ptr ;
Cell cell_val ;
size_t i, rnum_in_trieinstr_unif_stk = (trieinstr_unif_stkptr-trieinstr_unif_stk)+1;
size_t new_size_in_bytes, new_size_in_cells ; /* what a mess ! */
double expandtime ;
if (new_size <= glstack.size) { // asked to shrink
// new_size is space needed + half of init_size, rounded to K
new_size = (((glstack.high - (byte *)top_of_localstk) +
((byte *)hreg - glstack.low)) + glstack.init_size*K/2 + (K-1)) / K;
// but not smaller than init_size
if (new_size < glstack.init_size) new_size = glstack.init_size;
if (new_size >= glstack.size) return 0; // computed new_size won't shrink
// printf("shrinking glstack from %dK to %dK\n",glstack.size,new_size);
}
// fprintf(stddbg,"Reallocating the Heap and Local Stack data area");
#ifdef DEBUG_VERBOSE
if (LOG_REALLOC <= cur_log_level) {
if (glstack.size == glstack.init_size) {
xsb_dbgmsg((LOG_REALLOC,"\tBottom:\t\t%p\t\tInitial Size: %" Intfmt "K",
glstack.low, glstack.size));
xsb_dbgmsg((LOG_REALLOC,"\tTop:\t\t%p", glstack.high));
}
}
#endif
expandtime = cpu_time();
new_size_in_bytes = new_size*K ;
new_size_in_cells = new_size_in_bytes/sizeof(Cell) ;
/* and let's hope K stays divisible by sizeof(Cell) */
stack_boundaries ;
/* Expand the data area and push the Local Stack to the high end. */
if (new_size < glstack.size) { //shrinking
// move local stack down
memmove(glstack.low + new_size_in_bytes-(glstack.high-(byte *)ls_top), // to
ls_top, // from
glstack.high - (byte *)ls_top // size
);
new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
heap_offset = new_heap_bot - heap_bot ;
new_ls_bot = new_heap_bot + new_size_in_cells - 1 ;
local_offset = new_ls_bot - ls_bot ;
} else { // expanding
if (!USER_MEMORY_LIMIT_EXHAUSTED(new_size))
new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
if (new_heap_bot == NULL) {
if (2*glstack.size == new_size) { /* if trying to double, try backing off, may not help */
size_t increment = new_size;
while (new_heap_bot == NULL && increment > 40) {
increment = increment/2;
new_size = glstack.size + increment;
new_size_in_bytes = new_size*K ;
new_size_in_cells = new_size_in_bytes/sizeof(Cell) ;
if (!USER_MEMORY_LIMIT_EXHAUSTED(new_size))
new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
}
if (new_heap_bot == NULL) {
// xsb_mesg("Not enough core to resize the Heap/Local Stack! (current: %"Intfmt"; resize %"Intfmt")",
// glstack.size*K,new_size_in_bytes);
return 1; /* return an error output -- will be picked up later */
}
} else {
xsb_mesg("Not enough core to resize the Heap and Local Stack! (%" Intfmt ")",new_size_in_bytes);
return 1; /* return an error output -- will be picked up later */
}
}
// printf("realloced heap %d -> %d\n",glstack.size,new_size);
heap_offset = new_heap_bot - heap_bot ;
new_ls_bot = new_heap_bot + new_size_in_cells - 1 ;
local_offset = new_ls_bot - ls_bot ;
#if defined(GENERAL_TAGGING)
// printf("glstack expand %p %p\n",(void *)new_heap_bot,(void *)new_ls_bot+1);
extend_enc_dec_as_nec(new_heap_bot,new_ls_bot+1);
#endif
memmove(ls_top + local_offset, /* move to */
ls_top + heap_offset, /* move from */
(ls_bot - ls_top + 1)*sizeof(Cell) ); /* number of bytes */
}
initialize_glstack(heap_top + heap_offset,ls_top+local_offset);
/* TLS: below, the condition should not need to be commented out.
If the heap expands, there should be no pointers from heap into
the local stack, so we shouldnt need to traverse the heap.
However, call subumption code actually copies the substitution
factor from the CPS to heap (I dont know why, but see the comment
after the call to subsumptive_call_search() in slginsts_xsb_i.h),
so that substitution factor pointers may point from the heap to
local stack. Therefore the pointer update causes the heap-ls
pointers to be harmless at glstack expansion.
*/
/* Update the Heap links */
// if (heap_offset != 0) {
for (cell_ptr = (CPtr *)(heap_top + heap_offset);
cell_ptr-- > (CPtr *)new_heap_bot;
)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
// }
/* Update the pointers in the Local Stack */
for (cell_ptr = (CPtr *)(ls_top + local_offset);
cell_ptr <= (CPtr *)new_ls_bot;
cell_ptr++)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
/* Update the trailed variable pointers */
for (cell_ptr = (CPtr *)top_of_trail - 1;
cell_ptr > (CPtr *)tcpstack.low;
cell_ptr = cell_ptr - 2)
{ /* first the value */
reallocate_heap_or_ls_pointer(cell_ptr);
/* now the address */
cell_ptr-- ;
cell_val = (Cell)*cell_ptr ;
#ifdef PRE_IMAGE_TRAIL
if ((size_t) cell_val & PRE_IMAGE_MARK) {
/* remove tag */
cell_val = (Cell) ((Cell) cell_val & ~PRE_IMAGE_MARK);
/* realloc and tag */
realloc_ref_pre_image(cell_ptr,(CPtr)cell_val) ;
cell_ptr--;
/* realoc pre-image */
reallocate_heap_or_ls_pointer(cell_ptr);
} else
#endif
realloc_ref(cell_ptr,(CPtr)cell_val) ;
}
/* Update the CP Stack pointers */
for (cell_ptr = (CPtr *)top_of_cpstack;
cell_ptr < (CPtr *)tcpstack.high;
cell_ptr++)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
/* Update the argument registers */
while (arity)
{ cell_ptr = (CPtr *)(reg+arity) ;
reallocate_heap_or_ls_pointer(cell_ptr) ;
arity-- ;
}
i = 0;
while (i < rnum_in_trieinstr_unif_stk) {
cell_ptr = (CPtr *)(trieinstr_unif_stk+i);
// printf(" reallocate trieinstr_unif_stk[%d]=%p\n",i,cell_ptr);
reallocate_heap_or_ls_pointer(cell_ptr) ;
i++;
}
/* Update the system variables */
glstack.low = (byte *)new_heap_bot ;
glstack.high = (byte *)(new_ls_bot + 1) ;
pspace_tot_gl = pspace_tot_gl + (new_size - glstack.size)*K;
glstack.size = new_size ;
hreg = (CPtr)hreg + heap_offset ;
hbreg = (CPtr)hbreg + heap_offset ;
hfreg = (CPtr)hfreg + heap_offset ;
ereg = (CPtr)ereg + local_offset ;
ebreg = (CPtr)ebreg + local_offset ;
efreg = (CPtr)efreg + local_offset ;
if (islist(delayreg))
delayreg = (CPtr)makelist(clref_val(delayreg) + heap_offset);
expandtime = cpu_time() - expandtime;
xsb_dbgmsg((LOG_REALLOC,"\tNew Bottom:\t%p\t\tNew Size: %" Intfmt "K",
glstack.low, glstack.size));
xsb_dbgmsg((LOG_REALLOC,"\tNew Top:\t%p", glstack.high));
xsb_dbgmsg((LOG_REALLOC,
"Heap/Local Stack data area expansion - finished in %lf secs\n",
expandtime));
return 0;
} /* glstack_realloc */
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;
}
xsbBool glstack_realloc(int new_size, int arity)
{
CPtr new_heap_bot ; /* bottom of new Global Stack area */
CPtr new_ls_bot ; /* bottom of new Local Stack area */
long heap_offset ; /* offsets between the old and new */
long local_offset ; /* stack bottoms, measured in Cells */
CPtr *cell_ptr ;
Cell cell_val ;
size_t new_size_in_bytes, new_size_in_cells ; /* what a mess ! */
long expandtime ;
if (new_size <= glstack.size) return 0;
xsb_dbgmsg((LOG_REALLOC,
"Reallocating the Heap and Local Stack data area"));
#ifdef DEBUG_VERBOSE
if (LOG_REALLOC <= cur_log_level) {
if (glstack.size == glstack.init_size) {
xsb_dbgmsg((LOG_REALLOC,"\tBottom:\t\t%p\t\tInitial Size: %ldK",
glstack.low, glstack.size));
xsb_dbgmsg((LOG_REALLOC,"\tTop:\t\t%p", glstack.high));
}
}
#endif
expandtime = (long)(1000*cpu_time()) ;
new_size_in_bytes = new_size*K ;
new_size_in_cells = new_size_in_bytes/sizeof(Cell) ;
/* and let's hope K stays divisible by sizeof(Cell) */
stack_boundaries ;
/* Expand the data area and push the Local Stack to the high end. */
new_heap_bot = (CPtr)realloc(heap_bot, new_size_in_bytes);
if (new_heap_bot == NULL) {
xsb_mesg("Not enough core to resize the Heap and Local Stack!");
return 1; /* return an error output -- will be picked up later */
}
heap_offset = new_heap_bot - heap_bot ;
new_ls_bot = new_heap_bot + new_size_in_cells - 1 ;
local_offset = new_ls_bot - ls_bot ;
memmove(ls_top + local_offset, /* move to */
ls_top + heap_offset, /* move from */
(ls_bot - ls_top + 1)*sizeof(Cell) ); /* number of bytes */
/* Update the Heap links */
for (cell_ptr = (CPtr *)(heap_top + heap_offset);
cell_ptr-- > (CPtr *)new_heap_bot;
)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
/* Update the pointers in the Local Stack */
for (cell_ptr = (CPtr *)(ls_top + local_offset);
cell_ptr <= (CPtr *)new_ls_bot;
cell_ptr++)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
/* Update the trailed variable pointers */
for (cell_ptr = (CPtr *)top_of_trail - 1;
cell_ptr > (CPtr *)tcpstack.low;
cell_ptr = cell_ptr - 2)
{ /* first the value */
reallocate_heap_or_ls_pointer(cell_ptr);
/* now the address */
cell_ptr-- ;
cell_val = (Cell)*cell_ptr ;
realloc_ref(cell_ptr,(CPtr)cell_val) ;
}
/* Update the CP Stack pointers */
for (cell_ptr = (CPtr *)top_of_cpstack;
cell_ptr < (CPtr *)tcpstack.high;
cell_ptr++)
{ reallocate_heap_or_ls_pointer(cell_ptr) ; }
/* Update the argument registers */
while (arity)
{ cell_ptr = (CPtr *)(reg+arity) ;
reallocate_heap_or_ls_pointer(cell_ptr) ;
arity-- ;
}
/* Update the system variables */
glstack.low = (byte *)new_heap_bot ;
glstack.high = (byte *)(new_ls_bot + 1) ;
glstack.size = new_size ;
hreg = (CPtr)hreg + heap_offset ;
hbreg = (CPtr)hbreg + heap_offset ;
hfreg = (CPtr)hfreg + heap_offset ;
ereg = (CPtr)ereg + local_offset ;
ebreg = (CPtr)ebreg + local_offset ;
efreg = (CPtr)efreg + local_offset ;
if (islist(delayreg))
delayreg = (CPtr)makelist(clref_val(delayreg) + heap_offset);
expandtime = (long)(1000*cpu_time()) - expandtime;
xsb_dbgmsg((LOG_REALLOC,"\tNew Bottom:\t%p\t\tNew Size: %ldK",
glstack.low, glstack.size));
xsb_dbgmsg((LOG_REALLOC,"\tNew Top:\t%p", glstack.high));
xsb_dbgmsg((LOG_REALLOC,
"Heap/Local Stack data area expansion - finished in %ld msecs\n",
expandtime));
return 0;
} /* glstack_realloc */