6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-11-26 02:49:17 +00:00
Code Issues Projects Releases Wiki Activity

First working py65 version

Browse Source
This commit is contained in:
Carsten Strotmann 2020-07-15 20:50:07 +02:00
parent 0478a47a95
commit 6b91250f37
4 changed files with 32 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
6502/py65/6502f83.fb
View File

File diff suppressed because one or more lines are too long

14
6502/py65/6502f83.fth
View File

@ -20,7 +20,7 @@ ende 123
\ *** Block No. 1, Hexblock 1 \ *** Block No. 1, Hexblock 1
\ volksFORTH Loadscreen cas 26jan06 \ volksFORTH Loadscreen for py65 target cas 15juli2020
forth definitions forth definitions
: (C [compile] ( ; IMMEDIATE \ : ) ; IMMEDIATE : (C [compile] ( ; IMMEDIATE \ : ) ; IMMEDIATE
@ -58,7 +58,7 @@ HERE DUP ORIGIN!
\ *** Block No. 3, Hexblock 3 \ *** Block No. 3, Hexblock 3
\ Coldstartvalues and user variables cas 26jan06 \ Coldstartvalues and user variables cas 15juli2020
\ \
0 JMP 0 JSR HERE 2- >LABEL >WAKE 0 JMP 0 JSR HERE 2- >LABEL >WAKE
@ -67,7 +67,7 @@ HERE DUP ORIGIN!
0D6 ALLOT 0D6 ALLOT
\ Bootlabel \ Bootlabel
," VOLKSFORTH-83 3.8 COMPILED 26JAN06CS" ," VOLKSFORTH-83 3.8 py65 15july2020 CS"
@ -1692,7 +1692,7 @@ DEFER NOTFOUND
\ *** Block No. 89, Hexblock 59 \ *** Block No. 89, Hexblock 59
\ ?STACK 08SEP84KS) 11jan13py \ ?STACK 08SEP84KS) cas 15july2020
| : STACKFULL ( -- ) | : STACKFULL ( -- )
DEPTH 20 > ABORT" TIGHT STACK" DEPTH 20 > ABORT" TIGHT STACK"
@ -1702,7 +1702,7 @@ DEFER NOTFOUND
CODE ?STACK USER' DP # LDY CODE ?STACK USER' DP # LDY
SEC SP LDA UP )Y SBC N STA INY SP 1+ LDA UP )Y SBC SEC SP LDA UP )Y SBC N STA INY SP 1+ LDA UP )Y SBC
0= ?[ 1 # LDY ;C: STACKFULL ; ASSEMBLER ]? 0= ?[ 1 # LDY ;C: STACKFULL ; ASSEMBLER ]?
USER' S0 # LDY UP )Y LDA SP CMP INY USER' S0 # LDY UP )Y LDA SP CMP INY
UP )Y LDA SP 1+ SBC 1 # LDY CS ?[ NEXT JMP ]? UP )Y LDA SP 1+ SBC 1 # LDY CS ?[ NEXT JMP ]?
;C: TRUE ABORT" STACK EMPTY" ; -2 ALLOT ;C: TRUE ABORT" STACK EMPTY" ; -2 ALLOT
@ -2300,7 +2300,7 @@ HOST TARGET
\ *** Block No. 121, Hexblock 79 \ *** Block No. 121, Hexblock 79
\ 'COLD 07JUN85BP) cas 26jan06 \ 'COLD 07JUN85BP) cas 15juli2020
| : INIT-VOCABULARYS VOC-LINK @ | : INIT-VOCABULARYS VOC-LINK @
BEGIN DUP 2- @ OVER 4 - ! @ ?DUP 0= UNTIL ; BEGIN DUP 2- @ OVER 4 - ! @ ?DUP 0= UNTIL ;
@ -2309,7 +2309,7 @@ HOST TARGET
DEFER 'COLD ' NOOP IS 'COLD DEFER 'COLD ' NOOP IS 'COLD
| : (COLD INIT-VOCABULARYS INIT-BUFFERS PAGE 'COLD ONLYFORTH | : (COLD INIT-VOCABULARYS INIT-BUFFERS PAGE 'COLD ONLYFORTH
." volksFORTH-83 REV 3.8" CR RESTART ; -2 ALLOT ." volksFORTH-83 3.8 py65 202007" CR RESTART ; -2 ALLOT
DEFER 'RESTART ' NOOP IS 'RESTART DEFER 'RESTART ' NOOP IS 'RESTART
| : (RESTART ['] (QUIT IS 'QUIT | : (RESTART ['] (QUIT IS 'QUIT

2
6502/py65/systemio.fb
View File

File diff suppressed because one or more lines are too long

46
6502/py65/systemio.fth
View File

@ -20,16 +20,16 @@
\ *** Block No. 1, Hexblock 1 \ *** Block No. 1, Hexblock 1
\ loadscreen fuer generic System IO cas 26jan06 \ loadscreen for py65 cas 15juli2020
1 9 +thru 1 9 +thru
\\ This example IO definitions are based on serial communication \\ The following IO definitions are for the py65
emulator at https://github.com/mnaberez/py65
The definitions needs to be adapted for each system
A char can can be read by memory mapped IO at $f004
A char can be written to memory mapped IO at $f001
@ -39,18 +39,18 @@ The definitions needs to be adapted for each system
\ *** Block No. 2, Hexblock 2 \ *** Block No. 2, Hexblock 2
\ 65KEY? GETKEY 25JAN85RE) er14dez88 \ 65KEY? GETKEY 25JAN85RE) cas 15july2020
CODE 65KEY? ( -- FLAG) $C0EA jsr push0a jmp end-code CODE 65KEY? ( -- FLAG) $f004 lda $9ff sta push0a jmp end-code
CODE GETKEY ( -- 8B) $C0A6 jsr push0a jmp end-code CODE GETKEY ( -- 8B) $9ff lda push0a jmp end-code
CODE CURON ( --) NEXT JMP END-CODE CODE CURON ( --) NEXT JMP END-CODE
CODE CUROFF ( --) NEXT JMP END-CODE CODE CUROFF ( --) NEXT JMP END-CODE
: 65KEY ( -- 8B) : 65KEY ( -- 8B)
CURON BEGIN PAUSE 65KEY? UNTIL CUROFF GETKEY ; BEGIN PAUSE 65KEY? UNTIL GETKEY ;
@ -58,9 +58,9 @@ CODE CUROFF ( --) NEXT JMP END-CODE
\ *** Block No. 3, Hexblock 3 \ *** Block No. 3, Hexblock 3
\ DECODE EXPECT KEYBOARD BP28MAY85) \ DECODE EXPECT KEYBOARD BP28MAY85) cas 15july2020
08 CONSTANT #BS 0D CONSTANT #CR &27 CONSTANT #ESC 08 CONSTANT #BS 0D CONSTANT #CR &27 CONSTANT #ESC
0A CONSTANT #LF
: 65DECODE ( ADDR CNT1 KEY -- ADDR CNT2) : 65DECODE ( ADDR CNT1 KEY -- ADDR CNT2)
#BS CASE? IF DUP IF DEL 1- THEN EXIT THEN #BS CASE? IF DUP IF DEL 1- THEN EXIT THEN
#CR CASE? IF DUP SPAN ! EXIT THEN #CR CASE? IF DUP SPAN ! EXIT THEN
@ -77,17 +77,17 @@ INPUT: KEYBOARD [ HERE INPUT ! ]
\ *** Block No. 4, Hexblock 4 \ *** Block No. 4, Hexblock 4
\ send? (emit 65emit er14dez88 cas 26jan06 \ send? (emit 65emit cas 15july2020
| $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
\ | Code send? ( -- flg )
\ $01 # lda push0a jmp end-code
Code (emit ( 8b -- )
SP X) lda $f001 sta (drop jmp end-code
@ -96,13 +96,14 @@ Code (emit ( 8b -- ) SP X) LDA aciaio sta (drop jmp end-code
\ *** Block No. 5, Hexblock 5 \ *** Block No. 5, Hexblock 5
\ EMIT CR DEL PAGE AT AT? 25JAN85RE) cas 26jan06 \ EMIT CR DEL PAGE AT AT? 25JAN85RE) cas 15july2020
| Variable out 0 out ! | &80 Constant c/row | Variable out 0 out ! | &80 Constant c/row
: 65emit ( 8b -- ) BEGIN pause send? UNTIL 1 out +! (emit ; : 65emit ( 8b -- ) pause 1 out +! (emit ;
: 65CR #CR 65emit out @ c/row / 1+ c/row * out ! ; : 65CR #CR 65emit #LF 65emit
out @ c/row / 1+ c/row * out ! ;
: 65DEL #bs 65emit SPACE #bs 65emit -2 out +! ; : 65DEL #bs 65emit SPACE #bs 65emit -2 out +! ;
@ -112,10 +113,9 @@ Code (emit ( 8b -- ) SP X) LDA aciaio sta (drop jmp end-code
.( insert code for at ) swap c/row * + out ! ; .( insert code for at ) swap c/row * + out ! ;
: 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ; : 65AT? ( -- ROW COL ) out @ c/row /mod &24 min swap ;
\ *** Block No. 6, Hexblock 6 \ *** Block No. 6, Hexblock 6
\ 65type cas 26jan06 \ 65type cas 15jul2020
: 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ; : 65type ( adr len -- ) bounds ?DO I c@ emit LOOP ;