eightball.c

/**************************************************************************/
/* EightBall                                                              */
/*                                                                        */
/* The Eight Bit Algorithmic Language                                     */
/* For Apple IIe/c/gs (64K), Commodore 64, VIC-20 +32K RAM expansion      */
/* (also builds for Linux as 32 bit executable (gcc -m32) only)           */
/*                                                                        */
/* Compiles with cc65 v2.15 for VIC-20, C64, Apple II                     */
/* and gcc 7.3 for Linux                                                  */
/*                                                                        */
/* Note that this code assumes that sizeof(int) = sizeof(int*), which is  */
/* true for 6502 (16 bits each) and i686 (32 bits each) - but not amd64   */
/*                                                                        */
/* cc65: Define symbol VIC20 to build for Commodore VIC-20 + 32K.         */
/*       Define symbol C64 to build for Commodore 64.                     */
/*       Define symbol A2E to build for Apple //e.                        */
/*                                                                        */
/* Copyright Bobbi Webber-Manners 2016, 2017, 2018                        */
/*                                                                        */
/* Formatted using indent -kr -nut                                        */
/*                                                                        */
/**************************************************************************/

/**************************************************************************/
/*  GNU PUBLIC LICENCE v3 OR LATER                                        */
/*                                                                        */
/*  This program is free software: you can redistribute it and/or modify  */
/*  it under the terms of the GNU General Public License as published by  */
/*  the Free Software Foundation, either version 3 of the License, or     */
/*  (at your option) any later version.                                   */
/*                                                                        */
/*  This program 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 General Public License for more details.                          */
/*                                                                        */
/*  You should have received a copy of the GNU General Public License     */
/*  along with this program.  If not, see <http://www.gnu.org/licenses/>. */
/*                                                                        */
/**************************************************************************/

//#include <stdio.h>
#include <ctype.h>
#include <stdlib.h>
#include <string.h>
#include <setjmp.h>
#include <unistd.h>

#include "eightballutils.h"
#include "eightballvm.h"

/* Define EXTMEM to enable extended memory support for source code.
 * Define EXTMEMCODE to enable extended memory support for object code.
 * Works for Apple //e only at present, but easy to extend.
 * EXTMEMCODE can only be enabled if EXTMEM is also enabled.
 */ 
#ifdef A2E
#define EXTMEM      /* Enable/disable extended memory for source code */
#define EXTMEMCODE  /* Enable/disable extended memory for object code */
#endif

/* Shortcut define CC65 makes code clearer */
#if defined(VIC20) || defined(C64) || defined(A2E)
#define CC65
#endif

/* Shortcut define CBM is useful! */
#if defined(VIC20) || defined(C64)
#define CBM
#endif

#ifdef CC65
#ifdef CBM
/* Commodore headers */
#include <cbm.h>
#include <peekpoke.h>
#endif
#if defined(A2E)
/* Apple //e headers */
#include <apple2enh.h>
#include <fcntl.h>              /* For open(), close() */
#include <unistd.h>             /* For read(), write() */
#include <conio.h>              /* For clrscr() */
#include <stdio.h>              /* For fopen(), fclose() */
#include <peekpoke.h>
#include <em.h>
#endif
#endif

#ifdef __GNUC__
#include <stdio.h>              /* For FILE */
#endif

//#define TEST
//#define DEBUG_READFILE

//#define EXIT(arg) {printf("%d\n",__LINE__); exit(arg);}
#define EXIT(arg) exit(arg)

#define VARNUMCHARS 4           /* First 4 chars of variable name are significant */
#define SUBRNUMCHARS 8          /* First 8 chars of variable name are significant */

/*
 ***************************************************************************
 * Lightweight functions (lighter than the cc65 library for our use case)
 ***************************************************************************
 */

/*
 * This should use less memory than the table-driven version of isalpha()
 * provided by cc65
 */
#define isalphach(ch) ((ch >= 'a' && ch <= 'z') || (ch >= 'A' && ch <= 'Z'))

/*
 * This should use less memory than the table-driven version of isdigit()
 * provided by cc65
 */
#define isdigitch(ch) (ch >= '0' && ch <= '9')

/*
 * Implement this ourselves for cc65 - x^y
 */
int _pow(int x, int y)
{
    int i;
    int ret = 1;

    for (i = 0; i < y; i++) {
        ret *= x;
    }
    return ret;
}

/*
 ***************************************************************************
 * Prototypes
 ***************************************************************************
 */
unsigned char P(void);
unsigned char E(void);
unsigned char eval(unsigned char checkNoMore, int *val);
unsigned char parseint(int *);
unsigned char parsehexint(int *);
unsigned char getintvar(char *, int, int *, unsigned char *, unsigned char);
unsigned char openfile(unsigned char);
unsigned char readfile(void);
unsigned char writefile(void);
void list(unsigned int, unsigned int);
void run(unsigned char);
void new(void);
unsigned char parseline(void);
unsigned char docall(void);
unsigned char doreturn(int retvalue);
void emit(enum bytecode code);
void emit_imm(enum bytecode code, int word);
void emitprmsg(void);
void linksubs(void);
void copyfromaux(char *auxptr, unsigned char len);

#define emitldi(x) emit_imm(VM_LDIMM, x)

/*
 ***************************************************************************
 * Globals
 ***************************************************************************
 */

char compile = 0;               /* 0 means interpret, 1 means compile          */
char compilingsub = 0;          /* 1 when compiling subroutine, 0 otherwise    */
char onlyconstants = 0;         /* 0 is normal, 1 means only allow const exprs */
char compiletimelookup = 0;     /* When set to 1, getintvar() will do lookup   */
                                /* rather than code generation                 */

#define FILENAMELEN 15

char readbuf[255];              /* Buffer for reading from file                */
char lnbuf[255];                /* Input text line buffer                      */
char filename[FILENAMELEN+1];   /* Name of bytecode file                       */
char *txtPtr;                   /* Pointer to next character to read in lnbuf  */

#define STACKSZ 16              /* Size of expression stacks   */
#define RETSTACKSZ 64           /* Size of return stack        */

int operand_stack[STACKSZ];     /* Operand stack - grows down  */
unsigned char operator_stack[STACKSZ];  /* Operator stack - grows down */
int return_stack[RETSTACKSZ];   /* Return stack - grows down   */

unsigned char operatorSP;       /* Operator stack pointer      */
unsigned char operandSP;        /* Operand stack pointer       */
unsigned char returnSP;         /* Return stack pointer        */

jmp_buf jumpbuf;                /* For setjmp()/longjmp()      */

#ifndef CBM
FILE *fd;                       /* File descriptor             */
#endif

/*
 * Definitions for the EightBall VM - compilation target
 */

unsigned int rtPC;              /* Program counter when compiling      */
unsigned int rtSP;              /* Stack pointer when compiling        */
unsigned int rtFP;              /* Frame pointer when compiling        */
unsigned int rtPCBeforeEval;    /* Stashed copy of program counter     */
unsigned char *codeptr;         /* Pointer to write VM code to memory  */

#ifdef EXTMEMCODE
unsigned char *codestart;       /* Start address of VM code in ext mem */
#endif

/*
 * Represents a line of EightBall code.
 * The string itself is stored adjacent in regular memory or, if EXTMEM is
 * defined, in extended memory (aux RAM on Apple //e.)
 */
struct lineofcode {
    char *line;
    struct lineofcode *next;
#ifdef EXTMEM
    unsigned char len;
#endif
};

/*
 * Pointer to current line
 */
struct lineofcode *current = NULL;

/*
 * Used as a line number counter
 */
int counter;

/*
 * Holds the return value from a subroutine / function
 * (for the interpreter only)
 */
int retregister = 0;

/*
 ***************************************************************************
 * Token table for expression parser
 ***************************************************************************
 */

/*
 * Single character binary operators - order must match binaryops string.
 * and must be sequential.
 */
#ifdef CBM
const char binaryops[] = "^/%*+-><&#!";
#else
const char binaryops[] = "^/%*+-><&|!";
#endif

#define TOK_POW     245         /* Binary ^               */
#define TOK_DIV     246         /* Binary /               */
#define TOK_MOD     247         /* Binary %               */
#define TOK_MUL     248         /* Binary *               */
#define TOK_ADD     249         /* Binary +               */
#define TOK_SUB     250         /* Binary -               */
#define TOK_GT      251         /* Binary >               */
#define TOK_LT      252         /* Binary <               */
#define TOK_BITAND  253         /* Binary &               */
#define TOK_BITOR   254         /* Binary | (# on CBM)    */
#define TOK_BITXOR  255         /* Binary ! (^ in C code) */

/*
 * Macro to determine if a token is a binary operator with one character.
 */
#define IS1CHBINARY(tok) ((tok >= TOK_POW) && (tok <= TOK_BITXOR))

/*
 * Two character binary operators - order must match binaryops1/2 strings.
 * and must be sequential.
 */
#ifdef CBM
const char binaryops1[] = "=!><&#<>";   /* 1st char */
const char binaryops2[] = "====&#<>";   /* 2nd char */
#else
const char binaryops1[] = "=!><&|<>";   /* 1st char */
const char binaryops2[] = "====&|<>";   /* 2nd char */
#endif

#define TOK_EQL     237         /* Binary ==             */
#define TOK_NEQL    238         /* Binary !=             */
#define TOK_GTE     239         /* Binary >=             */
#define TOK_LTE     240         /* Binary <=             */
#define TOK_AND     241         /* Binary &&             */
#define TOK_OR      242         /* Binary || (## on CBM) */
#define TOK_LSH     243         /* Binary <<             */
#define TOK_RSH     244         /* Binary >>             */

/*
 * Macro to determine if a token is a binary operator with two characters.
 */
#define IS2CHBINARY(tok) ((tok >= TOK_EQL) && (tok <= TOK_RSH))

/*
 * Unary operators - order must match unaryops string and must be sequential.
 * All unary operators are single character.
 */
#ifdef CBM
const char unaryops[] = "-+!.*^";
#else
const char unaryops[] = "-+!~*^";
#endif

#define TOK_UNM     231         /* Unary -                  */
#define TOK_UNP     232         /* Unary +                  */
#define TOK_NOT     233         /* Unary !                  */
#define TOK_BITNOT  234         /* Unary ~ (. on CBM)       */
#define TOK_STAR    235         /* Unary * (word deref.)    */
#define TOK_CARET   236         /* Unary ^ (byte deref.)    */

/*
 * Macro to determine if a token is a unary operator.
 */
#define ISUNARY(tok) ((tok >= TOK_UNM) && (tok <= TOK_CARET))

/*
 * Special token to mark end of stack
 */
#define SENTINEL    50

/*
 * Special token for illegal operator or statement.
 */
#define ILLEGAL     100

/*
 * Error codes
 */
#define ERR_FIRST   101         /* FIRST ERROR NUM    */
#define ERR_NOIF    101         /* No IF              */
#define ERR_NOFOR   102         /* No FOR             */
#define ERR_NOWHILE 103         /* No WHILE           */
#define ERR_NOSUB   104         /* No SUB             */
#define ERR_STACK   105         /* No stack           */
#define ERR_COMPLEX 106         /* Too complex        */
#define ERR_VAR     107         /* Variable expected  */
#define ERR_REDEF   108         /* Variable redefined */
#define ERR_EXPECT  109         /* Expected character */
#define ERR_EXTRA   110         /* Unexpected extra   */
#define ERR_DIM     111         /* Bad dimension      */
#define ERR_SUBSCR  112         /* Bad subscript      */
#define ERR_RUNSUB  113         /* Ran into sub       */
#define ERR_STR     114         /* Bad string         */
#define ERR_FILE    115         /* File error         */
#define ERR_LINE    116         /* Bad line number    */
#define ERR_EXPR    117         /* Invalid expr       */
#define ERR_NUM     118         /* Invalid number     */
#define ERR_ARG     119         /* Argument error     */
#define ERR_TYPE    120         /* Type error         */
#define ERR_DIVZERO 121         /* Divide by zero     */
#define ERR_VALUE   122         /* Bad value          */
#define ERR_CONST   123         /* Const value reqd   */
#define ERR_STCONST 124         /* Const value reqd   */
#define ERR_TOOLONG 125         /* Initializer too lng */
#define ERR_LINK    126         /* Linkage error      */

char *errmsgs[] = {
    "no if",                    /* ERR_NOIF    */
    "no for",                   /* ERR_NOFOR   */
    "no while",                 /* ERR_NOWHILE */
    "no sub",                   /* ERR_NOSUB   */
    "stack",                    /* ERR_STACK   */
    "complex",                  /* ERR_COMPLEX */
    "expect var",               /* ERR_VAR     */
    "redef",                    /* ERR_REDEF   */
    "expected ",                /* ERR_EXPECT  */
    "extra",                    /* ERR_EXTRA   */
    "bad dim",                  /* ERR_DIM     */
    "bad idx",                  /* ERR_SUBSCR  */
    "ran into sub",             /* ERR_RUNSUB  */
    "bad str",                  /* ERR_STR     */
    "file",                     /* ERR_FILE    */
    "bad line#",                /* ERR_LINE    */
    "bad expr",                 /* ERR_EXPR    */
    "bad num",                  /* ERR_NUM     */
    "arg",                      /* ERR_ARG     */
    "type",                     /* ERR_TYPE    */
    "div/0",                    /* ERR_DIVZERO */
    "bad val",                  /* ERR_VALUE   */
    "not const",                /* ERR_CONST   */
    "const",                    /* ERR_STCONST */
    "too long",                 /* ERR_TOOLONG */
    "link"                      /* ERR_LINK    */
};

/*
 * Error reporting
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void error(unsigned char errcode)
{
    printchar('?');
    print(errmsgs[errcode - ERR_FIRST]);
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Based on C's precedence rules.  Higher return value means higher precedence.
 * Ref: http://en.cppreference.com/w/c/language/operator_precedence
 * TODO: Code will probably be smaller if we use a table.
 */
unsigned char getprecedence(int token)
{
    switch (token) {
    case TOK_UNP:
    case TOK_UNM:
    case TOK_STAR:
    case TOK_CARET:
    case TOK_NOT:
    case TOK_BITNOT:
        return 11;
    case TOK_POW:
    case TOK_DIV:
    case TOK_MUL:
    case TOK_MOD:
        return 10;
    case TOK_ADD:
    case TOK_SUB:
        return 9;
    case TOK_LSH:
    case TOK_RSH:
        return 8;
    case TOK_GT:
    case TOK_GTE:
    case TOK_LT:
    case TOK_LTE:
        return 7;
    case TOK_EQL:
    case TOK_NEQL:
        return 6;
    case TOK_BITAND:
        return 5;
    case TOK_BITXOR:
        return 4;
    case TOK_BITOR:
        return 3;
    case TOK_AND:
        return 2;
    case TOK_OR:
        return 1;
    case SENTINEL:
        return 0;  /* Must be lowest precedence! */
    default:
        /* Should never happen */
        EXIT(99);
    }
}

/*
 * Operator stack routines
 */

void push_operator_stack(unsigned char operator)
{
    operator_stack[operatorSP] = operator;
    if (!operatorSP) {
        /* Warm start */
        error(ERR_COMPLEX);
        longjmp(jumpbuf, 1);
    }
    --operatorSP;
}

unsigned char pop_operator_stack()
{
    if (operatorSP == STACKSZ - 1) {
        /* Warm start */
        longjmp(jumpbuf, 1);
    }
    ++operatorSP;
    return operator_stack[operatorSP];
}

#define top_operator_stack() operator_stack[operatorSP + 1]

/*
 * Operand stack routines
 */

void push_operand_stack(int operand)
{
    if (compile) {
        emitldi(operand);
        return;
    }
    operand_stack[operandSP] = operand;
    if (!operandSP) {
        /* Warm start */
        error(ERR_COMPLEX);
        longjmp(jumpbuf, 1);
    }
    --operandSP;
}

int pop_operand_stack()
{
    if (compile) {
        return 0;
    }
    if (operandSP == STACKSZ - 1) {
        /* Warm start */
        longjmp(jumpbuf, 1);
    }
    ++operandSP;
    return operand_stack[operandSP];
}

#define top_operand_stack() operand_stack[operandSP + 1]

/*
 ***************************************************************************
 * Parser proper ...
 ***************************************************************************
 */

/*
 * Binary operators
 *
 * Examines the character at *txtPtr, and if not NULL the character at
 * *(txtPtr+1).  If a two character binary operator is found, return the
 * token, otherwise if a one character binary operator is found return
 * the token.  If neither of these, return ILLEGAL.
 *
 * Uses the global tables binaryops (for single char operators) and
 * binaryops1 / binaryops2 (for two character operators).
 */
unsigned char binary()
{
    unsigned char tok;
    unsigned char idx = 0;

    /*
     * First two char ops (don't try if first char is NULL though!)
     */

    if (*txtPtr) {
        tok = TOK_EQL;
        while (binaryops1[idx]) {
            if (binaryops1[idx] == *txtPtr) {
                if (binaryops2[idx] == *(txtPtr + 1)) {
                    return tok;
                }
            }
            ++idx;
            ++tok;
        }
    }

    /*
     * Now single char ops
     */
    idx = 0;
    tok = TOK_POW;
    while (binaryops[idx]) {
        if (binaryops[idx] == *txtPtr) {
            return tok;
        }
        ++idx;
        ++tok;
    }

    return ILLEGAL;
}

/*
 * Unary operators
 *
 * Examines the character at *txtPtr.  If it is one of the unary operators
 * (which are all single character), returns the token value, otherwise
 * returns ILLEGAL.
 *
 * Uses the global tables unaryops (for single char operators).
 */
unsigned char unary()
{
    unsigned char idx = 0;
    unsigned char tok = TOK_UNM;

    while (unaryops[idx]) {
        if (unaryops[idx] == *txtPtr) {
            return tok;
        }
        ++idx;
        ++tok;
    }
    return ILLEGAL;
}

/*
 * Pop an operator from the operator stack, pop the operands from the
 * operand stack and apply the operator to the operands.
 * Returns 0 if successful, 1 on error
 */
unsigned char pop_operator()
{
    int operand2;
    int result;
    int token = pop_operator_stack();
    int operand1 = pop_operand_stack();

    if (!ISUNARY(token)) {

        /*
         * Evaluate binary operator
         * (Apply the operator token to operand1, operand2)
         */
        operand2 = pop_operand_stack();

        switch (token) {
        case TOK_POW:
            result = _pow(operand2, operand1);
            break;
        case TOK_MUL:
            if (compile) {
                emit(VM_MUL);
                return 0;
            }
            result = operand2 * operand1;
            break;
        case TOK_DIV:
            if (compile) {
                emit(VM_DIV);
                return 0;
            }
            if (operand1 == 0) {
                error(ERR_DIVZERO);
                return 1;
            } else {
                result = operand2 / operand1;
            }
            break;
        case TOK_MOD:
            if (compile) {
                emit(VM_MOD);
                return 0;
            }
            if (operand1 == 0) {
                error(ERR_DIVZERO);
                return 1;
            } else {
                result = operand2 % operand1;
            }
            break;
        case TOK_ADD:
            if (compile) {
                emit(VM_ADD);
                return 0;
            }
            result = operand2 + operand1;
            break;
        case TOK_SUB:
            if (compile) {
                emit(VM_SUB);
                return 0;
            }
            result = operand2 - operand1;
            break;
        case TOK_GT:
            if (compile) {
                emit(VM_GT);
                return 0;
            }
            result = operand2 > operand1;
            break;
        case TOK_GTE:
            if (compile) {
                emit(VM_GTE);
                return 0;
            }
            result = operand2 >= operand1;
            break;
        case TOK_LT:
            if (compile) {
                emit(VM_LT);
                return 0;
            }
            result = operand2 < operand1;
            break;
        case TOK_LTE:
            if (compile) {
                emit(VM_LTE);
                return 0;
            }
            result = operand2 <= operand1;
            break;
        case TOK_EQL:
            if (compile) {
                emit(VM_EQL);
                return 0;
            }
            result = operand2 == operand1;
            break;
        case TOK_NEQL:
            if (compile) {
                emit(VM_NEQL);
                return 0;
            }
            result = operand2 != operand1;
            break;
        case TOK_AND:
            if (compile) {
                emit(VM_AND);
                return 0;
            }
            result = operand2 && operand1;
            break;
        case TOK_OR:
            if (compile) {
                emit(VM_OR);
                return 0;
            }
            result = operand2 || operand1;
            break;
        case TOK_BITAND:
            if (compile) {
                emit(VM_BITAND);
                return 0;
            }
            result = operand2 & operand1;
            break;
        case TOK_BITOR:
            if (compile) {
                emit(VM_BITOR);
                return 0;
            }
            result = operand2 | operand1;
            break;
        case TOK_BITXOR:
            if (compile) {
                emit(VM_BITXOR);
                return 0;
            }
            result = operand2 ^ operand1;
            break;
        case TOK_LSH:
            if (compile) {
                emit(VM_LSH);
                return 0;
            }
            result = operand2 << operand1;
            break;
        case TOK_RSH:
            if (compile) {
                emit(VM_RSH);
                return 0;
            }
            result = operand2 >> operand1;
            break;
        default:
            /* Should never happen */
            EXIT(99);
        }

    } else {

        /*
         * Evaluate unary operator
         * (Apply the operator token to operand1)
         */

        switch (token) {
        case TOK_UNM:
            if (compile) {
                emit(VM_NEG);
                return 0;
            }
            result = -operand1;
            break;
        case TOK_UNP:
            if (compile) {
                return 0;
            }
            result = operand1;
            break;
        case TOK_NOT:
            if (compile) {
                emit(VM_NOT);
                return 0;
            }
            result = !operand1;
            break;
        case TOK_BITNOT:
            if (compile) {
                emit(VM_BITNOT);
                return 0;
            }
            result = ~operand1;
            break;
        case TOK_STAR:
            if (compile) {
                emit(VM_LDAWORD);
                return 0;
            }
            result = *((int *) operand1);
            break;
        case TOK_CARET:
            if (compile) {
                emit(VM_LDABYTE);
                return 0;
            }
            result = *((unsigned char *) operand1);
            break;
        default:
            /* Should never happen */
            EXIT(99);
        }
    }
    push_operand_stack(result);
    return 0;
}

/*
 * Returns 0 if successful, 1 on error
 */
unsigned char push_operator(int operator_token)
{
    /* Handles operator precedence here */
    while (getprecedence(top_operator_stack()) >=
           getprecedence(operator_token)) {

        if (pop_operator()) {
            return 1;
        }
    }
    push_operator_stack(operator_token);
    return 0;
}


#define CALLFRAME   0xfffe      /* Magic number for CALL stack frame           */
#define IFFRAME     0xfffd      /* Magic number for IF stack frame             */
#define FORFRAME_B  0xfffc      /* Magic number for FOR stack frame - byte var */
#define FORFRAME_W  0xfffb      /* Magic number for FOR stack frame - word var */
#define WHILEFRAME  0xfffa      /* Magic number for WHILE stack frame          */

/*
 * Push line number (or other int) to return stack.
 */
void push_return(int linenum)
{
    return_stack[returnSP] = linenum;
    if (!returnSP) {
        error(ERR_STACK);
        longjmp(jumpbuf, 1);
    }
    --returnSP;
}

/*
 * Pop line number (or other int) from return stack.
 */
int pop_return()
{
    if (returnSP == RETSTACKSZ - 1) {
        error(ERR_STACK);
        longjmp(jumpbuf, 1);
    }
    ++returnSP;
    return return_stack[returnSP];
}

/*
 * Consume any space characters at txtPtr
 * Macro so it inlines on 6502 for speed.
 */
#define eatspace() \
while (*txtPtr == ' ') { \
    ++txtPtr; \
}

/*
 * Returns 0 on success, 1 if error
 * This is only ever invoked for single character tokens
 * (which allows some simplification)
 */
unsigned char expect(unsigned char token)
{
    if (*txtPtr == token) {
        ++txtPtr;               // expect() only called for one char tokens
        eatspace();
        return 0;
    } else {
        error(ERR_EXPECT);
        printchar(token);
        return 1;
    }
}

/*
 * Handles an expression
 * Returns 0 on success, 1 on error
 */
unsigned char E()
{
    int op;

    if (P()) {
        return 1;
    }

    while ((op = binary()) != ILLEGAL) {
        if (push_operator(op)) {
            return 1;
        }
        if (IS1CHBINARY(op)) {
            ++txtPtr;
        } else {
            txtPtr += 2;
        }
        if (P()) {
            return 1;
        }
    }

    while (top_operator_stack() != SENTINEL) {
        if (pop_operator()) {
            return 1;
        }
    }
    return 0;
}

/*
 * Parse array subscript
 * Returns 0 if '[expr]' is found, 1 otherwise
 */
unsigned char subscript(int *idx)
{
    /* Start a new subexpression */
    push_operator_stack(SENTINEL);

    if (expect('[')) {
        return 1;
    }
    if (eval(0, idx)) {
        return 1;
    }
    if (expect(']')) {
        return 1;
    }

    /* Throw away SENTINEL */
    pop_operator_stack();

    return 0;
}

/*
 * Handles a predicate
 * Returns 0 on success, 1 on error
 * If the global variable onlyconstants is set then only allow constant predicates.
 */
unsigned char P()
{
    struct lineofcode *oldcurrent;
    int oldcounter;
    char key[VARNUMCHARS];
    int idx;
    char *writePtr;
    unsigned char addressmode;  /* Set to 1 if there is '&' */
    int arg = 0;
    unsigned char type;

    eatspace();

    if (!(*txtPtr)) {
        error(ERR_EXPR);
        return 1;
    }

    if ((*txtPtr == '&') || (isalphach(*txtPtr))) {

        addressmode = 0;

        /*
         * Handle address-of operator
         */
        if (*txtPtr == '&') {
            addressmode = 1;
            ++txtPtr;
            if (!isalphach(*txtPtr)) {
                error(ERR_VAR);
                return 1;
            }
        }

        /*
         * Handle variables
         */
        writePtr = readbuf;
        while (isalphach(*txtPtr) || isdigitch(*txtPtr)) {
            if (arg < VARNUMCHARS) {
                key[arg++] = *txtPtr;
            }
            *writePtr = *txtPtr;
            ++txtPtr;
            ++writePtr;
        }
        if (arg < VARNUMCHARS) {
            key[arg] = '\0';
        }
        *writePtr = '\0';

        idx = -1;
        if (*txtPtr == '[') {
            idx = 0;
            if (subscript(&idx) == 1) {
                error(ERR_SUBSCR);
                return 1;
            }

        } else if (*txtPtr == '(') {

            /*
             * Function invokation
             */

            if (onlyconstants) {
                error(ERR_CONST);
                return 1;
            }

            /* No taking address of functions thank you! */
            if (addressmode) {
                error(ERR_VAR);
                return 1;
            }

            if (compile) {
                push_operator_stack(SENTINEL);
                if (docall()) {
                    return 1;
                }

                pop_operator_stack();

            } else {

                push_operator_stack(SENTINEL);

                oldcurrent = current;
                oldcounter = counter;

                /*
                 * For CALL, stack frame is just the
                 * magic number, the return line (-2 in this case)
                 * and the txtPtr pointer (-1 again).
                 *
                 * We create this fake CALLFRAME so that the call to 
                 * run() below terminates after hitting a return
                 * statement in the sub being called.
                 */
                push_return(CALLFRAME);
                push_return(-2);        /* Magic number for function */
                push_return(-1);

                /*
                 * Function call - sets up current, counter and txtPtr
                 * to first line of subroutine being called.
                 */
                if (docall()) {
                    return 1;
                }

                /*
                 * Run the function.  When the function returns it 
                 * is treated as immediate mode, so it comes back
                 * here.  txtPtr is restored to immediately after
                 * the call automatically.
                 */
                run(1);

                current = oldcurrent;
                counter = oldcounter;

#ifdef EXTMEM
                // Restore embuf, which is trashed by the call to run() above
                copyfromaux(current->line, current->len);
#endif
                /*
                 * Throw away our CALLFRAME.
                 */
                pop_return();
                pop_return();
                pop_return();

                /* Throw away the sentinel */
                pop_operator_stack();

                push_operand_stack(retregister);
            }
            goto skip_var;      // MESSY!!
        }

        if (compile) {
            compiletimelookup = 1;
            if (getintvar(key, idx, &arg, &type, addressmode)) {
                return 1;
            }

            if (type & 0x20) {
                push_operand_stack(arg);
                goto skip_var;
            }
        }

        if (getintvar(key, idx, &arg, &type, addressmode)) {
            return 1;
        }

        /* If onlyconstants is set then only allow const variables */
        if (onlyconstants && !(type & 0x20)) {
            error(ERR_CONST);
            return 1;
        }

        if (!compile) {
            push_operand_stack(arg);
        }

      skip_var:
        eatspace();

    } else if (isdigitch(*txtPtr)) {
        /*
         * Handle integer constants
         */
        if (parseint(&arg)) {
            error(ERR_NUM);
            return 1;
        }
        push_operand_stack(arg);
        eatspace();

    } else if (*txtPtr == '$') {
        /*
         * Handle hex constants
         */
        ++txtPtr;               /* Eat the $ */
        if (parsehexint(&arg)) {
            error(ERR_NUM);
            return 1;
        }
        push_operand_stack(arg);
        eatspace();

    } else if (*txtPtr == '\'') {
        /*
         * Handle character constants
         */
        ++txtPtr;               /* Eat the ' */
        arg = *txtPtr;
        ++txtPtr;
        if (*txtPtr != '\'') {
            error(ERR_NUM);
            return 1;
        }
        ++txtPtr;               /* Eat the ' */
        push_operand_stack(arg);
        eatspace();

    } else if (*txtPtr == '(') {
        /*
         * Handle subexpressions in parenthesis
         */
        ++txtPtr;
        push_operator_stack(SENTINEL);
        if (E()) {
            return 1;
        }
        if (expect(')')) {
            return 1;
        }
        pop_operator_stack();

    } else if ((arg = unary()) != ILLEGAL) {
        /*
         * Handle unary operator
         */
        push_operator_stack(arg);
        ++txtPtr;
        if (P()) {
            return 1;
        }

    } else {
        /*
         * Otherwise error
         */
        error(ERR_EXTRA);
        printchar(' ');
        printchar(*txtPtr);
        return 1;
    }
    return 0;
}

/*
 * Evaluate expression at txtPtr
 * If checkNoMore is 1 then check there is no extra input to be consumed.
 * eval() is basically a wrapper around the expression parser routine E().
 * Result is returned via argument val.
 * Returns 0 if successful, 1 on error.
 */
unsigned char eval(unsigned char checkNoMore, int *val)
{

    eatspace();

    if (!(*txtPtr)) {
        error(ERR_EXPR);
        return 1;
    }
    if (E()) {
        return 1;
    }
    if (checkNoMore == 1) {
        if (*txtPtr == ';') {
            goto doret;
        }

        if (*txtPtr) {
            error(ERR_EXTRA);
            printchar(' ');
            print(txtPtr);
            return 1;
        }
    }
  doret:
    *val = pop_operand_stack();

    return 0;
}

/*
 * Everything above this line is the expression parser.
 * Everything below is the rest of the language implementation.
 */

unsigned char *heap1Ptr;        /* Arena 1: top-down stack */
unsigned char *heap2PtrTop;     /* Arena 2: top-down stack */
unsigned char *heap2PtrBttm;    /* Arena 2: bottom-up heap */

#ifdef A2E
unsigned char *auxmemPtrBttm;   /* Auxiliary memory: bottom up heap */
#endif

#ifdef A2E

/*
 * Apple II Enhanced
 *
 * Code starts at 0x0800.  Top of memory is 0xbf00.
 * Stack is 2K immediately below 0xbfff. (0xb800-0xbfff) ??
 *
 * Heap usage:
 *   Heap 1: Variables
 *   Heap 2: Linked list of pointers to lines of program text
 *   Auxiliary memory is used to store program text
 */
#define HEAP1TOP (char*)0xb7ff
#define HEAP1LIM (char*)0x9800

#define HEAP2TOP (char*)(HEAP1LIM - 1)
#ifdef EXTMEM
#define HEAP2LIM (char*)0x8000
#else
#define HEAP2LIM (char*)0x6f00
#endif
                                 /* HEAP2LIM HAS TO BE ADJUSTED TO NOT
                                  * TRASH THE CODE, WHICH LOADS FROM $0800 UP
                                  * USE THE MAPFILE! */

#define AUXMEMTOP (char*)(192*256)  /* Amount of aux memory available */
#define AUXMEMBTTM (char*)2048      /* Bottom 2K of aux mem is used for 80 cols */

#elif defined(C64)

/*
 * C64
 *
 * Here we have a continuous block of RAM from the top of the executable
 * to 0xbfff.  I retain the heap 1 / heap 2 convention of the VIC-20 for now.
 * For now I assign 8K to heap 1 and whatever is left for heap 2.
 *
 * Heap usage:
 *   Heap 1: Variables
 *   Heap 2: Program text
 */
#define HEAP1TOP (char*)0xbfff  /* Leaves 2K for stack, and 2K for ??? */
#define HEAP1LIM (char*)0xa000

#define HEAP2TOP (char*)0x9fff - 0x0400 /* Leave $800 for the C stack */
#define HEAP2LIM (char*)0x6f00
                                 /* HEAP2LIM HAS TO BE ADJUSTED TO NOT
                                  * TRASH THE CODE, WHICH LOADS FROM $0800 UP
                                  * USE THE MAPFILE! */


#elif defined(VIC20)

/*
 * VIC-20:
 *
 * We have two heaps because we have two discontinuous blocks of free memory
 * Heap 1: one using all of BLK5 (8KB)
 * Heap 2: growing down from the top of BLK3 (27.5K less size of executable)
 * The executable is around 19K at the time of writing.
 *
 * Heap usage:
 *   Heap 1: Variables
 *   Heap 2: Program text
 */
//#define HEAP1TOP (char*)0xbfff
//#define HEAP1LIM (char*)0xa000

//#define HEAP2TOP (char*)0x7fff - 0x0400 /* Leave $400 for the C stack */
//#define HEAP2LIM (char*)0x7600  /* HEAP2LIM HAS TO BE ADJUSTED TO NOT
//                                 * TRASH THE CODE, WHICH LOADS FROM $1200 UP
//                                 * USE THE MAPFILE! */

// Everything in BLK5 for now
// BLK3 is almost totally full of code!
// Man ... we really need more memory!!
#define HEAP1TOP (char*)0xbfff
#define HEAP1LIM (char*)0xb000
#define HEAP2TOP (char*)0xafff
#define HEAP2LIM (char*)0xa000


#endif

#ifdef __GNUC__

#define HEAP1SZ 1024*16
unsigned char heap1[HEAP1SZ];
#define HEAP1TOP (heap1 + HEAP1SZ - 1)
#define HEAP1LIM heap1

#endif

/*
 * When compiling, generated code will be stored from start of HEAP 1.
 * Symbol tables grow down from the top of HEAP1
 */
#define CODESTART      HEAP1LIM

/*
 * Clears heap 1.  Must call this before using alloc1().
 */
#define CLEARHEAP1() heap1Ptr = HEAP1TOP

/*
 * Clears heap 2 top-down stack.  Must call this before using alloc2top().
 */
#ifdef CC65
#define CLEARHEAP2TOP() heap2PtrTop = HEAP2TOP
#endif

/*
 * Clears heap 2 bottom-up heap.  Must call this before using alloc2bttm().
 */
#ifdef CC65
#define CLEARHEAP2BTTM() heap2PtrBttm = HEAP2LIM
#endif

/*
 * Clears aux mem bottom-up heap.  Must call this before using allocauxmem().
 */
#ifdef CC65
#ifdef EXTMEM
#define CLEARAUXMEM() auxmemPtrBttm = AUXMEMBTTM;
#endif
#endif

/*
 * Clears runtime call stack (target system when compiling)
 * Called before compilation begins.
 */
#ifdef EXTMEMCODE
#define CLEARRTCALLSTACK() rtSP = RTCALLSTACKTOP; rtFP = rtSP; rtPC = RTPCSTART; codeptr = auxmemPtrBttm; codestart = codeptr;
#else
#define CLEARRTCALLSTACK() rtSP = RTCALLSTACKTOP; rtFP = rtSP; rtPC = RTPCSTART; codeptr = CODESTART;
#endif

/*
 * Allocate bytes on heap 1.
 */
void *alloc1(unsigned int bytes)
{
    if ((heap1Ptr - bytes) < HEAP1LIM) {
        print("No mem (1)!\n");
        longjmp(jumpbuf, 1);
    }
    heap1Ptr -= bytes;
    return heap1Ptr;
}

/*
 * Free bytes on heap 1.
 */
void free1(unsigned int bytes)
{
    heap1Ptr += bytes;
}

/*
 * Allocate bytes on target's call stack
 * Starts at RTCALLSTACKTOP and grows down.
 *
 * To have this track the VM's stack pointer, be sure
 * to emit stack push instuctions (VM_PSHWORD / VM_PSHBYTE)
 * instructions that match calls to
 * rt_push_callstack().
 */
unsigned int rt_push_callstack(unsigned int bytes)
{
    if ((rtSP - bytes) < RTCALLSTACKLIM) {
        print("No tgt mem!\n");
        longjmp(jumpbuf, 1);
    }
    rtSP -= bytes;
    return rtSP;
}

/*
 * Free bytes on target's call stack
 *
 * To have this track the VM's stack pointer, be sure
 * to emit VM_POPWORD / VM_POPBYTE / VM_RTS instructions
 * that match calls to rt_pop_callstack().
 *
 * Note that local variables are freed on function end
 * using the FPSP instruction.
 */
void rt_pop_callstack(unsigned int bytes)
{
    rtSP += bytes;
}

/*
 * Allocate bytes on the stack at the top of heap 2.
 */
void *alloc2top(unsigned int bytes)
{
#ifdef __GNUC__
    void *p = malloc(bytes);
    if (!p) {
        print("No mem (2)!\n");
        longjmp(jumpbuf, 1);
    }
    return p;
#else
    if ((heap2PtrTop - bytes) < heap2PtrBttm) {
        print("No mem (2)!\n");
        longjmp(jumpbuf, 1);
    }
    heap2PtrTop -= bytes;
    return heap2PtrTop;
#endif
}

/*
 * Allocate bytes on the heap at the bottom of heap 2.
 */
void *alloc2bttm(unsigned int bytes)
{
#ifdef __GNUC__
    void *p = malloc(bytes);
    if (!p) {
        print("No mem (2)!\n");
        longjmp(jumpbuf, 1);
    }
    return p;
#else
    void *p = heap2PtrBttm;
    if ((heap2PtrBttm + bytes) > heap2PtrTop) {
        print("No mem (2)!\n");
        longjmp(jumpbuf, 1);
    }
    heap2PtrBttm += bytes;
    return p;
#endif
}

/*
 * Return the total amount of free space on heap 1.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int getfreespace1()
{
    return (heap1Ptr - HEAP1LIM + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Return total amount of space in heap 1.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int gettotalspace1()
{
    return (HEAP1TOP - HEAP1LIM + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Return the total amount of free space on heap 2.
 * This is the space between the bottom of the downwards-growning
 * stack at the top and the top of the upwards-growing heap at the
 * bottom.
 */
