From: Dan White Date: Thu, 16 May 2013 19:19:22 +0000 (-0500) Subject: msp4th: more opcode co-simulation tests, none should FAIL X-Git-Tag: cheetah~64 X-Git-Url: http://git.whiteaudio.com/gitweb/?a=commitdiff_plain;h=be2e72590065131f31e796ae479b8f8d1ac0d350;p=430.git msp4th: more opcode co-simulation tests, none should FAIL --- diff --git a/msp4th/cosim.py b/msp4th/cosim.py index e8c4192..65ca27b 100644 --- a/msp4th/cosim.py +++ b/msp4th/cosim.py @@ -29,7 +29,7 @@ def cleanup(): pc.close(force=True) -def print_side(a, b): +def print_side(a, b, compare=True): alines = [x.rstrip() for x in a.split('\n')] blines = [x.rstrip() for x in b.split('\n')] @@ -40,9 +40,8 @@ def print_side(a, b): blines.extend([''] * max(alen - blen, 0)) for (aline, bline) in zip(alines, blines): - if aline == bline: - eq = '=' - else: + eq = '=' + if compare and aline != bline: eq = '!' s = '%-80s %s %-80s' % (aline, eq, bline) @@ -64,8 +63,11 @@ try: # side-by-side output prompt(atoi) prompt(pc) - print_side(' '.join(atoi.args), ' '.join(pc.args)) + print_side(' '.join(atoi.args), ' '.join(pc.args), False) for line in open('tests.4th'): + if line.startswith('bye'): + break + s = line.rstrip() s += '\r' diff --git a/msp4th/tests.4th b/msp4th/tests.4th index 77951e3..818da84 100644 --- a/msp4th/tests.4th +++ b/msp4th/tests.4th @@ -1,7 +1,231 @@ \ vim: ft=forth -: fail ( -- ) 0x46 emit 0x41 emit 0x49 emit 0x4c emit cr ; -: star ( -- ) 0x2a emit ; -: ( -- ) 0x20 emit ; -: cmp ( a b -- ) == not if fail then ; -: tloop do i star . cr loop ; +: .. + dup . ; +: fail ( -- ) + 0x46 emit 0x41 emit 0x49 emit 0x4c emit cr ; +: cmp ( a b -- ) + == not if fail s. then ; +: scmp ( x*2n n -- ) \ verify stack contents match + 0 swap do + i roll cmp + -1 +loop ; +5 6 7 8 5 6 7 8 4 scmp + + +\ case 2: // + ( a b -- a+b ) +32767 1 + +-32768 cmp + +\ case 3: // - ( a b -- a-b ) +-32768 1 - +32767 cmp + +\ case 4: // * ( a b -- reshi reslo ) +32767 1 * +0 32767 2 scmp + +\ case 5: // /% ( a b -- a/b a%b ) +1000 3 /% +333 1 2 scmp + +\ case 6: // . ( a -- ) +0x8000 . +depth 0 cmp + +\ case 7: // dup ( a -- a a ) +42 dup +42 42 2 scmp + +\ case 8: // drop ( a -- ) +15 16 drop +15 cmp + +\ case 9: // swap ( a b -- b a ) +99 100 swap +100 99 2 scmp + +\ case 10: // < ( a b -- a ( a b -- a>b ) +1 2 > +0 cmp + +-1 -2 > +1 cmp + +\ case 12: // == ( a b -- a==b ) +1 dup == +1 cmp + +53 64 == +0 cmp + +\ case 13: // hb. ( a -- ) +: hw2b dup 8 0 do /2 loop hb. hb. ; +0xabcd hw2b + +\ case 14: // gw ( -- ) \ get word from input +: test-gw gw pwrd ; +test-gw theword + +\ case 15: // dfn ( -- ) \ create opcode and store word to cmdList +? + +\ case 16: // abs ( a -- |a| ) \ -32768 is unchanged +-32768 abs +-32768 cmp + +1 abs +1 cmp + +-1 abs +1 cmp + +\ case 17: // , ( opcode -- ) \ push opcode to prog space +20056 , +h@ 1 - p@ +20056 cmp + +\ case 18: // p@ ( opaddr -- opcode ) +\ case 19: // p! ( opcode opaddr -- ) +20006 h@ p! +h@ p@ +20006 cmp + +\ case 20: // not ( a -- !a ) \ logical not +1 not +0 cmp + +-1 not +0 cmp + +0 not +1 cmp + +\ case 21: // list ( -- ) \ show defined words +list + +\ case 22: // if ( flag -- ) +: if-not ( flag -- !flag ) + if push0 else push 1 then ; +1 if-not +0 cmp + +0 if-not +1 cmp + +\ case 25: // begin ( -- ) ( -a- pcnt ) +\ case 26: // until ( flag -- ) ( addr -a- ) +: test-begin-until ( n -- ) + push0 + swap + begin + push1 - .. + swap .. cr push1 + swap + dup push0 == + until drop drop ; +20 test-begin-until + +\ case 27: // depth ( -- n ) \ math stack depth +0 0 0 0 0 +depth +5 cmp +depth ndrop + +\ case 28: // h. ( a -- ) +0xcafe 0xbeef h. h. + +\ case 30: // num ( -- n flag ) \ is word in buffer a number? +: test-num + gw num ; +test-num 235 +235 1 2 scmp + +\ case 31: // push0 ( -- 0 ) +push0 0 cmp + +\ case 33: // exec ( opcode -- ) +20043 exec +h@ cmp + +\ case 34: // lu ( -- opcode 1 | 0 ) +: test-lu + gw lu ; + +test-lu foo +0 cmp + +test-lu lu +20034 1 2 scmp + +\ case 36: // over ( a b -- a b a ) +1 2 over +1 2 1 3 scmp + +\ case 37: // push1 ( -- 1 ) +push1 1 - push0 cmp + +\ case 38: // pwrd ( -- ) \ print word buffer +: test-pwrd + gw pwrd ; +test-pwrd bar + +\ case 39: // emit ( c -- ) +0x5b emit 0x60 emit 0x73 emit 0x75 emit 0x70 emit 0x5d emit cr + +\ case 41: // @ ( addr -- val ) \ read directly from memory address +\ case 42: // ! ( val addr -- ) \ write directly to memory address words only! +0xff00 @ +42 0xff00 ! +0xff00 @ +42 cmp + +\ case 43: // h@ ( -- prog ) \ end of program code space +\ case 44: // do ( limit cnt -- ) ( -a- limit cnt pcnt ) +\ case 45: // loop ( -- ) ( limit cnt pcnt -a- | limit cnt+1 pcnt ) +\ case 46: // +loop ( n -- ) ( limit cnt pcnt -a- | limit cnt+n pcnt ) \ decrement loop if n<0 +\ case 47: // i ( -- cnt ) \ loop counter value +\ case 48: // j ( -- cnt ) \ next outer loop counter value +\ case 49: // k ( -- cnt ) \ next next outer loop counter value +\ case 50: // ~ ( a -- ~a ) \ bitwise complement +\ case 51: // ^ ( a b -- a^b ) \ bitwise xor +\ case 52: // & ( a b -- a&b ) \ bitwise and +\ case 53: // | ( a b -- a|b ) \bitwise or +\ case 54: // */ ( a b c -- (a*b)/c ) \ 32b intermediate +\ case 55: // key ( -- c ) \ get a key from input .... (wait for it) +\ case 56: // cr ( -- ) +\ case 57: // 2* ( a -- a<<1 ) +\ case 58: // 2/ ( a -- a>>1 ) +\ case 59: // call0 ( &func -- *func() ) +\ case 60: // call1 ( a &func -- *func(a) ) +\ case 61: // call2 ( a b &func -- *func(a,b) ) +\ case 62: // call3 ( a b c &func -- *func(a,b,c) ) +\ case 63: // call4 ( a b c d &func -- *func(a,b,c,d) ) +\ case 64: // ndrop ( (x)*n n -- ) \ drop n math stack cells +\ case 65: // swpb ( n -- n ) \ byteswap TOS +\ case 66: // +! ( n addr -- ) \ *addr += n +\ case 67: // roll ( n -- ) \ nth stack removed and placed on top +\ case 68: // pick ( n -- ) \ nth stack copied to top +\ case 69: // tuck ( a b -- b a b ) \ insert copy TOS to after NOS +\ case 70: // max ( a b -- c ) \ c = a ? a>b : b +\ case 71: // min ( a b -- c ) \ c = a ? a