Apple-2-SW/EightBall
1
0
Fork 0
mirror of https://github.com/bobbimanners/EightBall.git synced 2025-02-20 08:28:56 +00:00
Code Issues Projects Releases Wiki Activity

EightBall v0.5 - With Compile and Virtual Machine

Browse Source
This commit is contained in:
Bobbi Webber-Manners 2018-04-27 23:47:22 -04:00 committed by GitHub
parent 756e356704
commit 11f99c9840
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
19 changed files with 5543 additions and 2626 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
8ball20.prg
View File

Binary file not shown.

BIN
8ball64.prg
View File

Binary file not shown.

BIN
8ballvm20.prg Normal file
View File

Binary file not shown.

BIN
8ballvm64.prg Normal file
View File

Binary file not shown.

92
Makefile Normal file
View File

@ -0,0 +1,92 @@
all: eightball eightballvm 8ball20.prg 8ballvm20.prg 8ball64.prg 8ballvm64.prg eightball.system ebvm.system test.d64 test.dsk
clean:
rm -f eightball eightballvm *.o 8ball20.* 8ball64.* eightball*.s eightball.system test.d64 *.map
eightball.o: eightball.c eightballutils.h eightballvm.h
# 32 bit so sizeof(int*) = sizeof(int) [I am lazy]
gcc -m32 -Wall -Wextra -g -c -o eightball.o eightball.c -lm
eightballvm.o: eightballvm.c eightballutils.h eightballvm.h
# 32 bit so sizeof(int*) = sizeof(int) [I am lazy]
gcc -m32 -Wall -Wextra -g -c -o eightballvm.o eightballvm.c -lm
eightballutils.o: eightballutils.c eightballutils.h
# 32 bit so sizeof(int*) = sizeof(int) [I am lazy]
gcc -m32 -Wall -Wextra -g -c -o eightballutils.o eightballutils.c -lm
eightball: eightball.o eightballutils.o
# 32 bit so sizeof(int*) = sizeof(int) [I am lazy]
gcc -m32 -Wall -Wextra -g -o eightball eightball.o eightballutils.o -lm
eightballvm: eightballvm.o eightballutils.o
# 32 bit so sizeof(int*) = sizeof(int) [I am lazy]
gcc -m32 -Wall -Wextra -g -o eightballvm eightballvm.o eightballutils.o -lm
eightball_20.o: eightball.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t vic20 -D VIC20 -o eightball_20.s eightball.c
~/Personal/Development/cc65/bin/ca65 -t vic20 eightball_20.s
eightballvm_20.o: eightballvm.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t vic20 -D VIC20 -o eightballvm_20.s eightballvm.c
~/Personal/Development/cc65/bin/ca65 -t vic20 eightballvm_20.s
eightballutils_20.o: eightballutils.c eightballutils.h
~/Personal/Development/cc65/bin/cc65 -Or -t vic20 -D VIC20 -o eightballutils_20.s eightballutils.c
~/Personal/Development/cc65/bin/ca65 -t vic20 eightballutils_20.s
8ball20.prg: eightball_20.o eightballutils_20.o
~/Personal/Development/cc65/bin/ld65 -m 8ball20.map -o 8ball20.prg -Ln 8ball20.vice -C vic20-32k.cfg eightball_20.o eightballutils_20.o ~/Personal/Development/cc65/lib/vic20.lib
8ballvm20.prg: eightballvm_20.o eightballutils_20.o
~/Personal/Development/cc65/bin/ld65 -m 8ballvm20.map -o 8ballvm20.prg -Ln 8ballvm20.vice -C vic20-32k.cfg eightballvm_20.o eightballutils_20.o ~/Personal/Development/cc65/lib/vic20.lib
eightball_64.o: eightball.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t c64 -D C64 -o eightball_64.s eightball.c
~/Personal/Development/cc65/bin/ca65 -t c64 eightball_64.s
eightballvm_64.o: eightballvm.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t c64 -D C64 -o eightballvm_64.s eightballvm.c
~/Personal/Development/cc65/bin/ca65 -t c64 eightballvm_64.s
eightballutils_64.o: eightballutils.c eightballutils.h
~/Personal/Development/cc65/bin/cc65 -Or -t c64 -D C64 -o eightballutils_64.s eightballutils.c
~/Personal/Development/cc65/bin/ca65 -t c64 eightballutils_64.s
8ball64.prg: eightball_64.o eightballutils_64.o
~/Personal/Development/cc65/bin/ld65 -m 8ball64.map -o 8ball64.prg -Ln 8ball64.vice -C c64.cfg eightball_64.o eightballutils_64.o ~/Personal/Development/cc65/lib/c64.lib
8ballvm64.prg: eightballvm_64.o eightballutils_64.o
~/Personal/Development/cc65/bin/ld65 -m 8ballvm64.map -o 8ballvm64.prg -Ln 8ballvm64.vice -C c64.cfg eightballvm_64.o eightballutils_64.o ~/Personal/Development/cc65/lib/c64.lib
eightball_a2e.o: eightball.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t apple2enh -D A2E -o eightball_a2e.s eightball.c
~/Personal/Development/cc65/bin/ca65 -t apple2enh eightball_a2e.s
eightballvm_a2e.o: eightballvm.c eightballutils.h eightballvm.h
~/Personal/Development/cc65/bin/cc65 -Or -t apple2enh -D A2E -o eightballvm_a2e.s eightballvm.c
~/Personal/Development/cc65/bin/ca65 -t apple2enh eightballvm_a2e.s
eightballutils_a2e.o: eightballutils.c eightballutils.h
~/Personal/Development/cc65/bin/cc65 -Or -t apple2enh -D A2E -o eightballutils_a2e.s eightballutils.c
~/Personal/Development/cc65/bin/ca65 -t apple2enh eightballutils_a2e.s
eightball.system: eightball_a2e.o eightballutils_a2e.o
~/Personal/Development/cc65/bin/ld65 -m 8balla2e.map -o eightball.system -C apple2enh-system.cfg eightball_a2e.o eightballutils_a2e.o apple2enh-iobuf-0800.o ~/Personal/Development/cc65/lib/apple2enh.lib
ebvm.system: eightballvm_a2e.o eightballutils_a2e.o
~/Personal/Development/cc65/bin/ld65 -m 8ballvma2e.map -o ebvm.system -C apple2enh-system.cfg eightballvm_a2e.o eightballutils_a2e.o apple2enh-iobuf-0800.o ~/Personal/Development/cc65/lib/apple2enh.lib
test.d64: 8ball20.prg 8ballvm20.prg 8ball64.prg 8ballvm64.prg
c1541 -format eb,00 d64 test.d64
c1541 -attach test.d64 -write 8ball20.prg
c1541 -attach test.d64 -write 8ballvm20.prg
c1541 -attach test.d64 -write 8ball64.prg
c1541 -attach test.d64 -write 8ballvm64.prg
test.dsk: eightball.system ebvm.system
java -jar ~/Desktop/Apple2/AppleCommander-1.3.5.jar -d test.dsk e8ball.system
java -jar ~/Desktop/Apple2/AppleCommander-1.3.5.jar -d test.dsk ebvm.system
java -jar ~/Desktop/Apple2/AppleCommander-1.3.5.jar -p test.dsk e8ball.system sys <eightball.system
java -jar ~/Desktop/Apple2/AppleCommander-1.3.5.jar -p test.dsk ebvm.system sys <ebvm.system

