
;------------------------------------------------------------------------------
;  Mecrisp-Ice - A conveniently enhanced fork of Swapforth by James Bowman
;------------------------------------------------------------------------------

Mecrisp-Ice Forth running on a stack processor in the FPGA of the MCH2022 badge
for quick experiments with your creative ideas on the Pmod connector.

Load the bitstream and connect terminal with 115200 baud 8N1 LF to ttyACM1

Matthias Koch, mecrisp.sourceforge.net

;------------------------------------------------------------------------------
; What makes this Forth special
;------------------------------------------------------------------------------

This 16 bit Forth runs on a custom stack processor designed for Forth,
generates native code, and handles optimisations like constant-folding
and tail-call.

It features interrupts, with a fixed latency of 2 clock cycles for
realtime challenges.

UTF-8 Unicode support baked in!
You can develop in any human language you like.

Once upon a time, it started as a fork of Swapforth and the J1 CPU
by James Bowman: https://github.com/jamesbowman/swapforth/

;------------------------------------------------------------------------------
; New to Forth?
;------------------------------------------------------------------------------

Typing WORDS gives a list of all available commands.

A very short primer to get an idea:

https://jeelabs.org/article/1612b/

And the classic introduction to Forth:

https://www.forth.com/starting-forth/

;------------------------------------------------------------------------------
; Notes for standard Forth wizards coming from ANS
;------------------------------------------------------------------------------

Mecrisp-Ice is using initialised variables like FIG-Forth, so instead of

  variable answer  42 answer !

write

          42  variable answer
  $1234.5678 2variable longresult

Number input works different internally, but supports
all the standard number formats (and a bit more).

The most notable extension are s15.16 fixpoint numbers like 3,14159 written
with a comma instead of a dot.

Dictionary structure is a special snowflake with additional flags
for constant folding.

This implementation is case-insensitive, but only for letters 'a' to 'z'.
UTF-8 Unicode encoded characters beyond 7 bit ASCII are case-sensitive.

Before quickly uploading source code, switch off the terminal LCD echo
and pin state display using

  dint -lcd

;------------------------------------------------------------------------------
; Memory map and IO registers
;------------------------------------------------------------------------------

This Forth has separate address spaces for main memory and IO area.

$0000 to $2FFF: 12 kb executable main memory, accessible with @ ! c@ c!

Two special locations are located in main memory:

$0000 is the reset vector
        (and typically holds a jump opcode)
$0002 is the interrupt vector
        (and either holds return opcode $608C or a jump to the interrupt handler)

All opcodes execute in one clock cycle, except @ because the BRAMs
in iCE40 FPGAs offer one read port only. The trick for reading main memory
is a call to a high address with $4000 bit set; logic in the processor
then pushes the "opcode" fetched onto the data stack and returns.


The IO area has word-only access with io@ and io!

Available registers:

  $0100: RO  Pmod IN

  $0200: RW  Pmod OUT
  $0201: WO  Pmod OUT Clear  bits, atomic
  $0202: WO  Pmod OUT Set    bits, atomic
  $0203: WO  Pmod OUT Toggle bits, atomic

  $0400: RW  Pmod DIR
  $0401: WO  Pmod DIR Clear  bits, atomic
  $0402: WO  Pmod DIR Set    bits, atomic
  $0403: WO  Pmod DIR Toggle bits, atomic

  $0800: RW  Address for 128 kb SPRAM, word addressed
  $0810: RW  Read and write to SRAM location, 16 bits wide

  $0820: RW  Address for access of character buffer and font data, byte addressed
  $0830: RW  Read and write 1024 bytes font data, 128 characters, 8 bytes per character
  $0840: RW  Read and write 1536 bytes character buffer, 40x30=1200 chars on LCD

  $0850: RW  Normal    color foreground, RGB 5:6:5
  $0860: RW  Normal    color background, RGB 5:6:5
  $0870: RW  Highlight color foreground, RGB 5:6:5
  $0880: RW  Highlight color background, RGB 5:6:5

  $0890: RW  LCD control and sync lines
  $08A0: WO  LCD data and command

  $08B0: RW  LEDs: [6] Blue in [5] Green in [4] Red in   [3] 0 [2] Blue [1] Green [0] Red
  $08C0: RW  Sigma-delta modulator brightness for red   channel
  $08D0: RW  Sigma-delta modulator brightness for green channel
  $08E0: RW  Sigma-delta modulator brightness for blue  channel

  $08F0: RO  Button states

  $1000: RW  Serial terminal. Write: Send character. Read: Received character.
  $2000: RO  Flags. [2] Random [1] Valid [0] Ready
  $4000: RW  Read: Ticks counter. Write: Set ticks. Generates interrupt on overflow.
  $8000: RO  Free running cycle counter for delays

