mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-01-09 13:32:05 +00:00
Refactor vf-cbm-bufs.fth and vf-cbm-core.fth so that
compiling without including the buffer mechanism is possible.
This commit is contained in:
parent
02f932a533
commit
6b996fd2a6
@ -7,8 +7,6 @@ User file 0 file !
|
||||
\ adr of file control block
|
||||
Variable prev 0 prev !
|
||||
\ Listhead
|
||||
Variable buffers 0 buffers !
|
||||
\ Semaphore
|
||||
0408 Constant b/buf
|
||||
\ Physical Size
|
||||
|
||||
@ -120,22 +118,6 @@ Label blockfound SP 2inc
|
||||
|
||||
Defer diskerr ' (diskerr Is diskerr
|
||||
|
||||
Defer r/w
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 107, Hexblock 6b
|
||||
6b fthpage
|
||||
@ -219,8 +201,11 @@ Defer r/w
|
||||
: block ( blk -- addr )
|
||||
file@ (block ;
|
||||
|
||||
: (blk-source ( -- addr len)
|
||||
blk @ ?dup IF block b/blk exit THEN
|
||||
tib #tib @ ;
|
||||
|
||||
|
||||
' (blk-source IS source
|
||||
|
||||
|
||||
|
||||
@ -231,11 +216,18 @@ Defer r/w
|
||||
|
||||
: update 080 prev @ 6+ 1+ c! ;
|
||||
|
||||
: save-buffers
|
||||
: (save-buffers
|
||||
buffers lock BEGIN updates? ?dup
|
||||
WHILE backup REPEAT
|
||||
buffers unlock ;
|
||||
|
||||
' (save-buffers IS save-buffers
|
||||
|
||||
| : (init-buffers
|
||||
0 prev ! limit first ! all-buffers ;
|
||||
|
||||
' (init-buffers IS init-buffers
|
||||
|
||||
: empty-buffers
|
||||
buffers lock prev
|
||||
BEGIN @ ?dup
|
||||
@ -245,12 +237,13 @@ Defer r/w
|
||||
: flush save-buffers empty-buffers ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
: list ( blk --)
|
||||
scr ! ." Scr " scr @ dup blk/drv mod u.
|
||||
." Dr " drv? .
|
||||
l/s 0 DO stop? IF leave THEN
|
||||
cr I 2 .r space scr @ block
|
||||
I c/l * + c/l (C 1- )
|
||||
-trailing type LOOP cr ;
|
||||
|
||||
|
||||
\ *** Block No. 111, Hexblock 6f
|
||||
@ -287,8 +280,6 @@ Defer r/w
|
||||
|
||||
\ Allocating buffers clv12jul87
|
||||
|
||||
\ E400 Constant limit Variable first
|
||||
|
||||
: allotbuffer ( -- )
|
||||
first @ r0 @ - b/buf 2+ u< ?exit
|
||||
b/buf negate first +!
|
||||
|
@ -1378,10 +1378,13 @@ Code capitalize ( string -- string )
|
||||
|
||||
( source word parse name 08apr85bp)
|
||||
|
||||
: source ( -- addr len)
|
||||
blk @ ?dup IF block b/blk exit THEN
|
||||
defer source
|
||||
|
||||
: (source ( -- addr len)
|
||||
tib #tib @ ;
|
||||
|
||||
' (source IS source
|
||||
|
||||
: word ( char -- addr) source (word ;
|
||||
|
||||
: parse ( char -- addr len)
|
||||
@ -2335,13 +2338,6 @@ Label (-trail
|
||||
10 (C drop 19 ) Constant l/s
|
||||
\ lines per screen
|
||||
|
||||
: list ( blk --)
|
||||
scr ! ." Scr " scr @ dup blk/drv mod u.
|
||||
." Dr " drv? .
|
||||
l/s 0 DO stop? IF leave THEN
|
||||
cr I 2 .r space scr @ block
|
||||
I c/l * + c/l (C 1- )
|
||||
-trailing type LOOP cr ;
|
||||
|
||||
|
||||
|
||||
@ -2381,11 +2377,16 @@ end-code
|
||||
|
||||
E400 Constant limit Variable first
|
||||
|
||||
Variable buffers 0 buffers !
|
||||
\ Semaphore
|
||||
|
||||
Defer r/w
|
||||
Defer save-buffers ' noop IS save-buffers
|
||||
Defer init-buffers ' noop IS init-buffers
|
||||
|
||||
include vf-cbm-bufs.fth
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 113, Hexblock 71
|
||||
71 fthpage
|
||||
|
||||
@ -2594,9 +2595,6 @@ Host Target
|
||||
BEGIN dup 2- @ over 4 - !
|
||||
@ ?dup 0= UNTIL ;
|
||||
|
||||
| : init-buffers
|
||||
0 prev ! limit first ! all-buffers ;
|
||||
|
||||
Defer 'cold ' noop Is 'cold
|
||||
|
||||
| : (cold
|
||||
|
Loading…
x
Reference in New Issue
Block a user