EPNODE *
getE3(void) /* E3 -> E4 ^ E3 */
/* E4 */
{
EPNODE *ep1, *ep2;
ep1 = getE4();
if (nextc != '^')
return(ep1);
ep2 = newnode();
ep2->type = nextc;
scan();
addekid(ep2, ep1);
addekid(ep2, getE3());
if (esupport&E_RCONST) {
EPNODE *ep3 = ep1->sibling;
if (ep1->type == NUM && ep3->type == NUM) {
ep2 = rconst(ep2);
} else if (ep1->type == NUM && ep1->v.num == 0) {
epfree(ep3); /* (0 ^ E3) */
ep1->sibling = NULL;
efree((char *)ep2);
ep2 = ep1;
} else if ((ep3->type == NUM && ep3->v.num == 0) ||
(ep1->type == NUM && ep1->v.num == 1)) {
epfree(ep2); /* (E4 ^ 0) or (1 ^ E3) */
ep2 = newnode();
ep2->type = NUM;
ep2->v.num = 1;
}
}
return(ep2);
}
EPNODE *
getE4(void) /* E4 -> ADDOP E5 */
/* E5 */
{
EPNODE *ep1, *ep2;
if (nextc == '-') {
scan();
ep2 = getE5();
if (ep2->type == NUM) {
ep2->v.num = -ep2->v.num;
return(ep2);
}
if (ep2->type == UMINUS) { /* don't generate -(-E5) */
ep1 = ep2->v.kid;
efree((char *)ep2);
return(ep1);
}
ep1 = newnode();
ep1->type = UMINUS;
addekid(ep1, ep2);
return(ep1);
}
if (nextc == '+')
scan();
return(getE5());
}
EPNODE *
getE1(void) /* E1 -> E1 ADDOP E2 */
/* E2 */
{
EPNODE *ep1, *ep2;
ep1 = getE2();
while (nextc == '+' || nextc == '-') {
ep2 = newnode();
ep2->type = nextc;
scan();
addekid(ep2, ep1);
addekid(ep2, getE2());
if (esupport&E_RCONST &&
ep1->type == NUM && ep1->sibling->type == NUM)
ep2 = rconst(ep2);
ep1 = ep2;
}
return(ep1);
}
EPNODE *
getE2(void) /* E2 -> E2 MULOP E3 */
/* E3 */
{
EPNODE *ep1, *ep2;
ep1 = getE3();
while (nextc == '*' || nextc == '/') {
ep2 = newnode();
ep2->type = nextc;
scan();
addekid(ep2, ep1);
addekid(ep2, getE3());
if (esupport&E_RCONST) {
EPNODE *ep3 = ep1->sibling;
if (ep1->type == NUM && ep3->type == NUM) {
ep2 = rconst(ep2);
} else if (ep3->type == NUM) {
if (ep2->type == '/') {
if (ep3->v.num == 0)
syntax("divide by zero constant");
ep2->type = '*'; /* for speed */
ep3->v.num = 1./ep3->v.num;
} else if (ep3->v.num == 0) {
ep1->sibling = NULL; /* (E2 * 0) */
epfree(ep2);
ep2 = ep3;
}
} else if (ep1->type == NUM && ep1->v.num == 0) {
epfree(ep3); /* (0 * E3) or (0 / E3) */
ep1->sibling = NULL;
efree((char *)ep2);
ep2 = ep1;
}
}
ep1 = ep2;
}
return(ep1);
}
EPNODE *
getdefn(void)
/* A -> SYM = E1 */
/* SYM : E1 */
/* FUNC(SYM,..) = E1 */
/* FUNC(SYM,..) : E1 */
{
EPNODE *ep1, *ep2;
if (!isalpha(nextc) && nextc != CNTXMARK)
syntax("illegal variable name");
ep1 = newnode();
ep1->type = SYM;
ep1->v.name = savestr(getname());
if (esupport&E_FUNCTION && nextc == '(') {
ep2 = newnode();
ep2->type = FUNC;
addekid(ep2, ep1);
ep1 = ep2;
do {
scan();
if (!isalpha(nextc))
syntax("illegal parameter name");
ep2 = newnode();
ep2->type = SYM;
ep2->v.name = savestr(getname());
addekid(ep1, ep2);
} while (nextc == ',');
if (nextc != ')')
syntax("')' expected");
scan();
curfunc = ep1;
}
if (nextc != '=' && nextc != ':')
syntax("'=' or ':' expected");
ep2 = newnode();
ep2->type = nextc;
scan();
addekid(ep2, ep1);
addekid(ep2, getE1());
if (ep1->type == SYM && ep1->sibling->type != NUM) {
ep1 = newnode();
ep1->type = CLKT;
ep1->v.tick = 0;
addekid(ep2, ep1);
ep1 = newnode();
ep1->type = NUM;
addekid(ep2, ep1);
}
curfunc = NULL;
return(ep2);
}
void
varset( /* set a variable's value */
char *vname,
int assign,
double val
)
{
char *qname;
EPNODE *ep1, *ep2;
/* get qualified name */
qname = qualname(vname, 0);
/* check for quick set */
if ((ep1 = dlookup(qname)) != NULL && ep1->v.kid->type == SYM &&
(ep1->type == ':') <= (assign == ':')) {
ep2 = ep1->v.kid->sibling;
if (ep2->type == NUM) {
ep2->v.num = val;
ep1->type = assign;
return;
}
}
/* hand build definition */
ep1 = newnode();
ep1->type = assign;
ep2 = newnode();
ep2->type = SYM;
ep2->v.name = savestr(vname);
addekid(ep1, ep2);
ep2 = newnode();
ep2->type = NUM;
ep2->v.num = val;
addekid(ep1, ep2);
if (assign == ':')
dremove(qname);
else
dclear(qname);
dpush(qname, ep1);
}
EPNODE *
getchan(void) /* A -> $N = E1 */
{
EPNODE *ep1, *ep2;
if (nextc != '$')
syntax("missing '$'");
scan();
ep1 = newnode();
ep1->type = CHAN;
ep1->v.chan = getinum();
if (nextc != '=')
syntax("'=' expected");
scan();
ep2 = newnode();
ep2->type = '=';
addekid(ep2, ep1);
addekid(ep2, getE1());
return(ep2);
}
EPNODE *
getE5(void) /* E5 -> (E1) */
/* VAR */
/* NUM */
/* $N */
/* FUNC(E1,..) */
/* ARG */
{
int i;
char *nam;
EPNODE *ep1, *ep2;
if (nextc == '(') {
scan();
ep1 = getE1();
if (nextc != ')')
syntax("')' expected");
scan();
return(ep1);
}
if (esupport&E_INCHAN && nextc == '$') {
scan();
ep1 = newnode();
ep1->type = CHAN;
ep1->v.chan = getinum();
return(ep1);
}
if (esupport&(E_VARIABLE|E_FUNCTION) &&
(isalpha(nextc) || nextc == CNTXMARK)) {
nam = getname();
ep1 = NULL;
if ((esupport&(E_VARIABLE|E_FUNCTION)) == (E_VARIABLE|E_FUNCTION)
&& curfunc != NULL)
for (i = 1, ep2 = curfunc->v.kid->sibling;
ep2 != NULL; i++, ep2 = ep2->sibling)
if (!strcmp(ep2->v.name, nam)) {
ep1 = newnode();
ep1->type = ARG;
ep1->v.chan = i;
break;
}
if (ep1 == NULL) {
ep1 = newnode();
ep1->type = VAR;
ep1->v.ln = varinsert(nam);
}
if (esupport&E_FUNCTION && nextc == '(') {
ep2 = newnode();
ep2->type = FUNC;
addekid(ep2, ep1);
ep1 = ep2;
do {
scan();
addekid(ep1, getE1());
} while (nextc == ',');
if (nextc != ')')
syntax("')' expected");
scan();
} else if (!(esupport&E_VARIABLE))
syntax("'(' expected");
if (esupport&E_RCONST && isconstvar(ep1))
ep1 = rconst(ep1);
return(ep1);
}
if (isdecimal(nextc)) {
ep1 = newnode();
ep1->type = NUM;
ep1->v.num = getnum();
return(ep1);
}
syntax("unexpected character");
return NULL; /* pro forma return */
}
