/*
* is_visible_op(atom, module, mod_tag) returns 1 iff there is an
* operator attached to 'atom', returns 0 otherwise.
*
* Must be called in an interrupt protected area.
*/
int
is_visible_op(dident atom, dident module, type mod_tag)
{
opi *operator_prop;
int err = PERROR;
int res;
if (atom == D_UNKNOWN || !DidIsOp(atom))
{
Set_Bip_Error(PERROR);
return 0;
}
a_mutex_lock(&PropertyLock);
/* DidIsOp may be out of date, ie. it may be set even when there
* is no longer such an operator. That's why we have to check. */
if ((DidIsOp(atom) & IS_PREFIX_OP)
&& (operator_prop = OperatorItem(atom, module, mod_tag,
VISIBLE_PROP, PREFIX_PROP, &res))
&& operator_prop->tag.kernel != TEND
&& GetOpiPreced(operator_prop))
{
a_mutex_unlock(&PropertyLock);
return 1;
}
else if ((DidIsOp(atom) & IS_INFIX_OP)
&& (operator_prop = OperatorItem(atom, module, mod_tag,
VISIBLE_PROP, INFIX_PROP,&res))
&& operator_prop->tag.kernel != TEND
&& GetOpiPreced(operator_prop))
{
a_mutex_unlock(&PropertyLock);
return 1;
}
else if ((DidIsOp(atom) & IS_POSTFIX_OP)
&& (operator_prop = OperatorItem(atom, module, mod_tag,
VISIBLE_PROP, POSTFIX_PROP,&res))
&& operator_prop->tag.kernel != TEND
&& GetOpiPreced(operator_prop))
{
a_mutex_unlock(&PropertyLock);
return 1;
}
else
{
Set_Bip_Error(err);
a_mutex_unlock(&PropertyLock);
return 0;
}
}
static int
_tool_body(pri *proci, dident *pdid, int *parity, dident *pmodule)
{
pri *procb;
int flags;
vmcode *code;
flags = proci->flags;
code = proci->code.vmc;
if (!(flags & CODE_DEFINED))
{
if (flags & AUTOLOAD)
{ Set_Bip_Error(NOT_LOADED); }
else
{ Set_Bip_Error(NOENTRY); }
return 0;
}
if (!(flags & TOOL))
{
Set_Bip_Error(NO_TOOL);
return 0;
}
if (PriCodeType(proci) == VMCODE)
{
if (DebugProc(proci))
procb = (pri *) *(code + DEBUG_LENGTH + 1);
else
procb = (pri *) *(code + 1);
*pdid = procb->did;
*parity = DidArity(procb->did);
*pmodule = procb->module_def;
}
else /* don't know how to get the tool body */
{
Set_Bip_Error(NO_TOOL);
return 0;
}
return 1;
}
pri *
pri_home(pri *pd)
{
type tm;
if (pd->module_ref == pd->module_def)
return pd;
if (pd->module_ref == D_UNKNOWN)
{
Set_Bip_Error(NOENTRY);
return 0;
}
tm.kernel = ModuleTag(pd->module_ref);
return visible_procedure(pd->did, pd->module_ref, tm, PRI_DONTIMPORT);
}
