Merge pull request #36 from pzembrod/v3.9.3

V3.9.3

6502/C64/Makefile

@@ -34,7 +34,7 @@ clean:
 
 binaries: $(vf_binaries)
 
-test: $(test_resuls)
+test: $(test_resuls) test-v4th-x16-39.result
 
 test64: std64 blk64
 
@@ -136,6 +136,16 @@ test-v4th-x16.log: cbmfiles/v4th-x16 emulator/sdcard.img
 	mcopy -i emulator/sdcard.img ::TEST.LOG cbmfiles/test.log
 	petscii2ascii cbmfiles/test.log $@
 
+test-v4th-x16-39.log: cbmfiles/v4th-x16 emulator/sdcard.img
+	rm -f cbmfiles/test.log
+	emulator/run-in-x16-39.sh v4th-x16 \
+	  "include run-std-tests.fth\n1234567890\n"
+	mcopy -i emulator/sdcard.img ::TEST.LOG cbmfiles/test.log
+	petscii2ascii cbmfiles/test.log $@
+
+test-v4th-x16-39.golden: test-v4th-x16.golden
+	cp $< $@
+
 test-%.result: test-%.log test-%.golden tests/evaluate-test.sh
 	rm -f $@
 	tests/evaluate-test.sh $(basename $@)

6502/C64/emulator/run-in-x16-39.sh

@@ -0,0 +1,9 @@
+#!/bin/bash
+
+set -e
+
+emulatordir="$(realpath --relative-to="$PWD" "$(dirname "${BASH_SOURCE[0]}")")"
+
+export PATH="${HOME}/x16-r39:${PATH}"
+echo "PATH = ${PATH}"
+"${emulatordir}/run-in-x16emu.sh" "$@"

6502/C64/emulator/run-in-x16emu.sh

@@ -36,7 +36,7 @@ then
   mcopy -i "${sdcard}" "${emulatordir}/notdone" "::NOTDONE"
   warp="-warp"
 else
-  scale="-scale 2"
+  # scale="-scale 2"
   debug="-debug"
 fi
 

6502/C64/src/cbmopen.fth

@@ -0,0 +1,28 @@
+
+include vf-lbls-cbm.fth
+
+Code cbmopen  ( lfn ga sa fname fnlen -- )
+  5 # lda  Setup jsr
+  N 8 + lda  N 6 + ldx  N 4 + ldy  SETLFS jsr
+  N     lda  N 2 + ldx  N 3 + ldy  SETNAM jsr
+  OPEN jsr  xyNext jmp  end-code
+
+Code cbmclose  ( lfn -- )
+  SP X) lda  CLOSE jsr
+  Label xyPop   0 # ldx  1 # ldy
+  Pop jmp  end-code
+
+Code cbmchkin  ( lfn -- )
+  SP X) lda  tax  CHKIN jsr  xyPop jmp  end-code
+
+Code cbmchkout  ( lfn -- )
+  SP X) lda  tax  CHKOUT jsr  xyPop jmp  end-code
+
+Code cbmclrchn  ( -- )
+  CLRCHN jsr  xyNext jmp  end-code
+
+Code cbmbasout  ( chr -- )
+  SP X) lda  CHROUT jsr  xyPop jmp  end-code
+
+Code cbmbasin  ( -- chr )
+  CHRIN jsr  Push0A jmp  end-code

6502/C64/src/notmpheap.fth

@@ -8,4 +8,4 @@
 ' |on  alias ||on
 ' |off alias ||off
 
-' noop alias tmpclear
+' noop alias tmp-clear

6502/C64/src/tmpheap.fth

@@ -31,11 +31,11 @@ reset-tmp-heap
    tmpheap> @ over - ;
 
 | : tmp-heapmove1x   ( from size -- from offset )
-   tmp-heapmove  ?heapmovetx off ;
+   tmp-heapmove  ?headmove-xt off ;
 