#ifdef CC65
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int getfreespace2()
{
    return (heap2PtrTop - heap2PtrBttm + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif
#endif

/*
 * Return total amount of space in heap 2.
 */
#ifdef CC65
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int gettotalspace2()
{
    return (HEAP2TOP - HEAP2LIM + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif
#endif

#ifdef CC65
#ifdef EXTMEM
/*
 * This is used to keep track of allocations in Apple II auxiliary memory.
 * This memory is accessed using cc65's extended memory (EM) driver.
 */
void *allocauxmem(unsigned int bytes) {
    void *p = auxmemPtrBttm;
    if ((auxmemPtrBttm + bytes) > AUXMEMTOP) {
        print("No aux mem!\n");
        longjmp(jumpbuf, 1);
    }
    auxmemPtrBttm += bytes;
    return p;
}

/*
 * Returns the number of bytes of aux mem free
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int getfreeauxmem()
{
    return (AUXMEMTOP - auxmemPtrBttm + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Returns total number of usable bytes of aux mem available
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
int gettotalauxmem()
{
    return (AUXMEMTOP - AUXMEMBTTM + 1);
}
#ifdef A2E
#pragma code-name (pop)
#endif

#endif
#endif

#ifdef EXTMEM
struct em_copy emcopy;

char embuf[255];
char embuf2[255];

char b;
extern char *addrptr;
#pragma zpsym ("addrptr");

/*
 * This inline assembler version avoids the memory corruption
 * which results from using em_copyto() in this situation.
 */
void copybytetoaux(char *auxptr, char byte) {
    addrptr = auxptr; /* addrptr is in zero page */
    addrptr += 0x200; /* BASE address offset */
    b = byte;
    __asm__("sta $c005"); /* Write to aux mem */
    __asm__("lda %v", b);
    __asm__("sta (%v)", addrptr); /* 65C02 instruction */
    __asm__("sta $c004"); /* Back to normal */
#if 0 
    b = byte;
    emcopy.buf = &b;
    emcopy.count = 1;
    emcopy.offs = (unsigned char)auxptr;
    emcopy.page = (unsigned int)auxptr >> 8;
    em_copyto(&emcopy);
#endif
}

void copybytefromaux(char *auxptr) {
    emcopy.buf = embuf;
    emcopy.count = 1;
    emcopy.offs = (unsigned char)auxptr;
    emcopy.page = (unsigned int)auxptr >> 8;
    em_copyfrom(&emcopy);
}

void copytoaux(char *auxptr, char *line) {
    emcopy.buf = line;
    emcopy.count = strlen(line) + 1;
    emcopy.offs = (unsigned char)auxptr;
    emcopy.page = (unsigned int)auxptr >> 8;
    em_copyto(&emcopy);
}

void copyfromaux(char *auxptr, unsigned char len) {
    emcopy.buf = embuf;
    emcopy.count = len + 1; /* Remember the NULL */
    emcopy.offs = (unsigned char)auxptr;
    emcopy.page = (unsigned int)auxptr >> 8;
    em_copyfrom(&emcopy);
}

void copyfromaux2(char *auxptr, unsigned char len) {
    emcopy.buf = embuf2;
    emcopy.count = len + 1; /* Remember the NULL */
    emcopy.offs = (unsigned char)auxptr;
    emcopy.page = (unsigned int)auxptr >> 8;
    em_copyfrom(&emcopy);
}
#endif

/*
 * Compiler: Emit simple one byte code
 * Used for everything except immediate mode opcodes
 * Stores using codeptr.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void emit(enum bytecode code)
{
/*
    unsigned char c = code;
*/

#ifdef EXTMEMCODE
    copybytetoaux(codeptr++, code);
#else
    *codeptr++ = code;
#endif

/*
    printhex(rtPC);
    print(": ");
    printhexbyte(c);
    print("       : ");
    print(bytecodenames[c]);
    printchar('\n');
*/
    ++rtPC;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Compiler: Emit opcode and 16 bit word argument
 * Stores using codeptr.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void emit_imm(enum bytecode code, int word)
{
    unsigned char *p = (unsigned char *) &word;

#ifdef EXTMEMCODE
    copybytetoaux(codeptr++, code);
    copybytetoaux(codeptr++, *p++);
    copybytetoaux(codeptr++, *p);
#else
    *codeptr++ = code;
    *codeptr++ = *p++;
    *codeptr++ = *p;
#endif
    rtPC += 3;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Compiler: Emit PRMSG and string argument.
 * String is in readbuf
 * String is zero-terminated.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void emitprmsg(void)
{
    char *p = readbuf;
#ifdef EXTMEMCODE
    copybytetoaux(codeptr++, VM_PRMSG);
    ++rtPC;
    while (*p) {
        copybytetoaux(codeptr++, *p++);
        ++rtPC;
    }
    copybytetoaux(codeptr++, 0);
    ++rtPC;
#else
    emit(VM_PRMSG);
    ++rtPC;
    while (*p) {
        *codeptr++ = *p++;
        ++rtPC;
    }
    *codeptr++ = 0;
    /* TODO: For some reason I don't need ++rtPC here */
#endif
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Emit fixup for address.
 * The compiler uses this to go back and fill in the address for forward
 * jumps, once it discovers where the destination is.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void emit_fixup(int address, int word)
{
#ifdef EXTMEMCODE
    unsigned char *ptr = (unsigned char *) (codestart + address - RTPCSTART);
    unsigned char *p = (unsigned char *) &word;
    copybytetoaux(ptr++, *p++);
    copybytetoaux(ptr, *p);
#else
    unsigned char *ptr = (unsigned char *) (CODESTART + address - RTPCSTART);
    unsigned char *p = (unsigned char *) &word;
    *ptr++ = *p++;
    *ptr = *p;
#endif

/*
    printhex(address);
    print(": ");
    printhex(word);
    print("                 ; Fixup\n");
*/
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Write code to file.
 * Call this after compilation is done.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void writebytecode()
{
    unsigned char *end = codeptr;
    unsigned char *p;
    unsigned char *q;
#ifdef EXTMEMCODE
    p = (unsigned char *) codestart;
#else
    p = (unsigned char *) CODESTART;
#endif
    strcpy(readbuf, filename);
    printchar('\n');
    openfile(1);
    print("...\n");
    while (p < end) {
#ifdef EXTMEMCODE
        copybytefromaux(p);
        q = embuf;
#else
        q = p;
#endif
#ifdef CBM
        cbm_write(1, q, 1);
#else
        fwrite(q, 1, 1, fd);
#endif
        ++p;
    }
#ifdef CBM
    cbm_close(1);
#else
    fclose(fd);
#endif
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Values:
 *  0 not editing program
 *  1 editing program
 *  2 editing program - insert first line
 */
unsigned char editmode = 0;

/*
 * Pointer to first line of code.
 */
struct lineofcode *program = NULL;

/*
 * skipFlag is set to one when we enter a body of code which we are not
 * executing (for example because a while loop condition was false.)  When
 * skipFlag is one, the parser will only process certain loop control tokens
 * - all others are ignored.
 */
unsigned char skipFlag;

/*
 * Append a line to the program
 * The new line will be appended after current
 * and current will be moved forward to point to the newly added line.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void appendline(char *line)
{
    struct lineofcode *loc = alloc2bttm(sizeof(struct lineofcode));

#ifdef EXTMEM
    loc->line = allocauxmem(sizeof(char) * strlen(line) + 1);
    copytoaux(loc->line, line);
    loc->len = strlen(line);
#else
    loc->line = alloc2bttm(sizeof(char) * (strlen(line) + 1));
    strcpy(loc->line, line);
#endif
    loc->next = current->next;
    current->next = loc;
    current = loc;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Insert new first line (special case)
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void insertfirstline(char *line)
{
    struct lineofcode *loc = alloc2bttm(sizeof(struct lineofcode));

#ifdef EXTMEM
    loc->line = allocauxmem(sizeof(char) * strlen(line) + 1);
    copytoaux(loc->line, line);
    loc->len = strlen(line);
#else
    loc->line = alloc2bttm(sizeof(char) * (strlen(line) + 1));
    strcpy(loc->line, line);
#endif
    loc->next = program;
    program = loc;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Make current point to the line with number linenum
 * (or NULL if not found).
 * Line numbers start from one in this routine.
 */
void findline(int linenum)
{
    counter = 1;
    current = program;
    while (current) {
        if (counter == linenum) {
            return;
        }
        current = current->next;
        ++counter;
    }
}

/*
 * Delete line(s)
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void deleteline(int startline, int endline)
{
    int linesToDel = endline - startline + 1;
    struct lineofcode *prev = NULL;

    counter = 1;
    if (endline < startline) {
        return;
    }
    current = program;
    while (current && linesToDel) {
        if (counter == startline) {
            if (prev) {
                prev->next = current->next;
            } else {
                program = current->next;
            }
#ifdef __GNUC__
            free(current->line);
            free(current);
#endif
            current = current->next;    /* ILLEGAL BUT WORKS FOR NOW */
            --linesToDel;
            continue;
        }
        prev = current;
        current = current->next;
        ++counter;
    }
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Replace line pointed to by current
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void changeline(char *line)
{
#ifdef __GNUC__
    free(current->line);
#endif

#ifdef EXTMEM
    current->line = allocauxmem(sizeof(char) * (strlen(line) + 1));
    copytoaux(current->line, line);
#else
    current->line = alloc2bttm(sizeof(char) * (strlen(line) + 1));
    strcpy(current->line, line);
#endif
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Delete program, free memory.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void new()
{
#ifdef __GNUC__
    struct lineofcode *l = program;
    struct lineofcode *l2;

    while (l) {
        l2 = l->next;
        free(l->line);
        free(l);
        l = l2;
    }
#else
    /* No need to iterate and free them all, just dump the heap */
    CLEARHEAP2TOP();
    CLEARHEAP2BTTM();
#ifdef EXTMEM
    CLEARAUXMEM();
#endif
#endif
    program = NULL;
    current = NULL;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/* 0 is the top level, 1 is first level sub call etc. */
int calllevel;

/*
 * Entry in the variable table
 * name: first VARNUMCHARS characters as key
 * type: encodes the type in the least significant 4 bits (bits 3:0) encode
 *       the data type (TYPE_WORD or TYPE_BYTE).  The next least significant
 *       bit (bit 4) is 0 for a scalar value and 1 for an array.  Bit 5 is
 *       0 for a normal variable and 1 for a constant.
 * next: pointer to next vartabent.
 */
struct vartabent {
    char name[VARNUMCHARS];
    unsigned char type;         /* See above */
    struct vartabent *next;
};

typedef struct vartabent var_t;

var_t *varsbegin;               /* First table entry */
var_t *varsend;                 /* Last table entry  */
var_t *varslocal;               /* Local stack frame */

/*
 * Entry in the subroutine table.  This is used by the compiler only.
 * name: first SUBRNUMCHARS characters as key
 * addr: address of entry point in compiled code.
 */
struct subtabent {
    char name[SUBRNUMCHARS];
    unsigned int addr;
    struct subtabent *next;
};

typedef struct subtabent sub_t;

sub_t *subsbegin;               /* Entry points of compiled subroutines - first */
sub_t *subsend;                 /* Entry points of compiled subroutines - last  */
sub_t *callsbegin;              /* Subroutine calls - first */
sub_t *callsend;                /* Subroutine calls - end */

#define getptrtoscalarword(v) (int*)((char*)v + sizeof(var_t))
#define getptrtoscalarbyte(v) (unsigned char*)((char*)v + sizeof(var_t))

/*
 * Find integer variable
 * local - pointer to unsigned char.  If this contains 1 on entry then
 * only local variables will be searched.  The value returned in this
 * field can be used to determine if variable found was local (1) or
 * global (0).
 */
var_t *findintvar(char *name, unsigned char *local)
{
    var_t *ptr;

    /* Search locals */
    ptr = varslocal;
    while (ptr) {
        if (!strncmp(name, ptr->name, VARNUMCHARS)) {
            *local = 1;
            return ptr;
        }
        ptr = ptr->next;
    }

    if (*local == 1) {
        return NULL;
    }

    /* Search globals */
    ptr = varsbegin;
    while (ptr && (ptr->name[0] != '-')) {
        if (!strncmp(name, ptr->name, VARNUMCHARS)) {
            *local = 0;
            return ptr;
        }
        ptr = ptr->next;
    }
    return NULL;                /* Not found */
}

/*
 * Clear all variables
 */
void clearvars()
{
/* No need to iterate and free them all, just dump the heap */
    CLEARHEAP1();
    varsbegin = NULL;
    varsend = NULL;
    varslocal = NULL;
}

enum types {
    TYPE_CONST,                 /* Stored as TYPE_WORD     */
    TYPE_WORD,                  /* Word variable - 16 bits */
    TYPE_BYTE                   /* Byte variable - 8 bits  */
};

/*
 * Print all variables as a table
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void printvars()
{
    var_t *v = varsbegin;

    while (v) {
        printchar(v->name[0] ? v->name[0] : ' ');
        printchar(v->name[1] ? v->name[1] : ' ');
        printchar(v->name[2] ? v->name[2] : ' ');
        printchar(v->name[3] ? v->name[3] : ' ');
        if (v->type & 0x10) {
            printchar('[');
            printdec(*(int *)
                     ((unsigned char *) v + sizeof(var_t) + sizeof(int)));
            printchar(']');
        }
        printchar(' ');
        printchar(((v->type & 0x0f) == TYPE_WORD) ? 'w' : 'b');
        printchar((v->type & 0x20) ? 'c' : ' ');
        printchar(' ');
        if ((v->type & 0x10) == 0) {
            if (v->type == TYPE_WORD) {
                printdec(*getptrtoscalarword(v));
            } else {
                printdec(*getptrtoscalarbyte(v));
            }
        }
        printchar('\n');
        v = v->next;
    }
}
#ifdef A2E
#pragma code-name (pop)
#endif

/* Factored out to save a few bytes
 * Used by createintvar() only.
 */
void civ_st_rel_word(unsigned int i)
{
    emitldi(rtSP - rtFP + 2 * i);
    emit(VM_STRWORD);
}

/* Factored out to save a few bytes
 * Used by createintvar() only.
 */
void civ_st_rel_byte(unsigned int i)
{
    emitldi(rtSP - rtFP + i);
    emit(VM_STRBYTE);
}

#define STRG_INIT 0
#define LIST_INIT 1
/*
 * Create new integer variable (either word or byte, scalar or array)
 *
 * name is the variable name
 * type specifies if it is a word (TYPE_WORD) variable, a byte variable
 * (TYPE_BYTE), or a constant (TYPE_CONST).
 * isarray is 0 for scalar variable, 1 for array variable
 * sz is the size (for an array only)
 * value is the initializer (for a scalar only)  TODO: Can save a word of arguments here!!!!!
 * bodyptr is used when allocating arrays.  If bodyptr is null then the
 * function will allocate space for the array data block, following the
 * array header.  If, on the other hand, a non-null pointer is passed then
 * only the array header will be allocated and the pointer will be stored
 * as the pointer to the array data block.  This allows array pass-by-reference
 * semantics.
 * 
 * Return 0 on success, 1 if error.
 *
 * New variable is appended to table, which adds it to the innermost scope.
 */
unsigned char createintvar(char *name,
                           enum types type,
                           unsigned char isarray,
                           int sz, int value, int bodyptr)
{
    int i;
    int val;
    var_t *v;
    unsigned char arrinitmode;  /* STRG_INIT means string initializer, LIST_INIT means list initializer */
    unsigned char local = 1;
    unsigned char isconst = 0;

    v = findintvar(name, &local);       /* local = 1, so only search local scope */

    if (v) {
        error(ERR_REDEF);
        return 1;
    }

    if (sz < 1) {
        error(ERR_DIM);
        return 1;
    }

    if (type == TYPE_CONST) {
        isconst = 1;
        type = TYPE_WORD;
    }

    if (!isarray) {
        /*
         * Scalar variables
         */
        if (compile) {
            /*
             * When compiling we store the address of the variable in
             * the target VM where the value normally goes.
             *
             * For local variables this is RELATIVE to the frame pointer but
             * for globals it is an ABSOLUTE address.
             */
            v = alloc1(sizeof(var_t) + sizeof(int));
            if (isconst) {
                /* Store value of const.  No code generation. */
                *getptrtoscalarword(v) = value;
            } else if (type == TYPE_WORD) {
                /* Relative if compiling sub, absolute otherwise */
                *getptrtoscalarword(v) = (compilingsub ? (rt_push_callstack(2) - rtFP) : (rt_push_callstack(2) + 1));
                emit(VM_PSHWORD);
            } else {
                /* Relative if compiling sub, absolute otherwise */
                *getptrtoscalarword(v) = (compilingsub ? (rt_push_callstack(1) - rtFP) : (rt_push_callstack(1) + 1));
                emit(VM_PSHBYTE);
            }
        } else {
            if (type == TYPE_WORD) {
                v = alloc1(sizeof(var_t) + sizeof(int));
                *getptrtoscalarword(v) = value;
            } else {
                v = alloc1(sizeof(var_t) + sizeof(unsigned char));
                *getptrtoscalarbyte(v) = value;
            }
        }
    } else {
        /*
         * Array variables.
         *
         * Here we allocate two words of space as follows:
         *  WORD1: Pointer to payload
         *  WORD2: to record the single dimensions of the 1D array.
         * The payload follows these two words.  This scheme is
         * designed to be extensible to more dimensions.
         */
        if (bodyptr) {

            /*
             * Should work for both interpreter and compiler
             * (although only used in interpreter right now)
             */
            v = alloc1(sizeof(var_t) + 2 * sizeof(int));

        } else {
            /*
             * For arrays we parse the initializer here.
             */
            if (isarray) {
                if (*txtPtr == '"') {
                    arrinitmode = STRG_INIT;
                    ++txtPtr;
#ifdef CBM
                } else if (*txtPtr == '[') {
#else
                } else if (*txtPtr == '{') {
#endif
                    arrinitmode = LIST_INIT;
                    ++txtPtr;
                }
            }

            if (compile) {

                v = alloc1(sizeof(var_t) + 2 * sizeof(int));
                if (type == TYPE_WORD) {
                    /* Relative if compiling sub, absolute otherwise */
                    bodyptr = (compilingsub ? (rt_push_callstack(sz * 2) - rtFP) : (rt_push_callstack(sz * 2) + 1));
                } else {
                    /* Relative if compiling sub, absolute otherwise */
                    bodyptr = (compilingsub ? (rt_push_callstack(sz) - rtFP) : (rt_push_callstack(sz) + 1));
                }

                /*
                 * The following generates code to allocate the array
                 * TODO: This is not very efficient. Need a VM instruction to allocate a block.
                 */
                emitldi(sz);
                emit(VM_DEC);
                emit(VM_DUP);
                emitldi(0);     /* Value to fill with */
                emit((type == TYPE_WORD) ? VM_PSHWORD : VM_PSHBYTE);
                emitldi(0);
                emit(VM_NEQL);
                emit_imm(VM_BRNCHIMM, rtPC - 10);
                emit(VM_DROP);

                /*
                 * Initialize array
                 * arrinitmode STRG_INIT is for string initializer "like this"
                 * arrinitmode LIST_INIT is for list initializer {123, 456, 789 ...}
                 */
                if (arrinitmode == STRG_INIT) {
                    --sz;       /* Hack to leave space for final null */
                }
                for (i = 0; i < sz; ++i) {
                    if (arrinitmode == STRG_INIT) {
                        emitldi((*txtPtr == '"') ? 0 : *txtPtr);
                        ((type == TYPE_WORD) ? civ_st_rel_word(i) : civ_st_rel_byte(i));
                        if (*txtPtr == '"') {
                            break;
                        }
                        ++txtPtr;
                    } else {
#ifdef CBM
                        if (*txtPtr == ']')
#else
                        if (*txtPtr == '}')
#endif
                        {
                            break;
                        }
                        if (eval(0, &val)) {
                            return 1;
                        }
                        ((type == TYPE_WORD) ? civ_st_rel_word(i) : civ_st_rel_byte(i));
                        eatspace();
                        if (*txtPtr == ',') {
                            ++txtPtr;
                        }
                        eatspace();
                    }
                }
            } else {
                if (type == TYPE_WORD) {
                    v = alloc1(sizeof(var_t) + (sz + 2) * sizeof(int));
                } else {
                    v = alloc1(sizeof(var_t) + 2 * sizeof(int) + sz * sizeof(unsigned char));
                }
                bodyptr = (int) ((unsigned char *) v + sizeof(var_t) + 2 * sizeof(int));

                /*
                 * Initialize array
                 * arrinitmode STRG_INIT is for string initializer "like this"
                 * arrinitmode LIST_INIT is for list initializer {123, 456, 789 ...}
                 */
                if (arrinitmode == STRG_INIT) {
                    --sz;       /* Hack to leave space for final null */
                }
                for (i = 0; i < sz; ++i) {
                    if (arrinitmode == STRG_INIT) {
                        if (*txtPtr == '"') {
                            val = 0;
                        } else {
                            val = *txtPtr;
                            ++txtPtr;
                        }
                    } else {
#ifdef CBM
                        if (*txtPtr == ']')
#else
                        if (*txtPtr == '}')
#endif
                        {
                            val = 0;
                        } else {
                            if (eval(0, &val)) {
                                return 1;
                            }
                            eatspace();
                            if (*txtPtr == ',') {
                                ++txtPtr;
                            }
                            eatspace();
                        }
                    }
                    if (type == TYPE_WORD) {
                        *((int *) bodyptr + i) = val;
                    } else {
                        *((unsigned char *) bodyptr + i) = val;
                    }
                }
            }
            if (arrinitmode == STRG_INIT) {
                ++sz;           /* Reverse the hack we perpetuated above */
                if (*txtPtr == '"') {
                    ++txtPtr;
                } else {
                    error(ERR_TOOLONG);
                    return 1;
                }
            } else {
#ifdef CBM
                if (*txtPtr == ']')
#else
                if (*txtPtr == '}')
#endif
                {
                    ++txtPtr;
                } else {
                    error(ERR_TOOLONG);
                    return 1;
                }
            }
        }

        /* Store pointer to payload */
        *(int *) ((unsigned char *) v + sizeof(var_t)) = (int) bodyptr;

        /* Store size */
        *(int *) ((unsigned char *) v + sizeof(var_t) + sizeof(int)) = sz;
    }

    strncpy(v->name, name, VARNUMCHARS);
    v->type = (isconst << 5) | (isarray << 4) | type;
    v->next = NULL;

    if (varsend) {
        varsend->next = v;
    }
    varsend = v;
    if (!varsbegin) {
        varsbegin = v;
        varslocal = v;
    }
    return 0;
}

/*
 * Mark variable table when we enter a subroutine.
 * We use a fake variable entry for this, with illegal name '----'
 * Records pointer to the fake entry in varslocal.
 */
void vars_markcallframe()
{
    ++calllevel;
    varslocal = alloc1(sizeof(var_t) + sizeof(int));
    strncpy(varslocal->name, "----", VARNUMCHARS);
    varslocal->type = TYPE_WORD;
    varslocal->next = NULL;
    *(getptrtoscalarword(varslocal)) = (int) varsend;   /* Store pointer to previous in value */
    if (varsend) {
        varsend->next = varslocal;
    }
    varsend = varslocal;
    if (!varsbegin) {
        varsbegin = varslocal;
    }
}

/*
 * Release local variables on return from a subroutine.
 */
void vars_deletecallframe()
{
    var_t *newend = (void *) *(getptrtoscalarword(varslocal));  /* Recover pointer */
    var_t *v = varslocal;

    /* Free the local variables */
    if (!newend) {
        CLEARHEAP1();
    } else {
        free1((int) newend - (int) varsend);
    }

    if (newend) {
        newend->next = NULL;
    } else {
        varsbegin = NULL;
    }
    varsend = newend;
    --calllevel;

    /* Set varslocal to previous stack frame or NULL if none */
    varslocal = NULL;
    v = varsbegin;
    while (v) {
        if (v->name[0] == '-') {
            varslocal = v;
        }
        v = v->next;
    }
}

/* Factored out to save a few bytes
 * Used by setintvar() only.
 */
void siv_st_abs(unsigned char type)
{
    ((type == TYPE_WORD) ? emit(VM_STAWORD) : emit(VM_STABYTE));
}

/* Factored out to save a few bytes
 * Used by setintvar() only.
 */
void siv_st_rel(unsigned char type)
{
    ((type == TYPE_WORD) ? emit(VM_STRWORD) : emit(VM_STRBYTE));
}

/* Factored out to save a few bytes
 * Used by setintvar() only.
 */
void siv_st_abs_imm(unsigned int addr, unsigned char type)
{
    emit_imm(((type & 0x0f) == TYPE_WORD) ? VM_STAWORDIMM : VM_STABYTEIMM, addr);
}

/* Factored out to save a few bytes
 * Used by setintvar() only.
 */
void siv_st_rel_imm(unsigned int addr, unsigned char type)
{
    emit_imm(((type & 0x0f) == TYPE_WORD) ? VM_STRWORDIMM : VM_STRBYTEIMM, addr);
}

/*
 * Set existing integer variable
 * name is the variable name
 * idx is the index into an array. -1 means subscript not given.
 * value is the value to set
 * Return 0 if successful, 1 on error
 *
 * Sets matching local variable.  If no local exists then return the
 * matching global.  Otherwise error.
 */
unsigned char setintvar(char *name, int idx, int value)
{
    unsigned char isarray;
    unsigned char type;
    void *bodyptr;
    unsigned char local = 0;

    var_t *ptr = findintvar(name, &local);

    if (!ptr) {
        error(ERR_VAR);
        return 1;
    }
    isarray = (ptr->type & 0x10) >> 4;
    type = ptr->type & 0x0f;

    /* Error if try to set const */
    if (ptr->type & 0x20) {
        error(ERR_STCONST);
        return 1;
    }

    if (!isarray) {
        /*
         * Scalars
         */
        if (idx != -1) {
            /* Means [..] subscript was provided */
            error(ERR_SUBSCR);
            return 1;
        }
        if (compile) {
            /*
             * When we are at the top level scope (global scope), all
             * variables are globals and we use ABSOLUTE addressing.
             * When we are at function scope, globals still use
             * ABSOLUTE addressing, but locals are addressed RELATIVE
             * to the frame pointer.
             */
            if (local && compilingsub) {
                siv_st_rel_imm(*getptrtoscalarword(ptr), type);
            } else {
                siv_st_abs_imm(*getptrtoscalarword(ptr), type);
            }
        } else {
            if (type == TYPE_WORD) {
                *getptrtoscalarword(ptr) = value;
            } else {
                *getptrtoscalarbyte(ptr) = value;
            }
        }
    } else {
        /*
         * Arrays
         */
        if (idx == -1) {
            /* Means [..] subscript was never provided */
            error(ERR_SUBSCR);
            return 1;
        }
        bodyptr = (void *) *(int *) ((unsigned char *) ptr + sizeof(var_t));

        if (compile) {
            /* *** Index is on the stack (X) */
            emit(VM_SWAP);
            if (type == TYPE_WORD) {
                emitldi(1);
                emit(VM_LSH);
            }
            emitldi((int) ((int *) bodyptr));
            /*
             * If the array size field is -1, this means the bodyptr is a
             * pointer to a pointer to the body (rather than pointer to
             * the body), so it needs to be dereferenced one more time.
             */
            if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) {
                emit(VM_LDRWORD);
            }
            emit(VM_ADD);
            if (local && compilingsub) {
                if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) {
                    siv_st_abs(type);
                } else {
                    siv_st_rel(type);
                }
            } else {
                siv_st_abs(type);
            }
        } else {
            if ((idx < 0) || (idx >= *(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)))) {
                error(ERR_SUBSCR);
                return 1;
            }
            if (type == TYPE_WORD) {
                *((int *) bodyptr + idx) = value;
            } else {
                *((unsigned char *) bodyptr + idx) = value;
            }
        }
    }

    return 0;
}

/* Factored out to save a few bytes
 * Used by getintvar() only.
 */
void giv_ld_abs(unsigned char type)
{
    (((type & 0x0f) == TYPE_WORD) ? emit(VM_LDAWORD) : emit(VM_LDABYTE));
}

/* Factored out to save a few bytes
 * Used by getintvar() only.
 */
void giv_ld_rel(unsigned char type)
{
    (((type & 0x0f) == TYPE_WORD) ? emit(VM_LDRWORD) : emit(VM_LDRBYTE));
}

/* Factored out to save a few bytes
 * Used by getintvar() only.
 */
void giv_ld_abs_imm(unsigned int addr, unsigned char type)
{
    emit_imm(((type & 0x0f) == TYPE_WORD) ? VM_LDAWORDIMM : VM_LDABYTEIMM, addr);
}

/* Factored out to save a few bytes
 * Used by getintvar() only.
 */
void giv_ld_rel_imm(unsigned int addr, unsigned char type)
{
    emit_imm(((type & 0x0f) == TYPE_WORD) ? VM_LDRWORDIMM : VM_LDRBYTEIMM, addr);
}

/*
 * Get existing integer variable
 * name is the variable name
 * idx is the index into an array. -1 means subscript not given.
 * Returns the value (or the address) in val.
 * Return the type TYPE_BYTE or TYPE_WORD in type.
 * address if set to 1 then address is returned, not value
 * Return 0 if successful, 1 on error
 *
 * Returns matching local variable.  If no local exists then return the
 * matching global.  Otherwise error.
 */
unsigned char getintvar(char *name,
                        int idx,
                        int *val,
                        unsigned char *type, unsigned char address)
{
    unsigned char isarray;
    void *bodyptr;
    unsigned char local = 0;

    var_t *ptr = findintvar(name, &local);

    if (!ptr) {
        error(ERR_VAR);
        return 1;
    }
    isarray = (ptr->type & 0x10) >> 4;
    *type = ptr->type;

    if (compiletimelookup) {
        /*
         * Special hack to allow lookup (rather than code
         * generation) during compilation.
         */
        *val = *getptrtoscalarword(ptr);
        compiletimelookup = 0;
        return 0;
    }

    if (!isarray) {
        /*
         * Scalars
         */
        if (idx != -1) {
            /* Means [..] subscript was provided */
            error(ERR_SUBSCR);
            return 1;
        }
        if (compile) {
            /*
             * When we are at the top level scope (global scope), all
             * variables are globals and we use ABSOLUTE addressing.
             * When we are at function scope, globals still use
             * ABSOLUTE addressing, but locals are addressed RELATIVE
             * to the frame pointer.
             */
            if (address) {
                emitldi(*getptrtoscalarword(ptr));
                if (local && compilingsub) {
                    emit(VM_RTOA);
                }
            } else {
                if (local && compilingsub) {
                    giv_ld_rel_imm(*getptrtoscalarword(ptr), *type);
                } else {
                    giv_ld_abs_imm(*getptrtoscalarword(ptr), *type);
                }
            }
        } else {
            if ((*type & 0x0f) == TYPE_WORD) {
                if (address) {
                    *val = (int) getptrtoscalarword(ptr);
                } else {
                    *val = *getptrtoscalarword(ptr);
                }
            } else {
                if (address) {
                    *val = (int) getptrtoscalarbyte(ptr);
                } else {
                    *val = *getptrtoscalarbyte(ptr);
                }
            }
        }
    } else {
        /*
         * Arrays
         * Note the special cases, for an array A:
         * 1) &A is the same as &A[0]
         * 2) A is the same as &A[0]
         * This second case is needed to make the eval() work propertly
         * for array pass-by-reference.
         */
        if (idx == -1) {
            /* Means [..] subscript was never provided */
            address = 1;
            idx = 0;
            if (compile) {
                emitldi(0);
            }
        }
        bodyptr =
            (void *) *(int *) ((unsigned char *) ptr + sizeof(var_t));

        if (compile) {
            /* *** Index is on the stack (X) *** */
            if ((*type & 0x0f) == TYPE_WORD) {
                emitldi(1);
                emit(VM_LSH);
            }
            emitldi((int) ((int *) bodyptr));
            /*
             * If the array size field is -1, this means the bodyptr is a
             * pointer to a pointer to the body (rather than pointer to
             * the body), so it needs to be dereferenced one more time.
             */
            if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) {
                emit(VM_LDRWORD);
            }
            emit(VM_ADD);
            if (!address) {
                if (local && compilingsub) {
                    if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) {
                        giv_ld_abs(*type);
                    } else {
                        giv_ld_rel(*type);
                    }
                } else {
                    giv_ld_abs(*type);
                }
            } else {
                if (local && compilingsub) {
                    if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) != -1) {
                        /* Convert to absolute address */
                        emit(VM_RTOA);
                    }
                }
            }
        } else {
            if ((idx < 0) || (idx >= *(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)))) {
                error(ERR_SUBSCR);
                return 1;
            }

            if ((*type & 0x0f) == TYPE_WORD) {
                if (address) {
                    *val = (int) ((int *) bodyptr + idx);
                } else {
                    *val = *((int *) bodyptr + idx);
                }
            } else {
                if (address) {
                    *val = (int) ((unsigned char *) bodyptr + idx);
                } else {
                    *val = *((unsigned char *) bodyptr + idx);
                }
            }
        }
    }

    return 0;
}