BIN
ebvm.system Normal file
View File

Binary file not shown.

BIN
eightball Normal file
View File

Binary file not shown.

6285
eightball.c
View File

File diff suppressed because it is too large Load Diff

BIN
eightball.system
View File

Binary file not shown.

218
eightballutils.c Normal file
View File

@ -0,0 +1,218 @@
/**************************************************************************/
/* 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 */
/* */
/**************************************************************************/
/**************************************************************************/
/* 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 "eightballutils.h"
#include <string.h>
#include <unistd.h>
#include <stdlib.h>
#ifdef A2E
#include <apple2enh.h>
#include <peekpoke.h>
#include <conio.h>
#endif
/*
* This does the same thing as fputs(str, 1), but uses marginally less
* memory.
*/
void print(char *str) {
write(1, str, strlen(str));
}
/*
* This does the same thing as printchar() but uses marginally less memory.
*/
void printchar(char c) {
write(1, &c, 1);
}
/*
* Print a 16 bit integer value as an unsigned decimal
*/
void printdec(unsigned int val) {
unsigned char digit;
unsigned int denom = 10000;
unsigned char doprint = 0;
do {
digit = val / denom;
if (digit) {
doprint = 1;
}
if (doprint) {
printchar(digit + '0');
}
val = val % denom;
denom = denom / 10;
} while (denom);
if (!doprint) {
printchar('0');
}
}
/*
* Return character for hex digit 0 to 15
*/
char hexval2char(unsigned char val) {
if (val > 9) {
return val - 10 + 'a';
}
return val + '0';
}
/*
* Print a value as hex
*/
void printhex(unsigned int val) {
printchar('$');
printchar(hexval2char((val>>12) & 0x0f));
printchar(hexval2char((val>>8) & 0x0f));
printchar(hexval2char((val>>4) & 0x0f));
printchar(hexval2char(val & 0x0f));
}
/*
* Print a value as hex
*/
void printhexbyte(unsigned char val) {
printchar('$');
printchar(hexval2char((val>>4) & 0x0f));
printchar(hexval2char(val & 0x0f));
}
#ifdef A2E
#define KEY_BACKSPACE 127
#define KEY_LEFTARROW 8
#endif
/*
* This is lighter than gets() and also safe!
* Will read up to buflen bytes from STDIN
* Has some ugly special case code for Apple II.
*/
void getln(char *str, unsigned char buflen)
{
unsigned char i;
#ifdef A2E
unsigned char key;
unsigned char xpos;
unsigned char ypos;
#endif
unsigned char j = 0;
do {
i = read(0, str + j, 1);
#ifdef A2E
/*
* Handle backspace and delete keys
* TODO: I would sooner not use these conio functions.
* However this works for now.
* TODO: This assumes 80 column mode and does strange things
* in 40 cols!
*/
key = *(str + j);
if (key == KEY_BACKSPACE) {
xpos = wherex();
ypos = wherey();
if ((xpos == 1) && (ypos != 0)) {
xpos = 79;
--ypos;
} else if ((xpos == 0) && (ypos != 0)) {
xpos = 78;
--ypos;
} else if (xpos > 1) {
xpos -= 2;
}
gotoxy(xpos, ypos);
}
if ((key == KEY_LEFTARROW) || (key == KEY_BACKSPACE)) {
--j;
} else {
++j;
}
#else
++j;
#endif
} while ((i) && (j < buflen) && *(str + j - 1) != '\n');
str[j - 1] = '\0';
}
#ifdef A2E
/*
* This is for Apple II only. Obtain keypress.
*/
char getkey(void)
{
char junk;
char ch = PEEK(0xc000);
if (ch > 128) {
junk = PEEK(0xc010); /* Clear kbd strobe */
return ch - 128;
}
return 0;
}
#endif
/*
* For Apple II and CBM.
* Returns 1 if interrupted by user, 0 otherwise
*/
unsigned char checkInterrupted(void)
{
#ifdef A2E
char junk;
#endif
#ifdef CBM
/* Check for STOP key */
if (PEEK(0x00c5) == 24) {
return 1;
}
#elif defined(A2E)
/* Check for ESC key */
if (PEEK(0xc000) == 0x9b) {
junk = PEEK(0xc010); /* Clear kbd strobe */
return 1;
}
#endif
return 0;
}

59
eightballutils.h Normal file
View File

@ -0,0 +1,59 @@
/**************************************************************************/
/* 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 */
/* */
/**************************************************************************/
/**************************************************************************/
/* 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/>. */
/* */
/**************************************************************************/
void print(char *str);
void printchar(char c);
void printdec(unsigned int val);
#ifdef __GNUC__
char hexval2char(unsigned char val);
#endif
void printhex(unsigned int val);
void printhexbyte(unsigned char val);
void getln(char *str, unsigned char buflen);
char getkey(void);
unsigned char checkInterrupted(void);

