DllExport char* call_conv string_find(const char *str, int insert) {
char **ptr, *str0;
SYS_MUTEX_LOCK_NOERROR( MUTEX_STRING ) ;
ptr = (char **)string_table.table + hash(str, 0, string_table.size);
while (*ptr) {
str0 = *ptr + CHAR_PTR_SIZE;
if (strcmp(str, str0) == 0)
goto exit_string_find;
ptr = (char **)(*ptr);
}
if (insert) {
str0 = (char *)mem_alloc(CHAR_PTR_SIZE + strlen(str) + 1,STRING_SPACE);
*ptr = str0;
*(char **)str0 = NULL;
str0 = str0 + CHAR_PTR_SIZE;
strcpy(str0, str);
string_table_increment_and_check_for_overflow;
if ((pspacesize[STRING_SPACE] > 4*last_string_space_size) &&
(pspacesize[ASSERT_SPACE] < 2*last_assert_space_size)) {
force_string_gc = TRUE;
}
}
else
str0 = NULL ;
exit_string_find:
SYS_MUTEX_UNLOCK_NOERROR( MUTEX_STRING ) ;
return str0;
}
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 */
Pair insert_module(int type, char *name)
{
Pair new_pair;
int is_new;
SYS_MUTEX_LOCK_NOERROR( MUTEX_SYMBOL ) ;
new_pair = insert0(name, 0, (Pair *)&flags[MOD_LIST], &is_new);
if (is_new) {
set_type(new_pair->psc_ptr, type);
} else { /* set loading bit: T_MODU - loaded; 0 - unloaded */
set_type(new_pair->psc_ptr, get_type(new_pair->psc_ptr) | type);
}
SYS_MUTEX_UNLOCK_NOERROR( MUTEX_SYMBOL ) ;
return new_pair;
} /* insert_module */
Pair insert(char *name, byte arity, Psc mod_psc, int *is_new)
{
Pair *search_ptr, temp;
SYS_MUTEX_LOCK_NOERROR( MUTEX_SYMBOL ) ;
if (is_globalmod(mod_psc)) {
search_ptr = (Pair *)(symbol_table.table +
hash(name, arity, symbol_table.size));
temp = insert0(name, arity, search_ptr, is_new);
if (*is_new)
symbol_table_increment_and_check_for_overflow;
}
else {
search_ptr = (Pair *)&(get_data(mod_psc));
temp = insert0(name, arity, search_ptr, is_new);
}
SYS_MUTEX_UNLOCK_NOERROR( MUTEX_SYMBOL ) ;
return temp ;
} /* insert */
