Re: Tali Forth for the 65c02
Posted: Sun Nov 20, 2022 12:23 am
Thank you. I see your Github is squared away, watching and appreciate you!
Code: Select all
hex
: myblockreader1 ED9C execute ;
: myblockwriter1 EE42 execute ;
decimal
: store_block_num 15350 ! ;
: clear_loading 1279 1024 blank ;
: myblockreader store_block_num . clear_loading myblockreader1 ;
: myblockwriter store_block_num . myblockwriter1 ;
' myblockreader BLOCK-READ-VECTOR !
' myblockwriter BLOCK-WRITE-VECTOR !
editor-wordlist >order
hex
: TEXT PAD 258 BL FILL WORD COUNT PAD SWAP MOVE ;
decimal
CREATE list_path 64 allot
: ls 13 TEXT PAD list_path 64 move 60592 execute ;
: pwd 13 TEXT PAD list_path 64 move 60624 execute ;
: cd 13 TEXT PAD list_path 64 move 60656 execute ;
: mkdir 13 TEXT PAD list_path 64 move 60699 execute ;
: rm 13 TEXT PAD list_path 64 move 60742 execute ;
: mv 13 TEXT PAD list_path 64 move 60785 execute ;
: bload 13 TEXT PAD list_path 64 move 61232 execute ;
hex
: A1 DC12 execute ;
: A1W DC15 execute ;
: MON FC00 execute ;
: MONW FC29 execute ;
: WOZMON FC00 execute ;
decimal
: cls 12 emit ;Code: Select all
: block2eeprom ( u -- u u ) ( blocknum -- eeprom_address i2c_address )
( Note that the i2c_address returned has already been shifted to )
( the left by one bit. The R/*W bit in bit 0 starts as a zero. )
dup 40 < if
( Blocks 0-63[decimal] )
400 * ( multiply block number by 1024[decimal] )
A0 ( use $50 [shifted left one place] as I2C address )
else
( Blocks 64-127[decimal] - no limit check )
40 - ( subtract 64[decimal] from block number )
400 * ( multiply block number by 1024[decimal] )
A8 ( use $54 [shifted left one place] as I2C address )
then ;
: eeprom-pagewrite ( addr u u -- ) ( buffer_address eeprom_address i2c_address -- )
dup >r ( save the i2c address for later )
i2c-start i2c-tx drop ( start the i2c frame using computed i2c address )
100 /mod i2c-tx drop i2c-tx drop ( send the 16-bit address as two bytes )
80 0 do ( send the 128[decimal] bytes )
dup i + ( compute buffer address )
c@ i2c-tx drop ( send the byte )
loop drop i2c-stop ( end the frame )
r> begin ( recall the i2c address and poll until complete )
dup
i2c-start i2c-tx ( start the i2c frame using computed i2c address )
0= until drop
i2c-stop
;
: eeprom-blockwrite ( addr u -- ) ( buffer_address blocknum -- )
( Write the entire block buffer one eeprom page [128 bytes] at a time )
8 0 do
over i 80 * + ( offset by eeprom pages into block buffer )
over block2eeprom
swap i 80 * + swap ( offset by eeprom pages into eeprom )
eeprom-pagewrite
loop
2drop ;
: eeprom-blockread ( addr u -- ) ( buffer_address blocknum -- )
block2eeprom dup
i2c-start i2c-tx drop ( start the i2c frame using computed i2c address )
swap ( move the eeprom internal address to TOS )
100 /mod i2c-tx drop i2c-tx drop ( send the 16-bit address as two bytes )
i2c-start 1+ i2c-tx drop ( send I2C address again with R/W* bit set )
3FF 0 do ( loop though all but the last byte )
0 i2c-rx over i + c!
loop
( Read last byte with NAK to stop )
1 i2c-rx over 3FF + c! i2c-stop drop ;
\ Connect to Fourth BLOCK words
' eeprom-blockread BLOCK-READ-VECTOR !
' eeprom-blockwrite BLOCK-WRITE-VECTOR !Code: Select all
3 LIST \ List the code in block 3 to the screen.
3 LOAD \ Load the code in block 3.Code: Select all
: NOOP ;
[B]
: INIT_VIA ( -- )
00110000 VIA3DDRB C! \ Bits 5 and 4 begin as outputs.
VIA3PB C_OFF ; \ Begin with SCLK low.
CODE CLK_UP LDA# 00100000 C, TSB_ABS VIA3PB , JMP NEXT , \ Set VIA3PB5.
CODE CLK_DN LDA# 00100000 C, TRB_ABS VIA3PB , JMP NEXT , \ Clear VIA3PB5.
CODE DATA_UP LDA# 00010000 C, TSB_ABS VIA3PB , JMP NEXT , \ Set VIA3PB4.
CODE DATA_DN LDA# 00010000 C, TRB_ABS VIA3PB , JMP NEXT , \ Clear VIA3PB4.
CODE I2C_DATA_OUT LDA# 00010000 C, TSB_ABS VIA3DDRB , JMP NEXT , \ Make VIA3PB4 an output.
CODE I2C_DATA_IN LDA# 00010000 C, TRB_ABS VIA3DDRB , JMP NEXT , \ Make VIA3PB4 an input.
: INIT_VIA ( -- )
00110000 VIA3DDRB C! \ Bits 5 and 4 begin as outputs.
VIA3PB C_OFF ; \ Begin with SCLK low.
: I2C_START ( -- ) I2C_DATA_OUT DATA_UP CLK_UP DATA_DN CLK_DN ;
: I2C_STOP ( -- ) I2C_DATA_OUT DATA_DN CLK_UP DATA_UP CLK_DN ;
: I2C_ACK ( -- ) I2C_DATA_OUT DATA_DN CLK_UP CLK_DN ; \ Assumed clock is low to start.
: I2C_NAK ( -- ) I2C_DATA_OUT DATA_UP CLK_UP CLK_DN ; \ "
: I2C_ACK? ( -- f ) I2C_DATA_IN CLK_UP VIA3PB C@ 00010000 AND CLK_DN \ "
I2C_DATA_OUT 0= ; \ Check data line bit. Lo=ack=true.
[H]
: RD_I2C_BIT ( n -- 2n | 2n+1 ) \ Does not affect the clock line.
2* VIA3PB C@ -4 SHIFT 1 AND + ; \ VIA pin must already be an input.
: SEND_BIT ( n -- n ) DUP 0< \ Was MSB a 1? Remember SEND_I2C_BYT uses >< .
IF DATA_UP ELSE DATA_DN THEN \ Set data appropriately (assumes VIA data bit is an output already)
NOOP CLK_UP NOOP CLK_DN ; \ then cycle the clock up and back down.
: SEND_I2C_BYT ( b -- f ) \ Make sure you don't input anything over FF. f=0 if not acknowledged.
>< \ Swap byte order so 2* puts high bit in negative flag. I2C_DATA_OUT assumed.
8 0 \ Loop 8 times:
DO SEND_BIT 2* \ Send out MSB, then shift left so next-highest bit goes out next.
LOOP DROP \ After sending 8 bits, drop what's left of the cell.
I2C_ACK? ; \ Get the acknowledge flag.
: RCV_I2C_BYT ( -- b )
I2C_DATA_IN \ Make the bit an input so the I2C device can send us data.
DUMMYCELL \ Put the seed on the stack to build the received byte on.
8 0 \ Loop 8 times:
DO CLK_UP RD_I2C_BIT CLK_DN \ Set the clock line high before reading the data line, then put clock back down.
LOOP ; \ The acknowledge or not-acknowledge bit must be sent separately.
Code: Select all
\ Set up the VIA for I2C. I'm using the VIA DDR method.
\ PTA7 is data
\ PTA0 is clock
hex
7F01 constant via.porta
7F03 constant via.ddra
\ Make port A an input so the bus starts idle.
: i2c-setup 0 via.porta c! 0 via.ddra c! ;
\ Data on PORTA7 (note that 0 = 1 on the I2C bus for writing)
\ : i2c-sda0 via.ddra c@ 80 or via.ddra c! ; allow-native
\ : i2c-sda1 via.ddra c@ 7f and via.ddra c! ; allow-native
: i2c-sda0
[
AD c, 03 c, 7f c, ( lda $7f03 )
09 c, 80 c, ( ora #$80 )
8D c, 03 c, 7f c, ( sta $7f03 )
] ; allow-native
: i2c-sda1
[
AD c, 03 c, 7f c, ( lda $7f03 )
29 c, 7F c, ( and #$7F )
8D c, 03 c, 7f c, ( sta $7f03 )
] ; allow-native
\ Clock is on PORTA0 (note that 0 = 1 on I2C bus)
\ : i2c-scl0 via.ddra c@ 01 or via.ddra c! ; allow-native
\ : i2c-scl1 via.ddra c@ FE and via.ddra c! ; allow-native
: i2c-scl0
[
AD c, 03 c, 7f c, ( lda $7f03 )
09 c, 01 c, ( ora #$01 )
8D c, 03 c, 7f c, ( sta $7f03 )
] ; allow-native
: i2c-scl1
[
AD c, 03 c, 7f c, ( lda $7f03 )
29 c, FE c, ( and #$FE )
8D c, 03 c, 7f c, ( sta $7f03 )
] ; allow-native
\ Clock the bus high, then low.
: i2c-clock
i2c-scl1 i2c-scl0 ; allow-native
\ Generate a START condition on the bus.
: i2c-start
i2c-sda1 i2c-scl1 i2c-sda0 i2c-scl0 ; allow-native
\ Generate a STOP condition on the bus.
: i2c-stop
i2c-sda0 i2c-scl1 i2c-sda1 ; allow-native
\ Transmit a single bit.
: i2c-txbit ( bit -- )
if i2c-sda1 else i2c-sda0 then i2c-clock ;
\ Receive a single bit.
: i2c-rxbit ( -- bit )
i2c-sda1 i2c-scl1 via.porta c@
80 and if 1 else 0 then i2c-scl0 ;
: i2c-tx ( byte -- nak )
8 0 do dup 80 and i2c-txbit 2* loop drop ( Send the byte )
i2c-rxbit ; ( Get the NAK flag )
: i2c-rx ( nak -- byte )
0 8 0 do 2* i2c-rxbit + loop ( Receive the byte )
swap i2c-txbit ; ( Send the NAK flag )
: block2eeprom ( u -- u u ) ( blocknum -- eeprom_address i2c_address )
dup 40 < if
( Blocks 0-63[decimal] )
400 * ( multiply block number by 1024[decimal] )
A0 ( use $50 [shifted left one place] as I2C address )
else
( Blocks 64-127[decimal] - no limit check )
40 - ( subtract 64[decimal] from block number )
400 * ( multiply block number by 1024[decimal] )
A8 ( use $54 [shiften left one place] as I2C address )
then ;
: eeprom-pagewrite ( addr u u -- ) ( buffer_address eeprom_address i2c_address -- )
dup >r ( save the i2c address for later )
i2c-start i2c-tx drop ( start the i2c frame using computed i2c address )
100 /mod i2c-tx drop i2c-tx drop ( send the 16-bit address as two bytes )
80 0 do ( send the 128[decimal] bytes )
dup i + ( compute buffer address )
c@ i2c-tx drop ( send the byte )
loop drop i2c-stop ( end the frame )
r> begin ( recall the i2c address and poll until complete )
dup
i2c-start i2c-tx ( start the i2c frame using computed i2c address )
0= until drop
i2c-stop
;
: eeprom-blockwrite ( addr u -- ) ( buffer_address blocknum -- )
( Write the entire block buffer one eeprom page [128 bytes] at a time )
8 0 do
over i 80 * + ( offset by eeprom pages into block buffer )
over block2eeprom
swap i 80 * + swap ( offset by eeprom pages into eeprom )
eeprom-pagewrite
loop
2drop ;
: eeprom-blockread ( addr u -- ) ( buffer_address blocknum -- )
block2eeprom dup
i2c-start i2c-tx drop ( start the i2c frame using computed i2c address )
swap ( move the eeprom internal address to TOS )
100 /mod i2c-tx drop i2c-tx drop ( send the 16-bit address as two bytes )
i2c-start 1+ i2c-tx drop ( send I2C address again with R/W* bit set )
3FF 0 do ( loop though all but the last byte )
0 i2c-rx over i + c!
loop
( Read last byte with NAK to stop )
1 i2c-rx over 3FF + c! i2c-stop drop ;
\ Connect to Fourth BLOCK words
' eeprom-blockread BLOCK-READ-VECTOR !
' eeprom-blockwrite BLOCK-WRITE-VECTOR !
decimalCode: Select all
hist_buff = ram_end-$03ff ; begin of history buffers
acia_buff = hist_buff-$102 ; begin of ACIA buffer memory Code: Select all
ACIA_DATA = $7F80
ACIA_STATUS = $7F81
ACIA_COMMAND = $7F82
ACIA_CTRL = $7F83
;; Defines for the 256 byte circular buffer with two 8-bit pointers.
ACIA_BUFFER = acia_buff+2
ACIA_RD_PTR = acia_buff+0
ACIA_WR_PTR = acia_buff+1
;; Init ACIA to 19200 8,N,1
;; Uses: A (not restored)
Init_ACIA:
lda #$1F
sta ACIA_CTRL
lda #$09 ; RX interrupt on. RTS low (asserted).
sta ACIA_COMMAND
;; Initialize the buffer
stz ACIA_RD_PTR
stz ACIA_WR_PTR
; Turn on interrupts.
cli
rtsCode: Select all
v_irq: ; IRQ handler (only handling ACIA RX)
SERVICE_ACIA:
pha
phx
lda ACIA_STATUS
;and #$07 ; Check for errors.
;bne SERVICE_ACIA_END ; Ignore errors.
and #$08 ; Check for RX byte available
beq SERVICE_ACIA_END ; No byte available.
; There is a byte to get.
lda ACIA_DATA
jsr WR_ACIA_BUF
; Check how many bytes in the buffer are used.
jsr ACIA_BUF_DIF
cmp #$F0
bcc SERVICE_ACIA_END
; There are only 15 chars left - de-assert RTS
lda #$01
sta ACIA_COMMAND
SERVICE_ACIA_END:
plx
pla
rtiCode: Select all
;; Get_Char - get a character from the serial port into A.
;; Set the carry flag if char is valid.
;; Return immediately with carry flag clear if no char available.
;; Uses: A (return value)
Get_Char:
;; Check to see if there is a character.
jsr ACIA_BUF_DIF
beq no_char_available
char_available:
;; See if RTS should be asserted (low)
;; buffer bytes in use in A from above.
cmp #$E0
bcs buf_full
lda #$09
sta ACIA_COMMAND
buf_full:
phx ; Reading from buffer messes with X.
jsr RD_ACIA_BUF ; Get the character.
plx
;; jsr Send_Char ; Echo
sec ; Indicate it's valid.
rts
no_char_available:
clc ; Indicate no char available.
rts
kernel_getc:
; """Get a single character from the keyboard (waits for key).
; """
;; Get_Char_Wait - same as Get_Char only blocking.
;; Uses: A (return value)
Get_Char_Wait:
jsr Get_Char
bcc Get_Char_Wait
rts
kernel_putc:
; """Print a single character to the console. """
;; Send_Char - send character in A out serial port.
;; Uses: A (original value restored)
Send_Char:
sei
pha ;Save A (required for ehbasic)
wait_tx: ; Wait for the TX buffer to be free.
lda ACIA_STATUS
; A byte may come in while we are trying to transmit.
; Because we have disabled interrupts, and we've just read from
; the status register (which clears an interrupt),
; we might have to deal with it ourselves.
pha ; Save the status for checking the TRDE bit later.
and #$08 ; Check for byte recieved
beq check_tx ; No bye received, continue to check TRDE bit.
; A byte was recieved while we are trying to transmit.
; Process it and then go back to checking for TX ready.
phx
lda ACIA_DATA
jsr WR_ACIA_BUF
; Check how many bytes in the buffer are used.
jsr ACIA_BUF_DIF
cmp #$F0
bcc tx_keep_rts_active
; There are only 15 chars left - de-assert RTS
lda #$01
sta ACIA_COMMAND
tx_keep_rts_active:
plx ; Restore the ACIA_STATUS value to A.
check_tx:
; Check to see if we can transmit yet.
pla
and #$10
beq wait_tx ; TRDE is not set - byte still being sent.
; Send the byte.
pla
sta ACIA_DATA
cli
rts