From e7dd310923d085fe8e5efa44ae7ca8fc655f8576 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 20:31:30 +0200
Subject: [PATCH 1/8] Pull (most) platform-dependent code and loads all the way
 up into the top level vf-c64/c16-main.fth and remove vf-main.fth. Now the CBM
 interface with its platform dependencies in blocks $7e-$94 can be pried apart
 into files. One motivating issue is that (C64 ... ) can't comment out
 multi-line blocks of code with my current implementation of include, only
 single lines. I'll have to figure out how other Forths do this when I work on
 that code again to develop it into something ANS-compliant.

---
 6502/C64/src/vf-c16-32k.fth  | 34 ++++++++++++++---------------
 6502/C64/src/vf-c16-main.fth | 42 +++++++++++++++++-------------------
 6502/C64/src/vf-c64-main.fth | 34 ++++++++++++++---------------
 6502/C64/src/vf-main.fth     | 19 ----------------
 4 files changed, 54 insertions(+), 75 deletions(-)
 delete mode 100644 6502/C64/src/vf-main.fth

diff --git a/6502/C64/src/vf-c16-32k.fth b/6502/C64/src/vf-c16-32k.fth
index 681c7a1..e88907b 100644
--- a/6502/C64/src/vf-c16-32k.fth
+++ b/6502/C64/src/vf-c16-32k.fth
@@ -1,35 +1,35 @@
 
 hex
 
+\ load transient part of target compiler
 2 drive 27 30 thru
 
 1 drive
 
 Onlyforth hex
+
 \ clear memory and clr labels  .status
 include vf-tc-prep.fth
 
-
-\ *** Block No. 9, Hexblock 9
-
-\ Target-Machine              clv06dec88
-
+\ Host and target settings and display
 cr .( Host is: )
     (64  .( C64) C)
     (16  .( C16) C)
 
