Merge pull request #3 from pzembrod/master

Add testing for c16-volksforth83, and add coreplustest.fth

6502/C64/Makefile

@@ -22,10 +22,17 @@ run-devenv: emulator/devenv.T64
 run-testbase: emulator/testbase.T64
 	emulator/run-in-vice.sh testbase
 
-run-tests: emulator/testbase.T64 $(test_files_petscii)
+test: emulator/testbase.T64 $(test_files_petscii)
 	emulator/run-in-vice.sh testbase \
 	  "include run-vf-tests.fth\n"
 
+run-testbase16: emulator/testbase16.T64
+	VICE=xplus4 emulator/run-in-vice.sh testbase16
+
+test16: emulator/testbase.T64 $(test_files_petscii)
+	VICE=xplus4 emulator/run-in-vice.sh testbase16 \
+	  "include run-vf-tests.fth\n"
+
 
 # Rules for building Forth binaries on top of the plain vanilla
 # c64-volksforth83.
@@ -39,6 +46,10 @@ cbmfiles/testbase: emulator/run-in-vice.sh emulator/build-testbase.sh \
     emulator/c64-volksforth83.T64 disks/file-words.d64
 	emulator/build-testbase.sh
 
+cbmfiles/testbase16: emulator/run-in-vice.sh emulator/build-testbase.sh \
+    emulator/c16-volksforth83.T64 disks/file-words.d64
+	emulator/build-testbase16.sh
+
 
 # Generic T64 tape image rule
 

6502/C64/emulator/build-testbase16.sh

@@ -0,0 +1,16 @@
+#!/bin/bash
+set -e
+
+emulatordir="$(dirname "${BASH_SOURCE[0]}")"
+basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")"
+
+rm -f "${basedir}/cbmfiles/testbase"
+
+# load savesystem w/o editor from file-words.d64 block 20 in drive 11.
+# load include and dos from file-words.d64 block 10 in drive 11.
+# savesystem and then scratch file notdone to exit emulator.
+keybuf="3 drive 20 load\n3 drive 10 load\n\
+savesystem testbase16\ndos s0:notdone\n"
+
+VICE=xplus4 "${emulatordir}/run-in-vice.sh" \
+  "c16-volksforth83" "${keybuf}"

6502/C64/emulator/run-in-vice.sh

@@ -1,6 +1,7 @@
 #!/bin/bash
 set -e
 
+test -n "$VICE" || VICE=x64
 emulatordir="$(realpath --relative-to="$PWD" "$(dirname "${BASH_SOURCE[0]}")")"
 basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")"
 
@@ -20,7 +21,7 @@ then
   warp="-warp"
 fi
 
-x64 \
+"$VICE" \
   -virtualdev \
   +truedrive \
   -drive8type 1541 \

6502/C64/tests/ans-shim.fth

@@ -1,6 +1,4 @@
 
-: \vf  [compile] \ ;
-
 : cells  2* ;
 
 : s"  [compile] " compile count ; immediate
@@ -43,3 +41,7 @@
  >r  count digit? WHILE accumulate r> 1- REPEAT 1- r> ;
 
 : accept  expect span @ ;
