diff --git a/8ball20.prg b/8ball20.prg index c6bb003..6ae8bdf 100644 Binary files a/8ball20.prg and b/8ball20.prg differ diff --git a/8ball64.prg b/8ball64.prg index 6f35ce0..fa85939 100644 Binary files a/8ball64.prg and b/8ball64.prg differ diff --git a/8ballvm20.prg b/8ballvm20.prg index 5638532..406a1a4 100644 Binary files a/8ballvm20.prg and b/8ballvm20.prg differ diff --git a/8ballvm64.prg b/8ballvm64.prg index c137e32..12d2b6f 100644 Binary files a/8ballvm64.prg and b/8ballvm64.prg differ diff --git a/ebvm.system b/ebvm.system index 0588b55..c3cf0c9 100644 Binary files a/ebvm.system and b/ebvm.system differ diff --git a/eightball.c b/eightball.c index d64cec4..fb7961d 100644 --- a/eightball.c +++ b/eightball.c @@ -1893,19 +1893,21 @@ 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); +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 st_abs_byte(int i) { - emitldi(rtSP + 1 + i); - emit(VM_STABYTE); +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) * @@ -1933,7 +1935,7 @@ unsigned char createintvar(char *name, int i; int val; var_t *v; - unsigned char arrinitmode = 0; /* 0 means string initializer, 1 means list initializer */ + unsigned char arrinitmode; /* STRG_INIT means string initializer, LIST_INIT means list initializer */ unsigned char local = 1; v = findintvar(name, &local); /* Only search local scope */ @@ -2009,14 +2011,14 @@ unsigned char createintvar(char *name, */ if (numdims != 0) { if (*txtPtr == '"') { - arrinitmode = 0; + arrinitmode = STRG_INIT; ++txtPtr; #ifdef CBM } else if (*txtPtr == '[') { #else } else if (*txtPtr == '{') { #endif - arrinitmode = 1; + arrinitmode = LIST_INIT; ++txtPtr; } } @@ -2062,16 +2064,16 @@ unsigned char createintvar(char *name, /* * Initialize array - * arrinitmode 0 is for string initializer "like this" - * arrinitmode 1 is for list initializer {123, 456, 789 ...} + * arrinitmode STRG_INIT is for string initializer "like this" + * arrinitmode LIST_INIT is for list initializer {123, 456, 789 ...} */ - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { --sz; /* Hack to leave space for final null */ } for (i = 0; i < sz; ++i) { - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { emitldi((*txtPtr == '"') ? 0 : *txtPtr); - ((type == TYPE_WORD) ? st_abs_word(i) : st_abs_byte(i)); + ((type == TYPE_WORD) ? civ_st_rel_word(i) : civ_st_rel_byte(i)); if (*txtPtr == '"') { break; } @@ -2087,7 +2089,7 @@ unsigned char createintvar(char *name, if (eval(0, &val)) { return 1; } - ((type == TYPE_WORD) ? st_abs_word(i) : st_abs_byte(i)); + ((type == TYPE_WORD) ? civ_st_rel_word(i) : civ_st_rel_byte(i)); eatspace(); if (*txtPtr == ',') { ++txtPtr; @@ -2095,7 +2097,7 @@ unsigned char createintvar(char *name, eatspace(); } } - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { ++sz; /* Reverse the hack we perpetuated above */ if (*txtPtr == '"') { ++txtPtr; @@ -2126,53 +2128,45 @@ unsigned char createintvar(char *name, /* * Initialize array - * arrinitmode 0 is for string initializer "like this" - * arrinitmode 1 is for list initializer {123, 456, 789 ...} + * arrinitmode STRG_INIT is for string initializer "like this" + * arrinitmode LIST_INIT is for list initializer {123, 456, 789 ...} */ - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { --sz; /* Hack to leave space for final null */ } for (i = 0; i < sz; ++i) { - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { if (*txtPtr == '"') { - if (type == TYPE_WORD) { - *((int *) bodyptr + i) = 0; - } else { - *((unsigned char *) bodyptr + i) = 0; - } - break; + val = 0; } else { - if (type == TYPE_WORD) { - *((int *) bodyptr + i) = *txtPtr; - } else { - *((unsigned char *) bodyptr + i) = *txtPtr; - } + val = *txtPtr; + ++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; + val =0; } else { - *((unsigned char *) bodyptr + i) = val; + if (eval(0, &val)) { + return 1; + } + eatspace(); + if (*txtPtr == ',') { + ++txtPtr; + } + eatspace(); } - eatspace(); - if (*txtPtr == ',') { - ++txtPtr; - } - eatspace(); + } + if (type == TYPE_WORD) { + *((int *) bodyptr + i) = val; + } else { + *((unsigned char *) bodyptr + i) = val; } } - if (arrinitmode == 0) { + if (arrinitmode == STRG_INIT) { ++sz; /* Reverse the hack we perpetuated above */ if (*txtPtr == '"') { ++txtPtr; @@ -2273,6 +2267,20 @@ void vars_deletecallframe() } } +/* 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)); +} + /* * Set existing integer variable * name is the variable name @@ -2286,6 +2294,7 @@ void vars_deletecallframe() unsigned char setintvar(char *name, int idx, int value) { unsigned char numdims; + unsigned char type; void *bodyptr; unsigned char local = 0; @@ -2296,6 +2305,7 @@ unsigned char setintvar(char *name, int idx, int value) return 1; } numdims = (ptr->type & 0xf0) >> 4; + type = ptr->type & 0x0f; if (numdims == 0) { /* @@ -2315,21 +2325,13 @@ unsigned char setintvar(char *name, int idx, int value) * to the frame pointer. */ emitldi(*getptrtoscalarword(ptr)); - if ((ptr->type & 0x0f) == TYPE_WORD) { - if (local && compilingsub) { - emit(VM_STRWORD); - } else { - emit(VM_STAWORD); - } + if (local && compilingsub) { + siv_st_rel(type); } else { - if (local && compilingsub) { - emit(VM_STRBYTE); - } else { - emit(VM_STABYTE); - } + siv_st_abs(type); } } else { - if ((ptr->type & 0x0f) == TYPE_WORD) { + if (type == TYPE_WORD) { *getptrtoscalarword(ptr) = value; } else { *getptrtoscalarbyte(ptr) = value; @@ -2347,57 +2349,37 @@ unsigned char setintvar(char *name, int idx, int value) bodyptr = (void *) *(int *) ((unsigned char *) ptr + sizeof(var_t)); if (compile) { - /* *** Index is on the stack (Y), and initializer is on the stack (X) *** */ + /* *** Index is on the stack (X) */ emit(VM_SWAP); - if ((ptr->type & 0x0f) == TYPE_WORD) { + 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. - */ + } + 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) { - emit(VM_LDRWORD); + siv_st_abs(type); + } else { + siv_st_rel(type); } - emit(VM_ADD); - if (local && compilingsub) { - if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) { - emit(VM_STAWORD); - } else { - emit(VM_STRWORD); - } - } else { - emit(VM_STAWORD); - } } else { - 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) { - emit(VM_STABYTE); - } else { - emit(VM_STRBYTE); - } - } else { - emit(VM_STABYTE); - } + siv_st_abs(type); } } else { if ((idx < 0) || (idx >= *(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)))) { error(ERR_SUBSCR); return 1; } - if ((ptr->type & 0x0f) == TYPE_WORD) { + if (type == TYPE_WORD) { *((int *) bodyptr + idx) = value; } else { *((unsigned char *) bodyptr + idx) = value; @@ -2411,6 +2393,20 @@ unsigned char setintvar(char *name, int idx, int value) /* Special hack ... */ unsigned char compiletimelookup = 0; +/* Factored out to save a few bytes + * Used by getintvar() only. + */ +void giv_ld_abs(unsigned char type) { + ((type == 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 == TYPE_WORD) ? emit(VM_LDRWORD) : emit(VM_LDRBYTE)); +} + /* * Get existing integer variable * name is the variable name @@ -2439,11 +2435,7 @@ unsigned char getintvar(char *name, return 1; } numdims = (ptr->type & 0xf0) >> 4; - if ((ptr->type & 0x0f) == TYPE_WORD) { - *type = TYPE_WORD; - } else { - *type = TYPE_BYTE; - } + *type = (ptr->type & 0x0f); if (numdims == 0) { /* @@ -2476,27 +2468,16 @@ unsigned char getintvar(char *name, emit(VM_RTOA); } } else { - if ((ptr->type & 0x0f) == TYPE_WORD) { - if (local && compilingsub) { - emitldi(*getptrtoscalarword(ptr)); - emit(VM_LDRWORD); - } else { - emitldi(*getptrtoscalarword(ptr)); - emit(VM_LDAWORD); - } + emitldi(*getptrtoscalarword(ptr)); + if (local && compilingsub) { + giv_ld_rel(*type); } else { - if (local && compilingsub) { - emitldi(*getptrtoscalarword(ptr)); - emit(VM_LDRBYTE); - } else { - emitldi(*getptrtoscalarword(ptr)); - emit(VM_LDABYTE); - } + giv_ld_abs(*type); } } } } else { - if ((ptr->type & 0x0f) == TYPE_WORD) { + if (*type == TYPE_WORD) { if (address) { *val = (int) getptrtoscalarword(ptr); } else { @@ -2531,74 +2512,47 @@ unsigned char getintvar(char *name, if (compile) { /* *** Index is on the stack (X) *** */ - if ((ptr->type & 0x0f) == TYPE_WORD) { + 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 (!address) { - if (local && compilingsub) { - if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) == -1) { - emit(VM_LDAWORD); - } else { - emit(VM_LDRWORD); - } - } else { - emit(VM_LDAWORD); - } - } else { - if (local && compilingsub) { - if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) != -1) { - /* Convert to absolute address */ - emit(VM_RTOA); - } + } + 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) { + print("PASS BY REF\n"); + giv_ld_abs(*type); + } else { + print("REL\n"); + giv_ld_rel(*type); } - } - } else { - 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) { - emit(VM_LDABYTE); - } else { - emit(VM_LDRBYTE); - } - } else { - emit(VM_LDABYTE); - } - } else { - if (local && compilingsub) { - if (*(int *) ((unsigned char *) ptr + sizeof(var_t) + sizeof(int)) != -1) { - /* Convert to absolute address */ - emit(VM_RTOA); - } + } 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 ((ptr->type & 0x0f) == TYPE_WORD) { + if (*type == TYPE_WORD) { if (address) { *val = (int) ((int *) bodyptr + idx); } else { diff --git a/eightball.system b/eightball.system index d70477d..de6ea19 100644 Binary files a/eightball.system and b/eightball.system differ diff --git a/eightballutils.h b/eightballutils.h index 83daa4f..d5e52d7 100644 --- a/eightballutils.h +++ b/eightballutils.h @@ -37,7 +37,7 @@ /* */ /**************************************************************************/ -#define VERSIONSTR "0.64" +#define VERSIONSTR "0.65" void print(char *str); diff --git a/eightballvm b/eightballvm index ac386d9..a0bbc31 100644 Binary files a/eightballvm and b/eightballvm differ diff --git a/test.d64 b/test.d64 index 4a9dd1d..8c012ba 100644 Binary files a/test.d64 and b/test.d64 differ diff --git a/test.dsk b/test.dsk index b596f2f..c123540 100644 Binary files a/test.dsk and b/test.dsk differ diff --git a/unittest.8bp b/unittest.8bp new file mode 100644 index 0000000..4fbee36 --- /dev/null +++ b/unittest.8bp @@ -0,0 +1,543 @@ +'----------------------' +' ÅIGHTBALL ÕNIT ÔESTS ' +'----------------------' + +BYTE STATUS=0 +WORD COUNTER=1 +WORD FAILS=0 + +'------------------ +' ×ORD VARIABLES +'------------------ +PR.MSG "×ORD VARS:"; PR.NL +WORD W1=10 +WORD W2=100 +WORD W3=50 +W1=10 +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) + +'------------------ +' ÂYTE VARIABLES +'------------------ +PR.MSG "ÂYTE VARS:"; PR.NL +BYTE B1=10; +BYTE B2=100; +WORD B3='A'; +CALL EXPECT((B1==10)&&(B2==100)&&(B3=='A')) + +B2=B2+10 +CALL EXPECT((B1==10)&&(B2==110)&&(B3=='A')) + +B2=B1+10 +CALL EXPECT((B1==10)&&(B2==20)&&(B3=='A')) + +'------------------ +' ×ORD ARRAYS +'------------------ +PR.MSG "×ORD ARRAYS:"; PR.NL +WORD WPRE=0 +WORD WARR[10]={12,12,12,12,12,12,12,12,12,12} +WORD WPOST=0 + +PR.MSG "ÓIZE OF WORD (4 FOR INTERPETER, 2 FOR 6502 & ÖÍ): " +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)) + +'------------------ +' ÂYTE ARRAYS +'------------------ +PR.MSG "ÂYTE ARRAYS:"; PR.NL +BYTE BPRE=0 +BYTE BARR[2*5]={12,12,12,12,12,12,12,12,12,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)) + +'------------------ +' ÆOR LOOP +'------------------ +PR.MSG "ÆOR 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) + +'------------------ +' ×HILE LOOP +'------------------ +PR.MSG "×HILE 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) + +'------------------ +' ÉF/ÅNDIF +'------------------ +PR.MSG "ÉF/ÅNDIF:"; 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) + +'------------------ +' ÉF/ÅLSE/ÅNDIF +'------------------ +PR.MSG "ÉF/ÅLSE/ÅNDIF:"; 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) + +'------------------ +' ÐOINTERS/ÁDDRESSES +'------------------ +PR.MSG "ÐOINTERS/ÁDDRESSES:"; PR.NL + +WORD PTR=&IW +*PTR=9999 +CALL EXPECT(IW==9999) + +PTR=&IB +^PTR=73 +CALL EXPECT(IB==73) + +CALL EXPECT(&WARR[0]==&WARR) + +'------------------ +' ÃALL SUBROUTINE +'------------------ +PR.MSG "ÃALL 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) + +CALL NORET() +CALL EXPECT(IW==9876) + +'------------------ +' ÓUBROUTINE PARAMS +'------------------ +PR.MSG "ÓUB 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) + +PR.MSG " ÒECURSIVE:"; PR.NL +CALL RECURSE1(5, &IW) +CALL EXPECT(IW==120) + +PR.MSG " ÁRRAY PASS BY REF:"; PR.NL +WORD ÁÁ[10]={} +CALL SETWARRAY(ÁÁ, 10) +CALL SUMWARRAY(ÁÁ, 10) +CALL EXPECT(IW==45) + +BYTE ÂÂ[10]={} +CALL SETBARRAY(ÂÂ, 10) +CALL SUMBARRAY(ÂÂ, 10) +CALL EXPECT(IW==45) + +CALL PBRFIRSTLEVEL(ÁÁ) +CALL EXPECT(ÁÁ[3]==123) + +CALL WRAPPER() + +'------------------ +' ÉNVOKE FUNC +'------------------ +PR.MSG "ÉNVOKE FUNC:"; PR.NL +CALL EXPECT(SQR(10)==100) + +PR.MSG " ÒECURSIVE:"; PR.NL +IW=RECURSE2(5) +CALL EXPECT(IW==5*4*3*2) + +IW=RECURSE3(5) +CALL EXPECT(IW==5*4*3*2) + +'------------------ +' ÌOCALS +'------------------ +PR.MSG "ÌOCALS:"; 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) + +'------------------ +CALL DONE() +'------------------ + +END + +' +' ÔEST SUBROUTINES +' +SUB GV1() + IW = 987; ' ÓET GLOBAL WORD + RETURN 0 +ENDSUB + +SUB GB1() + IB = $AE; ' ÓET GLOBAL BYTE + RETURN 0 +ENDSUB + +SUB GWA1() + WARR[3] = 1234; ' ÓET GLOBAL WORD ARRAY MEMBER + RETURN 0 +ENDSUB + +SUB GBA1() + BARR[7] = $34; ' ÓET 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 NORET() + IW = 9876 +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 SETWARRAY(WORD Á[], WORD LEN) + WORD I=0 + FOR I=0:LEN-1 + Á[I] = I + ENDFOR +ENDSUB + +SUB SUMWARRAY(WORD Á[], WORD LEN) + WORD I=0 + IW=0 + FOR I=0:LEN-1 + IW=IW+Á[I] + ENDFOR +ENDSUB + +SUB SETBARRAY(BYTE Á[], WORD LEN) + WORD I=0 + FOR I=0:LEN-1 + Á[I] = I + ENDFOR +ENDSUB + +SUB SUMBARRAY(BYTE Á[], WORD LEN) + WORD I=0 + IW=0 + FOR I=0:LEN-1 + IW=IW+Á[I] + ENDFOR +ENDSUB + +SUB PBRFIRSTLEVEL(WORD ØØ[]) + CALL PBRSECONDLEVEL(ØØ) +ENDSUB + +SUB PBRSECONDLEVEL(WORD ØØ[]) + BYTE I=0 + FOR I=0:9 + ØØ[I]=123 + ENDFOR +ENDSUB + +SUB WRAPPER() + WORD XYZ[10]={} + CALL PBRFIRSTLEVEL(XYZ) + CALL EXPECT(XYZ[3]==123) +ENDSUB + +SUB RECURSE2(WORD X) + IF X==0 + RETURN 1; + ELSE + RETURN RECURSE2(X-1)*X + ENDIF +ENDSUB + +' ×HY DOES THIS NOT WORK, EVEN THOUGH +' RECURSE2() WORKS FINE?? +SUB RECURSE3(WORD X) + IF X==0 + RETURN 1; + ELSE + RETURN X*RECURSE3(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 + +' +' ÕTILITY SUBROUTINES +' +SUB EXPECT(BYTE B) + PR.DEC COUNTER + PR.MSG ": " + COUNTER=COUNTER+1 + IF B + PR.MSG " ÐASS " + ELSE + PR.MSG " ÆÁÉÌ " + FAILS=FAILS+1 + ENDIF + PR.NL + RETURN 0 +ENDSUB + +SUB DONE() + IF FAILS==0 + PR.MSG "*** ÁÌÌ "; PR.DEC COUNTER-1; PR.MSG " ÔÅÓÔÓ ÐÁÓÓÅÄ ***"; PR.NL + ELSE + PR.MSG "*** "; PR.DEC FAILS; PR.CH '/'; PR.DEC COUNTER-1; PR.MSG " ÔÅÓÔÓ ÆÁÉÌÅÄ ***"; PR.NL + ENDIF +ENDSUB +