static int compatible(Type ty1, Type ty2) {
ty1 = unqual(ty1);
ty2 = unqual(ty2);
return isptr(ty1) && !isfunc(ty1->type)
&& isptr(ty2) && !isfunc(ty2->type)
&& eqtype(unqual(ty1->type), unqual(ty2->type), 0);
}
Tree condtree(Tree e, Tree l, Tree r) {
Symbol t1;
Type ty, xty = l->type, yty = r->type;
Tree p;
if (isarith(xty) && isarith(yty))
ty = binary(xty, yty);
else if (eqtype(xty, yty, 1))
ty = unqual(xty);
else if (isptr(xty) && isnullptr(r))
ty = xty;
else if (isnullptr(l) && isptr(yty))
ty = yty;
else if (isptr(xty) && !isfunc(xty->type) && isvoidptr(yty)
|| isptr(yty) && !isfunc(yty->type) && isvoidptr(xty))
ty = voidptype;
else if ((isptr(xty) && isptr(yty)
&& eqtype(unqual(xty->type), unqual(yty->type), 1)))
ty = xty;
else {
typeerror(COND, l, r);
return consttree(0, inttype);
}
if (isptr(ty)) {
ty = unqual(unqual(ty)->type);
if (isptr(xty) && isconst(unqual(xty)->type)
|| isptr(yty) && isconst(unqual(yty)->type))
ty = qual(CONST, ty);
if (isptr(xty) && isvolatile(unqual(xty)->type)
|| isptr(yty) && isvolatile(unqual(yty)->type))
ty = qual(VOLATILE, ty);
ty = ptr(ty);
}
switch (e->op) {
case CNST+I: return cast(e->u.v.i != 0 ? l : r, ty);
case CNST+U: return cast(e->u.v.u != 0 ? l : r, ty);
case CNST+P: return cast(e->u.v.p != 0 ? l : r, ty);
case CNST+F: return cast(e->u.v.d != 0.0 ? l : r, ty);
}
if (ty != voidtype && ty->size > 0) {
t1 = genident(REGISTER, unqual(ty), level);
/* t1 = temporary(REGISTER, unqual(ty)); */
l = asgn(t1, l);
r = asgn(t1, r);
} else
t1 = NULL;
p = tree(COND, ty, cond(e),
tree(RIGHT, ty, root(l), root(r)));
p->u.sym = t1;
return p;
}
/* subtree - construct tree for l - r */
static Tree subtree(int op, Tree l, Tree r) {
long n;
Type ty = inttype;
if (isarith(l->type) && isarith(r->type)) {
ty = binary(l->type, r->type);
l = cast(l, ty);
r = cast(r, ty);
} else if (isptr(l->type) && !isfunc(l->type->type) && isint(r->type)) {
ty = unqual(l->type);
n = unqual(ty->type)->size;
if (n == 0)
error("unknown size for type `%t'\n", ty->type);
r = cast(r, promote(r->type));
if (n > 1)
r = multree(MUL, cnsttree(signedptr, n), r);
if (isunsigned(r->type))
r = cast(r, unsignedptr);
else
r = cast(r, signedptr);
return simplify(SUB+P, ty, l, r);
} else if (compatible(l->type, r->type)) {
ty = unqual(l->type);
n = unqual(ty->type)->size;
if (n == 0)
error("unknown size for type `%t'\n", ty->type);
l = simplify(SUB+U, unsignedptr,
cast(l, unsignedptr), cast(r, unsignedptr));
return simplify(DIV+I, longtype,
cast(l, longtype), cnsttree(longtype, n));
} else
typeerror(op, l, r);
return simplify(op, ty, l, r);
}
static Tree addtree(int op, Tree l, Tree r) {
Type ty = inttype;
if (isarith(l->type) && isarith(r->type)) {
ty = binary(l->type, r->type);
l = cast(l, ty);
r = cast(r, ty);
} else if (isptr(l->type) && isint(r->type))
return addtree(ADD, r, l);
else if ( isptr(r->type) && isint(l->type)
&& !isfunc(r->type->type))
{
long n;
ty = unqual(r->type);
n = unqual(ty->type)->size;
if (n == 0)
error("unknown size for type `%t'\n", ty->type);
l = cast(l, promote(l->type));
if (n > 1)
l = multree(MUL, cnsttree(signedptr, n), l);
if (isunsigned(l->type))
l = cast(l, unsignedptr);
else
l = cast(l, signedptr);
if (YYcheck && !isaddrop(r->op)) /* omit */
return nullcall(ty, YYcheck, r, l); /* omit */
return simplify(ADD, ty, l, r);
}
else
typeerror(op, l, r);
return simplify(op, ty, l, r);
}
static void
load(CTy *t)
{
if(isitype(t) || isptr(t)) {
switch(t->size) {
case 8:
outi("movq (%%rax), %%rax\n");
break;
case 4:
outi("movslq (%%rax), %%rax\n");
break;
case 2:
outi("movswq (%%rax), %%rax\n");
break;
case 1:
outi("movsbq (%%rax), %%rax\n");
break;
default:
panic("internal error\n");
}
return;
}
if(isstruct(t)) {
return;
}
if(isarray(t)) {
return;
}
if(isfunc(t)) {
return;
}
errorf("unimplemented load %d\n", t->t);
}
static Tree expr2(void) {
Tree p = expr3(4);
if (t == '?') {
Tree l, r;
Coordinate pts[2];
if (Aflag > 1 && isfunc(p->type))
warning("%s used in a conditional expression\n", funcname(p));
p = pointer(p);
t = gettok();
pts[0] = src;
l = pointer(expr(':'));
pts[1] = src;
r = pointer(expr2());
if (events.points) {
apply(events.points, &pts[0], &l);
apply(events.points, &pts[1], &r);
}
p = condtree(p, l, r);
}
return p;
}
static bool first_funcdef(node_t * ty)
{
bool prototype = token->id == '{';
bool oldstyle = first_decl(token) && TYPE_OLDSTYLE(ty);
return isfunc(ty) && (prototype || oldstyle);
}
static void
call(Node *n)
{
int i, nargs, nintargs, cleanup;
Vec *args;
Node *arg;
args = n->Call.args;
i = nargs = args->len;
/* Push args in reverse order */
while(i-- != 0) {
arg = vecget(args, i);
if(!isitype(arg->type) && !isptr(arg->type) && !isarray(arg->type) && !isfunc(arg->type))
errorposf(&arg->pos, "unimplemented arg type\n");
expr(arg);
pushq("rax");
}
nintargs = nargs;
if(nintargs > 6)
nintargs = 6;
for(i = 0; i < nintargs; i++)
popq(intargregs[i]);
expr(n->Call.funclike);
outi("call *%%rax\n");
cleanup = 8 * (nargs - nintargs);
if(cleanup) {
outi("add $%d, %%rsp\n", cleanup);
stackoffset -= cleanup;
}
}
void
emitsym(Sym *sym)
{
out("# emit sym %s\n", sym->name);
switch(sym->k){
case SYMGLOBAL:
if(sym->Global.sclass == SCEXTERN)
break;
if(isfunc(sym->type)) {
func(sym->init, sym->Global.label, sym->Global.sclass == SCGLOBAL);
break;
}
penddata(sym->Global.label, sym->type, sym->init, sym->Global.sclass == SCGLOBAL);
break;
case SYMLOCAL:
if(sym->init) {
expr(sym->init);
pushq("rax");
outi("leaq %d(%%rbp), %%rax\n", sym->Local.slot->offset);
popq("rcx");
if(!isptr(sym->type) && !isitype(sym->type) && !isstruct(sym->type))
errorf("unimplemented init\n");
store(sym->type);
}
break;
case SYMENUM:
case SYMTYPE:
panic("internal error");
}
out("\n");
}
Tree eqtree(int op, Tree l, Tree r) {
Type xty = unqual(l->type), yty = unqual(r->type);
if (isptr(xty) && isnullptr(r)
|| isptr(xty) && !isfunc(xty->type) && isvoidptr(yty)
|| (isptr(xty) && isptr(yty)
&& eqtype(unqual(xty->type), unqual(yty->type), 1))) {
Type ty = unsignedptr;
l = cast(l, ty);
r = cast(r, ty);
return simplify(mkop(op,ty), inttype, l, r);
}
if (isptr(yty) && isnullptr(l)
|| isptr(yty) && !isfunc(yty->type) && isvoidptr(xty))
return eqtree(op, r, l);
return cmptree(op, l, r);
}
static Tree conditional(int tok) {
Tree p = expr(tok);
if (Aflag > 1 && isfunc(p->type))
warning("%s used in a conditional expression\n",
funcname(p));
return cond(p);
}
void spn_value_release(const SpnValue *val)
{
if (isobject(val)) {
assert(isstring(val) || isarray(val)
|| ishashmap(val) || isfunc(val)
|| isuserinfo(val));
spn_object_release(objvalue(val));
}
}
/* dbxout - output .stabs entry for type ty */
static void dbxout(Type ty) {
ty = unqual(ty);
if (!ty->x.printed) {
int col = 0;
print(".stabs \""), col += 8;
if (ty->u.sym && !(isfunc(ty) || isarray(ty) || isptr(ty)))
print("%s", ty->u.sym->name), col += strlen(ty->u.sym->name);
print(":%c", isstruct(ty) || isenum(ty) ? 'T' : 't'), col += 2;
emittype(ty, 0, col);
print("\",%d,0,0,0\n", N_LSYM);
}
}
int main ( int argc, char *argv[] ) {
void *funp = (void *)main;
void *texp = (void *)text;
size_t funl = sizeof( main )
, texl = sizeof( text )
, count = funl > texl ? funl : texl;
ISFUNC_BOOL isfunc_func, isfunc_text;
errno = 0;
if ( (isfunc_func = isfunc( funp ))
&& ! errno
&& ! (isfunc_text = isfunc( texp ))
&& ! errno ) {
printf( "main[%14p]: %s%s (%2lu) - %s\n", funp, hexdump( funp, count ), chardump( funp, count ), funl, isfunc_func ? "isfunc" : "! isfunc" );
printf( "text[%14p]: %s%s (%2lu) - %s\n", texp, hexdump( texp, count ), chardump( texp, count ), texl, isfunc_text ? "isfunc" : "! isfunc" );
}
printf( "isfunc is %sworking\n"
, ( ! errno && isfunc_func && ! isfunc_text )
? "" : "NOT " );
return 0;
}
static node_t *make_decl(struct token *id, node_t * ty, int sclass,
int fspec, declfun_p * dcl)
{
node_t *decl;
if (sclass == TYPEDEF)
decl = ast_decl(TYPEDEF_DECL);
else if (isfunc(ty))
decl = ast_decl(FUNC_DECL);
else
decl = ast_decl(VAR_DECL);
node_t *sym = dcl(id, ty, sclass, fspec);
DECL_SYM(decl) = sym;
return decl;
}
/* stabsym - output a stab entry for symbol p */
void stabsym(Symbol p) {
int code, tc, sz = p->type->size;
if (p->generated || p->computed)
return;
if (isfunc(p->type)) {
print(".stabs \"%s:%c%d\",%d,0,0,%s\n", p->name,
p->sclass == STATIC ? 'f' : 'F', dbxtype(freturn(p->type)),
N_FUN, p->x.name);
return;
}
if (!IR->wants_argb && p->scope == PARAM && p->structarg) {
assert(isptr(p->type) && isstruct(p->type->type));
tc = dbxtype(p->type->type);
sz = p->type->type->size;
} else
tc = dbxtype(p->type);
if (p->sclass == AUTO && p->scope == GLOBAL || p->sclass == EXTERN) {
print(".stabs \"%s:G", p->name);
code = N_GSYM;
} else if (p->sclass == STATIC) {
print(".stabs \"%s:%c%d\",%d,0,0,%s\n", p->name, p->scope == GLOBAL ? 'S' : 'V',
tc, p->u.seg == BSS ? N_LCSYM : N_STSYM, p->x.name);
return;
} else if (p->sclass == REGISTER) {
if (p->x.regnode) {
int r = p->x.regnode->number;
if (p->x.regnode->set == FREG)
r += 32; /* floating point */
print(".stabs \"%s:%c%d\",%d,0,", p->name,
p->scope == PARAM ? 'P' : 'r', tc, N_RSYM);
print("%d,%d\n", sz, r);
}
return;
} else if (p->scope == PARAM) {
print(".stabs \"%s:p", p->name);
code = N_PSYM;
} else if (p->scope >= LOCAL) {
print(".stabs \"%s:", p->name);
code = N_LSYM;
} else
assert(0);
print("%d\",%d,0,0,%s\n", tc, code,
p->scope >= PARAM && p->sclass != EXTERN ? p->x.name : "0");
}
Tree vcall(Symbol func, Type ty, ...) {
va_list ap;
Tree args = NULL, e, f = pointer(idtree(func)), r = NULL;
assert(isfunc(func->type));
if (ty == NULL)
ty = freturn(func->type);
va_start(ap, ty);
while ((e = va_arg(ap, Tree)) != NULL) {
if (hascall(e))
r = r == NULL ? e : tree(RIGHT, voidtype, r, e);
args = tree(mkop(ARG, e->type), e->type, e, args);
}
va_end(ap);
if (r != NULL)
args = tree(RIGHT, voidtype, r, args);
return calltree(f, ty, args, NULL);
}
static void r_symbol(SCTX_ unsigned mode, struct token *pos, struct symbol *sym)
{
char b[512];
if ((!sym->ctype.base_type || sym->ctype.base_type->type != SYM_FN) && !isglobal(sctx_ sym))
return;
print_usage(sctx_ pos, sym, mode);
if (!sym->ident)
sym->ident = MK_IDENT("__asm__");
memcpy(b, sym->ident->name, sym->ident->len);
b[sym->ident->len] = 0;
if (isfunc(sctx_ sym))
strcat(b, "()");
printf("%s%-32.*s %s 0x%x 0x%p %s\n", sctxp reporter->indent ? "\t" : "",
(int)strlen(b), b,
show_typename(sctx_ sym->ctype.base_type),
(unsigned int )sym->ctype.modifiers, sym, symbol_type_name(sym->type));
}
static void
cast(Node *n)
{
CTy *from;
CTy *to;
expr(n->Cast.operand);
from = n->Cast.operand->type;
to = n->type;
if(isptr(from) && isptr(to))
return;
if(isptr(to) && isitype(from))
return;
if(isptr(from) && isitype(to))
return;
if(isitype(from) && isitype(to))
return;
if(isfunc(from) && isptr(to))
return;
if(isarray(from) && isptr(to))
return;
errorf("unimplemented cast %d %d\n", from->t, to->t);
}
static int
isdeclarationcmd(struct narg *arg)
{
int have_command = 0;
if (arg == NULL)
return (0);
while (mustexpandto(arg->text, "command")) {
have_command = 1;
arg = &arg->next->narg;
if (arg == NULL)
return (0);
/*
* To also allow "command -p" and "command --" as part of
* a declaration command, add code here.
* We do not do this, as ksh does not do it either and it
* is not required by POSIX.
*/
}
return (mustexpandto(arg->text, "export") ||
mustexpandto(arg->text, "readonly") ||
(mustexpandto(arg->text, "local") &&
(have_command || !isfunc("local"))));
}
/* up - returns p's non-external ancestor */
static Symbol up(Symbol p) {
while (p != NULL && p->defined == 0
&& (p->sclass == EXTERN || isfunc(p->type) && p->sclass == AUTO))
p = p->up;
return p;
}
Tree unary(void) {
Tree p;
switch (t) {
case '*': t = gettok(); p = unary(); p = pointer(p);
if (isptr(p->type)
&& (isfunc(p->type->type) || isarray(p->type->type)))
p = retype(p, p->type->type);
else {
if (YYnull)
p = nullcheck(p);
p = rvalue(p);
} break;
case '&': t = gettok(); p = unary(); if (isarray(p->type) || isfunc(p->type))
p = retype(p, ptr(p->type));
else
p = lvalue(p);
if (isaddrop(p->op) && p->u.sym->sclass == REGISTER)
error("invalid operand of unary &; `%s' is declared register\n", p->u.sym->name);
else if (isaddrop(p->op))
p->u.sym->addressed = 1;
break;
case '+': t = gettok(); p = unary(); p = pointer(p);
if (isarith(p->type))
p = cast(p, promote(p->type));
else
typeerror(ADD, p, NULL); break;
case '-': t = gettok(); p = unary(); p = pointer(p);
if (isarith(p->type)) {
Type ty = promote(p->type);
p = cast(p, ty);
if (isunsigned(ty)) {
warning("unsigned operand of unary -\n");
p = simplify(ADD, ty, simplify(BCOM, ty, p, NULL), cnsttree(ty, 1UL));
} else
p = simplify(NEG, ty, p, NULL);
} else
typeerror(SUB, p, NULL); break;
case '~': t = gettok(); p = unary(); p = pointer(p);
if (isint(p->type)) {
Type ty = promote(p->type);
p = simplify(BCOM, ty, cast(p, ty), NULL);
} else
typeerror(BCOM, p, NULL); break;
case '!': t = gettok(); p = unary(); p = pointer(p);
if (isscalar(p->type))
p = simplify(NOT, inttype, cond(p), NULL);
else
typeerror(NOT, p, NULL); break;
case INCR: t = gettok(); p = unary(); p = incr(INCR, pointer(p), consttree(1, inttype)); break;
case DECR: t = gettok(); p = unary(); p = incr(DECR, pointer(p), consttree(1, inttype)); break;
case TYPECODE: case SIZEOF: { int op = t;
Type ty;
p = NULL;
t = gettok();
if (t == '(') {
t = gettok();
if (istypename(t, tsym)) {
ty = typename();
expect(')');
} else {
p = postfix(expr(')'));
ty = p->type;
}
} else {
int
isfuncptr(CTy *t)
{
return isptr(t) && isfunc(t->Ptr.subty);
}
Cell *call(Node **a, int n) /* function call. very kludgy and fragile */
{
static Cell newcopycell = { OCELL, CCOPY, 0, (char *) "", 0.0, NUM|STR|DONTFREE };
int i, ncall, ndef;
Node *x;
Cell *args[NARGS], *oargs[NARGS], *y, *z, *fcn;
char *s;
fcn = execute(a[0]); /* the function itself */
s = fcn->nval;
if (!isfunc(fcn))
ERROR "calling undefined function %s", s FATAL;
if (frame == NULL) {
fp = frame = (struct Frame *) calloc(nframe += 100, sizeof(struct Frame));
if (frame == NULL)
ERROR "out of space for stack frames calling %s", s FATAL;
}
for (ncall = 0, x = a[1]; x != NULL; x = x->nnext) /* args in call */
ncall++;
ndef = (int) fcn->fval; /* args in defn */
dprintf( ("calling %s, %d args (%d in defn), fp=%d\n", s, ncall, ndef, fp-frame) );
if (ncall > ndef)
ERROR "function %s called with %d args, uses only %d",
s, ncall, ndef WARNING;
if (ncall + ndef > NARGS)
ERROR "function %s has %d arguments, limit %d", s, ncall+ndef, NARGS FATAL;
for (i = 0, x = a[1]; x != NULL; i++, x = x->nnext) { /* get call args */
dprintf( ("evaluate args[%d], fp=%d:\n", i, fp-frame) );
y = execute(x);
oargs[i] = y;
dprintf( ("args[%d]: %s %f <%s>, t=%o\n",
i, y->nval, y->fval, isarr(y) ? "(array)" : (char*) y->sval, y->tval) );
if (isfunc(y))
ERROR "can't use function %s as argument in %s", y->nval, s FATAL;
if (isarr(y))
args[i] = y; /* arrays by ref */
else
args[i] = copycell(y);
tempfree(y);
}
for ( ; i < ndef; i++) { /* add null args for ones not provided */
args[i] = gettemp();
*args[i] = newcopycell;
}
fp++; /* now ok to up frame */
if (fp >= frame + nframe) {
int dfp = fp - frame; /* old index */
frame = (struct Frame *)
realloc((char *) frame, (nframe += 100) * sizeof(struct Frame));
if (frame == NULL)
ERROR "out of space for stack frames in %s", s FATAL;
fp = frame + dfp;
}
fp->fcncell = fcn;
fp->args = args;
fp->nargs = ndef; /* number defined with (excess are locals) */
fp->retval = gettemp();
dprintf( ("start exec of %s, fp=%d\n", s, fp-frame) );
y = execute((Node *)(fcn->sval)); /* execute body */
dprintf( ("finished exec of %s, fp=%d\n", s, fp-frame) );
for (i = 0; i < ndef; i++) {
Cell *t = fp->args[i];
if (isarr(t)) {
if (t->csub == CCOPY) {
if (i >= ncall) {
freesymtab(t);
t->csub = CTEMP;
} else {
oargs[i]->tval = t->tval;
oargs[i]->tval &= ~(STR|NUM|DONTFREE);
oargs[i]->sval = t->sval;
tempfree(t);
}
}
} else if (t != y) { /* kludge to prevent freeing twice */
t->csub = CTEMP;
tempfree(t);
}
}
tempfree(fcn);
if (isexit(y) || isnext(y) || isnextfile(y))
return y;
tempfree(y); /* this can free twice! */
z = fp->retval; /* return value */
dprintf( ("%s returns %g |%s| %o\n", s, getfval(z), getsval(z), z->tval) );
fp--;
return(z);
}
static Sym *
definesym(SrcPos *p, int sclass, char *name, CTy *type, Node *n)
{
Sym *sym;
if(sclass == SCAUTO || n != 0)
if(type->incomplete)
errorposf(p, "cannot use incomplete type in this context");
if(sclass == SCAUTO && isglobal())
errorposf(p, "defining local symbol in global scope");
sym = mapget(syms[nscopes - 1], name);
if(sym) {
switch(sym->k) {
case SYMTYPE:
if(sclass != SCTYPEDEF || !sametype(sym->type, type))
errorposf(p, "incompatible redefinition of typedef %s", name);
break;
case SYMGLOBAL:
if(sym->Global.sclass != sclass)
errorposf(p, "redefinition of %s with differing storage class", name);
if(sym->init && n)
errorposf(p, "%s already initialized", name);
if(!sym->init && n) {
sym->init = n;
emitsym(sym);
removetentativesym(sym);
}
break;
default:
errorposf(p, "redefinition of %s", name);
}
return sym;
}
sym = gcmalloc(sizeof(Sym));
sym->name = name;
sym->type = type;
sym->init = n;
switch(sclass) {
case SCAUTO:
sym->k = SYMLOCAL;
sym->Local.slot = gcmalloc(sizeof(StkSlot));
sym->Local.slot->size = sym->type->size;
sym->Local.slot->align = sym->type->align;
vecappend(curfunc->Func.stkslots, sym->Local.slot);
break;
case SCTYPEDEF:
sym->k = SYMTYPE;
break;
case SCGLOBAL:
sym->k = SYMGLOBAL;
sym->Global.label = name;
sym->Global.sclass = SCGLOBAL;
break;
case SCSTATIC:
sym->k = SYMGLOBAL;
sym->Global.label = newlabel();
sym->Global.sclass = SCSTATIC;
break;
}
if(sym->k == SYMGLOBAL) {
if(sym->init)
emitsym(sym);
else
if(!isfunc(sym->type))
addtentativesym(sym);
}
if(!define(syms, name, sym))
panic("internal error");
return sym;
}
int nexttoken(void)
/* Gets the next token from the input stream */
{
char *start, numstring[80];
int decimal, len, numlen;
while (*input == ' ')
input++;
if (*input == 0)
return(EOLN);
if (strchr("0123456789.", *input))
{
start = input;
len = 0;
decimal = FALSE;
while ((isdigit(*input)) ||
((*input == '.') && (!decimal)))
{
if (*input == '.')
decimal = TRUE;
input++;
len++;
}
if ((len == 1) && (start[0] == '.'))
return(BAD);
if (*input == 'E')
{
input++;
len++;
if (strchr("+-", *input) != NULL)
{
input++;
len++;
}
numlen = 0;
while ((isdigit(*input)) && (++numlen <= 3))
{
input++;
len++;
}
}
strncpy(numstring, start, len);
numstring[len] = 0;
curtoken.x.value = atof(numstring);
if (errno == ERANGE)
return(BAD);
return(NUM);
}
else if (isalpha(*input))
{
if
(isfunc("ABS") ||
isfunc("ACOS") ||
isfunc("ASIN") ||
isfunc("ATAN") ||
isfunc("COSH") ||
isfunc("COS") ||
isfunc("EXP") ||
isfunc("LOG10") ||
isfunc("LOG") ||
isfunc("POW10") ||
isfunc("ROUND") ||
isfunc("SINH") ||
isfunc("SIN") ||
isfunc("SQRT") ||
isfunc("SQR") ||
isfunc("TANH") ||
isfunc("TAN") ||
isfunc("TRUNC"))
return(FUNC);
if (formulastart(&input, &curtoken.x.c.col, &curtoken.x.c.row))
{
isformula = TRUE;
return(CELL);
}
else
return(BAD);
}
else switch(*(input++))
{
case '+' : return(PLUS);
case '-' : return(MINUS);
case '*' : return(TIMES);
case '/' : return(DIVIDE);
case '^' : return(EXP);
case ':' : return(COLON);
case '(' : return(OPAREN);
case ')' : return(CPAREN);
default : return(BAD);
} /* switch */
} /* nexttoken */