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;
}
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 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;
}
void
checkHTable(Table ht)
{ int i;
int n = 0;
for(i=0; i<ht->buckets; i++)
{ Symbol s;
for(s=ht->entries[i]; s; s=s->next)
{ assert(lookupHTable(ht, s->name) == s);
n++;
}
}
assert(n == ht->size);
}
static operator *
visibleOperator(Module m, atom_t name, int kind)
{ Symbol s;
operator *op;
ListCell c;
if ( m->operators &&
(s = lookupHTable(m->operators, (void *)name)) )
{ op = s->value;
if ( op->type[kind] != OP_INHERIT )
return op;
}
for(c = m->supers; c; c=c->next)
{ if ( (op = visibleOperator(c->value, name, kind)) )
return op;
}
return NULL;
}
int
destroySourceFile(SourceFile sf)
{ Symbol s;
DEBUG(MSG_SRCFILE,
Sdprintf("Destroying source file %s\n", PL_atom_chars(sf->name)));
clearSourceAdmin(sf);
LOCK();
s = lookupHTable(GD->files.table, (void*)sf->name);
assert(s);
deleteSymbolHTable(GD->files.table, s);
PL_unregister_atom(sf->name);
putSourceFileArray(sf->index, NULL);
if ( GD->files.no_hole_before > sf->index )
GD->files.no_hole_before = sf->index;
UNLOCK();
unallocSourceFile(sf);
return TRUE;
}