/*
 * codegen - module to generate opcodes from the input tokens
 *
 * Copyright (C) 1999-2007,2017,2021-2023,2025-2026  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/
 */

/*
 * important <system> header includes
 */
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <setjmp.h>
#include <stdint.h>
#include <stdbool.h>

/*
 * conditional <system> head includes
 */
#if defined(_WIN32) || defined(_WIN64)
#  if !defined(__CYGWIN__)
#    include <direct.h>
#  endif
#endif

/*
 * calc local src includes
 */
#include "value.h"
#include "lib_calc.h"
#include "calc.h"
#include "token.h"
#include "symbol.h"
#include "opcodes.h"
#include "label.h"
#include "func.h"
#include "conf.h"
#include "strl.h"
#include "attribute.h"
#include "errtbl.h"

#include "banned.h" /* include after all other includes */

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

FUNC *curfunc;

static int getsymvalue(char *name, VALUE *v_p);
static int getfilename(char *name, size_t namelen, bool *once);
static bool getid(char *buf);
static void getshowstatement(void);
static void getfunction(void);
static void ungetfunction(void);
static void getbody(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel);
static int getdeclarations(int symtype);
static int getsimpledeclaration(int symtype);
static int getonevariable(int symtype);
static void getstatement(LABEL *contlabel, LABEL *breaklabel, LABEL *nextcaselabel, LABEL *defaultlabel);
static void getobjdeclaration(int symtype);
static void getoneobj(long index, int symtype);
static void getobjvars(char *name, int symtype);
static void getmatdeclaration(int symtype);
static void getonematrix(int symtype);
static void creatematrix(void);
static void getsimplebody(void);
static void getcondition(void);
static void getmatargs(void);
static void getelement(void);
static void usesymbol(char *name, int autodef);
static void definesymbol(char *name, int symtype);
static void getcallargs(char *name);
static void do_changedir(void);
static int getexprlist(void);
static int getopassignment(void);
static int getassignment(void);
static int getaltcond(void);
static int getorcond(void);
static int getandcond(void);
static int getrelation(void);
static int getsum(void);
static int getproduct(void);
static int getorexpr(void);
static int getandexpr(void);
static int getshiftexpr(void);
static int getreference(void);
static int getincdecexpr(void);
static int getterm(void);
static int getidexpr(bool okmat, int autodef);
static 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
 */
static 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.
 */
static 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'.
 */
static 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*/
static 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 ] ... ';'.
 */
static 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".
 */
static 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
 *      static a, b = 1, c d = 2, d;
 */
static 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
 */
static 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.
 */
static 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 *)calloc(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;
        }
    }
}

static 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 "static" declaration, or, if
 * symtype is SYM_UNDEFINED, to create one object value of the specified
 * type.
 *
 * given:
 *      name            object name
 *      symtype         declaration type
 */
static 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);
    }
}

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

static 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();
}

static 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 ] ... }.
 */
static 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 ')'.
 */
static 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 ] ...
 */
static 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.
 */
static 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
 */

static 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 ].
 */
static 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 ] ...
 */
static 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 ] ...
 */
static 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.
 */
static 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 ] ...
 */
static 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 ] ...
 */
static 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 ] ...
 */
static 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 ] ...
 */
static 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.
 */
static 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
 */
static 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--
 */
static 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
 */
static 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.
 */
static 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.
 */
static 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
 */
static 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;
}

/*
 * Useful routine to return the index of one string within another one
 * which has the format:  "str1\000str2\000str3\000...strn\0\0".  Index starts
 * at one for the first string.  Returns zero if the string being checked
 * is not contained in the formatted string.
 *
 * Be sure to use \000 instead of \0.  ANSI-C compilers interpret "foo\0foo..."
 * as "foo\017oo...".
 *
 * given:
 *      format          string formatted into substrings
 *      test            string to be found in formatted string
 */
static long
stringindex(char *format, char *test)
{
    long index;     /* found index */
    size_t len;     /* length of current piece of string */
    size_t testlen; /* length of test string */

    testlen = strlen(test);
    index = 1;
    while (*format) {
        len = strlen(format);
        if ((len == testlen) && (*format == *test) && (strcmp(format, test) == 0)) {
            return index;
        }
        format += (len + 1);
        index++;
    }
    return 0;
}

/*
 * Read the show command to display useful information
 */
static 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'.
 */
static 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.
 */
static 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.
 */
static 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.
 */
static 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
 */
static 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
 */
static 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.
 */
static 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);
    }
}
