
#
#    Mecrisp-Quintus - A native code Forth implementation for RISC-V
#    Copyright (C) 2018  Matthias Koch
#
#    This program is free software: you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation, either version 3 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program.  If not, see <http://www.gnu.org/licenses/>.
#


Mecrisp-Quintus: A native code Forth for RISC-V... and MIPS.

Currently supports RV32I, RM32IM, RV32IMC and MIPS M4K.

# ------------------------------------------------------------------------------
#  What to expect:
# ------------------------------------------------------------------------------

A native code Forth performing compiler optimisations,
running on many 32 bit RISC-V and MIPS2 targets.

Acrobatics, a register allocator allowing to hold both data and return stack
elements in CPU registers is available as loadable compiler extension written
in Forth for easier maintenance and understandability.

A selection of tools is available in the /common folder containing
disassemblers, a multitasker, math functions, graphics primitives and much more.

Simple processor+terminal emulators for all embedded targets allow to create
custom binary images with precompiled Forth sources included.

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

This package also contains complete RISC-V example designs for FPGAs.

# ------------------------------------------------------------------------------
#  Notes on specialities of Mecrisp-Quintus, especially for first time users:
# ------------------------------------------------------------------------------

Mecrisp-Quintus can compile definitions directly into flash memory and will
write each location exactly one time. In normal operation, flash cells are never
erased unless the user types "eraseflash". This implies that dictionary pointer
and the dictionary chain need to be scanned on each boot, as there is no
possibility to store these pointers. This results in dictionary link order in
flash being backwards, from the oldest to the newest definition.

You can switch between memories using "compiletoram" and "compiletoflash".

Flash definitions are visible in compiletoram mode, but definitions living
in RAM are not visible when in compiletoflash mode.

If you write a definition to flash with the name "init", this will be run
at boot automatically, allowing you to create turnkey applications.

Important differences to ANS Forth:

* Variables are initialised like in FIG-Forth, and their initialisation value
  is restored upon each boot. Example: 42 variable answer

* Create has a standard action, which cannot be replaced by does> in flash memory.
  Use <builds does> instead.

* You cannot "create ... allot" properly in flash memory.
  Use buffer: instead to get an uninitialised chunk of RAM.

* Number input works different internally, but supports the standard number
  formats (and a bit more). The most notable extension are s31.32 fixpoint
  numbers like 3,14159 written with a comma instead of a dot.

* Dictionary structure is a special snowflake, including find.

* Flags like immediate need to be inside of the definition, not after the ;
  so that these can be collected for the header to be written at once
  when compiling into flash memory.

# ------------------------------------------------------------------------------
#  Similarities to Mecrisp-Stellaris and differences:
# -------------------------------------------------------------------------------

Functionally, Mecrisp-Quintus is mostly compatible with Mecrisp-Stellaris.

* Shifts decode the lowest 5 bits only on RISC-V.
  Therefore, ar/r/lshift behave like "31 and ar/r/lshift".
  32 lshift does nothing.

* Mecrisp-Quintus makes heavy use of PC-relative calls, which render inlining
  harmful. If you port code from Mecrisp-Stellaris, remove "inline" flags.

* c, is not available on any Mecrisp-Quintus target.
  h, is available only on RISC-V targets with compressed instruction support.

# ------------------------------------------------------------------------------
#  How to assemble:
# ------------------------------------------------------------------------------

You need a few packages which come with Debian 11:

apt-get install binutils-riscv64-linux-gnu binutils-mipsel-linux-gnu qemu-user-static srecord fpc

Run ./assemble which builds the assembler sources for the Forth cores only
or ./release for a full rebuild with precompiled sources.

# ------------------------------------------------------------------------------
#  How to synthesise the FPGA bitstreams:
# ------------------------------------------------------------------------------

The easiest way to install the tools needed to synthesise bitstreams
for the iCE40 and ECP5 family FPGAs is oss-cad-suite:

https://github.com/YosysHQ/oss-cad-suite-build/releases

You can also build Yosys, Icestorm, and NextPNR from source.

https://github.com/YosysHQ/yosys/
https://github.com/YosysHQ/icestorm
https://github.com/YosysHQ/nextpnr/

Do not try to install packaged Yosys/NextPNR/Icestorm tools that might come
with your distro – the toolchain is advancing very, very quick, and if your
distro packaged it three months ago, it is already heavily outdated.
The ones in Debian Stable – Ouch!

