spinix-hive/pfth/fds.fth

89 lines
2.4 KiB
Forth

\ ############################################################################
\ # fds.fth - This program implements a full duplex serial port. It is base
\ # on the FullDuplexSerial Spin object.
\ #
\ # Copyright (c) 2012 Dave Hein
\ # MIT Licensed
\ ############################################################################
0 value fds_cog
create fds_vars 68 allot
: fds_var create , does> @ fds_vars + ;
0 fds_var rx_head
4 fds_var rx_tail
8 fds_var tx_head
12 fds_var tx_tail
16 fds_var rx_pin
20 fds_var tx_pin
24 fds_var rxtx_mode
28 fds_var bit_ticks
32 fds_var buffer_ptr
36 fds_var rx_buffer
52 fds_var tx_buffer
hex
create fds_entry
a0bca9f0 , 80fca810 , 08bcaa54 , a0fcb201 , 2cbcb255 , 80fca804 , 08bcaa54 ,
a0fcbe01 , 2cbcbe55 , 80fca804 , 08bcae54 , 80fca804 , 08bcb054 , 80fca804 ,
08bcb454 , a0bcc05a , 80fcc010 , 627cae04 , 617cae02 , 689be85f , 68abec5f ,
a0fcc833 , 5cbcbc64 , 627cae01 , 613cb3f2 , 5c640016 , a0fcb809 , a0bcba58 ,
28fcba01 , 80bcbbf1 , 80bcba58 , 5cbcbc64 , a0bca85d , 84bca9f1 , c17ca800 ,
5c4c001f , 613cb3f2 , 30fcb601 , e4fcb81e , 28fcb617 , 60fcb6ff , 627cae01 ,
6cd4b6ff , 08bcabf0 , 80bcaa5a , 003cb655 , 84bcaa5a , 80fcaa01 , 60fcaa0f ,
083cabf0 , 5c7c0016 , 5cbcc85e , a0bca9f0 , 80fca808 , 08bcaa54 , 80fca804 ,
08bcac54 , 863caa56 , 5c680033 , 80bcac60 , 00bcc256 , 84bcac60 , 80fcac01 ,
60fcac0f , 083cac54 , 68fcc300 , 2cfcc202 , 68fcc201 , a0fcc40b , a0bcc7f1 ,
627cae04 , 617cae02 , 6ce0c201 , 29fcc201 , 70abe85f , 7497ec5f , 80bcc658 ,
5cbcc85e , a0bca863 , 84bca9f1 , c17ca800 , 5c4c004d , e4fcc446 , 5c7c0033 ,
decimal
: fds_start ( rxpin txpin mode baudrate ... )
>r
fds_vars 16 0 fill
rxtx_mode ! tx_pin ! rx_pin !
clkfreq@ r> / bit_ticks !
rx_buffer buffer_ptr !
0 dira!
fds_entry rx_head cognew
1+ dup to fds_cog
;
: fds_stop fds_cog if fds_cog 1- cogstop 0 to fds_cog then ;
: fds_rxcheck rx_tail @ rx_head @ 2dup . . cr =
if
-1
else
rx_tail @ rx_buffer + c@
rx_tail @ 1+ 15 and rx_tail !
then
;
: fds_rx begin fds_rxcheck dup -1 = while drop repeat ;
: fds_tx begin tx_tail @ tx_head @ 1+ 15 and <> until
tx_head @ tx_buffer + c!
tx_head @ 1+ 15 and tx_head !
rxtx_mode @ 8 and if fds_rx then
;
: fdstest
." Type 'q' to quit" cr
31 30 0 115200 fds_start
drop
begin
fds_rx
dup [char] q <>
while
[char] < fds_tx fds_tx [char] > fds_tx
repeat
drop
fds_stop
1 30 lshift dira!
;