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

Diff for /OpenXM_contrib2/asir2000/engine/RU.c between version 1.1.1.1 and 1.5

version 1.1.1.1, 1999/12/03 07:39:08 version 1.5, 2018/03/29 01:32:51
Line 1 
Line 1 
 /* $OpenXM: OpenXM/src/asir99/engine/RU.c,v 1.1.1.1 1999/11/10 08:12:26 noro Exp $ */  /*
    * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
    * All rights reserved.
    *
    * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
    * non-exclusive and royalty-free license to use, copy, modify and
    * redistribute, solely for non-commercial and non-profit purposes, the
    * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
    * conditions of this Agreement. For the avoidance of doubt, you acquire
    * only a limited right to use the SOFTWARE hereunder, and FLL or any
    * third party developer retains all rights, including but not limited to
    * copyrights, in and to the SOFTWARE.
    *
    * (1) FLL does not grant you a license in any way for commercial
    * purposes. You may use the SOFTWARE only for non-commercial and
    * non-profit purposes only, such as academic, research and internal
    * business use.
    * (2) The SOFTWARE is protected by the Copyright Law of Japan and
    * international copyright treaties. If you make copies of the SOFTWARE,
    * with or without modification, as permitted hereunder, you shall affix
    * to all such copies of the SOFTWARE the above copyright notice.
    * (3) An explicit reference to this SOFTWARE and its copyright owner
    * shall be made on your publication or presentation in any form of the
    * results obtained by use of the SOFTWARE.
    * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
    * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
    * for such modification or the source code of the modified part of the
    * SOFTWARE.
    *
    * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
    * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
    * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
    * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
    * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
    * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
    * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
    * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
    * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
    * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
    * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
    * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
    * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
    * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
    * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
    * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
    * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
    *
    * $OpenXM: OpenXM_contrib2/asir2000/engine/RU.c,v 1.4 2002/07/26 00:33:02 noro Exp $
   */
 #include "ca.h"  #include "ca.h"
   
 int qcoefr(r)  int qcoefr(r)
 Obj r;  Obj r;
 {  {
         if ( !r )    if ( !r )
                 return 1;      return 1;
         else    else
                 switch ( OID(r) ) {      switch ( OID(r) ) {
                         case O_N:        case O_N:
                                 return RATN(r)?1:0; break;          return RATN(r)?1:0; break;
                         case O_P:        case O_P:
                                 return qcoefp(r); break;          return qcoefp(r); break;
                         default:        default:
                                 return qcoefp((Obj)NM((R)r))&&qcoefp((Obj)DN((R)r)); break;          return qcoefp((Obj)NM((R)r))&&qcoefp((Obj)DN((R)r)); break;
                 }      }
 }  }
   
 int qcoefp(p)  int qcoefp(p)
 Obj p;  Obj p;
 {  {
         DCP dc;    DCP dc;
   
         if ( !p )    if ( !p )
                 return 1;      return 1;
         else    else
                 switch ( OID(p) ) {      switch ( OID(p) ) {
                         case O_N:        case O_N:
                                 return RATN(p)?1:0; break;          return RATN(p)?1:0; break;
                         default:        default:
                                 for ( dc = DC((P)p); dc; dc = NEXT(dc) )          for ( dc = DC((P)p); dc; dc = NEXT(dc) )
                                         if ( !qcoefp((Obj)COEF(dc)) )            if ( !qcoefp((Obj)COEF(dc)) )
                                                 return 0;              return 0;
                                 return 1; break;          return 1; break;
                 }      }
 }  }
   
 void reductr(vl,p,r)  void reductr(vl,p,r)
 VL vl;  VL vl;
 Obj p,*r;  Obj p,*r;
 {  {
         P t,s,u,cnm,cdn,pnm,pdn;    P t,s,u,cnm,cdn,pnm,pdn;
         R a;    R a;
   
         if ( !p )    if ( !p )
                 *r = 0;      *r = 0;
         else if ( OID(p) <= O_P )    else if ( OID(p) <= O_P )
                 *r = p;      *r = p;
         else if ( ((R)p)->reduced )    else if ( ((R)p)->reduced )
                 *r = p;      *r = p;
         else if ( NUM(DN((R)p)) )    else if ( NUM(DN((R)p)) )
                 divsp(vl,NM((R)p),DN((R)p),(P *)r);      divsp(vl,NM((R)p),DN((R)p),(P *)r);
         else if ( qcoefp((Obj)NM((R)p)) && qcoefp((Obj)DN((R)p)) ) {    else if ( qcoefp((Obj)NM((R)p)) && qcoefp((Obj)DN((R)p)) ) {
                 ptozp(NM((R)p),1,(Q *)&cnm,&pnm); ptozp(DN((R)p),1,(Q *)&cdn,&pdn);      ptozp(NM((R)p),1,(Q *)&cnm,&pnm); ptozp(DN((R)p),1,(Q *)&cdn,&pdn);
                 ezgcdpz(vl,pnm,pdn,&t);      ezgcdpz(vl,pnm,pdn,&t);
                 divsp(vl,NM((R)p),t,&u); divsp(vl,DN((R)p),t,&s);      divsp(vl,NM((R)p),t,&u); divsp(vl,DN((R)p),t,&s);
                 if ( NUM(s) )      if ( NUM(s) )
                         divsp(vl,u,s,(P *)r);        divsp(vl,u,s,(P *)r);
                 else {      else {
                         divsp(vl,u,cdn,&pnm); divsp(vl,s,cdn,&pdn);        divsp(vl,u,cdn,&pnm); divsp(vl,s,cdn,&pdn);
                         MKRAT(pnm,pdn,1,a); *r = (Obj)a;        if ( headsgn(pdn) < 0 ) {
                 }          chsgnp(pnm,&t); pnm = t;
         } else {          chsgnp(pdn,&t); pdn = t;
                 MKRAT(NM((R)p),DN((R)p),1,a); *r = (Obj)a;        }
         }        MKRAT(pnm,pdn,1,a); *r = (Obj)a;
       }
     } else {
       MKRAT(NM((R)p),DN((R)p),1,a); *r = (Obj)a;
     }
 }  }
   
 void pderivr(vl,a,v,b)  void pderivr(vl,a,v,b)