The serial terminal flags contain a ring oscillator used for random numbers,
but wait (a few) 100 clock cycles before capturing the next random bit because
one gets correlations between the bits when reading too fast.
Just give the ring oscillator a little bit of time to drift away.

"random" does exactly that. Try "random .x" for an example.

Button state bits are:

    0 - joystick down
    1 - joystick up
    2 - joystick left
    3 - joystick right
    4 - joystick press
    5 - home
    6 - menu
    7 - select
    8 - start
    9 - accept
   10 - back

For accessing the SPRAM, you have to io! the address into $0800 first before reading
or writing $0810. Note that the memory is word-addressed, so for example
accessing $CAF1 is *not* the high byte of $CAF0 but a separate word-location.
This way, the full 128 kb of available SPRAM can be used despite this being a 16 bit
implementation only.

The font contains 128 glyphs, taken from the Commodore 64 and rearranged
for 7 bit ASCII. The MSB ($80) selects a "highlight" pair of
foreground/background colors. The font and character spaces are byte-addressed.

For convenience, sram@ sram! font@ font! char@ char! are defined.

There is also a disassembler, to be used with SEE <name>

see char!
1BCA : 8820   Imm  0820       0820
1BCC : 7842   Alu             io!
1BCE : 8840   Imm  0840       0840
1BD0 : 78CE   Alu             io! exit
 ok.

If you want to disassemble any location in main memory, use

$0000 disasm-$ ! seec

The disassembler tries to detect the end of definitions by watching out
for opcodes with the return bit set, but continues when it encounters
a jump around that before, for an example, "see dup?"

Try a game of snake which source code combines a lot of the features:

https://github.com/badgeteam/mch2022-firmware-ice40/blob/master/projects/Forth/fw/mch2022/snake.fs

;------------------------------------------------------------------------------
; Build instructions
;------------------------------------------------------------------------------

Due to dependencies, the Makefile only re-synthesises the bitstream,
not the firmware which is contained in the BRAM initialisation.

For a complete build of the whole project, you need Gforth and Freepascal
(packages gforth and fpc on Debian) installed.

Gforth compiles the assembler and the Forth core, which is run in an emulator
for the stack processor written in Pascal to compile additional Forth sources.
At the end, a memory dump is written by the "icecreammachine" emulator.

Change directory to Forth/fw/mch2022/ and start the "compilenucleus" script
which creates a fresh memory image and copies the result to Forth/rtl folder.

For running a definition directly after boot, store its address into the
"init" variable.    ' pmod-lab init !

;------------------------------------------------------------------------------
; IO and PMOD laboratory
;------------------------------------------------------------------------------

Registers and lowlevel IO:

        in              ( -- io-addr )  PMOD in register

        out             ( -- io-addr )  PMOD out register
        out-clr         ( -- io-addr )    Write to  clear bits
        out-set         ( -- io-addr )    Write to    set bits
        out-xor         ( -- io-addr )    Write to toggle bits

        dir             ( -- io-addr )  PMOD direction register. 0: Input, 1: Output
        dir-clr         ( -- io-addr )     Write to  clear bits
        dir-set         ( -- io-addr )     Write to    set bits
        dir-xor         ( -- io-addr )     Write to toggle bits

        leds-special    ( -- io-addr )  Direct LED access. [6:4]: In [2:0]: Constant current drivers
        pwm-red         ( -- io-addr )  16 bit dimmer on red
        pwm-green       ( -- io-addr )  16 bit dimmer on green
        pwm-blue        ( -- io-addr )  16 bit dimmer on blue

        buttons         ( -- x ) Read current button state