If you choose the precompiled oss-cad-suite, enter the environment with

source ~/path/to/oss-cad-suite/environment

Run ./synthesise and wait.

# ------------------------------------------------------------------------------
#  Hacking
# ------------------------------------------------------------------------------

Software multiplication and division routines are included in
mecrisp-quintus-source/common/multiplydivide-sw.s
for support of most basic RV32I processors.

Dictionary structure:

-- Aligned on 4 --
   4 bytes link
   4 bytes flags
   1 byte  name length
   n bytes name
-- Aligned on either 2 (RV32IMC only) or 4 (all other archs) --
   Code

Link chain in RAM is from newest to oldest (find uses first hit),
the oldest definition in RAM points to the oldest definition in flash,
and link chain continues in flash from oldest to newest
(find scans whole flash dictionary and uses last hit).

If in compiletoflash mode, find starts directly at the oldest flash definition,
skipping the dictionary link chain in RAM.

Empty link field or name length of zero denotes end of dictionary chain.


Only the low 16 registers are in use if you do not load the Acrobatics extension,
so you can easily port this Forth for RV32E targets should these arise.

  x0  : Contains zero. Hardwired in silicon.
  x1  : "Link register", holds link back and is also used to compose long calls
  x2  : SP Stack pointer for return stack.
  x3  : Loop index
  x4  : Loop limit
  x5  : Scratch register, needs to be saved.
  x6  : Scratch register, needs to be saved.
  x7  : Scratch register, needs to be saved.

  x8  : TOS Top of data stack.
  x9  : PSP Data stack pointer.
  x10 : Scratch register, needs to be saved.
  x11 : Scratch register, needs to be saved.
  x12 : Scratch register, needs to be saved.
  x13 : Scratch register, needs to be saved.
  x14 : Free scratch register, not saved across calls.
  x15 : Free scratch register, not saved across calls.

  x16 to x31 : Unused in vanilla cores.

  Acrobatics compiler is using x16 to x25 are free scratch registers, not saved across calls.

  Besides x0=zero, nothing is enforced by hardware on this architecture.

For MIPS, the assembler is tweaked with a few macros to accept the RISC-V style.
Make sure to have a look at mecrisp-quintus-source/common/mips-v.s for details.

Register map is very similiar, with the following differences:

  $1  : Free scratch register used by the assembler to construct opcode sequences
        (none on RISC-V)

  $31 : Link register
        (x1 on RISC-V)

All other CPU registers have a 1:1 map to their RISC-V counterparts.

# ------------------------------------------------------------------------------
#  Glossary
# ------------------------------------------------------------------------------

View with fixed-width font !

;------------------------------------------------------------------------------
; Terminal-IO  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

        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.

        hook-emit?      ( -- a-addr ) Hooks for redirecting
        hook-key?       ( -- a-addr )   terminal IO
        hook-key        ( -- a-addr )     on the fly
        hook-emit       ( -- a-addr )

        serial-emit?    ( -- Flag )  Serial interface
        serial-key?     ( -- Flag )    terminal routines
        serial-key      ( -- Char )      as default communications
        serial-emit     ( Char -- )

        hook-pause      ( -- a-addr ) Hook for a multitasker
        pause           ( -- )        Task switch, none for default

;------------------------------------------------------------------------------
; Stack Jugglers  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

Single-Jugglers:

        depth           ( -- +n ) Gives number of single-cell stack items.
        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 )
        pick            ( ... xi+1 xi ... x1 x0 i -- ... x1 x0 xi )
                                  Picks one element from deep below

        >r              ( x -- ) (R: -- x )
        r>              ( -- x ) (R: x -- )
        r@              ( -- x ) (R: x -- x )
        rdrop           (  --  ) (R: x -- )
        rdepth          ( -- +n ) Gives number of return stack items.
        rpick           ( i -- xi ) R: ( ... xi ... x0 -- ... xi ... x0 )

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

        2nip            ( x1 x2 x3 x4 -- x3 x4 )
        2drop           ( x1 x2 -- )
        2rot            ( x1 x2 x3 x4 x5 x6 -- x3 x4 x5 x6 x1 x2 )
        2-rot           ( x1 x2 x3 x4 x5 x6 -- x5 x6 x1 x2 x3 x4 )
        2swap           ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
        2tuck           ( x1 x2 x3 x4 -- x3 x4 x1 x2 x3 x4 )
        2over           ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
        2dup            ( x1 x2 -- x1 x2 x1 x2 )

        2>r             ( x1 x2 -- ) (R: -- x1 x2 )
        2r>             ( -- x1 x2 ) (R: x1 x2 -- )
        2r@             ( -- x1 x2 ) (R: x1 x2 -- x1 x2 )
        2rdrop          ( -- )       (R: x1 x2 -- )

