Word CADFPCAD(Word D, Word P, Word S, Word I, Word Pb)
{
Word Db,Is,N,Sb,Pb_N,Ts,L,p,i,is,Q,Ms,C,Cs,Ds,Ss;
Word Mb,mb;
Step1: /* Is D the root cell? */
Db = LELTI(D,SC_REP);
if (LELTI(D,SC_PAR) == NIL) {
Is = NIL;
Ss = NIL;
Ms = NIL; }
else {
Step2: /* D is not the root cell. */
Is = CINV(COMP(LELTI(D,SC_INX),CINV(I)));
N = LENGTH(Is);
Step3: /* Signiture & multiplicity information. */
Sb = FIRST(LELTI(Db,SIGNPF));
Pb_N = LELTI(Pb,N);
Ts = NIL; Ms = NIL; is = 0;
/* Loop over each level N polynomial in P. */
for(L = CINV(LELTI(P,N)); L != NIL; L = RED(L)) {
p = FIRST(L); i = 1; is++;
/* Set i so that p is the ith level N pol in Pb. */
i = PFPIPFL(p,Pb_N);
if (i == 0) { SWRITE("CAPFPCAD: Can't find the polynomial!\n"); }
Ts = COMP(LELTI(Sb,i),Ts);
/* Set the multiplicity list if necessary */
for (Mb = LELTI(Db,MULSUB); Mb != NIL; Mb = RED(Mb)) {
mb = FIRST(Mb);
if (FIRST(mb) == THIRD(LELTI(p,PO_LABEL))) {
Ms = COMP(mb,Ms); } } }
/* Ms = CINV(Ms); */
Ss = COMP(Ts,S); }
Step4: /* Children. */
C = LELTI(D,SC_CDTV);
if ( ISATOM(C) ) {
Cs = NIL; }
else {
for(Cs = NIL; C != NIL; C = RED(C)) {
Cs = COMP(CADFPCAD(FIRST(C),P,Ss,Is,Pb),Cs); }
Cs = CINV(Cs); }
Step5: /* */
Ds = LCOPY(Db);
SLELTI(Ds,CHILD,Cs);
SLELTI(Ds,INDX,Is);
SLELTI(Ds,SIGNPF,Ss);
SLELTI(Ds,HOWTV,NOTDET); /* Might want to change. */
SLELTI(Ds,MULSUB,Ms);
Return: /* Prepare to return. */
return (Ds);
}
Word PCADCSV(Word cs, Word Ps)
{
Word c,l,S,s,I,V,Vs;
Step1: /* */
c = LELTI(cs,SC_REP);
l = LELTI(c,LEVEL);
if (l == 0) {
Vs = NIL; goto Return; }
S = LELTI(Ps,l);
for(I = NIL; S != NIL; S = RED(S)) {
s = FIRST(S);
I = COMP(THIRD(LELTI(s,PO_LABEL)),I); }
LBIBMS(I);
I = CINV(I);
V = FIRST(LELTI(c,SIGNPF));
for(Vs = NIL;I != NIL; I = RED(I))
Vs = COMP(LELTI(V,FIRST(I)),Vs);
Return: /* Prepare to return. */
return (Vs);
}
Word QepcadCls::ACCCVBCR(Word k, Word c, Word B1, Word b, Word* B1h)
{
Word d, nnf, dV, IV, cp, i, I_i, d_i, c_i, L, Q, Qb, Qbs, F, Fp, a;
Step1: /* Initialization **********************************************/
a = NIL; /* this is the pseudo-sample point we're building up *******/
F = NIL; /* Useless now, could be usefull later. ********************/
d = 0; /* dimension of cell c_i. **********************************/
nnf = 0; /* number of variables not fixed. **************************/
dV = CINV(RED(PDEGV(k+1,B1))); /* vector of degrees of first k ******
variables of B1. ******************/
IV = LELTI(c,INDX); /* vector of indices of cell c. ******/
Step2: /* Loop over each level from 1 to k ****************************/
c_i = GVPC;
for(i = 1; i <= k; i++) {
I_i = LELTI(IV,i);
d_i = LELTI(dV,i);
c_i = LELTI(LELTI(c_i,CHILD),I_i);
Step3: /* c_i is a section over a 0-dimensional cell ******************/
if ((I_i % 2 == 0) && d == 0) {
a = SUFFIX(a,LELTI(b,i));
continue; }
Step4: /* c_i is a section over a cell of dimension greater than zero */
if ((I_i % 2 == 0) && d > 0) {
for(L=SECTIONPOLS(i,c_i,GVPF),Qbs=1,Fp=NIL; L != NIL; L=RED(L)) {
Q = RPFIP(i,LELTI(FIRST(L),PO_POLY));
Qb = SPECIALSUBSR(i,a,Q); /* Qb can't be zero, by definition of
SECTIONPOLS */
Qbs = RPEMV(nnf + 1,Qb,LELTI(b,i));
if (Qbs == 0) {
a = SUFFIX(a,LELTI(b,i));
break; }
else
Fp = COMP(Qb,Fp); }
if (L == NIL) {
F = CCONC(F,Fp);
nnf++;
a = SUFFIX(a,NIL);
} }
Step5: /* c_i is a sector *********************************************/
if (I_i % 2 == 1) {
d++;
nnf++;
a = SUFFIX(a,NIL); }
}
/*Step6: a is the psuedo-sample point, check that B1 is univariate at a. */
bool uniq = true;
Word B1b = SPECIALSUBSR(k+1,a,RPFIP(k+1,B1));
for(Word B1s = B1b; uniq && B1s != 0; B1s = PRED(B1s))
uniq = IPCONST(nnf,PLDCF(B1s));
if (B1h != 0) *B1h = B1b;
return uniq ? TRUE : UNDET;
}
void IPDWRITELATEX(Word r, Word A, Word V)
{
Word Ap,E,Ep,Vp,a,e,l,s,t,v;
Step1: /* r=0 or A=0. */
Ap = DIPFP(r,A);
if (r == 0 || Ap == 0) {
IWRITE(Ap);
goto Return; }
l = 1;
Step2: /* General case. */
do {
ADV2(Ap,&a,&E,&Ap);
s = ISIGNF(a);
a = IABSF(a);
if (s > 0 && l == 0)
CWRITE('+');
if (s < 0)
CWRITE('-');
if (a != 1) {
if (l == 0)
CWRITE(' ');
IWRITE(a);
t = 1; }
else
t = 0;
Ep = CINV(E);
Vp = V;
do {
ADV(Ep,&e,&Ep);
ADV(Vp,&v,&Vp);
if (e > 0) {
if (l == 0 || t == 1)
CWRITE(' ');
VWRITE(v);
t = 1; }
if (e > 1) {
CWRITE('^');
CWRITE('{');
AWRITE(e); }
CWRITE('}'); }
while (Ep != NIL);
if (t == 0) {
if (l == 0)
CWRITE(' ');
CWRITE('1'); }
if (Ap == NIL)
goto Return;
CWRITE(' ');
l = 0; }
while (1);
Return: /* Prepare for return. */
return;
}
static Word comp(Word A, Word B)
{
Word S_a,S_b,s_a,s_b,t;
Step1: /* Initialization. */
S_a = CINV(LELTI(A,SIGNPF));
S_b = CINV(LELTI(B,SIGNPF));
t = 0;
Step2: /* Compare siginitures. */
while (t == 0 && S_a != NIL) {
ADV(S_a,&s_a,&S_a); ADV(S_b,&s_b,&S_b);
while ( t == 0 && s_a != NIL) {
t = BDCOMP(FIRST(s_a),FIRST(s_b));
s_a = RED(s_a); s_b = RED(s_b); } }
Return: /* Return. */
return (t);
}
Word NORMAETF(Word A)
{
Word X,T,j,P,r,I,s,c,L,Lr,Fs,Fa,L_i,e_i,P_i,rk_i,Pk_i,F;
Step1: /* Get the components. */
FIRST6(A,&X,&T,&j,&P,&r,&I);
Step2: /* Factor \v{P}. */
if (!ISLIST(FIRST(P)))
IPFACDB(r,P,&s,&c,&L);
else {
Word Lp = NIL;
for(; P != NIL; P = RED(P))
Lp = COMP(LIST2(1,FIRST(P)),Lp);
L = CINV(Lp);
}
Step3: /* Sign of content is irrelevant in _root_ expressions! */
Step4: /* Simplify the representation of the polys in \v{L}. */
Lr = NIL; /* r-level factors */
Fs = NIL; /* factors of level less than r can't be zero! */
while (L != NIL)
{
ADV(L,&L_i,&L);
FIRST2(L_i,&e_i,&P_i);
PSIMREP(r,P_i,&rk_i,&Pk_i);
if (rk_i < r)
Fs = COMP(LIST4(NEOP,Pk_i,rk_i,NIL),Fs);
else
Lr = COMP(Pk_i,Lr);
}
Lr = INV(Lr);
Step5: /* Create formula */
Fa = LIST6(IROOT,T,j,Lr,r,NIL);
F = COMP(Fa,Fs);
F = COMP(ANDOP,CINV(F));
Return: /* Prepare for return. */
return(F);
}
Word FMAOPCOMBINE(Word F)
{
Word L,M,Fp,f,a,b,Lp,Mp,Lb;
switch(FIRST(F)) {
case OROP:
/* Set L to a list of all top level atomic formulas. */
L = NIL; M = NIL;
for(Fp = RED(F); Fp != NIL; Fp = RED(Fp)) {
f = FIRST(Fp);
if (ISLIST(FIRST(f)))
L = COMP(f,L);
else
M = COMP(f,M); }
/* Create Lp from L */
Lp = NIL;
while(L != NIL) {
a = FIRST(L);
if (FMAQEXTAF(a)) { Lp = COMP(a,Lp); L = RED(L); continue; }
Lb = RED(L);
for(L = NIL; Lb != NIL; Lb = RED(Lb)) {
b = FIRST(Lb);
if (FMAQEXTAF(b) || ! EQUAL(FIRST(b),FIRST(a)))
L = COMP(b,L);
else
a = LIST2(FIRST(a),SECOND(a) | SECOND(b)); }
if (SECOND(a) > 6)
Lp = COMP(LIST1(TRUE),Lp);
else
Lp = COMP(a,Lp); }
/* Create Mp from M. */
for(Mp = NIL; M != NIL; M = RED(M))
Mp = COMP(FMAOPCOMBINE(FIRST(M)),Mp);
Fp = COMP(OROP,CCONC(Lp,Mp));
break;
case ANDOP:
Fp = NIL;
for(L = CINV(RED(F)); L != NIL; L = RED(L))
Fp = COMP(FMAOPCOMBINE(FIRST(L)),Fp);
Fp = COMP(ANDOP,Fp);
break;
default:
Fp = F;
}
return Fp;
}
Word LBMIPL(Word L, BDigit r)
{
Word S, s, i, L_i;
S = NIL;
s = LENGTH(L);
for(i = s; i >= 1; i--)
{
for(L_i = CINV(LELTI(L,i)); L_i != NIL; L_i = RED(L_i))
S = COMP(RVSPTSVSP(i,FIRST(L_i),r),S);
}
return S;
}
Word CYLFORM(Word C, Word P, Word k, Word A)
{
Word SF,L,Lp,c,S,t,Q,As,Ap,Fp,F,Lt,Lf,s;
Step1: /* Set L to a list of all (k-1)-level cells over which there are
k-level cells with SC_TMPM of TRUE. */
if (k == 0) {
SF = LIST1(TRUE);
goto Return; }
SF = NIL;
L = NIL;
for(Lp = PCADCL(C,k-1); Lp != NIL; Lp = RED(Lp)) {
c = FIRST(Lp);
S = LELTI(c,SC_CDTV); if (!ISLIST(S)) continue;
for(t = 0; S != NIL && !t; S = RED(S))
t = (LELTI(FIRST(S),SC_TMPM) == TRUE);
if (t)
L = COMP(c,L); }
Step3: /* Construct formula for the k-level cells. */
Lt = NIL;
Lf = NIL;
S = NIL;
for(Lp = L; Lp != NIL; Lp = RED(Lp))
S = CCONC(LELTI(FIRST(Lp),SC_CDTV),S);
for(S = PCADCL(C,k); S != NIL; S = RED(S)) {
s = FIRST(S);
if (LELTI(s,SC_TMPM) == TRUE)
Lt = COMP(s,Lt);
else
Lf = COMP(s,Lf); }
F = NAIVESF(SPCADCBDD(Lt,k),Lf,A,P);
Step2: /* Formula for the projection. */
for(Q = L; Q != NIL; Q = RED(Q))
SLELTI(FIRST(Q),SC_TMPM,TRUE);
As = NIL;
for(Ap = CINV(A); Ap != NIL; Ap = RED(Ap))
if (FMALEVEL(FIRST(Ap)) < k)
As = COMP(FIRST(Ap),As);
Fp = CYLFORM(C,P,k-1,As);
SF = LIST3(ANDOP,Fp,F);
Return: /* Prepare to return. */
return SF;
}
Word ESPCADLSNC(Word D, Word P, Word i)
{
Word Q,C,T,L,Lp,A,t,R,Rp,r,c1,c2,c3,S;
Step1: /* Construct Q, a list of (i-1)-level cells. */
Q = PCADCL(D,i-1);
Step2: /* Loop over each cell C in Q. */
for(L = NIL; Q != NIL; Q = RED(Q)) {
C = FIRST(Q);
if (ISATOM(LELTI(C,SC_CDTV)))
continue;
Step3: /* Remove from L any condition that is not necessary over C.
for(Lp = CINV(L), S = NIL; Lp != NIL; Lp = RED(Lp)) {
A = FIRST(Lp);
for(t = 1, R = LELTI(C,SC_CDTV); t && R != NIL; R = RED(R)) {
r = FIRST(R);
t = (LELTI(r,SC_TMPM) != TRUE || FMACELLEVAL(A,r) == TRUE); }
if (t)
S = COMP(A,S); } */
Step4: /* Construct T, a list of necessary conditions over C. */
R = LELTI(C,SC_CDTV);
T = NIL;
for(ADV(R,&c1,&R); R != NIL; c1 = c3) {
ADV2(R,&c2,&c3,&R);
T = CONC(ESPCADCTLSNC(c1,c2,c3,i,P),T); }
Step5: /* Merge T and L. */
L = GMSDSL(CCONC(T,L),comp); }
Step6: /* Remove from L any condition that is not necessary. */
R = PCADCL(D,i);
for(Lp = CINV(L), S = NIL; Lp != NIL; Lp = RED(Lp)) {
A = FIRST(Lp);
for(t = 1, Rp = R; t && Rp != NIL; Rp = RED(Rp)) {
r = FIRST(Rp);
t = (LELTI(r,SC_TMPM) != TRUE || FMACELLEVAL(A,P,r) == TRUE); }
if (t)
S = COMP(A,S); }
L = S;
Return: /* */
return L;
}
/*
List of extended Tarski atoms (modified to only include atoms involving
>= and <=, i.e. the one's you'd need for full-dim cells only)
P a proj fac set
i a level
t a T/F flag
Returns a list of atoms using the extended stuff if "t" and
otherwise not. the atoms are only the ones you need if you
only look at full dim cells.
*/
static Word LISTOETAmod(Word P, Word i, Word t)
{
Word L,n,L_A,p,B;
Step1: /* Construct list of all projection factors, in reverse order. */
for(L = NIL, n = 1; n <= i; n++)
L = CCONC(LELTI(P,n),L);
L = CINV(L);
Step2: /* */
for(L_A = NIL; L != NIL; L = RED(L)) {
p = FIRST(L);
B = PDEG(LELTI(p,PO_POLY));
L_A = CCONC(PLISTOETAmod(p,B > 1 ? B : 0,t),L_A); }
return L_A;
}
// z[0],z[1] is (1,1) entry of matrix
// z[2],z[3] is (2,1) entry of matrix, etc.
static void invert_c2x2(double z[]){
// [a c]
// [b d]
// ad-bc
double idet[2], tmp[2];
CMUL(&z[2*0], &z[2*3], idet);
CMUL(&z[2*1], &z[2*2], tmp);
CSUB(idet,tmp);
CINV(idet);
CSWP(&z[2*0], &z[2*3]);
CNEG(&z[2*1]);
CNEG(&z[2*2]);
CMUL(&z[2*0], idet, tmp); CSET(&z[2*0], tmp);
CMUL(&z[2*1], idet, tmp); CSET(&z[2*1], tmp);
CMUL(&z[2*2], idet, tmp); CSET(&z[2*2], tmp);
CMUL(&z[2*3], idet, tmp); CSET(&z[2*3], tmp);
}
void QepcadCls::ECLI(Word D, Word *c_, Word *t_)
{
Word L,l,t,c,p;
Step1: /* Initialize if first time through (GVECPI = 0). */
if (GVECPI == 0) {
GVECS = ISFECLI(D);
goto Step3; }
Step2: /* Look for previously returned eligible cell. If it is still
in the CAD and has undetermined truth value, push the indices of its
eligible children onto the stack. */
p = CELLNA(GVECPI,D);
if (SCREEN(p))
for(L = CINV(LELTI(p,CHILD)); L != NIL; L = RED(L)) {
l = FIRST(L);
if (SCREEN(l))
GVECS = COMP(LELTI(l,INDX),GVECS); }
Step3: /* Keep popping cell indices off the stack until one is found
such that the corresponding cell still exists and does not already
have a truth value. If the cell returned by CELLNA is not the one
with index GVECPI, then it must have determined truth value. Thus
this single test below accounts for two cases: The cell with index
GVECPI does exist but has determined truth value, or the cell with
index GVECPI does not exist any longer. */
while(GVECS != NIL) {
ADV(GVECS,&GVECPI.W,&GVECS.W);
p = CELLNA(GVECPI,D);
if (SCREEN(p)) {
t = 1;
c = p;
goto Return; } }
Step4: /* No more cells left. */
t = 0;
c = NIL;
GVECPI = 0;
Return: /* Prepare to return. */
*c_ = c;
*t_ = t;
return;
}
Word LPFSETMINUS(Word S, Word G)
{
Word Q,Sp,s,i_s,t,Gp;
Step1: /* Initialize. */
Q = NIL;
Step2: /* Loop over each polynomial s in S. */
for(Sp = CINV(S); Sp != NIL; Sp = RED(Sp)) {
s = FIRST(Sp);
i_s = THIRD(LELTI(s,PO_LABEL));
Step3: /* Test if s is in G. */
t = 0;
for(Gp = G; t == 0 && Gp != NIL; Gp = RED(Gp))
t = (i_s == THIRD(LELTI(FIRST(Gp),PO_LABEL)));
Step4: /* If s is not in G then add s to Q. */
if (! t)
Q = COMP(s,Q); }
Return: /* Return. */
return (Q);
}
void TDTOD(Word P, Word N, Word ***P2_, Word *P1_, Word *k_)
{
Word **P2,Pp,i,pp,n,k,m,j,P1,I,l;
Step1: /* Allocate P2. At the end of the loop k is # of pf's in P. */
P2 = (Word**)GETARRAY((N+1)*(sizeof(Word*)/sizeof(Word))); /* ASSUMES THIS / IS EXACT! */
Pp = P; k = 0;
for(i = 1; i <= N; i++) {
ADV(Pp,&pp,&Pp);
n = LENGTH(pp);
k += n;
/* Finds I, the largest index in pp. */
for(I = 0; pp != NIL; pp = RED(pp))
I = IMAX(THIRD(LELTI(FIRST(pp),PO_LABEL)),I);
P2[i] = (Word*)GETARRAY(I+1);
P2[i][0] = n; }
Step2: /* Construct P1. */
P1 = NIL; m = k - 1;
Pp = NIL;
for(i = N; i > 0; i--) { Pp = COMP(LELTI(P,i),Pp); }
for(Pp = INV(Pp); Pp != NIL; Pp = RED(Pp)) {
for(pp = CINV(FIRST(Pp)); pp != NIL; pp = RED(pp)) {
l = LELTI(FIRST(pp),PO_LABEL);
FIRST2(RED(l),&i,&j);
P2[i][j] = m--;
P1 = COMP(l,P1); } }
Return: /* Prepare to return. */
*P2_ = P2;
*P1_ = P1;
*k_ = k;
return;
}
Word NECCONDS(Word L_T, Word L_F, Word L_A, Word P)
{
Word SF,Lp,N,a,t,Fp,SFp,A,n,S,f,S_f,T,I,i,Ap,L;
Word t1,t2,t3;
t1 = ACLOCK();
Step1: /* Construct N, the list of necessary conditions. */
for(Lp = CINV(L_A), N = NIL; Lp != NIL; Lp = RED(Lp)) {
a = FIRST(Lp);
for(t = TRUE,T = L_T; t == TRUE && T != NIL; T = RED(T))
t = FMACELLEVAL(a,FIRST(T),P);
if (t == TRUE)
N = COMP(a,N); }
Step2: /* Construct Fp, the list of false cells satisfying N. */
for(Lp = CINV(L_F), Fp = NIL; Lp != NIL; Lp = RED(Lp))
if (FMACELLEVAL(COMP(ANDOP,N),FIRST(Lp),P) != FALSE)
Fp = COMP(FIRST(Lp),Fp);
t1 = ACLOCK() - t1;
t2 = ACLOCK();
Step3: /* Construct formula for simplified problem. */
SFp = NAIVESF(L_T,Fp,L_A,P);
t2 = ACLOCK() - t2;
t3 = ACLOCK();
Step4: /* Construct Fp, the list of false cells satisfying SFp. */
for(Lp = CINV(L_F), Fp = NIL; Lp != NIL; Lp = RED(Lp))
if (FMACELLEVAL(SFp,FIRST(Lp),P) != FALSE)
Fp = COMP(FIRST(Lp),Fp);
if (Fp == NIL) {
SF = SFp;
goto Return; }
Step5: /* Construct the minimum hitting set problem. */
A = CINV(N);
n = LENGTH(A);
for(S = NIL; Fp != NIL; Fp = RED(Fp)) {
f = FIRST(Fp);
S_f = NIL;
for(i = n, Ap = A; Ap != NIL; i--,Ap = RED(Ap))
if (FMACELLEVAL(FIRST(Ap),f,P) == FALSE)
S_f = COMP(i,S_f);
S = COMP(S_f,S); }
Step6: /* Get the hitting set. */
T = MINHITSETSR(S,-1);
Step7: /* Convert hitting set to a formula. */
T = LBIBMS(T);
for(I = NIL, L = N, i = 1; T != NIL; i++, L = RED(L))
if (i == FIRST(T)) {
T = RED(T);
I = COMP(FIRST(L),I); }
if (LENGTH(I) == 1)
I = FIRST(I);
else
I = COMP(ANDOP,INV(I));
Step8: /* Join I and SFp. */
SF = LIST3(ANDOP,I,SFp);
Return: /* Prepare to return. */
t3 = ACLOCK() - t3;
if (PCVERBOSE) {
SWRITE("\nNECCONDS: t1 = ");IWRITE(t1);SWRITE(" t2 = ");
IWRITE(t2);SWRITE(" t3 = ");IWRITE(t3);SWRITE("\n\n"); }
return SF;
}
Word CFLCELLLIST(Word L_D)
{
Word C,r,C_r,L,Lp,T,F,U,c,t,f,u,Fp,Up,h,Cb,Cp,Q;
/* Time */ Word tm;
Step1: /* Initialize. */
C = NIL;
Step2: /* Get the children of L_D. */
L = NIL;
for(Q = L_D; Q != NIL; Q = RED(Q)) {
L = CCONC(LELTI(FIRST(Q),CHILD),L); }
Step3: /* Sort by signiture. */
L = GISL(L,comp);
Step4: /* Loop over each block of cells with same signiture. */
while (L != NIL) {
Lp = NIL;
do {
Lp = COMP(FIRST(L),Lp);
L = RED(L);
} while (L != NIL && comp(FIRST(Lp),FIRST(L)) == 0);
Step5: /* Separate into lists of TRUE, FALSE, and UNDET cells. */
T = NIL; F = NIL; U = NIL; C_r = NIL;
while (Lp != NIL) {
ADV(Lp,&c,&Lp);
switch (LELTI(c,TRUTH)) {
case (TRUE) : T = COMP(c,T); break;
case (FALSE) : F = COMP(c,F); break;
case (UNDET) : U = COMP(c,U); break; } }
Step6: /* TRUE/FALSE & TRUE/UNDET combinations. */
for(; T != NIL; T = RED(T)) {
t = FIRST(T);
for(Fp = F; Fp != NIL; Fp = RED(Fp)) {
f = FIRST(Fp); C_r = COMP(LIST2(t,f),C_r); }
for(Up = U; Up != NIL; Up = RED(Up)) {
u = FIRST(Up);
h = CATV(u);
if (h == FALSE || h == UNDET)
C_r = COMP(LIST2(t,u),C_r); } }
Step7: /* FALSE/UNDET combinations. */
for(; F != NIL; F = RED(F)) {
f = FIRST(F);
for(Up = U; Up != NIL; Up = RED(Up)) {
u = FIRST(Up);
h = CATV(u);
if (h == TRUE || h == UNDET)
C_r = COMP(LIST2(f,u),C_r); } }
Step8: /* Recurse on the UNDET cells. */
if ( U != NIL )
Cb = COMP(C_r,CFLCELLLIST(U));
else
Cb = LIST1(C_r);
Step9: /* Update C to include the */
Cp = NIL;
while( C != NIL && Cb != NIL ) {
Cp = COMP(CCONC(FIRST(Cb),FIRST(C)),Cp);
C = RED(C); Cb = RED(Cb); }
Cp = CINV(Cp);
if ( C != NIL ) Cp = CCONC(Cp,C);
if ( Cb != NIL ) Cp = CCONC(Cp,Cb);
C = Cp; }
Return: /* Prepare to return. */
return (C);
}
Word CELLRIGHTSIB(Word c, Word D)
{
Word Ip;
Ip = CINV(LELTI(c,INDX));
return CELLFINDEX(D,CINV(COMP(FIRST(Ip) + 1,RED(Ip))));
}
void IBPRRIOAPSF(Word M, Word I, Word B, BDigit p, BDigit k, Word *J_, Word *L_)
{
BDigit *Mp,*bp,*c,i,m,n,q1,q2,S,s,t;
Word b,Bp,I1,I2,J,K,L,Ls,Lp,T,Jp;
Step1: /* Convert the minimal polynomial to a software interval
polynomial. */
n = PDEG(M);
q1 = p + 3;
q2 = q1 + q1;
S = (n + 1) * q2 + 1;
Mp = GETARRAY(S);
IPSIP(M,p,Mp);
Step2: /* Compute the trend of \alpha. */
b = SECOND(I);
bp = GETARRAY(q1);
t = LBRNFEC(b,p,bp);
J = I;
L = 0;
if (t == 0) {
FREEARRAY(bp);
goto Return; }
t = SIPES(Mp,bp);
FREEARRAY(bp);
if (t == NIL)
goto Return;
Step3: /* Refine the isolating interval for \alpha. */
J = SIPIR(Mp,I,t,- (p * ZETA));
FREEARRAY(Mp);
Step4: /* Isolate the real roots of B(J)[Y]. */
L = NIL;
m = PDEG(B);
s = (m + 1) * q2 + 1;
c = GETARRAY(s);
IBPELBRISIPR(B,J,p,c);
L = SIPRRID(c);
if (L == 0)
goto Step8;
t = c[s - q2 + 1];
if (EVEN(m))
t = -t;
Step5: /* Refine the intervals. */
if (k == NIL)
goto Return;
Ls = NIL;
for(Lp = L; Lp != NIL; Lp = RED(Lp))
{
Jp = SIPIR(c,FIRST(Lp),t,-k);
Ls = COMP(Jp,Ls);
t = -t;
}
L = CINV(Ls);
Step8: /* Free arrays. */
FREEARRAY(c);
Return: /* Return J and L. */
*J_ = J;
*L_ = L;
return;
}
void QepcadCls::CSORCELLTR_MOD(Word c, Word Pp, Word PpO, Word PpN, Word P)
{
Word f,s,sh,M,K,C,Pps,L,T,B,E,I,A,a,b,k;
Word PP,NP,L_P,TP,i,ta,t;
Step0:
k = LELTI(c,LEVEL);
s = LELTI(c,SAMPLE);
sh = CONVERT(s,k);
SLELTI(c,SAMPLE,sh);
/* Trick CONSTRUCT into working for us by wrapping the elements of
Pp (which are SACLIB polynomials) in a dummy QEPCAD projection
polynomial/factor data structure. */
Word PpM = NIL;
for(Word PpR = CINV(Pp),j=LENGTH(Pp); PpR != NIL; PpR = RED(PpR),--j)
PpM = COMP( LIST5(FIRST(PpR),LIST3(LFS("P"),k+1,j),0,PO_FAC,0) ,PpM);
CONSTRUCT(c,k,GVNFV,PpM,GVNIP);
Step5: /* Add two new fields to each cell to make it an RCell. */
T = NIL;
for(A = LELTI(c,CHILD); A != NIL; A = RED(A)) {
T = COMP(CCONC(FIRST(A),LIST2(NIL,NIL)),T); }
SLELTI(c,CHILD,CINV(T));
Step6: /* Add truth values and other information. */
/* Get mask for pivot pol's, i.e. a list of
1's and zeros corresponding to PpO, where
the non-pivot pol positions are 1, and
the pivot pol positions are zero. */
SEPPIVNONPIV(LELTI(P,k+1),k+1,&PP,&NP); /* Get list of pivot pol's for this level. */
if ( (NP != NIL) && SINTER(LELTI(GVPIVOT,k+1),LLPFZC(c,P)) != NIL ) {
PP = LELTI(P,k+1); NP = NIL; }
L_P = NIL;
ta = FIRST(LELTI(FIRST(LELTI(c,CHILD)),SIGNPF)); /* signiture of a sector on level
k+1 pols. */
for(TP = LELTI(P,k+1); TP != NIL; TP = RED(TP)) {
/* Subtle point: a pivot pol might vanish identically in this stack,
which would mess everything up. If this pol does vanish identically
in the stack, don't include it in the mask! */
ADV(ta,&i,&ta); /* sign of current pol in a sector: if 0 then pol vanishes in stack. */
if ( PFPIPFL(FIRST(TP),PP) && i ) {
L_P = COMP(0,L_P); }
else
L_P = COMP(1,L_P); }
L_P = INV(L_P);
A = LELTI(c,CHILD); /* Stack with more cells, i.e. new. */
B = LELTI(LELTI(c,INCELL),CHILD); /* Stack with fewer cells, i.e. old. */
ADV(B,&b,&B);
ADV(A,&a,&A);
while (A != NIL) {
SLELTI(a,INCELL,b);
SLELTI(a,TRUTH,LELTI(b,TRUTH));
SLELTI(a,HOWTV,LELTI(b,HOWTV));
ADV(A,&a,&A);
if (LELTI(b,MULSUB) != NIL)
ADV(B,&b,&B); /* i.e. if b is a section. */
if ( ISCSOPP(a,L_P) ) {
do{
ADV(B,&b,&B);
} while( ! ISCSOPP(b,L_P) ); } }
SLELTI(a,INCELL,b);
SLELTI(a,TRUTH,LELTI(b,TRUTH));
SLELTI(a,HOWTV,LELTI(b,HOWTV));
Return: /* */
return;
}
void SPFRPSFT(Word P, Word c, Word k, Word *R_, Word *F_)
{
Word R,F,Pk1,l,R1,i,j,S,Si,Pi,Sij,Pij,G,g;
Word H,h,f1,f2,f3,f4,f5,f6,n,n1,n2,L,L1,L2;
Step1: /* Initialize. */
Pk1 = LELTI(P,k+1);
l = LENGTH(Pk1);
R = NIL;
for (i=1; i<=l; i++) {
R1 = NIL;
for (j=1; j<=l; j++)
R1 = COMP(1,R1);
R = COMP(R1,R); }
F = NIL;
for (i=1; i<=l; i++)
F = COMP(1,F);
if (l == 0) goto Return;
Step2: /* Update. */
S = LELTI(c,SIGNPF);
S = CINV(S);
for (i=1; i<=k; i++) {
ADV(S,&Si,&S);
ADV(P,&Pi,&P);
while (Si != NIL) {
ADV(Si,&Sij,&Si);
ADV(Pi,&Pij,&Pi);
if (Sij != 0) continue;
G = LELTI(Pij,PO_PARENT);
while (G != NIL) {
ADV(G,&g,&G);
if (FIRST(g) != PO_FAC) continue;
H = LELTI(THIRD(g),PO_PARENT);
while (H != NIL) {
ADV(H,&h,&H);
switch(FIRST(h)) {
case PO_LCO:
FIRST3(h,&f1,&f2,&f3);
if (f2 != 0) break;
L = LELTI(f3,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_LCO");
SLELTI(F,n,0);
break;
case PO_DIS:
FIRST4(h,&f1,&f2,&f3,&f4);
if (f2 != 0 || f3 != 0) break;
L = LELTI(f4,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_DIS");
SLELTI(F,n,0);
break;
case PO_RES:
FIRST6(h,&f1,&f2,&f3,&f4,&f5,&f6);
if (f2 != 0 || f3 != 0 || f5 != 0) break;
L1 = LELTI(f4,PO_LABEL);
if (SECOND(L1) != k+1) break;
L2 = LELTI(f6,PO_LABEL);
if (SECOND(L2) != k+1)
FAIL("SPFRPSFT","resultant of diff level");
n1 = PLPOS(Pk1,THIRD(L1));
if (n1 == 0) FAIL("SPFRPSFT","PO_RES: n1");
n2 = PLPOS(Pk1,THIRD(L2));
if (n2 == 0) FAIL("SPFRPSFT","PO_RES: n2");
if (n2 > n1)
SLELTI(LELTI(R,n1),n2,0);
else
FAIL("SPFRPSFT","n2 <= n1");
break; } } } } }
Return: /* Prepare for return. */
*R_ = R;
*F_ = F;
return;
}
Word MINPFSETNSC(Word P,Word S,Word D,Word K)
{
Word C,Sltr,Pltr,r,L_r,Ls_r,L,l,l_t,l_s,ls,Kp,Js,x,Jsp,s_k,sk;
Word x_s,js,Ls,O,Q,Q_i,Sp,Pp,i,Cp,*V,*Vp,**A,a,N,k,S_r,I,j,p;
Step1: /* Initialization. */
C = NIL; Sltr = NIL; Pltr = NIL; N = LENGTH(K);
Step2: /* Loop over each level in D. */
for(r = 1; r <= N; r++) {
Step3: /* Get signiture and truth value for each cell. */
L_r = CADCL(D,r);
for(Ls_r = NIL; L_r != NIL; L_r = RED(L_r)) {
l = FIRST(L_r);
l_t = LELTI(l,TRUTH); l_s = LELTI(l,SIGNPF);
for(ls = NIL; l_s != NIL; l_s = RED(l_s)) {
ls = CCONC(FIRST(l_s),ls); }
ls = COMP(l_t,ls);
Ls_r = COMP(ls,Ls_r); }
Step4: /* Get conflict cell signitures. */
Jsp = NIL;
for(Kp = LELTI(K,r); Kp != NIL; Kp = RED(Kp)) {
k = FIRST(FIRST(Kp));
s_k = LELTI(k,SIGNPF);
for(sk = NIL; s_k != NIL; s_k = RED(s_k)) {
sk = CCONC(FIRST(s_k),sk); }
if (! MEMBER(sk,Jsp) )
Jsp = COMP(sk,Jsp); }
for(Js = NIL; Jsp != NIL; Jsp = RED(Jsp)) {
Js = COMP(COMP(CFLCT,FIRST(Jsp)),Js); }
Step5: /* Put lists together, and sort with duplicate removal. */
Ls = CCONC(Js,Ls_r);
Ls = GMSDSL(Ls,comp1);
Step6: /* Put this all into array representation. */
a = LENGTH(Ls);
k = LENGTH(FIRST(Ls)) - 1;
V = (Word*)GETARRAY(a*(k + 1)); Vp = V;
A = (Word**)GETARRAY(a*(sizeof(Word*)/sizeof(Word))); /* ASSUMES THIS / IS EXACT! */
for(i = 0; i < a; i++) {
A[i] = V + 1;
for(ADV(Ls,&ls,&Ls); ls != NIL; ls = RED(ls))
*(V++) = FIRST(ls); }
Step7: /* Build S_r. */
Sltr = CCONC(Sltr,LELTI(S,r));
Pltr = CCONC(Pltr,LELTI(P,r));
Sp = CINV(Sltr);
for(S_r = NIL; Sp != NIL; Sp = RED(Sp)) {
i = PFPIPFL(FIRST(Sp),Pltr);
S_r = COMP(i - 1,S_r); }
Step8: /* Sort cell signitures on S_r, and list conflict resolving
polynomials for each pair of conflicting cells in the same
class. */
CSORTSS(A,a,S_r);
for(i = 0;i < a; i = j) {
for(j = i + 1; (j < a) && ( SIGEQUALOL(A[i],A[j],S_r));j++);
Cp = ICSIGDIFFLNSC(A+i,j-i,k);
C = CCONC(C,Cp); }
Step9: /* Deallocate memory. */
FREEARRAY(Vp);
FREEARRAY(A); }
Step10:/* Get a min-hit-set */
O = MINHITSETSR(C,-1);
O = LMERGE(O,S_r);
O = LBIBMS(O); Q = NIL;
for(r = N; r > 0; r--) Q = COMP(NIL,Q);
while (O != NIL) {
ADV(O,&k,&O);
p = LELTI(Pltr,k+1);
i = LELTI(LELTI(p,PO_LABEL),2);
Q_i = SUFFIX(LELTI(Q,i),p);
SLELTI(Q,i,Q_i); }
Return: /* Prepare to return. */
return (Q);
}
void IBPRRIOAP(Word M,Word I,Word B,Word k, Word *L_,BDigit *t_)
{
Word L,CFP,Bp,Ls,Lp;
BDigit t,n,n1,n2,np,u,s,e,i,j,t1,tc,c;
ieee F1,F2;
double p,w1,w2;
interval *A,K,*Q,*HICFP,J;
Step1: /* Convert the isolating interval for \alpha to a
hardware interval. */
L = NIL;
LBRNIEEEE(FIRST(I), &t,&F1,&n1);
if (t != 0)
goto Return;
w1 = F1.num;
LBRNIEEEE(SECOND(I), &t,&F2,&n2);
if (t != 0)
goto Return;
w2 = F2.num;
np = MIN(n1,n2);
Step2: /* Convert the minimal polynomial to a hardware interval
polynomial and refine the hardware interval. */
FPCATCH();
IUPHIP(M,&A,&t);
if (t == 0) {
t = 1;
goto Return; }
n = PDEG(M);
t = HIPFES(n,A,w2);
if (FPCHECK() == 1) {
t = 1;
goto Return; }
if (t == NIL) {
t = 2;
goto Return; }
u = 0;
while (u == 0 && np > 0) {
p = (w1 + w2) / 2.0;
s = HIPFES(n,A,p);
if ((FPCHECK() == 1) || (s == NIL))
u = 1;
else if (s == t)
w2 = p;
else if (s == -t)
w1 = p;
else {
w1 = p;
w2 = p; }
np = np - 1; }
K.left = w1;
K.right = w2;
Step3: /* Isolate the roots of B(alpha,y) */
/* Get hardware interval array to store B(alpha,y) (init to zero) */
Q = GETHIPARRAY(PDEG(B));
for(i = 0; i < PDEG(B) + 1; i++)
IHI(0,&(Q[i]),&t); /* this can't fail! */
/* Compute B(alpha,y) and store in Q */
for(Bp = B; Bp != NIL; Bp = RED2(Bp)) {
FIRST2(Bp,&e,&CFP);
IUPHIP(CFP,&HICFP,&c);
Q[e] = HIPIEVAL(PDEG(CFP),HICFP,K); }
/* Check leading coefficient */
s = HISIGN(Q[PDEG(B)]);
if (s == NIL) {
t = 3;
goto Return; }
/* get trend of first root */
if (PDEG(B) % 2 == 0 && s == 1 || PDEG(B) % 2 == 1 && s == -1)
t1 = -1;
else
t1 = 1;
/* Isolate the roots of B(alpha,y) */
HIPRRID(PDEG(B),Q, &L,&t);
if (t != 0)
goto Return;
Step4: /* Refine roots? */
if (k == NIL)
goto Return;
Ls = NIL;
for(Lp = L, tc = t1; Lp != NIL; Lp = RED(Lp), tc *= -1)
{
LBRIHI(FIRST(Lp),&J,&t); /* Can this fail? */
if (LBRNCOMP(FIRST(FIRST(Lp)),SECOND(FIRST(Lp))) != 0) {
/* Open interval! */
j = -LSILW(FIRST(Lp));
HIPIR(PDEG(B),Q,J,tc,j,k,&J,&j);
Ls = COMP(HILBRI(J),Ls); }
else {
/* 1-Point interval! */
Ls = COMP(FIRST(Lp),Ls); }
}
L = CINV(Ls);
t = 0;
Return: /* Return L and t. */
*L_ = L;
*t_ = t;
return;
}