mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-12-22 21:29:32 +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: \
|
||||
$(patsubst %, $(cpmfilesdir)/%, v4thblk.com sfileint.fth \
|
||||
log2file.fb core.fr) \
|
||||
sblkint.fth log2file.fb core.fr) \
|
||||
$(patsubst tests/%, $(cpmfilesdir)/%, $(wildcard tests/*.fth) \
|
||||
tests/empty.fb) | emu
|
||||
./emulator/run-in-runcpm.sh \
|
||||
"v4thblk sfileint.fth" \
|
||||
"include-isfile" \
|
||||
"include sblkint.fth" \
|
||||
"onlyforth" \
|
||||
"include test-blk.fth" \
|
||||
"bye" \
|
||||
@ -218,7 +219,7 @@ test3.log: \
|
||||
"v4th3 sfileint.fth" \
|
||||
"include-isfile" \
|
||||
"onlyforth" \
|
||||
"include test-blk.fth" \
|
||||
"include test-std.fth" \
|
||||
"bye" \
|
||||
"exit"
|
||||
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
|
||||
\ 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
|
||||
|
||||
\ File Control Blocks UH 18Feb88
|
||||
@ -91,7 +72,6 @@ Constant b/fcb
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ File sizes UH 05Oct87
|
||||
@ -108,9 +88,6 @@ Forth definitions
|
||||
|
||||
Dos definitions
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ (open UH 18Feb88
|
||||
@ -126,10 +103,6 @@ Dos definitions
|
||||
dup position 0. rot 2!
|
||||
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
|
||||
|
||||
\ Print Filenames UH 10Oct87
|
||||
@ -229,14 +202,7 @@ Dos definitions
|
||||
|
||||
\ Close a file UH 10Oct87
|
||||
|
||||
' 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 ;
|
||||
Defer flushfile ' noop is flushfile
|
||||
|
||||
: (close ( fcb -- ) \ close file in fcb
|
||||
dup flushfile
|
||||
@ -280,27 +246,6 @@ Forth definitions
|
||||
|
||||
: 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
|
||||
|
||||
\ 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
|
||||
|
||||
\ File Interface User words UH 11Oct87
|
||||
@ -366,8 +292,7 @@ Forth definitions
|
||||
: emptyfile isfile@ >dosfcb createfile ;
|
||||
|
||||
: from isfile push use ;
|
||||
: loadfrom ( n -- )
|
||||
isfile push fromfile push use load close ;
|
||||
|
||||
: include ( -- )
|
||||
increc-offset push isfile push fromfile push
|
||||
use cr file?
|
||||
@ -390,15 +315,6 @@ Forth definitions
|
||||
|
||||
| : >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! ;
|
||||
0 Drive: a: Drive: b: Drive: c: Drive: d:
|
||||
5 + Drive: j: drop
|
||||
@ -414,40 +330,5 @@ Forth definitions
|
||||
?DO I dma! isfile@ >dosfcb write-seq Abort" disk full!"
|
||||
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
|
||||
' file-r/w Is r/w
|
||||
' noop Is drvinit
|
||||
\ include startup.fb \ load Standard System
|
||||
|
||||
@ -94,7 +94,7 @@ Defer r/w
|
||||
|
||||
\ backup emptybuf readblk 20Oct86
|
||||
|
||||
| : backup ( bufaddr -- ) dup 6+ @ 0<
|
||||
: backup ( bufaddr -- ) dup 6+ @ 0<
|
||||
IF 2+ dup @ 1+ \ buffer empty if file = -1
|
||||
IF input push output push standardi/o
|
||||
BEGIN dup 6+ over 2+ @ 2 pick @ 0 r/w
|
||||
|
||||
Loading…
Reference in New Issue
Block a user