RP2040 MSForth Dictionary 0
Where I keep track of my dictionary 0 for Mecrisp-Stellaris Forth on the Feather RP2040.
\ main dictionary for words which have been debugged
compiletoflash
: words4 ( -- ) cr \ A columnar Word list printer. Width = 20 characters, handles overlength Words neatly
0 \ column counter
dictionarystart
begin
dup 6 + dup
ctype \ dup before 6 is for dictionarynext input
count nip \ get number of characters in the word and drop the address of the word
20 swap - dup 0 > if \ if Word is less than 20 chars
spaces swap \ pad with spaces to equal 20 chars
else drop cr \ issue immediate carriage return and drop negative number
nip -1 \ and reset to column -1
then
dup 3 = if 3 - cr \ if at 4th column, zero column counter
else 1 +
then
swap
dictionarynext \ ( a-addr - - a-addr flag )
until
2drop
;
: freeram ( -- )
flashvar-here 4 -
compiletoram here
- . ." Bytes "
;
: bp cr . .s cr ;
$40014000 constant IO_BANK0_GPIO0_STATUS \ GPIO status
$40014004 constant IO_BANK0_GPIO0_CTRL \ GPIO control including function select and overrides.
$d0000000 constant SIO_BASE
#5 constant SIO \ SIO (F5) DS_p258
SIO_BASE $004 + constant GPIO_IN \ Input value for GPIO
SIO_BASE $010 + constant GPIO_OUT \ GPIO output value
SIO_BASE $014 + constant GPIO_OUT_SET \ GPIO output value set
SIO_BASE $018 + constant GPIO_OUT_CLR \ GPIO output value clear
SIO_BASE $01c + constant GPIO_OUT_XOR \ GPIO output value XOR
SIO_BASE $020 + constant GPIO_OE \ GPIO output enable
SIO_BASE $024 + constant GPIO_OE_SET \ GPIO output enable set
SIO_BASE $028 + constant GPIO_OE_CLR \ GPIO output enable clear
SIO_BASE $02c + constant GPIO_OE_XOR \ GPIO output enable XOR
\ Feather RP2040 localization
#13 constant GP13
GP13 constant LED
#2 constant minGPIO
#29 constant maxGPIO
#0 constant minTest
#3 constant maxTest
#8 constant padsize
: GPIO_ctrl ( GPIO -- ) \ get the address for the specific GPIO ctrl register
#8 * IO_BANK0_GPIO0_CTRL +
;
\ print values of the GPIO_CTRL registers
: print_CTRL ( n -- ) \ print CTRL values upto GPIO n
0 CR DO
I GPIO_ctrl @
I . . CR
LOOP
;
: one_sec ( -- ) \ one sec ( -- )ond delay
1000 ms
;
: half_sec ( -- ) \ half sec ( -- )ond delay
500 ms
;
: qtr_sec ( -- ) \ quarter sec ( -- )ond delay
250 ms
;
: tenth_sec ( -- ) \ tenth sec ( -- )ond delay
100 ms
;
: GPIO_F5 ( GPIO -- ) \ ensure GPIO is in F5
dup GPIO_ctrl
@ %11111 and
5 = if drop else ." Not F5! " 5 swap GPIO_ctrl ! then
;
: GPIO_OUT ( GPIO -- ) \ set GPIO to output
1 swap lshift GPIO_OE !
;
: tog_GPIO ( GPIO -- )
1 swap lshift GPIO_OUT_XOR !
;
: set_GPIO ( GPIO -- )
1 swap lshift GPIO_OUT_SET !
;
: clr_GPIO ( GPIO -- )
1 swap lshift GPIO_OUT_CLR !
;
: blink_GPIO ( GPIO -- )
dup GPIO_F5
dup GPIO_OUT
begin
dup tog_GPIO
tenth_sec ( -- )
key? until drop
;
padsize buffer: pad
: print_pad
padsize 0 do
pad I + c@ hex .
loop
;
: erase_pad
padsize 0 do
0 pad I + c!
loop
;
\ Test_GPIO Messages
: enter_GPIO ." Enter GPIO to test or q to quit: (#2-29) " ;
: print_GPIO ." GPIO under test is: " ;
: enter_Tests ." Enter Test to run: (0-3) " ;
: print_Tests ." Tests: 0=> new GPIO 1=> High 2=> Low 3=> Blink once " ;
: print_exit ." Exit " ;
: error_GPIO ." Error: Check GPIO range: " ;
: error_input ." Error: Check input value: " ;
: error_value_low ." Error: Value too low: " ;
: error_value_high ." Error: Value too high: " ;
: error_number ." Error: Not a number: ";
\ test_gpio words
\ state variables
false variable exit_state
: clr_exit false exit_state ! ;
: set_exit true exit_state ! ;
: exit_state? exit_state @ ;
: prt_exit ." Exit_state is " exit_state @ . ;
false variable test0_state
: clr_test0 false test0_state ! ;
: set_test0 true test0_state ! ;
: test0_state? test0_state @ ;
: prt_test ." Test_state is " test0_state @ . ;
false variable GPIO_state
: clr_gpio_st false GPIO_state ! ;
: set_gpio_st true GPIO_state ! ;
: GPIO_state? GPIO_state @ ;
: prt_GPIO ." GPIO_state is " GPIO_state @ . ;
false variable err_state
: clr_err false err_state ! ;
: set_err true err_state ! ;
: err_state? err_state @ ;
: prt_err ." Err_state is " err_state @ . ;
13 variable gpio
: quit? ( c -- c T | c F ) \ test if char is q to quit
dup [char] q =
;
: one_digit ( n -- d T | c F ) \ on a single digit, test if a decimal char
decimal
digit
if true
else pad c@ false
then
;
: two_digits ( addr -- dd T | c F ) \ on two digits, test if a decimal
decimal c@ digit
if 10 * pad 1 + c@ digit
if + true
else drop pad 1 + c@ false
then
else pad c@ false
then
;
: get_2chr ( -- n ) \ get upto 2 char into buffer, pad
pad 2 accept ;
: chrtodd ( -- d|dd T | c F) \ get one or two char and make them decimals
get_2chr 1 - 0= if pad c@ one_digit else pad two_digits then
;
: minGPIO?
dup minGPIO <
;
: maxGPIO?
dup maxGPIO >
;
: in_range?
minGPIO?
if false
else
maxGPIO?
if false
else true
then
then
;
: quit_test drop set_exit cr print_exit ;
: get_1 ( -- n ) pad 1 accept ;
: test_1 ( GPIO -- )
clr_gpio_st dup GPIO_F5
dup GPIO_OUT
set_GPIO
clr_gpio_st
;
: test_2 ( GPIO -- )
clr_gpio_st dup GPIO_F5
dup GPIO_OUT
clr_GPIO
clr_gpio_st
;
: test_3 ( GPIO -- )
clr_gpio_st dup GPIO_F5
dup GPIO_OUT
dup tog_GPIO
tenth_sec
tog_GPIO
qtr_sec
clr_gpio_st
;
: tests
clr_gpio_st case
0 of cr set_test0 endof
1 of gpio @ test_1 clr_test0 clr_gpio_st endof
2 of gpio @ test_2 clr_test0 clr_gpio_st endof
3 of gpio @ test_3 clr_test0 clr_gpio_st endof
dup error_input . clr_test0
endcase
clr_gpio_st
;
: minTest?
dup 0 <
;
: maxTest?
dup 3 >
;
: valid_range?
minTest?
if error_value_low . false
else
maxTest?
if error_value_high . false
else true
then
then
;
: ctotest ( -- )
get_1 drop pad c@ digit
if valid_range?
else quit?
if set_test0 quit_test
else drop true
then
then
;
: get_test
decimal
begin
cr enter_Tests ctotest
if tests
else drop true
then
test0_state?
until
;
: init_test
erase_pad clr_err clr_gpio_st clr_exit clr_test0
cr enter_GPIO
;
: run_tests
begin
get_test true
until
;
: test_gpio
cr ." Interactive GPIO test, GPIO range is " minGPIO . ." - " maxGPIO . cr
begin
print_Tests
begin
init_test
chrtodd
if in_range?
if cr dup gpio ! print_GPIO . set_test0 set_gpio_st
else set_err error_GPIO .
then
else quit?
if set_gpio_st quit_test
else set_err error_input .
then
then
GPIO_state?
until
test0_state?
if run_tests
then
exit_state?
until
;
: endofDict0 ;
0 save#
compiletoram
Comments powered by Talkyard.