-: ||     ['] tmp-heapmove1x  ?heapmovetx ! ;
-: ||on   ['] tmp-heapmove    ?heapmovetx ! ;
-: ||off  ?heapmovetx off ;
+: ||     ['] tmp-heapmove1x  ?headmove-xt ! ;
+: ||on   ['] tmp-heapmove    ?headmove-xt ! ;
+: ||off  ?headmove-xt off ;
 
 
 | : remove-tmp-words-in-voc  ( voc -- )
@@ -51,7 +51,7 @@ reset-tmp-heap
  voc-link  BEGIN  @ ?dup
   WHILE  dup 4 - remove-tmp-words-in-voc REPEAT  ;
 
-: tmpclear  ( -- )
+: tmp-clear  ( -- )
   remove-tmp-words
   \ Uncomment the following line to help determine the ideal tmpheap
   \ size for your project.

6502/C64/src/vf-cbm-bufs.fth

@@ -1,6 +1,25 @@
 \ *** Block No. 102, Hexblock 66
+\needs fthpage ' drop | alias fthpage
 66 fthpage
 
+( load +load thru +thru --> )
+
+: load   ( blk --)
+ ?dup 0= ?exit blk push  blk !
+ >in push  >in off
+ .status interpret ;
+
+: +load  ( offset --)  blk @  + load ;
+
+: thru  ( from to --)
+ 1+  swap  DO  I load  LOOP ;
+
+: +thru  ( off0 off1 --)
+ 1+  swap  DO  I +load LOOP ;
+
+: -->
+ 1 blk +! >in off .status  ;  immediate
+
 ( buffer mechanism            15dec83ks)
 
 User file           0 file !

6502/C64/src/vf-cbm-core.fth

@@ -1650,7 +1650,7 @@ Label docreate
 \ *** Block No. 76, Hexblock 4c
 4c fthpage
 
-\ warning  ?heapmovetx  |  |on |off  Create
+\ warning  ?headmove-xt  |  |on |off  Create
 
 Variable warning  0 warning !
 
@@ -1660,18 +1660,18 @@ Variable warning  0 warning !
  IF space  last @ .name ." exists " ?cr
  THEN  ;
 
-Variable ?heapmovetx  0 ?heapmovetx !
+Variable ?headmove-xt  0 ?headmove-xt !
 
 | : heapmove   ( from size -- offset )
    over >r  dup hallot ( from size ) heap swap cmove ( )
    heap r> - ;
 
 | : heapmove1x   ( from size -- offset )
-   heapmove  ?heapmovetx off ;
+   heapmove  ?headmove-xt off ;
 
-: |     ['] heapmove1x  ?heapmovetx ! ;
-: |on   ['] heapmove    ?heapmovetx ! ;
-: |off  ?heapmovetx off ;
+: |     ['] heapmove1x  ?headmove-xt ! ;
+: |on   ['] heapmove    ?headmove-xt ! ;
+: |off  ?headmove-xt off ;
 
 : Create
  here
@@ -1679,10 +1679,10 @@ Variable ?heapmovetx  0 ?heapmovetx !
  name c@
  dup 1 $20 uwithin not  Abort" invalid name"
  here last !  1+ allot  exists?
- ?heapmovetx @
+ ?headmove-xt @
  IF dup  6502-align/1 ,  \ Pointer to code
     dup  here  over -
-    ?heapmovetx perform  last +!
+    ?headmove-xt perform  last +!
     $20 flag! 6502-align/1 dp !
  ELSE  6502-align/2  drop
  THEN  reveal  0 ,
@@ -2122,7 +2122,7 @@ Code ?stack
 \ *** Block No. 92, Hexblock 5c
 5c fthpage
 
-( .status push load           08sep84ks)
+( .status push           08sep84ks)
 
 Defer .status    ' noop Is .status
 
@@ -2132,37 +2132,10 @@ Defer .status    ' noop Is .status
  r> swap dup >r @ >r  pull >r >r  ;
  restrict
 
-: load   ( blk --)
- ?dup 0= ?exit blk push  blk !
- >in push  >in off
- .status interpret ;
-
-
-
-
-
-
-
-
-
-
-
-
 \ *** Block No. 93, Hexblock 5d
 5d fthpage
 
-( +load thru +thru --> rdepth depth  ks)
-
-: +load  ( offset --)  blk @  + load ;
-
-: thru  ( from to --)
- 1+  swap  DO  I load  LOOP ;
-
-: +thru  ( off0 off1 --)
- 1+  swap  DO  I +load LOOP ;
-
-: -->
- 1 blk +! >in off .status  ;  immediate
+( rdepth depth  ks)
 
 : rdepth  ( -- +n)  r0 @  rp@ 2+ - 2/ ;
 

6502/C64/src/vf-cbm-file.fth

@@ -63,8 +63,8 @@
 \   include                    09jun20pz
 
   : interpret-via-tib
- BEGIN freadline >r  >in off
- interpret  r> UNTIL ;
+ BEGIN freadline >r  .status
+ >in off interpret  r> UNTIL ;
 
   : include ( -- )
  blk @ Abort" no include from blk"

6502/C64/src/vf-head-c16.fth

@@ -28,5 +28,5 @@ here dup origin!
 $100 allot
 
 Create logo
- (C16+ ," volksFORTH-83 3.9.2-C16+ " )
- (C16- ," volksFORTH-83 3.9.2-C16- " )
+ (C16+ ," volksFORTH-83 3.9.3-C16+ " )
+ (C16- ," volksFORTH-83 3.9.3-C16- " )

6502/C64/src/vf-head-c64.fth

@@ -28,4 +28,4 @@ here dup origin!
 $100 allot
 
 Create logo
-  ," volksFORTH-83 3.9.2-C64  "
+  ," volksFORTH-83 3.9.3-C64  "

6502/C64/src/vf-head-x16.fth

@@ -27,4 +27,4 @@ here dup origin!
 $100 allot
 
 Create logo
-  ," volksFORTH-83 3.9.2-X16  "
+  ," volksFORTH-83 3.9.3-X16  "

6502/C64/src/vf-sys-c64.fth

@@ -20,6 +20,12 @@ include vf-lbls-cbm.fth
   0d8 >label InsCnt
  028a >label KeyRep
 
+  0cc >label blnsw
+  0cd >label blnct
+  0ce >label gdbln
+  0cf >label blnon
+  0d1 >label pnt
+  0d3 >label pntr
 
 \ *** Block No. 129, Hexblock 81
 81 fthpage
@@ -48,12 +54,12 @@ Code getkey  ( -- 8b)
 \ C64 curon curoff
 
 Code curon   ( --)
- 0D3 ldy  0D1 )Y lda  0CE sta  0CC stx
+ pntr ldy  pnt )Y lda  gdbln sta  blnsw stx
  xyNext jmp   end-code
 
 Code curoff   ( --)
- iny  0CC sty  0CD sty  0CF stx
- 0CE lda  0D3 ldy  0D1 )Y sta
+ iny  blnsw sty  blnct sty  blnon stx
+ gdbln lda  pntr ldy  pnt )Y sta
  1 # ldy  Next jmp   end-code
 
 

6502/C64/src/vf-sys-x16.fth

@@ -5,7 +5,7 @@ include vf-lbls-cbm.fth
 
 \ X16 labels
 
-0c28c >label ConOut
+0ffd2 >label ConOut
  0286 >label IOStatus
  028c >label MsgFlg
  028b >label OutDev
@@ -18,6 +18,22 @@ include vf-lbls-cbm.fth
  0381 >label CurFlg  \ aka qtsw
  0385 >label InsCnt  \ aka insrt
 
+\ TODO(issues/33): Remove the R?mBank38 labels.
+09f60 >label RomBank38
+09f61 >label RamBank38
+1 >label RomBank
+0 >label RamBank
+
+0a000 >label KeyD  \ keyboard buffer
+0a00a >label Ndx   \ #keys in keyboard buffer
+
+  037B >label blnsw  \ C64: $cc
+\   037C >label blnct  \ C64: $cd
+\   037D >label gdbln  \ C64: $ce
+\   037E >label blnon  \ C64: $cf
+\   0262 >label pnt    \ C64: $d1
+\   0380 >label pntr   \ C64: $d3
+\   0373 >label gdcol
 
 \ C64 labels that X16 doesn't have:
 
@@ -30,22 +46,30 @@ include vf-lbls-cbm.fth
 \ X16 c64key? getkey
 
 Code c64key? ( -- flag)
- 9f61 ldx
- 0 # lda  9f61 sta
- 0a00a lda
+ RamBank ldx
+\ TODO(issues/33): Remove the lines accessing RamBank38.
+ RamBank38 ldy
+ 0 # lda  RamBank sta
+ RamBank38 sta
+ Ndx lda
  0<> ?[  0FF # lda  ]? pha
- 9f61 stx
+ RamBank stx
+ RamBank38 sty
  Push jmp  end-code
 
 Code getkey  ( -- 8b)
- 9f61 lda  N sta
- 0 # lda  9f61 sta
- 0a00a lda  0<>
- ?[  sei  0a000 ldy
-  [[  0a000 1+ ,X lda  0a000 ,X sta  inx
-      0a00a cpx  0= ?]
-  0a00a dec
-  N lda  9f61 sta
+ RamBank lda  N sta
+\ TODO(issues/33): Remove the lines accessing RamBank38.
+ RamBank38 lda  N 1+ sta
+ 0 # lda  RamBank sta
+ RamBank38 sta
+ Ndx lda  0<>
+ ?[  sei  KeyD ldy
+  [[  KeyD 1+ ,X lda  KeyD ,X sta  inx
+      Ndx cpx  0= ?]
+  Ndx dec
+  N lda  RamBank sta
+  N 1+ lda  RamBank38 sta
   tya  cli  0A0 # cmp
   0= ?[  bl # lda  ]?
  ]?
@@ -57,16 +81,6 @@ Code getkey  ( -- 8b)
 
 \ X16 curon curoff
 
-  037B >label blnsw  \ C64: $cc
-\   037C >label blnct  \ C64: $cd
-\   037D >label gdbln  \ C64: $ce
-\   037E >label blnon  \ C64: $cf
-\   0262 >label pnt    \ C64: $d1
-\   0380 >label pntr   \ C64: $d3
-\   0373 >label gdcol
-
-09f60 >label via1pb
-
 Code curon   ( --)
   blnsw stx  Next jmp  end-code
 
@@ -109,7 +123,9 @@ Label restore   pha txa pha tya pha cld
 
 Label first-init
  sei cld
- via1pb lda  $f8 # and  via1pb sta \ map in KERNAL ROM
+ RomBank lda  $f8 # and  RomBank sta \ map in KERNAL ROM
+\ TODO(issues/33): Remove this line accessing RomBank38.
+ RomBank38 lda  $f8 # and  RomBank38 sta \ map in KERNAL ROM for R38
  IOINIT jsr  CINT jsr  RESTOR jsr  \ init. and set I/O-Vectors
  ink-pot    lda BrdCol sta \ border
  ink-pot 1+ lda BkgCol sta \ backgrnd

6502/C64/src/x16tmpheap.fth

@@ -29,11 +29,11 @@ User ]tmpheap
    tmpheap> @ over - ;
 
 | : tmp-heapmove1x   ( from size -- from offset )
-   tmp-heapmove  ?heapmovetx off ;
+   tmp-heapmove  ?headmove-xt off ;
 
-: ||     ['] tmp-heapmove1x  ?heapmovetx ! ;
-: ||on   ['] tmp-heapmove    ?heapmovetx ! ;
-: ||off  ?heapmovetx off ;
+: ||     ['] tmp-heapmove1x  ?headmove-xt ! ;
+: ||on   ['] tmp-heapmove    ?headmove-xt ! ;
+: ||off  ?headmove-xt off ;
 
 
 | : remove-tmp-words-in-voc  ( voc -- )
@@ -49,7 +49,7 @@ User ]tmpheap
  voc-link  BEGIN  @ ?dup
   WHILE  dup 4 - remove-tmp-words-in-voc REPEAT  ;
 
-: tmpclear  ( -- )
+: tmp-clear  ( -- )
   remove-tmp-words
   \ Uncomment the following line to help determine the ideal tmpheap
   \ size for your project.

6502/C64/tests/logtofile.fth

@@ -17,8 +17,8 @@ Output: alsologtofile
  c64at c64at? ;
 
 : logopen"
-  ascii " parse  log-dev-2nd@ busopen
-  2dup type
+  ascii " parse  2dup type
+  log-dev-2nd@ busopen
   bustype " ,s,w" count bustype busoff
   i/o-status? IF c64cr log-dev @ dos-error abort THEN
   alsologtofile ;