/*
 * codegen - module to generate opcodes from the input tokens
 *
 * Copyright (C) 1999-2007,2017,2021-2023  David I. Bell and Ernest Bowen
 *
 * Primary author:  David I. Bell
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:   1990/02/15 01:48:13
 * File existed as early as:    before 1990
 *
 * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
 */


#include <stdio.h>
#include "have_unistd.h"
#if defined(HAVE_UNISTD_H)
#include <unistd.h>
#endif

#include "lib_calc.h"
#include "calc.h"
#include "alloc.h"
#include "token.h"
#include "symbol.h"
#include "label.h"
#include "opcodes.h"
#include "str.h"
#include "func.h"
#include "conf.h"
#include "strl.h"

#if defined(_WIN32) || defined(_WIN64)
#if !defined(__CYGWIN__)
# include <direct.h>
#endif
#endif


#include "errtbl.h"
#include "banned.h"     /* include after system header <> includes */


STATIC bool rdonce;     /* true => do not reread this file */

FUNC *curfunc;

S_FUNC int getsymvalue(char *name, VALUE *v_p);
S_FUNC int getfilename(char *name, size_t namelen, bool *once);
S_FUNC bool getid(char *buf);
S_FUNC void getshowstatement(void);
S_FUNC void getfunction(void);
S_FUNC void ungetfunction(void);
S_FUNC void getbody(LABEL *contlabel, LABEL *breaklabel,
                    LABEL *nextcaselabel, LABEL *defaultlabel);
S_FUNC int getdeclarations(int symtype);
S_FUNC int getsimpledeclaration (int symtype);
S_FUNC int getonevariable (int symtype);
S_FUNC void getstatement(LABEL *contlabel, LABEL *breaklabel,
                         LABEL *nextcaselabel, LABEL *defaultlabel);
S_FUNC void getobjdeclaration(int symtype);
S_FUNC void getoneobj(long index, int symtype);
S_FUNC void getobjvars(char *name, int symtype);
S_FUNC void getmatdeclaration(int symtype);
S_FUNC void getonematrix(int symtype);
S_FUNC void creatematrix(void);
S_FUNC void getsimplebody(void);
S_FUNC void getcondition(void);
S_FUNC void getmatargs(void);
S_FUNC void getelement(void);
S_FUNC void usesymbol(char *name, int autodef);
S_FUNC void definesymbol(char *name, int symtype);
S_FUNC void getcallargs(char *name);
S_FUNC void do_changedir(void);
S_FUNC int getexprlist(void);
S_FUNC int getopassignment(void);
S_FUNC int getassignment(void);
S_FUNC int getaltcond(void);
S_FUNC int getorcond(void);
S_FUNC int getandcond(void);
S_FUNC int getrelation(void);
S_FUNC int getsum(void);
S_FUNC int getproduct(void);
S_FUNC int getorexpr(void);
S_FUNC int getandexpr(void);
S_FUNC int getshiftexpr(void);
S_FUNC int getreference(void);
S_FUNC int getincdecexpr(void);
S_FUNC int getterm(void);
S_FUNC int getidexpr(bool okmat, int autodef);
S_FUNC long getinitlist(void);

#define INDICALLOC 8

STATIC int quickindices[INDICALLOC];
STATIC int * newindices;
STATIC int * indices;
STATIC int maxindices;


/*
 * Read all the commands from an input file.
 * These are either declarations, or else are commands to execute now.
 * In general, commands are terminated by newlines or semicolons.
 * Exceptions are function definitions and escaped newlines.
 * Commands are read and executed until the end of file.
 * The toplevel flag indicates whether we are at the top interactive level.
 */
void
getcommands(bool toplevel)
{
        char name[MAXCMD+1+1];  /* program name */

        /* firewall */
        name[0] = '\0';
        name[MAXCMD+1] = '\0';
        abort_now = false;

        /* getcommands */
        if (!toplevel)
                enterfilescope();
        for (;;) {
                int i;
                (void) tokenmode(TM_NEWLINES);
                switch (gettoken()) {

                case T_DEFINE:
                        getfunction();
                        break;

                case T_EOF:
                        if (!toplevel)
                                exitfilescope();
                        return;

                case T_HELP:
                        for (i=1;;i++) {
                                switch(getfilename(name, MAXCMD+1, NULL)) {
                                case 1:
                                case -1:
                                        if(i == 1) {
                                                strlcpy(name,
                                                        DEFAULTCALCHELP,
                                                        MAXCMD+1);
                                                givehelp(name);
                                        }
                                        break;
                                case 0:
                                        givehelp(name);
                                        continue;
                                default:
                                        break;
                                }
                                break;
                        }
                        break;

                case T_READ:
                        if (!allow_read) {
                                scanerror(T_NULL,
                                    "read command disallowed by -m mode\n");
                                break;
                        }
                        for (;;) {
                                int open_ret;

                                if (getfilename(name, MAXCMD+1, &rdonce))
                                        break;
                                open_ret = opensearchfile(name,calcpath,
                                                          CALCEXT,rdonce);
                                switch (open_ret) {
                                case 0:
                                        getcommands(false);
                                        closeinput();
                                        continue;
                                case 1:
                                        /* prev read and -once was given */
                                        continue;
                                case -2:
                                        scanerror(T_NULL,
                                                 "Maximum input depth reached");
                                        break;
                                default:
                                        scanerror(T_NULL,
                                                  "Cannot open \"%s\"", name);
                                        continue;
                                }
                                break;
                        }
                        break;

                case T_WRITE:
                        if (!allow_write) {
                                scanerror(T_NULL,
                                    "write command disallowed by -m mode\n");
                                break;
                        }
                        if (getfilename(name, MAXCMD+1, NULL))
                                break;
                        if (writeglobals(name)) {
                                scanerror(T_NULL,
                                          "Error writing \"%s\"\n", name);
                        }
                        break;

                case T_CD:
                        do_changedir();
                        break;
                case T_NEWLINE:
                case T_SEMICOLON:
                        break;

                default:
                        rescantoken();
                        initstack();
                        if (evaluate(false))
                                updateoldvalue(curfunc);
                        freefunc(curfunc);
                        if (abort_now) {
                                if (!stdin_tty)
                                        run_state = RUN_EXIT;
                                else if (run_state < RUN_PRE_TOP_LEVEL)
                                run_state = RUN_PRE_TOP_LEVEL;
                                if (calc_use_scanerr_jmpbuf != 0) {
                                        longjmp(calc_scanerr_jmpbuf, 30);
                                } else {
                                        fprintf(stderr,
                          "calc_scanerr_jmpbuf not setup, exiting code 30\n");
                                        libcalc_call_me_last();
                                        exit(30);
                                }
                        }
                }
        }
}


/*
 * Evaluate a line of statements.
 * This is done by treating the current line as a function body,
 * compiling it, and then executing it.  Returns true if the line
 * successfully compiled and executed.  The last expression result
 * is saved in the f_savedvalue element of the current function.
 * The nestflag variable should be false for the outermost evaluation
 * level, and true for all other calls (such as the 'eval' function).
 * The function name begins with an asterisk to indicate specialness.
 *
 * given:
 *      nestflag                true if this is a nested evaluation
 */
bool
evaluate(bool nestflag)
{
        char *funcname;
        int loop = 1;           /* 0 => end the main while loop */

        funcname = (nestflag ? "**" : "*");
        beginfunc(funcname, nestflag);
        if (gettoken() == T_LEFTBRACE) {
                getbody(NULL_LABEL, NULL_LABEL, NULL_LABEL, NULL_LABEL);
        } else {
                if (nestflag)
                        (void) tokenmode(TM_DEFAULT);
                rescantoken();
                while (loop) {
                        switch (gettoken()) {
                        case T_SEMICOLON:
                                break;
                        case T_NEWLINE:
                        case T_EOF:
                                loop = 0;
                                break;

                        default:
                                rescantoken();
                                getstatement(NULL_LABEL, NULL_LABEL,
                                        NULL_LABEL, NULL_LABEL);
                        }
                }
        }
        addop(OP_UNDEF);
        addop(OP_RETURN);
        checklabels();
        if (errorcount)
                return false;
        calculate(curfunc, 0);
        return true;
}

/*
 * Undefine one or more functions
 */
S_FUNC void
ungetfunction(void)
{
        char *name;
        int type;

        for (;;) {
                switch (gettoken()) {
                case T_COMMA:
                        continue;
                case T_SYMBOL:
                        name = tokensymbol();
                        type = getbuiltinfunc(name);
                        if (type >= 0) {
                                warning(
                        "Cannot undefine builtin function \"%s\"", name);
                        continue;
                        }
                        rmuserfunc(name);
                        continue;
                case T_MULT:
                        rmalluserfunc();
                        continue;
                case T_STATIC:
                        if (gettoken() != T_SYMBOL) {
                                scanerror(T_SEMICOLON,
                         "Non-identifier following \"undefine static\"");
                                return;
                        }
                        name = tokensymbol();
                        endscope(name, false);
                        continue;

                case T_NEWLINE:
                case T_SEMICOLON:
                case T_EOF:
                        rescantoken();
                        return;
                default:
                        scanerror(T_SEMICOLON, "Non-name arg for undefine");
                        return;
                }
        }
}


/*
 * Get a function declaration.
 * func = name '(' '' | name [ ',' name] ... ')' simplebody
 *      | name '(' '' | name [ ',' name] ... ')' body.
 */
