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 listADT ListConcat(listADT list1, listADT list2)
{
if (list1 == NULL) {
return (list2);
} else {
return (ListCons(ListHead(list1),
ListConcat(ListTail(list1), list2)));
}
}
static void ConcatOperation(dataBlockT db, string lhs)
{
listADT result;
string v1, v2;
CheckForToken(db->scanner, "(");
v1 = ConvertToLowerCase(ReadToken(db->scanner));
CheckForToken(db->scanner, ",");
v2 = ConvertToLowerCase(ReadToken(db->scanner));
CheckForToken(db->scanner, ")");
result = ListConcat(GetValue(db, v1), GetValue(db, v2));
if (lhs == NULL) {
DisplayStringList(result);
} else {
SetValue(db, lhs, result);
}
}
static List mk_let(Term m1, List cut, Term a1)
{
List l,l2;
List lb,le;
List sd;
int num1,den1;
int io1=0,io2=0,rmn=0;
for(l=CompoundArgN(m1,3);l;l=ListTail(l))
{
Term prp=0;
if(CompoundName(ListFirst(l))==OPR_PARAMETER)
prp=GetAtomProperty(CompoundArg2(ListFirst(l)),A_INFINITESIMAL);
if(prp && IntegerValue(CompoundArg1(prp))>0)
io1+=IntegerValue(CompoundArg1(prp));
if(CompoundName(ListFirst(l))==A_INFINITESIMAL)
io1+=IntegerValue(CompoundArg2(ListFirst(l)));
}
l=ConsumeCompoundArg(a1,1);
FreeAtomic(a1);
a1=l;
for(l2=a1;l2;l2=ListTail(l2))
{
Term m11=ListFirst(l2);
io2=0;
for(l=CompoundArgN(m11,3);l;l=ListTail(l))
{
Term prp=0;
if(CompoundName(ListFirst(l))==OPR_PARAMETER)
prp=GetAtomProperty(CompoundArg2(ListFirst(l)),A_INFINITESIMAL);
if(prp && IntegerValue(CompoundArg1(prp))>0)
io2+=IntegerValue(CompoundArg1(prp));
if(CompoundName(ListFirst(l))==A_INFINITESIMAL)
io2+=IntegerValue(CompoundArg2(ListFirst(l)));
}
if(io1+io2>infi_order)
{
FreeAtomic(ListFirst(l2));
ChangeList(l2,0);
rmn++;
}
}
if(rmn)
do
{
for(l=a1;l;l=ListTail(l))
if(ListFirst(l)==0)
{
a1=CutFromList(a1,l);
break;
}
}
while(l);
num1=IntegerValue(ConsumeCompoundArg(m1,1));
den1=IntegerValue(ConsumeCompoundArg(m1,2));
l=ConsumeCompoundArg(m1,3);
sd=ConsumeCompoundArg(m1,4);
lb=ListSplit(l,cut,&le);
FreeAtomic(cut);
FreeAtomic(m1);
l=a1;
while(!is_empty_list(l))
{
int n1,n2,d1,d2,num,den,cf;
List lb1,lb1e,le1,le1e,lm;
m1=ListFirst(l);
lm=ConsumeCompoundArg(m1,3);
lb1=CopyList(lb,&lb1e);
le1=CopyList(le,&le1e);
if(lm==0)
lm=le1;
else if(le1)
ConcatList(lm,le1);
if(lb1==0)
lb1=lm;
else if(lm)
ListConcat(lb1e,lm);
/*lb1=ConcatList(lb1,lm);
lb1=ConcatList(lb1,le1);*/
SetCompoundArg(m1,3,lb1);
lm=ConsumeCompoundArg(m1,4);
lb1=CopyList(sd,&lb1e);
if(lb1==0)
lb1=lm;
else if(lm)
ListConcat(lb1e,lm);
/*lm=ConcatList(lm,CopyTerm(sd));*/
SetCompoundArg(m1,4,lb1);
n1=num1;
d1=den1;
n2=IntegerValue(CompoundArg1(m1));
d2=IntegerValue(CompoundArg2(m1));
num=n1*n2;
den=d1*d2;
if(den<0) den=-den;
cf=gcf(num,den);
num/=cf;
den/=cf;
if(d1<0 && d2<0)
{
num=-num;
}
else
if((d1<0 && d2>0) || (d1>0 && d2<0))
{
den=-den;
}
SetCompoundArg(m1,1,NewInteger(num));
SetCompoundArg(m1,2,NewInteger(den));
l=ListTail(l);
}
FreeAtomic(lb);
FreeAtomic(le);
FreeAtomic(sd);
return a1;
}
static List alg1_s_w_m(Term m1, List sl)
{
List l1,ret,rete;
ret=NewList();
ret=AppendLast(ret,m1);
rete=ret;
l1=sl;
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);*/
FreeAtomic(rrr);
#ifdef MTHREAD
if(th_no && ListLength(ret)>200 && ListTail(l1))
{l1=ListTail(l1);puts("!!");break;}
#endif
l1=ListTail(l1);
}
#ifndef MTHREAD
return ret;
#else
if(l1==0)
return ret;
{
pthread_t thid[16];
List thli[16];
int i;
th_src=ret;
th_ww=l1;
for(i=0;i<th_no;i++)
{
thli[i]=i;
pthread_create(&thid[i],NULL,th_w,(void *) &thli[i]);
}
for(i=0;i<th_no;i++)
pthread_join(thid[i],NULL);
RemoveList(ret);
ret=0;
for(i=0;i<th_no;i++) ret=ConcatList(ret,thli[i]);
return ret;
}
#endif
}
static List alg1_s_w_m_1(Term m1, Term by)
{
Atomic ind;
int range;
int i1,i2;
int c1,c2;
List l1;
List ret,rete;
int i;
i1=i2=0;
c1=c2=0;
i=1;
ind=CompoundArg1(by);
range=IntegerValue(CompoundArg2(by));
l1=CompoundArgN(m1,3);
while(!is_empty_list(l1))
{
Term t1;
t1=ListFirst(l1);
if(CompoundName(t1)==OPR_WILD)
{
List l2;
int no;
no=1;
l2=CompoundArg1(t1);
while(!is_empty_list(l2))
{
Term t2;
t2=ListFirst(l2);
if(CompoundArg2(t2)==ind)
{
if(c1==0)
{
c1=i;
i1=no;
}
else
if(is_empty_list(c2))
{
c2=i;
i2=no;
}
else
{
printf("Internal error (3rd index)\n");
longjmp(alg1_jmp_buf,1);
}
}
no++;
l2=ListTail(l2);
}
}
i++;
l1=ListTail(l1);
}
/*
printf("First: %lx %d\n",c1,i1);
printf("Second: %lx %d\n",c2,i2);
*/
ret=NewList();
rete=ret;
for(i=1;i<=range;i++)
{
List nn=alg1_sub_w(m1,ind,c1,i1,c2,i2,i);
if(nn)
{
if(ret==0) {ret=nn;rete=ret;}
else ListConcat(rete,nn);
while(ListTail(rete)) rete=ListTail(rete);
}
/*ret=ConcatList(ret,nn);*/
}
return ret;
}