static SourceFile
lookupSourceFile_unlocked(atom_t name, int create)
{ GET_LD
SourceFile file;
if ( !GD->files.table )
{ GD->files.table = newHTable(32);
GD->files.table->free_symbol = freeSymbolSourceFile;
GD->files.no_hole_before = 1;
}
if ( (file=lookupHTable(GD->files.table, (void*)name)) )
{ ;
} else if ( create )
{ file = allocHeapOrHalt(sizeof(*file));
memset(file, 0, sizeof(*file));
file->name = name;
file->system = GD->bootsession;
#ifdef O_PLMT
file->mutex = allocSimpleMutex(PL_atom_chars(name));
#endif
PL_register_atom(file->name);
file->magic = SF_MAGIC;
registerSourceFile(file);
addNewHTable(GD->files.table, (void*)name, file);
} else
{ file = NULL;
}
return file;
}
static int
defOperator(Module m, atom_t name, int type, int priority, int force)
{ GET_LD
Symbol s;
operator *op;
int t = (type & OP_MASK); /* OP_PREFIX, ... */
DEBUG(7, Sdprintf(":- op(%d, %s, %s) in module %s\n",
priority,
PL_atom_chars(operatorTypeToAtom(type)),
PL_atom_chars(name),
PL_atom_chars(m->name)));
assert(t>=OP_PREFIX && t<=OP_POSTFIX);
if ( !force && !SYSTEM_MODE )
{ if ( name == ATOM_comma ||
(name == ATOM_bar && ((t&OP_MASK) != OP_INFIX ||
(priority < 1001 && priority != 0))) )
{ GET_LD
atom_t action = (name == ATOM_comma ? ATOM_modify : ATOM_create);
term_t t = PL_new_term_ref();
PL_put_atom(t, name);
return PL_error(NULL, 0, NULL, ERR_PERMISSION,
action, ATOM_operator, t);
}
}
LOCK();
if ( !m->operators )
m->operators = newOperatorTable(8);
if ( (s = lookupHTable(m->operators, (void *)name)) )
{ op = s->value;
} else if ( priority < 0 )
{ UNLOCK(); /* already inherited: do not change */
return TRUE;
} else
{ op = allocHeapOrHalt(sizeof(*op));
op->priority[OP_PREFIX] = -1;
op->priority[OP_INFIX] = -1;
op->priority[OP_POSTFIX] = -1;
op->type[OP_PREFIX] = OP_INHERIT;
op->type[OP_INFIX] = OP_INHERIT;
op->type[OP_POSTFIX] = OP_INHERIT;
}
op->priority[t] = priority;
op->type[t] = (priority >= 0 ? type : OP_INHERIT);
if ( !s )
{ PL_register_atom(name);
addHTable(m->operators, (void *)name, op);
}
UNLOCK();
return TRUE;
}
static const uri_component_ranges *
base_ranges(term_t t)
{ atom_t a;
if ( PL_get_atom(t, &a) )
{ base_cache *base = myBase();
if ( base->atom != a )
{ size_t len;
pl_wchar_t *s;
if ( base->atom )
{ PL_unregister_atom(base->atom);
PL_free(base->text);
}
if ( !PL_get_wchars(t, &len, &s, CVT_ATOM|BUF_MALLOC) )
return NULL;
base->atom = a;
PL_register_atom(a);
base->text = s;
parse_uri(&base->ranges, len, s);
}
return &base->ranges;
} else
{ type_error("atom", t);
return NULL;
}
}
functor_t
lookupFunctorDef(atom_t atom, size_t arity)
{ GET_LD
int v;
FunctorDef *table;
int buckets;
FunctorDef f, head;
redo:
acquire_functor_table(table, buckets);
v = (int)pointerHashValue(atom, buckets);
head = table[v];
DEBUG(9, Sdprintf("Lookup functor %s/%d = ", stringAtom(atom), arity));
for(f = table[v]; f; f = f->next)
{ if (atom == f->name && f->arity == arity)
{ DEBUG(9, Sdprintf("%p (old)\n", f));
if ( !FUNCTOR_IS_VALID(f->flags) )
{ goto redo;
}
release_functor_table();
return f->functor;
}
}
if ( functorDefTable->buckets * 2 < GD->statistics.functors )
{ LOCK();
rehashFunctors();
UNLOCK();
}
if ( !( head == table[v] && table == functorDefTable->table ) )
goto redo;
f = (FunctorDef) allocHeapOrHalt(sizeof(struct functorDef));
f->functor = 0L;
f->name = atom;
f->arity = arity;
f->flags = 0;
f->next = table[v];
if ( !( COMPARE_AND_SWAP(&table[v], head, f) &&
table == functorDefTable->table) )
{ PL_free(f);
goto redo;
}
registerFunctor(f);
ATOMIC_INC(&GD->statistics.functors);
PL_register_atom(atom);
DEBUG(9, Sdprintf("%p (new)\n", f));
release_functor_table();
return f->functor;
}
static foreign_t
archive_open_entry(term_t archive, term_t stream)
{ archive_wrapper *ar;
IOSTREAM *s;
if ( !get_archive(archive, &ar) )
return FALSE;
if ( (s=Snew(ar, SIO_INPUT|SIO_RECORDPOS, &ar_entry_functions)) )
{ ar->status = AR_OPENED_ENTRY;
if ( PL_unify_stream(stream, s) )
{ PL_register_atom(ar->symbol); /* We may no longer reference the */
return TRUE; /* archive itself */
}
Sclose(s);
return FALSE;
}
return PL_resource_error("memory");
}
functor_t
lookupFunctorDef(atom_t atom, unsigned int arity)
{ int v;
FunctorDef f;
LOCK();
v = (int)pointerHashValue(atom, functor_buckets);
DEBUG(9, Sdprintf("Lookup functor %s/%d = ", stringAtom(atom), arity));
for(f = functorDefTable[v]; f; f = f->next)
{ if (atom == f->name && f->arity == arity)
{ DEBUG(9, Sdprintf("%p (old)\n", f));
UNLOCK();
return f->functor;
}
}
f = (FunctorDef) allocHeapOrHalt(sizeof(struct functorDef));
f->functor = 0L;
f->name = atom;
f->arity = arity;
if ( atom == ATOM_call && arity > 8 )
f->flags = CONTROL_F;
else
f->flags = 0;
f->next = functorDefTable[v];
functorDefTable[v] = f;
registerFunctor(f);
GD->statistics.functors++;
PL_register_atom(atom);
DEBUG(9, Sdprintf("%p (new)\n", f));
if ( functor_buckets * 2 < GD->statistics.functors )
rehashFunctors();
UNLOCK();
return f->functor;
}
static int
get_lang_stemmer(term_t t, struct sb_stemmer **stemmer)
{ stem_cache *cache = get_cache();
atom_t lang;
int i;
if ( !PL_get_atom(t, &lang) )
return type_error("atom", t);
for(i=0; i<CACHE_SIZE; i++)
{ if ( cache->stemmers[i].language == lang )
{ *stemmer = cache->stemmers[i].stemmer;
return TRUE;
}
}
for(i=0; i<CACHE_SIZE; i++)
{ if ( !cache->stemmers[i].stemmer )
{ struct sb_stemmer *st;
if ( !(st= sb_stemmer_new(PL_atom_chars(lang), NULL)) )
{ if ( errno == ENOMEM )
return resource_error("memory");
else
return domain_error("snowball_algorithm", t);
}
cache->stemmers[i].language = lang;
cache->stemmers[i].stemmer = st;
PL_register_atom(cache->stemmers[i].language);
*stemmer = cache->stemmers[i].stemmer;
return TRUE;
}
}
assert(0); /* TBD: clean cache */
return FALSE;
}
static foreign_t
pl_rl_add_history(term_t text)
{ atom_t a;
static atom_t last = 0;
if ( PL_get_atom(text, &a) )
{ if ( a != last )
{ TCHAR *s;
if ( last )
PL_unregister_atom(last);
last = a;
PL_register_atom(last);
PL_get_wchars(text, NULL, &s, CVT_ATOM);
rlc_add_history(PL_current_console(), s);
}
return TRUE;
}
return FALSE;
}
