\
\    Mecrisp-Across - A Forth cross compiler for small MSP430 microcontrollers
\    Copyright (C) 2016  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-Across is a Forth cross compiler for MSP430F2012 and similar chips.

HIC SUNT DRACONES - HIC SUNT DRACONES - HIC SUNT DRACONES

This is an early experimental release, so beware: Monsters may be inside !

-------------------------------------------------------------------------------

One of my favourite chips for small electronic projects is the MSP430F2012,
which is equipped with 2048 bytes of Flash and 128 bytes of RAM.

For assembly projects, memory is fine, but conquering these little critters
with Forth calls for a cross compiler. A compiler inside is just too large.

Fortunately, I wished to experiment with strong compiler optimisations for
a long time, and I enjoyed it a lot to find out what is possible when there
are neither size nor runtime constraints for compilation.

What you are currently looking at, dear reader, might be one of the strongest
optimizing Forth cross compilers you have ever seen. Out of the box, it does:

* Constant folding
* Register allocation for both data and return stack
* Dead code elimination (imagine a constant feed into case)
* Register allocation across control structures
* Determination which definitions are in use,
    just as Freepascals Smartlinking (fpc -XX)
* Automatic inlining of definitions used one time only
* Interrupt handler framing depending on register usage

And, despite it is a cross compiler running completely in the host system,
you can interactively test your definitions. Of course, this is neither
in real hardware nor in real time, but for future releases, it would be
possible to route IO port fetches and stores through JTAG into real chips.

This has some special effects:

There is no Forth kernel necessary in the target hardware ! Actually, no
memory is filled up with special requirements, everything is yours.

Additionally, this has a special implication on licencing:

Unlike most other Forth systems which need their kernel included into
every one of your projects, no piece of this one is included into the
generated target binary. For you, this means: The compiler is GPL3 licenced,
but the generated binaries are entirely yours - on whatever licence you wish.

I would be glad if you tell me of your cool project, and I love to make
example projects available with GPL3, but if you wish to compile your
own secret sauce for commercial success, you can do as you desire.

-------------------------------------------------------------------------------

How to run Mecrisp-Across:
--------------------------

It runs on current Mecrisp-Stellaris 2.3.6 for Linux and generates
example binaries that run on a MSP430G2553 Launchpad.

Just run "across" script which cats mecrisp-across-linux.txt into
Mecrisp-Stellaris for Linux like this:

stty -icanon -echo
cat mecrisp-across.txt - | qemu-arm-static mecrisp-stellaris-linux
stty sane

A mystery easy to solve is qemu-arm-static:
  It lets you run ARM binaries on any machine you have Linux running on.
  Get it on Debian: apt-get install qemu-user-static
  On a native ARM machine you can directly run mecrisp-stellaris-linux.


You can also load mecrisp-across-tiva.txt on a TM4C1294 Tiva Connected Launchpad
and connect a real MSP430F2012 with four wires:

   3.3V -- Vcc
    PA4 -- /Reset
    PA5 -- Test
    GND -- GND

As JTAG flash writing is timing sensitive, you should use the classic (non-RA)
version of Mecrisp-Stellaris for the Tiva at the moment.

With this setup, IO ports will be redirected over JTAG in interactive mode.

See msp430f2012/blinky.txt for hints on how to use it !

-------------------------------------------------------------------------------

How to generate a "Hello World" blinky with this compiler:
----------------------------------------------------------

new \ Start with a clean target dictionary

target \ Code for the target follows

: blinky ( -- )
  1 p1dir c!
  begin
    1 p1out cxor!
    10000 0 do loop
  again
;

host \ Back to the host

$FFFE vector blinky  \ Define Reset vector

crosscompile  \ Start compilation. You can do this only once after new !

disimage  \ Curious ? Gives disassembler listing

hexdump  \ Get the binary

-------------------------------------------------------------------------------

What you'll get if you compile the blinky example:
--------------------------------------------------

F800: 40B2  mov.w #5A80h, &120h                         Disable Watchdog
F802: 5A80
F804: 0120
F806: 4031  mov.w #278h, r1                             Prepare return stack
F808: 0278
F80A: 4034  mov.w #254h, r4                             Prepare  data  stack
F80C: 0254

F80E: 43D2  mov.b #1h, &22h
F810: 0022
F812: E3D2  xor.b #1h, &21h
F814: 0021
F816: 4307  mov.w #0h, r7
F818: 4038  mov.w #2710h, r8
F81A: 2710
F81C: 5317  add.w #1h, r7
F81E: 9807  cmp.w r8, r7
F820: 23FD  jnz F81C
F822: 3FF7  jmp F812