S_FUNC void
getfunction(void)
{
        char *name;             /* parameter name */
        int type;               /* type of token read */
        LABEL label;
        long index;

        (void) tokenmode(TM_DEFAULT);
        if (gettoken() != T_SYMBOL) {
                scanerror(T_NULL, "Function name was expected");
                return;
        }
        name = tokensymbol();
        type = getbuiltinfunc(name);
        if (type >= 0) {
                scanerror(T_SEMICOLON, "Using builtin function name");
                return;
        }
        beginfunc(name, false);
        enterfuncscope();
        if (gettoken() != T_LEFTPAREN) {
                scanerror(T_SEMICOLON,
                        "Left parenthesis expected for function");
                return;
        }
        index = 0;
        for (;;) {
                type = gettoken();
                if (type == T_RIGHTPAREN)
                        break;
                if (type != T_SYMBOL) {
                        scanerror(T_COMMA,
                        "Using non-identifier as function parameter");
                        return;
                }
                name = tokensymbol();
                switch (symboltype(name)) {
                case SYM_UNDEFINED:
                case SYM_GLOBAL:
                case SYM_STATIC:
                        index = addparam(name);
                        break;
                default:
                        scanerror(T_NULL,
                                  "Parameter \"%s\" is already defined",
                                  name);
                }
                type = gettoken();
                if (type == T_ASSIGN) {
                        clearlabel(&label);
                        addopone(OP_PARAMADDR, index);
                        addoplabel(OP_JUMPNN, &label);
                        getopassignment();
                        addop(OP_ASSIGNPOP);
                        setlabel(&label);
                        type = gettoken();
                }

                if (type == T_RIGHTPAREN)
                        break;
                if (type != T_COMMA) {
                        scanerror(T_COMMA,
                        "Using other than comma to separate parameters");
                        return;
                }
        }
        switch (gettoken()) {
        case T_ASSIGN:
                getsimplebody();
                break;
        case T_LEFTBRACE:
                getbody(NULL_LABEL, NULL_LABEL, NULL_LABEL,
                        NULL_LABEL);
                break;
        default:
                scanerror(T_NULL,
                        "Left brace or equals sign expected for function");
                return;
        }
        endfunc();
        exitfuncscope();
}


/*
 * Get a simple assignment style body for a function declaration.
 * simplebody = '=' assignment '\n'.
 */
S_FUNC void
getsimplebody(void)
{
        (void) tokenmode(TM_NEWLINES);
        (void) getexprlist();
        addop(OP_RETURN);
}


/*
 * Get the body of a function, or a sub-body of a function.
 * body = '{' [ declarations ] ... [ statement ] ... '}'
 *      | [ declarations ] ... [statement ] ... '\n'
 */
/*ARGSUSED*/
S_FUNC void
getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel,
        LABEL *defaultlabel)
{
        int oldmode;

        oldmode = tokenmode(TM_DEFAULT);
        while (true) {
                switch (gettoken()) {
                case T_RIGHTBRACE:
                        (void) tokenmode(oldmode);
                        return;

                case T_EOF:
                        scanerror(T_NULL, "End-of-file in function body");
                        return;

                default:
                        rescantoken();
                        getstatement(contlabel, breaklabel,
                                     nextcaselabel, defaultlabel);
                }
        }
}


/*
 * Get a line of possible local, global, or static variable declarations.
 * declarations = { LOCAL | GLOBAL | STATIC } onedeclaration
 *      [ ',' onedeclaration ] ... ';'.
 */
S_FUNC int
getdeclarations(int symtype)
{
        int res = 0;

        while (true) {
                switch (gettoken()) {
                case T_COMMA:
                        continue;

                case T_NEWLINE:
                case T_SEMICOLON:
                case T_RIGHTBRACE:
                case T_EOF:
                        rescantoken();
                        return res;

                case T_SYMBOL:
                        addopone(OP_DEBUG, linenumber());
                        rescantoken();
                        if (getsimpledeclaration(symtype))
                                res = 1;
                        break;

                case T_MAT:
                        addopone(OP_DEBUG, linenumber());
                        getmatdeclaration(symtype);
                        res = 1;
                        break;

                case T_OBJ:
                        addopone(OP_DEBUG, linenumber());
                        getobjdeclaration(symtype);
                        addop(OP_POP);
                        res = 1;
                        break;

                default:
                        scanerror(T_SEMICOLON,
                                 "Bad syntax in declaration statement");
                        return res;
                }
        }
}


/*
 * Get declaration of a sequence of simple identifiers, as in
 *      global a, b = 1, c d = 2, d;
 * Subsequences end with "," or at end of line; spaces indicate
 * repeated assignment, e.g. "c d = 2" has the effect of "c = 2, d = 2".
 */
S_FUNC int
getsimpledeclaration(int symtype)
{
        int res = 0;

        for (;;) {
                switch (gettoken()) {
                case T_SYMBOL:
                        rescantoken();
                        if (getonevariable(symtype)) {
                                res = 1;
                                addop(OP_POP);
                        }
                        continue;
                case T_COMMA:
                        continue;
                default:
                        rescantoken();
                        return res;
                }
        }
}


/*
 * Get one variable in a sequence of simple identifiers.
 * Returns 1 if the subsequence in which the variable occurs ends with
 * an assignment, e.g. for the variables b, c, d, in
 *      S_FUNC a, b = 1, c d = 2, d;
 */
S_FUNC int
getonevariable(int symtype)
{
        char *name;
        int res = 0;

        switch(gettoken()) {
        case T_SYMBOL:
                name = addliteral(tokensymbol());
                res = getonevariable(symtype);
                definesymbol(name, symtype);
                if (res) {
                        usesymbol(name, 0);
                        addop(OP_ASSIGNBACK);
                }
                return res;
        case T_ASSIGN:
                getopassignment();
                rescantoken();
                return 1;
        default:
                rescantoken();
                return 0;
        }
}

/*
 * Get a statement.
 * statement = IF condition statement [ELSE statement]
 *      | FOR '(' [assignment] ';' [assignment] ';' [assignment] ')' statement
 *      | WHILE condition statement
 *      | DO statement WHILE condition ';'
 *      | SWITCH condition '{' [caseclause] ... '}'
 *      | CONTINUE ';'
 *      | BREAK ';'
 *      | RETURN assignment ';'
 *      | GOTO label ';'
 *      | PRINT assignment [, assignment ] ... ';'
 *      | QUIT [ string ] ';'
 *      | ABORT [ string ] ';'
 *      | SHOW item ';'
 *      | body
 *      | assignment ';'
 *      | label ':' statement
 *      | ';'.
 *
 * given:
 *      contlabel               label for continue statement
 *      breaklabel              label for break statement
 *      nextcaselabel           label for next case statement
 *      defaultlabel            label for default case
 */