Stack pointers:

        sp@             ( -- a-addr )  Fetch  data stack pointer
        sp!             ( a-addr -- )  Store  data stack pointer
        rp@             ( -- a-addr )  Fetch return stack pointer
        rp!             ( a-addr -- )  Store return stack pointer

;------------------------------------------------------------------------------
; Logic  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

        arshift         ( x1 u -- x2 ) Arithmetic 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
        shr             ( x1 -- x2 )   Logical right-shift of one bit-place
        shl             ( x1 -- x2 )   Logical  left-shift of one bit-place
        ror             ( x1 -- x2 )   Logical right-rotation of one bit-place
        rol             ( x1 -- x2 )   Logical  left-rotation of one bit-place
        bic             ( x1 x2 -- x3 ) Bit clear, identical to "not and"
        not             ( x1 -- x2 )   Invert all bits
        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
        clz             ( x1 -- u ) Count leading zeros

;------------------------------------------------------------------------------
; Calculus for single numbers  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

        u/mod           ( u1 u2 -- u3 u4 ) 32/32 = 32 rem 32 Division
                                           u1 / u2 = u4 remainder u3
        /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 ) 32*32 = 32 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
        2-              ( u1|n1 -- u2|n2 ) Subtracts two, optimized
        1-              ( u1|n1 -- u2|n2 ) Subtracts one, optimized
        2+              ( u1|n1 -- u2|n2 ) Adds two, optimized
        1+              ( u1|n1 -- u2|n2 ) Adds one, optimized
        even            ( u1|n1 -- u2|n2 ) Makes even. Adds one if uneven.
        2*              ( n1 -- n2 ) Arithmetic  left-shift
        2/              ( n1 -- n2 ) Arithmetic right-shift
        abs             ( n -- u ) Absolute value
        negate          ( n1 -- n2 ) Negate
        -               ( u1|n1 u2|n2 -- u3|n3 ) Subtraction
        +               ( u1|n1 u2|n2 -- u3|n3 ) Addition

;------------------------------------------------------------------------------
; Calculus involving double numbers  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

        um*             ( u1 u2 -- ud )        32*32 = 64 Multiplication
        ud*             ( ud1|d1 ud2|d2 -- ud3|d3 )  64*64 = 64 Multiplication
        udm*            ( ud1 ud2 -- ud3-Low ud4-High ) 64*64=128 Multiplication

        um/mod          ( ud u1 -- u2 u3 )     ud / u1 = u3 remainder u2
        ud/mod          ( ud1 ud2 -- ud3 ud4 ) 64/64 = 64 rem 64 Division
                                               ud1 / ud2 = ud4 remainder ud3

        m*              ( n1 n2 -- d )         n1 * n2 = d
        m/mod           ( d  n1 -- n2 n3 )     d  / n1 = n3 remainder r2
        d/mod           ( d1 d2 -- d3 d4 )     d1 / d2 = d4 remainder d3
        d/              ( d1 d2 -- d3 )        d1 / d2 = d3
        */              ( n1 n2 n3 -- n4 )     n1 * n2 / n3 = n4
        u*/             ( u1 u2 u3 -- u4 )     u1 * u2 / u3 = u4
        */mod           ( n1 n2 n3 -- n4 n5 )  n1 * n2 / n3 = n5 remainder n4
        u*/mod          ( u1 u2 u3 -- u4 u5 )  u1 * u2 / u3 = u5 remainder u4

        d2*             ( d1 -- d2 ) Arithmetic  left-shift
        d2/             ( d1 -- d2 ) Arithmetic right-shift
        dshl            ( ud1 -- ud2 )  Logical  left-shift, same as d2*
        dshr            ( ud1 -- ud2 )  Logical right-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

        2arshift        ( d1 u -- d2 ) Arithmetic double right-shift of u bit-places
        2rshift         ( d1 u -- d2 ) Logical    double right-shift of u bit-places
        2lshift         ( d1 u -- d2 ) Logical    double  left-shift of u bit-places

