mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-01-24 19:30:10 +00:00
Get blocktest.fth to pass for c64-vf-latest - c16 will come later.
This commit is contained in:
Philip Zembrod
parent
07d2bc46fd
commit
02f932a533
@ -22,6 +22,7 @@ vf_blk_fth: $(vf_blk_fth_files)
|
||||
clean:
|
||||
rm -f cbmfiles/*.fr cbmfiles/*.fth cbmfiles/*.log *.log *.result
|
||||
rm -f cbmfiles/c??-testbase
|
||||
rm -f disks/scratch.d64
|
||||
|
||||
|
||||
# Convenience targets
|
||||
@ -70,8 +71,9 @@ cbmfiles/c16-vf-32k: emulator/tcbase.T64 emulator/build-vf.sh \
|
||||
test-c64.result: emulator/c64-vf-latest.T64 $(test_files_petscii) \
|
||||
emulator/run-in-vice.sh tests/evaluate-test.sh tests/test-c64.golden
|
||||
rm -f test-c64.log test-c64.result
|
||||
emulator/run-in-vice.sh c64-vf-latest \
|
||||
"include run-vf-tests.fth\n1234567890\ndos s0:notdone\n"
|
||||
cp disks/empty.d64 disks/scratch.d64
|
||||
DISK9=scratch emulator/run-in-vice.sh c64-vf-latest \
|
||||
"include run-vf-tests.fth\n1234567890\n"
|
||||
petscii2ascii cbmfiles/test.log test-c64.log
|
||||
tests/evaluate-test.sh test-c64
|
||||
|
||||
@ -79,7 +81,7 @@ test-c16.result: emulator/c16-vf-latest.T64 $(test_files_petscii) \
|
||||
emulator/run-in-vice.sh tests/evaluate-test.sh tests/test-c16.golden
|
||||
rm -f test-c16.log test-c16.result
|
||||
VICE=xplus4 emulator/run-in-vice.sh c16-vf-latest \
|
||||
"include run-vf-tests.fth\n1234567890\ndos s0:notdone\n"
|
||||
"include run-vf-tests.fth\n1234567890\n"
|
||||
petscii2ascii cbmfiles/test.log test-c16.log
|
||||
tests/evaluate-test.sh test-c16
|
||||
|
||||
|
||||
@ -1445,8 +1445,8 @@ Variable state 0 state !
|
||||
: .( Ascii ) parse type ;
|
||||
immediate
|
||||
|
||||
: \ >in @ c/l / 1+ c/l * >in ! ;
|
||||
immediate
|
||||
: \ blk @ IF >in @ c/l / 1+ c/l *
|
||||
ELSE #tib @ THEN >in ! ; immediate
|
||||
|
||||
: \\ b/blk >in ! ; immediate
|
||||
|
||||
|
||||
@ -65,10 +65,6 @@
|
||||
|
||||
\ include 09jun20pz
|
||||
|
||||
: \ ( -- )
|
||||
blk @ IF [compile] \ exit THEN
|
||||
#tib @ >in ! ; immediate
|
||||
|
||||
create >tib-orig >tib @ ,
|
||||
fib >tib !
|
||||
|
||||
|
||||
@ -440,30 +440,30 @@ T{ RND-TEST-BLOCK DUP TL3 DUP LOAD = -> TRUE }T
|
||||
|
||||
\ EVALUATE resets BLK
|
||||
\ u: "EVALUATE-BLK@"; u LOAD
|
||||
: EVALUATE-BLK@ ( -- BLK@ )
|
||||
S" BLK @" EVALUATE ;
|
||||
: TL4 ( blk -- )
|
||||
S" EVALUATE-BLK@" WRITE-BLOCK ;
|
||||
T{ RND-TEST-BLOCK DUP TL4 LOAD -> 0 }T
|
||||
\vf : EVALUATE-BLK@ ( -- BLK@ )
|
||||
\vf S" BLK @" EVALUATE ;
|
||||
\vf : TL4 ( blk -- )
|
||||
\vf S" EVALUATE-BLK@" WRITE-BLOCK ;
|
||||
\vf T{ RND-TEST-BLOCK DUP TL4 LOAD -> 0 }T
|
||||
|
||||
\ EVALUTE can nest with LOAD
|
||||
\ u: "BLK @"; S" u LOAD" EVALUATE
|
||||
: TL5 ( blk -- c-addr u )
|
||||
0 <# \ blk 0
|
||||
[CHAR] D HOLD
|
||||
[CHAR] A HOLD
|
||||
[CHAR] O HOLD
|
||||
[CHAR] L HOLD
|
||||
BL HOLD
|
||||
#S #> ; \ c-addr u
|
||||
\T{ RND-TEST-BLOCK DUP TL3 DUP TL5 EVALUATE = -> TRUE }T
|
||||
\vf : TL5 ( blk -- c-addr u )
|
||||
\vf 0 <# \ blk 0
|
||||
\vf [CHAR] D HOLD
|
||||
\vf [CHAR] A HOLD
|
||||
\vf [CHAR] O HOLD
|
||||
\vf [CHAR] L HOLD
|
||||
\vf BL HOLD
|
||||
\vf #S #> ; \ c-addr u
|
||||
\vf T{ RND-TEST-BLOCK DUP TL3 DUP TL5 EVALUATE = -> TRUE }T
|
||||
|
||||
\ Nested LOADs
|
||||
\ u2: "BLK @"; u1: "LOAD u2"; u1 LOAD
|
||||
: TL6 ( blk1 blk2 -- )
|
||||
DUP TL3 \ blk1 blk2
|
||||
TL5 WRITE-BLOCK ;
|
||||
T{ 2RND-TEST-BLOCKS 2DUP TL6 SWAP LOAD = -> TRUE }T
|
||||
\vf : TL6 ( blk1 blk2 -- )
|
||||
\vf DUP TL3 \ blk1 blk2
|
||||
\vf TL5 WRITE-BLOCK ;
|
||||
\vf T{ 2RND-TEST-BLOCKS 2DUP TL6 SWAP LOAD = -> TRUE }T
|
||||
|
||||
\ LOAD changes the currect block that is effected by UPDATE
|
||||
\ This test needs at least 2 distinct buffers, though this is not a
|
||||
@ -611,6 +611,7 @@ TESTING \, SAVE-INPUT, RESTORE-INPUT and REFILL from a block source
|
||||
S" 4444" WRITE-BLOCK-LINE
|
||||
THEN
|
||||
DROP UPDATE SAVE-BUFFERS ;
|
||||
|
||||
T{ RND-TEST-BLOCK DUP TCSIRIR1 LOAD -> 2222 4444 }T
|
||||
|
||||
VARIABLE T-CNT 0 T-CNT !
|
||||
@ -622,43 +623,43 @@ VARIABLE T-CNT 0 T-CNT !
|
||||
IF EXECUTE ELSE DROP THEN ;
|
||||
|
||||
\ SAVE-INPUT and RESTORE-INPUT within a single block
|
||||
: TCSIRIR2-EXPECTED S" EDCBCBA" ; \ Remember that the string comes out backwards
|
||||
: TCSIRIR2 ( blk -- )
|
||||
C/L 1024 U< IF
|
||||
BLANK-BUFFER
|
||||
S" 0 T-CNT !" WRITE-BLOCK-LINE
|
||||
S" <# MARK A SAVE-INPUT MARK B" WRITE-BLOCK-LINE
|
||||
S" 1 T-CNT +! MARK C ' RESTORE-INPUT T-CNT @ 2 < ?EXECUTE MARK D" WRITE-BLOCK-LINE
|
||||
S" MARK E 0 0 #>" WRITE-BLOCK-LINE
|
||||
UPDATE SAVE-BUFFERS DROP
|
||||
ELSE
|
||||
S" 0 TCSIRIR2-EXPECTED" WRITE-BLOCK
|
||||
THEN ;
|
||||
T{ RND-TEST-BLOCK DUP TCSIRIR2 LOAD TCSIRIR2-EXPECTED S= -> 0 TRUE }T
|
||||
\vf : TCSIRIR2-EXPECTED S" EDCBCBA" ; \ Remember that the string comes out backwards
|
||||
\vf : TCSIRIR2 ( blk -- )
|
||||
\vf C/L 1024 U< IF
|
||||
\vf BLANK-BUFFER
|
||||
\vf S" 0 T-CNT !" WRITE-BLOCK-LINE
|
||||
\vf S" <# MARK A SAVE-INPUT MARK B" WRITE-BLOCK-LINE
|
||||
\vf S" 1 T-CNT +! MARK C ' RESTORE-INPUT T-CNT @ 2 < ?EXECUTE MARK D" WRITE-BLOCK-LINE
|
||||
\vf S" MARK E 0 0 #>" WRITE-BLOCK-LINE
|
||||
\vf UPDATE SAVE-BUFFERS DROP
|
||||
\vf ELSE
|
||||
\vf S" 0 TCSIRIR2-EXPECTED" WRITE-BLOCK
|
||||
\vf THEN ;
|
||||
\vf T{ RND-TEST-BLOCK DUP TCSIRIR2 LOAD TCSIRIR2-EXPECTED S= -> 0 TRUE }T
|
||||
|
||||
\ REFILL across 2 blocks
|
||||
: TCSIRIR3 ( blks -- )
|
||||
DUP S" 1 2 3 REFILL 4 5 6" WRITE-BLOCK
|
||||
1+ S" 10 11 12" WRITE-BLOCK ;
|
||||
T{ 2 RND-TEST-BLOCK-SEQ DUP TCSIRIR3 LOAD -> 1 2 3 -1 10 11 12 }T
|
||||
\vf : TCSIRIR3 ( blks -- )
|
||||
\vf DUP S" 1 2 3 REFILL 4 5 6" WRITE-BLOCK
|
||||
\vf 1+ S" 10 11 12" WRITE-BLOCK ;
|
||||
\vf T{ 2 RND-TEST-BLOCK-SEQ DUP TCSIRIR3 LOAD -> 1 2 3 -1 10 11 12 }T
|
||||
|
||||
\ SAVE-INPUT and RESTORE-INPUT across 2 blocks
|
||||
: TCSIRIR4-EXPECTED S" HGF1ECBF1ECBA" ; \ Remember that the string comes out backwards
|
||||
: TCSIRIR4 ( blks -- )
|
||||
C/L 1024 U< IF
|
||||
DUP BLANK-BUFFER
|
||||
S" 0 T-CNT !" WRITE-BLOCK-LINE
|
||||
S" <# MARK A SAVE-INPUT MARK B" WRITE-BLOCK-LINE
|
||||
S" MARK C REFILL MARK D" WRITE-BLOCK-LINE
|
||||
DROP UPDATE 1+ BLANK-BUFFER
|
||||
S" MARK E ABS CHAR 0 + HOLD" WRITE-BLOCK-LINE
|
||||
S" 1 T-CNT +! MARK F ' RESTORE-INPUT T-CNT @ 2 < ?EXECUTE MARK G" WRITE-BLOCK-LINE
|
||||
S" MARK H 0 0 #>" WRITE-BLOCK-LINE
|
||||
DROP UPDATE SAVE-BUFFERS
|
||||
ELSE
|
||||
S" 0 TCSIRIR4-EXPECTED" WRITE-BLOCK
|
||||
THEN ;
|
||||
T{ 2 RND-TEST-BLOCK-SEQ DUP TCSIRIR4 LOAD TCSIRIR4-EXPECTED S= -> 0 TRUE }T
|
||||
\vf : TCSIRIR4-EXPECTED S" HGF1ECBF1ECBA" ; \ Remember that the string comes out backwards
|
||||
\vf : TCSIRIR4 ( blks -- )
|
||||
\vf C/L 1024 U< IF
|
||||
\vf DUP BLANK-BUFFER
|
||||
\vf S" 0 T-CNT !" WRITE-BLOCK-LINE
|
||||
\vf S" <# MARK A SAVE-INPUT MARK B" WRITE-BLOCK-LINE
|
||||
\vf S" MARK C REFILL MARK D" WRITE-BLOCK-LINE
|
||||
\vf DROP UPDATE 1+ BLANK-BUFFER
|
||||
\vf S" MARK E ABS CHAR 0 + HOLD" WRITE-BLOCK-LINE
|
||||
\vf S" 1 T-CNT +! MARK F ' RESTORE-INPUT T-CNT @ 2 < ?EXECUTE MARK G" WRITE-BLOCK-LINE
|
||||
\vf S" MARK H 0 0 #>" WRITE-BLOCK-LINE
|
||||
\vf DROP UPDATE SAVE-BUFFERS
|
||||
\vf ELSE
|
||||
\vf S" 0 TCSIRIR4-EXPECTED" WRITE-BLOCK
|
||||
\vf THEN ;
|
||||
\vf T{ 2 RND-TEST-BLOCK-SEQ DUP TCSIRIR4 LOAD TCSIRIR4-EXPECTED S= -> 0 TRUE }T
|
||||
|
||||
\ ------------------------------------------------------------------------------
|
||||
TESTING THRU
|
||||
|
||||
@ -29,6 +29,11 @@ include coreplustest.fth
|
||||
|
||||
(64 include doubletest.fth C)
|
||||
|
||||
(64 1 drive C)
|
||||
(64 include blocktest.fth C)
|
||||
|
||||
(64 REPORT-ERRORS C)
|
||||
|
||||
logclose
|
||||
|
||||
dos s0:notdone
|
||||
|
||||
@ -128,13 +128,147 @@ End of Core Extension word tests
|
||||
doubletest.fth*****************
|
||||
End of Double-Number word tests
|
||||
|
||||
blocktest.fth**=== NOT TESTED === *******Scr 21 Dr 1
|
||||
0 Should show a (mostly) blank screen
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
16
|
||||
17
|
||||
18
|
||||
19
|
||||
20
|
||||
21
|
||||
22
|
||||
23
|
||||
24
|
||||
Scr 20 Dr 1
|
||||
0 List of the First test block
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
16
|
||||
17
|
||||
18
|
||||
19
|
||||
20
|
||||
21
|
||||
22
|
||||
23
|
||||
24
|
||||
Scr 29 Dr 1
|
||||
0 List of the Last test block
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
16
|
||||
17
|
||||
18
|
||||
19
|
||||
20
|
||||
21
|
||||
22
|
||||
23
|
||||
24
|
||||
Scr 25 Dr 1
|
||||
0
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
16
|
||||
17
|
||||
18
|
||||
19
|
||||
20
|
||||
21
|
||||
22
|
||||
23
|
||||
24 End of Screen
|
||||
Scr 21 Dr 1
|
||||
0 Should show another (mostly) blank scree
|
||||
1
|
||||
2
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
8
|
||||
9
|
||||
10
|
||||
11
|
||||
12
|
||||
13
|
||||
14
|
||||
15
|
||||
16
|
||||
17
|
||||
18
|
||||
19
|
||||
20
|
||||
21
|
||||
22
|
||||
23
|
||||
24
|
||||
*** | exists Given Characters per Line: 41
|
||||
*
|
||||
End of Block word tests
|
||||
|
||||
---------------------------
|
||||
Error Report
|
||||
Word Set Errors
|
||||
---------------------------
|
||||
Core 0
|
||||
Core extension 0
|
||||
Block -
|
||||
Block 0
|
||||
Double number 0
|
||||
Exception -
|
||||
Facility -
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user