S_FUNC void
getstatement(LABEL *contlabel, LABEL *breaklabel,
             LABEL *nextcaselabel, LABEL *defaultlabel)
{
        LABEL label;
        LABEL label1, label2, label3, label4;   /* locations for jumps */
        int type;
        bool printeol;
        int oldmode;

        addopone(OP_DEBUG, linenumber());
        switch (gettoken()) {
        case T_NEWLINE:
        case T_SEMICOLON:
                return;

        case T_GLOBAL:
                (void) getdeclarations(SYM_GLOBAL);
                break;

        case T_STATIC:
                clearlabel(&label);
                addoplabel(OP_INITSTATIC, &label);
                if (getdeclarations(SYM_STATIC))
                        setlabel(&label);
                else
                        curfunc->f_opcodecount -= 2;
                break;

        case T_LOCAL:
                (void) getdeclarations(SYM_LOCAL);
                break;

        case T_UNDEFINE:
                ungetfunction();
                break;

        case T_RIGHTBRACE:
                scanerror(T_NULL, "Extraneous right brace");
                return;

        case T_CONTINUE:
                if (contlabel == NULL_LABEL) {
                        scanerror(T_SEMICOLON,
                                  "CONTINUE not within FOR, WHILE, or DO");
                        return;
                }
                addoplabel(OP_JUMP, contlabel);
                break;

        case T_BREAK:
                if (breaklabel == NULL_LABEL) {
                        scanerror(T_SEMICOLON,
                                  "BREAK not within FOR, WHILE, or DO");
                        return;
                }
                addoplabel(OP_JUMP, breaklabel);
                break;

        case T_GOTO:
                if (gettoken() != T_SYMBOL) {
                        scanerror(T_SEMICOLON, "Missing label in goto");
                        return;
                }
                addop(OP_JUMP);
                addlabel(tokensymbol());
                break;

        case T_RETURN:
                switch (gettoken()) {
                case T_NEWLINE:
                case T_SEMICOLON:
                        addop(OP_UNDEF);
                        addop(OP_RETURN);
                        return;
                default:
                        rescantoken();
                        (void) getexprlist();
                        if (curfunc->f_name[0] == '*')
                                addop(OP_SAVE);
                        addop(OP_RETURN);
                }
                break;

        case T_LEFTBRACE:
                getbody(contlabel, breaklabel, nextcaselabel, defaultlabel);
                return;

        case T_IF:
                clearlabel(&label1);
                clearlabel(&label2);
                getcondition();
                switch(gettoken()) {
                case T_CONTINUE:
                        if (contlabel == NULL_LABEL) {
                                scanerror(T_SEMICOLON,
                                          "CONTINUE not within FOR, "
                                          "WHILE, or DO");
                                return;
                        }
                        addoplabel(OP_JUMPNZ, contlabel);
                        break;
                case T_BREAK:
                        if (breaklabel == NULL_LABEL) {
                                scanerror(T_SEMICOLON,
                                          "BREAK not within FOR, "
                                          "WHILE, or DO");
                                return;
                        }
                        addoplabel(OP_JUMPNZ, breaklabel);
                        break;
                case T_GOTO:
                        if (gettoken() != T_SYMBOL) {
                                scanerror(T_SEMICOLON,
                                          "Missing label in goto");
                                return;
                        }
                        addop(OP_JUMPNZ);
                        addlabel(tokensymbol());
                        break;
                default:
                        addoplabel(OP_JUMPZ, &label1);
                        rescantoken();
                        getstatement(contlabel, breaklabel,
                                     NULL_LABEL, NULL_LABEL);
                        if (gettoken() != T_ELSE) {
                                setlabel(&label1);
                                rescantoken();
                                return;
                        }
                        addoplabel(OP_JUMP, &label2);
                        setlabel(&label1);
                        getstatement(contlabel, breaklabel,
                                     NULL_LABEL, NULL_LABEL);
                        setlabel(&label2);
                        return;
                }
                if (gettoken() != T_SEMICOLON) /* This makes ';' optional */
                        rescantoken();
                if (gettoken() != T_ELSE) {
                        rescantoken();
                        return;
                }
                getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
                return;

        case T_FOR:     /* for (a; b; c) x */
                oldmode = tokenmode(TM_DEFAULT);
                clearlabel(&label1);
                clearlabel(&label2);
                clearlabel(&label3);
                clearlabel(&label4);
                contlabel = NULL_LABEL;
                breaklabel = &label4;
                if (gettoken() != T_LEFTPAREN) {
                        (void) tokenmode(oldmode);
                        scanerror(T_SEMICOLON, "Left parenthesis expected");
                        return;
                }
                if (gettoken() != T_SEMICOLON) {        /* have 'a' part */
                        rescantoken();
                        (void) getexprlist();
                        addop(OP_POP);
                        if (gettoken() != T_SEMICOLON) {
                                (void) tokenmode(oldmode);
                                scanerror(T_SEMICOLON, "Missing semicolon");
                                return;
                        }
                }
                if (gettoken() != T_SEMICOLON) {        /* have 'b' part */
                        setlabel(&label1);
                        contlabel = &label1;
                        rescantoken();
                        (void) getexprlist();
                        addoplabel(OP_JUMPNZ, &label3);
                        addoplabel(OP_JUMP, breaklabel);
                        if (gettoken() != T_SEMICOLON) {
                                (void) tokenmode(oldmode);
                                scanerror(T_SEMICOLON, "Missing semicolon");
                                return;
                        }
                }
                if (gettoken() != T_RIGHTPAREN) {       /* have 'c' part */
                        if (label1.l_offset < 0)
                                addoplabel(OP_JUMP, &label3);
                        setlabel(&label2);
                        contlabel = &label2;
                        rescantoken();
                        (void) getexprlist();
                        addop(OP_POP);
                        if (label1.l_offset >= 0)
                                addoplabel(OP_JUMP, &label1);
                        if (gettoken() != T_RIGHTPAREN) {
                                (void) tokenmode(oldmode);
                                scanerror(T_SEMICOLON,
                                          "Right parenthesis expected");
                                return;
                        }
                }
                setlabel(&label3);
                if (contlabel == NULL_LABEL)
                        contlabel = &label3;
                (void) tokenmode(oldmode);
                getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
                addoplabel(OP_JUMP, contlabel);
                setlabel(breaklabel);
                return;

        case T_WHILE:
                oldmode = tokenmode(TM_DEFAULT);
                contlabel = &label1;
                clearlabel(contlabel);
                setlabel(contlabel);
                getcondition();
                (void) tokenmode(oldmode);
                if (gettoken() != T_SEMICOLON) {
                        breaklabel = &label2;
                        clearlabel(breaklabel);
                        addoplabel(OP_JUMPZ, breaklabel);
                        rescantoken();
                        getstatement(contlabel, breaklabel,
                                NULL_LABEL, NULL_LABEL);
                        addoplabel(OP_JUMP, contlabel);
                        setlabel(breaklabel);
                } else {
                        addoplabel(OP_JUMPNZ, contlabel);
                }
                return;

        case T_DO:
                oldmode = tokenmode(TM_DEFAULT);
                contlabel = &label1;
                breaklabel = &label2;
                clearlabel(contlabel);
                clearlabel(breaklabel);
                clearlabel(&label3);
                setlabel(&label3);
                getstatement(contlabel, breaklabel, NULL_LABEL, NULL_LABEL);
                if (gettoken() != T_WHILE) {
                        (void) tokenmode(oldmode);
                        scanerror(T_SEMICOLON,
                                  "WHILE keyword expected for DO statement");
                        return;
                }
                setlabel(contlabel);
                getcondition();
                addoplabel(OP_JUMPNZ, &label3);
                setlabel(breaklabel);
                (void) tokenmode(oldmode);
                return;

        case T_SWITCH:
                oldmode = tokenmode(TM_DEFAULT);
                breaklabel = &label1;
                nextcaselabel = &label2;
                defaultlabel = &label3;
                clearlabel(breaklabel);
                clearlabel(nextcaselabel);
                clearlabel(defaultlabel);
                getcondition();
                if (gettoken() != T_LEFTBRACE) {
                        (void) tokenmode(oldmode);
                        scanerror(T_SEMICOLON,
                                  "Missing left brace for switch statement");
                        return;
                }
                addoplabel(OP_JUMP, nextcaselabel);
                rescantoken();
                getstatement(contlabel, breaklabel,
                             nextcaselabel, defaultlabel);
                addoplabel(OP_JUMP, breaklabel);
                setlabel(nextcaselabel);
                if (defaultlabel->l_offset > 0)
                        addoplabel(OP_JUMP, defaultlabel);
                else
                        addop(OP_POP);
                setlabel(breaklabel);
                (void) tokenmode(oldmode);
                return;

        case T_CASE:
                if (nextcaselabel == NULL_LABEL) {
                        scanerror(T_SEMICOLON,
                                  "CASE not within SWITCH statement");
                        return;
                }
                clearlabel(&label1);
                addoplabel(OP_JUMP, &label1);
                setlabel(nextcaselabel);
                clearlabel(nextcaselabel);
                (void) getexprlist();
                if (gettoken() != T_COLON) {
                        scanerror(T_SEMICOLON,
                                  "Colon expected after CASE expression");
                        return;
                }
                addoplabel(OP_CASEJUMP, nextcaselabel);
                setlabel(&label1);
                getstatement(contlabel, breaklabel,
                             nextcaselabel, defaultlabel);
                return;

        case T_DEFAULT:
                if (gettoken() != T_COLON) {
                        scanerror(T_SEMICOLON,
                                  "Colon expected after DEFAULT keyword");
                        return;
                }
                if (defaultlabel == NULL_LABEL) {
                        scanerror(T_SEMICOLON,
                                  "DEFAULT not within SWITCH statement");
                        return;
                }
                if (defaultlabel->l_offset > 0) {
                        scanerror(T_SEMICOLON,
                                  "Multiple DEFAULT clauses in SWITCH");
                        return;
                }
                clearlabel(&label1);
                addoplabel(OP_JUMP, &label1);
                setlabel(defaultlabel);
                addop(OP_POP);
                setlabel(&label1);
                getstatement(contlabel, breaklabel,
                             nextcaselabel, defaultlabel);
                return;

        case T_ELSE:
                scanerror(T_SEMICOLON, "ELSE without preceding IF");
                return;

        case T_SHOW:
                getshowstatement();
                break;

        case T_PRINT:
                printeol = true;
                for (;;) {
                        switch (gettoken()) {
                        case T_RIGHTPAREN:
                        case T_RIGHTBRACKET:
                        case T_RIGHTBRACE:
                        case T_NEWLINE:
                        case T_ELSE:
                        case T_EOF:
                                rescantoken();
                                /*FALLTHRU*/
                        case T_SEMICOLON:
                                if (printeol)
                                        addop(OP_PRINTEOL);
                                return;
                        case T_COMMA:
                                addop(OP_PRINTSPACE);
                                /*FALLTHRU*/
                        case T_COLON:
                                printeol = false;
                                break;
                        case T_STRING:
                                printeol = true;
                                addopone(OP_PRINTSTRING, tokenstring());
                                break;
                        default:
                                printeol = true;
                                rescantoken();
                                (void) getopassignment();
                                addopone(OP_PRINT, (long) PRINT_NORMAL);
                        }
                }

        case T_QUIT:
                switch (gettoken()) {
                case T_STRING:
                        addopone(OP_QUIT, tokenstring());
                        break;
                default:
                        addopone(OP_QUIT, -1);
                        rescantoken();
                }
                break;

        case T_ABORT:
                switch (gettoken()) {
                case T_STRING:
                        addopone(OP_ABORT, tokenstring());
                        break;
                default:
                        addopone(OP_ABORT, -1);
                        rescantoken();
                }
                break;

        case T_SYMBOL:
                if (nextchar() == ':') {        /****HACK HACK****/
                        definelabel(tokensymbol());
                        if (gettoken() == T_RIGHTBRACE) {
                                rescantoken();
                                return;
                        }
                        rescantoken();
                        getstatement(contlabel, breaklabel,
                                NULL_LABEL, NULL_LABEL);
                        return;
                }
                reread();
                /*FALLTHRU*/

        default:
                rescantoken();
                type = getexprlist();
                if (contlabel || breaklabel || (curfunc->f_name[0] != '*')) {
                        addop(OP_POP);
                        break;
                }
                addop(OP_SAVE);
                if (isassign(type) || (curfunc->f_name[1] != '\0')) {
                        addop(OP_POP);
                        break;
                }
                addop(OP_PRINTRESULT);
                break;
        }
        for (;;) {
                switch (gettoken()) {
                case T_RIGHTBRACE:
                case T_NEWLINE:
                case T_EOF:
                case T_ELSE:
                        rescantoken();
                        return;
                case T_SEMICOLON:
                        return;
                case T_NUMBER:
                case T_IMAGINARY:
                        addopone(OP_NUMBER, tokennumber());
                        scanerror(T_NULL, "Unexpected number");
                        continue;
                default:
                        scanerror(T_NULL, "Semicolon expected");
                        return;
                }
        }
}


/*
 * Read in an object declaration.
 * This is of the following form:
 *      OBJ type [ '{' id [ ',' id ] ... '}' ]  [ objlist ].
 * The OBJ keyword has already been read.  Symtype is SYM_UNDEFINED if this
 * is an OBJ statement, otherwise this is part of a declaration which will
 * define new symbols with the specified type.
 */
S_FUNC void
getobjdeclaration(int symtype)
{
        char *name;                     /* name of object type */
        int count;                      /* number of elements */
        int index;                      /* current index */
        int i;                          /* loop counter */
        int oldmode;

        if (gettoken() != T_SYMBOL) {
                scanerror(T_SEMICOLON, "Object type name missing");
                return;
        }
        name = addliteral(tokensymbol());
        if (gettoken() != T_LEFTBRACE) {
                rescantoken();
                getobjvars(name, symtype);
                return;
        }
        /*
         * Read in the definition of the elements of the object.
         */
        count = 0;
        indices = quickindices;
        maxindices = INDICALLOC;

        oldmode = tokenmode(TM_DEFAULT);

        for (;;) {
                switch (gettoken()) {
                case T_SYMBOL:
                        if (count == maxindices) {
                                if (maxindices == INDICALLOC) {
                                        maxindices += INDICALLOC;
                                        newindices = (int *) malloc(maxindices *
                                                sizeof(int));
                                        if (newindices == NULL) {
                                                scanerror(T_SEMICOLON,
                                            "Out of memory for indices malloc");
                                                (void) tokenmode(oldmode);
                                                return;
                                        }
                                        memcpy(newindices, quickindices,
                                                INDICALLOC * sizeof(int));
                                        indices = newindices;
                                } else {
                                        maxindices += INDICALLOC;
                                        newindices = (int *) realloc(indices,
                                                maxindices * sizeof(int));
                                        if (newindices == NULL) {
                                                free(indices);
                                                scanerror(T_SEMICOLON,
                                          "Out of memory for indices realloc");
                                                (void) tokenmode(oldmode);
                                                return;
                                        }
                                        indices = newindices;
                                }
                        }
                        index = addelement(tokensymbol());
                        for (i = 0; i < count; i++) {
                                if (indices[i] == index) {
                                        if (indices != quickindices)
                                                free(indices);
                                        scanerror(T_SEMICOLON,
                                            "Duplicate element name \"%s\"",
                                            tokensymbol());
                                        (void) tokenmode(oldmode);
                                        return;
                                }
                        }
                        indices[count++] = index;
                        if (gettoken() == T_COMMA)
                                continue;
                        rescantoken();
                        if (gettoken() != T_RIGHTBRACE) {
                                if (indices != quickindices)
                                        free(indices);
                                scanerror(T_SEMICOLON,
                                    "Bad object type definition");
                                (void) tokenmode(oldmode);
                                return;
                        }
                        /*FALLTHRU*/
                case T_RIGHTBRACE:
                        (void) tokenmode(oldmode);
                        if (defineobject(name, indices, count)) {
                                if (indices != quickindices)
                                        free(indices);
                                scanerror(T_NULL,
                                "Object type \"%s\" is already defined", name);
                                return;
                        }
                        if (indices != quickindices)
                                free(indices);
                        getobjvars(name, symtype);
                        return;
                case T_NEWLINE:
                        continue;
                default:
                        if (indices != quickindices)
                                free(indices);
                        scanerror(T_SEMICOLON, "Bad object type definition");
                                (void) tokenmode(oldmode);
                        return;

                }
        }
}


S_FUNC void
getoneobj(long index, int symtype)
{
        char *symname;

        if (gettoken() == T_SYMBOL) {
                if (symtype == SYM_UNDEFINED) {
                        rescantoken();
                        (void) getidexpr(true, 1);
                } else {
                        symname = tokensymbol();
                        definesymbol(symname, symtype);
                        usesymbol(symname, 0);
                }
                getoneobj(index, symtype);
                addop(OP_ASSIGN);
                return;
        }
        rescantoken();
        addopone(OP_OBJCREATE, index);
        while (gettoken() == T_ASSIGN)
                (void) getinitlist();
        rescantoken();
}

/*
 * Routine to assign a specified object-type value to each of a set of
 * variables in a "global", "local" or "S_FUNC" declaration, or, if
 * symtype is SYM_UNDEFINED, to create one object value of the specified
 * type.
 *
 * given:
 *      name            object name
 *      symtype         declaration type
 */
S_FUNC void
getobjvars(char *name, int symtype)
{
        long index;             /* index for object */

        index = checkobject(name);
        if (index < 0) {
                scanerror(T_SEMICOLON,
                          "Object %s has not been defined yet", name);
                return;
        }
        for (;;) {
                getoneobj(index, symtype);
                if (symtype == SYM_UNDEFINED)
                        return;
                if (gettoken() != T_COMMA) {
                        rescantoken();
                        return;
                }
                addop(OP_POP);
        }
}


S_FUNC void
getmatdeclaration(int symtype)
{
        for (;;) {
                switch (gettoken()) {
                case T_SYMBOL:
                        rescantoken();
                        getonematrix(symtype);
                        addop(OP_POP);
                        continue;
                case T_COMMA:
                        continue;
                default:
                        rescantoken();
                        return;
                }
        }
}


S_FUNC void
getonematrix(int symtype)
{
        long dim;
        long index;
        long count;
        unsigned long patchpc;
        char *name;

        if (gettoken() == T_SYMBOL) {
                if (symtype == SYM_UNDEFINED) {
                        rescantoken();
                        (void) getidexpr(false, 1);
                } else {
                        name = tokensymbol();
                        definesymbol(name, symtype);
                        usesymbol(name, 0);
                }
                while (gettoken() == T_COMMA);
                rescantoken();
                getonematrix(symtype);
                addop(OP_ASSIGN);
                return;
        }
        rescantoken();

        if (gettoken() == T_LEFTPAREN) {
                if (isrvalue(getexprlist())) {
                        scanerror(T_SEMICOLON, "Lvalue expected");
                        return;
                }
                if (gettoken() != T_RIGHTPAREN) {
                        scanerror(T_SEMICOLON, "Missing right parenthesis");
                        return;
                }
                getonematrix(symtype);
                addop(OP_ASSIGN);
                return;
        }
        rescantoken();

        if (gettoken() != T_LEFTBRACKET) {
                rescantoken();
                scanerror(T_SEMICOLON, "Left-bracket expected");
                return;
        }
        dim = 1;

        /*
         * If there are no bounds given for the matrix, then they must be
         * implicitly defined by a list of initialization values.  Put in
         * a dummy number in the opcode stream for the bounds and remember
         * its location.  After we know how many values are in the list, we
         * will patch the correct value back into the opcode.
         */
        if (gettoken() == T_RIGHTBRACKET) {
                if (gettoken() == T_ASSIGN) {
                        clearopt();
                        patchpc = curfunc->f_opcodecount + 1;
                        addopone(OP_NUMBER, (long) -1);
                        clearopt();
                        addop(OP_ZERO);
                        addopone(OP_MATCREATE, dim);
                        addop(OP_ZERO);
                        addop(OP_INITFILL);
                        count = 0;
                        count = getinitlist();
                        index = addqconstant(itoq(count));
                        if (index < 0)
                                math_error("Cannot allocate constant");
                        curfunc->f_opcodes[patchpc] = index;
                        return;
                }
                rescantoken();
                addopone(OP_MATCREATE, 0);
                if (gettoken() == T_LEFTBRACKET) {
                        creatematrix();
                } else {
                        rescantoken();
                        addop(OP_ZERO);
                }
                addop(OP_INITFILL);
                return;
        }

        /*
         * This isn't implicit, so we expect expressions for the bounds.
         */
        rescantoken();
        creatematrix();
        while (gettoken() == T_ASSIGN)
                (void) getinitlist();
        rescantoken();
}


