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); }