Annotation of OpenXM_contrib2/asir2000/builtin/cplxnum.c, Revision 1.1
1.1 ! noro 1: /* $OpenXM: OpenXM/src/asir99/builtin/cplxnum.c,v 1.1.1.1 1999/11/10 08:12:25 noro Exp $ */
! 2: #include "ca.h"
! 3: #include "parse.h"
! 4:
! 5: void Pconj(),Preal(),Pimag();
! 6:
! 7: #if defined(THINK_C)
! 8: void cplx_conj(Obj,Obj *);
! 9: void cplx_real(Obj,Obj *);
! 10: void cplx_imag(Obj,Obj *);
! 11: #else
! 12: void cplx_conj();
! 13: void cplx_real();
! 14: void cplx_imag();
! 15: #endif
! 16:
! 17: struct ftab cplx_tab[] = {
! 18: {"conj",Pconj,1},
! 19: {"real",Preal,1},
! 20: {"imag",Pimag,1},
! 21: {0,0,0},
! 22: };
! 23:
! 24: void Pconj(arg,rp)
! 25: NODE arg;
! 26: Obj *rp;
! 27: {
! 28: cplx_conj((Obj)ARG0(arg),rp);
! 29: }
! 30:
! 31: void Preal(arg,rp)
! 32: NODE arg;
! 33: Obj *rp;
! 34: {
! 35: cplx_real((Obj)ARG0(arg),rp);
! 36: }
! 37:
! 38: void Pimag(arg,rp)
! 39: NODE arg;
! 40: Obj *rp;
! 41: {
! 42: cplx_imag((Obj)ARG0(arg),rp);
! 43: }
! 44:
! 45: void cplx_conj(p,r)
! 46: Obj p;
! 47: Obj *r;
! 48: {
! 49: C c;
! 50: DCP dc,dcr,dcr0;
! 51: P t;
! 52:
! 53: if ( !p )
! 54: *r = 0;
! 55: else
! 56: switch ( OID(p) ) {
! 57: case O_N:
! 58: if ( NID((Num)p) <= N_B )
! 59: *r = p;
! 60: else {
! 61: NEWC(c); c->r = ((C)p)->r; chsgnnum(((C)p)->i,&c->i);
! 62: *r = (Obj)c;
! 63: }
! 64: break;
! 65: case O_P:
! 66: for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
! 67: NEXTDC(dcr0,dcr); cplx_conj((Obj)COEF(dc),(Obj *)&COEF(dcr));
! 68: DEG(dcr) = DEG(dc);
! 69: }
! 70: NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
! 71: break;
! 72: default:
! 73: error("cplx_conj : not implemented"); break;
! 74: }
! 75: }
! 76:
! 77: void cplx_real(p,r)
! 78: Obj p;
! 79: Obj *r;
! 80: {
! 81: DCP dc,dcr,dcr0;
! 82: P t;
! 83:
! 84: if ( !p )
! 85: *r = 0;
! 86: else
! 87: switch ( OID(p) ) {
! 88: case O_N:
! 89: if ( NID((Num)p) <= N_B )
! 90: *r = p;
! 91: else
! 92: *r = (Obj)((C)p)->r;
! 93: break;
! 94: case O_P:
! 95: for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
! 96: cplx_real((Obj)COEF(dc),(Obj *)&t);
! 97: if ( t ) {
! 98: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 99: }
! 100: }
! 101: if ( !dcr0 )
! 102: *r = 0;
! 103: else {
! 104: NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
! 105: }
! 106: break;
! 107: default:
! 108: error("cplx_real : not implemented"); break;
! 109: }
! 110: }
! 111:
! 112: void cplx_imag(p,r)
! 113: Obj p;
! 114: Obj *r;
! 115: {
! 116: DCP dc,dcr,dcr0;
! 117: P t;
! 118:
! 119: if ( !p )
! 120: *r = 0;
! 121: else
! 122: switch ( OID(p) ) {
! 123: case O_N:
! 124: if ( NID((Num)p) <= N_B )
! 125: *r = 0;
! 126: else
! 127: *r = (Obj)((C)p)->i;
! 128: break;
! 129: case O_P:
! 130: for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
! 131: cplx_imag((Obj)COEF(dc),(Obj *)&t);
! 132: if ( t ) {
! 133: NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
! 134: }
! 135: }
! 136: if ( !dcr0 )
! 137: *r = 0;
! 138: else {
! 139: NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
! 140: }
! 141: break;
! 142: default:
! 143: error("cplx_imag : not implemented"); break;
! 144: }
! 145: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>