BIN
eightballvm Normal file
View File

Binary file not shown.

750
eightballvm.c Normal file
View File

@ -0,0 +1,750 @@
/**************************************************************************/
/* EightBall Virtual Machine */
/* */
/* 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 2018 */
/* Reference implementation of EightBall Virtual Machine. */
/* */
/* This is not intended to be optimized for speed. I plan to implement */
/* an optimized version in 6502 assembler later. */
/* */
/* Formatted with 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/>. */
/* */
/**************************************************************************/
/*
#define DEBUG
#define EXTRADEBUG
#define DEBUGREGS
#define DEBUGADDRESSING
#define DEBUGSTACK
*/
#include "eightballvm.h"
#include "eightballutils.h"
#include <stdlib.h>
#include <stdio.h>
#define EVALSTACKSZ 16
/*
* Call stack grows down from top of memory.
* If it hits CALLSTACKLIM then VM will quit with error
*/
#ifdef __GNUC__
#define MEMORYSZ (64 * 1024)
#else
/* Has to be 64K minus a byte otherwise winds up being zero! */
#define MEMORYSZ (64 * 1024) - 1
#endif
#define CALLSTACKLIM (32 * 1024)
#ifdef __GNUC__
#define UINT16 unsigned short
#else
#define UINT16 unsigned int
#endif
UINT16 pc = RTPCSTART; /* Program counter */
UINT16 sp = RTCALLSTACKTOP; /* Stack pointer */
UINT16 fp = RTCALLSTACKTOP; /* Frame pointer */
/* Evaluation stack - 16 bit ints. Addressed by evalptr */
UINT16 evalstack[EVALSTACKSZ];
/* evalptr points to the empty slot above the top of the evaluation stack */
unsigned char evalptr = 0;
/*
* System memory - addressed in bytes.
* Used for program storage. Addressed by pc.
* - Programs are stored from address 0 upwards.
* Used for callstack. Addressed by sp.
* - Callstack grows down from top of memory.
*/
#ifdef __GNUC__
unsigned char memory[MEMORYSZ];
#else
unsigned char *memory = 0;
#endif
#define XREG evalstack[evalptr - 1] /* Only valid if evalptr >= 1 */
#define YREG evalstack[evalptr - 2] /* Only valid if evalptr >= 2 */
#define ZREG evalstack[evalptr - 3] /* Only valid if evalptr >= 3 */
#define TREG evalstack[evalptr - 4] /* Only valid if evalptr >= 4 */
/*
* Error checks are called through macros to make it easy to
* disable them in production. We should not need these checks
* in production (assuming no bugs in the compiler!) ... but they
* are helpful for debugging!
*/
/* Check evaluation stack is not going to underflow */
#define CHECKUNDERFLOW(level) checkunderflow(level)
/* Check evaluation stack is not going to overflow */
#define CHECKOVERFLOW() checkoverflow()
/* Check call stack is not going to underflow */
#define CHECKSTACKUNDERFLOW(bytes) checkstackunderflow(bytes)
/* Check call stack is not going to overflow */
#define CHECKSTACKOVERFLOW(bytes) checkstackoverflow(bytes)
/* Handler for unsupported bytecode */
#define UNSUPPORTED() unsupported()
/*
* Check for evaluation stack underflow.
* level - Number of 16 bit operands required on eval stack.
*/
void checkunderflow(unsigned char level)
{
if (evalptr < level) {
print("Eval stack underflow\nPC=");
printhex(pc);
printchar('\n');
while (1);
}
}
/*
* Check evaluation stack is not going to overflow.
* Assumes evalptr has already been advanced.
*/
void checkoverflow()
{
if (evalptr > EVALSTACKSZ - 1) {
print("Eval stack overflow\nPC=");
printhex(pc);
printchar('\n');
while (1);
}
}
/*
* Check call stack is not going to underflow.
* bytes - Number of bytes required on call stack.
*/
void checkstackunderflow(unsigned char bytes)
{
if ((MEMORYSZ - sp) < bytes) {
print("Call stack underflow\nPC=");
printhex(pc); printchar('\n');
while (1);
}
}
/*
* Check call stack is not going to overflow.
* Assumes sp has already been advanced.
*/
void checkstackoverflow()
{
if (sp < CALLSTACKLIM + 1) {
print("Call stack overflow\nPC=");
printhex(pc);
printchar('\n');
while (1);
}
}
/*
* Handler for unsupported bytecodes
*/
void unsupported()
{
print("Unsupported instruction ");
printhexbyte(memory[pc]);
print("\nPC=");
printhex(pc);
printchar('\n');
while (1);
}
/*
* Fetch, decode and execute a VM instruction, then advance the program counter.
*/
void execute_instruction()
{
unsigned int tempword;
unsigned char *byteptr;
#ifndef __GNUC__
unsigned int delay;
#endif
#ifdef DEBUGREGS
unsigned int i;
print("\n");
print("--->PC "); printhex(pc); print("\n");
print("--->SP "); printhex(sp); print("\n");
print("--->FP "); printhex(fp); print("\n");
print("Call Stk: ");
for(i = sp+1; i <= RTCALLSTACKTOP; ++i) {
printhexbyte(memory[i]); printchar(' ');
}
print("\nEval Stk: ");
printhex(XREG);
printchar(' ');
printhex(YREG);
printchar(' ');
printhex(ZREG);
printchar(' ');
printhex(TREG);
printchar('\n');
#endif
#ifdef DEBUG
#ifdef A2E
printchar('\r');
#else
printchar('\n');
#endif
printhex(pc);
print(": ");
print(bytecodenames[memory[pc]]);
if (memory[pc] == VM_LDIMM) {
printchar(' ');
printhex(memory[pc + 1] + 256 * memory[pc + 2]);
printchar(' ');
} else {
print(" ");
}
#ifdef EXTRADEBUG
print("stk: ");
if (evalptr >= 1) {
printhex(XREG);
}
if (evalptr >= 2) {
print(", ");
printhex(YREG);
}
if (evalptr >= 3) {
print(", ");
printhex(ZREG);
}
if (evalptr >= 4) {
print(", ");
printhex(TREG);
}
if (evalptr >= 5) {
print(", ");
printhex(evalstack[evalptr - 5]);
}
if (evalptr >= 6) {
print(" ...");
}
#endif
#endif
switch (memory[pc]) {
case VM_LDIMM: /* Pushes the following 16 bit word to the evaluation stack */
++evalptr;
CHECKOVERFLOW();
/* Note: Word is stored in little endian format! */
tempword = memory[++pc];
tempword += memory[++pc] * 256;
XREG = tempword;
break;
/*
* Absolute addressing:
* XREG points to absolute address within system memory.
*/
case VM_LDAWORD: /* Replaces X with 16 bit value pointed to by X. */
CHECKUNDERFLOW(1);
#ifdef DEBUGADDRESSING
print("\n XREG: ");
printhex(XREG);
printchar('\n');
#endif
XREG = memory[XREG] + 256 * memory[XREG + 1];
break;
case VM_LDABYTE: /* Replaces X with 8 bit value pointed to by X. */
CHECKUNDERFLOW(1);
XREG = memory[XREG];
break;
case VM_STAWORD: /* Stores 16 bit value Y in addr pointed to by X. Drops X and Y. */
CHECKUNDERFLOW(2);
memory[XREG] = YREG & 0x00ff;
memory[XREG + 1] = (YREG & 0xff00) >> 8;
evalptr -= 2;
break;
case VM_STABYTE: /* Stores 8 bit value Y in addr pointed to by X. Drops X and Y. */
CHECKUNDERFLOW(2);
memory[XREG] = YREG;
evalptr -= 2;
break;
/*
* Relative to Frame Pointer addressing:
* XREG points to address in system memory relative to the frame pointer.
*/
case VM_LDRWORD: /* Replaces X with 16 bit value pointed to by X. */
CHECKUNDERFLOW(1);
#ifdef DEBUGADDRESSING
print("\n XREG: ");
printhex(XREG);
print(", FP: ");
printhex(fp);
print(" -> ");
printhex((XREG + fp + 1) & 0xffff);
printchar('\n');
#endif
XREG = memory[(XREG + fp + 1) & 0xffff] + 256 * memory[(XREG + fp + 2) & 0xffff];
break;
case VM_LDRBYTE: /* Replaces X with 8 bit value pointed to by X. */
CHECKUNDERFLOW(1);
#ifdef DEBUGADDRESSING
print("\n XREG: ");
printhex(XREG);
print(", FP: ");
printhex(fp);
print(" -> ");
printhex((XREG + fp + 1) & 0xffff);
printchar('\n');
#endif
XREG = memory[(XREG + fp + 1) & 0xffff];
break;
case VM_STRWORD: /* Stores 16 bit value Y in addr pointed to by X. Drops X and Y. */
CHECKUNDERFLOW(2);
memory[(XREG + fp + 1) & 0xffff] = YREG & 0x00ff;
memory[(XREG + fp + 2) & 0xffff] = (YREG & 0xff00) >> 8;
evalptr -= 2;
break;
case VM_STRBYTE: /* Stores 8 bit value Y in addr pointed to by X. Drops X and Y. */
CHECKUNDERFLOW(2);
memory[(XREG + fp + 1) & 0xffff] = YREG;
evalptr -= 2;
break;
/*
* Manipulate evaluation stack
*/
case VM_SWAP: /* Swaps X and Y */
CHECKUNDERFLOW(2);
tempword = XREG;
XREG = YREG;
YREG = tempword;
break;
case VM_DUP: /* Duplicates X -> X, Y */
CHECKUNDERFLOW(1);
++evalptr;
CHECKOVERFLOW();
XREG = YREG;
break;
case VM_DUP2: /* Duplicates X -> X,Z; Y -> Y,T */
CHECKUNDERFLOW(2);
evalptr += 2;
CHECKOVERFLOW();
XREG = ZREG;
YREG = TREG;
break;
case VM_DROP: /* Drops X */
CHECKUNDERFLOW(1);
--evalptr;
break;
case VM_OVER: /* Duplicates Y -> X,Z */
CHECKUNDERFLOW(2);
++evalptr;
CHECKOVERFLOW();
XREG = ZREG;
break;
case VM_PICK: /* Duplicates stack level specified in X+1 -> X */
CHECKUNDERFLOW(XREG + 1);
XREG = evalstack[evalptr - (XREG + 1)];
break;
/*
* Manipulate call stack
*/
case VM_POPWORD: /* Pop 16 bit value from call stack, push onto eval stack [X] */
CHECKSTACKUNDERFLOW(2);
sp += 2;
++evalptr;
CHECKOVERFLOW();
XREG = memory[sp - 1] + 256 * memory[sp];
break;
case VM_POPBYTE: /* Pop 8 bit value from call stack, push onto eval stack [X] */
CHECKSTACKUNDERFLOW(1);
++sp;
++evalptr;
CHECKOVERFLOW();
XREG = memory[sp];
break;
case VM_PSHWORD: /* Push 16 bit value in X onto call stack. Drop X. */
#ifdef DEBUGSTACK
print("\n Push word to ");
printhex(sp-1);
printchar('\n');
#endif
memory[sp] = (XREG & 0xff00) >> 8;
--sp;
CHECKSTACKOVERFLOW();
memory[sp] = XREG & 0x00ff;
--sp;
CHECKSTACKOVERFLOW();
--evalptr;
break;
case VM_PSHBYTE: /* Push 8 bit value in X onto call stack. Drop X. */
#ifdef DEBUGSTACK
print("\n Push byte to ");
printhex(sp);
printchar('\n');
#endif
memory[sp] = XREG & 0x00ff;
--sp;
CHECKSTACKOVERFLOW();
--evalptr;
break;
case VM_SPTOFP: /* Copy stack pointer to frame pointer. (Enter function scope) */
#ifdef DEBUGSTACK
print("\n SPTOFP FP before ");
printhex(fp);
print(" SP ");
printhex(sp);
printchar('\n');
#endif
/* Push old FP to stack */
memory[sp] = (fp & 0xff00) >> 8;
--sp;
CHECKSTACKOVERFLOW();
memory[sp] = fp & 0x00ff;
--sp;
CHECKSTACKOVERFLOW();
fp = sp;
break;
case VM_FPTOSP: /* Copy frame pointer to stack pointer. (Release local vars) */
#ifdef DEBUGSTACK
print("\n FPTOSP SP before ");
printhex(sp);
print(" FP ");
printhex(fp);
printchar('\n');
#endif
sp = fp;
/* Pop old FP from stack -> FP */
CHECKSTACKUNDERFLOW(2);
sp += 2;
CHECKOVERFLOW();
fp = memory[sp - 1] + 256 * memory[sp];
#ifdef DEBUGSTACK
print(" Recovered FP ");
printhex(fp);
print(" from stack\n");
#endif
break;
/*
* Miscellaneous
*/
case VM_RTOA: /* Convert relative address in X to absolute address */
XREG = (XREG + fp + 1) & 0xffff;
break;
case VM_END: /* Terminate execution */
#ifdef __GNUC__
exit(0);
#else
/* Spin forever */
for (delay = 0; delay < 25000; ++delay);
exit(0);
#endif
break;
/*
* Integer math
*/
case VM_INC: /* X = X+1. */
CHECKUNDERFLOW(1);
++XREG;
break;
case VM_DEC: /* X = X-1. */
CHECKUNDERFLOW(1);
--XREG;
break;
case VM_ADD: /* X = Y+X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG + XREG;
--evalptr;
break;
case VM_SUB: /* X = Y-X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG - XREG;
--evalptr;
break;
case VM_MUL: /* X = Y*X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG * XREG;
--evalptr;
break;
case VM_DIV: /* X = Y/X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG / XREG;
--evalptr;
break;
case VM_MOD: /* X = Y%X. Y is dropped . */
CHECKUNDERFLOW(2);
YREG = YREG % XREG;
--evalptr;
break;
case VM_NEG: /* X = -X */
CHECKUNDERFLOW(1);
XREG = -XREG;
break;
/*
* Comparisons
*/
case VM_GT: /* X = Y>X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG > XREG;
--evalptr;
break;
case VM_GTE: /* X = Y>=X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG >= XREG;
--evalptr;
break;
case VM_LT: /* X = Y<X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG < XREG;
--evalptr;
break;
case VM_LTE: /* X = Y<=X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG <= XREG;
--evalptr;
break;
case VM_EQL: /* X = Y==X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG == XREG;
--evalptr;
break;
case VM_NEQL: /* X = Y!=X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG != XREG;
--evalptr;
break;
/*
* Logical operations
*/
case VM_AND: /* X = Y&&X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG && XREG;
--evalptr;
break;
case VM_OR: /* X = Y||X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG || XREG;
--evalptr;
break;
case VM_NOT: /* X = !X */
CHECKUNDERFLOW(1);
XREG = !XREG;
break;
/*
* Bitwise operations
*/
case VM_BITAND: /* X = Y&X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG & XREG;
--evalptr;
break;
case VM_BITOR: /* X = Y|X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG | XREG;
--evalptr;
break;
case VM_BITXOR: /* X = Y^X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG ^ XREG;
--evalptr;
break;
case VM_BITNOT: /* X = ~X. */
CHECKUNDERFLOW(1);
XREG = ~XREG;
break;
case VM_LSH: /* X = Y<<X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG << XREG;
--evalptr;
break;
case VM_RSH: /* X = Y>>X. Y is dropped. */
CHECKUNDERFLOW(2);
YREG = YREG >> XREG;
--evalptr;
break;
/*
* Flow control
*/
case VM_JMP: /* Jump to address X. Drop X. */
CHECKUNDERFLOW(1);
pc = XREG;
--evalptr;
return; /* Do not advance program counter */
case VM_BRNCH: /* If Y!= 0, jump to address X. Drop X, Y. */
CHECKUNDERFLOW(2);
if (YREG) {
pc = XREG;
} else {
++pc;
}
evalptr -= 2;
return; /* Do not advance program counter */
case VM_JSR: /* Push PC to call stack. Jump to address X. Drop X. */
CHECKUNDERFLOW(1);
byteptr = (unsigned char *) &pc;
memory[sp] = *byteptr;
--sp;
CHECKSTACKOVERFLOW();
memory[sp] = *(byteptr + 1);
--sp;
CHECKSTACKOVERFLOW();
pc = XREG;
--evalptr;
return; /* Do not advance program counter */
case VM_RTS: /* Pop call stack, jump to the address popped. */
CHECKSTACKUNDERFLOW(2);
++sp;
pc = 256 * memory[sp] + memory[sp + 1];
++sp;
break;
/*
* Input / Output
*/
case VM_PRDEC: /* Print 16 bit decimal in X. Drop X */
CHECKUNDERFLOW(1);
printdec(XREG);
--evalptr;
break;
case VM_PRHEX: /* Print 16 bit hex in X. Drop X */
CHECKUNDERFLOW(1);
printhex(XREG);
--evalptr;
break;
case VM_PRCH: /* Print character in X. Drop X */
CHECKUNDERFLOW(1);
printchar((unsigned char) XREG);
--evalptr;
break;
case VM_PRSTR: /* Print null terminated string pointed to by X. Drop X */
CHECKUNDERFLOW(1);
while(memory[XREG]) {
printchar(memory[XREG++]);
}
--evalptr;
break;
case VM_PRMSG: /* Print literal string at PC (null terminated) */
++pc;
while(memory[pc]) {
printchar(memory[pc++]);
}
break;
case VM_KBDCH: /* Push character from keyboard onto eval stack */
CHECKUNDERFLOW(1);
++evalptr;
/* Loop until we get a keypress */
#ifdef A2E
while (!(XREG = getkey()));
#elif defined(CBM)
while (!(*(char *) XREG = cbm_k_getin()));
#else
/* TODO: Unimplemented in Linux */
XREG = 0;
#endif
break;
case VM_KBDLN: /* Obtain line from keyboard and write to memory pointed to by */
/* Y. X contains the max number of bytes in buf. Drop X, Y. */
CHECKUNDERFLOW(2);
getln((char *) &memory[YREG], XREG);
evalptr -= 2;
break;
/*
* Unsupported instruction
*/
default:
UNSUPPORTED();
break;
}
++pc;
};
/*
* Run the program!
*/
void execute()
{
while (1) {
execute_instruction();
}
}
/*
* Load bytecode into memory[].
* TODO: This is POSIX-only at the moment. Need to add CBM support.
*/
void load()
{
FILE *fp;
char ch;
pc = RTPCSTART;
fp = fopen("bytecode", "r");
while (!feof(fp)) {
ch = fgetc(fp);
//printhexbyte(ch);
//printchar('\n');
memory[pc++] = ch;
}
fclose(fp);
pc = RTPCSTART;
}
int main()
{
load();
execute();
return 0;
}

