6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-12-22 21:29:32 +00:00
Code Issues Projects Releases Wiki Activity

Create the test3 for v4th3.com and add a first compiling version of

Browse Source 
vf-file.fth to the forked source v4th3.fth, with separate test.
This commit is contained in:
Philip Zembrod 2024-11-09 05:50:00 +01:00
parent 3a8650ea3c
commit 2cb921222a
4 changed files with 305 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
8080/CPM/Makefile
View File

@ -90,7 +90,7 @@ $(patsubst %, $(cpmfilesdir)/%, kernel.com \
"include log2file.fb" \
"logopen" \
"include ass8080.fb" \
"include xinout.fb" \
".( include xinout.fb) cr" \
"include savesys.fb" \
"$50 constant /tib" \
"include include.fb" \
@ -121,15 +121,15 @@ $(cpmfilesdir)/v4th.com: \
$(cpmfilesdir)/v4th3.com: \
$(patsubst %, $(cpmfilesdir)/%, tc-base.com \
target.fb v4th.fth vf-core.fth vf-io.fth \
vf-bufs.fth vf-sys.fth vf-file.fth vf-end.fth vf-bdos.fth) \
target.fb v4th3.fth vf-core.fth vf-io.fth \
vf-bufs.fth vf-sys.fth vf-file1.fth vf-end.fth vf-bdos.fth) \
Makefile | emu
rm -f $(runcpmdir)/A/0/V4TH.COM $(runcpmdir)/A/0/LOGFILE.TXT $@
./emulator/run-in-runcpm.sh \
"tc-base" \
"logopen" \
"include target.fb" \
"include v4th.fth" \
"include v4th3.fth" \
"logclose" \
"bye" \
"exit"
@ -209,6 +209,22 @@ test-blk.log: \
"exit"
dos2unix -n $(runcpmdir)/logfile.txt $@
test3.log: \
$(patsubst %, $(cpmfilesdir)/%, v4th3.com fileint.fb \
include.fb log2file.fb core.fr) \
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth) \
tests/empty.fb) | emu
./emulator/run-in-runcpm.sh \
"v4th3 fileint.fb" \
"1 load onlyforth" \
"use include.fb" \
"onlyforth dos also forth definitions" \
"1 1 thru" \
"include test-blk.fth" \
"bye" \
"exit"
dos2unix -n $(runcpmdir)/logfile.txt $@
emu: $(runcpmdir)/RunCPM
test-min.golden: $(patsubst %, tests/golden/%.golden, prelim core)
@ -222,6 +238,10 @@ test-blk.golden: $(patsubst %, tests/golden/%.golden, \
prelim core coreplus coreext doubltst block report-blk)
cat $^ > $@
test3.golden: $(patsubst %, tests/golden/%.golden, \
prelim core coreplus coreext doubltst block report-blk)
cat $^ > $@
test-kernel.golden: $(patsubst %, tests/golden/%.golden, prelim core)
cat $^ > $@

33
8080/CPM/src/v4th3.fth Normal file
View File