-       : )     ; immediate
-       : (C    ; immediate
+: )     ; immediate
+: (C    ; immediate
 
-\      : (C64  ; immediate
-       : (C16  ; immediate
-\      : (C16+ ; immediate
-       : (C16- ; immediate
+: (C16  ; immediate
+: (C16- ; immediate
+: (C64  [compile] ( ; immediate
+: (C16+ [compile] ( ; immediate
+\ ) - just to unconfuse my editor
+include vf-pr-target.fth
 
-       : (C64  [compile] ( ; immediate
-\      : (C16  [compile] ( ; immediate
-       : (C16+ [compile] ( ; immediate
-\      : (C16- [compile] ( ; immediate
+\ The actual volksForth sources
+include vf-sys-indep.fth
+$7E $93 thru          \ CBM-Interface
+include vf-finalize.fth
 
-
-include vf-main.fth
+include vf-pr-target.fth
+quit
diff --git a/6502/C64/src/vf-c16-main.fth b/6502/C64/src/vf-c16-main.fth
index 5699797..8345f7d 100644
--- a/6502/C64/src/vf-c16-main.fth
+++ b/6502/C64/src/vf-c16-main.fth
@@ -1,44 +1,42 @@
 
 hex
 
+\ load transient part of target compiler
 2 drive 27 30 thru
 
 1 drive
 
 Onlyforth hex
+
 \ clear memory and clr labels  .status
 include vf-tc-prep.fth
 
-
-\ *** Block No. 9, Hexblock 9
-
-\ Target-Machine              clv06dec88
-
+\ Host and target settings and display
 cr .( Host is: )
     (64  .( C64) C)
     (16  .( C16) C)
 
-       : )     ; immediate
-       : (C    ; immediate
+: )     ; immediate
+: (C    ; immediate
 
-\      : (C64  ; immediate
-       : (C16  ; immediate
-       : (C16+ ; immediate
-\      : (C16- ; immediate
+: (C16  ; immediate
+: (C16+ ; immediate
+: (C64  [compile] ( ; immediate
+: (C16- [compile] ( ; immediate
+\ ) - just to unconfuse my editor
+include vf-pr-target.fth
 
-       : (C64  [compile] ( ; immediate
-\      : (C16  [compile] ( ; immediate
-\      : (C16+ [compile] ( ; immediate
-       : (C16- [compile] ( ; immediate
-
-\ *** Block No. 10, Hexblock a
-
-\ load/remove  JSR-Macros    clv14.4.87)
+\ The actual volksForth sources
+\ including some initial C16 tweaks
 
 Assembler also definitions
-
 \needs C16+Jsr          8 load
-' C16+Jsr Is Jsr .( JSR Is:C16+  )
+' C16+Jsr Is Jsr
 
+include vf-sys-indep.fth
+$7E $93 thru          \ CBM-Interface
+(c16+    $94 load )    \ c16init RamIRQ
+include vf-finalize.fth
 
-include vf-main.fth
+include vf-pr-target.fth
+quit
diff --git a/6502/C64/src/vf-c64-main.fth b/6502/C64/src/vf-c64-main.fth
index 602d5a1..05689cc 100644
--- a/6502/C64/src/vf-c64-main.fth
+++ b/6502/C64/src/vf-c64-main.fth
@@ -1,35 +1,35 @@
 
 hex
 
+\ load transient part of target compiler
 2 drive 27 30 thru
 
 1 drive
 
 Onlyforth hex
+
 \ clear memory and clr labels  .status
 include vf-tc-prep.fth
 
-
-\ *** Block No. 9, Hexblock 9
-
-\ Target-Machine              clv06dec88
-
+\ Host and target settings and display
 cr .( Host is: )
     (64  .( C64) C)
     (16  .( C16) C)
 
-       : )     ; immediate
-       : (C    ; immediate
+: )     ; immediate
+: (C    ; immediate
 
-       : (C64  ; immediate
-\      : (C16  ; immediate
-\      : (C16+ ; immediate
-\      : (C16- ; immediate
+: (C64  ; immediate
+: (C16  [compile] ( ; immediate
+: (C16+ [compile] ( ; immediate
+: (C16- [compile] ( ; immediate
+\ ) - just to unconfuse my editor
+include vf-pr-target.fth
 
-\      : (C64  [compile] ( ; immediate
-       : (C16  [compile] ( ; immediate
-       : (C16+ [compile] ( ; immediate
-       : (C16- [compile] ( ; immediate
+\ The actual volksForth sources
+include vf-sys-indep.fth
+$7E $93 thru          \ CBM-Interface
+include vf-finalize.fth
 
-
-include vf-main.fth
+include vf-pr-target.fth
+quit
diff --git a/6502/C64/src/vf-main.fth b/6502/C64/src/vf-main.fth
deleted file mode 100644
index c2b2840..0000000
--- a/6502/C64/src/vf-main.fth
+++ /dev/null
@@ -1,19 +0,0 @@
-
-
-include vf-pr-target.fth
-
-include vf-sys-indep.fth
-
-$7E $93 thru          \ CBM-Interface
-(c16+    $94 load )    \ c16init RamIRQ
-
-include vf-finalize.fth
-
-' .blk is .status
-
-include vf-pr-target.fth
-
-cr .( for manual saving:)
-cr .( save-target volksforth83)
-cr
-quit

From 45bc8879c86ea8d4712a322790602f5255bb4b6f Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 21:26:17 +0200
Subject: [PATCH 2/8] Extract screens $7e to $93 from vforth4_2.fth and make
 vf-c64 build independent of vforth4_2.d64, i.e. for C64 VolksForth sources
 are fully text-file based. Only transient TC part still comes from tc38q.d64

---
 6502/C64/src/vf-c64-main.fth |   2 +-
 6502/C64/src/vf-sys-c64.fth  | 464 +++++++++++++++++++++++++++++++++++
 2 files changed, 465 insertions(+), 1 deletion(-)
 create mode 100644 6502/C64/src/vf-sys-c64.fth

diff --git a/6502/C64/src/vf-c64-main.fth b/6502/C64/src/vf-c64-main.fth
index 05689cc..8fbb226 100644
--- a/6502/C64/src/vf-c64-main.fth
+++ b/6502/C64/src/vf-c64-main.fth
@@ -28,7 +28,7 @@ include vf-pr-target.fth
 
 \ The actual volksForth sources
 include vf-sys-indep.fth
-$7E $93 thru          \ CBM-Interface
+include vf-sys-c64.fth
 include vf-finalize.fth
 
 include vf-pr-target.fth
diff --git a/6502/C64/src/vf-sys-c64.fth b/6502/C64/src/vf-sys-c64.fth
new file mode 100644
index 0000000..15881f8
--- /dev/null
+++ b/6502/C64/src/vf-sys-c64.fth
@@ -0,0 +1,464 @@
+
+\ *** Block No. 126, Hexblock 7e
+7e fthpage
+
+\ CBM-Labels                   05nov87re
+
+$FFA5 >label ACPTR
+$FFC6 >label CHKIN
+$FFC9 >label CHKOUT
+$FFD2 >label CHROUT
+$FF81 >label CINT
+$FFA8 >label CIOUT
+$FFC3 >label CLOSE
+$FFCC >label CLRCHN
+$FFE4 >label GETIN
+$FF84 >label IOINIT
+$FFB1 >label LISTEN
+$FFC0 >label OPEN
+$FFF0 >label PLOT
+$FF8A >label RESTOR
+$FF93 >label SECOND
+$FFE1 >label STOP
+$FFB4 >label TALK
+$FF96 >label TKSA
+$FFEA >label UDTIM
+$FFAE >label UNLSN
+$FFAB >label UNTLK
+$FFCF >label CHRIN
+$FF99 >label MEMTOP
+
+\ *** Block No. 127, Hexblock 7f
+7f fthpage
+
+\ C64-Labels                 clv13.4.87)
+
+0E716 >label ConOut
+  09d >label MsgFlg
+  09a >label OutDev
+  099 >label  InDev
+0d020 >label BrdCol
+0d021 >label BkgCol
+ 0286 >label PenCol
+  0ae >label PrgEnd
+  0c1 >label IOBeg
+  0d4 >label CurFlg
+  0d8 >label InsCnt
+ 028a >label KeyRep
+
+
+\ *** Block No. 129, Hexblock 81
+81 fthpage
+
+\ C64 c64key? getkey
+
+Code c64key? ( -- flag)
+ 0C6 lda
+ 0<> ?[  0FF # lda  ]? pha
+ Push jmp  end-code
+
+Code getkey  ( -- 8b)
+ 0C6 lda  0<>
+ ?[  sei  0277 ldy
+  [[  0277 1+ ,X lda  0277 ,X sta  inx
+      0C6 cpx  0= ?]
+  0C6 dec  tya  cli  0A0 # cmp
+  0= ?[  bl # lda  ]?
+ ]?
+ Push0A jmp   end-code
+
+
+\ *** Block No. 130, Hexblock 82
+82 fthpage
+
+\ C64 curon curoff
+
+Code curon   ( --)
+ 0D3 ldy  0D1 )Y lda  0CE sta  0CC stx
+ xyNext jmp   end-code
+
+Code curoff   ( --)
+ iny  0CC sty  0CD sty  0CF stx
+ 0CE lda  0D3 ldy  0D1 )Y sta
+ 1 # ldy  Next jmp   end-code
+
+
+\ *** Block No. 131, Hexblock 83
+83 fthpage
+
+( #bs #cr ..keyboard         clv12.4.87)
+
+: c64key  ( -- 8b)
+ curon BEGIN pause c64key?  UNTIL
+ curoff getkey ;
+
+14 Constant #bs   0D Constant #cr
+
+: c64decode
+ ( addr cnt1 key -- addr cnt2)
+  #bs case?  IF  dup  IF del 1- THEN
+                            exit  THEN
+  #cr case?  IF  dup span ! exit THEN
+  >r  2dup +  r@ swap c!  r> emit  1+ ;
+
+: c64expect ( addr len1 -- )
+ span !  0
+ BEGIN  dup span @  u<
+ WHILE  key  decode
+ REPEAT 2drop space ;
+
+Input: keyboard   [ here input ! ]
+ c64key c64key? c64decode c64expect ;
+
+
+\ *** Block No. 132, Hexblock 84
+84 fthpage
+
+( con! printable?            clv11.4.87)
+
+Code con!  ( 8b --)   SP X) lda
+Label (con!     ConOut jsr    SP 2inc
+Label (con!end  CurFlg stx InsCnt stx
+ 1 # ldy ;c:  pause ;
+
+Label (printable?   \ for CBM-Code !
+                    \ CS is printable
+  80 # cmp  CC ?[   bl # cmp  rts  ]?
+ 0E0 # cmp  CC ?[  0C0 # cmp  rts  ]?
+ clc  rts  end-code
+
+Code printable? ( 8b -- 8b flag)
+ SP X) lda  (printable? jsr CS ?[ dex ]?
+ txa  PushA jmp     end-code
+
+
+\ *** Block No. 133, Hexblock 85
+85 fthpage
+
+( emit cr del page at at?    clv11.4.87)
+
+Code c64emit  ( 8b -- )
+ SP X) lda  (printable? jsr
+    CC ?[  Ascii . # lda ]?
+ (con! jmp   end-code
+
+: c64cr     #cr con! ;
+
+: c64del    9D con!  space  9D con! ;
+
+: c64page   93 con! ;
+
+Code c64at  ( row col --)
+ 2 # lda  Setup jsr
+ N 2+ ldx  N ldy  clc  PLOT jsr
+(C16 \ ) 0D3 ldy  0D1 )Y lda   0CE sta
+ xyNext jmp  end-code
+
+Code c64at?  ( -- row col)
+ SP 2dec txa  SP )Y sta
+ sec  PLOT jsr
+ 28 # cpy  tya  CS ?[ 28 # sbc ]?
+ pha  txa  0 # ldx  SP X) sta  pla
+ Push0A jmp  end-code
+
+
+\ *** Block No. 134, Hexblock 86
+86 fthpage
+
+( type display (bye          clv11.4.87)
+
+Code  c64type  ( adr len -- )
+ 2 # lda  Setup jsr  0 # ldy
+  [[  N cpy  0<>
+  ?[[  N 2+ )Y lda  (printable? jsr
+         CC ?[  Ascii . # lda  ]?
+ ConOut jsr  iny  ]]?
+ (con!end jmp   end-code
+
+Output: display   [ here output ! ]
+ c64emit c64cr c64type c64del c64page
+ c64at c64at? ;
+
+(C64  | Create (bye  $FCE2  here 2- ! )
+
+(C16- | Create (bye  $FF52  here 2- ! )
+
+(C16+ | CODE   (bye  rom $FF52 jmp  end-code )
+
+
+\ *** Block No. 135, Hexblock 87
+87 fthpage
+
+\ b/blk drive >drive drvinit  clv14:2x87
+
+400 Constant b/blk
+
+0AA Constant blk/drv
+
+Variable (drv    0 (drv !
+
+| : disk ( -- dev.no )   (drv @ 8 + ;
+
+: drive  ( drv# -- )
+ blk/drv *  offset ! ;
+
+: >drive ( block drv# -- block' )
+ blk/drv * +   offset @ - ;
+
+: drv?    ( block -- drv# )
+ offset @ + blk/drv / ;
+
+: drvinit  noop ;
+
+
+\ *** Block No. 136, Hexblock 88
+88 fthpage
+
+( i/o busoff                  10may85we)
+
+Variable i/o  0 i/o !  \ Semaphore
+
+Code busoff  ( --)   CLRCHN jsr
+Label unlocki/o  1 # ldy  0 # ldx
+ ;c:  i/o unlock ;
+
+Label nodevice     0 # ldx  1 # ldy
+ ;c:  busoff   buffers unlock
+      true Abort" no device" ;
+
+
+\ *** Block No. 137, Hexblock 89
+89 fthpage
+
+\ ?device                     clv12jul87
+
+Label (?dev
+ 90 stx (C16 $ae sta ( ) LISTEN jsr
+        \ because of error in OS
+ 60 # lda  SECOND jsr  UNLSN jsr
+ 90 lda  0<> ?[ pla pla nodevice jmp ]?
+ rts    end-code
+
+ Code (?device  ( dev --)
+ SP X) lda  (?dev jsr  SP 2inc
+ unlocki/o jmp  end-code
+
+: ?device  ( dev -- )
+ i/o lock  (?device ;
+
+ Code (busout  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  LISTEN jsr
+ N lda  60 # ora SECOND jsr
+ N 2+ ldx  OutDev stx
+ xyNext jmp  end-code
+
+
+\ *** Block No. 138, Hexblock 8a
+8a fthpage
+
+\ busout/open/close/in        clv12jul87
+
+: busout    ( dev 2nd -- )
+ i/o lock (busout ;
+
+: busopen   ( dev 2nd -- )
+ 0F0 or busout ;
+
+: busclose  ( dev 2nd -- )
+ 0E0 or busout busoff ;
+
+ Code (busin  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  TALK jsr
+ N lda  60 # ora (C16 $ad sta ( )
+ TKSA jsr
+\ because of error in old C16 OS
+ N 2+ ldx  InDev stx
+ xyNext jmp end-code
+
+: busin  ( dev 2nd -- )
+ i/o lock  (busin ;
+
+
+\ *** Block No. 139, Hexblock 8b
+8b fthpage
+
+( bus-!/type/@/input derror?  24feb85re)
+
+Code bus!  ( 8b --)
+ SP X) lda  CIOUT jsr  (xydrop jmp
+ end-code
+
+: bustype  ( adr n --)
+ bounds  ?DO  I c@ bus!  LOOP pause ;
+
+Code bus@  ( -- 8b)
+ ACPTR jsr Push0A jmp  end-code
+
+: businput  ( adr n --)
+ bounds  ?DO  bus@ I c! LOOP pause ;
+
+: derror?  ( -- flag )
+ disk $F busin bus@  dup Ascii 0 -
+  IF  BEGIN emit bus@ dup #cr =  UNTIL
+  0= cr  THEN   0=  busoff ;
+
+
+\ *** Block No. 140, Hexblock 8c
+8c fthpage
+
+( s#>s+t  x,x                 28may85re)
+
+165 | Constant 1.t
+1EA | Constant 2.t
+256 | Constant 3.t
+
+| : (s#>s+t ( sector# -- sect track)
+      dup 1.t u< IF 15 /mod exit THEN
+ 3 +  dup 2.t u< IF 1.t - 13 /mod 11 +
+                            exit THEN
+      dup 3.t u< IF 2.t - 12 /mod 18 +
+                            exit THEN
+ 3.t - 11 /mod 1E + ;
+
+| : s#>t+s  ( sector# -- track sect )
+ (s#>s+t  1+ swap ;
+
+| : x,x ( sect track -- adr count)
+ base push  decimal
+ 0 <# #s drop Ascii , hold #s #> ;
+
+
+\ *** Block No. 141, Hexblock 8d
+8d fthpage
+
+( readsector writesector      28may85re)
+
+100 | Constant b/sek
+
+: readsector  ( adr tra# sect# -- flag)
+ disk 0F busout
+ " u1:13,0," count   bustype
+ x,x bustype busoff pause
+ derror? ?exit
+ disk 0D busin b/sek businput busoff
+ false ;
+
+: writesector  ( adr tra# sect# -- flag)
+ rot disk 0F busout
+ " b-p:13,0" count bustype busoff
+ disk 0D busout b/sek bustype busoff
+ disk 0F busout
+ " u2:13,0," count  bustype
+ x,x bustype busoff pause  derror? ;
+
+
+\ *** Block No. 142, Hexblock 8e
+8e fthpage
+
+( 1541r/w                     28may85re)
+
+: diskopen  ( -- flag)
+ disk 0D busopen  Ascii # bus! busoff
+ derror? ;
+
+: diskclose ( -- )
+ disk 0D busclose  busoff ;
+
+: 1541r/w  ( adr blk file r/wf -- flag)
+ swap Abort" no file"
+ -rot  blk/drv /mod  dup (drv ! 3 u>
+ IF . ." beyond capacity" nip exit  THEN
+ diskopen  IF  drop nip exit  THEN
+ 0 swap   2* 2* 4 bounds
+ DO  drop  2dup I rot
+     IF    s#>t+s readsector
+     ELSE  s#>t+s writesector THEN
+     >r b/sek + r> dup  IF  LEAVE  THEN
+ LOOP   -rot  2drop  diskclose  ;
+
+' 1541r/w  Is   r/w
+
+
+\ *** Block No. 143, Hexblock 8f
+8f fthpage
+
+\ index findex ink-pot         05nov87re
+
+: index ( from to --)
+ 1+ swap DO
+   cr  I 2 .r  I block 1+  25  type
+   stop?  IF LEAVE THEN  LOOP ;
+
+: findex ( from to --)
+ diskopen  IF  2drop  exit  THEN
+ 1+ swap DO  cr  I 2 .r
+   pad dup I 2* 2* s#>t+s readsector
+   >r 1+ 25 type
+   r> stop? or IF LEAVE THEN
+ LOOP  diskclose  ;
+
+Create ink-pot
+    \ border bkgnd pen  0
+(C64    6 c,   6 c,  3 c, 0 c, ) \ Forth
+(C64   0E c,   6 c,  3 c, 0 c, ) \ Edi
+(C64    6 c,   6 c,  3 c, 0 c, ) \ User
+(C16   f6 c, 0f6 c, 03 c, 0 c, ) \ Forth
+(C16  0eE c, 0f6 c, 03 c, 0 c, ) \ Edi
+(C16  0f6 c, 0f6 c, 03 c, 0 c, ) \ User
+
+
+\ *** Block No. 144, Hexblock 90
+90 fthpage
+
+\ restore                      05nov87re
+
+Label asave 0 c,    Label 1save 0 c,
+
+Label continue
+ pha  1save lda  1 sta  pla  rti
+
+Label restore   sei  asave sta
+ continue $100 /mod
+ # lda pha  # lda pha  php  \ for RTI
+ asave lda pha  txa pha  tya pha
+ 1 lda 1save sta
+ $36 # lda   1 sta  \ Basic off ROM on
+ $7F # lda  $DD0D sta
+ $DD0D ldy  0< ?[
+Label 6526-NMI $FE72 jmp  ]?
+ UDTIM jsr STOP jsr  \ RUN/STOP ?
+ 6526-NMI bne        \ not >>-->
+ ' restart @ jmp  end-code
+
+
+\ *** Block No. 145, Hexblock 91
+91 fthpage
+
+\ C64:Init                     06nov87re
+
+: init-system   $FF40 dup $C0 cmove
+ [ restore ] Literal  dup
+ $FFFA ! $318 ! ;  \ NMI-Vector to RAM
+
+Label first-init
+ sei cld
+ IOINIT jsr  CINT jsr  RESTOR jsr
+  \ init. and set I/O-Vectors
+ $36 # lda   01 sta        \ Basic off
+ ink-pot    lda BrdCol sta \ border
+ ink-pot 1+ lda BkgCol sta \ backgrnd
+ ink-pot 2+ lda PenCol sta \ pen
+$80 # lda KeyRep sta  \ repeat all keys
+$17 # lda  $D018 sta  \ low/upp +
+  0 # lda  $D01A sta  \ VIC-IRQ off
+$1B # lda  $D011 sta  \ Textmode on
+  4 # lda   $288 sta  \ low screen
+ cli rts end-code
+first-init dup bootsystem 1+ !
+               warmboot   1+ !
+Code c64init first-init jsr
+ xyNext jmp end-code

From 285794383b4fa76dcd66b9587b36f8bc4f96b194 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 21:28:21 +0200
Subject: [PATCH 3/8] Remove reference to drive 1 aka device 9 (where
 vforth4_2.d64 is mounted) from vf-c64-main.fth

---
 6502/C64/src/vf-c64-main.fth | 1 -
 1 file changed, 1 deletion(-)

diff --git a/6502/C64/src/vf-c64-main.fth b/6502/C64/src/vf-c64-main.fth
index 8fbb226..9746588 100644
--- a/6502/C64/src/vf-c64-main.fth
+++ b/6502/C64/src/vf-c64-main.fth
@@ -4,7 +4,6 @@ hex
 \ load transient part of target compiler
 2 drive 27 30 thru
 
-1 drive
 
 Onlyforth hex
 

From 9a532254694b4f95d66495396c431ecd23eed521 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 22:20:04 +0200
Subject: [PATCH 4/8] Extract screens $8 and $7e to $94 from vforth4_2.fth and
 make vf-c16 build independent of vforth4_2.d64, i.e. now for C16 VolksForth
 sources are fully text-file based, too, like for the C64 already. Only
 transient TC part still comes from tc38q.d64

---
 6502/C64/src/vf-c16+jsr.fth  |  18 ++
 6502/C64/src/vf-c16-32k.fth  |   3 +-
 6502/C64/src/vf-c16-main.fth |  11 +-
 6502/C64/src/vf-sys-c16.fth  | 481 +++++++++++++++++++++++++++++++++++
 6502/C64/src/vf-sys-c64.fth  |   2 +-
 5 files changed, 504 insertions(+), 11 deletions(-)
 create mode 100644 6502/C64/src/vf-c16+jsr.fth
 create mode 100644 6502/C64/src/vf-sys-c16.fth

diff --git a/6502/C64/src/vf-c16+jsr.fth b/6502/C64/src/vf-c16+jsr.fth
new file mode 100644
index 0000000..64c4270
--- /dev/null
+++ b/6502/C64/src/vf-c16+jsr.fth
@@ -0,0 +1,18 @@
+
+\ *** Block No. 8, Hexblock 8
+8 fthpage
+
+\ ram rom jsr NormJsr f.C16+ clv12.4.87)
+
+Assembler also definitions
+
+\ C16+Macros for Bankswitching
+
+: ram $ff3f sta ;   : rom $ff3e sta ;
+
+' Jsr Alias NormJsr   Defer Jsr
+
+: C16+Jsr dup $c000 u>
+ IF rom NormJsr ram ELSE NormJsr THEN ;
+
+' C16+Jsr Is Jsr
diff --git a/6502/C64/src/vf-c16-32k.fth b/6502/C64/src/vf-c16-32k.fth
index e88907b..a8aab2d 100644
--- a/6502/C64/src/vf-c16-32k.fth
+++ b/6502/C64/src/vf-c16-32k.fth
@@ -4,7 +4,6 @@ hex
 \ load transient part of target compiler
 2 drive 27 30 thru
 
-1 drive
 
 Onlyforth hex
 
@@ -28,7 +27,7 @@ include vf-pr-target.fth
 
 \ The actual volksForth sources
 include vf-sys-indep.fth
-$7E $93 thru          \ CBM-Interface
+include vf-sys-c16.fth
 include vf-finalize.fth
 
 include vf-pr-target.fth
diff --git a/6502/C64/src/vf-c16-main.fth b/6502/C64/src/vf-c16-main.fth
index 8345f7d..679a75c 100644
--- a/6502/C64/src/vf-c16-main.fth
+++ b/6502/C64/src/vf-c16-main.fth
@@ -4,7 +4,6 @@ hex
 \ load transient part of target compiler
 2 drive 27 30 thru
 
-1 drive
 
 Onlyforth hex
 
@@ -27,15 +26,11 @@ cr .( Host is: )
 include vf-pr-target.fth
 
 \ The actual volksForth sources
-\ including some initial C16 tweaks
-
-Assembler also definitions
-\needs C16+Jsr          8 load
-' C16+Jsr Is Jsr
+\ including an initial C16+ tweak
 
+include vf-c16+jsr.fth
 include vf-sys-indep.fth
-$7E $93 thru          \ CBM-Interface
-(c16+    $94 load )    \ c16init RamIRQ
+include vf-sys-c16.fth
 include vf-finalize.fth
 
 include vf-pr-target.fth
diff --git a/6502/C64/src/vf-sys-c16.fth b/6502/C64/src/vf-sys-c16.fth
new file mode 100644
index 0000000..7b3e2a1
--- /dev/null
+++ b/6502/C64/src/vf-sys-c16.fth
@@ -0,0 +1,481 @@
+
+\ *** Block No. 126, Hexblock 7e
+7e fthpage
+
+\ CBM-Labels                   05nov87re
+
+$FFA5 >label ACPTR
+$FFC6 >label CHKIN
+$FFC9 >label CHKOUT
+$FFD2 >label CHROUT
+$FF81 >label CINT
+$FFA8 >label CIOUT
+$FFC3 >label CLOSE
+$FFCC >label CLRCHN
+$FFE4 >label GETIN
+$FF84 >label IOINIT
+$FFB1 >label LISTEN
+$FFC0 >label OPEN
+$FFF0 >label PLOT
+$FF8A >label RESTOR
+$FF93 >label SECOND
+$FFE1 >label STOP
+$FFB4 >label TALK
+$FF96 >label TKSA
+$FFEA >label UDTIM
+$FFAE >label UNLSN
+$FFAB >label UNTLK
+$FFCF >label CHRIN
+$FF99 >label MEMTOP
+
+\ *** Block No. 128, Hexblock 80
+80 fthpage
+
+\ C16-Labels                 clv13.4.87)
+
+0ff4c >label ConOut
+  09a >label MsgFlg
+  099 >label OutDev
+  098 >label  InDev
+0ff19 >label BrdCol
+0ff15 >label BkgCol
+ 0540 >label PenCol
+  09d >label PrgEnd
+  0b2 >label IOBeg
+  0cb >label CurFlg
+  0cf >label InsCnt
+ 0540 >label KeyRep
+
+ 055d >label PKeys
+
+
+\ *** Block No. 129, Hexblock 81
+81 fthpage
+
+\ C16 c64key? getkey
+
+Code c64key? ( -- flag)
+ 0ef lda  055d ora
+ 0<> ?[  0FF # lda  ]? pha
+ Push jmp  end-code
+
+Code getkey  ( -- 8b)
+ 0ebdd jsr
+  0A0 # cmp 0= ?[  bl # lda  ]?
+ Push0A jmp   end-code
+
+
+\ *** Block No. 130, Hexblock 82
+82 fthpage
+
+\ C16 curon curoff
+
+Code curon \ --
+0ca lda clc 0c8 adc 0ff0d sta
+0c9 lda     0 # adc 0b # sbc 0ff0c sta
+next jmp end-code
+
+Code curoff \ --
+0ff # lda ff0c sta 0ff0d sta Next jmp
+end-code
+
+
+\ *** Block No. 131, Hexblock 83
+83 fthpage
+
+( #bs #cr ..keyboard         clv12.4.87)
+
+: c64key  ( -- 8b)
+ curon BEGIN pause c64key?  UNTIL
+ curoff getkey ;
+
+14 Constant #bs   0D Constant #cr
+
+: c64decode
+ ( addr cnt1 key -- addr cnt2)
+  #bs case?  IF  dup  IF del 1- THEN
+                            exit  THEN
+  #cr case?  IF  dup span ! exit THEN
+  >r  2dup +  r@ swap c!  r> emit  1+ ;
+
+: c64expect ( addr len1 -- )
+ span !  0
+ BEGIN  dup span @  u<
+ WHILE  key  decode
+ REPEAT 2drop space ;
+
+Input: keyboard   [ here input ! ]
+ c64key c64key? c64decode c64expect ;
+
+
+\ *** Block No. 132, Hexblock 84
+84 fthpage
+
+( con! printable?            clv11.4.87)
+
+Code con!  ( 8b --)   SP X) lda
+Label (con!     ConOut jsr    SP 2inc
+Label (con!end  CurFlg stx InsCnt stx
+ 1 # ldy ;c:  pause ;
+
+Label (printable?   \ for CBM-Code !
+                    \ CS is printable
+  80 # cmp  CC ?[   bl # cmp  rts  ]?
+ 0E0 # cmp  CC ?[  0C0 # cmp  rts  ]?
+ clc  rts  end-code
+
+Code printable? ( 8b -- 8b flag)
+ SP X) lda  (printable? jsr CS ?[ dex ]?
+ txa  PushA jmp     end-code
+
+
+\ *** Block No. 133, Hexblock 85
+85 fthpage
+
+( emit cr del page at at?    clv11.4.87)
+
+Code c64emit  ( 8b -- )
+ SP X) lda  (printable? jsr
+    CC ?[  Ascii . # lda ]?
+ (con! jmp   end-code
+
+: c64cr     #cr con! ;
+
+: c64del    9D con!  space  9D con! ;
+
+: c64page   93 con! ;
+
+Code c64at  ( row col --)
+ 2 # lda  Setup jsr
+ N 2+ ldx  N ldy  clc  PLOT jsr
+(C16 \ ) 0D3 ldy  0D1 )Y lda   0CE sta
+ xyNext jmp  end-code
+
+Code c64at?  ( -- row col)
+ SP 2dec txa  SP )Y sta
+ sec  PLOT jsr
+ 28 # cpy  tya  CS ?[ 28 # sbc ]?
+ pha  txa  0 # ldx  SP X) sta  pla
+ Push0A jmp  end-code
+
+
+\ *** Block No. 134, Hexblock 86
+86 fthpage
+
+( type display (bye          clv11.4.87)
+
+Code  c64type  ( adr len -- )
+ 2 # lda  Setup jsr  0 # ldy
+  [[  N cpy  0<>
+  ?[[  N 2+ )Y lda  (printable? jsr
+         CC ?[  Ascii . # lda  ]?
+ ConOut jsr  iny  ]]?
+ (con!end jmp   end-code
+
+Output: display   [ here output ! ]
+ c64emit c64cr c64type c64del c64page
+ c64at c64at? ;
+
+(C64  | Create (bye  $FCE2  here 2- ! )
+
+(C16- | Create (bye  $FF52  here 2- ! )
+
+(C16+ | CODE   (bye  rom $FF52 jmp  end-code )
+
+
+\ *** Block No. 135, Hexblock 87
+87 fthpage
+
+\ b/blk drive >drive drvinit  clv14:2x87
+
+400 Constant b/blk
+
+0AA Constant blk/drv
+
+Variable (drv    0 (drv !
+
+| : disk ( -- dev.no )   (drv @ 8 + ;
+
+: drive  ( drv# -- )
+ blk/drv *  offset ! ;
+
+: >drive ( block drv# -- block' )
+ blk/drv * +   offset @ - ;
+
+: drv?    ( block -- drv# )
+ offset @ + blk/drv / ;
+
+: drvinit  noop ;
+
+
+\ *** Block No. 136, Hexblock 88
+88 fthpage
+
+( i/o busoff                  10may85we)
+
+Variable i/o  0 i/o !  \ Semaphore
+
+Code busoff  ( --)   CLRCHN jsr
+Label unlocki/o  1 # ldy  0 # ldx
+ ;c:  i/o unlock ;
+
+Label nodevice     0 # ldx  1 # ldy
+ ;c:  busoff   buffers unlock
+      true Abort" no device" ;
+
+
+\ *** Block No. 137, Hexblock 89
+89 fthpage
+
+\ ?device                     clv12jul87
+
+Label (?dev
+ 90 stx (C16 $ae sta ( ) LISTEN jsr
+        \ because of error in OS
+ 60 # lda  SECOND jsr  UNLSN jsr
+ 90 lda  0<> ?[ pla pla nodevice jmp ]?
+ rts    end-code
+
+ Code (?device  ( dev --)
+ SP X) lda  (?dev jsr  SP 2inc
+ unlocki/o jmp  end-code
+
+: ?device  ( dev -- )
+ i/o lock  (?device ;
+
+ Code (busout  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  LISTEN jsr
+ N lda  60 # ora SECOND jsr
+ N 2+ ldx  OutDev stx
+ xyNext jmp  end-code
+
+
+\ *** Block No. 138, Hexblock 8a
+8a fthpage
+
+\ busout/open/close/in        clv12jul87
+
+: busout    ( dev 2nd -- )
+ i/o lock (busout ;
+
+: busopen   ( dev 2nd -- )
+ 0F0 or busout ;
+
+: busclose  ( dev 2nd -- )
+ 0E0 or busout busoff ;
+
+ Code (busin  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  TALK jsr
+ N lda  60 # ora (C16 $ad sta ( )
+ TKSA jsr
+\ because of error in old C16 OS
+ N 2+ ldx  InDev stx
+ xyNext jmp end-code
+
+: busin  ( dev 2nd -- )
+ i/o lock  (busin ;
+
+
+\ *** Block No. 139, Hexblock 8b
+8b fthpage
+
+( bus-!/type/@/input derror?  24feb85re)
+
+Code bus!  ( 8b --)
+ SP X) lda  CIOUT jsr  (xydrop jmp
+ end-code
+
+: bustype  ( adr n --)
+ bounds  ?DO  I c@ bus!  LOOP pause ;
+
+Code bus@  ( -- 8b)
+ ACPTR jsr Push0A jmp  end-code
+
+: businput  ( adr n --)
+ bounds  ?DO  bus@ I c! LOOP pause ;
+
+: derror?  ( -- flag )
+ disk $F busin bus@  dup Ascii 0 -
+  IF  BEGIN emit bus@ dup #cr =  UNTIL
+  0= cr  THEN   0=  busoff ;
+
+
+\ *** Block No. 140, Hexblock 8c
+8c fthpage
+
+( s#>s+t  x,x                 28may85re)
+
+165 | Constant 1.t
+1EA | Constant 2.t
+256 | Constant 3.t
+
+| : (s#>s+t ( sector# -- sect track)
+      dup 1.t u< IF 15 /mod exit THEN
+ 3 +  dup 2.t u< IF 1.t - 13 /mod 11 +
+                            exit THEN
+      dup 3.t u< IF 2.t - 12 /mod 18 +
+                            exit THEN
+ 3.t - 11 /mod 1E + ;
+
+| : s#>t+s  ( sector# -- track sect )
+ (s#>s+t  1+ swap ;
+
+| : x,x ( sect track -- adr count)
+ base push  decimal
+ 0 <# #s drop Ascii , hold #s #> ;
+
+
+\ *** Block No. 141, Hexblock 8d
+8d fthpage
+
+( readsector writesector      28may85re)
+
+100 | Constant b/sek
+
+: readsector  ( adr tra# sect# -- flag)
+ disk 0F busout
+ " u1:13,0," count   bustype
+ x,x bustype busoff pause
+ derror? ?exit
+ disk 0D busin b/sek businput busoff
+ false ;
+
+: writesector  ( adr tra# sect# -- flag)
+ rot disk 0F busout
+ " b-p:13,0" count bustype busoff
+ disk 0D busout b/sek bustype busoff
+ disk 0F busout
+ " u2:13,0," count  bustype
+ x,x bustype busoff pause  derror? ;
+
+
+\ *** Block No. 142, Hexblock 8e
+8e fthpage
+
+( 1541r/w                     28may85re)
+
+: diskopen  ( -- flag)
+ disk 0D busopen  Ascii # bus! busoff
+ derror? ;
+
+: diskclose ( -- )
+ disk 0D busclose  busoff ;
+
+: 1541r/w  ( adr blk file r/wf -- flag)
+ swap Abort" no file"
+ -rot  blk/drv /mod  dup (drv ! 3 u>
+ IF . ." beyond capacity" nip exit  THEN
+ diskopen  IF  drop nip exit  THEN
+ 0 swap   2* 2* 4 bounds
+ DO  drop  2dup I rot
+     IF    s#>t+s readsector
+     ELSE  s#>t+s writesector THEN
+     >r b/sek + r> dup  IF  LEAVE  THEN
+ LOOP   -rot  2drop  diskclose  ;
+
+' 1541r/w  Is   r/w
+
+
+\ *** Block No. 143, Hexblock 8f
+8f fthpage
+
+\ index findex ink-pot         05nov87re
+
+: index ( from to --)
+ 1+ swap DO
+   cr  I 2 .r  I block 1+  25  type
+   stop?  IF LEAVE THEN  LOOP ;
+
+: findex ( from to --)
+ diskopen  IF  2drop  exit  THEN
+ 1+ swap DO  cr  I 2 .r
+   pad dup I 2* 2* s#>t+s readsector
+   >r 1+ 25 type
+   r> stop? or IF LEAVE THEN
+ LOOP  diskclose  ;
+
+Create ink-pot
+    \ border bkgnd pen  0
+(C64    6 c,   6 c,  3 c, 0 c, ) \ Forth
+(C64   0E c,   6 c,  3 c, 0 c, ) \ Edi
+(C64    6 c,   6 c,  3 c, 0 c, ) \ User
+(C16   f6 c, 0f6 c, 03 c, 0 c, ) \ Forth
+(C16  0eE c, 0f6 c, 03 c, 0 c, ) \ Edi
+(C16  0f6 c, 0f6 c, 03 c, 0 c, ) \ User
+
+
+\ *** Block No. 146, Hexblock 92
+92 fthpage
+
+\ C16:Init                01oct87clv/re)
+
+Code init-system $F7 # ldx  txs
+ xyNext jmp end-code
+
+$fcb3 >label IRQ   \ normal IRQ
+$fffe >label >IRQ  \ 6502-Ptr to IRQ
+
+\ selfmodifying code:
+Label RAMIRQ       \ the new IRQ
+   rom RAMIRQ $15 + sta RAMIRQ $17 + stx
+(  +9) RAMIRQ $1b + $100 u/mod # lda pha
+                               # lda pha
+(  +f) tsx $103 ,x lda pha   \ flags
+( +14) 0 # lda 0 # ldx IRQ jmp
+( +1b) ram rti end-code
+
+
+\ *** Block No. 147, Hexblock 93
+93 fthpage
+
+\ C16:..Init              01oct87clv/re)
+
+Label first-init
+   \ will be called in ROM first time
+   \ later called from RAM
+ sei rom
+ RAMIRQ $100 u/mod    \ new IRQ
+   # lda >IRQ 1+ sta  \ .. install
+   # lda >IRQ sta
+ $FF84 normJsr  $FF8A normJsr
+    \ CIAs init. and set I/O-Vectors
+ ink-pot    lda BrdCol sta \ border
+ ink-pot 1+ lda BkgCol sta \ backgrnd
+ ink-pot 2+ lda PenCol sta \ pen
+ $80 # lda KeyRep sta \ repeat all keys
+ $FF13 lda 04 # ora $FF13 sta \ low/upp
+ ram cli rts end-code
+
+first-init dup bootsystem 1+ !
+               warmboot   1+ !
+
+Code c64init first-init jsr
+ xyNext jmp end-code
+
+
+\ *** Block No. 148, Hexblock 94
+94 fthpage
+
+\ C16-Pushkeys C64-like   01oct87clv/re)
+
+Label InitPKs \ Pushkeys: Daten
+00 c, 00 c,  \ curr. numb Char, currPtr
+01 c, 01 c, 01 c, 01 c, \ StrLength
+01 c, 01 c, 01 c, 01 c, \   "
+
+85 c, 86 c, 87 c, 89 c, \ Content
+8a c, 8b c, 8c c, 88 c, \   "
+
+
+here InitPKs - >label InitPKlen
+
+
+Code C64fkeys \ Pushkeys a la C64
+  InitPKlen # ldx
+  [[ dex  0>= ?[[
+    InitPKs ,X lda PKeys ,x sta ]]?
+  xyNext jmp end-code
diff --git a/6502/C64/src/vf-sys-c64.fth b/6502/C64/src/vf-sys-c64.fth
index 15881f8..b5daecc 100644
--- a/6502/C64/src/vf-sys-c64.fth
+++ b/6502/C64/src/vf-sys-c64.fth
@@ -414,7 +414,7 @@ Create ink-pot
 \ *** Block No. 144, Hexblock 90
 90 fthpage
 
-\ restore                      05nov87re
+\ C64 restore
 
 Label asave 0 c,    Label 1save 0 c,
 

From d31aaed5e664c39f981a5993afd1ace4aa29fddc Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 22:34:11 +0200
Subject: [PATCH 5/8] Rename vf-sys-indep.fth to vf-cbm-core.fth

---
 6502/C64/src/vf-c16-32k.fth                        | 2 +-
 6502/C64/src/vf-c16-main.fth                       | 2 +-
 6502/C64/src/vf-c64-main.fth                       | 2 +-
 6502/C64/src/{vf-sys-indep.fth => vf-cbm-core.fth} | 0
 4 files changed, 3 insertions(+), 3 deletions(-)
 rename 6502/C64/src/{vf-sys-indep.fth => vf-cbm-core.fth} (100%)

diff --git a/6502/C64/src/vf-c16-32k.fth b/6502/C64/src/vf-c16-32k.fth
index a8aab2d..d115e16 100644
--- a/6502/C64/src/vf-c16-32k.fth
+++ b/6502/C64/src/vf-c16-32k.fth
@@ -26,7 +26,7 @@ cr .( Host is: )
 include vf-pr-target.fth
 
 \ The actual volksForth sources
-include vf-sys-indep.fth
+include vf-cbm-core.fth
 include vf-sys-c16.fth
 include vf-finalize.fth
 
diff --git a/6502/C64/src/vf-c16-main.fth b/6502/C64/src/vf-c16-main.fth
index 679a75c..5b2f2af 100644
--- a/6502/C64/src/vf-c16-main.fth
+++ b/6502/C64/src/vf-c16-main.fth
@@ -29,7 +29,7 @@ include vf-pr-target.fth
 \ including an initial C16+ tweak
 
 include vf-c16+jsr.fth
-include vf-sys-indep.fth
+include vf-cbm-core.fth
 include vf-sys-c16.fth
 include vf-finalize.fth
 
diff --git a/6502/C64/src/vf-c64-main.fth b/6502/C64/src/vf-c64-main.fth
index 9746588..c0fb903 100644
--- a/6502/C64/src/vf-c64-main.fth
+++ b/6502/C64/src/vf-c64-main.fth
@@ -26,7 +26,7 @@ cr .( Host is: )
 include vf-pr-target.fth
 
 \ The actual volksForth sources
-include vf-sys-indep.fth
+include vf-cbm-core.fth
 include vf-sys-c64.fth
 include vf-finalize.fth
 
diff --git a/6502/C64/src/vf-sys-indep.fth b/6502/C64/src/vf-cbm-core.fth
similarity index 100%
rename from 6502/C64/src/vf-sys-indep.fth
rename to 6502/C64/src/vf-cbm-core.fth

From 6fb1f6d9727fe334796d97e33eba8a9ac096668e Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 22:49:41 +0200
Subject: [PATCH 6/8] Extract the platform dependent heads/preambles and make
 vf-cbm-core.fth really platform-independent. Likely this might eventually
 deserve the name vf-6502-core.fth

---
 6502/C64/src/vf-c16-32k.fth  |  1 +
 6502/C64/src/vf-c16-main.fth |  1 +
 6502/C64/src/vf-c64-main.fth |  1 +
 6502/C64/src/vf-cbm-core.fth | 38 +-----------------------------------
 6502/C64/src/vf-head-c16.fth | 32 ++++++++++++++++++++++++++++++
 6502/C64/src/vf-head-c64.fth | 31 +++++++++++++++++++++++++++++
 6 files changed, 67 insertions(+), 37 deletions(-)
 create mode 100644 6502/C64/src/vf-head-c16.fth
 create mode 100644 6502/C64/src/vf-head-c64.fth

diff --git a/6502/C64/src/vf-c16-32k.fth b/6502/C64/src/vf-c16-32k.fth
index d115e16..96acff8 100644
--- a/6502/C64/src/vf-c16-32k.fth
+++ b/6502/C64/src/vf-c16-32k.fth
@@ -26,6 +26,7 @@ cr .( Host is: )
 include vf-pr-target.fth
 
 \ The actual volksForth sources
+include vf-head-c16.fth
 include vf-cbm-core.fth
 include vf-sys-c16.fth
 include vf-finalize.fth
diff --git a/6502/C64/src/vf-c16-main.fth b/6502/C64/src/vf-c16-main.fth
index 5b2f2af..872559c 100644
--- a/6502/C64/src/vf-c16-main.fth
+++ b/6502/C64/src/vf-c16-main.fth
@@ -29,6 +29,7 @@ include vf-pr-target.fth
 \ including an initial C16+ tweak
 
 include vf-c16+jsr.fth
+include vf-head-c16.fth
 include vf-cbm-core.fth
 include vf-sys-c16.fth
 include vf-finalize.fth
diff --git a/6502/C64/src/vf-c64-main.fth b/6502/C64/src/vf-c64-main.fth
index c0fb903..e5a938a 100644
--- a/6502/C64/src/vf-c64-main.fth
+++ b/6502/C64/src/vf-c64-main.fth
@@ -26,6 +26,7 @@ cr .( Host is: )
 include vf-pr-target.fth
 
 \ The actual volksForth sources
+include vf-head-c64.fth
 include vf-cbm-core.fth
 include vf-sys-c64.fth
 include vf-finalize.fth
diff --git a/6502/C64/src/vf-cbm-core.fth b/6502/C64/src/vf-cbm-core.fth
index 2bb6293..ba9834b 100644
--- a/6502/C64/src/vf-cbm-core.fth
+++ b/6502/C64/src/vf-cbm-core.fth
@@ -1,40 +1,4 @@
-\ The main and mostly system independent part of CBM VolkForth
-
-\ Initial part of load screen
-
-Onlyforth
-
-(C64 $801 ) (C16 $1001 ) dup displace !
-
-Target definitions   here!
-
-
-\ *** Block No. 16, Hexblock 10
-10 fthpage
-
-\ FORTH Preamble and ID       clv06aug87
-
-(C64  $D c, $8 c, $A c, 00 c, 9E c, 28 c, 32 c, 30 c, )
-(C64  36 c, 34 c, 29 c, 00 c, 00 c, 00 c, 00 c, ) \ SYS(2064)
-(C16  $D c, 10 c, $A c, 00 c, 9E c, 28 c, 34 c, 31 c, )
-(C16  31 c, 32 c, 29 c, 00 c, 00 c, 00 c, 00 c, ) \ SYS(4112)
-
-Assembler
-  nop  0 jmp  here 2- >label >cold
-  nop  0 jmp  here 2- >label >restart
-
-here dup origin!
-\ Here are coldstart- and Uservariables
-\
-0 jmp  0 jsr  here 2- >label >wake
- end-code
-$100 allot
-
-Create logo
- (C64  ," volksFORTH-83 3.80.1-C64  " )
- (C16+ ," volksFORTH-83 3.80.1-C16+ " )
- (C16- ," volksFORTH-83 3.80.1-C16- " )
-
+\ The system independent part of CBM VolkForth
 
 \ *** Block No. 17, Hexblock 11
 11 fthpage
diff --git a/6502/C64/src/vf-head-c16.fth b/6502/C64/src/vf-head-c16.fth
new file mode 100644
index 0000000..c047138
--- /dev/null
+++ b/6502/C64/src/vf-head-c16.fth
@@ -0,0 +1,32 @@
+\ The head of C16 VolkForth
+
+\ Initial part of load screen
+
+Onlyforth
+
+$1001 dup  displace !
+Target definitions   here!
+
+
+\ *** Block No. 16, Hexblock 10
+10 fthpage
+
+\ FORTH Preamble and ID       clv06aug87
+
+$D c, 10 c, $A c, 00 c, 9E c, 28 c, 34 c, 31 c,
+31 c, 32 c, 29 c, 00 c, 00 c, 00 c, 00 c, \ SYS(4112)
+
+Assembler
+  nop  0 jmp  here 2- >label >cold
+  nop  0 jmp  here 2- >label >restart
+
+here dup origin!
+\ Here are coldstart- and Uservariables
+\
+0 jmp  0 jsr  here 2- >label >wake
+ end-code
+$100 allot
+
+Create logo
+ (C16+ ," volksFORTH-83 3.80.1-C16+ " )
+ (C16- ," volksFORTH-83 3.80.1-C16- " )
diff --git a/6502/C64/src/vf-head-c64.fth b/6502/C64/src/vf-head-c64.fth
new file mode 100644
index 0000000..4048288
--- /dev/null
+++ b/6502/C64/src/vf-head-c64.fth
@@ -0,0 +1,31 @@
+\ The head of C64 VolkForth
+
+\ Initial part of load screen
+
+Onlyforth
+
+$801 dup  displace !
+Target definitions   here!
+
+
+\ *** Block No. 16, Hexblock 10
+10 fthpage
+
+\ FORTH Preamble and ID       clv06aug87
+
+$D c, $8 c, $A c, 00 c, 9E c, 28 c, 32 c, 30 c,
+36 c, 34 c, 29 c, 00 c, 00 c, 00 c, 00 c, \ SYS(2064)
+
+Assembler
+  nop  0 jmp  here 2- >label >cold
+  nop  0 jmp  here 2- >label >restart
+
+here dup origin!
+\ Here are coldstart- and Uservariables
+\
+0 jmp  0 jsr  here 2- >label >wake
+ end-code
+$100 allot
+
+Create logo
+  ," volksFORTH-83 3.80.1-C64  "

From ce1d44584013c186338fd463c00a07909ea55419 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 23:03:06 +0200
Subject: [PATCH 7/8] Extract common code from vf-sys-7c64/c16.fth

---
 6502/C64/src/vf-lbls-cbm.fth |  29 +++
 6502/C64/src/vf-sys-c16.fth  | 355 +----------------------------------
 6502/C64/src/vf-sys-c64.fth  | 355 +----------------------------------
 6502/C64/src/vf-sys-cbm.fth  | 318 +++++++++++++++++++++++++++++++
 4 files changed, 361 insertions(+), 696 deletions(-)
 create mode 100644 6502/C64/src/vf-lbls-cbm.fth
 create mode 100644 6502/C64/src/vf-sys-cbm.fth

diff --git a/6502/C64/src/vf-lbls-cbm.fth b/6502/C64/src/vf-lbls-cbm.fth
new file mode 100644
index 0000000..3b7fb9a
--- /dev/null
+++ b/6502/C64/src/vf-lbls-cbm.fth
@@ -0,0 +1,29 @@
+
+\ *** Block No. 126, Hexblock 7e
+7e fthpage
+
+\ CBM-Labels                   05nov87re
+
+$FFA5 >label ACPTR
+$FFC6 >label CHKIN
+$FFC9 >label CHKOUT
+$FFD2 >label CHROUT
+$FF81 >label CINT
+$FFA8 >label CIOUT
+$FFC3 >label CLOSE
+$FFCC >label CLRCHN
+$FFE4 >label GETIN
+$FF84 >label IOINIT
+$FFB1 >label LISTEN
+$FFC0 >label OPEN
+$FFF0 >label PLOT
+$FF8A >label RESTOR
+$FF93 >label SECOND
+$FFE1 >label STOP
+$FFB4 >label TALK
+$FF96 >label TKSA
+$FFEA >label UDTIM
+$FFAE >label UNLSN
+$FFAB >label UNTLK
+$FFCF >label CHRIN
+$FF99 >label MEMTOP
diff --git a/6502/C64/src/vf-sys-c16.fth b/6502/C64/src/vf-sys-c16.fth
index 7b3e2a1..9a6bab8 100644
--- a/6502/C64/src/vf-sys-c16.fth
+++ b/6502/C64/src/vf-sys-c16.fth
@@ -1,32 +1,5 @@
 
-\ *** Block No. 126, Hexblock 7e
-7e fthpage
-
-\ CBM-Labels                   05nov87re
-
-$FFA5 >label ACPTR
-$FFC6 >label CHKIN
-$FFC9 >label CHKOUT
-$FFD2 >label CHROUT
-$FF81 >label CINT
-$FFA8 >label CIOUT
-$FFC3 >label CLOSE
-$FFCC >label CLRCHN
-$FFE4 >label GETIN
-$FF84 >label IOINIT
-$FFB1 >label LISTEN
-$FFC0 >label OPEN
-$FFF0 >label PLOT
-$FF8A >label RESTOR
-$FF93 >label SECOND
-$FFE1 >label STOP
-$FFB4 >label TALK
-$FF96 >label TKSA
-$FFEA >label UDTIM
-$FFAE >label UNLSN
-$FFAB >label UNTLK
-$FFCF >label CHRIN
-$FF99 >label MEMTOP
+include vf-lbls-cbm.fth
 
 \ *** Block No. 128, Hexblock 80
 80 fthpage
@@ -80,332 +53,18 @@ Code curoff \ --
 end-code
 
 
-\ *** Block No. 131, Hexblock 83
-83 fthpage
-
-( #bs #cr ..keyboard         clv12.4.87)
-
-: c64key  ( -- 8b)
- curon BEGIN pause c64key?  UNTIL
- curoff getkey ;
-
-14 Constant #bs   0D Constant #cr
-
-: c64decode
- ( addr cnt1 key -- addr cnt2)
-  #bs case?  IF  dup  IF del 1- THEN
-                            exit  THEN
-  #cr case?  IF  dup span ! exit THEN
-  >r  2dup +  r@ swap c!  r> emit  1+ ;
-
-: c64expect ( addr len1 -- )
- span !  0
- BEGIN  dup span @  u<
- WHILE  key  decode
- REPEAT 2drop space ;
-
-Input: keyboard   [ here input ! ]
- c64key c64key? c64decode c64expect ;
-
-
-\ *** Block No. 132, Hexblock 84
-84 fthpage
-
-( con! printable?            clv11.4.87)
-
-Code con!  ( 8b --)   SP X) lda
-Label (con!     ConOut jsr    SP 2inc
-Label (con!end  CurFlg stx InsCnt stx
- 1 # ldy ;c:  pause ;
-
-Label (printable?   \ for CBM-Code !
-                    \ CS is printable
-  80 # cmp  CC ?[   bl # cmp  rts  ]?
- 0E0 # cmp  CC ?[  0C0 # cmp  rts  ]?
- clc  rts  end-code
-
-Code printable? ( 8b -- 8b flag)
- SP X) lda  (printable? jsr CS ?[ dex ]?
- txa  PushA jmp     end-code
-
-
-\ *** Block No. 133, Hexblock 85
-85 fthpage
-
-( emit cr del page at at?    clv11.4.87)
-
-Code c64emit  ( 8b -- )
- SP X) lda  (printable? jsr
-    CC ?[  Ascii . # lda ]?
- (con! jmp   end-code
-
-: c64cr     #cr con! ;
-
-: c64del    9D con!  space  9D con! ;
-
-: c64page   93 con! ;
-
-Code c64at  ( row col --)
- 2 # lda  Setup jsr
- N 2+ ldx  N ldy  clc  PLOT jsr
-(C16 \ ) 0D3 ldy  0D1 )Y lda   0CE sta
- xyNext jmp  end-code
-
-Code c64at?  ( -- row col)
- SP 2dec txa  SP )Y sta
- sec  PLOT jsr
- 28 # cpy  tya  CS ?[ 28 # sbc ]?
- pha  txa  0 # ldx  SP X) sta  pla
- Push0A jmp  end-code
-
-
-\ *** Block No. 134, Hexblock 86
-86 fthpage
-
-( type display (bye          clv11.4.87)
-
-Code  c64type  ( adr len -- )
- 2 # lda  Setup jsr  0 # ldy
-  [[  N cpy  0<>
-  ?[[  N 2+ )Y lda  (printable? jsr
-         CC ?[  Ascii . # lda  ]?
- ConOut jsr  iny  ]]?
- (con!end jmp   end-code
-
-Output: display   [ here output ! ]
- c64emit c64cr c64type c64del c64page
- c64at c64at? ;
-
-(C64  | Create (bye  $FCE2  here 2- ! )
-
-(C16- | Create (bye  $FF52  here 2- ! )
-
-(C16+ | CODE   (bye  rom $FF52 jmp  end-code )
-
-
-\ *** Block No. 135, Hexblock 87
-87 fthpage
-
-\ b/blk drive >drive drvinit  clv14:2x87
-
-400 Constant b/blk
-
-0AA Constant blk/drv
-
-Variable (drv    0 (drv !
-
-| : disk ( -- dev.no )   (drv @ 8 + ;
-
-: drive  ( drv# -- )
- blk/drv *  offset ! ;
-
-: >drive ( block drv# -- block' )
- blk/drv * +   offset @ - ;
-
-: drv?    ( block -- drv# )
- offset @ + blk/drv / ;
-
-: drvinit  noop ;
-
-
-\ *** Block No. 136, Hexblock 88
-88 fthpage
-
-( i/o busoff                  10may85we)
-
-Variable i/o  0 i/o !  \ Semaphore
-
-Code busoff  ( --)   CLRCHN jsr
-Label unlocki/o  1 # ldy  0 # ldx
- ;c:  i/o unlock ;
-
-Label nodevice     0 # ldx  1 # ldy
- ;c:  busoff   buffers unlock
-      true Abort" no device" ;
-
-
-\ *** Block No. 137, Hexblock 89
-89 fthpage
-
-\ ?device                     clv12jul87
-
-Label (?dev
- 90 stx (C16 $ae sta ( ) LISTEN jsr
-        \ because of error in OS
- 60 # lda  SECOND jsr  UNLSN jsr
- 90 lda  0<> ?[ pla pla nodevice jmp ]?
- rts    end-code
-
- Code (?device  ( dev --)
- SP X) lda  (?dev jsr  SP 2inc
- unlocki/o jmp  end-code
-
-: ?device  ( dev -- )
- i/o lock  (?device ;
-
- Code (busout  ( dev 2nd -- )
- MsgFlg stx  2 # lda  Setup jsr
- N 2+ lda  (?dev jsr
- N 2+ lda  LISTEN jsr
- N lda  60 # ora SECOND jsr
- N 2+ ldx  OutDev stx
- xyNext jmp  end-code
-
-
-\ *** Block No. 138, Hexblock 8a
-8a fthpage
-
-\ busout/open/close/in        clv12jul87
-
-: busout    ( dev 2nd -- )
- i/o lock (busout ;
-
-: busopen   ( dev 2nd -- )
- 0F0 or busout ;
-
-: busclose  ( dev 2nd -- )
- 0E0 or busout busoff ;
-
- Code (busin  ( dev 2nd -- )
- MsgFlg stx  2 # lda  Setup jsr
- N 2+ lda  (?dev jsr
- N 2+ lda  TALK jsr
- N lda  60 # ora (C16 $ad sta ( )
- TKSA jsr
-\ because of error in old C16 OS
- N 2+ ldx  InDev stx
- xyNext jmp end-code
-
-: busin  ( dev 2nd -- )
- i/o lock  (busin ;
-
-
-\ *** Block No. 139, Hexblock 8b
-8b fthpage
-
-( bus-!/type/@/input derror?  24feb85re)
-
-Code bus!  ( 8b --)
- SP X) lda  CIOUT jsr  (xydrop jmp
- end-code
-
-: bustype  ( adr n --)
- bounds  ?DO  I c@ bus!  LOOP pause ;
-
-Code bus@  ( -- 8b)
- ACPTR jsr Push0A jmp  end-code
-
-: businput  ( adr n --)
- bounds  ?DO  bus@ I c! LOOP pause ;
-
-: derror?  ( -- flag )
- disk $F busin bus@  dup Ascii 0 -
-  IF  BEGIN emit bus@ dup #cr =  UNTIL
-  0= cr  THEN   0=  busoff ;
-
-
-\ *** Block No. 140, Hexblock 8c
-8c fthpage
-
-( s#>s+t  x,x                 28may85re)
-
-165 | Constant 1.t
-1EA | Constant 2.t
-256 | Constant 3.t
-
-| : (s#>s+t ( sector# -- sect track)
-      dup 1.t u< IF 15 /mod exit THEN
- 3 +  dup 2.t u< IF 1.t - 13 /mod 11 +
-                            exit THEN
-      dup 3.t u< IF 2.t - 12 /mod 18 +
-                            exit THEN
- 3.t - 11 /mod 1E + ;
-
-| : s#>t+s  ( sector# -- track sect )
- (s#>s+t  1+ swap ;
-
-| : x,x ( sect track -- adr count)
- base push  decimal
- 0 <# #s drop Ascii , hold #s #> ;
-
-
-\ *** Block No. 141, Hexblock 8d
-8d fthpage
-
-( readsector writesector      28may85re)
-
-100 | Constant b/sek
-
-: readsector  ( adr tra# sect# -- flag)
- disk 0F busout
- " u1:13,0," count   bustype
- x,x bustype busoff pause
- derror? ?exit
- disk 0D busin b/sek businput busoff
- false ;
-
-: writesector  ( adr tra# sect# -- flag)
- rot disk 0F busout
- " b-p:13,0" count bustype busoff
- disk 0D busout b/sek bustype busoff
- disk 0F busout
- " u2:13,0," count  bustype
- x,x bustype busoff pause  derror? ;
-
-
-\ *** Block No. 142, Hexblock 8e
-8e fthpage
-
-( 1541r/w                     28may85re)
-
-: diskopen  ( -- flag)
- disk 0D busopen  Ascii # bus! busoff
- derror? ;
-
-: diskclose ( -- )
- disk 0D busclose  busoff ;
-
-: 1541r/w  ( adr blk file r/wf -- flag)
- swap Abort" no file"
- -rot  blk/drv /mod  dup (drv ! 3 u>
- IF . ." beyond capacity" nip exit  THEN
- diskopen  IF  drop nip exit  THEN
- 0 swap   2* 2* 4 bounds
- DO  drop  2dup I rot
-     IF    s#>t+s readsector
-     ELSE  s#>t+s writesector THEN
-     >r b/sek + r> dup  IF  LEAVE  THEN
- LOOP   -rot  2drop  diskclose  ;
-
-' 1541r/w  Is   r/w
+include vf-sys-cbm.fth
 
 
 \ *** Block No. 143, Hexblock 8f
+\ ... continued
 8f fthpage
 
-\ index findex ink-pot         05nov87re
-
-: index ( from to --)
- 1+ swap DO
-   cr  I 2 .r  I block 1+  25  type
-   stop?  IF LEAVE THEN  LOOP ;
-
-: findex ( from to --)
- diskopen  IF  2drop  exit  THEN
- 1+ swap DO  cr  I 2 .r
-   pad dup I 2* 2* s#>t+s readsector
-   >r 1+ 25 type
-   r> stop? or IF LEAVE THEN
- LOOP  diskclose  ;
-
 Create ink-pot
-    \ border bkgnd pen  0
-(C64    6 c,   6 c,  3 c, 0 c, ) \ Forth
-(C64   0E c,   6 c,  3 c, 0 c, ) \ Edi
-(C64    6 c,   6 c,  3 c, 0 c, ) \ User
-(C16   f6 c, 0f6 c, 03 c, 0 c, ) \ Forth
-(C16  0eE c, 0f6 c, 03 c, 0 c, ) \ Edi
-(C16  0f6 c, 0f6 c, 03 c, 0 c, ) \ User
+\ border bkgnd pen  0
+ f6 c, 0f6 c, 03 c, 0 c,  \ Forth
+0eE c, 0f6 c, 03 c, 0 c,  \ Edi
+0f6 c, 0f6 c, 03 c, 0 c,  \ User
 
 
 \ *** Block No. 146, Hexblock 92
diff --git a/6502/C64/src/vf-sys-c64.fth b/6502/C64/src/vf-sys-c64.fth
index b5daecc..a7bf6d1 100644
--- a/6502/C64/src/vf-sys-c64.fth
+++ b/6502/C64/src/vf-sys-c64.fth
@@ -1,32 +1,5 @@
 
-\ *** Block No. 126, Hexblock 7e
-7e fthpage
-
-\ CBM-Labels                   05nov87re
-
-$FFA5 >label ACPTR
-$FFC6 >label CHKIN
-$FFC9 >label CHKOUT
-$FFD2 >label CHROUT
-$FF81 >label CINT
-$FFA8 >label CIOUT
-$FFC3 >label CLOSE
-$FFCC >label CLRCHN
-$FFE4 >label GETIN
-$FF84 >label IOINIT
-$FFB1 >label LISTEN
-$FFC0 >label OPEN
-$FFF0 >label PLOT
-$FF8A >label RESTOR
-$FF93 >label SECOND
-$FFE1 >label STOP
-$FFB4 >label TALK
-$FF96 >label TKSA
-$FFEA >label UDTIM
-$FFAE >label UNLSN
-$FFAB >label UNTLK
-$FFCF >label CHRIN
-$FF99 >label MEMTOP
+include vf-lbls-cbm.fth
 
 \ *** Block No. 127, Hexblock 7f
 7f fthpage
@@ -83,332 +56,18 @@ Code curoff   ( --)
  1 # ldy  Next jmp   end-code
 
 
-\ *** Block No. 131, Hexblock 83
-83 fthpage
-
-( #bs #cr ..keyboard         clv12.4.87)
-
-: c64key  ( -- 8b)
- curon BEGIN pause c64key?  UNTIL
- curoff getkey ;
-
-14 Constant #bs   0D Constant #cr
-
-: c64decode
- ( addr cnt1 key -- addr cnt2)
-  #bs case?  IF  dup  IF del 1- THEN
-                            exit  THEN
-  #cr case?  IF  dup span ! exit THEN
-  >r  2dup +  r@ swap c!  r> emit  1+ ;
-
-: c64expect ( addr len1 -- )
- span !  0
- BEGIN  dup span @  u<
- WHILE  key  decode
- REPEAT 2drop space ;
-
-Input: keyboard   [ here input ! ]
- c64key c64key? c64decode c64expect ;
-
-
-\ *** Block No. 132, Hexblock 84
-84 fthpage
-
-( con! printable?            clv11.4.87)
-
-Code con!  ( 8b --)   SP X) lda
-Label (con!     ConOut jsr    SP 2inc
-Label (con!end  CurFlg stx InsCnt stx
- 1 # ldy ;c:  pause ;
-
-Label (printable?   \ for CBM-Code !
-                    \ CS is printable
-  80 # cmp  CC ?[   bl # cmp  rts  ]?
- 0E0 # cmp  CC ?[  0C0 # cmp  rts  ]?
- clc  rts  end-code
-
-Code printable? ( 8b -- 8b flag)
- SP X) lda  (printable? jsr CS ?[ dex ]?
- txa  PushA jmp     end-code
-
-
-\ *** Block No. 133, Hexblock 85
-85 fthpage
-
-( emit cr del page at at?    clv11.4.87)
-
-Code c64emit  ( 8b -- )
- SP X) lda  (printable? jsr
-    CC ?[  Ascii . # lda ]?
- (con! jmp   end-code
-
-: c64cr     #cr con! ;
-
-: c64del    9D con!  space  9D con! ;
-
-: c64page   93 con! ;
-
-Code c64at  ( row col --)
- 2 # lda  Setup jsr
- N 2+ ldx  N ldy  clc  PLOT jsr
-(C16 \ ) 0D3 ldy  0D1 )Y lda   0CE sta
- xyNext jmp  end-code
-
-Code c64at?  ( -- row col)
- SP 2dec txa  SP )Y sta
- sec  PLOT jsr
- 28 # cpy  tya  CS ?[ 28 # sbc ]?
- pha  txa  0 # ldx  SP X) sta  pla
- Push0A jmp  end-code
-
-
-\ *** Block No. 134, Hexblock 86
-86 fthpage
-
-( type display (bye          clv11.4.87)
-
-Code  c64type  ( adr len -- )
- 2 # lda  Setup jsr  0 # ldy
-  [[  N cpy  0<>
-  ?[[  N 2+ )Y lda  (printable? jsr
-         CC ?[  Ascii . # lda  ]?
- ConOut jsr  iny  ]]?
- (con!end jmp   end-code
-
-Output: display   [ here output ! ]
- c64emit c64cr c64type c64del c64page
- c64at c64at? ;
-
-(C64  | Create (bye  $FCE2  here 2- ! )
-
-(C16- | Create (bye  $FF52  here 2- ! )
-
-(C16+ | CODE   (bye  rom $FF52 jmp  end-code )
-
-
-\ *** Block No. 135, Hexblock 87
-87 fthpage
-
-\ b/blk drive >drive drvinit  clv14:2x87
-
-400 Constant b/blk
-
-0AA Constant blk/drv
-
-Variable (drv    0 (drv !
-
-| : disk ( -- dev.no )   (drv @ 8 + ;
-
-: drive  ( drv# -- )
- blk/drv *  offset ! ;
-
-: >drive ( block drv# -- block' )
- blk/drv * +   offset @ - ;
-
-: drv?    ( block -- drv# )
- offset @ + blk/drv / ;
-
-: drvinit  noop ;
-
-
-\ *** Block No. 136, Hexblock 88
-88 fthpage
-
-( i/o busoff                  10may85we)
-
-Variable i/o  0 i/o !  \ Semaphore
-
-Code busoff  ( --)   CLRCHN jsr
-Label unlocki/o  1 # ldy  0 # ldx
- ;c:  i/o unlock ;
-
-Label nodevice     0 # ldx  1 # ldy
- ;c:  busoff   buffers unlock
-      true Abort" no device" ;
-
-
-\ *** Block No. 137, Hexblock 89
-89 fthpage
-
-\ ?device                     clv12jul87
-
-Label (?dev
- 90 stx (C16 $ae sta ( ) LISTEN jsr
-        \ because of error in OS
- 60 # lda  SECOND jsr  UNLSN jsr
- 90 lda  0<> ?[ pla pla nodevice jmp ]?
- rts    end-code
-
- Code (?device  ( dev --)
- SP X) lda  (?dev jsr  SP 2inc
- unlocki/o jmp  end-code
-
-: ?device  ( dev -- )
- i/o lock  (?device ;
-
- Code (busout  ( dev 2nd -- )
- MsgFlg stx  2 # lda  Setup jsr
- N 2+ lda  (?dev jsr
- N 2+ lda  LISTEN jsr
- N lda  60 # ora SECOND jsr
- N 2+ ldx  OutDev stx
- xyNext jmp  end-code
-
-
-\ *** Block No. 138, Hexblock 8a
-8a fthpage
-
-\ busout/open/close/in        clv12jul87
-
-: busout    ( dev 2nd -- )
- i/o lock (busout ;
-
-: busopen   ( dev 2nd -- )
- 0F0 or busout ;
-
-: busclose  ( dev 2nd -- )
- 0E0 or busout busoff ;
-
- Code (busin  ( dev 2nd -- )
- MsgFlg stx  2 # lda  Setup jsr
- N 2+ lda  (?dev jsr
- N 2+ lda  TALK jsr
- N lda  60 # ora (C16 $ad sta ( )
- TKSA jsr
-\ because of error in old C16 OS
- N 2+ ldx  InDev stx
- xyNext jmp end-code
-
-: busin  ( dev 2nd -- )
- i/o lock  (busin ;
-
-
-\ *** Block No. 139, Hexblock 8b
-8b fthpage
-
-( bus-!/type/@/input derror?  24feb85re)
-
-Code bus!  ( 8b --)
- SP X) lda  CIOUT jsr  (xydrop jmp
- end-code
-
-: bustype  ( adr n --)
- bounds  ?DO  I c@ bus!  LOOP pause ;
-
-Code bus@  ( -- 8b)
- ACPTR jsr Push0A jmp  end-code
-
-: businput  ( adr n --)
- bounds  ?DO  bus@ I c! LOOP pause ;
-
-: derror?  ( -- flag )
- disk $F busin bus@  dup Ascii 0 -
-  IF  BEGIN emit bus@ dup #cr =  UNTIL
-  0= cr  THEN   0=  busoff ;
-
-
-\ *** Block No. 140, Hexblock 8c
-8c fthpage
-
-( s#>s+t  x,x                 28may85re)
-
-165 | Constant 1.t
-1EA | Constant 2.t
-256 | Constant 3.t
-
-| : (s#>s+t ( sector# -- sect track)
-      dup 1.t u< IF 15 /mod exit THEN
- 3 +  dup 2.t u< IF 1.t - 13 /mod 11 +
-                            exit THEN
-      dup 3.t u< IF 2.t - 12 /mod 18 +
-                            exit THEN
- 3.t - 11 /mod 1E + ;
-
-| : s#>t+s  ( sector# -- track sect )
- (s#>s+t  1+ swap ;
-
-| : x,x ( sect track -- adr count)
- base push  decimal
- 0 <# #s drop Ascii , hold #s #> ;
-
-
-\ *** Block No. 141, Hexblock 8d
-8d fthpage
-
-( readsector writesector      28may85re)
-
-100 | Constant b/sek
-
-: readsector  ( adr tra# sect# -- flag)
- disk 0F busout
- " u1:13,0," count   bustype
- x,x bustype busoff pause
- derror? ?exit
- disk 0D busin b/sek businput busoff
- false ;
-
-: writesector  ( adr tra# sect# -- flag)
- rot disk 0F busout
- " b-p:13,0" count bustype busoff
- disk 0D busout b/sek bustype busoff
- disk 0F busout
- " u2:13,0," count  bustype
- x,x bustype busoff pause  derror? ;
-
-
-\ *** Block No. 142, Hexblock 8e
-8e fthpage
-
-( 1541r/w                     28may85re)
-
-: diskopen  ( -- flag)
- disk 0D busopen  Ascii # bus! busoff
- derror? ;
-
-: diskclose ( -- )
- disk 0D busclose  busoff ;
-
-: 1541r/w  ( adr blk file r/wf -- flag)
- swap Abort" no file"
- -rot  blk/drv /mod  dup (drv ! 3 u>
- IF . ." beyond capacity" nip exit  THEN
- diskopen  IF  drop nip exit  THEN
- 0 swap   2* 2* 4 bounds
- DO  drop  2dup I rot
-     IF    s#>t+s readsector
-     ELSE  s#>t+s writesector THEN
-     >r b/sek + r> dup  IF  LEAVE  THEN
- LOOP   -rot  2drop  diskclose  ;
-
-' 1541r/w  Is   r/w
+include vf-sys-cbm.fth
 
 
 \ *** Block No. 143, Hexblock 8f
+\ ... continued
 8f fthpage
 
-\ index findex ink-pot         05nov87re
-
-: index ( from to --)
- 1+ swap DO
-   cr  I 2 .r  I block 1+  25  type
-   stop?  IF LEAVE THEN  LOOP ;
-
-: findex ( from to --)
- diskopen  IF  2drop  exit  THEN
- 1+ swap DO  cr  I 2 .r
-   pad dup I 2* 2* s#>t+s readsector
-   >r 1+ 25 type
-   r> stop? or IF LEAVE THEN
- LOOP  diskclose  ;
-
 Create ink-pot
-    \ border bkgnd pen  0
-(C64    6 c,   6 c,  3 c, 0 c, ) \ Forth
-(C64   0E c,   6 c,  3 c, 0 c, ) \ Edi
-(C64    6 c,   6 c,  3 c, 0 c, ) \ User
-(C16   f6 c, 0f6 c, 03 c, 0 c, ) \ Forth
-(C16  0eE c, 0f6 c, 03 c, 0 c, ) \ Edi
-(C16  0f6 c, 0f6 c, 03 c, 0 c, ) \ User
+\ border bkgnd pen  0
+  6 c,   6 c,  3 c, 0 c,  \ Forth
+ 0E c,   6 c,  3 c, 0 c,  \ Edi
+  6 c,   6 c,  3 c, 0 c,  \ User
 
 
 \ *** Block No. 144, Hexblock 90
diff --git a/6502/C64/src/vf-sys-cbm.fth b/6502/C64/src/vf-sys-cbm.fth
new file mode 100644
index 0000000..ee26313
--- /dev/null
+++ b/6502/C64/src/vf-sys-cbm.fth
@@ -0,0 +1,318 @@
+
+\ *** Block No. 131, Hexblock 83
+83 fthpage
+
+( #bs #cr ..keyboard         clv12.4.87)
+
+: c64key  ( -- 8b)
+ curon BEGIN pause c64key?  UNTIL
+ curoff getkey ;
+
+14 Constant #bs   0D Constant #cr
+
+: c64decode
+ ( addr cnt1 key -- addr cnt2)
+  #bs case?  IF  dup  IF del 1- THEN
+                            exit  THEN
+  #cr case?  IF  dup span ! exit THEN
+  >r  2dup +  r@ swap c!  r> emit  1+ ;
+
+: c64expect ( addr len1 -- )
+ span !  0
+ BEGIN  dup span @  u<
+ WHILE  key  decode
+ REPEAT 2drop space ;
+
+Input: keyboard   [ here input ! ]
+ c64key c64key? c64decode c64expect ;
+
+
+\ *** Block No. 132, Hexblock 84
+84 fthpage
+
+( con! printable?            clv11.4.87)
+
+Code con!  ( 8b --)   SP X) lda
+Label (con!     ConOut jsr    SP 2inc
+Label (con!end  CurFlg stx InsCnt stx
+ 1 # ldy ;c:  pause ;
+
+Label (printable?   \ for CBM-Code !
+                    \ CS is printable
+  80 # cmp  CC ?[   bl # cmp  rts  ]?
+ 0E0 # cmp  CC ?[  0C0 # cmp  rts  ]?
+ clc  rts  end-code
+
+Code printable? ( 8b -- 8b flag)
+ SP X) lda  (printable? jsr CS ?[ dex ]?
+ txa  PushA jmp     end-code
+
+
+\ *** Block No. 133, Hexblock 85
+85 fthpage
+
+( emit cr del page at at?    clv11.4.87)
+
+Code c64emit  ( 8b -- )
+ SP X) lda  (printable? jsr
+    CC ?[  Ascii . # lda ]?
+ (con! jmp   end-code
+
+: c64cr     #cr con! ;
+
+: c64del    9D con!  space  9D con! ;
+
+: c64page   93 con! ;
+
+Code c64at  ( row col --)
+ 2 # lda  Setup jsr
+ N 2+ ldx  N ldy  clc  PLOT jsr
+(C16 \ ) 0D3 ldy  0D1 )Y lda   0CE sta
+ xyNext jmp  end-code
+
+Code c64at?  ( -- row col)
+ SP 2dec txa  SP )Y sta
+ sec  PLOT jsr
+ 28 # cpy  tya  CS ?[ 28 # sbc ]?
+ pha  txa  0 # ldx  SP X) sta  pla
+ Push0A jmp  end-code
+
+
+\ *** Block No. 134, Hexblock 86
+86 fthpage
+
+( type display (bye          clv11.4.87)
+
+Code  c64type  ( adr len -- )
+ 2 # lda  Setup jsr  0 # ldy
+  [[  N cpy  0<>
+  ?[[  N 2+ )Y lda  (printable? jsr
+         CC ?[  Ascii . # lda  ]?
+ ConOut jsr  iny  ]]?
+ (con!end jmp   end-code
+
+Output: display   [ here output ! ]
+ c64emit c64cr c64type c64del c64page
+ c64at c64at? ;
+
+(C64  | Create (bye  $FCE2  here 2- ! )
+
+(C16- | Create (bye  $FF52  here 2- ! )
+
+(C16+ | CODE   (bye  rom $FF52 jmp  end-code )
+
+
+\ *** Block No. 135, Hexblock 87
+87 fthpage
+
+\ b/blk drive >drive drvinit  clv14:2x87
+
+400 Constant b/blk
+
+0AA Constant blk/drv
+
+Variable (drv    0 (drv !
+
+| : disk ( -- dev.no )   (drv @ 8 + ;
+
+: drive  ( drv# -- )
+ blk/drv *  offset ! ;
+
+: >drive ( block drv# -- block' )
+ blk/drv * +   offset @ - ;
+
+: drv?    ( block -- drv# )
+ offset @ + blk/drv / ;
+
+: drvinit  noop ;
+
+
+\ *** Block No. 136, Hexblock 88
+88 fthpage
+
+( i/o busoff                  10may85we)
+
+Variable i/o  0 i/o !  \ Semaphore
+
+Code busoff  ( --)   CLRCHN jsr
+Label unlocki/o  1 # ldy  0 # ldx
+ ;c:  i/o unlock ;
+
+Label nodevice     0 # ldx  1 # ldy
+ ;c:  busoff   buffers unlock
+      true Abort" no device" ;
+
+
+\ *** Block No. 137, Hexblock 89
+89 fthpage
+
+\ ?device                     clv12jul87
+
+Label (?dev
+ 90 stx (C16 $ae sta ( ) LISTEN jsr
+        \ because of error in OS
+ 60 # lda  SECOND jsr  UNLSN jsr
+ 90 lda  0<> ?[ pla pla nodevice jmp ]?
+ rts    end-code
+
+ Code (?device  ( dev --)
+ SP X) lda  (?dev jsr  SP 2inc
+ unlocki/o jmp  end-code
+
+: ?device  ( dev -- )
+ i/o lock  (?device ;
+
+ Code (busout  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  LISTEN jsr
+ N lda  60 # ora SECOND jsr
+ N 2+ ldx  OutDev stx
+ xyNext jmp  end-code
+
+
+\ *** Block No. 138, Hexblock 8a
+8a fthpage
+
+\ busout/open/close/in        clv12jul87
+
+: busout    ( dev 2nd -- )
+ i/o lock (busout ;
+
+: busopen   ( dev 2nd -- )
+ 0F0 or busout ;
+
+: busclose  ( dev 2nd -- )
+ 0E0 or busout busoff ;
+
+ Code (busin  ( dev 2nd -- )
+ MsgFlg stx  2 # lda  Setup jsr
+ N 2+ lda  (?dev jsr
+ N 2+ lda  TALK jsr
+ N lda  60 # ora (C16 $ad sta ( )
+ TKSA jsr
+\ because of error in old C16 OS
+ N 2+ ldx  InDev stx
+ xyNext jmp end-code
+
+: busin  ( dev 2nd -- )
+ i/o lock  (busin ;
+
+
+\ *** Block No. 139, Hexblock 8b
+8b fthpage
+
+( bus-!/type/@/input derror?  24feb85re)
+
+Code bus!  ( 8b --)
+ SP X) lda  CIOUT jsr  (xydrop jmp
+ end-code
+
+: bustype  ( adr n --)
+ bounds  ?DO  I c@ bus!  LOOP pause ;
+
+Code bus@  ( -- 8b)
+ ACPTR jsr Push0A jmp  end-code
+
+: businput  ( adr n --)
+ bounds  ?DO  bus@ I c! LOOP pause ;
+
+: derror?  ( -- flag )
+ disk $F busin bus@  dup Ascii 0 -
+  IF  BEGIN emit bus@ dup #cr =  UNTIL
+  0= cr  THEN   0=  busoff ;
+
+
+\ *** Block No. 140, Hexblock 8c
+8c fthpage
+
+( s#>s+t  x,x                 28may85re)
+
+165 | Constant 1.t
+1EA | Constant 2.t
+256 | Constant 3.t
+
+| : (s#>s+t ( sector# -- sect track)
+      dup 1.t u< IF 15 /mod exit THEN
+ 3 +  dup 2.t u< IF 1.t - 13 /mod 11 +
+                            exit THEN
+      dup 3.t u< IF 2.t - 12 /mod 18 +
+                            exit THEN
+ 3.t - 11 /mod 1E + ;
+
+| : s#>t+s  ( sector# -- track sect )
+ (s#>s+t  1+ swap ;
+
+| : x,x ( sect track -- adr count)
+ base push  decimal
+ 0 <# #s drop Ascii , hold #s #> ;
+
+
+\ *** Block No. 141, Hexblock 8d
+8d fthpage
+
+( readsector writesector      28may85re)
+
+100 | Constant b/sek
+
+: readsector  ( adr tra# sect# -- flag)
+ disk 0F busout
+ " u1:13,0," count   bustype
+ x,x bustype busoff pause
+ derror? ?exit
+ disk 0D busin b/sek businput busoff
+ false ;
+
+: writesector  ( adr tra# sect# -- flag)
+ rot disk 0F busout
+ " b-p:13,0" count bustype busoff
+ disk 0D busout b/sek bustype busoff
+ disk 0F busout
+ " u2:13,0," count  bustype
+ x,x bustype busoff pause  derror? ;
+
+
+\ *** Block No. 142, Hexblock 8e
+8e fthpage
+
+( 1541r/w                     28may85re)
+
+: diskopen  ( -- flag)
+ disk 0D busopen  Ascii # bus! busoff
+ derror? ;
+
+: diskclose ( -- )
+ disk 0D busclose  busoff ;
+
+: 1541r/w  ( adr blk file r/wf -- flag)
+ swap Abort" no file"
+ -rot  blk/drv /mod  dup (drv ! 3 u>
+ IF . ." beyond capacity" nip exit  THEN
+ diskopen  IF  drop nip exit  THEN
+ 0 swap   2* 2* 4 bounds
+ DO  drop  2dup I rot
+     IF    s#>t+s readsector
+     ELSE  s#>t+s writesector THEN
+     >r b/sek + r> dup  IF  LEAVE  THEN
+ LOOP   -rot  2drop  diskclose  ;
+
+' 1541r/w  Is   r/w
+
+
+\ *** Block No. 143, Hexblock 8f
+8f fthpage
+
+\ index findex ink-pot         05nov87re
+
+: index ( from to --)
+ 1+ swap DO
+   cr  I 2 .r  I block 1+  25  type
+   stop?  IF LEAVE THEN  LOOP ;
+
+: findex ( from to --)
+ diskopen  IF  2drop  exit  THEN
+ 1+ swap DO  cr  I 2 .r
+   pad dup I 2* 2* s#>t+s readsector
+   >r 1+ 25 type
+   r> stop? or IF LEAVE THEN
+ LOOP  diskclose  ;

From 87c822f8a9ec39fbe99a231e1766295a4ed8b1f5 Mon Sep 17 00:00:00 2001
From: Philip Zembrod <pzembrod@google.com>
Date: Sun, 12 Jul 2020 23:12:20 +0200
Subject: [PATCH 8/8] Remove mapping of vforth4_2.d64 from build-vf.sh, now
 that we fully build from txt files.

---
 6502/C64/emulator/build-vf.sh | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/6502/C64/emulator/build-vf.sh b/6502/C64/emulator/build-vf.sh
index 0493029..9f8ef01 100755
--- a/6502/C64/emulator/build-vf.sh
+++ b/6502/C64/emulator/build-vf.sh
@@ -18,5 +18,5 @@ test -n "$target" && rm -f "${basedir}/cbmfiles/${target}"
 keybuf="include ${source}\nsave-target ${target}\ndos s0:notdone\n"
 test -z "$target" && keybuf="include ${source}\n"
 
-DISK9=vforth4_2 DISK10=tc38q "${emulatordir}/run-in-vice.sh" \
+DISK10=tc38q "${emulatordir}/run-in-vice.sh" \
   "tcbase" "${keybuf}"