Shortcuts for manual experimentation, u between 0 and 7:

        h               ( u -- ) Set pin high
        l               ( u -- ) Set pin low
        t               ( u -- ) Toggle pin
        z               ( u -- ) Set pin as input

Fun with colors:

        rgb             ( r g b -- ) Set dimmers for RGB LED with RGB value
        color           ( x -- ) Use LCD 5:6:5 color constant on RGB LED

Artwork and user interface:

        time            ( -- ud ) Read 32 bit millisecond counter
        blink           ( -- ) Blink LEDs inserted into PMOD connector
        printrandom     ( -- ) A little artwort
        pmod-lab        ( -- ) This is the turnkey definition, initialising everything

For internal usage:

        (ms)            ( -- a-addr ) Double variable for milliseconds elapsed, updated in interrupt
        interrupt       ( -- ) Updates (ms) and the pinstate display
        avgshift        ( -- u ) Shift width constant for smoothing filter
        expavg          ( avg x -- avg' ) Exponential moving average
        pinstate        ( -- ) Update pin state display prepared by pmod-lab
     green-sunshine     ( -- a-addr ) Variable for counting current brightness
     average-sunshine   ( -- a-addr ) Variable for smoothing average brightness
     sunshine-indicator ( u -- ) Show bar with values from 0 to 16

;------------------------------------------------------------------------------
; Textmode on 320x240 LCD
;------------------------------------------------------------------------------

        lcd-init        ( -- ) Initialise LCD
        waitretrace     ( -- ) Wait for end of current update activity

        char!           ( x addr -- ) Character memory store, 0 to 1199. 7-Bit ASCII, MSB selects color pair.
        char@           ( addr -- x ) Read from character memory

        font!           ( x addr -- ) Font memory store, 0 to 1023. 8 bytes per glyph, 128 glyphs.
        font@           ( addr -- x ) Read from font memory, 0 to 1023

        fg0             ( -- io-addr ) Normal    foreground color register
        bg0             ( -- io-addr ) Normal    background color register
        fg1             ( -- io-addr ) Highlight foreground color register
        bg1             ( -- io-addr ) Highlight background color register

        BLACK      MAROON     DARKGREY  RED      ORANGE
        NAVY       PURPLE     BLUE      MAGENTA  GREENYELLOW
        DARKGREEN  OLIVE      GREEN     YELLOW   PINK
        DARKCYAN   LIGHTGREY  CYAN      WHITE

                        ( -- x ) Color constants, 16 bit RGB 5:6:5 format

Default colors are:

    yellow fg0 io!  \ Normal foreground
    navy   bg0 io!  \ Normal background
    cyan   fg1 io!  \ Highlight foreground
    navy   bg1 io!  \ Highlight background

For internal usage:

        lcd-ctrl        ( -- io-addr ) LCD control lines
        lcd-data        ( -- io-addr ) LCD data, writeonly. Set $100 for commands.
        cmd>lcd         ( c -- )       Write command byte to LCD
           >lcd         ( c -- )       Write data byte to LCD

;------------------------------------------------------------------------------
; Character handling for text mode
;------------------------------------------------------------------------------

        highlight       ( -- ) Following text shall be highlighted
        normal          ( -- ) Following text shall be normal color

        caption         ( -- ) Fix caption lines when scrolling
        nocaption       ( -- ) Remove caption protection

        page            ( -- ) Clear display (but leave caption)
        clr             ( -- ) Same as page, just an alias

        +lcd            ( -- ) Terminal output both on LCD and serial
        -lcd            ( -- ) Serial terminal only

For internal usage:

        xpos            ( -- a-addr ) Variable for cursor x position
        ypos            ( -- a-addr ) Variable for cursor y position
        textmarker      ( -- a-addr ) Variable for text highlighting
        captionchars    ( -- a-addr ) Variable for amount of fixed characters

        addline         ( -- ) Scroll up display contents by one line
        addchar         ( c -- ) Add one character and advance cursor position
        stepback        ( -- ) Go back to last cursor position
        lcd-emit        ( c -- ) Add one character, handling line feed, backspace and UTF-8

        dispatch-emit   ( c -- ) Fork output both for LCD and serial terminal


;------------------------------------------------------------------------------
; Miscellaneous
;------------------------------------------------------------------------------

        cycles          ( -- u ) Read continuous cycle counter
        delay-cycles    ( u -- ) Delay given number of cycles

        sram@           ( addr -- x ) Read  128 kb word addressed data memory
        sram!           ( x addr -- ) Write 128 kb word addressed data memory

        esc?            ( -- Flag ) Check whether Escape was pressed


;------------------------------------------------------------------------------
Here comes a word list,                                          -- Glossary --
  with short descriptions of all currently included words:
View it with fixed-width font !
;------------------------------------------------------------------------------

;------------------------------------------------------------------------------
; Terminal-IO
;------------------------------------------------------------------------------

        emit?           ( -- Flag ) Ready to send a character ?
        key?            ( -- Flag ) Checks if a key is waiting
        key             ( -- Char ) Waits for and fetches the pressed key
        emit            ( Char -- ) Emits a character.

;------------------------------------------------------------------------------
; Stack Jugglers
;------------------------------------------------------------------------------

Single-Jugglers:

        depth           ( -- +n ) Gives number of single-cell stack items.
        rdepth          ( -- +n ) HX8K only: Number of items on return stack.
        nip             ( x1 x2 -- x2 )
        drop            ( x -- )
        rot             ( x1 x2 x3 -- x2 x3 x1 )
        -rot            ( x1 x2 x3 -- x3 x1 x2 )
        swap            ( x1 x2 -- x2 x1 )
        tuck            ( x1 x2 -- x2 x1 x2 )
        over            ( x1 x2 -- x1 x2 x1 )
        ?dup            ( x -- 0 | x x )
        dup             ( x -- x x )

        >r              ( x -- ) (R: -- x )
        r>              ( -- x ) (R: x -- )
        r@              ( -- x ) (R: x -- x )
        rdrop           (  --  ) (R: x -- )

Double-Jugglers:        They perform the same for double numbers.

        2drop           ( x1 x2 -- )
        2swap           ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
        2over           ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
        2dup            ( x1 x2 -- x1 x2 x1 x2 )

;------------------------------------------------------------------------------
; Logic
;------------------------------------------------------------------------------

        arshift         ( x1 u -- x2 ) Arithmetric right-shift of u bit-places
        rshift          ( x1 u -- x2 ) Logical right-shift of u bit-places
        lshift          ( x1 u -- x2 ) Logical  left-shift of u bit-places
        invert          ( x1 -- x2 )   Invert all bits
        not             ( x1 -- x2 )   Invert all bits = Bitwise not
        xor             ( x1 x2 -- x3 ) Bitwise Exclusive-OR
        or              ( x1 x2 -- x3 ) Bitwise OR
        and             ( x1 x2 -- x3 ) Bitwise AND
        false           ( --  0 ) False-Flag
        true            ( -- -1 ) True-Flag

;------------------------------------------------------------------------------
; Arithmetic for single numbers
;------------------------------------------------------------------------------

        /mod            ( n1 n2 -- n3 n4 ) n1 / n2 = n4 rem n3
        mod             ( n1 n2 -- n3 ) n1 / n2 = remainder n3
        /               ( n1 n2 -- n3 ) n1 / n2 = n3
        *               ( u1|n1 u2|n2 -- u3|n3 ) 16*16 = 16 Multiplication
        min             ( n1 n2 -- n1|n2 ) Keeps smaller of top two items
        max             ( n1 n2 -- n1|n2 ) Keeps greater of top two items
        umin            ( u1 u2 -- u1|u2 ) Keeps unsigned smaller
        umax            ( u1 u2 -- u1|u2 ) Keeps unsigned greater
        1-              ( u1|n1 -- u2|n2 ) Subtracts one, optimized
        1+              ( u1|n1 -- u2|n2 ) Adds one, optimized

        2*              ( n1 -- n2 ) Arithmetric  left-shift
        2/              ( n1 -- n2 ) Arithmetric right-shift
        abs             ( n -- u ) Absolute value
        negate          ( n1 -- n2 ) Negate
        sgn             ( u1 n1 -- n2 ) Give u1 the sign of n2
        -               ( u1|n1 u2|n2 -- u3|n3 ) Subtraction
        +               ( u1|n1 u2|n2 -- u3|n3 ) Addition

;------------------------------------------------------------------------------
; Arithmetic involving double numbers
;------------------------------------------------------------------------------

        um*             ( u1 u2 -- ud )    16*16 = 32 Multiplication

        um/mod          ( ud u1 -- u2 u3 ) ud / u1 = u3 remainder u2

        m+              ( d1 n -- d2 ) Addition of a double with a single
        m*              ( n1 n2 -- d )     n1 * n2 = d
        fm/mod          ( d n1 -- n2 n3 )  d / n1 = n3 remainder r2 floored
        sm/rem          ( d n1 -- n2 n3 )  d / n1 = n3 remainder r2 symmetric

        */              ( n1 n2 n3 -- n4 )     n1 * n2 / n3 = n4
        */mod           ( n1 n2 n3 -- n4 n5 )  n1 * n2 / n3 = n5 remainder n4

        d2*             ( d1 -- d2 ) Arithmetric  left-shift

        dabs            ( d -- ud ) Absolute value
        dnegate         ( d1 -- d2 ) Negate
        d-              ( ud1|d1 ud2|d2 -- ud3|d3 ) Subtraction
        d+              ( ud1|d1 ud2|d2 -- ud3|d3 ) Addition
        s>d             ( n -- d ) Makes a signed single number double length

;------------------------------------------------------------------------------
; Comparisons
;------------------------------------------------------------------------------

        u<=             ( u1 u2 -- flag )   Unsigned comparisons
        u>=             ( u1 u2 -- flag )
        u>              ( u1 u2 -- flag )
        u<              ( u1 u2 -- flag )
        <=              ( n1 n2 -- flag )   Signed comparisons
        >=              ( n1 n2 -- flag )
        >               ( n1 n2 -- flag )
        <               ( n1 n2 -- flag )
        0>              ( n -- flag )       Positive ?
        0<              ( n -- flag )       Negative ?
        0<>             ( x -- flag )
        0=              ( x -- flag )
        <>              ( x1 x2 -- flag )
        =               ( x1 x2 -- flag )

        d0=             ( d -- flag )

        within          ( x1 x2 x3 -- ? )   Check if x1 is within x2 and x3.

;------------------------------------------------------------------------------
; Extension for double and s15.16 fixpoint numbers
;------------------------------------------------------------------------------

        2constant name  ( ud|d -- ) Makes a double constant.
        2variable name  ( ud|d -- ) Makes an initialized double variable

        du<=            ( ud1 ud2 -- flag )   Unsigned double comparisons
        du>=            ( ud1 ud2 -- flag )
        du>             ( ud1 ud2 -- flag )
        du<             ( ud1 ud2 -- flag )

        d<=             ( d1 d2 -- flag )     Signed double comparisons
        d>=             ( d1 d2 -- flag )
        d>              ( d1 d2 -- flag )
        d<              ( d1 d2 -- flag )

        d0<             ( d -- flag )         Negative ?
        d<>             ( xd1 xd2 -- flag )
        d=              ( xd1 xd2 -- flag )

        dmax            ( d1 d2 -- d1|d2 ) Keeps smaller of top two items
        dmin            ( d1 d2 -- d1|d2 ) Keeps greater of top two items

        2rot            ( xd1 xd2 xd3 -- xd2 xd3 xd1 )
        2nip            ( xd1 xd2 -- xd2 )

        2xor            ( xd1 xd2 -- xd3 ) Bitwise Exclusive-OR
        2or             ( xd1 xd2 -- xd3 ) Bitwise OR
        2and            ( xd1 xd2 -- xd3 ) Bitwise AND

        d2/             ( d1 -- d2 )   Arithmetric right-shift
        dshr            ( xd1 -- xd2 ) Logic right-shift

        2arshift        ( xd1 u -- xd2 ) Arithmetric right-shift of u bit-places
        2rshift         ( xd1 u -- xd2 ) Logical right-shift of u bit-places
        2lshift         ( xd1 u -- xd2 ) Logical  left-shift of u bit-places

        ud/mod          ( ud1 ud2 -- ud3 ud4 ) 32/32 = 32 rem 32 Division
                                               ud1 / ud2 = ud4 remainder ud3

Fixpoint numbers are stored ( n-comma n-whole ) and can be handled
like signed double numbers.

        s>f             ( n -- df ) Single integer to s15.16 fixpoint

        f/              ( df1 df2 -- df3 ) Division of two fixpoint numbers
        f*              ( df1 df2 -- df3 ) Multiplication

        hold<           ( char -- )
                        Adds character to pictured number output buffer
                        from behind.
        f#              ( n-comma1 -- n-comma2 )
                        Adds one comma-digit to number output
        f.              ( df -- )
                        Prints a fixpoint number with 16 fractional digits
        f.n             ( df n -- )
                        Prints a fixpoint number with n fractional digits

For internal usage:

        (ud/mod)        ( -- ) Common part of ud/mod and f/
        divisor         ( -- a-addr ) Double variable
        shift           ( -- a-addr ) Double variable
        dividend        ( -- a-addr ) Double variable

;------------------------------------------------------------------------------
; Tools for number input
;------------------------------------------------------------------------------

        number          ( c-addr len -- 0 )
                                     -- n 1 )
                                     -- n-low n-high 2 )
                        Tries to convert a string to a number.

