Esempio n. 1
0
Pair link_sym(Psc psc, Psc mod_psc)
{
    Pair *search_ptr, found_pair;
    char *name, message[120];
    byte arity, global_flag;

    name = get_name(psc);
    arity = get_arity(psc);
    if ( (global_flag = is_globalmod(mod_psc)) )
      search_ptr = (Pair *)symbol_table.table +
	           hash(name, arity, symbol_table.size);
    else
      search_ptr = (Pair *)&get_data(mod_psc);
    if ((found_pair = search(arity, name, search_ptr))) {
      if (pair_psc(found_pair) != psc) {
	/*
	 *  Invalidate the old name!! It is no longer accessible
	 *  through the global chain.
	 */
	if ( get_type(pair_psc(found_pair)) != T_ORDI ) {
	  sprintf(message,
		  "%s/%d (type %d) was defined in another module!",
		  name, arity, get_type(pair_psc(found_pair)));
	  xsb_warn(message);
	}
	pair_psc(found_pair) = psc;
      }
    }
    else {
      found_pair = make_psc_pair(psc, search_ptr);
      if (global_flag)
	symbol_table_increment_and_check_for_overflow;
    }
    return found_pair;
} /* link_sym */
Esempio n. 2
0
Pair link_sym(Psc psc, Psc mod_psc)
{
    Pair *search_ptr, found_pair;
    char *name;
    byte arity, global_flag, type;

    SYS_MUTEX_LOCK_NOERROR( MUTEX_SYMBOL ) ;
    name = get_name(psc);
    arity = get_arity(psc);
    if ( (global_flag = is_globalmod(mod_psc)) ) {
        search_ptr = (Pair *)symbol_table.table +
                     hash(name, arity, symbol_table.size);
    } else
        search_ptr = (Pair *)&get_data(mod_psc);
    if ((found_pair = search(arity, name, search_ptr))) {
        if (pair_psc(found_pair) != psc) {
            /*
             *  Invalidate the old name!! It is no longer accessible
             *  through the global chain.
             */
            type = get_type(pair_psc(found_pair));
            if ( type != T_ORDI ) {
                char message[220], modmsg[200];
                if (type == T_DYNA || type == T_PRED) {
                    Psc mod_psc;
                    mod_psc = (Psc) get_data(pair_psc(found_pair));
                    if (mod_psc == 0) snprintf(modmsg,200,"%s","usermod");
                    else if (isstring(mod_psc)) snprintf(modmsg,200,"usermod from file: %s",string_val(mod_psc));
                    else snprintf(modmsg,200,"module: %s",get_name(mod_psc));
                    snprintf(message,220,
                             "%s/%d (type %d) had been defined in %s",
                             name, arity, type,
                             modmsg);
                } else
                    snprintf(message,220,
                             "%s/%d (type %d) had been defined in another module!",
                             name, arity, type);
                xsb_warn(message);
            }
            pair_psc(found_pair) = psc;
        }
    }
    else {
        found_pair = make_psc_pair(psc, search_ptr);
        if (global_flag)
            symbol_table_increment_and_check_for_overflow;
    }
    SYS_MUTEX_UNLOCK_NOERROR( MUTEX_SYMBOL ) ;
    return found_pair;
} /* link_sym */
int prolog_call0(CTXTdeclc Cell term)
{
    Psc  psc;
    if (isconstr(term)) {
      int  disp;
      char *addr;
      psc = get_str_psc(term);
      addr = (char *)(clref_val(term));
      for (disp = 1; disp <= (int)get_arity(psc); ++disp) {
	bld_copy(reg+disp, cell((CPtr)(addr)+disp));
      }
    } else if (isstring(term)) {
      int  value;
      Pair sym;
      if (string_val(term) == true_string) return TRUE; /* short-circuit if calling "true" */
      sym = insert(string_val(term),0,(Psc)flags[CURRENT_MODULE],&value);
      psc = pair_psc(sym);
    } else {
      if (isnonvar(term))
	xsb_type_error(CTXTc "callable",term,"call/1",1);
      else xsb_instantiation_error(CTXTc "call/1",1);
      return FALSE;
    }
#ifdef CP_DEBUG
    pscreg = psc;
#endif
    pcreg = get_ep(psc);
    if (asynint_val) intercept(CTXTc psc);
    return TRUE;
}
Esempio n. 4
0
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);*/
}
Esempio n. 5
0
/*
 * Get the PSC for intern/1, a generic functor for storing in the roots
 * of interned tries.
 */
Psc get_intern_psc() {

  Pair intern_handle;
  int new_indicator;

  intern_handle = insert("intern", 1, global_mod, &new_indicator);
  return (pair_psc(intern_handle));
}
Esempio n. 6
0
/*
 *  Create a PSC-PAIR record, set it to point to a PSC record, and place
 *  it at the head of a PSC-PAIR record chain.
 */
static Pair make_psc_pair(Psc psc_ptr, Pair *link_ptr) {

  Pair new_pair;
  
  new_pair = (Pair)mem_alloc(sizeof(struct psc_pair));
  pair_psc(new_pair) = psc_ptr;         /* set 1st to point to psc_rec */
  pair_next(new_pair) = *link_ptr;      /* set 2nd to old head */
  *link_ptr = new_pair;                 /* new symbol is in the head! */
  return new_pair;
}
Esempio n. 7
0
/*
 * Get the PSC for ret/n.  If it already exists, just return it.  Or
 * create one and save it in ret_psc[n].
 */
Psc get_ret_psc(int n)
{
  Pair temp;
  int new_indicator;

  if (!ret_psc[n]) {
    temp = (Pair) insert("ret", (byte) n, global_mod, &new_indicator);
    ret_psc[n] = pair_psc(temp);
  }
  return ret_psc[n];
}
Esempio n. 8
0
/*
 *  Create a PSC-PAIR record, set it to point to a PSC record, and place
 *  it at the head of a PSC-PAIR record chain.
 */
static Pair make_psc_pair(Psc psc_ptr, Pair *link_ptr) {

  Pair new_pair;
  
  new_pair = (Pair)mem_alloc(sizeof(struct psc_pair),ATOM_SPACE);
  //  printf("new_psc_pair %d, prev %d\n",(int)new_pair, (int)*link_ptr);
  pair_psc(new_pair) = psc_ptr;         /* set 1st to point to psc_rec */
  pair_next(new_pair) = *link_ptr;      /* set 2nd to old head */
  *link_ptr = new_pair;                 /* new symbol is in the head! */
  return new_pair;
}