/*
 * Handy defines for return codes
 */
#define RET_SUCCESS      0      /* Successful */
#define RET_ERROR        1      /* Error */

/*************************************************************************/
/* IF / THEN / ELSE                                                      */
/*************************************************************************/

/*
 * Handles if statement.
 */
void doif(unsigned char arg)
{

    /*
     * Place the following on the return stack when interpreting:
     *   - Magic value IFFRAME to indicate IF loop stack frame
     *   - Status value as follows:
     *     0: skipFlag was already set so not evaluating my argument
     *     1: skipFlag was clear and I set it (condition false)
     *     2: skipFlag was clear and I left it clear (condition true)
     *   - Dummy value 0
     *
     * When compiling:
     *   - Magic value IFFRAME
     *   - Address of the branch destination operand for when condition
     *     is false.  This will be filled in later and may point to the
     *     ELSE block (if present) or end of the IF block otherwise.
     *   - Space to store the branch destination operand which will be
     *     used to skip over the ELSE block if the IF block runs.  This
     *     will also be filled in later.
     */
    push_return(IFFRAME);

    if (compile) {
        /* **** Value of IF expression is on the eval stack **** */
        emit(VM_NOT);
        push_return(rtPC + 1);
        emit_imm(VM_BRNCHIMM, 0xffff);        /* To be filled in later */
        push_return(0);
    } else {
        if (skipFlag) {
            push_return(0);
        } else {
            if (!arg) {
                skipFlag = 1;
                push_return(1);
            } else {
                push_return(2);
            }
        }
        push_return(0);         /* Dummy */
    }
}

/*
 * Handles else statement.
 * Returns RET_SUCCESS if no error, RET_ERROR if error
 */
unsigned char doelse()
{
    if (return_stack[returnSP + 3] != IFFRAME) {
        error(ERR_NOIF);
        return RET_ERROR;
    }

    if (compile) {
        /*
         * Code to jump over ELSE block when IF condition is true
         */
        return_stack[returnSP + 1] = rtPC + 1;
        emit_imm(VM_JMPIMM, 0xffff); /* To be filled in later */

        /*
         * Fixup the dummy destination address initialized by
         * doif() to point to ELSE
         */
        emit_fixup(return_stack[returnSP + 2], rtPC);
        return_stack[returnSP + 2] = 0;
    } else {
        /*
         * If the matching IF statement had condition true then the
         * value at return_stack[returnSP + 1] will be 2.  If the
         * matching IF statement had condition false then the value
         * will be 1.
         */
        if (return_stack[returnSP + 2] == 2) {
            skipFlag = 1;
        } else if (return_stack[returnSP + 2] == 1) {
            skipFlag = 0;
        }
    }
    return RET_SUCCESS;
}

/*
 * Handles endif statement.
 * Returns RET_SUCCESS if no error, RET_ERROR if error
 */
unsigned char doendif()
{
    if (return_stack[returnSP + 3] != IFFRAME) {
        error(ERR_NOIF);
        return RET_ERROR;
    }

    if (compile) {
        /*
         * Fixup the dummy destination address initialized by
         * doif() to point to ENDIF. (Only do this if it hasn't
         * already been updated to point to the ELSE.)
         */
        if (return_stack[returnSP + 2]) {
            emit_fixup(return_stack[returnSP + 2], rtPC);
        }
        /*
         * Fixup the dummy destination address initialized by
         * doelse() to point to ENDIF. (Only do this if there was
         * actually an ELSE.)
         */
        if (return_stack[returnSP + 1]) {
            emit_fixup(return_stack[returnSP + 1], rtPC);
        }
    } else {
        /*
         * If skipFlag was false when we hit the matching IF
         * statement, then the value at return_stack[returnSP + 2]
         * will be 1 or 2. In this case, clear skipFlag.
         */
        if (return_stack[returnSP + 2]) {
            skipFlag = 0;
        }
    }

    pop_return();
    pop_return();
    pop_return();
    return RET_SUCCESS;
}

/*************************************************************************/
/* FOR LOOPS                                                             */
/*************************************************************************/

/*
 * Routine handles five cases, each of which looks like variable assignment.
 * Doing these all together here makes code easier to maintain and smaller.
 */
#define WORD_MODE  0
#define BYTE_MODE  1
#define CONST_MODE 2
#define LET_MODE   3
#define FOR_MODE   4

/*
 * Handles four cases, according to value of mode:
 *  - WORD_MODE  - declaration of word variable 
 *  - BYTE_MODE  - declaration of byte variable 
 *  - CONST_MODE - declaration of constant
 *  - LET_MODE   - assignment to existing variable
 *  - FOR_MODE   - entry to for loop
 *
 * Handles parsing the following text (mode == WORD_MODE/BYTE_MODE) either:
 *     "var = expr"
 * or, "var[expr1] = expr2"
 * or (mode == CONST_MODE), just:
 *     "var = expr"
 * or (mode == FOR_MODE):
 *     "var = expr2 : expr3"
 * or, "var[expr1] = expr2 : expr3"
 *
 * Returns RET_SUCCESS if no error, RET_ERROR if error
 */
unsigned char assignorcreate(unsigned char mode)
{
    int j;
    int k;
    unsigned char type;
    char name[VARNUMCHARS];
    int i = 0;
    unsigned char isarray = 0;
    unsigned char local = 0;
    unsigned char oldcompile = compile;

    if (!txtPtr || !isalphach(*txtPtr)) {
        error(ERR_VAR);
        return RET_ERROR;
    }
    while (*txtPtr && (isalphach(*txtPtr) || isdigitch(*txtPtr))) {
        if (i < VARNUMCHARS) {
            name[i++] = *txtPtr;
        }
        ++txtPtr;
    }
    if (i < VARNUMCHARS) {
        name[i] = '\0';
    }

    i = 0;
    if (*txtPtr == '[') {
        isarray = 1;
        switch (mode) {
        case WORD_MODE:
        case BYTE_MODE:
            onlyconstants = 1;  /* Only parse constants - no variables  */
            compile = 0;        /* Use subscript() to eval, not codegen */
            if (subscript(&i) == 1) {
                onlyconstants = 0;
                compile = oldcompile;
                return RET_ERROR;
            }
            onlyconstants = 0;  /* Back to normal service */
            compile = oldcompile;
            break;
        default:
            if (subscript(&i) == 1) {
                return RET_ERROR;
            }
        }
    }

    eatspace();

    if (expect('=')) {
        return RET_ERROR;
    }

    eatspace();

    if (mode == CONST_MODE) {
        compile = 0;            /* Eval, not codegen */
    }

    /*
     * If it is LET or FOR, evaluate the single argument.
     * If it is declaration, only evaluate single argument for scalars.
     * For arrays, the initializer is evaluated inside createintvar().
     */
    if (!isarray || (mode == LET_MODE) || (mode == FOR_MODE)) {
        if (eval((mode != FOR_MODE), &j)) {
            compile = 1;
            return RET_ERROR;
        }
    }
    compile = oldcompile;

    switch (mode) {

    case WORD_MODE:
    case BYTE_MODE:
    case CONST_MODE:
        if (i == 0) {
            ++i;
        }
        if (createintvar(name,
                         ((mode == CONST_MODE) ? TYPE_CONST : ((mode == WORD_MODE) ? TYPE_WORD : TYPE_BYTE)),
                         isarray, i, j, 0)) {
            return RET_ERROR;
        }
        break;

    case LET_MODE:
    case FOR_MODE:
        if (!isarray) {
            i = -1;
        }
        if (setintvar(name, i, j)) {
            return RET_ERROR;
        }
        break;
    }

    if (mode != FOR_MODE) {
        return RET_SUCCESS;
    }

    /*
     * The remaining code is to handle entry to FOR
     * mode == FOR_MODE
     */

    if (expect(':')) {
        return RET_ERROR;
    }

    if (eval(1, &k)) {
        return RET_ERROR;
    }

    /*
     * Place the following on the return stack when interpreting:
     * - Magic value FORFRAME_B or FORFRAME_W - to indicate FOR loop stack
     *   frame for byte or word variable respectively.
     * - Line counter for the for statement (here) (int)
     * - txtPtr (int*)
     * - Loop limit (int)
     * - Pointer to loop control variable (int*)
     *
     * When compiling:
     *
     * - Magic value FORFRAME_B or FORFRAME_W.
     * - 0 if absolute addressing, 1 if relative addressing
     * - Runtime PC
     * - Pointer to loop control variable.
     * - Dummy word
     */

    /* Get the address of the variable */
    if (compile) {
        compiletimelookup = 1;
    }
    if (getintvar(name, i, &j, &type, 1)) {
        return RET_ERROR;
    }

    push_return(((type & 0x0f) == TYPE_WORD) ? FORFRAME_W : FORFRAME_B);

    if (compile) {
        /* Find out if it is a local or a global */
        findintvar(name, &local);
        push_return(local && compilingsub);     /* 0: absolute, 1: relative addr */

        /* Loop limit k should be on the runtime eval stack, move it to call stack */
        emit(VM_PSHWORD);

        push_return(rtPC);      /* Store PC so we know where to come back to */
        push_return(j);
        push_return(0);         /* Dummy */
    } else {
        push_return(counter);
        push_return((int) txtPtr);
        push_return(k);
        push_return(j);
    }

    return RET_SUCCESS;
}

/*
 * Go back to the start of a loop or return after end of subroutine.
 * (Used for FOR and WHILE loops and for subroutine CALL/RETURN).
 * - linenum is the line number of the start of the loop or the call
 *   statement, or -1 in immediate mode.
 * - oldTxtPtr is the stashed text pointer, which is expected to point
 *   to the code immediately after the opening loop statement.
 * This is used by the interpreter only.
 */
void backtotop(int linenum, char *oldTxtPtr)
{

    if (linenum == -1) {
        /* Return to immediate mode */
        counter = -1;
        current = NULL;
    } else {
        /*
         * If not immediate mode, then reload the line containing
         * the opening statement of the loop, or the call statement
         */
        findline(linenum + 1);
        --counter;              /* Findline uses 1-based linenums */
        if (!current) {
            /* Should never get here! */
            EXIT(99);
        }
    }

#ifdef EXTMEM
    copyfromaux(current->line, current->len);
#endif

    /* This should also work with extended memory */
    txtPtr = oldTxtPtr;
}

/*
 * Handle iterating or exiting the FOR loop.
 * Expects to find pointer to loop variable, loop limit
 * and line counter on the return stack.
 * Returns RET_SUCCESS on success, RET_ERROR on error
 */
unsigned char doendfor()
{
    int val;
    unsigned char type = 0xff;

    if (return_stack[returnSP + 5] == FORFRAME_W) {
        type = TYPE_WORD;
        if (!compile) {
            val = *(int *) (return_stack[returnSP + 1]);
        }
    } else if (return_stack[returnSP + 5] == FORFRAME_B) {
        type = TYPE_BYTE;
        if (!compile) {
            val = *(unsigned char *) (return_stack[returnSP + 1]);
        }
    }
    if (type == 0xff) {
        error(ERR_NOFOR);
        return RET_ERROR;
    }

    if (compile) {
        /* **** Loop limit is on the call stack **** */
        emit(VM_POPWORD);
        emit(VM_DUP);
        emit(VM_PSHWORD);

        //emitldi(return_stack[returnSP + 2]); /* Pointer to loop variable */
        if (return_stack[returnSP + 4]) {    /* Rel or abs */
            /* Pointer to loop var */
            emit_imm((type == TYPE_WORD) ? VM_LDRWORDIMM : VM_LDRBYTEIMM, return_stack[returnSP + 2]);
        } else {
            /* Pointer to loop var */
            emit_imm((type == TYPE_WORD) ? VM_LDAWORDIMM : VM_LDABYTEIMM, return_stack[returnSP + 2]);
        }

        /* Increment and store loop variable */
        emit(VM_INC);
        emit(VM_DUP);
        if (return_stack[returnSP + 4]) {
            emit_imm((type == TYPE_WORD) ? VM_STRWORDIMM : VM_STRBYTEIMM, return_stack[returnSP + 2]);
        } else {
            emit_imm((type == TYPE_WORD) ? VM_STAWORDIMM : VM_STABYTEIMM, return_stack[returnSP + 2]);
        }

        /* Compare with loop limit already on eval stack */
        emit(VM_GTE);
        emit_imm(VM_BRNCHIMM, return_stack[returnSP + 3]); /* Branch destination */

        /* Drop loop limit from call stack */
        emit(VM_POPWORD);
        emit(VM_DROP);
        goto unwind;
    }

    /*
     * Compare loop control variable and limit
     */
    if (val < return_stack[returnSP + 2]) {

        /*
         * If loop not done, increment loop control var, jump back
         * to line after FOR
         */
        if (type == TYPE_WORD) {
            ++(*(int *) (return_stack[returnSP + 1]));
        } else {
            ++(*(unsigned char *) (return_stack[returnSP + 1]));
        }

        backtotop(return_stack[returnSP + 4], (char *) return_stack[returnSP + 3]);

        return RET_SUCCESS;
    }

  unwind:
    /* Done looping, unwind stack */
    pop_return();
    pop_return();
    pop_return();
    pop_return();
    pop_return();
    return RET_SUCCESS;
}

/*************************************************************************/
/* WHILE LOOPS                                                           */
/*************************************************************************/

/*
 * Handles entry into a while loop.
 * startTxtPtr should point to the text of the WHILE statement itself.
 * arg is the evaluated value of the argument to the WHILE.
 */
void dowhile(char *startTxtPtr, unsigned char arg)
{

    /*
     * Place the following on the return stack when interpreting:
     *   - Magic value WHILEFRAME to indicate WHILE loop stack frame
     *   - Status value as follows:
     *     0: skipFlag was already set so not evaluating my argument
     *     1: skipFlag was clear and I set it (condition false)
     *     2: skipFlag was clear and I left it clear (condition true)
     *   - Line number for the WHILE line (here)
     *   - txtPtr (int*)
     *
     * When compiling:
     *   - Magic value WHILEFRAME
     *   - Runtime PC prior to evaluating WHILE expression
     *   - Runtime PC for patching up the branch
     *   - Dummy value
     *
     */
    push_return(WHILEFRAME);

    if (compile) {
        push_return(rtPCBeforeEval);
        /* **** Value of WHILE expression is on the eval stack **** */
        emit(VM_NOT);
        push_return(rtPC + 1);  /* Address of dummy 0xffff */
        emit_imm(VM_BRNCHIMM, 0xffff);
        push_return(0);         /* Dummy */
    } else {
        if (skipFlag) {
            push_return(0);
        } else {
            if (!arg) {
                skipFlag = 1;
                push_return(1);
            } else {
                push_return(2);
            }
        }
        push_return(counter);
        push_return((int) startTxtPtr);
    }
}

