static int
count(Static *S, ograd **ogp)
{
int i, rv, nz, *s, *z;
double t, *x;
ograd *og, *og1;
s = s_s;
x = s_x;
z = s_z;
t = 0;
nz = rv = 0;
for(og = *ogp; og; og = og1) {
og1 = og->next;
if ((i = og->varno) < 0)
t += og->coef;
else if (!s[i]++)
x[z[nz++] = i] = og->coef;
else
x[i] += og->coef;
free_og(S, og);
}
while(nz > 0) {
s[i = z[--nz]] = 0;
if (x[i]) {
og = new_og(S, og, i, x[i]);
rv++;
}
}
if (t)
og = new_og(S, og, -1, t);
*ogp = og;
return rv;
}
static void
free_oglist(Static *S, ograd *og)
{
ograd *og1;
for(; og; og = og1) {
og1 = og->next;
free_og(S, og);
}
}
static term *
ewalk(Static *S, expr *e)
{
term *L, *R, *T;
ograd *o, *oR;
expr **ep, **epe;
int i;
ASL_fg *asl;
switch(Intcast e->op) {
case OPNUM:
return new_term(S, new_og(S, 0, -1 , ((expr_n *)e)->v));
case OPPLUS:
return termsum(S, ewalk(S, e->L.e), ewalk(S, e->R.e));
case OPMINUS:
return termsum(S, ewalk(S, e->L.e), scale(S, ewalk(S, e->R.e), -1.));
case OPUMINUS:
return scale(S, ewalk(S, e->L.e), -1.);
case OPMULT:
if (!(L = ewalk(S, e->L.e))
|| !(R = ewalk(S, e->R.e)))
break;
if (L->Q) {
if (R->Q)
break;
qscale:
o = R->L;
if (o->next || o->varno >= 0)
break;
scale(S, L, o->coef);
free_og(S, o);
free_term(S, R);
return L;
}
if (R->Q) {
T = L;
L = R;
R = T;
goto qscale;
}
o = L->L;
oR = R->L;
if (o->next || o->varno >= 0) {
if (oR->next || oR->varno >= 0) {
L->Q = L->Qe = new_dyad(S, 0,o,oR,1);
L->L = L->Le = 0;
}
else {
scale(S, L, oR->coef);
free_og(S, oR);
}
free_term(S, R);
return L;
}
scale(S, R, o->coef);
free_og(S, o);
free_term(S, L);
return R;
case OPDIV:
/* only allow division by a constant */
if (!(R = ewalk(S, e->R.e)))
break;
o = R->L;
if (R->Q || o->next || o->varno >= 0)
break;
if (!(L = ewalk(S, e->L.e)))
break;
if (!o->coef) {
zerodiv++;
L = 0;
}
else
scale(S, L, 1./o->coef);
free_og(S, o);
free_term(S, R);
return L;
case OPSUMLIST:
ep = e->L.ep;
epe = e->R.ep;
L = ewalk(S, *ep);
while(L && ++ep < epe)
L = termsum(S, L, ewalk(S, *ep));
return L;
case OP2POW:
L = ewalk(S, e->L.e);
if (!L || L->Q)
break;
o = L->L;
if (!o->next && o->varno < 0) {
o->coef *= o->coef;
return L;
}
L->Q = L->Qe = new_dyad(S, 0,o,o,1);
L->L = L->Le = 0;
return L;
case OPVARVAL:
asl = S->asl;
if ((i = (expr_v *)e - var_e) < n_var)
return new_term(S, new_og(S, 0, i, 1.));
i -= S->nvinc;
if (!(L = cterms[i -= n_var])
&& !(L = cterms[i] = comterm(S, i)))
return 0;
return termdup(S, L);
}
return 0; /* nonlinear */
}
static ograd *
linform(LCADJ_Info *lci, expr *e, ograd **oglp)
{
ASL_fg *asl;
cexp *ce;
cexp1 *ce1;
expr **ep, **epe;
expr_n *en;
int i;
linpart *L, *Le;
ograd *og, *og1, *og1e, *og2, *og2e, *og2x, **ogp;
real t;
switch(Intcast e->op) {
case OPNUM:
return *oglp = new_og(lci, -1, ((expr_n *)e)->v);
case OPPLUS:
if (!(og1 = linform(lci, e->L.e, &og1e)))
return og1;
if (!(og2 = linform(lci, e->R.e, &og2e))) {
free_og(lci, og1, og1e);
return og2;
}
finish_plus:
if (og1->varno > og2->varno) {
og = og1;
og1 = og2;
og2 = og;
og = og1e;
og1e = og2e;
og2e = og;
}
else for(og = og1; og; og = og->next) {
if (!og2) {
og2e = og1e;
break;
}
if (og2->varno != og->varno)
break;
og->coef += og2->coef;
og2x = og2->next;
og2->next = lci->freeog;
lci->freeog = og2;
og2 = og2x;
}
og1e->next = og2;
*oglp = og2e;
return og1;
case OPMINUS:
if (!(og1 = linform(lci, e->L.e, &og1e)))
return og1;
if (!(og2 = linform(lci, e->R.e, &og2e))) {
free_og(lci, og1, og1e);
return og2;
}
for(og = og2; og; og = og->next)
og->coef = -og->coef;
goto finish_plus;
case OPUMINUS:
if ((og1 = linform(lci, e->L.e, oglp))) {
og2 = og1;
do og2->coef = -og2->coef;
while((og2 = og2->next));
}
return og1;
case OPMULT:
if (!(og1 = linform(lci, e->L.e, &og1e)))
return og1;
if (!(og2 = linform(lci, e->R.e, &og2e))) {
free_og(lci, og1, og1e);
return og2;
}
if (og1->varno < 0 && !og1->next) {
t = og1->coef;
free_og(lci, og1, og1e);
}
else if (og2->varno < 0 && !og2->next) {
t = og2->coef;
free_og(lci, og2, og2e);
og2 = og1;
og2e = og1e;
}
else {
free_og(lci, og1, og1e);
free_og(lci, og2, og2e);
return 0;
}
for(og = og2; og; og = og->next)
og->coef *= t;
*oglp = og2e;
return og2;
case OPDIV:
/* only allow division by a constant */
if (!(og1 = linform(lci, e->L.e, &og1e)))
return og1;
if (!(og2 = linform(lci, e->L.e, &og2e))) {
free_og(lci, og1, og1e);
return og2;
}
if (og2->varno < 0 && !og2->next) {
t = og2->coef;
free_og(lci, og2, og2e);
}
else {
free_og(lci, og1, og1e);
free_og(lci, og2, og2e);
return 0;
}
for(og = og1; og; og = og->next)
og->coef /= t;
*oglp = og1e;
return og1;
case OPSUMLIST:
ep = e->L.ep;
epe = e->R.ep;
if (!(og1 = linform(lci, *ep, &og1e)))
return og1;
while(++ep < epe) {
if (!(og2 = linform(lci, *ep, &og2e))) {
free_og(lci, og1, og1e);
return og2;
}
if (og1->varno > og2->varno) {
og = og1;
og1 = og2;
og2 = og;
og = og1e;
og1e = og2e;
og2e = og;
}
else for(og = og1; og; og = og->next) {
if (!og2) {
og2e = og1e;
break;
}
if (og2->varno != og->varno)
break;
og->coef += og2->coef;
og2x = og2->next;
og2->next = lci->freeog;
lci->freeog = og2;
og2 = og2x;
}
og1e->next = og2;
og1e = og2e;
}
*oglp = og1e;
return og1;
case OPVARVAL:
asl = (ASL_fg*)lci->asl;
if ((i = (expr_v *)e - var_e) < n_var)
return *oglp = new_og(lci, i, 1.);
if ((i -= n_var) < ncom0) {
ce = cexps + i;
en = (expr_n*)ce->e;
L = ce->L;
Le = L + ce->nlin;
}
else {
ce1 = cexps1 + (i - ncom0);
en = (expr_n*)ce1->e;
L = ce1->L;
Le = L + ce1->nlin;
}
if ((Intcast en->op) != OPNUM)
return 0;
ogp = &og2;
if (en->v != 0.) {
og2 = new_og(lci, -1, en->v);
ogp = &og2->next;
}
for(og = 0; L < Le; L++) {
i = (expr_v*)((char*)L->v.rp - (char*)voffset_of(expr_v,v)) - var_e;
og = *ogp = new_og(lci, i, L->fac);
ogp = &og->next;
}
*ogp = 0;
*oglp = og;
return og2;
}
return 0;
}