F824: 3FFF  jmp F824                                    Trap to catch execution

:10F80000B240805A20013140780234405402D24341
:10F810002200D2E3210007433840102717530798EE
:10F82000FD23F73FFF3FFFFFFFFFFFFFFFFFFFFF4E
:10FFF000FFFFFFFFFFFFFFFFFFFFFFFFFFFF00F817
:00000001FF

-------------------------------------------------------------------------------

Configuration, please ?
-----------------------

There are a few options to get different types of optimisations.
Set them according your wishes before you call "crosscompile".

* Choose the canonical stack state across function calls.
  Default is: TOS in r6, all other elements on stack.

  kanonischer-zustand-tos-im-register kanonischer-zustand !
  \ kanonischer-zustand-tos-auf-stack kanonischer-zustand !

-------------------------------------------------------------------------------

A different chip, please ?
--------------------------

Deep inside of the compiler, the memory map of the target chip is defined:

 $0200 constant ramstart

    \ Space for Variables and Buffers

    $0240 constant stackarea
    $0260 constant initialdatastack
    $0280 constant initialreturnstack
 $0280 constant ramend

 $F800 constant flashstart

    \ Space for Forth Dictionary

    $FFE0 constant vectortable
$10000 constant flashend

You need to recompile the compiler in order to change, but if you wish
to use this compiler with a MSP430G2452 instead, you know what to change.

-------------------------------------------------------------------------------

Special behaviour you should know
---------------------------------

* Fetches might occour later due to sophisticated register allocation.
    If you wish a fetch to take place exactly now, follow it with "flush".
    ... p1in c@ flush ...

* Use <builds does>

* Endcreate is necessary to end a constant table
    create answer 42 , endcreate

* Everything will be in Flash except VARIABLE and BUFFER:

* Crosscompilation mangles the dictionary.
    Use no more than once after each NEW.

-------------------------------------------------------------------------------

Ouch, the complete source code is in German !
---------------------------------------------

Which faciliates tinkering with the code, at least for me :-)

But you can do something: Tell me you are using this compiler...

I'll keep a counter in my mind. Counter rollover: Time to translate.

-------------------------------------------------------------------------------

Bugs around the corner !
------------------------

A very likely encounter with an experimental compiler which follows
experimental design ideas.

Report, and you'll find your name in the CREDITS file soon.

-------------------------------------------------------------------------------
-------------------------------------------------------------------------------


  Target Glossary
-------------------


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

