From 644111b858a56e86b91333bf00cf5633a54826ca Mon Sep 17 00:00:00 2001 From: Bobbi Webber-Manners Date: Sun, 27 May 2018 16:31:34 -0400 Subject: [PATCH] Copied EightBall sample scripts into subdir. --- 8b-scripts/fact.8b | 17 ++ 8b-scripts/sieve.8b | 52 ++++ 8b-scripts/str.8b | 87 +++++++ 8b-scripts/tetris.8b | 514 +++++++++++++++++++++++++++++++++++++ 8b-scripts/unittest.8b | 559 +++++++++++++++++++++++++++++++++++++++++ 5 files changed, 1229 insertions(+) create mode 100644 8b-scripts/fact.8b create mode 100644 8b-scripts/sieve.8b create mode 100644 8b-scripts/str.8b create mode 100644 8b-scripts/tetris.8b create mode 100644 8b-scripts/unittest.8b diff --git a/8b-scripts/fact.8b b/8b-scripts/fact.8b new file mode 100644 index 0000000..0086602 --- /dev/null +++ b/8b-scripts/fact.8b @@ -0,0 +1,17 @@ +' +' Recursive factorial function test +' + +pr.dec fact(5); 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 + diff --git a/8b-scripts/sieve.8b b/8b-scripts/sieve.8b new file mode 100644 index 0000000..8f8484c --- /dev/null +++ b/8b-scripts/sieve.8b @@ -0,0 +1,52 @@ +' Sieve of Eratosthenes + +pr.msg "Sieve of Eratosthenes ..." + +const sz=30 +const arrsz=sz*sz +byte A[arrsz] = {} +word i = 0 +for i = 0 : arrsz-1 + A[i] = 1 +endfor +call doall(sz, A) +end + +sub doall(word nr, byte array[]) + word n = nr * nr + pr.msg "nr is "; pr.dec nr; pr.nl + call sieve(n, nr, array) + call printresults(n, array) + return 0 +endsub + +sub sieve(word n, word nr, byte AA[]) + pr.msg "Sieve" + word i = 0; word j = 0 + for i = 2 : (nr - 1) + if AA[i] + j = i * i + while (j < n) + AA[j] = 0 + j = j + i + endwhile + endif + endfor + return 0 +endsub + +sub printresults(word n, byte AA[]) + word i = 0 + for i = 2 : (n - 1) + if AA[i] + if i > 2 + pr.msg ", " + endif + pr.dec i + endif + endfor + pr.msg "." + pr.nl + return 0 +endsub + diff --git a/8b-scripts/str.8b b/8b-scripts/str.8b new file mode 100644 index 0000000..2ba0534 --- /dev/null +++ b/8b-scripts/str.8b @@ -0,0 +1,87 @@ + +byte msg1[100]="Enter your first name> " +byte msg2[100]="Enter your last name> " +byte s1[100]={} +byte s2[100]={} +byte full[200]={} +byte space[2]=" " + +pr.str msg1 +kbd.ln s1,100 +pr.msg "'"; pr.str s1; pr.msg "' has "; pr.dec strlen(s1); pr.msg " chars"; pr.nl +pr.str msg2 +kbd.ln s2,100 +pr.msg "'"; pr.str s2; pr.msg "' has "; pr.dec strlen(s2); pr.msg " chars"; pr.nl +call strcpy(full,s1) +call strcat(full,space) +call strcat(full,s2) +pr.msg "'"; pr.str full; pr.msg "' has "; pr.dec strlen(full); pr.msg " chars"; pr.nl +pr.msg "Comparison s1:s2 ... "; pr.dec.s strcmp(s1,s2); pr.nl +end + +' +' Return length of null-terminated string +' +sub strlen(byte str[]) + word i=0 + while str[i] + i=i+1 + endwhile + return i +endsub + +' +' Copy null-terminated string from src to dst +' +sub strcpy(byte dst[], byte src[]) + word i=0 + while src[i] + dst[i]=src[i] + i=i+1 + endwhile +endsub + +' +' Append null-terminated string src to dst +' +sub strcat(byte dst[], byte src[]) + word i=0 + word j=0 + while dst[i] + i=i+1 + endwhile + while src[j] + dst[i]=src[j] + i=i+1 + j=j+1 + endwhile +endsub + +' +' Compare null-terminated string s1 to s2 +' Return -1 if s1 < s2 +' Return 0 if s1 == s2 +' Return +1 if s1 > s2 +' +sub strcmp(byte s1[], byte s2[]) + word i=0 + while 1 + if ((!s1[i])&&(!s2[i])) + return 0 + endif + if (!s1[i]) + return -1 + endif + if (!s2[i]) + return 1 + endif + if (s1[i]s2[i]) + return 1 + endif + i=i+1 + endwhile +endsub + diff --git a/8b-scripts/tetris.8b b/8b-scripts/tetris.8b new file mode 100644 index 0000000..67f33fd --- /dev/null +++ b/8b-scripts/tetris.8b @@ -0,0 +1,514 @@ +' Apple II Low Res Tetris +' Bobbi 2018 + +word addrs[24]={$400,$480,$500,$580,$600,$680,$700,$780,$428,$4a8,$528,$5a8,$628,$6a8,$728,$7a8,$450,$4d0,$550,$5d0,$650,$6d0,$750,$7d0} + +' Size of playfield +const lhs=14 +const rhs=lhs+11 +const top=10 +const bttm=top+22 + +const strow=8 +const stcol=18 + +' Apple II specific addresses +const spkr=$c030 +const kbdata=$c000 +const kbstrb=$c010 +const hpos=36 +const rnd=$4e + +' ASCII +const beep=7 +const clrscr=12 + +' Position of piece +byte col=stcol +byte row=strow +byte rot=0 + +' Previous col, row, rotation +byte ocol=stcol +byte orow=strow +byte orot=0 + +byte key=0 +byte piece=0 +byte done=0 +word score=0 + +' Seed the PRNG +word rr=$4e + +' Left, right, rotate permitted? +byte lok=1 +byte rok=1 +byte rotok=1 + +' First run +byte first=1 + +call prng() +piece=rr%5 +call loresmix() +while 1 + score=0 + pr.ch clrscr + call clrlomix() + call frame() + call printnewlines() + if first + call printintro() + kbd.ch &key + call clearintro() + first=0 + endif + call printtext() + call printscore() + call playgame() + kbd.ch &key +endwhile +end + +sub playgame() + while 1 + key=getkey() + orow=row;ocol=col;orot=rot + if key=='s'&&rotok + if rot==3 + rot=0 + else + rot=rot+1 + endif + else + if (key=='a')&&lok + col=col-1 + else + if (key=='d')&&rok + col=col+1 + else + if key=='p' + while getkey()==0 + endwhile + endif + endif + endif + endif + key=^spkr + row=row+1 + lok=1 + rok=1 + rotok=1 + call drawPiece(ocol,orow,orot,1); 'Erase + if drawPiece(col,row,rot,0) + if row==strow+1 + call loser() + return 0 + else + call checkframe(row) + col=stcol;row=strow;rot=0 + call prng() + piece=rr%5 + endif + endif + endwhile +endsub + +sub getkey() + if ^kbdata<128 + return 0 + endif + ^kbstrb=0 + return ^kbdata +endsub + +sub lores() + ^$c050=0 + ^$c052=0 + ^$c054=0 + ^$c056=0 +endsub + +sub loresmix() + ^$c050=0 + ^$c053=0 + ^$c054=0 + ^$c056=0 +endsub + +sub text() + ^$c051=0 + ^$c054=0 +endsub + +sub clrlo() + byte r=0 + byte c=0 + for r=0:23 + for c=0:39 + ^(addrs[r]+c)=0 + endfor + endfor +endsub + +sub clrlomix() + byte r=0 + byte c=0 + for r=0:19 + for c=0:39 + ^(addrs[r]+c)=0 + endfor + endfor + for r=20:23 + for c=0:39 + ^(addrs[r]+c)=' '+128 + endfor + endfor +endsub + +sub plot(byte c,byte r,byte color) + word a=addrs[r/2]+c + if r%2 + ^a=(^a&$0f)|(color<<4) + else + ^a=(^a&$f0)|color + endif +endsub + +sub readpix(byte c,byte r) + word a=addrs[r/2]+c + if r%2 + return (^a&$f0)>>4 + else + return ^a&$0f + endif +endsub + +sub hlin(byte c1,byte c2,byte r,byte color) + byte i=0 + for i=c1:c2 + call plot(i,r,color) + endfor +endsub + +sub vlin(byte c,byte r1,byte r2,byte color) + byte i=0 + for i=r1:r2 + call plot(c,i,color) + endfor +endsub + +sub frame() + call hlin(lhs,rhs,bttm,4) + call vlin(lhs,top,bttm,4) + call vlin(rhs,top,bttm,4) +endsub + +sub drawPiece(byte c,byte r,byte rot,byte erase) + if piece==0 + return drawT(c,r,rot,erase) + else; if piece==1 + return drawL(c,r,rot,erase) + else; if piece==2 + return drawZ(c,r,rot,erase) + else; if piece==3 + return drawSq(c,r,rot,erase) + else + return drawI(c,r,rot,erase) + endif;endif;endif;endif +endsub + +sub drawT(byte c,byte r,byte rot,byte erase) + byte color=1 + if erase + color=0 + endif + if rot==0 + call plot(c,r+1,color) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + call plot(c+1,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c,r+3)) + rok=!(readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+2,r+3)) + rotok=!(readpix(c,r+2)||readpix(c+1,r+3)) + return readpix(c,r+2)||readpix(c+1,r+3)||readpix(c+2,r+2) + else + if rot==1 + call plot(c+1,r,color) + call plot(c,r+1,color) + call plot(c+1,r+1,color) + call plot(c+1,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c,r+3)) + rok=!(readpix(c+2,r+1)||readpix(c+2,r+2)||readpix(c+2,r+3)) + rotok=!(readpix(c,r+2)||readpix(c+2,r+2)) + return readpix(c,r+2)||readpix(c+1,r+3) + else + if rot==2 + call plot(c+1,r,color) + call plot(c,r+1,color) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + if erase + return 0 + endif + lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c+1,r+2)) + rok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+3,r+2)) + rotok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+1,r+3)) + return readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+2,r+2) + else + if rot==3 + call plot(c+1,r,color) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + call plot(c+1,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c,r+3)) + rok=!(readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+2,r+3)) + rotok=!(readpix(c,r+2)||readpix(c+2,r+2)||readpix(c+1,r+3)) + return readpix(c+1,r+3)||readpix(c+2,r+2) + endif + endif + endif + endif +endsub + +sub drawL(byte c,byte r,byte rot,byte erase) + byte color=8 + if erase + color=0 + endif + if rot==0 + call plot(c+1,r,color) + call plot(c+1,r+1,color) + call plot(c+1,r+2,color) + call plot(c+2,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c,r+3)||readpix(c+1,r+3)) + rok=!(readpix(c+2,r+1)||readpix(c+2,r+3)||readpix(c+3,r+3)) + rotok=!(readpix(c,r+2)||readpix(c+2,r+1)) + return readpix(c+1,r+3)||readpix(c+2,r+3) + else + if rot==1 + call plot(c+2,r,color) + call plot(c,r+1,color) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + if erase + return 0 + endif + lok=!(readpix(c-1,r+2)||readpix(c,r+2)||readpix(c+1,r+2)) + rok=!(readpix(c+1,r+2)||readpix(c+2,r+2)||readpix(c+3,r+2)||readpix(c+3,r+1)) + rotok=!(readpix(c+2,r+2)||readpix(c+2,r+3)) + return readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+2,r+2) + else + if rot==2 + call plot(c+1,r,color) + call plot(c+2,r,color) + call plot(c+2,r+1,color) + call plot(c+2,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c,r+1)||readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+1,r+3)) + rok=!(readpix(c+3,r+1)||readpix(c+3,r+2)||readpix(c+3,r+3)) + rotok=!(readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+3,r+1)) + return readpix(c+1,r+1)||readpix(c+2,r+3) + else + if rot==3 + call plot(c+1,r,color) + call plot(c+2,r,color) + call plot(c+3,r,color) + call plot(c+1,r+1,color) + if erase + return 0 + endif + lok=!(readpix(c,r+1)||readpix(c,r+2)) + rok=!(readpix(c+2,r+1)||readpix(c+3,r+1)||readpix(c+4,r+1)||readpix(c+2,r+2)) + rotok=!(readpix(c+2,r+1)||readpix(c+2,r+2)||readpix(c+2,r+3)||readpix(c+3,r+3)) + return readpix(c+1,r+2)||readpix(c+2,r+1)||readpix(c+3,r+1) + endif + endif + endif + endif +endsub + +sub drawZ(byte c,byte r,byte rot,byte erase) + byte color=2 + if erase + color=0 + endif + if (rot==0)||(rot==2) + call plot(c+1,r,color) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + call plot(c+2,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c,r+1)||readpix(c,r+2)||readpix(c+1,r+2)||readpix(c+1,r+3)) + rok=!(readpix(c+3,r+2)||readpix(c+3,r+3)) + rotok=!(readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+1,r+2)) + return readpix(c+1,r+2)||readpix(c+2,r+3) + else + if (rot==1)||(rot==3) + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + call plot(c,r+2,color) + call plot(c+1,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c-1,r+3)||readpix(c,r+3)||readpix(c+2,r+2)) + rok=!(readpix(c+1,r+3)||readpix(c+2,r+3)||readpix(c+2,r+2)||readpix(c+3,r+2)) + rotok=!(readpix(c+2,r+2)||readpix(c+2,r+3)) + return readpix(c,r+3)||readpix(c+1,r+3) + endif + endif +endsub + +sub drawI(byte c,byte r,byte rot,byte erase) + byte color=14 + if erase + color=0 + endif + if (rot==0)||(rot==2) + call plot(c,r+2,color) + call plot(c+1,r+2,color) + call plot(c+2,r+2,color) + call plot(c+3,r+2,color) + if erase + return 0 + endif + lok=!readpix(c-1,r+3) + rok=!readpix(c+4,r+3) + rotok=!(readpix(c+2,r+3)||readpix(c+2,r+4)) + return readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+2,r+3)||readpix(c+3,r+3) + else + if (rot==1)||(rot==3) + call plot(c+2,r,color) + call plot(c+2,r+1,color) + call plot(c+2,r+2,color) + call plot(c+2,r+3,color) + if erase + return 0 + endif + lok=!(readpix(c+1,r+1)||readpix(c+1,r+2)||readpix(c+1,r+3)||readpix(c+1,r+4)) + rok=!(readpix(c+3,r+1)||readpix(c+3,r+2)||readpix(c+3,r+3)||readpix(c+3,r+4)) + rotok=!(readpix(c,r+3)||readpix(c+1,r+3)||readpix(c+3,r+3)) + return readpix(c+2,r+4) + endif + endif +endsub + +sub drawSq(byte c,byte r,byte rot,byte erase) + byte color=13 + if erase + color=0 + endif + call plot(c+1,r+1,color) + call plot(c+2,r+1,color) + call plot(c+1,r+2,color) + call plot(c+2,r+2,color) + if erase + return 0 + endif + lok=!(readpix(c,r+2)||readpix(c,r+3)) + rok=!(readpix(c+3,r+2)||readpix(c+3,r+3)) + rotok=1 + return readpix(c+1,r+3)||readpix(c+2,r+3) +endsub + +sub checkframe(byte r) + byte rr=r+3 + if rr>bttm-1 + rr=bttm-1 + endif + while rr>=r + if checkline(rr) + pr.ch beep + else + rr=rr-1 + endif + endwhile +endsub + +sub checkline(byte r) + byte c=0 + for c=lhs+1:rhs-1 + if !readpix(c,r) + return 0 + endif + endfor + call deleterow(r) + score=score+1 + call printscore() + return 1 +endsub + +sub deleterow(byte r) + byte i=r + byte c=0 + byte v=0 + byte empty=0 + while (i>top+1)&&(!empty) + empty=1 + for c=lhs+1:rhs-1 + v=readpix(c,i-1) + if v + empty=0 + endif + call plot(c,i,v) + endfor + i=i-1 + endwhile +endsub + +sub printnewlines() + byte i=0 + for i=0:19 + pr.nl + endfor +endsub + +sub printintro() + ^hpos=10 + pr.msg "TETRIS - PRESS ANY KEY" +endsub + +sub clearintro() + ^hpos=10 + pr.msg " " +endsub + +sub printtext() + ^hpos=10 + pr.msg "SCORE: " +endsub + +sub printscore() + ^hpos=17 + pr.dec score + pr.msg " " +endsub + +sub loser() + ^hpos=10 + pr.msg "GAME OVER - SCORE WAS " + pr.dec score +endsub + +sub prng() + rr=rr*8191+7; ' Mersenne prime +endsub + diff --git a/8b-scripts/unittest.8b b/8b-scripts/unittest.8b new file mode 100644 index 0000000..891856b --- /dev/null +++ b/8b-scripts/unittest.8b @@ -0,0 +1,559 @@ +'----------------------' +' Eightball Unit Tests ' +'----------------------' + +byte status=0 +word counter=1 +word fails=0 + +'------------------ +' Word variables +'------------------ +pr.msg "Word 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) + +'------------------ +' Byte variables +'------------------ +pr.msg "Byte 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')) + +'------------------ +' Word arrays +'------------------ +pr.msg "Word arrays:"; pr.nl +word wpre=0 +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): " +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[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)) + +'------------------ +' 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) + +call noret() +call expect(iw==9876) + +'------------------ +' 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) + +pr.msg " Recursive:"; pr.nl +call recurse1(5, &iw) +call expect(iw==120) + +pr.msg " Array pass by ref:"; pr.nl +word AA[10]={} +call setwarray(AA, 10) +call sumwarray(AA, 10) +call expect(iw==45) + +byte BB[10]={} +call setbarray(BB, 10) +call sumbarray(BB, 10) +call expect(iw==45) + +call pbrfirstlevel(AA) +call expect(AA[3]==123) + +call wrapper() + +'------------------ +' Invoke func +'------------------ +pr.msg "Invoke func:"; pr.nl +call expect(sqr(10)==100) + +pr.msg " Recursive:"; pr.nl +iw=recurse2(5) +call expect(iw==5*4*3*2) + +iw=recurse3(5) +call expect(iw==5*4*3*2) + +'------------------ +' 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) + +'------------------ +' Consts +'------------------ +pr.msg "Consts:"; pr.nl +const cstsz=10 +word AAA[cstsz]={} +byte iii=0 +word summ=0 +for iii=0:cstsz-1 + AAA[iii]=10 +endfor +for iii=0:cstsz-1 + summ=summ+AAA[iii] +endfor +call expect(summ==cstsz*10) + +'------------------ +call done() +'------------------ + +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 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 A[], word len) + word i=0 + for i=0:len-1 + A[i] = i + endfor +endsub + +sub sumwarray(word A[], word len) + word i=0 + iw=0 + for i=0:len-1 + iw=iw+A[i] + endfor +endsub + +sub setbarray(byte A[], word len) + word i=0 + for i=0:len-1 + A[i] = i + endfor +endsub + +sub sumbarray(byte A[], word len) + word i=0 + iw=0 + for i=0:len-1 + iw=iw+A[i] + endfor +endsub + +sub pbrfirstlevel(word XX[]) + call pbrsecondlevel(XX) +endsub + +sub pbrsecondlevel(word XX[]) + byte i=0 + for i=0:9 + XX[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 + +' Why 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 + +' +' 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 +