S_FUNC void
creatematrix(void)
{
        long dim;

        dim = 0;

        for (;;) {
                if (gettoken() == T_RIGHTBRACKET) {
                        addopone(OP_MATCREATE, dim);
                        if (gettoken() == T_LEFTBRACKET) {
                                creatematrix();
                        } else {
                                rescantoken();
                                addop(OP_ZERO);
                        }
                        addop(OP_INITFILL);
                        return;
                }
                rescantoken();
                if (++dim > MAXDIM) {
                        scanerror(T_SEMICOLON,
                                  "Only %d dimensions allowed", MAXDIM);
                        return;
                }
                (void) getopassignment();
                switch (gettoken()) {
                case T_RIGHTBRACKET:
                        rescantoken();
                        /*FALLTHRU*/
                case T_COMMA:
                        addop(OP_ONE);
                        addop(OP_SUB);
                        addop(OP_ZERO);
                        break;
                case T_COLON:
                        (void) getopassignment();
                        switch(gettoken()) {
                        case T_RIGHTBRACKET:
                                rescantoken();
                                /*FALLTHRU*/
                        case T_COMMA:
                                continue;
                        }
                        /*FALLTHRU*/
                default:
                        rescantoken();
                        scanerror(T_SEMICOLON,
                                  "Illegal matrix definition");
                        return;
                }
        }
}


/*
 * Get an optional initialization list for a matrix or object definition.
 * Returns the number of elements that are in the list, or -1 on parse error.
 *      initlist = { assignment [ , assignment ] ... }.
 */
S_FUNC long
getinitlist(void)
{
        long index;
        int oldmode;

        oldmode = tokenmode(TM_DEFAULT);

        if (gettoken() != T_LEFTBRACE) {
                scanerror(T_SEMICOLON,
                    "Missing left brace for initialization list");
                (void) tokenmode(oldmode);
                return -1;
        }

        for (index = 0; ; index++) {
                switch(gettoken()) {
                case T_COMMA:
                case T_NEWLINE:
                        continue;
                case T_RIGHTBRACE:
                        (void) tokenmode(oldmode);
                        return index;
                case T_LEFTBRACE:
                        rescantoken();
                        addop(OP_DUPLICATE);
                        addopone(OP_ELEMADDR, index);
                        (void) getinitlist();
                        break;
                default:
                        rescantoken();
                        getopassignment();
                }
                addopone(OP_ELEMINIT, index);
                switch (gettoken()) {
                case T_COMMA:
                case T_NEWLINE:
                        continue;

                case T_RIGHTBRACE:
                        (void) tokenmode(oldmode);
                        return index;

                default:
                        scanerror(T_SEMICOLON,
                              "Missing right brace for initialization list");
                        (void) tokenmode(oldmode);
                        return -1;
                }
        }
}


/*
 * Get a condition.
 * condition = '(' assignment ')'.
 */
S_FUNC void
getcondition(void)
{
        if (gettoken() != T_LEFTPAREN) {
                scanerror(T_SEMICOLON,
                          "Missing left parenthesis for condition");
                return;
        }
        (void) getexprlist();
        if (gettoken() != T_RIGHTPAREN) {
                scanerror(T_SEMICOLON,
                          "Missing right parenthesis for condition");
                return;
        }
}


/*
 * Get an expression list consisting of one or more expressions,
 * separated by commas.  The value of the list is that of the final expression.
 * This is the top level routine for parsing expressions.
 * Returns flags describing the type of the last assignment or expression found.
 * exprlist = assignment [ ',' assignment ] ...
 */
S_FUNC int
getexprlist(void)
{
        int     type;

        type = getopassignment();
        while (gettoken() == T_COMMA) {
                addop(OP_POP);
                type = getopassignment();
        }
        rescantoken();
        return type;
}


/*
 * Get an op-assignment or possibly just an assignment or expression.
 * Returns flags describing the type of assignment or expression found.
 * assignment = lvalue '=' assignment
 *      | lvalue '+=' assignment
 *      | lvalue '-=' assignment
 *      | lvalue '*=' assignment
 *      | lvalue '/=' assignment
 *      | lvalue '%=' assignment
 *      | lvalue '//=' assignment
 *      | lvalue '&=' assignment
 *      | lvalue '|=' assignment
 *      | lvalue '<<=' assignment
 *      | lvalue '>>=' assignment
 *      | lvalue '^=' assignment
 *      | lvalue '**=' assignment
 *      | orcond.
 */
S_FUNC int
getopassignment(void)
{
        int type;               /* type of expression */
        long op;                /* opcode to generate */

        type = getassignment();
        switch (gettoken()) {
        case T_PLUSEQUALS:      op = OP_ADD; break;
        case T_MINUSEQUALS:     op = OP_SUB; break;
        case T_MULTEQUALS:      op = OP_MUL; break;
        case T_DIVEQUALS:       op = OP_DIV; break;
        case T_SLASHSLASHEQUALS: op = OP_QUO; break;
        case T_MODEQUALS:       op = OP_MOD; break;
        case T_ANDEQUALS:       op = OP_AND; break;
        case T_OREQUALS:        op = OP_OR; break;
        case T_LSHIFTEQUALS:    op = OP_LEFTSHIFT; break;
        case T_RSHIFTEQUALS:    op = OP_RIGHTSHIFT; break;
        case T_POWEREQUALS:     op = OP_POWER; break;
        case T_HASHEQUALS:      op = OP_HASHOP; break;
        case T_TILDEEQUALS:     op = OP_XOR; break;
        case T_BACKSLASHEQUALS: op = OP_SETMINUS; break;

        default:
                rescantoken();
                return type;
        }
        if (isrvalue(type)) {
                scanerror(T_NULL, "Illegal assignment");
                (void) getopassignment();
                return (EXPR_RVALUE | EXPR_ASSIGN);
        }
        writeindexop();
        for(;;) {
                addop(OP_DUPLICATE);
                if (gettoken() == T_LEFTBRACE) {
                        rescantoken();
                        addop(OP_DUPVALUE);
                        getinitlist();
                        while (gettoken() == T_ASSIGN)
                                getinitlist();
                        rescantoken();
                } else {
                        rescantoken();
                        (void) getassignment();
                }
                addop(op);
                addop(OP_ASSIGN);
                switch (gettoken()) {
                case T_PLUSEQUALS:      op = OP_ADD; break;
                case T_MINUSEQUALS:     op = OP_SUB; break;
                case T_MULTEQUALS:      op = OP_MUL; break;
                case T_DIVEQUALS:       op = OP_DIV; break;
                case T_SLASHSLASHEQUALS: op = OP_QUO; break;
                case T_MODEQUALS:       op = OP_MOD; break;
                case T_ANDEQUALS:       op = OP_AND; break;
                case T_OREQUALS:        op = OP_OR; break;
                case T_LSHIFTEQUALS:    op = OP_LEFTSHIFT; break;
                case T_RSHIFTEQUALS:    op = OP_RIGHTSHIFT; break;
                case T_POWEREQUALS:     op = OP_POWER; break;
                case T_HASHEQUALS:      op = OP_HASHOP; break;
                case T_TILDEEQUALS:     op = OP_XOR; break;
                case T_BACKSLASHEQUALS: op = OP_SETMINUS; break;

                default:
                        rescantoken();
                        return EXPR_ASSIGN;
                }
        }
}


/*
 * Get an assignment (lvalue = ...) or possibly just an expression
 */

S_FUNC int
getassignment (void)
{
        int type;               /* type of expression */

        switch(gettoken()) {
        case T_COMMA:
        case T_SEMICOLON:
        case T_NEWLINE:
        case T_RIGHTPAREN:
        case T_RIGHTBRACKET:
        case T_RIGHTBRACE:
        case T_EOF:
                addop(OP_UNDEF);
                rescantoken();
                return EXPR_RVALUE;
        }

        rescantoken();

        type = getaltcond();

        switch (gettoken()) {
        case T_NUMBER:
        case T_IMAGINARY:
                addopone(OP_NUMBER, tokennumber());
                type = (EXPR_RVALUE | EXPR_CONST);
                /*FALLTHRU*/
        case T_STRING:
        case T_SYMBOL:
        case T_OLDVALUE:
        case T_LEFTPAREN:
        case T_PLUSPLUS:
        case T_MINUSMINUS:
        case T_NOT:
                scanerror(T_NULL, "Missing operator");
                return type;
        case T_ASSIGN:
                break;

        default:
                rescantoken();
                return type;
        }
        if (isrvalue(type)) {
                scanerror(T_SEMICOLON, "Illegal assignment");
                (void) getassignment();
                return (EXPR_RVALUE | EXPR_ASSIGN);
        }
        writeindexop();
        if (gettoken() == T_LEFTBRACE) {
                rescantoken();
                getinitlist();
                while (gettoken() == T_ASSIGN)
                        getinitlist();
                rescantoken();
                return EXPR_ASSIGN;
        }
        rescantoken();
        (void) getassignment();
        addop(OP_ASSIGN);
        return EXPR_ASSIGN;
}


/*
 * Get a possible conditional result expression (question mark).
 * Flags are returned indicating the type of expression found.
 * altcond = orcond [ '?' orcond ':' altcond ].
 */
S_FUNC int
getaltcond(void)
{
        int type;               /* type of expression */
        LABEL donelab;          /* label for done */
        LABEL altlab;           /* label for alternate expression */

        type = getorcond();
        if (gettoken() != T_QUESTIONMARK) {
                rescantoken();
                return type;
        }
        clearlabel(&donelab);
        clearlabel(&altlab);
        addoplabel(OP_JUMPZ, &altlab);
        type = getaltcond();
        if (gettoken() != T_COLON) {
                scanerror(T_SEMICOLON,
                          "Missing colon for conditional expression");
                return EXPR_RVALUE;
        }
        addoplabel(OP_JUMP, &donelab);
        setlabel(&altlab);
        type |= getaltcond();
        setlabel(&donelab);
        return type;
}


