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

Extract vf-bufs.fth from source.fth and use it building v4th.com

Browse Source
This commit is contained in:
Philip Zembrod 2024-10-08 22:40:17 +02:00
parent f61430eb83
commit 853a555eb2
3 changed files with 193 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
8080/CPM/Makefile
View File

@ -81,7 +81,7 @@ inctest.log: \
$(cpmfilesdir)/v4th.com: \
$(patsubst %, $(cpmfilesdir)/%, volks4th.com \
include.fb log2file.fb target.fb source.fb \
v4th.fth vf-core.fth vf-io.fth) \
v4th.fth vf-core.fth vf-io.fth vf-bufs.fth) \
Makefile | emu
rm -f $(runcpmdir)/A/0/V4TH.COM $@
./emulator/run-in-runcpm.sh \

3
8080/CPM/src/v4th.fth
View File

@ -5,8 +5,9 @@ Target definitions $100 here!
include vf-core.fth
include vf-io.fth
include vf-bufs.fth
use source.fb
$5e $75 thru \ Standard 8080-System
$68 $75 thru \ Standard 8080-System
cr .( unresolved: ) .unresolved ( ' .blk is .status )

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

@ -0,0 +1,190 @@
\ *** Block No. 94, Hexblock 5e
\ buffer mechanism 20Oct86 07Oct87
User isfile 0 isfile ! \ addr of file control block
Variable fromfile 0 fromfile !
Variable prev 0 prev ! \ Listhead
| Variable buffers 0 buffers ! \ Semaphor
$408 Constant b/buf \ physikalische Groesse
$400 Constant b/blk
\ \\ Struktur eines Buffers: 0 : link
\ 2 : file
\ 4 : blocknummer
\ 6 : statusflags
\ 8 : Data ... 1 Kb ...
\ Statusflag bits : 15 1 -> updated
\ file : -1 -> empty buffer, 0 -> no fcb, direct access
\ else addr of fcb ( system dependent )
\ *** Block No. 95, Hexblock 5f
\ search for blocks in memory 30Jun86
| Variable pred
\ DE:blk BC:file HL:bufadr
Label thisbuffer? ( Zero = this buffer )
H push H inx H inx M A mov C cmp 0=
?[ H inx M A mov B cmp 0= ?[ H inx M A mov E cmp
0= ?[ H inx M A mov D cmp ]? ]? ]? H pop ret
Code (core? ( blk file -- adr\blk file )
IP H mvx Ipsave shld
user' offset D lxi UP lhld D dad
M E mov H inx M D mov
B pop H pop H push B push D dad xchg
prev lhld
thisbuffer? call 0= ?[
\ *** Block No. 96, Hexblock 60
\ search for blocks in memory 30Jun86
Label blockfound
D pop D pop 8 D lxi D dad H push ' exit @ jmp ]?
[[ pred shld
M A mov H inx M H mov A L mov
H ora 0= ?[ IPsave lhld H IP mvx Next ]?
thisbuffer? call 0= ?]
xchg pred lhld D ldax A M mov
H inx D inx D ldax A M mov D dcx
prev lhld xchg E M mov H inx D M mov
H dcx prev shld
blockfound jmp end-code
\ *** Block No. 97, Hexblock 61
\ (core? 29Jun86
\ \\
\
\ | : this? ( blk file bufadr -- flag )
\ dup 4+ @ swap 2+ @ d= ;
\
\ | : (core? ( blk file -- dataaddr / blk file )
\ BEGIN over offset @ + over prev @ this?
\ IF rdrop 2drop prev @ 8 + exit THEN
\ 2dup >r offset @ + >r prev @
\ BEGIN dup @ ?dup 0= IF rdrop rdrop drop exit THEN
\ dup r> r> 2dup >r >r rot this? 0=
\ WHILE nip REPEAT
\ dup @ rot ! prev @ over ! prev ! rdrop rdrop
\ REPEAT ;
\ *** Block No. 98, Hexblock 62
\ (diskerr 29Jul86 07Oct87
: (diskerr
." error! r to retry " key $FF and
capital Ascii R = not Abort" aborted" ;
Defer diskerr
' (diskerr Is diskerr
Defer r/w
\ *** Block No. 99, Hexblock 63
\ backup emptybuf readblk 20Oct86
| : 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
WHILE ." write " diskerr
REPEAT THEN 4+ dup @ $7FFF and over ! THEN drop ;
: emptybuf ( bufaddr -- ) 2+ dup on 4+ off ;
| : readblk ( blk file addr -- blk file addr )
dup emptybuf
input push output push standardi/o >r
BEGIN over offset @ + over r@ 8 + -rot 1 r/w
WHILE ." read " diskerr REPEAT r> ;
\ *** Block No. 100, Hexblock 64
\ take mark updates? core? 10Mar86 19Nov87
| : take ( -- bufaddr) prev
BEGIN dup @ WHILE @ dup 2+ @ -1 = UNTIL
buffers lock dup backup ;
| : mark ( blk file bufaddr -- blk file )
2+ >r 2dup r@ ! offset @ + r@ 2+ ! r> 4+ off
buffers unlock ;
| : updates? ( -- bufaddr / flag)
prev BEGIN @ dup WHILE dup 6+ @ 0< UNTIL ;
: core? ( blk file -- addr /false ) (core? 2drop false ;
\ *** Block No. 101, Hexblock 65
\ block & buffer manipulation 20Oct86 18Nov87
: (buffer ( blk file -- addr )
BEGIN (core? take mark REPEAT ;
: (block ( blk file -- addr )
BEGIN (core? take readblk mark REPEAT ;
Code isfile@ ( -- addr ) user' isfile D lxi
UP lhld D dad fetch jmp end-code
: buffer ( blk -- addr ) isfile@ (buffer ;
: block ( blk -- addr ) isfile@ (block ;
\ : isfile@ ( -- addr ) isfile @ ;
\ *** Block No. 102, Hexblock 66
\ block & buffer manipulation 05Oct87
: update $80 prev @ 6+ 1+ ( Byte-Order! ) c! ;
Defer save-dos-buffers
: save-buffers ( -- ) buffers lock
BEGIN updates? ?dup WHILE backup REPEAT save-dos-buffers
buffers unlock ;
: empty-buffers ( -- ) buffers lock prev
BEGIN @ ?dup WHILE dup emptybuf REPEAT buffers unlock ;
: flush save-buffers empty-buffers ;
\ *** Block No. 103, Hexblock 67
\ Allocating buffers 10Oct87
$10000 Constant limit Variable first
: allotbuffer ( -- )
first @ r0 @ - b/buf 2+ u< ?exit
b/buf negate first +! first @ dup emptybuf
prev @ over ! prev ! ;
: freebuffer ( -- ) first @ limit b/buf - u<
IF first @ backup prev
BEGIN dup @ first @ - WHILE @ REPEAT
first @ @ swap ! b/buf first +! THEN ;
: all-buffers BEGIN first @ allotbuffer first @ = UNTIL ;
| : init-buffers prev off limit first ! all-buffers ;