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_; } }