mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-01-10 05:29:55 +00:00
Split sblkint.fth out of sfileint.fth, to make sfileint independent of vf-bufs.fth
This commit is contained in:
Philip Zembrod
parent
7f278a81d5
commit
9d0789f958
@ -197,12 +197,13 @@ test-std.log: \
|
|||||||
|
|
||||||
test-blk.log: \
|
test-blk.log: \
|
||||||
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fth \
|
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fth \
|
||||||
log2file.fb core.fr) \
|
sblkint.fth log2file.fb core.fr) \
|
||||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth) \
|
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth) \
|
||||||
tests/empty.fb) | emu
|
tests/empty.fb) | emu
|
||||||
./emulator/run-in-runcpm.sh \
|
./emulator/run-in-runcpm.sh \
|
||||||
"v4thblk sfileint.fth" \
|
"v4thblk sfileint.fth" \
|
||||||
"include-isfile" \
|
"include-isfile" \
|
||||||
|
"include sblkint.fth" \
|
||||||
"onlyforth" \
|
"onlyforth" \
|
||||||
"include test-blk.fth" \
|
"include test-blk.fth" \
|
||||||
"bye" \
|
"bye" \
|
||||||
@ -218,7 +219,7 @@ test3.log: \
|
|||||||
"v4th3 sfileint.fth" \
|
"v4th3 sfileint.fth" \
|
||||||
"include-isfile" \
|
"include-isfile" \
|
||||||
"onlyforth" \
|
"onlyforth" \
|
||||||
"include test-blk.fth" \
|
"include test-std.fth" \
|
||||||
"bye" \
|
"bye" \
|
||||||
"exit"
|
"exit"
|
||||||
dos2unix -n $(runcpmdir)/logfile.txt $@
|
dos2unix -n $(runcpmdir)/logfile.txt $@
|
||||||
|
|||||||
86
8080/CPM/src/sblkint.fth
Normal file
86
8080/CPM/src/sblkint.fth
Normal file
@ -0,0 +1,86 @@
|
|||||||
|
|
||||||
|
Dos definitions
|
||||||
|
|
||||||
|
: file-r/w ( buffer block fcb f -- f )
|
||||||
|
over 0= Abort" no Direct Disk IO supported! "
|
||||||
|
>r dup (open 2dup in-range r> (r/w ;
|
||||||
|
|
||||||
|
\ backup was made visible in vf-blk.fth so no need to peek its address
|
||||||
|
\ ' (save-buffers >body $0C + @ | Alias backup
|
||||||
|
|
||||||
|
| : filebuffer? ( fcb -- fcb bufaddr/flag )
|
||||||
|
prev BEGIN @ dup WHILE 2dup 2+ @ = UNTIL ;
|
||||||
|
|
||||||
|
| : (flushfile ( fcb -- ) \ flush file buffers
|
||||||
|
BEGIN filebuffer? ?dup WHILE
|
||||||
|
dup backup emptybuf REPEAT drop ;
|
||||||
|
|
||||||
|
' (flushfile is flushfile
|
||||||
|
|
||||||
|
Forth definitions
|
||||||
|
|
||||||
|
: list ( n -- ) 3 spaces file? list ;
|
||||||
|
|
||||||
|
\ *** Block No. 15, Hexblock f
|
||||||
|
|
||||||
|
\ words for viewing UH 10Oct87
|
||||||
|
|
||||||
|
Forth definitions
|
||||||
|
|
||||||
|
| $200 Constant viewoffset \ max. %512 kB files
|
||||||
|
|
||||||
|
: (makeview ( -- n ) \ calc. view filed for a name
|
||||||
|
blk @ dup 0= ?exit
|
||||||
|
loadfile @ ?dup IF fileno @ viewoffset * + THEN ;
|
||||||
|
|
||||||
|
: (view ( blk -- blk' ) \ select file and leave block
|
||||||
|
dup 0=exit
|
||||||
|
viewoffset u/mod file-link
|
||||||
|
BEGIN @ dup WHILE 2dup fileno @ = UNTIL
|
||||||
|
!files drop ; \ not found: direct access
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 17, Hexblock 11
|
||||||
|
|
||||||
|
\ print a list of all buffers UH 20Oct86
|
||||||
|
|
||||||
|
: .buffers
|
||||||
|
prev BEGIN @ ?dup WHILE stop? abort" stopped"
|
||||||
|
cr dup u. dup 2+ @ dup 1+
|
||||||
|
IF ." Block: " over 4+ @ 5 .r
|
||||||
|
." File : " [ Dos ] .file
|
||||||
|
dup 6 + @ 0< IF ." updated" THEN
|
||||||
|
ELSE ." Buffer empty" drop THEN REPEAT ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
: loadfrom ( n -- )
|
||||||
|
isfile push fromfile push use load close ;
|
||||||
|
|
||||||
|
| : addblock ( n -- ) \ add block n to file
|
||||||
|
dup buffer under b/blk bl fill
|
||||||
|
isfile@ rec/blk over filesize +! false file-r/w
|
||||||
|
IF close Abort" disk full!" THEN ;
|
||||||
|
|
||||||
|
: more ( n -- ) open >fileend
|
||||||
|
capacity swap bounds ?DO I addblock LOOP close
|
||||||
|
open close ;
|
||||||
|
|
||||||
|
\ *** Block No. 22, Hexblock 16
|
||||||
|
|
||||||
|
\ Status UH 10OCt87
|
||||||
|
|
||||||
|
|
||||||
|
: .blk ( -- ) blk @ ?dup 0=exit
|
||||||
|
dup 1 = IF cr file? THEN base push hex ." Blk " . ?cr ;
|
||||||
|
|
||||||
|
' .blk Is .status
|
||||||
|
|
||||||
|
' (makeview Is makeview
|
||||||
|
' file-r/w Is r/w
|
||||||
|
|
||||||
@ -37,25 +37,6 @@ OnlyForth
|
|||||||
\ ' noop Is drvinit
|
\ ' noop Is drvinit
|
||||||
\ include startup.fb \ load Standard System
|
\ include startup.fb \ load Standard System
|
||||||
|
|
||||||
\ *** Block No. 2, Hexblock 2
|
|
||||||
|
|
||||||
\ Build correct view-numbers for this file UUH 19Nov87
|
|
||||||
|
|
||||||
| : fileintview ( -- n ) $400 blk @ + ;
|
|
||||||
|
|
||||||
' fileintview Is makeview
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 3, Hexblock 3
|
\ *** Block No. 3, Hexblock 3
|
||||||
|
|
||||||
\ File Control Blocks UH 18Feb88
|
\ File Control Blocks UH 18Feb88
|
||||||
@ -91,7 +72,6 @@ Constant b/fcb
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 5, Hexblock 5
|
\ *** Block No. 5, Hexblock 5
|
||||||
|
|
||||||
\ File sizes UH 05Oct87
|
\ File sizes UH 05Oct87
|
||||||
@ -108,9 +88,6 @@ Forth definitions
|
|||||||
|
|
||||||
Dos definitions
|
Dos definitions
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 6, Hexblock 6
|
\ *** Block No. 6, Hexblock 6
|
||||||
|
|
||||||
\ (open UH 18Feb88
|
\ (open UH 18Feb88
|
||||||
@ -126,10 +103,6 @@ Dos definitions
|
|||||||
dup position 0. rot 2!
|
dup position 0. rot 2!
|
||||||
dup filesize off opened on offset off ;
|
dup filesize off opened on offset off ;
|
||||||
|
|
||||||
: file-r/w ( buffer block fcb f -- f )
|
|
||||||
over 0= Abort" no Direct Disk IO supported! "
|
|
||||||
>r dup (open 2dup in-range r> (r/w ;
|
|
||||||
|
|
||||||
\ *** Block No. 7, Hexblock 7
|
\ *** Block No. 7, Hexblock 7
|
||||||
|
|
||||||
\ Print Filenames UH 10Oct87
|
\ Print Filenames UH 10Oct87
|
||||||
@ -229,14 +202,7 @@ Dos definitions
|
|||||||
|
|
||||||
\ Close a file UH 10Oct87
|
\ Close a file UH 10Oct87
|
||||||
|
|
||||||
' save-buffers >body $0C + @ | Alias backup
|
Defer flushfile ' noop is flushfile
|
||||||
|
|
||||||
| : filebuffer? ( fcb -- fcb bufaddr/flag )
|
|
||||||
prev BEGIN @ dup WHILE 2dup 2+ @ = UNTIL ;
|
|
||||||
|
|
||||||
| : flushfile ( fcb -- ) \ flush file buffers
|
|
||||||
BEGIN filebuffer? ?dup WHILE
|
|
||||||
dup backup emptybuf REPEAT drop ;
|
|
||||||
|
|
||||||
: (close ( fcb -- ) \ close file in fcb
|
: (close ( fcb -- ) \ close file in fcb
|
||||||
dup flushfile
|
dup flushfile
|
||||||
@ -280,27 +246,6 @@ Forth definitions
|
|||||||
|
|
||||||
: file? isfile@ .file ; \ print current file
|
: file? isfile@ .file ; \ print current file
|
||||||
|
|
||||||
: list ( n -- ) 3 spaces file? list ;
|
|
||||||
|
|
||||||
\ *** Block No. 15, Hexblock f
|
|
||||||
|
|
||||||
\ words for viewing UH 10Oct87
|
|
||||||
|
|
||||||
Forth definitions
|
|
||||||
|
|
||||||
| $200 Constant viewoffset \ max. %512 kB files
|
|
||||||
|
|
||||||
: (makeview ( -- n ) \ calc. view filed for a name
|
|
||||||
blk @ dup 0= ?exit
|
|
||||||
loadfile @ ?dup IF fileno @ viewoffset * + THEN ;
|
|
||||||
|
|
||||||
: (view ( blk -- blk' ) \ select file and leave block
|
|
||||||
dup 0=exit
|
|
||||||
viewoffset u/mod file-link
|
|
||||||
BEGIN @ dup WHILE 2dup fileno @ = UNTIL
|
|
||||||
!files drop ; \ not found: direct access
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 16, Hexblock 10
|
\ *** Block No. 16, Hexblock 10
|
||||||
|
|
||||||
\ FORGETing files UH 10Oct87
|
\ FORGETing files UH 10Oct87
|
||||||
@ -320,25 +265,6 @@ Forth definitions
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 17, Hexblock 11
|
|
||||||
|
|
||||||
\ print a list of all buffers UH 20Oct86
|
|
||||||
|
|
||||||
: .buffers
|
|
||||||
prev BEGIN @ ?dup WHILE stop? abort" stopped"
|
|
||||||
cr dup u. dup 2+ @ dup 1+
|
|
||||||
IF ." Block: " over 4+ @ 5 .r
|
|
||||||
." File : " [ Dos ] .file
|
|
||||||
dup 6 + @ 0< IF ." updated" THEN
|
|
||||||
ELSE ." Buffer empty" drop THEN REPEAT ;
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 18, Hexblock 12
|
\ *** Block No. 18, Hexblock 12
|
||||||
|
|
||||||
\ File Interface User words UH 11Oct87
|
\ File Interface User words UH 11Oct87
|
||||||
@ -366,8 +292,7 @@ Forth definitions
|
|||||||
: emptyfile isfile@ >dosfcb createfile ;
|
: emptyfile isfile@ >dosfcb createfile ;
|
||||||
|
|
||||||
: from isfile push use ;
|
: from isfile push use ;
|
||||||
: loadfrom ( n -- )
|
|
||||||
isfile push fromfile push use load close ;
|
|
||||||
: include ( -- )
|
: include ( -- )
|
||||||
increc-offset push isfile push fromfile push
|
increc-offset push isfile push fromfile push
|
||||||
use cr file?
|
use cr file?
|
||||||
@ -390,15 +315,6 @@ Forth definitions
|
|||||||
|
|
||||||
| : >fileend isfile@ >dosfcb size drop ;
|
| : >fileend isfile@ >dosfcb size drop ;
|
||||||
|
|
||||||
| : addblock ( n -- ) \ add block n to file
|
|
||||||
dup buffer under b/blk bl fill
|
|
||||||
isfile@ rec/blk over filesize +! false file-r/w
|
|
||||||
IF close Abort" disk full!" THEN ;
|
|
||||||
|
|
||||||
: more ( n -- ) open >fileend
|
|
||||||
capacity swap bounds ?DO I addblock LOOP close
|
|
||||||
open close ;
|
|
||||||
|
|
||||||
: Drive: ( n -- n' ) dup Constant 1+ Does> @ drive! ;
|
: Drive: ( n -- n' ) dup Constant 1+ Does> @ drive! ;
|
||||||
0 Drive: a: Drive: b: Drive: c: Drive: d:
|
0 Drive: a: Drive: b: Drive: c: Drive: d:
|
||||||
5 + Drive: j: drop
|
5 + Drive: j: drop
|
||||||
@ -414,40 +330,5 @@ Forth definitions
|
|||||||
?DO I dma! isfile@ >dosfcb write-seq Abort" disk full!"
|
?DO I dma! isfile@ >dosfcb write-seq Abort" disk full!"
|
||||||
b/rec +LOOP close ;
|
b/rec +LOOP close ;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 22, Hexblock 16
|
|
||||||
|
|
||||||
\ Status UH 10OCt87
|
|
||||||
|
|
||||||
|
|
||||||
: .blk ( -- ) blk @ ?dup 0=exit
|
|
||||||
dup 1 = IF cr file? THEN base push hex ." Blk " . ?cr ;
|
|
||||||
|
|
||||||
' .blk Is .status
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
\ *** Block No. 23, Hexblock 17
|
|
||||||
|
|
||||||
File source.fb \ Define already existing Files
|
|
||||||
File fileint.fb File startup.fbr
|
|
||||||
|
|
||||||
' (makeview Is makeview
|
|
||||||
' remove-files Is custom-remove
|
' remove-files Is custom-remove
|
||||||
' file-r/w Is r/w
|
|
||||||
' noop Is drvinit
|
' noop Is drvinit
|
||||||
\ include startup.fb \ load Standard System
|
|
||||||
|
|||||||
@ -94,7 +94,7 @@ Defer r/w
|
|||||||
|
|
||||||
\ backup emptybuf readblk 20Oct86
|
\ backup emptybuf readblk 20Oct86
|
||||||
|
|
||||||
| : backup ( bufaddr -- ) dup 6+ @ 0<
|
: backup ( bufaddr -- ) dup 6+ @ 0<
|
||||||
IF 2+ dup @ 1+ \ buffer empty if file = -1
|
IF 2+ dup @ 1+ \ buffer empty if file = -1
|
||||||
IF input push output push standardi/o
|
IF input push output push standardi/o
|
||||||
BEGIN dup 6+ over 2+ @ 2 pick @ 0 r/w
|
BEGIN dup 6+ over 2+ @ 2 pick @ 0 r/w
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user