242
eightballvm.h Normal file
View File

@ -0,0 +1,242 @@
/**************************************************************************/
/* EightBall Virtual Machine */
/* */
/* 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 2018 */
/* Reference implementation of EightBall Virtual Machine. */
/* */
/* This is not intended to be optimized for speed. I plan to implement */
/* an optimized version in 6502 assembler later. */
/* */
/**************************************************************************/
/**************************************************************************/
/* 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/>. */
/* */
/**************************************************************************/
/*
* EIGHTBALL VIRTUAL MACHINE DEFINITION - Compilation Target
*
* Simple stack based VM with EVALUATION STACK of 16 bit integer values.
* It doesn't need to be too big - 16 words is a reasonable size for this
* stack.
*
* For convenience define this shorthand:
* [ X ] Top of stack
* [ Y ] Second
* [ Z ] Third
* [ T ] Fourth
*
* There is a separate CALL STACK which is used for argument passing,
* subroutine call and return and for local variables. This stack can grow
* very large, especially if you allocate big local arrays. The call stack
* allows either 16 bit words or bytes to be pushed or popped.
*
* The virtual machine also has the following three 16 bit registers:
* Program Counter (Referred to as rtPC in the compiler code)
* Stack Pointer (Referred to as rtSP in the compiler code)
* Points to free memory one 'above' the top of the call stack.
* Frame Pointer (points to stack pointer on entry to subroutine. Used to make
* it easier to refer to local variables allocated on the call
* stack, and also to release the locals on return from sub.)
*/
enum bytecode {
/**** Miscellaneous ********************************************************/
VM_END, /* Terminate execution */
/**** Load and Store *******************************************************/
VM_LDIMM, /* Pushes the following 16 bit word to the evaluation stack */
/* Absolute addressing: */
VM_LDAWORD,/* Replaces X with 16 bit value pointed to by X. */
VM_LDABYTE,/* Replaces X with 8 bit value pointed to by X. */
VM_STAWORD,/* Stores 16 bit value Y in addr pointed to by X. Drops X and Y.*/
VM_STABYTE,/* Stores 8 bit value Y in addr pointed to by X. Drops X and Y. */
/* Relative to Frame Pointer addressing: */
VM_LDRWORD,/* Replaces X with 16 bit value pointed to by X. */
VM_LDRBYTE,/* Replaces X with 8 bit value pointed to by X. */
VM_STRWORD,/* Stores 16 bit value Y in addr pointed to by X. Drops X and Y.*/
VM_STRBYTE,/* Stores 8 bit value Y in addr pointed to by X. Drops X and Y. */
/**** Manipulate evaluation stack ******************************************/
VM_SWAP, /* Swaps X and Y */
VM_DUP, /* Duplicates X -> X, Y */
VM_DUP2, /* Duplicates X -> X,Z; Y -> Y,T */
VM_DROP, /* Drops X */
VM_OVER, /* Duplicates Y -> X,Z */
VM_PICK, /* Duplicates stack level specified in X+1 -> X */
/**** Manipulate call stack ************************************************/
VM_POPWORD,/* Pop 16 bit value from call stack, push onto eval stack [X] */
VM_POPBYTE,/* Pop 8 bit value from call stack, push onto eval stack [X] */
VM_PSHWORD,/* Push 16 bit value in X onto call stack. Drop X. */
VM_PSHBYTE,/* Push 8 bit value in X onto call stack. Drop X. */
VM_SPTOFP, /* Copy stack pointer to frame pointer. (Enter function scope) */
VM_FPTOSP, /* Copy frame pointer to stack pointer. (Release local vars) */
VM_RTOA, /* Convert relative address in X to absolute address */
/**** Integer math *********************************************************/
VM_INC, /* X = X+1. */
VM_DEC, /* X = X-1. */
VM_ADD, /* X = Y+X. Y is dropped. */
VM_SUB, /* X = Y-X. Y is dropped. */
VM_MUL, /* X = Y*X. Y is dropped. */
VM_DIV, /* X = Y/X. Y is dropped. */
VM_MOD, /* X = Y%X. Y is dropped . */
VM_NEG, /* X = -X */
/**** Comparisons **********************************************************/
VM_GT, /* X = Y>X. Y is dropped. */
VM_GTE, /* X = Y>=X. Y is dropped. */
VM_LT, /* X = Y<X. Y is dropped. */
VM_LTE, /* X = Y<=X. Y is dropped. */
VM_EQL, /* X = Y==X. Y is dropped. */
VM_NEQL, /* X = Y!=X. Y is dropped. */
/**** Logical operations ***************************************************/
VM_AND, /* X = Y&&X. Y is dropped. */
VM_OR, /* X = Y||X. Y is dropped. */
VM_NOT, /* X = !X */
/**** Bitwise operations ***************************************************/
VM_BITAND, /* X = Y&X. Y is dropped. */
VM_BITOR, /* X = Y|X. Y is dropped. */
VM_BITXOR, /* X = Y^X. Y is dropped. */
VM_BITNOT, /* X = ~X. */
VM_LSH, /* X = Y<<X. Y is dropped. */
VM_RSH, /* X = Y>>X. Y is dropped. */
/**** Flow control *********************************************************/
VM_JMP, /* Jump to address X. Drop X. */
VM_BRNCH, /* If Y!= 0, jump to address X. Drop X, Y. */
VM_JSR, /* Push PC to call stack. Jump to address X. Drop X. */
VM_RTS, /* Pop call stack, jump to the address popped. */
/**** Input / Output *******************************************************/
VM_PRDEC, /* Print 16 bit decimal in X. Drop X */
VM_PRHEX, /* Print 16 bit hex in X. Drop X */
VM_PRCH, /* Print character in X. Drop X */
VM_PRSTR, /* Print null terminated string pointed to by X. Drop X */
VM_PRMSG, /* Print literal string at PC (null terminated) */
VM_KBDCH, /* Push character from keyboard onto eval stack */
VM_KBDLN /* Obtain line from keyboard and write to memory pointed to by */
/* Y. X contains the max number of bytes in buf. Drop X, Y. */
/***************************************************************************/
};
/* Order must match enum bytecode */
char *bytecodenames[] = {
"END",
"LDI",
"LDAW",
"LDAB",
"STAW",
"STAB",
"LDRW",
"LDRB",
"STRW",
"STRB",
"SWP",
"DUP",
"DUP2",
"DRP",
"OVER",
"PICK",
"POPW",
"POPB",
"PSHW",
"PSHB",
"SPFP",
"FPSP",
"RTOA",
"INC",
"DEC",
"ADD",
"SUB",
"MUL",
"DIV",
"MOD",
"NEG",
"GT",
"GTE",
"LT",
"LTE",
"EQL",
"NEQL",
"AND",
"OR",
"NOT",
"BAND",
"BOR",
"BXOR",
"BNOT",
"LSH",
"RSH",
"JMP",
"BRC",
"JSR",
"RTS",
"PRDEC",
"PRHEX",
"PRCH",
"PRSTR",
"PRMSG",
"KBDCH",
"KBDLN"
};
#ifdef A2E
/*
* Apple II Enhanced
*/
#define RTCALLSTACKTOP 0xb7ff
#define RTCALLSTACKLIM 0x9800
#define RTPCSTART 0x5000 /* TBC */
#elif defined(C64)
/*
* C64
*/
#define RTCALLSTACKTOP 0xbfff
#define RTCALLSTACKLIM 0xa000
#define RTPCSTART 0x3000 /* TBC */
#elif defined(VIC20)
/*
* VIC-20:
*/
#define RTCALLSTACKTOP 0xbfff
#define RTCALLSTACKLIM 0xa000
#define RTPCSTART 0x4000 /* TBC */
#elif defined(__GNUC__)
/*
* Linux
*/
//#define RTCALLSTACKTOP 64 * 1024 - 1
#define RTCALLSTACKTOP 48 * 1024 - 1 // FOR TESTING
#define RTCALLSTACKLIM 32 * 1024
#define RTPCSTART 0
#endif