;------------------------------------------------------------------------------
; Comparisions  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

Single-Comparisions:
        u<=             ( u1 u2 -- flag )  Unsigned comparisions
        u>=             ( u1 u2 -- flag )
        u>              ( u1 u2 -- flag )
        u<              ( u1 u2 -- flag )
        <=              ( n1 n2 -- flag )    Signed comparisions
        >=              ( n1 n2 -- flag )
        >               ( n1 n2 -- flag )
        <               ( n1 n2 -- flag )
        0<              ( n - flag )         Negative ?
        0<>             ( x -- flag )
        0=              ( x -- flag )
        <>              ( x1 x2 -- flag )
        =               ( x1 x2 -- flag )

Double-Comparisions:            They perform the same for double numbers.
        du>             ( ud1 ud2 -- flag )
        du<             ( ud1 ud2 -- flag )
        d>              ( d1 d2 -- flag )
        d<              ( d1 d2 -- flag )
        d0<             ( d -- flag )
        d0=             ( d -- flag )
        d<>             ( d1 d2 -- flag )
        d=              ( d1 d2 -- flag )

Specials:
        slt             ( u1 u2 -- 0 | 1 ) Set if less than
        sltu            ( u1 u2 -- 0 | 1 ) Set if less than, unsigned

;------------------------------------------------------------------------------
; Tools (not only) for s31.32 fixed point numbers  (speciality!)
;------------------------------------------------------------------------------

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

        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#S             ( n-comma1 -- n-comma2 )
                        Adds 32 comma-digits to number output
        f#              ( n-comma1 -- n-comma2 )
                        Adds one comma-digit to number output
        f.              ( df -- )
                        Prints a fixpoint number with 32 fractional digits
        f.n             ( df n -- )
                        Prints a fixpoint number with n fractional digits

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

;------------------------------------------------------------------------------
; Number base  (exactly ANS)
;------------------------------------------------------------------------------

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

;------------------------------------------------------------------------------
; Memory access  (subtle differences to ANS, special cpu-specific extensions)
;------------------------------------------------------------------------------

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

        cbit@           ( mask c-addr -- flag ) Test BIts in byte-location
        hbit@           ( mask h-addr -- flag ) Test BIts in halfword-location
        bit@            ( mask a-addr -- flag ) Test BIts in word-location

        cxor!           ( mask c-addr -- ) Toggle bits in byte-location
        hxor!           ( mask h-addr -- ) Toggle bits in halfword-location
        xor!            ( mask a-addr -- ) Toggle bits in word-location

        cbic!           ( mask c-addr -- ) Clear BIts in byte-location
        hbic!           ( mask h-addr -- ) Clear BIts in halfword-location
        bic!            ( mask a-addr -- ) Clear BIts in word-location

        cbis!           ( mask c-addr -- ) Set BIts in byte-location
        hbis!           ( mask h-addr -- ) Set BIts in halfword-location
        bis!            ( mask a-addr -- ) Set BIts in word-location

        2constant name  ( ud|d -- ) Makes a double constant.
        constant  name  ( u|n -- )  Makes a single constant.
        2variable name  ( ud|d -- ) Makes an initialized double variable
        variable  name  ( n|n -- )  Makes an initialized single variable
        nvariable name  ( n1*u|n n1 -- ) Makes an initialized variable with
                                         specified size of n1 words
                                         Maximum is 15 words

        buffer: name    ( u -- ) Creates a buffer in RAM with u bytes length

        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

        h@              ( h-addr -- u )    Fetches halfword from memory
        h@signed        ( h-addr -- n )    Fetches halfword with sign extension
        h!              ( u h-addr )       Stores halfword in memory
        h+!             ( u|n h-addr -- )  Add to halfword memory location

        c@              ( c-addr -- char ) Fetches byte from memory
        c@signed        ( c-addr -- n )    Fetches byte with sign extension
        c!              ( char c-addr )    Stores byte in memory
        c+!             ( u|n a-addr -- )  Add to byte memory location

