Annotation of OpenXM_contrib2/asir2000/builtin/cplxnum.c, Revision 1.1.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>