[BACK]Return to C.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / engine

Diff for /OpenXM_contrib2/asir2000/engine/C.c between version 1.3 and 1.15

version 1.3, 2000/08/22 05:04:03 version 1.15, 2018/03/29 01:32:51
Line 45 
Line 45 
  * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,   * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
  * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.   * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
  *   *
  * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.2 2000/08/21 08:31:24 noro Exp $   * $OpenXM: OpenXM_contrib2/asir2000/engine/C.c,v 1.14 2003/01/16 00:33:28 noro Exp $
 */  */
 #include "ca.h"  #include "ca.h"
 #include "inline.h"  #include "inline.h"
Line 54 
Line 54 
 V up_var;  V up_var;
   
 /* binary has at least 32 leading 0 chars. */  /* binary has at least 32 leading 0 chars. */
 void binaryton(binary,np)  void binaryton(char *binary,N *np)
 char *binary;  
 N *np;  
 {  {
         int i,w,len;    int i,w,len;
         N n;    N n;
         char buf[33];    char buf[33];
   
         binary += strlen(binary)%32;    binary += strlen(binary)%32;
         len = strlen(binary);    len = strlen(binary);
         w = len/32; /* sufficient for holding binary */    w = len/32; /* sufficient for holding binary */
         n = NALLOC(w);    n = NALLOC(w);
         for ( i = 0; i < w; i++ ) {    for ( i = 0; i < w; i++ ) {
                 strncpy(buf,binary+len-32*(i+1),32); buf[32] = 0;      strncpy(buf,binary+len-32*(i+1),32); buf[32] = 0;
                 n->b[i] = strtoul(buf,0,2);      n->b[i] = strtoul(buf,0,2);
         }    }
         for ( i = w-1; i >= 0 && !n->b[i]; i-- );    for ( i = w-1; i >= 0 && !n->b[i]; i-- );
         if ( i < 0 )    if ( i < 0 )
                 *np = 0;      *np = 0;
         else {    else {
                 n->p = i+1;      n->p = i+1;
                 *np = n;      *np = n;
         }    }
 }  }
   
 /* hex has at least 8 leading 0 chars. */  /* hex has at least 8 leading 0 chars. */
 void hexton(hex,np)  void hexton(char *hex,N *np)
 char *hex;  
 N *np;  
 {  {
         int i,w,len;    int i,w,len;
         N n;    N n;
         char buf[9];    char buf[9];
   
         hex += strlen(hex)%8;    hex += strlen(hex)%8;
         len = strlen(hex);    len = strlen(hex);
         w = len/8; /* sufficient for holding hex */    w = len/8; /* sufficient for holding hex */
         n = NALLOC(w);    n = NALLOC(w);
         for ( i = 0; i < w; i++ ) {    for ( i = 0; i < w; i++ ) {
                 strncpy(buf,hex+len-8*(i+1),8); buf[8] = 0;      strncpy(buf,hex+len-8*(i+1),8); buf[8] = 0;
                 n->b[i] = strtoul(buf,0,16);      n->b[i] = strtoul(buf,0,16);
         }    }
         for ( i = w-1; i >= 0 && !n->b[i]; i-- );    for ( i = w-1; i >= 0 && !n->b[i]; i-- );
         if ( i < 0 )    if ( i < 0 )
                 *np = 0;      *np = 0;
         else {    else {
                 n->p = i+1;      n->p = i+1;
                 *np = n;      *np = n;
         }    }
 }  }
   
 void ntobn(base,n,nrp)  void ntobn(int base,N n,N *nrp)
 int base;  
 N n,*nrp;  
 {  {
         int i,d,plc;    int i,d,plc;
         unsigned int *c,*x,*w;    unsigned int *c,*x,*w;
         unsigned int r;    unsigned int r;
         L m;    L m;
         N nr;    N nr;
   
         if ( !n ) {    if ( !n ) {
                 *nrp = NULL;      *nrp = NULL;
                 return;      return;
         }    }
   
         d = PL(n);    d = PL(n);
         w = BD(n);    w = BD(n);
   
         for ( i = 1, m = 1; m <= LBASE/(L)base; m *= base, i++ );    for ( i = 1, m = 1; m <= LBASE/(L)base; m *= base, i++ );
   
         c = (unsigned int *)W_ALLOC(d*i+1);    c = (unsigned int *)W_ALLOC(d*i+1);
         x = (unsigned int *)W_ALLOC(d+1);    x = (unsigned int *)W_ALLOC(d+1);
         for ( i = 0; i < d; i++ )    for ( i = 0; i < d; i++ )
                 x[i] = w[i];      x[i] = w[i];
         for ( plc = 0; d >= 1; plc++ ) {    for ( plc = 0; d >= 1; plc++ ) {
                 for ( i = d - 1, r = 0; i >= 0; i-- ) {      for ( i = d - 1, r = 0; i >= 0; i-- ) {
                         DSAB((unsigned int)base,r,x[i],x[i],r)        DSAB((unsigned int)base,r,x[i],x[i],r)
                 }      }
                 c[plc] = r;      c[plc] = r;
                 if ( !x[d-1] ) d--;      if ( !x[d-1] ) d--;
         }    }
   
         *nrp = nr = NALLOC(plc); INITRC(nr);    *nrp = nr = NALLOC(plc); INITRC(nr);
         PL(nr) = plc;    PL(nr) = plc;
         for ( i = 0; i < plc; i++ )    for ( i = 0; i < plc; i++ )
                 BD(nr)[i] = c[i];      BD(nr)[i] = c[i];
 }  }
   
 void bnton(base,n,nrp)  void bnton(int base,N n,N *nrp)
 int base;  
 N n,*nrp;  
 {  {
         unsigned int carry;    unsigned int carry;
         unsigned int *x,*w;    unsigned int *x,*w;
         int i,j,d,plc;    int i,j,d,plc;
         N nr;    N nr;
   
         if ( !n ) {    if ( !n ) {
                 *nrp = 0;      *nrp = 0;
                 return;      return;
         }    }
   
         d = PL(n);    d = PL(n);
         w = BD(n);    w = BD(n);
         x = (unsigned int *)W_ALLOC(d + 1);    x = (unsigned int *)W_ALLOC(d + 1);
   
         for ( plc = 0, i = d - 1; i >= 0; i-- ) {    for ( plc = 0, i = d - 1; i >= 0; i-- ) {
                 for ( carry = w[i],j = 0; j < plc; j++ ) {      for ( carry = w[i],j = 0; j < plc; j++ ) {
                         DMA(x[j],(unsigned int)base,carry,carry,x[j])        DMA(x[j],(unsigned int)base,carry,carry,x[j])
                 }      }
                 if ( carry ) x[plc++] = carry;      if ( carry ) x[plc++] = carry;
         }    }
         *nrp = nr = NALLOC(plc); INITRC(nr);    *nrp = nr = NALLOC(plc); INITRC(nr);
         PL(nr) = plc;    PL(nr) = plc;
         for ( i = 0; i < plc; i++ )    for ( i = 0; i < plc; i++ )
                 BD(nr)[i] = x[i];      BD(nr)[i] = x[i];
 }  }
   
 void ptomp(m,p,pr)  void ptomp(int m,P p,P *pr)
 int m;  
 P p;  
 P *pr;  
 {  {
         DCP dc,dcr,dcr0;    DCP dc,dcr,dcr0;
         Q q;    Q q;
         unsigned int a,b;    unsigned int a,b;
         P t;    P t;
         MQ s;    MQ s;
   
         if ( !p )    if ( !p )
                 *pr = 0;      *pr = 0;
         else if ( NUM(p) ) {    else if ( NUM(p) ) {
                 q = (Q)p;      q = (Q)p;
                 a = rem(NM(q),m);      a = rem(NM(q),m);
                 if ( a && (SGN(q) < 0) )      if ( a && (SGN(q) < 0) )
                         a = m-a;        a = m-a;
                 b = !DN(q)?1:rem(DN(q),m);      b = !DN(q)?1:rem(DN(q),m);
                 if ( !b )      if ( !b )
                         error("ptomp : denominator = 0");        error("ptomp : denominator = 0");
                 a = dmar(a,invm(b,m),0,m); STOMQ(a,s); *pr = (P)s;      a = dmar(a,invm(b,m),0,m); STOMQ(a,s); *pr = (P)s;
         } else {    } else {
                 for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {      for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                         ptomp(m,COEF(dc),&t);        ptomp(m,COEF(dc),&t);
                         if ( t ) {        if ( t ) {
                                 NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;          NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                         }        }
                 }      }
                 if ( !dcr0 )      if ( !dcr0 )
                         *pr = 0;        *pr = 0;
                 else {      else {
                         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);        NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
                 }      }
         }    }
 }  }
   
 void mptop(f,gp)  void mptop(P f,P *gp)
 P f;  
 P *gp;  
 {  {
         DCP dc,dcr,dcr0;    DCP dc,dcr,dcr0;
         Q q;    Q q;
   
         if ( !f )    if ( !f )
                 *gp = 0;      *gp = 0;
         else if ( NUM(f) )    else if ( NUM(f) )
                 STOQ(CONT((MQ)f),q),*gp = (P)q;      STOQ(CONT((MQ)f),q),*gp = (P)q;
         else {    else {
                 for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {      for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
                         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); mptop(COEF(dc),&COEF(dcr));        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); mptop(COEF(dc),&COEF(dcr));
                 }      }
                 NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);      NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
         }    }
 }  }
   
 void ptolmp(p,pr)  void ptosfp(P p,P *pr)
 P p;  
 P *pr;  
 {  {
         DCP dc,dcr,dcr0;    DCP dc,dcr,dcr0;
         LM a;    GFS a;
         P t;    P t;
   
         if ( !p )    if ( !p )
                 *pr = 0;      *pr = 0;
         else if ( NUM(p) ) {    else if ( NUM(p) ) {
                 qtolm((Q)p,&a); *pr = (P)a;      if ( NID((Num)p) == N_GFS )
         } else {        *pr = (P)p;
                 for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {      else {
                         ptolmp(COEF(dc),&t);        qtogfs((Q)p,&a); *pr = (P)a;
                         if ( t ) {      }
                                 NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;    } else {
                         }      for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                 }        ptosfp(COEF(dc),&t);
                 if ( !dcr0 )        if ( t ) {
                         *pr = 0;          NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                 else {        }
                         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);      }
                 }      if ( !dcr0 )
         }        *pr = 0;
       else {
         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
       }
     }
 }  }
   
 void lmptop(f,gp)  void sfptop(P f,P *gp)
 P f;  
 P *gp;  
 {  {
         DCP dc,dcr,dcr0;    DCP dc,dcr,dcr0;
         Q q;    Q q;
     MQ fq;
   
         if ( !f )    if ( !f )
                 *gp = 0;      *gp = 0;
         else if ( NUM(f) ) {    else if ( NUM(f) ) {
                 NTOQ(((LM)f)->body,1,q); *gp = (P)q;      gfstomq((GFS)f,&fq);
         } else {      STOQ(CONT(fq),q);
                 for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {      *gp = (P)q;
                         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); lmptop(COEF(dc),&COEF(dcr));    } else {
                 }      for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
                 NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); sfptop(COEF(dc),&COEF(dcr));
         }      }
       NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
     }
 }  }
   
 void ptoum(m,f,wf)  void sfptopsfp(P f,V v,P *gp)
 int m;  
 P f;  
 UM wf;  
 {  {
         unsigned int r;    DCP dc,dcr,dcr0;
         int i;    Q q;
         DCP dc;    P fq;
   
         for ( i = UDEG(f); i >= 0; i-- )    if ( !f )
                 COEF(wf)[i] = 0;      *gp = 0;
     else if ( NUM(f) )
       gfstopgfs((GFS)f,v,gp);
     else {
       for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
         sfptopsfp(COEF(dc),v,&COEF(dcr));
       }
       NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
     }
   }
   
         for ( dc = DC(f); dc; dc = NEXT(dc) ) {  void sf_galois_action(P p,Q e,P *pr)
                 r = rem(NM((Q)COEF(dc)),m);  {
                 if ( r && (SGN((Q)COEF(dc)) < 0) )    DCP dc,dcr,dcr0;
                         r = m-r;    GFS a;
                 COEF(wf)[QTOS(DEG(dc))] = r;    P t;
         }  
         degum(wf,UDEG(f));    if ( !p )
       *pr = 0;
     else if ( NUM(p) ) {
       gfs_galois_action((GFS)p,e,&a); *pr = (P)a;
     } else {
       for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
         sf_galois_action(COEF(dc),e,&t);
         if ( t ) {
           NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
         }
       }
       if ( !dcr0 )
         *pr = 0;
       else {
         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
       }
     }
 }  }
   
 void umtop(v,w,f)  /* GF(pn)={0,1,a,a^2,...} -> GF(pm)={0,1,b,b^2,..} ; a -> b^k */
 V v;  
 UM w;  void sf_embed(P p,int k,int pm,P *pr)
 P *f;  
 {  {
         int *c;    DCP dc,dcr,dcr0;
         DCP dc,dc0;    GFS a;
         int i;    P t;
         Q q;  
   
         if ( DEG(w) < 0 )    if ( !p )
                 *f = 0;      *pr = 0;
         else if ( DEG(w) == 0 )    else if ( NUM(p) ) {
                 STOQ(COEF(w)[0],q), *f = (P)q;      gfs_embed((GFS)p,k,pm,&a); *pr = (P)a;
         else {    } else {
                 for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )      for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                         if ( c[i] ) {        sf_embed(COEF(dc),k,pm,&t);
                                 NEXTDC(dc0,dc);        if ( t ) {
                                 STOQ(i,DEG(dc));          NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                                 STOQ(c[i],q), COEF(dc) = (P)q;        }
                         }      }
                 NEXT(dc) = 0;      if ( !dcr0 )
                 MKP(v,dc0,*f);        *pr = 0;
         }      else {
         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
       }
     }
 }  }
   
 void ptoup(n,nr)  void ptolmp(P p,P *pr)
 P n;  
 UP *nr;  
 {  {
         DCP dc;    DCP dc,dcr,dcr0;
         UP r;    LM a;
         int d;    P t;
   
         if ( !n )    if ( !p )
                 *nr = 0;      *pr = 0;
         else if ( OID(n) == O_N ) {    else if ( NUM(p) ) {
                 *nr = r = UPALLOC(0);      qtolm((Q)p,&a); *pr = (P)a;
                 DEG(r) = 0; COEF(r)[0] = (Num)n;    } else {
         } else {      for ( dc = DC(p), dcr0 = 0; dc; dc = NEXT(dc) ) {
                 d = UDEG(n);        ptolmp(COEF(dc),&t);
                 up_var = VR(n);        if ( t ) {
                 *nr = r = UPALLOC(d); DEG(r) = d;          NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
                 for ( dc = DC(n); dc; dc = NEXT(dc) ) {        }
                         COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);      }
                 }      if ( !dcr0 )
         }        *pr = 0;
       else {
         NEXT(dcr) = 0; MKP(VR(p),dcr0,*pr);
       }
     }
 }  }
   
   void lmptop(P f,P *gp)
   {
     DCP dc,dcr,dcr0;
     Q q;
   
 void uptop(n,nr)    if ( !f )
 UP n;      *gp = 0;
 P *nr;    else if ( NUM(f) ) {
       NTOQ(((LM)f)->body,1,q); *gp = (P)q;
     } else {
       for ( dc = DC(f), dcr0 = 0; dc; dc = NEXT(dc) ) {
         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); lmptop(COEF(dc),&COEF(dcr));
       }
       NEXT(dcr) = 0; MKP(VR(f),dcr0,*gp);
     }
   }
   
   void ptoum(int m,P f,UM wf)
 {  {
         int i;    unsigned int r;
         DCP dc0,dc;    int i;
     DCP dc;
   
         if ( !n )    for ( i = UDEG(f); i >= 0; i-- )
                 *nr = 0;      COEF(wf)[i] = 0;
         else if ( !DEG(n) )  
                 *nr = (P)COEF(n)[0];    for ( dc = DC(f); dc; dc = NEXT(dc) ) {
         else {      r = rem(NM((Q)COEF(dc)),m);
                 for ( i = DEG(n), dc0 = 0; i >= 0; i-- )      if ( r && (SGN((Q)COEF(dc)) < 0) )
                         if ( COEF(n)[i] ) {        r = m-r;
                                 NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];      COEF(wf)[QTOS(DEG(dc))] = r;
                         }    }
                 if ( !up_var )    degum(wf,UDEG(f));
                         up_var = CO->v;  
                 MKP(up_var,dc0,*nr);  
         }  
 }  }
   
 void ulmptoum(m,f,wf)  void umtop(V v,UM w,P *f)
 int m;  
 UP f;  
 UM wf;  
 {  {
         int i,d;    int *c;
         LM *c;    DCP dc,dc0;
     int i;
     Q q;
   
         if ( !f )    if ( DEG(w) < 0 )
                 wf->d = -1;      *f = 0;
         else {    else if ( DEG(w) == 0 )
                 wf->d = d = f->d;      STOQ(COEF(w)[0],q), *f = (P)q;
                 c = (LM *)f->c;    else {
                 for ( i = 0, d = f->d; i <= d; i++ )      for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
                         COEF(wf)[i] = rem(c[i]->body,m);        if ( c[i] ) {
         }          NEXTDC(dc0,dc);
           STOQ(i,DEG(dc));
           STOQ(c[i],q), COEF(dc) = (P)q;
         }
       NEXT(dc) = 0;
       MKP(v,dc0,*f);
     }
 }  }
   
 void objtobobj(base,p,rp)  void ptosfum(P f,UM wf)
 int base;  
 Obj p;  
 Obj *rp;  
 {  {
         if ( !p )    GFS c;
                 *rp = 0;    int i;
         else    DCP dc;
                 switch ( OID(p) ) {  
                         case O_N:    if ( OID(f) == O_N ) {
                                 numtobnum(base,(Num)p,(Num *)rp); break;      DEG(wf) = 0;
                         case O_P:      ntogfs((Obj)f,&c);
                                 ptobp(base,(P)p,(P *)rp); break;      COEF(wf)[0] = FTOIF(CONT(c));
                         case O_LIST:      return;
                                 listtoblist(base,(LIST)p,(LIST *)rp); break;    }
                         case O_VECT:  
                                 vecttobvect(base,(VECT)p,(VECT *)rp); break;    for ( i = UDEG(f); i >= 0; i-- )
                         case O_MAT:      COEF(wf)[i] = 0;
                                 mattobmat(base,(MAT)p,(MAT *)rp); break;  
                         case O_STR:    for ( dc = DC(f); dc; dc = NEXT(dc) ) {
                                 *rp = p; break;      ntogfs((Obj)COEF(dc),&c);
                         case O_COMP: default:      if ( c )
                                 error("objtobobj : not implemented"); break;        COEF(wf)[QTOS(DEG(dc))] = FTOIF(CONT(c));
                 }    }
     degum(wf,UDEG(f));
 }  }
   
 void bobjtoobj(base,p,rp)  void sfumtop(V v,UM w,P *f)
 int base;  
 Obj p;  
 Obj *rp;  
 {  {
         if ( !p )    int *c;
                 *rp = 0;    DCP dc,dc0;
         else    int i,t;
                 switch ( OID(p) ) {    GFS q;
                         case O_N:  
                                 bnumtonum(base,(Num)p,(Num *)rp); break;    if ( DEG(w) < 0 )
                         case O_P:      *f = 0;
                                 bptop(base,(P)p,(P *)rp); break;    else if ( DEG(w) == 0 ) {
                         case O_LIST:      t = COEF(w)[0];
                                 blisttolist(base,(LIST)p,(LIST *)rp); break;      t = IFTOF(t);
                         case O_VECT:      MKGFS(t,q);
                                 bvecttovect(base,(VECT)p,(VECT *)rp); break;      *f = (P)q;
                         case O_MAT:    } else {
                                 bmattomat(base,(MAT)p,(MAT *)rp); break;      for ( i = DEG(w), c = COEF(w), dc0 = 0; i >= 0; i-- )
                         case O_STR:        if ( c[i] ) {
                                 *rp = p; break;          NEXTDC(dc0,dc);
                         case O_COMP: default:          STOQ(i,DEG(dc));
                                 error("bobjtoobj : not implemented"); break;          t = COEF(w)[i];
                 }          t = IFTOF(t);
           MKGFS(t,q);
           COEF(dc) = (P)q;
         }
       NEXT(dc) = 0;
       MKP(v,dc0,*f);
     }
 }  }
   
 void numtobnum(base,p,rp)  void ptoup(P n,UP *nr)
 int base;  
 Num p;  
 Num *rp;  
 {  {
         N nm,dn,body;    DCP dc;
         Q q;    UP r;
         LM l;    int d;
   
         if ( !p )    if ( !n )
                 *rp = 0;      *nr = 0;
         else    else if ( OID(n) == O_N ) {
                 switch ( NID(p) ) {      *nr = r = UPALLOC(0);
                         case N_Q:      DEG(r) = 0; COEF(r)[0] = (Num)n;
                                 ntobn(base,NM((Q)p),&nm);    } else {
                                 if ( DN((Q)p) ) {      d = UDEG(n);
                                         ntobn(base,DN((Q)p),&dn);      up_var = VR(n);
                                         NDTOQ(nm,dn,SGN((Q)p),q);      *nr = r = UPALLOC(d); DEG(r) = d;
                                 } else      for ( dc = DC(n); dc; dc = NEXT(dc) ) {
                                         NTOQ(nm,SGN((Q)p),q);        COEF(r)[QTOS(DEG(dc))] = (Num)COEF(dc);
                                 *rp = (Num)q;      }
                                 break;    }
                         case N_R:  
                                 *rp = p; break;  
                         case N_LM:  
                                 ntobn(base,((LM)p)->body,&body);  
                                 MKLM(body,l); *rp = (Num)l;  
                                 break;  
                         default:  
                                 error("numtobnum : not implemented"); break;  
                 }  
 }  }
   
 void bnumtonum(base,p,rp)  void uptop(UP n,P *nr)
 int base;  
 Num p;  
 Num *rp;  
 {  {
         N nm,dn,body;    int i;
         Q q;    DCP dc0,dc;
         LM l;  
   
         if ( !p )    if ( !n )
                 *rp = 0;      *nr = 0;
         else    else if ( !DEG(n) )
                 switch ( NID(p) ) {      *nr = (P)COEF(n)[0];
                         case N_Q:    else {
                                 bnton(base,NM((Q)p),&nm);      for ( i = DEG(n), dc0 = 0; i >= 0; i-- )
                                 if ( DN((Q)p) ) {        if ( COEF(n)[i] ) {
                                         bnton(base,DN((Q)p),&dn);          NEXTDC(dc0,dc); STOQ(i,DEG(dc)); COEF(dc) = (P)COEF(n)[i];
                                         NDTOQ(nm,dn,SGN((Q)p),q);        }
                                 } else      if ( !up_var )
                                         NTOQ(nm,SGN((Q)p),q);        up_var = CO->v;
                                 *rp = (Num)q;      MKP(up_var,dc0,*nr);
                                 break;    }
                         case N_R:  
                                 *rp = p; break;  
                         case N_LM:  
                                 bnton(base,((LM)p)->body,&body);  
                                 MKLM(body,l); *rp = (Num)l;  
                                 break;  
                         default:  
                                 error("bnumtonum : not implemented"); break;  
                 }  
 }  }
   
 void ptobp(base,p,rp)  void ulmptoum(int m,UP f,UM wf)
 int base;  
 P p;  
 P *rp;  
 {  {
         DCP dcr0,dcr,dc;    int i,d;
     LM *c;
   
         if ( !p )    if ( !f )
                 *rp = p;      wf->d = -1;
         else {    else {
                 for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {      wf->d = d = f->d;
                         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);      c = (LM *)f->c;
                         objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));      for ( i = 0, d = f->d; i <= d; i++ )
                 }        COEF(wf)[i] = rem(c[i]->body,m);
                 NEXT(dcr) = 0;    }
                 MKP(VR(p),dcr0,*rp);  
         }  
 }  }
   
 void bptop(base,p,rp)  void objtobobj(int base,Obj p,Obj *rp)
 int base;  
 P p;  
 P *rp;  
 {  {
         DCP dcr0,dcr,dc;    if ( !p )
       *rp = 0;
     else
       switch ( OID(p) ) {
         case O_N:
           numtobnum(base,(Num)p,(Num *)rp); break;
         case O_P:
           ptobp(base,(P)p,(P *)rp); break;
         case O_LIST:
           listtoblist(base,(LIST)p,(LIST *)rp); break;
         case O_VECT:
           vecttobvect(base,(VECT)p,(VECT *)rp); break;
         case O_MAT:
           mattobmat(base,(MAT)p,(MAT *)rp); break;
         case O_STR:
           *rp = p; break;
         case O_COMP: default:
           error("objtobobj : not implemented"); break;
       }
   }
   
         if ( !p )  void bobjtoobj(int base,Obj p,Obj *rp)
                 *rp = p;  {
         else {    if ( !p )
                 for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {      *rp = 0;
                         NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);    else
                         bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));      switch ( OID(p) ) {
                 }        case O_N:
                 NEXT(dcr) = 0;          bnumtonum(base,(Num)p,(Num *)rp); break;
                 MKP(VR(p),dcr0,*rp);        case O_P:
         }          bptop(base,(P)p,(P *)rp); break;
         case O_LIST:
           blisttolist(base,(LIST)p,(LIST *)rp); break;
         case O_VECT:
           bvecttovect(base,(VECT)p,(VECT *)rp); break;
         case O_MAT:
           bmattomat(base,(MAT)p,(MAT *)rp); break;
         case O_STR:
           *rp = p; break;
         case O_COMP: default:
           error("bobjtoobj : not implemented"); break;
       }
 }  }
   
 void listtoblist(base,p,rp)  void numtobnum(int base,Num p,Num *rp)
 int base;  
 LIST p;  
 LIST *rp;  
 {  {
         NODE nr0,nr,n;    N nm,dn,body;
     Q q;
     LM l;
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = 0;
         else {    else
                 for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {      switch ( NID(p) ) {
                         NEXTNODE(nr0,nr);        case N_Q:
                         objtobobj(base,BDY(n),(Obj *)&BDY(nr));          ntobn(base,NM((Q)p),&nm);
                 }          if ( DN((Q)p) ) {
                 NEXT(nr) = 0;            ntobn(base,DN((Q)p),&dn);
                 MKLIST(*rp,nr0);            NDTOQ(nm,dn,SGN((Q)p),q);
         }          } else
             NTOQ(nm,SGN((Q)p),q);
           *rp = (Num)q;
           break;
         case N_R:
           *rp = p; break;
         case N_LM:
           ntobn(base,((LM)p)->body,&body);
           MKLM(body,l); *rp = (Num)l;
           break;
         default:
           error("numtobnum : not implemented"); break;
       }
 }  }
   
 void blisttolist(base,p,rp)  void bnumtonum(int base,Num p,Num *rp)
 int base;  
 LIST p;  
 LIST *rp;  
 {  {
         NODE nr0,nr,n;    N nm,dn,body;
     Q q;
     LM l;
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = 0;
         else {    else
                 for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {      switch ( NID(p) ) {
                         NEXTNODE(nr0,nr);        case N_Q:
                         bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));          bnton(base,NM((Q)p),&nm);
                 }          if ( DN((Q)p) ) {
                 NEXT(nr) = 0;            bnton(base,DN((Q)p),&dn);
                 MKLIST(*rp,nr0);            NDTOQ(nm,dn,SGN((Q)p),q);
         }          } else
             NTOQ(nm,SGN((Q)p),q);
           *rp = (Num)q;
           break;
         case N_R:
           *rp = p; break;
         case N_LM:
           bnton(base,((LM)p)->body,&body);
           MKLM(body,l); *rp = (Num)l;
           break;
         default:
           error("bnumtonum : not implemented"); break;
       }
 }  }
   
 void vecttobvect(base,p,rp)  void ptobp(int base,P p,P *rp)
 int base;  
 VECT p;  
 VECT *rp;  
 {  {
         int i,l;    DCP dcr0,dcr,dc;
         VECT r;  
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = p;
         else {    else {
                 l = p->len;      for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
                 MKVECT(r,l); *rp = r;        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
                 for ( i = 0; i < l; i++ )        objtobobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
                         objtobobj(base,p->body[i],(Obj *)&r->body[i]);      }
         }      NEXT(dcr) = 0;
       MKP(VR(p),dcr0,*rp);
     }
 }  }
   
 void bvecttovect(base,p,rp)  void bptop(int base,P p,P *rp)
 int base;  
 VECT p;  
 VECT *rp;  
 {  {
         int i,l;    DCP dcr0,dcr,dc;
         VECT r;  
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = p;
         else {    else {
                 l = p->len;      for ( dcr0 = 0, dc = DC(p); dc; dc = NEXT(dc) ) {
                 MKVECT(r,l); *rp = r;        NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc);
                 for ( i = 0; i < l; i++ )        bobjtoobj(base,(Obj)COEF(dc),(Obj *)&COEF(dcr));
                         bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);      }
         }      NEXT(dcr) = 0;
       MKP(VR(p),dcr0,*rp);
     }
 }  }
   
 void mattobmat(base,p,rp)  void listtoblist(int base,LIST p,LIST *rp)
 int base;  
 MAT p;  
 MAT *rp;  
 {  {
         int row,col,i,j;    NODE nr0,nr,n;
         MAT r;  
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = p;
         else {    else {
                 row = p->row; col = p->col;      for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
                 MKMAT(r,row,col); *rp = r;        NEXTNODE(nr0,nr);
                 for ( i = 0; i < row; i++ )        objtobobj(base,BDY(n),(Obj *)&BDY(nr));
                         for ( j = 0; i < col; j++ )      }
                         objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);      NEXT(nr) = 0;
         }      MKLIST(*rp,nr0);
     }
 }  }
   
 void bmattomat(base,p,rp)  void blisttolist(int base,LIST p,LIST *rp)
 int base;  
 MAT p;  
 MAT *rp;  
 {  {
         int row,col,i,j;    NODE nr0,nr,n;
         MAT r;  
   
         if ( !p )    if ( !p )
                 *rp = p;      *rp = p;
         else {    else {
                 row = p->row; col = p->col;      for ( nr0 = 0, n = BDY(p); n; n = NEXT(n) ) {
                 MKMAT(r,row,col); *rp = r;        NEXTNODE(nr0,nr);
                 for ( i = 0; i < row; i++ )        bobjtoobj(base,BDY(n),(Obj *)&BDY(nr));
                         for ( j = 0; i < col; j++ )      }
                         bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);      NEXT(nr) = 0;
         }      MKLIST(*rp,nr0);
     }
 }  }
   
 void n32ton27(g,rp)  void vecttobvect(int base,VECT p,VECT *rp)
 N g;  
 N *rp;  
 {  {
         int i,j,k,l,r,bits,words;    int i,l;
         unsigned int t;    VECT r;
         unsigned int *a,*b;  
         N z;  
   
         l = PL(g); a = BD(g);    if ( !p )
         for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );      *rp = p;
         bits = (l-1)*32+i+1; words = (bits+26)/27;    else {
         *rp = z = NALLOC(words); PL(z) = words;      l = p->len;
         bzero((char *)BD(z),words*sizeof(unsigned int));      MKVECT(r,l); *rp = r;
         for ( j = 0, b = BD(z); j < words; j++ ) {      for ( i = 0; i < l; i++ )
                 k = (27*j)/32; r = (27*j)%32;        objtobobj(base,p->body[i],(Obj *)&r->body[i]);
                 if ( r > 5 )    }
                         b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));  
                 else  
                         b[j] = (a[k]>>r)&((1<<27)-1);  
         }  
         if ( !(r = bits%27) )  
                 r = 27;  
         b[words-1] &= ((1<<r)-1);  
 }  }
   
 void n27ton32(a,rp)  void bvecttovect(int base,VECT p,VECT *rp)
 N a;  
 N *rp;  
 {  {
         int i,j,k,l,r,bits,words;    int i,l;
         unsigned int t;    VECT r;
         unsigned int *b,*c;  
         N z;  
   
         l = PL(a); b = BD(a);    if ( !p )
         for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );      *rp = p;
         bits = (l-1)*27+i+1; words = (bits+31)/32;    else {
         *rp = z = NALLOC(words); PL(z) = words;      l = p->len;
         bzero((char *)BD(z),words*sizeof(unsigned int));      MKVECT(r,l); *rp = r;
         for ( j = 0, c = BD(z); j < l; j++ ) {      for ( i = 0; i < l; i++ )
                 k = (27*j)/32; r = (27*j)%32;        bobjtoobj(base,p->body[i],(Obj *)&r->body[i]);
                 if ( r > 5 ) {    }
                         c[k] |= (b[j]&((1<<(32-r))-1))<<r;  
                         if ( k+1 < words )  
                                 c[k+1] = (b[j]>>(32-r));  
                 } else  
                         c[k] |= (b[j]<<r);  
         }  
 }  }
   
 void mptoum(p,pr)  void mattobmat(int base,MAT p,MAT *rp)
 P p;  
 UM pr;  
 {  {
         DCP dc;    int row,col,i,j;
     MAT r;
   
         if ( !p )    if ( !p )
                 DEG(pr) = -1;      *rp = p;
         else if ( NUM(p) ) {    else {
                 DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);      row = p->row; col = p->col;
         } else {      MKMAT(r,row,col); *rp = r;
                 bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));      for ( i = 0; i < row; i++ )
                 for ( dc = DC(p); dc; dc = NEXT(dc) )        for ( j = 0; i < col; j++ )
                         COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));        objtobobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
                 degum(pr,UDEG(p));    }
         }  
 }  }
   
 void umtomp(v,p,pr)  void bmattomat(int base,MAT p,MAT *rp)
 V v;  
 UM p;  
 P *pr;  
 {  {
         DCP dc,dc0;    int row,col,i,j;
         int i;    MAT r;
         MQ q;  
   
         if ( !p || (DEG(p) < 0) )    if ( !p )
                 *pr = 0;      *rp = p;
         else if ( !DEG(p) )    else {
                 STOMQ(COEF(p)[0],q), *pr = (P)q;      row = p->row; col = p->col;
         else {      MKMAT(r,row,col); *rp = r;
                 for ( dc0 = 0, i = DEG(p); i >= 0; i-- )      for ( i = 0; i < row; i++ )
                         if ( COEF(p)[i] ) {        for ( j = 0; i < col; j++ )
                                 NEXTDC(dc0,dc); STOQ(i,DEG(dc));        bobjtoobj(base,p->body[i][j],(Obj *)&r->body[i][j]);
                                 STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;    }
                         }  }
                 NEXT(dc) = 0; MKP(v,dc0,*pr);  
         }  void n32ton27(N g,N *rp)
   {
     int i,j,k,l,r,bits,words;
     unsigned int t;
     unsigned int *a,*b;
     N z;
   
     l = PL(g); a = BD(g);
     for ( i = 31, t = a[l-1]; !(t&(1<<i)); i-- );
     bits = (l-1)*32+i+1; words = (bits+26)/27;
     *rp = z = NALLOC(words); PL(z) = words;
     bzero((char *)BD(z),words*sizeof(unsigned int));
     for ( j = 0, b = BD(z); j < words; j++ ) {
       k = (27*j)/32; r = (27*j)%32;
       if ( r > 5 )
         b[j] = (a[k]>>r)|(k==(l-1)?0:((a[k+1]&((1<<(r-5))-1))<<(32-r)));
       else
         b[j] = (a[k]>>r)&((1<<27)-1);
     }
     if ( !(r = bits%27) )
       r = 27;
     b[words-1] &= ((1<<r)-1);
   }
   
   void n27ton32(N a,N *rp)
   {
     int i,j,k,l,r,bits,words;
     unsigned int t;
     unsigned int *b,*c;
     N z;
   
     l = PL(a); b = BD(a);
     for ( i = 26, t = b[l-1]; !(t&(1<<i)); i-- );
     bits = (l-1)*27+i+1; words = (bits+31)/32;
     *rp = z = NALLOC(words); PL(z) = words;
     bzero((char *)BD(z),words*sizeof(unsigned int));
     for ( j = 0, c = BD(z); j < l; j++ ) {
       k = (27*j)/32; r = (27*j)%32;
       if ( r > 5 ) {
         c[k] |= (b[j]&((1<<(32-r))-1))<<r;
         if ( k+1 < words )
           c[k+1] = (b[j]>>(32-r));
       } else
         c[k] |= (b[j]<<r);
     }
   }
   
   void mptoum(P p,UM pr)
   {
     DCP dc;
   
     if ( !p )
       DEG(pr) = -1;
     else if ( NUM(p) ) {
       DEG(pr) = 0; COEF(pr)[0] = CONT((MQ)p);
     } else {
       bzero((char *)pr,(int)((UDEG(p)+2)*sizeof(int)));
       for ( dc = DC(p); dc; dc = NEXT(dc) )
         COEF(pr)[QTOS(DEG(dc))] = CONT((MQ)COEF(dc));
       degum(pr,UDEG(p));
     }
   }
   
   void umtomp(V v,UM p,P *pr)
   {
     DCP dc,dc0;
     int i;
     MQ q;
   
     if ( !p || (DEG(p) < 0) )
       *pr = 0;
     else if ( !DEG(p) )
       STOMQ(COEF(p)[0],q), *pr = (P)q;
     else {
       for ( dc0 = 0, i = DEG(p); i >= 0; i-- )
         if ( COEF(p)[i] ) {
           NEXTDC(dc0,dc); STOQ(i,DEG(dc));
           STOMQ(COEF(p)[i],q), COEF(dc) = (P)q;
         }
       NEXT(dc) = 0; MKP(v,dc0,*pr);
     }
   }
   
   /* f(p) -> f(x) */
   
   void enc_to_p(int p,int a,V v,P *pr)
   {
     DCP dc,dct;
     int i,c;
     Q dq,cq;
   
     dc = 0;
     for ( i = 0; a; i++, a /= p ) {
       c = a%p;
       if ( c ) {
         STOQ(i,dq); STOQ(c,cq);
         NEWDC(dct); DEG(dct) = dq; COEF(dct) = (P)cq;
         NEXT(dct) = dc; dc = dct;
       }
     }
     MKP(v,dc,*pr);
 }  }
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.15
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>