diff --git a/8ball20.prg b/8ball20.prg index b5ebef5..93f2856 100644 Binary files a/8ball20.prg and b/8ball20.prg differ diff --git a/8ball64.prg b/8ball64.prg index 2f49a83..b66acfb 100644 Binary files a/8ball64.prg and b/8ball64.prg differ diff --git a/8ballvm20.prg b/8ballvm20.prg index 149cfef..ebb2f7a 100644 Binary files a/8ballvm20.prg and b/8ballvm20.prg differ diff --git a/8ballvm64.prg b/8ballvm64.prg index 1308933..1375f31 100644 Binary files a/8ballvm64.prg and b/8ballvm64.prg differ diff --git a/ebvm.system b/ebvm.system index c978156..4fbb4ca 100644 Binary files a/ebvm.system and b/ebvm.system differ diff --git a/eightball b/eightball index 23c0e0d..6dcec24 100644 Binary files a/eightball and b/eightball differ diff --git a/eightball.c b/eightball.c index a65e7c5..44decd8 100644 --- a/eightball.c +++ b/eightball.c @@ -325,7 +325,8 @@ const char unaryops[] = "-+!~*^"; #define ERR_DIVZERO 121 /* Divide by zero */ #define ERR_VALUE 122 /* Bad value */ #define ERR_CONST 123 /* Const value reqd */ -#define ERR_LINK 124 /* Linkage error */ +#define ERR_TOOLONG 124 /* Initializer too lng*/ +#define ERR_LINK 125 /* Linkage error */ /* * Error reporting @@ -406,6 +407,9 @@ void error(unsigned char errcode) case ERR_CONST: print("not const"); break; + case ERR_TOOLONG: + print("too long"); + break; case ERR_LINK: print("link"); break; @@ -1287,7 +1291,7 @@ unsigned char *heap2PtrBttm; /* Arena 2: bottom-up heap */ #define HEAP2TOP (char*)0x97ff //#define HEAP2LIM (char*)0x8600 -#define HEAP2LIM (char*)0x8b00 // SET EXPERIMENTALLY +#define HEAP2LIM (char*)0x8c00 // SET EXPERIMENTALLY /* HEAP2LIM HAS TO BE ADJUSTED TO NOT * TRASH THE CODE, WHICH LOADS FROM $2000 UP * USE THE MAPFILE! */ @@ -1309,7 +1313,7 @@ unsigned char *heap2PtrBttm; /* Arena 2: bottom-up heap */ #define HEAP2TOP (char*)0x9fff - 0x0400 /* Leave $800 for the C stack */ //#define HEAP2LIM (char*)0x6a00 -#define HEAP2LIM (char*)0x7000 // SET EXPERIMENTALLY +#define HEAP2LIM (char*)0x7300 // SET EXPERIMENTALLY /* HEAP2LIM HAS TO BE ADJUSTED TO NOT * TRASH THE CODE, WHICH LOADS FROM $0800 UP * USE THE MAPFILE! */ @@ -1329,13 +1333,22 @@ unsigned char *heap2PtrBttm; /* Arena 2: bottom-up heap */ * Heap 1: Variables * Heap 2: Program text */ -#define HEAP1TOP (char*)0xbfff -#define HEAP1LIM (char*)0xa000 +//#define HEAP1TOP (char*)0xbfff +//#define HEAP1LIM (char*)0xa000 + +//#define HEAP2TOP (char*)0x7fff - 0x0400 /* Leave $400 for the C stack */ +//#define HEAP2LIM (char*)0x7c00 /* 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 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 -#define HEAP2TOP (char*)0x7fff - 0x0400 /* Leave $400 for the C stack */ -#define HEAP2LIM (char*)0x7700 /* HEAP2LIM HAS TO BE ADJUSTED TO NOT - * TRASH THE CODE, WHICH LOADS FROM $1200 UP - * USE THE MAPFILE! */ #endif @@ -1903,6 +1916,22 @@ void printvars() } } +/* Factored out to save a few bytes + * Used by createintvar() only. + */ +void st_abs_word(int i) { + emitldi(rtSP + 1 + 2 * i); + emit(VM_STAWORD); +} + +/* Factored out to save a few bytes + * Used by createintvar() only. + */ +void st_abs_byte(int i) { + emitldi(rtSP + 1 + i); + emit(VM_STABYTE); +} + /* * Create new integer variable (either word or byte, scalar or array) * @@ -1928,7 +1957,9 @@ unsigned char createintvar(char *name, int sz, int value, int bodyptr) { int i; + int val; var_t *v; + unsigned char arrinitmode = 0; /* 0 means string initializer, 1 means list initializer */ unsigned char local = 1; v = findintvar(name, &local); /* Only search local scope */ @@ -1982,15 +2013,14 @@ unsigned char createintvar(char *name, } } else { /* - * Array variables - * + * 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) { /* @@ -2000,6 +2030,23 @@ unsigned char createintvar(char *name, v = alloc1(sizeof(var_t) + 2 * sizeof(int)); } else { + /* + * For arrays we parse the initializer here. + */ + if (numdims != 0) { + if (*txtPtr == '"') { + arrinitmode = 0; + ++txtPtr; +#ifdef CBM + } else if (*txtPtr == '[') { +#else + } else if (*txtPtr == '{') { +#endif + arrinitmode = 1; + ++txtPtr; + } + } + if (compile) { /* *** Initializer value is on stack (X) *** */ @@ -2019,8 +2066,9 @@ unsigned char createintvar(char *name, } /* - * The following generates code to initialize the array + * The following generates code to allocate the array */ + emitldi(0); /* Value to fill with */ emitldi(sz); emit(VM_DEC); emit(VM_DUP); @@ -2037,24 +2085,136 @@ unsigned char createintvar(char *name, emit(VM_BRNCH); emit(VM_DROP); emit(VM_DROP); + + /* + * Initialize array + * arrinitmode 0 is for string initializer "like this" + * arrinitmode 1 is for list initializer {123, 456, 789 ...} + */ + if (arrinitmode == 0) { + --sz; /* Hack to leave space for final null */ + } + for (i = 0; i < sz; ++i) { + if (arrinitmode == 0) { + emitldi((*txtPtr == '"') ? 0 : *txtPtr); + ((type == TYPE_WORD) ? st_abs_word(i) : st_abs_byte(i)); + ++txtPtr; + } else { +#ifdef CBM + if (*txtPtr == ']') { +#else + if (*txtPtr == '}') { +#endif + break; + } + if (eval(0, &val)) { + return 1; + } + ((type == TYPE_WORD) ? st_abs_word(i) : st_abs_byte(i)); + eatspace(); + if (*txtPtr == ',') { + ++txtPtr; + } + eatspace(); + } + } + if (arrinitmode == 0) { + ++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; + } + } } else { if (type == TYPE_WORD) { v = alloc1(sizeof(var_t) + (sz + 2) * sizeof(int)); bodyptr = (int) ((unsigned char *) v + sizeof(var_t) + 2 * sizeof(int)); - - /* Initialize array */ - for (i = 0; i < sz; ++i) { - *((int *) bodyptr + i) = value; - } - } else { + } 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 */ - for (i = 0; i < sz; ++i) { - *((unsigned char *) bodyptr + i) = value; - } - } + /* + * Initialize array + * arrinitmode 0 is for string initializer "like this" + * arrinitmode 1 is for list initializer {123, 456, 789 ...} + */ + if (arrinitmode == 0) { + --sz; /* Hack to leave space for final null */ + } + for (i = 0; i < sz; ++i) { + if (arrinitmode == 0) { + if (*txtPtr == '"') { + if (type == TYPE_WORD) { + *((int *) bodyptr + i) = 0; + } else { + *((unsigned char *) bodyptr + i) = 0; + } + break; + } else { + if (type == TYPE_WORD) { + *((int *) bodyptr + i) = *txtPtr; + } else { + *((unsigned char *) bodyptr + i) = *txtPtr; + } + } + ++txtPtr; + } else { +#ifdef CBM + if (*txtPtr == ']') { +#else + if (*txtPtr == '}') { +#endif + break; + } + if (eval(0, &val)) { + return 1; + } + if (type == TYPE_WORD) { + *((int *) bodyptr + i) = val; + } else { + *((unsigned char *) bodyptr + i) = val; + } + eatspace(); + if (*txtPtr == ',') { + ++txtPtr; + } + eatspace(); + } + } + if (arrinitmode == 0) { + ++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; + } + } } } @@ -2719,41 +2879,34 @@ unsigned char assignorcreate(unsigned char mode) return RET_ERROR; } - if (eval((mode != FOR_MODE), &j)) { - return RET_ERROR; + eatspace(); + + /* + * 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 ((numdims == 0) || (mode == LET_MODE) || (mode == FOR_MODE)) { + if (eval((mode != FOR_MODE), &j)) { + return RET_ERROR; + } } switch (mode) { case WORD_MODE: - if (i == 0) { - ++i; - } - if (createintvar(name, TYPE_WORD, numdims, i, j, 0)) { - return RET_ERROR; - } - break; - case BYTE_MODE: if (i == 0) { ++i; } - if (createintvar(name, TYPE_BYTE, numdims, i, j, 0)) { + if (createintvar(name, ((mode == WORD_MODE) ? TYPE_WORD : TYPE_BYTE), numdims, i, j, 0)) { return RET_ERROR; } break; case LET_MODE: - if (numdims == 0) { - i = -1; - } - if (setintvar(name, i, j)) { - return RET_ERROR; - } - break; - case FOR_MODE: if (numdims == 0) { - i = -1; + i = -1; } if (setintvar(name, i, j)) { return RET_ERROR; diff --git a/eightball.system b/eightball.system index 3b0c490..3ac59b7 100644 Binary files a/eightball.system and b/eightball.system differ diff --git a/eightballvm b/eightballvm index eabf684..3c6f226 100644 Binary files a/eightballvm and b/eightballvm differ diff --git a/sieve4.8b b/sieve4.8b index 703fc08..14ae3c9 100644 --- a/sieve4.8b +++ b/sieve4.8b @@ -1,12 +1,17 @@ ' Sieve of Eratosthenes -byte A[20*20] = 1 -call doall(20, A) +pr.msg "Sieve of Eratosthenes ..." + +byte A[30*30] = {} +word i = 0 +for i = 0 : 30*30-1 + A[i] = 1 +endfor +call doall(30, A) end sub doall(word nr, byte array[]) word n = nr * nr - pr.msg "Sieve of Eratosthenes ..." pr.msg "nr is "; pr.dec nr; pr.nl call sieve(n, nr, array) call printresults(n, array) @@ -43,5 +48,3 @@ sub printresults(word n, byte AA[]) return 0 endsub - - diff --git a/test.d64 b/test.d64 index cfcb9fb..e5f8d5a 100644 Binary files a/test.d64 and b/test.d64 differ diff --git a/test.dsk b/test.dsk index 7f28192..01ad356 100644 Binary files a/test.dsk and b/test.dsk differ diff --git a/unittest.8b b/unittest.8b index 1021245..4b2b1df 100644 --- a/unittest.8b +++ b/unittest.8b @@ -2,7 +2,9 @@ ' Eightball Unit Tests ' '----------------------' -word status=0 +byte status=0 +word counter=1 +word fails=0 '------------------ ' Word variables @@ -43,7 +45,7 @@ call expect((b1==10)&&(b2==20)&&(b3=='a')) '------------------ pr.msg "Word arrays:"; pr.nl word wpre=0 -word warr[10]=12 +word warr[10]={12,12,12,12,12,12,12,12,12,12} word wpost=0 pr.msg "Size of word (4 for interpeter, 2 for 6502 & VM): " @@ -60,7 +62,7 @@ call expect((wpre==0)&&(warr[0]==12)&&(warr[1]==123)&&(warr[2]==12)&&(warr[9]==1 '------------------ pr.msg "Byte arrays:"; pr.nl byte bpre=0 -byte barr[2*5]=12 +byte barr[2*5]={12,12,12,12,12,12,12,12,12,12} byte bpost=0 call expect((&barr[2]-&barr[1])==1) @@ -238,12 +240,12 @@ call recurse1(5, &iw) call expect(iw==120) pr.msg " Array pass by ref:"; pr.nl -word AA[10]=0 +word AA[10]={} call setwarray(AA, 10) call sumwarray(AA, 10) call expect(iw==45) -byte BB[10]=0 +byte BB[10]={} call setbarray(BB, 10) call sumbarray(BB, 10) call expect(iw==45) @@ -296,6 +298,7 @@ call gp1() call expect(iw==1) '------------------ +call done() '------------------ end @@ -432,7 +435,7 @@ sub pbrsecondlevel(word XX[]) endsub sub wrapper() - word xyz[10]=0 + word xyz[10]={} call pbrfirstlevel(xyz) call expect(xyz[3]==123) endsub @@ -517,12 +520,24 @@ endsub ' Utility subroutines ' sub expect(byte b) + pr.dec counter + pr.msg ": " + counter=counter+1 if b pr.msg " Pass " else pr.msg " FAIL " + fails=fails+1 endif pr.nl return 0 endsub +sub done() + if fails==0 + pr.msg "*** ALL "; pr.dec counter-1; pr.msg " TESTS PASSED ***"; pr.nl + else + pr.msg "*** "; pr.dec fails; pr.ch '/'; pr.dec counter-1; pr.msg " TESTS FAILED ***"; pr.nl + endif +endsub +