/************************************************************************ * * Code is modified from the code for Gnuplot by Zou Maorong */ /* * G N U P L O T -- internal.c * Copyright (C) 1986, 1987 Thomas Williams, Colin Kelley * You may use this code as you wish if credit is given and this message * is retained. */ /****************************************************************************/ #include #include #include "plot.h" extern BOOLEAN undefined; char *strcpy(); struct value *pop(), *complex(), *integer(); double magnitude(), angle(), real(); struct value stack[STACK_DEPTH]; int s_p = -1; /* stack pointer */ /*************************************************************/ reset_stack() { s_p = -1; } /*************************************************************/ check_stack() /* make sure stack's empty */ { if (s_p != -1) (void)fprintf(STDERRR,"\nwarning: internal error--stack not empty!\n"); } /*************************************************************/ struct value *pop(x) struct value *x; { #ifdef DEBUG if (s_p < 0 ) int_error("stack underflow",NO_CARET); #endif *x = stack[s_p--]; return(x); } /*************************************************************/ push(x) struct value *x; { #ifdef DEBUG if (s_p == STACK_DEPTH - 1) int_error("stack overflow",NO_CARET); #endif stack[++s_p] = *x; } /*************************************************************/ #define ERR_VAR "undefined variable: " f_push(x) union argument *x; /* contains pointer to value to push; */ { static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR; struct udvt_entry *udv; udv = x->udv_arg; if (udv->udv_undef) /* undefined */ { (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name); int_error(err_str,NO_CARET); } push(&(udv->udv_value)); } /*************************************************************/ f_pushc(x) union argument *x; { push(&(x->v_arg)); } /*************************************************************/ f_pushd0(x) union argument *x; { push(&(x->udf_arg->dummy_value)); } /*************************************************************/ f_pushd1(x) union argument *x; { push(&(x->udf_arg->dummy_value1)); } /*************************************************************/ f_pushd2(x) union argument *x; { push(&(x->udf_arg->dummy_value2)); } /*************************************************************/ f_pushd3(x) union argument *x; { push(&(x->udf_arg->dummy_value3)); } /*************************************************************/ #define ERR_FUN "undefined function: " f_call(x) /* execute a udf */ union argument *x; { static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN; register struct udft_entry *udf; udf = x->udf_arg; if (!udf->at) /* undefined */ { (void) strcpy(&err_str[sizeof(ERR_FUN) - 1], udf->udf_name); int_error(err_str,NO_CARET); } if(udf->n_arg == 4) (void) pop(&(udf->dummy_value3)); if(udf->n_arg >= 3) (void) pop(&(udf->dummy_value2)); if(udf->n_arg >= 2) (void) pop(&(udf->dummy_value1)); (void) pop(&(udf->dummy_value)); execute_at(udf->at); } /*************************************************************/ static int_check(v) struct value *v; { if (v->type != INT) int_error("non-integer passed to boolean operator",NO_CARET); } /*************************************************************/ f_lnot() { struct value a; int_check(pop(&a)); push(integer(&a,!a.v.int_val) ); } /*************************************************************/ f_bnot() { struct value a; int_check(pop(&a)); push( integer(&a,~a.v.int_val) ); } /*************************************************************/ f_bool() { /* converts top-of-stack to boolean */ int_check(&top_of_stack); top_of_stack.v.int_val = !!top_of_stack.v.int_val; } /*************************************************************/ f_lor() { struct value a,b; int_check(pop(&b)); int_check(pop(&a)); push( integer(&a,a.v.int_val || b.v.int_val) ); } /*************************************************************/ f_land() { struct value a,b; int_check(pop(&b)); int_check(pop(&a)); push( integer(&a,a.v.int_val && b.v.int_val) ); } /*************************************************************/ f_bor() { struct value a,b; int_check(pop(&b)); int_check(pop(&a)); push( integer(&a,a.v.int_val | b.v.int_val) ); } /*************************************************************/ f_xor() { struct value a,b; int_check(pop(&b)); int_check(pop(&a)); push( integer(&a,a.v.int_val ^ b.v.int_val) ); } /*************************************************************/ f_band() { struct value a,b; int_check(pop(&b)); int_check(pop(&a)); push( integer(&a,a.v.int_val & b.v.int_val) ); } /*************************************************************/ f_uminus() { struct value a; (void) pop(&a); switch(a.type) { case INT: a.v.int_val = -a.v.int_val; break; case CMPLX: a.v.cmplx_val.real = -a.v.cmplx_val.real; a.v.cmplx_val.imag = -a.v.cmplx_val.imag; } push(&a); } /*************************************************************/ f_eq() /* note: floating point equality is rare because of roundoff error! */ { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val == b.v.int_val); break; case CMPLX: result = (a.v.int_val == b.v.cmplx_val.real && b.v.cmplx_val.imag == 0.0); } break; case CMPLX: switch (b.type) { case INT: result = (b.v.int_val == a.v.cmplx_val.real && a.v.cmplx_val.imag == 0.0); break; case CMPLX: result = (a.v.cmplx_val.real== b.v.cmplx_val.real && a.v.cmplx_val.imag== b.v.cmplx_val.imag); } } push(integer(&a,result)); } /*************************************************************/ f_ne() { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val != b.v.int_val); break; case CMPLX: result = (a.v.int_val != b.v.cmplx_val.real || b.v.cmplx_val.imag != 0.0); } break; case CMPLX: switch (b.type) { case INT: result = (b.v.int_val != a.v.cmplx_val.real || a.v.cmplx_val.imag != 0.0); break; case CMPLX: result = (a.v.cmplx_val.real != b.v.cmplx_val.real || a.v.cmplx_val.imag != b.v.cmplx_val.imag); } } push(integer(&a,result)); } /*************************************************************/ f_gt() { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val > b.v.int_val); break; case CMPLX: result = (a.v.int_val > b.v.cmplx_val.real); } break; case CMPLX: switch (b.type) { case INT: result = (a.v.cmplx_val.real > b.v.int_val); break; case CMPLX: result = (a.v.cmplx_val.real > b.v.cmplx_val.real); } } push(integer(&a,result)); } /*************************************************************/ f_lt() { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val < b.v.int_val); break; case CMPLX: result = (a.v.int_val < b.v.cmplx_val.real); } break; case CMPLX: switch (b.type) { case INT: result = (a.v.cmplx_val.real < b.v.int_val); break; case CMPLX: result = (a.v.cmplx_val.real < b.v.cmplx_val.real); } } push(integer(&a,result)); } /*************************************************************/ f_ge() { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val >= b.v.int_val); break; case CMPLX: result = (a.v.int_val >= b.v.cmplx_val.real); } break; case CMPLX: switch (b.type) { case INT: result = (a.v.cmplx_val.real >= b.v.int_val); break; case CMPLX: result = (a.v.cmplx_val.real >= b.v.cmplx_val.real); } } push(integer(&a,result)); } /*************************************************************/ f_le() { struct value a, b; register int result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: result = (a.v.int_val <= b.v.int_val); break; case CMPLX: result = (a.v.int_val <= b.v.cmplx_val.real); } break; case CMPLX: switch (b.type) { case INT: result = (a.v.cmplx_val.real <= b.v.int_val); break; case CMPLX: result = (a.v.cmplx_val.real <= b.v.cmplx_val.real); } } push(integer(&a,result)); } /*************************************************************/ f_plus() { struct value a, b, result; (void) pop(&b); (void) pop(&a); switch(a.type) { case INT: switch (b.type) { case INT: (void) integer(&result,a.v.int_val + b.v.int_val); break; case CMPLX: (void) complex(&result,a.v.int_val + b.v.cmplx_val.real, b.v.cmplx_val.imag); } break; case CMPLX: switch (b.type) { case INT: (void) complex(&result,b.v.int_val + a.v.cmplx_val.real, a.v.cmplx_val.imag); break; case CMPLX: (void) complex(&result,a.v.cmplx_val.real+ b.v.cmplx_val.real, a.v.cmplx_val.imag+ b.v.cmplx_val.imag); } } push(&result); } /*************************************************************/ f_minus() { struct value a, b, result; (void) pop(&b); (void) pop(&a); /* now do a - b */ switch(a.type) { case INT: switch (b.type) { case INT: (void) integer(&result,a.v.int_val - b.v.int_val); break; case CMPLX: (void) complex(&result,a.v.int_val - b.v.cmplx_val.real, -b.v.cmplx_val.imag); } break; case CMPLX: switch (b.type) { case INT: (void) complex(&result,a.v.cmplx_val.real - b.v.int_val, a.v.cmplx_val.imag); break; case CMPLX: (void) complex(&result,a.v.cmplx_val.real- b.v.cmplx_val.real, a.v.cmplx_val.imag- b.v.cmplx_val.imag); } } push(&result); } /************************************************************/ f_mult() { struct value a, b, result; (void) pop(&b); (void) pop(&a); /* now do a*b */ switch(a.type) { case INT: switch (b.type) { case INT: (void) integer(&result,a.v.int_val * b.v.int_val); break; case CMPLX: (void) complex(&result,a.v.int_val * b.v.cmplx_val.real, a.v.int_val * b.v.cmplx_val.imag); } break; case CMPLX: switch (b.type) { case INT: (void) complex(&result,b.v.int_val * a.v.cmplx_val.real, b.v.int_val * a.v.cmplx_val.imag); break; case CMPLX: (void) complex(&result,a.v.cmplx_val.real* b.v.cmplx_val.real- a.v.cmplx_val.imag* b.v.cmplx_val.imag, a.v.cmplx_val.real* b.v.cmplx_val.imag+ a.v.cmplx_val.imag* b.v.cmplx_val.real); } } push(&result); } /************************************************************/ f_div() { struct value a, b, result; register double square; (void) pop(&b); (void) pop(&a); /* now do a/b */ switch(a.type) { case INT: switch (b.type) { case INT: if (b.v.int_val) (void) integer(&result,a.v.int_val / b.v.int_val); else { (void) integer(&result,0); undefined = TRUE; } break; case CMPLX: square = b.v.cmplx_val.real* b.v.cmplx_val.real + b.v.cmplx_val.imag* b.v.cmplx_val.imag; if (square) (void) complex(&result,a.v.int_val* b.v.cmplx_val.real/square, -a.v.int_val* b.v.cmplx_val.imag/square); else { (void) complex(&result,0.0,0.0); undefined = TRUE; } } break; case CMPLX: switch (b.type) { case INT: if (b.v.int_val) (void) complex(&result,a.v.cmplx_val.real/ b.v.int_val, a.v.cmplx_val.imag/ b.v.int_val); else { (void) complex(&result,0.0,0.0); undefined = TRUE; } break; case CMPLX: square = b.v.cmplx_val.real* b.v.cmplx_val.real + b.v.cmplx_val.imag* b.v.cmplx_val.imag; if (square) (void) complex(&result,(a.v.cmplx_val.real* b.v.cmplx_val.real+ a.v.cmplx_val.imag* b.v.cmplx_val.imag)/square, (a.v.cmplx_val.imag* b.v.cmplx_val.real- a.v.cmplx_val.real* b.v.cmplx_val.imag)/ square); else { (void) complex(&result,0.0,0.0); undefined = TRUE; } } } push(&result); } /************************************************************/ f_mod() { struct value a, b; (void) pop(&b); (void) pop(&a); /* now do a%b */ if (a.type != INT || b.type != INT) int_error("can only mod ints",NO_CARET); if (b.v.int_val) push(integer(&a,a.v.int_val % b.v.int_val)); else { push(integer(&a,0)); undefined = TRUE; } } /************************************************************/ f_power() { struct value a, b, result; register int i, t, count; register double mag, ang; (void) pop(&b); (void) pop(&a); /* now find a**b */ switch(a.type) { case INT: switch (b.type) { case INT: count = abs(b.v.int_val); t = 1; for(i = 0; i < count; i++) t *= a.v.int_val; if (b.v.int_val >= 0) (void) integer(&result,t); else (void) complex(&result,1.0/t,0.0); break; case CMPLX: mag = pow(magnitude(&a),fabs(b.v.cmplx_val.real)); if (b.v.cmplx_val.real < 0.0) mag = 1.0/mag; ang = angle(&a)*b.v.cmplx_val.real+ b.v.cmplx_val.imag; (void) complex(&result,mag*cos(ang), mag*sin(ang)); } break; case CMPLX: switch (b.type) { case INT: if (a.v.cmplx_val.imag == 0.0) { mag = pow(a.v.cmplx_val.real,(double)abs(b.v.int_val)); if (b.v.int_val < 0) mag = 1.0/mag; (void) complex(&result,mag,0.0); } else { /* not so good, but...! */ mag = pow(magnitude(&a),(double)abs(b.v.int_val)); if (b.v.int_val < 0) mag = 1.0/mag; ang = angle(&a)*b.v.int_val; (void) complex(&result,mag*cos(ang), mag*sin(ang)); } break; case CMPLX: mag = pow(magnitude(&a),fabs(b.v.cmplx_val.real)); if (b.v.cmplx_val.real < 0.0) mag = 1.0/mag; ang = angle(&a)*b.v.cmplx_val.real+ b.v.cmplx_val.imag; (void) complex(&result,mag*cos(ang), mag*sin(ang)); } } push(&result); } /************************************************************/ f_factorial() { struct value a; register int i; register double val; (void) pop(&a); /* find a! (factorial) */ switch (a.type) { case INT: val = 1.0; for (i = a.v.int_val; i > 1; i--) /*fpe's should catch overflows*/ val *= i; break; default: int_error("factorial (!) argument must be an integer", NO_CARET); } push(complex(&a,val,0.0)); } /************************************************************/ int f_jump(x) union argument *x; { return(x->j_arg); } /************************************************************/ int f_jumpz(x) union argument *x; { struct value a; int_check(&top_of_stack); if (top_of_stack.v.int_val) /* non-zero */ { (void) pop(&a); return 1; /* no jump */ } else return(x->j_arg); /* leave the argument on TOS */ } /************************************************************/ int f_jumpnz(x) union argument *x; { struct value a; int_check(&top_of_stack); if (top_of_stack.v.int_val) /* non-zero */ return(x->j_arg); /* leave the argument on TOS */ else { (void) pop(&a); return 1; /* no jump */ } } /************************************************************/ int f_jtern(x) union argument *x; { struct value a; int_check(pop(&a)); if (a.v.int_val) return(1); /* no jump; fall through to TRUE code */ else return(x->j_arg); /* go jump to FALSE code */ } /****************************************************************************/