void alg2_decommon_n(Term a2)
{
List l1;
int cnum,cden;
Term t;
l1=CompoundArgN(a2,5);
if(is_empty_list(l1))
{
SetCompoundArg(a2,2,0);
return;
}
t=ConsumeCompoundArg(a2,2);
cnum=IntegerValue(CompoundArg1(t));
cden=IntegerValue(CompoundArg2(t));
FreeAtomic(t);
while(!is_empty_list(l1))
{
Term t;
int c1,c2,c3;
c1=cnum*IntegerValue(CompoundArg1(ListFirst(l1)));
c2=cden;
c3=gcf(c1,c2);
c1/=c3;
c2/=c3;
t=MakeCompound2(OPR_DIV,NewInteger(c1),NewInteger(c2));
SetCompoundArg(ListFirst(l1),1,t);
l1=ListTail(l1);
}
}
/* bind a parallel list of symbols and arguments */
void bind_argument_list(interp_core_type *interp, object_type *sym_list,
object_type *value_list) {
/* we have a list of symbols */
while(!is_empty_list(interp, sym_list) && !is_empty_list(interp, value_list)
&& !is_symbol(interp, sym_list)) {
bind_symbol(interp, car(sym_list), car(value_list), &interp->cur_env);
sym_list=cdr(sym_list);
value_list=cdr(value_list);
}
/* handle single, variadic argument lists */
if(is_symbol(interp, sym_list)) {
bind_symbol(interp, sym_list, value_list, &interp->cur_env);
return;
}
/* make sure that we have the same number of arguments
as we have symbols */
if(!is_empty_list(interp, sym_list) &&
!is_empty_list(interp, value_list)) {
interp->error=1;
}
}
object_type *get_binding(interp_core_type *interp,
object_type *sym) {
object_type *binding=0;
object_type *env=0;
object_type *list=0;
env=interp->cur_env;
/* Walk each environment */
while(!is_empty_list(interp, env)) {
list=car(env);
/* walk every binding */
while(!is_empty_list(interp, list)) {
binding=car(list);
/* we found the binding! */
if(car(binding)==sym) {
return binding;
}
list=cdr(list);
}
/* move to the next environment */
env=cdr(env);
}
return 0;
}
static void *th_w(void *d)
{
List l1,fret=0, frete=0, ret=0,rete=0;
int ind=*(int *)d;
pthread_setspecific(TermsKey,&ind);
begin:
ret=NewList();
pthread_mutex_lock(&mtww);
if(th_src==0)
{
*(List *)d=fret;
pthread_mutex_unlock(&mtww);
return 0;
}
ret=ListFirst(th_src);
th_src=ListTail(th_src);
pthread_mutex_unlock(&mtww);
ret=AppendFirst(0,ret);
l1=th_ww;
while(!is_empty_list(l1))
{
Term rrr;
List l2;
rrr=ret;
ret=NewList(); rete=ret;
l2=rrr;
while(!is_empty_list(l2))
{
List nn=alg1_s_w_m_1(ListFirst(l2),ListFirst(l1));
if(nn)
{
if(ret==0) {ret=nn;rete=ret;}
else ListConcat(rete,nn);
while(ListTail(rete)) rete=ListTail(rete);
}
/*ret=ConcatList(ret,nn);*/
l2=ListTail(l2);
}
/*printf(" %d ",ListLength(ret));fflush(stdout);*/
FreeAtomic2(rrr,ind);
l1=ListTail(l1);
}
if(ret==0)
goto begin;
if(fret==0)
{fret=ret; frete=fret;}
else
ConcatList(frete,ret);
while(ListTail(frete)) frete=ListTail(frete);
goto begin;
}
static inline object *sequence_to_exp(object *seq)
{
if (is_empty_list(seq)) {
return seq;
} else if (is_empty_list(cdr(seq))) {
return car(seq);
} else {
return make_begin(seq);
}
}
void alg2_recommon_n(Term a2)
{
List m2l,l,l1,nl;
int cnum,n,d;
m2l=CompoundArgN(a2,5);
nl=NewList();
l=m2l;
if(is_empty_list(l))
return;
while(!is_empty_list(l))
{
nl=AppendLast(nl,CompoundArg1(ListFirst(l)));
l=ListTail(l);
}
cnum=gcf_list(nl);
if(IntegerValue(ListFirst(nl))<0)
cnum*=-1;
if(cnum==1)
{
RemoveList(nl);
return;
}
l1=m2l;
l=nl;
while(!is_empty_list(l))
{
SetCompoundArg(ListFirst(l1),1,
NewInteger(IntegerValue(ListFirst(l))/cnum));
l=ListTail(l);
l1=ListTail(l1);
}
RemoveList(nl);
n=IntegerValue(CompoundArg1(CompoundArg2(a2)));
d=IntegerValue(CompoundArg2(CompoundArg2(a2)));
n*=cnum;
cnum=gcf(n,d);
n/=cnum;
d/=cnum;
SetCompoundArg(CompoundArg2(a2),1,NewInteger(n));
SetCompoundArg(CompoundArg2(a2),2,NewInteger(d));
return ;
}
static void rename_ind(Term t, Label from, Label to)
{
if(is_list(t))
{
List l;
l=t;
while(!is_empty_list(l))
{
Term u;
u=ListFirst(l);
if(u==from)
ChangeList(l,to);
else
rename_ind(u,from,to);
l=ListTail(l);
}
return;
}
if(is_compound(t))
{
int i,ac;
ac=CompoundArity(t);
for(i=1;i<=ac;i++)
{
Term u;
u=CompoundArgN(t,i);
if(u==from)
SetCompoundArg(t,i,to);
else
rename_ind(u,from,to);
}
}
return;
}
void
save_new_cycle(GraphFrame *gf,struct pt *begin, struct pt *end, int cycle_len)
{
LNode_type *bptr, *eptr,*tptr;
/*printf("begin %s, level %d, end %s, level %d\n",
begin->label, begin->level,end->label, end->level);*/
if( (end->level - begin->level + 1) != cycle_len
|| ! is_empty_list(gf->the_cycle))
return;
bptr = Search_Sequential_list(gf->list_visited_vertex, (char *)begin);
eptr = Search_Sequential_list(gf->list_visited_vertex, (char *)end);
/*printf ("found cycle\n");*/
for(tptr = bptr ; tptr != eptr->back; tptr = tptr->back)
{
struct pt *v = (struct pt *)tptr->info;
/*printf ("vcicle : %s ", v->label);*/
Insert_linked_list(gf->the_cycle,create_new_node_llist((char*)v));
}
/*printf("\n");*/
}
/* insert an item to the end of the linked list */
void list_insert_rear(struct list_t* list, void *element)
{
struct list_t *walker;
if ( is_empty_list(list) )
{
list->data = element;
}
else
{
walker = list;
while ( walker->next != 0)
{
walker = walker->next;
}
walker->next = malloc( sizeof(struct list_t) );
walker = walker->next;
if ( walker == 0 )
{
printf( "Out of memory" );
exit(0);
}
walker->next = 0;
walker->data = element;
}
}
void sem_pend(sem_struct *sem)
{
cpu_sr_t cpu_sr;
list_node_t *pnode;
thread_struct *pthread;
cpu_sr = save_cpu_sr();
if (sem->value == 0) {
if (!is_empty_list(&sem->wait_list)) {
for (pnode = begin_list(&sem->wait_list);
pnode != end_list(&sem->wait_list);
pnode = next_list(pnode)) {
pthread = entry_list(pnode, thread_struct, node);
if (current_thread->prio < pthread->prio) {
current_thread->state = EVENT_WAIT;
insert_before_list(
pnode,
¤t_thread->node);
break;
}
}
}
if (current_thread->state != EVENT_WAIT) {
current_thread->state = EVENT_WAIT;
insert_back_list(&sem->wait_list, ¤t_thread->node);
}
schedule(SCHED_THREAD_REQUEST);
return;
}
sem->value--;
restore_cpu_sr(cpu_sr);
}
static Term cc_particle(Term t1, List *ind)
{
Term t, prt;
t=ConsumeCompoundArg(t1,1);
FreeAtomic(t1);
prt=GetAtomProperty(t,PROP_TYPE);
if( !(is_compound(prt) && CompoundName(prt)==OPR_PARTICLE))
{
ErrorInfo(216);
printf(" cc(\'");WriteTerm(t);printf("\') is undefined.\n");
longjmp(alg1_jmp_buf,1);
}
t1=t;
/* if(CompoundArg1(prt)==t)
t=CompoundArg2(prt);
else
t=CompoundArg1(prt);*/
if(ind!=NULL)
*ind=CopyTerm(GetAtomProperty(t,PROP_INDEX));
if(!is_empty_list(*ind) && CompoundName(CompoundArg1(ListFirst(*ind)))==A_LORENTZ)
{
Term tt, in1,in2;
tt=CompoundArg1(ListFirst(*ind));
in1=ConsumeCompoundArg(tt,1);
in2=ConsumeCompoundArg(tt,2);
SetCompoundArg(tt,1,in2);
SetCompoundArg(tt,2,in1);
}
/*
WriteTerm(*ind); puts("");
*/
return t1;
}
struct list_t* list_remove_rear(struct list_t* list)
{
/* an empty list */
if ( is_empty_list(list) )
{
return list;
}
/* one element in list */
else if ( list->next == 0 )
{
list->data = 0;
list->next = 0;
return list;
}
else
{
struct list_t *walker, *prev_item;
walker = list;
while ( walker->next != 0)
{
prev_item = walker;
walker = walker->next;
}
prev_item->next = 0;
free(walker);
return list;
}
}
/* insert an item on specified position or to the end if position>lenght(list) */
struct list_t* list_insert_after(struct list_t* list, void *element, int pos)
{
struct list_t *walker, *next_element, *new_element;
int i = 1;
if ( pos == 1)
{
list = list_insert_front(list, element);
}
else if ( !is_empty_list(list) && pos > 1 )
{
walker = list;
while ( walker->next != 0 && ++i<pos)
{
walker = walker->next;
}
/* can insert record instead of the last element or after it */
if ( i == pos || i == (pos - 1) )
{
next_element = walker->next;
new_element = malloc( sizeof(struct list_t) );
new_element->next = next_element;
new_element->data = element;
walker->next = new_element;
}
}
return list;
}
int search(struct list_t* list, void *element)
{
struct list_t *walker;
size_t i = 0;
int find = 0;
if ( !is_empty_list(list) )
{
i = 1;
walker = list;
while ( walker->next != 0 )
{
if ( walker->data == element )
{
find = 1;
break;
}
++i;
walker = walker->next;
}
}
if ( !find )
{
i = 0;
}
return i;
}
size_t list_size(struct list_t* list)
{
struct list_t *walker;
size_t i = 0;
if ( !is_empty_list(list) )
{
i = 1;
walker = list;
/* DEBUG_INFO: print root elem */
printf( "%d ",*((int*)walker->data));
while (walker->next != 0)
{
++i;
walker = walker->next;
/* DEBUG_INFO: print every next elem */
printf( "%d ",*((int*)walker->data));
}
}
/* DEBUG_INFO */
printf("; Size: %d.\n", (int)i );
return i;
}
static inline object *binding_value(object *binding)
{
if (!is_empty_list(cdr(cdr(binding)))) {
warn("ignoring extra expressions in let binding");
}
return car(cdr(binding));
}
static inline object *bindings_values(object *bindings)
{
return is_empty_list(bindings) ?
get_empty_list() :
cons (binding_value(car(bindings)),
bindings_values(cdr(bindings)));
}
void alg2_decommon_s(Term a2)
{
Term cfl;
List l;
cfl=ConsumeCompoundArg(a2,3);
if(is_empty_list(cfl))
return;
for(l=CompoundArgN(a2,5);l;l=ListTail(l))
{
List pfl;
List l1,l2;
pfl=ConsumeCompoundArg(ListFirst(l),2);
for(l1=cfl;l1;l1=ListTail(l1))
{
Atom p;
p=CompoundArg1(ListFirst(l1));
for(l2=pfl;l2;l2=ListTail(l2))
{
if(CompoundArg1(ListFirst(l2))==p)
{
int pw;
pw=IntegerValue(CompoundArg2(ListFirst(l2)))
+IntegerValue(CompoundArg2(ListFirst(l1)));
SetCompoundArg(ListFirst(l2),2,NewInteger(pw));
break;
}
}
if(is_empty_list(l2))
pfl=AppendFirst(pfl,CopyTerm(ListFirst(l1)));
}
rr:
for(l1=pfl;l1;l1=ListTail(l1))
if(CompoundArg2(ListFirst(l1))==NewInteger(0))
{
pfl=CutFromList(pfl,l1);
goto rr;
}
pfl=SortedList(pfl,prtcmp);
SetCompoundArg(ListFirst(l),2,pfl);
}
FreeAtomic(cfl);
}
static object *prepare_apply_operands(object *arguments)
{
if (is_empty_list(cdr(arguments))) {
return car(arguments);
} else {
return cons(car(arguments), prepare_apply_operands(cdr(arguments)));
}
}
void alg1_fix_wild(Term a1)
{
List l1;
l1=CompoundArg1(a1);
while(!is_empty_list(l1))
{
List l2;
l2=CompoundArgN(ListFirst(l1),3);
while(!is_empty_list(l2))
{
if(CompoundName(ListFirst(l2))==OPR_WILD)
alg1_fix_w1(ListFirst(l2));
l2=ListTail(l2);
}
l1=ListTail(l1);
}
}
/*
static int mlt_list1(List l)
{
int ret=1;
while(!is_empty_list(l))
{
if( is_empty_list(ListTail(l)) ||
!ListMember(ListTail(l),ListFirst(l)))
ret*=IntegerValue(ListFirst(l));
l=ListTail(l);
}
return ret;
}
*/
static int gcf_list(List l)
{
int ret;
if(is_empty_list(l))
return 1;
ret=IntegerValue(ListFirst(l));
if(ret<0)
ret=-ret;
l=ListTail(l);
while(!is_empty_list(l))
{
if(ret==1)
return 1;
ret=gcf(ret,IntegerValue(ListFirst(l)));
l=ListTail(l);
}
return ret;
}
static object *eval_parameters(object *parameters, object *env)
{
if (is_empty_list(parameters)) {
return get_empty_list();
} else {
return cons(bs_eval(car(parameters), env),
eval_parameters(cdr(parameters), env));
}
}
static inline object *if_alternate(object *exp)
{
object *alt = cdr(cdr(cdr(exp)));
if (is_empty_list(alt)) {
return get_boolean(0);
} else {
return car(alt);
}
}
/* delete all nodes where data == element */
struct list_t* list_remove_any(struct list_t* list, void *element)
{
struct list_t *walker, *prev_item, *next_item;
int need_to_del_first = 1;
if ( is_empty_list(list) )
{
return list;
}
else if ( !is_empty_list(list) )
{
while ( need_to_del_first == 1)
{
if ( list->data == element )
{
list = list_remove_front(list);
need_to_del_first = 1;
}
else
{
need_to_del_first = 0;
}
}
walker = list;
while ( walker->next != 0 )
{
prev_item = walker;
walker = walker->next;
if ( walker->data == element ) {
next_item = walker->next;
prev_item->next = next_item;
free(walker);
walker = prev_item;
}
}
}
return list;
}
static void mult_no(List e1, int no)
{
while(!is_empty_list(e1))
{
int v;
v=IntegerValue(CompoundArg1(ListFirst(e1)));
v*=no;
SetCompoundArg(ListFirst(e1),1,NewInteger(v));
e1=ListTail(e1);
}
}
static object *expand_clauses(object *clauses)
{
if (is_empty_list(clauses)) {
return get_boolean(0);
} else {
object *first = car(clauses);
object *rest = cdr(clauses);
if (cond_predicate(first) == lookup_symbol("else")) {
if (is_empty_list(rest)) {
return sequence_to_exp(cond_actions(first));
} else {
error("else clause must be last in cond expression");
}
} else {
return make_if(cond_predicate(first),
sequence_to_exp(cond_actions(first)),
expand_clauses(rest));
}
}
}
static void
ensure_sanity(const struct util_cache *cache)
{
#ifdef DEBUG
unsigned i, cnt = 0;
assert(cache);
for (i = 0; i < cache->size; i++) {
struct util_cache_entry *header = &cache->entries[i];
assert(header);
assert(header->state == FILLED ||
header->state == EMPTY ||
header->state == DELETED);
if (header->state == FILLED) {
cnt++;
assert(header->hash == cache->hash(header->key));
}
}
assert(cnt == cache->count);
assert(cache->size >= cnt);
if (cache->count == 0) {
assert (is_empty_list(&cache->lru));
}
else {
struct util_cache_entry *header = cache->lru.next;
assert (header);
assert (!is_empty_list(&cache->lru));
for (i = 0; i < cache->count; i++)
header = header->next;
assert(header == &cache->lru);
}
#endif
(void)cache;
}
/* select the next thread in the ready list with top_prio
*/
static void select_next_thread(int top_prio)
{
list_node_t *pnode;
/* otherwise, threads in a ready state, then run the highest
* priority one. */
pnode = delete_front_list(&ready_list[top_prio]);
if (is_empty_list(&ready_list[top_prio]))
prio_exist_flag[top_prio] = false;
next_thread = entry_list(pnode, thread_struct, node);
next_thread->state = RUNNING;
next_thread->time_quantum = TIME_QUANTUM;
}
List SetLets(List l)
{
List l1,lr, lre=0;
lr=NewList();
slrl++;
l1=l;
while(!is_empty_list(l1))
{
List nl=s_l_1(ListFirst(l1));
if(nl==0)
{l1=ListTail(l1);continue;}
if(lr==0)
{lr=nl;lre=lr;}
else
ConcatList(lre,nl);
while(ListTail(lre)) lre=ListTail(lre);
/*lr=ConcatList(lr,);*/
l1=ListTail(l1);
}
RemoveList(l);
slrl--;
if(slrl==0)
{
for(l1=lr;l1;l1=ListTail(l1))
{
List l2,sl=ConsumeCompoundArg(ListFirst(l1),3);
int ch=0;
for(l2=sl;l2;l2=ListTail(l2))
if(CompoundName(ListFirst(l2))==A_INFINITESIMAL)
{
FreeAtomic(ListFirst(l2));
ChangeList(l2,0);
ch++;
}
if(ch)
do
{
for(l2=sl;l2;l2=ListTail(l2))
if(ListFirst(l2)==0)
{
sl=CutFromList(sl,l2);
break;
}
} while(l2);
SetCompoundArg(ListFirst(l1),3,sl);
}
}
lr=a1l_rem_inf(lr);
return lr;
}
int
compute_sel_bary_positions(GraphFrame *gf)
{
int mes = 0;
int cycle_len = count_llist(gf->list_sel_vertex);
enumerate_vertices(gf);
reset_mark_pick_vertices(gf);
reset_level_vertices(gf);
if(!gf->the_cycle)
gf->the_cycle = init_linked_list();
if(!gf->list_visited_vertex)
gf->list_visited_vertex = init_linked_list();
if(!gf->the_rest)
gf->the_rest = init_linked_list();
get_sel_cycle(gf);
/*printing_linked_list(gf->the_cycle);*/
if(!is_empty_list(gf->the_cycle))
{
Delete_hash_table(gf->HV);
circularize(gf,gf->the_cycle, cycle_len);
get_rest(gf);
/*printing_linked_list(gf->the_rest);*/
if(!is_empty_list(gf->the_rest))
mes = layout_rest(gf, gf->the_rest, gf->count_vertex-cycle_len);
}
else
mes = NO_CYCLE;
Delete_all_list(gf->the_cycle);
Delete_all_list(gf->list_visited_vertex);
Delete_all_list(gf->the_rest);
gf->the_cycle = init_linked_list();
gf->list_visited_vertex = init_linked_list();
gf->the_rest = init_linked_list();
return mes;
}