static void
_update_def_use(pri *def, pri *use)
{
/* Note on memory management of code blocks:
* Undefined-code blocks are never shared between descriptors,
* so don't copy pointers to them.
* Defined-code is shared and pointed to from all descriptors.
*/
if ((PriCodeType(use) == VMCODE) && !(PriFlags(use) & CODE_DEFINED))
{
if (PriFlags(def) & CODE_DEFINED)
{
remove_procedure(use); /* undefined -> defined */
use->code = def->code;
}
else if (!use->code.vmc) /* undefined -> undefined */
_pri_init_vmcode(use, PriFlags(def)&TOOL);
/* else keep undefined-code field */
}
else
{
if ((PriCodeType(def) == VMCODE) && !(PriFlags(def) & CODE_DEFINED))
_pri_init_vmcode(use, PriFlags(def)&TOOL); /* defined -> undefined */
else
use->code = def->code; /* defined -> defined */
}
use->module_ref = def->module_def;
use->mode = def->mode;
use->trans_function = def->trans_function;
use->flags = (use->flags & DESCRIPTOR_FLAGS) | (def->flags & COMMON_FLAGS);
}
static int
p_tool2(value vi, type ti, value vb, type tb, value vm, type tm)
{
dident di, db;
pri *procb, *proci;
uint32 changed_flags, new_flags;
pri_code_t pricode;
int err;
Check_Module(tm, vm);
Get_Proc_Did(vi, ti, di);
Get_Proc_Did(vb, tb, db);
if (DidArity(di) + 1 != DidArity(db))
{
Bip_Error(RANGE_ERROR);
}
if (vm.did == d_.kernel_sepia)
proci = export_procedure(di, vm.did, tm);
else
proci = local_procedure(di, vm.did, tm, PRI_CREATE);
if (!proci)
{
Get_Bip_Error(err);
Bip_Error(err);
}
procb = visible_procedure(db, vm.did, tm, PRI_CREATE);
if (!procb)
{
Get_Bip_Error(err);
Bip_Error(err);
}
/* Incompatbilities of being a TOOL */
if (DynamicProc(proci))
{
Bip_Error(INCONSISTENCY);
}
/* Incompatbilities of being a tool body */
if (PriFlags(procb) & TOOL)
{
Bip_Error(INCONSISTENCY);
}
changed_flags = TOOL|TOOL_INHERIT_FLAGS|DEBUG_DB|SYSTEM;
new_flags = TOOL
|(TOOL_INHERIT_FLAGS & procb->flags)
|(GlobalFlags & DBGCOMP ? DEBUG_DB : 0)
|(vm.did == d_.kernel_sepia ? SYSTEM : 0);
err = pri_compatible_flags(proci, changed_flags, new_flags);
if (err != PSUCCEED)
{
Bip_Error(err);
}
pri_change_flags(proci, changed_flags & ~CODETYPE, new_flags & ~CODETYPE);
Pri_Set_Reference(procb);
proci->mode = procb->mode;
pricode.vmc = _tool_code(procb, GlobalFlags & DBGCOMP);
pri_define_code(proci, procb->flags & CODETYPE, pricode);
/* make sure the tool body is exported or reexported, so it can
* be invoked with a qualified call with lookup module vm */
if (!PriAnyExp(procb) && !PriWillExport(procb))
{
if (PriScope(procb) == IMPORT)
procb = reexport_procedure(db, vm.did, tm, PriHomeModule(procb));
else
procb = export_procedure(db, vm.did, tm);
if (!procb)
{
Get_Bip_Error(err);
Bip_Error(err);
}
}
Succeed_;
}
