File: [local] / OpenXM_contrib2 / asir2000 / builtin / cplxnum.c (download)
Revision 1.1.1.1 (vendor branch), Fri Dec 3 07:39:07 1999 UTC (24 years, 7 months ago) by noro
Branch: NORO
CVS Tags: RELEASE_20000124, RELEASE_1_1_2, ASIR2000 Changes since 1.1: +0 -0
lines
Imported asir2000 as OpenXM_contrib2/asir2000.
|
/* $OpenXM: OpenXM_contrib2/asir2000/builtin/cplxnum.c,v 1.1.1.1 1999/12/03 07:39:07 noro Exp $ */
#include "ca.h"
#include "parse.h"
void Pconj(),Preal(),Pimag();
#if defined(THINK_C)
void cplx_conj(Obj,Obj *);
void cplx_real(Obj,Obj *);
void cplx_imag(Obj,Obj *);
#else
void cplx_conj();
void cplx_real();
void cplx_imag();
#endif
struct ftab cplx_tab[] = {
{"conj",Pconj,1},
{"real",Preal,1},
{"imag",Pimag,1},
{0,0,0},
};
void Pconj(arg,rp)
NODE arg;
Obj *rp;
{
cplx_conj((Obj)ARG0(arg),rp);
}
void Preal(arg,rp)
NODE arg;
Obj *rp;
{
cplx_real((Obj)ARG0(arg),rp);
}
void Pimag(arg,rp)
NODE arg;
Obj *rp;
{
cplx_imag((Obj)ARG0(arg),rp);
}
void cplx_conj(p,r)
Obj p;
Obj *r;
{
C c;
DCP dc,dcr,dcr0;
P t;
if ( !p )
*r = 0;
else
switch ( OID(p) ) {
case O_N:
if ( NID((Num)p) <= N_B )
*r = p;
else {
NEWC(c); c->r = ((C)p)->r; chsgnnum(((C)p)->i,&c->i);
*r = (Obj)c;
}
break;
case O_P:
for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
NEXTDC(dcr0,dcr); cplx_conj((Obj)COEF(dc),(Obj *)&COEF(dcr));
DEG(dcr) = DEG(dc);
}
NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
break;
default:
error("cplx_conj : not implemented"); break;
}
}
void cplx_real(p,r)
Obj p;
Obj *r;
{
DCP dc,dcr,dcr0;
P t;
if ( !p )
*r = 0;
else
switch ( OID(p) ) {
case O_N:
if ( NID((Num)p) <= N_B )
*r = p;
else
*r = (Obj)((C)p)->r;
break;
case O_P:
for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
cplx_real((Obj)COEF(dc),(Obj *)&t);
if ( t ) {
NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
}
}
if ( !dcr0 )
*r = 0;
else {
NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
}
break;
default:
error("cplx_real : not implemented"); break;
}
}
void cplx_imag(p,r)
Obj p;
Obj *r;
{
DCP dc,dcr,dcr0;
P t;
if ( !p )
*r = 0;
else
switch ( OID(p) ) {
case O_N:
if ( NID((Num)p) <= N_B )
*r = 0;
else
*r = (Obj)((C)p)->i;
break;
case O_P:
for ( dcr0 = 0, dc = DC((P)p); dc; dc = NEXT(dc) ) {
cplx_imag((Obj)COEF(dc),(Obj *)&t);
if ( t ) {
NEXTDC(dcr0,dcr); DEG(dcr) = DEG(dc); COEF(dcr) = t;
}
}
if ( !dcr0 )
*r = 0;
else {
NEXT(dcr) = 0; MKP(VR((P)p),dcr0,t); *r = (Obj)t;
}
break;
default:
error("cplx_imag : not implemented"); break;
}
}