;------------------------------------------------------------------------------
; Number base
;------------------------------------------------------------------------------

        binary          ( -- ) Sets base to 2
        decimal         ( -- ) Sets base to 10
        hex             ( -- ) Sets base to 16
        base            ( -- a-addr ) Base variable address

;------------------------------------------------------------------------------
; Memory access
;------------------------------------------------------------------------------

        cmove           ( c-addr1 c-addr2 u -- ) Moves backward
        cmove>          ( c-addr1 c-addr2 u -- ) Moves forward
        move            ( c-addr1 c-addr2 u -- ) Moves u Bytes in Memory
        fill            ( c-addr u c ) Fill u Bytes of Memory with value c

        constant  name  ( u|n -- )  Makes a single constant.
        variable  name  ( u|n -- )  Makes an initialized single variable

        2@              ( a-addr -- ud|d ) Fetches double number from memory
        2!              ( ud|d a-addr -- ) Stores double number in memory

        @               ( a-addr -- u|n ) Fetches single number from memory
        !               ( u|n a-addr -- ) Stores single number in memory
        +!              ( u|n a-addr -- ) Add to memory location

        c@              ( c-addr -- char ) Fetches byte from memory
        c!              ( char c-addr ) Stores byte in memory

IO memory area:

        io@             ( c-addr -- x ) Fetches from IO register
        io!             ( x c-addr -- ) Stores  into IO register

        xor!            ( mask c-addr -- ) Toggle bits
        bic!            ( mask c-addr -- ) Clear BIts
        bis!            ( mask c-addr -- ) Set BIts