/*
 * Handles endwhile statement.
 * Returns RET_SUCCESS on success, RET_ERROR on error
 */
unsigned char doendwhile()
{

    if (return_stack[returnSP + 4] != WHILEFRAME) {
        error(ERR_NOWHILE);
        return RET_ERROR;
    }

    if (compile) {
        /*
         * Jump back and re-evaluate the WHILE argument.
         */
        emit_imm(VM_JMPIMM, return_stack[returnSP + 3]);

        /*
         * Fixup the dummy destination address initialized by
         * dowhile() to point to the ENDWHILE.
         */
        emit_fixup(return_stack[returnSP + 2], rtPC);
    } else {
        switch (return_stack[returnSP + 3]) {

        case 0:

            /*
             * If skipFlag was true when we hit the
             * matching WHILE statement, the the value
             * at return_stack[returnSP+3] will be 0.
             */

            goto doret;

        case 1:

            /*
             * If skipFlag was false when we hit the
             * matching WHILE statement, then the value
             * at return_stack[returnSP + 3] will be 1
             * (condition false) or 2 (condition true).
             * If the WHILE was false, then just set
             * clear skipFlag, pop the stack and keep
             * going.  If the WHILE was true, pop the
             * stack and jump back to the WHILE test
             * again.
             */

            skipFlag = 0;
            goto doret;

        case 2:

            /*
             * skipFlag was true when we hit the
             * matching WHILE. Having executed the
             * loop body, now we loop back
             * to the WHILE statement.
             */
            backtotop(return_stack[returnSP + 2],
                      (char *) return_stack[returnSP + 1]);

            goto doret;

        default:
            /* Should never get here! */
            exit(99);
        }
    }

  doret:
    pop_return();
    pop_return();
    pop_return();
    pop_return();

    return RET_SUCCESS;
}

/*
 * Compare two strings up to terminator character.
 * This function takes two char pointers and compares them character
 * by character, up until a terminator character c (or space), which MUST
 * appear in s1.  Returns 0 if equal, 1 if unequal.
 */
unsigned char compareUntil(char *s1, char *s2, char term)
{
    while (*s1 == *s2) {
        if (*s1 == 0) {
            return 1;
        }
        ++s1;
        ++s2;
    }
    /* s2 is allowed to have extra trailing junk */
    if ((*s1 == term) || (*s1 == ' ')) {
        return 0;
    }
    return 1;
}

/*
 * Handle subroutine declaration.
 * This is really only used by the compiler.
 */
unsigned char dosubr()
{
    unsigned char type;
    char name[VARNUMCHARS];
    unsigned char j;
    unsigned char arraymode;
    var_t *v;
    sub_t *s;

    if (compile) {

        compilingsub = 1;

        print("\n[");
        print(readbuf);
        print("]");

        /*
         * Create entry in subroutine table
         * Allocate this on the top-down stack in arena 2.  This grows down towards the
         * source code, which is growing up from the bottom of arena 2.
         */
        s = alloc2top(sizeof(sub_t));
        strncpy(s->name, readbuf, SUBRNUMCHARS);
        s->addr = rtPC;
        s->next = NULL;

        if (subsend) {
            subsend->next = s;
        }
        subsend = s;
        if (!subsbegin) {
            subsbegin = s;
        }

        vars_markcallframe();

        /* Update frame pointer */
        emit(VM_SPTOFP);
        rtFP = rtSP;

        if (expect('(')) {
            return RET_ERROR;
        }

        for (;;) {
            eatspace();
            if (*txtPtr == ')') {
                break;
            }
            if (!strncmp(txtPtr, "word ", 5)) {
                type = TYPE_WORD;
            } else if (!strncmp(txtPtr, "byte ", 5)) {
                type = TYPE_BYTE;
            } else {
                error(ERR_ARG);
                return RET_ERROR;
            }
            txtPtr += 5;
            eatspace();
            for (j = 0; j < VARNUMCHARS; ++j) {
                name[j] = 0;
            }
            j = 0;
            while (txtPtr && (isalphach(*txtPtr) || isdigitch(*txtPtr))) {
                if (j < VARNUMCHARS) {
                    name[j] = *txtPtr;
                }
                ++j;
                ++txtPtr;
            }
            /*
             * If argument is followed by '[]'
             * then switch to pass array by ref
             * mode.
             */
            arraymode = 0;
            if (*txtPtr == '[') {
                ++txtPtr;
                if (*txtPtr == ']') {
                    ++txtPtr;
                    arraymode = 1;
                } else {
                    error(ERR_ARG);
                    return RET_ERROR;
                }
            }

            /*
             * Set up the variables for the formal parameters,
             * pointing back to the storage already allocated on
             * the eval stack by the caller.  Each time we add
             * a parameter, adjust the relative addresses of all
             * the previously handled parameters.
             */
            v = varslocal;
            while (v) {
                if (v->name[0] != '-') {
                    if (arraymode || (type == TYPE_WORD)) {
                        *(int *) ((unsigned char *) v + sizeof(var_t)) +=
                            2;
                    } else {
                        *(int *) ((unsigned char *) v + sizeof(var_t)) +=
                            1;
                    }
                }
                v = v->next;
            }

            if (arraymode) {
                v = alloc1(sizeof(var_t) + 2 * sizeof(int));
            } else {
                v = alloc1(sizeof(var_t) + sizeof(int));
            }

            *(int *) ((unsigned char *) v + sizeof(var_t)) = 4; // Skip over return address and frame pointer
            strncpy(v->name, name, VARNUMCHARS);
            v->type = (arraymode << 4) | type;
            v->next = NULL;

            if (arraymode) {
                /*
                 * Array pass-by-reference.
                 *
                 * In this case the pointer to the array body was pushed to the
                 * call stack by the caller, and the var_t record records the
                 * pointer to this pointer!
                 *
                 * Array size is not used in compiled code, so set it to -1 to
                 * indicate array-pass-by-reference.  Code in setintvar() and
                 * getintvar() uses this to work out that it has to do an extra
                 * dereference.
                 */
                *(int *) ((unsigned char *) v + sizeof(var_t) +
                          sizeof(int)) = -1;
            }

            if (varsend) {
                varsend->next = v;
            }
            varsend = v;
            if (!varsbegin) {
                varsbegin = v;
                varslocal = v;
            }

            eatspace();
            if (*txtPtr == ',') {
                ++txtPtr;       /* Eat the comma */
            }
        }
        if (expect(')')) {
            return RET_ERROR;
        }

    } else {
        /* Error if we just run into this line! */
        error(ERR_RUNSUB);
        return RET_ERROR;
    }
    return RET_SUCCESS;
}

/*
 * Handle endsub
 */
unsigned char doendsubr()
{
    if (compile) {
        rtSP = rtFP;
        compilingsub = 0;
        vars_deletecallframe();
        emitldi(0);
    }
    doreturn(0);
    return RET_SUCCESS;
}

/*
 * Perform call instruction
 * Expects sub name to call in readbuf
 * Return RET_SUCCESS if successful, RET_ERROR on error
 */
unsigned char docall()
{
    unsigned char type;
    char *p;
    int arg;
    char name[VARNUMCHARS];
    char name2[VARNUMCHARS];
    unsigned char j;
    unsigned char arraymode;
    var_t *oldvarslocal;
    var_t *newvarslocal;
    var_t *array;
    sub_t *s;
    unsigned char argbytes = 0;
    struct lineofcode *l = program;
    int origcounter = counter;
    unsigned char local = 0;

    /*
     * Do this before evaluating arguments, which overwrites readbuf
     */
    if (compile) {
        /*
         * Allocate this on the top-down stack in arena 2.  This grows down
         * towards the source code, which is growing up from the bottom of
         * arena 2.
         */
        s = alloc2top(sizeof(sub_t));
        strncpy(s->name, readbuf, SUBRNUMCHARS);
    }

    if (!compile) {
        counter = -1;
    }
    while (l) {
#ifdef EXTMEM
        copyfromaux2(l->line, l->len);
        p = embuf2;
#else
        p = l->line;
#endif
        if (!compile) {
            ++counter;
        }

        skipFlag = 0;

        while (p && (*p == ' ')) {
            ++p;
        }
        if (!strncmp(p, "sub ", 4)) {
            p += 4;
            while (p && (*p == ' ')) {
                ++p;
            }

            if (!compareUntil(p, readbuf, '(')) {

                /*
                 * Here we are parsing two lines at a time:
                 * The call (at *txtPtr as usual) and the
                 * sub being called (at *p).
                 */

                /* Eat the subroutine name at *p */
                while (p && (*p != '(')) {
                    ++p;
                }
                if (!p) {
                    error(ERR_EXPECT);
                    printchar('(');
                    return RET_ERROR;
                }
                ++p;            /* Eat the '(' */

                /*
                 * Set up txtPtr to start passing the argument
                 * list of the call
                 */
                eatspace();
                if (expect('(')) {
                    counter = origcounter;
                    return RET_ERROR;
                }

                if (!compile) {
                    /*
                     * Will need this later for looking up
                     * things in the 'old' frame
                     */
                    oldvarslocal = varslocal;

                    /*
                     * For CALL, stack frame is:
                     *  - CALLFRAME magic number
                     *  - line number of CALL
                     *  - Pointer to just after the call statement
                     *    (set further down in the code)
                     */
                    push_return(CALLFRAME);
                    push_return(origcounter);

                    vars_markcallframe();

                    newvarslocal = varslocal;
                }

                /*
                 * Iterate through the formal parameter
                 * list of the sub (at *p).
                 *
                 * For word and byte scalar parameters, we
                 * instantiate a local of the appropriate
                 * type, evaluate the corresponding expression
                 * in the call and store the result in this
                 * new local.
                 *
                 * For arrays we copy the header, leaving
                 * the pointer to the original global data
                 * intact.  Effectively, this gives arrays
                 * pass by reference semantics (similar to C).
                 * This trick works when passing literal
                 * arrays only.
                 */
                for (;;) {
                    while (p && (*p == ' ')) {
                        ++p;
                    }
                    if (!p) {
                        error(ERR_ARG);
                        return RET_ERROR;
                    }
                    if (*p == ')') {
                        break;
                    }
                    if (!strncmp(p, "word ", 5)) {
                        type = TYPE_WORD;
                    } else if (!strncmp(p, "byte ", 5)) {
                        type = TYPE_BYTE;
                    } else {
                        error(ERR_ARG);
                        return RET_ERROR;
                    }
                    p += 5;
                    while (p && (*p == ' ')) {
                        ++p;
                    }
                    if (!p) {
                        error(ERR_ARG);
                        return RET_ERROR;
                    }
                    for (j = 0; j < VARNUMCHARS; ++j) {
                        name[j] = 0;
                    }
                    j = 0;
                    while (p && (isalphach(*p) || isdigitch(*p))) {
                        if (j < VARNUMCHARS) {
                            name[j] = *p;
                        }
                        ++j;
                        ++p;
                    }
                    /*
                     * If argument is followed by '[]'
                     * then switch to pass array by ref
                     * mode.
                     */
                    arraymode = 0;
                    if (p && (*p == '[')) {
                        ++p;
                        if (p && (*p == ']')) {
                            ++p;
                            arraymode = 1;
                        } else {
                            error(ERR_ARG);
                            return RET_ERROR;
                        }
                    }

                    /*
                     * Now we go back to looking at the 
                     * call arguments
                     */

                    /* If end of line, error */
                    if (!(*txtPtr)) {
                        counter = origcounter;
                        error(ERR_ARG);
                        return RET_ERROR;
                    }
                    if (*txtPtr == ')') {
                        counter = origcounter;
                        error(ERR_ARG);
                        return RET_ERROR;
                    }
                    if (!arraymode) {
                        /*
                         * Pass scalar value
                         */
                        if (!compile) {
                            /* Back to old frame for lookup */
                            varslocal = oldvarslocal;
                        }
                        if (eval(0, &arg)) {
                            /* No expression found */
                            counter = origcounter;
                            error(ERR_ARG);
                            return RET_ERROR;
                        }
#ifdef EXTMEM
                        // Recover embuf2, which has been trashed by eval() above
                        copyfromaux2(l->line, l->len);
#endif
                        if (compile) {
                            if (type == TYPE_WORD) {
                                emit(VM_PSHWORD);
                                argbytes += 2;
                            } else {
                                emit(VM_PSHBYTE);
                                ++argbytes;
                            }
                        } else {
                            /* Back to new frame to create var */
                            varslocal = newvarslocal;
                            createintvar(name, type, 0, 1, arg, 0);
                        }
                    } else {
                        /*
                         * Array pass-by-reference
                         */
                        if (!compile) {
                            for (j = 0; j < VARNUMCHARS; ++j) {
                                name2[j] = 0;
                            }
                            j = 0;
                            while (txtPtr && (isalphach(*txtPtr) || isdigitch(*txtPtr))) {
                                if (j < VARNUMCHARS) {
                                    name2[j] = *txtPtr;
                                }
                                ++txtPtr;
                                ++j;
                            }
                            /* Back to old frame for lookup */
                            varslocal = oldvarslocal;
                            array = findintvar(name2, &local);
                            if (!array) {
                                counter = origcounter;
                                error(ERR_VAR);
                                return RET_ERROR;
                            }
                            /* j holds number of dimensions */
                            j = (array->type & 0xf0) >> 4;
                            if (((array->type & 0x0f) != type) || (j == 0)) {
                                counter = origcounter;
                                error(ERR_TYPE);
                                return RET_ERROR;
                            }
                            /* Back to new frame to create var */
                            varslocal = newvarslocal;
                            createintvar(name,
                                         type,
                                         j,
                                         *(getptrtoscalarword(array) + 1),
                                         0, *getptrtoscalarword(array));

                        } else {
                            if (eval(0, &arg)) {
                                /* No expression found */
                                counter = origcounter;
                                error(ERR_ARG);
                                return RET_ERROR;
                            }
                            emit(VM_PSHWORD);
                            argbytes += 2;
                        }
                    }
                    eatspace();
                    if (*txtPtr == ',') {
                        ++txtPtr;
                    }
                    eatspace();

                    while (p && (*p == ' ')) {
                        ++p;
                    }

                    if (!p) {
                        error(ERR_ARG);
                        return RET_ERROR;
                    }

                    if (*p == ',') {
                        ++p;    /* Eat the comma */
                    }
                }

                eatspace();
                if (expect(')')) {
                    counter = origcounter;
                    return RET_ERROR;
                }

                if (compile) {

                    emit_imm(VM_JSRIMM, 0xffff);

                    /*
                     * Create entry in call table
                     */
                    s->addr = rtPC - 2;
                    s->next = NULL;

                    if (callsend) {
                        callsend->next = s;
                    }
                    callsend = s;
                    if (!callsbegin) {
                        callsbegin = s;
                    }

                    /* Caller must drop the arguments
                     * pushed to call stack above */
                    if (argbytes) {
                        emitldi(argbytes);
                        emit(VM_DISCARD);
                    }
                } else {
                    /* Stash pointer to just after the call stmt */
                    push_return((int) txtPtr);

                    /*
                     * Set up parser to start executing first
                     * line of subroutine
                     */
                    current = l->next;
                    ++counter;
#ifdef EXTMEM
                    copyfromaux(current->line, current->len);
                    txtPtr = embuf;
#else
                    txtPtr = current->line;
#endif
                }
                return RET_SUCCESS;
            }
        }
        l = l->next;
    }
    counter = origcounter;
    error(ERR_NOSUB);
    return RET_ERROR;
}

/*
 * Handle return from subroutine.
 * Parameter retvalue is the value to be returned to the caller.
 * Returns RET_SUCCESS on success, RET_ERROR on error
 */
unsigned char doreturn(int retvalue)
{
    if (compile) {

        /*
         * Return value is already on evaluation stack
         */

        /* Update stack pointer to drop local variables */
        emit(VM_FPTOSP);

        /* And done! */
        emit(VM_RTS);

    } else {

        /*
         * Search the stack to find the first CALLFRAME.  This allows us
         * to unwind any inner stackframes (for example where we return
         * from within a FOR loop or IF statement.)
         */

        int p = returnSP + 1;

        while (p <= RETSTACKSZ - 1) {
            if (return_stack[p] == CALLFRAME) {
                /*
                 * Unwind the stack.
                 */
                returnSP = p;
                goto found;
            }
            ++p;
        }

        error(ERR_STACK);
        return RET_ERROR;

      found:
        /* Stash the return value */
        retregister = retvalue;

        vars_deletecallframe();

        backtotop(return_stack[p - 1], (char *) return_stack[p - 2]);
    }
    return RET_SUCCESS;
}

/*************************************************************************/

/*
 * Parse a decimal integer constant.
 * The text to parse is pointed to by txtPtr.
 * The result is placed in val.
 * If successful returns 0, otherwise 1.
 */
unsigned char parseint(int *val)
{
    *val = 0;
    if (!(*txtPtr)) {
        return 1;
    }
    if (!isdigitch(*txtPtr)) {
        return 1;
    }
    do {
        *val *= 10;
        *val += *txtPtr - '0';
        ++txtPtr;
    } while (isdigitch(*txtPtr));
    return 0;
}

/*
 * Return value of hex char
 */
unsigned char hexchar2val(char c)
{
    if (c >= 'a' && c <= 'f') {
        return c - 'a' + 10;
    }
    return c - '0';
}

/*
 * Parse a hexadecimal integer constant.
 * The text to parse is pointed to by txtPtr.
 * The result is placed in val.
 * If successful returns 0, otherwise 1.
 */
