Shift code between vf-bufs.fth and the vf-bdos/core/io/sys.fth so that v4th.fth

could compile without vf-bufs.fth

8080/CPM/src/sfileint.fth

@@ -41,7 +41,7 @@ OnlyForth
 
 \ Build correct view-numbers for this file           UUH 19Nov87
 
-| : fileintview ( -- )  $400 blk @ + ;
+| : fileintview ( -- n )  $400 blk @ + ;
 
 ' fileintview Is makeview
 

8080/CPM/src/v4th3.fth

@@ -12,20 +12,20 @@ Onlyforth
     $8000 displace !
 Target definitions   $100 here!
 
- .( order1 ) order
+ \ .( order1 ) order
   include vf-core.fth
- .( order2 ) order
+ \ .( order2 ) order
   include vf-io.fth
- .( order3 ) order
+ \ .( order3 ) order
   include vf-bufs.fth
- .( order4 ) order
+ \ .( order4 ) order
   include vf-sys.fth
- .( order5 ) order
+ \ .( order5 ) order
   include vf-bdos.fth
   \ Target definitions
- .( order6 ) order
+ \ .( order6 ) order
   include vf-file1.fth
- .( order7 ) order
+ \ .( order7 ) order
   include vf-end.fth
 
 cr .( unresolved: )  .unresolved   ( ' .blk is .status )

8080/CPM/src/vf-bdos.fth

@@ -99,7 +99,9 @@ $5C Constant fcb
 
 \ Default Disk Interface: open and close                 20Nov87
 
-Target Dos also     Defer drvinit       Dos definitions
+Target Dos also     Defer drvinit
+
+Dos definitions
 
 | Variable  opened
 : default  ( -- )  opened off
@@ -108,35 +110,20 @@ Target Dos also     Defer drvinit       Dos definitions
    openfile Abort" default file not found!"  opened on  ;
 ' default Is drvinit
 
+Defer save-dos-buffers
+
 : close-default ( -- ) opened @ not ?exit
     fcb closefile Abort" can't close default-file!" ;
 ' close-default Is save-dos-buffers
 
 
 
-\ *** Block No. 125, Hexblock 7d
-
-\ Default Disk Interface: read/write                     14Feb88
-
-Target Dos also
-
-| : rec# ( 'dosfcb -- 'rec# )  &33 + ;
-
-: (r/w  ( adr blk file r/wf -- flag )  >r
-    dup 0= Abort" no Direct Disk IO supported! " >dosfcb
-    swap rec/blk *  over rec#   0 over 2+ c!   !
-    r> rot  b/blk bounds
-    DO I dma!  2dup IF rec@ drop
-       ELSE rec! IF 2drop true endloop exit THEN THEN
-       over rec#   0 over 2+ c!  1 swap +!
-    b/rec +LOOP  2drop false ;
-
-' (r/w Is r/w
-
 \ *** Block No. 126, Hexblock 7e
 
 \ Postlude                                               20Nov87
 
+Target Dos also
+
 Defer postlude
 
 | : (bye ( -- )   postlude 0 0 bdos ;

8080/CPM/src/vf-bufs.fth

@@ -2,12 +2,9 @@
 
 \ 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
@@ -141,13 +138,16 @@ Defer r/w
 : (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 ;
 
+: (blk-source   ( -- addr len)
+    blk @ ?dup IF loadfile @ (block  b/blk  exit THEN
+    tib #tib @ ;
+
+' (blk-source IS source
+
 \ : isfile@ ( -- addr )    isfile @ ;
 
 \ *** Block No. 102, Hexblock 66
@@ -156,11 +156,10 @@ Code isfile@ ( -- addr )  user' isfile  D lxi
 
 : update          $80 prev @ 6+ 1+ ( Byte-Order! )  c! ;
 
-Defer save-dos-buffers
-
-: save-buffers ( -- )   buffers lock
+: (save-buffers ( -- )   buffers lock
    BEGIN updates? ?dup WHILE backup REPEAT save-dos-buffers
    buffers unlock ;
+' (save-buffers IS save-buffers
 
 : empty-buffers ( -- )   buffers lock prev
    BEGIN @ ?dup  WHILE dup emptybuf REPEAT  buffers unlock ;
@@ -172,7 +171,7 @@ Defer save-dos-buffers
 \ *** Block No. 103, Hexblock 67
 
 \ Allocating buffers                                     10Oct87
-$10000 Constant limit            Variable first
+Variable first
 
 : allotbuffer ( -- )
    first @  r0 @  -  b/buf 2+  u< ?exit
@@ -186,5 +185,30 @@ $10000 Constant limit            Variable first
 
 : all-buffers  BEGIN  first @ allotbuffer first @ =  UNTIL ;
 
-| : init-buffers    prev off  limit first ! all-buffers ;
+| : (init-buffers    prev off  limit first ! all-buffers  flush ;
+' (init-buffers IS init-buffers
 
+\ *** Block No. 125, Hexblock 7d
+
+\ Default Disk Interface: read/write                     14Feb88
+
+Target Dos also
+
+| : rec# ( 'dosfcb -- 'rec# )  &33 + ;
+
+: (r/w  ( adr blk file r/wf -- flag )  >r
+    dup 0= Abort" no Direct Disk IO supported! " >dosfcb
+    swap rec/blk *  over rec#   0 over 2+ c!   !
+    r> rot  b/blk bounds
+    DO I dma!  2dup IF rec@ drop
+       ELSE rec! IF 2drop true endloop exit THEN THEN
+       over rec#   0 over 2+ c!  1 swap +!
+    b/rec +LOOP  2drop false ;
+
+' (r/w Is r/w
+
+: list ( blk -- )
+   scr ! ." Scr " scr @ u.
+   l/s 0 DO
+     cr I 2 .r space scr @ block I c/l * + c/l -trailing type
+   LOOP cr ;

8080/CPM/src/vf-core.fth

@@ -1010,10 +1010,11 @@ Code (word ( char adr0 len0 -- addr )
 
 \ source word parse name                       20Oct86UH 25Jan88
 
-Variable loadfile
+defer source
 
-: source ( -- addr len )   blk @ ?dup
-   IF loadfile @ (block  b/blk   exit  THEN  tib #tib @ ;
+: (source   ( -- addr len)   tib #tib @  ;
+
+' (source IS source
 
 : word ( char -- addr )   source (word ;
 

8080/CPM/src/vf-io.fth

@@ -8,6 +8,7 @@ Defer .status   ' noop Is .status
 
 : push   ( addr -- )   r> swap dup >r @ >r pull >r >r ;
                        restrict
+Variable loadfile
 
 : (load  ( blk offset -- )
    isfile push  loadfile push  fromfile push  blk push >in push
@@ -159,11 +160,6 @@ $20 Constant bl
 $40 Constant c/l        \ Screen line length
 $10 Constant l/s        \ lines per screen
 
-: list ( blk -- )
-   scr ! ." Scr " scr @ u.
-   l/s 0 DO
-     cr I 2 .r space scr @ block I c/l * + c/l -trailing type
-   LOOP cr ;
 
 
 
@@ -187,3 +183,18 @@ Code pause   >next here 2- !  end-code
 Label wake   H pop   H dcx   UP shld
    6 D lxi   D dad   M A mov   H inx   M H mov  A L mov   sphl
    H pop   RP shld   IP pop   Next   end-code
+
+\ file related definitions moved here from vf-bufs.fth
+
+User isfile          0 isfile !   \ addr of file control block
+Variable fromfile    0 fromfile !
+
+Code isfile@ ( -- addr )  user' isfile  D lxi
+   UP lhld   D dad   fetch jmp   end-code
+
+$FF00 Constant limit
+
+Defer save-buffers  ' noop IS save-buffers
+Defer init-buffers  ' noop IS init-buffers
+
+$400 Constant b/blk

8080/CPM/src/vf-sys.fth

@@ -82,7 +82,8 @@ Defer custom-remove     ' noop Is custom-remove
    voc-link @ BEGIN  dup 4- @ over 2- ! @ ?dup  0= UNTIL
    up@ origin $100 cmove ;
 
-: bye       flush empty (bye ;
+: bye       save-buffers  (bye ;
+\ : bye       flush empty (bye ;
 
 | : end?    key #cr = IF true rdrop THEN ;
 
@@ -146,7 +147,7 @@ Defer 'cold    ' noop Is 'cold
 
 | : (cold      origin up@ $100 cmove  $80 count
      $50 umin >r tib r@ move r> #tib ! >in off  blk off
-     init-vocabularys init-buffers  flush  'cold
+     init-vocabularys init-buffers  'cold
      Onlyforth page &24 spaces  logo count type cr (restart  ;