static void init_hashtable(xsbHashTable *table)
{
/* calloc zeroes the allocated space; clients rely on this */
table->table = (char *)calloc(table->length,table->bucket_size);
if (!table->table)
xsb_exit("Out of Memory: Can't create hash table");
table->initted = TRUE;
}
void xsb_segfault_quitter(int err)
{
#ifdef MULTI_THREAD
th_context *th = find_context(xsb_thread_self());
#endif
print_xsb_backtrace(CTXT);
xsb_exit(CTXTc xsb_segfault_message);
}
xsbBucket *search_bucket(Cell name,
xsbHashTable *table,
enum xsbHashSearchOp search_op)
{
xsbBucket *bucket, *prev;
if (! table->initted) init_hashtable(table);
prev = NULL;
bucket = get_top_bucket(table,table_hash(name,table->length));
while (bucket && bucket->name) {
if (bucket->name == name) {
if (search_op == hashtable_delete) {
if (!prev) {
/* if deleting a top bucket, copy the next bucket into the top one
and delete that next bucket. If no next, then just nullify name */
prev = bucket;
bucket=bucket->next;
if (bucket) {
/* use memcpy() because client bucket might have extra fields */
memcpy(prev, bucket, table->bucket_size);
free(bucket);
} else {
mark_bucket_free(prev,table->bucket_size);
xsb_dbgmsg((LOG_HASHTABLE,
"SEARCH_BUCKET: Destroying storage handle for %s\n",
string_val(name)));
xsb_dbgmsg((LOG_HASHTABLE,
"SEARCH_BUCKET: Bucket nameptr is %p, next bucket %p\n",
prev->name, prev->next));
}
} else {
/* Not top bucket: rearrange pointers & free space */
prev->next = bucket->next;
free(bucket);
}
return NULL;
} else
return bucket;
}
prev = bucket;
bucket = bucket->next;
}
/* not found */
if (search_op != hashtable_insert) return NULL;
/* else create new bucket */
/* calloc nullifies the allocated space; CLIENTS RELY ON THIS */
if (!bucket) { /* i.e., it is not a top bucket */
bucket = (xsbBucket *)calloc(1,table->bucket_size);
if (!bucket)
xsb_exit("Out of Memory: Can't allocate hash bucket");
prev->next = bucket;
/* NOTE: not necessary to nullify bucket->next because of calloc() */
}
bucket->name = name;
return bucket;
}
/*-----------------------------------------------------------------------------*/
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!");
}
/* SIGSEGV/SIGBUS handler that catches segfaults; used unless
configured with DEBUG */
void xsb_segfault_catcher(int err)
{
char *tmp_message = xsb_segfault_message;
#ifdef MULTI_THREAD
th_context *th = find_context(xsb_thread_self());
xsb_exit(th, tmp_message);
#else
xsb_segfault_message = xsb_default_segfault_msg; /* restore default */
printf("segfault!!\n");
xsb_basic_abort(tmp_message);
#endif
}
static void default_inthandler(CTXTdeclc int intcode)
{
char message[80];
switch (intcode) {
case MYSIG_UNDEF:
xsb_exit(CTXTc "Undefined predicate; exiting by the default handler.");
break;
case MYSIG_KEYB:
xsb_exit(CTXTc "Keyboard interrupt; exiting by the default handler.");
break;
case MYSIG_PSC:
break;
default:
sprintf(message,
"Unknown interrupt (%d) occured; exiting by the default handler",
intcode);
xsb_exit(CTXTc message);
break;
}
}
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 */
static Integer get_index_tab(CTXTdeclc FILE *fd, int clause_no)
{
Integer hashval, size, j;
Integer count = 0;
byte type ;
CPtr label;
Integer ival;
Cell val;
Integer dummy; /* used to squash warnings */
size = hsize(clause_no);
indextab = (struct hrec *)mem_alloc(size*sizeof(struct hrec),COMPILED_SPACE);
for (j = 0; j < size; j++) {
indextab[j].l = 0;
indextab[j].link = (CPtr)&(indextab[j].link);
}
for (j = 0; j < clause_no; j++) {
dummy = get_obj_byte(&type);
switch (type) {
case 'i': get_obj_word_bbsig_notag(&ival);
hashval = ihash((Cell) ival, size);
count += 9;
break;
case 'f':
get_obj_word_bbsig_notag(&ival);
// printf("sfloat: %f, %x\n",(*(float *)(&ival)), (*(Integer *)(&ival)) );
#ifndef FAST_FLOATS
val = float_val_to_hash(*(float *)(&ival));
#else
val = ival;
#endif
hashval = ihash((Cell) val, size);
count += 9;
break;
case 'd': {
double fval;
dummy = get_obj_string(&fval,8);
#ifndef FAST_FLOATS
val = float_val_to_hash(fval);
#else
{
union {
long intp;
float fltp;
} cvtr;
cvtr.fltp = (float)fval;
val = cvtr.intp;
}
#endif
// printf("bld float index: %2.14f, %0x, size=%d\n",fval,val,size);
hashval = ihash((Cell) val, size);
count += 9;
break;
}
case 'l':
hashval = ihash((Cell)(list_pscPair), size);
count += 5;
break;
case 'n':
hashval = ihash((Cell) 0, size);
count += 5;
break;
case 'c': get_obj_word_bb(&ival);
count += 9;
val = (Cell)ival ;
st_pscname(&val);
hashval = ihash(val, size) ;
break;
case 's': get_obj_word_bb(&ival);
count += 9;
val = (Cell)ival ;
st_ptrpsc(&val);
hashval = ihash(val, size) ;
break;
default:
hashval = 0;
xsb_exit( "illegal format");
}
get_obj_word_bbsig_notag(&label);
label = reloc_addr((Integer)label, seg_text(current_seg));
inserth(label, &indextab[hashval]);
}
return count;
}
int gc_heap(int arity)
{
#ifdef GC
CPtr p;
unsigned long begin_marktime, end_marktime,
end_slidetime, end_copy_time;
int marked = 0, marked_dregs = 0, i;
int start_heap_size;
DECL_GC_PROFILE;
INIT_GC_PROFILE;
if (flags[GARBAGE_COLLECT] != NO_GC) {
num_gc++ ;
GC_PROFILE_PRE_REPORT;
slide = (flags[GARBAGE_COLLECT] == SLIDING_GC) |
(flags[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 (i = 1; i <= arity; i++) {
*hreg = reg[i];
hreg++;
}
}
#ifdef SLG_GC
/* in SLGWAM, copy hfreg to the heap */
if (slide) {
*hreg = (unsigned long) hfreg;
hreg++;
}
#endif
marked = mark_heap(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:
/* get rid of the marking areas - if they exist */
if (heap_marks) { free((heap_marks-1)); heap_marks = NULL; }
if (tr_marks) { free(tr_marks); tr_marks = NULL; }
if (ls_marks) { free(ls_marks); ls_marks = NULL; }
if (cp_marks) { free(cp_marks); cp_marks = 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)*1000/CLOCKS_PER_SEC;
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(marked) ;
if (hreg != (heap_bot+marked))
xsb_dbgmsg((LOG_GC, "heap sliding gc - inconsistent hreg"));
#ifdef SLG_GC
/* copy hfreg back from the heap */
hreg--;
hfreg = (unsigned long*) *hreg;
#endif
/* copy the aregs from the top of the heap back */
hreg -= arity;
hbreg = cp_hreg(breg);
p = hreg;
for (i = 1; i <= arity; i++)
reg[i] = *p++ ;
if (delayreg != NULL)
delayreg = (CPtr)reg[arity--];
end_slidetime = cpu_time();
total_time_gc += (double)
(end_slidetime - begin_marktime)*1000/CLOCKS_PER_SEC;
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)malloc(marked*sizeof(Cell));
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(marked,begin_new_heap,end_new_heap,arity);
free(begin_new_heap);
adapt_hfreg_from_choicepoints(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)*1000/CLOCKS_PER_SEC;
GC_PROFILE_COPY_FINAL_SUMMARY;
}
if (print_on_gc) print_all_stacks(arity);
/* get rid of the marking areas - if they exist */
if (heap_marks) {
check_zero(heap_marks,(heap_top - heap_bot),"heap") ;
free((heap_marks-1)) ; /* see its calloc */
heap_marks = NULL ;
}
if (tr_marks) {
check_zero(tr_marks,(tr_top - tr_bot + 1),"tr") ;
free(tr_marks) ;
tr_marks = NULL ;
}
if (ls_marks) {
check_zero(ls_marks,(ls_bot - ls_top + 1),"ls") ;
free(ls_marks) ;
ls_marks = NULL ;
}
if (cp_marks) {
check_zero(cp_marks,(cp_bot - cp_top + 1),"cp") ;
free(cp_marks) ;
cp_marks = NULL ;
}
#ifdef SAFE_GC
p = hreg;
while (p < heap_top)
*p++ = 0;
#endif
} /* if (flags[GARBAGE_COLLECT]) */
#else
/* for no-GC, there is no gc, but stack expansion can be done */
#endif
#ifdef GC
end:
GC_PROFILE_POST_REPORT;
#endif /* GC */
return(TRUE);
} /* gc_heap */
/*-----------------------------------------------------------------------------*/
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 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 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;
}
