Apple-2-SW/EightBall
1
0
Fork 0
mirror of https://github.com/bobbimanners/EightBall.git synced 2024-05-29 03:41:32 +00:00
Code Issues Projects Releases Wiki Activity
2f3d705769
EightBall/eightball.c
Bobbi Webber-Manners aa819ef166
v0.72: Extended memory support for Apple //e 
- Implemented initial version of extended memory support, which allows the EightBall source code to be stored in aux RAM (extended 80 column card).  Once an apparent bug in the cc65 extended memory driver is fixed then bytecode will also be stored in aux RAM.
- Moved non-performance critical portions of interpreter / compiler to Apple II language card memory, which frees up more main memory.
- Improvements to display of free memory (`free` command)
2018-05-27 00:13:48 -04:00

5515 lines
145 KiB
C
Raw Blame History

/**************************************************************************/
/* 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.
* At present EXTMEMCODE is **BROKEN** due to apparent bug in cc65 ext mem driver
*/
#ifdef A2E
#define EXTMEM /* Enable/disable extended memory for source code */
#undef 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 */
char readbuf[255]; /* Buffer for reading from file */
char lnbuf[255]; /* Input text line buffer */
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]);
print(" \"");
print(txtPtr);
print("\"\n");
}
#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 0x2000. Top of memory is 0xbfff.
* Stack is 2K immediately below 0xbfff. (0xb800-0xbfff)
*
* Space below 0x2000 is used for file buffers (cc65 provides a module we
* link in for this.)
*
* 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 HEAP1LIM (char*)0xa800
#define HEAP1LIM (char*)0xa400
#define HEAP2TOP (char*)(HEAP1LIM - 1)
#ifdef EXTMEM
#define HEAP2LIM (char*)0x9000
#else
#define HEAP2LIM (char*)0x7f00
#endif
/* HEAP2LIM HAS TO BE ADJUSTED TO NOT
* TRASH THE CODE, WHICH LOADS FROM $2000 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 buf[3];
void copybytetoaux(char *auxptr, char byte) {
//char *p = em_map((unsigned int)auxptr >> 8);
//*(p + (unsigned char)auxptr) = byte;
//em_commit();
buf[0] = byte;
buf[1] = 0;
emcopy.buf = buf;
emcopy.count = 1;
emcopy.offs = (unsigned char)auxptr;
emcopy.page = (unsigned int)auxptr >> 8;
em_copyto(&emcopy);
}
void copybytefromaux(char *auxptr) {
emcopy.buf = buf;
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);
#else
emit(VM_PRMSG);
++rtPC;
while (*p) {
*codeptr++ = *p++;
++rtPC;
}
*codeptr++ = 0;
#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, "bytecode");
printchar('\n');
openfile(1);
print("...\n");
while (p < end) {
#ifdef EXTMEMCODE
copybytefromaux(p);
q = buf;
#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;
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] + 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, NOARGS}, /* 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:
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;
}
}
}
Reference in New Issue View Git Blame Copy Permalink