unsigned char parsehexint(int *val)
{
    *val = 0;
    if (!(isdigitch(*txtPtr) || ((*txtPtr >= 'a') && (*txtPtr <= 'f')))) {
        return 1;
    }
    do {
        *val *= 16;
        *val += hexchar2val(*txtPtr);
        ++txtPtr;
    } while (isdigitch(*txtPtr) || ((*txtPtr >= 'a') && (*txtPtr <= 'f')));
    return 0;
}

/*
 * Statement tokens - must be in order with no gaps in sequence
 */
#define TOK_COMM     150        /* (comment) must be lowest-numbered token */
#define TOK_PRDEC    151        /* pr.dec        */
#define TOK_PRDEC_S  152        /* pr.dec.s      */
#define TOK_PRHEX    153        /* pr.hex        */
#define TOK_PRMSG    154        /* pr.msg        */
#define TOK_PRNL     155        /* pr.nl         */
#define TOK_PRSTR    156        /* pr.str        */
#define TOK_PRCH     157        /* pr.ch         */
#define TOK_KBDCH    158        /* kbd.ch        */
#define TOK_KBDLN    159        /* kbd.ln        */
#define TOK_QUIT     160        /* quit          */
#define TOK_CLEAR    161        /* clear         */
#define TOK_VARS     162        /* vars          */
#define TOK_WORD     163        /* word          */
#define TOK_BYTE     164        /* byte          */
#define TOK_CONST    165        /* byte          */
#define TOK_RUN      166        /* run           */
#define TOK_COMPILE  167        /* comp          */
#define TOK_NEW      168        /* new           */
#define TOK_SUBR     169        /* sub           */
#define TOK_ENDSUBR  170        /* endsub        */
#define TOK_IF       171        /* if            */
#define TOK_ELSE     172        /* else          */
#define TOK_ENDIF    173        /* endif         */
#define TOK_FREE     174        /* free          */
#define TOK_CALL     175        /* call sub      */
#define TOK_RET      176        /* return        */
#define TOK_FOR      177        /* for           */
#define TOK_ENDFOR   178        /* endfor        */
#define TOK_WHILE    179        /* while         */
#define TOK_ENDW     180        /* endwhile      */
#define TOK_END      181        /* end           */
#define TOK_MODE     182        /* mode          */

/*
 * All the following tokens do not require trailing whitespace
 * Careful - the ordering matters!
 */
#define TOK_POKEWORD 183        /* poke word (*) */
#define TOK_POKEBYTE 184        /* poke byte (^) */

/* Line editor commands */
#define TOK_LOAD    185         /* Editor: load        */
#define TOK_SAVE    186         /* Editor: save        */
#define TOK_LIST    187         /* Editor: list        */
#define TOK_CHANGE  188         /* Editor: modify line */
#define TOK_APP     189         /* Editor: append line */
#define TOK_INS     190         /* Editor: insert line */
#define TOK_DEL     191         /* Editor: delete line */

/*
 * Used for the stmnttabent type field.  Code in parseline() uses this
 * value to determine how to handle parameters for the statement.
 *
 *  FULLLINE: full-line statement where the entire line 'belongs' to the
 *            statement (comments, sub and lbl are like this.)
 *  NOARGS: no arguments permitted.
 *  ONEARG: one expression is expected and evaluated.  No further arguments
 *          permitted.
 *  TWOARGS: two expressions are expected, separated by a comma
 *  INITIALARG: one expression is evaluated.  Any subsequent arguments may be
 *              evaluated by custom code for each statement.
 *  ONESTRARG: a string constant in quotes is expected
 *  INITIALNAMEARG: a single name is evaluated.  Any subsequent arguments may
 *                  be evaluated by custom code for each statement.  The name
 *                  must start with alpha character and has no spaces.
 *  CUSTOM: the statement has its own custom code to handle parameters
 */
enum stmnttype {
    FULLLINE,
    NOARGS,
    ONEARG,
    TWOARGS,
    INITIALARG,
    ONESTRARG,
    INITIALNAMEARG,
    CUSTOM
};

/*
 * Represents an entry in the statement table
 */
struct stmnttabent {
    char *name;
    unsigned char token;
    enum stmnttype type;
};

/*
 * Number of statements - must be updated to match the table
 */
#define NUMSTMNTS 42

/*
 * Statement table
 * Must be in order of sequentially increasing token value, so that
 * stmnttabent[t - TOK_COMM] is the line matching token t
 *
 * Also note that if a one name is a prefix of another, the longer one
 * must be first (so println goes before print).
 */
struct stmnttabent stmnttab[] = {

    /* Statements */
    {"\'", TOK_COMM, FULLLINE},         /* 1 */
    {"pr.dec", TOK_PRDEC, ONEARG},      /* 2 */
    {"pr.dec.s", TOK_PRDEC_S, ONEARG},  /* 3 */
    {"pr.hex", TOK_PRHEX, ONEARG},      /* 4 */
    {"pr.msg", TOK_PRMSG, ONESTRARG},   /* 5 */
    {"pr.nl", TOK_PRNL, NOARGS},        /* 6 */
    {"pr.str", TOK_PRSTR, ONEARG},      /* 7 */
    {"pr.ch", TOK_PRCH, ONEARG},        /* 8 */
    {"kbd.ch", TOK_KBDCH, ONEARG},      /* 9 */
    {"kbd.ln", TOK_KBDLN, TWOARGS},     /* 10 */
    {"quit", TOK_QUIT, NOARGS},         /* 11 */
    {"clear", TOK_CLEAR, NOARGS},       /* 12 */
    {"vars", TOK_VARS, NOARGS},         /* 13 */
    {"word", TOK_WORD, CUSTOM},         /* 14 */
    {"byte", TOK_BYTE, CUSTOM},         /* 15 */
    {"const", TOK_CONST, CUSTOM},       /* 16 */
    {"run", TOK_RUN, NOARGS},           /* 17 */
    {"comp", TOK_COMPILE, ONESTRARG},   /* 18 */
    {"new", TOK_NEW, NOARGS},           /* 19 */
    {"sub", TOK_SUBR, INITIALNAMEARG},  /* 20 */
    {"endsub", TOK_ENDSUBR, NOARGS},    /* 21 */
    {"if", TOK_IF, ONEARG},             /* 22 */
    {"else", TOK_ELSE, NOARGS},         /* 23 */
    {"endif", TOK_ENDIF, NOARGS},       /* 24 */
    {"free", TOK_FREE, NOARGS},         /* 25 */
    {"call", TOK_CALL, INITIALNAMEARG}, /* 26 */
    {"return", TOK_RET, ONEARG},        /* 27 */
    {"for", TOK_FOR, CUSTOM},           /* 28 */
    {"endfor", TOK_ENDFOR, NOARGS},     /* 29 */
    {"while", TOK_WHILE, ONEARG},       /* 30 */
    {"endwhile", TOK_ENDW, NOARGS},     /* 31 */
    {"end", TOK_END, NOARGS},           /* 32 */
    {"mode", TOK_MODE, ONEARG},         /* 33 */
    {"*", TOK_POKEWORD, INITIALARG},    /* 34 */
    {"^", TOK_POKEBYTE, INITIALARG},    /* 35 */

    /* Editor commands */
    {":r", TOK_LOAD, ONESTRARG},        /* 36 */
    {":w", TOK_SAVE, ONESTRARG},        /* 37 */
    {":l", TOK_LIST, CUSTOM},           /* 38 */
    {":c", TOK_CHANGE, INITIALARG},     /* 39 */
    {":a", TOK_APP, ONEARG},            /* 40 */
    {":i", TOK_INS, ONEARG},            /* 41 */
    {":d", TOK_DEL, INITIALARG}         /* 42 - set NUMSTMNTS to this value */
};

/*
 * Attempt to find statement keyword
 * Returns the token or ILLEGAL
 *
 * Uses table stmnttab, returning the token corresponding to the first
 * matching name.  Also checks for either a space or end of line following
 * the keyword, or will not declare a match.
 */
unsigned char matchstatement()
{
    unsigned char i;
    unsigned char len;
    char c;
    struct stmnttabent *s;

    for (i = 0; i < NUMSTMNTS; ++i) {
        s = &(stmnttab[i]);
        len = strlen(s->name);
        if (!strncmp(txtPtr, s->name, len)) {
            /*
             * Do not check for whitespace for tokens >= TOK_POKEWORD
             * Also do not check for whitespace for tokens <= TOK_COMM.
             */
            if ((s->token >= TOK_POKEWORD) || (s->token <= TOK_COMM)) {
                return s->token;
            }
            c = *(txtPtr + len);
            if ((c == 0) || (c == ' ') || (c == ';')) {
                return s->token;
            }
        }
    }
    return ILLEGAL;
}

/*
 * Used to check no arguments are passed to statements that do not take them
 * Returns 0 if end of line or semicolon next, 1 otherwise.
 */
unsigned char checkNoMoreArgs()
{
    eatspace();
    if (*txtPtr && (*txtPtr != ';')) {
        error(ERR_EXTRA);
        printchar(' ');
        print(txtPtr);
        return 1;
    }
    return 0;
}

#ifdef A2E
#pragma code-name (push, "LC")
#endif
void showfreespace() {
    print("free:\n");
#ifdef CC65
#ifdef EXTMEM
    print("Blk1: ");
    printdec(getfreespace1());
    print(" / ");
    printdec(gettotalspace1());
#ifdef EXTMEMCODE
    print(" vars\n");
#else
    print(" bytecode,vars\n");
#endif
    print("Blk2: ");
    printdec(getfreespace2());
    print(" / ");
    printdec(gettotalspace2());
    print(" lists,linkage\n");
    print("Aux:  ");
    printdec(getfreeauxmem());
    print(" / ");
    printdec(gettotalauxmem());
#ifdef EXTMEMCODE
    print(" source,bytecode");
#else
    print(" source");
#endif
#else
    print("Blk1: ");
    printdec(getfreespace1());
    print(" / ");
    printdec(gettotalspace1());
    print(" bytecode,vars\n");
    print("Blk2: ");
    printdec(getfreespace2());
    print(" / ");
    printdec(gettotalspace2());
    print(" source,linkage");
#endif
#else
    printdec(getfreespace1());
    print(" / ");
    printdec(gettotalspace1());
    print(" bytecode,vars\n");
    print("unlimited source,linkage");
#endif
}
#ifdef A2E
#pragma code-name (pop)
#endif

/* Parse a line from the input buffer
 * Handles statements
 * Starts reading from location of txtPtr
 * Returns:
 *   0: Keep executing
 *   1: Normal stop
 *   2: Error stop
 *   3: User stop / escape
 */
unsigned char parseline()
{
    int token;
    int arg;
    int arg2;
    char *p;
    char *startTxtPtr;
    struct stmnttabent *s;

    for (;;) {

        /* See if user requested stop */
        if (checkInterrupted()) {
            return 3;
        }

        eatspace();

        while (*txtPtr == ';') {
            ++txtPtr;
            if (!(*txtPtr)) {
                return 0;
            }
            eatspace();
        }

        if (!(*txtPtr)) {
            return 0;
        }

        startTxtPtr = txtPtr;

        token = matchstatement();

        /*
         * If skipFlag is set, then only process those tokens that
         * manipulate skipFlag:
         *   'if / else / endif'
         *   'while / endw'
         * Skip all others.
         */
        if (skipFlag) {
            if ((token != TOK_IF) &&
                (token != TOK_ELSE) &&
                (token != TOK_ENDIF) &&
                (token != TOK_WHILE) && (token != TOK_ENDW)) {

                /*
                 * Eat the statement up to semicolon or the
                 * end.
                 */
                while (*txtPtr && (*txtPtr != ';')) {
                    ++txtPtr;
                }
                continue;
            }
        }

        if (token == ILLEGAL) {

#ifdef CBM
            /*
             * If the first character is a digit then treat
             * this as an editor 'change line' command.  This
             * allows the VIC-20/C64 screen editor to work the
             * same way as in BASIC.
             */

            if (isdigitch(*txtPtr)) {

                token = TOK_CHANGE;
                s = &(stmnttab[token - TOK_COMM]);

            } else {
#endif
                /*
                 * Variable assignment winds up here
                 */
                if (assignorcreate(LET_MODE)) {
                    return 2;   /* Error */
                }
                continue;
#ifdef CBM
            }
#endif

        } else {

            s = &(stmnttab[token - TOK_COMM]);

            /* Eat the keyword */
            txtPtr += strlen(s->name);

            eatspace();
        }

        /*
         * If we are compiling it is good to keep a copy of the
         * VM program counter just before we begin argument 
         * handling.  This is useful for re-evaluating WHILE loop
         * guards, for example!
         */
        rtPCBeforeEval = rtPC;

        /*
         * Generic parameter handling based on statement type.
         */
        switch (s->type) {

        case NOARGS:
            /* Check end of input */
            arg = checkNoMoreArgs();
            if (arg) {
                return 2;
            }
            break;
        case ONEARG:
            /* Evaluate one arg and check end of input */
            if (eval(1, &arg)) {
                return 2;
            }
            break;
        case TWOARGS:
            /* Evaluate one arg don't check end of input */
            if (eval(0, &arg)) {
                return 2;
            }
            eatspace();
            if (expect(',')) {
                return 2;
            }
            /* Evaluate second arg, don't check end of input */
            if (eval(0, &arg2)) {
                return 2;
            }
            break;
        case INITIALARG:
            /* Evaluate one arg, don't check end of input */
            if (eval(0, &arg)) {
                return 2;
            }
            break;
        case ONESTRARG:
            /* Parse quoted string, place it in readbuf */
            if (!(*txtPtr == '"')) {
                return 2;
            }
            ++txtPtr;
            p = readbuf;
            while (*txtPtr && (*txtPtr != '"')) {
                *(p++) = *(txtPtr++);
            }
            *p = '\0';
            if (*txtPtr == '"') {
                ++txtPtr;
            } else {
                error(ERR_STR);
                return 2;
            }
            arg = checkNoMoreArgs();
            if (arg) {
                return 2;
            }
            break;
        case INITIALNAMEARG:
            /* Evaluate name, place in readbuf */
            /* Don't check end of input */
            if (!isalpha(*txtPtr)) {
                return 2;
            }
            p = readbuf;
            while (*txtPtr && (isalphach(*txtPtr) || isdigitch(*txtPtr))) {
                *(p++) = *(txtPtr++);
            }
            *p = '\0';
            break;
        case FULLLINE:
            /* Eat the line */
            while (*txtPtr) {
                ++txtPtr;
            }
            break;
#ifdef __GNUC__
        case CUSTOM:
            break;
#endif
        }

        /*
         * Code for individual statements.
         */
        switch (token) {
        case TOK_COMM:
            break;
        case TOK_QUIT:
#ifdef C64
            /* Restore normal NMI vector on C64 */
            POKE(808, 237);
#elif defined(VIC20)
            /* Restore normal NMI vector on VIC20 */
            POKE(808, 112);
#endif

            print("Bye!\n");
            EXIT(0);
        case TOK_PRDEC:
            if (compile) {
                emit(VM_PRDEC);
            } else {
                printdec(arg);
            }
            break;
        case TOK_PRDEC_S:
            if (compile) {
                emit(VM_DUP);   /* Preserve arg on the stack */
                emitldi(0x8000);
                emit(VM_BITAND);
                emit(VM_NOT);
                emit_imm(VM_BRNCHIMM, rtPC + 9);      /* Jump over printing of '-' */
                emitldi('-');
                emit(VM_PRCH);
                emit(VM_NEG);
                emit(VM_PRDEC);
            }
            if (arg < 0) {
                printchar('-');
                arg = -arg;
            }
            printdec(arg);
            break;
        case TOK_PRHEX:
            if (compile) {
                emit(VM_PRHEX);
            } else {
                printhex(arg);
            }
            break;
        case TOK_PRMSG:
            if (compile) {
                emitprmsg();
            } else {
                print(readbuf);
            }
            break;
        case TOK_PRNL:
            if (compile) {
#ifdef CBM
                emitldi(13);
#else
                emitldi(10);
#endif
                emit(VM_PRCH);
            } else {
                printchar('\n');
            }
            break;
        case TOK_PRSTR:
            if (compile) {
                emit(VM_PRSTR);
            } else {
                print((char *) arg);
            }
            break;
        case TOK_PRCH:
            if (compile) {
                emit(VM_PRCH);
            } else {
                printchar(arg);
            }
            break;
        case TOK_KBDCH:
            if (compile) {
                /* Address should be on the eval stack already */
                emit(VM_KBDCH);
                /* Now the keycode is pushed to the eval stack also */
                emit(VM_SWAP);
                emit(VM_STABYTE);
            } else {
#ifdef A2E
                /* Loop until we get a keypress */
                while (!(arg2 = getkey()));
                *(char *) arg = arg2;
#elif defined(CBM)
                /* Loop until we get a keypress */
                while (!(*(char *) arg = cbm_k_getin()));
#else
                print("kbd.ch unimplemented on Linux\n");
#endif
            }
            break;
        case TOK_KBDLN:
            if (compile) {
                /* Address and length should both be on the eval stack */
                emit(VM_KBDLN);
            } else {
                getln((char *) arg, arg2);
            }
            break;
        case TOK_CLEAR:
            clearvars();
            break;
        case TOK_VARS:
            printvars();
            break;
        case TOK_WORD:
            if (assignorcreate(WORD_MODE)) {
                return 2;
            }
            break;
        case TOK_BYTE:
            if (assignorcreate(BYTE_MODE)) {
                return 2;
            }
            break;
        case TOK_CONST:
            if (assignorcreate(CONST_MODE)) {
                return 2;
            }
            break;
        case TOK_RUN:
            run(0);             /* Start from beginning */
            break;
        case TOK_COMPILE:
            strncpy(filename, readbuf, FILENAMELEN);
            filename[FILENAMELEN] = 0; /* Just in case not terminated */
            compile = 1;
            subsbegin = subsend = NULL;
            callsbegin = callsend = NULL;
            CLEARRTCALLSTACK();
            run(0);
            if (compile) {
                emit(VM_END);
                linksubs();
                writebytecode();
                compile = 0;
            }
#ifndef __GNUC__
            CLEARHEAP2TOP();    /* Clear the linkage table */
#endif
            break;
        case TOK_NEW:
            new();
            break;
        case TOK_SUBR:
            if (dosubr()) {
                return 2;
            }
            break;
        case TOK_ENDSUBR:
            if (doendsubr()) {
                return 2;
            }
            break;
        case TOK_CALL:
            if (docall()) {
                return 2;
            }
            if (compile) {
                /* Drop the return value */
                emit(VM_DROP);
            } else {
                /* If we were called from immediate mode ... */
                /* Switch to run mode and continue */
                if (return_stack[returnSP + 2] == -1) {
                    run(1);
                }
            }
            break;
        case TOK_RET:
            if (doreturn(arg)) {
                /* Error */
                return 2;
            }

            /*
             * If this was a function invocation, just
             * return and let P() continue with its job!
             */
            if (return_stack[returnSP + 2] == -2) {
                return 1;
            }

            break;
        case TOK_IF:
            doif(arg);
            break;
        case TOK_ELSE:
            if (doelse()) {
                return 2;
            }
            break;
        case TOK_ENDIF:
            if (doendif()) {
                return 2;
            }
            break;
        case TOK_FOR:
            if (assignorcreate(FOR_MODE)) {
                return 2;
            }
            break;
        case TOK_ENDFOR:
            if (doendfor()) {
                return 2;
            }
            break;
        case TOK_WHILE:
            dowhile(startTxtPtr, arg);
            break;
        case TOK_ENDW:
            if (doendwhile()) {
                return 2;
            }
            break;
        case TOK_END:
            if (compile) {
                emit(VM_END);
            } else {
                return 1;       /* Normal stop */
            }
            break;
        case TOK_MODE:
#ifdef A2E
            if (arg == 40) {
                videomode(VIDEOMODE_40COL);
            } else if (arg == 80) {
                videomode(VIDEOMODE_80COL);
            } else {
                error(ERR_VALUE);
                return 2;
            }
#endif
            break;
        case TOK_FREE:
            showfreespace();
            break;
        case TOK_POKEWORD:
            eatspace();
            if (expect('=')) {
                return 2;
            }
            if (eval(1, &arg2)) {
                return 2;
            }
            if (compile) {
                emit(VM_SWAP);
                emit(VM_STAWORD);
                return 0;
            }
            *(int *) arg = arg2;
            break;
        case TOK_POKEBYTE:
            eatspace();
            if (expect('=')) {
                return 2;
            }
            if (eval(1, &arg2)) {
                return 2;
            }
            if (compile) {
                emit(VM_SWAP);
                emit(VM_STABYTE);
                return 0;
            }
            *(unsigned char *) arg = arg2;
            break;
        case TOK_APP:
            findline(arg);
            if (!current) {
                error(ERR_LINE);
                break;
            }
            editmode = 1;
            break;
        case TOK_INS:
            if (arg <= 1) {
                editmode = 2;   /* Special mode for insert
                                   first line */
            } else {
                findline(arg - 1);
                if (!current) {
                    error(ERR_LINE);
                    break;
                }
                editmode = 1;
            }
            break;
        case TOK_DEL:
            eatspace();
            if (!(*txtPtr)) {
                deleteline(arg, arg);   /* One arg */
                break;
            }
            if (expect(',')) {
                return 2;
            }
            if (eval(1, &arg2)) {
                return 2;
            }
            deleteline(arg, arg2);      /* Two args */
            break;
        case TOK_CHANGE:
            eatspace();
            if (expect(':')) {
                return 2;
            }
            findline(arg);
            if (!current) {
                error(ERR_LINE);
                break;
            }
            changeline(txtPtr);
            /* Don't execute the changed code yet! */
            return 0;
            break;
        case TOK_LIST:
            if (!(*txtPtr)) {
                list(1, 32767); /* No args */
                break;
            }
            if (eval(0, &arg)) {
                return 2;
            }
            eatspace();
            if (!(*txtPtr)) {
                list(arg, 32767);       /* One arg */
                break;
            }
            if (expect(',')) {
                return 2;
            }
            if (eval(1, &arg2)) {
                return 2;
            }
            list(arg, arg2);    /* Two args */
            break;
        case TOK_LOAD:
            if (readfile()) {
                return 2;       /* Error */
            }
            /* Because readfile() trashes lnbuf ... */
            return 0;
            break;
        case TOK_SAVE:
            if (writefile()) {
                return 2;       /* Error */
            }
            break;
        default:
            /* Should never get here */
            EXIT(99);
        }
    }
    return 0;
}

