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_; }
void delete_duet_from_chain(dident the_name, didlist **chain) { didlist *current_duet; current_duet = *chain; while(current_duet) { if (current_duet->name == the_name) { *chain = current_duet->next; hg_free_size((generic_ptr) current_duet, sizeof(didlist)); break; } chain = &(current_duet->next); current_duet = current_duet->next; } }
void delete_proc_from_chain(pri *p, proc_duet **chain) /* Locks: requires ProcChainLock. aquires nothing. */ { proc_duet *current_gd; current_gd = *chain; while (current_gd) { if (current_gd->desc == p) { /* found, so delete it from the chain */ *chain = current_gd->next; hg_free_size((generic_ptr) current_gd, sizeof(proc_duet)); break; } chain = ¤t_gd->next; current_gd = current_gd->next; } }
void erase_module_props(property *prop_list) { register property *p; while(prop_list) { p = prop_list->next_mod; while (p->next_mod != prop_list) p = p->next_mod; p->next_mod = prop_list->next_mod; p = prop_list; prop_list = prop_list->next_prop; free_prop_value((int) p->name, &p->property_value); hg_free_size((generic_ptr) p, sizeof(property)); } }
static void _free_heap_array(t_heap_array *obj) /* obj != NULL */ { if (--obj->ref_ctr <= 0) { pword *p = obj->array; int arity = DidArity(p[0].val.did); int i; for (i = arity; i > 0; --i) { free_heapterm(&p[i]); } hg_free_size(obj, sizeof(t_heap_array) + arity*sizeof(pword)); #ifdef DEBUG_RECORD p_fprintf(current_err_, "\n_free_heap_array(0x%x)", obj); ec_flush(current_err_); #endif } }
static void _free_pri(pri *pd) { hg_free_size((generic_ptr)pd, sizeof(pri)); }
int erase_modular_property(dident functor, int property_name, dident module, type mod_tag, int which) { register property *p, **prev_p; int res; module_item *pm; if (which != GLOBAL_PROP && IsLocked(module) && !IsModuleTag(module, mod_tag)) { return LOCKED; } /* this lookup must be before the lock */ if (which != GLOBAL_PROP) pm = (module_item *) (get_property(module, MODULE_PROP))->val.ptr; a_mutex_lock(&PropListLock); /* get pointer to property list from atom */ prev_p = &(DidProperties(functor)); p = *prev_p; /* scan property list until an entry for property is found or end */ while (p) { if (p->name == property_name) { if (which != GLOBAL_PROP) { register property *m, **prev_m; prev_m = &(p->next_mod); m = *prev_m; while (m != p) /* scan module list */ { if (m->module == module) { /* erase the local */ *prev_m = m->next_mod; _rem_from_module_entry(m, pm); free_prop_value(property_name, &m->property_value); hg_free_size((generic_ptr) m, sizeof(property)); if (p->next_mod == p && p->module == D_UNKNOWN) { /* all erased, remove head descriptor */ *prev_p = p->next_prop; hg_free_size((generic_ptr) p, sizeof(property)); /* this is not an error, it is a message to notify that the property is erased completely */ res = PFAIL; goto _unlock_return_; } res = PSUCCEED; goto _unlock_return_; } prev_m = &(m->next_mod); m = *prev_m; } } if (which != LOCAL_PROP && p->module != D_UNKNOWN) { /* erase the global */ free_prop_value(property_name, &p->property_value); if (p->next_mod == p) { /* no locals: remove global descriptor */ *prev_p = p->next_prop; hg_free_size((generic_ptr) p, sizeof(property)); /* this is not an error, it is a message to notify that the property is erased completely */ res = PFAIL; goto _unlock_return_; } else p->module = D_UNKNOWN; /* just mark it unused */ res = PSUCCEED; goto _unlock_return_; } res = PERROR; goto _unlock_return_; /* should give a warning */ } prev_p = &(p->next_prop); p = *prev_p; } res = PERROR; _unlock_return_: a_mutex_unlock(&PropListLock); return(res); }