+
+: tuck  under ;
+
+: :noname  here  ['] tuck @ ,  0 ] ;

6502/C64/tests/coreplustest.fth

@@ -0,0 +1,306 @@
+\ Additional tests on the the ANS Forth Core word set
+
+\ This program was written by Gerry Jackson in 2007, with contributions from
+\ others where indicated, and is in the public domain - it can be distributed
+\ and/or modified in any way but please retain this notice.
+
+\ This program is distributed in the hope that it will be useful,
+\ but WITHOUT ANY WARRANTY; without even the implied warranty of
+\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+\ The tests are not claimed to be comprehensive or correct
+
+\ ------------------------------------------------------------------------------
+\ The tests are based on John Hayes test program for the core word set
+\
+\ This file provides some more tests on Core words where the original Hayes
+\ tests are thought to be incomplete
+\
+\ Words tested in this file are:
+\     DO I +LOOP RECURSE ELSE >IN IMMEDIATE FIND IF...BEGIN...REPEAT ALLOT DOES>
+\ and
+\     Parsing behaviour
+\     Number prefixes # $ % and 'A' character input
+\     Definition names
+\ ------------------------------------------------------------------------------
+\ Assumptions and dependencies:
+\     - tester.fr or ttester.fs has been loaded prior to this file
+\     - core.fr has been loaded so that constants <TRUE> MAX-INT, MIN-INT and
+\       MAX-UINT are defined
+\ ------------------------------------------------------------------------------
+
+DECIMAL
+
+TESTING DO +LOOP with run-time increment, negative increment, infinite loop
+\ Contributed by Reinhold Straub
+
+VARIABLE ITERATIONS
+VARIABLE INCREMENT
+: GD7 ( LIMIT START INCREMENT -- )
+   INCREMENT !
+   0 ITERATIONS !
+   DO
+      1 ITERATIONS +!
+      I
+      ITERATIONS @  6 = IF LEAVE THEN
+      INCREMENT @
+   +LOOP ITERATIONS @
+;
+
+T{  4  4 -1 GD7 -> 4 1 }T
+T{  1  4 -1 GD7 -> 4 3 2 1 4 }T
+T{  4  1 -1 GD7 -> 1 0 -1 -2 -3 -4 6 }T
+T{  4  1  0 GD7 -> 1 1 1 1 1 1 6 }T
+T{  0  0  0 GD7 -> 0 0 0 0 0 0 6 }T
+T{  1  4  0 GD7 -> 4 4 4 4 4 4 6 }T
+T{  1  4  1 GD7 -> 4 5 6 7 8 9 6 }T
+T{  4  1  1 GD7 -> 1 2 3 3 }T
+T{  4  4  1 GD7 -> 4 5 6 7 8 9 6 }T
+T{  2 -1 -1 GD7 -> -1 -2 -3 -4 -5 -6 6 }T
+T{ -1  2 -1 GD7 -> 2 1 0 -1 4 }T
+T{  2 -1  0 GD7 -> -1 -1 -1 -1 -1 -1 6 }T
+T{ -1  2  0 GD7 -> 2 2 2 2 2 2 6 }T
+T{ -1  2  1 GD7 -> 2 3 4 5 6 7 6 }T
+T{  2 -1  1 GD7 -> -1 0 1 3 }T
+T{ -20 30 -10 GD7 -> 30 20 10 0 -10 -20 6 }T
+T{ -20 31 -10 GD7 -> 31 21 11 1 -9 -19 6 }T
+T{ -20 29 -10 GD7 -> 29 19 9 -1 -11 5 }T
+
+\ ------------------------------------------------------------------------------
+TESTING DO +LOOP with large and small increments
+
+\ Contributed by Andrew Haley
+
+MAX-UINT 8 RSHIFT 1+ CONSTANT USTEP
+USTEP NEGATE CONSTANT -USTEP
+MAX-INT 7 RSHIFT 1+ CONSTANT STEP
+STEP NEGATE CONSTANT -STEP
+
+VARIABLE BUMP
+
+T{ : GD8 BUMP ! DO 1+ BUMP @ +LOOP ; -> }T
+
+T{ 0 MAX-UINT 0 USTEP GD8 -> 256 }T
+T{ 0 0 MAX-UINT -USTEP GD8 -> 256 }T
+
+T{ 0 MAX-INT MIN-INT STEP GD8 -> 256 }T
+T{ 0 MIN-INT MAX-INT -STEP GD8 -> 256 }T
+
+\ Two's complement arithmetic, wraps around modulo wordsize
+\ Only tested if the Forth system does wrap around, use of conditional
+\ compilation deliberately avoided
+
+MAX-INT 1+ MIN-INT = CONSTANT +WRAP?
+MIN-INT 1- MAX-INT = CONSTANT -WRAP?
+MAX-UINT 1+ 0=       CONSTANT +UWRAP?
+0 1- MAX-UINT =      CONSTANT -UWRAP?
+
+: GD9  ( n limit start step f result -- )
+   >R IF GD8 ELSE 2DROP 2DROP R@ THEN -> R> }T
+;
+
+T{ 0 0 0  USTEP +UWRAP? 256 GD9
+T{ 0 0 0 -USTEP -UWRAP?   1 GD9
+T{ 0 MIN-INT MAX-INT  STEP +WRAP? 1 GD9
+T{ 0 MAX-INT MIN-INT -STEP -WRAP? 1 GD9
+
+\ ------------------------------------------------------------------------------
+TESTING DO +LOOP with maximum and minimum increments
+
+: (-MI) MAX-INT DUP NEGATE + 0= IF MAX-INT NEGATE ELSE -32767 THEN ;
+(-MI) CONSTANT -MAX-INT
+
+T{ 0 1 0 MAX-INT GD8  -> 1 }T
+T{ 0 -MAX-INT NEGATE -MAX-INT OVER GD8  -> 2 }T
+
+T{ 0 MAX-INT  0 MAX-INT GD8  -> 1 }T
+T{ 0 MAX-INT  1 MAX-INT GD8  -> 1 }T
+T{ 0 MAX-INT -1 MAX-INT GD8  -> 2 }T
+T{ 0 MAX-INT DUP 1- MAX-INT GD8  -> 1 }T
+
+T{ 0 MIN-INT 1+   0 MIN-INT GD8  -> 1 }T
+T{ 0 MIN-INT 1+  -1 MIN-INT GD8  -> 1 }T
+T{ 0 MIN-INT 1+   1 MIN-INT GD8  -> 2 }T
+T{ 0 MIN-INT 1+ DUP MIN-INT GD8  -> 1 }T
+
+\ ------------------------------------------------------------------------------
+\ TESTING +LOOP setting I to an arbitrary value
+
+\ The specification for +LOOP permits the loop index I to be set to any value
+\ including a value outside the range given to the corresponding  DO.
+
+\ SET-I is a helper to set I in a DO ... +LOOP to a given value
+\ n2 is the value of I in a DO ... +LOOP
+\ n3 is a test value
+\ If n2=n3 then return n1-n2 else return 1
+: SET-I  ( n1 n2 n3 -- n1-n2 | 1 )
+   OVER = IF - ELSE 2DROP 1 THEN
+;
+
+: -SET-I ( n1 n2 n3 -- n1-n2 | -1 )
+   SET-I DUP 1 = IF NEGATE THEN
+;
+
+: PL1 20 1 DO I 18 I 3 SET-I +LOOP ;
+T{ PL1 -> 1 2 3 18 19 }T
+: PL2 20 1 DO I 20 I 2 SET-I +LOOP ;
+T{ PL2 -> 1 2 }T
+: PL3 20 5 DO I 19 I 2 SET-I DUP 1 = IF DROP 0 I 6 SET-I THEN +LOOP ;
+T{ PL3 -> 5 6 0 1 2 19 }T
+: PL4 20 1 DO I MAX-INT I 4 SET-I +LOOP ;
+T{ PL4 -> 1 2 3 4 }T
+: PL5 -20 -1 DO I -19 I -3 -SET-I +LOOP ;
+T{ PL5 -> -1 -2 -3 -19 -20 }T
+: PL6 -20 -1 DO I -21 I -4 -SET-I +LOOP ;
+T{ PL6 -> -1 -2 -3 -4 }T
+: PL7 -20 -1 DO I MIN-INT I -5 -SET-I +LOOP ;
+T{ PL7 -> -1 -2 -3 -4 -5 }T
+: PL8 -20 -5 DO I -20 I -2 -SET-I DUP -1 = IF DROP 0 I -6 -SET-I THEN +LOOP ;
+T{ PL8 -> -5 -6 0 -1 -2 -20 }T
+
+\ ------------------------------------------------------------------------------
+TESTING multiple RECURSEs in one colon definition
+
+: ACK ( m n -- u )    \ Ackermann function, from Rosetta Code
+   OVER 0= IF  NIP 1+ EXIT  THEN       \ ack(0, n) = n+1
+   SWAP 1- SWAP                        ( -- m-1 n )
+   DUP  0= IF  1+  RECURSE EXIT  THEN  \ ack(m, 0) = ack(m-1, 1)
+   1- OVER 1+ SWAP RECURSE RECURSE     \ ack(m, n) = ack(m-1, ack(m,n-1))
+;
+
+T{ 0 0 ACK ->  1 }T
+T{ 3 0 ACK ->  5 }T
+T{ 2 4 ACK -> 11 }T
+
+\ ------------------------------------------------------------------------------
+\vf TESTING multiple ELSE's in an IF statement
+\ Discussed on comp.lang.forth and accepted as valid ANS Forth
+
+\vf : MELSE IF 1 ELSE 2 ELSE 3 ELSE 4 ELSE 5 THEN ;
+\vf T{ 0 MELSE -> 2 4 }T
+\vf T{ -1 MELSE -> 1 3 5 }T
+
+\ ------------------------------------------------------------------------------
+TESTING manipulation of >IN in interpreter mode
+
+T{ 12345 DEPTH OVER 9 < 34 AND + 3 + >IN ! -> 12345 2345 345 45 5 }T
+T{ 14145 8115 ?DUP 0= 34 AND >IN +! TUCK MOD 14 >IN ! GCD CALCULATION -> 15 }T
+
+\ ------------------------------------------------------------------------------
+TESTING IMMEDIATE with CONSTANT  VARIABLE and CREATE [ ... DOES> ]
+
+T{ 123 CONSTANT IW1 IMMEDIATE IW1 -> 123 }T
+T{ : IW2 IW1 LITERAL ; IW2 -> 123 }T
+T{ VARIABLE IW3 IMMEDIATE 234 IW3 ! IW3 @ -> 234 }T
+T{ : IW4 IW3 [ @ ] LITERAL ; IW4 -> 234 }T
+T{ :NONAME [ 345 ] IW3 [ ! ] ; DROP IW3 @ -> 345 }T
+T{ CREATE IW5 456 , IMMEDIATE -> }T
+T{ :NONAME IW5 [ @ IW3 ! ] ; DROP IW3 @ -> 456 }T
+T{ : IW6 CREATE , IMMEDIATE DOES> @ 1+ ; -> }T
+T{ 111 IW6 IW7 IW7 -> 112 }T
+T{ : IW8 IW7 LITERAL 1+ ; IW8 -> 113 }T
+T{ : IW9 CREATE , DOES> @ 2 + IMMEDIATE ; -> }T
+: FIND-IW BL WORD FIND NIP ;  ( -- 0 | 1 | -1 )
+T{ 222 IW9 IW10 FIND-IW IW10 -> -1 }T   \ IW10 is not immediate
+T{ IW10 FIND-IW IW10 -> 224 1 }T        \ IW10 becomes immediate
+
+\ ------------------------------------------------------------------------------
+TESTING that IMMEDIATE doesn't toggle a flag
+
+VARIABLE IT1 0 IT1 !
+: IT2 1234 IT1 ! ; IMMEDIATE IMMEDIATE
+T{ : IT3 IT2 ; IT1 @ -> 1234 }T
+
+\ ------------------------------------------------------------------------------
+TESTING parsing behaviour of S" ." and (
+\ which should parse to just beyond the terminating character no space needed
+
+T{ : GC5 S" A string"2DROP ; GC5 -> }T
+T{ ( A comment)1234 -> 1234 }T
+T{ : PB1 CR ." You should see 2345: "." 2345"( A comment) CR ; PB1 -> }T
+
+\ ------------------------------------------------------------------------------
+TESTING number prefixes # $ % and 'c' character input
+\ Adapted from the Forth 200X Draft 14.5 document
+
+VARIABLE OLD-BASE
+DECIMAL BASE @ OLD-BASE !
+T{ &1289 -> 1289 }T  \ vf: s/#/&/
+T{ -&1289 -> -1289 }T  \ vf: s/#-/-&/
+T{ $12eF -> 4847 }T
+T{ -$12eF -> -4847 }T  \ vf: s/$-/-$/
+T{ %10010110 -> 150 }T
+T{ -%10010110 -> -150 }T  \ vf: s/%-/-%/
+\vf T{ 'z' -> 122 }T
+\vf T{ 'Z' -> 90 }T
+\ Check BASE is unchanged
+T{ BASE @ OLD-BASE @ = -> <TRUE> }T
+
+\ Repeat in Hex mode
+16 OLD-BASE ! 16 BASE !
+T{ &1289 -> 509 }T  \ vf: s/#/&/
+T{ -&1289 -> -509 }T  \ vf: s/#/&/
+T{ $12eF -> 12EF }T
+T{ -$12eF -> -12EF }T  \ vf: s/$-/-$/
+T{ %10010110 -> 96 }T
+T{ -%10010110 -> -96 }T  \ vf: s/%-/-%/
+\vf T{ 'z' -> 7a }T
+\vf T{ 'Z' -> 5a }T
+\ Check BASE is unchanged
+T{ BASE @ OLD-BASE @ = -> <TRUE> }T   \ 2
+
+DECIMAL
+\ Check number prefixes in compile mode
+\ vf: s/#/&/ s/$-/-$/ s/'''/ascii '/
+T{ : nmp  &8327 -$2cbe %011010111 ascii ' ; nmp -> 8327 -11454 215 39 }T
+
+\ ------------------------------------------------------------------------------
+TESTING definition names
+\ should support {1..31} graphical characters
+: !"#$%&'()*+,-./0123456789:;<=>? 1 ;
+T{ !"#$%&'()*+,-./0123456789:;<=>? -> 1 }T
+: @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^ 2 ;
+T{ @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^ -> 2 }T
+: _`abcdefghijklmnopqrstuvwxyz{|} 3 ;
+T{ _`abcdefghijklmnopqrstuvwxyz{|} -> 3 }T
+: _`abcdefghijklmnopqrstuvwxyz{|~ 4 ;     \ Last character different
+T{ _`abcdefghijklmnopqrstuvwxyz{|~ -> 4 }T
+T{ _`abcdefghijklmnopqrstuvwxyz{|} -> 3 }T
+
+\ ------------------------------------------------------------------------------
+TESTING FIND with a zero length string and a non-existent word
+
+CREATE EMPTYSTRING 0 C,
+: EMPTYSTRING-FIND-CHECK ( c-addr 0 | xt 1 | xt -1 -- t|f )
+    DUP IF ." FIND returns a TRUE value for an empty string!" CR THEN
+    0= SWAP EMPTYSTRING = = ;
+T{ EMPTYSTRING FIND EMPTYSTRING-FIND-CHECK -> <TRUE> }T
+
+CREATE NON-EXISTENT-WORD   \ Same as in exceptiontest.fth
+       15 C, CHAR $ C, CHAR $ C, CHAR Q C, CHAR W C, CHAR E C, CHAR Q C,
+   CHAR W C, CHAR E C, CHAR Q C, CHAR W C, CHAR E C, CHAR R C, CHAR T C,
+   CHAR $ C, CHAR $ C,
+T{ NON-EXISTENT-WORD FIND -> NON-EXISTENT-WORD 0 }T
+
+\ ------------------------------------------------------------------------------
+\vf TESTING IF ... BEGIN ... REPEAT (unstructured)
+
+\vf T{ : UNS1 DUP 0 > IF 9 SWAP BEGIN 1+ DUP 3 > IF EXIT THEN REPEAT ; -> }T
+\vf T{ -6 UNS1 -> -6 }T
+\vf T{  1 UNS1 -> 9 4 }T
+
+\ ------------------------------------------------------------------------------
+TESTING DOES> doesn't cause a problem with a CREATEd address
+
+: MAKE-2CONST DOES> 2@ ;
+T{ CREATE 2K 3 , 2K , MAKE-2CONST 2K -> ' 2K >BODY 3 }T
+
+\ ------------------------------------------------------------------------------
+TESTING ALLOT ( n -- ) where n <= 0
+
+T{ HERE 5 ALLOT -5 ALLOT HERE = -> <TRUE> }T
+T{ HERE 0 ALLOT HERE = -> <TRUE> }T
+
+\ ------------------------------------------------------------------------------
+
+CR .( End of additional Core tests) CR

6502/C64/tests/run-vf-tests.fth

@@ -8,3 +8,5 @@ include tester.fth
 \ 1 verbose !
 
 include core.fr
+
+include coreplustest.fth