demo1.fs

\ : 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

demo2.fs

\ 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 ;

demo3.fs

\ 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