static int
p_unlock2(value v, type t, value vl, type tl)
{
module_item *m;
Check_Atom_Or_Nil(v, t);
Check_String(tl);
if (!IsModule(v.did))
{
Bip_Error(MODULENAME);
}
if (!IsLocked(v.did))
{
Succeed_;
}
if (DidModule(v.did) == HARD_LOCK_MODULE)
{
Bip_Error(LOCKED);
}
m = ModuleItem(v.did);
if (!strcmp(m->lock, StringStart(vl)))
{
hg_free((generic_ptr) m->lock);
DidModule(v.did) = UNLOCK_MODULE;
m->lock = (char *) 0;
Succeed_;
}
else
{
Bip_Error(WRONG_UNLOCK_STRING);
}
}
/*ARGSUSED*/
static int
p_import(value library, type tlib, value import_mod, type tim)
{
module_item *export_prop, *import_prop;
pri *pe, *pi;
didlist *lib_scan;
Check_Module_And_Access(import_mod, tim);
Check_Module(tlib, library);
a_mutex_lock(&ModuleLock);
export_prop = ModuleItem(library.did);
import_prop = ModuleItem(import_mod.did);
/* check that the module is not already imported */
lib_scan = import_prop->imports;
while (lib_scan)
{
if (lib_scan->name == library.did)
{
a_mutex_unlock(&ModuleLock);
Succeed_; /* the library is already imported */
}
lib_scan = lib_scan->next;
}
/* add library to the lists of the mods imported by import_mod */
_add_module(library.did, &(import_prop->imports));
/* now perform the pending imports */
resolve_pending_imports(import_prop->procedures);
a_mutex_unlock(&ModuleLock);
Succeed_;
}
static int
p_lock_pass_(value vl, type tl, value v, type t)
{
module_item *m;
Check_Module_And_Access(v, t);
Check_String(tl);
DidModule(v.did) = SOFT_LOCK_MODULE;
m = ModuleItem(v.did);
/* the string should be stored crypted */
m->lock = (char *) hg_alloc((int) StringLength(vl) + 1);
Copy_Bytes(m->lock, StringStart(vl), StringLength(vl) + 1);
Succeed_;
}
static int
p_erase_module(value module, type module_tag, value from_mod, type tfrom_mod)
{
module_item *pm, *import_pm;
int i;
didlist *lib_scan;
pword *prop;
Check_Module(tfrom_mod, from_mod);
Check_Atom_Or_Nil(module, module_tag);
if (!IsModule(module.did))
{
Succeed_;
} else if (IsLocked(module.did)
&& (from_mod.did != d_.kernel_sepia
|| !IsModuleTag(from_mod.did, tfrom_mod)))
{
Bip_Error(LOCKED);
}
/*
* This is a big mess with respect to locking. The erased module's
* descriptor is unprotected. It should be first removed as property
* and then cleaned up.
*/
pm = ModuleItem(module.did);
/* first, clean the procedures, we can reclaim the space */
erase_module_procs(pm->procedures);
hg_free_size((generic_ptr) pm->syntax, sizeof(syntax_desc));
/* reclaim the properties */
erase_module_props(pm->properties);
/* reclaim module descriptor */
(void) erase_property(module.did, MODULE_PROP);
DidPtr(module.did)->module = 0;
Succeed_;
}
static pri*
_new_visible_pri(dident functor, dident module, module_item *module_property, int visibility)
{
pri *pd = _new_pri(functor, module);
pd->flags |= VMCODE|ARGFIXEDWAM|visibility
|PriPriorityFlags(SUSP_EAGER_PRIO);
/* insert it at the beginning of the functor list */
pd->nextproc = DidPtr(functor)->procedure;
DidPtr(functor)->procedure = pd;
/* insert it at the beginning of the module list */
if (!module_property)
module_property = ModuleItem(module);
pd->next_in_mod = module_property->procedures;
module_property->procedures = pd;
return pd;
}
void
pri_statistics(void)
{
int idx = 0;
dident mod;
int count[6];
while (next_functor(&idx, &mod))
{
if (IsModule(mod))
{
pri *pd;
int i;
for(i=0;i<6;++i) count[i] = 0;
for (pd = ModuleItem(mod)->procedures; pd; pd = pd->next_in_mod)
{
switch(PriScope(pd))
{
case QUALI: ++count[0]; break;
case LOCAL: ++count[1]; break;
case EXPORT: ++count[2]; break;
case IMPORT: ++count[3]; break;
case DEFAULT: ++count[4]; break;
case IMPEXP: ++count[5]; break;
default: p_fprintf(current_err_, "Illegal scope %s\n", PriScope(pd)); break;
}
}
p_fprintf(log_output_, "\nModule: %s\n", DidName(mod));
p_fprintf(log_output_, " QUALI=%d", count[0]);
p_fprintf(log_output_, " LOCAL=%d", count[1]);
p_fprintf(log_output_, " EXPORT=%d", count[2]);
p_fprintf(log_output_, " IMPORT=%d", count[3]);
p_fprintf(log_output_, " DEFAULT=%d", count[4]);
p_fprintf(log_output_, " IMPEXP=%d", count[5]);
ec_newline(log_output_);
}
}
}