17
fact.8b Normal file
View File

@ -0,0 +1,17 @@
'
' Recursive factorial function test
'
pr.dec fact(3); pr.nl
end
sub fact(word val)
pr.msg "fact("; pr.dec val; pr.msg ")"; pr.nl
if val == 0
return 1
else
' return val * fact(val-1) ; ' THIS DOES NOT WORK
return fact(val-1) * val ; ' BUT THIS DOES!!!
endif
endsub

47
sieve4.8b Normal file
View File

@ -0,0 +1,47 @@
' Sieve of Eratosthenes
byte A[10000] = 1
call doall(100)
end
sub doall(word nr)
word n = nr * nr
pr.msg "Sieve of Eratosthenes ..."
pr.msg "nr is "; pr.dec nr; pr.nl
call sieve(n, nr)
call printresults(n)
return 0
endsub
sub sieve(word n, word nr)
pr.msg "Sieve"
word i = 0; word j = 0
for i = 2 : (nr - 1)
if A[i]
j = i * i
while (j < n)
A[j] = 0
j = j + i
endwhile
endif
endfor
return 0
endsub
sub printresults(word n)
word i = 0
for i = 2 : (n - 1)
if A[i]
if i > 2
pr.msg ", "
endif
pr.dec i
endif
endfor
pr.msg "."
pr.nl
return 0
endsub