/*
 * Get a possible conditional or expression.
 * Flags are returned indicating the type of expression found.
 * orcond = andcond [ '||' andcond ] ...
 */
S_FUNC int
getorcond(void)
{
        int type;               /* type of expression */
        LABEL donelab;          /* label for done */

        clearlabel(&donelab);
        type = getandcond();
        while (gettoken() == T_OROR) {
                addoplabel(OP_CONDORJUMP, &donelab);
                type |= getandcond();
        }
        rescantoken();
        if (donelab.l_chain >= 0)
                setlabel(&donelab);
        return type;
}


/*
 * Get a possible conditional and expression.
 * Flags are returned indicating the type of expression found.
 * andcond = relation [ '&&' relation ] ...
 */
S_FUNC int
getandcond(void)
{
        int type;               /* type of expression */
        LABEL donelab;          /* label for done */

        clearlabel(&donelab);
        type = getrelation();
        while (gettoken() == T_ANDAND) {
                addoplabel(OP_CONDANDJUMP, &donelab);
                type |= getrelation();
        }
        rescantoken();
        if (donelab.l_chain >= 0)
                setlabel(&donelab);
        return type;
}


/*
 * Get a possible relation (equality or inequality), or just an expression.
 * Flags are returned indicating the type of relation found.
 * relation = sum '==' sum
 *      | sum '!=' sum
 *      | sum '<=' sum
 *      | sum '>=' sum
 *      | sum '<' sum
 *      | sum '>' sum
 *      | sum.
 */
S_FUNC int
getrelation(void)
{
        int type;               /* type of expression */
        long op;                /* opcode to generate */

        type = getsum();
        switch (gettoken()) {
        case T_EQ: op = OP_EQ; break;
        case T_NE: op = OP_NE; break;
        case T_LT: op = OP_LT; break;
        case T_GT: op = OP_GT; break;
        case T_LE: op = OP_LE; break;
        case T_GE: op = OP_GE; break;
        default:
                rescantoken();
                return type;
        }
        if (islvalue(type))
                addop(OP_GETVALUE);
        (void) getsum();
        addop(op);
        return EXPR_RVALUE;
}


/*
 * Get an expression made up of sums of products.
 * Flags indicating the type of expression found are returned.
 * sum = product [ {'+' | '-'} product ] ...
 */
S_FUNC int
getsum(void)
{
        int type;               /* type of expression found */
        long op;                /* opcode to generate */

        type = EXPR_RVALUE;
        switch(gettoken()) {
        case T_PLUS:
                (void) getproduct();
                addop(OP_PLUS);
                break;
        case T_MINUS:
                (void) getproduct();
                addop(OP_NEGATE);
                break;
        default:
                rescantoken();
                type = getproduct();
        }
        for (;;) {
                switch (gettoken()) {
                case T_PLUS:    op = OP_ADD; break;
                case T_MINUS:   op = OP_SUB; break;
                case T_HASH: op = OP_HASHOP; break;
                default:
                        rescantoken();
                        return type;
                }
                if (islvalue(type))
                        addop(OP_GETVALUE);
                (void) getproduct();
                addop(op);
                type = EXPR_RVALUE;
        }
}


/*
 * Get the product of arithmetic or expressions.
 * Flags indicating the type of expression found are returned.
 * product = orexpr [ {'*' | '/' | '//' | '%'} orexpr ] ...
 */
S_FUNC int
getproduct(void)
{
        int type;               /* type of value found */
        long op;                /* opcode to generate */

        type = getorexpr();
        for (;;) {
                switch (gettoken()) {
                case T_MULT:    op = OP_MUL; break;
                case T_DIV:     op = OP_DIV; break;
                case T_MOD:     op = OP_MOD; break;
                case T_SLASHSLASH: op = OP_QUO; break;
                default:
                        rescantoken();
                        return type;
                }
                if (islvalue(type))
                        addop(OP_GETVALUE);
                (void) getorexpr();
                addop(op);
                type = EXPR_RVALUE;
        }
}


/*
 * Get an expression made up of arithmetic or operators.
 * Flags indicating the type of expression found are returned.
 * orexpr = andexpr [ '|' andexpr ] ...
 */
S_FUNC int
getorexpr(void)
{
        int type;               /* type of value found */

        type = getandexpr();
        while (gettoken() == T_OR) {
                if (islvalue(type))
                        addop(OP_GETVALUE);
                (void) getandexpr();
                addop(OP_OR);
                type = EXPR_RVALUE;
        }
        rescantoken();
        return type;
}


/*
 * Get an expression made up of arithmetic and operators.
 * Flags indicating the type of expression found are returned.
 * andexpr = shiftexpr [ '&' shiftexpr ] ...
 */
S_FUNC int
getandexpr(void)
{
        int type;               /* type of value found */
        long op;

        type = getshiftexpr();
        for (;;) {
                switch (gettoken()) {
                case T_AND: op = OP_AND; break;
                case T_TILDE: op = OP_XOR; break;
                case T_BACKSLASH: op = OP_SETMINUS; break;
                default:
                        rescantoken();
                        return type;
                }
                if (islvalue(type))
                        addop(OP_GETVALUE);
                (void) getshiftexpr();
                addop(op);
                type = EXPR_RVALUE;
        }
}


/*
 * Get a shift or power expression.
 * Flags indicating the type of expression found are returned.
 * shift = '+' shift
 *       | '-' shift
 *       | '/' shift
 *       | '\' shift
 *       | '~' shift
 *       | '#' shift
 *       | reference '^' shiftexpr
 *       | reference '<<' shiftexpr
 *       | reference '>>' shiftexpr
 *       | reference.
 */
S_FUNC int
getshiftexpr(void)
{
        int type;               /* type of value found */
        long op;                /* opcode to generate */

        op = 0;
        switch (gettoken()) {
        case T_PLUS:            op = OP_PLUS; break;
        case T_MINUS:           op = OP_NEGATE; break;
        case T_NOT:             op = OP_NOT; break;
        case T_DIV:             op = OP_INVERT; break;
        case T_BACKSLASH:       op = OP_BACKSLASH; break;
        case T_TILDE:           op = OP_COMP; break;
        case T_HASH:            op = OP_CONTENT; break;
        }
        if (op) {
                (void) getshiftexpr();
                addop(op);
                return EXPR_RVALUE;
        }
        rescantoken();
        type = getreference();
        switch (gettoken()) {
        case T_POWER:           op = OP_POWER; break;
        case T_LEFTSHIFT:       op = OP_LEFTSHIFT; break;
        case T_RIGHTSHIFT:      op = OP_RIGHTSHIFT; break;
        default:
                rescantoken();
                return type;
        }
        if (islvalue(type))
                addop(OP_GETVALUE);
        (void) getshiftexpr();
        addop(op);
        return EXPR_RVALUE;
}


/*
 * set an address or dereference indicator
 * address = '&' term
 * dereference = '*' term
 */
S_FUNC int
getreference(void)
{
        int type;

        switch(gettoken()) {
        case T_ANDAND:
                scanerror(T_NULL, "&& used as prefix operator");
                /*FALLTHRU*/
        case T_AND:
                type = getreference();
                addop(OP_PTR);
                type = EXPR_RVALUE;
                break;
        case T_MULT:
                (void) getreference();
                addop(OP_DEREF);
                type = 0;
                break;
        case T_POWER:                   /* '**' or '^' */
                (void) getreference();
                addop(OP_DEREF);
                addop(OP_DEREF);
                type = 0;
                break;
        default:
                rescantoken();
                type = getincdecexpr();
        }
        return type;
}


/*
 * get an increment or decrement expression
 * ++expr, --expr, expr++, expr--
 */
S_FUNC int
getincdecexpr(void)
{
        int type;
        int tok;

        type = getterm();
        tok = gettoken();
        if (tok == T_PLUSPLUS || tok == T_MINUSMINUS) {
                if (isrvalue(type))
                                scanerror(T_NULL, "Bad ++ usage");
                writeindexop();
                if (tok == T_PLUSPLUS)
                        addop(OP_POSTINC);
                else
                        addop(OP_POSTDEC);
                for (;;) {
                        tok = gettoken();
                        switch(tok) {
                        case T_PLUSPLUS:
                                addop(OP_PREINC);
                                continue;
                        case T_MINUSMINUS:
                                addop(OP_PREDEC);
                                continue;
                        default:
                                addop(OP_POP);
                                break;
                        }
                        break;
                }
                type = EXPR_RVALUE | EXPR_ASSIGN;
        }
        if (tok == T_NOT) {
                addopfunction(OP_CALL, getbuiltinfunc("fact"), 1);
                tok = gettoken();
                type = EXPR_RVALUE;
        }
        rescantoken();
        return type;
}


/*
 * Get a single term.
 * Flags indicating the type of value found are returned.
 * term = lvalue
 *      | lvalue '[' assignment ']'
 *      | lvalue '++'
 *      | lvalue '--'
 *      | real_number
 *      | imaginary_number
 *      | '.'
 *      | string
 *      | '(' assignment ')'
 *      | function [ '(' [assignment  [',' assignment] ] ')' ]
 *      | '!' term
 */
