static void *
dynlib_bind_internal(uim_lisp name)
{
void *library;
void (*dynlib_instance_init)(void);
void (*dynlib_instance_quit)(void);
DPRINTFN(UIM_VLEVEL_DYNLIB, (stderr, "Loading %s", REFER_C_STR(name)));
library = dlopen(REFER_C_STR(name), RTLD_NOW);
if (library == NULL) {
uim_notify_fatal(_("dynlib: %s: Load failed."), dlerror());
return uim_scm_f();
}
dynlib_instance_init
= (void (*)(void))dlfunc(library, "uim_dynlib_instance_init");
dynlib_instance_quit
= (void (*)(void))dlfunc(library, "uim_dynlib_instance_quit");
if (!dynlib_instance_init) {
uim_notify_fatal(_("dynlib: %s: Initialization failed."), REFER_C_STR(name));
return uim_scm_f();
}
DPRINTFN(UIM_VLEVEL_DYNLIB, (stderr, "Calling dynlib_instance_init() for %s.\n", REFER_C_STR(name)));
(*dynlib_instance_init)();
return LIST3(MAKE_PTR(library),
MAKE_FPTR(dynlib_instance_init),
MAKE_FPTR(dynlib_instance_quit));
}
/* ESPCAD cell triple and polynomial index list of strong necessary conditions. */
Word ESPCADCTPILSNC(Word c1,Word c2, Word c3, Word i, Word j,Word k, Word P)
{
Word Lt,Lf,C,c,A,tt,tf,L,Lp,Ls;
Step1: /* Classify cells as true or false. */
C = LIST3(c1,c2,c3);
for(Lt = NIL, Lf = NIL; C != NIL; C = RED(C)) {
c = FIRST(C);
switch(LELTI(c,SC_TMPM)) {
case TRUE: Lt = COMP(c,Lt); break;
case FALSE: Lf = COMP(c,Lf); break;
default: break; } }
Step2: /* Need a true cell and a false cell to continue. */
if (Lt == NIL || Lf == NIL) {
L = NIL;
goto Return; }
Step3: /* Weed out conditions that are not strong & necessary. */
Ls = FMAAFPIRN(i,j,k);
for(L = NIL; Ls != NIL; Ls = RED(Ls)) {
A = FIRST(Ls);
for(tt = 1, Lp = Lt; tt && Lp != NIL; Lp = RED(Lp))
tt = FMACELLEVAL(A,FIRST(Lp),P);
for(tf = 1, Lp = Lf; tf && Lp != NIL; Lp = RED(Lp))
tf = FMACELLEVAL(A,FIRST(Lp),P);
if (tt && !tf)
L = COMP(A,L); }
Return: /* */
return L;
}
Word CYLIMPFORM(Word C, Word P, Word k, Word A)
{
Word SF,L,Lp,c,S,t,Q,As,Ap,Fp,F,Lt,Lf,s,Si,Fi,Qp,SF2;
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) {
if (LELTI(C,SC_TMPM) == TRUE)
SF = LIST1(TRUE);
else
SF = LIST1(FALSE);
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); }
Step2: /* 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);
Step3: /* */
S = GEOPARTII(FMASORT(FMA2DNF(F)),L,P,NIL);
/* Construct definiting formula from each (Si,Fi) in S. */
for(; S != NIL; S = RED(S)) {
FIRST2(FIRST(S),&Si,&Fi);
ESCSLKMF(C,k-1);
for(Qp = Si; Qp != NIL; Qp = RED(Qp))
SLELTI(FIRST(Qp),SC_TMPM,TRUE);
SF2 = CYLIMPFORM(C,P,k-1,A);
SF = COMP(LIST3(ANDOP,SF2,CLEANUPFORM(Si,Fi,P)),SF); }
Step4: /* Convert SF from a list of formulas to a formula. */
if (LENGTH(SF) > 1)
SF = COMP(OROP,SF);
else
SF = FIRST(SF);
Return: /* Prepare to return. */
return SF;
}
static uim_lisp
c_file_position_set(uim_lisp fildes_, uim_lisp offset_, uim_lisp whence_)
{
int ret = 0;
ret = lseek(C_INT(fildes_), C_INT(offset_), C_INT(whence_));
if (ret == -1) {
uim_lisp err_ = LIST3(fildes_, offset_, whence_);
ERROR_OBJ(strerror(errno), err_);
}
return MAKE_INT(ret);
}
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 QepcadCls::INITPCAD()
{
Word D, tv;
Step0: /* Determine truth value! */
if (GVNA == FALSE || GVNA != NIL && LELTI(GVNA,1) == NEOP && LELTI(GVNA,2) == 0) tv = NA;
else if (LELTI(GVNQFF,1) == NEOP && LELTI(GVNQFF,2) == 0) tv = FALSE;
else if (LELTI(GVNQFF,1) == EQOP && LELTI(GVNQFF,2) == 0) tv = TRUE;
else tv = UNDET;
Step1: /* Make one and initialize it. */
D = MCELL(0,NIL,FALSE,tv,LIST3(0,LIST2(0,0),NIL),NIL,NIL,0,NIL,NIL);
Return: /* Prepare for return. */
return(D);
}
Word GROUPSAMEPJ(Word r, Word J)
{
Word J1,Jp,Js,t, Js1, Jt, J2, Jt2, i;
Step1: /* Group. */
Jp = NIL; Js = J;
i = 0;
while (Js != NIL)
{
ADV(Js,&J1,&Js);
Js1 = LELTI(J1,PO_POLY);
Jt = Jp;
t = 0;
while (Jt != NIL)
{
ADV(Jt,&J2,&Jt);
Jt2 = LELTI(J2,PO_POLY);
if (LELTI(J1,PO_TYPE) == PO_POINT && LELTI(J2,PO_TYPE) == PO_POINT
&& PRJPNTEQUAL(Js1,Jt2) ||
LELTI(J1,PO_TYPE) != PO_POINT && LELTI(J2,PO_TYPE) != PO_POINT
&& EQUAL(Js1,Jt2))
{
SLELTI(J2,PO_PARENT,CONC(LELTI(J2,PO_PARENT),LELTI(J1,PO_PARENT)));
t = 1;
break;
}
}
if (t == 0)
{
i = i + 1;
SLELTI(J1,PO_LABEL,LIST3(LFS("J"),r,i));
Jp = COMP(J1,Jp);
}
}
Jp = INV(Jp);
Return: /* Prepare for return. */
return(Jp);
}
Word RMCAFS(Word F)
{
Word F1,F2,Fb,Fp,Fp1,Fp2,T,t,t1,t2;
/* hide t,t1,t2; */
Step1: /* Classify the formula F. */
T = FIRST(F);
if (T == ANDOP) goto Step3;
if (T == OROP) goto Step4;
if (T == NOTOP) goto Step5;
if (T == RIGHTOP) goto Step6;
if (T == LEFTOP) goto Step7;
if (T == EQUIOP) goto Step8;
Step2: /* Atomic Formula. */
t = TYPEAF(F);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
Fp = F;
goto Return;
Step3: /* Conjunction. */
Fb = RED(F);
Fp = LIST1(ANDOP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step4: /* Disjunction. */
Fb = RED(F);
Fp = LIST1(OROP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step5: /* Negation. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) Fp = LIST4(NEOP,0,0,NIL);
else if (t == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else Fp = LIST2(NOTOP,Fp1);
goto Return;
Step6: /* $\Rightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(RIGHTOP,Fp1,Fp2);
goto Return;
Step7: /* $\Leftarrow$. */
F1 = THIRD(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = SECOND(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(LEFTOP,Fp2,Fp1);
goto Return;
Step8: /* $\Leftrightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t2 == TRUE) Fp = Fp1;
else if (t1 == FALSE && t2 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t1 == FALSE) Fp = LIST2(NOTOP,Fp2);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(EQUIOP,Fp1,Fp2);
goto Return;
Return: /* Prepare for return. */
return(Fp);
}
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 NORMAF(Word A)
{
Word F,I,L,L_i,Lh,Lh_i,P,P_i,Ph_i,T,c,e_i,r,rh_i,s;
/* hide rh_i,s; */
Step1: /* Get the components. */
if (FIRST(A) == IROOT)
{
F = NORMAETF(A);
goto Return;
}
FIRST4(A,&T,&P,&r,&I);
Step2: /* \v{P} = 0. */
if (P != 0) goto Step3;
switch (T)
{
case EQOP:
F = LIST4(EQOP,0,0,NIL);
break;
case GEOP:
F = LIST4(EQOP,0,0,NIL);
break;
case LEOP:
F = LIST4(EQOP,0,0,NIL);
break;
case GTOP:
F = LIST4(NEOP,0,0,NIL);
break;
case LTOP:
F = LIST4(NEOP,0,0,NIL);
break;
case NEOP:
F = LIST4(NEOP,0,0,NIL);
break;
}
goto Return;
Step3: /* Factor \v{P}. */
IPFACDB(r,P,&s,&c,&L);
Step4: /* Adjust \v{T}. */
if (s < 0) T = NEGRLOP(T);
Step5: /* \v{P} is an integer. */
if (L != NIL) goto Step6;
switch (T)
{
case NEOP:
F = LIST4(EQOP,0,0,NIL);
break;
case GTOP:
F = LIST4(EQOP,0,0,NIL);
break;
case GEOP:
F = LIST4(EQOP,0,0,NIL);
break;
case EQOP:
F = LIST4(NEOP,0,0,NIL);
break;
case LTOP:
F = LIST4(NEOP,0,0,NIL);
break;
case LEOP:
F = LIST4(NEOP,0,0,NIL);
break;
}
goto Return;
Step6: /* Simplify the representation of the polys in \v{L}. */
Lh = NIL;
while (L != NIL)
{
ADV(L,&L_i,&L);
FIRST2(L_i,&e_i,&P_i);
PSIMREP(r,P_i,&rh_i,&Ph_i);
Lh_i = LIST3(e_i,rh_i,Ph_i);
Lh = COMP(Lh_i,Lh);
}
Lh = INV(Lh);
Step7: /* Expand. */
switch (T)
{
case EQOP:
F = EXPAFEQ(Lh);
break;
case GTOP:
F = EXPAFGT(Lh);
break;
case LTOP:
F = EXPAFLT(Lh);
break;
case NEOP:
F = LIST2(NOTOP,EXPAFEQ(Lh));
break;
case LEOP:
F = LIST2(NOTOP,EXPAFGT(Lh));
break;
case GEOP:
F = LIST2(NOTOP,EXPAFLT(Lh));
break;
}
goto Return;
Return: /* Prepare for return. */
return(F);
}
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;
}
Word QepcadCls::PROJMC(Word r, Word A)
{
Word A1,A2,Ap,Ap1,Ap2,App,D,L,Lh,P,R,W,i,t;
Step1: /* Obtain coefficients. */
P = NIL;
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue;
Ap1 = LELTI(A1,PO_POLY);
L = PLDCF(Ap1);
Lh = NIL;
t = 0;
if (!PCONST(r - 1,L)) {
W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
Lh = COMP(L,Lh);
t = 1; }
i = 0;
while (t) {
Ap1 = PRED(Ap1); i++; L = PLDCF(Ap1);
t = 0;
if (Ap1 != 0)
if (!PCONST(r - 1,L))
if (!IPFZT(r - 1,Lh)) {
W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,i,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
Lh = COMP(L,Lh);
t = 1; } } }
Step2: /* Obtain discriminants. */
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue;
Ap1 = LELTI(A1,PO_POLY);
if (PDEG(Ap1) >= 2) {
D = IPDSCRQE(r,Ap1);
W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
Step3: /* Obtain resultants. */
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
Ap1 = LELTI(A1,PO_POLY);
App = Ap;
while (App != NIL) {
ADV(App,&A2,&App);
if (PCEQC &&
LELTI(A1,PO_TYPE) != PO_ECON &&
LELTI(A2,PO_TYPE) != PO_ECON) continue;
Ap2 = LELTI(A2,PO_POLY);
R = IPRESQE(r,Ap1,Ap2);
W = MPOLY(R,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
Step4: /* Finish. */
P = INV(P);
goto Return;
Return: /* Prepare for return. */
return(P);
}
Word QepcadCls::PROJHO(Word r, Word A)
{
Word A1,A2,Ap,Ap1,Ap2,App,D,L,L1,P,Ps,R,R1,R11,R2,Rp,Rp11,Rpp,Rs,Rs1,
S1,T,W,ap1,b,d,i,k,w;
Step1: /* $r = 2$. */
if (r > 2) goto Step2;
P = NIL; Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue;
Ap1 = LELTI(A1,PO_POLY);
W = MPOLY(PLDCF(Ap1),NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
if (PDEG(Ap1) >= 2) {
D = IPDSCRQE(2,Ap1);
W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
Ap1 = LELTI(A1,PO_POLY);
App = Ap;
while (App != NIL) {
ADV(App,&A2,&App);
if (PCEQC &&
LELTI(A1,PO_TYPE) != PO_ECON &&
LELTI(A2,PO_TYPE) != PO_ECON) continue;
Ap2 = LELTI(A2,PO_POLY);
T = IPRESQE(2,Ap1,Ap2);
W = MPOLY(T,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
P = INV(P);
goto Return;
Step2: /* Determine number of reducta needed for each $A_i$. */
Ap = A; R = NIL;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
Ap1 = LELTI(A1,PO_POLY);
R1 = LIST1(Ap1);
ap1 = PLDCF(Ap1);
S1 = LIST1(ap1);
b = PCONST(r - 1,ap1);
d = 0;
Ap1 = PRED(Ap1);
while (!b && !d && Ap1 != 0) {
R1 = COMP(Ap1,R1);
ap1 = PLDCF(Ap1);
b = PCONST(r - 1,ap1);
if (!b) {
S1 = COMP(ap1,S1);
d = IPFZT(r - 1,S1); }
Ap1 = PRED(Ap1); }
R1 = INV(R1);
R = COMP(R1,R); }
R = INV(R);
Step3: /* Process each $R_i$. */
P = NIL; Rp = R; Ap = A;
while (Rp != NIL) {
ADV(Rp,&R1,&Rp); ADV(Ap,&A1,&Ap);
if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue;
S1 = NIL;
i = 0;
do {
ADV(R1,&R11,&R1);
W = MPOLY(PLDCF(R11),NIL,LIST1(LIST3(PO_LCO,i,A1)),
PO_OTHER,PO_KEEP);
P = COMP(W,P);
if (PDEG(R11) >= 2) {
Rp11 = IPDMV(r,R11);
L = IPPSCT(r,R11,Rp11,S1);
k = 0;
while (L != NIL) {
ADV(L,&L1,&L);
W = MPOLY(L1,NIL,LIST1(LIST4(PO_DIS,k,i,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
k = k + 1; }
S1 = COMP(PLDCF(R11),S1); }
i++; }
while (R1 != NIL); }
Step4: /* Process pairs $R_i$, $R_j$. */
Rp = R; Ap = A;
while (Rp != NIL) {
ADV(Rp,&R1,&Rp); ADV(Ap,&A1,&Ap);
Rpp = Rp; App = Ap;
while (Rpp != NIL) {
ADV(Rpp,&R2,&Rpp); ADV(App,&A2,&App);
if (PCEQC &&
LELTI(A1,PO_TYPE) != PO_ECON &&
LELTI(A2,PO_TYPE) != PO_ECON) continue;
if (LENGTH(R1) > LENGTH(R2)) {
Ps = FIRST(R1);
Rs = R2;
w = 1; }
else {
Ps = FIRST(R2);
Rs = R1;
w = 0; }
S1 = NIL;
i = 0;
while (Rs != NIL) {
ADV(Rs,&Rs1,&Rs);
if (PDEG(Rs1) >= 1) {
if (w == 1) L = IPPSCT(r,Ps,Rs1,S1);
else L = IPPSCT(r,Rs1,Ps,S1);
k = 0;
while (L != NIL) {
ADV(L,&L1,&L);
if (w == 1)
W = MPOLY(L1,NIL,LIST1(LIST6(PO_RES,k,0,A1,i,A2)),
PO_OTHER,PO_KEEP);
else
W = MPOLY(L1,NIL,LIST1(LIST6(PO_RES,k,i,A1,0,A2)),
PO_OTHER,PO_KEEP);
P = COMP(W,P);
k++; }
S1 = COMP(PLDCF(Rs1),S1); }
i++; } } }
Step5: /* Finish. */
P = INV(P);
Return: /* Prepare for return. */
return(P);
}
Word QepcadCls::PROJMCmod(Word r, Word A)
{
Word A1,A2,Ap,Ap1,Ap2,App,D,L,Lh,P,R,W,i,t,Q,j,S,Sp;
Step1: /* Obtain coefficients. */
P = NIL;
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
Ap1 = LELTI(A1,PO_POLY);
/* Deal with projection points! */
if (LELTI(A1,PO_TYPE) == PO_POINT) {
W = MPOLY(RED(Ap1),NIL,LIST1(LIST2(PT_PRJ,A1)),PO_POINT,PO_KEEP);
P = COMP(W,P);
continue;
}
/* Handle the leading coefficient! */
L = PLDCF(Ap1);
Lh = NIL;
t = 0;
/* if (!PCONST(r - 1,L)) {*/
if (!VERIFYCONSTSIGN(r-1,IPIP(r-1,ISIGNF(PLBCF(r-1,L)),L),1,GVNA.W)) {
W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
Lh = COMP(L,Lh);
t = 1; }
/* If r = 2 then we know the leading coefficient is always enough! */
if (r == 2)
t = 0;
/* If x_{r-1} is a bound variable, and the quantifier is
either F or G, then we know we'll only be lifting over
full dimensional cells so we don't have to add more
coefficients! */
if (t) {
j = r - GVNFV - 1;
if (j > 0) {
Q = LELTI(GVQ,j); /* Quantifier for x_{r-1} */
if (Q == FULLDE || Q == FULLDA)
t = 0; } }
/* If PCMZERROR is set to true, then we only need leading coefficients
when projecting polynomials of level k+1 or lower. */
if (t && PCMZERROR && r <= GVNFV + 1)
t = 0;
/* If it can be determined that the system of coefficients is
inconsistent ... we can stop with just the leading coeff! */
if (t) {
j = CLOCK();
S = COEFSYS(r,Ap1);
if (S == 1 || (Sp = SIMPLIFYSYSLIST(r-1,S,GVNA == NIL ? TRUE : GVNA.W)) == 1)
t = 0;
else {
QepcadCls Q; Word G;
for(t = 0; t == 0 && Sp != NIL; Sp = RED(Sp))
if ((G = SYSSOLVECAD(r-1,FIRST(Sp),GVNA == NIL ? TRUE : GVNA.W,GVVL,Q)) != NIL)
{
/* If there are finitely many solutions, add those points as projection
points. */
if (ISLIST(G)) {
for(Word Lp = G; Lp != NIL; Lp = RED(Lp)) {
/* ADD POINTS to PROJECTION POLS! */
Word X = NIL; /* List of all sample points up to and inluding FIRST(G) */
Word c = Q.GVPC;
for(Word I = LELTI(FIRST(Lp),INDX); I != NIL; I = RED(I))
{
c = LELTI(LELTI(c,CHILD),FIRST(I));
Word s = LELTI(c,SAMPLE);
X = COMP(ISPRIMIT(s) ? (LENGTH(s) > 3 ? FOURTH(s) : s) : s,X);
}
W = MPOLY(X,NIL,LIST1(LIST2(PT_NUL,A1)),PO_POINT,PO_KEEP);
P = COMP(W,P);
}
}
else
t = 1; /* Instead of adding all the other coeffs, better to add system! */
}
}
j = CLOCK() - j;
if (PCVERBOSE) {
SWRITE("Coef consistency check took "); IWRITE(j); SWRITE("ms\n");
if (!t)
SWRITE("Found system inconsistent for ");
else
SWRITE("Unable to determine consistency for ");
IPDWRITE(r,Ap1,GVVL);
SWRITE("\n");
}
}
/* Handle the rest of the coefficients as needed. */
i = 0;
while (t) {
Ap1 = PRED(Ap1); i++; L = PLDCF(Ap1);
t = 0;
if (Ap1 != 0)
if (!PCONST(r - 1,L))
if (!IPFZT(r - 1,Lh)) {
W = MPOLY(L,NIL,LIST1(LIST3(PO_LCO,i,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P);
Lh = COMP(L,Lh);
t = 1; } }
}
Step2: /* Obtain discriminants. */
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
if (LELTI(A1,PO_TYPE) == PO_POINT) continue;
if (PCEQC && LELTI(A1,PO_TYPE) != PO_ECON) continue;
Ap1 = LELTI(A1,PO_POLY);
if (PDEG(Ap1) >= 2) {
D = IPDSCRQE(r,Ap1);
W = MPOLY(D,NIL,LIST1(LIST4(PO_DIS,0,0,A1)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
Step3: /* Obtain resultants. */
Ap = A;
while (Ap != NIL) {
ADV(Ap,&A1,&Ap);
if (LELTI(A1,PO_TYPE) == PO_POINT) continue;
Ap1 = LELTI(A1,PO_POLY);
App = Ap;
while (App != NIL) {
ADV(App,&A2,&App);
if (LELTI(A2,PO_TYPE) == PO_POINT) continue;
if (PCEQC &&
LELTI(A1,PO_TYPE) != PO_ECON &&
LELTI(A2,PO_TYPE) != PO_ECON) continue;
Ap2 = LELTI(A2,PO_POLY);
R = IPRESQE(r,Ap1,Ap2);
W = MPOLY(R,NIL,LIST1(LIST6(PO_RES,0,0,A1,0,A2)),PO_OTHER,PO_KEEP);
P = COMP(W,P); } }
Step4: /* Finish. */
P = INV(P);
goto Return;
Return: /* Prepare for return. */
return(P);
}
/*
* Scheme interfaces
*/
static uim_lisp
notify_get_plugins_internal(void)
{
uim_lisp ret_;
DIR *dirp;
struct dirent *dp;
size_t plen, slen;
const uim_notify_desc *desc;
void *handle;
uim_notify_desc *(*desc_func)(void);
const char *str;
plen = sizeof(NOTIFY_PLUGIN_PREFIX);
slen = sizeof(NOTIFY_PLUGIN_SUFFIX);
desc = uim_notify_stderr_get_desc();
ret_ = CONS(LIST3(MAKE_SYM(desc->name),
MAKE_STR(desc->name),
MAKE_STR(desc->desc)),
uim_scm_null());
if (getenv("UIM_DISABLE_NOTIFY") != NULL)
return uim_scm_callf("reverse", "o", ret_);
dirp = opendir(NOTIFY_PLUGIN_PATH);
if (dirp) {
while ((dp = readdir(dirp)) != NULL) {
size_t len = strlen(dp->d_name);
char path[PATH_MAX];
if ((len < plen + slen - 1) ||
(PATH_MAX < (sizeof(NOTIFY_PLUGIN_PATH "/") + len)) ||
(strcmp(dp->d_name, NOTIFY_PLUGIN_PREFIX) <= 0) ||
(strcmp(dp->d_name + len + 1 - slen, NOTIFY_PLUGIN_SUFFIX) != 0))
continue;
snprintf(path, sizeof(path), "%s/%s", NOTIFY_PLUGIN_PATH, dp->d_name);
handle = dlopen(path, RTLD_NOW);
if ((str = dlerror()) != NULL) {
fprintf(stderr, "load failed %s(%s)\n", path, str);
continue;
}
desc_func = (uim_notify_desc *(*)(void))dlfunc(handle, "uim_notify_plugin_get_desc");
if (!desc_func) {
fprintf(stderr, "cannot found 'uim_notify_get_desc()' in %s\n", path);
dlclose(handle);
continue;
}
desc = desc_func();
ret_ = CONS(LIST3(MAKE_SYM(desc->name),
MAKE_STR(desc->name),
MAKE_STR(desc->desc)),
ret_);
dlclose(handle);
}
(void)closedir(dirp);
}
return uim_scm_callf("reverse", "o", ret_);
}
void EC1(Word c, Word L, Word Bs)
{
Word B,I,J,Lp,M,N,S,Sp,P,a,b,kp,l,r,rp,s,xb,xp,Lp1,OL;
/* hide kp,xp; */
Word T;
Step1: /* Initialize. */
S = NIL; Lp = L; kp = 1; xp = 0;
M = PMON(1,1); J = LIST2(0,0);
Step2: /* No real root. */
if (Lp != NIL) goto Step3;
a = CSSP(NIL,NIL);
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
SLELTI(c,CHILD,S);
goto Return;
Step3: /* First sector. */
ADV(Lp,&Lp1,&Lp);
FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r);
a = AFFRN(CSSP(NIL,l));
T = r;
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step4: /* First section. */
if (PDEG(B) == 1)
{ a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); }
else
{ a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); }
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
N = NIL;
for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); }
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S);
Step5: /* Check if there are more roots. */
if (Lp == NIL) goto Step9;
rp = r;
Step6: /* Next sector. */
ADV(Lp,&Lp1,&Lp);
FIRST3(Lp1,&B,&I,&OL); FIRST2(I,&l,&r);
a = AFFRN(CSSP(T,l));
T = r;
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step7: /* Next section. */
if (PDEG(B) == 1)
{ a = IUPRLP(B); a = AFFRN(a); b = LIST1(a); s = LIST3(M,J,b); }
else
{ a = AFGEN(); b = LIST1(a); s = LIST3(B,I,b); }
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
N = NIL;
for(Word X = OL; X != NIL; X = RED(X)) { N = COMP(LIST2(THIRD(LELTI(FIRST(X),PO_LABEL)),1),N); }
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,N); S = COMP(Sp,S);
Step8: /* Loop. */
goto Step5;
Step9: /* Last sector. */
a = AFFRN(CSSP(T,NIL));
b = LIST1(a); s = LIST3(M,J,b);
xp = xp + 1; xb = LIST1(xp);
P = LIST1(0);
Sp = MCELL(kp,NIL,FALSE,LELTI(c,TRUTH),s,xb,P,LELTI(c,HOWTV),NIL,NIL); S = COMP(Sp,S);
Step10: /* Finalize. */
S = INV(S); SLELTI(c,CHILD,S); goto Return;
Return: /* Prepare for return. */
return;
}
