mirror of
https://github.com/forth-ev/VolksForth.git
synced 2025-01-10 21:29:24 +00:00
Merge pull request #11 from pzembrod/master
Build c64-vf-latest and c16-vf-latest fully from txt file sources
This commit is contained in:
Carsten Strotmann
GitHub
commit
75d4310434
@ -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}"
|
||||
|
||||
18
6502/C64/src/vf-c16+jsr.fth
Normal file
18
6502/C64/src/vf-c16+jsr.fth
Normal file
@ -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
|
||||
@ -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-head-c16.fth
|
||||
include vf-cbm-core.fth
|
||||
include vf-sys-c16.fth
|
||||
include vf-finalize.fth
|
||||
|
||||
|
||||
include vf-main.fth
|
||||
include vf-pr-target.fth
|
||||
quit
|
||||
|
||||
@ -1,44 +1,38 @@
|
||||
|
||||
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
|
||||
\ including an initial C16+ tweak
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
include vf-c16+jsr.fth
|
||||
include vf-head-c16.fth
|
||||
include vf-cbm-core.fth
|
||||
include vf-sys-c16.fth
|
||||
include vf-finalize.fth
|
||||
|
||||
\ load/remove JSR-Macros clv14.4.87)
|
||||
|
||||
Assembler also definitions
|
||||
|
||||
\needs C16+Jsr 8 load
|
||||
' C16+Jsr Is Jsr .( JSR Is:C16+ )
|
||||
|
||||
|
||||
include vf-main.fth
|
||||
include vf-pr-target.fth
|
||||
quit
|
||||
|
||||
@ -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-head-c64.fth
|
||||
include vf-cbm-core.fth
|
||||
include vf-sys-c64.fth
|
||||
include vf-finalize.fth
|
||||
|
||||
|
||||
include vf-main.fth
|
||||
include vf-pr-target.fth
|
||||
quit
|
||||
|
||||
@ -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
|
||||
32
6502/C64/src/vf-head-c16.fth
Normal file
32
6502/C64/src/vf-head-c16.fth
Normal file
@ -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- " )
|
||||
31
6502/C64/src/vf-head-c64.fth
Normal file
31
6502/C64/src/vf-head-c64.fth
Normal file
@ -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 "
|
||||
29
6502/C64/src/vf-lbls-cbm.fth
Normal file
29
6502/C64/src/vf-lbls-cbm.fth
Normal file
@ -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
|
||||
@ -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
|
||||
140
6502/C64/src/vf-sys-c16.fth
Normal file
140
6502/C64/src/vf-sys-c16.fth
Normal file
@ -0,0 +1,140 @@
|
||||
|
||||
include vf-lbls-cbm.fth
|
||||
|
||||
\ *** 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
|
||||
|
||||
|
||||
include vf-sys-cbm.fth
|
||||
|
||||
|
||||
\ *** Block No. 143, Hexblock 8f
|
||||
\ ... continued
|
||||
8f fthpage
|
||||
|
||||
Create ink-pot
|
||||
\ 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
|
||||
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
|
||||
123
6502/C64/src/vf-sys-c64.fth
Normal file
123
6502/C64/src/vf-sys-c64.fth
Normal file
@ -0,0 +1,123 @@
|
||||
|
||||
include vf-lbls-cbm.fth
|
||||
|
||||
\ *** 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
|
||||
|
||||
|
||||
include vf-sys-cbm.fth
|
||||
|
||||
|
||||
\ *** Block No. 143, Hexblock 8f
|
||||
\ ... continued
|
||||
8f fthpage
|
||||
|
||||
Create ink-pot
|
||||
\ 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
|
||||
90 fthpage
|
||||
|
||||
\ C64 restore
|
||||
|
||||
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
|
||||
318
6502/C64/src/vf-sys-cbm.fth
Normal file
318
6502/C64/src/vf-sys-cbm.fth
Normal file
@ -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 ;
|
||||
Loading…
x
Reference in New Issue
Block a user