;------------------------------------------------------------------------------
; Strings and beautiful output (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

String routines:

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

        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

        compare         ( caddr-1 len-1 c-addr-2 len-2 -- flag )
                        Compares two strings

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

Counted string routines:

        ctype           ( cstr-addr -- )
                        Prints a counted string.

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

        cexpect         ( cstr-addr maxlength -- ) Read input into a counted string.

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

        skipstring      ( cstr-addr -- a-addr )
                        Increases the pointer to the aligned end of the string.

Pictured numerical output:

        .digit          ( u -- char ) Converts a digit to a char
        digit           ( char -- u true | false ) Converts a char to a digit

        [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

Deep insights:

        words           ( -- ) Prints list of defined words.
        .s              ( many -- many ) Prints stack contents, signed
        u.s             ( many -- many ) Prints stack contents, unsigned
        h.s             ( many -- many ) Prints stack contents, unsigned, hex
        .rs             ( many -- many ) Prints return stack contents
        hex.            ( u -- ) Prints 32 bit unsigned in hex base,
                                 needs emit only.
                                 This is independent of number subsystem.

;------------------------------------------------------------------------------
; User input and its interpretation (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

        query           ( -- ) Fetches user input to input buffer
        tib             ( -- cstr-addr ) Input buffer

        current-source  ( -- addr ) Double-Variable which contains source
        setsource       ( c-addr len -- ) Change source
        source          ( -- c-addr len ) Current source
        >in             ( -- addr ) Variable with current offset into source

        token           ( -- c-addr len ) Cuts one token out of input buffer
        parse           ( char -- c-addr len )
                        Cuts anything delimited by char out of input buffer

        evaluate        ( any addr len -- any ) Interpret given string
        interpret       ( any -- any ) Execute, compile, fold, optimize...
        quit            ( many -- ) (R: many -- ) Resets Stacks
        hook-quit       ( -- a-addr ) Hook for changing the inner quit loop
        (quit)          ( any -- any ) Standard REPL, default for hook-quit

;------------------------------------------------------------------------------
; Dictionary expansion  (exactly ANS, some logical extensions)
;------------------------------------------------------------------------------

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

        unused          ( -- u ) Get current amount of free memory
        allot           ( n -- ) Tries to advance Dictionary Pointer by n bytes
                                 Aborts, if not enough space available
        here            ( -- a-addr|h-addr )
                        Gives current position in Dictionary
        (dp)            ( -- a-addr ) Variable: Dictionary pointer
        (latest)        ( -- a-addr ) Variable: Latest definition

        ,               ( u|n -- ) Appends a single number to dictionary
        h,              ( u|n -- ) Appends a halfword to dictionary, RV32IMC only

        compiletoram?   ( -- ? ) Currently compiling into ram ?
        compiletoram    ( -- ) Makes ram   the target for compiling
        compiletoflash  ( -- ) Makes flash the target for compiling

        forgetram       ( -- ) Forget definitions in ram without a reset

        addrinflash?    ( addr -- flag ) Location in flash memory ?
        addrinram?      ( addr -- flag ) Location in ram   memory ?

;------------------------------------------------------------------------------
; Dictionary expansion  (speciality!)
;------------------------------------------------------------------------------

        string,         ( c-addr len -- ) Inserts a string of maximum 255 characters without runtime
        literal,        ( u|n -- ) Compiles a literal with runtime
        inline,         ( a-addr -- ) Inlines the choosen subroutine
        call,           ( a-addr -- ) Compiles a call to a subroutine
        ret,            ( -- ) Compiles a ret opcode

        flashvar-here   ( -- a-addr ) Gives current RAM management pointer
        dictionarystart ( -- a-addr ) Current entry point for dictionary search
        dictionarynext  ( a-addr -- a-addr flag )
                        Scans dictionary chain and returns true if end is reached.

        skipdefinition  ( addr -- addr* ) Skip after the next ret opcode
        (sp)            ( -- a-addr) Variable to compare data stack pointer
                                     before and after compilation of definitions

       registerliteral, ( x register -- ) Generate shortest possible sequence
                                          to get x into given register.

RISC-V only:                   Can x be encoded as immediate for...

        uj-encoding?    ( x -- x false | bitmask true ) ... unconditional jumps
        sb-encoding?    ( x -- x false | bitmask true ) ...   conditional jumps

RISC-V with compressed instruction support only:

        cj-encoding?    ( x -- x false | bitmask true ) ... c.jal

;------------------------------------------------------------------------------
; Flags and inventory  (speciality!)
;------------------------------------------------------------------------------

        smudge          ( -- ) Makes current definition visible, burns
                               collected flags to flash and
                               takes care of proper ending
        inline          ( -- ) Makes current definition inlineable.
                               For flash, place it inside your definition !
        noframe         ( -- ) No need to push/pop link register when compiling this definition.
                               For flash, place it inside your definition !
        immediate       ( -- ) Makes current definition immediate.
                               For flash, place it inside your definition !
        compileonly     ( -- ) Makes current definition compileonly.
                               For flash, place it inside your definition !
        setflags        ( x -- ) Sets Flags with a mask. This isn't immediate,
                               but for flash, place it inside your definition !
        (create) name   ( -- ) Creates and links a new invisible dictionary
                               header that does nothing.
                               Use FIG-style <builds .. does> !
        find            ( c-addr len -- a-addr flags )
                               Searches for a String in Dictionary.
                               Gives back flags, which are different to ANS !
        hook-find       ( -- a-addr ) Hook for redirecting find
        (find)          ( c-addr len -- a-addr flags ) Default find implementation

        0-foldable      ( -- ) Current word becomes foldable with zero constants
        1-foldable      ( -- ) Current word becomes foldable with one constants
        2-foldable      ( -- ) Current word becomes foldable with two constants
        3-foldable      ( -- ) Current word becomes foldable with 3   constants
            ...
        7-foldable      ( -- ) Current word becomes foldable with 7   constants

;------------------------------------------------------------------------------
; Compiler essentials  (subtle differences to ANS)
;------------------------------------------------------------------------------

        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.
        <builds         ( -- ) Makes Dictionary header and reserves space
                               for special call.
        create name     ( -- ) Create a definition with default action which
                               cannot be changed later. Use <builds does> instead.
                               Equivalent to : create <builds does> ;
        state           ( -- a-addr ) Address of state variable
        ]               ( -- ) Switch to compile state
        [               ( -- ) Switch to execute state
        ;               ( -- ) Finishes new definition
        : name          ( -- ) Opens new definition

;------------------------------------------------------------------------------
; Control structures (exactly ANS)
;------------------------------------------------------------------------------
Internally, they have complicated compile-time stack effects.

Decisions:

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

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

Case:

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

        case            ( n -- n )       Begins case structure
        of              ( m -- )         Compares m with n, choose this if n=m
        ?of             ( n flag -- )    Flag-of, for custom comparisions
        endof           ( -- )           End of one possibility
        endcase         ( n -- )         Ends case structure, discards n

Indefinite Loops:

begin ... again
begin ... flag until
begin ... flag while ... repeat
begin ... flag while ... flag while ... repeat ... else ... then

        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


        k               ( -- u|n ) Gives third  loop index
        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.
                               Compiles a ret opcode.

        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

;------------------------------------------------------------------------------
; Common interrupt primitives
;------------------------------------------------------------------------------

        reset           ( -- ) Reset on hardware level, if possible
        dint            ( -- ) Disables Interrupts
        eint            ( -- ) Enables  Interrupts
        eint?           ( -- ) Are Interrupts enabled ?
        nop             ( -- ) No Operation. Hook for unused handlers !

        unhandled       ( -- ) Message for unhandled interrupts.

        irq-collection  ( -- a-addr ) Collection of all unhandled interrupts
        irq-fault       ( -- a-addr ) For all faults, if available

;------------------------------------------------------------------------------
; Common flash memory primitives
;------------------------------------------------------------------------------

        eraseflash      ( -- ) Erases everything. Clears Ram. Restarts Forth.

        eraseflashfrom  ( a-addr -- ) Starts erasing at this address.
                                      Clears Ram. Restarts Forth.

        flashpageerase  ( a-addr -- ) Erase one flash page only. Take care:
                                      No Reset, no dictionary reinitialisation.

        hflash!         ( u|n a-addr -- )   Writes halfword to flash, RV32IMC only
        flash!          ( u|n 4-a-addr -- ) Writes single number to flash,
                                              4 aligned !

;------------------------------------------------------------------------------
; Specials depending on architecture
;------------------------------------------------------------------------------

        risc-v          ( -- ) Welcome message if arch is RISC-V
        mips            ( -- ) Welcome message if arch is MIPS


Matthias Koch, October 2022