;------------------------------------------------------------------------------
; Strings and beautiful output
;------------------------------------------------------------------------------

String routines:

        type            ( c-addr length -- )
                        Prints a string.

        rtype           ( c-addr length u -- )
                        Prints a string in a field u characters wide.

        s" Hello"       Compiles a string and
                        ( -- c-addr length )
                        gives back its address and length when executed.

        ." Hello"       Compiles a string and
                        ( -- )
                        prints it when executed.

        ( Comment )     Ignore Comment
        \ Comment       Comment to end of line

        cr              ( -- ) Emits line feed
        bl              ( -- 32 ) ASCII code for Space
        space           ( -- ) Emits space
        spaces          ( n -- ) Emits n spaces if n is positive

        accept          ( c-addr maxlength -- length ) Read input into a string.

Counted string routines:

        count           ( cstr-addr -- c-addr length )
                        Convert counted string into addr-length string

Pictured numerical output:

        [char] *        Compiles code of following char
                        ( -- char ) when executed

        char *          ( -- char ) gives code of following char
        hold            ( char -- ) Adds character to pictured number
                                    output buffer from the front.

        sign            ( n -- ) Add a minus sign to pictured number
                                 output buffer, if n is negative

        #S              ( ud1|d1 -- 0 0 ) Add all remaining digits
                        from the double length number to output buffer
        #               ( ud1|d1 -- ud2|d2 ) Add one digit from the
                        double length number to output buffer
        #>              ( ud|d -- c-addr len )
                        Drops double-length number and finishes
                        pictured numeric output ready for type
        <#              ( -- ) Prepare pictured number output buffer
        u.              ( u -- ) Print unsigned single number
        .               ( n -- ) Print single number
        ud.             ( ud -- ) Print unsigned double number
        d.              ( d -- ) Print double number

        u.r             ( u width -- ) Print      unsigned right aligned
         .r             ( n width -- ) Print        signed right aligned
        d.r             ( d width -- ) Print double signed right aligned

        buf0            ( -- a-addr ) Start of number output buffer
        buf             ( -- a-addr ) End   of number output buffer
        hld             ( -- a-addr ) Variable with current position

