diff --git a/8080/CPM/Makefile b/8080/CPM/Makefile index 923d236..739cf27 100644 --- a/8080/CPM/Makefile +++ b/8080/CPM/Makefile @@ -31,6 +31,20 @@ src/%.fth: src/%.fb ../../tools/fb2fth.py tests/%.fth: tests/%.fb ../../tools/fb2fth.py ../../tools/fb2fth.py $< $@ +logtest.log: \ + $(patsubst %, $(cpmfilesdir)/%, volks4th.com) \ + $(patsubst tests/%, $(cpmfilesdir)/%, tests/log2file.fb) \ + | emu + ./emulator/run-in-runcpm.sh \ + "volks4th" \ + "include log2file.fb" \ + "logopen" \ + ".( hello world) cr" \ + "logclose" \ + "bye" \ + "exit" + dos2unix -n $(runcpmdir)/logfile.txt $@ + inctest.log: \ $(patsubst %, $(cpmfilesdir)/%, volks4th.com) \ $(patsubst src/%, $(cpmfilesdir)/%, src/include.fb) \ @@ -48,18 +62,24 @@ inctest.log: \ "exit" dos2unix -n $(runcpmdir)/logfile.txt $@ -logtest.log: \ +test-std.log: \ $(patsubst %, $(cpmfilesdir)/%, volks4th.com) \ + $(patsubst src/%, $(cpmfilesdir)/%, src/include.fb) \ $(patsubst tests/%, $(cpmfilesdir)/%, tests/log2file.fb) \ + $(patsubst tests/%, $(cpmfilesdir)/%, tests/ans-shim.fth) \ + $(patsubst tests/%, $(cpmfilesdir)/%, tests/prelim.fth) \ | emu ./emulator/run-in-runcpm.sh \ "volks4th" \ + "include include.fb" \ "include log2file.fb" \ "logopen" \ - ".( hello world) cr" \ - "logclose" \ - "bye" \ - "exit" + "include ans-shim.fth" \ + ": \\vf [compile] \\ ; immediate" \ + "include prelim.fth" \ + "" \ + "" \ + "" dos2unix -n $(runcpmdir)/logfile.txt $@ emu: $(runcpmdir)/RunCPM diff --git a/8080/CPM/tests/ans-shim.fth b/8080/CPM/tests/ans-shim.fth new file mode 100644 index 0000000..b47c389 --- /dev/null +++ b/8080/CPM/tests/ans-shim.fth @@ -0,0 +1,102 @@ + +: cells 2* ; + +: s" [compile] " compile count ; immediate restrict +: c" [compile] " ; immediate restrict + +: [char] [compile] ascii ; immediate +: char [compile] ascii ; + +: invert not ; + +: lshift 0 ?DO 2* LOOP ; + +: rshift 0 ?DO 2/ 32767 and LOOP ; + +\ : 2over 3 pick 3 pick ; + +: s>d extend ; + +: fm/mod m/mod ; + +: sm/rem dup >r 2dup xor >r m/mod + over IF r> 0< IF 1+ swap r> - swap ELSE rdrop THEN + ELSE rdrop rdrop THEN ; + +: postpone ' dup >name c@ $40 and + IF , ELSE [compile] compile compile , THEN ; immediate + +\ : align ; +: aligned ; +: cell+ 2+ ; +: char+ 1+ ; +: chars ; + +\ : 2@ dup 2+ @ swap @ ; +\ : 2! under ! 2+ ! ; + +: recurse last @ name> , ; immediate + +' endloop alias unloop + +: >number ( ud1 c-addr1 u1 -- ud2 c-addr2 u2 ) + BEGIN dup 0= IF exit THEN + >r count digit? WHILE accumulate r> 1- REPEAT 1- r> ; + +: accept expect span @ ; + +: tuck under ; + +: :noname here ['] tuck @ , 0 ] ; + +: <> = not ; + +: 2>r r> -rot swap >r >r >r ; +: 2r> r> r> r> swap rot >r ; +: 2r@ r> r> r> 2dup >r >r swap rot >r ; + +: WITHIN ( test low high -- flag ) OVER - >R - R> U< ; + +: unused sp@ here - ; +: again [compile] repeat ; immediate restrict + +: BUFFER: CREATE ALLOT ; + +: compile, , ; + +: defer! >body ! ; +: defer@ >body @ ; +: action-of + STATE @ IF + POSTPONE ['] POSTPONE DEFER@ + ELSE + ' DEFER@ + THEN ; IMMEDIATE + + : HOLDS ( addr u -- ) + BEGIN DUP WHILE 1- 2DUP + C@ HOLD REPEAT 2DROP ; + +: 2Variable ( --) Create 4 allot ; + ( -- adr) + +: 2Constant ( d --) Create , , + Does> ( -- d) 2@ ; + +: 2literal swap [compile] literal [compile] literal ; +immediate restrict + +: d- dnegate d+ ; +: d0< 0. d< ; +: d2* 2dup d+ ; +: d2/ dup 1 and -rot 2/ >r + 1 rshift swap IF $8000 or THEN r> ; + +: 2over 3 pick 3 pick ; +: dmax 2over 2over d< IF 2swap THEN 2drop ; +: dmin 2over 2over 2swap d< IF 2swap THEN 2drop ; + +: d>s drop ; + +: m+ extend d+ ; + +: 2rot 5 roll 5 roll ; diff --git a/8080/CPM/tests/prelim.fth b/8080/CPM/tests/prelim.fth new file mode 100644 index 0000000..8ca9ef5 --- /dev/null +++ b/8080/CPM/tests/prelim.fth @@ -0,0 +1,233 @@ +CR CR SOURCE TYPE ( Preliminary test ) CR +SOURCE ( These lines test SOURCE, TYPE, CR and parenthetic comments ) TYPE CR +( The next line of output should be blank to test CR ) SOURCE TYPE CR CR + +( It is now assumed that SOURCE, TYPE, CR and comments work. SOURCE and ) +( TYPE will be used to report test passes until something better can be ) +( defined to report errors. Until then reporting failures will depend on the ) +( system under test and will usually be via reporting an unrecognised word ) +( or possibly the system crashing. Tests will be numbered by #n from now on ) +( to assist fault finding. Test successes will be indicated by ) +( 'Pass: #n ...' and failures by 'Error: #n ...' ) + +( Initial tests of >IN +! and 1+ ) +( Check that n >IN +! acts as an interpretive IF, where n >= 0 ) +( Pass #1: testing 0 >IN +! ) 0 >IN +! SOURCE TYPE CR +( Pass #2: testing 1 >IN +! ) 1 >IN +! xSOURCE TYPE CR +( Pass #3: testing 1+ ) 1 1+ >IN +! xxSOURCE TYPE CR + +( Test results can now be reported using the >IN +! trick to skip ) +( 1 or more characters ) + +( The value of BASE is unknown so it is not safe to use digits > 1, therefore ) +( it will be set it to binary and then decimal, this also tests @ and ! ) + +( Pass #4: testing @ ! BASE ) 0 1+ 1+ BASE ! BASE @ >IN +! xxSOURCE TYPE CR +( Set BASE to decimal ) 1010 BASE ! +( Pass #5: testing decimal BASE ) BASE @ >IN +! xxxxxxxxxxSOURCE TYPE CR + +( Now in decimal mode and digits >1 can be used ) + +( A better error reporting word is needed, much like .( which can't ) +( be used as it is in the Core Extension word set, similarly PARSE can't be ) +( used either, only WORD is available to parse a message and must be used ) +( in a colon definition. Therefore a simple colon definition is tested next ) + +( Pass #6: testing : ; ) : .SRC SOURCE TYPE CR ; 6 >IN +! xxxxxx.SRC +( Pass #7: testing number input ) 19 >IN +! xxxxxxxxxxxxxxxxxxx.SRC + +( VARIABLE is now tested as one will be used instead of DROP e.g. Y ! ) + +( Pass #8: testing VARIABLE ) VARIABLE Y 2 Y ! Y @ >IN +! xx.SRC + +: MSG 41 WORD COUNT ; ( 41 is the ASCII code for right parenthesis ) +( The next tests MSG leaves 2 items on the data stack ) +( Pass #9: testing WORD COUNT ) 5 MSG abcdef) Y ! Y ! >IN +! xxxxx.SRC +( Pass #10: testing WORD COUNT ) MSG ab) >IN +! xxY ! .SRC + +( For reporting success .MSG( is now defined ) +: .MSG( MSG TYPE ; .MSG( Pass #11: testing WORD COUNT .MSG) CR + +( To define an error reporting word, = 2* AND will be needed, test them first ) +( This assumes 2's complement arithmetic ) +1 1 = 1+ 1+ >IN +! x.MSG( Pass #12: testing = returns all 1's for true) CR +1 0 = 1+ >IN +! x.MSG( Pass #13: testing = returns 0 for false) CR +1 1 = -1 = 1+ 1+ >IN +! x.MSG( Pass #14: testing -1 interpreted correctly) CR + +1 2* >IN +! xx.MSG( Pass #15: testing 2*) CR +-1 2* 1+ 1+ 1+ >IN +! x.MSG( Pass #16: testing 2*) CR + +-1 -1 AND 1+ 1+ >IN +! x.MSG( Pass #17: testing AND) CR +-1 0 AND 1+ >IN +! x.MSG( Pass #18: testing AND) CR +6 -1 AND >IN +! xxxxxx.MSG( Pass #19: testing AND) CR + +( Define ~ to use as a 'to end of line' comment. \ cannot be used as it a ) +( Core Extension word ) +: ~ ( -- ) SOURCE >IN ! Y ! ; + +( Rather than relying on a pass message test words can now be defined to ) +( report errors in the event of a failure. For convenience words ?T~ and ) +( ?F~ are defined together with a helper ?~~ to test for TRUE and FALSE ) +( Usage is: ?T~ Error #n: ) +( Success makes >IN index the ~ in ?T~ or ?F~ to skip the error message. ) +( Hence it is essential there is only 1 space between ?T~ and Error ) + +: ?~~ ( -1 | 0 -- ) 2* >IN +! ; +: ?F~ ( f -- ) 0 = ?~~ ; +: ?T~ ( f -- ) -1 = ?~~ ; + +( Errors will be counted ) +VARIABLE #ERRS 0 #ERRS ! +: Error 1 #ERRS +! -6 >IN +! .MSG( CR ; +: Pass -1 #ERRS +! 1 >IN +! Error ; ~ Pass is defined solely to test Error + +-1 ?F~ Pass #20: testing ?F~ ?~~ Pass Error +-1 ?T~ Error #1: testing ?T~ ?~~ ~ + +0 0 = 0= ?F~ Error #2: testing 0= +1 0 = 0= ?T~ Error #3: testing 0= +-1 0 = 0= ?T~ Error #4: testing 0= + +0 0 = ?T~ Error #5: testing = +0 1 = ?F~ Error #6: testing = +1 0 = ?F~ Error #7: testing = +-1 1 = ?F~ Error #8: testing = +1 -1 = ?F~ Error #9: testing = + +-1 0< ?T~ Error #10: testing 0< +0 0< ?F~ Error #11: testing 0< +1 0< ?F~ Error #12: testing 0< + + DEPTH 1+ DEPTH = ?~~ Error #13: testing DEPTH + ~ Up to now whether the data stack was empty or not hasn't mattered as + ~ long as it didn't overflow. Now it will be emptied - also + ~ removing any unreported underflow + DEPTH 0< 0= 1+ >IN +! ~ 0 0 >IN ! Remove any underflow + DEPTH 0= 1+ >IN +! ~ Y ! 0 >IN ! Empty the stack + DEPTH 0= ?T~ Error #14: data stack not emptied + + 4 -5 SWAP 4 = SWAP -5 = = ?T~ Error #15: testing SWAP + 111 222 333 444 + DEPTH 4 = ?T~ Error #16: testing DEPTH + 444 = SWAP 333 = = DEPTH 3 = = ?T~ Error #17: testing SWAP DEPTH + 222 = SWAP 111 = = DEPTH 1 = = ?T~ Error #18: testing SWAP DEPTH + DEPTH 0= ?T~ Error #19: testing DEPTH = 0 + +~ From now on the stack is expected to be empty after a test so +~ ?~ will be defined to include a check on the stack depth. Note +~ that ?~~ was defined and used earlier instead of ?~ to avoid +~ (irritating) redefinition messages that many systems display had +~ ?~ simply been redefined + +: ?~ ( -1 | 0 -- ) DEPTH 1 = AND ?~~ ; ~ -1 test success, 0 test failure + +123 -1 ?~ Pass #21: testing ?~ +Y ! ~ equivalent to DROP + +~ Testing the remaining Core words used in the Hayes tester, with the above +~ definitions these are straightforward + +1 DROP DEPTH 0= ?~ Error #20: testing DROP +123 DUP = ?~ Error #21: testing DUP +123 ?DUP = ?~ Error #22: testing ?DUP +0 ?DUP 0= ?~ Error #23: testing ?DUP +123 111 + 234 = ?~ Error #24: testing + +123 -111 + 12 = ?~ Error #25: testing + +-123 111 + -12 = ?~ Error #26: testing + +-123 -111 + -234 = ?~ Error #27: testing + +-1 NEGATE 1 = ?~ Error #28: testing NEGATE +0 NEGATE 0= ?~ Error #29: testing NEGATE +987 NEGATE -987 = ?~ Error #30: testing NEGATE +HERE DEPTH SWAP DROP 1 = ?~ Error #31: testing HERE +CREATE TST1 HERE TST1 = ?~ Error #32: testing CREATE HERE +16 ALLOT HERE TST1 NEGATE + 16 = ?~ Error #33: testing ALLOT +-16 ALLOT HERE TST1 = ?~ Error #34: testing ALLOT +0 CELLS 0= ?~ Error #35: testing CELLS +1 CELLS ALLOT HERE TST1 NEGATE + VARIABLE CSZ CSZ ! +CSZ @ 0= 0= ?~ Error #36: testing CELLS +3 CELLS CSZ @ DUP 2* + = ?~ Error #37: testing CELLS +-3 CELLS CSZ @ DUP 2* + + 0= ?~ Error #38: testing CELLS +: TST2 ( f -- n ) DUP IF 1+ THEN ; +0 TST2 0= ?~ Error #39: testing IF THEN +1 TST2 2 = ?~ Error #40: testing IF THEN +: TST3 ( n1 -- n2 ) IF 123 ELSE 234 THEN ; +0 TST3 234 = ?~ Error #41: testing IF ELSE THEN +1 TST3 123 = ?~ Error #42: testing IF ELSE THEN +: TST4 ( -- n ) 0 5 0 DO 1+ LOOP ; +TST4 5 = ?~ Error #43: testing DO LOOP +: TST5 ( -- n ) 0 10 0 DO I + LOOP ; +TST5 45 = ?~ Error #44: testing I +: TST6 ( -- n ) 0 10 0 DO DUP 5 = IF LEAVE ELSE 1+ THEN LOOP ; +TST6 5 = ?~ Error #45: testing LEAVE +: TST7 ( -- n1 n2 ) 123 >R 234 R> ; +TST7 NEGATE + 111 = ?~ Error #46: testing >R R> +: TST8 ( -- ch ) [CHAR] A ; +TST8 65 = ?~ Error #47: testing [CHAR] +: TST9 ( -- ) [CHAR] s [CHAR] s [CHAR] a [CHAR] P 4 0 DO EMIT LOOP ; +TST9 .MSG( #22: testing EMIT) CR +: TST10 ( -- ) S" Pass #23: testing S" TYPE [CHAR] " EMIT CR ; TST10 + +~ The Hayes core test core.fr uses CONSTANT before it is tested therefore +~ we test CONSTANT here + +1234 CONSTANT CTEST +CTEST 1234 = ?~ Error #48: testing CONSTANT + +~ The Hayes tester uses some words from the Core extension word set +~ These will be conditionally defined following definition of a +~ word called ?DEFINED to determine whether these are already defined + +VARIABLE TIMM1 0 TIMM1 ! +: TIMM2 123 TIMM1 ! ; IMMEDIATE +: TIMM3 TIMM2 ; TIMM1 @ 123 = ?~ Error #49: testing IMMEDIATE + +: ?DEFINED ( "name" -- 0 | -1 ) 32 WORD FIND SWAP DROP 0= 0= ; +?DEFINED SWAP ?~ Error #50: testing FIND ?DEFINED +?DEFINED <> 0= ?~ Error #51 testing FIND ?DEFINED + +?DEFINED \ ?~ : \ ~ ; IMMEDIATE +\ Error #52: testing \ +: TIMM4 \ Error #53: testing \ is IMMEDIATE +; + +~ TRUE and FALSE are defined as colon definitions as they have been used +~ more than CONSTANT above + +?DEFINED TRUE ?~ : TRUE 1 NEGATE ; +?DEFINED FALSE ?~ : FALSE 0 ; +?DEFINED HEX ?~ : HEX 16 BASE ! ; + +TRUE -1 = ?~ Error #54: testing TRUE +FALSE 0= ?~ Error #55: testing FALSE +10 HEX 0A = ?~ Error #56: testing HEX +AB 0A BASE ! 171 = ?~ Error #57: testing hex number + +~ Delete the ~ on the next 2 lines to check the final error report +~ Error #998: testing a deliberate failure +~ Error #999: testing a deliberate failure + +~ Describe the messages that should be seen. The previously defined .MSG( +~ can be used for text messages + +CR .MSG( Results: ) CR +CR .MSG( Pass messages #1 to #23 should be displayed above) +CR .MSG( and no error messages) CR + +~ Finally display a message giving the number of tests that failed. +~ This is complicated by the fact that untested words including .( ." and . +~ cannot be used. Also more colon definitions shouldn't be defined than are +~ needed. To display a number, note that the number of errors will have +~ one or two digits at most and an interpretive loop can be used to +~ display those. + +CR +0 #ERRS @ +~ Loop to calculate the 10's digit (if any) +DUP NEGATE 9 + 0< NEGATE >IN +! ( -10 + SWAP 1+ SWAP 0 >IN ! ) +~ Display the error count +SWAP ?DUP 0= 1+ >IN +! ( 48 + EMIT ( ) 48 + EMIT + +.MSG( test) #ERRS @ 1 = 1+ >IN +! ~ .MSG( s) +.MSG( failed out of 57 additional tests) CR + +CR CR .MSG( --- End of Preliminary Tests --- ) CR