Esempio n. 1
0
Word ADJ_2D1_COMPLETE(Word c, Word c_l, Word c_r, Word P, Word J)
{
       Word Sol,Sol1,Sol2;


Step1: /* Construct list of possible adjacency assignments. */
       if (LELTI(c,CHILD) == NIL) {
	 Sol = NIL;
	 goto Return; }
       if (LELTI(c_l,CHILD) == NIL)
	 Sol1 = LIST1(NIL);
       else
	 Sol1 = ADJ_2D1(c,c_l,P,J);
       if (LELTI(c_r,CHILD) == NIL)
	 Sol2 = LIST1(NIL);
       else
	 Sol2 = ADJ_2D1(c,c_r,P,J);

Step2: /* If assignment is not unique, decide which is correct. */
       if (LENGTH(Sol1) == 1 && LENGTH(Sol2) == 1)
	 Sol = CCONC(FIRST(Sol1),FIRST(Sol2));
       else
	 Sol = ACMADJ2D(c,c_l,c_r,P);
       Sol = LIST1(Sol);

Return: /* Prepare to return. */
       return Sol;
}
Esempio n. 2
0
File: HAP3.c Progetto: nilqed/qepcad
Word HAP3(Word U, Word w_l, Word B)
{
    Word Sol,u,I,w_u,r,c1,c2;

Step1: /* Initialization. */
    if (U == NIL) {
        Sol = LIST1(NIL);
        goto Return;
    }

    ADV(U,&u,&U);
    FIRST2(u,&I,&r);
    Sol = LIST1(LIST2(I,LIST2(B,AD2D_Infy)));

    while(U != NIL) {
        ADV(U,&u,&U);
        FIRST2(u,&I,&w_u);
        r = VECTOR_SUM(r,w_u);
        Sol = COMP(LIST2(I,LIST2(B,AD2D_Infy)),Sol);
    }
    while(r != NIL) {
        ADV(r,&c1,&r);
        ADV(w_l,&c2,&w_l);
        if (c1 != 0 && c2 == 0) {
            Sol = AD2D_FAIL;
            goto Return;
        }
    }
    Sol = LIST1(Sol);

Return: /* Prepare to return. */
    return Sol;
}
Esempio n. 3
0
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;      
}
Esempio n. 4
0
Word CF(Word L,Word F,Word P)
{
  Word Fp,A,Ap,f;

  switch(FIRST(F)) {
  case (TRUE)  : Fp = F; break;
  case (FALSE) : Fp = F; break;
  case (ANDOP) : 
    A = RED(F);
    for(Ap = NIL; A != NIL; A = RED(A)) {
      f = CF(L,FIRST(A),P);
      if (FIRST(f) == FALSE) {
	Fp = f;
	goto Return; }
      if (FIRST(f) != TRUE)
	Ap = COMP(f,Ap); }
    if (Ap == NIL)
      Fp = LIST1(TRUE);
    else if (LENGTH(Ap) == 1)
      Fp = FIRST(Ap);
    else
      Fp = COMP(ANDOP,Ap);
    break;
  case (OROP) :
    A = RED(F);
    for(Ap = NIL; A != NIL; A = RED(A)) {
      f = CF(L,FIRST(A),P);
      if (FIRST(f) == TRUE) {
	Fp = f;
	goto Return; }
      if (FIRST(f) != FALSE)
	Ap = COMP(f,Ap); }
    if (Ap == NIL)
      Fp = LIST1(FALSE);
    else if (LENGTH(Ap) == 1)
      Fp = FIRST(Ap);
    else
      Fp = COMP(OROP,Ap);
    break;
  default:
    f = UNIFORMTV(L,F,P);
    if (f == UNDET)
      Fp = F;
    else
      Fp = LIST1(f);
    break; }
Return:
  return Fp;
}
Esempio n. 5
0
Word QepcadCls::SFCFULLDf(Word D, Word P, Word J, Word n)
{
      Word t,SF,Dp,Pp,Lt,Lf,LA,Q,D1,P1,D0,P0,J0,i,Lp,pflag, L;
      char e,s,m,c;

Step1: /* Space is either empty or R^n. */
      t = DOPFSUFF_FULLD(P,LIST1(D));
      if (t == TRUE) {       
        SF = LIST1(TRUE);  /* CAD is identically TRUE. */
        goto Return; }
      else if (t == FALSE) {
        SF = LIST1(FALSE); /* CAD is identically FALSE. */
        goto Return; }

Step2: /* Extended language. */
      /* Dp,Pp are a simplified CAD for D,P (based only on full-dimensional cells!) */
      CCADCONmod(n,P,D,&Pp,&Dp); 
      Dp = PCAD2ESPCAD(P,Pp,Dp,NIL);

      /* Get list of all the true and false cells. */
      LTFOCALWTV(Dp,n,&Lt,&Lf);

      /* Filter out all but the full-dimensional true/false cells. */
      for(L = NIL; Lt != NIL; Lt = RED(Lt))
	if (LELTI(LELTI(FIRST(Lt),SC_REP),LEVEL) == CELLDIM(LELTI(FIRST(Lt),SC_REP)))
	  L = COMP(FIRST(Lt),L);
      Lt = L;
      for(L = NIL; Lf != NIL; Lf = RED(Lf))
	if (LELTI(LELTI(FIRST(Lf),SC_REP),LEVEL) == CELLDIM(LELTI(FIRST(Lf),SC_REP)))
	  L = COMP(FIRST(Lf),L);
      Lf = L;
	

      if (Lt == NIL && Lf == NIL) {
	SWRITE("No cells have truth values!\n");
	goto Return; }
      t = ESPCADDOPFSUFF(Pp,LIST1(Dp));
      LA = LISTOETAmod(Pp,n,t==NIL);

      /* Construct formula */
      SF = NECCONDS(Lt,Lf,LA,Pp); 
      SF = FMASORT(SF);
      SF = FMA_REMCONST(SF);
      SF = FMASMOOTH(SF);
      SF = FMAOPCOMBINE(SF);

 Return: /* Prepare to return. */
      return SF;
}
Esempio n. 6
0
void testSIimplOI(BDigit r, Word P, Word ZL, Word NZ, Word A)
{
  /* Compute generators A and all its 1st order partials */
  Word L = LIST1(A);
  for(int i = 1; i <= r; ++i)
  {
    Word D = IPDER(r,A,i);
    if (D != 0)
      L = COMP(D,L);
  } 
  L = CCONC(L,ZL);

  /* Compute a variable list for output purposes. */
  Word V = NIL;
  for(int i = r; i > 0; i--)
  {
    char s[2];
      s[0] = 'a' - 1 + i;
      s[1] = '\0';
      V = COMP(LFS(s),V);
  }

  /* Go through assumptions and find non-vanishing conditions. */
  Word M = NZ;
  SWRITE("Test si ==> oi: ");
  IPDWRITE(r,A,V);
  SWRITE("\n");
  GBTest(r,L,V);
}
Esempio n. 7
0
Word RMNOTOP(Word F)
{
       Word F1,Fb,Fp,Fp1,T;

Step1: /* Classify the formula v{F}. */
       T = FIRST(F);
       if (T == ANDOP) goto Step3;
       if (T == OROP) goto Step3;
       if (T == NOTOP) goto Step4;

Step2: /* Atomic Formula. */
       Fp = F; goto Return;

Step3: /* Conjunction/Disjunction. */
       Fb = RED(F); Fp = LIST1(T);
       while (Fb != NIL)
         {
         ADV(Fb,&F1,&Fb);
         Fp1 = RMNOTOP(F1);
         Fp = COMP(Fp1,Fp);
         }
       Fp = INV(Fp);
       goto Return;

Step4: /* Negation. */
       F1 = SECOND(F);
       Fp = RMNOTOPN(F1);
       goto Return;

Return: /* Prepare for return. */
       return(Fp);
}
Esempio n. 8
0
File: expat.c Progetto: DirtYiCE/uim
static void
xml_end_element_handler(void *userData, const XML_Char *name)
{
  uim_xml_userdata *data = (uim_xml_userdata *)userData;

  if (data && data->end_) {
    uim_scm_call(data->end_, LIST1(MAKE_STR(name)));
  }
}
Esempio n. 9
0
/* Projection point equal */
BDigit PRJPNTEQUAL(Word A, Word B)
{
  if (LENGTH(A) != LENGTH(B))
    return 0;

  /* Both primitive */
  Word a = FIRST(A), b = FIRST(B);
  if (ISPRIMIT(a) && ISPRIMIT(b)) {
    Word aC,aK,ac,bC,bK,bc;
    FIRST3(a,&aC,&aK,&ac);
    FIRST3(b,&bC,&bK,&bc);
    if (!EQUAL(aC,bC)) return 0;
    if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(aK,bK)) return 1;
    if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0;
    if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0;
    return EQUAL(ac,bc);
  }

  /* Both Not Primitive */
  if (!ISPRIMIT(a) && !ISPRIMIT(b)) {
    if (!PRJPNTEQUAL(LIST1(SECOND(A)),LIST1(SECOND(B)))) return 0;
    Word aC,aK,aM,aI,ac,bC,bK,G,Af,Bf;
    FIRST5(a,&aC,&aK,&aM,&aI,&ac);
    FIRST2(b,&bC,&bK);
    if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0;
    if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0;
    if (EQUAL(aC,bC)) return 1;
    AFUPGC(aM,aC,bC,&G,&Af,&Bf);
    if (PDEG(G) < 1) return 0;
    Word KL = LIST2(FIRST(aK),LIST2(1,1));
    Word KR = LIST2(SECOND(aK),LIST2(1,1));
    Word sL = AFSIGN(aM,aI,AFPEMV(1,aM,G,KL));
    Word sR = AFSIGN(aM,aI,AFPEMV(1,aM,G,KR));
    return EQUAL(KL,KR) && sL == 0 || sL == 1 && sR == -1 || sL == -1 && sR == 1;
  }

  /* One primitive, the other not */
  if (ISPRIMIT(a) != ISPRIMIT(b)) {
    SWRITE("This condition not implemented in PRJPNTEQUAL!\n");
    FAIL("PRJPNTEQUAL","Incomplete Implementation Error!");
  }

  return -1;
}
Esempio n. 10
0
void GBTest(Word r, Word L, Word N, Word Vp)
{
  if (LENGTH(Vp) < r) { SWRITE("Not enough variables in GBTest!\n"); }
  Word F = GVCAP->IPFACTGB(r,L,N);
  SWRITE("\nSYSTEM:\n"); PRINTCOEFFSYS(r,LIST1(L),Vp); SWRITE("\n");
  SWRITE("\nGB's:\n");
  PRINTCOEFFSYS(r,F,Vp);
  SWRITE("\n");
    
}
Esempio n. 11
0
void QepcadCls::PROJMCECCLOSURE(Word P, Word J, Word Q)
{
      Word N,k,Q_k,PP,NP,pp,L,l,i,S,s;

Step1: /* Initialization. */
      N = LENGTH(Q);

Step2: /* Loop from */
      for(k = N; k > 1; k--) {

	Q_k = LELTI(Q,k);
	SEPPIVNONPIV(Q_k,k,&PP,&NP);

	while (PP != NIL) {
	  ADV(PP,&pp,&PP);

Step3: /* Add necessary coefficients of pp. */
	  L = PFSUFFCOEF(pp,P,J);
	  while (L != NIL ) { 
	    ADV(L,&l,&L); 
	    i = SECOND(LELTI(l,PO_LABEL));
	    SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); }

Step4: /* Add factors of the discriminant of pp. */
	  if (PDEG(LELTI(pp,PO_POLY)) > 1) {
	    L = PFDISCRIM(pp,P,J);
	    while (L != NIL ) { 
	      ADV(L,&l,&L); 
	      i = SECOND(LELTI(l,PO_LABEL));
	      SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } }

Step5: /* Add resultants. */
	  for(S = CCONC(PP,NP); S != NIL; S = RED(S)) {
	    s = FIRST(S);
	    L = PFRES(pp,s,P,J);
	    while (L != NIL ) { 
	      ADV(L,&l,&L); 
	      i = SECOND(LELTI(l,PO_LABEL));
	      SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } } } }

Return:/* Return. */
      return;
}
Esempio n. 12
0
static uim_lisp
im_acquire_text(uim_lisp uc_, uim_lisp text_id_, uim_lisp origin_,
                uim_lisp former_len_, uim_lisp latter_len_)
{
    uim_context uc;
    int err, former_len, latter_len;
    enum UTextArea text_id;
    enum UTextOrigin origin;
    char *former, *latter, *cv_former, *cv_latter;
    uim_lisp former_, latter_;

    uc = retrieve_uim_context(uc_);

    if (!uc->acquire_text_cb)
        return uim_scm_f();

    text_id = C_INT(text_id_);
    origin = C_INT(origin_);
    former_len = C_INT(former_len_);
    latter_len = C_INT(latter_len_);

    err = uc->acquire_text_cb(uc->ptr, text_id, origin,
                              former_len, latter_len, &former, &latter);
    if (err)
        return uim_scm_f();

    /* FIXME: string->list is not applied here for each text part. This
     * interface should be revised when SigScheme has been introduced to
     * uim. Until then, perform character separation by each input methods if
     * needed.  -- YamaKen 2006-10-07 */
    cv_former = uc->conv_if->convert(uc->inbound_conv, former);
    cv_latter = uc->conv_if->convert(uc->inbound_conv, latter);
    free(former);
    free(latter);
    former_
        = (TEXT_EMPTYP(cv_former)) ? uim_scm_null() : LIST1(MAKE_STR_DIRECTLY(cv_former));
    latter_
        = (TEXT_EMPTYP(cv_latter)) ? uim_scm_null() : LIST1(MAKE_STR_DIRECTLY(cv_latter));

    return uim_scm_callf("ustr-new", "oo", former_, latter_);
}
Esempio n. 13
0
void IUPRWR(Word v, Word A, Word I)
{
       Word l,r;

Step1: /* Write. */
       SWRITE("the unique root of "); IPDWRITE(1,A,LIST1(v));
       FIRST2(I,&l,&r);
       SWRITE(" between "); RNWRITE(l); SWRITE(" and "); RNWRITE(r); 

Return: /* Prepare for return. */
       return;
}
Esempio n. 14
0
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;
}
Esempio n. 15
0
Word CELLSCPCELL(Word C, Word P, Word Ps)
{
      Word c,A,i,L,N,Ps_N,Lp,l,S,s,k,Z,r;

Step1: /* Initialize. */
      FIRST3(C,&c,&A,&i);
      if (A == NIL) {
	Lp = LIST1(c);
	goto Return; }
      L = CELLSCPCELL(A,P,Ps);
      N = LELTI(c,LEVEL);
      Ps_N = LELTI(Ps,N);

Step2: /* Loop over all the cells that form the projection of C. */
      Lp = NIL;
      while (L != NIL) {
	ADV(L,&l,&L);
	S = LELTI(l,CHILD);
	if (S == NIL) { Lp = COMP(l,Lp); }
	else {
  
Step3: /* Set s to the first child of l which lies in C. */
	  ADV(S,&s,&S);
	  for(k = 1; k < i; S = RED(S)) {
	    s = FIRST(S);
	    if ( EVEN(k) )
	      k++;
	    else {
	      Z = LPFZC(s,P);
	      if ( LPFSETINTERSECT(Z,Ps_N) != NIL )
		k++; } }

Step4: /* Continue adding cells from S until they no longer lie in C. */
	  if ( EVEN(i) )
	    Lp = COMP(s,Lp);
	  else {
	    Lp = COMP(s,Lp);
	    
	    while ( S != NIL ) {
	      ADV2(S,&s,&r,&S);
	      Z = LPFZC(s,P);
	      if ( LPFSETINTERSECT(Z,Ps_N) == NIL ) {
		Lp = COMP(s,Lp);
		Lp = COMP(r,Lp); }
	      else
		break; } } } }

Return: /* Return. */
      return (Lp);
}
Esempio n. 16
0
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;      
}
Esempio n. 17
0
File: expat.c Progetto: DirtYiCE/uim
static void
xml_characterdata_handler(void *userData, const XML_Char *s, int len)
{
  uim_xml_userdata *data = (uim_xml_userdata *)userData;

  char *str = uim_malloc(len + 1);

  memcpy(str, s, len);
  str[len] = '\0';

  if (data && data->characterdata_) {
    uim_scm_call(data->characterdata_, LIST1(MAKE_STR(str)));
  }

  free(str);
}
Esempio n. 18
0
void MODCRDB(Word b, Word S1, Word Ms, Word Ns, Word *b1_)
{
       Word b1;

Step1: /* Process. */
       if (PCDBUSE == 'n')
         {
         MODCR(b,S1,Ms,Ns,&b1);
         goto Return;
         }
       if (DBSRCH(DBMODCR,LIST4(b,S1,Ms,Ns)) == 0)
         {
         MODCR(b,S1,Ms,Ns,&b1);
         DBADD(DBMODCR,LIST4(b,S1,Ms,Ns),LIST1(b1),&DBMODCR);
         }
       else
         b1 = FIRST(DBINFO);
       goto Return;

Return: /* Prepare for return. */
       *b1_ = b1;
       return;
}
Esempio n. 19
0
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);
}
Esempio n. 20
0
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);
}
Esempio n. 21
0
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);
}
Esempio n. 22
0
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);
}
Esempio n. 23
0
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);
}
Esempio n. 24
0
Word sacMain()
{
  interval *A;
  Word P,t,L,n;

  SWRITE("Enter pol. in x: ");
  IPEXPREAD(1,LIST1(LFS("x")),&P,&t);
  CREAD();
  
  I = LBRIREAD();

 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(P,&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;



  HIPFES(PDEG(P),A,x);

  return 0;
}
Esempio n. 25
0
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;
}