Mecrisp-Stellaris Forth: Dictionary 0
Where I keep my dictionary 0 with all of the basic Forth definitions.
Introduction
It helps to have the complete dictionary for Mecrisp-Stellaris Forth, this is dictionary 0 which has my most basic definitions. I load this before I start doing any work in Forth on the 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
;
: freememory ( -- )
compiletoflash unused ." FLASH: " .
compiletoram unused ." RAM: " .
;
\ xterm colors 256!
\ https://github.com/sindresorhus/xterm-colors
: esc 27 emit ;
: black ( -- cursor colour ) esc ." [38;5;0m" ;
: red ( -- cursor colour ) esc ." [38;5;9m" ;
: green ( -- cursor colour ) esc ." [38;5;2m" ;
: purple ( -- cursor colour ) esc ." [38;5;93m" ;
: blue ( -- cursor colour ) esc ." [38;5;12m" ;
: magenta ( -- cursor colour ) esc ." [38;5;127m" ;
: cyan ( -- cursor colour ) esc ." [38;5;51m" ;
: white ( -- cursor colour ) esc ." [38;5;15m" ;
: grey ( -- cursor colour ) esc ." [38;5;8m" ;
: fuchsia ( -- cursor colour ) esc ." [38;5;13m" ;
: green3 ( -- cursor colour ) esc ." [38;5;34m" ;
: lime ( -- cursor colour ) esc ." [38;5;10m" ;
: navy ( -- cursor colour ) esc ." [38;5;4m" ;
: darkorange ( -- cursor colour ) esc ." [38;5;208m" ;
: grey62 ( -- cursor colour ) esc ." [38;5;247m" ;
: grey82 ( -- cursor colour ) esc ." [38;5;252m" ;
: test_black black ." BLACK black " black ;
: test_red red ." RED red " black ;
: test_green green ." GREEN green " black ;
: test_purple purple ." PURPLE purple " black ;
: test_blue blue ." BLUE blue " black ;
: test_magenta magenta ." MAGENTA magenta " black ;
: test_cyan cyan ." CYAN cyan" black ;
: test_white white ." WHITE white " black ;
: test_grey grey ." GREY grey " black ;
: test_fuchsia fuchsia ." FUCHSIA fuchsia " black ;
: test_green3 green3 ." GREEN3 green3 " black ;
: test_lime lime ." LIME lime " black ;
: test_navy navy ." NAVY navy " black ;
: test_darkorange darkorange ." DARKORANGE darkorange " black ;
: test_grey62 grey62 ." GREY62 grey62 " black ;
: test_grey82 grey82 ." GREY82 grey82 " black ;
: colors
cr test_black cr test_grey cr test_grey62 cr test_grey82
cr test_white cr test_red cr test_darkorange cr test_lime
cr test_green3 cr test_green cr test_cyan cr test_blue
cr test_navy cr test_magenta cr test_fuchsia cr test_purple
cr
;
: bp blue cr . .s cr black ;
$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 of all GPIO pins
: .CTRL ( -- ) \ print CTRL values of all GPIO pins
30 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, uses atomic set
1 swap lshift GPIO_OE_SET !
;
: tog_GPIO ( GPIO -- )
1 swap lshift GPIO_OUT_XOR !
;
: high_GPIO ( GPIO -- )
1 swap lshift GPIO_OUT_SET !
;
: low_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
;
: ms_blink_GPIO ( n GPIO -- ) \ blink GPIO every n milliseconds, until key
dup GPIO_F5
dup GPIO_OUT
begin
dup tog_GPIO
swap dup ms swap
key? until drop drop
;
: us_blink_GPIO ( n GPIO -- ) \ blink GPIO every n microseconds, infinite
dup GPIO_F5
dup GPIO_OUT
begin
dup tog_GPIO
swap dup us swap
again drop drop
;
padsize buffer: pad
: .pad
padsize 0 do
pad I + c@ hex .
loop
;
: erase_pad
padsize 0 do
0 pad I + c!
loop
;
: endofDict0 ;
0 save#
compiletoram
Comments powered by Talkyard.