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 SourceFile
lookupSourceFile_unlocked(atom_t name, int create)
{ SourceFile file;
Symbol s;
if ( !GD->files.table )
{ GD->files.table = newHTable(32);
GD->files.table->free_symbol = freeSymbolSourceFile;
GD->files.no_hole_before = 1;
}
if ( (s=lookupHTable(GD->files.table, (void*)name)) )
{ file = s->value;
} 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);
registerSourceFile(file);
addHTable(GD->files.table, (void*)name, file);
} else
{ file = NULL;
}
return file;
}