S_FUNC int
getterm(void)
{
        int type;               /* type of term found */
        int oldmode;

        type = 0;
        switch (gettoken()) {
        case T_NUMBER:
                addopone(OP_NUMBER, tokennumber());
                type = (EXPR_RVALUE | EXPR_CONST);
                break;

        case T_IMAGINARY:
                addopone(OP_IMAGINARY, tokennumber());
                type = (EXPR_RVALUE | EXPR_CONST);
                break;

        case T_OLDVALUE:
                addop(OP_OLDVALUE);
                type = 0;
                break;

        case T_STRING:
                addopone(OP_STRING, tokenstring());
                type = EXPR_RVALUE;
                break;

        case T_PLUSPLUS:
                if (isrvalue(getterm()))
                        scanerror(T_NULL, "Bad ++ usage");
                writeindexop();
                addop(OP_PREINC);
                type = EXPR_ASSIGN;
                break;

        case T_MINUSMINUS:
                if (isrvalue(getterm()))
                        scanerror(T_NULL, "Bad -- usage");
                writeindexop();
                addop(OP_PREDEC);
                type = EXPR_ASSIGN;
                break;

        case T_LEFTPAREN:
                oldmode = tokenmode(TM_DEFAULT);
                type = getexprlist();
                if (gettoken() != T_RIGHTPAREN)
                        scanerror(T_SEMICOLON,
                                  "Missing right parenthesis");
                (void) tokenmode(oldmode);
                break;

        case T_MAT:
                getonematrix(SYM_UNDEFINED);
                type = EXPR_ASSIGN;
                break;

        case T_OBJ:
                getobjdeclaration(SYM_UNDEFINED);
                type = EXPR_ASSIGN;
                break;

        case T_SYMBOL:
                rescantoken();
                type = getidexpr(true, 0);
                break;

        case T_MULT:
                (void) getterm();
                addop(OP_DEREF);
                type = 0;
                break;

        case T_POWER:                   /* '**' or '^' */
                (void) getterm();
                addop(OP_DEREF);
                addop(OP_DEREF);
                type = 0;
                break;

        case T_GLOBAL:
                if (gettoken() != T_SYMBOL) {
                        scanerror(T_NULL,
                                 "No identifier after global specifier");
                        break;
                }
                rescantoken();
                type = getidexpr(true, T_GLOBAL);
                break;

        case T_LOCAL:
                if (gettoken() != T_SYMBOL) {
                        scanerror(T_NULL,
                                 "No identifier after local specifier");
                        break;
                }
                rescantoken();
                type = getidexpr(true, T_LOCAL);
                break;

        case T_STATIC:
                if (gettoken() != T_SYMBOL) {
                        scanerror(T_NULL,
                                 "No identifier after static specifier");
                        break;
                }
                rescantoken();
                type = getidexpr(true, T_STATIC);
                break;

        case T_LEFTBRACKET:
                scanerror(T_NULL, "Left bracket with no preceding lvalue");
                break;

        case T_PERIOD:
                scanerror(T_NULL, "Period with no preceding lvalue");
                break;

        default:
                if (iskeyword(type)) {
                        scanerror(T_NULL,
                            "Expression contains reserved keyword");
                        break;
                }
                rescantoken();
                scanerror(T_COMMA, "Missing expression");
        }
        if (type == 0) {
                for (;;) {
                        switch (gettoken()) {
                        case T_LEFTBRACKET:
                                rescantoken();
                                getmatargs();
                                type = 0;
                                break;
                        case T_PERIOD:
                                getelement();
                                type = 0;
                                break;
                        case T_LEFTPAREN:
                                scanerror(T_NULL,
                                          "Function calls not allowed "
                                          "as expressions");
                                /*FALLTHRU*/
                        default:
                                rescantoken();
                        return type;
                        }
                }
        }
        return type;
}


/*
 * Read in an identifier expressions.
 * This is a symbol name followed by parenthesis, or by square brackets or
 * element references.  The symbol can be a global or a local variable name.
 * Returns the type of expression found.
 */
S_FUNC int
getidexpr(bool okmat, int autodef)
{
        int type;
        char name[SYMBOLSIZE+1];        /* symbol name */
        int oldmode;

        type = 0;
        if (!getid(name))
                return type;
        switch (gettoken()) {
        case T_LEFTPAREN:
                oldmode = tokenmode(TM_DEFAULT);
                getcallargs(name);
                (void) tokenmode(oldmode);
                type = 0;
                break;
        case T_ASSIGN:
                if (autodef != T_GLOBAL && autodef != T_LOCAL &&
                                autodef != T_STATIC)
                        autodef = 1;
                /*FALLTHRU*/
        default:
                rescantoken();
                usesymbol(name, autodef);
        }
        /*
         * Now collect as many element references and matrix index operations
         * as there are following the id.
         */
        for (;;) {
                switch (gettoken()) {
                case T_LEFTBRACKET:
                        rescantoken();
                        if (!okmat)
                                return type;
                        getmatargs();
                        type = 0;
                        break;
                case T_ARROW:
                        addop(OP_DEREF);
                        /*FALLTHRU*/
                case T_PERIOD:
                        getelement();
                        type = 0;
                        break;
                case T_LEFTPAREN:
                        scanerror(T_NULL,
                                  "Function calls not allowed "
                                  "as expressions");
                        /*FALLTHRU*/
                default:
                        rescantoken();
                        return type;
                }
        }
}


/*
 * getsymvalue - return the VALUE of a symbol
 *
 * given:
 *      name    symbol name
 *      v_p     pointer to value return
 *
 * returns:
 *      symbol type found:
 *
 *              SYM_UNDEFINED   no such symbol
 *              SYM_GLOBAL      global symbol found
 *
 * NOTE: This is a special hack to allow some special code in getfilename()
 *       to get the value of a symbol.  It should NOT be used in the
 *       general op code generation / calc code parsing case.
 */
S_FUNC int
getsymvalue(char *name, VALUE *v_p)
{
        GLOBAL *g_ret;          /* global return from findglobal() */

        /* firewall */
        if (name == NULL || v_p == NULL) {
                return SYM_UNDEFINED;
        }

        /* look for a global */
        g_ret = findglobal(name);
        if (g_ret != NULL) {
                *v_p = g_ret->g_value;
                return SYM_GLOBAL;
        }

        /* no such symbol */
        return SYM_UNDEFINED;
}


/*
 * Read in a filename for a read or write command.
 * Both quoted and unquoted filenames are handled here.
 * The name must be terminated by an end of line or semicolon.
 * Returns true if the filename was successfully parsed.
 *
 * given:
 *      name            filename to read
 *      namelen         length of filename buffer including NUL byte
 *      once            non-NULL => set to true of -once read
 */
S_FUNC int
getfilename(char *name, size_t namelen, bool *once)
{
        STRING *s;
        char *symstr;   /* symbol string */
        VALUE val;      /* value of the symbol */
        int i;

        (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);
        for (i = 2; i > 0; i--) {
                switch (gettoken()) {
                case T_STRING:

                        /* use the value of the literal string */
                        s = findstring(tokenstring());
                        strlcpy(name, s->s_str, namelen);
                        sfree(s);
                        break;

                case T_SYMBOL:

                        /* get the symbol name */
                        symstr = tokensymbol();

                        /*
                         * special hack - symbols starting with $ are
                         *                treated as a global variable
                         *                instead of a literal string.
                         */
                        if (symstr[0] == '$') {
                                ++symstr;
                                if (getsymvalue(symstr, &val)) {
                                        if (val.v_type == V_STR) {
                                                /* use symbol VALUE string */
                                                symstr = val.v_str->s_str;
                                                if (symstr == NULL) {
                                                        math_error(
                                        "string value pointer is NULL!!");
                                                        not_reached();
                                                }
                                        } else {
                                                math_error(
                                    "a filename variable must be a string");
                                                not_reached();
                                        }
                                } else {
                                        math_error("no such global variable");
                                        not_reached();
                                }
                        }

                        /* return symbol name or value of global var string */
                        strlcpy(name, symstr, namelen);
                        break;

                case T_NEWLINE:

                        /* found newline */
                        rescantoken();
                        return 1;

                default:

                        /* found something unexpected */
                        rescantoken();
                        return -1;
                }

                /* deal with -once */
                if (i == 2 && once != NULL) {
                        if ((*once = !strcmp(name, "-once")))
                                continue;
                }
                break;
        }
        return 0;
}


/*
 * Read the show command to display useful information
 */
S_FUNC void
getshowstatement(void)
{
        char name[5];
        long arg, index;

        switch (gettoken()) {
        case T_SYMBOL:
                strlcpy(name, tokensymbol(), sizeof(name));
                name[4] = '\0';
                /* Yuck! */
                arg = stringindex("buil\000"
                                  "real\000"
                                  "func\000"
                                  "objf\000"
                                  "conf\000"
                                  "objt\000"
                                  "file\000"
                                  "size\000"
                                  "erro\000"
                                  "cust\000"
                                  "bloc\000"
                                  "cons\000"
                                  "glob\000"
                                  "stat\000"
                                  "numb\000"
                                  "redc\000"
                                  "stri\000"
                                  "lite\000"
                                  "opco\000", name);
                break;
        case T_GLOBAL:
                arg = 13; break;
        case T_STATIC:
                arg = 14; break;
        default:
                printf("SHOW command to be followed by at least ");
                printf("four letters of one of:\n");
                printf("\tblocks, builtin, config, constants, ");
                printf("custom, errors, files, functions,\n");
                printf("\tglobaltypes, objfunctions, objtypes, "
                       "opcodes, sizes, ");
                printf("realglobals,\n");
                printf("\tstatics, numbers, redcdata, "
                       "strings, literals\n");
                rescantoken();
                return;

        }
        if (arg == 19) {
                if (gettoken() != T_SYMBOL) {
                        rescantoken();
                        scanerror(T_SEMICOLON,
                                  "Function name expected for show statement");
                        return;
                }
                index = adduserfunc(tokensymbol());
                addopone(OP_SHOW, index + 19);
                return;
        }
        if (arg > 0)
                addopone(OP_SHOW, arg);
        else
                warning("Unknown parameter for show statement");
}


