static int
_compatible_def_use(pri *def, pri *use)
{
uint32 conflicts;
char *reason = NULL;
/* if not yet referenced, any change is allowed */
if (!PriReferenced(use))
return 1;
/* don't allow changing certain flags */
conflicts = (def->flags ^ use->flags) &
(use->flags & CODE_DEFINED ?
PF_DONT_CHANGE_WHEN_DEFINED :
PF_DONT_CHANGE_WHEN_REFERENCED);
if (conflicts)
{
if (conflicts & TOOL)
reason = "tool declaration";
else if (conflicts & PROC_DYNAMIC)
reason = "static/dynamic";
else if (conflicts & PROC_DEMON)
reason = "demon declaration";
else if (conflicts & PROC_PARALLEL)
reason = "parallel declaration";
else if (conflicts & (CODETYPE|ARGPASSING|UNIFTYPE))
reason = "calling convention";
else
reason = "predicate properties";
}
/* other restrictions when already referenced */
if (def->mode != use->mode)
reason = "mode declaration";
if (def->trans_function != use->trans_function)
reason = "inline declaration";
if (reason)
{
p_fprintf(warning_output_,
"Definition of %s/%d in module %s is incompatible (%s) with call in module %s\n",
DidName(def->did), DidArity(def->did), DidName(def->module_def),
reason, DidName(use->module_def));
ec_flush(warning_output_);
return 0;
}
return 1;
}
static int
_procedure_referenced(pri *pd)
/* Locks: requires nothing. acquires ProcListLock. */
{
dident definition_module;
if (PriReferenced(pd))
return 1;
if (!PriExported(pd))
return 0;
a_mutex_lock(&ProcListLock);
definition_module = pd->module_def;
for(pd = DidPtr(pd->did)->procedure; pd; pd = pd->nextproc)
{
if (pd->module_ref == definition_module && PriReferenced(pd))
{
a_mutex_unlock(&ProcListLock);
return 1;
}
}
a_mutex_unlock(&ProcListLock);
return 0;
}
/*
pr(Name/Arity)
prints on the current_output the properties of a predicate
in all modules.
*/
static int
p_pr(value v, type t)
{
pri *proc;
dident wdid;
dident module;
int flags;
int yes = 0;
Get_Proc_Did(v, t, wdid);
proc = DidPtr(wdid)->procedure;
while (proc)
{
module = proc->module_def;
if (!module
#ifndef PRINTAM
|| (IsLocked(module) && !PriExported(proc))
#endif
)
{
proc = proc->nextproc;
continue;
}
yes = 1;
p_fprintf(log_output_, "in %s: ", DidName(module));
if (SystemProc(proc))
p_fprintf(log_output_, "system ");
if (proc->flags & AUTOLOAD)
(void) ec_outfs(log_output_, "autoload ");
if (proc->flags & PROC_DYNAMIC) {
(void) ec_outfs(log_output_, "dynamic ");
} else {
(void) ec_outfs(log_output_, "static ");
}
switch(proc->flags & CODETYPE) {
case VMCODE:
(void) ec_outfs(log_output_, "vmcode ");
break;
case FUNPTR:
(void) ec_outfs(log_output_, "funptr ");
break;
default:
(void) ec_outfs(log_output_, "code? ");
break;
}
switch(proc->flags & ARGPASSING) {
case ARGFIXEDWAM:
(void) ec_outfs(log_output_, "argfixedwam ");
break;
case ARGFLEXWAM:
(void) ec_outfs(log_output_, "argflexwam ");
break;
default:
(void) ec_outfs(log_output_, "? ");
break;
}
if (proc->flags & EXTERN)
{
(void) ec_outfs(log_output_, "external");
switch(proc->flags & UNIFTYPE) {
case U_NONE:
(void) ec_outfs(log_output_, "_u_none ");
break;
case U_SIMPLE:
(void) ec_outfs(log_output_, "_u_simple ");
break;
case U_GROUND:
(void) ec_outfs(log_output_, "_u_ground ");
break;
case U_UNIFY: /* equal to fresh */
(void) ec_outfs(log_output_, "_u_unify ");
break;
case U_GLOBAL:
(void) ec_outfs(log_output_, "_u_global ");
break;
case U_DELAY:
(void) ec_outfs(log_output_, "_u_delay ");
break;
default:
(void) ec_outfs(log_output_, "_u_? ");
break;
}
}
else
{
(void) ec_outfs(log_output_, "prolog ");
}
flags = proc->flags;
if (flags & TOOL)
(void) ec_outfs(log_output_, "tool ");
switch (PriScope(proc))
{
case EXPORT:
(void) ec_outfs(log_output_, "exported "); break;
case LOCAL:
(void) ec_outfs(log_output_, "local "); break;
case IMPORT:
(void) ec_outfs(log_output_, "imported "); break;
case DEFAULT:
(void) ec_outfs(log_output_, "default "); break;
case QUALI:
(void) ec_outfs(log_output_, "qualified "); break;
}
p_fprintf(log_output_, "%s ", DidName(proc->module_ref));
if (flags & DEBUG_DB)
(void) ec_outfs(log_output_, "debugged ");
if (flags & DEBUG_ST)
(void) ec_outfs(log_output_, "start_tracing ");
if (flags & DEBUG_TR)
(void) ec_outfs(log_output_, "traceable ");
else
(void) ec_outfs(log_output_, "untraceable ");
if (flags & DEBUG_SP)
(void) ec_outfs(log_output_, "spied ");
if (flags & DEBUG_SK)
(void) ec_outfs(log_output_, "skipped ");
if (!PriReferenced(proc))
(void) ec_outfs(log_output_, "non_referenced ");
if (flags & CODE_DEFINED)
(void) ec_outfs(log_output_, "code_defined ");
proc = proc->nextproc;
(void) ec_outfs(log_output_, "\n");
}
if (yes)
{
Succeed_;
}
else
{
Fail_;
}
}
