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);
}
/*
* sac_to_gmp() assumes that the incoming integer really is a bignum and is
* not representable as a machine precision integer. If the argument sac is
* machine precision, the while loop becomes infinite (this is bad).
*
* On entry I also assume that the caller has initialized gmp_int.
*/
static void sac_to_gmp(mpz_ptr gmp_int, Word sac)
{
short set_neg_flag = -1; /* when set, this will be 0 or 1 */
MP_INT pwr, temp;
Word lsac, d;
#ifdef MP_DEBUG
fprintf(stderr, "sac_to_gmp: entering, the bignum here is ");
IWRITE(sac);printf("\n"); fflush(stderr);
#endif
if (ISATOM(sac)) {
if (sac < 0) {
set_neg_flag = 1;
sac = -sac;
}
else set_neg_flag = 0;
mpz_set_si(gmp_int, (int) sac);
if (set_neg_flag) mpz_neg(gmp_int, gmp_int);
return;
}
ADV(sac, &d, &lsac);
mpz_init(&pwr); mpz_set_si(&pwr, 1);
if (d != 0) {
set_neg_flag = (d < 0) ? 1 : 0;
if (set_neg_flag) d = -d;
}
mpz_set_si(gmp_int, d);
mpz_init(&temp);
while (!ISNIL(lsac)) {
mpz_mul_ui(&pwr, &pwr, BETA);
ADV(lsac, &d, &lsac);
if (d != 0) {
mpz_clear(&temp);
/* Argh!! We need to keep checking because we may have
had all leading zeroes to this point! */
if (set_neg_flag == -1) set_neg_flag = (d < 0) ? 1 : 0;
if (set_neg_flag) d = -d;
mpz_mul_ui(&temp, &pwr, d);
mpz_add(gmp_int, gmp_int, &temp);
}
}
if (set_neg_flag) mpz_neg(gmp_int, gmp_int);
#ifdef MP_DEBUG
fprintf(stderr,"sac_to_gmp: exiting\n");fflush(stderr);
#endif
return;
}
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;
}
Word SSILRCRI(Word a_, Word b_)
{
Word s,a,b,p,c,a1,a2,b1,b2,n,t,m,B,C,r;
Step0: /* Reflect interval if neccesary. */
if (RNSIGN(a_) == -1) {
s = 1; a = RNNEG(b_); b = RNNEG(a_); }
else {
s = 0; a = a_; b = b_; }
Step1: /* Initialize loop. */
RNFCL2(RNDIF(b,a),&p,&c);
if (p == c) p--;
FIRST2(b,&b1,&b2);
if (a == 0)
n = 0;
else {
FIRST2(a,&a1,&a2);
n = IQ(ITRUNC(a1,p),a2); }
Step2: /* Loop until n is even, then increment p and divide n by 2. */
do {
if (ISATOM(n)) t = ODD(n);
else t = ODD(FIRST(n));
p++;
n = IDP2(n,1);
}while(t);
m = ISUM(n,1);
Step3: /* If p is smallest possible, i.e. p = c, check (m+1)2^p > b. */
if (p == c) {
if (p >= 0) {
B = b1;
C = IMP2(IPROD(b2,m),p); }
else {
B = IMP2(b1,-p);
C = IPROD(b2,m); }
if (ICOMP(B,C) >= 1)
goto Step2; }
Return: /* Return, reflecting the output interval if needed. */
if (s) { r = n; n = -m; m = -r; }
return (LIST2(LBRNFIE(n,p),LBRNFIE(m,p)));
}
void PCADWRITE(Word Cs, Word Ps)
{
Word C,l,i,L,k,I;
Step1: /* */
I = PCADCINDEX(Cs);
l = LENGTH(I);
L = LELTI(Cs,SC_CDTV);
Step2: /* */
SWRITE("\n");
for(k = 0; k < l; k++)
SWRITE(" ");
OWRITE(I);
Step3: /* */
SWRITE(":");
SIGNLWR(PCADCSV(Cs,Ps));
Step4: /* */
if (ISATOM(L)) {
if (L == 0)
SWRITE(":F");
else if (L == 1)
SWRITE(":T");
else
SWRITE(":?"); }
else {
SWRITE(":==>");
while (L != NIL) {
PCADWRITE(FIRST(L),Ps);
L = RED(L); } }
Return: /* */
if (I == NIL) SWRITE("\n");
return;
}
bool bpx_is_atom(TERM t)
{
XDEREF(t);
return ISATOM(t);
}
