mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-12 18:09:39 +00:00
New Py65 target
This commit is contained in:
parent
7ebd1068b9
commit
281bf402a5
1
6502/py65/2words.fb
Normal file
1
6502/py65/2words.fb
Normal file
|
@ -0,0 +1 @@
|
|||
\ Additional definitions for 32bit values cas 26jan06 \ 2Words Loadscreen cas 26jan06 hex &2 &3 thru decimal \ 2! 2@ 2VARIABLE 2CONSTANT 08JUL85RE) CODE 2! ( D ADR --) TYA SETUP JSR 3 # LDY [[ SP )Y LDA N )Y STA DEY 0< ?] 1 # LDY POPTWO JMP END-CODE CODE 2@ ( ADR -- D) SP X) LDA N STA SP )Y LDA N 1+ STA SP 2DEC 3 # LDY [[ N )Y LDA SP )Y STA DEY 0< ?] XYNEXT JMP END-CODE \ : 2VARIABLE ( --) CREATE 4 ALLOT ; ( -- ADR) : 2CONSTANT ( D --) CREATE , , DOES> ( -- D) 2@ ; \ 2DUP EXISTS \ 2SWAP EXISTS \ 2DROP EXISTS
|
76
6502/py65/2words.fth
Normal file
76
6502/py65/2words.fth
Normal file
|
@ -0,0 +1,76 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ Additional definitions for 32bit values cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ 2Words Loadscreen cas 26jan06
|
||||
|
||||
hex
|
||||
&2 &3 thru
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ 2! 2@ 2VARIABLE 2CONSTANT 08JUL85RE)
|
||||
|
||||
CODE 2! ( D ADR --)
|
||||
TYA SETUP JSR 3 # LDY
|
||||
[[ SP )Y LDA N )Y STA DEY 0< ?]
|
||||
1 # LDY POPTWO JMP END-CODE
|
||||
|
||||
CODE 2@ ( ADR -- D)
|
||||
SP X) LDA N STA SP )Y LDA N 1+ STA
|
||||
SP 2DEC 3 # LDY
|
||||
[[ N )Y LDA SP )Y STA DEY 0< ?]
|
||||
XYNEXT JMP END-CODE
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\
|
||||
|
||||
: 2VARIABLE ( --) CREATE 4 ALLOT ;
|
||||
( -- ADR)
|
||||
|
||||
: 2CONSTANT ( D --) CREATE , , DOES> ( -- D) 2@ ;
|
||||
|
||||
\ 2DUP EXISTS
|
||||
\ 2SWAP EXISTS
|
||||
\ 2DROP EXISTS
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
BIN
6502/py65/4th.prg
Normal file
BIN
6502/py65/4th.prg
Normal file
Binary file not shown.
1
6502/py65/6502f83.fb
Normal file
1
6502/py65/6502f83.fb
Normal file
File diff suppressed because one or more lines are too long
2508
6502/py65/6502f83.fth
Normal file
2508
6502/py65/6502f83.fth
Normal file
File diff suppressed because it is too large
Load Diff
10
6502/py65/COPYING
Normal file
10
6502/py65/COPYING
Normal file
|
@ -0,0 +1,10 @@
|
|||
Copyright (c) 1985-2005, Forthgesellschaft e.V. (www.forth-ev.de)
|
||||
All rights reserved.
|
||||
|
||||
Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
|
||||
|
||||
* Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
|
||||
* Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
|
||||
* Neither the name of the Forthgesellschaft e.V. nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
11
6502/py65/Makefile
Normal file
11
6502/py65/Makefile
Normal file
|
@ -0,0 +1,11 @@
|
|||
|
||||
blk_files = $(wildcard *.fb)
|
||||
fth_files = $(patsubst %.fb, %.fth, $(blk_files))
|
||||
|
||||
# Target to convert all .fb blk sources into .fth files.
|
||||
fth: $(fth_files)
|
||||
|
||||
# Generic rule for converting .fb blk sources into .fth files.
|
||||
|
||||
%.fth: %.fb fb2fth.py
|
||||
../../../tools/fb2fth.py $< $@
|
7
6502/py65/README.ORG
Normal file
7
6502/py65/README.ORG
Normal file
|
@ -0,0 +1,7 @@
|
|||
#+Title: VolksForth (Version for py65) Readme
|
||||
#+Version: Version 1.0
|
||||
#+Date: <2020-07-15 Wed>
|
||||
#+Author: carsten Strotmann
|
||||
|
||||
This is a version of the 6502 VolksForth to run in Mike Naberezny Py65
|
||||
(https://github.com/mnaberez/py65).
|
1
6502/py65/as65.fb
Normal file
1
6502/py65/as65.fb
Normal file
File diff suppressed because one or more lines are too long
228
6502/py65/as65.fth
Normal file
228
6502/py65/as65.fth
Normal file
|
@ -0,0 +1,228 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ FORTH-6502 ASSEMBLER WFR ) cas 26jan06
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
|
||||
Load from Screen 1 for the transient assembler:
|
||||
This 6502 Forth Assembler can be loaded into the heap
|
||||
and then not be saved in the final binary to save memory.
|
||||
|
||||
Load from Screen 2 for the regular assembler:
|
||||
This 6502 Forth Assembler will be loaded into normal
|
||||
memory and will be saved into the final binary.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ TRANSIENT FORTH-6502 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
|
||||
( INTERNAL LOADING 04MAY85BP/RE)
|
||||
hex
|
||||
\ HERE $200 HALLOT HEAP DP !
|
||||
&10 LOAD
|
||||
&11 LOAD
|
||||
3 &8 THRU
|
||||
&9 LOAD \ for System-Assembler
|
||||
|
||||
\ DP !
|
||||
|
||||
ONLYFORTH
|
||||
decimal
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
ONLYFORTH
|
||||
Vocabulary tassembler
|
||||
TASSEMBLER ALSO DEFINITIONS
|
||||
hex
|
||||
|
||||
8 +load \ relocate
|
||||
1 6 +THRU
|
||||
\ 7 +load \ System Assembler
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ FORTH-83 6502-ASSEMBLER ) er14dez88
|
||||
: END-CODE CONTEXT 2- @ CONTEXT ! ;
|
||||
CREATE INDEX
|
||||
09 c, 09 c, 05 c, 15 c, 15 c, 01 c, 11 c, 80 c,
|
||||
09 c, 80 c, 0D c, 1D c, 19 c, 80 c, 80 c, 80 c,
|
||||
80 c, 00 c, 04 c, 14 c, 14 c, 80 c, 80 c, 80 c,
|
||||
80 c, 80 c, 0C c, 1C c, 1C c, 80 c, 80 c, 2C c,
|
||||
|
||||
| VARIABLE MODE
|
||||
|
||||
: MODE: ( N -) CREATE C, DOES> ( -) C@ MODE ! ;
|
||||
|
||||
0 MODE: .A 1 MODE: # 2 | MODE: MEM 3 MODE: ,X
|
||||
4 MODE: ,Y 5 MODE: X) 6 MODE: )Y 0F MODE: )
|
||||
6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
6 MODE: )Y 0F MODE: ) 6 MODE: )Y 0F MODE: )
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ UPMODE CPU ) er14dez88
|
||||
| : UPMODE ( ADDR0 F0 - ADDR1 F1)
|
||||
IF MODE @ 8 OR MODE ! THEN 1 MODE @ 0F AND ?DUP IF
|
||||
0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
|
||||
|
||||
: CPU ( 8B -) CREATE C, DOES> ( -) C@ >c, MEM ;
|
||||
|
||||
00 CPU BRK 18 CPU CLC D8 CPU CLD
|
||||
58 CPU CLI B8 CPU CLV CA CPU DEX
|
||||
88 CPU DEY E8 CPU INX C8 CPU INY
|
||||
EA CPU NOP 48 CPU PHA 08 CPU PHP
|
||||
68 CPU PLA 28 CPU PLP 40 CPU RTI
|
||||
60 CPU RTS 38 CPU SEC F8 CPU SED
|
||||
78 CPU SEI AA CPU TAX A8 CPU TAY
|
||||
BA CPU TSX 8A CPU TXA 9A CPU TXS
|
||||
98 CPU TYA
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ M/CPU ) er14dez88
|
||||
|
||||
: M/CPU ( MODE OPCODE -) CREATE C, , DOES>
|
||||
DUP 1+ @ 80 AND IF 10 MODE +! THEN OVER FF00 AND UPMODE UPMODE
|
||||
IF MEM TRUE ABORT" INVALID" THEN
|
||||
C@ MODE @ INDEX + C@ + >c, MODE @ 7 AND
|
||||
IF MODE @ 0F AND 7 < IF >c, ELSE >, THEN THEN MEM ;
|
||||
|
||||
1C6E 60 M/CPU ADC 1C6E 20 M/CPU AND 1C6E C0 M/CPU CMP
|
||||
1C6E 40 M/CPU EOR 1C6E A0 M/CPU LDA 1C6E 00 M/CPU ORA
|
||||
1C6E E0 M/CPU SBC 1C6C 80 M/CPU STA 0D0D 01 M/CPU ASL
|
||||
0C0C C1 M/CPU DEC 0C0C E1 M/CPU INC 0D0D 41 M/CPU LSR
|
||||
0D0D 21 M/CPU ROL 0D0D 61 M/CPU ROR 0414 81 M/CPU STX
|
||||
0486 E0 M/CPU CPX 0486 C0 M/CPU CPY 1496 A2 M/CPU LDX
|
||||
0C8E A0 M/CPU LDY 048C 80 M/CPU STY 0480 14 M/CPU JSR
|
||||
8480 40 M/CPU JMP 0484 20 M/CPU BIT
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
|
||||
| : RANGE? ( BRANCH -- BRANCH )
|
||||
DUP ABS 07F U> ABORT" OUT OF RANGE " ;
|
||||
|
||||
: [[ ( BEGIN) >here ;
|
||||
: ?] ( UNTIL) >c, >here 1+ - RANGE? >c, ;
|
||||
: ?[ ( IF) >c, >here 0 >c, ;
|
||||
: ?[[ ( WHILE) ?[ SWAP ;
|
||||
: ]? ( THEN) >here OVER >c@ IF SWAP >!
|
||||
ELSE OVER 1+ - RANGE? SWAP >c! THEN ;
|
||||
: ][ ( ELSE) >here 1+ 1 JMP
|
||||
SWAP >here OVER 1+ - RANGE? SWAP >c! ;
|
||||
: ]] ( AGAIN) JMP ;
|
||||
: ]]? ( REPEAT) JMP ]? ;
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ ASSEMBLER CONDITIONALS ) er14dez88
|
||||
|
||||
90 CONSTANT CS B0 CONSTANT CC
|
||||
D0 CONSTANT 0= F0 CONSTANT 0<>
|
||||
10 CONSTANT 0< 30 CONSTANT 0>=
|
||||
50 CONSTANT VS 70 CONSTANT VC
|
||||
|
||||
: NOT 20 [ FORTH ] XOR ;
|
||||
|
||||
: BEQ 0<> ?] ; : BMI 0>= ?] ;
|
||||
: BNE 0= ?] ; : BPL 0< ?] ;
|
||||
: BCC CS ?] ; : BVC VS ?] ;
|
||||
: BCS CC ?] ; : BVS VC ?] ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ 2INC/2DEC WINC/WDEC KS 19 MAY 84 ) er14dez88
|
||||
|
||||
: 2INC
|
||||
DUP LDA CLC 2 # ADC DUP STA CS ?[ SWAP 1+ INC ]? ;
|
||||
|
||||
: 2DEC
|
||||
DUP LDA SEC 2 # SBC DUP STA CC ?[ SWAP 1+ DEC ]? ;
|
||||
|
||||
: WINC DUP INC 0= ?[ SWAP 1+ INC ]? ;
|
||||
|
||||
: WDEC DUP LDA 0= ?[ OVER 1+ DEC ]? DEC ;
|
||||
|
||||
: ;C: RECOVER JSR END-CODE ] 0 LAST ! 0 ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ ;CODE CODE CODE> BP 03 02 85) er14dez88
|
||||
ONLYFORTH
|
||||
|
||||
: ASSEMBLER ASSEMBLER [ ASSEMBLER ] MEM ;
|
||||
|
||||
: ;CODE [COMPILE] DOES> -3 >allot
|
||||
[COMPILE] ; -2 >allot ASSEMBLER ; IMMEDIATE
|
||||
|
||||
: CODE CREATE >here DUP 2- >! ASSEMBLER ;
|
||||
|
||||
: >LABEL ( ADR -)
|
||||
>here | CREATE SWAP , 4 HALLOT
|
||||
HEAP 1 AND HALLOT ( 6502-ALIGN) HERE 4 - HEAP 4 CMOVE
|
||||
HEAP LAST @ COUNT 01F AND + ! DP ! DOES> ( - ADR) @ ;
|
||||
|
||||
: LABEL [ ASSEMBLER ] >here >LABEL ASSEMBLER ;
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ Code generating primitives er14dez88
|
||||
|
||||
Variable >codes
|
||||
| Create nrc ] c, , c@ here allot ! c! [
|
||||
|
||||
: nonrelocate nrc >codes ! ; nonrelocate
|
||||
|
||||
| : >exec Create c,
|
||||
Does> c@ >codes @ + @ execute ;
|
||||
|
||||
| 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
| 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
| $0C >exec >c!
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 11, Hexblock b
|
||||
|
||||
\ FORTH-65 ASSEMBLER WFR ) er14dez88
|
||||
( BASIS: FORTH DIMENSIONS VOL III NO. 5)
|
||||
ONLYFORTH
|
||||
|
||||
ASSEMBLER ALSO DEFINITIONS
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
1
6502/py65/assemble.fb
Normal file
1
6502/py65/assemble.fb
Normal file
File diff suppressed because one or more lines are too long
361
6502/py65/assemble.fth
Normal file
361
6502/py65/assemble.fth
Normal file
|
@ -0,0 +1,361 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\\ *** Assembler *** 25may86we
|
||||
|
||||
Dieses File enthält den 68000-Assembler für volksFORTH-83.
|
||||
Der Assembler basiert auf dem von Michael Perry für F83 entwik-
|
||||
kelten, enthält aber einige zusätzliche Features.
|
||||
Wegen der Heap-Struktur im volksFORTH sind z.B. echte Labels
|
||||
verwendbar. Aus Geschwindigkeitsgründen enthält der Assembler
|
||||
kaum Fehlerüberprüfung, es empfiehlt sich daher, nach getaner
|
||||
Tat die Code-Worte mit einem Disassembler zu überprüfen.
|
||||
|
||||
Screen $11 enthält einen Loadscreen, mit dem man der kompletten
|
||||
Assembler auf den Heap laden kann, damit er während der Kompila-
|
||||
tionszeit zur Verfügung steht, aber keinen Platz im Dictionary
|
||||
verbraucht. Mit CLEAR oder SAVE wird der Assembler entfernt,
|
||||
wenn er nicht mehr benötigt wird.
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ 68000 Assembler Load Screen 26oct86we
|
||||
|
||||
Onlyforth
|
||||
Vocabulary Assembler Assembler also definitions
|
||||
|
||||
: end-code context 2- @ context ! ;
|
||||
' swap | Alias *swap
|
||||
|
||||
base @ 4 $11 +thru base !
|
||||
|
||||
: reg) size push .l 0 *swap FP DI) ;
|
||||
: Next .w IP )+ D7 move D7 reg) D6 move D6 reg) jmp
|
||||
>here next-link @ , next-link ! ;
|
||||
|
||||
2 3 +thru Onlyforth
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ Internal Assembler 09sep86we
|
||||
|
||||
Onlyforth
|
||||
|
||||
here
|
||||
$1300 hallot heap dp ! -1 +load
|
||||
dp !
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ Extended adressing modes 09sep86we
|
||||
|
||||
: R#) ( addr -- ) size push
|
||||
[ Forth ] dup 0< IF [ Assembler ] .w # D6 move D6 reg)
|
||||
[ Forth ] exit THEN .w FP D) ;
|
||||
|
||||
|
||||
| : inrange? ( addr -- offset f ) [ Forth ]
|
||||
>here 2+ - >here 0< IF dup $FFFE >here - < exit THEN
|
||||
dup >here negate > ;
|
||||
: pcrel) ( addr -- ) \ pc-relativ adressing mode
|
||||
inrange? [ Forth ] 0= abort" out of range" pcd) ;
|
||||
|
||||
: ;c: 0 recover R#) jsr end-code ] ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ Assembler Forth words 09sep86we
|
||||
Forth definitions
|
||||
: Assembler Assembler [ Assembler ] .w ;
|
||||
: Code Create here dup 2- ! Assembler ;
|
||||
|
||||
| : (;code r> last @ name> ! ;
|
||||
: ;Code 0 ?pairs compile (;code [compile] [ reveal
|
||||
Assembler ; immediate restrict
|
||||
|
||||
: >label ( addr -- ) here | Create swap , immediate
|
||||
4 hallot >here 4- heap 4 cmove
|
||||
heap last @ count $1F and + even ! dp !
|
||||
Does> ( -- addr ) @
|
||||
state @ IF [compile] Literal THEN ;
|
||||
: Label [ Assembler ] >here [ Forth ] 1 and
|
||||
[ Assembler ] >allot >here >label Assembler ;
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ Code generating primitives 26oct86we
|
||||
|
||||
Variable >codes
|
||||
| Create nrc ] c, , c@ here allot ! c! [
|
||||
|
||||
: nonrelocate nrc >codes ! ; nonrelocate
|
||||
|
||||
| : >exec Create c,
|
||||
Does> c@ >codes @ + @ execute ;
|
||||
|
||||
| 0 >exec >c, | 2 >exec >, | 4 >exec >c@
|
||||
| 6 >exec >here | 8 >exec >allot | $0A >exec >!
|
||||
| $0C >exec >c!
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ 68000 Meta Assembler 04sep86we
|
||||
|
||||
| : ?, IF >, THEN >, ;
|
||||
| : 2, >, >, ;
|
||||
8 base !
|
||||
Variable size
|
||||
: .b 10000 size ! ;
|
||||
: .w 30100 size ! ; .w
|
||||
: .l 24600 size ! ;
|
||||
|
||||
| : Sz Constant Does> @ size @ and or ;
|
||||
00300 | Sz sz3 00400 | Sz sz4
|
||||
04000 | Sz sz40 30000 | Sz sz300
|
||||
|
||||
| : long? size @ 24600 = ;
|
||||
| : -sz1 long? IF 100 or THEN ;
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ addressing modes 09sep86we
|
||||
|
||||
| : Regs 10 0 DO dup 1001 I * or Constant LOOP drop ;
|
||||
| : Mode Constant Does> @ *swap 7007 and or ;
|
||||
0000 Regs D0 D1 D2 D3 D4 D5 D6 D7
|
||||
0110 Regs A0 A1 A2 A3 A4 A5 A6 A7
|
||||
0220 Mode ) \ address register indirect
|
||||
0330 Mode )+ \ adr reg ind post-increment
|
||||
0440 Mode -) \ adr reg ind pre-decrement
|
||||
0550 Mode D) \ adr reg ind displaced
|
||||
0660 Mode (DI) \ adr reg ind displaced indexed s.u.
|
||||
0770 Constant #) \ immediate address
|
||||
1771 Constant L#) \ immediate long address
|
||||
2772 Constant pcD) \ pc relative displaced
|
||||
3773 Constant (pcDI) \ pc relative displaced indexed
|
||||
4774 Constant # \ immediate data
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ fields and register assignments 08sep86we
|
||||
|
||||
| : Field Constant Does> @ and ;
|
||||
7000 | Field rd 0007 | Field rs
|
||||
0070 | Field ms 0077 | Field eas
|
||||
0377 | Field low
|
||||
| : dn? ( ea -- ea flag ) dup ms 0= ;
|
||||
| : src ( ea instr -- ea instr' ) over eas or ;
|
||||
| : dst ( ea instr -- ea instr' ) *swap rd or ;
|
||||
|
||||
| : ??dn ( mod -- mod ) dn? 0= abort" needs Data-Register" ;
|
||||
| : ??an ( mod -- mod ) dup ms 1 =
|
||||
abort" needs Adress-Register" ;
|
||||
|
||||
A6 Constant SP A5 Constant RP A4 Constant IP
|
||||
A3 Constant FP
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ extended addressing 09sep86we
|
||||
: DI) (DI) size @ *swap ;
|
||||
: pcDI) (pcDI) size @ *swap ;
|
||||
|
||||
| : double? ( mode -- flag) dup L#) = *swap
|
||||
# = long? and or ;
|
||||
| : index? ( {n} mode -- {m} mode )
|
||||
dup >r dup 0770 and A0 (DI) = *swap (pcDI) = or
|
||||
IF size @ >r size !
|
||||
dup rd 10 * *swap ms IF 100000 or THEN
|
||||
sz40 *swap low or r> size !
|
||||
THEN r> ;
|
||||
|
||||
| : more? ( ea -- ea flag ) dup ms 0040 > ;
|
||||
| : ,more ( ea -- ) more?
|
||||
IF index? double? ?, ELSE drop THEN ;
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ extended addressing extras 09sep86we
|
||||
|
||||
| Create extra here 5 dup allot erase \ temporary storage area
|
||||
|
||||
| : extra? ( {n} mode -- mode ) more?
|
||||
IF >r r@ index? double? extra 1+ *swap
|
||||
IF under ! 2+ ! 2 ELSE ! 1 THEN extra c! r>
|
||||
ELSE 0 extra !
|
||||
THEN ;
|
||||
|
||||
| : ,extra ( -- ) extra c@ ?dup
|
||||
IF extra 1+ *swap 1 =
|
||||
IF @ >, ELSE dup 2+ @ *swap @ 2, THEN extra 5 erase
|
||||
THEN ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 11, Hexblock b
|
||||
|
||||
\ immediates & address register specific 15jan86we
|
||||
| : Imm Constant Does> @ >r extra? eas r> or
|
||||
sz3 >, long? ?, ,extra ; ( n ea)
|
||||
0000 Imm ori 1000 Imm andi
|
||||
2000 Imm subi 3000 Imm addi
|
||||
5000 Imm eori 6000 Imm cmpi
|
||||
| : Immsr Constant Does> @ sz3 2, ; ( n )
|
||||
001074 Immsr andi>sr
|
||||
005074 Immsr eori>sr
|
||||
000074 Immsr ori>sr
|
||||
| : Iq Constant Does> @ >r extra? eas *swap rs 1000 * or
|
||||
r> or sz3 >, ,extra ; ( n ea )
|
||||
050000 Iq addq 050400 Iq subq
|
||||
| : Ieaa Constant Does> @ dst src sz4 >, ,more ; ( ea an )
|
||||
150300 Ieaa adda 130300 Ieaa cmpa
|
||||
040700 Ieaa lea 110300 Ieaa suba
|
||||
|
||||
\ *** Block No. 12, Hexblock c
|
||||
|
||||
\ shifts, rotates, and bit manipulation 15jan86we
|
||||
| : Isr Constant Does> @ >r dn?
|
||||
IF *swap dn? IF r> 40 or >r ELSE drop *swap 1000 * THEN
|
||||
rd *swap rs or r> or 160000 or sz3 >,
|
||||
ELSE dup eas 300 or r@ 400 and or r> 70 and 100 * or
|
||||
160000 or >, ,more
|
||||
THEN ; ( dm dn ) ( m # dn ) ( ea )
|
||||
400 Isr asl 000 Isr asr
|
||||
410 Isr lsl 010 Isr lsr
|
||||
420 Isr roxl 020 Isr roxr
|
||||
430 Isr rol 030 Isr ror
|
||||
| : Ibit Constant does> @ >r extra? dn?
|
||||
IF rd src 400 ELSE drop dup eas 4000 THEN
|
||||
or r> or >, ,extra ,more ; ( ea dn ) ( ea n # )
|
||||
000 Ibit btst 100 Ibit bchg
|
||||
200 Ibit bclr 300 Ibit bset
|
||||
|
||||
\ *** Block No. 13, Hexblock d
|
||||
|
||||
\ branch, loop, and set conditionals 15jan86we
|
||||
|
||||
| : Setclass ' *swap 0 DO I over execute LOOP drop ;
|
||||
| : Ibra 400 * 060000 or Constant ( label )
|
||||
Does> @ *swap >here 2+ - dup abs 200 <
|
||||
IF low or >, ELSE *swap 2, THEN ;
|
||||
20 Setclass Ibra bra bsr bhi bls bcc bcs bne beq
|
||||
bvc bvs bpl bmi bge blt bgt ble
|
||||
| : Idbr 400 * 050310 or Constant ( label \ dn - )
|
||||
Does> @ *swap rs or >, >here - >, ;
|
||||
20 Setclass Idbr dxit dbra dbhi dbls dbcc dbcs dbne dbeq
|
||||
dbvc dbvs dbpl dbmi dbge dblt dbgt dble
|
||||
| : Iset 400 * 050300 or Constant ( ea )
|
||||
Does> @ src >, ,more ;
|
||||
20 Setclass Iset set sno shi sls scc scs sne seq
|
||||
svc svs spl smi sge slt sgt sle
|
||||
|
||||
\ *** Block No. 14, Hexblock e
|
||||
|
||||
\ moves 15jan86we
|
||||
|
||||
: move extra? 7700 and src sz300 >,
|
||||
,more ,extra ; ( ea ea )
|
||||
: moveq ??dn rd *swap low or 070000 or >, ; ( n dn )
|
||||
: move>usp ??an rs 047140 or >, ; ( an )
|
||||
: move<usp ??an rs 047150 or >, ; ( an )
|
||||
: movem>
|
||||
extra? eas 044200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
: movem<
|
||||
extra? eas 046200 or -sz1 >, >, ,extra ; ( n ea )
|
||||
: movep dn? IF rd *swap rs or 410 or
|
||||
ELSE rs rot rd or 610 or THEN -sz1 2, ;
|
||||
( dm d an ) ( d an dm )
|
||||
: lmove 7700 and *swap eas or 20000 or >, ;
|
||||
( long reg move )
|
||||
|
||||
\ *** Block No. 15, Hexblock f
|
||||
|
||||
\ odds and ends 15jan86we
|
||||
|
||||
: cmpm rd *swap rs or 130410 or sz3 >, ; ( an@+ am@+ )
|
||||
: exg dn? IF *swap dn? IF 140500 ELSE 140610 THEN >r
|
||||
ELSE *swap dn? IF 140610 ELSE 140510 THEN >r *swap
|
||||
THEN rs dst r> or >, ; ( rn rm )
|
||||
: ext ??dn rs 044200 or -sz1 >, ; ( dn )
|
||||
: swap ??dn rs 044100 or >, ; ( dn )
|
||||
: stop 47162 2, ; ( n )
|
||||
: trap 17 and 47100 or >, ; ( n )
|
||||
: link ??an rs 047120 or 2, ; ( n an )
|
||||
: unlk ??an rs 047130 or >, ; ( an )
|
||||
: eor extra? eas dst sz3 130400 or >, ,extra ; ( dn ea )
|
||||
: cmp ??dn 130000 dst src sz3 >, ,more ; ( ea dn )
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 16, Hexblock 10
|
||||
|
||||
\ arithmetic and logic 15jan86we
|
||||
| : Ibcd Constant Does> @ dst over rs or *swap ms
|
||||
IF 10 or THEN >, ; ( dn dm ) ( an@- am@- )
|
||||
140400 Ibcd abcd 100400 Ibcd sbcd
|
||||
| : Idd Constant Does> @ dst over rs or *swap ms
|
||||
IF 10 or THEN sz3 >, ; ( dn dm ) ( an@- am@- )
|
||||
150400 Idd addx 110400 Idd subx
|
||||
| : Idea Constant Does> @ >r dn? ( ea dn ) ( dn ea )
|
||||
IF rd src r> or sz3 >, ,more
|
||||
ELSE extra? eas dst 400 or r> or sz3 >, ,extra THEN ;
|
||||
150000 Idea add 110000 Idea sub
|
||||
140000 Idea and 100000 Idea or
|
||||
| : Iead Constant Does> @ >r ??dn r> dst src
|
||||
>, ,more ; ( ea dn)
|
||||
040600 Iead chk 100300 Iead divu 100700 Iead divs
|
||||
140300 Iead mulu 140700 Iead muls
|
||||
|
||||
\ *** Block No. 17, Hexblock 11
|
||||
|
||||
\ arithmetic and control 15jan86we
|
||||
|
||||
| : Iea Constant Does> @ src >, ,more ; ( ea )
|
||||
047200 Iea jsr 047300 Iea jmp
|
||||
042300 Iea move>ccr
|
||||
040300 Iea move<sr 043300 Iea move>sr
|
||||
044000 Iea nbcd 044100 Iea pea
|
||||
045300 Iea tas
|
||||
| : Ieas Constant Does> @ src sz3 >, ,more ; ( ea )
|
||||
041000 Ieas clr 043000 Ieas not
|
||||
042000 Ieas neg 040000 Ieas negx
|
||||
045000 Ieas tst
|
||||
| : Icon Constant Does> @ >, ;
|
||||
47160 Icon reset 47161 Icon nop
|
||||
47163 Icon rte 47165 Icon rts
|
||||
47166 Icon trapv 47167 Icon rtr
|
||||
|
||||
\ *** Block No. 18, Hexblock 12
|
||||
|
||||
\ structured conditionals +/- 256 bytes 15jan86we
|
||||
: THEN >here over 2+ - *swap 1+ >c! ;
|
||||
: IF >, >here 2- ; hex
|
||||
: ELSE 6000 IF *swap THEN ;
|
||||
: BEGIN >here ;
|
||||
: UNTIL >, >here - >here 1- >c! ;
|
||||
: AGAIN 6000 UNTIL ;
|
||||
: WHILE IF *swap ;
|
||||
: REPEAT AGAIN THEN ;
|
||||
: DO >here *swap ;
|
||||
: LOOP dbra ;
|
||||
6600 Constant 0= 6700 Constant 0<>
|
||||
6A00 Constant 0< 6B00 Constant 0>=
|
||||
6C00 Constant < 6D00 Constant >=
|
||||
6E00 Constant <= 6F00 Constant >
|
||||
6500 Constant CC 6400 Constant CS
|
1
6502/py65/ccompile.fb
Normal file
1
6502/py65/ccompile.fb
Normal file
|
@ -0,0 +1 @@
|
|||
\ Crosscompile Script for 6502 Target cas 26jan06 \ loadscreen for cross-compiler cas 26jan06 include assemble.fb \ load 68000 assembler 2 loadfrom as65.fb page \ load 6502 assembler include crostarg.fb page \ load target compiler include 6502f83.fb \ load Forth Kernel Source save-target f6502.com \ save new forth as f6502.comkey drop page .( Ready ) cr \ wait for keypress bye \ and exit forth
|
38
6502/py65/ccompile.fth
Normal file
38
6502/py65/ccompile.fth
Normal file
|
@ -0,0 +1,38 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ Crosscompile Script for 6502 Target cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ loadscreen for cross-compiler cas 26jan06
|
||||
|
||||
include assemble.fb \ load 68000 assembler
|
||||
2 loadfrom as65.fb page \ load 6502 assembler
|
||||
include crostarg.fb page \ load target compiler
|
||||
include 6502f83.fb \ load Forth Kernel Source
|
||||
|
||||
save-target f6502.com \ save new forth as f6502.com
|
||||
key drop page .( Ready ) cr \ wait for keypress
|
||||
bye \ and exit forth
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
1
6502/py65/crostarg.fb
Normal file
1
6502/py65/crostarg.fb
Normal file
File diff suppressed because one or more lines are too long
760
6502/py65/crostarg.fth
Normal file
760
6502/py65/crostarg.fth
Normal file
|
@ -0,0 +1,760 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\\ *** volksFORTH-84 Target-Compiler *** cas 26jan06
|
||||
|
||||
This Target Compiler can be used to create a new Forth System
|
||||
using the Sourcecode 6502F82.FB.
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ Target compiler loadscr 09sep86we
|
||||
\ Idea and first Implementation by ks/bp
|
||||
\ Implemented on 6502 by ks/bp
|
||||
\ ultraFORTH83-Version by bp/we
|
||||
\ Atari 520 ST - Version by we
|
||||
Onlyforth Assembler nonrelocate
|
||||
07 Constant imagepage \ Virtual memory bank
|
||||
Vocabulary Ttools
|
||||
Vocabulary Defining
|
||||
: .stat .blk .s ; ' .stat Is .status
|
||||
\ : 65( [compile] ( ; immediate
|
||||
: 65( ; immediate : ) ; immediate \ cpu-addressing|lbyte|hbyte|
|
||||
1 $14 +thru \ Target compiler
|
||||
$15 $17 +thru \ Target Tools
|
||||
$18 $1A +thru \ Redefinitions
|
||||
save $1B $24 +thru \ Predefinitions
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ Target header pointers bp05mar86we
|
||||
|
||||
Variable tdp : there tdp @ ;
|
||||
Variable displace
|
||||
Variable ?thead 0 ?thead !
|
||||
Variable tlast 0 tlast !
|
||||
Variable glast' 0 glast' !
|
||||
Variable tdoes>
|
||||
Variable >in:
|
||||
Variable tvoc 0 tvoc !
|
||||
Variable tvoc-link 0 tvoc-link !
|
||||
Variable tnext-link 0 tnext-link !
|
||||
|
||||
: c+! ( 8b addr -- ) dup c@ rot + swap c! ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ Image and byteorder 15sep86we
|
||||
|
||||
: >image ( addr1 - addr2 ) displace @ - ;
|
||||
|
||||
: >heap ( from quan - )
|
||||
heap over - 1 and + \ 68000-align
|
||||
dup hallot heap swap cmove ;
|
||||
\\
|
||||
: >ascii 2drop ; ' noop Alias C64>ascii
|
||||
|
||||
Code Lc@ ( laddr -- 8b )
|
||||
.l SP )+ A0 move .w D0 clr .b A0 ) D0 move
|
||||
.w D0 SP -) move Next end-code
|
||||
Code Lc! ( 8b addr -- )
|
||||
.l SP )+ A0 move .w SP )+ D0 move .b D0 A0 ) move
|
||||
Next end-code
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ Ghost-creating 05mar86we
|
||||
|
||||
0 | Constant <forw> 0 | Constant <res>
|
||||
|
||||
| : Make.ghost ( - cfa.ghost )
|
||||
here dup 1 and allot here
|
||||
state @ IF context @ ELSE current THEN @
|
||||
dup @ , name
|
||||
dup c@ 1 $1F uwithin not abort" inval.Gname"
|
||||
dup c@ 1+ over c!
|
||||
c@ dup 1+ allot 1 and 0= IF bl c, THEN
|
||||
here 2 pick - -rot
|
||||
<forw> , 0 , 0 ,
|
||||
swap here over - >heap
|
||||
heap swap ! swap dp !
|
||||
heap + ;
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ ghost words 05mar86we
|
||||
|
||||
: gfind ( string - cfa tf / string ff )
|
||||
dup count + 1+ bl swap c!
|
||||
dup >r 1 over c+! find -1 r> c+! ;
|
||||
|
||||
: ghost ( - cfa )
|
||||
>in @ name gfind IF nip exit THEN
|
||||
drop >in ! Make.ghost ;
|
||||
|
||||
: Word, ghost execute ;
|
||||
|
||||
: gdoes> ( cfa.ghost - cfa.does )
|
||||
4+ dup @ IF @ exit THEN
|
||||
here dup <forw> , 0 , 4 >heap
|
||||
dp ! heap dup rot ! ;
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ ghost utilities 04dec85we
|
||||
|
||||
: g' name gfind 0= abort" ?" ;
|
||||
|
||||
: '.
|
||||
g' dup @ <forw> case?
|
||||
IF ." forw" ELSE <res> - abort" ??" ." res" THEN
|
||||
2+ dup @ 5 u.r
|
||||
2+ @ ?dup
|
||||
IF dup @ <forw> case?
|
||||
IF ." fdef" ELSE <res> - abort" ??" ." rdef" THEN
|
||||
2+ @ 5 u.r THEN ;
|
||||
|
||||
' ' Alias h'
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ .unresolved 05mar86we
|
||||
|
||||
| : forward? ( cfa - cfa / exit&true )
|
||||
dup @ <forw> = over 2+ @ and IF drop true rdrop exit THEN ;
|
||||
|
||||
| : unresolved? ( addr - f )
|
||||
2+ dup c@ $1F and over + c@ BL =
|
||||
IF name> forward? 4+ @ dup IF forward? THEN
|
||||
THEN drop false ;
|
||||
|
||||
| : unresolved-words
|
||||
BEGIN @ ?dup WHILE dup unresolved?
|
||||
IF dup 2+ .name ?cr THEN REPEAT ;
|
||||
|
||||
: .unresolved voc-link @
|
||||
BEGIN dup 4- unresolved-words @ ?dup 0= UNTIL ;
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ Extending Vocabularys for Target-Compilation 05mar86we
|
||||
|
||||
: Vocabulary Vocabulary 0 , here tvoc @ , tvoc ! ;
|
||||
|
||||
Vocabulary Transient 0 tvoc !
|
||||
|
||||
Only definitions Forth also
|
||||
|
||||
: T Transient ; immediate
|
||||
: H Forth ; immediate
|
||||
|
||||
definitions
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ Transient primitives 05mar86we
|
||||
|
||||
Code byte> ( 8bh 8bl -- 16b )
|
||||
SP )+ D1 move SP ) D0 move 8 # D0 lsl .b D1 D0 move
|
||||
.w D0 SP ) move Next end-code
|
||||
Code >byte ( 16b -- 8bl 8bh )
|
||||
SP )+ D0 move D0 D1 move $FF D0 andi 8 # D1 lsr
|
||||
D0 SP -) move D1 SP -) move Next end-code
|
||||
|
||||
Transient definitions
|
||||
: c@ H >image imagepage lc@ ;
|
||||
: c! H >image imagepage lc! ;
|
||||
: @ dup T c@ swap 1+ T c@ 65( swap ) byte> ;
|
||||
: ! >r >byte 65( swap ) r@ T c! r> 1+ T c! ;
|
||||
: cmove ( from.mem to.target quan -)
|
||||
bounds ?DO dup H c@ I T c! H 1+ LOOP drop ;
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ Transient primitives bp05mar86we
|
||||
|
||||
: here there ;
|
||||
: allot Tdp +! ;
|
||||
: c, T here c! 1 allot H ;
|
||||
: , T here ! 2 allot H ;
|
||||
|
||||
: ," Ascii " parse dup T c,
|
||||
under there swap cmove
|
||||
.( dup 1 and 0= IF 1+ THEN ) allot H ;
|
||||
|
||||
: fill ( addr quan 8b -)
|
||||
-rot bounds ?DO dup I T c! H LOOP drop ;
|
||||
: erase 0 T fill ;
|
||||
: blank bl T fill ;
|
||||
: here! H Tdp ! ;
|
||||
|
||||
\ *** Block No. 11, Hexblock b
|
||||
|
||||
\ Resolving 08dec85we
|
||||
Forth definitions
|
||||
: resolve ( cfa.ghost cfa.target -)
|
||||
over dup @ <res> =
|
||||
IF space dup >name .name ." exists " ?cr 2+ ! drop exit THEN
|
||||
>r >r 2+ @ ?dup
|
||||
IF BEGIN dup T @ H 2dup = abort" resolve loop" r@ rot T !
|
||||
H ?dup 0= UNTIL
|
||||
THEN r> r> <res> over ! 2+ ! ;
|
||||
|
||||
: resdoes> ( cfa.ghost cfa.target -)
|
||||
swap gdoes> dup @ <res> = IF 2+ ! exit THEN swap resolve ;
|
||||
] Does> [ here 4- 0 ] dup @ there rot ! T , H ;
|
||||
' <forw> >body !
|
||||
] Does> [ here 4- 0 ] @ T , H ;
|
||||
' <res> >body !
|
||||
|
||||
\ *** Block No. 12, Hexblock c
|
||||
|
||||
\ move-threads 68000-align cas 26jan06
|
||||
|
||||
: move-threads Tvoc @ Tvoc-link @
|
||||
BEGIN over ?dup
|
||||
WHILE 2- @ over 2- T ! @ H swap @ swap REPEAT
|
||||
error" some undef. Target-Vocs left" drop ;
|
||||
|
||||
| : tlatest ( - addr) current @ 6 + ;
|
||||
|
||||
\\
|
||||
not used for the 6502 architecture
|
||||
|
||||
| : 68000-talign ( cfa -- ) 1 and IF 1 T allot H THEN ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 13, Hexblock d
|
||||
|
||||
\ save-target 09sep86we
|
||||
|
||||
Dos definitions
|
||||
|
||||
Code (filewrite ( buff len handle -- n)
|
||||
SP )+ D0 move .l D2 clr .w SP )+ D2 move
|
||||
.l 0 imagepage # D1 move .w SP )+ D1 move
|
||||
.l D1 A7 -) move \ buffer adress
|
||||
.l D2 A7 -) move \ buffer length
|
||||
.w D0 A7 -) move \ handle
|
||||
$40 # A7 -) move \ call WRITE
|
||||
1 trap $0C # A7 adda
|
||||
.w D0 SP -) move Next end-code Forth definitions
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 14, Hexblock e
|
||||
|
||||
\ save Target-System 09sep86we
|
||||
|
||||
: save-target [ Dos ]
|
||||
bl word count dup 0= abort" missing filename"
|
||||
over + off (createfile dup >r 0< abort" no device "
|
||||
T here $1C - 4 ! 0 , 0 , H [ Dos ] \ Programm header
|
||||
0 there r@ (filewrite there - abort" write error"
|
||||
r> (closefile 0< abort" close error" ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 15, Hexblock f
|
||||
|
||||
\\ 6502-ALIGN ?HEAD \ 08SEP84BP)
|
||||
|
||||
| : 6502-align/1 ( adr -- adr' ) dup 0FF and 0FF = - ;
|
||||
|
||||
|
||||
| : 6502-align/2 ( lfa -- lfa )
|
||||
there 0FF and 0FF =
|
||||
IF dup dup 1+ there over - 1+ cmove> \ lfa now invalid
|
||||
1 tlast +! 1 tallot THEN ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 16, Hexblock 10
|
||||
|
||||
\\ WARNING CREATE 30DEC84BP)
|
||||
|
||||
VARIABLE WARNING 0 WARNING !
|
||||
|
||||
| : EXISTS?
|
||||
WARNING @ ?EXIT
|
||||
LAST @ CURRENT @ (FIND NIP
|
||||
IF SPACE LAST @ .NAME ." EXISTS " ?CR THEN ;
|
||||
|
||||
: CREATE HERE BLK @ , CURRENT @ @ ,
|
||||
NAME C@ DUP 1 020 UWITHIN NOT ABORT" INVALID NAME"
|
||||
HERE LAST ! 1+ ALLOT EXISTS? ?HEAD @
|
||||
IF 1 ?HEAD +! DUP 6502-ALIGN/1 , \ POINTER TO CODE
|
||||
HEAPMOVE 020 FLAG! 6502-ALIGN/1 DP !
|
||||
ELSE 6502-ALIGN/2 DROP THEN REVEAL 0 ,
|
||||
;CODE DOCREATE JMP END-CODE
|
||||
|
||||
\ *** Block No. 17, Hexblock 11
|
||||
|
||||
\ compiling names into targ. 05mar86we
|
||||
|
||||
: (theader
|
||||
?thead @ IF 1 ?thead +!
|
||||
there $FF and $FF = IF 1 T allot H THEN exit THEN
|
||||
>in @ name swap >in !
|
||||
dup c@ 1 $20 uwithin not abort" inval. Tname"
|
||||
dup c@ 3 + there + $FF and $FF =
|
||||
there 2+ $FF and $FF = or IF 1 T allot H THEN
|
||||
blk @ T , H there tlatest dup @ T , H ! there dup tlast !
|
||||
over c@ 1+ .( even ) dup T allot cmove H ;
|
||||
|
||||
: Theader tlast off
|
||||
(theader Ghost dup glast' !
|
||||
there resolve ;
|
||||
|
||||
|
||||
\ *** Block No. 18, Hexblock 12
|
||||
|
||||
\ prebuild defining words bp27jun85we
|
||||
|
||||
| : executable? ( adr - adr f ) dup ;
|
||||
| : tpfa, there , ;
|
||||
| : (prebuild ( cfa.adr -- )
|
||||
>in @ Create >in ! here 2- ! ;
|
||||
|
||||
: prebuild ( adr 0.from.: - 0 )
|
||||
0 ?pairs executable? dup >r
|
||||
IF [compile] Literal compile (prebuild ELSE drop THEN
|
||||
compile Theader Ghost gdoes> ,
|
||||
r> IF compile tpfa, THEN 0 ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 19, Hexblock 13
|
||||
|
||||
\ code portion of def.words bp11sep86we
|
||||
|
||||
: dummy 0 ;
|
||||
|
||||
: DO> ( - adr.of.jmp.dodoes> 0 )
|
||||
[compile] Does> here 4- compile @ 0 ] ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 20, Hexblock 14
|
||||
|
||||
\ the 68000 Assembler 11sep86we
|
||||
|
||||
Forth definitions
|
||||
| Create relocate ] T c, , c@ here allot ! c! H [
|
||||
|
||||
Transient definitions
|
||||
|
||||
: Assembler H [ Tassembler ] relocate >codes ! Tassembler ;
|
||||
: >label ( 16b -) H >in @ name gfind rot >in !
|
||||
IF over resolve dup THEN drop Constant ;
|
||||
: Label T .( here 1 and allot ) here >label Assembler H ;
|
||||
: Code H Theader there 2+ T , Assembler H ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 21, Hexblock 15
|
||||
|
||||
\ immed. restr. ' \ compile bp05mar86we
|
||||
|
||||
: ?pairs ( n1 n2 -- ) H - abort" unstructured" ;
|
||||
: >mark ( - addr ) H there T 0 , H ;
|
||||
: >resolve ( addr - ) H there over - swap T ! H ;
|
||||
: <mark ( - addr ) H there ;
|
||||
: <resolve ( addr - ) H there - T , H ;
|
||||
: immediate H Tlast @ ?dup
|
||||
IF dup T c@ $40 or swap c! H THEN ;
|
||||
: restrict H Tlast @ ?dup
|
||||
IF dup T c@ $80 or swap c! H THEN ;
|
||||
: ' ( <name> - cfa ) H g' dup @ <res> - abort" ?" 2+ @ ;
|
||||
: | H ?thead @ ?exit ?thead on ;
|
||||
: compile H Ghost , ; immediate restrict
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 22, Hexblock 16
|
||||
|
||||
\ Target tools ks05mar86we
|
||||
|
||||
Onlyforth Ttools also definitions
|
||||
|
||||
| : ttype ( adr n -) bounds ?DO I T c@ H dup
|
||||
bl > IF emit ELSE drop Ascii . emit THEN LOOP ;
|
||||
: .name ( nfa -) ?dup IF dup 1+ swap T c@ H $1F and ttype
|
||||
ELSE ." ??? " THEN space ?cr ;
|
||||
| : nfa? ( cfa lfa - nfa / cfa ff)
|
||||
BEGIN dup WHILE 2dup 2+ dup T c@ H $1F and + 1+ .( even ) =
|
||||
IF 2+ nip exit THEN
|
||||
T @ H REPEAT ;
|
||||
: >name ( cfa - nfa / ff)
|
||||
Tvoc BEGIN @ dup WHILE under 2- @ nfa? ?dup
|
||||
IF nip exit THEN
|
||||
swap REPEAT nip ;
|
||||
|
||||
\ *** Block No. 23, Hexblock 17
|
||||
|
||||
\ Ttools for decompiling ks05mar86we
|
||||
|
||||
| : ?: dup 4 u.r ." :" ;
|
||||
| : @? dup T @ H 6 u.r ;
|
||||
| : c? dup T c@ H 3 .r ;
|
||||
|
||||
: s ( addr - addr+ ) ?: space c? 3 spaces
|
||||
dup 1+ over T c@ H ttype dup T c@ H + 1+ ;
|
||||
|
||||
: n ( addr - addr+2 ) ?: @? 2 spaces
|
||||
dup T @ H [ Ttools ] >name .name H 2+ ;
|
||||
|
||||
: d ( addr n - addr+n ) 2dup swap ?: swap 0 DO c? 1+ LOOP
|
||||
2 spaces -rot ttype ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 24, Hexblock 18
|
||||
|
||||
\ Tools for decompiling bp05mar86we
|
||||
|
||||
: l ( addr -- addr+2 ) ?: 5 spaces @? 2+ ;
|
||||
|
||||
: c ( addr -- addr+1 ) 1 d ;
|
||||
|
||||
: b ( addr -- addr+1 ) ?: @? dup T @ H over + 5 u.r 2+ ;
|
||||
|
||||
: dump ( adr n -) bounds ?DO cr I $10 d drop
|
||||
stop? IF LEAVE THEN $10 +LOOP ;
|
||||
|
||||
: view T ' H [ Ttools ] >name ?dup
|
||||
IF 4- T @ H l THEN ;
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 25, Hexblock 19
|
||||
|
||||
\ reinterpretation def.-words 05mar86we
|
||||
|
||||
Onlyforth
|
||||
|
||||
: redefinition
|
||||
tdoes> @ IF >in push [ ' >interpret >body ] Literal push
|
||||
state push context push >in: @ >in !
|
||||
name [ ' Transient 2+ ] Literal (find nip 0=
|
||||
IF cr ." Redefinition: " here .name
|
||||
>in: @ >in ! : Defining interpret THEN
|
||||
THEN 0 tdoes> ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 26, Hexblock 1a
|
||||
|
||||
\ Create..does> structure bp05mar86we
|
||||
|
||||
| : (;tcode
|
||||
Tlast @ dup T c@ .( dup 1 and - ) 1+ + ! H rdrop ;
|
||||
| : changecfa compile lit tdoes> @ , compile (;tcode ;
|
||||
|
||||
Defining definitions
|
||||
|
||||
: ;code 0 ?pairs changecfa reveal rdrop ;
|
||||
immediate restrict
|
||||
|
||||
Defining ' ;code Alias does> immediate restrict
|
||||
|
||||
: ; [compile] ; rdrop ; immediate restrict
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 27, Hexblock 1b
|
||||
|
||||
\ redefinition conditionals bp27jun85we
|
||||
|
||||
' DO Alias DO immediate restrict
|
||||
' ?DO Alias ?DO immediate restrict
|
||||
' LOOP Alias LOOP immediate restrict
|
||||
' IF Alias IF immediate restrict
|
||||
' THEN Alias THEN immediate restrict
|
||||
' ELSE Alias ELSE immediate restrict
|
||||
' BEGIN Alias BEGIN immediate restrict
|
||||
' UNTIL Alias UNTIL immediate restrict
|
||||
' WHILE Alias WHILE immediate restrict
|
||||
' REPEAT Alias REPEAT immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 28, Hexblock 1c
|
||||
|
||||
\ clear Liter. Ascii ['] ." bp05mar86we
|
||||
|
||||
Onlyforth Transient definitions
|
||||
|
||||
: clear true abort" There are ghosts" ;
|
||||
: Literal ( n -) T compile lit , H ; immediate
|
||||
: Ascii H bl word 1+ c@ state @
|
||||
IF T [compile] Literal H THEN ; immediate
|
||||
: ['] T ' [compile] Literal H ; immediate restrict
|
||||
: " T compile (" ," H ; immediate restrict
|
||||
: ." T compile (." ," H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 29, Hexblock 1d
|
||||
|
||||
\ Target compilation ] [ bp05mar86we
|
||||
|
||||
Forth definitions
|
||||
|
||||
: tcompile
|
||||
?stack >in @ name find ?dup
|
||||
IF 0> IF nip execute >interpret THEN
|
||||
drop dup >in ! name
|
||||
THEN gfind IF nip execute >interpret THEN
|
||||
nullstring? IF drop exit THEN
|
||||
number? ?dup IF 0> IF swap T [compile] Literal THEN
|
||||
[compile] Literal H drop >interpret THEN
|
||||
drop >in ! Word, >interpret ;
|
||||
|
||||
Transient definitions
|
||||
: ] H state on ['] tcompile is >interpret ;
|
||||
|
||||
\ *** Block No. 30, Hexblock 1e
|
||||
|
||||
\ Target conditionals bp05mar86we
|
||||
|
||||
: IF T compile ?branch >mark H 1 ; immediate restrict
|
||||
: THEN abs 1 T ?pairs >resolve H ; immediate restrict
|
||||
: ELSE T 1 ?pairs compile branch >mark swap >resolve
|
||||
H -1 ; immediate restrict
|
||||
: BEGIN T <mark H 2 ; immediate restrict
|
||||
: WHILE T 2 ?pairs 2 compile ?branch >mark -2 H 2swap ;
|
||||
immediate restrict
|
||||
| : (repeat T 2 ?pairs <resolve H BEGIN dup -2 =
|
||||
WHILE drop T >resolve H REPEAT ;
|
||||
: UNTIL T compile ?branch (repeat H ; immediate restrict
|
||||
: REPEAT T compile branch (repeat H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 31, Hexblock 1f
|
||||
|
||||
\ Target conditionals bp27jun85we
|
||||
|
||||
: DO T compile (do >mark H 3 ; immediate restrict
|
||||
: ?DO T compile (?do >mark H 3 ; immediate restrict
|
||||
: LOOP T 3 ?pairs compile (loop compile endloop
|
||||
>resolve H ; immediate restrict
|
||||
: +LOOP T 3 ?pairs compile (+loop compile endloop
|
||||
>resolve H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 32, Hexblock 20
|
||||
|
||||
\ predefinitions bp05mar86we
|
||||
|
||||
: abort" T compile (abort" ," H ; immediate
|
||||
: error" T compile (err" ," H ; immediate
|
||||
|
||||
Forth definitions
|
||||
|
||||
Variable torigin
|
||||
Variable tudp 0 Tudp !
|
||||
|
||||
: >user T c@ H torigin @ + ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 33, Hexblock 21
|
||||
|
||||
\ Datatypes bp05mar86we
|
||||
|
||||
Transient definitions
|
||||
: origin! H torigin ! ;
|
||||
: user' ( -- n ) T ' >body c@ H ;
|
||||
: uallot ( n -- ) H tudp @ swap tudp +! ;
|
||||
|
||||
DO> >user ;
|
||||
: User prebuild User 2 T uallot c, ;
|
||||
|
||||
DO> ;
|
||||
: Create prebuild Create ;
|
||||
|
||||
DO> T @ H ;
|
||||
: Constant prebuild Constant T , ;
|
||||
: Variable Create 2 T allot ;
|
||||
|
||||
\ *** Block No. 34, Hexblock 22
|
||||
|
||||
\ Datatypes bp05mar86we
|
||||
|
||||
dummy
|
||||
: Vocabulary
|
||||
H >in @ Vocabulary >in ! T prebuild Vocabulary 0 , 0 ,
|
||||
here H tvoc-link @ T , H tvoc-link ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 35, Hexblock 23
|
||||
|
||||
\ target defining words bp08sep86we
|
||||
|
||||
Do> ;
|
||||
: Defer prebuild Defer 2 T allot ;
|
||||
: Is T ' H >body state @ IF T compile (is , H
|
||||
ELSE T ! H THEN ; immediate
|
||||
| : dodoes> T compile (;code H Glast' @
|
||||
there resdoes> there tdoes> ! ;
|
||||
|
||||
: ;code 0 T ?pairs dodoes> Assembler H [compile] [
|
||||
redefinition ; immediate restrict
|
||||
|
||||
: does> T dodoes> $04C C,
|
||||
compile (dodoes> H ; immediate restrict
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 36, Hexblock 24
|
||||
|
||||
\ : Alias ; bp25mar86we
|
||||
|
||||
: Create: T Create H current @ context ! T ] H 0 ;
|
||||
|
||||
dummy
|
||||
: : H tdoes> off >in @ >in: ! T prebuild :
|
||||
H current @ context ! T ] H 0 ;
|
||||
|
||||
: Alias ( n -- ) H Tlast off (theader Ghost over resolve
|
||||
tlast @ T c@ H $20 or tlast @ T c! , H ;
|
||||
|
||||
: ; T 0 ?pairs compile exit .( unnest gegen exit getauscht)
|
||||
[compile] [ H redefinition ; immediate restrict
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 37, Hexblock 25
|
||||
|
||||
\ predefinitions bp11sep86we
|
||||
|
||||
: compile T compile compile H ; immediate restrict
|
||||
: Host H Onlyforth Ttools also ;
|
||||
: Compiler T Host H Transient also definitions ;
|
||||
: [compile] H Word, ; immediate restrict
|
||||
: Onlypatch H there 3 - 0 tdoes> ! 0 ;
|
||||
|
||||
Onlyforth
|
||||
: Target Onlyforth Transient also definitions ;
|
||||
|
||||
Transient definitions
|
||||
Ghost c, drop
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 38, Hexblock 26
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 39, Hexblock 27
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
BIN
6502/py65/ediicon.rsc
Normal file
BIN
6502/py65/ediicon.rsc
Normal file
Binary file not shown.
1
6502/py65/systemio.fb
Normal file
1
6502/py65/systemio.fb
Normal file
File diff suppressed because one or more lines are too long
209
6502/py65/systemio.fth
Normal file
209
6502/py65/systemio.fth
Normal file
|
@ -0,0 +1,209 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ System depended IO definitions for 6502 target cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ loadscreen fuer generic System IO cas 26jan06
|
||||
|
||||
|
||||
1 9 +thru
|
||||
|
||||
\\ This example IO definitions are based on serial communication
|
||||
|
||||
The definitions needs to be adapted for each system
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ 65KEY? GETKEY 25JAN85RE) er14dez88
|
||||
|
||||
CODE 65KEY? ( -- FLAG) $C0EA jsr push0a jmp end-code
|
||||
|
||||
CODE GETKEY ( -- 8B) $C0A6 jsr push0a jmp end-code
|
||||
|
||||
CODE CURON ( --) NEXT JMP END-CODE
|
||||
|
||||
CODE CUROFF ( --) NEXT JMP END-CODE
|
||||
|
||||
: 65KEY ( -- 8B)
|
||||
CURON BEGIN PAUSE 65KEY? UNTIL CUROFF GETKEY ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ DECODE EXPECT KEYBOARD BP28MAY85)
|
||||
08 CONSTANT #BS 0D CONSTANT #CR &27 CONSTANT #ESC
|
||||
|
||||
: 65DECODE ( 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+ ;
|
||||
|
||||
: 65EXPECT ( ADDR LEN1 -- ) SPAN ! 0
|
||||
BEGIN DUP SPAN @ U<
|
||||
WHILE KEY DECODE
|
||||
REPEAT 2DROP SPACE ;
|
||||
|
||||
INPUT: KEYBOARD [ HERE INPUT ! ]
|
||||
65KEY 65KEY? 65DECODE 65EXPECT [
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ send? (emit 65emit er14dez88 cas 26jan06
|
||||
|
||||
| $8001 Constant aciasr
|
||||
| $8000 Constant aciaio
|
||||
|
||||
| Code send? ( -- flg )
|
||||
aciasr lda pha $08 # and 0= not ?[ $c058 jsr ]?
|
||||
pla $10 # and push0a jmp end-code
|
||||
|
||||
Code (emit ( 8b -- ) SP X) LDA aciaio sta (drop jmp end-code
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ EMIT CR DEL PAGE AT AT? 25JAN85RE) cas 26jan06
|
||||
|
||||
| Variable out 0 out ! | &80 Constant c/row
|
||||
|
||||
: 65emit ( 8b -- ) BEGIN pause send? UNTIL 1 out +! (emit ;
|
||||
|
||||
: 65CR #CR 65emit out @ c/row / 1+ c/row * out ! ;
|
||||
|
||||
: 65DEL #bs 65emit SPACE #bs 65emit -2 out +! ;
|
||||
|
||||
: 65PAGE .( insert code for page ) out off ;
|
||||
|
||||
: 65at ( row col -- )
|
||||
.( insert code for at ) swap c/row * + out ! ;
|
||||
: 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ;
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ 65type cas 26jan06
|
||||
|
||||
: 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ TYPE DISPLAY (BYE BP 28MAY85RE) er14dez88
|
||||
|
||||
OUTPUT: DISPLAY [ HERE OUTPUT ! ]
|
||||
65EMIT 65CR 65TYPE 65DEL 65PAGE 65AT 65AT? [
|
||||
|
||||
|
||||
| : (bye ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ B/BLK DRIVE >DRIVE DRVINIT 28MAY85RE) cas 26jan06
|
||||
|
||||
$400 CONSTANT B/BLK \ Bytes per physical Sector
|
||||
|
||||
$0AA CONSTANT BLK/DRV \ number of Blocks per Drive
|
||||
|
||||
| VARIABLE (DRV 0 (DRV !
|
||||
|
||||
| : DISK ( -- DEV.NO ) (DRV @ 8 + ;
|
||||
|
||||
: DRIVE ( DRV# -- ) BLK/DRV * OFFSET ! ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ cas 26jan06
|
||||
: >DRIVE ( BLOCK DRV# -- BLOCK' )
|
||||
BLK/DRV * + OFFSET @ - ;
|
||||
: DRV? ( BLOCK -- DRV# )
|
||||
OFFSET @ + BLK/DRV / ;
|
||||
|
||||
: DRVINIT NOOP ;
|
||||
.( for read and write errorhandler is needed )
|
||||
| : readserial ( adr blk -- )
|
||||
&27 emit .( rb ) space base push decimal . cr
|
||||
$400 bounds DO key I c! LOOP ;
|
||||
|
||||
| : writeserial ( adr blk -- )
|
||||
&27 emit .( wb ) space base push decimal . cr
|
||||
$400 bounds DO I c@ emit LOOP ;
|
||||
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ (r/w er14dez88
|
||||
|
||||
: (R/W ( ADR BLK FILE R/WF -- FLAG)
|
||||
swap abort" no file"
|
||||
IF readserial ELSE writeserial THEN false ;
|
||||
|
||||
' (R/W IS R/W
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
1
6502/py65/tasker.fb
Normal file
1
6502/py65/tasker.fb
Normal file
File diff suppressed because one or more lines are too long
190
6502/py65/tasker.fth
Normal file
190
6502/py65/tasker.fth
Normal file
|
@ -0,0 +1,190 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ Multitasking Extension to volksFORTH cas 26jan06
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ Tasker Loadscreen
|
||||
|
||||
\NEEDS CODE abort( Assembler needed )
|
||||
hex
|
||||
1 5 +thru \ load Tasker
|
||||
7 load \ Task-Demo
|
||||
decimal
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ MULTITASKER BP 13.9.84 )
|
||||
|
||||
CODE STOP
|
||||
SP 2DEC IP LDA SP X) STA IP 1+ LDA SP )Y STA
|
||||
SP 2DEC RP LDA SP X) STA RP 1+ LDA SP )Y STA
|
||||
6 # LDY SP LDA UP )Y STA INY SP 1+ LDA UP )Y STA
|
||||
1 # LDY TYA CLC UP ADC W STA
|
||||
TXA UP 1+ ADC W 1+ STA W 1- JMP END-CODE
|
||||
|
||||
| CREATE TASKPAUSE ASSEMBLER
|
||||
2C # LDA UP X) STA ' STOP @ JMP END-CODE
|
||||
|
||||
: SINGLETASK [ ' PAUSE @ ] LITERAL ['] PAUSE ! ;
|
||||
|
||||
: MULTITASK TASKPAUSE ['] PAUSE ! ;
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ PASS ACTIVATE KS 8 MAY 84 )
|
||||
|
||||
: PASS ( N0 .. NR-1 TADR R -- )
|
||||
BEGIN [ ROT ( TRICK ! ) ]
|
||||
SWAP 02C OVER C! \ AWAKE TASK
|
||||
R> -ROT \ IP R ADDR
|
||||
8 + >R \ S0 OF TASK
|
||||
R@ 2+ @ SWAP \ IP R0 R
|
||||
2+ 2* \ BYTES ON TASKSTACK
|
||||
\ INCL. R0 & IP
|
||||
R@ @ OVER - \ NEW SP
|
||||
DUP R> 2- ! \ INTO SSAVE
|
||||
SWAP BOUNDS ?DO I ! 2 +LOOP ; RESTRICT
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\
|
||||
|
||||
: ACTIVATE ( TADR --)
|
||||
0 [ -ROT ( TRICK ! ) ] REPEAT ; -2 ALLOT RESTRICT
|
||||
|
||||
: SLEEP ( TADR --) 4C SWAP C! ; \ JMP-OPCODE
|
||||
|
||||
: WAKE ( TADR --) 2C SWAP C! ; \ BIT-OPCODE
|
||||
|
||||
| : TASKERROR ( STRING -)
|
||||
STANDARDI/O SINGLETASK ." TASK ERROR : " COUNT TYPE
|
||||
MULTITASK STOP ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\ BUILDING A TASK BP 13.9.84 )
|
||||
|
||||
: TASK ( RLEN SLEN -- )
|
||||
ALLOT \ STACK
|
||||
HERE 00FF AND 0FE =
|
||||
IF 1 ALLOT THEN \ 6502-ALIGN
|
||||
UP@ HERE 100 CMOVE \ INIT USER AREA
|
||||
HERE 04C C, \ JMP OPCODE TO SLEEP TASK
|
||||
UP@ 1+ @ ,
|
||||
DUP UP@ 1+ ! \ LINK TASK
|
||||
3 ALLOT \ ALLOT JSR WAKE
|
||||
DUP 6 - DUP , , \ SSAVE AND S0
|
||||
2DUP + , \ HERE + RLEN = R0
|
||||
UNDER + HERE - 2+ ALLOT ['] TASKERROR OVER
|
||||
[ ' ERRORHANDLER >BODY C@ ] LITERAL + ! CONSTANT ;
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ MORE TASKS KS/BP 26APR85RE)
|
||||
|
||||
: RENDEZVOUS ( SEMAPHORADR -) DUP UNLOCK PAUSE LOCK ;
|
||||
|
||||
| : STATESMART STATE @ IF [COMPILE] LITERAL THEN ;
|
||||
|
||||
: 'S ( TADR - ADR.OF.TASKUSERVAR)
|
||||
' >BODY C@ + STATESMART ; IMMEDIATE
|
||||
|
||||
\ SYNTAX: 2 DEMOTASK 'S BASE ! \ MAKES DEMOTASK WORKING BINARY
|
||||
|
||||
: TASKS ( -) ." MAIN " CR UP@ DUP 1+ @
|
||||
BEGIN 2DUP - WHILE
|
||||
DUP [ ' R0 >BODY C@ ] LITERAL + @ 6 + NAME> >NAME .NAME
|
||||
DUP C@ 04C = IF ." SLEEPING" THEN CR 1+ @ REPEAT 2DROP ;
|
||||
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ TASKDEMO 27APR85RE)
|
||||
: TASKMARK ;
|
||||
|
||||
VARIABLE COUNTER COUNTER OFF
|
||||
|
||||
100 100 TASK BACKGROUND
|
||||
|
||||
: >COUNT ( N -) BACKGROUND 1 PASS COUNTER !
|
||||
BEGIN COUNTER @ DUP 1- COUNTER ! ?DUP
|
||||
WHILE PAUSE 0 <# #S #> type REPEAT stop ;
|
||||
|
||||
: WAIT BACKGROUND SLEEP ;
|
||||
|
||||
: GO BACKGROUND WAKE ;
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
1
6502/py65/tools.fb
Normal file
1
6502/py65/tools.fb
Normal file
File diff suppressed because one or more lines are too long
285
6502/py65/tools.fth
Normal file
285
6502/py65/tools.fth
Normal file
|
@ -0,0 +1,285 @@
|
|||
|
||||
\ *** Block No. 0, Hexblock 0
|
||||
|
||||
\ Development Tools cas 26jan06
|
||||
|
||||
Interactive Tracer
|
||||
|
||||
One-Step Debugger
|
||||
|
||||
Traps
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 1, Hexblock 1
|
||||
|
||||
\ TOOLS LOADSCREEN 22MAR85RE)
|
||||
|
||||
ONLYFORTH
|
||||
|
||||
\NEEDS CODE abort( Assembler is needed )
|
||||
|
||||
VOCABULARY TOOLS
|
||||
|
||||
TOOLS ALSO DEFINITIONS
|
||||
hex
|
||||
1 &11 +THRU
|
||||
decimal
|
||||
ONLYFORTH
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 2, Hexblock 2
|
||||
|
||||
\ HANDLE STEPS BP 10 02 85)
|
||||
|
||||
ASSEMBLER ALSO DEFINITIONS
|
||||
|
||||
ONLY FORTH ALSO TOOLS ALSO DEFINITIONS
|
||||
| VARIABLE (W | VARIABLE RPT
|
||||
|
||||
| CODE STEP
|
||||
RPT DEC RP X) LDA IP STA
|
||||
RP )Y LDA IP 1+ STA RP 2INC
|
||||
(W LDA W STA (W 1+ LDA W 1+ STA
|
||||
W 1- JMP END-CODE
|
||||
|
||||
| CREATE NEXTSTEP ] STEP [
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 3, Hexblock 3
|
||||
|
||||
\ THROW STATUS ON R-STACK B 23JUL85RE)
|
||||
|
||||
| CREATE NPULL 0 ]
|
||||
RP@ COUNT 2DUP + RP! R> SWAP CMOVE ;
|
||||
|
||||
: NPUSH ( ADDR LEN -)
|
||||
R> -ROT OVER >R RP@ OVER 1+ - DUP RP! PLACE
|
||||
NPULL >R >R ;
|
||||
|
||||
| : ONELINE .STATUS SPACE QUERY INTERPRET
|
||||
-82 ALLOT RDROP ( DELETE QUIT FROM TNEXT ) ;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 4, Hexblock 4
|
||||
|
||||
\ TRAP AND DISPLAY KS 26MAR85RE)
|
||||
LABEL TNEXT
|
||||
IP 2INC RP LDA RPT CMP 0<> ?[
|
||||
[[ W 1- JMP SWAP ]?
|
||||
RP 1+ LDA RPT 1+ CMP 0= ?]
|
||||
LABEL DOTRACE
|
||||
RPT INC ( DISABLE TRACER )
|
||||
W LDA (W STA W 1+ LDA (W 1+ STA
|
||||
;C: R@ NEXTSTEP >R
|
||||
INPUT PUSH KEYBOARD
|
||||
OUTPUT PUSH DISPLAY
|
||||
CR 2- DUP 4 U.R @ DUP 5 U.R 2 SPACES
|
||||
>NAME .NAME 1C COL - 0 MAX SPACES .S
|
||||
STATE PUSH BLK PUSH >IN PUSH
|
||||
[ ' 'QUIT >BODY ] LITERAL PUSH
|
||||
[ ' >INTERPRET >BODY ] LITERAL PUSH
|
||||
|
||||
\ *** Block No. 5, Hexblock 5
|
||||
|
||||
\
|
||||
#TIB PUSH TIB #TIB @ NPUSH R0 PUSH
|
||||
RP@ R0 ! 082 ALLOT
|
||||
['] ONELINE IS 'QUIT QUIT ; -2 ALLOT
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 6, Hexblock 6
|
||||
|
||||
\ TRACER COMMANDS BP 23JUL85RE)
|
||||
|
||||
| CODE (TRACE TNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA
|
||||
# LDA NEXT 0B + STA
|
||||
04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
|
||||
: TRACE' RP@ 2- RPT ! ' (TRACE EXECUTE END-TRACE ;
|
||||
|
||||
: BREAK RP@ 2+ RPT ! (TRACE ; RESTRICT
|
||||
|
||||
: TRACEL: CREATE , DOES> @ RPT +! ;
|
||||
|
||||
-6 TRACEL: +DO 6 TRACEL: -DO
|
||||
-2 TRACEL: +R 2 TRACEL: -R
|
||||
-6 TRACEL: +PUSH 6 TRACEL: -PUSH
|
||||
|
||||
\ *** Block No. 7, Hexblock 7
|
||||
|
||||
\ WATCH TRAP BP 10 02 85 )
|
||||
|
||||
| VARIABLE WATCHPT 2 ALLOT
|
||||
|
||||
LABEL WNEXT IP 2INC
|
||||
WATCHPT LDA N STA WATCHPT 1+ LDA N 1+ STA
|
||||
N X) LDA WATCHPT 2+ CMP 0<> ?[
|
||||
[[ RP LDA RPT STA RP 1+ LDA RPT 1+ STA
|
||||
( SET TO TNEXT) TNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA # LDA NEXT 0B + STA
|
||||
DOTRACE JMP SWAP ]?
|
||||
N )Y LDA WATCHPT 3 + CMP 0= ?] W 1- JMP END-CODE
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 8, Hexblock 8
|
||||
|
||||
\ WATCH COMMANDS BP 10 02 85 )
|
||||
|
||||
| CODE (WATCH WNEXT 0 100 M/MOD
|
||||
# LDA NEXT 0C + STA
|
||||
# LDA NEXT 0B + STA
|
||||
04C # LDA NEXT 0A + STA NEXT JMP END-CODE
|
||||
|
||||
: WATCH' ( ADR -- )
|
||||
DUP WATCHPT ! @ WATCHPT 2+ ! ' (WATCH EXECUTE END-TRACE ;
|
||||
|
||||
: CONT ( -) WATCHPT @ @ WATCHPT 2+ ! (WATCH ;
|
||||
|
||||
( SYNTAX : <VARNAME> WATCH' <PROCEDURE> )
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 9, Hexblock 9
|
||||
|
||||
\ TOOLS FOR DECOMPILING, KS 4 APR 83 )
|
||||
( INTERACTIVE USE )
|
||||
| : ?: DUP 4 U.R ." :" ;
|
||||
| : @? DUP @ 6 U.R ;
|
||||
| : C? DUP C@ 3 .R ;
|
||||
| : BL 024 COL - 0 MAX SPACES ;
|
||||
|
||||
: S ( ADR - ADR+) ( PRINT LITERAL STRING)
|
||||
?: SPACE C? 4 SPACES DUP COUNT TYPE
|
||||
DUP C@ + 1+ BL ; ( COUNT + RE)
|
||||
|
||||
: N ( ADR - ADR+2) ( PRINT NAME OF NEXT WORD BY ITS CFA)
|
||||
?: @? 2 SPACES DUP @ >NAME .NAME 2+ BL ;
|
||||
|
||||
: L ( ADR - ADR+2) ( PRINT LITERAL VALUE) ?: @? 2+ BL ;
|
||||
|
||||
|
||||
\ *** Block No. 10, Hexblock a
|
||||
|
||||
\ TOOLS FOR DECOMPILING, INTERACTIVE )
|
||||
|
||||
: D ( ADR N - ADR+N) ( DUMP N BYTES)
|
||||
2DUP SWAP ?: 3 SPACES SWAP 0 DO C? 1+ LOOP
|
||||
4 SPACES -ROT TYPE BL ;
|
||||
|
||||
: C ( ADR - ADR+1) ( PRINT BYTE AS UNSIGNED VALUE) 1 D ;
|
||||
|
||||
: B ( ADR - ADR+2) ( PRINT BRANCH TARGET LOCATION )
|
||||
?: @? DUP @ OVER + 6 U.R 2+ BL ;
|
||||
|
||||
( USED FOR : )
|
||||
( NAME STRING LITERAL DUMP CLIT BRANCH )
|
||||
( - - - - - - )
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 11, Hexblock b
|
||||
|
||||
\ DEBUGGING UTILITIES BP 19 02 85 )
|
||||
|
||||
: UNRAVEL \ UNRAVEL PERFORM (ABORT"
|
||||
RDROP RDROP RDROP CR ." TRACE DUMP IS " CR
|
||||
|
||||
BEGIN RP@ R0 @ -
|
||||
WHILE R> DUP 8 U.R SPACE 2- @ >NAME .NAME CR
|
||||
REPEAT (ERROR ;
|
||||
|
||||
' UNRAVEL ERRORHANDLER !
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 12, Hexblock c
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 13, Hexblock d
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
\ *** Block No. 14, Hexblock e
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user