Annotation of OpenXM_contrib2/asir2000/parse/arith.c, Revision 1.1
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/parse/arith.c,v 1.2 1999/11/18 05:42:02 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4:
! 5: struct oAFUNC {
! 6: void (*add)();
! 7: void (*sub)();
! 8: void (*mul)();
! 9: void (*div)();
! 10: void (*pwr)();
! 11: void (*chsgn)();
! 12: int (*comp)();
! 13: };
! 14:
! 15: struct oARF arf[6];
! 16: ARF addfs, subfs, mulfs, divfs, remfs, pwrfs;
! 17:
! 18: void divsdc();
! 19:
! 20: struct oAFUNC afunc[] = {
! 21: /* ??? */ {0,0,0,0,0,0,0},
! 22: /* O_N */ {addnum,subnum,mulnum,divnum,pwrnum,chsgnnum,compnum},
! 23: /* O_P */ {addp,subp,mulp,divr,pwrp,chsgnp,compp},
! 24: /* O_R */ {addr,subr,mulr,divr,pwrr,chsgnr,compr},
! 25: /* O_LIST */ {notdef,notdef,notdef,notdef,notdef,notdef,complist},
! 26: /* O_VECT */ {addvect,subvect,mulvect,divvect,notdef,chsgnvect,compvect},
! 27: /* O_MAT */ {addmat,submat,mulmat,divmat,pwrmat,chsgnmat,compmat},
! 28: /* O_STR */ {addstr,notdef,notdef,notdef,notdef,notdef,compstr},
! 29: /* O_COMP */ {addcomp,subcomp,mulcomp,divcomp,pwrcomp,chsgncomp,compcomp},
! 30: /* O_DP */ {addd,subd,muld,divsdc,notdef,chsgnd,compd},
! 31: /* O_UI */ {notdef,notdef,notdef,notdef,notdef,notdef,compui},
! 32: /* O_GF2MAT */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
! 33: /* O_ERR */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
! 34: /* O_GFMMAT */ {notdef,notdef,notdef,notdef,notdef,notdef,(int(*)())notdef},
! 35: };
! 36:
! 37: void arf_init() {
! 38: addfs = &arf[0]; addfs->name = "+"; addfs->fp = arf_add;
! 39: subfs = &arf[1]; subfs->name = "-"; subfs->fp = arf_sub;
! 40: mulfs = &arf[2]; mulfs->name = "*"; mulfs->fp = arf_mul;
! 41: divfs = &arf[3]; divfs->name = "/"; divfs->fp = arf_div;
! 42: remfs = &arf[4]; remfs->name = "%"; remfs->fp = arf_remain;
! 43: pwrfs = &arf[5]; pwrfs->name = "^"; pwrfs->fp = arf_pwr;
! 44: }
! 45:
! 46: void arf_add(vl,a,b,r)
! 47: VL vl;
! 48: Obj a,b,*r;
! 49: {
! 50: int mid;
! 51:
! 52: if ( !a )
! 53: *r = b;
! 54: else if ( !b )
! 55: *r = a;
! 56: else if ( OID(a) == OID(b) )
! 57: (*afunc[OID(a)].add)(vl,a,b,r);
! 58: else if ( (mid = MAX(OID(a),OID(b))) <= O_R )
! 59: (*afunc[mid].add)(vl,a,b,r);
! 60: else
! 61: notdef(vl,a,b,r);
! 62: }
! 63:
! 64: void arf_sub(vl,a,b,r)
! 65: VL vl;
! 66: Obj a,b,*r;
! 67: {
! 68: int mid;
! 69:
! 70: if ( !a )
! 71: if ( !b )
! 72: *r = 0;
! 73: else
! 74: (*afunc[OID(b)].chsgn)(b,r);
! 75: else if ( !b )
! 76: *r = a;
! 77: else if ( OID(a) == OID(b) )
! 78: (*afunc[OID(a)].sub)(vl,a,b,r);
! 79: else if ( (mid = MAX(OID(a),OID(b))) <= O_R )
! 80: (*afunc[mid].sub)(vl,a,b,r);
! 81: else
! 82: notdef(vl,a,b,r);
! 83: }
! 84:
! 85: void arf_mul(vl,a,b,r)
! 86: VL vl;
! 87: Obj a,b,*r;
! 88: {
! 89: int mid;
! 90:
! 91: if ( !a || !b )
! 92: *r = 0;
! 93: else if ( OID(a) == OID(b) )
! 94: (*(afunc[OID(a)].mul))(vl,a,b,r);
! 95: else if ( (mid = MAX(OID(a),OID(b))) <= O_R ||
! 96: (mid == O_MAT) || (mid == O_VECT) || (mid == O_DP) )
! 97: (*afunc[mid].mul)(vl,a,b,r);
! 98: else
! 99: notdef(vl,a,b,r);
! 100: }
! 101:
! 102: void arf_div(vl,a,b,r)
! 103: VL vl;
! 104: Obj a,b,*r;
! 105: {
! 106: int mid;
! 107:
! 108: if ( !b )
! 109: error("div : division by 0");
! 110: if ( !a )
! 111: *r = 0;
! 112: else if ( (OID(a) == OID(b)) )
! 113: (*(afunc[OID(a)].div))(vl,a,b,r);
! 114: else if ( (mid = MAX(OID(a),OID(b))) <= O_R ||
! 115: (mid == O_MAT) || (mid == O_VECT) || (mid == O_DP) )
! 116: (*afunc[mid].div)(vl,a,b,r);
! 117: else
! 118: notdef(vl,a,b,r);
! 119: }
! 120:
! 121: void arf_remain(vl,a,b,r)
! 122: VL vl;
! 123: Obj a,b,*r;
! 124: {
! 125: if ( !b )
! 126: error("rem : division by 0");
! 127: else if ( !a )
! 128: *r = 0;
! 129: else if ( MAX(OID(a),OID(b)) <= O_P )
! 130: cmp((Q)b,(P)a,(P *)r);
! 131: else
! 132: notdef(vl,a,b,r);
! 133: }
! 134:
! 135: void arf_pwr(vl,a,e,r)
! 136: VL vl;
! 137: Obj a,e,*r;
! 138: {
! 139: R t;
! 140:
! 141: if ( !a )
! 142: *r = 0;
! 143: else if ( !e )
! 144: *r = (pointer)ONE;
! 145: else if ( (OID(e) <= O_N) && INT(e) ) {
! 146: if ( (OID(a) == O_P) && (SGN((Q)e) < 0) ) {
! 147: MKRAT((P)a,(P)ONE,1,t);
! 148: (*(afunc[O_R].pwr))(vl,t,e,r);
! 149: } else
! 150: (*(afunc[OID(a)].pwr))(vl,a,e,r);
! 151: } else if ( OID(a) <= O_R )
! 152: mkpow(vl,a,e,r);
! 153: else
! 154: notdef(vl,a,e,r);
! 155: }
! 156:
! 157: void arf_chsgn(a,r)
! 158: Obj a,*r;
! 159: {
! 160: if ( !a )
! 161: *r = 0;
! 162: else
! 163: (*(afunc[OID(a)].chsgn))(a,r);
! 164: }
! 165:
! 166: int arf_comp(vl,a,b)
! 167: VL vl;
! 168: Obj a,b;
! 169: {
! 170: if ( !a )
! 171: if ( !b )
! 172: return 0;
! 173: else
! 174: return (*afunc[OID(b)].comp)(vl,a,b);
! 175: else if ( !b )
! 176: return (*afunc[OID(a)].comp)(vl,a,b);
! 177: else if ( OID(a) != OID(b) )
! 178: return OID(a)>OID(b) ? 1 : -1;
! 179: else
! 180: return (*afunc[OID(a)].comp)(vl,a,b);
! 181: }
! 182:
! 183: int complist(vl,a,b)
! 184: VL vl;
! 185: LIST a,b;
! 186: {
! 187: int i,t;
! 188: NODE an,bn;
! 189:
! 190: if ( !a )
! 191: if ( !b )
! 192: return 0;
! 193: else
! 194: return -1;
! 195: else if ( !b )
! 196: return 1;
! 197: for ( i = 0, an = BDY(a); an; i++, an = NEXT(an) );
! 198: for ( an = BDY(b); an; i--, an = NEXT(an) );
! 199: if ( i )
! 200: return i > 0 ? 1 : -1;
! 201: for ( an = BDY(a), bn = BDY(b); an; an = NEXT(an), bn = NEXT(bn) )
! 202: if ( t = arf_comp(vl,BDY(an),BDY(bn)) )
! 203: return t;
! 204: return 0;
! 205: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to arith.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / parse