Deep insights:

        words           ( -- ) Prints list of defined words.
        .x2             ( c -- ) Prints  8 bit unsigned in hex base
        .x              ( u -- ) Prints 16 bit unsigned in hex base
                                 This is independent of number subsystem.

;------------------------------------------------------------------------------
; User input and its interpretation
;------------------------------------------------------------------------------

        tib             ( -- c-addr ) Input buffer
        pad             ( -- c-addr ) Location to hold temporary data

        refill          ( -- ? ) Refill input buffer, return true if successful
        source!         ( c-addr len -- ) Change source
        source          ( -- c-addr len ) Current source
        >in             ( -- addr ) Variable with current offset into source

        /string         ( c-addr1 u1 n -- c-addr2 u2 ) Cut n leading characters
        parse-name      ( -- c-addr len ) Get next token from input buffer
        parse           ( char -- c-addr len )
                        Cuts anything delimited by char out of input buffer

        evaluate        ( any addr len -- any ) Interpret given string
        quit            ( many -- ) (R: many -- ) Resets Stacks
        abort           ( many -- ) (R: many -- ) Print ? and quit

;------------------------------------------------------------------------------
; Dictionary expansion
;------------------------------------------------------------------------------

        align           ( -- ) Aligns dictionary pointer
        aligned         ( c-addr -- a-addr ) Advances to next aligned address
        cell+           ( x -- x+2 ) Add size of one cell
        cells           ( n -- 2*n ) Calculate size of n cells

        allot           ( n -- ) Tries to advance Dictionary Pointer by n bytes
        here            ( -- a-addr|c-addr )
                        Gives current position in Dictionary

        ,               ( u|n -- ) Appends a single number to dictionary
        c,              ( char -- ) Appends a byte to dictionary

        unused          ( -- u ) How many free space is still available ?

        cornerstone name    Create a permanent dictionary wayback point
        new                 Core wayback point.