/*
 * Expects filename in readbuf.
 * If writemode = 0 then it opens file for reading, otherwise for writing.
 * Returns 0 if OK, 1 if error.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
unsigned char openfile(unsigned char writemode)
{
    char *readPtr = readbuf;

    if (writemode) {
        print("Writing ");
    } else {
        print("Reading ");
    }
    print(readPtr);
    printchar(':');
    while (*readPtr) {
        ++readPtr;
    }
#ifdef CBM
    /* Commodore only, append ',s' for SEQ file */
    *(readPtr++) = ',';
    *(readPtr++) = 's';
#endif
    *readPtr = '\0';

    readPtr = readbuf;

#ifdef CBM
    /* Commodore */
    if (cbm_open(1, 8, (writemode ? CBM_WRITE : CBM_READ), readPtr)) {
        error(ERR_FILE);
        return 1;
    }
#else

#ifdef A2E
    _filetype = 4;              /* Text file */
#endif

    /* POSIX */
    fd = fopen(readPtr, (writemode ? "w" : "r"));
    if (fd == NULL) {
        error(ERR_FILE);
        return 1;
    }
#endif

    return 0;

}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Load program from file.
 * Expects filename in readbuf.
 * Returns 0 if OK, 1 if error.
 * NOTE: Trashes lnbuf !!
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
unsigned char readfile()
{
    unsigned char i;
    unsigned char j;
    unsigned int bytes;
    unsigned char foundEOL;
    unsigned char bytesInBuf = 0;
    char *readPtr = readbuf;
    int donereading = 0;
    int count = 0;

    if (openfile(0)) {
        return 1;
    }

    clearvars();
    new();

    readPtr = readbuf;
    do {
        if (!donereading) {
#ifdef DEBUG_READFILE
            print("About to read ");
            printdec(255 - bytesInBuf);
            print(" bytes\n");
#endif

#ifdef CBM
            /* Commodore */
            bytes = cbm_read(1, readPtr, 255 - bytesInBuf);
#else
            /* POSIX */
            bytes = fread(readPtr, 1, 255 - bytesInBuf, fd);

#endif
            if (bytes == -1U) {
                error(ERR_FILE);
#ifdef CBM
                /* Commodore */
                cbm_close(1);
#else
                /* POSIX */
                fclose(fd);
#endif
                return 1;
            }
            if (!bytes) {
                donereading = 1;
            }

            readPtr += bytes;
            bytesInBuf += bytes;

#ifdef DEBUG_READFILE
            print("Read ");
            printdec(bytes);
            print(" bytes\nBuf[");
            for (i = 0; i < bytesInBuf; ++i) {
                printchar(readbuf[i]);
            }
            print("]\n");
#endif
        }

        foundEOL = 0;
        for (i = 0; i < bytesInBuf; ++i) {
            if (readbuf[i] == 10 || readbuf[i] == 13) {
                strncpy(lnbuf, readbuf, i);
                lnbuf[i] = 0;
                for (j = i + 1; j < bytesInBuf; ++j) {
                    readbuf[j - i - 1] = readbuf[j];
                }
                readPtr = readbuf + bytesInBuf - i - 1;
                bytesInBuf -= (i + 1);
                foundEOL = 1;
                break;
            }
        }

        if (foundEOL == 1) {
            if (!count) {
                insertfirstline(lnbuf);
                findline(1);
            } else {
                appendline(lnbuf);
            }
            ++count;
        } else {
            if (bytesInBuf == 255) {
                error(ERR_FILE);
#ifdef CBM
                /* Commodore */
                cbm_close(1);
#else
                /* Apple II and POSIX */
                fclose(fd);
#endif
                return 1;
            }
            /* Handle last line with missing CRLF */
            if (donereading == 1 && bytesInBuf) {
                readbuf[bytesInBuf] = '\0';
                appendline(readbuf);
                ++count;
                break;
            }
        }

    } while (bytes || bytesInBuf);

#ifdef CBM
    /* Commodore */
    cbm_close(1);
#else
    /* Apple II and POSIX */
    fclose(fd);
#endif

    printdec(count);
    print(" lines\n");
    return 0;
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Save program to file.
 * Expects filename in readbuf.
 * Returns 0 if OK, 1 if error.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
unsigned char writefile()
{
    unsigned int bytes;
    unsigned int index;

    if (openfile(1)) {
        return 1;
    }

    current = program;
    while (current) {
        index = 0;

#ifdef EXTMEM
        copyfromaux(current->line, current->len);
        for (index = 0; index < strlen(embuf); ++index) {
#else
        for (index = 0; index < strlen(current->line); ++index) {
#endif

#ifdef CBM
            /* Commodore */
            bytes = cbm_write(1, current->line + index, 1);

#elif defined(EXTMEM)
            /* Apple II, using extended memory driver */
            bytes = fwrite(embuf + index, 1, 1, fd);
#else
            /* POSIX and Apple II without extended memory */
            bytes = fwrite(current->line + index, 1, 1, fd);
#endif
            if (!bytes) {
                goto error;
            }
        }
#ifdef CBM
        /* Commodore */
        bytes += cbm_write(1, "\n", 1);
#elif defined(A2E)
        /* Apple II */
        bytes += fwrite("\r", 1, 1, fd);
#else
        /* POSIX */
        bytes += fwrite("\n", 1, 1, fd);
#endif
        if (!bytes) {
            goto error;
        }
        current = current->next;
    }

#ifdef CBM
    /* Commodore */
    cbm_close(1);
#else
    /* POSIX */
    fclose(fd);
#endif
    print("OK\n");
    return 0;

  error:
#ifdef CBM
    /* Commodore */
    cbm_close(1);
#else
    /* POSIX */
    fclose(fd);
#endif
    error(ERR_FILE);
    return 1;
}
#ifdef A2E
#pragma code-name (pop)
#endif


void run(unsigned char cont)
{
    int status = 0;

    calllevel = 0;
    skipFlag = 0;
    if (cont == 0) {
        counter = 0;
        clearvars();
        returnSP = RETSTACKSZ - 1;
        current = program;
    }
    while (current && !status) {
        if (compile) {
            printchar('.');
        }
#ifdef EXTMEM
        copyfromaux(current->line, current->len);
        txtPtr = embuf;
#else
        txtPtr = current->line;
#endif
        status = parseline();
        /* parseline() can set current to NULL when return is to
         * immediate mode */
        if (!current) {
            break;
        }
        current = current->next;
        ++counter;
    }
    switch (status) {
    case 2:
        print(" err at ");
        printdec(counter);
        printchar('\n');
        returnSP = (RETSTACKSZ - 1);
        skipFlag = 0;
        compile = 0;
        break;
    case 3:
        print("\nBrk at ");
        printdec(counter);
        printchar('\n');
        returnSP = (RETSTACKSZ - 1);
        skipFlag = 0;
        compile = 0;
        break;
    }
}

/*
 * Perform linkage.
 * The subroutine definitions are in the list that starts with subsbegin.
 * The subroutine calls are in the list that starts with callsbegin.
 */
#ifdef A2E
#pragma code-name (push, "LC")
#endif
void linksubs()
{
    sub_t *call;
    sub_t *sub;
    call = callsbegin;
    while (call) {
        sub = subsbegin;

        while (strncmp(sub->name, call->name, SUBRNUMCHARS)) {
            sub = sub->next;
            if (!sub) {
                error(ERR_LINK);
                return;
            }
        }
        emit_fixup(call->addr, sub->addr);
        call = call->next;
    }
}
#ifdef A2E
#pragma code-name (pop)
#endif

#ifdef A2E
#pragma code-name (push, "LC")
#endif
void list(unsigned int startline, unsigned int endline)
{
    unsigned int count = 1;

    current = program;
    while (current) {
        if ((count >= startline) && (count <= endline)) {
#ifdef CBM
            printchar(28);      /* Red */
            printchar(18);      /* Reverse On */
#elif defined(A2E)
            revers(1);
#endif
            printdec(count);
#ifdef CBM
            printchar(':');     /* To make scrn editor work */
            printchar(144);     /* Black */
            printchar(146);     /* Reverse Off */
#elif defined(A2E)
            revers(0);
#endif

#ifdef EXTMEM
            copyfromaux(current->line, current->len);
            print(embuf);
#else
            print(current->line);
#endif
            printchar('\n');
        }
        ++count;
        current = current->next;
    }
}
#ifdef A2E
#pragma code-name (pop)
#endif

/*
 * Clear the operator and operand stacks prior to evaluating expression.
 */
#define clearexprstacks() \
    operandSP = STACKSZ - 1; \
    operatorSP = STACKSZ - 1; \
    push_operator_stack(SENTINEL);


/*
 * Entry point.
 */
#ifdef __GNUC__
int
#else
void
#endif
main()
{

#ifdef EXTMEM
    unsigned char emhandle;
#endif
#ifdef A2E
    clrscr();
#elif defined(VIC20)
    POKE(0x900f, 254);          /* Nice color scheme */
#elif defined(C64)
    char *border = (char *) 0xd020;
    char *background = (char *) 0xd021;
    *border = 6;
    *background = 7;
#endif

#ifdef CBM
    printchar(147);             /* Clear */
    printchar(28);              /* Red */
    printchar(18);              /* Reverse On */

    /* Disable RUNSTOP/RESTORE */
    POKE(808, 100);
#endif

    calllevel = 1;
    returnSP = RETSTACKSZ - 1;
    varsbegin = NULL;
    varsend = NULL;
    varslocal = NULL;
    program = NULL;
    current = NULL;

#ifdef A2E
    videomode(VIDEOMODE_80COL);
    revers(1);
    print("      ***    EIGHTBALL V" VERSIONSTR "   ***     \n");
    print("      ***    (C)BOBBI, 2018    ***     \n\n");
    revers(0);
#ifdef EXTMEM
    emhandle = em_load_driver("a2e.auxmem.emd");
    if (emhandle != EM_ERR_OK) {
        print("Unable to load EM driver a2e.auxmem.emd\n");
        return;
    }
#endif
#elif defined(C64)
    print("      ***    EightBall v" VERSIONSTR "   ***      ");
    print("      ***    (c)Bobbi, 2018    ***      \n\n");
#elif defined(VIC20)
    /* Looks great in 22 cols! */
    print("*** EightBall v" VERSIONSTR "****** (c)Bobbi, 2017 ***\n\n");
#else
    print("      ***    EightBall v" VERSIONSTR "   ***     \n");
    print("      ***    (c)Bobbi, 2018    ***     \n\n");
#endif

#ifdef CBM
    printchar(144);             /* Black */
    printchar(146);             /* Reverse Off */
#endif
    print("Free Software.\n");
    print("Licenced under GPL.\n\n");

    CLEARHEAP1();
#ifdef CC65
    CLEARHEAP2TOP();
    CLEARHEAP2BTTM();
#ifdef EXTMEM
    CLEARAUXMEM();
#endif
#endif

    showfreespace();
    print("\n\n");

    /* Warm reset goes here */
    if (setjmp(jumpbuf) == 1) {
        print("Restart\n");
    }

    for (;;) {
        clearexprstacks();
        if (editmode) {
#ifdef CBM
            printchar(30);      /* Green */
            printchar(18);      /* Reverse On */
#endif
            printchar('>');
#ifdef CBM
            printchar(144);     /* Black */
            printchar(146);     /* Reverse Off */
#endif
        }

        compile = 0;
        getln(lnbuf, 255);

        switch (editmode) {
        case 0:                /* Not editing - immediate mode execute */
            txtPtr = lnbuf;
            current = NULL;
            counter = -1;
            switch (parseline()) {
            case 0:
            case 1:
                printchar('\n');
                break;
            case 2:
                print(" err\n");
                returnSP = (RETSTACKSZ - 1);
                skipFlag = 0;
                break;
            case 3:
                print("Brk\n");
                returnSP = (RETSTACKSZ - 1);
                skipFlag = 0;
                break;
            }
            if (returnSP != (RETSTACKSZ - 1)) {
                error(ERR_STACK);
                returnSP = (RETSTACKSZ - 1);
            }
            skipFlag = 0;
            break;
        case 1:                /* Editing the program, period to escape */
            if (lnbuf[0] == '.') {
                editmode = 0;
            } else {
                appendline(lnbuf);
            }
            break;
        case 2:                /* Special case for insert first line */
            insertfirstline(lnbuf);
            findline(1);
            editmode = 1;
            break;
        }
    }
}