mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-08-05 19:25:41 +00:00
Read the last record of the outer include again, after an inner include.
This commit is contained in:
Philip Zembrod
@@ -16,7 +16,7 @@ clean:
|
||||
rm -rf $(runcpmdir)
|
||||
rm -f msdos
|
||||
|
||||
test: logtest.result inctest.result test-std.result
|
||||
test: logtest.result inctest.result test-std.result test-min.result
|
||||
|
||||
run-editor: | msdos
|
||||
FORTHPATH="f:\\src;f:\\tests;f:\\msdos" \
|
||||
@@ -31,6 +31,12 @@ src/%.fth: src/%.fb ../../tools/fb2fth.py
|
||||
tests/%.fth: tests/%.fb ../../tools/fb2fth.py
|
||||
../../tools/fb2fth.py $< $@
|
||||
|
||||
run-volks4th: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, volks4th.com) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"volks4th"
|
||||
|
||||
logtest.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, volks4th.com) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, tests/log2file.fb) \
|
||||
@@ -90,6 +96,25 @@ test-std.log: \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
test-min.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) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, tests/tester.fth) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, tests/core.fr) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, tests/test-min.fth) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"volks4th" \
|
||||
"include include.fb" \
|
||||
"include log2file.fb" \
|
||||
"include test-min.fth" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
emu: $(runcpmdir)/RunCPM
|
||||
|
||||
%.golden: tests/golden/%.golden
|
||||
|
||||
File diff suppressed because one or more lines are too long
@@ -1,37 +1,37 @@
|
||||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ include for stream sources for cp/m phz 10apr23
|
||||
\ include for stream sources for cp/m phz 30aug23
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ loadscreen content while debugging read-seq esp. dos-error?
|
||||
|
||||
1 +load \ /tib tibeof eolf?
|
||||
create tib /tib 1+ allot variable #tib #tib off
|
||||
2 3 +thru
|
||||
: pushfile r> isfile push fromfile push >r ; restrict
|
||||
: iopen ( -- )
|
||||
pushfile use cr file?
|
||||
isfile@ incfile ! b/rec rec-offset c!
|
||||
incpos push incpos off incpos 2+ dup push off
|
||||
0 incfile @ record 1- c! ;
|
||||
: iread ( -- )
|
||||
freadline cr . cr tib #tib @ type cr ;
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ load screen phz 06mai23
|
||||
\ load screen phz 02sep23
|
||||
|
||||
onlyforth dos also forth definitions
|
||||
|
||||
: idos-error? ( n -- f ) 0<> ;
|
||||
: iread-seq ( dosfcb -- f ) $14 bdosa idos-error? ;
|
||||
: cr+ex@ ( fcb -- cr+256*ex )
|
||||
dup &34 + c@ swap &14 + c@ $100 * + ;
|
||||
: cr+ex! ( cr+256*ex fcb -- )
|
||||
>r $100 u/mod r@ &14 + c! r> &34 + c! ;
|
||||
|
||||
1 6 +thru
|
||||
|
||||
|
||||
|
||||
|
||||
1 7 +thru
|
||||
|
||||
|
||||
|
||||
@@ -58,21 +58,21 @@
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ incfile incpos inc-fgetc phz 25aug23
|
||||
\ incfile incpos inc-fgetc phz 02sep23
|
||||
|
||||
variable incfile
|
||||
variable incpos 2 allot
|
||||
create rec-offset 1 allot
|
||||
variable increc
|
||||
variable rec-offset
|
||||
$80 constant dmabuf | $ff constant dmabuf-last
|
||||
|
||||
: readrec ( fcb -- f )
|
||||
0 rec-offset c! dmabuf dma! drive iread-seq ;
|
||||
dup cr+ex@ increc !
|
||||
rec-offset off dmabuf dma! drive iread-seq ;
|
||||
|
||||
: inc-fgetc ( -- c )
|
||||
rec-offset c@ b/rec u< 0=
|
||||
rec-offset @ b/rec u< 0=
|
||||
IF incfile @ readrec IF ctrl-z exit THEN THEN
|
||||
rec-offset c@ dup 1+ rec-offset c! dmabuf + c@ ;
|
||||
|
||||
rec-offset @ dmabuf + c@ 1 rec-offset +! ;
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
@@ -115,26 +115,50 @@
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ interpret-via-tib include phz 25aug23
|
||||
\ interpret-via-tib inner-include phz 02sep23
|
||||
|
||||
: interpret-via-tib
|
||||
BEGIN freadline >r .status >in off interpret r> UNTIL ;
|
||||
|
||||
: pushfile r> isfile push fromfile push >r ; restrict
|
||||
: include ( -- )
|
||||
pushfile use cr file?
|
||||
0 isfile@ record 1- c! isfile@ readrec IF close exit THEN
|
||||
probe-for-fb IF 1 load exit THEN
|
||||
: include-inner ( -- )
|
||||
increc push 0 isfile@ cr+ex!
|
||||
isfile@ readrec Abort" can't read start of file"
|
||||
probe-for-fb IF 1 load exit THEN
|
||||
incfile push isfile@ incfile !
|
||||
incpos push incpos off incpos 2+ dup push off
|
||||
savetib >r interpret-via-tib close r> restoretib ;
|
||||
: (stashquit stash[ stash> ! (quit ;
|
||||
: stashrestore ['] (stashquit IS 'quit ;
|
||||
' stashrestore IS 'restart
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ \ phz 25aug23
|
||||
\ include phz 02sep23
|
||||
|
||||
: include ( -- )
|
||||
rec-offset push isfile push fromfile push
|
||||
use cr file?
|
||||
include-inner
|
||||
incfile @
|
||||
IF increc @ incfile @ cr+ex!
|
||||
incfile @ readrec Abort" error re-reading after include"
|
||||
THEN ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ \ phz 02sep23
|
||||
|
||||
: (stashquit stash[ stash> ! incfile off increc off
|
||||
(quit ;
|
||||
: stashrestore ['] (stashquit IS 'quit ;
|
||||
' stashrestore IS 'restart
|
||||
|
||||
: \ blk @ IF >in @ negate c/l mod >in +!
|
||||
ELSE #tib @ >in ! THEN ; immediate
|
||||
@@ -145,27 +169,3 @@
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
65
8080/CPM/tests/golden/test-min.golden
Normal file
65
8080/CPM/tests/golden/test-min.golden
Normal file
@@ -0,0 +1,65 @@
|
||||
|
||||
ANS-SHIM.FTH
|
||||
PRELIM.FTH
|
||||
|
||||
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
|
||||
|
||||
( 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
|
||||
( Pass #4: testing @ ! BASE ) 0 1+ 1+ BASE ! BASE @ >IN +! xxSOURCE TYPE CR
|
||||
( Pass #5: testing decimal BASE ) BASE @ >IN +! xxxxxxxxxxSOURCE TYPE CR
|
||||
( Pass #6: testing : ; ) : .SRC SOURCE TYPE CR ; 6 >IN +! xxxxxx.SRC
|
||||
( Pass #7: testing number input ) 19 >IN +! xxxxxxxxxxxxxxxxxxx.SRC
|
||||
( Pass #8: testing VARIABLE ) VARIABLE Y 2 Y ! Y @ >IN +! xx.SRC
|
||||
( Pass #9: testing WORD COUNT ) 5 MSG abcdef) Y ! Y ! >IN +! xxxxx.SRC
|
||||
( Pass #10: testing WORD COUNT ) MSG ab) >IN +! xxY ! .SRC
|
||||
Pass #11: testing WORD COUNT .MSG
|
||||
Pass #12: testing = returns all 1's for true
|
||||
Pass #13: testing = returns 0 for false
|
||||
Pass #14: testing -1 interpreted correctly
|
||||
Pass #15: testing 2*
|
||||
Pass #16: testing 2*
|
||||
Pass #17: testing AND
|
||||
Pass #18: testing AND
|
||||
Pass #19: testing AND
|
||||
Pass #20: testing ?F~ ?~~ Pass Error
|
||||
Pass #21: testing ?~
|
||||
Pass #22: testing EMIT
|
||||
Pass #23: testing S"
|
||||
|
||||
Results:
|
||||
|
||||
Pass messages #1 to #23 should be displayed above
|
||||
and no error messages
|
||||
|
||||
0 tests failed out of 57 additional tests
|
||||
|
||||
|
||||
--- End of Preliminary Tests ---
|
||||
|
||||
TESTER.FTH ERROR exists
|
||||
CORE.FR
|
||||
*********************YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:
|
||||
!"#$%&'()*+,-./0123456789:;<=>?@
|
||||
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
|
||||
abcdefghijklmnopqrstuvwxyz{|}~
|
||||
YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:
|
||||
0 1 2 3 4 5 6 7 8 9
|
||||
YOU SHOULD SEE 0-9 (WITH NO SPACES):
|
||||
0123456789
|
||||
YOU SHOULD SEE A-G SEPARATED BY A SPACE:
|
||||
A B C D E F G
|
||||
YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:
|
||||
0 1 2 3 4 5
|
||||
YOU SHOULD SEE TWO SEPARATE LINES:
|
||||
LINE 1
|
||||
LINE 2
|
||||
YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:
|
||||
SIGNED: -8000 7FFF
|
||||
UNSIGNED: 0 FFFF
|
||||
** GDX exists
|
||||
End of Core word set tests
|
||||
|
||||
14
8080/CPM/tests/test-min.fth
Normal file
14
8080/CPM/tests/test-min.fth
Normal file
@@ -0,0 +1,14 @@
|
||||
|
||||
\ include log2file.fb
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
|
||||
logclose
|
||||
Reference in New Issue
Block a user