Skip to content

Instantly share code, notes, and snippets.

@Crest

Crest/demo1.fs Secret

Created May 8, 2021
Embed
What would you like to do?
\ : begin a new word definition (Forth functions are called words)
\ ." text" prints a string
\ ; finish the current word
: hello ( -- ) ." Hello Update!" cr ;
\ Call the new word
hello
\ Forth is a concatenative stack based language just like old HP calculators.
\ There is little to no formal syntax: just a stream of tokens
2 3 * 4 - cr .
2 3 * -4 + cr .
-4 2 3 * + cr .
\ If a token doesn't match a known word it's parsed as a literal
#10 . \ decimal
$2a . \ hex
%10111 . \ binary
5 . \ current BASE
hex \ Set base to 16
\ Control flow words are only available inside a compiled word
: digits ( -- ) base @ 0 ?do i . loop cr ;
digits
decimal \ Back to base 10
\ Calculate the factorial of a small natural number
\ stack comment: ( inputs ... -- outpus ... )
\ $b $a DO LOOP is a counted loop
: fac ( n -- n! )
\ multiply 1 with all i in [1,n+1)
1 swap 1+ 1 ( 1 n+1 1 ) \ stack comment
DO ( n! )
i * ( n! )
LOOP 1-foldable ; \ mark the word as foldable
1 fac .
2 fac .
3 fac .
4 fac .
5 fac .
: foo ( -- x ) 10 fac 3 + ;
\ The compiler rewards our annotation with better code
see foo
\ Thinking Forth (PDF)
token https://thinking-forth.sourceforge.net/ type cr
\ The 8 LEDs are hooked up to PORT A pin 0 through 7
port-a 0 +pin +high +gpio +open-drain +50MHz constant diode0
port-a 1 +pin +high +gpio +open-drain +50MHz constant diode1
port-a 2 +pin +high +gpio +open-drain +50MHz constant diode2
port-a 3 +pin +high +gpio +open-drain +50MHz constant diode3
port-a 4 +pin +high +gpio +open-drain +50MHz constant diode4
port-a 5 +pin +high +gpio +open-drain +50MHz constant diode5
port-a 6 +pin +high +gpio +open-drain +50MHz constant diode6
port-a 7 +pin +high +gpio +open-drain +50MHz constant diode7
\ Initialize all eight GPIO pins
: diode-init ( -- )
diode0 pin-init
diode1 pin-init
diode2 pin-init
diode3 pin-init
diode4 pin-init
diode5 pin-init
diode6 pin-init
diode7 pin-init ;
diode-init
\ The LEDs are inverted by the open drain configuration
\ (LED and series resistor between 3.3V and the PIN)
: on ( diode -- ) low ;
: off ( diode -- ) high ;
\ Write to all eight LEDs
: diodes! ( byte -- ) not $ff port-a port! ;
\ The Forth kernel calls the latest word named "init" on boot
: init ( -- )
init \ Call the previous definition of init
diode-init ;
\ Same configuration for the LEDs
port-a 0 +pin +high +gpio +open-drain +50MHz constant diode0
port-a 1 +pin +high +gpio +open-drain +50MHz constant diode1
port-a 2 +pin +high +gpio +open-drain +50MHz constant diode2
port-a 3 +pin +high +gpio +open-drain +50MHz constant diode3
port-a 4 +pin +high +gpio +open-drain +50MHz constant diode4
port-a 5 +pin +high +gpio +open-drain +50MHz constant diode5
port-a 6 +pin +high +gpio +open-drain +50MHz constant diode6
port-a 7 +pin +high +gpio +open-drain +50MHz constant diode7
\ Each button has a pin and a histogram
false port-b 0 +pin +high +gpio +pull-down 2variable switch0
false port-b 1 +pin +high +gpio +pull-down 2variable switch1
false port-b 10 +pin +high +gpio +pull-down 2variable switch2
false port-b 11 +pin +high +gpio +pull-down 2variable switch3
: diode-init ( -- )
diode0 pin-init
diode1 pin-init
diode2 pin-init
diode3 pin-init
diode4 pin-init
diode5 pin-init
diode6 pin-init
diode7 pin-init ;
diode-init
: on ( diode -- ) low ;
: off ( diode -- ) high ;
: diodes! ( byte -- ) not $ff port-a port! ;
: switch-init ( -- )
switch0 @ pin-init
switch1 @ pin-init
switch2 @ pin-init
switch3 @ pin-init ;
switch-init
: init ( -- ) init diode-init switch-init ;
\ The buttons are inverted too
: pressed? ( switch -- ? )
@ pin? not ;
\ Okay i admit this word is a bit ugly
\ Each switch is represented by two 32 bit cells.
\ One containing the GPIO pin and its configuration
\ and the other containing its debounced level in the MSB and a
\ history of the last 31 observations in ther remaining bits.
\ Shift out the oldest observation and shift in the latest sample
: shift-in ( sample switch -- )
cell+ tuck @ ( &state sample state )
dup 31 rshift 31 lshift swap ( &state sample pressed state )
2 lshift 1 rshift or ( &state sample state )
swap 1 and or ( &state state )
swap ! ;
\ Are the last 31 observations identical and different from the last debounced level?
: edge? ( switch -- ? )
cell+ @ ( state )
dup 31 arshift swap ( level state )
1 lshift 1 arshift ( level history )
tuck <> swap ( different history )
dup 0= swap 1+ 0= or ( different all-same )
and ;
\ Update the debounced level
: change-level ( switch -- )
cell+ dup @ ( &state state )
1 lshift 1 arshift ( &state state )
swap ! ;
\ Read the debounved level
: level@ ( switch -- level? )
cell+ @ 31 arshift ;
\ Debounce the switch
: debounce ( switch -- level? edge? )
dup pressed? ( switch sample )
over shift-in ( switch )
dup edge? if
dup change-level
level@ true
else
level@ false
then ;
\ What should happen
' led-on variable switch0-down
' nop variable switch0-up
-1 variable switch0-sv
' led-off variable switch1-down
' nop variable switch1-up
-1 variable switch1-sv
\ This callback has to be called periodically
: switch-service ( up down switch -- )
debounce if
if nip else drop then @ execute
else
drop 2drop
then ;
\ The periodic callbacks are executed on the same stack.
\ This implies that they must have no stack effect.
: switch0-service ( -- ) switch0-up switch0-down switch0 switch-service ;
: switch1-service ( -- ) switch1-up switch1-down switch1 switch-service ;
\ Register the callbacks
: debounce-init ( -- )
false blink!
true ['] switch0-service pendsv-register drop dup switch0-sv ! per-tick!
true ['] switch1-service pendsv-register drop dup switch1-sv ! per-tick! ;
: init ( -- ) init debounce-init ;
debounce-init
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment