void remove_output_link_tc_info(output_link * ol)
{
cons *c, *prev_c;
Symbol *id;
while (ol->ids_in_tc) { /* for each id in the old TC... */
c = ol->ids_in_tc;
ol->ids_in_tc = c->rest;
id = c->first;
free_cons(c);
/* --- remove "ol" from the list of associated_output_links(id) --- */
prev_c = NIL;
for (c = id->id.associated_output_links; c != NIL; prev_c = c, c = c->rest)
if (c->first == ol)
break;
if (!c) {
char msg[MESSAGE_SIZE];
strncpy(msg, "io.c: Internal error: can't find output link in id's list\n", MESSAGE_SIZE);
msg[MESSAGE_SIZE - 1] = 0;
abort_with_fatal_error(msg);
}
if (prev_c)
prev_c->rest = c->rest;
else
id->id.associated_output_links = c->rest;
free_cons(c);
symbol_remove_ref(id);
}
}
void free_list (agent* thisAgent, list *the_list) {
cons *c;
while (the_list) {
c = the_list;
the_list = the_list->rest;
free_cons (thisAgent, c);
}
}
Cons parse_cons(char *string, int *offset)
{
Cons cur, head, pre;
int step;
pre = head = make_cons(lt_nil, lt_nil);
for (int i = 0; string[i] != '\0'; i += step) {
switch (string[i]) {
case '(':
cur = make_cons(parse_cons(string + i + 1, &step), lt_nil);
break;
case ' ':
case '\n':
step = 1;
continue;
case ')':
*offset = i + 2;
pre = CDR(head);
free_cons(head);
return pre;
case '\'': {
/* Symbol quote; */
LispObject obj;
/* quote = S("QUOTE"); */
obj = parse_sexp(string + i + 1, &step);
/* cur = make_cons(make_cons(S("QUOTE"), make_cons(obj, lt_nil)), lt_nil); */
cur = make_cons(make_list(S("QUOTE"), obj), lt_nil);
step++;
break;
}
default :
cur = make_cons(parse_atom(string + i, &step), lt_nil);
}
set_cdr(pre, cur);
pre = cur;
}
pre = CDR(head);
free_cons(head);
return pre;
}
void free_cons(cons_t *c)
{
if(c != NULL){
if(c->type == TYPE_CAR){
free_cons(c->v.car);
}
if(c->type != TYPE_STR){
low_free(c);
}
}
}
void trace_grounded_potentials(void)
{
tc_number tc;
cons *c, *next_c, *prev_c;
condition *pot;
bool need_another_pass;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM])
print_string("\n\n*** Tracing Grounded Potentials ***\n");
#endif
/* --- setup the tc of the ground set --- */
tc = get_new_tc_number();
for (c = current_agent(grounds); c != NIL; c = c->rest)
add_cond_to_tc(c->first, tc, NIL, NIL);
need_another_pass = TRUE;
while (need_another_pass) {
need_another_pass = FALSE;
/* --- look for any potentials that are in the tc now --- */
prev_c = NIL;
for (c = current_agent(positive_potentials); c != NIL; c = next_c) {
next_c = c->rest;
pot = c->first;
if (cond_is_in_tc(pot, tc)) {
/* --- pot is a grounded potential, move it over to ground set --- */
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string("\n-->Moving to grounds: ");
print_wme(pot->bt.wme);
}
#endif
if (prev_c)
prev_c->rest = next_c;
else
current_agent(positive_potentials) = next_c;
if (pot->bt.wme->grounds_tc != current_agent(grounds_tc)) { /* add pot to grounds */
pot->bt.wme->grounds_tc = current_agent(grounds_tc);
c->rest = current_agent(grounds);
current_agent(grounds) = c;
add_cond_to_tc(pot, tc, NIL, NIL);
need_another_pass = TRUE;
} else { /* pot was already in the grounds, do don't add it */
free_cons(c);
}
} else {
prev_c = c;
}
} /* end of for c */
} /* end of while need_another_pass */
}
void remove_garbage_slots(agent* thisAgent)
{
cons* c;
slot* s;
while (thisAgent->slots_for_possible_removal)
{
c = thisAgent->slots_for_possible_removal;
thisAgent->slots_for_possible_removal = thisAgent->slots_for_possible_removal->rest;
s = static_cast<slot_struct*>(c->first);
free_cons(thisAgent, c);
if (s->wmes || s->all_preferences)
{
/* --- don't deallocate it if it still has any wmes or preferences --- */
s->marked_for_possible_removal = false;
continue;
}
/* --- deallocate the slot --- */
#ifdef DEBUG_SLOTS
print_with_symbols(thisAgent, "\nDeallocate slot %y ^%y", s->id, s->attr);
#endif
/* MMA 9-2012 */
if (s->CDPS && thisAgent->sysparams[CHUNK_THROUGH_EVALUATION_RULES_SYSPARAM])
{
clear_CDPS(thisAgent, s);
}
/* MMA 9-2012 end */
if (s->changed && (!s->isa_context_slot))
{
remove_from_dll(thisAgent->changed_slots, s->changed, next, prev);
free_with_pool(&thisAgent->dl_cons_pool, s->changed);
}
remove_from_dll(s->id->id->slots, s, next, prev);
symbol_remove_ref(thisAgent, s->id);
symbol_remove_ref(thisAgent, s->attr);
if (s->wma_val_references != NIL)
{
s->wma_val_references->~wma_sym_reference_map();
free_with_pool(&(thisAgent->wma_slot_refs_pool), s->wma_val_references);
s->wma_val_references = NIL;
}
free_with_pool(&thisAgent->slot_pool, s);
}
}
/* allocate and initialize console structure */
static vntsd_cons_t *
alloc_cons(vntsd_group_t *groupp, vcc_console_t *consolep)
{
vntsd_cons_t *consp;
int rv;
/* allocate console */
consp = (vntsd_cons_t *)malloc(sizeof (vntsd_cons_t));
if (consp == NULL) {
vntsd_log(VNTSD_ERR_NO_MEM, "alloc_cons");
return (NULL);
}
/* intialize console */
bzero(consp, sizeof (vntsd_cons_t));
(void) mutex_init(&consp->lock, USYNC_THREAD|LOCK_ERRORCHECK, NULL);
(void) cond_init(&consp->cvp, USYNC_THREAD, NULL);
consp->cons_no = consolep->cons_no;
(void) strlcpy(consp->domain_name, consolep->domain_name, MAXPATHLEN);
(void) strlcpy(consp->dev_name, consolep->dev_name, MAXPATHLEN);
consp->wr_tid = (thread_t)-1;
consp->vcc_fd = (thread_t)-1;
/* join the group */
(void) mutex_lock(&groupp->lock);
if ((rv = vntsd_que_append(&groupp->conspq, consp)) !=
VNTSD_SUCCESS) {
(void) mutex_unlock(&groupp->lock);
vntsd_log(rv, "alloc_cons");
free_cons(consp);
return (NULL);
}
groupp->num_cons++;
consp->group = groupp;
(void) mutex_unlock(&groupp->lock);
D1(stderr, "t@%d alloc_cons@%d %s %s\n", thr_self(),
consp->cons_no, consp->domain_name, consp->dev_name);
return (consp);
}
init_expr (struct param_expr_info *p)
/* recup_item *tr, int nr, int *ppr, int *pnd,
expr (*tc) [2], int nc, char *s, int *ppc */
{
int i;
param_expr = p;
for (i=0; i<N_CONS; i++)
free_cons(i);
ptr_cons = 0;
tab_recup[0].n = -1;
ptr_recup = 1;
n_decl = 0;
ptr_symbol = 0;
for (i=0; i<N_SYMBOL; i++)
tab_symbol[i] = NULL;
}
gc ()
{
int i, pr, n;
for (i=0; i<N_CONS; i++)
free_cons(i);
pr = ptr_recup - 1;
n = n_decl;
while (n != -1 && pr > 0)
{
for (i=0; i<n; i++)
take_tree (*(tab_recup[pr-i].adr));
pr -= n;
n = tab_recup[pr--].n;
}
ptr_cons = 0;
while (!cons_free(ptr_cons) && ptr_cons < N_CONS-1)
ptr_cons++;
if (!cons_free(ptr_cons))
{
fprintf (stderr, "Memory overflow\n");
exit (-1);
}
}
init_expr (recup_item *tr, int nr, int *ppr, int *pnd,
expr (*tc) [2], int nc, char *s, int *ppc)
{
int i;
tab_cons = tc;
n_cons = nc;
tab_status = s;
p_ptr_cons = ppc;
for (i=0; i<N_CONS; i++)
free_cons(i);
ptr_cons = 0;
tab_recup = tr;
n_recup = nr;
p_ptr_recup = ppr;
p_n_decl = pnd;
tab_recup[0].n = -1;
ptr_recup = 1;
n_decl = 0;
ptr_symbol = 0;
for (i=0; i<N_SYMBOL; i++)
tab_symbol[i] = NULL;
}
/*
* all clients connected to a console must disconnect before
* removing a console.
*/
static void
cleanup_cons(vntsd_cons_t *consp)
{
vntsd_group_t *groupp;
timestruc_t to;
assert(consp);
D1(stderr, "t@%d vntsd_disconn_clients@%d\n", thr_self(),
consp->cons_no);
groupp = consp->group;
assert(groupp);
(void) mutex_lock(&consp->lock);
/* wait for all clients disconnect from the console */
while (consp->clientpq != NULL) {
consp->status |= VNTSD_CONS_SIG_WAIT;
/* signal client to disconnect the console */
(void) vntsd_que_walk(consp->clientpq,
(el_func_t)vntsd_notify_client_cons_del);
(void) thr_kill(consp->wr_tid, SIGUSR1);
to.tv_sec = VNTSD_CV_WAIT_DELTIME;
to.tv_nsec = 0;
/* wait for clients to disconnect */
(void) cond_reltimedwait(&consp->cvp, &consp->lock, &to);
}
(void) mutex_unlock(&consp->lock);
free_cons(consp);
}
void fill_in_new_instantiation_stuff (instantiation *inst,
bool need_to_do_support_calculations) {
condition *cond;
preference *p;
goal_stack_level level;
production_add_ref (inst->prod);
find_match_goal (inst);
level = inst->match_goal_level;
/* Note: since we'll never backtrace through instantiations at the top
level, it might make sense to not increment the reference counts
on the wmes and preferences here if the instantiation is at the top
level. As it stands now, we could gradually accumulate garbage at
the top level if we have a never-ending sequence of production
firings at the top level that chain on each other's results. (E.g.,
incrementing a counter on every decision cycle.) I'm leaving it this
way for now, because if we go to S-Support, we'll (I think) need to
save these around (maybe). */
/* KJC 6/00: maintaining all the top level ref cts does have a big
impact on memory pool usage and also performance (due to malloc).
(See tests done by Scott Wallace Fall 99.) Therefore added
preprocessor macro so that by setting macro the top level ref cts are not
incremented. It's possible that in some systems, these ref cts may
be desireable: they can be added by defining DO_TOP_LEVEL_REF_CTS
*/
for (cond=inst->top_of_instantiated_conditions; cond!=NIL; cond=cond->next)
if (cond->type==POSITIVE_CONDITION) {
#ifdef DO_TOP_LEVEL_REF_CTS
wme_add_ref (cond->bt.wme);
#else
if (level > TOP_GOAL_LEVEL) wme_add_ref (cond->bt.wme);
#endif
/* --- if trace is for a lower level, find one for this level --- */
if (cond->bt.trace) {
if (cond->bt.trace->inst->match_goal_level > level) {
cond->bt.trace = find_clone_for_level (cond->bt.trace, level);
}
#ifdef DO_TOP_LEVEL_REF_CTS
if (cond->bt.trace) preference_add_ref (cond->bt.trace);
#else
if ((cond->bt.trace) && (level > TOP_GOAL_LEVEL))
preference_add_ref (cond->bt.trace);
#endif
}
}
if (inst->match_goal) {
for (p=inst->preferences_generated; p!=NIL; p=p->inst_next) {
insert_at_head_of_dll (inst->match_goal->id.preferences_from_goal, p,
all_of_goal_next, all_of_goal_prev);
p->on_goal_list = TRUE;
}
}
inst->backtrace_number = 0;
if ((current_agent(o_support_calculation_type) == 0) ||
(current_agent(o_support_calculation_type) == 3)) {
/* --- do calc's the normal Soar 6 way --- */
if (need_to_do_support_calculations)
calculate_support_for_instantiation_preferences (inst);
} else if (current_agent(o_support_calculation_type) == 1) {
if (need_to_do_support_calculations)
calculate_support_for_instantiation_preferences (inst);
/* --- do calc's both ways, warn on differences --- */
if ((inst->prod->declared_support!=DECLARED_O_SUPPORT) &&
(inst->prod->declared_support!=DECLARED_I_SUPPORT)) {
/* --- At this point, we've done them the normal way. To look for
differences, save o-support flags on a list, then do Doug's
calculations, then compare and restore saved flags. --- */
list *saved_flags;
preference *pref;
bool difference_found;
saved_flags = NIL;
for (pref=inst->preferences_generated; pref!=NIL; pref=pref->inst_next)
push ((pref->o_supported ? pref : NIL), saved_flags);
saved_flags = destructively_reverse_list (saved_flags);
dougs_calculate_support_for_instantiation_preferences (inst);
difference_found = FALSE;
for (pref=inst->preferences_generated; pref!=NIL; pref=pref->inst_next){
cons *c; bool b;
c = saved_flags; saved_flags = c->rest;
b = (c->first ? TRUE : FALSE); free_cons (c);
if (pref->o_supported != b) difference_found = TRUE;
pref->o_supported = b;
}
if (difference_found) {
print_with_symbols("\n*** O-support difference found in production %y",
inst->prod->name);
}
}
}
else {
/* --- do calc's Doug's way --- */
if ((inst->prod->declared_support!=DECLARED_O_SUPPORT) &&
(inst->prod->declared_support!=DECLARED_I_SUPPORT)) {
dougs_calculate_support_for_instantiation_preferences (inst);
}
}
}
bool trace_ungrounded_potentials(goal_stack_level grounds_level)
{
/* mvp 5-17-94 */
cons *c, *next_c, *prev_c, *prohibits;
cons *pots_to_bt;
condition *potential;
preference *bt_pref, *p;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM])
print_string("\n\n*** Tracing Ungrounded Potentials ***\n");
#endif
/* --- scan through positive potentials, pick out the ones that have
a preference we can backtrace through --- */
pots_to_bt = NIL;
prev_c = NIL;
for (c = current_agent(positive_potentials); c != NIL; c = next_c) {
next_c = c->rest;
potential = c->first;
bt_pref = find_clone_for_level(potential->bt.trace, (goal_stack_level) (grounds_level + 1));
if (bt_pref) {
if (prev_c)
prev_c->rest = next_c;
else
current_agent(positive_potentials) = next_c;
c->rest = pots_to_bt;
pots_to_bt = c;
} else {
prev_c = c;
}
}
/* --- if none to BT, exit --- */
if (!pots_to_bt)
return FALSE;
/* --- backtrace through each one --- */
while (pots_to_bt) {
c = pots_to_bt;
pots_to_bt = pots_to_bt->rest;
potential = c->first;
free_cons(c);
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string("\nFor ungrounded potential ");
print_wme(potential->bt.wme);
print_string(" ");
}
#endif
bt_pref = find_clone_for_level(potential->bt.trace, (goal_stack_level) (grounds_level + 1));
#ifdef NO_TOP_JUST
if (bt_pref->inst)
backtrace_through_instantiation(bt_pref->inst, grounds_level, potential, 0);
#else
/* mvp 5-17-94 */
backtrace_through_instantiation(bt_pref->inst, grounds_level, potential, 0);
#endif
if (potential->bt.prohibits) {
for (prohibits = potential->bt.prohibits; prohibits != NIL; prohibits = prohibits->rest) {
p = prohibits->first;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string(" For prohibit preference: ");
print_preference(p);
}
#endif
#ifdef NO_TOP_JUST
if (p->inst)
backtrace_through_instantiation(p->inst, grounds_level, potential, 6);
#else
backtrace_through_instantiation(p->inst, grounds_level, potential, 6);
#endif
}
}
/* mvp done */
}
return TRUE;
}
void trace_locals(goal_stack_level grounds_level)
{
/* mvp 5-17-94 */
cons *c, *prohibits;
condition *cond;
preference *bt_pref, *p;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM])
print_string("\n\n*** Tracing Locals ***\n");
#endif
while (current_agent(locals)) {
c = current_agent(locals);
current_agent(locals) = current_agent(locals)->rest;
cond = c->first;
free_cons(c);
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string("\nFor local ");
print_wme(cond->bt.wme);
print_string(" ");
}
#endif
bt_pref = find_clone_for_level(cond->bt.trace, (goal_stack_level) (grounds_level + 1));
/* --- if it has a trace at this level, backtrace through it --- */
if (bt_pref) {
#ifdef NO_TOP_JUST
if (bt_pref->inst) {
/* mvp 5-17-94 */
backtrace_through_instantiation(bt_pref->inst, grounds_level, cond, 0);
/* check if any prohibit preferences */
if (cond->bt.prohibits) {
for (prohibits = cond->bt.prohibits; prohibits != NIL; prohibits = prohibits->rest) {
p = prohibits->first;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string(" For prohibit preference: ");
print_preference(p);
}
#endif
if (p->inst)
backtrace_through_instantiation(p->inst, grounds_level, cond, 6);
}
}
/* mvp done */
}
#else
/* mvp 5-17-94 */
backtrace_through_instantiation(bt_pref->inst, grounds_level, cond, 0);
/* check if any prohibit preferences */
if (cond->bt.prohibits) {
for (prohibits = cond->bt.prohibits; prohibits != NIL; prohibits = prohibits->rest) {
p = prohibits->first;
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM]) {
print_string(" For prohibit preference: ");
print_preference(p);
}
#endif
backtrace_through_instantiation(p->inst, grounds_level, cond, 6);
}
}
/* mvp done */
#endif
continue;
}
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM])
print_string("...no trace, can't BT");
#endif
/* --- for augmentations of the local goal id, either handle the
"^quiescence t" test or discard it --- */
if (referent_of_equality_test(cond->data.tests.id_test)->id.isa_goal) {
if ((referent_of_equality_test(cond->data.tests.attr_test) ==
current_agent(quiescence_symbol)) &&
(referent_of_equality_test(cond->data.tests.value_test) ==
current_agent(t_symbol)) && (!cond->test_for_acceptable_preference)) {
current_agent(variablize_this_chunk) = FALSE;
current_agent(quiescence_t_flag) = TRUE;
}
continue;
}
/* --- otherwise add it to the potential set --- */
#ifndef TRACE_CONTEXT_DECISIONS_ONLY
if (current_agent(sysparams)[TRACE_BACKTRACING_SYSPARAM])
print_string(" --> make it a potential.");
#endif
add_to_potentials(cond);
} /* end of while locals loop */
}
saved_test *simplify_test (agent* thisAgent, test *t, saved_test *old_sts) {
test New, subtest;
saved_test *saved;
Symbol *var, *sym;
cons *c, *prev_c, *next_c;
complex_test *ct;
if (test_is_blank_test(*t)) {
sym = generate_new_variable (thisAgent, "dummy-");
*t = make_equality_test_without_adding_reference (sym);
return old_sts;
}
if (test_is_blank_or_equality_test(*t)) {
return old_sts;
}
ct = complex_test_from_test(*t);
switch (ct->type) {
case CONJUNCTIVE_TEST:
/* --- look at subtests for an equality test --- */
sym = NIL;
for (c=ct->data.conjunct_list; c!=NIL; c=c->rest) {
subtest = static_cast<char *>(c->first);
if (test_is_blank_or_equality_test(subtest))
sym = referent_of_equality_test(subtest);
}
/* --- if no equality test was found, generate a variable for it --- */
if (!sym) {
sym = generate_new_variable (thisAgent, "dummy-");
New = make_equality_test_without_adding_reference (sym);
allocate_cons (thisAgent, &c);
c->first = New;
c->rest = ct->data.conjunct_list;
ct->data.conjunct_list = c;
}
/* --- scan through, create saved_test for subtests except equality --- */
prev_c = NIL;
c = ct->data.conjunct_list;
while (c) {
next_c = c->rest;
subtest = static_cast<char *>(c->first);
if (! test_is_blank_or_equality_test(subtest)) {
/* --- create saved_test, splice this cons out of conjunct_list --- */
allocate_with_pool (thisAgent, &thisAgent->saved_test_pool, &saved);
saved->next = old_sts;
old_sts = saved;
saved->var = sym;
symbol_add_ref (sym);
saved->the_test = subtest;
if (prev_c)
prev_c->rest = next_c;
else
ct->data.conjunct_list = next_c;
free_cons (thisAgent, c);
} else {
prev_c = c;
}
c = next_c;
}
break;
default:
/* --- goal/impasse, disjunction, and non-equality relational tests --- */
var = generate_new_variable (thisAgent, "dummy-");
New = make_equality_test_without_adding_reference (var);
allocate_with_pool (thisAgent, &thisAgent->saved_test_pool, &saved);
saved->next = old_sts;
old_sts = saved;
saved->var = var;
symbol_add_ref (var);
saved->the_test = *t;
*t = New;
break;
}
return old_sts;
}