static void
_remove_incompatible_uses(pri *def) /* must be the definition module descriptor */
/* Locks: requires ProcListLock. acquires nothing. */
{
pri *use;
if (!PriExported(def))
return ;
for(use = DidPtr(PriDid(def))->procedure; use; use = use->nextproc)
{
if (PriIsProxy(use) && use->module_ref == def->module_ref)
{
if (!_compatible_def_use(def, use))
{
/* attempt to undo the impossible def-use link */
switch (PriScope(use))
{
case IMPORT: Pri_Set_Scope(use, LOCAL); break;
case IMPEXP: Pri_Set_Scope(use, EXPORT); break;
case QUALI: break;
}
use->module_ref = use->module_def;
}
}
}
}
static void
_update_all_uses(pri *def) /* must be the definition module descriptor */
/* Locks: requires ProcListLock. acquires nothing. */
{
pri *use;
if (!PriExported(def))
return;
for(use = DidPtr(PriDid(def))->procedure; use; use = use->nextproc)
{
if (PriIsProxy(use) && use->module_ref == def->module_ref)
{
_update_def_use(def, use);
}
}
}
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_;
}
}