Line 71  VL vl;
Line 123  VL vl;
 V v;  V v;
 Obj a,*b;  Obj a,*b;
 {  {
         P t,s,u;    P t,s,u;
         R r;    R r;
   
         if ( !a )    if ( !a )
                 *b = 0;      *b = 0;
         else if ( OID(a) <= O_P )    else if ( OID(a) <= O_P )
                 diffp(vl,(P)a,v,(P *)b);      diffp(vl,(P)a,v,(P *)b);
         else {    else {
                 diffp(vl,NM((R)a),v,&t); mulp(vl,t,DN((R)a),&s);      diffp(vl,NM((R)a),v,&t); mulp(vl,t,DN((R)a),&s);
                 diffp(vl,DN((R)a),v,&t); mulp(vl,t,NM((R)a),&u);      diffp(vl,DN((R)a),v,&t); mulp(vl,t,NM((R)a),&u);
                 subp(vl,s,u,&t);      subp(vl,s,u,&t);
                 if ( t ) {      if ( t ) {
                         mulp(vl,DN((R)a),DN((R)a),&u); MKRAT(t,u,0,r); *b = (Obj)r;        mulp(vl,DN((R)a),DN((R)a),&u); MKRAT(t,u,0,r); *b = (Obj)r;
                 } else      } else
                         *b = 0;        *b = 0;
         }    }
 }  }
   
 void clctvr(vl,p,nvl)  void clctvr(vl,p,nvl)
 VL vl,*nvl;  VL vl,*nvl;
 Obj p;  Obj p;
 {  {
         VL vl1,vl2;    VL vl1,vl2;
   
         if ( !p )    if ( !p )
                 *nvl = 0;      *nvl = 0;
         else if ( OID(p) <= O_P )    else if ( OID(p) <= O_P )
                 clctv(vl,(P)p,nvl);      clctv(vl,(P)p,nvl);
         else {    else {
                 clctv(vl,NM((R)p),&vl1); clctv(vl,DN((R)p),&vl2); mergev(vl,vl1,vl2,nvl);      clctv(vl,NM((R)p),&vl1); clctv(vl,DN((R)p),&vl2); mergev(vl,vl1,vl2,nvl);
         }    }
 }  }
Legend:
Removed from v.1.1.1.1  
changed lines
  Added in v.1.5
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>