mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-01-02 14:30:35 +00:00
Merge pull request #54 from pzembrod/cpm-msdos-cleanup
Cpm msdos cleanup
This commit is contained in:
Philip Zembrod
GitHub
commit
023334fdb2
@ -1,9 +1,9 @@
|
||||
|
||||
srcfbfiles = $(wildcard src/*.fb)
|
||||
srcfthfiles = $(patsubst src/%.fb, src/%.fth, $(srcfbfiles))
|
||||
srcfbtxtfiles = $(patsubst src/%.fb, src/%.fb.txt, $(srcfbfiles))
|
||||
testsfbfiles = $(wildcard tests/*.fb)
|
||||
testsfthfiles = $(patsubst tests/%.fb, tests/%.fth, $(testsfbfiles))
|
||||
fthfiles = $(srcfthfiles) $(testsfthfiles)
|
||||
testsfbtxtfiles = $(patsubst tests/%.fb, tests/%.fb.txt, $(testsfbfiles))
|
||||
fb_txt_files = $(srcfbtxtfiles) $(testsfbtxtfiles)
|
||||
|
||||
whitch_runcpm = $(shell which RunCPM)
|
||||
runcpmdir = runcpm
|
||||
@ -11,7 +11,7 @@ cpmfilesdir = cpmfiles
|
||||
|
||||
bin: $(cpmfilesdir)/v4th.com
|
||||
|
||||
fth: $(fthfiles)
|
||||
fb.txt: $(fb_txt_files)
|
||||
|
||||
clean:
|
||||
rm -f *.log *.golden *.result
|
||||
@ -34,10 +34,10 @@ run-editor: | msdos
|
||||
msdos:
|
||||
ln -s ../../8086/msdos msdos
|
||||
|
||||
src/%.fth: src/%.fb ../../tools/fb2fth.py
|
||||
$(srcfbtxtfiles): src/%.fb.txt: src/%.fb ../../tools/fb2fth.py
|
||||
../../tools/fb2fth.py $< $@
|
||||
|
||||
tests/%.fth: tests/%.fb ../../tools/fb2fth.py
|
||||
$(testsfbtxtfiles): tests/%.fb.txt: tests/%.fb ../../tools/fb2fth.py
|
||||
../../tools/fb2fth.py $< $@
|
||||
|
||||
run-volks4th: \
|
||||
@ -66,7 +66,7 @@ logtest.log: \
|
||||
|
||||
inctest.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, kernel.com fileint.fb \
|
||||
include.fb log2file.fb inctest.fth) \
|
||||
include.fb log2file.fb inctest.fs) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"kernel fileint.fb" \
|
||||
@ -75,19 +75,19 @@ inctest.log: \
|
||||
"include include.fb" \
|
||||
"include log2file.fb" \
|
||||
"logopen" \
|
||||
"include inctest.fth" \
|
||||
"include inctest.fs" \
|
||||
"logclose" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
$(cpmfilesdir)/tc-base.com: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, kernel.com \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4th-4tc.com \
|
||||
fileint.fb ass8080.fb include.fb log2file.fb xinout.fb savesys.fb) \
|
||||
Makefile | emu
|
||||
rm -f $(runcpmdir)/A/0/TC-BASE.COM $@
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"kernel fileint.fb" \
|
||||
"v4th-4tc fileint.fb" \
|
||||
"1 load" \
|
||||
"include log2file.fb" \
|
||||
"logopen" \
|
||||
@ -104,17 +104,38 @@ $(patsubst %, $(cpmfilesdir)/%, kernel.com \
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@.log
|
||||
cp -f $(runcpmdir)/A/0/TC-BASE.COM $@
|
||||
|
||||
$(cpmfilesdir)/tc-base2.com: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fs \
|
||||
ass8080.fb include.fb log2file.fb xinout.fb savesys.fb) \
|
||||
Makefile | emu
|
||||
rm -f $(runcpmdir)/A/0/TC-BASE.COM $@
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"v4thblk sfileint.fs" \
|
||||
"include-isfile" \
|
||||
"include log2file.fb" \
|
||||
"logopen" \
|
||||
"include ass8080.fb" \
|
||||
".( include xinout.fb) cr" \
|
||||
"include savesys.fb" \
|
||||
"cr decimal caps on" \
|
||||
"scr off r# off savesystem tc-base.com" \
|
||||
"logclose" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@.log
|
||||
cp -f $(runcpmdir)/A/0/TC-BASE.COM $@
|
||||
|
||||
$(cpmfilesdir)/v4th.com: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, tc-base.com \
|
||||
target.fb v4th.fth vf-core.fth vf-file.fth \
|
||||
vf-io.fth vf-sys.fth vf-end.fth vf-bdos.fth) \
|
||||
target.fb v4th.fs vf-core.fs vf-file.fs \
|
||||
vf-io.fs vf-sys.fs vf-end.fs vf-bdos.fs) \
|
||||
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 v4th.fs" \
|
||||
"logclose" \
|
||||
"bye" \
|
||||
"exit"
|
||||
@ -123,15 +144,15 @@ $(cpmfilesdir)/v4th.com: \
|
||||
|
||||
$(cpmfilesdir)/v4thblk.com: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, tc-base.com \
|
||||
target.fb v4thblk.fth vf-core.fth vf-file.fth \
|
||||
vf-io.fth vf-bufs.fth vf-sys.fth vf-end.fth vf-bdos.fth) \
|
||||
target.fb v4thblk.fs vf-core.fs vf-file.fs \
|
||||
vf-io.fs vf-bufs.fs vf-sys.fs vf-end.fs vf-bdos.fs) \
|
||||
Makefile | emu
|
||||
rm -f $(runcpmdir)/A/0/V4THBLK.COM $(runcpmdir)/A/0/LOGFILE.TXT $@
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"tc-base" \
|
||||
"logopen" \
|
||||
"include target.fb" \
|
||||
"include v4thblk.fth" \
|
||||
"include v4thblk.fs" \
|
||||
"logclose" \
|
||||
"bye" \
|
||||
"exit"
|
||||
@ -140,58 +161,58 @@ $(cpmfilesdir)/v4thblk.com: \
|
||||
|
||||
test-kernel.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, kernel.com fileint.fb \
|
||||
include.fb log2file.fb core.fr) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth)) \
|
||||
include.fb log2file.fb core.fs) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fs)) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"kernel fileint.fb" \
|
||||
"1 load onlyforth" \
|
||||
"$50 constant /tib" \
|
||||
"include include.fb" \
|
||||
"include test-krn.fth" \
|
||||
"include test-krn.fs" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
test-min.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4th.com sfileint.fth \
|
||||
logfile.fth \
|
||||
ans-shim.fth prelim.fth tester.fth core.fr test-min.fth) \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4th.com sfileint.fs \
|
||||
logfile.fs \
|
||||
ans-shim.fs prelim.fs tester.fs core.fs test-min.fs) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"v4th sfileint.fth" \
|
||||
"v4th sfileint.fs" \
|
||||
"include-isfile" \
|
||||
"onlyforth" \
|
||||
"include test-min.fth" \
|
||||
"include test-min.fs" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
test-std.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4th.com sfileint.fth \
|
||||
logfile.fth core.fr) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth)) \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4th.com sfileint.fs \
|
||||
logfile.fs core.fs) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fs)) \
|
||||
| emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"v4th sfileint.fth" \
|
||||
"v4th sfileint.fs" \
|
||||
"include-isfile" \
|
||||
"onlyforth" \
|
||||
"include test-std.fth" \
|
||||
"include test-std.fs" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
test-blk.log: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fth \
|
||||
sblkint.fth logfile.fth core.fr) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth) \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fs \
|
||||
sblkint.fs log2file.fb core.fs) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fs) \
|
||||
tests/empty.fb) | emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"v4thblk sfileint.fth" \
|
||||
"v4thblk sfileint.fs" \
|
||||
"include-isfile" \
|
||||
"include sblkint.fth" \
|
||||
"include sblkint.fs" \
|
||||
"onlyforth" \
|
||||
"include test-blk.fth" \
|
||||
"include test-blk.fs" \
|
||||
"bye" \
|
||||
"exit"
|
||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||
|
||||
BIN
8080/CPM/cpmfiles/tc-base2.com
Normal file
BIN
8080/CPM/cpmfiles/tc-base2.com
Normal file
Binary file not shown.
26
8080/CPM/cpmfiles/test-blk.fs
Normal file
26
8080/CPM/cpmfiles/test-blk.fs
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
include log2file.fb \ so that include with block file gets tested
|
||||
' noop Is .status
|
||||
logopen
|
||||
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
\ 1 verbose !
|
||||
include core.fs
|
||||
include coreplus.fs
|
||||
|
||||
include util.fs
|
||||
include errorrep.fs
|
||||
|
||||
include coreext.fs
|
||||
include doubltst.fs
|
||||
|
||||
include block.fs
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
|
||||
@ -1,26 +0,0 @@
|
||||
|
||||
include logfile.fth
|
||||
' noop Is .status
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
include coreplus.fth
|
||||
|
||||
include util.fth
|
||||
include errorrep.fth
|
||||
|
||||
include coreext.fth
|
||||
include doubltst.fth
|
||||
|
||||
include block.fth
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
|
||||
22
8080/CPM/cpmfiles/test-krn.fs
Normal file
22
8080/CPM/cpmfiles/test-krn.fs
Normal file
@ -0,0 +1,22 @@
|
||||
|
||||
include log2file.fb
|
||||
logopen
|
||||
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fs
|
||||
include coreplus.fs
|
||||
|
||||
include util.fs
|
||||
include errorrep.fs
|
||||
|
||||
include coreext.fs
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
@ -1,22 +0,0 @@
|
||||
|
||||
include log2file.fb
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
include coreplus.fth
|
||||
|
||||
include util.fth
|
||||
include errorrep.fth
|
||||
|
||||
include coreext.fth
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
14
8080/CPM/cpmfiles/test-min.fs
Normal file
14
8080/CPM/cpmfiles/test-min.fs
Normal file
@ -0,0 +1,14 @@
|
||||
|
||||
include logfile.fs
|
||||
logopen
|
||||
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fs
|
||||
|
||||
logclose
|
||||
@ -1,14 +0,0 @@
|
||||
|
||||
include logfile.fth
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
|
||||
logclose
|
||||
@ -3,26 +3,26 @@
|
||||
\ blk @ ?dup IF ." Blk " u. ?cr exit THEN
|
||||
\ incfile @ IF tib #tib @ cr type THEN ;
|
||||
|
||||
include logfile.fth
|
||||
include logfile.fs
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
include coreplus.fth
|
||||
include core.fs
|
||||
include coreplus.fs
|
||||
|
||||
include util.fth
|
||||
include errorrep.fth
|
||||
include util.fs
|
||||
include errorrep.fs
|
||||
|
||||
include coreext.fth
|
||||
include coreext.fs
|
||||
|
||||
\ ' .blk|tib Is .status
|
||||
|
||||
include doubltst.fth
|
||||
include doubltst.fs
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
BIN
8080/CPM/cpmfiles/v4th-4tc.com
Normal file
BIN
8080/CPM/cpmfiles/v4th-4tc.com
Normal file
Binary file not shown.
Binary file not shown.
24
8080/CPM/cpmfiles/v4th.fs
Normal file
24
8080/CPM/cpmfiles/v4th.fs
Normal file
@ -0,0 +1,24 @@
|
||||
|
||||
Onlyforth
|
||||
|
||||
: .pagestatus ( n -- )
|
||||
cr ." page " .
|
||||
." here " here u.
|
||||
." there " there u.
|
||||
." displaced there " there displace @ + u.
|
||||
." heap " heap u. cr
|
||||
;
|
||||
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fs
|
||||
include vf-io.fs
|
||||
include vf-sys.fs
|
||||
include vf-bdos.fs
|
||||
include vf-file.fs
|
||||
include vf-end.fs
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4TH.COM
|
||||
@ -1,15 +0,0 @@
|
||||
|
||||
Onlyforth
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fth
|
||||
include vf-io.fth
|
||||
include vf-sys.fth
|
||||
include vf-bdos.fth
|
||||
include vf-file.fth
|
||||
include vf-end.fth
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4TH.COM
|
||||
Binary file not shown.
26
8080/CPM/cpmfiles/v4thblk.fs
Normal file
26
8080/CPM/cpmfiles/v4thblk.fs
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
Onlyforth
|
||||
|
||||
: .pagestatus ( n -- )
|
||||
cr ." page " .
|
||||
." here " here u.
|
||||
." there " there u.
|
||||
." displaced there " there displace @ + u.
|
||||
." heap " heap u. cr
|
||||
;
|
||||
|
||||
$8000 displace !
|
||||
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fs
|
||||
include vf-io.fs
|
||||
include vf-sys.fs
|
||||
include vf-bdos.fs
|
||||
include vf-file.fs
|
||||
include vf-bufs.fs
|
||||
include vf-end.fs
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4THBLK.COM
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
Onlyforth
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fth
|
||||
include vf-io.fth
|
||||
include vf-bufs.fth
|
||||
include vf-sys.fth
|
||||
include vf-bdos.fth
|
||||
include vf-file.fth
|
||||
include vf-end.fth
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4THBLK.COM
|
||||
@ -1,5 +1,7 @@
|
||||
\ *** Block No. 94, Hexblock 5e
|
||||
|
||||
$5e .pagestatus
|
||||
|
||||
\ buffer mechanism 20Oct86 07Oct87
|
||||
|
||||
Variable prev 0 prev ! \ Listhead
|
||||
@ -190,6 +192,8 @@ Variable first
|
||||
|
||||
\ *** Block No. 125, Hexblock 7d
|
||||
|
||||
$7d .pagestatus
|
||||
|
||||
\ Default Disk Interface: read/write 14Feb88
|
||||
|
||||
Target Dos also
|
||||
@ -212,3 +216,27 @@ Target Dos also
|
||||
l/s 0 DO
|
||||
cr I 2 .r space scr @ block I c/l * + c/l -trailing type
|
||||
LOOP cr ;
|
||||
|
||||
|
||||
Variable loadfile
|
||||
|
||||
: (load ( blk offset -- )
|
||||
isfile push loadfile push fromfile push blk push >in push
|
||||
>in ! blk ! isfile@ loadfile ! .status interpret ;
|
||||
|
||||
: load ( blk --) ?dup 0=exit 0 (load ;
|
||||
' load IS include-load
|
||||
|
||||
|
||||
\ *** Block No. 85, Hexblock 55
|
||||
|
||||
$55 .pagestatus
|
||||
|
||||
\ +load thru +thru --> rdepth depth 20Oct86
|
||||
|
||||
: +load ( offset --) blk @ + load ;
|
||||
|
||||
: thru ( from to --) 1+ swap DO I load LOOP ;
|
||||
: +thru ( off0 off1 --) 1+ swap DO I +load LOOP ;
|
||||
|
||||
: --> 1 blk +! >in off .status ; immediate
|
||||
@ -2,6 +2,8 @@
|
||||
|
||||
\ FORTH Preamble and ID uho 19May2005
|
||||
|
||||
2 .pagestatus
|
||||
|
||||
Assembler
|
||||
|
||||
nop 0 jmp here 2- >label >boot
|
||||
@ -1543,6 +1545,8 @@ Defer parser
|
||||
|
||||
\ *** Block No. 83, Hexblock 53
|
||||
|
||||
$53 .pagestatus
|
||||
|
||||
\ ?stack 30Jun86
|
||||
| : stackfull ( -- ) depth $20 > Abort" tight stack"
|
||||
reveal last? IF dup heap? IF name> ELSE 4- THEN (forget THEN
|
||||
@ -1,5 +1,7 @@
|
||||
\ *** Block No. 116, Hexblock 74
|
||||
|
||||
$74 .pagestatus
|
||||
|
||||
\ Rest of Standard-System 04Oct87 07Oct87
|
||||
|
||||
\ 2 +load \ Operating System
|
||||
@ -19,6 +21,8 @@ Target Forth also definitions
|
||||
|
||||
\ *** Block No. 117, Hexblock 75
|
||||
|
||||
$75 .pagestatus
|
||||
|
||||
\ System patchup 04Oct87
|
||||
|
||||
$EF00 r0 !
|
||||
@ -1,4 +1,8 @@
|
||||
|
||||
$80 .pagestatus
|
||||
|
||||
Target Dos also
|
||||
|
||||
: cr+ex@ ( fcb -- cr+256*ex )
|
||||
dup &34 + c@ swap &14 + c@ $100 * + ;
|
||||
: cr+ex! ( cr+256*ex fcb -- )
|
||||
@ -61,10 +65,14 @@
|
||||
| : interpret-via-tib
|
||||
BEGIN freadline >r .status >in off interpret r> UNTIL ;
|
||||
|
||||
Defer include-load
|
||||
| : block-not-implemented 1 abort" block file access not implemented" ;
|
||||
' block-not-implemented IS include-load
|
||||
|
||||
: include-isfile ( -- )
|
||||
increc push 0 isfile@ cr+ex!
|
||||
isfile@ increadrec Abort" can't read start of file"
|
||||
probe-for-fb IF 1 load exit THEN
|
||||
probe-for-fb IF 1 include-load exit THEN
|
||||
incfile push isfile@ incfile !
|
||||
savetib >r interpret-via-tib r> restoretib
|
||||
incfile @ 2+ closefile Abort" error closing file" ;
|
||||
@ -1,5 +1,9 @@
|
||||
\ *** Block No. 84, Hexblock 54
|
||||
|
||||
$54 .pagestatus
|
||||
|
||||
Target
|
||||
|
||||
\ .status push load 20Oct86
|
||||
|
||||
Defer .status ' noop Is .status
|
||||
@ -8,26 +12,6 @@ Defer .status ' noop Is .status
|
||||
|
||||
: push ( addr -- ) r> swap dup >r @ >r pull >r >r ;
|
||||
restrict
|
||||
Variable loadfile
|
||||
|
||||
: (load ( blk offset -- )
|
||||
isfile push loadfile push fromfile push blk push >in push
|
||||
>in ! blk ! isfile@ loadfile ! .status interpret ;
|
||||
|
||||
: load ( blk --) ?dup 0=exit 0 (load ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 85, Hexblock 55
|
||||
|
||||
\ +load thru +thru --> rdepth depth 20Oct86
|
||||
|
||||
: +load ( offset --) blk @ + load ;
|
||||
|
||||
: thru ( from to --) 1+ swap DO I load LOOP ;
|
||||
: +thru ( off0 off1 --) 1+ swap DO I +load LOOP ;
|
||||
|
||||
: --> 1 blk +! >in off .status ; immediate
|
||||
|
||||
: rdepth ( -- +n) r0 @ rp@ 2+ - 2/ ;
|
||||
: depth ( -- +n) sp@ s0 @ swap - 2/ ;
|
||||
@ -167,6 +151,8 @@ $10 Constant l/s \ lines per screen
|
||||
|
||||
\ *** Block No. 93, Hexblock 5d
|
||||
|
||||
$5d .pagestatus
|
||||
|
||||
\ multitasker primitives 20Nov87
|
||||
|
||||
Code end-trace \ patch Next to its original state
|
||||
@ -1,5 +1,9 @@
|
||||
\ *** Block No. 104, Hexblock 68
|
||||
|
||||
$68 .pagestatus
|
||||
|
||||
Target
|
||||
|
||||
\ endpoints of forget 01Jul86
|
||||
|
||||
| : |? ( nfa -- flag ) c@ $20 and ;
|
||||
@ -191,6 +195,8 @@ end-code
|
||||
|
||||
\ *** Block No. 114, Hexblock 72
|
||||
|
||||
$72 .pagestatus
|
||||
|
||||
\ "search 05Mar88
|
||||
|
||||
Label notfound H pop H pop
|
||||
24
8080/CPM/src/v4th.fs
Normal file
24
8080/CPM/src/v4th.fs
Normal file
@ -0,0 +1,24 @@
|
||||
|
||||
Onlyforth
|
||||
|
||||
: .pagestatus ( n -- )
|
||||
cr ." page " .
|
||||
." here " here u.
|
||||
." there " there u.
|
||||
." displaced there " there displace @ + u.
|
||||
." heap " heap u. cr
|
||||
;
|
||||
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fs
|
||||
include vf-io.fs
|
||||
include vf-sys.fs
|
||||
include vf-bdos.fs
|
||||
include vf-file.fs
|
||||
include vf-end.fs
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4TH.COM
|
||||
@ -1,15 +0,0 @@
|
||||
|
||||
Onlyforth
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fth
|
||||
include vf-io.fth
|
||||
include vf-sys.fth
|
||||
include vf-bdos.fth
|
||||
include vf-file.fth
|
||||
include vf-end.fth
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4TH.COM
|
||||
26
8080/CPM/src/v4thblk.fs
Normal file
26
8080/CPM/src/v4thblk.fs
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
Onlyforth
|
||||
|
||||
: .pagestatus ( n -- )
|
||||
cr ." page " .
|
||||
." here " here u.
|
||||
." there " there u.
|
||||
." displaced there " there displace @ + u.
|
||||
." heap " heap u. cr
|
||||
;
|
||||
|
||||
$8000 displace !
|
||||
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fs
|
||||
include vf-io.fs
|
||||
include vf-sys.fs
|
||||
include vf-bdos.fs
|
||||
include vf-file.fs
|
||||
include vf-bufs.fs
|
||||
include vf-end.fs
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4THBLK.COM
|
||||
@ -1,16 +0,0 @@
|
||||
|
||||
Onlyforth
|
||||
$8000 displace !
|
||||
Target definitions $100 here!
|
||||
|
||||
include vf-core.fth
|
||||
include vf-io.fth
|
||||
include vf-bufs.fth
|
||||
include vf-sys.fth
|
||||
include vf-bdos.fth
|
||||
include vf-file.fth
|
||||
include vf-end.fth
|
||||
|
||||
cr .( unresolved: ) .unresolved ( ' .blk is .status )
|
||||
|
||||
save-target V4THBLK.COM
|
||||
@ -1,5 +1,7 @@
|
||||
\ *** Block No. 94, Hexblock 5e
|
||||
|
||||
$5e .pagestatus
|
||||
|
||||
\ buffer mechanism 20Oct86 07Oct87
|
||||
|
||||
Variable prev 0 prev ! \ Listhead
|
||||
@ -190,6 +192,8 @@ Variable first
|
||||
|
||||
\ *** Block No. 125, Hexblock 7d
|
||||
|
||||
$7d .pagestatus
|
||||
|
||||
\ Default Disk Interface: read/write 14Feb88
|
||||
|
||||
Target Dos also
|
||||
@ -212,3 +216,27 @@ Target Dos also
|
||||
l/s 0 DO
|
||||
cr I 2 .r space scr @ block I c/l * + c/l -trailing type
|
||||
LOOP cr ;
|
||||
|
||||
|
||||
Variable loadfile
|
||||
|
||||
: (load ( blk offset -- )
|
||||
isfile push loadfile push fromfile push blk push >in push
|
||||
>in ! blk ! isfile@ loadfile ! .status interpret ;
|
||||
|
||||
: load ( blk --) ?dup 0=exit 0 (load ;
|
||||
' load IS include-load
|
||||
|
||||
|
||||
\ *** Block No. 85, Hexblock 55
|
||||
|
||||
$55 .pagestatus
|
||||
|
||||
\ +load thru +thru --> rdepth depth 20Oct86
|
||||
|
||||
: +load ( offset --) blk @ + load ;
|
||||
|
||||
: thru ( from to --) 1+ swap DO I load LOOP ;
|
||||
: +thru ( off0 off1 --) 1+ swap DO I +load LOOP ;
|
||||
|
||||
: --> 1 blk +! >in off .status ; immediate
|
||||
@ -2,6 +2,8 @@
|
||||
|
||||
\ FORTH Preamble and ID uho 19May2005
|
||||
|
||||
2 .pagestatus
|
||||
|
||||
Assembler
|
||||
|
||||
nop 0 jmp here 2- >label >boot
|
||||
@ -1543,6 +1545,8 @@ Defer parser
|
||||
|
||||
\ *** Block No. 83, Hexblock 53
|
||||
|
||||
$53 .pagestatus
|
||||
|
||||
\ ?stack 30Jun86
|
||||
| : stackfull ( -- ) depth $20 > Abort" tight stack"
|
||||
reveal last? IF dup heap? IF name> ELSE 4- THEN (forget THEN
|
||||
@ -1,5 +1,7 @@
|
||||
\ *** Block No. 116, Hexblock 74
|
||||
|
||||
$74 .pagestatus
|
||||
|
||||
\ Rest of Standard-System 04Oct87 07Oct87
|
||||
|
||||
\ 2 +load \ Operating System
|
||||
@ -19,6 +21,8 @@ Target Forth also definitions
|
||||
|
||||
\ *** Block No. 117, Hexblock 75
|
||||
|
||||
$75 .pagestatus
|
||||
|
||||
\ System patchup 04Oct87
|
||||
|
||||
$EF00 r0 !
|
||||
@ -1,4 +1,8 @@
|
||||
|
||||
$80 .pagestatus
|
||||
|
||||
Target Dos also
|
||||
|
||||
: cr+ex@ ( fcb -- cr+256*ex )
|
||||
dup &34 + c@ swap &14 + c@ $100 * + ;
|
||||
: cr+ex! ( cr+256*ex fcb -- )
|
||||
@ -61,10 +65,14 @@
|
||||
| : interpret-via-tib
|
||||
BEGIN freadline >r .status >in off interpret r> UNTIL ;
|
||||
|
||||
Defer include-load
|
||||
| : block-not-implemented 1 abort" block file access not implemented" ;
|
||||
' block-not-implemented IS include-load
|
||||
|
||||
: include-isfile ( -- )
|
||||
increc push 0 isfile@ cr+ex!
|
||||
isfile@ increadrec Abort" can't read start of file"
|
||||
probe-for-fb IF 1 load exit THEN
|
||||
probe-for-fb IF 1 include-load exit THEN
|
||||
incfile push isfile@ incfile !
|
||||
savetib >r interpret-via-tib r> restoretib
|
||||
incfile @ 2+ closefile Abort" error closing file" ;
|
||||
@ -1,70 +0,0 @@
|
||||
|
||||
: 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 increc-offset
|
||||
| $80 constant dmabuf
|
||||
| $ff constant dmabuf-last
|
||||
|
||||
: increadrec ( fcb -- f )
|
||||
dup cr+ex@ increc !
|
||||
increc-offset off dmabuf dma! >dosfcb read-seq ;
|
||||
|
||||
| : inc-fgetc ( -- c )
|
||||
increc-offset @ b/rec u< 0=
|
||||
IF incfile @ increadrec IF ctrl-z exit THEN THEN
|
||||
increc-offset @ dmabuf + c@ 1 increc-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 ;
|
||||
|
||||
| $50 constant /stash
|
||||
| create stash[ /stash allot here | constant ]stash
|
||||
| variable stash> stash[ stash> !
|
||||
| : clear-tibstash 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-isfile ( -- )
|
||||
increc push 0 isfile@ cr+ex!
|
||||
isfile@ increadrec Abort" can't read start of file"
|
||||
probe-for-fb IF 1 load exit THEN
|
||||
incfile push isfile@ incfile !
|
||||
savetib >r interpret-via-tib r> restoretib
|
||||
incfile @ 2+ closefile Abort" error closing file" ;
|
||||
@ -1,5 +1,9 @@
|
||||
\ *** Block No. 84, Hexblock 54
|
||||
|
||||
$54 .pagestatus
|
||||
|
||||
Target
|
||||
|
||||
\ .status push load 20Oct86
|
||||
|
||||
Defer .status ' noop Is .status
|
||||
@ -8,26 +12,6 @@ Defer .status ' noop Is .status
|
||||
|
||||
: push ( addr -- ) r> swap dup >r @ >r pull >r >r ;
|
||||
restrict
|
||||
Variable loadfile
|
||||
|
||||
: (load ( blk offset -- )
|
||||
isfile push loadfile push fromfile push blk push >in push
|
||||
>in ! blk ! isfile@ loadfile ! .status interpret ;
|
||||
|
||||
: load ( blk --) ?dup 0=exit 0 (load ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 85, Hexblock 55
|
||||
|
||||
\ +load thru +thru --> rdepth depth 20Oct86
|
||||
|
||||
: +load ( offset --) blk @ + load ;
|
||||
|
||||
: thru ( from to --) 1+ swap DO I load LOOP ;
|
||||
: +thru ( off0 off1 --) 1+ swap DO I +load LOOP ;
|
||||
|
||||
: --> 1 blk +! >in off .status ; immediate
|
||||
|
||||
: rdepth ( -- +n) r0 @ rp@ 2+ - 2/ ;
|
||||
: depth ( -- +n) sp@ s0 @ swap - 2/ ;
|
||||
@ -167,6 +151,8 @@ $10 Constant l/s \ lines per screen
|
||||
|
||||
\ *** Block No. 93, Hexblock 5d
|
||||
|
||||
$5d .pagestatus
|
||||
|
||||
\ multitasker primitives 20Nov87
|
||||
|
||||
Code end-trace \ patch Next to its original state
|
||||
@ -1,5 +1,9 @@
|
||||
\ *** Block No. 104, Hexblock 68
|
||||
|
||||
$68 .pagestatus
|
||||
|
||||
Target
|
||||
|
||||
\ endpoints of forget 01Jul86
|
||||
|
||||
| : |? ( nfa -- flag ) c@ $20 and ;
|
||||
@ -191,6 +195,8 @@ end-code
|
||||
|
||||
\ *** Block No. 114, Hexblock 72
|
||||
|
||||
$72 .pagestatus
|
||||
|
||||
\ "search 05Mar88
|
||||
|
||||
Label notfound H pop H pop
|
||||
@ -1,5 +1,5 @@
|
||||
|
||||
BLOCK.FTH **=== NOT TESTED === ******* EMPTY.FB Scr 21
|
||||
BLOCK.FS **=== NOT TESTED === ******* EMPTY.FB Scr 21
|
||||
0 Should show a (mostly) blank screen
|
||||
1
|
||||
2
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
|
||||
TESTER.FTH ERROR exists
|
||||
CORE.FR
|
||||
TESTER.FS ERROR exists
|
||||
CORE.FS
|
||||
*********************YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:
|
||||
!"#$%&'()*+,-./0123456789:;<=>?@
|
||||
ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
|
||||
|
||||
@ -1,9 +1,9 @@
|
||||
|
||||
UTIL.FTH ?DEFTEST1 exists
|
||||
UTIL.FS ?DEFTEST1 exists
|
||||
Test utilities loaded
|
||||
|
||||
ERRORREP.FTH
|
||||
COREEXT.FTH **************
|
||||
ERRORREP.FS
|
||||
COREEXT.FS **************
|
||||
|
||||
Output from .(
|
||||
You should see -9876: -9876
|
||||
|
||||
@ -1,4 +1,4 @@
|
||||
COREPLUS.FTH ********
|
||||
COREPLUS.FS ********
|
||||
You should see 2345: 2345
|
||||
*****
|
||||
End of additional Core tests
|
||||
|
||||
@ -1,3 +1,3 @@
|
||||
|
||||
DOUBLTST.FTH *****************
|
||||
DOUBLTST.FS *****************
|
||||
End of Double-Number word tests
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
ok
|
||||
include inctest.fth
|
||||
INCTEST.FTH included from stream file: "1 2 + 4 * .": 12
|
||||
include inctest.fs
|
||||
INCTEST.FS included from stream file: "1 2 + 4 * .": 12
|
||||
ok
|
||||
logclose
|
||||
|
||||
@ -1,6 +1,6 @@
|
||||
|
||||
ANS-SHIM.FTH
|
||||
PRELIM.FTH
|
||||
ANS-SHIM.FS
|
||||
PRELIM.FS
|
||||
|
||||
CR CR SOURCE TYPE ( Preliminary test ) CR
|
||||
SOURCE ( These lines test SOURCE, TYPE, CR and parenthetic comments ) TYPE CR
|
||||
|
||||
@ -1,95 +0,0 @@
|
||||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ log2file loadscreen phz 20aug23
|
||||
|
||||
1 3 +thru
|
||||
|
||||
\\
|
||||
: .1x ( n -- ) $30 + dup $39 > IF 7 + THEN (emit ;
|
||||
|
||||
: .4x ( n -- )
|
||||
ascii $ (emit 4 0 DO $10 u/mod LOOP drop .1x .1x .1x .1x
|
||||
$20 (emit ;
|
||||
|
||||
: .2x ( n -- )
|
||||
ascii $ (emit 2 0 DO $10 u/mod LOOP drop .1x .1x
|
||||
$20 (emit ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ logfile phz 20aug23
|
||||
|
||||
Dos also Forth definitions
|
||||
|
||||
$18 constant fcb\nam
|
||||
create logfile ," LOGFILE TXT" fcb\nam allot 1 logfile c!
|
||||
create logdma b/rec allot
|
||||
variable logoffset 0 logoffset !
|
||||
|
||||
: logflush logdma dma! logfile $15 bdos $80 dma! ;
|
||||
|
||||
: logc! ( c -- )
|
||||
logoffset @ dup >r logdma + c! r> 1+
|
||||
dup logoffset ! b/rec =
|
||||
IF logflush 0 logoffset ! THEN ;
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ log-emit log-type log-cr alsologtofile pphz 03sep23
|
||||
|
||||
: log-emit ( char -- )
|
||||
dup (emit logc! ;
|
||||
|
||||
: log-type ( addr count -- )
|
||||
0 ?DO count log-emit LOOP drop ;
|
||||
|
||||
: log-cr ( -- )
|
||||
(cr #cr logc! #lf logc! ;
|
||||
|
||||
Output: alsologtofile
|
||||
log-emit log-cr log-type (del noop 2drop (at? ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ logopen phz 20aug23
|
||||
|
||||
: logopen ( -- )
|
||||
logfile filenamelen + 1+ fcb\nam erase
|
||||
0 logoffset !
|
||||
logfile killfile
|
||||
logfile createfile
|
||||
alsologtofile ;
|
||||
|
||||
: logclose ( -- )
|
||||
cr display &26 logc! logflush logfile closefile ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
26
8080/CPM/tests/test-blk.fs
Normal file
26
8080/CPM/tests/test-blk.fs
Normal file
@ -0,0 +1,26 @@
|
||||
|
||||
include log2file.fb \ so that include with block file gets tested
|
||||
' noop Is .status
|
||||
logopen
|
||||
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
\ 1 verbose !
|
||||
include core.fs
|
||||
include coreplus.fs
|
||||
|
||||
include util.fs
|
||||
include errorrep.fs
|
||||
|
||||
include coreext.fs
|
||||
include doubltst.fs
|
||||
|
||||
include block.fs
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
|
||||
@ -1,26 +0,0 @@
|
||||
|
||||
include logfile.fth
|
||||
' noop Is .status
|
||||
logopen
|
||||
|
||||
include ans-shim.fth
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fth
|
||||
include tester.fth
|
||||
\ 1 verbose !
|
||||
include core.fr
|
||||
include coreplus.fth
|
||||
|
||||
include util.fth
|
||||
include errorrep.fth
|
||||
|
||||
include coreext.fth
|
||||
include doubltst.fth
|
||||
|
||||
include block.fth
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
|
||||
22
8080/CPM/tests/test-krn.fs
Normal file
22
8080/CPM/tests/test-krn.fs
Normal file
@ -0,0 +1,22 @@
|
||||
|
||||
include log2file.fb
|
||||
logopen
|
||||
|
||||
include ans-shim.fs
|
||||
: \vf [compile] \ ; immediate
|
||||
|
||||
include prelim.fs
|
||||
include tester.fs
|
||||
|
||||
\ 1 verbose !
|
||||
include core.fs
|
||||
include coreplus.fs
|
||||
|
||||
include util.fs
|
||||
include errorrep.fs
|
||||
|
||||
include coreext.fs
|
||||
|
||||
REPORT-ERRORS
|
||||
|
||||
logclose
|
||||
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue
Block a user