Example #1
0
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;
}
Example #2
0
File: subp.c Project: flavioc/XSB
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);
}
Example #3
0
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;
}
Example #4
0
/*-----------------------------------------------------------------------------*/
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!");
}
Example #5
0
File: subp.c Project: flavioc/XSB
/* 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
}
Example #6
0
File: subp.c Project: flavioc/XSB
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;
  }
}
Example #7
0
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 */
Example #8
0
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;
}
Example #9
0
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 */
Example #10
0
/*-----------------------------------------------------------------------------*/
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;
}
Example #11
0
/*-----------------------------------------------------------------------------*/
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;    
}
Example #12
0
/*-----------------------------------------------------------------------------*/
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;
}