@ -0,0 +1,33 @@
Onlyforth
: status
." here " here u.
." there " there u.
." displaced there " there displace @ + u.
." heap " heap u. cr
;
\ ' status is .status
$8000 displace !
Target definitions $100 here!
.( order1 ) order
include vf-core.fth
.( order2 ) order
include vf-io.fth
.( order3 ) order
include vf-bufs.fth
.( order4 ) order
include vf-sys.fth
.( order5 ) order
include vf-bdos.fth
\ Target definitions
.( order6 ) order
include vf-file1.fth
.( order7 ) order
include vf-end.fth
cr .( unresolved: ) .unresolved ( ' .blk is .status )
save-target V4TH.COM

170
8080/CPM/src/vf-file.fth Normal file
View File

@ -0,0 +1,170 @@
\ *** Block No. 0, Hexblock 0
\ include for stream sources for cp/m phz 30aug23
\ *** Block No. 1, Hexblock 1
\ 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 7 +thru
\ *** Block No. 2, Hexblock 2
\ fib /fib #fib eolf? phz 09okt24
\ context @ dos also context !
\ $50 constant /tib
variable tibeof tibeof off
$1a constant ctrl-z
: eolf? ( c -- f )
\ f=-1: not yet eol; store c and continue
\ f=0: eol but not yet eof; return line and flag continue
\ f=1: eof: return line and flag eof
tibeof off
dup #lf = IF drop 0 exit THEN
ctrl-z = IF tibeof on 1 ELSE -1 THEN ;
\ *** Block No. 3, Hexblock 3
\ incfile incpos inc-fgetc phz 02sep23
variable incfile
variable increc
variable rec-offset
$80 constant dmabuf | $ff constant dmabuf-last
: readrec ( fcb -- f )
dup cr+ex@ increc !
rec-offset off dmabuf dma! drive iread-seq ;
: inc-fgetc ( -- c )
rec-offset @ b/rec u< 0=
IF incfile @ readrec IF ctrl-z exit THEN THEN
rec-offset @ dmabuf + c@ 1 rec-offset +! ;
\ *** Block No. 4, Hexblock 4
\ freadline probe-for-fb phz 25aug23
: freadline ( -- eof )
tib /tib bounds DO
inc-fgetc dup eolf? under 0< IF I c! ELSE drop THEN
0< 0= IF I tib - #tib ! ENDLOOP tibeof @ exit THEN
LOOP /tib #tib !
." warning: line exteeds max " /tib . cr
." extra chars ignored" cr
BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ;
| : probe-for-fb ( -- flag )
dmabuf BEGIN dup c@ #lf = IF drop 0 exit THEN
1+ dup dmabuf-last u> UNTIL drop 1 ;
\ *** Block No. 5, Hexblock 5
\ save/restoretib phz 06okt22
$50 constant /stash
create stash[ /stash allot here constant ]stash
variable stash> stash[ stash> !
: savetib ( -- n )
#tib @ >in @ - dup stash> @ + ]stash u>
abort" tib stash overflow" >r
tib >in @ + stash> @ r@ cmove
r@ stash> +! r> ;
: restoretib ( n -- )
dup >r negate stash> +! stash> @ tib r@ cmove
r> #tib ! >in off ;
\ *** Block No. 6, Hexblock 6
\ interpret-via-tib inner-include phz 02sep23
: interpret-via-tib
BEGIN freadline >r .status >in off interpret r> UNTIL ;
: 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 !
savetib >r interpret-via-tib close r> restoretib ;
\ *** Block No. 7, Hexblock 7
\ 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
\ : \needs have 0=exit
\ blk @ IF >in @ negate c/l mod >in +!
\ ELSE #tib @ >in ! THEN ;

78
8080/CPM/src/vf-file1.fth Normal file
View File

@ -0,0 +1,78 @@
\ target dos also target definitions
\ ' 2+ | Alias >dosfcb
: read-seq ( dosfcb -- f ) $14 bdosa dos-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! ;
variable tibeof tibeof off
$1a constant ctrl-z
: eolf? ( c -- f )
\ f=-1: not yet eol; store c and continue
\ f=0: eol but not yet eof; return line and flag continue
\ f=1: eof: return line and flag eof
tibeof off
dup #lf = IF drop 0 exit THEN
ctrl-z = IF tibeof on 1 ELSE -1 THEN ;
variable incfile
variable increc
variable rec-offset
$80 constant dmabuf | $ff constant dmabuf-last
.( line 27 )
: readrec ( fcb -- f )
dup cr+ex@ increc !
rec-offset off dmabuf dma! >dosfcb read-seq ;
: inc-fgetc ( -- c )
rec-offset @ b/rec u< 0=
IF incfile @ readrec IF ctrl-z exit THEN THEN
rec-offset @ dmabuf + c@ 1 rec-offset +! ;
: freadline ( -- eof )
tib /tib bounds DO
inc-fgetc dup eolf? under 0< IF I c! ELSE drop THEN
0< 0= IF I tib - #tib ! ENDLOOP tibeof @ exit THEN
LOOP /tib #tib !
." warning: line exteeds max " /tib . cr
." extra chars ignored" cr
BEGIN inc-fgetc eolf? 1+ UNTIL tibeof @ ;
| : probe-for-fb ( -- flag )
dmabuf BEGIN dup c@ #lf = IF drop 0 exit THEN
1+ dup dmabuf-last u> UNTIL drop 1 ;
.( line 50 )
$50 constant /stash
create stash[ /stash allot here constant ]stash
variable stash> stash[ stash> !
: savetib ( -- n )
#tib @ >in @ - dup stash> @ + ]stash u>
abort" tib stash overflow" >r
tib >in @ + stash> @ r@ cmove
r@ stash> +! r> ;
: restoretib ( n -- )
dup >r negate stash> +! stash> @ tib r@ cmove
r> #tib ! >in off ;
: interpret-via-tib
BEGIN freadline >r .status >in off interpret r> UNTIL ;
: include-inner ( -- )
increc push 0 isfile@ cr+ex!
isfile@ readrec Abort" can't read start of file"
probe-for-fb IF ." regular load " 1 load exit THEN
." stream include "
incfile push isfile@ incfile !
savetib >r interpret-via-tib isfile@ closefile r> restoretib ;