Single-Jugglers:

        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 -- )
        2dup            ( x1 x2 -- x1 x2 x1 x2 )
        2swap           ( x1 x2 x3 x4 -- x3 x4 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
        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
        ><              ( xy -- yx )   Swap bytes

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

        *               ( u1|n1 u2|n2 -- u3|n3 ) 16*16 = 16 Multiplication
        2*              ( n1 -- n2 ) Arithmetric  left-shift
        2/              ( n1 -- n2 ) Arithmetric right-shift
        negate          ( n1 -- n2 ) Negate
        -               ( u1|n1 u2|n2 -- u3|n3 ) Subtraction
        +               ( u1|n1 u2|n2 -- u3|n3 ) Addition

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

        d2*             ( d1 -- d2 ) Arithmetric  left-shift
        d2/             ( d1 -- d2 ) Arithmetric right-shift
        dshl            ( ud1 -- ud2 ) Logical left-shift, same as d2*
        dshr            ( ud1 -- ud2 ) Logical right-shift

        d-              ( ud1|d1 ud2|d2 -- ud3|d3 ) Subtraction
        d+              ( ud1|d1 ud2|d2 -- ud3|d3 ) Addition
        
        d0=             ( xd -- flag ) Zero ?

;------------------------------------------------------------------------------
; Arithmetic without special optimisations
;------------------------------------------------------------------------------

        abs             ( n -- u ) Absolute value

        dabs            ( d -- ud ) Absolute value
        dnegate         ( d1 -- d2 ) Negate

        s>d             ( n -- d ) Makes a signed single number double length

        um*             ( u1 u2 -- ud )  16*16 = 32 Multiplication
        um/mod          ( ud u1 -- u2 u3 )     ud / u1 = u3 remainder u2

        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

        /mod            ( n1 n2 -- n3 n4 ) n1 / n2 = n4 rem n3
        mod             ( n1 n2 -- n3 ) n1 / n2 = remainder n3
        /               ( n1 n2 -- n3 ) n1 / n2 = n3

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

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

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

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

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

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

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


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

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

        @               ( 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
        c+!             ( u|n a-addr -- ) Add to byte memory location

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

        inline          ( -- ) Makes current definition always inlineable.
        immediate       ( -- ) Makes current definition immediate.

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

        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 constant table.
        endcreate       ( -- ) Finish a constant table

        ]               ( -- ) Switch to compile state
        [               ( -- ) Switch to execute state
        ;               ( -- ) Finishes new definition
        : name          ( -- ) Opens new definition

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

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

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

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   .. ... .....
    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

        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            ( -- )
                        (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 hardware specialities
;------------------------------------------------------------------------------

        reset           ( -- ) Reset on hardware level by triggering Watchdog

        dint            ( -- ) Disables Interrupts
        eint            ( -- ) Enables  Interrupts

        lpm0            ( -- ) Enter LPM0 and enable IRQs:
                          CPU, MCLK are disabled.
                          SMCLK, ACLK are active

        lpm1            ( -- ) Enter LPM1 and enable IRQs:
                          CPU, MCLK are disabled.
                          DCO and DC generator are disabled if
                          the DCO is not used for SMCLK.
                          ACLK is active.

        lpm2            ( -- ) Enter LPM2 and enable IRQs:
                          CPU, MCLK, SMCLK, DCO are disabled.
                          DC generator remains enabled.
                          ACLK is active.

        lpm3            ( -- ) Enter LPM3 and enable IRQs:
                          CPU, MCLK, SMCLK, DCO are disabled.
                          DC generator disabled.
                          ACLK is active.

        lpm4            ( -- ) Enter LPM4 and enable IRQs:
                          CPU and all clocks disabled.

        wakeup          ( -- ) Gives the current vector the ability to wake
                               from sleep modes upon return.
                               This is a flag and cannot be used conditionally

;------------------------------------------------------------------------------
; A few predefined port constants
;------------------------------------------------------------------------------

Word-Ports:

        ADC10AE0        ( -- a-addr )
        ADC10CTL0
        ADC10CTL1
        ADC10MEM
        SD16CTL
        SD16CCTL0
        SD16IV
        SD16MEM0
        TACCR1
        TACCR0
        TAR
        TACCTL1
        TACCTL0
        TACTL
        TAIV
        FCTL3
        FCTL2
        FCTL1
        WDTCTL

Byte-Ports:

        ADC10AE         ( -- c-addr )

        SD16INCTL0
        SD16AE

        USICTL0
        USICTL1
        USICKCTL
        USICNT
        USISR

        CAPD
        CACTL2
        CACTL1

        BCSCTL3
        BCSCTL2
        BCSCTL1
        DCOCTL

        P2REN
        P2SEL
        P2IE
        P2IES
        P2IFG
        P2DIR
        P2OUT
        P2IN

        P1REN
        P1SEL
        P1IE
        P1IES
        P1IFG
        P1DIR
        P1OUT
        P1IN

        IFG2
        IFG1
        IE2
        IE1

;------------------------------------------------------------------------------
; Clock setup
;------------------------------------------------------------------------------

        1MHz            ( -- )      Load DCO calibration values
        8MHz            ( -- )
        12MHz           ( -- )
        16MHz           ( -- )

;------------------------------------------------------------------------------
; Terminal-IO, included for MSP430G2553 and emulation
;------------------------------------------------------------------------------

        uart-init       ( -- )      Prepare UART for 9600 Baud @ 8 MHz

        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.

        cr              ( -- )      Emits line feed
        space           ( -- )      Emits space
        spaces          ( u -- )    Emits u spaces
        hex.            ( u -- )    Prints 16 bit unsigned in hex base.
        type            ( addr len -- ) Prints string

;------------------------------------------------------------------------------
; Pictured numerical output - Warning: Large due to a lot of dependencies !
;------------------------------------------------------------------------------

        output-base     ( -- a-addr ) Number base variable for pictured output        
        
        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   
        
        rtype           ( addr len n -- ) Display string in field n characters wide

        u.r             ( u n -- )  Print unsigned single number in field n characters wide
        .r              ( n n -- )  Print single number in field n characters wide
        ud.r            ( ud n -- )  Print unsigned double number in field n characters wide
        d.r             ( d n -- )  Print double number in field n characters wide
        
;------------------------------------------------------------------------------
; Tools available only in target mode of host during development
;------------------------------------------------------------------------------

        words           ( -- ) Prints list of defined words.
        list            ( -- ) Prints a short overview of defined words.
        .s              ( many -- many ) Prints stack contents, hexadecimal
        see name        ( -- ) Insight into definitions
        
        binary          ( -- ) Sets input base to 2
        decimal         ( -- ) Sets input base to 10
        hex             ( -- ) Sets input base to 16        


Matthias Koch, Summer 2016