BIN
test.d64
View File

Binary file not shown.

BIN
test.dsk
View File

Binary file not shown.

459
unittest.8b Normal file
View File

@ -0,0 +1,459 @@
'----------------------'
' Eightball Unit Tests '
'----------------------'
word status=0
'------------------
' Word variables
'------------------
pr.msg "Word vars:"; pr.nl
word w1=10
word w2=100
word w3=50
status=(w1==10)&&(w2==100)&&(w3==50)
call expect(status)
w2=w2+10
status=(w1==10)&&(w2==110)&&(w3==50)
call expect(status)
w2=w1+10
status=(w1==10)&&(w2==20)&&(w3==50)
call expect(status)
'------------------
' Byte variables
'------------------
pr.msg "Byte vars:"; pr.nl
byte b1=10;
byte b2=100;
word b3=50;
call expect((b1==10)&&(b2==100)&&(b3==50))
b2=b2+10
call expect((b1==10)&&(b2==110)&&(b3==50))
b2=b1+10
call expect((b1==10)&&(b2==20)&&(b3==50))
'------------------
' Word arrays
'------------------
pr.msg "Word arrays:"; pr.nl
word wpre=0
word warr[10]=12
word wpost=0
pr.msg "Size of word (4 for interpeter, 2 for 6502 & VM): "
pr.dec (&warr[2]-&warr[1])
pr.nl
call expect((wpre==0)&&(warr[0]==12)&&(warr[1]==12)&&(warr[2]==12)&&(warr[9]==12)&&(wpost==0))
warr[1]=123
call expect((wpre==0)&&(warr[0]==12)&&(warr[1]==123)&&(warr[2]==12)&&(warr[9]==12)&&(wpost==0))
'------------------
' Byte arrays
'------------------
pr.msg "Byte arrays:"; pr.nl
byte bpre=0
byte barr[10]=12
byte bpost=0
call expect((&barr[2]-&barr[1])==1)
call expect((&barr[4]-&barr[1])==3)
call expect((bpre==0)&&(barr[0]==12)&&(barr[1]==12)&&(warr[2]==12)&&(barr[9]==12)&&(bpost==0))
barr[1]=123
call expect((bpre==0)&&(barr[0]==12)&&(barr[1]==123)&&(warr[2]==12)&&(barr[9]==12)&&(bpost==0))
'------------------
' For loop
'------------------
pr.msg "For loop:"; pr.nl
word sum=0
word iw=0
for iw=1:3
sum=sum+iw
endfor
call expect(sum==6)
sum=0
byte ib=0
for ib=1:3
sum=sum+ib
endfor
call expect(sum==6)
'------------------
' While loop
'------------------
pr.msg "While loop:"; pr.nl
sum=0
iw=0
while iw<4
sum=sum+iw
iw=iw+1
endwhile
call expect(sum==6)
sum=0
ib=0
while ib<4
sum=sum+ib
ib=ib+1
endwhile
call expect(sum==6)
'------------------
' If/Endif
'------------------
pr.msg "If/Endif:"; pr.nl
iw=123
ib=0
if iw==123
ib=1
endif
call expect(ib==1)
iw=124
ib=0
if iw==123
ib=1
endif
call expect(ib==0)
'------------------
' If/Else/Endif
'------------------
pr.msg "If/Else/Endif:"; pr.nl
iw=123
ib=99
if iw==123
ib=1
else
ib=0
endif
call expect(ib==1)
iw=124
ib=99
if iw==123
ib=1
else
ib=0
endif
call expect(ib==0)
'------------------
' Pointers/Addresses
'------------------
pr.msg "Pointers/Addresses:"; pr.nl
word ptr=&iw
*ptr=9999
call expect(iw==9999)
ptr=&ib
^ptr=73
call expect(ib==73)
call expect(&warr[0]==&warr)
'------------------
' Call subroutine
'------------------
pr.msg "Call sub:"; pr.nl
call gv1()
call expect(iw==987)
call gb1()
call expect(ib==$ae)
call gwa1()
call expect(warr[3]==1234)
call gba1()
call expect(barr[7]==$34)
call c1()
call expect(iw==555)
pr.msg " Recursive:"; pr.nl
call recurse1(5, &iw)
call expect(iw==120)
'------------------
' Subroutine params
'------------------
pr.msg "Sub params:"; pr.nl
warr[0]=100
call pw1(warr[0])
call expect(iw==200)
barr[2]=10
call pb1(barr[2])
call expect(iw==20)
warr[0]=10
warr[1]=20
call pw2(warr[0],warr[1])
call expect(iw==200)
barr[0]=10
barr[1]=20
call pb2(barr[0],barr[1])
call expect(iw==200)
warr[0]=500
warr[1]=750
call add(warr[0],warr[1],&iw)
call expect(iw==1250)
warr[0]=500
warr[1]=750
call add(warr[0],warr[1],&warr[2])
call expect(warr[2]==1250)
word a1=&iw
call ppw1(2345, a1)
call expect(iw==2345)
call ppw1(2345, &iw)
call expect(iw==2345)
word a2=&ib
call ppb1(110, a2)
call expect(ib==110)
'------------------
' Invoke func
'------------------
pr.msg "Invoke func:"; pr.nl
call expect(sqr(10)==100)
pr.msg " Recursive:"; pr.nl
iw=recurse2(4)
call expect(iw==24)
' TODO: This is failing in the compiler where it returns 1
' But it is okay in interpreter where it returns 24 as it should.
iw=recurse3(4)
call expect(iw==24)
'------------------
' Locals
'------------------
pr.msg "Locals:"; pr.nl
iw=123
call lw1()
call expect(iw==123*2)
iw=123
call lb1()
call expect(iw==123*2)
iw=123
call lw2()
call expect(iw==123*4)
iw=123
call lb2()
call expect(iw==123*4)
call lpw1()
call expect(iw==1)
call lpb1()
call expect(iw==1)
call gp1()
call expect(iw==1)
'------------------
'------------------
end
'
' Test subroutines
'
sub gv1()
iw = 987; ' Set global word
return 0
endsub
sub gb1()
ib = $ae; ' Set global byte
return 0
endsub
sub gwa1()
warr[3] = 1234; ' Set global word array member
return 0
endsub
sub gba1()
barr[7] = $34; ' Set global byte array member
return 0
endsub
sub pw1(word xx)
iw = xx * 2
return 0
endsub
sub pb1(byte xx)
iw = xx * 2
return 0
endsub
sub pw2(word xx, word yy)
iw = xx * yy
return 0
endsub
sub pb2(byte xx, byte yy)
iw = xx * yy
return 0
endsub
sub add(word a, word b, word sumaddr)
*sumaddr=a+b
return 0
endsub
sub ppw1(word val, word addr)
*addr=val
return 0
endsub
sub ppb1(byte val, word addr)
^addr=val
return 0
endsub
sub c1()
call c2()
return 0
endsub
sub c2()
call c3()
return 0
endsub
sub c3()
iw = 555
return 0
endsub
sub sqr(word x)
return x*x
endsub
sub recurse1(word x, word addr)
if x==0
*addr=1
else
call recurse1(x-1,addr)
*addr=*addr*x
endif
endsub
sub recurse2(word x)
if x==0
return 1;
else
return recurse2(x-1)*x
endif
endsub
' Why does this not work, even though
' recurse2() works fine??
sub recurse3(word x)
if x==0
return 1;
else
return x*recurse2(x-1)
endif
endsub
sub lw1()
word loc=2
iw=iw*loc
return 0
endsub
sub lb1()
byte loc=2
iw=iw*loc
return 0
endsub
sub lw2()
word loc=0
loc=4
iw=iw*loc
return 0
endsub
sub lb2()
byte loc=0
loc=4
iw=iw*loc
return 0
endsub
sub lpw1()
iw=0
word xx=0
word addr=&xx
*addr=1234
if xx==1234
iw=1
endif
return 0
endsub
sub lpb1()
iw=0
byte xx=0
word addr=&xx
^addr=123
if xx==123
iw=1
endif
return 0
endsub
sub gp1()
iw=0
word addr=&iw
*addr=5436
if iw==5436
iw=1
endif
return 0
endsub
'
' Utility subroutines
'
sub expect(byte b)
if b
pr.msg " Pass "
else
pr.msg " FAIL "
endif
pr.nl
return 0
endsub