static void
allocFunctorTable(void)
{ functorDefTable = allocHeapOrHalt(sizeof(*functorDefTable));
functorDefTable->buckets = FUNCTORHASHSIZE;
functorDefTable->table = allocHeapOrHalt(FUNCTORHASHSIZE * sizeof(FunctorDef));
memset(functorDefTable->table, 0, FUNCTORHASHSIZE * sizeof(FunctorDef));
functorDefTable->prev = NULL;
}
Symbol
addHTable(Table ht, void *name, void *value)
{ Symbol s;
int v;
LOCK_TABLE(ht);
v = (int)pointerHashValue(name, ht->buckets);
if ( lookupHTable(ht, name) )
{ UNLOCK_TABLE(ht);
return NULL;
}
s = allocHeapOrHalt(sizeof(struct symbol));
s->name = name;
s->value = value;
s->next = ht->entries[v];
ht->entries[v] = s;
ht->size++;
DEBUG(9, Sdprintf("addHTable(0x%x, 0x%x, 0x%x) --> size = %d\n",
ht, name, value, ht->size));
if ( ht->buckets * 2 < ht->size && !ht->enumerators )
s = rehashHTable(ht, s);
UNLOCK_TABLE(ht);
DEBUG(1, checkHTable(ht));
return s;
}
static void
allocFunctorTable(void)
{ int size = functor_buckets * sizeof(FunctorDef);
functorDefTable = allocHeapOrHalt(size);
memset(functorDefTable, 0, size);
}
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 void
copyOperatorSymbol(Symbol s)
{ operator *op = s->value;
operator *o2 = allocHeapOrHalt(sizeof(*o2));
*o2 = *op;
}
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 Code
allocCodes(size_t n)
{ Code codes = allocHeapOrHalt(sizeof(code)*(n+1));
*codes++ = (code)n;
return codes;
}
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 Symbol *
allocHTableEntries(int buckets)
{ size_t bytes = buckets * sizeof(Symbol);
Symbol *p;
p = allocHeapOrHalt(bytes);
memset(p, 0, bytes);
return p;
}
static void
rehashFunctors(void)
{ FunctorTable newtab;
size_t index;
int i, last = FALSE;
if ( functorDefTable->buckets * 2 >= GD->statistics.functors )
return;
newtab = allocHeapOrHalt(sizeof(*newtab));
newtab->buckets = functorDefTable->buckets * 2;
newtab->table = allocHeapOrHalt(newtab->buckets * sizeof(FunctorDef));
memset(newtab->table, 0, newtab->buckets * sizeof(FunctorDef));
newtab->prev = functorDefTable;
DEBUG(MSG_HASH_STAT,
Sdprintf("Rehashing functor-table (%d --> %d)\n", functorDefTable->buckets, newtab->buckets));
for(index=1, i=0; !last; i++)
{ size_t upto = (size_t)2<<i;
FunctorDef *b = GD->functors.array.blocks[i];
if ( upto >= GD->functors.highest )
{ upto = GD->functors.highest;
last = TRUE;
}
for(; index<upto; index++)
{ FunctorDef f = b[index];
if ( FUNCTOR_IS_VALID(f->flags) )
{ size_t v = pointerHashValue(f->name, newtab->buckets);
f->next = newtab->table[v];
newtab->table[v] = f;
}
}
}
functorDefTable = newtab;
maybe_free_functor_tables();
}
char *
store_string(const char *s)
{ if ( s )
{ char *copy = (char *)allocHeapOrHalt(strlen(s)+1);
strcpy(copy, s);
return copy;
} else
{ return NULL;
}
}
Table
copyHTable(Table org)
{ Table ht;
int n;
ht = allocHeapOrHalt(sizeof(struct table));
LOCK_TABLE(org);
*ht = *org; /* copy all attributes */
#ifdef O_PLMT
ht->mutex = NULL;
#endif
ht->entries = allocHTableEntries(ht->buckets);
for(n=0; n < ht->buckets; n++)
{ Symbol s, *q;
q = &ht->entries[n];
for(s = org->entries[n]; s; s = s->next)
{ Symbol s2 = allocHeapOrHalt(sizeof(*s2));
*q = s2;
q = &s2->next;
s2->name = s->name;
s2->value = s->value;
if ( ht->copy_symbol )
(*ht->copy_symbol)(s2);
}
*q = NULL;
}
#ifdef O_PLMT
if ( org->mutex )
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
UNLOCK_TABLE(org);
return ht;
}
static int
opt_append(opt_list **l, char *s)
{ opt_list *n = allocHeapOrHalt(sizeof(*n));
n->opt_val = s;
n->next = NULL;
while(*l)
l = &(*l)->next;
*l = n;
return TRUE;
}
Table
newHTable(int buckets)
{ Table ht;
ht = allocHeapOrHalt(sizeof(struct table));
ht->buckets = (buckets & ~TABLE_MASK);
ht->size = 0;
ht->enumerators = NULL;
ht->free_symbol = NULL;
ht->copy_symbol = NULL;
#ifdef O_PLMT
if ( (buckets & TABLE_UNLOCKED) )
ht->mutex = NULL;
else
{ ht->mutex = allocHeapOrHalt(sizeof(simpleMutex));
simpleMutexInit(ht->mutex);
}
#endif
ht->entries = allocHTableEntries(ht->buckets);
return ht;
}
int
opt_append(opt_list **l, const char *s)
{ opt_list *n = allocHeapOrHalt(sizeof(*n));
n->opt_val = store_string(s);
n->next = NULL;
while(*l)
l = &(*l)->next;
*l = n;
return TRUE;
}
void
addProcedureSourceFile(SourceFile sf, Procedure proc)
{ LOCKSRCFILE(sf);
if ( !hasProcedureSourceFile(sf, proc) )
{ ListCell cell;
cell = allocHeapOrHalt(sizeof(struct list_cell));
cell->value = proc;
cell->next = sf->procedures;
sf->procedures = cell;
set(proc->definition, FILE_ASSIGNED);
if ( !proc->source_no )
proc->source_no = sf->index;
else
set(proc, PROC_MULTISOURCE);
}
UNLOCKSRCFILE(sf);
}
static void
registerBuiltinFunctors(void)
{ int size = sizeof(functors)/sizeof(builtin_functor) - 1;
FunctorDef f = allocHeapOrHalt(size * sizeof(struct functorDef));
const builtin_functor *d;
GD->statistics.functors = size;
for(d = functors; d->name; d++, f++)
{ size_t v = pointerHashValue(d->name, functor_buckets);
f->name = d->name;
f->arity = d->arity;
f->flags = 0;
f->next = functorDefTable[v];
functorDefTable[v] = f;
registerFunctor(f);
}
}
TableEnum
newTableEnum(Table ht)
{ TableEnum e = allocHeapOrHalt(sizeof(struct table_enum));
Symbol n;
LOCK_TABLE(ht);
e->table = ht;
e->key = 0;
e->next = ht->enumerators;
ht->enumerators = e;
n = ht->entries[0];
while(!n && ++e->key < ht->buckets)
n=ht->entries[e->key];
e->current = n;
UNLOCK_TABLE(ht);
return e;
}
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 Symbol
rehashHTable(Table ht, Symbol map)
{ Symbol *newentries, *oldentries;
int newbuckets, oldbuckets;
int i;
int safe_copy = (ht->mutex != NULL);
newbuckets = ht->buckets*2;
newentries = allocHTableEntries(newbuckets);
DEBUG(MSG_HASH_STAT,
Sdprintf("Rehashing table %p to %d entries\n", ht, ht->buckets));
for(i=0; i<ht->buckets; i++)
{ Symbol s, n;
if ( safe_copy )
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
Symbol s2 = allocHeapOrHalt(sizeof(*s2));
n = s->next;
if ( s == map )
map = s2;
*s2 = *s;
s2->next = newentries[v];
newentries[v] = s2;
}
} else
{ for(s=ht->entries[i]; s; s = n)
{ int v = (int)pointerHashValue(s->name, newbuckets);
n = s->next;
s->next = newentries[v];
newentries[v] = s;
}
}
}
oldentries = ht->entries;
oldbuckets = ht->buckets;
ht->entries = newentries;
ht->buckets = newbuckets;
if ( safe_copy )
{ /* Here we should be waiting until */
/* active lookup are finished */
for(i=0; i<oldbuckets; i++)
{ Symbol s, n;
for(s=oldentries[i]; s; s = n)
{ n = s->next;
s->next = NULL; /* that causes old readers to stop */
freeHeap(s, sizeof(*s));
}
}
}
freeHeap(oldentries, oldbuckets * sizeof(Symbol));
DEBUG(CHK_SECURE, checkHTable(ht));
return map;
}