/*
 * Read in a set of matrix index arguments, surrounded with square brackets.
 * This also handles double square brackets for 'fast indexing'.
 */
S_FUNC void
getmatargs(void)
{
        int dim;

        if (gettoken() != T_LEFTBRACKET) {
                scanerror(T_NULL, "Matrix indexing expected");
                return;
        }
        /*
         * Parse all levels of the array reference
         * Look for the 'fast index' first.
         */
        if (gettoken() == T_LEFTBRACKET) {
                (void) getopassignment();
                if ((gettoken() != T_RIGHTBRACKET) ||
                        (gettoken() != T_RIGHTBRACKET)) {
                                scanerror(T_NULL, "Bad fast index usage");
                                return;
                }
                addop(OP_FIADDR);
                return;
        }
        rescantoken();
        /*
         * Normal indexing with the indexes separated by commas.
         * Initialize the flag in the opcode to assume that the array
         * element will only be referenced for reading.  If the parser
         * finds that the element will be referenced for writing, then
         * it will call writeindexop to change the flag in the opcode.
         */
        dim = 0;
        if (gettoken() == T_RIGHTBRACKET) {
                addoptwo(OP_INDEXADDR, (long) dim, (long) false);
                return;
        }
        rescantoken();
        for (;;) {
                ++dim;
                (void) getopassignment();
                switch (gettoken()) {
                case T_RIGHTBRACKET:
                        addoptwo(OP_INDEXADDR, (long) dim,
                                        (long) false);
                        return;
                case T_COMMA:
                        break;
                default:
                        rescantoken();
                        scanerror(T_NULL,
                                  "Missing right bracket in "
                                  "array reference");
                        return;
                }
        }
}


/*
 * Get an element of an object reference.
 * The leading period which introduces the element has already been read.
 */
S_FUNC void
getelement(void)
{
        long index;
        char name[SYMBOLSIZE+1];

        if (!getid(name))
                return;
        index = findelement(name);
        if (index < 0) {
                scanerror(T_NULL, "Element \"%s\" is undefined", name);
                return;
        }
        addopone(OP_ELEMADDR, index);
}


/*
 * Read in a single symbol name and copy its value into the given buffer.
 * Returns true if a valid symbol id was found.
 */
S_FUNC bool
getid(char *buf)
{
        int type;

        type = gettoken();
        if (iskeyword(type)) {
                scanerror(T_NULL, "Reserved keyword used as symbol name");
                type = T_SYMBOL;
                *buf = '\0';
                return false;
        }
        if (type != T_SYMBOL) {
                rescantoken();
                scanerror(T_NULL, "Symbol name expected");
                *buf = '\0';
                return false;
        }
        strlcpy(buf, tokensymbol(), SYMBOLSIZE+1);
        return true;
}


/*
 * Define a symbol name to be of the specified symbol type.  The scope
 * of a static variable with the same name is terminated if symtype is
 * global or if symtype is static and the old variable is at the same
 * level.  Warnings are issued when a global or local variable is
 * redeclared and when in the same body the variable will be accessible only
 ^ with the appropriate specifier.
 */
S_FUNC void
definesymbol(char *name, int symtype)
{
        switch (symboltype(name)) {
        case SYM_STATIC:
                if (symtype == SYM_GLOBAL || symtype == SYM_STATIC)
                        endscope(name, symtype == SYM_GLOBAL);
                break;
        case SYM_GLOBAL:
                if (symtype == SYM_GLOBAL && conf->redecl_warn) {
                        warning("redeclaration of global \"%s\"",
                                name);
                        return;
                }
                break;

        case SYM_LOCAL:
                if (symtype == SYM_LOCAL && conf->redecl_warn) {
                        warning("redeclaration of local \"%s\"",
                                name);
                        return;
                }
                if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
                        warning("both local and global \"%s\" defined", name);
                        break;
                }
                if (conf->dupvar_warn) {
                        warning("both local and static \"%s\" defined", name);
                }
                break;
        case SYM_PARAM:
                if (symtype == SYM_LOCAL && conf->dupvar_warn) {
                        warning("both local and parameter \"%s\" defined",
                                name);
                        break;
                }
                if (symtype == SYM_GLOBAL && conf->dupvar_warn) {
                        warning("both global and parameter \"%s\" defined",
                                name);
                        break;
                }
                if (conf->dupvar_warn) {
                        warning("both static and parameter \"%s\" defined",
                                name);
                }
        }
        if (symtype == SYM_LOCAL)
                (void) addlocal(name);
        else
                (void) addglobal(name, (symtype == SYM_STATIC));
}


/*
 * Check a symbol name to see if it is known and generate code to reference it.
 * The symbol can be either a parameter name, a local name, or a global name.
 * If autodef is true, we automatically define the name as a global symbol
 * if it is not yet known.
 *
 * given:
 *      name            symbol name to be checked
 *      autodef         1 => define if symbol is not known
 *                      T_GLOBAL => get global, define if necessary
 */
S_FUNC void
usesymbol(char *name, int autodef)
{
        int type;

        type = symboltype(name);
        if (autodef == T_GLOBAL) {
                if (type == SYM_GLOBAL) {
                        warning("Unnecessary global specifier");
                }
                addopptr(OP_GLOBALADDR, (char *) addglobal(name, false));
                return;
        }
        if (autodef == T_STATIC) {
                addopptr(OP_GLOBALADDR, (char *) addglobal(name, true));
                return;
        }
        if (autodef == T_LOCAL) {
                if (type == SYM_LOCAL) {
                        warning("Unnecessary local specifier");
                }
                addopone(OP_LOCALADDR, addlocal(name));
                return;
        }
        switch (type) {
        case SYM_LOCAL:
                addopone(OP_LOCALADDR, (long) findlocal(name));
                return;
        case SYM_PARAM:
                addopone(OP_PARAMADDR, (long) findparam(name));
                return;
        case SYM_GLOBAL:
        case SYM_STATIC:
                addopptr(OP_GLOBALADDR, (char *) findglobal(name));
                return;
        }
        /*
         * The symbol is not yet defined.
         * If we are at the top level and we are allowed to, then define it.
         */
        if ((curfunc->f_name[0] != '*') || !autodef) {
                scanerror(T_NULL, "\"%s\" is undefined", name);
                return;
        }
        (void) addglobal(name, false);
        addopptr(OP_GLOBALADDR, (char *) findglobal(name));
}


/*
 * Get arguments for a function call.
 * The name and beginning parenthesis has already been seen.
 * callargs = [ [ '&' ] assignment  [',' [ '&' ] assignment] ] ')'.
 *
 * given:
 *      name            name of function
 */
S_FUNC void
getcallargs(char *name)
{
        long index;             /* function index */
        long op;                /* opcode to add */
        int argcount;           /* number of arguments */
        bool addrflag;

        op = OP_CALL;
        index = getbuiltinfunc(name);
        if (index < 0) {
                op = OP_USERCALL;
                index = adduserfunc(name);
        }
        if (gettoken() == T_RIGHTPAREN) {
                if (op == OP_CALL)
                        builtincheck(index, 0);
                addopfunction(op, index, 0);
                return;
        }
        rescantoken();
        argcount = 0;
        for (;;) {
                argcount++;
                if (gettoken() == T_RIGHTPAREN) {
                        addop(OP_UNDEF);
                        if (op == OP_CALL)
                                builtincheck(index, argcount);
                        addopfunction(op, index, argcount);
                        return;
                }
                rescantoken();
                if (gettoken() == T_COMMA) {
                        addop(OP_UNDEF);
                        continue;
                }
                rescantoken();
                addrflag = (gettoken() == T_BACKQUOTE);
                if (!addrflag)
                        rescantoken();
                (void) getopassignment();
                if (addrflag) {
                        writeindexop();
                }
                if (!addrflag && (op != OP_CALL))
                        addop(OP_GETVALUE);
                if (!strcmp(name, "quomod") && argcount > 2)
                        writeindexop();
                switch (gettoken()) {
                case T_RIGHTPAREN:
                        if (op == OP_CALL)
                                builtincheck(index, argcount);
                        addopfunction(op, index, argcount);
                        return;
                case T_COMMA:
                        break;
                default:
                        scanerror(T_SEMICOLON,
                                  "Missing right parenthesis "
                                  "in function call");
                        return;
                }
        }
}


/*
 * Change the current directory.  If no directory is given, assume home.
 */
S_FUNC void
do_changedir(void)
{
        char *p;
        STRING *s;

        /* look at the next token */
        (void) tokenmode(TM_NEWLINES | TM_ALLSYMS);

        /* determine the new directory */
        s = NULL;
        switch (gettoken()) {
        case T_STRING:
                s = findstring(tokenstring());
                p = s->s_str;
                break;
        case T_SYMBOL:
                p = tokensymbol();
                break;
        default:
                p = home;
        }

        if (p == NULL) {
                fprintf(stderr, "Cannot determine HOME directory\n");
        }

        /* change to that directory */
        if (chdir(p)) {
                perror(p);
        }
        if (s != NULL)
                sfree(s);
}