;------------------------------------------------------------------------------
; Dictionary expansion  (more internal)
;------------------------------------------------------------------------------

        s,              ( c-addr len -- ) Inserts a string with a maximum
                                          of 255 characters without runtime
        sliteral        ( c-addr len -- ) Insert a string with runtime

        literal         ( u|n -- ) Compiles a literal

        compile,        ( a-addr -- ) Compiles a call to a subroutine

        forth           ( -- a-addr ) Variable with entry point for dictionary

        ahead           ( -- a-addr ) Prepare a forward jump

;------------------------------------------------------------------------------
; Flags and inventory
;------------------------------------------------------------------------------

        immediate       ( -- ) Makes current definition immediate.
        foldable        ( n -- ) Current word becomes foldable with n constants

        sfind           ( c-addr len -- c-addr len 0 | a-addr flags )
                               Searches for a string in Dictionary.

;------------------------------------------------------------------------------
; Compiler essentials
;------------------------------------------------------------------------------

        execute         ( a-addr -- ) Calls subroutine
        recurse         ( -- ) Lets the current definition call itself
        ' name          ( -- a-addr ) Tries to find name in dictionary
                                      gives back executable address
        ['] name        ( -- a-addr)  Tick that compiles the executable address
                                      of found word as literal
        postpone name   ( -- ) Helps compiling immediate words.
        does>           ( -- ) executes: ( -- a-addr )
                               Gives address to where you have stored data.
        create name     ( -- ) Create a definition with default action
        >body           ( a-addr -- a-addr ) Address of data field after create
        state           ( -- a-addr ) Address of state variable
        ]               ( -- ) Switch to compile state
        [               ( -- ) Switch to execute state
        ;               ( -- ) Finishes new definition
        : name          ( -- ) Opens new definition
        :noname         ( -- a-addr ) Opens new definition without name

;------------------------------------------------------------------------------
; Control structures
;------------------------------------------------------------------------------

Decisions:

flag if ... then
flag if ... else ... then

        then            ( -- )           This is the common
        else            ( -- )           flag if ... [else ...] then
        if              ( flag -- )      structure.

Case:

n case
     m1   of ... endof
     m2   .. ... .....
    all others
  endcase

        case            ( n -- n )       Begins case structure
        of              ( m -- )         Compares m with n, choose this if n=m
        endof           ( -- )           End of one possibility
        endcase         ( n -- )         Ends case structure, discards n

Indefinite Loops:

begin ... again
begin ... flag until
begin ... flag while ... repeat

        repeat          ( -- ) Finish of a middle-flag-checking loop.

        while           ( flag -- ) Check a flag in the middle of a loop

        until           ( flag -- ) begin ... flag until
                                    loops until flag is true
        again           ( -- )  begin ... again
                                is an endless loop
        begin           ( -- )


Definite Loops:

limit index   do ... [one or more leave(s)] ... loop
             ?do ... [one or more leave(s)] ... loop
              do ... [one or more leave(s)] ... n +loop
             ?do ... [one or more leave(s)] ... n +loop


        j               ( -- u|n ) Gives second loop index
        i               ( -- u|n ) Gives innermost loop index


        unloop          (R: old-limit old-index -- )
                        Drops innermost loop structure,
                        pops back old loop structures to loop registers

        exit            ( -- ) Returns from current definition.

        leave           ( -- ) (R: old-limit old-index -- )
                        Leaves current innermost loop promptly

        +loop           ( u|n -- )
                        (R: unchanged | old-limit old-index -- )
                        Adds number to current loop index register
                        and checks whether to continue or not

        loop            ( -- )
                        (R: unchanged | old-limit old-index -- )
                        Increments current loop index register by one
                        and checks whether to continue or not.

        ?do             ( Limit Index -- )
                        (R: unchanged | -- old-limit old-index )
                        Begins a loop if limit and index are not equal

        do              ( Limit Index -- )
                        (R: -- old-limit old-index )
                        Begins a loop

        bounds          ( addr len -- limit index )
                        Calculate values to loop over a string

;------------------------------------------------------------------------------
; Misc hardware
;------------------------------------------------------------------------------

        us              ( u -- ) Wait u microseconds
        ms              ( u -- ) Wait u milliseconds

        ticks           ( -- u ) Read current ticks
        nextirq         ( u -- ) Trigger next interrupt u cycles
                                 after the last one

        randombit       ( -- 0 | 1 ) Gives a random bit
        random          ( -- x ) Gives a random number

        eint?           ( -- ? ) Are interrupts enabled ?
        eint            ( -- ) Enable ticks counter overflow interrupt
        dint            ( -- ) Disable interrupt

;------------------------------------------------------------------------------
; Insight tools
;------------------------------------------------------------------------------

        .s              ( many -- many ) Prints stack contents

        dump            ( addr len -- ) Dump memory contents

        insight         ( -- ) Complete printout of dictionary structure

        name.           ( a-addr -- ) If this is the code-start of a definition,
                                      try to print its name.
        memstamp        ( a-addr -- ) Show memory location nicely
        disasm-$        ( -- a-addr ) Variable for current disasm position
        disasm-cont     ( -- a-addr ) Variable: Continue up to this position
        disasm-step     ( -- ) Disassemble one more instruction

        seec            ( -- ) Continue to see at disasm-$
        see name        ( -- ) See the definition

