/*
* Construct a complex number given the real and imaginary components.
*/
COMPLEX *
qqtoc(NUMBER *q1, NUMBER *q2)
{
COMPLEX *r;
if (qiszero(q1) && qiszero(q2))
return clink(&_czero_);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qlink(q1);
r->imag = qlink(q2);
return r;
}
/*
* Negate a complex number.
*/
COMPLEX *
cneg(COMPLEX *c)
{
COMPLEX *r;
if (ciszero(c))
return clink(&_czero_);
r = comalloc();
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qneg(c->real);
}
if (!qiszero(c->imag)) {
qfree(r->imag);
r->imag = qneg(c->imag);
}
return r;
}
/*
* hash_complex - hash a COMPLEX
*
* given:
* type - hash type (see hash.h)
* c - the COMPLEX
* state - the state to hash or NULL
*
* returns:
* the new state
*/
HASH *
hash_complex(int type, void *c, HASH *state)
{
COMPLEX *complex = (COMPLEX *)c; /* c as a COMPLEX pointer */
/*
* initialize if state is NULL
*/
if (state == NULL) {
state = hash_init(type, NULL);
}
/*
* setup for the COMPLEX hash
*/
(state->chkpt)(state);
state->bytes = FALSE;
/*
* catch the zero special case
*/
if (ciszero(complex)) {
/* note a zero numeric value and return */
(state->note)(HASH_ZERO(state->base), state);
return state;
}
/*
* process the real value if not pure imaginary
*
* We will ignore the real part if the value is of the form 0+xi.
*/
if (!qiszero(complex->real)) {
state = hash_number(type, complex->real, state);
}
/*
* if the NUMBER is not real, process the imaginary value
*
* We will ignore the imaginary part of the value is of the form x+0i.
*/
if (!cisreal(complex)) {
/* note the sqrt(-1) */
(state->note)(HASH_COMPLEX(state->base), state);
/* hash the imaginary value */
state = hash_number(type, complex->imag, state);
}
/*
* all done
*/
return state;
}
/*
* Subtract two complex numbers.
*/
COMPLEX *
csub(COMPLEX *c1, COMPLEX *c2)
{
COMPLEX *r;
if ((c1->real == c2->real) && (c1->imag == c2->imag))
return clink(&_czero_);
if (ciszero(c2))
return clink(c1);
r = comalloc();
if (!qiszero(c1->real) || !qiszero(c2->real)) {
qfree(r->real);
r->real = qsub(c1->real, c2->real);
}
if (!qiszero(c1->imag) || !qiszero(c2->imag)) {
qfree(r->imag);
r->imag = qsub(c1->imag, c2->imag);
}
return r;
}
/*
* Add two complex numbers.
*/
COMPLEX *
cadd(COMPLEX *c1, COMPLEX *c2)
{
COMPLEX *r;
if (ciszero(c1))
return clink(c2);
if (ciszero(c2))
return clink(c1);
r = comalloc();
if (!qiszero(c1->real) || !qiszero(c2->real)) {
qfree(r->real);
r->real = qqadd(c1->real, c2->real);
}
if (!qiszero(c1->imag) || !qiszero(c2->imag)) {
qfree(r->imag);
r->imag = qqadd(c1->imag, c2->imag);
}
return r;
}
/*
* Subtract a real number from a complex number.
*/
COMPLEX *
csubq(COMPLEX *c, NUMBER *q)
{
COMPLEX *r;
if (qiszero(q))
return clink(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qsub(c->real, q);
r->imag = qlink(c->imag);
return r;
}
/*
* Return the real part of a complex number.
*/
COMPLEX *
c_real(COMPLEX *c)
{
COMPLEX *r;
if (cisreal(c))
return clink(c);
r = comalloc();
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qlink(c->real);
}
return r;
}
/*
* Take the conjugate of a complex number.
* This negates the complex part.
*/
COMPLEX *
cconj(COMPLEX *c)
{
COMPLEX *r;
if (cisreal(c))
return clink(c);
r = comalloc();
if (!qiszero(c->real)) {
qfree(r->real);
r->real = qlink(c->real);
}
qfree(r->imag);
r->imag = qneg(c->imag);
return r;
}
/*
* Multiply a complex number by a real number.
*/
COMPLEX *
cmulq(COMPLEX *c, NUMBER *q)
{
COMPLEX *r;
if (qiszero(q))
return clink(&_czero_);
if (qisone(q))
return clink(c);
if (qisnegone(q))
return cneg(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qmul(c->real, q);
r->imag = qmul(c->imag, q);
return r;
}
/*
* Divide a complex number by a real number.
*/
COMPLEX *
cdivq(COMPLEX *c, NUMBER *q)
{
COMPLEX *r;
if (qiszero(q)) {
math_error("Division by zero");
/*NOTREACHED*/
}
if (qisone(q))
return clink(c);
if (qisnegone(q))
return cneg(c);
r = comalloc();
qfree(r->real);
qfree(r->imag);
r->real = qqdiv(c->real, q);
r->imag = qqdiv(c->imag, q);
return r;
}
/*
* Add an opcode to the current function being compiled.
* Note: This can change the curfunc global variable when the
* function needs expanding.
*/
void
addop(long op)
{
register FUNC *fp; /* current function */
NUMBER *q, *q1, *q2;
unsigned long count;
BOOL cut;
int diff;
fp = curfunc;
count = fp->f_opcodecount;
cut = TRUE;
diff = 2;
q = NULL;
if ((count + 5) >= maxopcodes) {
maxopcodes += OPCODEALLOCSIZE;
fp = (FUNC *) malloc(funcsize(maxopcodes));
if (fp == NULL) {
math_error("cannot malloc function");
/*NOTREACHED*/
}
memcpy((char *) fp, (char *) curfunc,
funcsize(curfunc->f_opcodecount));
if (curfunc != functemplate)
free(curfunc);
curfunc = fp;
}
/*
* Check the current opcode against the previous opcode and try to
* slightly optimize the code depending on the various combinations.
*/
switch (op) {
case OP_GETVALUE:
switch (oldop) {
case OP_NUMBER:
case OP_ZERO:
case OP_ONE:
case OP_IMAGINARY:
case OP_GETEPSILON:
case OP_SETEPSILON:
case OP_STRING:
case OP_UNDEF:
case OP_GETCONFIG:
case OP_SETCONFIG:
return;
case OP_DUPLICATE:
diff = 1;
oldop = OP_DUPVALUE;
break;
case OP_FIADDR:
diff = 1;
oldop = OP_FIVALUE;
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
oldop = OP_GLOBALVALUE;
break;
case OP_LOCALADDR:
oldop = OP_LOCALVALUE;
break;
case OP_PARAMADDR:
oldop = OP_PARAMVALUE;
break;
case OP_ELEMADDR:
oldop = OP_ELEMVALUE;
break;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodes[count - diff] = oldop;
return;
}
break;
case OP_POP:
switch (oldop) {
case OP_ASSIGN:
fp->f_opcodes[count-1] = OP_ASSIGNPOP;
oldop = OP_ASSIGNPOP;
return;
case OP_NUMBER:
case OP_IMAGINARY:
q = constvalue(fp->f_opcodes[count-1]);
qfree(q);
break;
case OP_STRING:
sfree(findstring((long)fp->f_opcodes[count-1]));
break;
case OP_LOCALADDR:
case OP_PARAMADDR:
break;
case OP_GLOBALADDR:
diff = 1 + PTR_SIZE;
break;
case OP_UNDEF:
fp->f_opcodecount -= 1;
oldop = OP_NOP;
oldoldop = OP_NOP;
return;
default:
cut = FALSE;
}
if (cut) {
fp->f_opcodecount -= diff;
oldop = OP_NOP;
oldoldop = OP_NOP;
fprintf(stderr,
"Line %ld: unused value ignored\n",
linenumber());
return;
}
break;
case OP_NEGATE:
if (oldop == OP_NUMBER) {
q = constvalue(fp->f_opcodes[count-1]);
fp->f_opcodes[count-1] = addqconstant(qneg(q));
qfree(q);
return;
}
}
if (oldop == OP_NUMBER) {
if (oldoldop == OP_NUMBER) {
q1 = constvalue(fp->f_opcodes[count - 3]);
q2 = constvalue(fp->f_opcodes[count - 1]);
switch (op) {
case OP_DIV:
if (qiszero(q2)) {
cut = FALSE;
break;
}
q = qqdiv(q1,q2);
break;
case OP_MUL:
q = qmul(q1,q2);
break;
case OP_ADD:
q = qqadd(q1,q2);
break;
case OP_SUB:
q = qsub(q1,q2);
break;
case OP_POWER:
if (qisfrac(q2) || qisneg(q2))
cut = FALSE;
else
q = qpowi(q1,q2);
break;
default:
cut = FALSE;
}
if (cut) {
qfree(q1);
qfree(q2);
fp->f_opcodes[count - 3] = addqconstant(q);
fp->f_opcodecount -= 2;
oldoldop = OP_NOP;
return;
}
} else if (op != OP_NUMBER) {
q = constvalue(fp->f_opcodes[count - 1]);
if (op == OP_POWER) {
if (qcmpi(q, 2L) == 0) {
fp->f_opcodecount--;
fp->f_opcodes[count - 2] = OP_SQUARE;
qfree(q);
oldop = OP_SQUARE;
return;
}
if (qcmpi(q, 4L) == 0) {
fp->f_opcodes[count - 2] = OP_SQUARE;
fp->f_opcodes[count - 1] = OP_SQUARE;
qfree(q);
oldop = OP_SQUARE;
return;
}
}
if (qiszero(q)) {
qfree(q);
fp->f_opcodes[count - 2] = OP_ZERO;
fp->f_opcodecount--;
} else if (qisone(q)) {
qfree(q);
fp->f_opcodes[count - 2] = OP_ONE;
fp->f_opcodecount--;
}
}
}
/*
* No optimization possible, so store the opcode.
*/
fp->f_opcodes[fp->f_opcodecount] = op;
fp->f_opcodecount++;
oldoldop = oldop;
oldop = op;
}
