diff --git a/8080/CPM/Makefile b/8080/CPM/Makefile index 92cc781..071ace2 100644 --- a/8080/CPM/Makefile +++ b/8080/CPM/Makefile @@ -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 \ diff --git a/8080/CPM/src/v4th.fth b/8080/CPM/src/v4th.fth index 1735014..7f6072c 100644 --- a/8080/CPM/src/v4th.fth +++ b/8080/CPM/src/v4th.fth @@ -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 ) diff --git a/8080/CPM/src/vf-bufs.fth b/8080/CPM/src/vf-bufs.fth new file mode 100644 index 0000000..8105105 --- /dev/null +++ b/8080/CPM/src/vf-bufs.fth @@ -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 ; +